Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/AA_make	(revision 5166)
@@ -0,0 +1,51 @@
+#- $Id$
+all_lib : libioipsl libparallel libparameters liborglob libstomate libsechiba
+
+libioipsl:
+	(cd ../IOIPSL/src; $(M_K) -f Makefile)
+
+libparameters :
+	(cd src_parameters ; $(M_K) -f Makefile)
+
+libparallel :
+	(cd ../../modeles/ORCHIDEE/src_parallel ; $(M_K) -f Makefile)
+
+liborglob :
+	(cd src_global ; $(M_K) -f Makefile)
+
+libstomate :
+	(cd src_stomate ; $(M_K) -f Makefile)
+
+libsechiba :
+	(cd src_sechiba ; $(M_K) -f Makefile)
+
+driver : all_lib
+	(cd src_driver ; $(M_K) -f Makefile)
+
+config : 
+	(cd src_parameters; $(M_K) -f Makefile config)
+	(cd src_sechiba; $(M_K) -f Makefile config)
+	(cd src_stomate; $(M_K) -f Makefile config)
+
+clean : 
+	(cd src_parameters; $(M_K) -f Makefile clean)
+	(cd src_parallel; $(M_K) -f Makefile clean)
+	(cd src_global; $(M_K) -f Makefile clean)
+	(cd src_sechiba; $(M_K) -f Makefile clean)
+	(cd src_stomate; $(M_K) -f Makefile clean)
+	(cd src_driver; $(M_K) -f Makefile clean)
+	(rm -f ../../lib/*)
+
+doc:
+	doxygen Doxyfile_ORCHIDEE
+	export TEXINPUTS="${TEXINPUTS}:${PWD}/DOC//"; export BIBINPUTS="${BIBINPUTS}:${PWD}/DOC/BIB//"; cd docs/latex ; latex refman.tex 
+
+bib:
+	export TEXINPUTS="${TEXINPUTS}:${PWD}/DOC//"; export BIBINPUTS="${BIBINPUTS}:${PWD}/DOC/BIB//"; cd docs/latex ; bibtex refman 
+
+index:
+	export TEXINPUTS="${TEXINPUTS}:${PWD}/DOC//"; export BIBINPUTS="${BIBINPUTS}:${PWD}/DOC/BIB//"; cd docs/latex ; makeindex refman 
+
+toc:
+	export TEXINPUTS="${TEXINPUTS}:${PWD}/DOC//"; export BIBINPUTS="${BIBINPUTS}:${PWD}/DOC/BIB//"; cd docs/latex ; latex refman.tex 
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/AA_make.ldef	(revision 5166)
@@ -0,0 +1,3 @@
+#- $Id$
+#---------------------------------------------------------------------
+#-
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/BIB/orchidee.bib
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/BIB/orchidee.bib	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/BIB/orchidee.bib	(revision 5166)
@@ -0,0 +1,37 @@
+@Article{Chalita_94,
+  author = 	 {{Chalita, S.} and {Le Treut, H.}},
+  title = 	 {``{The albedo of temperate and boreal forest and the Northern Hemisphere climate: a sensitivity experiment using the LMD GCM}''},
+  journal = 	 {Climate Dynamics},
+  year = 	 {1994},
+  volume = 	 {10},
+  pages = 	 {231-240},
+}
+
+
+@Article{Chuine_00,
+  author = 	 {{Chuine, I.}},
+  title = 	 {``{A unified model for budburst of trees}''},
+  journal = 	 {Journal of Theoretical Biology},
+  volume = 	 {207},
+  year = 	 {2000},
+  pages = 	 {337-347}
+}
+
+
+@Article{Bott-Viov-Ciais-Frie-Monf_00,
+  author = 	 {{Botta, A.} and {Viovy, N.} and {Ciais, P.} and {Friedlingstein, P.} and {Monfray, P.}},
+  title = 	 {``{A global prognostic scheme of leaf onset using satellite data.}''},
+  journal = 	 {Global Change Biology},
+  year = 	 {2000},
+  volume = 	 {6},
+  pages = 	 {709-725},
+}
+
+@Article{Orla-Garc-Ezqu-Roma-Domi-Gala-Forn_04,
+  author = 	 {{Orlandi, F.} and {Garcia-Mozo, H.} and {Ezquerra, L.V.} and {Romano, B.} and {Dominguez, E.} and {Galan, C.} and {Fornaciari, M.}},
+  title = 	 {``{Phenological olive chilling requirements in Umbria (Italy) and Andalusia (Spain)}''},
+  journal = 	 {Plant Biosystems},
+  year = 	 {2004},
+  volume = 	 {138},
+  pages = 	 {111-116},
+}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex	(revision 5166)
@@ -0,0 +1,12 @@
+We calculate the deviation of the saturated humidity with the temperature and the pressure.
+\begin{equation}
+\delta q_{sat}(T) = \frac{(q_s(\lfloor T+\frac{1}{2}\rfloor + 1) - 2.q_s(\lfloor T +\frac{1}{2} \rfloor) + q_s(\lfloor T+\frac{1}{2} \rfloor -1))(\lbrace T + \frac{1}{2}\rbrace -1 ) + q_s(\lfloor T+\frac{1}{2} \rfloor +1) - q_s(\lfloor T+\frac{1}{2} \rfloor)}{P}
+\end{equation}
+
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T + \frac{1}{2} \rfloor $ represents the largest integer not greater than $T + \frac{1}{2} $. 
+ \item  $ \lbrace T + \frac{1}{2} \rbrace = T + \frac{1}{2} -\lfloor T + \frac{1}{2} \rfloor $ is the fractional part of $T + \frac{1}{2} $.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex	(revision 5166)
@@ -0,0 +1,14 @@
+We calculate the deviation of the saturated humidity with the temperature and the pressure for a given pixel $x$.
+\begin{multline}
+\delta q_{sat}(x,T) = \\
+\frac{(q_s(x,\lfloor T+\frac{1}{2}\rfloor + 1) - 2.q_s(x,\lfloor T +\frac{1}{2} \rfloor) + q_s(x,\lfloor T+\frac{1}{2} \rfloor -1))(\lbrace T + \frac{1}{2}\rbrace -1 )} {P}+ 
+\\ \frac{q_s(x,\lfloor T+\frac{1}{2} \rfloor +1) - q_s(x, \lfloor T+\frac{1}{2} \rfloor)}{P}
+\end{multline}
+
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T + \frac{1}{2} \rfloor $ represents the largest integer not greater than $T + \frac{1}{2} $. 
+ \item  $ \lbrace T + \frac{1}{2} \rbrace = T + \frac{1}{2} -\lfloor T + \frac{1}{2} \rfloor $ is the fractional part of $T + \frac{1}{2} $.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex	(revision 5166)
@@ -0,0 +1,30 @@
+The subroutine qsfrict\_init uses modified Goff-Gratch equations (1946). The original formulations are : \\
+\begin{multline}
+\log e_w = \\ -7.90298 \left( \frac{T_s}{T} - 1 \right) + 5.02808 \log \left( \frac{T_s}{T} \right) 
+- 1.3816 \times 10^{-7}(10^{11.344 \left( 1-\frac{T_s}{T} \right)}-1) 
++ 8.1328 \times 10^{-3}(10^{-3.49149 \left( \frac{T_s}{T}-1 \right)}
+-1) \\ + \log e_{ws}
+\end{multline}
+where : \\
+\begin{itemize}
+ \item  $ \log(x) = \frac{\ln x}{\ln 10} $. 
+ \item  $e_w$ is the saturation water vapor pressure over a plane surface of pure ordinary liquid water (hPa).
+ \item  $T$ is the absolute air temperature in Kelvin.
+ \item  $T_s$ is the steam point temperature (373.16 K).
+ \item  $e_{ws}$ is the saturation pressure of pure ordinary liquid water at steam-point temperature (at 1 atm = 1013.25 hPa).
+\end{itemize}
+
+\begin{multline}
+\log e_i = \\ -9.09718 \times \left( \frac{T_0}{T} - 1 \right) - 3.56654 \times \log \left( \frac{T_0}{T} \right) 
++ 0.876793 \times \left( 1-\frac{T_0}{T} \right) 
++ \log e_{i0}
+\end{multline}
+where : \\
+\begin{itemize}
+ \item  $ \log(x) = \frac{\ln x}{\ln 10} $. 
+ \item  $e_i$ is the saturation water vapor pressure over a plane surface of pure ordinary water ice (hPa).
+ \item  $T$ is the absolute air temperature in Kelvin (K).
+ \item  $T_0$ is the boiling point at 1 atmosphere temperature (273.16 K).
+ \item  $e^{*}_{i0}$  is the saturation pressure of pure ordinary water ice at ice-point temperature (6.1173 hPa).
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex	(revision 5166)
@@ -0,0 +1,12 @@
+The interpolation the saturated humidity depends on the temperature $T$ (in Kelvin). 
+It is set by the following equation :
+\begin{equation}
+q_{sat}(T)= \dfrac{q_s(\lfloor T \rfloor +1) - q_s(\lfloor T \rfloor).\lbrace T \rbrace + q_s(\lfloor T \rfloor)}{P}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T \rfloor $ represents the largest integer not greater than $T$. 
+ \item  $ \lbrace T \rbrace = T -\lfloor T \rfloor $ is the fractional part of $T$.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex	(revision 5166)
@@ -0,0 +1,12 @@
+The interpolation the saturated humidity on one pixel $x$  depends on the temperature $T$ (in Kelvin). 
+It is set by the following equation :
+\begin{equation}
+q_{sat}(x,T)= \dfrac{q_s(x,\lfloor T \rfloor +1) - q_s(x,\lfloor T \rfloor).\lbrace T \rbrace + q_s(x,\lfloor T \rfloor)}{P}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T \rfloor $ represents the largest integer not greater than $T$. 
+ \item  $ \lbrace T \rbrace = T -\lfloor T \rfloor $ is the fractional part of $T$.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex	(revision 5166)
@@ -0,0 +1,17 @@
+The specific humidity  $q_s$ is a function of temperature $T$. Its values are : 
+\begin{equation}
+q_s(T) = 
+\begin{cases}
+0 & \text{if} \quad T < 100K \\
+\dfrac{M_{air}}{M_{vapor}} \cdot 10^{2.07203 - 0.0032099T - \frac{2484.896}{T} + 3.56654\log{T}} & \text{if} \quad 100K \leq T < 273K \\
+\dfrac{M_{air}}{M_{vapor}} \cdot 10^{23.819 - \frac{2948.964}{T} -
+  5.028\log{T} - 29910.16\exp(-0.0699832\times T) + 25.21935\exp(-\frac{2999.924}{T}) } & \text{if} \quad 273K \leq T \leq 370K \\
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $\dfrac{M_{air}}{M_{vapor}} = \dfrac{18.02 \times 10^{-3}}{28.964 \times 10^{-3}} \simeq 0.622 $ is the ratio between the molecular weight of dry air and \\ 
+the molecular weight of water vapor.
+ \item  $\log(T) = \dfrac{\ln T}{\ln 10}$
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex	(revision 5166)
@@ -0,0 +1,18 @@
+%\documentclass{article}
+%\usepackage[english]{babel}
+%\usepackage{amsmath}
+%\begin{document}
+\begin{equation}
+f(T) = 
+\begin{cases}
+0 & \text{if} \quad T < 273K \\
+1 - \dfrac{(T_{max} - T)^2}{(T_{max} - T_{min})^2} & \text{if} \quad 273K \leq T \leq 293K \\
+1 & \text{if} \quad T > 293K
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ T_{min} = 273K$ 
+ \item  $ T_{max} = 293K$
+\end{itemize}
+%\end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+snowAlb=snowaIni+snowaDec \times \exp{\frac{-snowAge}{tsctSnowa}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+fracSnow=\frac{snow}{snow+10}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+C = [\frac{1}{\kappa} ln(\frac{z}{z0})]^2 
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex	(revision 5166)
@@ -0,0 +1,100 @@
+%
+% \documentclass[11pt]{amsart}
+% \usepackage{helvet}
+% \usepackage{geometry}    
+% \geometry{a4paper} 
+% \usepackage[parfill]{parskip}  \usepackage{graphicx}
+% \usepackage{amssymb}
+% \usepackage{epstopdf}
+% 
+% 
+% 
+% \begin{document}
+
+As is outlined in Guimberteau (2010), evaporation in ORCHIDEE is calculated as a function of evaporation potential $E_{pot}$, limited by the resistances. Evaporation potential is defined as below:
+
+ \hspace{0.5cm}    \lefteqn{E_{pot} = \frac{\rho}{r_a}(q_{sat}(T_s)-q_{air})}
+
+{\it where $q_{sat}(T_s)$ is the saturation humidity corresponding to a particular surface temperature and $q_{air}$ is the specific humidity in the atmosphere immediately above the surface.}
+
+A conventional way to describe evaporation in surface layer modelling is via the means of the resistance analogy. Below we demonstrate how the $\beta$ coefficients within ORCHIDEE may be re-written in terms of this analogy.
+
+{\bf Evaporation of water intercepted by canopy}
+
+In ORCHIDEE, $\beta_2$, the water interception resistance, is defined as:
+
+\hspace{0.5cm} \lefteqn{E=\beta_{2} E_{pot}}
+
+\hspace{0.5cm} \lefteqn{\beta_{2} = \frac{1}{1+\frac{r_{s_v}}{r_a}}}
+
+{\it where E represents the evapotranspiration, $r_{s_v}$ is the structural resistance of the canopy and $r_a$ is the aerodynamic resistance. }
+
+This can be reformulated in terms of the 'traditional' circuitry analogy, where evapotranspiration represents (in the analogy) the current and the voltage (or potential difference) is represented by the difference in humidity between the saturated surface and the atmosphere just above the ground.
+
+ \hspace{0.5cm} \lefteqn{E\left( 1+\frac{r_{s_v}}{r_a}  \right) = \frac{\rho}{r_a}(q_{sat}(T_s) - q_{air})}
+
+ \hspace{0.5cm} \lefteqn{     \overbrace{   E}^I  \overbrace{ (r_a+r_{s_v})}^R = \overbrace { \rho (q_{sat}(T_s) - q_{air})  }^V }
+
+
+\includegraphics[scale=0.45]{diffuco_schematic2.png}
+
+{\bf Figure 1:} resistance chain for the evaporation of intercepted water
+
+
+\vspace{1cm}
+
+{\bf Transpiration of the canopy}
+
+
+$\beta_3$, the canopy transpiration resistance, is defined as:
+
+
+\hspace{0.5cm} \lefteqn{E=\beta_{3} E_{pot}}
+
+\hspace{0.5cm} \lefteqn{\beta_{3} = \left(  \frac{1}{1+\frac{r_{s_v} + r_{sto_v}}{r_a}}  \right) U_{s_v} }
+
+{\it where E represents the evapotranspiration, $U_{S_v}$ is the potential for extraction from the plant roots, $r_{s_v}$ is the structural resistance of the canopy, $r_{sto_v}$ is the stomatal resistance of the surface cover and $r_a$ is the aerodynamic resistance. }
+
+so:
+
+ \hspace{0.5cm}  \lefteqn{ \frac{E}{\beta_{3}} = \frac{\rho}{r_a}(q_{sat}(T_s)-q_{air})}
+
+\hspace{0.5cm}   \lefteqn{E\left( 1+   \frac{r_{s_v}+r_{sto_v}}{r_a}   \right) U_{sv} = \frac{\rho}{r_a}(q_{sat}(T_s) - q_{air})}
+
+\hspace{0.5cm}   \lefteqn{   \overbrace {  E  }^I   \overbrace{ (r_a + (r_{s_v}+ r_{sto_v}))U_{s_v} }  ^R =   \overbrace { \rho (q_{sat}(T_s) - q_{air}   )   } ^V  }
+
+\includegraphics[scale=0.5]{diffuco_schematic1.png}
+
+{\bf Figure 2:} resistance chain for canopy transpiration
+
+
+\vspace{1cm}
+
+{\bf Evaporation of the bare soil}
+
+$\beta_4$, the bare soil evaporation resistance, is defined as:
+
+
+\hspace{0.5cm} \lefteqn{E=\beta_{4} E_{pot}}
+
+\hspace{0.5cm} \lefteqn{\beta_{4} = \left(  \frac{1}{1+\frac{r_1}{r_a}}  \right) U_{s_1} }
+
+{\it where E represents the evapotranspiration, $U_{S_1}$ is the relative humidity in equilibrium with the bare soil, $r_{1}$ is the resistance of bare soil to evaporation and $r_a$ is the aerodynamic resistance. }
+
+so we can again convert the expression to the resistance analogy:
+
+ \hspace{0.5cm}  \lefteqn{\frac{E}{\beta_{4}} = \frac{\rho}{r_a}(q_{sat}(T_s)-q_{air})}
+
+ \hspace{0.5cm} \lefteqn{E\left( 1+   \frac{r_1}{r_a}   \right) U_{s_1} = \frac{\rho}{r_a}(q_{sat}(T_s) - q_{air})}
+
+ \hspace{0.5cm} \lefteqn{   \overbrace {E}^I    \overbrace  {(r_a + r_1)U_{s_1}}^R = \overbrace {\rho (q_{sat}(T_s) - q_{air}   )} ^V }
+
+
+\includegraphics[scale=0.45]{diffuco_schematic3.png}
+
+{\bf Figure 3:} resistance chain for bare soil evaporation
+
+% 
+% 
+% 
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex	(revision 5166)
@@ -0,0 +1,122 @@
+
+\documentclass[11pt]{amsart}
+\usepackage{helvet}
+\usepackage{geometry}    
+\geometry{a4paper} 
+\usepackage[parfill]{parskip}  \usepackage{graphicx}
+\usepackage{amssymb}
+\usepackage{epstopdf}
+
+
+
+\begin{document}
+
+\renewcommand{\arraystretch}{1.5}
+
+\begin{tabular}{|c|l|r|}
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+\hline
+ $ps^{old}$ & psold & surface static energy at old timestep (J/kg) \\
+ $ps^{new}$ & psnew & surface static energy at new timestep (J/kg)\\
+ $q_s$ & qsurf & surface specific humidity (kg/kg) \\
+ $q_{s, sat}$ & qsol\_sat & saturated surface humidity (kg/kg) \\
+ $q_{air}$ & qair & lowest level specific humidity at 'old' timestep (kg/kg) \\
+ $q_{air}^{new}$ & qair\_new & lowest level specific humidity at 'new' timestep (kg/kg) \\
+ $\frac{\delta q_s^{old}}{\delta t}$ & pdqsold & derivative of saturated specific humidity at old temperature (kg/(kg s)) \\ 
+ $p_l$ & pb & lowest level air pressure (Pa) \\
+ \hline
+ $C_p^{air}$ & cp\_air & lowest level atmospheric heat capacity (J/(K kg)) \\   
+ \hline
+ $\chi_{CO_2}^{canopy}$ & ccanopy & $CO_2$ concentration in the canopy (?? ppm)  \\
+ $\bar{Ci}$ & cimean & mean intercellular ci (from STOMATE) $(\mu mole/m^2/s)$\\  
+ \hline
+ $R^{LW}_{\uparrow}$ & lwup & long-wave upwelling radiation $(W/m^2)$ \\  
+ $ R^{LW}_{\downarrow}$ & lwdown & downwelling long-wave radiation flux $(W/m^2)$ \\
+ $R^{LW}_{abs}$ & lwabs  & LW radiation absorbed by the surface $(W/m^2)$ \\ 
+ $R^{SW}_{net}$ & swnet & net shortwave radiation flux $(W/m^2)$ \\
+ $R^{net}_{sns}$ & netrad\_sns & sensitivity of net radiation $(W/m^2)$ \\
+ $R_{net}$ & netrad & net radiation at surface layer $(W/m^2)$ \\
+ \hline
+ $\Delta \theta$ & dtradia & Time step (s) \\
+ $\epsilon$ & emis & emissivity (fraction) \\
+ $\sigma$ & c\_stefan & Stefan-Boltzmann constant $(W / (m^2 K^4))$\\
+ $q_{c}$ & q\_cdrag & surface drag coefficient (m/s) \\
+ $\rho_{air}$ & rau & density of air $(kg/m^3)$ \\
+\hline
+\end{tabular}
+
+
+\begin{tabular}{|c|l|r|}
+
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+
+
+ \hline
+ 
+ $z_0$     &  z0 & Surface roughness Length (m) \\
+ roughheight  & roughheight   & Effective roughness height (m) \\
+ zlev  &  zlev & Height of first atmospheric layer (m) \\
+ veget\_max  & veget\_max & Fraction of vegetation type (-) \\
+ temp\_sol & temp\_sol &  Ground temperature (K) \\
+ temp\_air & temp\_air  &     !! Lowest level temperature (K) \\
+ qsurf  & qsurf & near surface specific air humidity (kg/kg) \\
+ qair  & qair & Lowest level specific air humidity (kg/kg) \\
+ 
+ \hline
+ 
+ veget    & veget & vegetation fraction for each type (fraction) \\
+ qsintveg & qsintveg & Water on vegetation due to interception $(kg/m^2)$ \\
+ qsintmax & qsintmax & Maximum water on vegetation $(kg/m^2)$ \\
+ rstruct  & rstruct & architectural resistance (s/m) \\
+ humrel & humrel & Soil moisture stress (within range 0 to 1 \\
+ veget  & veget & Type of vegetation (-) \\
+ veget\_max  & veget\_max &  Max. vegetation fraction (LAI to infinity) (fraction) \\
+ lai  & lai & Leaf\ area\ index $(m^2/m^2)$ \\
+ qsintveg & qsintveg & Water on vegetation due to interception $(kg/m^2)$ \\
+ 
+ \hline
+ 
+ $r_a$    & raero & aerodynamic resistance (s/m) \\
+ $r_{soil}$    & rsol & bare soil evaporation resistance (s/m) \\
+ $\delta _c$ & zdefconc & water vapour concentration deficit $(kg/m^3)$\\
+ \hline
+  
+\end{tabular}
+
+
+
+\begin{tabular}{|c|l|r|}
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+
+
+ \hline
+ $T_{air}$ & tair & air temperature (K) \\
+ $T_{dgnc}^{2m}$ & t2mdiag & diagnostic temperature at 2m above ground (K) \\  
+ $T^{2m}$ & t2m & 2m air temperature (K) \\  
+ $q^{2m}$ & q2m & 2m specific humidity (kg/kg) \\  
+ $T_S$ & temp\_sol & surface temperature (K) \\  
+ \hline
+
+ $\alpha_v $ & valpha & total $\alpha$ resistance coefficient (fraction) \\
+ $\beta_v$ & vbeta & total resistance coefficient (fraction) \\
+ $\beta_{v1}$ & vbeta1 & snow resistance (fraction) \\  
+ $\beta_{v2}$ & vbeta2 & interception resistance (fraction)\\  
+ $\beta_{v3}$ & vbeta3 & vegetation resistance (fraction)\\  
+ $\beta_{v4}$ & vbeta4 & bare soil resistance (fraction)\\
+ $\beta_{v23}$ & vbeta23 & portion of wetted foliage that will transpire (fraction)\\ 
+ $\beta_{v,CO_2}$ & vbetaco2 & vegetation resistance to $CO_2$ \\ 
+ \hline
+ $U$ & speed & lowest level wind speed (m/s) \\
+ $u$ & u & lowest level wind velocity,  Eastward component  (m/s) \\
+ $v$ & v & lowest level wind volocity, Northward component  (m/s) \\
+ \hline
+ $z_{ikt}$ & zikt & aerodynamic resistance / density of air (kg s $m^{-4}$) \\
+ $z_{ikq}$ & zikq & aerodynamic resistance / density of air (kg s $m^{-4}$)  \\
+\hline
+\end{tabular}
+
+
+\end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex	(revision 5166)
@@ -0,0 +1,15 @@
+% \documentclass{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+The integration at the canopy level is done over nlai=20 fixed levels $l$.
+
+nlai is a local constant of the diffuco module.
+
+laimax is a local constant of the diffuco\_trans\_co2 subroutine independent of the PFT equal to 12. 
+
+\begin{equation}
+{{{LAI}}(l)={{lai}}{max}\frac{e^{{0{.}{15}\cdot (l-1)}}-1}{e^{{0{.}{15}\cdot {{nlai}}}}-1}}\nonumber
+\end{equation}
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex	(revision 5166)
@@ -0,0 +1,9 @@
+% \documentclass[onecolumn,a4paper]{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+\begin{equation}
+{{{light}}=e^{{-k\cdot {{LAI}}(l)}}}\nonumber
+\end{equation}
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex	(revision 5166)
@@ -0,0 +1,17 @@
+% \documentclass{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+$Q$ surface specific humidity
+
+$Q_{sat}$ saturated surface humidity (calculated in constant\_veg:qsatcalc)
+
+$P$ surface pressure
+
+$h_r$ relative humidity of air
+
+\begin{equation}
+{h_{{r}}=\frac{Q\cdot P/{(0{.}{622}+0{.}{378}\cdot Q)}}{Q_{{{{sat}}}}\cdot P/{(0{.}{622}+0{.}{378}\cdot Q_{{{{sat}}}})}}}
+\end{equation}
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex	(revision 5166)
@@ -0,0 +1,12 @@
+% \documentclass{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+$f_w$ soil relative humidity calculated in hydrolc:hydrolc\_soil
+
+$W_{lim}$ soil water limitation factor
+\begin{equation}
+{W_{{{lim}}}={{MIN}}(2f_{{w}},1)}\nonumber
+\end{equation}
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex	(revision 5166)
@@ -0,0 +1,24 @@
+% \documentclass[onecolumn,a4paper]{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+$T_0$ (tp\_00) = 273.15 0 degree Celsius expressed in degree Kelvin defined in constantes.f90
+
+$k_T$ temperature-dependent pseudo-first-order rate constant of assimilation response to CO2
+
+\begin{equation}
+{k_{{T}}=0{.}7\cdot 0{.}{177}\cdot e^{{0{.}{069}\cdot (T_{{{{air}}}}-T_{{0}})}}\cdot {10}^{6}}\nonumber
+\end{equation}
+
+$R_T$ temperature-dependent non-photosynthetic respiration
+
+\begin{equation}
+{R_{{T}}=0{.}8\cdot {\frac{0{.}{177}\cdot e^{{0{.}{069}\cdot (T_{{{{air}}}}-T_{{0}})}}}{(1+e^{1{.}3(T_{{{{air}}}}-T_{{{max}}})}{)}}}}\nonumber
+\end{equation}
+
+\begin{equation}
+{V_{{c}}=V_{{c{max}}}\cdot 0{.}{39}\frac{0{.}{177}\cdot e^{{0{.}{069}\cdot (T_{{{{air}}}}-T_{{0}})}}}{(1+e^{0{.}3\cdot (T_{{{min}}}-T_{{{{air}}}})}{)(1+e^{0{.}3\cdot (T_{{{{air}}}}-T_{{{{opt}}}})}}{)}}W_{{lim}}}\nonumber
+\end{equation}
+
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex	(revision 5166)
@@ -0,0 +1,26 @@
+Tlim temperature limitation factor
+
+\begin{equation}
+{T_{{{lim}}}=\frac{(T_{{{{air}}}}-T_{{{min}}})\cdot (T_{{{{air}}}}-T_{{{max}}})}{(T_{{{{air}}}}-T_{{{min}}})\cdot (T_{{{{air}}}}-T_{{{max}}})-(T_{{{{air}}}}-T_{{{{opt}}}})^{{2}}}}
+\end{equation}
+Tmin, Tmax and Topt are local variables that are initialized through the assim\_param array.
+
+Kc Michaelis-Menten constant for the rubisco enzyme catalytic activity for CO2 (ppm)
+
+\begin{equation}
+{K_{{c}}={39}{.}{09}\cdot e^{{0{.}{085}\cdot (T_{{{{air}}}}-T_{{0}})}}}
+\end{equation}
+Ko Michaelis-Menten constant for the rubisco enzyme catalytic activity for O2 (ppm)
+
+\begin{equation}
+{K_{{o}}=\frac{2{.}{412}\cdot {210000}\cdot e^{{0{.}{085}\cdot (T_{{{{air}}}}-T_{{{min}}})}}}{(T_{{{air}}}{-T_{{min}}}{)}}}
+\end{equation}
+\begin{equation}
+{\Gamma ^{{?}}={42}\cdot e^{{9{.}{46}\frac{T_{{{{air}}}}-T_{{0}}-{25}}{T_{{{{air}}}}}}}}
+\end{equation}
+\begin{equation}
+{V_{{c}}=V_{{c{max}}}\cdot T_{{{lim}}}\cdot W_{{{lim}}}}
+\end{equation}
+\begin{equation}
+{V_{{j}}=V_{{j{max}}}\cdot T_{{{lim}}}\cdot W_{{{lim}}}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex	(revision 5166)
@@ -0,0 +1,6 @@
+\begin{equation}
+{V_{{c}}(l)=V_{{c}}\cdot (1-0.7\cdot (1-e^{{-k\cdot LAI(l)}}))}
+\end{equation}
+\begin{equation}
+{V_{{j}}(l)=V_{{j}}\cdot (1-0.7\cdot (1-e^{{-k\cdot LAI(l)}}))}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex	(revision 5166)
@@ -0,0 +1,36 @@
+The photosynthesis is defined by a pair of nested quadratic equations:
+
+M flux determined by the Rubisco and light limited capacities
+
+${\Phi}$ fixed equal to 0.83
+
+${\beta}$ fixed equal to 0.93
+
+M smaller root of
+
+\begin{equation}
+{\Phi \cdot M^{{2}}-M\cdot (V_{{c}}(l)+\alpha \cdot Q)+V_{{c}}(l)\cdot \alpha \cdot Q=0}
+\end{equation}
+Ci(l) (leaf\_ci) global variable declared in diffuco module
+
+W smaller root of
+
+\begin{equation}
+{\beta \cdot W^{{2}}-W\cdot (M+k_{{T}}\cdot C_{{i}}(l)\cdot {10}^{{-6}})+M\cdot k_{{T}}\cdot C_{{i}}(l)\cdot {10}^{{-6}}=0}
+\end{equation}
+${\alpha}$ quantum efficiency
+
+\begin{equation}
+{\alpha \cdot Q=0{.}{092}\cdot 2{.}3\cdot {{SWdown}}\cdot k\cdot e^{{-k\cdot {{LAI}}(l)}}}
+\end{equation}
+
+\begin{equation}
+{M=\frac{V_{{c}}(l)+\alpha \cdot Q-\sqrt{(V_{{c}}(l)+\alpha \cdot Q)^{{2}}-4\cdot \Phi \cdot V_{{c}}(l)\cdot \alpha \cdot Q}}{2\cdot \Phi }}
+\end{equation}
+
+\begin{equation}
+{W=\frac{M+k_{{T}}\cdot C_{{i}}(l){.}{10}^{{-6}}-\sqrt{(M+k_{{T}}\cdot C_{{i}}(l){.}{10}^{{-6}})^{{2}}-4\cdot \beta \cdot M\cdot k_{{T}}\cdot C_{{i}}(l){.}{10}^{{-6}}}}{2\cdot \beta }}
+\end{equation}
+\begin{equation}
+{A=W-R_{{T}}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex	(revision 5166)
@@ -0,0 +1,43 @@
+Wc rubisco-limited carboxylation rate
+
+Oi partial pressure of O2 (fixed to 210000 ppm)
+
+\begin{equation}
+{W_{{c}}=\frac{V_{{c}}(l)\cdot C_{{i}}(l)}{C_{{i}}(l)+K_{{c}}\cdot (1+O_{{i}}/{K_{{o}}})}}
+\end{equation}
+Vj potential rate of RuBP regeneration
+
+I incident photon flux
+
+${\alpha}$j quantum yield of RuBP regeneration 
+
+\begin{equation}
+{\alpha_{{j}}\cdot I=0{.}{8855}\cdot {{SW}}_{{{{down}}}}\cdot k\cdot e^{{-k\cdot {{LAI}}(l)}}}
+\end{equation}
+${\Theta}$ curvature of the quantum response (fixed equal to 0.7)
+
+\begin{equation}
+{V_{{j}}=\frac{\alpha_{{j}}\cdot I+V_{{j}}(l)-\sqrt{(\alpha_{{j}}\cdot I+V_{{j}}(l))^{{2}}-4\cdot \Theta \cdot \alpha_{{j}}\cdot I\cdot V_{{j}}(l)}}{2\cdot \Theta }}
+\end{equation}
+Wj RuBP regeneration-limited rate
+
+${\Gamma}$* CO2 compensation point (ppm)
+
+\begin{equation}
+{W_{{j}}=\frac{V_{{j}}\cdot C_{{i}}(l)}{4{.}5\cdot C_{{i}}(l)+{10}{.}5\cdot \Gamma ^{{?}}}}
+\end{equation}
+
+\begin{equation}
+{W={{MIN}}(W_{{c}},W_{{j}})}
+\end{equation}
+
+Rd dark respiration
+
+fdr fraction of dark respiration (fixed equal to 0.011)
+
+\begin{equation}
+{R_{{d}}=f_{{{{dr}}}}\cdot V_{{c}}(l)}
+\end{equation}
+\begin{equation}
+{A=W\cdot \left(1-\frac{\Gamma ^{{?}}}{C_{{i}}(l)}\right)-R_{{d}}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+{g_{{s}}(l)={{mA}}(l)\frac{h_{{r}}}{C_{{a}}}+b}
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex	(revision 5166)
@@ -0,0 +1,7 @@
+\begin{equation}
+{A=A+A(l)\cdot({{LAI}}(l+1)-{{LAI}}(l))}
+\end{equation}
+\begin{equation}
+{g_{{s}}=g_{{s}}+g_{{s}}(l)\cdot({{LAI}}(l+1)-{{LAI}}(l))}
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = U_{wind}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    zscf = \sqrt{(1 + cd |Ri_{z}|)}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+     cd_{tmp}=\frac {cd_{neut}}{1+3 c_b Ri_z zscf}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+     zscf = \frac {1}  {1+ 3 cc * cc * cd_{neut}  *\sqrt{|Ri_z| \frac{ (z_{lev}   +  roughheight) }  {z_0} }}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+     cd_{tmp} = cd_{neut} (1-3 cb* Ri_{z} * zscf)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+      q_{cdrag} = max   \left\{  cd_{tmp}, \frac{1 \times 10^{-4}}{max \left\{ U, (U_{wind})_{min} \right\} }  \right\}    
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Z_g = Z_{lev} g_0
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Z_d^\phi = \left( \frac{Z_g} {C_{p,air}} \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{V, a, surf} = T_a + \frac {Z_d^\phi} {(1 + rv_{tmp2} q_{air})(1+retv q_{air}) }
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{V, surf} = T_g (1 + retv q_{surf})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \left( {\frac{\delta u}{\delta z}} \right) ^2 = max \{ (0.1)^2, U^2  \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Ri_{z} = z_g \frac {T_{V, a, surf}-T_{V, surf}}{\left( {\frac{\delta u}{\delta z}} \right) ^2  * T_{V, a, surf}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Ri_{z} = max \{   min   \{Ri_z, 5    \}, -5  \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    cd_{neut} = \left(  \frac{  \kappa }  {\frac{LOG(zlev + roughheight)}{z_0} }               \right)^2
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    r_{a} = \frac{1}{q_{c,drag}U}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,4} \equiv  \left(  \frac{1}{1+\frac{r_1}{r_a}}  \right) U_{s_1} = \left( \frac{1}{1+ \frac {r_{soil}}{r_a}} \right) VEG
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,4} = evap_{bare, lim}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \sum_1^{nvm} (\beta_{v,2}); \  \sum_1^{nvm} (\beta_{v,3})   
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_v = 1; \ \alpha_v = 1    
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_v = \beta_{v,4} +  \sum_1^{nvm} (\beta_{v,2}) + \sum_1^{nvm} (\beta_{v,3})   
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \sum_1^{nvm} (veget); \  \sum_2^{nvm} (veget)   
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{eqnarray}
+    IF \ (q_{sat} < q_{air}) \ THEN \ (IF \ (T_a > 0) \ THEN \ toveg=TRUE, \ tosnow = FALSE ) \\
+    IF \ (q_{sat} < q_{air}) \ THEN \ (IF \ (T_a < 0) \ THEN \ toveg= FALSE, \ tosnow=TRUE )  
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{eqnarray}
+    IF \ (toveg) \ THEN: \ \beta_{v,1}=0, \ \beta_{v,4} = (veget), \ \beta_v = \beta_{v,4}, \ \alpha_v = 1 \\
+    IF \ (tosnow) \ THEN: \ \beta_{v,1}=1, \ \beta_{v,4} = 0, \ \beta_v =1, \ \alpha_v = 1       
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{eqnarray}
+    \chi^{dew, veg}= \chi^{d,v}_6(LAI)^5 - \chi^{d,v}_5(LAI)^4 + \chi^{d,v}_4(LAI)^3 
+    - \chi^{d,v}_3(LAI)^2 + \chi^{d,v}_2(LAI) + \chi^{d,v}_1
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{eqnarray}
+    \beta_{v,3} = 0; \ RH = 0     
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{eqnarray}
+    \beta_{v,2} = 0       
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    zqs_{veg}^{rap} = max \left\{ 0, \left( \frac {qs_{int}^{veg} } { qs_{int}^{max} } \right) \right\}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,2} = VEG zqs_{veg}^{rap} \left( \frac{1}{1 + U q_{c,drag} r_{sv} }   \right) \equiv VEG zqs_{veg}^{rap} \left( \frac{1}{1 + \frac{r_{sv}}{r_a} }   \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+    ziltest = \Delta t \beta_{v,2} U q_{c,drag} \rho (q_{sat}-q_{air}) \equiv \Delta t \beta_{v,2} E_{pot} 
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    z_{rapp} = \frac{qs_{int}^{veg}}{ziltest}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,23} = max \left\{  \beta_{v,2} - \beta_{v,2}z_{rapp} , 0 \right\}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,2} = \beta_{v,2} z_{rapp}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \delta _c = \rho . max\{ (q_{sat} - q_{a}), 0 \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    zqs_{veg}^{rap} = max \left\{ 0 , \frac{q_{s,int}^{veg}}{q_{s,int}^{max}}  \right\}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    r_{veg} = \left( \frac{1}{LAI} \right) \left( \frac{R_{SW}^{net} + {R}_{0}}{R_{SW}^{net}} \right) \left( \frac{a+ \lambda \delta_c}{k_0} \right) 
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v3} = VEG (1 - zqs^{rap}_{veg} RH) \frac {1} {1 + \frac {r_{veg}^{pft} (r_{veg}^{et} + r_{sv})}{r_a} }
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,3} = \beta_{v,3} + min \left\{ \beta_{v,23}, VEG zqs_{veg}^{rap} RH \frac {1} {1 + \frac{ r_{veg}^{pft} (r_{veg}^{et} + r_{sv}) }{r_a}} \right\}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex	(revision 5166)
@@ -0,0 +1,72 @@
+% 
+% \documentclass[11pt]{amsart}
+% \usepackage{helvet}
+% \usepackage{geometry}    
+% \geometry{a4paper} 
+% \usepackage[parfill]{parskip}  \usepackage{graphicx}
+% \usepackage{amssymb}
+% \usepackage{epstopdf}
+%
+%
+%
+% \begin{document}
+% 
+{\bf Introduction to the coupled energy budget scheme}
+ 
+The coupled energy balance scheme in ORCHIDEE is described most extensively in Dufresne \& Ghattas (2009) with further context in Best et al. (2004). The key principles are summarised here. 
+
+Figure 1 depicts how the surface layer model interacts with the atmospheric model. The model is depicted as running from left to right. The coefficients A, B, C and D are derived for each variable as a means to solve the diffusivity equation for the four state variables of windspeeds 'u' and 'v', temperature and specific humidity (we here concentrate on the latter two variables, denoted together in Figure 1 as 'X'). This diffusivity equation (with a counter-gradient term for the temperature and specific humidity versions) is differenced in such a way that it can be solved implicitly - i.e. the system is solved using information both from the system at the current time and in the next timestep (in an explicit scheme only information from the current time step is used).
+
+\includegraphics[scale=0.5]{iterative_diagram3.png}
+
+{\bf {Figure 1}: Simple schematic of coupling scheme}
+
+The end result is that the diffusivity equation in LMDZ is solved using an 'offset' varient of the Tri-Diagonal Matrix Algorithm. This differencing scheme is as described by Richtmyer et al. (1967). The scheme allows for terms of the equation to be solved in sequence, as depicted, starting from the top of the model. It takes place by deriving coefficients A, B, C, D for each layer in terms of the preceding, higher, layer on a 'downwards' sweep. ORCHIDEE assumes the place of the lower surface layer boundary condition, and provides the state variables for the lowest level of the atmospheric model. On the 'upwards' sweep, the state variables for each layer are calculated in terms of the respective coefficients and of the state variable from the preceding, lower layer.
+
+
+The key information is passed down from the atmospheric model to the surface model are the sensitivity coefficients $A_S, B_S, A_q$ and $B_q$ where, according to the lower boundary conditions of the atmospheric model, where the surface interaction takes place (Best et al., 2004):
+
+\begin{eqnarray}
+  S_1^{new} = A_S(H) + B_S \\
+  q_1^{new} = A_q(\lambda E) + B_q
+\end{eqnarray}
+
+$S^{new}_1$ is the lowest atmospheric model dry static energy and $q^{new}_1$ is the lowest atmospheric model specific humidity, both for the 'new' time step. The A, B, C and D coefficients (which are recalculated for every time step) are a function of the state variables from the old last time step (specific humidity and surface static energy), as well as an intermediate variable (S) that includes the diffusivity coefficient (k), the atmospheric pressure at the height (P) and a 'counter-gradient term' ($\gamma$). The B coefficient is also a function of P, S and g. As part of the differencing scheme, each coefficient A,B,C and D is also a function of the coefficient above, so they are calculated by 'working down' the column, as depicted.
+
+Now, although the coefficients A and B in equations (1) and (2) are known quantities, $S^{new}$, $q^{new}$, H and $\lambda E$ are not.
+
+In order to determine these quantities, we need to make use of a further set of assumptions:
+
+a) We assume that surface fluxes for a given timestep are written as below (shown here for the 'new' timestep):
+\begin{eqnarray}
+   H = k_1^h (S_1^{new}-S_s^{new}) \\
+   \lambda E =\beta k_1^q (q_1^{new} - q_s ^{new}) =\beta k_1^q (q_1^{new} - q_0 ^{new} (T_s^{new}))
+\end{eqnarray}
+
+These equations are implicit because they have been formulated for the 'new' timestep. $q_0^{new}$ is the saturated humidity that corresponds to the surface temperature $T_s^{new}$. We make the saturated humidity assumption: i.e. the air within cavities in the surface vegetation is completely saturated. This means that the vapour pressure of the vegetation may be calculated as the saturated vapour pressure at the vegetation temperature.
+
+b) We assume, by first-order Taylor series expansion, that:
+
+\begin{eqnarray}
+    q_0(T_s^{new}) = q_{sat}(T_s^{old}) + \frac {\delta q_{sat}} {\delta T}|_{T_t} (T^{new}_s - T^{old}_s)
+\end{eqnarray}
+
+c) We assume that the energy budget is obeyed over the timestep $\Delta t$ such that a change in the balance of fluxes for the surface layer corresponds exactly to the change in surface temperature:
+
+\begin{eqnarray}
+   T_s^{new}=T^{old}_s + \frac{\delta t}{C_0} \sum F
+\end{eqnarray}
+
+where:
+
+\begin{eqnarray}
+    \sum F = H + \lambda E + R_{LW} + R_{SW} + F_G
+\end{eqnarray}
+
+Combining this set of equations, as is conducted by Dufresne \& Ghattas (2009) results in the sequence of operations that is carried out in the 'enerbil' module, and is outlined below.
+
+%
+%
+%
+%
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex	(revision 5166)
@@ -0,0 +1,135 @@
+%
+% \documentclass[11pt]{amsart}
+% \usepackage{helvet}
+% \usepackage{geometry}    
+% \geometry{a4paper} 
+% \usepackage[parfill]{parskip}  \usepackage{graphicx}
+% \usepackage{amssymb}
+% \usepackage{epstopdf}
+%
+%
+%
+% \begin{document}
+
+\renewcommand{\arraystretch}{1.5}
+
+\begin{tabular}{|c|l|r|}
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+\hline
+ $ps^{old}$ & psold & surface static energy at old timestep (J/kg) \\
+ $ps^{new}$ & psnew & surface static energy at new timestep (J/kg)\\
+ $q_s$ & qsurf & surface specific humidity (kg/kg) \\
+ $q_{s, sat}$ & qsol\_sat & saturated surface humidity (kg/kg) \\
+ $q_{air}$ & qair & lowest level specific humidity at 'old' timestep (kg/kg) \\
+ $q_{air}^{new}$ & qair\_new & lowest level specific humidity at 'new' timestep (kg/kg) \\
+ $\frac{\delta q_s^{old}}{\delta t}$ & pdqsold & derivative of saturated specific humidity at old temperature (kg/(kg s)) \\ 
+ $p_l$ & pb & lowest level air pressure (Pa) \\
+ \hline
+ $C_p^{air}$ & cp\_air & lowest level atmospheric heat capacity (J/(K kg)) \\   
+ \hline
+ $\chi_{CO_2}^{canopy}$ & ccanopy & $CO_2$ concentration in the canopy (?? ppm)  \\
+ $\bar{Ci}$ & cimean & mean intercellular ci (from STOMATE) $(\mu mole/m^2/s)$\\  
+ \hline
+ $R^{LW}_{\uparrow}$ & lwup & long-wave upwelling radiation $(W/m^2)$ \\  
+ $ R^{LW}_{\downarrow}$ & lwdown & downwelling long-wave radiation flux $(W/m^2)$ \\
+ $R^{LW}_{abs}$ & lwabs  & LW radiation absorbed by the surface $(W/m^2)$ \\ 
+ $R^{SW}_{net}$ & swnet & net shortwave radiation flux $(W/m^2)$ \\
+ $R^{net}_{sns}$ & netrad\_sns & sensitivity of net radiation $(W/m^2)$ \\
+ $R_{net}$ & netrad & net radiation at surface layer $(W/m^2)$ \\
+ \hline
+ $\Delta \theta$ & dtradia & Time step (s) \\
+ $\epsilon$ & emis & emissivity (fraction) \\
+ $\sigma$ & c\_stefan & Stefan-Boltzmann constant $(W / (m^2 K^4))$\\
+ $q_{c}$ & q\_cdrag & surface drag coefficient (m/s) \\
+ $\rho_{air}$ & rau & density of air $(kg/m^3)$ \\
+\hline
+\end{tabular}
+
+
+\begin{tabular}{|c|l|r|}
+
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+
+\hline
+
+ $\lambda E_{evap}^0$ & chalev0 & latent heat of evaporation (J/kg) \\
+ $\lambda E_{sub}^0$ & chalsu0 & latent heat of sublimination (J/kg) \\ 
+ $\lambda E_{fsn}^0$ & chalfu0 & latent heat of fusion (J/kg) \\
+
+ $H^{old}$ & sensfl\_old & sensible heat flux at 'old' timestep $(W/m^2)$ \\ 
+ $H^{sns}$ & sensfl\_sns & sensitivity of sensible heat flux $(W/m^2)$\\
+ $H^{new}$ & fluxsens & sensible heat flux at 'new' timestep $(W/m^2)$\\
+
+ ${\lambda E}_{evap}^{old}$ & lareva\_old  & evaporation latent heat flux at old timestep $(W/m^2)$ \\
+ ${\lambda E}_{evap}^{sns}$ & lareva\_sns  & sensitivity of latent heat flux $(W/m^2)$ \\
+  ${\lambda E}_{evap}^{new}$ & fluxsens  & sensitivity of latent heat flux at 'new' time step $(W/m^2)$ \\
+
+ $\lambda E_{sub}^{old}$ & larsub\_old & sublimation latent heat flux at 'old' time step $(W/m^2)$ \\
+ $\lambda E^{sns}_{sub}$ & larsub\_sns & sensitivity of sublimination latent heat flux $(W/m^2)$ \\
+ $\lambda E_{new}^{sub}$ & fluxsubli & sens. of subn. latent heat flux at 'new' time step $(W/m^2)$ \\
+
+ $\Sigma (\lambda E^{old})$ & sum\_old & total latent heat flux at 'old' time step $(W/m^2)$\\
+
+ $\Sigma (\lambda E^{sns})$ & sum\_sns & total latent heat flux sensitivity at 'old' time step $(W/m^2)$\\
+ $E_{pot}^{air,new}$ & epot\_air & air potential energy (?? J) \\
+
+ $G$ & soilflx & sensible heat flux from soil $(W/m^2)$ \\
+
+ \hline
+
+ $E^{snow}$ & vevapsno & snow evaporation (mm/day)\\  
+ $E^{soil}$ & vevapnu & bare soil evaporation  (mm/day)\\ 
+ 
+  $(melt)_{tot}$ & tot\_melt & total melt \\  
+ $vev_{app}$ & vevapp & total of evaporation (mm/d) \\  
+ 
+
+ 
+\hline
+\end{tabular}
+
+
+
+\begin{tabular}{|c|l|r|}
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+
+ \hline
+
+ $A_q^{orc}$ & peqAcoef & ORCHIDEE humidity coefficient 'A' \\
+ $B_q^{orc}$ & peqBcoef & ORCHIDEE humidity coefficient 'B'\\
+ $A_T^{orc}$  &  petAcoef & ORCHIDEE temperature coefficient 'A' \\
+ $B_T^{orc} $ & petBcoef & ORCHIDEE temperature coefficient 'B' \\    
+ $A_q^{lmdz}$ & ... & LMDZ humidity coefficient 'A' \\  
+ $B_T^{lmdz}$ & ... & LMDZ temperature coefficient 'A' \\  
+ $B_q^{lmdz}$ & ... & LMDZ humidity coefficient 'B' \\  
+ $B_T^{lmdz}$ & ... & LMDZ temperature coefficient 'B' \\  
+ \hline
+ $T_{air}$ & tair & air temperature (K) \\
+ $T_{dgnc}^{2m}$ & t2mdiag & diagnostic temperature at 2m above ground (K) \\  
+ $T_S$ & temp\_sol & surface temperature (K) \\  
+ \hline
+
+ $\alpha_v $ & valpha & total $\alpha$ resistance coefficient (fraction) \\
+ $\beta_v$ & vbeta & total resistance coefficient (fraction) \\
+ $\beta_{v1}$ & vbeta1 & snow resistance (fraction) \\  
+ $\beta_{v2}$ & vbeta2 & interception resistance (fraction)\\  
+ $\beta_{v3}$ & vbeta3 & vegetation resistance (fraction)\\  
+ $\beta_{v4}$ & vbeta4 & bare soil resistance (fraction)\\
+ $\beta_{v,CO_2}$ & vbetaco2 & vegetation resistance to $CO_2$ \\ 
+ \hline
+ $U$ & speed & lowest level wind speed (m/s) \\
+ $u$ & u & lowest level wind velocity,  Eastward component  (m/s) \\
+ $v$ & v & lowest level wind volocity, Northward component  (m/s) \\
+ \hline
+ $z_{ikt}$ & zikt & aerodynamic resistance / density of air (kg s $m^{-4}$) \\
+ $z_{ikq}$ & zikq & aerodynamic resistance / density of air (kg s $m^{-4}$)  \\
+\hline
+\end{tabular}
+
+%
+%
+%
+%\end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    ps^{old} = T_S C_p
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \frac{\delta q_s^{old}}{\delta t} = \delta q_s 
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R^{LW}_{abs} = \epsilon R^{LW}_{\downarrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R_{net} = R^{LW}_{\downarrow} + S^{SW}_{net} - \epsilon \sigma T^4 (1-\epsilon) R^{LW}_{\downarrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   E^{snow} = \beta_{v1} \Delta t \rho U q_c^{drag} (q_{sol,s}^{new}- q_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   E^{soil} = (1-\beta_{v1})\beta_{v4} \Delta t \rho U q_c^{drag} (q_{sol,s}^{new} - q_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   xx = \Delta t (1-\beta_{v1}) (q_{s,sat}^{new} - q_{a}) \rho S q_c^{drag}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Interception) = xx \beta_{v2}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Transpiration) = xx \beta_{v3}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   U = max \{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Assimilation) = \beta_{v,CO_2} \Delta t \rho S q_c^{drag} (\chi_{CO_2}^{canopy} - \bar{Ci})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U=max\{U_{min}, \sqrt{u^2+v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   H=\lambda E_0^{sub}(\rho)q_c(\beta_{v,1})(q_{s,sat}^{new}-q_{air}+\lambda E_0^{evap}(\rho)q_c(1-\beta_{v,1})\beta_v(\alpha_v)q_{s,sat}^{new}-q_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \lambda E^{sub}=\lambda E_0^{sub} (\rho)q_c\beta_{v,1}(q_{s,sat}^{new}-q_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H = \rho q_c (ps^{new}- E^{pot}_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   R^{LW}_{net} = R^{LW}_{\downarrow}-R^{LW}_{\uparrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   E^{pot}_{air} = max \{0, \Delta t \rho q_c (q_{s,sat}^{new} -q_{air}) \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T_{air}= \frac{E^{pot}_{air}}{c_{p, air}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_c=|v|q_{c, drag}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R^{LW}_{\uparrow}=\epsilon \sigma T_{sol}^4+\epsilon 4 \sigma T_{sol}^3(T_{s}^{new}-T_{s})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+    R^{LW}_{\uparrow}=R^{LW}_{\uparrow}+(1-\epsilon)R^{LW}_{\downarrow}
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{rad}=\epsilon \sigma T_{s}^4 + R^{LW}_{\uparrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_{surf}=\beta_{v,1} (q_{s,sat}^{new})+(1-\beta_{v,1})\beta_v\alpha_v(q_{s,sat}^{new})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_s = max \{q_s, q_{air} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R_{net}=R^{LW}_{\downarrow}+R^{SW}_{net}-R^{LW}_{\uparrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    vev_{app} = \Delta t (\rho)q_c \beta_{v,1}(q_{s,sat}^{new}-q_{air})+\Delta t(\rho)q_c(1-\beta_{1,v}\beta_v(\alpha_v)q_{s,sat}^{new}-q_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    (fusion) = (melt)_{tot} \frac {\lambda E_{sub}^0}{\Delta t}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{new} = T_{s}^{new} - \frac {(melt)_{tot} \lambda E_{sub}^0}{(soilcap)}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max \{ U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \Sigma E^{old} = R_{net} + H^{old} + {\lambda E}_{sub}^{old} + {\lambda E}_{evap}^{old} + G
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \Sigma E^{sns} = R^{sns} + H^{sns} + {\lambda E}_{sub}^{sns} + {\lambda E}_{evap}^{sns} + G
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \Delta \theta = \frac {\Delta t (\Sigma E^{old})} {\left( \frac {1}{C_p^{air}} (C_p^{soil} + \Delta T) (\Sigma E^{sns}) \right)}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    ps^{new} = ps^{old} + \Delta \theta
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_{s,sat}^{new} = q_{s,sat} + \left( \left( \frac{1}{C_p^{air}} \right) \left( \frac{\delta q_s^{old}}{\delta t} \right) \delta\theta \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{new} = \frac {ps^{new}}{C_p^{air}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    E_{pot}^{air,new} = z_{ikt} (H^{old} - H^{sns} \Delta \theta) + ps^{new}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+    {\lambda E} ^{evap} = ({\lambda E}_{evap}^{old} - {\lambda E} _{evap} ^{sns} \Delta \theta) + ({\lambda E}_{sub}^{old} - {\lambda E}_{sub}^{sns} \Delta \theta)
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_{air}^{new}(ji) = q_{air}(ji)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   q_{air}^{new} = z_{ikq} \frac {1} {(\lambda E^{evap}_0  (1 - \beta_{v1}) \beta_1 \alpha_v + \lambda E^{sub}_0 \beta_{v1})} {\lambda E} ^{evap} + q_{s,sat}^{new} 
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    z_{ikt}=\frac{1}{\rho_{air} U q_{c}}; \quad z_{ikq}=\frac{1}{\rho_{air} U q_{c}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H^{old} = \frac{B_T^{orc} - ps^{old}}{z_{ikt} - A_T^{orc}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \lambda E _{sub}^{old} = \lambda E_{sub}^0 \frac{B_q^{orc} - q_{s, sat}}{z_{ikq}-A_q^{orc}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \lambda E _{evap}^{old} = \lambda E_{evap}^0  \left( 1-\beta_{v1} \beta_v \left( \frac {  B_q^{orc} - \alpha_v q_{s, sat}  }{  z_{ikq} - A_q^{orc}  }  \right) \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R^{net}_{sns} = \left( \frac{1}{C_p} \right) 4 \epsilon \sigma \left( \left( \frac{1}{C_p} \right) ps_{t} ^3 \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H_{sns} = \frac{1} { \left( \frac{1}{\rho_{air} S q_{c}} - A_T^{orc} \right)}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \lambda E_{sns}^{sub} = \lambda E_{sub}^0 \beta_{v1} \frac{1}{C_p} \left( \frac{ ({\delta q_s^{t}}/{\delta t}) } {z_{ikq} - A_q^{orc} } \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \lambda E_{sns}^{evap} = \lambda E_{evap}^0 (1-\beta_{v1}) \beta_v \alpha_v \frac{1}{C_p} \left( \frac{ ({\delta q_s^{t}}/{\delta t}) } {z_{ikq} - A_q^{orc} } \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilt2mdiag1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilt2mdiag1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilt2mdiag1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{dgnc}^{2m} = T_{air} 
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex	(revision 5166)
@@ -0,0 +1,392 @@
+\documentclass{article}
+\begin{document}
+
+
+{ \bf enerbil.f90 equations }
+
+\vspace {10mm}
+{ \bf enerbil\_begin }
+
+\vspace {10mm}
+enerbilbegin1.tex
+
+\begin{equation}
+    ps^{t} = T_S C_p
+\end{equation}
+
+\vspace {10mm}
+enerbilbegin2.tex
+
+\begin{equation}
+    \frac{\delta q_s^{t}}{\delta t} = \delta q_s \frac{(p_l)^\kappa}{C_p^{air}}
+\end{equation}
+
+\vspace {10mm}
+enerbilbegin3.tex
+
+\begin{equation}
+    R^{LW}_{abs} = \epsilon R^{LW}_{\downarrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilbegin4.tex
+
+\begin{equation}
+    R_{net} = R^{LW}_{\downarrow} + S^{SW}_{net} - \epsilon \sigma T^4 (1-\epsilon) R^{LW}_{\downarrow}
+\end{equation}
+
+\vspace {10mm}
+{ \bf enerbil\_surftemp }
+
+\vspace {10mm}
+enerbilsurftemp1.tex
+
+\begin{equation}
+    U = max \{ U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp2.tex
+
+\begin{equation}
+    z_{ikt}=\frac{1}{\rho_{air} U q_{c}}; \quad z_{ikq}=\frac{1}{\rho_{air} U q_{c}}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp3.tex
+
+\begin{equation}
+    H^{t} = \frac{B_T^{orc} - ps^{t}}{z_{ikt} - A_T^{orc}}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp4.tex
+
+\begin{equation}
+    \lambda E _{sub}^{t} = \lambda E_{sub}^0 \frac{B_q^{orc} - q_{s, sat}}{z_{ikq}-A_q^{orc}}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp5.tex
+
+\begin{equation}
+    \lambda E _{evap}^{t} = \lambda E_{evap}^0  \left( 1-\beta_{v1} \beta_v \left( \frac {  B_q^{orc} - \alpha_v q_{s, sat}  }{  z_{ikq} - A_q^{orc}  }  \right) \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp6.tex
+
+\begin{equation}
+    R^{net}_{sns} = \left( \frac{1}{C_p} \right) 4 \epsilon \sigma \left( \left( \frac{1}{C_p} \right) ps_{t} ^3 \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp7.tex
+
+\begin{equation}
+    H_{sns} = \frac{1} { \left( \frac{1}{\rho_{air} S q_{c}} - A_T^{orc} \right)}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp8.tex
+
+\begin{equation}
+    \lambda E_{sns}^{sub} = \lambda E_{sub}^0 \beta_{v1} \frac{1}{C_p} \left( \frac{ ({\delta q_s^{t}}/{\delta t}) } {z_{ikq} - A_q^{orc} } \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp9.tex
+
+\begin{equation}
+    \lambda E_{sns}^{evap} = \lambda E_{evap}^0 (1-\beta_{v1}) \beta_v \alpha_v \frac{1}{C_p} \left( \frac{ ({\delta q_s^{t}}/{\delta t}) } {z_{ikq} - A_q^{orc} } \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp10.tex
+
+\begin{equation}
+    \Sigma E^{t} = R_{net} + H^{t} + {\lambda E}_{sub}^{t} + {\lambda E}_{evap}^{t} + G
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp11.tex
+
+\begin{equation}
+    \Sigma E^{sns} = R^{sns} + H^{sns} + {\lambda E}_{sub}^{sns} + {\lambda E}_{evap}^{sns} + G
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp12.tex
+
+\begin{equation}
+    \Delta \theta = \frac {\Delta t (\Sigma E^{t})} {\left( \frac {1}{C_p^{air}} (C_p^{soil} + \Delta T) (\Sigma E^{sns}) \right)}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp13.tex
+
+\begin{equation}
+    ps_{t+\Delta t} = ps_{t} + \Delta \theta
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp14.tex
+
+\begin{equation}
+    q_{s,sat}^{t+\Delta t} = q_{s,sat} + \left( \left( \frac{1}{C_p^{air}} \right) \left( \frac{\delta q_s^{t}}{\delta t} \right) \delta\theta \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp15.tex
+
+\begin{equation}
+    T_{s}^{t+\Delta t} = \frac {ps^{t+\Delta t}}{C_p^{air}}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp16.tex
+
+\begin{equation}
+    E_{pot}^{air,t+\Delta t} = z_{ikt} (H^{t} - H^{sns} \Delta \theta) + ps^{t+\Delta t}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp17.tex
+
+\begin{equation}
+    {\lambda E} ^{evap} = ({\lambda E}_{evap}^{t} - {\lambda E} _{evap} ^{sns} \Delta \theta) + ({\lambda E}_{sub}^{t} - {\lambda E}_{sub}^{sns} \Delta \theta)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp18.tex
+
+\begin{equation}
+    q_{air}^{t+\Delta t}(ji) = q_{air}(ji)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp19.tex
+
+\begin{equation}
+   q_{air}^{t+\Delta t} = z_{ikq} \frac {1} {(\lambda E^{evap}_0  (1 - \beta_{v1}) \beta_1 \alpha_v + \lambda E^{sub}_0 \beta_{v1})} {\lambda E} ^{evap} + q_{s,sat}^{t+\Delta t} 
+\end{equation}
+
+\vspace {10mm}
+{ \bf surf\_land\_orchidee (links from LMDZ to ORCHIDEE)} 
+
+\vspace {10mm}
+surflandLMDZ1.tex
+
+\begin{equation}
+    A_T^{orc} = B_T^{lmdz} \Delta t
+\end{equation}
+
+\vspace {10mm}
+surflandLMDZ2.tex
+
+\begin{equation}
+    B_T^{orc} = A_T^{lmdz}
+\end{equation}
+
+\vspace {10mm}
+surflandLMDZ3.tex
+
+\begin{equation}
+    A_q^{orc} = B_q^{lmdz} \Delta t
+\end{equation}
+
+\vspace {10mm}
+surflandLMDZ4.tex
+
+\begin{equation}
+    B_q^{orc} = A_q^{lmdz}
+\end{equation}
+
+\vspace {10mm}
+{ \bf enerbil\_flux} 
+
+\vspace {10mm}
+enerbilflux1.tex
+
+\begin{equation}
+    U=max\{U_{min}, \sqrt{u^2+v^2} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux2.tex
+
+\begin{equation}
+    q_c=|v|q_{c, drag}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux3.tex
+
+\begin{equation}
+    R^{LW}_{\uparrow}=\epsilon \sigma T_{sol}^4+\epsilon 4 \sigma T_{sol}^3(T_{s}^{t+\Delta t}-T_{s})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux4.tex
+
+\begin{equation}
+    R^{LW}_{\uparrow}=R^{LW}_{\uparrow}+(1-\epsilon)R^{LW}_{\downarrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux5.tex
+
+\begin{equation}
+    T_{s}^{rad}=\epsilon \sigma T_{s}^4 + R^{LW}_{\uparrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux6.tex
+
+\begin{equation}
+    q_{surf}=\beta_{v,1} (q_{s,sat}^{t+\Delta t})+(1-\beta_{v,1})\beta_v\alpha_v(q_{s,sat}^{t+\Delta t})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux7.tex
+
+\begin{equation}
+    q_s = max \{q_s, q_{air} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux8.tex
+
+\begin{equation}
+    R_{net}=R^{LW}_{\downarrow}+R^{SW}_{net}-R^{LW}_{\uparrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux9.tex
+
+\begin{equation}
+    vev_{app} = dt(\rho)q_c \beta_{v,1}(q_{s,sat}^{t+\Delta t}-q_{air})+\Delta t(\rho)q_c(1-\beta_{1,v}\beta_v(\alpha_v)q_{s,sat}^{t+\Delta t}-q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux10.tex
+
+\begin{equation}
+   H=\lambda E_0^{sub}(\rho)q_c(\beta_{v,1})(q_{s,sat}^{t+\Delta t}-q_{air}+\lambda E_0^{evap}(\rho)q_c(1-\beta_{v,1})\beta_v(\alpha_v)q_{s,sat}^{t+\Delta t}-q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux11.tex
+
+\begin{equation}
+   \lambda E^{sub}=\lambda E_0^{sub} (\rho)q_c\beta_{v,1}(q_{s,sat}^{t+\Delta t}-q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux12.tex
+
+\begin{equation}
+    H = \rho q_c (ps^{t+\Delta t}- E^{pot}_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux13.tex
+
+\begin{equation}
+   R^{LW}_{net} = R^{LW}_{\downarrow}-R^{LW}_{\uparrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux14.tex
+
+\begin{equation}
+   E^{pot}_{air} = max \{0, \Delta t \rho q_c (q_{s,sat}^{t+\Delta t} -q_{air}) \}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux15.tex
+
+\begin{equation}
+   T_{air}= \frac{E^{pot}_{air}}{c_{p, air}}
+\end{equation}
+
+
+
+
+
+
+
+
+
+{\bf enerbil\_evapveg.f90}
+
+\vspace {10mm}
+enerbilevapveg1.tex
+
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg2.tex
+
+\begin{equation}
+   E^{snow} = \beta_{v1} \Delta t \rho U q_c^{drag} (q_{sol,s}^{t+\Delta t}- q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg3.tex
+
+\begin{equation}
+   E^{soil} = (1-\beta_{v1})\beta_{v4} \Delta t \rho U q_c^{drag} (q_{sol,s}^{t+\Delta t} - q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg4.tex
+
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg5.tex
+
+\begin{equation}
+   xx = \Delta t (1-\beta_{v1}) (q_{s,sat}^{t+\Delta t} - q_{a}) \rho S q_c^{drag}
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg6.tex
+
+\begin{equation}
+   (Interception) = xx \beta_{v2}
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg7.tex
+
+\begin{equation}
+   (Transpiration) = xx \beta_{v3}
+\end{equation}
+
+
+\vspace {10mm}
+enerbilevapveg8.tex
+
+\begin{equation}
+   U = max \{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
+
+
+\vspace {10mm}
+enerbilevapveg9.tex
+
+\begin{equation}
+   (Assimilation) = \beta_{v,CO_2} \Delta t \rho S q_c^{drag} (\chi_{CO_2}^{canopy} - \bar{Ci})
+\end{equation}
+
+
+
+
+
+\end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+    A_T^{orc} = B_T^{lmdz} \Delta t
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    B_T^{orc} = A_T^{lmdz}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    A_q^{orc} = B_q^{lmdz} \Delta t
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    B_q^{orc} = A_q^{lmdz}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}\label{eq:bdiff}
+W_{b_j} = \frac{\sum_j a_j W_{b_j}}{\sum_j a_j}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{eqnarray}\label(eq:drs}
+R_s & = & 0.05 R \\
+D & = & 0.95 R
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex	(revision 5166)
@@ -0,0 +1,10 @@
+It is slower when the top soil moisture $W_t$ is low, and accelerates above a threshold moisture $W_t^\mathrm{lim}$: 
+\begin{equation}\label{eq:dr1}
+D_t = D_t^\mathrm{min}\frac{W_t}{W_t^\mathrm{max}}, \,\, \mathrm{if} \,\, W_t < W_t^\mathrm{lim},
+\end{equation}
+\begin{equation}\label{eq:dr2}
+D_t = D_t^\mathrm{min}\frac{W_t}{W_t^\mathrm{max}} + (D_t^\mathrm{max} - D_t^\mathrm{min})\left(
+\frac{W_t \,-\, W_t^\mathrm{lim}}{W_t^\mathrm{max}\, - \,W_t^\mathrm{lim}} \right)^{\alpha_t},
+\,\, \mathrm{if}\,\,W_i \geq W_i^{lim}
+\end{equation}
+where $D_t^\mathrm{min}$, $D_t^\mathrm{max}$, and $\alpha_t$ are specific parameters.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex	(revision 5166)
@@ -0,0 +1,4 @@
+For three variables (top and bottom soil moisture, $W_t$ and $W_b$; dry soil height at the top, $h_t^d$), we describe a linear relaxation of the values $X_j$ within each soil column towards their grid-cell average $X_j$, with a timescale $\tau_h$ of one day:
+\begin{equation}\label{eq:hdiff}
+\Delta X_j = - \frac{\Delta t}{\tau_h}(X_j-\overline{X}).
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel.tex	(revision 5166)
@@ -0,0 +1,15 @@
+If only one soil layer is present, then  $h_t^d = h_b^d$, and we define: 
+\begin{equation}\label{eq:us1}
+U_s=  \exp (-c_j \, h_t^d )
+\end{equation}
+If there are two soil layers, we compute $U_s$ as the average of the values defined by the two dry soil depths $h_t^d$ and  $h_b^d$. The weights depend on $a_j^\mathrm{sat}$, which defines the "transpiring" fraction of the top soil layer:
+\begin{equation}\label{eq:us2}
+U_s= a_j^\mathrm{sat} \exp (-c_j \, h_t^d ) + (\mathrm{1}-a_j^\mathrm{sat})  \exp (-c_j \, h_b^d )
+\end{equation}
+
+The "transpiring" fraction is defined by redistributing the top layer's moisture $W_t$ in a virtual layer of depth $h_t^\mathrm{sub}$ (set to 1 mm in hydrolc), what defines a totally dry and a totally saturated fraction ($a_j^\mathrm{sat}$):
+\begin{itemize}
+\item if  $W_t > h_t^\mathrm{sub} \, \theta^\mathrm{max}$, then $a_j^\mathrm{sat}$=1, and $U_s$ depends on $h_t^d$ only (Eq. \ref{eq:us1}), % $U_s=\exp (-c_j \, h_t^d )$,
+\item if $W_t$ is very small, $a_j^\mathrm{sat}$ decreases from 1 to 0 as the top layer's moisture vanishes, and it serves to describe a smooth transition to the case where the top soil layer has vanished and $U_s$ depends on  $h_t^d = h_b^d$.
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}\label{eq:us1}
+U_s=  \exp (-c_j \, h_t^d )
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}\label{eq:us2}
+U_s= a_j^\mathrm{sat} \exp (-c_j \, h_t^d ) + (\mathrm{1}-a_j^\mathrm{sat})  \exp (-c_j \, h_b^d )
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+snowmelt=\frac{(temp\_sol\_new - tp\_00)*soilcap}{chalfu0}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+d\_age=(age-(1- \frac{age}{max\_snow\_age})*\frac{dt\_radia}{one\_day})*\exp(-\frac{precip\_snow}{snow\_trans}))-age
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+d\_age\_nobio=\frac{d\_age}{1+(\frac{tp\_00-T}{7.})^4}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex	(revision 5166)
@@ -0,0 +1,14 @@
+These calculations are only performed in the non bare soil PFTs ($j>1$), over the vegetated fraction $a_j$. 
+The maximum amount of water that can be added to the interception reservoir is:
+\begin{equation}\label{eq:interc1}
+I^\mathrm{add} = I^\mathrm{max} - [I]_\mathrm{old} - E_i \Delta t.
+\end{equation}
+The intercepted water amount $I$ is therefore updated with:
+\begin{equation}\label{eq:interc2}
+[I]_\mathrm{new} = [I]_\mathrm{old} - E_i \Delta t + \min (a_j P_L (1-f_j) \Delta t, I^\mathrm{add}),
+\end{equation}
+where $f_j$ is the fraction of rainfall that cannot be intercepted and necessarily falls to the ground.
+The throughfall $P_T$ is then calculated with:
+\begin{equation}\label{eq:interc3}
+P_T \Delta t = P_L (1-f_j) \Delta t - ([I]_\mathrm{new} - [I]_\mathrm{old}).
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex	(revision 5166)
@@ -0,0 +1,10 @@
+It non linearly increases with the height of top dry soil $h_\mathrm{dry}$, and becomes very large when $h_\mathrm{dry}$ gets close to the total soil depth, $h_\mathrm{tot}$:
+\begin{equation}\label{eq:rsol}
+r_\mathrm{soil} = r_\mathrm{soil}^\mathrm{m} \left( h_\mathrm{dry} + \frac{\mathrm{1}}{\mathrm{100}(h_\mathrm{tot}-h_\mathrm{dry})^2}  \right).
+%r_\mathrm{soil} = r_\mathrm{soil}^r_\mathrm{m}  
+\end{equation}
+The top dry soil height  $h_\mathrm{dry}$ depends on both $h_t^d$ and $h_t^d$ in the bare soil fraction. As for the soil moisture stress factor on transpiration and bare soil evaporation ($U_s$), we use $a_j^\mathrm{sat}$ to describe a smooth transition between cases when the top layer's moisture  $W_t > h_t^\mathrm{sub} \theta^\mathrm{max}$ (then $h_\mathrm{dry}=h_t^d$),  and cases when the top layer's has vanished (then  $h_\mathrm{dry}=h_t^d=h_b^d$):
+\begin{equation}\label{eq:hdry}
+h_\mathrm{dry} = a_1^\mathrm{sat} h_{t_1}^d + (\mathrm{1} - a_1^\mathrm{sat})  h_{b_1}^d.
+\end{equation}
+% hdry(:) = a_subgrd(:,1)*dss(:,1) + (un-a_subgrd(:,1))*dsp(:,1) 
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsat.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsat.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsat.tex	(revision 5166)
@@ -0,0 +1,12 @@
+We calculate the deviation of the saturated humidity with the temperature and the pressure.
+\begin{equation}
+\delta q_{sat}(T) = \frac{(q_s(\lfloor T+\frac{1}{2}\rfloor + 1) - 2.q_s(\lfloor T +\frac{1}{2} \rfloor) + q_s(\lfloor T+\frac{1}{2} \rfloor -1))(\lbrace T + \frac{1}{2}\rbrace -1 ) + q_s(\lfloor T+\frac{1}{2} \rfloor +1) - q_s(\lfloor T+\frac{1}{2} \rfloor)}{P}
+\end{equation}
+
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T + \frac{1}{2} \rfloor $ represents the largest integer not greater than $T + \frac{1}{2} $. 
+ \item  $ \lbrace T + \frac{1}{2} \rbrace = T + \frac{1}{2} -\lfloor T + \frac{1}{2} \rfloor $ is the fractional part of $T + \frac{1}{2} $.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsatcalc.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsatcalc.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsatcalc.tex	(revision 5166)
@@ -0,0 +1,14 @@
+We calculate the deviation of the saturated humidity with the temperature and the pressure for a given pixel $x$.
+\begin{multline}
+\delta q_{sat}(x,T) = \\
+\frac{(q_s(x,\lfloor T+\frac{1}{2}\rfloor + 1) - 2.q_s(x,\lfloor T +\frac{1}{2} \rfloor) + q_s(x,\lfloor T+\frac{1}{2} \rfloor -1))(\lbrace T + \frac{1}{2}\rbrace -1 )} {P}+ 
+\\ \frac{q_s(x,\lfloor T+\frac{1}{2} \rfloor +1) - q_s(x, \lfloor T+\frac{1}{2} \rfloor)}{P}
+\end{multline}
+
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T + \frac{1}{2} \rfloor $ represents the largest integer not greater than $T + \frac{1}{2} $. 
+ \item  $ \lbrace T + \frac{1}{2} \rbrace = T + \frac{1}{2} -\lfloor T + \frac{1}{2} \rfloor $ is the fractional part of $T + \frac{1}{2} $.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/goff_gratch.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/goff_gratch.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/goff_gratch.tex	(revision 5166)
@@ -0,0 +1,30 @@
+The subroutine qsfrict\_init uses modified Goff-Gratch equations (1946). The original formulations are : \\
+\begin{multline}
+\log e_w = \\ -7.90298 \left( \frac{T_s}{T} - 1 \right) + 5.02808 \log \left( \frac{T_s}{T} \right) 
+- 1.3816 \times 10^{-7}(10^{11.344 \left( 1-\frac{T_s}{T} \right)}-1) 
++ 8.1328 \times 10^{-3}(10^{-3.49149 \left( \frac{T_s}{T}-1 \right)}
+-1) \\ + \log e_{ws}
+\end{multline}
+where : \\
+\begin{itemize}
+ \item  $ \log(x) = \frac{\ln x}{\ln 10} $. 
+ \item  $e_w$ is the saturation water vapor pressure over a plane surface of pure ordinary liquid water (hPa).
+ \item  $T$ is the absolute air temperature in Kelvin.
+ \item  $T_s$ is the steam point temperature (373.16 K).
+ \item  $e_{ws}$ is the saturation pressure of pure ordinary liquid water at steam-point temperature (at 1 atm = 1013.25 hPa).
+\end{itemize}
+
+\begin{multline}
+\log e_i = \\ -9.09718 \times \left( \frac{T_0}{T} - 1 \right) - 3.56654 \times \log \left( \frac{T_0}{T} \right) 
++ 0.876793 \times \left( 1-\frac{T_0}{T} \right) 
++ \log e_{i0}
+\end{multline}
+where : \\
+\begin{itemize}
+ \item  $ \log(x) = \frac{\ln x}{\ln 10} $. 
+ \item  $e_i$ is the saturation water vapor pressure over a plane surface of pure ordinary water ice (hPa).
+ \item  $T$ is the absolute air temperature in Kelvin (K).
+ \item  $T_0$ is the boiling point at 1 atmosphere temperature (273.16 K).
+ \item  $e^{*}_{i0}$  is the saturation pressure of pure ordinary water ice at ice-point temperature (6.1173 hPa).
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsat.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsat.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsat.tex	(revision 5166)
@@ -0,0 +1,12 @@
+The interpolation the saturated humidity depends on the temperature $T$ (in Kelvin). 
+It is set by the following equation :
+\begin{equation}
+q_{sat}(T)= \dfrac{q_s(\lfloor T \rfloor +1) - q_s(\lfloor T \rfloor).\lbrace T \rbrace + q_s(\lfloor T \rfloor)}{P}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T \rfloor $ represents the largest integer not greater than $T$. 
+ \item  $ \lbrace T \rbrace = T -\lfloor T \rfloor $ is the fractional part of $T$.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsatcalc.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsatcalc.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsatcalc.tex	(revision 5166)
@@ -0,0 +1,12 @@
+The interpolation the saturated humidity on one pixel $x$  depends on the temperature $T$ (in Kelvin). 
+It is set by the following equation :
+\begin{equation}
+q_{sat}(x,T)= \dfrac{q_s(x,\lfloor T \rfloor +1) - q_s(x,\lfloor T \rfloor).\lbrace T \rbrace + q_s(x,\lfloor T \rfloor)}{P}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T \rfloor $ represents the largest integer not greater than $T$. 
+ \item  $ \lbrace T \rbrace = T -\lfloor T \rfloor $ is the fractional part of $T$.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsfrict_init.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsfrict_init.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsfrict_init.tex	(revision 5166)
@@ -0,0 +1,17 @@
+The specific humidity  $q_s$ is a function of temperature $T$. Its values are : 
+\begin{equation}
+q_s(T) = 
+\begin{cases}
+0 & \text{if} \quad T < 100K \\
+\dfrac{M_{air}}{M_{vapor}} \cdot 10^{2.07203 - 0.0032099T - \frac{2484.896}{T} + 3.56654\log{T}} & \text{if} \quad 100K \leq T < 273K \\
+\dfrac{M_{air}}{M_{vapor}} \cdot 10^{23.819 - \frac{2948.964}{T} -
+  5.028\log{T} - 29910.16\exp(-0.0699832\times T) + 25.21935\exp(-\frac{2999.924}{T}) } & \text{if} \quad 273K \leq T \leq 370K \\
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $\dfrac{M_{air}}{M_{vapor}} = \dfrac{18.02 \times 10^{-3}}{28.964 \times 10^{-3}} \simeq 0.622 $ is the ratio between the molecular weight of dry air and \\ 
+the molecular weight of water vapor.
+ \item  $\log(T) = \dfrac{\ln T}{\ln 10}$
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/tempfunc.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/tempfunc.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/tempfunc.tex	(revision 5166)
@@ -0,0 +1,18 @@
+%\documentclass{article}
+%\usepackage[english]{babel}
+%\usepackage{amsmath}
+%\begin{document}
+\begin{equation}
+f(T) = 
+\begin{cases}
+0 & \text{if} \quad T < 273K \\
+1 - \dfrac{(T_{max} - T)^2}{(T_{max} - T_{min})^2} & \text{if} \quad 273K \leq T \leq 293K \\
+1 & \text{if} \quad T > 293K
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ T_{min} = 273K$ 
+ \item  $ T_{max} = 293K$
+\end{itemize}
+%\end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\frac{\partial T}{\partial t}=\frac{\partial ^2 T}{\partial z^2}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+C_p\frac{\partial T}{\partial t}=K\frac{\partial ^2 T}{\partial z^2}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+D = \Bigl[\frac{4 \times (C_{sapwood} + C_{heartwood})}{WD.\pi.k_{allom2}}\Bigr]^{\frac{1}{(2+k_{allom3})}} 
+H = k_{allom2} \times D^{k_{allom3}} 
+CA =\min(k_{allom1} \times D^{k_{rp}},CA_{max})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    D = \Bigl[\frac{4 \times (C_{sapwood} + C_{heartwood})}{WD.\pi.k_{allom2}}\Bigr]^{\frac{1}{(2+k_{allom3})}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H = k_{allom2} \times D^{k_{allom3}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    CA =\min(k_{allom1} \times D^{k_{rp}},CA_{max})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex	(revision 5166)
@@ -0,0 +1,37 @@
+\begin{equation}
+FPC = \frac{CN \cdot IND}{FRAC} \cdot \left[ 1 - \exp \left( -1 \cdot 
+    LM_{\rm max} \cdot SLA \cdot coff \right) \right]
+\end{equation}
+where $FPC$ is foliage projective cover (``fpc\_nat'' in source code),
+$CN$ crown area (cn\_ind; m$^{2}$), $IND$ number of individuals (ind;
+m$^{-2}$), $FRAC$ total fraction occupied by natual vegetation
+(fracnat), $LM_{\rm max}$ maximum leaf mass in last year
+(lm\_lastyearmax; g C m$^{-2}$), $SLA$ specific leaf area (sla;
+m$^{2}$ (g C)$^{-1}$), and $coff$ coefficient (ext\_coeff).
+
+\begin{equation}
+  EST_{\rm tree} = EST_{clm} \left[1 - \exp \left( -5 \cdot (1 - FPC_{\rm woody}) 
+    \right) \right] \cdot (1 - FPC_{\rm woody})
+\end{equation}
+where $EST_{\rm tree}$ is maximum tree establishment rate
+(estab\_rate\_max\_tree), $EST_{clm}$ maximum tree establishment rate
+controled by climate (estab\_rate\_\\max\_climate\_tree), $FPC_{\rm
+  woody}$ total woody FPC (sumfpc\_wood).
+
+\begin{equation}
+  EST_{\rm grass} = \max \left[  \min \left[ EST_{clm}, 0.98 - FPC_{\rm sum} \right], 
+    0 \right]
+\end{equation}
+where $EST_{\rm grass}$ is maximum grass establishment rate
+(estab\_rate\_max\_grass) and $FPC_{\rm sum}$ total natural fpc
+(sumfpc).
+
+\begin{equation}
+FPC = \min \left[ 1, CN \right] \cdot IND \cdot \max \left[ 1 - \exp 
+  \left( -coff \cdot LAI \right), MIN_{\rm cover} \right]
+\end{equation}
+where $MIN_{\rm cover}$ is fraction of crown area invaded by other
+trees (min\_cover = 0.05)
+
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex	(revision 5166)
@@ -0,0 +1,6 @@
+\begin{equation}
+p(m)=e^{-\pi*\left(\frac{m}{m_e}\right)^{2}}
+\end{equation}
+
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex	(revision 5166)
@@ -0,0 +1,6 @@
+\begin{equation}
+A(s)=s*e^{(\frac{s-1}{0.45*(s-1)^{3}+2.83*(s-1)^{2}+2.96*(s-1)+1.04})}
+\end{equation}
+
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+greff=\frac{\Delta}{C_{leaf}*SLA}
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+mort_{greff}=\frac{k_{mort1}}{1+k_{mort2}*greff}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+FPC = \frac{CN \cdot IND}{FRAC} \cdot \left[ 1 - \exp \left( -1 \cdot 
+    LM_{\rm max} \cdot SLA \cdot coff \right) \right]
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+A\propto \frac{\sum X_{i}}{\sum X_{i}+\sum Y_{j}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{rpc}=\frac{1}{1-e^{-{\frac{\mathit{z_soil}\left(nbdl\right)}{\mathit{z_nitrogen}}}}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+\mathit{t_{nitrogen}}=\sum_{l=1}^\mathit{nbdl} \mathit{tsoil_{month}} \cdot \mathit{rpc} \cdot \left( e^{  -\frac{\mathit{z_{soil}(l-1)}}{\mathit{z_{nitrogen}}}  } 
+- e^{  -\frac{\mathit{z_{soil}(l)}}{\mathit{z_{nitrogen}}}  } \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{h_{nitrogen}}=\sum_{l=1}^\mathit{nbdl} \left(\mathit{soil\_hum\_month} \cdot \mathit{rpc} \cdot \left(e^{-{\frac{\mathit{z_{soil}}\left(l-1\right)}{\mathit{z_{nitrogen}}}}}-e^{-{\frac{\mathit{z_{soil}}(l)}{\mathit{z_{nitrogen}}}}}\right)\right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+\mathit{use\_reserve}=\mathit{min}\left(\mathit{biomass}\left(\mathit{carbres}\right),2 \cdot \frac{\mathit{dt}}{\mathit{tau_{leafinit}}}\cdot\frac{\mathit{lai_{happy}}}{\mathit{sla}}\right)
+
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex	(revision 5166)
@@ -0,0 +1,6 @@
+\begin{equation}
+
+
+\mathit{transloc\_leaf}=\frac{\mathit{L0}}{\mathit{L0}+\mathit{R0}}\cdot \mathit{use\_reserve}
+
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{alloc\_sap_{above}}=\mathit(alloc\_min)+\left(\mathit{alloc\_max}-{\mathit{alloc\_min}}\right)\left(1-e^{-{\frac{\mathit{age}}{\mathit{demi\_alloc}}}}  \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex	(revision 5166)
@@ -0,0 +1,8 @@
+\begin{equation}
+\mathit{falloc_{leaf}}=\mathit{LtoLSR} \cdot \left( 1-\mathit{falloc_{fruit}} \right) \cdot \mathit{carb\_rescale}
+\mathit{falloc_{sapabove}}=\mathit{StoLSR}\cdot \mathit{alloc\_sap_{above}} \cdot \left( 1-\mathit{falloc_{fruit}} \right)\cdot \mathit{carb\_rescale}
+\mathit{falloc_{sapbelow}}=\mathit{StoLSR}\cdot \left( 1- \mathit{alloc\_sap_{above}} \right) \cdot \left( 1-\mathit{falloc_{fruit}} \right)\cdot \mathit{carb\_rescale}
+\mathit{falloc_{root}}=\mathit{RtoLSR}\cdot\left( 1-\mathit{falloc_{fruit}} \right)\cdot \mathit{carb\_rescale}
+\mathit{falloc_{carbres}}=\left( 1-\mathit{carb\_rescale}\right)\left( 1-\mathit{falloc_{fruit}} \right)
+
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex	(revision 5166)
@@ -0,0 +1,13 @@
+The SLA is calculated for each different PFT by the following equation :
+\begin{equation}
+SLA =
+\begin{cases}
+ 2.10^{-4}\times 10^{2.29 - 0.4\log(\frac{12}{a_{leaf}})} & \text{if PFT needle-leaf} \\
+ 2.10^{-4}\times 10^{2.41 - 0.38\log(\frac{12}{a_{leaf}})}
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $a_{leaf}$ is a PFT-specific value for leaf longevity in days.
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex	(revision 5166)
@@ -0,0 +1,9 @@
+The SLA is calculated in Reich et al. 97 by :
+\begin{equation} 
+SLA = \exp (5.615 - 0.46 \cdot \ln (a_{leaf}))
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $a_{leaf}$ is a PFT-specific value for leaf longevity in months.
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex	(revision 5166)
@@ -0,0 +1,43 @@
+Sapling biomass for grasses : \\
+
+\begin{equation}
+\alpha_{grass} = 0.5
+\end{equation}
+
+\begin{equation}
+SAPL_{leaf}
+\begin{cases}
+\dfrac{0.1}{SLA} & \\
+\dfrac{1}{SLA} & \text{if PFT crop}
+\end{cases} %\]
+\end{equation}
+
+\begin{equation}
+SAPL_{sapabove} = 0
+\end{equation}
+
+\begin{equation}
+SAPL_{sapbelow} = 0
+\end{equation}
+
+
+\begin{equation}
+SAPL_{heartabove} = 0
+\end{equation}
+
+\begin{equation}
+SAPL_{heartbelow} = 0
+\end{equation}
+
+\begin{equation}
+SAPL_{root} = 0.1 \cdot \frac{1}{\alpha_{grass}} \cdot SAPL_{leaf} 
+\end{equation}
+
+\begin{equation}
+SAPL_{fruit} = 0.3 \cdot SAPL_{leaf} 
+\end{equation}
+
+\begin{equation}
+SAPL_{reserve} = 5 \cdot SAPL_{leaf}  
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex	(revision 5166)
@@ -0,0 +1,55 @@
+Sapling biomass for trees : \\
+
+\begin{equation}
+\alpha_{tree} = 1
+\end{equation}
+
+\begin{equation}
+SAPL_{leaf} =  \left( \frac {4 \cdot k_{allom1} \cdot \left( \dfrac{4 \cdot r_{hs:s} \cdot SLA }{\pi .k_{la:sa}}\right)^{0.8} }{SLA} \right)^5
+\end{equation}
+
+\begin{equation}
+SAPL_{sapabove} = 0.5 \cdot P \cdot \frac{SAPL_{leaf}}{\left( \dfrac
+  {k_{la:sa}}{SLA} \right) } \cdot k_{allom2} \cdot \left(
+  \sqrt{4.\frac{r_{hs:s}}{\pi} \frac{SAPL_{leaf}}{ \left( \dfrac {k_{la:sa}}{SLA} \right) }} \right) ^{k_{allom3}} 
+\end{equation}
+
+\begin{equation}
+SAPL_{sapbelow} = SAPL_{sapabove}
+\end{equation}
+
+
+\begin{equation}
+SAPL_{heartabove} = 2.SAPL_{sapabove}
+\end{equation}
+
+\begin{equation}
+SAPL_{heartbelow} = 2.SAPL_{sapbelow}
+\end{equation}
+
+\begin{equation}
+SAPL_{root} = 0.1 \cdot \frac{1}{\alpha_{tree}} \cdot SAPL_{leaf} 
+\end{equation}
+
+\begin{equation}
+SAPL_{fruit} = 0.3 \cdot SAPL_{leaf} 
+\end{equation}
+
+\begin{equation}
+SAPL_{reserve} = 
+\begin{cases}
+5 \cdot SAPL_{leaf} & \text{if PFT not evergreen} \\
+0 & \text{if PFT evergreen}
+\end{cases} %\]
+\end{equation}
+
+where : \\
+\begin{itemize}
+ \item  $k_{allom1}= 100$; \quad $ k_{allom2} = 40$; \quad  $k_{allom3}= 0.5$.
+ \item  $r_{hs:s}$ is the ratio between the sum of the mass of sapwood and heartwood over sapwood.
+ \item  $k_{la:sa} = 8000 $
+ \item  $P = 200000$ is the pipe density. 
+\end{itemize}
+
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex	(revision 5166)
@@ -0,0 +1,10 @@
+Critical stem diameter for trees : beyond this diameter, the crown area no longer increases.
+\begin{equation}
+D_{max} = 0.01 .\left( \frac{k_{allom4}}{\dfrac{k_{allom2}.k_{allom3}}{100^{k_{allom3}}}} \right)^{\dfrac{1}{k_{allom3} - 1}}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $D_{max}$ is the maximum stem diameter.
+ \item  $ k_{allom2} = 40$; \quad  $k_{allom3}= 0.5$; \quad  $k_{allom4}= 0.3$
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   M=MAX(0.25,MIN(1,M)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=e^{0.69*(\frac{temp-303}{10})}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=MIN(1,T)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=MIN(1,T)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   DLC=1-e^{(-0.5*LAI)}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   M=-1.1*soilmoisture^2+2.4*soilmoisture-0.29
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   F=0.85-0.018*L*CN
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   k=\frac{1}{litter tau}*T*M
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dDL}{dt}=DL*(1-k)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dInput}{dt}=f*C*(1-L)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dLAI}{dt}=DL*sla*vegetmax
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+gdd_{crit}(i) =  GDD_{crit1,j} + GDD_{crit2,j} \times T_{l} + GDD_{crit3,j} \times T_{l}^{2}
+\end{equation}
+where GDD$_{crit1,2,3}$ are the PFT-dependent threshold parameters defined by the ::$pheno_crit$\%$gdd$, and $T_{l}$ is the long-term
+reference temperature (::$tlong_ref$ - calculated in ::$stomate_constants$) in degrees C. i and j are the grid cell and PFT respectively.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex	(revision 5166)
@@ -0,0 +1,7 @@
+\begin{equation}
+LM_{min}(i) = \frac{LAI_{init,min}(j)}{SLA(j)} 
+\end{equation}
+where $LM_{min}$ is the minimum leaf biomass, $LAI_{init\_min}$ is the minimum initial LAI, which is
+PFT-dependent and specified by the parameter ::pheno_crit\%lai\_initmin, which is defined in 
+::stomate\_constants. SLA, the specific leaf area, is also PFT-dependent and defined in
+::stomate\_constants. i and j are the grid cell number and PFT respectively.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+avail_{crit}(i) = min_{moi,ly}(i,j) + hum_{frac}(j) * ( max_{moi,ly}(i,j) - min_{moi,ly}(i,j))
+\end{equation}
+where $min_{moi,ly}$ and $max_{moi,ly}$ are last year's minimum and maximum moisture availability, and $hum_{frac}$ is the 
+parameter ::$pheno_crit\%hum\_frac$.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+A_{moi} = max(\, 0.1, \frac{\sum_{i=1}^{n} H_{i}e^{-z_{i}/\zeta}\Delta_{i}}{ \sum_{i=1}^{n} e^{-z_{i}/\zeta}\Delta_{i}} \,)
+\end{equation}
+where $A_{moi}$ is the plant available moisture, $H_{i}$ is the soil humidity (relative soil moisture) of the $i$-th layer, $z_{i}$ is the depth of the layer, and $\Delta$ is its thickness. $\zeta$ is the root density profile, which is 1.5m for trees and 0.3m for grasses (Krinner et al., 2005).
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+gdd_{min} = \frac{603}{\exp(0.0091*NCD(i,j))} - 64. 
+\end{equation}
+where i and j are the grid cell and PFT, respectively. 
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex	(revision 5166)
@@ -0,0 +1,5 @@
+The equation to calculate tree crown area from its diameter:
+\begin{equation}
+CA=k_{allom1}*Diameter^{k_{rp}}
+\end{equation}
+Where $CA$ is tree crown area, $Diameter$ is tree diameter, $k_{allom1}$ and $k_{rp}$ are parameters.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex	(revision 5166)
@@ -0,0 +1,5 @@
+The equation to calculate tree height from its diameter:
+\begin{equation}
+Height=k_{allom2}*Diameter^{k_{allom3}}
+\end{equation}
+Where $Height$ is tree height, $Diameter$ is tree diameter, $k_{allom2}$ and $k_{allom3}$ are parameters.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{rpc}=\frac{1}{1-e^{-{\frac{\mathit{z\_soil}\left(nbdl\right)}{\mathit{rprof}}}}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{t\_root}=\sum_{l=1}^\mathit{nbdl} (\mathit{stempdiag} \cdot \mathit{rpc} \cdot \left(e^{-{\frac{\mathit{z\_soil}\left(l-1\right)}{\mathit{rprof}}}}-e^{-{\frac{\mathit{z\_soil}(l)}{\mathit{rprof}}}}\right))
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{slope}=\mathit{maint\_resp\_slope1}+\mathit{maint\_resp\_slope2}\cdot \mathit{tl}+\mathit{maint\_resp\_slope3}\cdot \mathit{tl}\cdot \mathit{tl}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{coeff\_maint}=\mathit{coeff\_maint\_zero}\cdot \left(\frac{\mathit{dt}}{\mathit{one\_day}}\right)\cdot \left(1+\mathit{slope}\cdot \mathit{t\_maint\_radia}\right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{resp\_maint\_leaf}=\mathit{coeff\_maint(leaf)}\cdot \mathit{leaf\_biomass}\cdot\frac{ (0.3\cdot \mathit{LAI}+1.4\cdot (1.0-e^{-0.5\cdot \mathit{LAI}}))}{\mathit{LAI}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex	(revision 5166)
@@ -0,0 +1,6 @@
+\begin{equation}
+consumption = hvc1 \times NPPleaf_{long}^{hvc2}
+\end{equation}
+
+\noindent where hvc1 and hvc2 are herbivore activity constants which are set at the beginning of this module to
+0.019 and 1.38 respectively. NPPleaf_{long} is the mean, long-term leaf NPP.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+herbivore = \frac{Tres_{green} \times NPPleaf_{long}}{consumption} 
+\end{equation}
+
+\noindent where Tres_{green} is the mean residence time of the green tissue.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+X_{l} = \frac{X_{l} \, (\tau - {\Delta}t) + X_{s} \, {\Delta}t}{\tau}
+\end{equation}
+
+\noindent where X$_{l}$ is the long-term variable (e.g. monthly temperature/moisture availability), X$_{s}$ is the short-term variable (e.g. daily temperature/moisture availability), $\Delta$t is the time step, and $\tau$ is the time constant (in days) which varies according to the length of time represented by the long-term variable (equation (3) in Krinner et al., 2005). Values for tau set are based on calibration against observations CHECK.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+moist_{avail} = \frac{moist_{avail} \times (tau_{hum} - \Delta t) + moist_{avail,daily} \times \Delta t}{tau_{hum}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+ncd_{max} = 3. * one\_year 
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+soilhum_{month} = \frac{soilhum_{month} \times (tau_{soilhum} - \Delta t) + soilhum_{daily} * \Delta t}{tau_{soilhum}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex	(revision 5166)
@@ -0,0 +1,10 @@
+\begin{equation}
+Tl_{ref} = MAX(\, Tl_{ref-min}, \, MIN( \, Tl_{ref-max}, \, Tl \,) \,)
+\end{equation}
+
+\noindent where Tl$_{ref}$ is the long-term reference 2-meter temperature, 
+Tl$_{ref-min}$ and Tl$_{ref-max}$ are the reference minimum and maximum
+ long-term 2-meter temperature which CHECK should be set at the beginning of this 
+subroutine, and Tl is the "long-term" 2-meter reference temperature, previously
+calculated.
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+f_{active\rightarrow slow}=1-(0.85-0.68\times clay)-f_{active\rightarrow passive}.
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex	(revision 5166)
@@ -0,0 +1,13 @@
+\begin{equation}
+Flux_{pool}=
+\left\{
+  \begin{array}{ll}
+	C_{pool}\times\frac{\Delta t}{\tau_{pool}}\times\epsilon_T\times\epsilon_H & \textrm{(natural vegetation)} \\
+	C_{pool}\times\frac{\Delta t}{\tau_{pool}}\times\epsilon_T\times\epsilon_H\times 1.2 & \textrm{(C3 crops)} \\
+	C_{pool}\times\frac{\Delta t}{\tau_{pool}}\times\epsilon_T\times\epsilon_H\times 1.4 & \textrm{(C4 crops)}
+  \end{array}
+\right. \nonumber
+\end{equation}
+,where $C_{pool}$, $\Delta t$, $\tau_{pool}$, $\epsilon_T$ and $\epsilon_H$ are respectively the pool carbon
+stock, the time step, the pool turnover time, and two control coefficients
+(temperature and humidity) defined in the ::stomate\_litter module
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+Flux_{active}=Flux_{active}\cdot(1-0.75\times clay) . \nonumber
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+C_{pool} = C_{pool}-Flux_{pool}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+Resp_{soil}=\sum_{pool}(f_{pool\rightarrow atmosphere}\times Flux_{pool}).
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex	(revision 5166)
@@ -0,0 +1,9 @@
+\begin{equation}
+\left\{
+  \begin{array}{lcll}
+	C_{active}&=&C_{active}&+\sum_{pool}(f_{pool\rightarrow active}\times Flux_{pool})\\
+	C_{slow}   &=&C_{slow}&+\sum_{pool}(f_{pool\rightarrow slow}\times Flux_{pool})\\
+	C_{passive}&=&C_{passive}&+\sum_{pool}(f_{pool\rightarrow passive}\times Flux_{pool})
+  \end{array}
+\right.
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+\Delta B   = B \times MIN(0.99,\frac{\Delta t}{a_c}\times (\frac{a}{a_c})^4)
+\end{equation}
+where $B$ is the biomass, $\Delta B$ is the fraction of biomass lost, $\Delta t$ is the times step (1 day)
+and $a_c$ is the critical leaf age, a PFT-dependend parameter.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+\Delta B = B \times \frac{\Delta t} {tau_leaffall}
+\end{equation}
+where $B$ is the biomass, $\Delta B$ is the fraction of biomass lost, $\Delta t$ is the times step (1 day)
+and $tau_leaffall$ is the time constant of meteorological determined turnover.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+A = A + A_{i} \cdot f_{i}
+\end{equation}
+where $A$ is the mean leaf age, $A_{i}$ is the leaf age in leaf age class $i$ and $f_{i}$
+is the fraction of leaves in that class.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex	(revision 5166)
@@ -0,0 +1,8 @@
+\begin{equation}
+moist_{c}=MIN(MAX(moist_{min}+0.5(moist_{max}-moist_{min}),moist_{Senesc}),moist_{noSenesc})
+\end{equation}
+where $moist_{c}$ is the moisture availability critical level, $moist_{min}$ and 
+$moist_{max}$ are the last years moisture availability extrema for this location. 
+$moist_{Senesc}$ is the PFT dependend critical moisture level for which there is senescence and 
+$moist_{noSenesc}$ the PFT dependend critical moisture level above which there is no humidity 
+related senescence.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex	(revision 5166)
@@ -0,0 +1,6 @@
+\begin{equation}
+T_{crit}   = a\cdot T^{2}+b\cdot T+c
+\end{equation}
+where $T_{crit}$ is the critical temperature for senescence, $T$ is 
+the long term annual mean temperature and $a$,$b$ and $c$ are PFT-dependent 
+empirical parameters.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+LAI = SLA \cdot B_{leaf}
+\end{equation} 
+where LAI is the Leaf Area Index, SLA is the Specific Leaf Are and B_{leaf} is
+the leaf biomass.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex	(revision 5166)
@@ -0,0 +1,7 @@
+\begin{equation}
+f_{t} = \frac {f_{t-1}\cdot B_{leaf,t-1} + \Delta lm} {B_{leaf,t}}
+\end{equation}
+where $f_{t}$ is the new leaf fraction, $f_{t-1}$ is the old leaf fraction, $B_{leaf,t}$ is the new total leaf biomass
+and $B_{leaf,t-1}$ is the old total leaf biomass. $\Delta lm$ is the change in leaf biomass in the considered class due to 
+senescence.
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/TOOLS/codealgo.awk
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/TOOLS/codealgo.awk	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/TOOLS/codealgo.awk	(revision 5166)
@@ -0,0 +1,169 @@
+# codealgo.awk - filter of ORCHIDEE f90 files
+# command : gawk -f codealgo.awk [-d] file.f90
+# create a file.f90_preproc_codealgo filtered with algo comments inside each routine all group 
+# in the Doxygen comment just before its beginning.  
+
+#**************************************************************
+# Author: Martial.Mancip
+# Contact: Martial.Mancip__at__ipsl.jussieu.fr
+# $Revision::                                          $ Revision of last commit
+# $Author::                                            $ Author of last commit
+# $Date:: 
+# IPSL (2006)
+#  This software is governed by the CeCILL licence see libIGCM/libIGCM_CeCILL.LIC
+# Modification: 
+#
+#**************************************************************
+#==========================
+function debugprint(str) {
+  if (debug) {
+     print str  | "cat 1>&2"
+  }
+}
+function myprint(str) {
+    print str >> output_file
+}
+
+
+function flush_line() {
+    if ( nblc > 0 ) {
+	if ( inside_algo == 1 ) {
+	    myprint(" !> </ul>")
+	}
+	for ( i=1; i < nblc+1; i++ ) {
+	      myprint(line[i]) 	    
+	}
+	nblc=0
+    }
+}
+
+
+#==========================
+BEGIN {
+
+    nbarg=ARGC
+    if (ARGV[1] == "-d") {
+	debug=1
+	file=ARGV[2]
+	delete ARGV[1] 
+	nbarg--
+    } else {
+	debug=0
+	file=ARGV[1]
+    }
+    output_file=file "_preproc_codealgo"
+    if (debug) {
+	lscommand=("ls " output_file)
+	outsys=system(lscommand)
+	debugprint("output of ls : " outsys)
+	if ( outsys == 0 ) {
+	    debugprint("Already find " output_file)
+	    outsys=system("rm " output_file)
+	    debugprint("output of rm : " outsys)
+	    system("touch " output_file)
+	}
+    }
+
+# When exit statement, 'END' rule is always executed, so defined a exit_value to manage this
+    exit_value=0
+    if (nbarg != 2) {
+	debugprint("Usage: codealgo.awk [-d] file.f90")
+	debugprint("")
+	debugprint("Args:")
+	debugprint("      file.f90 = source code to be parsed")
+	debugprint("") 
+	debugprint("Options:" )
+	debugprint("       -d = debug mode")
+	debugprint("") 
+	exit_value=1
+	exit 2
+    }
+    debugprint("filter " file " in " output_file) 
+
+    # Number of previous lines commented
+    nblc=0
+    # Flag indicates inside a routine
+    routine = 0
+    routine_name = ""
+    # detect begin of algo liste
+    inside_algo=0
+
+    IGNORECASE=1
+}
+
+#==========================
+{
+  debugprint($0)
+
+  if ( match($0, "^[^!('\"]*subroutine") || match($0, "^[^!('\"]*function") ) {
+
+      debugprint("routine line.")
+
+      nblc++
+      line[nblc]=$0
+
+      # Begin of algo search
+      if ( match(line[nblc],"^[[:space:]]*end") ) {
+	  debugprint("End of the routine.")
+	  if ( routine == 0 ) {
+	      # error !
+	      debugprint("error ! End of routine has been detected but no routine was opened.")
+	      exit 1
+	  } else {
+	      if ( match(line[nblc],routine_name) ) {
+		  # here we flush the whole routine
+		  debugprint("Normal End of a routine : flush previous lines.")
+		  flush_line()
+		  routine = 0
+		  inside_algo = 0
+		  nblc = 0
+	      } else {
+		  debugprint("Error in a routine : routine_name " routine_name " doesn't match.")
+		  exit 3
+	      }
+	  }
+      } else {
+	  debugprint("Begining of a new routine.")
+
+	  if ( routine == 1 ) {
+	      if ( match(line[nblc],routine_name) ) {
+		  debugprint("routine : " routine_name " detect two times. Precompilation ? OK.")
+	      } else {
+		  # error !
+		  debugprint("error ! Already find a routine not closed.")
+		  exit 1
+	      }
+	  } else {
+	      routine_name=$2
+	      sub(/\(.*/,"",routine_name)
+	      debugprint("routine : " routine_name)
+	      routine = 1
+	  }
+      }
+
+  } else if ( routine == 1 ) {
+
+      nblc++
+      line[nblc]=$0
+
+      if (match(line[nblc], "^[[:space:]]+\\!+>*[[:space:]]+[[:digit:]]+\\.*"))
+      {
+	  debugprint("New algo line.")
+	  if ( inside_algo == 0 ) {
+	      myprint(" !> ")
+	      myprint(" !> ALGORITHM : ")
+	      myprint(" !> <ul>")
+	      debugprint("ALGORITHM.")
+	      inside_algo = 1
+	  }
+	  sub(/\!+>*/,"!> <li> ")
+	  myprint($0)
+      }
+  } else if ( routine == 0 ) {
+	  myprint($0)
+  }
+}
+
+END {
+    close(output_file)
+}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/TOOLS/codedox.awk
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/TOOLS/codedox.awk	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/TOOLS/codedox.awk	(revision 5166)
@@ -0,0 +1,366 @@
+# codedox.awk - filter of ORCHIDEE f90 files
+# command : gawk -f codedox.awk [-d] file.f90
+# create a file.f90_preproc_codedox filtered
+
+#**************************************************************
+# Author: Martial.Mancip
+# Contact: Martial.Mancip__at__ipsl.jussieu.fr
+# $Revision::                                          $ Revision of last commit
+# $Author::                                            $ Author of last commit
+# $Date:: 
+# IPSL (2006)
+#  This software is governed by the CeCILL licence see libIGCM/libIGCM_CeCILL.LIC
+# Modification: 
+#
+#**************************************************************
+#==========================
+function debugprint(str) {
+  if (debug) {
+      if ( ldebug ) { 
+	  print "-> " str  | "cat 1>&2"
+      } else {
+	  print str  | "cat 1>&2"
+      }
+  }
+}
+function myprint(str) {
+    if ( ldebug ) { 
+	print str  | "cat 1>&2"
+    } else {
+	print str >> output_file
+    }
+}
+
+
+function flush_line() {
+    if ( nblc > 0 ) {
+	debugprint("==> flush")
+	for ( i=0; i < nblc; i++ ) {
+	      myprint(line[i]) 	    
+	}
+	nblc=0
+	iblc=0
+    }
+}
+
+function code_intent(iblc) {
+    debugprint("line with intent")
+    if (match(line[iblc], "intent *\\(in\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in]",line[iblc])
+    } else if (match(line[iblc], "intent *\\(out\\)")) {
+	sub(/.*\!+>*\-*/, " !> [out]",line[iblc])
+    } else if (match(line[iblc], "intent *\\(inout\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in,out]",line[iblc])
+    } else {        
+        print "unknown intent error : " line[iblc]
+	debugprint("unknown intent error : " line[iblc])
+	exit 1
+    } 
+    if ( icont == 1 ) {
+	line[iblc]=line[iblc]  "\\n"
+    }
+    debugprint("line after Doxygen intent :" line[iblc])
+
+    sub(/\!.*/, "")
+    line[nblc]=$0
+    nblc++
+    debugprint("Only code intent :" $0)
+}
+
+function code_INTENT_ (iblc) {
+    debugprint("line with INTENT")
+    if (match(line[iblc], "INTENT *\\(in\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(out\\)")) {
+	sub(/.*\!+>*\-*/, " !> [out]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(inout\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in,out]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(IN\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(OUT\\)")) {
+	sub(/.*\!+>*\-*/, " !> [out]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(INOUT\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in,out]",line[iblc])
+    } else {	
+        print "unknown INTENT error : " line[iblc]
+	debugprint("unknown INTENT error : " line[iblc])
+	exit 1
+    } 
+    if ( icont == 1 ) {
+	line[iblc]=line[iblc]  "\\n"
+    }
+    debugprint("line after Doxygen INTENT :" line[iblc])
+
+    sub(/\!.*/, "")
+    line[nblc]=$0
+    nblc++
+    debugprint("Only code intent :" $0)
+}
+
+#==========================
+BEGIN {
+    ldebug=0
+    debug=0
+    if (ARGV[1] == "-d") {
+	debug=1
+	file=ARGV[2]
+ 	delete ARGV[1] 
+    } else if (ARGV[1] == "-dd") {
+	debug=1
+	ldebug=1
+	file=ARGV[2]
+	delete ARGV[1] 
+    } else {
+	file=ARGV[1]
+    }
+    debugprint("traitement de " file)
+
+    output_file=file "_preproc_codedox"
+    if (debug) {
+	if ( ! ldebug ) {
+	    lscommand=("ls " output_file)
+	    outsys=system(lscommand)
+	    debugprint("output of ls : " outsys)
+	    if ( outsys == 0 ) {
+		debugprint("Already find " output_file)
+		outsys=system("rm " output_file)
+		debugprint("output of rm : " outsys)
+		system("touch " output_file)
+	    }
+	}
+    }
+
+# When exit statement, 'END' rule is always executed, so defined a exit_value to manage this
+    exit_value=0
+    if ( ARGV[1] == "-h" ) {
+	debugprint("Usage: codedox.awk [-h] [-d|-dd] file.f90")
+	debugprint("")
+	debugprint("Args:")
+	debugprint("      file.f90 = source code to be parsed")
+	debugprint("") 
+	debugprint("Options:" )
+	debugprint("       -h = this usage")
+	debugprint("       -d = debug mode")
+	debugprint("       -dd = debug mode stdout")
+	debugprint("") 
+	exit_value=1
+	exit
+    }
+    # Number of previous lines commented
+    nblc=0
+
+    # Flag to point indented declaration
+    idecl=0
+    # index of first declaration comment 
+    icdecl=0
+    # Flag to point a continuation line inside a declaration
+    icont=0
+    # Number of the first line of declaration group inside line tab
+    nicont=0
+}
+
+#==========================
+{
+  debugprint($0)
+
+  # Divers modification de la ligne pour la compatibilitÃ© Doxygen
+  if (match($0, "!+")) {
+      
+      if (match($0, "!\\?")) {
+	  debugprint("Wrong comment")
+	  sub(/\!\?/, "!")
+	  debugprint("Correct wrong comment" $0)
+      } else if (match($0, "f90doc")) {
+	  debugprint("suppression de la ligne")
+	  next
+      } else if (match($0, "@call")) {
+	  debugprint("line with @call")
+	  sub(/@call/, "@see",$0)
+	  debugprint("line after correct call :" $0)
+      } else if (match($0, "@Version")) {
+          debugprint("line with @Version")
+          sub(/@Version/, "@version")
+          debugprint("line after Doxygen @version :" $0)
+      } else if (match($0, "@tex")) {
+	  match($0,"@tex([^@]+)@endtex",math)
+          debugprint("line with formula :" math[1])
+	  $0 = substr($0,1,match($0,"@tex")-1) "@htmlonly" math[1] "@endhtmlonly @latexonly" math[1] "@endlatexonly" substr($0,match($0,"@endtex")+7)
+      }
+
+      # traitement des simples cotes
+      if (match($0, "'") && ! match($0, "'.*'") ) {
+          debugprint("line with single cote")
+          sub(/'/, "''",$0)
+          debugprint("line without single cote : " $0)
+      }
+  }
+
+  if (match($0, "!+")) {
+      debugprint("line with comment")
+      
+      if ( idecl == 1 ) {
+	  debugprint("inside a decl " (match($0,"^[[:space:]]+!")) " " match($0,"!") " " icdecl ".")
+	  if ( (match($0,"^[[:space:]]+!")) && (match($0,"!") == icdecl) ) { 	
+	      line[nblc]=line[nblc-1]
+	      sub(/^[[:space:]]+\!+>*/," !>")
+	      # on Ã©crit le nouveau commentaire avant le prÃ©cÃ©dant
+	      line[nblc-1]=$0 "\\n"
+	      nblc++
+	      debugprint("continuation of declaration")
+	      next
+	  } else if ( icont == 1 ) {
+	      if (match($0,"!")) { 
+		  debugprint("continuation of declaration with &" nicont) 
+		  for ( i=nblc; i > nicont; i-- ) {
+		      line[i]=line[i-1]
+		  }
+		  nblc++
+
+		  line[nblc]=substr($0,1,icdecl-1)
+		  nblc++
+
+		  line[nicont+1]=line[nicont]
+
+		  line[nicont]=substr($0,icdecl)
+		  sub(/^\!+>*/," !>",line[nicont])
+		  line[nicont]=line[nicont] "\\n"
+		  for ( i=nicont-1; i < nblc; i++ ) {
+		      debugprint(":" i line[i])
+		  }
+	      } else {
+		  line[nblc]=$0
+		  nblc++
+		  debugprint("no comment in continuation of declaration with &") 
+	      }
+	      
+	      if ( match(line[nblc-1], "&") ) {
+		  if ( match(line[nblc-1], "&.*&") ) {
+		      icont = 1
+		      nicont=nicont+1
+		      debugprint("next line with &") 
+		  } else if ( match(line[nblc-1], "^[[:space:]]*&") ) {
+		      icont = 0
+		      nicont = 0
+		      debugprint("next line without &") 
+		  } else {
+		      icont = 1
+		      nicont=nicont+1
+		      debugprint("next line with &") 
+		  }
+	      } else {
+		  icont = 0
+		  nicont = 0
+		  debugprint(match(line[nblc-1], "^[[:space:]]+&*[^!]+&") match(line[nblc-1], "^[[:space:]]+[^!]+&[[:space:]]*!*"))
+	      }
+	      next
+	  } else {
+	      idecl=0
+	      icont = 0
+	      nicont = 0
+	      flush_line()
+	  }
+      }
+
+      iblc=nblc
+      line[nblc]=$0
+      nblc++
+
+      # commentary after a parameter documentation : need flush previous lines without Doxygen doc
+      if (match(line[iblc], "^[^!]+intent *\\(.*\\).*::")) {
+	  idecl=1
+	  icdecl=match($0,"!")
+	  if ( match(line[iblc], "[^!]*::[^!]*&") ) {
+	      icont = 1
+	      nicont=nblc
+	      debugprint("next line with &") 
+	  }
+	  code_intent(iblc)
+
+      } else if (match(line[iblc], "^[^!]+INTENT *\\(.*\\).*::")) {
+	  idecl=1
+	  icdecl=match($0,"!")
+	  if ( match(line[iblc], "[^!]*::[^!]*&") ) {
+	      icont = 1
+	      nicont=nblc
+	      debugprint("next line with &") 
+	  }
+	  code_INTENT_(iblc)
+
+      } else if (match(line[iblc], "^[^!]+::")) {
+	  debugprint("line with declaration")
+
+	  idecl=1
+	  icdecl=match($0,"!")
+	  if ( match(line[iblc], "[^!]*::[^!]*&") ) {
+	      icont = 1
+	      nicont=nblc
+	      debugprint("next line with &") 
+	  }
+
+	  sub(/.*\!+>*/, " !>",line[iblc])
+	  debugprint("line after Doxygen declaration :" line[iblc])
+
+	  sub(/\!.*/, "")
+	  debugprint("Only code declaration :" $0)
+	  line[nblc]=$0
+	  nblc++
+
+      }
+      next
+  } else if (match($0, "^[^!]*subroutine.*\\(.*") || match($0, "^[^!]*SUBROUTINE.*\\(.*") || 
+	     ( match($0, "^[^!]*subroutine ") && ! (match($0, "^[[:space:]]+end ")) ) || 
+	     ( match($0, "^[^!]*SUBROUTINE ") && ! (match($0, "^[[:space:]]+END ")) ) || 
+	     match($0, "^[^!]*function.*\\(.*") || match($0, "^[^!]*FUNCTION.*\\(.*") || 
+	     match($0, "^[^!]*module *") || match($0, "^[^!]*MODULE *") || 
+	     match($0, "^[^!]*interface *") || match($0, "^[^!]*INTERFACE *") ||
+	     match($0, "^[^!]+::")) {
+
+      debugprint("f90 declaration")
+
+      if ( idecl == 1 ) {
+	  idecl=0
+	  icont=0
+	  flush_line()
+      } 
+      if (nblc > 0 && ( match($0, "^[^!]+intent *\\(.*\\).*::") ||
+			match($0, "^[^!]+INTENT *\\(.*\\).*::") )) {
+	  if (match($0, "\\(in\\)") || match($0, "\\(IN\\)")) {
+	      sub(/.*\!+>*\-*/, " !> [in]",line[iblc])
+	  } else if (match($0, "\\(out\\)") || match($0, "\\(OUT\\)")) {
+	      sub(/.*\!+>*\-*/, " !> [out]",line[iblc])
+	  } else if (match($0, "\\(inout\\)") || match($0, "\\(INOUT\\)")) {
+	      sub(/.*\!+>*\-*/, " !> [in,out]",line[iblc])
+	  } else {	
+	      print "unknown INTENT error : " $0
+	      debugprint("unknown INTENT error : " $0)
+	      exit 1
+	  }
+      } else {
+
+	  for ( i=0; i < nblc; i++ ) {
+	      #  : ajout des commentaires Doxygen
+	      if (match(line[i], "!<")) {
+		  sub(/\^ *\!+</, " !>",line[i])
+	      } else {
+		  sub(/^ *\!\!/, " !>",line[i])
+	      }
+
+	      debugprint("traitement des lignes prÃ©cÃ©dentes : " line[i])
+	  }
+      }
+      flush_line()
+      myprint($0)
+      next
+  } else {
+      debugprint("normal line")
+
+      if ( idecl == 1 ) idecl=0
+
+      flush_line()
+      myprint($0)
+  }
+}
+
+END {
+    if ( ! ldebug ) close(output_file)
+}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/TOOLS/codeinc.awk
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/TOOLS/codeinc.awk	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/TOOLS/codeinc.awk	(revision 5166)
@@ -0,0 +1,121 @@
+# codeinc.awk - filter of ORCHIDEE f90 files
+# command : gawk -f codeinc.awk [-d] file.f90
+# create a file.f90_preproc_codeinc filtered
+
+#**************************************************************
+# Author: Martial.Mancip
+# Contact: Martial.Mancip__at__ipsl.jussieu.fr
+# $Revision::                                          $ Revision of last commit
+# $Author::                                            $ Author of last commit
+# $Date:: 
+# IPSL (2006)
+#  This software is governed by the CeCILL licence see libIGCM/libIGCM_CeCILL.LIC
+# Modification: 
+#
+#**************************************************************
+#==========================
+function debugprint(str) {
+  if (debug) {
+     print str  | "cat 1>&2"
+  }
+}
+function myprint(str) {
+    print str >> output_file
+}
+
+
+#==========================
+BEGIN {
+    debugprint("traitement de " ARGV[1])
+
+    nbarg=ARGC
+    if (ARGV[1] == "-d") {
+	debug=1
+	file=ARGV[2]
+	delete ARGV[1] 
+	nbarg--
+    } else {
+	debug=0
+	file=ARGV[1]
+    }
+    output_file=file "_preproc_codeinc"
+    if (debug) {
+	lscommand=("ls " output_file)
+	outsys=system(lscommand)
+	debugprint("output of ls : " outsys)
+	if ( outsys == 0 ) {
+	    debugprint("Already find " output_file)
+	    outsys=system("rm " output_file)
+	    debugprint("output of rm : " outsys)
+	    system("touch " output_file)
+	}
+    }
+
+# When exit statement, 'END' rule is always executed, so defined a exit_value to manage this
+    exit_value=0
+    if (nbarg != 2) {
+	debugprint("Usage: codeinc.awk [-d] file.f90")
+	debugprint("")
+	debugprint("Args:")
+	debugprint("      file.f90 = source code to be parsed")
+	debugprint("") 
+	debugprint("Options:" )
+	debugprint("       -d = debug mode")
+	debugprint("") 
+	exit_value=1
+	exit
+    }
+    codeinc=0
+    linecodeinc[1]=""
+    line[1]=""
+}
+
+#==========================
+{
+  debugprint($0)
+
+# Get information with MPI Program Information output on NEC
+  if (match($0, " *!> @codeinc *")) 
+  {
+      codeinc=1
+      nblines=0
+      Length=(match($0,"!>")-1)
+      spaces=substr($0,1,Length)
+      debugprint("Find @codeinc !" spaces Length)
+      myprint(spaces "!> @code")
+      next
+  } 
+  else if ( codeinc == 1 )
+  {
+      if (match($0, " *!> @endcodeinc *")) 
+      {
+	  codeinc=0
+	  debugprint("Find @endcodeinc !")
+	  for (i=0; i<nblines; i++) {  
+	      myprint(spaces "!> " linecodeinc[i])
+	  }
+ 	  myprint(spaces "!> @endcode")
+	  for (i=0; i<nblines; i++) {  
+	      myprint(line[i])
+	  }
+	  nblines=0
+      }
+      else
+      {
+	  line[nblines]=$0
+	  debugprint(nblines " | " line[nblines])
+	  linecodeinc[nblines]=substr(line[nblines],Length+1)
+	  debugprint(linecodeinc[nblines])
+	  nblines++
+      }
+  }
+  else
+  {
+      myprint($0)
+  }
+
+}
+
+END {
+    close(output_file)
+}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/footer.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/footer.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/footer.tex	(revision 5166)
@@ -0,0 +1,72 @@
+
+% \addcontentsline{toc}{chapter}{ANNEXE B : Table des notations} 
+% \markboth{\uppercase{\ Title Notations}}
+% {\uppercase{\ Notations}} \thispagestyle{empty} \input{./notation} %
+% \thispagestyle{empty} \newpage \thispagestyle{empty} \null \newpage \newpage 
+% {\pagestyle{empty}\cleardoublepage}
+
+\part{Annexes}
+
+\chapter{Index}
+\label{chap:index}
+
+\printindex
+
+\newpage
+\clearemptydoublepage
+
+\bibliographystyle{alpha}
+\bibliography{orchidee}
+\setcounter{chapter}{17}
+\addcontentsline{toc}{chapter}{Bibliography}
+\label{chap:biblio}
+
+\clearemptydoublepage
+
+This scientific documentation is the result of a huge effort led by the ORCHIDEE community,
+which reached a peak at the now famous ORCHIDEE summit, held at Saint-Lambert-Des-Bois (France), on 
+January, 19-20, 2012.
+
+Citation: To Be Defined
+
+List of Contributors:
+\begin{itemize}
+\item Bellassen Valentin, CDC Climat
+\item Cadule Patricia, IPSL
+\item Campoy AurÃ©lien, Sisyphe/UPMC
+\item Ciais Philippe, LSCE/IPSL
+\item de Noblet Nathalie, LSCE/IPSL
+\item de Weirdt Marjolein, UGent
+\item Ducharne AgnÃšs, Sisyphe/UPMC
+\item Gouttevin Isabelle, LGGE
+\item Guenet Betrand, LSCE/IPSL
+\item Guimberteau Mathieu, LOCEAN/IPSL
+\item Kato Tomomichi, LSCE/IPSL
+\item Koffi Ernest, LSCE/IPSL
+\item Kuppel Sylvain, LSCE/IPSL
+\item LathiÃšre Juliette, LSCE/IPSL
+\item Launois Thomas, LSCE/IPSL
+\item Luyssaert Sebastiaan, LSCE/IPSL
+\item MacBean Natasha, LSCE/IPSL
+\item Maignan Fabienne, LSCE/IPSL
+\item Mancip Martial, IPSL
+\item OttlÃ© Catherine, LSCE/IPSL
+\item Otto Juliane, LSCE/IPSL
+\item Peylin Philippe, LSCE/IPSL
+\item Polcher Jan, LMD/IPSL
+\item Poulter Benjamin, LSCE/IPSL
+\item Ryder James, LSCE/IPSL
+\item Saito Makoto, LSCE/IPSL
+\item Solyga Didier, LSCE/IPSL
+\item Tan Kun, LSCE/IPSL
+\item Valade Aude, LSCE/IPSL
+\item Verbecke Thomas, LSCE/IPSL
+\item Viovy Nicolas, LSCE/IPSL
+\item Vuichard Nicolas, LSCE/IPSL
+\item Wang Tao, LSCE/IPSL
+\item Yue Chao, LSCE/IPSL
+\end{itemize}
+
+
+
+\end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/header.tex.init
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/header.tex.init	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/DOC/header.tex.init	(revision 5166)
@@ -0,0 +1,252 @@
+\batchmode
+\documentclass[a4paper]{book}
+\usepackage{a4wide}
+\usepackage{makeidx}
+\usepackage[pdftex]{graphicx}
+\newcommand\textsubscript[1]{\ensuremath{{}_{\text{#1}}}}
+\usepackage{multicol}
+\usepackage{float}
+\usepackage{listings}
+\usepackage{color}
+\usepackage{ifthen}
+\usepackage[table]{xcolor}
+\usepackage{textcomp}
+\usepackage{alltt}
+\usepackage{times}
+\usepackage{ifpdf}
+\usepackage{hyperref}
+\hypersetup{pdftex,
+            pagebackref=true,
+            colorlinks=true,
+            linkcolor=blue,
+            citecolor=blue, 
+            filecolor=blue,
+            urlcolor=blue,
+            unicode,
+            pdftitle=ORCHIDEE Documentation,
+            pdfauthor=IPSL,
+            pdfsubject=Documentation,
+            pdfkeywords=ORCHIDEE Documentation Scientific Development}
+% Text styles
+\newcommand\textstyleInternetlink[1]{\textcolor[rgb]{0.0,0.0,0.5019608}{#1}}
+\newcommand\textstyleCitationHTML[1]{\textit{#1}}
+\makeatletter
+\newcommand\arraybslash{\let\\\@arraycr}
+\makeatother
+
+\usepackage[utf8]{inputenc}
+\usepackage[T1]{fontenc}
+\usepackage[english]{babel}
+%\usepackage[french]{babel}
+
+\usepackage{pifont}
+\usepackage{eurosym}
+\usepackage{amsmath}
+\usepackage{wasysym}
+\usepackage{amssymb,amsfonts,textcomp}
+\usepackage[top=2.54cm,bottom=2.54cm,left=3.175cm,right=3.175cm]{geometry}
+
+\usepackage{array}
+\usepackage{supertabular}
+\usepackage{hhline}
+% \newcommand\arraybslash{\let\\\@arraycr}
+\makeatother
+% Footnote rule
+\setlength{\skip\footins}{0.119cm}
+\renewcommand\footnoterule{\vspace*{-0.018cm}\setlength\leftskip{0pt}\setlength\rightskip{0pt plus 1fil}\noindent\textcolor{black}{\rule{0.25\columnwidth}{0.018cm}}\vspace*{0.101cm}}
+% Pages styles
+\makeatletter
+\newcommand\ps@Standard{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{}
+  \renewcommand\thepage{\arabic{page}}
+}
+\makeatother
+\pagestyle{Standard}
+\setlength\tabcolsep{1mm}
+\renewcommand\arraystretch{1.3}
+
+% Pages styles
+\makeatletter
+\newcommand\ps@Conversionvi{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionv{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversioniv{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+% \newcommand\ps@Standard{
+%   \renewcommand\@oddhead{}
+%   \renewcommand\@evenhead{}
+%   \renewcommand\@oddfoot{}
+%   \renewcommand\@evenfoot{}
+%   \renewcommand\thepage{\arabic{page}}
+% }
+\newcommand\ps@Conversioniii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\roman{page}}
+}
+\newcommand\ps@Conversionii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversioni{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\roman{page}}
+}
+\newcommand\ps@Conversionxv{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionxiv{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionxiii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionxii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionxi{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionx{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionix{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionviii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionvii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+
+\usepackage{doxygen}
+\lstset{language=C++,inputencoding=utf8,basicstyle=\footnotesize,breaklines=true,breakatwhitespace=true,tabsize=8,numbers=left }
+\usepackage{indentfirst}
+\makeindex
+\setcounter{tocdepth}{3}
+\renewcommand{\footrulewidth}{0.4pt}
+\hfuzz=15pt
+\setlength{\emergencystretch}{15pt}
+\hbadness=750
+\tolerance=750
+
+\usepackage{minitoc}
+\setcounter{minitocdepth}{5}
+%\renewcommand{\mtctitle}{\em Plan du chapitre}
+
+\renewcommand{\chaptermark}[1]{\markboth{#1}{}}
+\renewcommand{\sectionmark}[1]{\markright{\thesection \ #1}}
+
+% Les headers (tÃªtes de page)
+% \usepackage{fancyhdr}
+% \pagestyle{fancy}
+% \fancyhf{}
+% \fancyhead[LE,RO]{\bfseries\thepage}
+% \fancyhead[LO]{\bfseries\rightmark}
+% \fancyhead[RE]{\bfseries\leftmark}
+% \fancypagestyle{plain}
+% \fancyhead{}
+\renewcommand{\headrulewidth}{1pt}
+ 
+
+\begin{document}
+\hypersetup{pageanchor=false,citecolor=blue}
+\begin{titlepage}
+\vspace*{7cm}
+\begin{center}
+\leavevmode
+\includegraphics[scale=1]{logo_orchidee.png}
+{ \\[1ex]\large MYTAG revision MYREV}\\
+\vspace*{0.5cm}
+{\Large IPSL (Pierre Simon Laplace Institute)}\\
+\vspace*{1cm}
+{\-ORCHIDEE is the land-surface scheme of the IPSL.\\
+This scheme is the result of the coupling of the SECHIBA land-surface
+scheme, \\
+which is dedicated to the surface energy and water balances, \\
+and the carbon and vegetation model STOMATE.}\\
+\vspace*{0.5cm}
+{\Large \today}
+\end{center}
+\end{titlepage}
+
+\dominitoc
+
+\part{Table Of Contents}
+\clearemptydoublepage
+\pagenumbering{roman}
+\tableofcontents
+%\clearemptydoublepage
+
+\pagenumbering{arabic}
+\hypersetup{pageanchor=true,citecolor=blue}
+
+\part{Documentation}
+\label{part:doc}
+
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/Doxyfile_ORCHIDEE.init
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/Doxyfile_ORCHIDEE.init	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/Doxyfile_ORCHIDEE.init	(revision 5166)
@@ -0,0 +1,288 @@
+# Doxyfile 1.7.3
+
+#---------------------------------------------------------------------------
+# Project related configuration options
+#---------------------------------------------------------------------------
+DOXYFILE_ENCODING      = UTF-8
+PROJECT_NAME           = ORCHIDEE
+PROJECT_NUMBER         = "MYTAG rev MYREV"
+PROJECT_BRIEF          = "The land-surface scheme of IPSL."
+PROJECT_LOGO           = MYPATH/ORCHIDEE/DOC/logo_orchidee.png
+OUTPUT_DIRECTORY       = MYPATH/ORCHIDEE/docs
+CREATE_SUBDIRS         = YES
+OUTPUT_LANGUAGE        = English
+BRIEF_MEMBER_DESC      = YES
+REPEAT_BRIEF           = YES
+ABBREVIATE_BRIEF       =
+ALWAYS_DETAILED_SEC    = YES
+INLINE_INHERITED_MEMB  = YES
+FULL_PATH_NAMES        = YES
+STRIP_FROM_PATH        = MYPATH/modeles_doc
+STRIP_FROM_INC_PATH    = MYPATH/ORCHIDEE/DOC
+SHORT_NAMES            = NO
+JAVADOC_AUTOBRIEF      = NO
+QT_AUTOBRIEF           = NO
+MULTILINE_CPP_IS_BRIEF = NO
+INHERIT_DOCS           = YES
+SEPARATE_MEMBER_PAGES  = YES
+TAB_SIZE               = 12
+ALIASES                = 
+OPTIMIZE_OUTPUT_FOR_C  = NO
+OPTIMIZE_OUTPUT_JAVA   = NO
+OPTIMIZE_FOR_FORTRAN   = YES
+OPTIMIZE_OUTPUT_VHDL   = NO
+EXTENSION_MAPPING      =
+BUILTIN_STL_SUPPORT    = NO
+CPP_CLI_SUPPORT        = NO
+SIP_SUPPORT            = NO
+IDL_PROPERTY_SUPPORT   = NO
+DISTRIBUTE_GROUP_DOC   = YES
+SUBGROUPING            = YES
+TYPEDEF_HIDES_STRUCT   = YES
+SYMBOL_CACHE_SIZE      = 9
+#---------------------------------------------------------------------------
+# Build related configuration options
+#---------------------------------------------------------------------------
+EXTRACT_ALL            = YES
+EXTRACT_PRIVATE        = YES
+EXTRACT_STATIC         = YES
+EXTRACT_LOCAL_CLASSES  = YES
+EXTRACT_LOCAL_METHODS  = YES
+EXTRACT_ANON_NSPACES   = YES
+HIDE_UNDOC_MEMBERS     = NO
+HIDE_UNDOC_CLASSES     = NO
+HIDE_FRIEND_COMPOUNDS  = NO
+HIDE_IN_BODY_DOCS      = NO
+INTERNAL_DOCS          = YES
+CASE_SENSE_NAMES       = NO
+HIDE_SCOPE_NAMES       = YES
+SHOW_INCLUDE_FILES     = YES
+FORCE_LOCAL_INCLUDES   = YES
+INLINE_INFO            = YES
+SORT_MEMBER_DOCS       = YES
+SORT_BRIEF_DOCS        = NO
+SORT_MEMBERS_CTORS_1ST = NO
+SORT_GROUP_NAMES       = NO
+SORT_BY_SCOPE_NAME     = NO
+STRICT_PROTO_MATCHING  = NO
+GENERATE_TODOLIST      = YES
+GENERATE_TESTLIST      = YES
+GENERATE_BUGLIST       = YES
+GENERATE_DEPRECATEDLIST= YES
+ENABLED_SECTIONS       = 
+MAX_INITIALIZER_LINES  = 30
+SHOW_USED_FILES        = YES
+SHOW_DIRECTORIES       = YES
+SHOW_FILES             = YES
+SHOW_NAMESPACES        = YES
+FILE_VERSION_FILTER    = 
+LAYOUT_FILE            =
+#---------------------------------------------------------------------------
+# configuration options related to warning and progress messages
+#---------------------------------------------------------------------------
+QUIET                  = NO
+WARNINGS               = YES
+WARN_IF_UNDOCUMENTED   = YES
+WARN_IF_DOC_ERROR      = YES
+WARN_NO_PARAMDOC       = YES
+WARN_FORMAT            = "$file:$line: $text"
+WARN_LOGFILE           = doxygen.log
+#---------------------------------------------------------------------------
+# configuration options related to the input files
+#---------------------------------------------------------------------------
+INPUT                  = SRCPATH/ORCHIDEE \
+                         SRCPATH/ORCHIDEE_OL
+# \
+#                         SRCPATH/IOIPSL/src/
+INPUT_ENCODING         = UTF-8
+FILE_PATTERNS          = *.f90 \
+                         *.F90 \
+                         *.h
+RECURSIVE              = YES
+EXCLUDE                = 
+EXCLUDE_SYMLINKS       = YES
+EXCLUDE_PATTERNS       = 
+EXCLUDE_SYMBOLS        = 
+EXAMPLE_PATH           = MYPATH/ORCHIDEE/DOC
+EXAMPLE_PATTERNS       = *
+EXAMPLE_RECURSIVE      = NO
+IMAGE_PATH             = MYPATH/ORCHIDEE/DOC
+INPUT_FILTER           = 
+FILTER_PATTERNS        = 
+FILTER_SOURCE_FILES    = NO
+FILTER_SOURCE_PATTERNS =
+#---------------------------------------------------------------------------
+# configuration options related to source browsing
+#---------------------------------------------------------------------------
+SOURCE_BROWSER         = YES
+INLINE_SOURCES         = YES
+STRIP_CODE_COMMENTS    = NO
+REFERENCED_BY_RELATION = YES
+REFERENCES_RELATION    = YES
+REFERENCES_LINK_SOURCE = YES
+USE_HTAGS              = NO
+VERBATIM_HEADERS       = YES
+#---------------------------------------------------------------------------
+# configuration options related to the alphabetical class index
+#---------------------------------------------------------------------------
+ALPHABETICAL_INDEX     = YES
+COLS_IN_ALPHA_INDEX    = 5
+IGNORE_PREFIX          = 
+#---------------------------------------------------------------------------
+# configuration options related to the HTML output
+#---------------------------------------------------------------------------
+GENERATE_HTML          = YES
+HTML_OUTPUT            = html
+HTML_FILE_EXTENSION    = .html
+HTML_HEADER            = 
+# MYPATH/ORCHIDEE/DOC/header.html
+HTML_FOOTER            = 
+# MYPATH/ORCHIDEE/DOC/footer.html
+HTML_STYLESHEET        = 
+HTML_EXTRA_FILES       =
+HTML_COLORSTYLE_HUE    = 220
+HTML_COLORSTYLE_SAT    = 100
+HTML_COLORSTYLE_GAMMA  = 80
+HTML_TIMESTAMP         = YES
+HTML_ALIGN_MEMBERS     = YES
+HTML_DYNAMIC_SECTIONS  = YES
+GENERATE_DOCSET        = YES
+DOCSET_FEEDNAME        = "IPSL model"
+DOCSET_BUNDLE_ID       = fr.orchidee.ipsl.jussieu
+DOCSET_PUBLISHER_ID    = org.doxygen.Publisher
+DOCSET_PUBLISHER_NAME  = Publisher
+GENERATE_HTMLHELP      = NO
+CHM_FILE               = 
+HHC_LOCATION           = 
+GENERATE_CHI           = NO
+CHM_INDEX_ENCODING     =
+BINARY_TOC             = YES
+TOC_EXPAND             = YES
+GENERATE_QHP           = YES
+QCH_FILE               =
+QHP_NAMESPACE          = fr.orchidee.ipsl.jussieu
+QHP_VIRTUAL_FOLDER     = docs
+QHP_CUST_FILTER_NAME   =
+QHP_CUST_FILTER_ATTRS  =
+QHP_SECT_FILTER_ATTRS  =
+QHG_LOCATION           =
+GENERATE_ECLIPSEHELP   = YES
+ECLIPSE_DOC_ID         = org.doxygen.Project
+DISABLE_INDEX          = NO
+ENUM_VALUES_PER_LINE   = 4
+GENERATE_TREEVIEW      = YES
+USE_INLINE_TREES       = YES
+TREEVIEW_WIDTH         = 250
+EXT_LINKS_IN_WINDOW    = YES
+FORMULA_FONTSIZE       = 10
+FORMULA_TRANSPARENT    = YES
+USE_MATHJAX            = YES
+MATHJAX_RELPATH        = http://www.mathjax.org/mathjax
+SEARCHENGINE           = YES
+SERVER_BASED_SEARCH    = NO
+#---------------------------------------------------------------------------
+# configuration options related to the LaTeX output
+#---------------------------------------------------------------------------
+GENERATE_LATEX         = YES
+LATEX_OUTPUT           = latex
+LATEX_CMD_NAME         = latex
+MAKEINDEX_CMD_NAME     = makeindex
+COMPACT_LATEX          = NO
+EXTRA_PACKAGES         = 
+LATEX_HEADER           = MYPATH/ORCHIDEE/DOC/header.tex
+LATEX_FOOTER           = MYPATH/ORCHIDEE/DOC/footer.tex
+PDF_HYPERLINKS         = YES
+LATEX_HIDE_INDICES     = NO
+LATEX_SOURCE_CODE      = NO 
+#---------------------------------------------------------------------------
+# configuration options related to the RTF output
+#---------------------------------------------------------------------------
+GENERATE_RTF           = NO
+RTF_OUTPUT             = rtf
+COMPACT_RTF            = NO
+RTF_HYPERLINKS         = NO
+RTF_STYLESHEET_FILE    = 
+RTF_EXTENSIONS_FILE    = 
+#---------------------------------------------------------------------------
+# configuration options related to the man page output
+#---------------------------------------------------------------------------
+GENERATE_MAN           = NO
+MAN_OUTPUT             = man
+MAN_EXTENSION          = .3
+MAN_LINKS              = NO
+#---------------------------------------------------------------------------
+# configuration options related to the XML output
+#---------------------------------------------------------------------------
+GENERATE_XML           = NO
+XML_OUTPUT             = xml
+XML_SCHEMA             = 
+XML_DTD                = 
+XML_PROGRAMLISTING     = YES
+#---------------------------------------------------------------------------
+# configuration options for the AutoGen Definitions output
+#---------------------------------------------------------------------------
+GENERATE_AUTOGEN_DEF   = NO
+#---------------------------------------------------------------------------
+# configuration options related to the Perl module output
+#---------------------------------------------------------------------------
+GENERATE_PERLMOD       = NO
+PERLMOD_LATEX          = NO
+PERLMOD_PRETTY         = YES
+PERLMOD_MAKEVAR_PREFIX = 
+#---------------------------------------------------------------------------
+# Configuration options related to the preprocessor   
+#---------------------------------------------------------------------------
+ENABLE_PREPROCESSING   = YES
+MACRO_EXPANSION        = NO
+EXPAND_ONLY_PREDEF     = NO
+SEARCH_INCLUDES        = YES
+INCLUDE_PATH           = 
+INCLUDE_FILE_PATTERNS  = 
+PREDEFINED             = 
+EXPAND_AS_DEFINED      = 
+SKIP_FUNCTION_MACROS   = YES
+#---------------------------------------------------------------------------
+# Configuration::additions related to external references   
+#---------------------------------------------------------------------------
+TAGFILES               = 
+GENERATE_TAGFILE       = ORCHIDEE_tags
+ALLEXTERNALS           = NO
+EXTERNAL_GROUPS        = NO
+PERL_PATH              = /usr/bin/perl
+#---------------------------------------------------------------------------
+# Configuration options related to the dot tool   
+#---------------------------------------------------------------------------
+CLASS_DIAGRAMS         = YES
+MSCGEN_PATH            = 
+HIDE_UNDOC_RELATIONS   = NO
+HAVE_DOT               = YES
+DOT_NUM_THREADS        = 0
+DOT_FONTNAME           = Helvetica
+DOT_FONTSIZE           = 10
+DOT_FONTPATH           =
+CLASS_GRAPH            = YES
+COLLABORATION_GRAPH    = YES
+GROUP_GRAPHS           = YES
+UML_LOOK               = YES
+TEMPLATE_RELATIONS     = YES
+INCLUDE_GRAPH          = YES
+INCLUDED_BY_GRAPH      = YES
+CALL_GRAPH             = YES
+CALLER_GRAPH           = YES
+GRAPHICAL_HIERARCHY    = YES
+DIRECTORY_GRAPH        = YES
+DOT_IMAGE_FORMAT       = png
+DOT_PATH               = 
+DOTFILE_DIRS           = MYPATH/ORCHIDEE/DOC/DOT
+MSCFILE_DIRS           =
+DOT_GRAPH_MAX_NODES    = 50
+MAX_DOT_GRAPH_DEPTH    = 1000
+DOT_TRANSPARENT        = NO
+DOT_MULTI_TARGETS      = YES
+GENERATE_LEGEND        = YES
+DOT_CLEANUP            = YES
+#---------------------------------------------------------------------------
+#- ALIAS ORCHDIEE
+#---------------------------------------------------------------------------
+ALIASES += Bold{1}="<b>\1</b>"
+ALIASES += Emph{1}="<em>\1</em>"
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/ORCHIDEE_CeCILL.LIC
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/ORCHIDEE_CeCILL.LIC	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/ORCHIDEE_CeCILL.LIC	(revision 5166)
@@ -0,0 +1,40 @@
+The following licence information concerns ONLY the ORCHIDEE MODEL
+==================================================================
+
+Copyright © Centre National de la Recherche Scientifique CNRS  
+            Commissariat à l'Énergie Atomique CEA
+
+ORCHIDEE : Organizing Carbon and Hydrology In Dynamic EcosystEms. 
+
+The purpose of this software is to simulate a number of exchanges
+occurring at the interface between the continental biosphere and the
+atmosphere, as well as the state of the biosphere (soil water and
+carbon content, living biomass, fluxes of latent, sensible heat, net
+CO2 flux, .....). It includes physical, biogeochemical and chemical
+processes at varying time scales (minutes to centuries).
+
+This software is governed by the CeCILL  license under French law and
+abiding by the rules of distribution of free software.  You can  use, 
+modify and/ or redistribute the software under the terms of the CeCILL
+license as circulated by CEA, CNRS and INRIA at the following URL
+"http://www.cecill.info". 
+
+As a counterpart to the access to the source code and  rights to copy,
+modify and redistribute granted by the license, users are provided only
+with a limited warranty  and the software's author,  the holder of the
+economic rights,  and the successive licensors  have only  limited
+liability. 
+
+In this respect, the user's attention is drawn to the risks associated
+with loading,  using,  modifying and/or developing or reproducing the
+software by the user in light of its specific status of free software,
+that may mean  that it is complicated to manipulate,  and  that  also
+therefore means  that it is reserved for developers  and  experienced
+professionals having in-depth computer knowledge. Users are therefore
+encouraged to load and test the software's suitability as regards their
+requirements in conditions enabling the security of their systems and/or 
+data to be ensured and,  more generally, to use and operate it in the 
+same conditions as regards security. 
+
+The fact that you are presently reading this means that you have had
+knowledge of the CeCILL license and that you accept its terms.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_ADA.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_ADA.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_ADA.fcm	(revision 5166)
@@ -0,0 +1,16 @@
+%COMPILER            mpiifort
+%LINK                mpiifort
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF              
+%BASE_FFLAGS         -integer-size 32 -real-size 64 -align all -shared-intel -mcmodel=large -fp-model precise 
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+%DEBUG_FFLAGS        -fpe0 -O0 -g -traceback -fp-stack-check -ftrapuv -check bounds -check all
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp -openmp-threadprivate compat
+%BASE_LD             -shared-intel -mcmodel=large -Wl,-rpath=/smplocal/pub/NetCDF/4.1.3/mpi/lib:/smplocal/pub/HDF5/1.8.9/par/lib 
+%MPI_LD
+%OMP_LD              -openmp
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_ADA.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_ADA.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_ADA.path	(revision 5166)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="${NETCDF_LDFLAGS:-/smplocal/pub/NetCDF/4.1.3/mpi/lib -lnetcdff -lnetcdf -lstdc++ -L/smplocal/pub/HDF5/1.8.9/par/lib -Bstatic -lhdf5_hl -lhdf5_fortran -lhdf5 -Bdynamic -lz}"
+NETCDF_INCDIR="${NETCDF_FFLAGS:-/smplocal/pub/HDF5/1.8.9/par/include -I/smplocal/pub/NetCDF/4.1.3/mpi/include}"
+IOIPSL_INCDIR=${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=${ORCHDIR}/../../lib
+XIOS_INCDIR=${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="${ORCHDIR}/../XIOS/lib -lxios"
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_CURIE.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_CURIE.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_CURIE.fcm	(revision 5166)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINK                mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF              
+%BASE_FFLAGS         -i4 -r8 -auto -align all -fp-model precise 
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+%DEBUG_FFLAGS        -fpe0 -O0 -g -traceback -fp-stack-check -ftrapuv -check bounds -check all
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp -openmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -openmp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_CURIE.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_CURIE.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_CURIE.path	(revision 5166)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="$NETCDF_LIBDIR -lnetcdff -lnetcdf -lstdc++"
+NETCDF_INCDIR=$NETCDF_INCDIR
+IOIPSL_INCDIR=${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=${ORCHDIR}/../../lib
+XIOS_INCDIR=${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="${ORCHDIR}/../XIOS/lib -lxios"
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_OCCIGEN.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_OCCIGEN.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_OCCIGEN.fcm	(revision 5166)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINK                mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF              
+%BASE_FFLAGS         -i4 -r8 -auto -align all -fp-model precise -xCORE-AVX2
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -p -g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+%DEBUG_FFLAGS        -p -g -traceback -fp-stack-check -ftrapuv -check bounds
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp -openmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -openmp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_OCCIGEN.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_OCCIGEN.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-X64_OCCIGEN.path	(revision 5166)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="$NETCDF_LIB_DIR $NETCDFF_LIBDIR -lnetcdff -lnetcdf -lstdc++"
+NETCDF_INCDIR="$NETCDF_INC_DIR -I$NETCDFF_INCDIR"
+IOIPSL_INCDIR=${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=${ORCHDIR}/../../lib
+XIOS_INCDIR=${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="${ORCHDIR}/../XIOS/lib -lxios"
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-gfortran.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-gfortran.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-gfortran.fcm	(revision 5166)
@@ -0,0 +1,15 @@
+%COMPILER            gfortran
+%LINK                gfortran
+%AR                  ar
+%MAKE                make
+%FPP_FLAGS           -P -C -traditional
+%FPP_DEF             
+%BASE_FFLAGS         -fdefault-real-8
+%PROD_FFLAGS         -O3 -funroll-all-loops
+%DEV_FFLAGS          -O
+%DEBUG_FFLAGS        -ffpe-trap=invalid,zero,overflow -fbounds-check -g3 -O0 -fstack-protector-all
+%MPI_FFLAGS
+%OMP_FFLAGS          
+%BASE_LD      
+%MPI_LD
+%OMP_LD              
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-gfortran.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-gfortran.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-gfortran.path	(revision 5166)
@@ -0,0 +1,4 @@
+NETCDF_LIBDIR=/usr/local/lib
+NETCDF_INCDIR=/usr/local/include
+IOIPSL_INCDIR=${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=${ORCHDIR}/../../lib
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-ifort_CICLAD.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-ifort_CICLAD.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-ifort_CICLAD.fcm	(revision 5166)
@@ -0,0 +1,15 @@
+%COMPILER            /usr/lib64/openmpi/1.4.5-ifort/bin/mpif90 
+%LINK                /usr/lib64/openmpi/1.4.5-ifort/bin/mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF              
+%BASE_FFLAGS         -i4 -r8 -fp-model precise  
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+%DEBUG_FFLAGS        -fpe0 -O0 -g -traceback -fp-stack-check -ftrapuv -check bounds -check all
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp -openmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -openmp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-ifort_CICLAD.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-ifort_CICLAD.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-ifort_CICLAD.path	(revision 5166)
@@ -0,0 +1,6 @@
+NETCDF_LIBDIR="/opt/netcdf42/ifort/lib -lnetcdf -lnetcdff -lstdc++"
+NETCDF_INCDIR=/opt/netcdf42/ifort/include
+IOIPSL_INCDIR=../../../lib
+IOIPSL_LIBDIR=../../../lib
+XIOS_INCDIR=${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="${ORCHDIR}/../XIOS/lib -lxios"
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-ifort_LSCE.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-ifort_LSCE.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-ifort_LSCE.fcm	(revision 5166)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINK                mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF              
+%BASE_FFLAGS         -i4 -r8 -fp-model precise  
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+%DEBUG_FFLAGS        -fpe0 -O0 -g -traceback -fp-stack-check -ftrapuv -check bounds -check all
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp -openmp-threadprivate compat
+%BASE_LD             -i4 -r8
+%MPI_LD
+%OMP_LD              -openmp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-ifort_LSCE.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-ifort_LSCE.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/arch/arch-ifort_LSCE.path	(revision 5166)
@@ -0,0 +1,7 @@
+NETCDF_LIBDIR="/usr/local/install/netcdf-4.3.2p/lib -lnetcdff -lnetcdf -L/usr/local/install/hdf5-1.8.9p/lib -lhdf5_hl -lhdf5 -lhdf5 -lz -lcurl -lstdc++"
+NETCDF_INCDIR=/usr/local/install/netcdf-4.3.2p/include
+IOIPSL_INCDIR=${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=${ORCHDIR}/../../lib
+XIOS_INCDIR=${ORCHDIR}/../XIOS/inc
+XIOS_LIBDIR="${ORCHDIR}/../XIOS/lib -lxios"
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/bld.cfg
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/bld.cfg	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/bld.cfg	(revision 5166)
@@ -0,0 +1,82 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+
+inc arch.fcm
+inc config.fcm
+
+%ROOT_PATH         $PWD
+%CONFIG_PATH       %ROOT_PATH/.config
+%SRC_PATH          %ROOT_PATH
+
+
+src::global       %SRC_PATH/src_global
+src::parallel     %SRC_PATH/src_parallel
+src::sechiba      %SRC_PATH/src_sechiba
+src::stomate      %SRC_PATH/src_stomate
+src::parameters   %SRC_PATH/src_parameters
+src::orchidee_ol  %SRC_PATH/src_driver
+src::ext_src      %EXT_SRC
+
+bld::lib::global         orglob
+bld::lib::parallel       parallel
+bld::lib::sechiba        sechiba
+bld::lib::stomate        stomate
+bld::lib::parameters     parameters
+bld::lib::orchidee_ol    orchidee_ol
+bld::lib                 orchidee
+
+bld::target              liborglob.a libparallel.a libsechiba.a libstomate.a libparameters.a liborchidee.a
+bld::target              %EXEC
+bld::exe_dep             ext_src global parallel sechiba stomate parameters orchidee_ol
+
+dir::root            %CONFIG_PATH
+dir::lib             %ROOT_PATH/lib
+dir::bin             %ROOT_PATH/bin
+dir::inc             %ROOT_PATH/lib
+dir::tmp             %ROOT_PATH/tmp_src
+
+#search_src           1
+
+bld::tool::fc        %COMPILER 
+bld::tool::ld        %LINK
+bld::tool::ar        %AR
+bld::tool::make      %MAKE
+bld::tool::fflags    %FFLAGS %INCDIR
+bld::tool::ldflags   %LD_FFLAGS %LIBDIR -lioipsl -lnetcdf   
+
+bld::tool::cppflags  %FPP_FLAGS %INCDIR
+bld::tool::fppflags  %FPP_FLAGS %INCDIR
+bld::tool::fppkeys   %CPP_KEY
+
+
+# Pre-process code before analysing dependencies
+bld::pp              1
+infile_ext::f90 fpp::fpp9x::source
+
+# Ignore the following dependencies
+bld::excl_dep        inc::netcdf.inc
+bld::excl_dep        use::netcdf
+bld::excl_dep        h::netcdf.inc
+bld::excl_dep        h::mpif.h
+bld::excl_dep        inc::mpif.h
+bld::excl_dep        use::ioipsl
+bld::excl_dep        USE::defprec
+bld::excl_dep        USE::calendar
+bld::excl_dep        USE::xios
+
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".inc" as an extension for CPP include files
+bld::infile_ext::inc  CPP::INCLUDE
+
+# extension for module output
+bld::outfile_ext::mod .mod
+bld::tool::SHELL   /bin/bash
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/makeorchidee_fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/makeorchidee_fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/makeorchidee_fcm	(revision 5166)
@@ -0,0 +1,459 @@
+#!/bin/bash
+
+#==============================================================================================================================\n
+#  MODULE 	: makeorchidee_fcm
+# 
+#  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+#
+#  LICENCE      : IPSL (2006)
+#  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+#
+# SVN     :
+# $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/trunk/ORCHIDEE/makeorchidee_fcm $ 
+# $Date: $
+# $Revision: $
+# \n
+####################################################################################################
+#
+# This script has several possible functions :
+#   1. Compiling ORCHIDEE
+#   2. Building of the documentation
+#
+#***************************************************************************************************
+#
+# Command lines :
+#
+#   1) makeorchidee_fcm   [ -parallel  PARALLEL_TYPE ]
+#                         [ -driver ]
+#                         [ -arch XXX ]
+#                         [ -prod | -dev | -debug ]
+#
+#   2) makeorchidee_fcm   [ -clean ]
+#
+#   3) makeorchidee_fcm   [ -doc | -doc_para ] ## actually doc_para is commented
+#                         [ -rmdoc ]
+#                         [ -doc_tree ]
+#
+
+parallel_mode=seq
+is_driver_opt=FALSE
+is_arch_opt=FALSE 
+clean=FALSE
+compile_flags="%PROD_FFLAGS"
+xios1=FALSE
+xios2=FALSE
+full=""
+job=1
+ext_src=""
+
+export P_P=""
+export SECTIONS_PARA=""
+
+ORCHDIR=`/bin/pwd`
+fcm_path=$ORCHDIR/tools/FCM_V1.2/bin
+
+while (($# > 0)) ; do
+  case $1 in
+      "-h") cat <<fin
+
+########################################################################
+# Usage of the script makeorchidee_fcm
+#
+# makeorchidee_fcm compiles ORCHIDEE using the Fcm a software developed
+# by the Hadley Centre. Fcm is stored in tools directory. 
+# Platform specific compile options are found in the arch directory. 
+########################################################################
+
+./makeorchidee_fcm [Options] 
+
+Main options
+[ -h ]        : show this help
+
+[ -arch XXX ] : name of the archicture file containg platform dependent compile options. 
+                The files arch/arch-XXX.fcm and arch/arch-XXX.path must exist. 
+
+[ -parallel|-p PARALLEL_TYPE ] : choose parallelization mode for ORCHIDEE : 
+    PARALLEL_TYPE =
+    ( mpi | MPI )              : only MPI (Message Passing Interface)
+    ( omp | OMP )              : only OpenMP
+    ( mpi_omp | MPI_OMP )      : hybrid MPI/OpenMP mode
+    ( none | NONE | seq )      : sequential mode (default)
+
+[ -driver ]      : compilation of ORCHIDEE offline driver (default compiling only the library)
+
+Options related to cleaning
+| -clean ]       : delete all files produceed during previous compilation
+| -full ]        : activate full recompiling 
+
+Options for XIOS, only choose one of the following
+[ -xios | -xios1 ] : linking with XIOS 1.0
+[ -xios2 ]         : linking with XIOS 2.0
+[ -noxios ]        : compilation without XIOS (default)
+
+Options for optimization, choose only one of the following
+[ -prod ]        : compilation for production (all optimization)
+[ -dev ]         : compilation for development (low optimization and -g)
+[ -debug ]       : compilation for debugging (no optmization and all debug options)
+
+Option to optimize the compilation time
+[ -j x ]         : activate parallel compiling on x task, default 1 task
+
+Option to add extra source to compile
+[ -ext_src path] : path to an additional directory with fortran routines to compile with the model
+
+Options for compiling the documentation :
+[ -doc ]         : generate documentation with Doxygen (exit after doc computation)
+[ -doc_para ]    : generate documentation with Doxygen with parallelization calls
+[ -rmdoc ]       : remove documentation directory (before generate new documentation with Doxygen ?)
+[ -doc_tree ]    : generate tree of ORCHIDEE directories for each file
+
+
+Example 1 : compile at curie(TGCC) for MPI parallel run mode
+   ./makeorchidee_fcm -parallel mpi -arch X64_CURIE -driver
+
+Example 2 : compile at ada(IDRIS) for MPI-OpenMP parallel run mode
+   ./makeorchidee_fcm -parallel mpi_omp -arch X64_ADA -driver
+
+Example 3 : compile at obelix(LSCE)
+   ./makeorchidee_fcm -arch ifort_LSCE -driver
+
+Example 4 : compile using gfortran compiler for sequential run mode 
+First make sure that the files arch/gfortran.fcm and arch/gfortran.path are suitable for 
+your environement especially the path to netcdf library. 
+   ./makeorchidee_fcm -parallel seq -arch gfortran -driver
+
+Example 5 : clean files created during previous compilation
+   ./makeorchidee_fcm -clean
+
+fin
+    exit;;
+
+########################################################################
+# Read argument
+########################################################################
+
+    "-parallel")
+        parallel_mode=$2 ; shift ; shift ;; 
+                       
+    "-driver")
+         is_driver_opt=TRUE
+        shift ;;
+
+    "-arch")
+        is_arch_opt=TRUE
+        arch="$2" ; shift ; shift ;;
+
+    "-xios")
+         xios1=TRUE
+         xios2=FALSE
+        shift ;;
+
+    "-xios1")
+         xios1=TRUE
+         xios2=FALSE
+        shift ;;
+
+    "-xios2")
+         xios1=FALSE
+         xios2=TRUE
+        shift ;;
+
+    "-noxios")
+         xios1=FALSE
+         xios2=FALSE
+        shift ;;
+
+    "-prod")
+        compile_flags="%PROD_FFLAGS"
+        shift ;;
+
+    "-dev")
+        compile_flags="%DEV_FFLAGS"
+        shift ;;
+
+    "-debug")
+        compile_flags="%DEBUG_FFLAGS"
+        shift ;;
+
+     "-j")
+        job="$2" ; shift ; shift ;;
+
+     "-full")
+        full='-full'
+        shift ;;
+
+     "-clean")
+        clean=TRUE
+        shift ;;
+
+      "-ext_src")
+        ext_src=$2 ; shift ; shift ;;
+
+#    "-doc_para")
+#        setenv P_P -DCPP_PARA
+#	setenv SECTIONS_PARA "-e s&ENABLED_SECTIONS\ *= &ENABLED_SECTIONS       = CPP_PARA&g"
+#	goto doc
+
+	"-doc")
+#####################################################################################################
+
+# 2) Building the documentation:
+# ------------------------------
+# We assume to start in the ORCHIDEE directory
+#
+#****  Directory structure:
+#
+# ..                       : parent of the start dir.
+#   -- ORCHIDEE            : ($MODELPATH), start directory
+#       - src_sechiba
+#       - src_stomate
+#       + DOC
+#       + webdoc
+#   -- IOIPSL
+#       - src
+#   ++ modeles_doc         : ($SRCPATH), source files for the documentation, emptied at start, temporary
+#
+#****  gawk scripts called :
+#
+# codeinc.awk              : encaspulates code parts in Doxygen documentation
+# codedox.awk              : transforms almost all comments in Doxygen comments for documentation
+# codealgo.awk             : emphasizes main algorithm description of each routine in their Doxygen documentation
+#
+#****
+        unalias cd
+
+	export REV=`svn info | grep vision | sed -e 's&.*vision.*: \([0-9]*\)&\1&' | head -n 1`
+	export TAG=`svn info | grep URL | sed -e 's&.*URL.*: svn://forge.ipsl.jussieu.fr/orchidee/\(.*\)&\1&' | head -n 1 | xargs dirname`
+       	cd ..
+
+	\rm -rf modeles_doc
+	export MODELPATH=${PWD}
+	\mkdir modeles_doc
+	export SRCPATH=${MODELPATH}/modeles_doc
+
+	find IOIPSL/src \( -not -path '*.svn*' \
+			-a \( -name '*.f90' -o -name "*.F90" -o -name "*.h" \) \) \
+		    -exec bash -c 'mkdir -p '${SRCPATH}'/$( dirname {} ); cp -p {} '${SRCPATH}'/$( dirname {} )' \;
+
+	find ORCHIDEE \( -not -path '*.svn*' \
+			-a \( -name '*.f90' -o -name "*.F90" -o -name "*.h" \) \) \
+		    -exec bash -c 'mkdir -p '${SRCPATH}'/$( dirname {} ); cp -p {} '${SRCPATH}'/$( dirname {} )' \;
+	cd ${SRCPATH}
+	# Use standard preprocessor to suppress all preproc directives
+	\find . -name "*.f90" -exec cpp -P -C -traditional -x assembler-with-cpp ${P_P} '{}' '{}'_ \;
+	\find . -name "*.f90" -print -exec mv -f '{}'_ '{}' \;
+
+	# use codeinc script to encaspulate code parts in Doxygen documentation
+	\find . -name "*.f90" -exec gawk -f ${MODELPATH}/ORCHIDEE/DOC/TOOLS/codeinc.awk '{}' \; > /dev/null
+	\find . -name "*.f90" -print -exec mv -f '{}'_preproc_codeinc '{}' \;
+	# use codedox script to transform almost all comments in Doxygen comments for documentation (use with care !)
+	\find . -name "*.f90" -exec gawk -f ${MODELPATH}/ORCHIDEE/DOC/TOOLS/codedox.awk '{}' \; > /dev/null
+	\find . -name "*.f90" -print -exec mv -f '{}'_preproc_codedox '{}' \;
+
+	# use codealgo script to emphasize main algorithm description of each routine in their Doxygen documentation
+	\find . -name "*.f90" -exec gawk -f ${MODELPATH}/ORCHIDEE/DOC/TOOLS/codealgo.awk '{}' \; > /dev/null
+	\find . -name "*.f90" -print -exec mv -f '{}'_preproc_codealgo '{}' \;
+        cd ../ORCHIDEE
+	\rm -f ${MODELPATH}/ORCHIDEE/Doxyfile_ORCHIDEE
+	sed -e 's&MYPATH&'${MODELPATH}'&g' -e 's&SRCPATH&'${SRCPATH}'&g' \
+            -e 's&MYTAG&'${TAG}'&' -e 's&MYREV&'${REV}'&' ${SECTIONS_PARA} \
+            ${MODELPATH}/ORCHIDEE/Doxyfile_ORCHIDEE.init > ${MODELPATH}/ORCHIDEE/Doxyfile_ORCHIDEE
+	\rm -f ${MODELPATH}/ORCHIDEE/DOC/header.tex
+	sed -e "s&MYTAG&${TAG}&" -e "s&MYREV&${REV}&" \
+            ${MODELPATH}/ORCHIDEE/DOC/header.tex.init > ${MODELPATH}/ORCHIDEE/DOC/header.tex
+	ln -s /home/orchidee01/maignan/ORCHIDEE/DOC/IMAGES ${MODELPATH}/ORCHIDEE/DOC/IMAGES
+	gmake doc
+	gmake bib
+	gmake toc
+	\rm -rf ${MODELPATH}/ORCHIDEE/webdoc
+	\mv ${MODELPATH}/ORCHIDEE/docs/html ${MODELPATH}/ORCHIDEE/webdoc
+	gmake index
+	gmake toc
+	\rm -rf ${SRCPATH}
+	cp ${MODELPATH}/ORCHIDEE/docs/latex/refman.pdf ${MODELPATH}/ORCHIDEE/documentation.pdf
+	exit
+        shift ;;
+
+
+     "-rmdoc")
+	\rm -rf docs
+        shift ;;
+
+     "-doc_tree") 
+        cd ..
+	find ORCHIDEE \( -not -path '*.svn*' \
+			-a \( -name '*.f90' -o -name "*.F90" -o -name "*.h" \) \) \
+		    -exec bash -c 'mkdir -p ORCHIDEE/DOC/$( dirname {} )/$( echo $( basename {} ) | sed -e "s/\..*//" )' \;
+	cd ORCHIDEE
+        shift ;;
+
+    *)
+        echo "unknown option "$1" , exiting..."
+        exit 
+   esac
+done
+
+#####################################################################################################
+# 0) Clean directory from files produced during previous compilation
+# --------------------------------------
+if [[ "$clean" == "TRUE" ]] ; then
+    rm -fr .config
+    rm -fr lib
+    rm -fr bin
+    rm -fr tmp_src
+    rm -f ../../lib/intersurf.mod
+    rm -f ../../lib/chemistry.mod
+    rm -f ../../lib/liborglob.a 
+    rm -f ../../lib/libparallel.a 
+    rm -f ../../lib/libsechiba.a 
+    rm -f ../../lib/libstomate.a 
+    rm -f ../../lib/libparameters.a 
+    rm -f ../../lib/liborchidee_ol.a
+    rm -f ../../lib/liborchidee.a
+
+    exit
+fi
+
+# 1) Compilation du code direct avec fcm
+# --------------------------------------
+# Add fcm in environement path
+export PATH=${fcm_path}:${PATH}
+
+#define architecture files
+if [[ "$is_arch_opt" == "TRUE" ]] ; then
+  if [[ -e arch/arch-${arch}.fcm ]] ; then
+    rm -f arch.fcm
+    ln -s arch/arch-${arch}.fcm arch.fcm
+  else
+    echo "architecture file : << arch/arch-${arch}.fcm >> is missing, exiting...."
+    exit
+  fi
+  
+  if [[ -e arch/arch-${arch}.path ]] ; then
+    rm -f arch.path
+    ln -s arch/arch-${arch}.path arch.path
+  else
+    echo "architecture file : << arch/arch-${arch}.path >> is missing, exiting...."
+    exit
+  fi
+else
+  echo "Warning : architecture not specified, taking default file <<arch.fcm>> and <<arch.path>>" 
+  if [[ ! -e arch.fcm ]] ; then
+    echo "architecture file : << arch.fcm >> is missing, exiting...."
+    exit
+  fi
+
+  if [[ ! -e arch.fcm ]] ; then
+    echo "architecture file : << arch.path >> is missing, exiting...."
+    exit
+  fi
+fi
+  
+# set compiler flags
+FFLAGS="%BASE_FFLAGS"
+LD_FFLAGS="%BASE_LD"
+CPP_KEY="%FPP_DEF"
+
+# set compiler flags for optimisation
+FFLAGS=${FFLAGS}" "$compile_flags
+LD_FFLAGS=${LD_FFLAGS}" "$compile_flags
+
+# set compiler flags for parallelism
+echo "parallel_mode = "${parallel_mode}
+
+if [[ "$parallel_mode" == "mpi" ]] || [[ "$parallel_mode" == "MPI" ]] ; then 
+    FFLAGS="${FFLAGS} %MPI_FFLAGS"
+    LD_FFLAGS="%MPI_LD ${LD_FFLAGS}"
+    CPP_KEY="CPP_PARA ${CPP_KEY}"
+elif [[ "$parallel_mode" == "omp" ]] || [[ "$parallel_mode" == "OMP" ]] ; then
+    FFLAGS="${FFLAGS} %OMP_FFLAGS"
+    LD_FFLAGS="%OMP_LD ${LD_FFLAGS}"
+    CPP_KEY="CPP_OMP CPP_PARA ${CPP_KEY}"
+elif [[ "$parallel_mode" == "mpi_omp" ]] || [[ "$parallel_mode" == "MPI_OMP" ]] ; then
+    FFLAGS="${FFLAGS} %MPI_FFLAGS %OMP_FFLAGS"
+    LD_FFLAGS="%MPI_LD %OMP_LD ${LD_FFLAGS}"
+    CPP_KEY="CPP_OMP CPP_PARA ${CPP_KEY}"
+elif [[ "$parallel_mode" == "none" ]] || [[ "$parallel_mode" == "NONE" ]] || [[ "$parallel_mode" == "seq" ]] ; then
+    echo "Compiling for sequential mode"
+else
+    echo "This option for parallel_mode is not implemeted. Choose between mpi, omp, mpi_omp and none."
+    exit
+fi
+
+
+if [[ "$xios1" == "TRUE" ]] ; then
+    CPP_KEY="XIOS ${CPP_KEY}"
+elif [[ "$xios2" == "TRUE" ]] ; then
+    CPP_KEY="XIOS XIOS2 ${CPP_KEY}"
+fi
+
+# set target
+TARGET=liborchidee.a
+if [[ "$is_driver_opt" == "TRUE" ]] ; then
+    TARGET="liborchidee_ol.a dim2_driver.exe teststomate.exe forcesoil.exe"
+fi
+
+source ./arch.path
+
+# build config file
+config_fcm="config.fcm"
+rm -f $config_fcm
+touch $config_fcm
+
+echo "%ARCH          $arch"                             >> $config_fcm 
+echo "%FFLAGS        $FFLAGS"                           >> $config_fcm 
+echo "%CPP_KEY       $CPP_KEY"                          >> $config_fcm
+echo "%EXEC          $TARGET"                           >> $config_fcm
+echo "%LD_FFLAGS     $LD_FFLAGS"                        >> $config_fcm
+if [[ "$xios1" == "TRUE" ]] || [[ "$xios2" == "TRUE" ]] ; then
+   echo "%INCDIR        -I$NETCDF_INCDIR -I$IOIPSL_INCDIR -I$XIOS_INCDIR" >> $config_fcm
+   echo "%LIBDIR        -L$NETCDF_LIBDIR -L$IOIPSL_LIBDIR -L$XIOS_LIBDIR" >> $config_fcm
+else
+   echo "%INCDIR        -I$NETCDF_INCDIR -I$IOIPSL_INCDIR" >> $config_fcm
+   echo "%LIBDIR        -L$NETCDF_LIBDIR -L$IOIPSL_LIBDIR" >> $config_fcm
+fi
+echo "%EXT_SRC       $ext_src"                          >> $config_fcm
+
+
+# Delete interface module from modipsl/lib directory
+rm -f ../../lib/intersurf.mod
+rm -f ../../lib/chemistry.mod
+
+# Check if compiling is locked
+if [ -f .config/fcm.bld.lock ] ; then
+    echo "WARNING : build lock file exists"
+    echo "This means that either someone else is compiling this directory right now "
+    echo "or the previous compiling was interrupt abnormally."
+    echo ""
+    echo "Do you whant to remove this file and start compiling? [answer yes/no]"  
+    read answer
+    if [ $answer = "yes" ] || [ $answer = "y" ] ; then
+	rm -f .config/fcm.bld.lock
+    else
+	echo "Exit now!!!"
+	exit 1
+    fi
+fi
+
+# Do the compiling
+fcm build -j $job $full
+err=$?
+if [ $err != 0 ] ; then 
+  # ERROR IN COMPILING
+  echo ERROR IN COMPILING ORCHIDEE : $err 
+  exit 1
+fi
+
+# Copy into modipsl/lib directory libraries and interface module needed by LMDZ
+cp lib/lib*a ../../lib/.
+cp lib/intersurf.mod ../../lib/.
+cp lib/chemistry.mod ../../lib/.
+
+# Copy executables to modipsl/bin directory
+if [[ "$is_driver_opt" == "TRUE" ]] ; then
+    cp bin/dim2_driver.exe ../../bin/orchidee_ol
+    cp bin/teststomate.exe ../../bin/teststomate
+    cp bin/forcesoil.exe ../../bin/forcesoil
+fi
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/orchidee.default
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/orchidee.default	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/orchidee.default	(revision 5166)
@@ -0,0 +1,1685 @@
+#
+#
+#  WARNING !!! 
+#  DO NOT MODIFY THIS FILE.
+#  THIS FILE IS ONLY PROVIDING INFORMATION ABOUT DEFAULT PARAMETER SETTINGS IN ORCHIDEE. 
+#
+#*******************************************************************************************
+#                    Namelist for ORCHIDEE 
+#*******************************************************************************************
+#
+#  For more details, see : http://forge.ipsl.jussieu.fr/orchidee/wiki/Documentation/OrchideeParameters 
+#
+#  Note : [m] : meters; [K] : Kelvin degrees; [C] : Celsius degrees
+#
+
+#*******************************************************************************************
+#          ORCHIDEE driver parameters (read in Off-line mode only) 
+#*******************************************************************************************
+
+# FORCING_FILE ([FILE] ) :  Name of file containing the forcing data 	{[-]}
+FORCING_FILE =  forcing_file.nc 
+
+# DT_SECHIBA ([seconds]) :  Time-step of the SECHIBA component 	{NOT(WEATHERGEN)}
+DT_SECHIBA =  1800. 
+
+# RESTART_FILEIN ([FILE]) :  Name of restart to READ for initial conditions 	{[-]}
+RESTART_FILEIN =  NONE 
+
+# RESTART_FILEOUT ([FILE]) :  Name of restart files to be created by the driver 	{[-]}
+RESTART_FILEOUT =  driver_rest_out.nc 
+
+# DRIVER_reset_time ([FLAG]) :  Overwrite time values from the driver restart file 	{[-]}
+DRIVER_reset_time =  n 
+
+# TIME_SKIP ([seconds, days, months, years]) :  Time in the forcing file at which the model is started. 	{[-]}
+TIME_SKIP =  0 
+
+# TIME_LENGTH ([seconds, days, months, years]) :  Length of the integration in time. 	{[-]}
+TIME_LENGTH =  Full length of the forcing file  
+
+# RELAXATION ([FLAG]) :  method of forcing 	{[-]}
+RELAXATION =  n 
+
+# RELAX_A ([days?]) :  Time constant of the relaxation layer 	{RELAXATION}
+RELAX_A =  1.0 
+
+# NO_INTER  ([FLAG]) :  No interpolation IF split is larger than 1 	{[-]}
+NO_INTER  =  y 
+
+# INTER_LIN ([FLAG]) :  Interpolation IF split is larger than 1 	{[-]}
+INTER_LIN =  n 
+
+# SPRED_PREC ([-]) :  Spread the precipitation. 	{[-]}
+SPRED_PREC =  Half of the forcing time step or uniform, depending on dt_force and dt_sechiba 
+
+# NETRAD_CONS ([FLAG]) :  Conserve net radiation in the forcing 	{INTER_LIN}
+NETRAD_CONS =  y 
+
+# ATM_CO2 ([ppm]) :  Value for atm CO2 	{[-]}
+ATM_CO2 =  350. 
+
+# ALLOW_WEATHERGEN ([FLAG]) :  Allow weather generator to create data 	{[-]}
+ALLOW_WEATHERGEN =  n 
+
+# DT_WEATHGEN ([seconds]) :  Calling frequency of weather generator 	{ALLOW_WEATHERGEN}
+DT_WEATHGEN =  1800. 
+
+# LIMIT_WEST ([Degrees] ) :  Western limit of region 	{[-]}
+LIMIT_WEST =  -180. 
+
+# LIMIT_EAST ([Degrees] ) :  Eastern limit of region 	{[-]}
+LIMIT_EAST =  180. 
+
+# LIMIT_NORTH ([Degrees]) :  Northern limit of region 	{[-]}
+LIMIT_NORTH =  90. 
+
+# LIMIT_SOUTH ([Degrees]) :  Southern limit of region 	{[-]}
+LIMIT_SOUTH =  -90. 
+
+# MERID_RES ([Degrees]) :  North-South Resolution 	{ALLOW_WEATHERGEN}
+MERID_RES =  2. 
+
+# ZONAL_RES ([Degrees] ) :  East-West Resolution 	{ALLOW_WEATHERGEN}
+ZONAL_RES =  2. 
+
+# HEIGHT_LEV1 ([m]) :  Height at which T and Q are given 	{offline mode}
+HEIGHT_LEV1 =  2.0 
+
+# HEIGHT_LEVW ([m]) :  Height at which the wind is given 	{offline mode}
+HEIGHT_LEVW =  10.0 
+
+# NBUFF (-) :  Number of time steps of data to buffer between each reading of the forcing file 	{OFF_LINE}
+NBUFF =  1 
+
+# IPPREC ([-] ) :  Use prescribed values 	{ALLOW_WEATHERGEN}
+IPPREC =  0 
+
+# WEATHGEN_PRECIP_EXACT ([FLAG]) :  Exact monthly precipitation 	{ALLOW_WEATHERGEN}
+WEATHGEN_PRECIP_EXACT =  n 
+
+# DUMP_WEATHER ([FLAG]) :  Write weather from generator into a forcing file 	{ALLOW_WEATHERGEN  }
+DUMP_WEATHER =  n 
+
+# DUMP_WEATHER_FILE ([FILE]) :  Name of the file that contains the weather from generator 	{DUMP_WEATHER}
+DUMP_WEATHER_FILE =  weather_dump.nc 
+
+# DUMP_WEATHER_GATHERED ([FLAG]) :  Dump weather data on gathered grid 	{DUMP_WEATHER}
+DUMP_WEATHER_GATHERED =  y 
+
+# HEIGHT_LEV1_DUMP ([m]) :   	{DUMP_WEATHER}
+HEIGHT_LEV1_DUMP =  10. 
+
+#*******************************************************************************************
+#          ORCHIDEE parameters  
+#*******************************************************************************************
+
+# SOILTYPE_CLASSIF ([-]) :  Type of classification used for the map of soil types  	{!IMPOSE_VEG}
+SOILTYPE_CLASSIF =  zobler 
+
+# RIVER_ROUTING ([FLAG]) :  Decides if we route the water or not 	{OK_SECHIBA}
+RIVER_ROUTING =  n 
+
+# HYDROL_CWRR ([FLAG]) :  Allows to switch on the multilayer hydrology of CWRR 	{OK_SECHIBA}
+HYDROL_CWRR =  n 
+
+# DO_IRRIGATION ([FLAG]) :  Should we compute an irrigation flux  	{RIVER_ROUTING }
+DO_IRRIGATION =  n 
+
+# DO_FLOODPLAINS ([FLAG]  ) :  Should we include floodplains  	{RIVER_ROUTING }
+DO_FLOODPLAINS =  n 
+
+# CHECK_WATERBAL ([FLAG]  ) :  Should we check the global water balance  	{OK_SECHIBA}
+CHECK_WATERBAL =  n 
+
+# OK_EXPLICITSNOW ([FLAG]) :  Activate explict snow scheme 	{OK_SECHIBA}
+OK_EXPLICITSNOW =  FALSE 
+
+# STOMATE_OK_CO2 ([FLAG]) :  Activate CO2? 	{OK_SECHIBA }
+STOMATE_OK_CO2 =  n 
+
+# STOMATE_OK_STOMATE ([FLAG]) :  Activate STOMATE? 	{OK_SECHIBA and OK_CO2}
+STOMATE_OK_STOMATE =  n 
+
+# STOMATE_OK_DGVM ([FLAG]) :  Activate DGVM? 	{OK_STOMATE}
+STOMATE_OK_DGVM =  n 
+
+# CHEMISTRY_BVOC ([FLAG]) :  Activate calculations for BVOC 	{OK_SECHIBA}
+CHEMISTRY_BVOC =  n 
+
+# CHEMISTRY_LEAFAGE ([FLAG]) :  Activate LEAFAGE? 	{CHEMISTRY_BVOC}
+CHEMISTRY_LEAFAGE =  n 
+
+# CANOPY_EXTINCTION  ([FLAG]) :  Use canopy radiative transfer model? 	{CHEMISTRY_BVOC }
+CANOPY_EXTINCTION  =  n 
+
+# CANOPY_MULTILAYER ([FLAG]) :  Use canopy radiative transfer model with multi-layers 	{CANOPY_EXTINCTION }
+CANOPY_MULTILAYER =  n 
+
+# NOx_RAIN_PULSE ([FLAG]) :  Calculate NOx emissions with pulse? 	{CHEMISTRY_BVOC }
+NOx_RAIN_PULSE =  n 
+
+# NOx_BBG_FERTIL ([FLAG]) :  Calculate NOx emissions with bbg fertilizing effect? 	{CHEMISTRY_BVOC }
+NOx_BBG_FERTIL =  n 
+
+# NOx_FERTILIZERS_USE ([FLAG] ) :  Calculate NOx emissions with fertilizers use? 	{CHEMISTRY_BVOC }
+NOx_FERTILIZERS_USE =  n 
+
+# NVM ([-]) :  number of PFTs   	{OK_SECHIBA or OK_STOMATE}
+NVM =  13 
+
+# IMPOSE_PARAM ([FLAG]) :  Do you impose the values of the parameters? 	{OK_SECHIBA or OK_STOMATE}
+IMPOSE_PARAM =  y 
+
+# THERMOSOIL_NBLEV (m) :  Number of soil level 	{HDYROL_CWRR=FALSE}
+THERMOSOIL_NBLEV =  Number of soil level 
+
+# DEPTH_MAX_T (m) :  Maximum depth of the soil thermodynamics 	{}
+DEPTH_MAX_T =  10.0 
+
+# DEPTH_MAX_H (m) :  Maximum depth of soil moisture 	{}
+DEPTH_MAX_H =  2.0 or 4.0 depending on hydrol_cwrr 
+
+# DEPTH_TOPTHICK (m) :  Thickness of upper most Layer  	{}
+DEPTH_TOPTHICK =  9.77517107e-04 
+
+# DEPTH_CSTTHICK (m) :  Depth at which constant layer thickness start 	{}
+DEPTH_CSTTHICK =  DEPTH_MAX_H  
+
+# REFINEBOTTOM (-) :  Depth at which the hydrology layers will be refined towards the bottom. 	{}
+REFINEBOTTOM =  .FALSE. 
+
+# DEPTH_GEOM (m) :  Depth at which we resume geometrical increases for temperature 	{}
+DEPTH_GEOM =  DEPTH_MAX_H  
+
+# RATIO_GEOM_BELOW (-) :  Ratio of the geometrical series defining the thickness below DEPTH_GEOM 	{}
+RATIO_GEOM_BELOW =  2 
+
+# ALMA_OUTPUT ([FLAG]) :  Should the output follow the ALMA convention 	{OK_SECHIBA}
+ALMA_OUTPUT =  n 
+
+# OUTPUT_FILE ([FILE]) :  Name of file in which the output is going to be written 	{OK_SECHIBA}
+OUTPUT_FILE =  sechiba_history.nc 
+
+# WRITE_STEP ([seconds]) :  Frequency in seconds for sechiba_history.nc file with IOIPSL 	{OK_SECHIBA, NOT XIOS_ORCHIDEE_OK}
+WRITE_STEP =  86400. 
+
+# SECHIBA_HISTLEVEL ([-]) :  SECHIBA history output level (0..10) 	{OK_SECHIBA and HF}
+SECHIBA_HISTLEVEL =  5 
+
+# SECHIBA_HISTFILE2 ([FLAG]) :  Flag to switch on histfile 2 for SECHIBA (hi-frequency ?) 	{OK_SECHIBA}
+SECHIBA_HISTFILE2 =  n 
+
+# WRITE_STEP2 ([seconds]) :  Frequency in seconds at which to WRITE output 	{SECHIBA_HISTFILE2}
+WRITE_STEP2 =  1800.0 
+
+# SECHIBA_OUTPUT_FILE2 ([FILE]) :  Name of file in which the output number 2 is going to be written 	{SECHIBA_HISTFILE2}
+SECHIBA_OUTPUT_FILE2 =  sechiba_out_2.nc 
+
+# SECHIBA_HISTLEVEL2 ([-] ) :  SECHIBA history 2 output level (0..10) 	{SECHIBA_HISTFILE2}
+SECHIBA_HISTLEVEL2 =  1 
+
+# STOMATE_OUTPUT_FILE ([FILE]) :  Name of file in which STOMATE's output is going to be written 	{OK_STOMATE}
+STOMATE_OUTPUT_FILE =  stomate_history.nc 
+
+# STOMATE_HIST_DT ([days]) :  STOMATE history time step 	{OK_STOMATE}
+STOMATE_HIST_DT =  10. 
+
+# STOMATE_IPCC_OUTPUT_FILE ([FILE]) :  Name of file in which STOMATE's output is going to be written 	{OK_STOMATE}
+STOMATE_IPCC_OUTPUT_FILE =  stomate_ipcc_history.nc 
+
+# STOMATE_IPCC_HIST_DT ([days]) :  STOMATE IPCC history time step 	{OK_STOMATE}
+STOMATE_IPCC_HIST_DT =  0. 
+
+# OK_HISTSYNC ([FLAG]) :  Syncronize and write IOIPSL output files at each time step 	{}
+OK_HISTSYNC =  FALSE 
+
+# STOMATE_HISTLEVEL ([-]) :  STOMATE history output level (0..10) 	{OK_STOMATE}
+STOMATE_HISTLEVEL =  10 
+
+# SECHIBA_restart_in ([FILE]) :  Name of restart to READ for initial conditions 	{OK_SECHIBA }
+SECHIBA_restart_in =  NONE 
+
+# SECHIBA_rest_out ([FILE]) :  Name of restart files to be created by SECHIBA 	{OK_SECHIBA}
+SECHIBA_rest_out =  sechiba_rest_out.nc 
+
+# STOMATE_RESTART_FILEIN ([FILE]) :  Name of restart to READ for initial conditions of STOMATE 	{STOMATE_OK_STOMATE}
+STOMATE_RESTART_FILEIN =  NONE 
+
+# STOMATE_RESTART_FILEOUT ([FILE]) :  Name of restart files to be created by STOMATE 	{STOMATE_OK_STOMATE}
+STOMATE_RESTART_FILEOUT =  stomate_rest_out.nc 
+
+# FORCE_CO2_VEG ([FLAG]) :  Flag to force the value of atmospheric CO2 for vegetation. 	{Only in coupled mode}
+FORCE_CO2_VEG =  FALSE 
+
+# ATM_CO2 ([ppm]) :  Value for atm CO2  	{FORCE_CO2_VEG (only in coupled mode)}
+ATM_CO2 =  350. 
+
+# ECCENTRICITY ([-]) :  Use prescribed values 	{ALLOW_WEATHERGEN}
+ECCENTRICITY =  0.016724 
+
+# PERIHELIE ([-]) :  Use prescribed values 	{ALLOW_WEATHERGEN}
+PERIHELIE =  102.04 
+
+# OBLIQUITY ([Degrees]) :  Use prescribed values 	{ALLOW_WEATHERGEN}
+OBLIQUITY =  23.446 
+
+# PFT_TO_MTC ([-]) :  correspondance array linking a PFT to MTC 	{OK_SECHIBA or OK_STOMATE}
+PFT_TO_MTC =  1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 
+
+# PFT_NAME ([-]) :  Name of a PFT 	{OK_SECHIBA or OK_STOMATE}
+PFT_NAME =  bare ground, tropical broad-leaved evergreen, tropical broad-leaved raingreen, temperate needleleaf evergreen, temperate broad-leaved evergreen, temperate broad-leaved summergreen,  boreal needleleaf evergreen, boreal broad-leaved summergreen, boreal needleleaf summergreen,  C3 grass, C4 grass, C3 agriculture, C4 agriculture  
+
+# LEAF_TAB ([-] ) :  leaf type : 1 	{OK_STOMATE}
+LEAF_TAB =  4, 1, 1, 2, 1, 1, 2, 1, 2, 3, 3, 3, 3  
+
+# PHENO_MODEL ([-] ) :  which phenology model is used? (tabulated)  	{OK_STOMATE}
+PHENO_MODEL =  none, none, moi, none, none, ncdgdd, none, ncdgdd, ngd, moigdd, moigdd, moigdd, moigdd 
+
+# SECHIBA_LAI ([m^2/m^2]) :  laimax for maximum lai(see also type of lai interpolation) 	{OK_SECHIBA or IMPOSE_VEG}
+SECHIBA_LAI =  0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2. 
+
+# LLAIMIN ([m^2/m^2]) :  laimin for minimum lai(see also type of lai interpolation) 	{OK_SECHIBA or IMPOSE_VEG}
+LLAIMIN =  0., 8., 0., 4., 4.5, 0., 4., 0., 0., 0., 0., 0., 0. 
+
+# SLOWPROC_HEIGHT ([m] ) :  prescribed height of vegetation  	{OK_SECHIBA}
+SLOWPROC_HEIGHT =  0., 30., 30., 20., 20., 20., 15., 15., 15., .5, .6, 1., 1. 
+
+# TYPE_OF_LAI ([-]) :  Type of behaviour of the LAI evolution algorithm  	{OK_SECHIBA}
+TYPE_OF_LAI =  inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter 
+
+# NATURAL ([BOOLEAN]) :  natural?  	{OK_SECHIBA, OK_STOMATE}
+NATURAL =  y, y, y, y, y, y, y, y, y, y, y, n, n  
+
+# IS_C4 ([BOOLEAN]) :  flag for C4 vegetation types 	{OK_SECHIBA or OK_STOMATE}
+IS_C4 =  n, n, n, n, n, n, n, n, n, n, n, y, n, y 
+
+# VCMAX_FIX ([micromol/m^2/s] ) :  values used for vcmax when STOMATE is not activated 	{OK_SECHIBA and NOT(OK_STOMATE)}
+VCMAX_FIX =  0., 40., 50., 30., 35., 40.,30., 40., 35., 60., 60., 70., 70. 
+
+# DOWNREG_CO2 ([-]) :  coefficient for CO2 downregulation (unitless) 	{OK_CO2}
+DOWNREG_CO2 =  0., 0.38, 0.38, 0.28, 0.28, 0.28, 0.22, 0.22, 0.22, 0.26, 0.26, 0.26, 0.26 
+
+# E_KmC ([J mol-1]) :  Energy of activation for KmC 	{OK_CO2}
+E_KmC =  -9999.,  79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430. 
+
+# E_KmO ([J mol-1]) :  Energy of activation for KmO 	{OK_CO2}
+E_KmO =  -9999., 36380.,  36380.,  36380.,  36380.,  36380., 36380., 36380., 36380., 36380., 36380., 36380., 36380. 
+
+# E_gamma_star ([J mol-1]) :  Energy of activation for gamma_star 	{OK_CO2}
+E_gamma_star =  -9999., 37830.,  37830.,  37830.,  37830.,  37830., 37830., 37830., 37830., 37830., 37830., 37830., 37830. 
+
+# E_Vcmax ([J mol-1]) :  Energy of activation for Vcmax 	{OK_CO2}
+E_Vcmax =  -9999., 71513., 71513., 71513., 71513., 71513., 71513., 71513., 71513., 71513., 67300., 71513., 67300. 
+
+# E_Jmax ([J mol-1]) :  Energy of activation for Jmax 	{OK_CO2}
+E_Jmax =  -9999., 49884., 49884., 49884., 49884., 49884., 49884., 49884., 49884., 49884., 77900., 49884., 77900.  
+
+# aSV ([J K-1 mol-1]) :  a coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax 	{OK_CO2}
+aSV =  -9999., 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 641.64, 668.39, 641.64  
+
+# bSV ([J K-1 mol-1 Â°C-1]) :  b coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax 	{OK_CO2}
+bSV =  -9999., -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, 0., -1.07, 0.  
+
+# TPHOTO_MIN ([-]) :  minimum photosynthesis temperature (deg C) 	{OK_STOMATE}
+TPHOTO_MIN =  -9999.,  -4., -4., -4., -4.,-4.,-4., -4., -4., -4., -4., -4., -4. 
+
+# TPHOTO_MAX ([-]) :  maximum photosynthesis temperature (deg C) 	{OK_STOMATE}
+TPHOTO_MAX =  -9999., 55., 55., 55., 55., 55., 55., 55., 55., 55., 55., 55., 55. 
+
+# aSJ ([J K-1 mol-1]) :  a coefficient of the linear regression (a+bT) defining the Entropy term for Jmax 	{OK_CO2}
+aSJ =  -9999., 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 630., 659.70, 630.  
+
+# bSJ ([J K-1 mol-1 Â°C-1]) :  b coefficient of the linear regression (a+bT) defining the Entropy term for Jmax 	{OK_CO2}
+bSJ =  -9999., -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, 0., -0.75, 0.  
+
+# D_Vcmax ([J mol-1]) :  Energy of deactivation for Vcmax 	{OK_CO2}
+D_Vcmax =  -9999., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 192000., 200000., 192000. 
+
+# D_Jmax ([J mol-1]) :  Energy of deactivation for Jmax 	{OK_CO2}
+D_Jmax =  -9999., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 192000., 200000., 192000. 
+
+# E_Rd ([J mol-1]) :  Energy of activation for Rd 	{OK_CO2}
+E_Rd =  -9999., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390. 
+
+# VCMAX25 ([micromol/m^2/s]) :  Maximum rate of Rubisco activity-limited carboxylation at 25Â°C 	{OK_STOMATE}
+VCMAX25 =  -9999., 65., 65., 35., 45., 55., 35., 45., 35., 70., 70., 70., 70. 
+
+# ARJV ([mu mol e- (mu mol CO2)-1]) :  a coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio  	{OK_STOMATE}
+ARJV =  -9999., 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 1.715, 2.59, 1.715 
+
+# BRJV ([(mu mol e- (mu mol CO2)-1) (Â°C)-1]) :  b coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio  	{OK_STOMATE}
+BRJV =  -9999., -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, 0., -0.035, 0. 
+
+# KmC25 ([ubar]) :  MichaelisâMenten constant of Rubisco for CO2 at 25Â°C 	{OK_CO2}
+KmC25 =  -9999., 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 650., 404.9, 650. 
+
+# KmO25 ([ubar]) :  MichaelisâMenten constant of Rubisco for O2 at 25Â°C 	{OK_CO2}
+KmO25 =  -9999., 278400., 278400., 278400., 278400., 278400., 278400., 278400., 278400., 278400., 450000., 278400., 450000. 
+
+# gamma_star25 ([ubar]) :  Ci-based CO2 compensation point in the absence of Rd at 25Â°C (ubar) 	{OK_CO2}
+gamma_star25 =  -9999., 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75 
+
+# a1 ([-]) :  Empirical factor involved in the calculation of fvpd 	{OK_CO2}
+a1 =  -9999., 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85 
+
+# b1 ([-]) :  Empirical factor involved in the calculation of fvpd 	{OK_CO2}
+b1 =  -9999., 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.20, 0.14, 0.20 
+
+# g0 ([mol mâ2 sâ1 barâ1]) :  Residual stomatal conductance when irradiance approaches zero  	{OK_CO2}
+g0 =  -9999., 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.01875, 0.00625, 0.01875  
+
+# h_protons ([mol mol-1]) :  Number of protons required to produce one ATP 	{OK_CO2}
+h_protons =  -9999., 4., 4., 4., 4., 4., 4., 4., 4., 4., 4., 4., 4.  
+
+# fpsir ([-]) :  Fraction of PSII eâ transport rate partitioned to the C4 cycle 	{OK_CO2}
+fpsir =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0.4, -9999., 0.4  
+
+# fQ ([-]) :  Fraction of electrons at reduced plastoquinone that follow the Q-cycle 	{OK_CO2}
+fQ =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 1., -9999., 1. 
+
+# fpseudo ([-]) :  Fraction of electrons at PSI that follow pseudocyclic transport  	{OK_CO2}
+fpseudo =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0.1, -9999., 0.1 
+
+# kp ([mol mâ2 sâ1 barâ1]) :  Initial carboxylation efficiency of the PEP carboxylase 	{OK_CO2}
+kp =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0.7, -9999., 0.7 
+
+# alpha ([-]) :  Fraction of PSII activity in the bundle sheath 	{OK_CO2}
+alpha =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0.1, -9999., 0.1 
+
+# gbs ([mol mâ2 sâ1 barâ1]) :  Bundle-sheath conductance 	{OK_CO2}
+gbs =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0.003, -9999., 0.003 
+
+# theta ([â]) :  Convexity factor for response of J to irradiance 	{OK_CO2}
+theta =  -9999., 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7 
+
+# alpha_LL ([mol eâ (mol photon)â1]) :  Conversion efficiency of absorbed light into J at strictly limiting light 	{OK_CO2}
+alpha_LL =  -9999., 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372 
+
+# EXT_COEFF ([-]) :  extinction coefficient of the Monsi&Seaki relationship (1953) 	{OK_SECHIBA or OK_STOMATE}
+EXT_COEFF =  .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5 
+
+# HYDROL_HUMCSTE ([m]) :  Root profile 	{OK_SECHIBA}
+HYDROL_HUMCSTE =  humcste_ref2m or humcste_ref4m depending on zmaxh 
+
+# PREF_SOIL_VEG ([-]        ) :  The soil tile number for each vegetation 	{OK_SECHIBA or OK_STOMATE}
+PREF_SOIL_VEG =  1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3 
+
+# RSTRUCT_CONST ([s/m]) :  Structural resistance  	{OK_SECHIBA}
+RSTRUCT_CONST =  0.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0,  2.5,  2.0,  2.0,  2.0 
+
+# KZERO ([kg/m^2/s]) :  A vegetation dependent constant used in the calculation of the surface resistance. 	{OK_SECHIBA}
+KZERO =  0.0, 12.E-5, 12.E-5, 12.e-5, 12.e-5, 25.e-5, 12.e-5,25.e-5, 25.e-5, 30.e-5, 30.e-5, 30.e-5, 30.e-5  
+
+# RVEG_PFT ([-]) :  Artificial parameter to increase or decrease canopy resistance. 	{OK_SECHIBA}
+RVEG_PFT =  1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1. 
+
+# WMAX_VEG ([kg/m^3]) :  Maximum field capacity for each of the vegetations (Temporary): max quantity of water 	{OK_SECHIBA}
+WMAX_VEG =  150., 150., 150., 150., 150., 150., 150.,150., 150., 150., 150., 150., 150. 
+
+# PERCENT_THROUGHFALL_PFT ([%]) :  Percent by PFT of precip that is not intercepted by the canopy. Default value depend on run mode. 	{OK_SECHIBA}
+PERCENT_THROUGHFALL_PFT =  Case offline+CWRR [0. 0. 0....] else [30. 30. 30.....] 
+
+# SNOWA_AGED ([-]) :  Minimum snow albedo value for each vegetation type after aging (dirty old snow) 	{OK_SECHIBA}
+SNOWA_AGED =  0.35, 0., 0., 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.18, 0.18, 0.18, 0.18 
+
+# SNOWA_DEC ([-]) :  Decay rate of snow albedo value for each vegetation type as it will be used in condveg_snow 	{OK_SECHIBA}
+SNOWA_DEC =  0.45, 0.,  0., 0.06, 0.06, 0.11, 0.06, 0.11, 0.11, 0.52,0.52, 0.52, 0.52 
+
+# ALB_LEAF_VIS ([-]) :  leaf albedo of vegetation type, visible albedo 	{OK_SECHIBA}
+ALB_LEAF_VIS =  .00, .04, .06, .06, .06,.06, .06, .06, .06, .10, .10, .10, .10 
+
+# ALB_LEAF_NIR ([-]) :  leaf albedo of vegetation type, near infrared albedo 	{OK_SECHIBA}
+ALB_LEAF_NIR =  .00, .20, .22, .22, .22,.22, .22, .22, .22, .30, .30, .30, .30  
+
+# ISO_ACTIVITY ([-]) :  Biogenic activity for each age class : isoprene 	{CHEMISTRY_BVOC}
+ISO_ACTIVITY =  0.5, 1.5, 1.5, 0.5 
+
+# METHANOL_ACTIVITY ([-]) :  Isoprene emission factor for each age class : methanol 	{CHEMISTRY_BVOC}
+METHANOL_ACTIVITY =  1., 1., 0.5, 0.5 
+
+# EM_FACTOR_ISOPRENE ([ugC/g/h] ) :  Isoprene emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_ISOPRENE =  0., 24., 24., 8., 16., 45., 8., 18., 0.5, 12., 18., 5., 5. 
+
+# EM_FACTOR_MONOTERPENE ([ugC/g/h] ) :  Monoterpene emission factor  	{CHEMISTRY_BVOC }
+EM_FACTOR_MONOTERPENE =  0., 2.0, 2.0, 1.8, 1.4, 1.6, 1.8, 1.4, 1.8, 0.8, 0.8,  0.22, 0.22 
+
+# C_LDF_MONO  ([]) :  Monoterpenes fraction dependancy to light 	{CHEMISTRY_BVOC}
+C_LDF_MONO  =  0.6 
+
+# C_LDF_SESQ  ([]) :  Sesquiterpenes fraction dependancy to light 	{CHEMISTRY_BVOC}
+C_LDF_SESQ  =  0.5 
+
+# C_LDF_METH  ([]) :  Methanol fraction dependancy to light 	{CHEMISTRY_BVOC}
+C_LDF_METH  =  0.8 
+
+# C_LDF_ACET  ([]) :  Acetone fraction dependancy to light 	{CHEMISTRY_BVOC}
+C_LDF_ACET  =  0.2 
+
+# EM_FACTOR_APINENE  ([ugC/g/h] ) :  Alfa pinene  emission factor  	{CHEMISTRY_BVOC }
+EM_FACTOR_APINENE  =  0., 1.35, 1.35, 0.85, 0.95, 0.75, 0.85, 0.60, 1.98, 0.30, 0.30, 0.09, 0.09 
+
+# EM_FACTOR_BPINENE ([ugC/g/h] ) :  Beta pinene  emission factor 	{CHEMISTRY_BVOC }
+EM_FACTOR_BPINENE =  0., 0.30, 0.30, 0.35, 0.25, 0.20, 0.35, 0.12, 0.45, 0.16, 0.12, 0.05, 0.05 
+
+# EM_FACTOR_LIMONENE ([ugC/g/h] ) :  Limonene  emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_LIMONENE =  0., 0.25, 0.25, 0.20, 0.25, 0.14, 0.20, 0.135, 0.11, 0.19, 0.42, 0.03, 0.03 
+
+# EM_FACTOR_MYRCENE ([ugC/g/h] ) :  Myrcene  emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_MYRCENE =  0., 0.20, 0.20, 0.12, 0.11, 0.065, 0.12, 0.036, 0.075, 0.08,  0.085, 0.015, 0.015 
+
+# EM_FACTOR_SABINENE ([ugC/g/h] ) :  Sabinene  emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_SABINENE =  0., 0.20, 0.20, 0.12, 0.17, 0.70, 0.12, 0.50, 0.09, 0.085, 0.075, 0.02, 0.02 
+
+# EM_FACTOR_CAMPHENE  ([ugC/g/h] ) :  Camphene  emission factor  	{CHEMISTRY_BVOC}
+EM_FACTOR_CAMPHENE  =  0., 0.15, 0.15, 0.10, 0.10, 0.01, 0.10, 0.01, 0.07, 0.07, 0.08, 0.01, 0.01 
+
+# EM_FACTOR_3CARENE  ([ugC/g/h] ) :  3-Carene  emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_3CARENE  =  0., 0.13, 0.13, 0.42, 0.02, 0.055, 0.42,0.025, 0.125, 0.085, 0.085, 0.065, 0.065 
+
+# EM_FACTOR_TBOCIMENE ([ugC/g/h] ) :  T-beta-ocimene  emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_TBOCIMENE =  0., 0.25, 0.25, 0.13, 0.09, 0.26, 0.13, 0.20, 0.085, 0.18, 0.18, 0.01, 0.01 
+
+# EM_FACTOR_OTHERMONOT ([ugC/g/h] ) :  Other monoterpenes  emission factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_OTHERMONOT =  0., 0.17, 0.17, 0.11, 0.11, 0.125, 0.11, 0.274, 0.01, 0.15, 0.155, 0.035, 0.035 
+
+# EM_FACTOR_SESQUITERP  ([ugC/g/h] ) :  Sesquiterpenes  emission factor  	{CHEMISTRY_BVOC}
+EM_FACTOR_SESQUITERP  =  0., 0.45, 0.45, 0.13, 0.3, 0.36, 0.15, 0.3, 0.25, 0.6, 0.6, 0.08, 0.08 
+
+# C_BETA_MONO  ([]) :  Monoterpenes temperature dependency coefficient 	{CHEMISTRY_BVOC}
+C_BETA_MONO  =  0.1 
+
+# C_BETA_SESQ  ([]) :  Sesquiterpenes temperature dependency coefficient 	{CHEMISTRY_BVOC}
+C_BETA_SESQ  =  0.17 
+
+# C_BETA_METH  ([]) :  Methanol temperature dependency coefficient 	{CHEMISTRY_BVOC}
+C_BETA_METH  =  0.08 
+
+# C_BETA_ACET  ([]) :  Acetone temperature dependency coefficient 	{CHEMISTRY_BVOC}
+C_BETA_ACET  =  0.1 
+
+# C_BETA_OXYVOC  ([]) :  Other oxygenated BVOC temperature dependency coefficient 	{CHEMISTRY_BVOC}
+C_BETA_OXYVOC  =  0.13 
+
+# EM_FACTOR_ORVOC ([ugC/g/h]  ) :  ORVOC emissions factor  	{CHEMISTRY_BVOC }
+EM_FACTOR_ORVOC =  0., 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5 
+
+# EM_FACTOR_OVOC ([ugC/g/h]        ) :  OVOC emissions factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_OVOC =  0., 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5 
+
+# EM_FACTOR_MBO ([ugC/g/h]  ) :  MBO emissions factor  	{CHEMISTRY_BVOC }
+EM_FACTOR_MBO =  0., 2.e-5, 2.e-5, 1.4, 2.e-5, 2.e-5, 0.14, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5 
+
+# EM_FACTOR_METHANOL ([ugC/g/h]  ) :  Methanol emissions factor  	{CHEMISTRY_BVOC }
+EM_FACTOR_METHANOL =  0., 0.8, 0.8, 1.8, 0.9, 1.9, 1.8, 1.8, 1.8, 0.7, 0.9, 2., 2. 
+
+# EM_FACTOR_ACETONE ([ugC/g/h]     ) :  Acetone emissions factor 	{CHEMISTRY_BVOC }
+EM_FACTOR_ACETONE =  0., 0.25, 0.25, 0.3, 0.2, 0.33, 0.3, 0.25, 0.25, 0.2, 0.2, 0.08, 0.08 
+
+# EM_FACTOR_ACETAL ([ugC/g/h]  ) :  Acetaldehyde emissions factor  	{CHEMISTRY_BVOC}
+EM_FACTOR_ACETAL =  0., 0.2, 0.2, 0.2, 0.2, 0.25, 0.25, 0.16, 0.16, 0.12, 0.12, 0.035, 0.02 
+
+# EM_FACTOR_FORMAL ([ugC/g/h]  ) :  Formaldehyde emissions factor 	{CHEMISTRY_BVOC }
+EM_FACTOR_FORMAL =  0., 0.04, 0.04, 0.08, 0.04, 0.04, 0.04, 0.04, 0.04, 0.025, 0.025, 0.013, 0.013 
+
+# EM_FACTOR_ACETIC ([ugC/g/h]  ) :  Acetic Acid emissions factor 	{CHEMISTRY_BVOC }
+EM_FACTOR_ACETIC =  0., 0.025, 0.025,0.025,0.022,0.08,0.025,0.022,0.013,0.012,0.012,0.008,0.008 
+
+# EM_FACTOR_FORMIC ([ugC/g/h]  ) :  Formic Acid emissions factor 	{CHEMISTRY_BVOC}
+EM_FACTOR_FORMIC =  0., 0.015, 0.015, 0.02, 0.02, 0.025, 0.025, 0.015, 0.015,0.010,0.010,0.008,0.008 
+
+# EM_FACTOR_NO_WET ([ngN/m^2/s]) :  NOx emissions factor wet soil emissions and exponential dependancy factor  	{CHEMISTRY_BVOC}
+EM_FACTOR_NO_WET =  0., 2.6, 0.06, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.36, 0.36, 0.36, 0.36 
+
+# EM_FACTOR_NO_DRY ([ngN/m^2/s] ) :  NOx emissions factor dry soil emissions and exponential dependancy factor  	{CHEMISTRY_BVOC}
+EM_FACTOR_NO_DRY =  0., 8.60, 0.40, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22, 2.65, 2.65, 2.65, 2.65 
+
+# LARCH ([-]  ) :  Larcher 1991 SAI/LAI ratio 	{CHEMISTRY_BVOC }
+LARCH =  0., 0.015, 0.015, 0.003, 0.005, 0.005, 0.003, 0.005, 0.003, 0.005, 0.005, 0.008, 0.008 
+
+# SLA ([m^2/gC]) :  specif leaf area  	{OK_STOMATE}
+SLA =  1.5E-2, 1.53E-2, 2.6E-2, 9.26E-3, 2E-2, 2.6E-2, 9.26E-3, 2.6E-2, 1.9E-2, 2.6E-2, 2.6E-2, 2.6E-2, 2.6E-2 
+
+# AVAILABILITY_FACT  ([-]   ) :  Calculate dynamic mortality in lpj_gap, pft dependent parameter 	{OK_STOMATE }
+AVAILABILITY_FACT  =  -9999., 0.14, 0.14, 0.10, 0.10, 0.10, 0.05, 0.05, 0.05, -9999., -9999., -9999., -9999.  
+
+# R0  ([-]    ) :  Standard root allocation  	{OK_STOMATE }
+R0  =  -9999., .30, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30 
+
+# S0  ([-]    ) :  Standard sapwood allocation  	{OK_STOMATE }
+S0  =  -9999., .25, .25, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30 
+
+# FRAC_GROWTHRESP ([-]) :  fraction of GPP which is lost as growth respiration 	{OK_STOMATE}
+FRAC_GROWTHRESP =  -9999., .28, .28, .28, .28, .28, .28, .28, .28, .28, .28, .28, .28  
+
+# MAINT_RESP_SLOPE_C ([-]) :  slope of maintenance respiration coefficient (1/K), constant c of aT^2+bT+c , tabulated 	{OK_STOMATE}
+MAINT_RESP_SLOPE_C =  -9999., .20, .20, .16, .16, .16, .16, .16, .16, .16, .12, .16, .12  
+
+# MAINT_RESP_SLOPE_B ([-]) :  slope of maintenance respiration coefficient (1/K), constant b of aT^2+bT+c , tabulated 	{OK_STOMATE}
+MAINT_RESP_SLOPE_B =  -9999., .0, .0, .0, .0, .0, .0, .0, .0, -.00133, .0, -.00133, .0  
+
+# MAINT_RESP_SLOPE_A ([-]) :  slope of maintenance respiration coefficient (1/K), constant a of aT^2+bT+c , tabulated 	{OK_STOMATE}
+MAINT_RESP_SLOPE_A =  -9999., .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0     
+
+# CM_ZERO_LEAF ([g/g/day]) :  maintenance respiration coefficient at 0 deg C, for leaves, tabulated 	{OK_STOMATE}
+CM_ZERO_LEAF =  -9999., 2.35E-3, 2.62E-3, 1.01E-3, 2.35E-3, 2.62E-3, 1.01E-3,2.62E-3, 2.05E-3, 2.62E-3, 2.62E-3, 2.62E-3, 2.62E-3 
+
+# CM_ZERO_SAPABOVE ([g/g/day]) :  maintenance respiration coefficient at 0 deg C,for sapwood above, tabulated 	{OK_STOMATE}
+CM_ZERO_SAPABOVE =  -9999., 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4 
+
+# CM_ZERO_SAPBELOW ([g/g/day]) :  maintenance respiration coefficient at 0 deg C, for sapwood below, tabulated 	{OK_STOMATE}
+CM_ZERO_SAPBELOW =  -9999., 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4  
+
+# CM_ZERO_HEARTABOVE ([g/g/day]) :  maintenance respiration coefficient at 0 deg C, for heartwood above, tabulated 	{OK_STOMATE }
+CM_ZERO_HEARTABOVE =  -9999., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.  
+
+# CM_ZERO_HEARTBELOW ([g/g/day] ) :  maintenance respiration coefficient at 0 deg C,for heartwood below, tabulated 	{OK_STOMATE }
+CM_ZERO_HEARTBELOW =  -9999., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.  
+
+# CM_ZERO_ROOT ([g/g/day] ) :  maintenance respiration coefficient at 0 deg C, for roots, tabulated 	{OK_STOMATE}
+CM_ZERO_ROOT =  -9999.,1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3,1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3 
+
+# CM_ZERO_FRUIT ([g/g/day] ) :  maintenance respiration coefficient at 0 deg C, for fruits, tabulated 	{OK_STOMATE}
+CM_ZERO_FRUIT =  -9999., 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4,1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4     
+
+# CM_ZERO_CARBRES ([g/g/day] ) :  maintenance respiration coefficient at 0 deg C, for carbohydrate reserve, tabulated 	{OK_STOMATE}
+CM_ZERO_CARBRES =  -9999., 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4,1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4 
+
+# FLAM ([-]) :  flamability: critical fraction of water holding capacity 	{OK_STOMATE}
+FLAM =  -9999., .15, .25, .25, .25, .25, .25, .25, .25, .25, .25, .35, .35 
+
+# RESIST ([-]) :  fire resistance 	{OK_STOMATE}
+RESIST =  -9999., .95, .90, .12, .50, .12, .12, .12, .12, .0, .0, .0, .0  
+
+# COEFF_LCCHANGE_1 ([-]) :  Coeff of biomass export for the year 	{OK_STOMATE}
+COEFF_LCCHANGE_1 =  -9999., 0.897, 0.897, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597  
+
+# COEFF_LCCHANGE_10 ([-]) :  Coeff of biomass export for the decade 	{OK_STOMATE}
+COEFF_LCCHANGE_10 =  -9999., 0.103, 0.103, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.403, 0.299, 0.403 
+
+# COEFF_LCCHANGE_100 ([-]) :  Coeff of biomass export for the century 	{OK_STOMATE}
+COEFF_LCCHANGE_100 =  -9999., 0., 0., 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0., 0.104, 0. 
+
+# LAI_MAX_TO_HAPPY ([-]) :  threshold of LAI below which plant uses carbohydrate reserves 	{OK_STOMATE}
+LAI_MAX_TO_HAPPY =  -9999., .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5  
+
+# LAI_MAX ([m^2/m^2]) :  maximum LAI, PFT-specific 	{OK_STOMATE}
+LAI_MAX =  -9999., 7., 7., 5., 5., 5., 4.5, 4.5, 3.0, 2.5, 2.5, 5.,5.  
+
+# PHENO_TYPE ([-]) :  type of phenology, 0 	{OK_STOMATE}
+PHENO_TYPE =  0, 1, 3, 1, 1, 2, 1, 2, 2, 4, 4, 2, 3 
+
+# PHENO_GDD_CRIT_C ([-]) :  critical gdd, tabulated (C), constant c of aT^2+bT+c 	{OK_STOMATE}
+PHENO_GDD_CRIT_C =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 270., 400., 125., 400. 
+
+# PHENO_GDD_CRIT_B ([-]) :  critical gdd, tabulated (C), constant b of aT^2+bT+c 	{OK_STOMATE}
+PHENO_GDD_CRIT_B =  -9999., -9999., -9999., -9999., -9999., -9999., -9999.,-9999., -9999., 6.25, 0., 0., 0. 
+
+# PHENO_GDD_CRIT_A ([-]) :  critical gdd, tabulated (C), constant a of aT^2+bT+c 	{OK_STOMATE}
+PHENO_GDD_CRIT_A =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0.03125,  0., 0., 0. 
+
+# PHENO_MOIGDD_T_CRIT ([C]) :  Average temperature threashold for C4 grass used in pheno_moigdd 	{OK_STOMATE}
+PHENO_MOIGDD_T_CRIT =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 22.0, -9999., -9999. 
+
+# NGD_CRIT ([days]) :  critical ngd, tabulated. Threshold -5 degrees 	{OK_STOMATE}
+NGD_CRIT =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., 0., -9999., -9999., -9999., -9999., -9999. 
+
+# NCDGDD_TEMP ([C] ) :  critical temperature for the ncd vs. gdd function in phenology 	{OK_STOMATE}
+NCDGDD_TEMP =  -9999., -9999., -9999., -9999., -9999., 5., -9999., 0., -9999., -9999., -9999., -9999., -9999. 
+
+# HUM_FRAC ([%]) :  critical humidity (relative to min/max) for phenology 	{OK_STOMATE}
+HUM_FRAC =  -9999., -9999., .5, -9999., -9999., -9999., -9999., -9999.,  -9999., .5, .5, .5,.5      
+
+# HUM_MIN_TIME ([days]) :  minimum time elapsed since moisture minimum 	{OK_STOMATE}
+HUM_MIN_TIME =  -9999., -9999., 50., -9999., -9999., -9999., -9999., -9999., -9999., 35., 35., 75., 75. 
+
+# TAU_SAP ([days]) :  sapwood -> heartwood conversion time 	{OK_STOMATE}
+TAU_SAP =  -9999., 730., 730., 730., 730., 730., 730., 730., 730., -9999., -9999., -9999., -9999. 
+
+# TAU_LEAFINIT ([days]) :  time to attain the initial foliage using the carbohydrate reserve 	{OK_STOMATE}
+TAU_LEAFINIT =  -9999., 10., 10., 10., 10., 10., 10., 10., 10., 10., 10., 10., 10. 
+
+# TAU_FRUIT ([days]) :  fruit lifetime 	{OK_STOMATE}
+TAU_FRUIT =  -9999., 90., 90., 90., 90., 90., 90., 90., 90., -9999., -9999., -9999., -9999. 
+
+# ECUREUIL ([-]) :  fraction of primary leaf and root allocation put into reserve 	{OK_STOMATE}
+ECUREUIL =  -9999., .0, 1., .0, .0, 1., .0, 1., 1., 1., 1., 1., 1. 
+
+# ALLOC_MIN ([-]) :  minimum allocation above/below  	{OK_STOMATE}
+ALLOC_MIN =  -9999., 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, -9999., -9999., -9999., -9999.  
+
+# ALLOC_MAX ([-]) :  maximum allocation above/below  	{OK_STOMATE}
+ALLOC_MAX =  -9999., 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, -9999., -9999., -9999., -9999. 
+
+# DEMI_ALLOC  ([-]) :  mean allocation above/below  	{OK_STOMATE}
+DEMI_ALLOC  =  -9999., 5., 5., 5., 5., 5., 5., 5., 5., -9999., -9999., -9999., -9999. 
+
+# LEAFLIFE_TAB ([years]) :  leaf longevity 	{OK_STOMATE}
+LEAFLIFE_TAB =  -9999., .5, 2., .33, 1., 2., .33, 2., 2., 2., 2., 2., 2.  
+
+# LEAFFALL ([days]) :  length of death of leaves, tabulated  	{OK_STOMATE}
+LEAFFALL =  -9999., -9999., 10., -9999., -9999., 10., -9999., 10., 10., 10., 10., 10., 10.  
+
+# LEAFAGECRIT ([days]) :  critical leaf age, tabulated 	{OK_STOMATE}
+LEAFAGECRIT =  -9999., 730., 180., 910., 730., 180., 910., 180., 180., 120., 120., 90., 90.   
+
+# SENESCENCE_TYPE ([-]) :  type of senescence, tabulated 	{OK_STOMATE}
+SENESCENCE_TYPE =  none, none, dry, none, none, cold, none, cold, cold, mixed, mixed, mixed, mixed  
+
+# SENESCENCE_HUM ([-] ) :  critical relative moisture availability for senescence 	{OK_STOMATE}
+SENESCENCE_HUM =  -9999., -9999., .3, -9999., -9999., -9999., -9999., -9999., -9999., .2, .2, .3, .2  
+
+# NOSENESCENCE_HUM ([-]) :  relative moisture availability above which there is no humidity-related senescence 	{OK_STOMATE}
+NOSENESCENCE_HUM =  -9999., -9999., .8, -9999., -9999., -9999., -9999., -9999., -9999., .3, .3, .3, .3  
+
+# MAX_TURNOVER_TIME ([days]) :  maximum turnover time for grasse 	{OK_STOMATE}
+MAX_TURNOVER_TIME =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999.,  80.,  80., 80., 80.  
+
+# MIN_TURNOVER_TIME ([days]) :  minimum turnover time for grasse  	{OK_STOMATE}
+MIN_TURNOVER_TIME =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 10., 10., 10., 10.  
+
+# MIN_LEAF_AGE_FOR_SENESCENCE ([days] ) :  minimum leaf age to allow senescence g 	{OK_STOMATE}
+MIN_LEAF_AGE_FOR_SENESCENCE =  -9999., -9999., 90., -9999., -9999., 90., -9999., 60., 60., 30., 30., 30., 30. 
+
+# SENESCENCE_TEMP_C ([-]) :  critical temperature for senescence (C), constant c of aT^2+bT+c, tabulated 	{OK_STOMATE}
+SENESCENCE_TEMP_C =  -9999., -9999., -9999., -9999., -9999., 12., -9999., 7., 2., -1.375, 5., 5., 10. 
+
+# SENESCENCE_TEMP_B ([-]) :  critical temperature for senescence (C), constant b of aT^2+bT+c ,tabulated 	{OK_STOMATE }
+SENESCENCE_TEMP_B =  -9999., -9999., -9999., -9999., -9999., 0., -9999., 0., 0., .1, 0., 0., 0. 
+
+# SENESCENCE_TEMP_A ([-] ) :  critical temperature for senescence (C), constant a of aT^2+bT+c , tabulated 	{OK_STOMATE}
+SENESCENCE_TEMP_A =  -9999., -9999., -9999., -9999., -9999., 0., -9999., 0., 0.,.00375, 0., 0., 0.  
+
+# GDD_SENESCENCE ([days] ) :  minimum gdd to allow senescence of crops   	{OK_STOMATE}
+GDD_SENESCENCE =  -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., -9999., 950., 4000. 
+
+# RESIDENCE_TIME ([years]) :  residence time of trees 	{OK_DGVM and NOT(LPJ_GAP_CONST_MORT)}
+RESIDENCE_TIME =  -9999., 30.0, 30.0, 40.0, 40.0, 40.0, 80.0, 80.0, 80.0, 0.0, 0.0, 0.0, 0.0  
+
+# TMIN_CRIT ([C]) :  critical tmin, tabulated 	{OK_STOMATE}
+TMIN_CRIT =  -9999.,  0.0, 0.0, -30.0, -14.0, -30.0, -45.0, -45.0, -9999., -9999., -9999., -9999., -9999. 
+
+# TCM_CRIT ([C]) :  critical tcm, tabulated  	{OK_STOMATE}
+TCM_CRIT =  -9999., -9999., -9999., 5.0, 15.5, 15.5, -8.0, -8.0, -8.0, -9999., -9999., -9999., -9999. 
+
+# HERBIVORES ([FLAG]) :  herbivores allowed? 	{OK_STOMATE }
+HERBIVORES =  n 
+
+# TREAT_EXPANSION ([FLAG]) :  treat expansion of PFTs across a grid cell? 	{OK_STOMATE }
+TREAT_EXPANSION =  n 
+
+# LPJ_GAP_CONST_MORT ([FLAG]) :  Constant mortality 	{OK_STOMATE AND NOT OK_DGVM}
+LPJ_GAP_CONST_MORT =  y/n depending on OK_DGVM 
+
+# HARVEST_AGRI ([FLAG]) :  Harvest model for agricultural PFTs. 	{OK_STOMATE }
+HARVEST_AGRI =  y 
+
+# FIRE_DISABLE ([FLAG]) :  no fire allowed 	{OK_STOMATE }
+FIRE_DISABLE =  n 
+
+# SPINUP_ANALYTIC (BOOLEAN    ) :  Activation of the analytic resolution of the spinup. 	{OK_STOMATE}
+SPINUP_ANALYTIC =  n 
+
+# AGRICULTURE ([FLAG]) :  agriculture allowed? 	{OK_SECHIBA or OK_STOMATE}
+AGRICULTURE =  y 
+
+# IMPOSE_VEG ([FLAG]) :  Should the vegetation be prescribed ? 	{OK_SECHIBA or OK_STOMATE}
+IMPOSE_VEG =  n 
+
+# IMPOSE_SOILT ([FLAG]) :  Should the soil type be prescribed ? 	{IMPOSE_VEG}
+IMPOSE_SOILT =  n 
+
+# LAI_MAP ([FLAG]) :  Read the LAI map 	{OK_SECHIBA or OK_STOMATE}
+LAI_MAP =  n 
+
+# MAP_PFT_FORMAT ([FLAG]) :  Read a land use vegetation map on PFT format 	{OK_SECHIBA or OK_STOMATE}
+MAP_PFT_FORMAT =  y 
+
+# VEGET_REINIT ([FLAG] ) :  booleen to indicate that a new LAND USE file will be used. 	{MAP_PFT_FORMAT}
+VEGET_REINIT =  y 
+
+# VEGET_YEAR ([FLAG] ) :  Year of the vegetation map to be read 	{MAP_PFT_FORMAT}
+VEGET_YEAR =  1 
+
+# MAXMASS_SNOW ([kg/m^2]  ) :  The maximum mass of a snow 	{OK_SECHIBA or HYDROL_CWRR}
+MAXMASS_SNOW =  3000. 
+
+# SNOWCRI ([kg/m^2]  ) :  Sets the amount above which only sublimation occures  	{OK_SECHIBA or HYDROL_CWRR}
+SNOWCRI =  1.5 
+
+# MIN_WIND ([m/s]) :  Minimum wind speed 	{OK_SECHIBA}
+MIN_WIND =  0.1 
+
+# MAX_SNOW_AGE ([days?]) :  Maximum period of snow aging  	{OK_SECHIBA}
+MAX_SNOW_AGE =  50. 
+
+# SNOW_TRANS ([m]   ) :  Transformation time constant for snow 	{OK_SECHIBA}
+SNOW_TRANS =  0.3 
+
+# Z0_OVER_HEIGHT ([-]   ) :  to get z0 from height  	{OK_SECHIBA }
+Z0_OVER_HEIGHT =  1/16. 
+
+# HEIGHT_DISPLACEMENT ([m]  ) :  Magic number which relates the height to the displacement height. 	{OK_SECHIBA }
+HEIGHT_DISPLACEMENT =  0.75 
+
+# Z0_BARE ([m]   ) :  bare soil roughness length 	{OK_SECHIBA }
+Z0_BARE =  0.01  
+
+# Z0_ICE ([m]   ) :  ice roughness length 	{OK_SECHIBA }
+Z0_ICE =  0.001 
+
+# TCST_SNOWA ([days]) :  Time constant of the albedo decay of snow 	{OK_SECHIBA }
+TCST_SNOWA =  5.0  
+
+# SNOWCRI_ALB ([cm]  ) :  Critical value for computation of snow albedo 	{OK_SECHIBA}
+SNOWCRI_ALB =  10.  
+
+# VIS_DRY ([-]  ) :  The correspondance table for the soil color numbers and their albedo  	{OK_SECHIBA }
+VIS_DRY =  0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.27 
+
+# NIR_DRY ([-]   ) :  The correspondance table for the soil color numbers and their albedo  	{OK_SECHIBA }
+NIR_DRY =  0.48, 0.44, 0.40, 0.36, 0.32, 0.28, 0.24, 0.20, 0.55 
+
+# VIS_WET  ([-]   ) :  The correspondance table for the soil color numbers and their albedo 	{OK_SECHIBA  }
+VIS_WET  =  0.12, 0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.15 
+
+# NIR_WET ([-]    ) :  The correspondance table for the soil color numbers and their albedo  	{OK_SECHIBA }
+NIR_WET =  0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.31 
+
+# ALBSOIL_VIS ([-]  ) :   	{OK_SECHIBA }
+ALBSOIL_VIS =  0.18, 0.16, 0.16, 0.15, 0.12, 0.105, 0.09, 0.075, 0.25 
+
+# ALBSOIL_NIR  ([-]  ) :   	{OK_SECHIBA }
+ALBSOIL_NIR  =  0.36, 0.34, 0.34, 0.33, 0.30, 0.25, 0.20, 0.15, 0.45 
+
+# ALB_DEADLEAF  ([-]     ) :  albedo of dead leaves, VIS+NIR  	{OK_SECHIBA }
+ALB_DEADLEAF  =  0.12, 0.35 
+
+# ALB_ICE ([-]  ) :  albedo of ice, VIS+NIR 	{OK_SECHIBA}
+ALB_ICE =  0.60, 0.20 
+
+# CONDVEG_SNOWA ([-]) :  The snow albedo used by SECHIBA 	{OK_SECHIBA}
+CONDVEG_SNOWA =  1.E+20 
+
+# ALB_BARE_MODEL ([FLAG]) :  Switch bare soil albedo dependent (if TRUE) on soil wetness 	{OK_SECHIBA}
+ALB_BARE_MODEL =  n 
+
+# ALB_BG_MODIS ([FLAG]) :  Read bare soil albedo from file with background MODIS data 	{OK_SECHIBA}
+ALB_BG_MODIS =  n 
+
+# Z0CDRAG_AVE ([FLAG]) :  Average method for z0 	{OK_SECHIBA}
+Z0CDRAG_AVE =  y 
+
+# IMPOSE_AZE ([FLAG]) :  Should the surface parameters be prescribed 	{OK_SECHIBA}
+IMPOSE_AZE =  n 
+
+# CONDVEG_Z0 ([m]) :  Surface roughness 	{IMPOSE_AZE}
+CONDVEG_Z0 =  0.15 
+
+# ROUGHHEIGHT ([m] ) :  Height to be added to the height of the first level 	{IMPOSE_AZE}
+ROUGHHEIGHT =  0.0 
+
+# CONDVEG_ALBVIS ([-]) :  SW visible albedo for the surface 	{IMPOSE_AZE}
+CONDVEG_ALBVIS =  0.25 
+
+# CONDVEG_ALBNIR ([-]  ) :  SW near infrared albedo for the surface 	{IMPOSE_AZE}
+CONDVEG_ALBNIR =  0.25 
+
+# CONDVEG_EMIS ([-] ) :  Emissivity of the surface for LW radiation 	{IMPOSE_AZE}
+CONDVEG_EMIS =  1.0 
+
+# xansmax  ([-] ) :  maximum snow albedo 	{OK_SECHIBA}
+xansmax  =  0.85 
+
+# xansmin  ([-] ) :  minimum snow albedo 	{OK_SECHIBA}
+xansmin  =  0.50 
+
+# xans_todry  ([S-1] ) :  albedo decay rate for the dry snow  	{OK_SECHIBA}
+xans_todry  =  0.008 
+
+# xans_t  ([S-1] ) :  albedo decay rate for the wet snow  	{OK_SECHIBA}
+xans_t  =  0.24 
+
+# xrhosmax  ([-] ) :  maximum snow density  	{OK_SECHIBA}
+xrhosmax  =  750 
+
+# xwsnowholdmax1 ([-] ) :  snow holding capacity 1 	{OK_SECHIBA}
+xwsnowholdmax1 =  0.03 
+
+# xwsnowholdmax2 ([-] ) :  snow holding capacity 2 	{OK_SECHIBA}
+xwsnowholdmax2 =  0.10 
+
+# xsnowrhohold  ([kg/m3] ) :  snow density  	{OK_SECHIBA}
+xsnowrhohold  =  200.0 
+
+# ZSNOWTHRMCOND1 ([W/m/K] ) :  Thermal conductivity Coef 1 	{OK_SECHIBA}
+ZSNOWTHRMCOND1 =  0.02  
+
+# ZSNOWTHRMCOND2 ([W m5/(kg2 K)] ) :  Thermal conductivity Coef 2 	{OK_SECHIBA}
+ZSNOWTHRMCOND2 =  2.5E-6 
+
+# ZSNOWTHRMCOND_AVAP ([W/m/K] ) :  Thermal conductivity Coef 1 water vapor 	{OK_SECHIBA}
+ZSNOWTHRMCOND_AVAP =  -0.06023 
+
+# ZSNOWTHRMCOND_BVAP ([W/m] ) :  Thermal conductivity Coef 2 water vapor 	{OK_SECHIBA}
+ZSNOWTHRMCOND_BVAP =  -2.5425 
+
+# ZSNOWTHRMCOND_CVAP ([K] ) :  Thermal conductivity Coef 3 water vapor 	{OK_SECHIBA}
+ZSNOWTHRMCOND_CVAP =  -289.99 
+
+# ZSNOWCMPCT_RHOD ([kg/m3]) :  Snow compaction coefficent 	{OK_SECHIBA}
+ZSNOWCMPCT_RHOD =  150.0 
+
+# ZSNOWCMPCT_ACM ([1/s]) :  Coefficent for the thermal conductivity 	{OK_SECHIBA}
+ZSNOWCMPCT_ACM =  2.8e-6 
+
+# ZSNOWCMPCT_BCM ([1/K]) :  Coefficent for the thermal conductivity 	{OK_SECHIBA}
+ZSNOWCMPCT_BCM =  0.04 
+
+# ZSNOWCMPCT_CCM ([m3/kg] ) :  Coefficent for the thermal conductivity 	{OK_SECHIBA}
+ZSNOWCMPCT_CCM =  460. 
+
+# ZSNOWCMPCT_V0 ([Pa/s]) :  Vapor coefficent for the thermal conductivity 	{OK_SECHIBA}
+ZSNOWCMPCT_V0 =  3.7e7 
+
+# ZSNOWCMPCT_VT ([1/K]) :  Vapor coefficent for the thermal conductivity 	{OK_SECHIBA}
+ZSNOWCMPCT_VT =  0.081 
+
+# ZSNOWCMPCT_VR ([m3/kg]) :  Vapor coefficent for the thermal conductivity 	{OK_SECHIBA}
+ZSNOWCMPCT_VR =  0.018 
+
+# CB ([-] ) :  Constant of the Louis scheme  	{OK_SECHIBA}
+CB =  5.0 
+
+# CC ([-] ) :  Constant of the Louis scheme  	{OK_SECHIBA}
+CC =  5.0 
+
+# CD ([-] ) :  Constant of the Louis scheme  	{OK_SECHIBA}
+CD =  5.0 
+
+# RAYT_CSTE ([W.m^{-2}] ) :  Constant in the computation of surface resistance   	{OK_SECHIBA}
+RAYT_CSTE =  125 
+
+# DEFC_PLUS ([K.W^{-1}] ) :  Constant in the computation of surface resistance   	{OK_SECHIBA}
+DEFC_PLUS =  23.E-3 
+
+# DEFC_MULT ([K.W^{-1}] ) :  Constant in the computation of surface resistance   	{OK_SECHIBA}
+DEFC_MULT =  1.5 
+
+# NLAI ([-]  ) :  Number of LAI levels 	{OK_SECHIBA}
+NLAI =  20 
+
+# LAIMAX ([m^2/m^2]   ) :  Maximum LAI 	{OK_SECHIBA}
+LAIMAX =   
+
+# DEW_VEG_POLY_COEFF ([-]   ) :  coefficients of the polynome of degree 5 for the dew 	{OK_SECHIBA}
+DEW_VEG_POLY_COEFF =  0.887773, 0.205673, 0.110112, 0.014843, 0.000824, 0.000017  
+
+# DOWNREGULATION_CO2 ([FLAG]   ) :  Activation of CO2 downregulation 	{OK_SECHIBA}
+DOWNREGULATION_CO2 =  n  
+
+# DOWNREGULATION_CO2_BASELEVEL ([ppm]   ) :  CO2 base level 	{OK_SECHIBA }
+DOWNREGULATION_CO2_BASELEVEL =  280. 
+
+# CLAYFRACTION_DEFAULT ([-]   ) :  default fraction of clay 	{OK_SECHIBA }
+CLAYFRACTION_DEFAULT =  0.2  
+
+# MIN_VEGFRAC  ([-]  ) :  Minimal fraction of mesh a vegetation type can occupy  	{OK_SECHIBA }
+MIN_VEGFRAC  =  0.001  
+
+# STEMPDIAG_BID  ([K]) :  only needed for an initial LAI if there is no restart file 	{OK_SECHIBA }
+STEMPDIAG_BID  =  280. 
+
+# LAI_LEVEL_DEPTH ([-]  ) :   	{OK_CO2}
+LAI_LEVEL_DEPTH =  0.15 
+
+# Oi ([ubar]  ) :  Intercellular oxygen partial pressure 	{OK_CO2}
+Oi =  210000. 
+
+# TOO_LONG  ([days]   ) :  longest sustainable time without regeneration (vernalization) 	{OK_STOMATE}
+TOO_LONG  =  5. 
+
+# TAU_FIRE  ([days]    ) :  Time scale for memory of the fire index (days). Validated for one year in the DGVM.  	{OK_STOMATE }
+TAU_FIRE  =  30. 
+
+# LITTER_CRIT ([gC/m^2]  ) :  Critical litter quantity for fire 	{OK_STOMATE }
+LITTER_CRIT =  200. 
+
+# FIRE_RESIST_STRUCT ([-]  ) :   	{OK_STOMATE }
+FIRE_RESIST_STRUCT =  0.5 
+
+# CO2FRAC ([-]  ) :  What fraction of a burned plant compartment goes into the atmosphere 	{OK_STOMATE }
+CO2FRAC =  0.95, 0.95, 0., 0.3, 0., 0., 0.95, 0.95 
+
+# BCFRAC_COEFF ([-]  ) :   	{OK_STOMATE }
+BCFRAC_COEFF =  0.3, 1.3, 88.2  
+
+# FIREFRAC_COEFF  ([-]   ) :   	{OK_STOMATE }
+FIREFRAC_COEFF  =  0.45, 0.8, 0.6, 0.13 
+
+# REF_GREFF ([1/year]  ) :  Asymptotic maximum mortality rate 	{OK_STOMATE }
+REF_GREFF =  0.035 
+
+# OK_MINRES ([FLAG]) :  Do we try to reach a minimum reservoir even if we are severely stressed? 	{OK_STOMATE }
+OK_MINRES =  y 
+
+# RESERVE_TIME_TREE  ([days]    ) :  maximum time during which reserve is used (trees)  	{OK_STOMATE }
+RESERVE_TIME_TREE  =  30. 
+
+# RESERVE_TIME_GRASS  ([days]   ) :  maximum time during which reserve is used (grasses)  	{OK_STOMATE }
+RESERVE_TIME_GRASS  =  20.  
+
+# F_FRUIT ([-]    ) :  Standard fruit allocation 	{OK_STOMATE }
+F_FRUIT =  0.1  
+
+# ALLOC_SAP_ABOVE_GRASS  ([-]   ) :  fraction of sapwood allocation above ground  	{OK_STOMATE }
+ALLOC_SAP_ABOVE_GRASS  =  1.0  
+
+# MIN_LTOLSR  ([-]   ) :  extrema of leaf allocation fraction  	{OK_STOMATE }
+MIN_LTOLSR  =  0.2 
+
+# MAX_LTOLSR ([-]   ) :  extrema of leaf allocation fraction 	{OK_STOMATE }
+MAX_LTOLSR =  0.5 
+
+# Z_NITROGEN ([m]  ) :  scaling depth for nitrogen limitation  	{OK_STOMATE}
+Z_NITROGEN =  0.2  
+
+# NLIM_TREF  ([C]  ) :   	{OK_STOMATE }
+NLIM_TREF  =  25.  
+
+# PIPE_TUNE1 ([-]    ) :  crown area  	{OK_STOMATE }
+PIPE_TUNE1 =  100.0 
+
+# PIPE_TUNE2  ([-]      ) :  height 	{OK_STOMATE }
+PIPE_TUNE2  =  40.0  
+
+# PIPE_TUNE3 ([-]    ) :  height 	{OK_STOMATE }
+PIPE_TUNE3 =  0.5  
+
+# PIPE_TUNE4 ([-]  ) :  needed for stem diameter 	{OK_STOMATE }
+PIPE_TUNE4 =  0.3  
+
+# PIPE_DENSITY  ([-]  ) :  Density 	{OK_STOMATE }
+PIPE_DENSITY  =  2.e5  
+
+# PIPE_K1  ([-]   ) :   	{OK_STOMATE }
+PIPE_K1  =  8.e3  
+
+# PIPE_TUNE_EXP_COEFF  ([-]   ) :  pipe tune exponential coeff  	{OK_STOMATE }
+PIPE_TUNE_EXP_COEFF  =  1.6  
+
+# PRECIP_CRIT  ([mm/year]  ) :  minimum precip 	{OK_STOMATE }
+PRECIP_CRIT  =  100. 
+
+# GDD_CRIT_ESTAB ([-]  ) :  minimum gdd for establishment of saplings 	{OK_STOMATE }
+GDD_CRIT_ESTAB =  150.  
+
+# FPC_CRIT ([-]  ) :  critical fpc, needed for light competition and establishment 	{OK_STOMATE }
+FPC_CRIT =  0.95 
+
+# ALPHA_GRASS ([-]   ) :  sapling characteristics : alpha's 	{OK_STOMATE }
+ALPHA_GRASS =  0.5 
+
+# ALPHA_TREE ([-]   ) :  sapling characteristics : alpha's  	{OK_STOMATE }
+ALPHA_TREE =  1. 
+
+# MASS_RATIO_HEART_SAP ([-]   ) :  mass ratio (heartwood+sapwood)/sapwood 	{OK_STOMATE }
+MASS_RATIO_HEART_SAP =  3. 
+
+# TAU_HUM_MONTH ([days]  ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_HUM_MONTH =  20.  
+
+# TAU_HUM_WEEK ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_HUM_WEEK =  7. 
+
+# TAU_T2M_MONTH ([days]     ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_T2M_MONTH =  20. 
+
+# TAU_T2M_WEEK ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_T2M_WEEK =  7. 
+
+# TAU_TSOIL_MONTH  ([days]     ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_TSOIL_MONTH  =  20.  
+
+# TAU_SOILHUM_MONTH ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_SOILHUM_MONTH =  20.  
+
+# TAU_GPP_WEEK  ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_GPP_WEEK  =  7.  
+
+# TAU_GDD ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_GDD =  40.  
+
+# TAU_NGD ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+TAU_NGD =  50. 
+
+# COEFF_TAU_LONGTERM ([days]   ) :  time scales for phenology and other processes 	{OK_STOMATE }
+COEFF_TAU_LONGTERM =  3.  
+
+# BM_SAPL_CARBRES  ([-]   ) :   	{OK_STOMATE }
+BM_SAPL_CARBRES  =  5.  
+
+# BM_SAPL_SAPABOVE ([-]    ) :   	{OK_STOMATE}
+BM_SAPL_SAPABOVE =  0.5  
+
+# BM_SAPL_HEARTABOVE  ([-]    ) :   	{OK_STOMATE }
+BM_SAPL_HEARTABOVE  =  2. 
+
+# BM_SAPL_HEARTBELOW  ([-]    ) :   	{OK_STOMATE }
+BM_SAPL_HEARTBELOW  =  2.  
+
+# INIT_SAPL_MASS_LEAF_NAT ([-]    ) :   	{OK_STOMATE }
+INIT_SAPL_MASS_LEAF_NAT =  0.1  
+
+# INIT_SAPL_MASS_LEAF_AGRI ([-]    ) :   	{OK_STOMATE }
+INIT_SAPL_MASS_LEAF_AGRI =  1.  
+
+# INIT_SAPL_MASS_CARBRES ([-]    ) :   	{OK_STOMATE }
+INIT_SAPL_MASS_CARBRES =  5.  
+
+# INIT_SAPL_MASS_ROOT ([-]   ) :   	{OK_STOMATE }
+INIT_SAPL_MASS_ROOT =  0.1  
+
+# INIT_SAPL_MASS_FRUIT ([-]    ) :   	{OK_STOMATE }
+INIT_SAPL_MASS_FRUIT =  0.3  
+
+# CN_SAPL_INIT  ([-]   ) :   	{OK_STOMATE }
+CN_SAPL_INIT  =  0.5  
+
+# MIGRATE_TREE  ([m/year]   ) :   	{OK_STOMATE }
+MIGRATE_TREE  =  10000. 
+
+# MIGRATE_GRASS ([m/year]   ) :   	{OK_STOMATE }
+MIGRATE_GRASS =  10000. 
+
+# LAI_INITMIN_TREE ([m^2/m^2]  ) :   	{OK_STOMATE }
+LAI_INITMIN_TREE =  0.3 
+
+# LAI_INITMIN_GRASS  ([m^2/m^2]    ) :   	{OK_STOMATE }
+LAI_INITMIN_GRASS  =  0.1 
+
+# DIA_COEFF ([-]   ) :   	{OK_STOMATE }
+DIA_COEFF =  4., 0.5 
+
+# MAXDIA_COEFF ([-]   ) :   	{OK_STOMATE }
+MAXDIA_COEFF =  100., 0.01  
+
+# BM_SAPL_LEAF ([-]  ) :   	{OK_STOMATE }
+BM_SAPL_LEAF =  4., 4., 0.8, 5.  
+
+# METABOLIC_REF_FRAC ([-]) :  	{OK_STOMATE }
+METABOLIC_REF_FRAC =  0.85   
+
+# Z_DECOMP ([m]   ) :  scaling depth for soil activity 	{OK_STOMATE }
+Z_DECOMP =  0.2 
+
+# CN ([-]  ) :  C/N ratio 	{OK_STOMATE }
+CN =  40., 40., 40., 40., 40., 40., 40., 40. 
+
+# LC  ([-]   ) :  Lignine/C ratio of the different plant parts 	{OK_STOMATE }
+LC  =  0.22, 0.35, 0.35, 0.35, 0.35, 0.22, 0.22, 0.22 
+
+# FRAC_SOIL_STRUCT_AA ([-]) :  frac_soil(istructural,iactive,iabove) 	{OK_STOMATE }
+FRAC_SOIL_STRUCT_AA =  0.55 
+
+# FRAC_SOIL_STRUCT_A  ([-]) :  frac_soil(istructural,iactive,ibelow) 	{OK_STOMATE }
+FRAC_SOIL_STRUCT_A  =  0.45 
+
+# FRAC_SOIL_STRUCT_SA ([-]   ) :  frac_soil(istructural,islow,iabove) 	{OK_STOMATE}
+FRAC_SOIL_STRUCT_SA =  0.7   
+
+# FRAC_SOIL_STRUCT_SB ([-]   ) :  frac_soil(istructural,islow,ibelow)  	{OK_STOMATE }
+FRAC_SOIL_STRUCT_SB =  0.7   
+
+# FRAC_SOIL_METAB_AA  ([-]   ) :  frac_soil(imetabolic,iactive,iabove)  	{OK_STOMATE }
+FRAC_SOIL_METAB_AA  =  0.45  
+
+# FRAC_SOIL_METAB_AB  ([-]   ) :  frac_soil(imetabolic,iactive,ibelow) 	{OK_STOMATE }
+FRAC_SOIL_METAB_AB  =  0.45   
+
+# METABOLIC_LN_RATIO ([-]   ) :   	{OK_STOMATE }
+METABOLIC_LN_RATIO =  0.018   
+
+# TAU_METABOLIC ([days] ) :   	{OK_STOMATE }
+TAU_METABOLIC =  0.066 
+
+# TAU_STRUCT  ([days]) :   	{OK_STOMATE }
+TAU_STRUCT  =  0.245  
+
+# SOIL_Q10 ([-]) :   	{OK_STOMATE }
+SOIL_Q10 =  0.69 ( 
+
+# TSOIL_REF ([C]   ) :   	{OK_STOMATE }
+TSOIL_REF =  30.  
+
+# LITTER_STRUCT_COEF  ([-]   ) :   	{OK_STOMATE }
+LITTER_STRUCT_COEF  =  3.  
+
+# MOIST_COEFF ([-]   ) :   	{OK_STOMATE }
+MOIST_COEFF =  1.1, 2.4, 0.29 
+
+# MOISTCONT_MIN ([-]) :  minimum soil wetness to limit the heterotrophic respiration 	{OK_STOMATE }
+MOISTCONT_MIN =  0.25 
+
+# FRAC_TURNOVER_DAILY  ([-]) :   	{OK_STOMATE }
+FRAC_TURNOVER_DAILY  =  0.55 
+
+# TAX_MAX ([-]   ) :  maximum fraction of allocatable biomass used for maintenance respiration 	{OK_STOMATE }
+TAX_MAX =  0.8 
+
+# ALWAYS_INIT ([-]   ) :  take carbon from atmosphere if carbohydrate reserve too small?  	{OK_STOMATE }
+ALWAYS_INIT =  n  
+
+# MIN_GROWTHINIT_TIME  ([days]  ) :  minimum time since last beginning of a growing season 	{OK_STOMATE }
+MIN_GROWTHINIT_TIME  =  300.  
+
+# MOIAVAIL_ALWAYS_TREE ([-]   ) :  moisture availability above which moisture tendency doesn't matter  	{OK_STOMATE }
+MOIAVAIL_ALWAYS_TREE =  1.0  
+
+# MOIAVAIL_ALWAYS_GRASS  ([-]   ) :  moisture availability above which moisture tendency doesn't matter 	{OK_STOMATE }
+MOIAVAIL_ALWAYS_GRASS  =  0.6  
+
+# T_ALWAYS_ADD ([C]    ) :  monthly temp. above which temp. tendency doesn't matter  	{OK_STOMATE }
+T_ALWAYS_ADD =  10. 
+
+# GDDNCD_REF  ([-]   ) :   	{OK_STOMATE }
+GDDNCD_REF  =  603.  
+
+# GDDNCD_CURVE ([-]  ) :   	{OK_STOMATE }
+GDDNCD_CURVE =  0.0091  
+
+# GDDNCD_OFFSET ([-]  ) :   	{OK_STOMATE }
+GDDNCD_OFFSET =  64.  
+
+# BM_SAPL_RESCALE  ([-]  ) :   	{OK_STOMATE }
+BM_SAPL_RESCALE  =  40.  
+
+# MAINT_RESP_MIN_VMAX ([-]  ) :   	{OK_STOMATE }
+MAINT_RESP_MIN_VMAX =  0.3 
+
+# MAINT_RESP_COEFF  ([-] ) :   	{OK_STOMATE }
+MAINT_RESP_COEFF  =  1.4  
+
+# FRAC_CARB_AP ([-]) :  frac carb coefficients from active pool: depends on clay content 	{OK_STOMATE }
+FRAC_CARB_AP =  0.004 
+
+# FRAC_CARB_SA ([-]) :  frac_carb_coefficients from slow pool 	{OK_STOMATE }
+FRAC_CARB_SA =  0.42 
+
+# FRAC_CARB_SP ([-] ) :  frac_carb_coefficients from slow pool 	{OK_STOMATE }
+FRAC_CARB_SP =  0.03 
+
+# FRAC_CARB_PA ([-]) :  frac_carb_coefficients from passive pool 	{OK_STOMATE }
+FRAC_CARB_PA =  0.45 
+
+# FRAC_CARB_PS ([-]) :  frac_carb_coefficients from passive pool 	{OK_STOMATE }
+FRAC_CARB_PS =  0.0 
+
+# ACTIVE_TO_PASS_CLAY_FRAC ([-] ) :   	{OK_STOMATE }
+ACTIVE_TO_PASS_CLAY_FRAC =  0.68   
+
+# CARBON_TAU_IACTIVE ( [days] ) :  residence times in carbon pools 	{OK_STOMATE }
+CARBON_TAU_IACTIVE =  0.149 
+
+# CARBON_TAU_ISLOW ([days]) :  residence times in carbon pools 	{OK_STOMATE }
+CARBON_TAU_ISLOW =  5.48 
+
+# CARBON_TAU_IPASSIVE ([days] ) :  residence times in carbon pools 	{OK_STOMATE }
+CARBON_TAU_IPASSIVE =  241. 
+
+# FLUX_TOT_COEFF ([days] ) :  	{OK_STOMATE }
+FLUX_TOT_COEFF =  1.2, 1.4,.75 
+
+# NEW_TURNOVER_TIME_REF ([days]  ) :   	{OK_STOMATE }
+NEW_TURNOVER_TIME_REF =  20.  
+
+# LEAF_AGE_CRIT_TREF ([days]  ) :   	{OK_STOMATE }
+LEAF_AGE_CRIT_TREF =  20.  
+
+# LEAF_AGE_CRIT_COEFF  ([-] ) :   	{OK_STOMATE }
+LEAF_AGE_CRIT_COEFF  =  1.5, 0.75, 10.  
+
+# VMAX_OFFSET  ([-]  ) :  offset (minimum relative vcmax) 	{OK_STOMATE }
+VMAX_OFFSET  =  0.3 
+
+# LEAFAGE_FIRSTMAX ([-] ) :  leaf age at which vmax attains vcmax_opt (in fraction of critical leaf age) 	{OK_STOMATE }
+LEAFAGE_FIRSTMAX =  0.03  
+
+# LEAFAGE_LASTMAX  ([-]  ) :  leaf age at which vmax falls below vcmax_opt (in fraction of critical leaf age)  	{OK_STOMATE }
+LEAFAGE_LASTMAX  =  0.5  
+
+# LEAFAGE_OLD  ([-]  ) :  leaf age at which vmax attains its minimum (in fraction of critical leaf age) 	{OK_STOMATE }
+LEAFAGE_OLD  =  1. 
+
+# GPPFRAC_DORMANCE  ([-]) :  rapport maximal GPP/GGP_max pour dormance 	{OK_STOMATE }
+GPPFRAC_DORMANCE  =  0.2  
+
+# TAU_CLIMATOLOGY ([days]) :  tau for "climatologic variables  	{OK_STOMATE }
+TAU_CLIMATOLOGY =  20 
+
+# HVC1  ([-]  ) :  parameters for herbivore activity 	{OK_STOMATE }
+HVC1  =  0.019 
+
+# HVC2  ([-]  ) :  parameters for herbivore activity  	{OK_STOMATE }
+HVC2  =  1.38 
+
+# LEAF_FRAC_HVC ([-] ) :  parameters for herbivore activity  	{OK_STOMATE }
+LEAF_FRAC_HVC =  0.33 
+
+# TLONG_REF_MAX ([K]  ) :  maximum reference long term temperature  	{OK_STOMATE }
+TLONG_REF_MAX =  303.1 
+
+# TLONG_REF_MIN  ([K]  ) :  minimum reference long term temperature  	{OK_STOMATE }
+TLONG_REF_MIN  =  253.1 
+
+# NCD_MAX_YEAR ([days]) :   	{OK_STOMATE }
+NCD_MAX_YEAR =  3.  
+
+# GDD_THRESHOLD  ([days] ) :   	{OK_STOMATE }
+GDD_THRESHOLD  =  5.  
+
+# GREEN_AGE_EVER  ([-]  ) :   	{OK_STOMATE }
+GREEN_AGE_EVER  =  2.  
+
+# GREEN_AGE_DEC ([-] ) :   	{OK_STOMATE }
+GREEN_AGE_DEC =  0.5  
+
+# ESTAB_MAX_TREE ([-]   ) :  Maximum tree establishment rate  	{OK_DGVM}
+ESTAB_MAX_TREE =  0.12  
+
+# ESTAB_MAX_GRASS ([-]  ) :  Maximum grass establishment rate 	{OK_DGVM}
+ESTAB_MAX_GRASS =  0.12  
+
+# ESTABLISH_SCAL_FACT ([-] ) :   	{OK_DGVM }
+ESTABLISH_SCAL_FACT =  5. 
+
+# MAX_TREE_COVERAGE  ([-] ) :   	{OK_DGVM }
+MAX_TREE_COVERAGE  =  0.98 
+
+# IND_0_ESTAB ([-]  ) :   	{OK_DGVM }
+IND_0_ESTAB =  0.2 
+
+# ANNUAL_INCREASE ([FLAG]) :  for diagnosis of fpc increase, compare today's fpc to last year's maximum (T) or to fpc of last time step (F)? 	{OK_DGVM}
+ANNUAL_INCREASE =  y 
+
+# MIN_COVER  ([-]  ) :  For trees, minimum fraction of crown area occupied  	{OK_DGVM}
+MIN_COVER  =  0.05  
+
+# IND_0  ([-]  ) :  initial density of individuals 	{OK_DGVM}
+IND_0  =  0.02  
+
+# MIN_AVAIL ([-]  ) :  minimum availability 	{OK_DGVM}
+MIN_AVAIL =  0.01 
+
+# RIP_TIME_MIN ([year]  ) :   	{OK_DGVM}
+RIP_TIME_MIN =  1.25  
+
+# NPP_LONGTERM_INIT ([gC/m^2/year]) :   	{OK_DGVM}
+NPP_LONGTERM_INIT =  10. 
+
+# EVERYWHERE_INIT ([-] ) :   	{OK_DGVM}
+EVERYWHERE_INIT =  0.05  
+
+# PRINTLEV ([0, 1, 2, 3, 4]) :  Print level for text output 	{}
+PRINTLEV =  1 
+
+# PRINTLEV_modname ([0, 1, 2, 3, 4]) :  Specific print level of text output for the module "modname". Default as PRINTLEV. 	{}
+PRINTLEV_modname =  1 
+
+# DRY_SOIL_HEAT_CAPACITY ([J.m^{-3}.K^{-1}] ) :  Dry soil Heat capacity of soils 	{OK_SECHIBA }
+DRY_SOIL_HEAT_CAPACITY =  1.80e+6 
+
+# DRY_SOIL_HEAT_COND ([W.m^{-2}.K^{-1}] ) :  Dry soil Thermal Conductivity of soils 	{OK_SECHIBA}
+DRY_SOIL_HEAT_COND =  0.40  
+
+# WET_SOIL_HEAT_CAPACITY ([J.m^{-3}.K^{-1}]) :  Wet soil Heat capacity of soils  	{OK_SECHIBA}
+WET_SOIL_HEAT_CAPACITY =  3.03e+6 
+
+# WET_SOIL_HEAT_COND ([W.m^{-2}.K^{-1}]) :  Wet soil Thermal Conductivity of soils 	{OK_SECHIBA }
+WET_SOIL_HEAT_COND =  1.89  
+
+# SNOW_HEAT_COND ([W.m^{-2}.K^{-1}]) :  Thermal Conductivity of snow 	{OK_SECHIBA  }
+SNOW_HEAT_COND =  0.3 
+
+# SNOW_DENSITY ([-] ) :  Snow density for the soil thermodynamics  	{OK_SECHIBA }
+SNOW_DENSITY =  330.0 
+
+# NOBIO_WATER_CAPAC_VOLUMETRI ([s/m^2]) :   	{OK_SECHIBA and .NOT.(HYDROL_CWRR)}
+NOBIO_WATER_CAPAC_VOLUMETRI =  150. 
+
+# SECHIBA_QSINT  ([m]) :  Interception reservoir coefficient 	{OK_SECHIBA }
+SECHIBA_QSINT  =  0.1 
+
+# CHOISNEL_DIFF_MIN ([kg/m^2/dt]) :  Diffusion constant for the slow regime 	{OK_SECHIBA and .NOT.(HYDROL_CWRR)}
+CHOISNEL_DIFF_MIN =  0.001 
+
+# CHOISNEL_DIFF_MAX ([kg/m^2/dt]) :  Diffusion constant for the fast regime 	{OK_SECHIBA and .NOT.(HYDROL_CWRR)}
+CHOISNEL_DIFF_MAX =  0.1 
+
+# CHOISNEL_DIFF_EXP ([-]) :  The exponential in the diffusion law 	{OK_SECHIBA and .NOT.(HYDROL_CWRR)}
+CHOISNEL_DIFF_EXP =  1.5 
+
+# CHOISNEL_RSOL_CSTE ([s/m^2]) :  Constant in the computation of resistance for bare  soil evaporation  	{OK_SECHIBA and .NOT.(HYDROL_CWRR)}
+CHOISNEL_RSOL_CSTE =  33.E3 
+
+# HCRIT_LITTER ([m]) :  Scaling depth for litter humidity 	{OK_SECHIBA and .NOT.(HYDROL_CWRR) }
+HCRIT_LITTER =  0.08  
+
+# OK_FREEZE ([FLAG]) :  Activate the complet soil freezing scheme 	{OK_SECHIBA }
+OK_FREEZE =  FALSE 
+
+# READ_REFTEMP ([FLAG]) :  Initialize soil temperature using climatological temperature 	{}
+READ_REFTEMP =  False 
+
+# OK_FREEZE_THERMIX ([FLAG]) :  Activate thermal part of the soil freezing scheme 	{}
+OK_FREEZE_THERMIX =  True if OK_FREEZE else false 
+
+# OK_ECORR ([FLAG]) :  Energy correction for freezing 	{OK_FREEZE_THERMIX}
+OK_ECORR =  True if OK_FREEZE else false 
+
+# POROS ([-] ) :  Soil porosity  	{OK_SECHIBA}
+POROS =  0.41 
+
+# fr_dT ([K] ) :  Freezing window     	{OK_SECHIBA}
+fr_dT =  2.0 
+
+# OK_SNOWFACT ([FLAG]) :  Activates the smoothering of landscapes by snow, 	{}
+OK_SNOWFACT =  True if OK_FREEZE else false 
+
+# OK_FREEZE_CWRR ([FLAG]) :  CWRR freezing scheme by I. Gouttevin 	{}
+OK_FREEZE_CWRR =  True if OK_FREEZE else false 
+
+# OK_THERMODYNAMICAL_FREEZING ([FLAG]) :  Calculate frozen fraction thermodynamically  	{HYDROL_CWRR .AND. OK_FREEZE_CWRR}
+OK_THERMODYNAMICAL_FREEZING =  True 
+
+# VEGET_UPDATE ([years]) :  Update vegetation frequency 	{MAP_PFT_FORMAT}
+VEGET_UPDATE =  0Y 
+
+# SECHIBA_ZCANOP ([m]) :  Soil level used for canopy development (if STOMATE disactivated) 	{OK_SECHIBA and .NOT. OK_STOMATE  }
+SECHIBA_ZCANOP =  0.5 
+
+# SECHIBA_QSINT  ([m]) :  Interception reservoir coefficient 	{OK_SECHIBA }
+SECHIBA_QSINT  =  0.1 
+
+# DT_STOMATE ([seconds]) :  Time step of STOMATE and other slow processes 	{OK_STOMATE}
+DT_STOMATE =  86400. 
+
+# SECHIBA_VEGMAX ([-]) :  Maximum vegetation distribution within the mesh (0-dim mode) 	{IMPOSE_VEG}
+SECHIBA_VEGMAX =  0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0 
+
+# SECHIBA_FRAC_NOBIO ([-]) :  Fraction of other surface types within the mesh (0-dim mode) 	{IMPOSE_VEG}
+SECHIBA_FRAC_NOBIO =  0.0 
+
+# SECHIBA_LAI ([-]) :  LAI for all vegetation types (0-dim mode) 	{IMPOSE_VEG}
+SECHIBA_LAI =  0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2. 
+
+# SOIL_FRACTIONS ([-]) :  Fraction of the 3 soil types (0-dim mode) 	{IMPOSE_VEG and IMPOSE_SOILT}
+SOIL_FRACTIONS =  -9999._sechiba 
+
+# CLAY_FRACTION ([-] ) :  Fraction of the clay fraction (0-dim mode) 	{IMPOSE_VEG and IMPOSE_SOIL}
+CLAY_FRACTION =  0.2 
+
+# REINF_SLOPE ([-]) :  Slope coef for reinfiltration  	{IMPOSE_VEG}
+REINF_SLOPE =  0.1 
+
+# SLOWPROC_HEIGHT ([m]) :  Height for all vegetation types  	{OK_SECHIBA}
+SLOWPROC_HEIGHT =  0., 30., 30., 20., 20., 20., 15., 15., 15., .5, .6, 1.0, 1.0 
+
+# GET_SLOPE ([FLAG]) :  Read slopes from file and do the interpolation 	{}
+GET_SLOPE =  n 
+
+# LAI_FILE ([FILE]) :  Name of file from which the vegetation map is to be read 	{LAI_MAP}
+LAI_FILE =  lai2D.nc 
+
+# RENORM_LAI ([FLAG]) :  flag to force LAI renormelization 	{LAI_MAP}
+RENORM_LAI =  n 
+
+# VEGETATION_FILE ([FILE]) :  Name of file from which the vegetation map is to be read 	{MAP_PFT_FORMAT}
+VEGETATION_FILE =  PFTmap.nc 
+
+# VEGETATION_FILE ([FILE]) :  Name of file from which the vegetation map is to be read 	{NOT(IMPOSE_VEG) and NOT(MAP_PFT_FORMAT)}
+VEGETATION_FILE =  carteveg5km.nc 
+
+# SOILCLASS_FILE ([FILE]) :  Name of file from which soil types are read 	{NOT(IMPOSE_VEG)}
+SOILCLASS_FILE =  soils_param.nc 
+
+# SLOPE_NOREINF ([-]) :  See slope_noreinf above 	{}
+SLOPE_NOREINF =  0.5 
+
+# TOPOGRAPHY_FILE ([FILE]) :  Name of file from which the topography map is to be read 	{}
+TOPOGRAPHY_FILE =  cartepente2d_15min.nc 
+
+# SOILALB_FILE ([FILE]) :  Name of file from which the bare soil albedo 	{NOT(IMPOSE_AZE)}
+SOILALB_FILE =  soils_param.nc 
+
+# ALB_BG_FILE ([FILE]) :  Name of file from which the background albedo is read  	{}
+ALB_BG_FILE =  alb_bg_jrctip.nc 
+
+# CDRAG_FROM_GCM ([FLAG]) :  Keep cdrag coefficient from gcm. 	{OK_SECHIBA}
+CDRAG_FROM_GCM =  y 
+
+# DIFFUCO_LEAFCI ([ppm]) :  Initial leaf CO2 level if not found in restart 	{OK_SECHIBA}
+DIFFUCO_LEAFCI =  233. 
+
+# N_FERTIL_FILE (- ) :  File name 	{CHEMISTRY_BVOC and NOx_FERTILIZERS_USE}
+N_FERTIL_FILE =  orchidee_fertilizer_1995.nc 
+
+# N_FERTIL_FILE (-) :  File name 	{CHEMISTRY_BVOC and NOx_FERTILIZERS_USE}
+N_FERTIL_FILE =  orchidee_fertilizer_1995.nc 
+
+# ENERBIL_TSURF (Kelvin [K]) :  Initial temperature if not found in restart 	{OK_SECHIBA}
+ENERBIL_TSURF =  280. 
+
+# ENERBIL_EVAPOT () :  Initial Soil Potential Evaporation 	{OK_SECHIBA       }
+ENERBIL_EVAPOT =  0.0 
+
+# BEDROCK_FLAG ([FLAG]) :  Flag to consider bedrock at deeper layers. 	{}
+BEDROCK_FLAG =  0 
+
+# THERMOSOIL_TPRO (Kelvin [K]) :  Initial soil temperature profile if not found in restart 	{OK_SECHIBA}
+THERMOSOIL_TPRO =  280. 
+
+# SOIL_REFTEMP_FILE ([FILE]) :  File with climatological soil temperature 	{READ_REFTEMP}
+SOIL_REFTEMP_FILE =  reftemp.nc 
+
+# HYDROL_OK_HDIFF ([FLAG]) :  do horizontal diffusion? 	{OK_SECHIBA and .NOT.(HYDROL_CWRR)  }
+HYDROL_OK_HDIFF =  n 
+
+# HYDROL_SNOW ([kg/m^2]) :  Initial snow mass if not found in restart 	{OK_SECHIBA}
+HYDROL_SNOW =  0.0 
+
+# HYDROL_SNOWAGE ([days]) :  Initial snow age if not found in restart 	{OK_SECHIBA }
+HYDROL_SNOWAGE =  0.0 
+
+# HYDROL_SNOW_NOBIO ([m]) :  Initial snow amount on ice, lakes, etc. if not found in restart 	{OK_SECHIBA }
+HYDROL_SNOW_NOBIO =  0.0 
+
+# HYDROL_SNOW_NOBIO_AGE ([days]) :  Initial snow age on ice, lakes, etc. if not found in restart 	{OK_SECHIBA }
+HYDROL_SNOW_NOBIO_AGE =  0.0 
+
+# HYDROL_HUMR ([-]) :  Initial soil moisture stress if not found in restart 	{OK_SECHIBA }
+HYDROL_HUMR =  1.0 
+
+# HYDROL_BQSB ([kg/m^2]) :  Initial restart deep soil moisture if not found in restart 	{OK_SECHIBA }
+HYDROL_BQSB =  999999.  
+
+# HYDROL_GQSB ([kg/m^2]) :  Initial upper soil moisture if not found in restart 	{OK_SECHIBA }
+HYDROL_GQSB =  0.0 
+
+# HYDROL_DSG ([m]) :  Initial upper reservoir depth if not found in restart 	{OK_SECHIBA }
+HYDROL_DSG =  0.0 
+
+# HYDROL_QSV ([kg/m^2]) :  Initial water on canopy if not found in restart 	{OK_SECHIBA }
+HYDROL_QSV =  0.0 
+
+# HYDROL_DSP ([m]) :  Initial dry soil above upper reservoir if not found in restart 	{OK_SECHIBA }
+HYDROL_DSP =  999999. 
+
+# HYDROL_TAU_HDIFF ([seconds]) :  time scale (s) for horizontal diffusion of water 	{HYDROL_OK_HDIFF}
+HYDROL_TAU_HDIFF =  86400. 
+
+# CHECK_CWRR ([FLAG]) :  Should we check detailed CWRR water balance ? 	{HYDROL_CWRR}
+CHECK_CWRR =  n 
+
+# DO_PONDS ([FLAG]) :  Should we include ponds  	{HYDROL_CWRR}
+DO_PONDS =  n 
+
+# CWRR_N_VANGENUCHTEN ([-]) :  Van genuchten coefficient n 	{HYDROL_CWRR}
+CWRR_N_VANGENUCHTEN =  1.89, 1.56, 1.31 
+
+# CWRR_A_VANGENUCHTEN ([1/mm]  ) :  Van genuchten coefficient a 	{HYDROL_CWRR}
+CWRR_A_VANGENUCHTEN =  0.0075, 0.0036, 0.0019 
+
+# VWC_RESIDUAL ([m3/m3]  ) :  Residual soil water content 	{HYDROL_CWRR}
+VWC_RESIDUAL =  0.065, 0.078, 0.095 
+
+# VWC_SAT ([m3/m3]  ) :  Saturated soil water content 	{HYDROL_CWRR}
+VWC_SAT =  0.41, 0.43, 0.41 
+
+# CWRR_KS  ([mm/d]   ) :  Hydraulic conductivity Saturation 	{HYDROL_CWRR }
+CWRR_KS  =  1060.8, 249.6, 62.4 
+
+# WETNESS_TRANSPIR_MAX ([-]    ) :  Soil moisture above which transpir is max 	{HYDROL_CWRR}
+WETNESS_TRANSPIR_MAX =  0.5, 0.5, 0.5 
+
+# VWC_FC  ([m3/m3]   ) :  Volumetric water content field capacity 	{HYDROL_CWRR}
+VWC_FC  =  0.32, 0.32, 0.32 
+
+# VWC_WP ([m3/m3]   ) :  Volumetric water content Wilting pt 	{HYDROL_CWRR}
+VWC_WP =  0.10, 0.10, 0.10  
+
+# VWC_MIN_FOR_WET_ALB ([m3/m3]  ) :  Vol. wat. cont. above which albedo is cst 	{HYDROL_CWRR}
+VWC_MIN_FOR_WET_ALB =  0.25, 0.25, 0.25 
+
+# VWC_MAX_FOR_DRY_ALB ([m3/m3]   ) :  Vol. wat. cont. below which albedo is cst 	{HYDROL_CWRR}
+VWC_MAX_FOR_DRY_ALB =  0.1, 0.1, 0.1 
+
+# HYDROL_MOISTURE_CONTENT ([m3/m3]) :  Soil moisture on each soil tile and levels 	{HYDROL_CWRR       }
+HYDROL_MOISTURE_CONTENT =  0.3 
+
+# US_INIT ([-]) :  US_NVM_NSTM_NSLM 	{HYDROL_CWRR       }
+US_INIT =  0.0 
+
+# FREE_DRAIN_COEF ([-]) :  Coefficient for free drainage at bottom, dimension nstm 	{HYDROL_CWRR       }
+FREE_DRAIN_COEF =  1.0 1.0 1.0 
+
+# WATER_TO_INFILT ([mm]) :  Water to be infiltrated on top of the soil 	{HYDROL_CWRR    }
+WATER_TO_INFILT =  0.0 
+
+# EVAPNU_SOIL ([mm]) :  Bare soil evap on each soil if not found in restart 	{HYDROL_CWRR  }
+EVAPNU_SOIL =  0.0 
+
+# HYDROL_SNOW () :  Initial snow mass if not found in restart 	{OK_SECHIBA}
+HYDROL_SNOW =  0.0 
+
+# HYDROL_SNOWAGE (***) :  Initial snow age if not found in restart 	{OK_SECHIBA}
+HYDROL_SNOWAGE =  0.0 
+
+# HYDROL_SNOW_NOBIO ([mm]) :  Initial snow amount on ice, lakes, etc. if not found in restart 	{OK_SECHIBA}
+HYDROL_SNOW_NOBIO =  0.0 
+
+# HYDROL_SNOW_NOBIO_AGE (***) :  Initial snow age on ice, lakes, etc. if not found in restart 	{OK_SECHIBA}
+HYDROL_SNOW_NOBIO_AGE =  0.0 
+
+# HYDROL_QSV ([mm]) :  Initial water on canopy if not found in restart 	{OK_SECHIBA}
+HYDROL_QSV =  0.0 
+
+# CWRR_NKS_N0  ([-]) :  fitted value for relation log((n-n0)/(n_ref-n0))  	{HYDROL_CWRR }
+CWRR_NKS_N0  =  0.95 
+
+# CWRR_NKS_POWER ([-]) :  fitted value for relation log((n-n0)/(n_ref-n0))  	{HYDROL_CWRR }
+CWRR_NKS_POWER =  0.34 
+
+# CWRR_AKS_A0  ([1/mm]) :  fitted value for relation log((a-a0)/(a_ref-a0))  	{HYDROL_CWRR }
+CWRR_AKS_A0  =  0.00012 
+
+# CWRR_AKS_POWER ([-]) :  fitted value for relation log((a-a0)/(a_ref-a0))  	{HYDROL_CWRR }
+CWRR_AKS_POWER =  0.53 
+
+# KFACT_DECAY_RATE ([1/m]) :  Factor for Ks decay with depth 	{HYDROL_CWRR }
+KFACT_DECAY_RATE =  2.0 
+
+# KFACT_STARTING_DEPTH ([m]) :  Depth for compacted value of Ks  	{HYDROL_CWRR }
+KFACT_STARTING_DEPTH =  0.3 
+
+# KFACT_MAX ([-]) :  Maximum Factor for Ks increase due to vegetation 	{HYDROL_CWRR }
+KFACT_MAX =  10.0 
+
+# DT_ROUTING  ([seconds]) :  Time step of the routing scheme 	{RIVER_ROUTING}
+DT_ROUTING  =  86400. 
+
+# ROUTING_RIVERS ([-]) :  Number of rivers  	{RIVER_ROUTING}
+ROUTING_RIVERS =  50 
+
+# DO_FLOODINFILT ([FLAG]) :  Should floodplains reinfiltrate into the soil  	{RIVER_ROUTING}
+DO_FLOODINFILT =  n 
+
+# DO_SWAMPS ([FLAG]) :  Should we include swamp parameterization  	{RIVER_ROUTING}
+DO_SWAMPS =  n 
+
+# DO_PONDS ([FLAG]) :  Should we include ponds  	{RIVER_ROUTING}
+DO_PONDS =  n 
+
+# SLOW_TCST ([days]) :  Time constant for the slow reservoir  	{RIVER_ROUTING }
+SLOW_TCST =  n 
+
+# FAST_TCST ([days]) :  Time constant for the fast reservoir  	{RIVER_ROUTING }
+FAST_TCST =  fast_tcst_cwrr or fast_tcst_chois depending on flag HYDROL_CWRR 
+
+# STREAM_TCST ([days]) :  Time constant for the stream reservoir  	{RIVER_ROUTING}
+STREAM_TCST =  stream_tcst_cwrr or stream_tcst_chois depending on flag HYDROL_CWRR 
+
+# FLOOD_TCST ([days]) :  Time constant for the flood reservoir  	{RIVER_ROUTING}
+FLOOD_TCST =  4.0 
+
+# SWAMP_CST ([-]) :  Fraction of the river that flows back to swamps  	{RIVER_ROUTING}
+SWAMP_CST =  0.2 
+
+# FLOOD_BETA ([-] ) :  Parameter to fix the shape of the floodplain   	{RIVER_ROUTING}
+FLOOD_BETA =  2.0 
+
+# POND_BETAP ([-] ) :  Ratio of the basin surface intercepted by ponds and the maximum surface of ponds 	{RIVER_ROUTING}
+POND_BETAP =  0.5 
+
+# FLOOD_CRI ([mm] ) :  Potential height for which all the basin is flooded 	{DO_FLOODPLAINS or DO_PONDS}
+FLOOD_CRI =  2000. 
+
+# POND_CRI ([mm] ) :  Potential height for which all the basin is a pond 	{DO_FLOODPLAINS or DO_PONDS}
+POND_CRI =  2000. 
+
+# RIVER_DESC ([FLAG]) :  Writes out a description of the rivers 	{RIVER_ROUTING}
+RIVER_DESC =  n 
+
+# RIVER_DESC_FILE ([FILE]) :  Filename in which we write the description of the rivers. If suffix is ".nc" a netCDF file is created 	{RIVER_DESC}
+RIVER_DESC_FILE =  river_desc.nc 
+
+# ROUTING_FILE ([FILE]) :  Name of file which contains the routing information 	{RIVER_ROUTING}
+ROUTING_FILE =  routing.nc 
+
+# IRRIGATION_FILE ([FILE]) :  Name of file which contains the map of irrigated areas 	{DO_IRRIGATION OR DO_FLOODPLAINS}
+IRRIGATION_FILE =  floodplains.nc 
+
+# EPS_CARBON ([%]   ) :  Allowed error on carbon stock 	{SPINUP_ANALYTIC}
+EPS_CARBON =  0.01 
+
+# SPINUP_PERIOD ([years]   ) :  Period to calulcate equilibrium during spinup analytic 	{SPINUP_ANALYTIC}
+SPINUP_PERIOD =  -1 
+
+# STOMATE_FORCING_NAME ([FILE]) :  Name of STOMATE's forcing file 	{OK_STOMATE}
+STOMATE_FORCING_NAME =  NONE 
+
+# STOMATE_FORCING_MEMSIZE ([MegaBytes]) :  Size of STOMATE forcing data in memory  	{OK_STOMATE}
+STOMATE_FORCING_MEMSIZE =  50 
+
+# STOMATE_CFORCING_NAME ([FILE]) :  Name of STOMATE's carbon forcing file 	{OK_STOMATE}
+STOMATE_CFORCING_NAME =  NONE 
+
+# FORCESOIL_STEP_PER_YEAR ([days, months, year]) :  Number of time steps per year for carbon spinup. 	{OK_STOMATE}
+FORCESOIL_STEP_PER_YEAR =  365 
+
+# FORCESOIL_NB_YEAR ([years]) :  Number of years saved for carbon spinup. 	{OK_STOMATE}
+FORCESOIL_NB_YEAR =  1 
+
+# XIOS_ORCHIDEE_OK ([FLAG]) :  Use XIOS for writing diagnostics file 	{}
+XIOS_ORCHIDEE_OK =  y  
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/AA_make	(revision 5166)
@@ -0,0 +1,66 @@
+#-
+#- $Id$
+#-
+MODS1 = dim2_driver.f90 \
+        weather.f90 \
+        readdim2.f90 \
+        teststomate.f90 \
+        forcesoil.f90 \
+        getprec.f90
+
+all : orchidee_ol teststomate forcesoil
+
+orchidee_ol:
+	$(M_K) m_orchidee_ol
+	@echo orchidee_ol is OK
+
+m_orchidee_ol: $(BINDIR)/orchidee_ol
+$(BINDIR)/orchidee_ol: \
+  $(SXIOIPSL_LIB) $(SXPARAM_LIB) $(SXPARALLEL_LIB) $(SXORGLOB_LIB) $(SXSTOMATE_LIB) $(SXSECHIBA_LIB) \
+  $(MODEL_LIB)(weather.o) $(MODEL_LIB)(readdim2.o) \
+  $(MODEL_LIB)(dim2_driver.o)
+	$(A_G) $(MODEL_LIB) dim2_driver.o
+	$(F_L) -o $(BINDIR)/orchidee_ol dim2_driver.o $(L_O) \
+          $(SXMODEL_LIB) $(SXSECHIBA_LIB) $(SXSTOMATE_LIB) \
+          $(SXPARALLEL_LIB) $(SXORGLOB_LIB) $(SXPARAM_LIB) $(SXIOIPSL_LIB) $(NCDF_LIB) 
+	$(RM) dim2_driver.o
+
+teststomate:
+	$(M_K) m_teststomate
+	@echo teststomate is OK
+
+m_teststomate: $(BINDIR)/teststomate
+$(BINDIR)/teststomate: \
+  $(SXIOIPSL_LIB) $(SXPARALLEL_LIB) $(SXPARAM_LIB) $(SXORGLOB_LIB) $(SXSTOMATE_LIB) $(SXSECHIBA_LIB) \
+  $(MODEL_LIB)(teststomate.o)
+	$(A_G) $(MODEL_LIB) teststomate.o
+	$(F_L) -o $(BINDIR)/teststomate teststomate.o $(L_O) \
+          $(SXMODEL_LIB) $(SXSECHIBA_LIB) $(SXSTOMATE_LIB) \
+          $(SXPARALLEL_LIB) $(SXORGLOB_LIB) $(SXPARAM_LIB) $(SXIOIPSL_LIB) $(NCDF_LIB)
+	$(RM) teststomate.o
+
+forcesoil:
+	$(M_K) m_forcesoil
+	@echo m_forcesoil is OK
+
+m_forcesoil: $(BINDIR)/forcesoil
+$(BINDIR)/forcesoil: \
+  $(SXIOIPSL_LIB) $(SXPARALLEL_LIB) $(SXPARAM_LIB) $(SXORGLOB_LIB) $(SXSTOMATE_LIB) $(SXSECHIBA_LIB) \
+  $(MODEL_LIB)(forcesoil.o)
+	$(A_G) $(MODEL_LIB) forcesoil.o
+	$(F_L) -o $(BINDIR)/forcesoil forcesoil.o $(L_O) \
+          $(SXMODEL_LIB) $(SXSECHIBA_LIB) $(SXSTOMATE_LIB) \
+          $(SXPARALLEL_LIB) $(SXORGLOB_LIB) $(SXPARAM_LIB) $(SXIOIPSL_LIB) $(NCDF_LIB)
+	$(RM) forcesoil.o
+
+libioipsl:
+	(cd ../../IOIPSL/src; $(M_K) -f Makefile)
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(%.o): %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(RM) $*.o
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/AA_make.ldef	(revision 5166)
@@ -0,0 +1,49 @@
+#-
+#- $Id$
+#-
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+MODDIR = $(LIBDIR)
+BINDIR = ../../../bin
+SCPDIR = ../../scripts
+ORDIR  = ..
+#---------------------------------------------------------------------
+MODEL_LIB = $(LIBDIR)/liborchidee.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec SXMODEL_LIB = $(LIBDIR)/libsxorchidee.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxorchidee.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxorchidee.a
+#-
+IOIPSL_LIB = $(LIBDIR)/libioipsl.a
+SXIOIPSL_LIB = $(IOIPSL_LIB)
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+ORGLOB_LIB = $(LIBDIR)/liborglob.a
+SXORGLOB_LIB = $(ORGLOB_LIB)
+#-Q- sxnec  SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-
+SECHIBA_LIB = $(LIBDIR)/libsechiba.a
+SXSECHIBA_LIB = $(SECHIBA_LIB)
+#-Q- sxnec SXSECHIBA_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- sx6nec SXSECHIBA_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- sx8brodie SXSECHIBA_LIB = $(LIBDIR)/libsxsechiba.a
+#-
+STOMATE_LIB = $(LIBDIR)/libstomate.a
+SXSTOMATE_LIB = $(STOMATE_LIB)
+#-Q- sxnec SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx6nec SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx8brodie SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/dim2_driver.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/dim2_driver.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/dim2_driver.f90	(revision 5166)
@@ -0,0 +1,1776 @@
+PROGRAM driver
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!- IPSL (2006)
+!-  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!---------------------------------------------------------------------
+!- This PROGRAM is the driver of the dim2 version of SECHIBA. It's
+!- main use is for PILPS type experiments. To run it you need to have
+!- the following software :
+!- - SECHIBA
+!- - ioipsl
+!- - netcdf
+!- - F90 compiler
+!- - tk (optional but very useful for configuring the model)
+!- Obviously also the associated Makefiles.
+!-
+!- The forcing data needs to be in netCDF format and should
+!- contain the following variables :
+!- - Incoming SW radiation
+!- - Incoming LW radiation
+!- - Precipitation
+!- - Air temperature at a reference level
+!- - Air humidity at the same level
+!- - wind at the same level
+!- - surface pressure
+!-
+!- Once you have all this and compiled the model you can configure it.
+!- Type make config and set all the values presented in the menu.
+!- This tool will create a run.def which will be used by the model.
+!- The run.def can also be edited by hand but it is more tedious.
+!- Once this run.def is created the model is ready to run.
+!---------------------------------------------------------------------
+  USE netcdf
+  USE ioipsl_para
+  USE grid
+  USE intersurf,  ONLY : intersurf_main_2d, intersurf_initialize_2d
+  USE constantes
+  USE constantes_soil
+  USE readdim2
+  USE mod_orchidee_para
+  USE timer
+!  USE control
+!-
+  IMPLICIT NONE
+!-
+  INTEGER :: iim, jjm, llm
+  INTEGER :: im, jm, lm, tm, is, force_id, itest, jtest
+  REAL :: dt, dt_force, dt_rest, date0, date0_rest
+  REAL :: zlflu
+  REAL :: alpha
+!-
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+ & swdown, coszang, precip_rain, precip_snow, tair_obs, u, v, &
+ & qair_obs, pb, lwdown, &
+ & eair_obs, zlev_vec, zlevuv_vec, relax
+!- Variables which are forcings for SECHIBA
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+ & petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, &
+ & for_u, for_v, for_swnet, for_swdown, for_coszang, for_lwdown, &
+ & for_psurf, for_qair, for_tair, for_eair, &
+ & for_ccanopy, for_rau
+!!$, tmp_eair, tmp_tair, &
+!!$ & tmp_qair, tmp_pb
+!-
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+ & for_contfrac, old_zlev, old_qair, old_eair, tsol_rad, vevapp, &
+ & temp_sol_NEW, temp_sol_old, qsurf, dtdt, coastalflow, riverflow, &
+ & fluxsens, fluxlat, emis, z0
+!!$, epot_sol
+!-
+  INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: for_neighbours
+!-
+  REAL, ALLOCATABLE, DIMENSION(:,:,:) :: for_resolution
+!  REAL, ALLOCATABLE, DIMENSION(:,:,:) :: soil_mc
+!  REAL, ALLOCATABLE, DIMENSION(:,:) :: litter_mc
+!-
+  REAL, ALLOCATABLE, DIMENSION(:,:,:) :: albedo
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: albedo_vis
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: albedo_nir
+!-
+  INTEGER, ALLOCATABLE, DIMENSION(:) :: kindex
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: lon, lat
+  REAL, ALLOCATABLE, DIMENSION(:)   :: tmplev
+!-
+  REAL :: old_tair
+  REAL :: atmco2
+  INTEGER :: nbindex
+  REAL :: julian, ss
+  INTEGER :: yy, mm, dd
+!-
+  LOGICAL :: relaxation
+!-
+  CHARACTER(LEN=80) :: filename, driv_restname_in, driv_restname_out
+  CHARACTER(LEN=30) :: time_str, var_name
+!-
+  INTEGER :: it, istp, istp_old, rest_id, it_force
+!-
+  INTEGER :: split, split_start, nb_spread, for_offset
+  INTEGER :: itau_dep, itau_dep_rest, itau_fin, itau_skip, itau_len
+
+  INTEGER,DIMENSION(2) :: ml
+!-
+  LOGICAL :: last_CALL, first_CALL
+  LOGICAL :: no_inter, inter_lin, netrad_cons
+!-
+  ! to check variables passed to intersurf
+  INTEGER :: ik
+  INTEGER :: i,j
+  INTEGER :: printlev_loc  !! local write level
+
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+  & fluxsens_g,vevapp_g,old_zlev_g,old_qair_g,old_eair_g,for_rau_g, &
+  & petAcoef_g, petBcoef_g,peqAcoef_g,peqBcoef_g,albedo_g,z0_g
+  LOGICAL :: Flag
+  LOGICAL :: driver_reset_time
+
+  REAL :: fill_init
+
+  fill_init=REAL(nf90_fill_real,r_std)
+  CALL ioconf_expval(val_exp)
+!-
+! Init parallelism
+
+  CALL Init_orchidee_para
+  CALL init_timer
+  CALL start_timer(timer_global)
+  CALL start_timer(timer_mpi)
+
+! Set specific write level to dim2_driver using PRINTLEV_dim2_driver=[0-4] 
+! in run.def. The global printlev is used as default value. 
+  printlev_loc=get_printlev('dim2_driver')
+
+!=====================================================================
+!- 1.0 This section defines the general set-up of the experiment :
+!-   - Forcing data to be used with its time step
+!-   - Restart file to be used
+!-   - The time step that will be used
+!-   - The starting date of the simulation
+!-   - Length of integration
+!-   - Basic flags for SSIPSL
+!=====================================================================
+!- 1.1 Initialize the driving variables. It essentialy gets the mode
+!-     used and the size of the driving variables.
+!=====================================================================
+  IF (printlev_loc>=3) WRITE(numout,*) 'Reading name of the forcing file'
+!- 
+ !Config Key   = FORCING_FILE
+ !Config Desc  = Name of file containing the forcing data
+ !Config If    = [-]
+ !Config Def   = forcing_file.nc
+ !Config Help  = This is the name of the file which should be opened
+ !Config         for reading the forcing data of the dim0 model.
+ !Config         The format of the file has to be netCDF and COADS
+ !Config         compliant.
+ !Config Units = [FILE] 
+!- 
+  filename='forcing_file.nc'
+  CALL getin_p('FORCING_FILE',filename)
+!-
+  IF (printlev_loc>=3) WRITE(numout,*) 'Opening forcing file'
+!-
+! We call flininfo to obtain the dimensions
+! of iim, jjm and others.
+! This information will allow us to allocate all the space needed.
+!-
+  CALL forcing_info &
+ &  (filename, iim, jjm, llm, tm, date0, dt_force, force_id) 
+!-
+  WRITE(numout,*) 'Out of flininfo : date0 ', date0, &
+       'iim, jjm, llm, tm',iim,jjm,llm,tm,' dt_force ',dt_force
+!-
+  CALL init_ioipsl_para
+!-
+  IF (printlev_loc>=3) THEN
+    WRITE(numout,*) 'Allocate memory for the driver :', iim, jjm, llm
+  ENDIF
+!-
+  ALLOCATE (tmplev(llm)) 
+  tmplev(:)=0.
+
+  ALLOCATE &
+ & (swdown(iim,jjm), coszang(iim,jjm), precip_rain(iim,jjm), precip_snow(iim,jjm), &
+ &  tair_obs(iim,jjm), u(iim,jjm), v(iim,jjm), qair_obs(iim,jjm), &
+ &  pb(iim,jjm), lwdown(iim,jjm), &
+ &  eair_obs(iim,jjm), zlev_vec(iim,jjm), zlevuv_vec(iim,jjm), relax(iim,jjm))
+!- 
+  ALLOCATE &
+ & (petAcoef(iim,jjm), peqAcoef(iim,jjm), &
+ &  petBcoef(iim,jjm), peqBcoef(iim,jjm), &
+ &  cdrag(iim,jjm), for_u(iim,jjm), for_v(iim,jjm), &
+ &  for_swnet(iim,jjm), for_swdown(iim,jjm), for_coszang(iim,jjm), for_lwdown(iim,jjm), &
+ &  for_psurf(iim,jjm), for_qair(iim,jjm), for_tair(iim,jjm), &
+ &  for_eair(iim,jjm), for_ccanopy(iim,jjm), for_rau(iim,jjm))
+!!$, &
+!!$ &  tmp_eair(iim,jjm), tmp_tair(iim,jjm), &
+!!$ &  tmp_qair(iim,jjm), tmp_pb(iim,jjm))
+!-
+  ALLOCATE &
+ & (for_contfrac(iim,jjm), for_neighbours(iim,jjm,8), for_resolution(iim,jjm,2), &
+ &  old_zlev(iim,jjm), old_qair(iim,jjm), old_eair(iim,jjm), &
+ &  tsol_rad(iim,jjm), vevapp(iim,jjm), &
+ &  temp_sol_NEW(iim,jjm), temp_sol_old(iim,jjm), &
+ &  dtdt(iim,jjm), coastalflow(iim,jjm), riverflow(iim,jjm), &
+ &  fluxsens(iim,jjm), fluxlat(iim,jjm), emis(iim,jjm), &
+ &  z0(iim,jjm), qsurf(iim,jjm))
+! &  z0(iim,jjm),qsurf(iim,jjm),soil_mc(iim*jjm,nbdl,nstm),litter_mc(iim*jjm,nstm))
+!!$, epot_sol(iim,jjm)
+!-
+  ALLOCATE(albedo(iim,jjm,2))
+  ALLOCATE(albedo_vis(iim,jjm),albedo_nir(iim,jjm))
+!-
+  ALLOCATE(kindex(iim*jjm))
+  ALLOCATE(lon(iim,jjm), lat(iim,jjm))
+!-- 
+  swdown(:,:) = fill_init
+  precip_rain(:,:) = 0.0
+  precip_snow(:,:) = 0.0
+  tair_obs(:,:) = 0.0
+  u(:,:) = fill_init
+  v(:,:) = fill_init
+  qair_obs(:,:) = fill_init
+  pb(:,:) = fill_init
+  lwdown(:,:) = fill_init
+  eair_obs(:,:) = fill_init
+  zlev_vec(:,:) = 0.0
+  zlevuv_vec(:,:) = 0.0
+  relax(:,:) = 0.0
+  petAcoef(:,:) = 0.0
+  peqAcoef(:,:) = 0.0
+  petBcoef(:,:) = 0.0
+  peqBcoef(:,:) = 0.0
+  cdrag(:,:) = 0.0
+  for_u(:,:) = fill_init
+  for_v(:,:) = fill_init
+  for_swnet(:,:) = fill_init
+  for_swdown(:,:) = fill_init
+  for_lwdown(:,:) = fill_init
+  for_psurf(:,:) = fill_init
+  for_qair(:,:) = fill_init
+  for_tair(:,:) = fill_init
+  for_eair(:,:) = fill_init
+  for_ccanopy(:,:) = 0.0
+  for_rau(:,:) = fill_init
+  for_contfrac(:,:) = 0.0
+  for_neighbours(:,:,:) = 0
+  for_resolution(:,:,:) = 0.0
+!  soil_mc(:,:,:) = 0.0
+!  litter_mc(:,:) = 0.0
+  old_zlev(:,:) = 0.0
+  old_qair(:,:) = 0.0
+  old_eair(:,:) = 0.0
+  tsol_rad(:,:) = 0.0
+  vevapp(:,:) = 0.0
+  temp_sol_NEW(:,:) = fill_init
+  temp_sol_old(:,:) = fill_init
+  dtdt(:,:) = 0.0
+  coastalflow(:,:) = 0.0
+  riverflow(:,:) = 0.0
+  fluxsens(:,:) = fill_init
+  fluxlat(:,:) = fill_init
+  emis(:,:) = 0.0
+  z0(:,:) = fill_init
+  qsurf(:,:) = 0.0
+  albedo(:,:,:) = fill_init
+  albedo_vis(:,:) = fill_init
+  albedo_nir(:,:) = fill_init
+  kindex(:) = 0
+  lon(:,:) = 0.0
+  lat(:,:) = 0.0
+!-
+! We need to know the grid.
+! Then we can initialize the restart files, and then we
+! can give read the restart files in the forcing subroutine.
+!-
+  CALL forcing_grid (iim,jjm,llm,lon,lat,init_f=.FALSE.)
+!=====================================================================
+!- 1.2 Time step to be used.
+!-     This is relative to the time step of the  forcing data
+!=====================================================================
+  IF ( .NOT. weathergen ) THEN
+     !Config Key   = DT_SECHIBA
+     !Config Desc  = Time-step of the SECHIBA component
+     !Config If    = NOT(WEATHERGEN)
+     !Config Def   = 1800.
+     !Config Help  = Determines the time resolution at which
+     !Config         the calculations in the SECHIBA component
+     !Config         are done
+     !Config Units = [seconds]
+     dt = 1800
+     CALL getin_p('DT_SECHIBA', dt)
+     split = INT(dt_force/dt)
+     WRITE(numout,*) 'Time step in forcing file: dt_force=',dt_force
+     WRITE(numout,*) 'Time step in sechiba component: dt_sechiba=',dt
+     WRITE(numout,*) 'Splitting of each forcing time step: split=',split
+     
+     IF ( split .LT. 1. ) THEN
+        CALL ipslerr_p ( 3, 'dim2_driver',&
+             'Time step of the forcing file is higher than the time step in sechiba',&
+             'Please, modify DT_SECHIBA parameter value !','')     
+     END IF
+  ELSE
+     ! Case weathergen: 
+     ! The model time step in sechiba is always the same as the forcing time step
+     dt = dt_force
+     split = 1
+  ENDIF
+
+!=====================================================================
+!- 1.3 Initialize the restart file for the driver
+!=====================================================================
+  !Config Key   = RESTART_FILEIN
+  !Config Desc  = Name of restart to READ for initial conditions
+  !Config If    = [-]
+  !Config Def   = NONE
+  !Config Help  = This is the name of the file which will be opened
+  !Config         to extract the initial values of all prognostic
+  !Config         values of the model. This has to be a netCDF file.
+  !Config         Not truly COADS compliant. NONE will mean that
+  !Config         no restart file is to be expected.
+  !Config Units = [FILE]
+!-
+  driv_restname_in = 'NONE'
+  CALL getin_p('RESTART_FILEIN',driv_restname_in)
+  if (printlev_loc>=3) WRITE(numout,*) 'INPUT RESTART_FILE : ',TRIM(driv_restname_in)
+!-
+  !Config Key   = RESTART_FILEOUT
+  !Config Desc  = Name of restart files to be created by the driver
+  !Config If    = [-]
+  !Config Def   = driver_rest_out.nc
+  !Config Help  = This variable give the  name for
+  !Config         the restart files. The restart software within
+  !Config         IOIPSL will add .nc if needed
+  !Config Units = [FILE]
+!-
+  driv_restname_out = 'driver_rest_out.nc'
+  CALL getin_p('RESTART_FILEOUT', driv_restname_out)
+  if (printlev_loc>=3) WRITE(numout,*) 'OUTPUT RESTART_FILE : ',TRIM(driv_restname_out)
+!-
+! Set default values for the start and end of the simulation
+! in the forcing chronology.
+
+  CALL gather2D_mpi(lon,lon_g)
+  CALL gather2D_mpi(lat,lat_g)
+
+
+  !Config Key   = DRIVER_reset_time
+  !Config Desc  = Overwrite time values from the driver restart file
+  !Config If    = [-]
+  !Config Def   = n
+  !Config Units = [FLAG]
+  
+  driver_reset_time=.FALSE.
+  CALL getin_p('DRIVER_reset_time', driver_reset_time)
+  IF (printlev_loc>=3) WRITE(numout,*) 'driver_reset_time=',driver_reset_time
+
+  IF (is_root_prc) THEN
+     ! Set default values for the time variables
+     itau_dep_rest = 0
+     date0_rest = date0
+     dt_rest = dt
+
+     IF (printlev_loc>=3) WRITE(numout,*) &
+          'Before driver restart file initialization : itau_dep_rest, date0_rest, dt_rest = ', &
+          itau_dep_rest, date0_rest, dt_rest
+
+     CALL restini &
+          (driv_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, tmplev, &
+          driv_restname_out, itau_dep_rest, date0_rest, dt_rest, rest_id, driver_reset_time)
+
+     IF (printlev_loc>=3) WRITE(numout,*) &
+          'After driver restart file initialization : itau_dep_rest, date0_rest, dt_rest = ', &
+          itau_dep_rest, date0_rest, dt_rest
+
+     IF (itau_dep_rest == 0 .OR. driver_reset_time) THEN
+        ! Restart file did not exist or we decide to overwrite time values in it.
+        ! Set time values to read the begining of the forcing file.
+        itau_dep=0
+        itau_fin=tm
+        date0_rest = date0
+     ELSE
+        ! Take time values from restart file
+        itau_dep = itau_dep_rest
+        itau_fin = itau_dep+tm
+     ENDIF
+
+     WRITE(numout,*) &
+          'Restart file initialized : itau_dep, itau_fin, date0_rest, dt_rest = ', &
+          itau_dep, itau_fin, date0_rest, dt_rest
+  ENDIF
+
+  ! Communicate values from root_prc to all the others
+  CALL bcast (itau_dep_rest)
+  CALL bcast (itau_dep)
+  CALL bcast (itau_fin)
+  CALL bcast (date0_rest)
+  CALL bcast (dt_rest)
+
+
+!=====================================================================
+!- 1.4 Here we do the first real reading of the driving. It only
+!-     gets a few variables.
+!=====================================================================
+
+! prepares kindex table from the information obtained
+! from the forcing data and reads some initial values for
+! temperature, etc.
+!- 
+  kindex(1) = 1
+!-
+  CALL forcing_READ &
+ &  (filename, rest_id, .TRUE., .FALSE., &
+ &   0, itau_dep, 0, split, nb_spread, netrad_cons, &
+ &   date0, dt_force, iim, jjm, lon, lat, zlev_vec, zlevuv_vec, tm, &
+ &   swdown, coszang, precip_rain, precip_snow, tair_obs, &
+ &   u, v, qair_obs, pb, lwdown, for_contfrac, for_neighbours, for_resolution, &
+ &   for_swnet, eair_obs, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, for_ccanopy, &
+ &   kindex, nbindex, force_id)
+!-
+  WRITE (numout,*) ">> Number of land points =",nbindex
+  IF (nbindex == 0) THEN
+     WRITE(numout,*) "Limits : (W,E / N,S)", limit_west, limit_east, &
+          &                             limit_north, limit_south
+     CALL ipslerr_p ( 3, 'dim2_driver','number of land points error.', &
+          &         ' is zero !','stop driver')
+  ENDIF
+
+  jlandindex = (((kindex(1:nbindex)-1)/iim) + 1)
+  ilandindex = (kindex(1:nbindex) - (jlandindex(1:nbindex)-1)*iim)
+  IF (printlev_loc>=4) THEN
+     WRITE(numout,*) "kindex of land points : ", kindex(1:nbindex)
+     WRITE(numout,*) "index i of land points : ", ilandindex
+     WRITE(numout,*) "index j of land points : ", jlandindex 
+  ENDIF
+
+  im = iim; jm = jjm; lm = llm;
+  IF ( (iim > 1).AND.(jjm > 1) ) THEN
+    jtest = INT((kindex(INT(nbindex/2))-1)/iim)+1
+    itest = MAX( 1, kindex(INT(nbindex/2))-(jtest-1)*iim )
+  ELSE
+    jtest = 1
+    itest = 1
+  ENDIF
+  IF (printlev_loc>=3) WRITE(numout,*) "test point in dim2_driver : ",itest,jtest
+!-
+  IF ((im /= iim) .AND. (jm /= jjm) .AND. (lm /= llm))  THEN
+    WRITE(numout,*) ' dimensions are not good. Verify FILE :'
+    WRITE(numout,*) ' filename = ',filename
+    WRITE(numout,*) ' im, jm, lm lus         = ', im, jm, lm
+    WRITE(numout,*) ' iim, jjm, llm demandes = ', iim, jjm, llm
+    CALL ipslerr_p(3,'dim2_driver','Pb in dimensions','','')
+  ENDIF  
+!=====================================================================
+!- 1.5  Configures the time-steps and other parameters 
+!-      of the run.
+!=====================================================================
+!-
+! If the time steping of the restart is different from the one
+! of the forcing we need to convert the itau_dep into the
+! chronology of the forcing. This ensures that the forcing will
+! start at the date of the restart file. Obviously the itau_fin
+! needs to be shifted as well !
+!-
+  IF ( (dt_rest /= dt_force).AND.(itau_dep > 1) ) THEN
+    itau_dep = NINT((itau_dep*dt_rest )/dt_force)
+    itau_fin = itau_dep+tm
+    if (printlev_loc>=3) WRITE(numout,*) &
+ & 'The time steping of the restart is different from the one ',&
+ & 'of the forcing we need to convert the itau_dep into the ',&
+ & 'chronology of the forcing. This ensures that the forcing will ',&
+ & 'start at the date of the restart file. Obviously the itau_fin ',&
+ & 'needs to be shifted as well : itau_dep, itau_fin ', &
+ & itau_dep, itau_fin
+  ENDIF
+!-
+! Same things if the starting dates are not the same.
+! Everything should look as if we had only one forcing file !
+!-
+  IF (date0 /= date0_rest) THEN
+    WRITE(numout,*) 'date0_rest , date0 : ',date0_rest , date0
+    for_offset = NINT((date0_rest-date0)*one_day/dt_force)
+  ELSE
+    for_offset = 0
+  ENDIF
+  WRITE(numout,*) 'OFFSET FOR THE data read :', for_offset
+
+  CALL ioconf_startdate(date0_rest)
+!-
+  !Config Key   = TIME_SKIP
+  !Config Desc  = Time in the forcing file at which the model is started.
+  !Config If    = [-]
+  !Config Def   = 0
+  !Config Help  = This time give the point in time at which the model
+  !Config         should be started. If exists, the date of the restart file is use.
+  !Config         The FORMAT of this date can be either of the following :
+  !Config         n   : time step n within the forcing file
+  !Config         nS  : n seconds after the first time-step in the file
+  !Config         nD  : n days after the first time-step
+  !Config         nM  : n month after the first time-step (year of 365 days)
+  !Config         nY  : n years after the first time-step (year of 365 days)
+  !Config         Or combinations :
+  !Config         nYmM: n years and m month
+  !Config Units = [seconds, days, months, years]
+!-
+  itau_skip = 0
+  WRITE(time_str,'(I10)') itau_skip
+  CALL getin_p('TIME_SKIP', time_str)
+!-
+! Transform into itau
+!-
+  CALL tlen2itau (time_str, dt_force, date0, itau_skip)
+!-
+  itau_dep = itau_dep+itau_skip
+!-
+! We need to select the right position of the splited time steps.
+!-
+  istp = itau_dep*split+1
+  IF (MOD(istp-1,split) /= 0) THEN
+    split_start = MOD(istp-1,split)+1
+  ELSE
+    split_start = 1
+  ENDIF
+  istp_old = itau_dep_rest
+!!$  it_force = MAX(MOD(itau_dep,INT(one_day*one_year/dt_force)),1)+itau_skip
+!!$  WRITE(numout,*) 'itau_dep, it_force :', itau_dep, it_force
+!-
+  itau_len = itau_fin-itau_dep
+!-
+  !Config Key   = TIME_LENGTH
+  !Config Desc  = Length of the integration in time.
+  !Config If    = [-]
+  !Config Def   = Full length of the forcing file 
+  !Config Help  = Length of integration. By default the entire length
+  !Config         of the forcing is used. The FORMAT of this date can
+  !Config         be either of the following :
+  !Config         n   : time step n within the forcing file
+  !Config         nS  : n seconds after the first time-step in the file
+  !Config         nD  : n days after the first time-step
+  !Config         nM  : n month after the first time-step (year of 365 days)
+  !Config         nY  : n years after the first time-step (year of 365 days)
+  !Config         Or combinations :
+  !Config         nYmM: n years and m month
+  !Config Units = [seconds, days, months, years]
+!-
+  WRITE(time_str,'(I10)') itau_len
+  CALL getin_p('TIME_LENGTH', time_str)
+!-
+! Transform into itau
+!-
+  CALL tlen2itau (time_str, dt_force, date0, itau_len)
+!-
+  itau_fin = itau_dep+itau_len
+!-
+  WRITE(numout,*) '>> Time origine in the forcing file :', date0
+  WRITE(numout,*) '>> Time origine in the restart file :', date0_rest
+  WRITE(numout,*) '>> Simulate starts at forcing time-step : ', itau_dep
+  WRITE(numout,*) '>> The splited time-steps start at (Sets the '
+  WRITE(numout,*) '>>  chronology for the history and restart files):',istp
+  WRITE(numout,*) '>> The time spliting starts at :', split_start
+  WRITE(numout,*) '>> Simulation ends at forcing time-step: ', itau_fin
+  WRITE(numout,*) '>> Length of the simulation is thus :', itau_len
+  WRITE(numout,*) '>> Length of the forcing data is in time-steps : ', tm
+  IF (tm < itau_len) THEN
+     CALL ipslerr_p ( 2, 'dim2_driver','Length of the simulation is greater than.', &
+ &         ' Length of the forcing data is in time-steps','verify TIME_LENGTH parameter.')
+  ENDIF
+  WRITE(numout,*) '>> Time steps : true, forcing and restart : ', dt,dt_force,dt_rest
+
+!=====================================================================
+!- 2.0 This section is going to define the details by which
+!-     the input data is going to be used to force the
+!-     land-surface scheme. The tasks are the following :
+!-   - Is the coupling going to be explicit or implicit
+!-   - Type of interpolation to be used.
+!-   - At which height are the atmospheric forcings going to be used ?
+!-   - Is a relaxation method going to be used on the forcing
+!-   - Does net radiation in the interpolated data need to be conserved
+!-   - How do we distribute precipitation.
+!=====================================================================
+  !Config Key   = RELAXATION
+  !Config Desc  = method of forcing
+  !Config If    = [-]
+  !Config Def   = n
+  !Config Help  = A method is proposed by which the first atmospheric
+  !Config         level is not directly forced by observations but
+  !Config         relaxed with a time constant towards observations.
+  !Config         For the moment the methods tends to smooth too much
+  !Config         the diurnal cycle and introduces a time shift.
+  !Config         A more sophisticated method is needed.
+  !Config Units = [FLAG]
+!-
+  relaxation = .FALSE.
+  CALL getin_p('RELAXATION', relaxation)  
+  IF ( relaxation ) THEN
+     WRITE(numout,*) 'dim2_driver : The relaxation option is temporarily disabled as it does not'
+     WRITE(numout,*) '              produce energy conservation in ORCHIDEE. If you intend to use it'
+     WRITE(numout,*) '              you should validate it.'
+     CALL ipslerr_p(3,'dim2_driver','relaxation option is not activated.','This option needs to be validated.','')
+
+     !Config Key   = RELAX_A
+     !Config Desc  = Time constant of the relaxation layer
+     !Config If    = RELAXATION
+     !Config Def   = 1.0
+     !Config Help  = The time constant associated to the atmospheric
+     !Config         conditions which are going to be computed
+     !Config         in the relaxed layer. To avoid too much
+     !Config         damping the value should be larger than 1000.
+     !Config Units = [days?]
+!-
+     alpha = 1000.0
+     CALL getin_p('RELAX_A', alpha)
+  ENDIF
+!-
+  no_inter = .TRUE.
+  inter_lin = .FALSE.
+
+  !Config Key   = NO_INTER 
+  !Config Desc  = No interpolation IF split is larger than 1
+  !Config If    = [-]
+  !Config Def   = y
+  !Config Help  = Choose IF you do not wish to interpolate linearly.
+  !Config Units = [FLAG]
+  CALL getin_p('NO_INTER', no_inter)
+
+  !Config Key   = INTER_LIN
+  !Config Desc  = Interpolation IF split is larger than 1
+  !Config If    = [-]
+  !Config Def   = n
+  !Config Help  = Choose IF you wish to interpolate linearly.
+  !Config Units = [FLAG]
+  CALL getin_p('INTER_LIN', inter_lin)
+!-
+  IF (inter_lin) THEN
+     no_inter = .FALSE.
+  ELSE
+     no_inter = .TRUE.
+  ENDIF
+!-
+  IF (split == 1) THEN
+    no_inter = .TRUE.
+    inter_lin = .FALSE.
+  ENDIF
+!-
+  !Config Key   = SPRED_PREC
+  !Config Desc  = Spread the precipitation.
+  !Config If    = [-]
+  !Config Def   = Half of the forcing time step or uniform, depending on dt_force and dt_sechiba
+  !Config Help  = Spread the precipitation over SPRED_PREC steps of the splited forcing 
+  !Config         time step. This ONLY applied if the forcing time step has been splited.
+  !Config         If the value indicated is greater than SPLIT_DT, SPLIT_DT is used for it.
+  !Config Units = [-]
+!-
+  IF ( dt_force >= 3*one_hour) THEN
+     ! Distribut the precipitations over the half of the forcing time step 
+     nb_spread = INT(0.5 * (dt_force/dt))
+  ELSE
+     ! Distribut the precipitations uniformly over the forcing time step
+     nb_spread = dt_force/dt
+  END IF
+
+  CALL getin_p('SPRED_PREC', nb_spread)  
+  IF (nb_spread > split) THEN
+    WRITE(numout,*) 'WARNING : nb_spread is too large it will be '
+    WRITE(numout,*) '          set to the value of split'
+    nb_spread = split
+  ELSE IF (split == 1) THEN
+    nb_spread = 1
+  ENDIF
+
+  IF (inter_lin) THEN
+     !Config Key   = NETRAD_CONS
+     !Config Desc  = Conserve net radiation in the forcing
+     !Config Def   = y
+     !Config If    = INTER_LIN
+     !Config Help  = When the interpolation is used the net radiation
+     !Config         provided by the forcing is not conserved anymore.
+     !Config         This should be avoided and thus this option should
+     !Config         be TRUE (y).
+     !Config         This option is not used for short-wave if the
+     !Config         time-step of the forcing is longer than an hour.
+     !Config         It does not make sense to try and reconstruct
+     !Config         a diurnal cycle and at the same time conserve the 
+     !Config         incoming solar radiation.
+     !Config Units = [FLAG]
+     !-
+     netrad_cons = .TRUE.
+     CALL getin_p('NETRAD_CONS', netrad_cons)
+  ELSE
+     netrad_cons = .FALSE.
+  ENDIF
+!=====================================================================
+!- 3.0 Finaly we can prepare all the variables before launching
+!-     the simulation !
+!=====================================================================
+! Initialize LOGICAL and the length of the integration
+!-
+  last_CALL = .FALSE.
+  first_CALL = .TRUE.
+!-
+  temp_sol_NEW(:,:) = tp_00
+!-  
+  !Config Key   = ATM_CO2
+  !Config Desc  = Value for atm CO2
+  !Config If    = [-]
+  !Config Def   = 350.
+  !Config Help  = Value to prescribe the atm CO2.
+  !Config         For pre-industrial simulations, the value is 286.2 .
+  !Config         348. for 1990 year.
+  !Config Units = [ppm]
+!-
+  atmco2=350.
+  CALL getin_p('ATM_CO2',atmco2)
+  for_ccanopy(:,:)=atmco2
+!-
+! Preparing for the implicit scheme.
+! This means loading the prognostic variables from the restart file.
+!-
+  Flag=.FALSE.
+  IF (is_root_prc) THEN
+     ALLOCATE(fluxsens_g(iim_g,jjm_g))
+     var_name= 'fluxsens'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., fluxsens_g)
+     IF (ALL(fluxsens_g(:,:) == val_exp)) THEN
+        Flag=.TRUE.
+     ELSE
+        Flag=.FALSE.
+     ENDIF
+  ELSE
+     ALLOCATE(fluxsens_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF (.NOT. Flag) THEN
+     CALL scatter2D_mpi(fluxsens_g,fluxsens)
+  ELSE
+     fluxsens(:,:) = zero
+  ENDIF
+  DEALLOCATE(fluxsens_g)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(vevapp_g(iim_g,jjm_g))
+     var_name= 'vevapp'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., vevapp_g)
+     IF (ALL(vevapp_g(:,:) == val_exp)) THEN
+        Flag=.TRUE.
+     ELSE
+        Flag=.FALSE.
+     ENDIF
+  ELSE
+     ALLOCATE(vevapp_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF (.NOT. Flag) THEN
+     CALL scatter2D_mpi(vevapp_g,vevapp)
+  ELSE
+     vevapp(:,:) = zero
+  ENDIF
+  DEALLOCATE(vevapp_g)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(old_zlev_g(iim_g,jjm_g))
+     var_name= 'zlev_old'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., old_zlev_g)
+     IF (ALL(old_zlev_g(:,:) == val_exp)) THEN
+        Flag=.TRUE.
+     ELSE
+        Flag=.FALSE.
+     ENDIF
+  ELSE
+     ALLOCATE(old_zlev_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF ( .NOT. Flag ) THEN
+     CALL scatter2D_mpi(old_zlev_g,old_zlev)
+  ELSE
+     old_zlev(:,:)=zlev_vec(:,:)
+  ENDIF
+  DEALLOCATE(old_zlev_g)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(old_qair_g(iim_g,jjm_g))
+     var_name= 'qair_old'
+     CALL restget &
+ &       (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., old_qair_g)
+    IF (ALL(old_qair_g(:,:) == val_exp)) THEN
+      Flag=.TRUE.
+    ELSE
+      Flag=.FALSE.
+    ENDIF
+  ELSE
+     ALLOCATE(old_qair_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF ( .NOT. Flag ) THEN
+     CALL scatter2D_mpi(old_qair_g,old_qair)
+  ELSE
+     old_qair(:,:) = qair_obs(:,:)
+  ENDIF
+  DEALLOCATE(old_qair_g)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(old_eair_g(iim_g,jjm_g))
+     var_name= 'eair_old'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., old_eair_g)
+    IF (ALL(old_eair_g(:,:) == val_exp)) THEN
+      Flag=.TRUE.
+    ELSE
+      Flag=.FALSE.
+    ENDIF
+  ELSE
+     ALLOCATE(old_eair_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF ( .NOT. Flag ) THEN
+     CALL scatter2D_mpi(old_eair_g,old_eair)
+  ELSE
+     DO ik=1,nbindex
+        i=ilandindex(ik)
+        j=jlandindex(ik)
+        old_eair(i,j) = cp_air * tair_obs(i,j) + cte_grav*zlev_vec(i,j)
+     ENDDO
+  ENDIF
+  DEALLOCATE(old_eair_g)
+!-
+! old density is also needed because we do not yet have the right pb
+!-
+!=> obsolète ??!! (tjrs calculé après forcing_read) 
+  IF (is_root_prc) THEN
+     ALLOCATE(for_rau_g(iim_g,jjm_g))
+     var_name= 'rau_old'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., for_rau_g)
+    IF (ALL(for_rau_g(:,:) == val_exp)) THEN
+      Flag=.TRUE.
+    ELSE
+      Flag=.FALSE.
+    ENDIF
+  ELSE
+     ALLOCATE(for_rau_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF ( .NOT. Flag ) THEN
+     CALL scatter2D_mpi(for_rau_g,for_rau)
+  ELSE
+     DO ik=1,nbindex
+        i=ilandindex(ik)
+        j=jlandindex(ik)
+        for_rau(i,j) = pb(i,j)/(cte_molr*(tair_obs(i,j)))
+     ENDDO
+  ENDIF
+  DEALLOCATE(for_rau_g)
+!-
+! For this variable the restart is extracted by SECHIBA
+!-
+  temp_sol_NEW(:,:) = tair_obs(:,:)
+!- 
+  if (.NOT. is_watchout) THEN
+!-
+!   This does not yield a correct restart in the case of relaxation
+!-
+     IF (is_root_prc) THEN
+        ALLOCATE(petAcoef_g(iim_g,jjm_g))
+        var_name= 'petAcoef'
+        CALL restget &
+ &           (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., petAcoef_g)
+        IF (ALL(petAcoef_g(:,:) == val_exp)) THEN
+           Flag=.TRUE.
+        ELSE
+           Flag=.FALSE.
+        ENDIF
+     ELSE
+        ALLOCATE(petAcoef_g(0,1))
+     ENDIF
+     CALL bcast(Flag)
+     IF ( .NOT. Flag ) THEN
+        CALL scatter2D_mpi(petAcoef_g,petAcoef)
+     ELSE
+        petAcoef(:,:) = zero
+     ENDIF
+     DEALLOCATE(petAcoef_g)
+!--
+     IF (is_root_prc) THEN
+        ALLOCATE(petBcoef_g(iim_g,jjm_g))
+        var_name= 'petBcoef'
+        CALL restget &
+ &           (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., petBcoef_g)
+        IF (ALL(petBcoef_g(:,:) == val_exp)) THEN
+           Flag=.TRUE.
+        ELSE
+           Flag=.FALSE.
+        ENDIF
+     ELSE
+        ALLOCATE(petBcoef_g(0,1))
+     ENDIF
+     CALL bcast(Flag)
+     IF ( .NOT. Flag ) THEN
+        CALL scatter2D_mpi(petBcoef_g,petBcoef)
+     ELSE
+        petBcoef(:,:) = old_eair(:,:)
+     ENDIF
+     DEALLOCATE(petBcoef_g)
+!--
+     IF (is_root_prc) THEN
+        ALLOCATE(peqAcoef_g(iim_g,jjm_g))
+        var_name= 'peqAcoef'
+        CALL restget &
+ &           (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., peqAcoef_g)
+        IF (ALL(peqAcoef_g(:,:) == val_exp)) THEN
+           Flag=.TRUE.
+        ELSE
+           Flag=.FALSE.
+        ENDIF
+     ELSE
+        ALLOCATE(peqAcoef_g(0,1))
+     ENDIF
+     CALL bcast(Flag)
+     IF ( .NOT. Flag ) THEN
+        CALL scatter2D_mpi(peqAcoef_g,peqAcoef)
+     ELSE
+        peqAcoef(:,:) = zero
+     ENDIF
+     DEALLOCATE(peqAcoef_g)
+!--
+     IF (is_root_prc) THEN
+        ALLOCATE(peqBcoef_g(iim_g,jjm_g))
+        var_name= 'peqBcoef'
+        CALL restget &
+ &           (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., peqBcoef_g)
+        IF (ALL(peqBcoef_g(:,:) == val_exp)) THEN
+           Flag=.TRUE.
+        ELSE
+           Flag=.FALSE.
+        ENDIF
+     ELSE
+        ALLOCATE(peqBcoef_g(0,1))
+     ENDIF
+     CALL bcast(Flag)
+     IF ( .NOT. Flag ) THEN
+        CALL scatter2D_mpi(peqBcoef_g,peqBcoef)
+     ELSE
+        peqBcoef(:,:) = old_qair(:,:)
+     ENDIF
+     DEALLOCATE(peqBcoef_g)
+  ENDIF
+!-
+! And other variables which need initial variables. These variables
+! will get properly initialized by ORCHIDEE when it is called for 
+! the first time.
+!-
+  albedo(:,:,:) = 0.13
+  emis(:,:) = 1.0
+  z0(:,:) = 0.1
+!--
+!=====================================================================
+!- 4.0 START THE TIME LOOP
+!=====================================================================
+
+  it = itau_dep+1
+  DO WHILE ( it <= itau_fin )
+!----
+    it_force = it+for_offset
+    IF (it_force < 0) THEN
+      WRITE(numout,*) 'The day is not in the forcing file :', &
+ &               it_force, it, for_offset
+      CALL ipslerr_p(3,'dim2_driver','Pb in forcing file','','')
+    ENDIF
+!!$    IF (it_force > itau_dep+tm) THEN
+!!$       WRITE(numout,*) 'ERROR : more time-steps than data'
+!!$       WRITE(numout,*) 'it_force : ', it_force, ' itau_dep+tm : ', itau_dep+tm
+!!$      STOP 'dim2_driver'
+!!$    ENDIF 
+!---
+    is=split_start
+    DO WHILE ( is <= split )
+!-----
+      julian = itau2date(istp, date0_rest, dt)
+      CALL ju2ymds(julian, yy, mm, dd, ss)
+      IF (printlev_loc>=3) THEN
+         WRITE(numout,*) "=============================================================="
+         WRITE(numout,"('New iteration at date : ',I4,'-',I2.2,'-',I2.2,':',F8.4)") &
+              &               yy,mm,dd,ss/3600.
+#ifdef CPP_PARA
+         IF (is_root_prc) THEN
+            WRITE(*,*) "=============================================================="
+            WRITE(*,"('New iteration at date : ',I4,'-',I2.2,'-',I2.2,':',F8.4)") &
+              &               yy,mm,dd,ss/3600.
+         ENDIF
+#endif
+      ENDIF
+!----- 
+      IF ( (it == itau_fin).AND.(is == split) ) THEN
+        last_CALL = .TRUE.
+      ENDIF
+!-----
+      IF (printlev_loc>=3) WRITE(numout,*) 'Into forcing_read'
+!-----
+      CALL forcing_READ &
+ &      (filename, rest_id, .FALSE., last_call, &
+ &       it_force, istp, is, split, nb_spread, netrad_cons, &
+ &       date0_rest, dt_force, iim, jjm, lon, lat, zlev_vec, zlevuv_vec, tm, &
+ &       swdown, coszang, precip_rain, precip_snow, tair_obs, &
+ &       u, v, qair_obs, pb, for_lwdown, for_contfrac, for_neighbours, for_resolution, &
+ &       for_swnet, eair_obs, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, for_ccanopy, &
+ &       kindex, nbindex, force_id)
+
+!-----
+!---- SECHIBA expects surface pressure in hPa
+!-----
+      for_psurf(:,:)  = pb(:,:)/100.
+
+      IF (printlev_loc>=4) THEN
+         WRITE(numout,*) "dim2_driver 0 ",it_force 
+         WRITE(numout,*) ">> Index of land points =",kindex(1:nbindex)
+         WRITE(numout,*) "Lowest level wind speed North = ", &
+              & (/ ( u(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level wind speed East = ", &
+              & (/ ( v(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "z0            ; Surface roughness = ", &
+              & (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Height of first layer = ", &
+              & (/ ( zlev_vec(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level specific humidity = ", &
+              & (/ ( qair_obs(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Rain precipitation = ", &
+              & (/ ( precip_rain(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+         WRITE(numout,*) "Snow precipitation = ", &
+              & (/ ( precip_snow(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+         WRITE(numout,*) "Down-welling long-wave flux = ", &
+              & (/ ( for_lwdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Net surface short-wave flux = ", &
+              & (/ ( for_swnet(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Downwelling surface short-wave flux = ", &
+              & (/ ( swdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Air temperature in Kelvin = ", &
+              & (/ ( tair_obs(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Air potential energy = ", &
+              & (/ ( eair_obs(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "CO2 concentration in the canopy = ", &
+              & (/ ( for_ccanopy(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Coeficients A from the PBL resolution = ", &
+              & (/ ( petAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "One for T and another for q = ", &
+              & (/ ( peqAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Coeficients B from the PBL resolution = ", &
+              & (/ ( petBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "One for T and another for q = ", &
+              & (/ ( peqBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Cdrag = ", &
+              & (/ ( cdrag(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /) 
+         WRITE(numout,*) "CO2 concentration in the canopy = ", &
+              & (/ ( for_ccanopy(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /) 
+         WRITE(numout,*) "Lowest level pressure = ", &
+              & (/ ( for_psurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Geographical coordinates lon = ", &
+              & (/ (  lon(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Geographical coordinates lat = ", &
+              & (/ (  lat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Fraction of continent in the grid = ", &
+              & (/ ( for_contfrac(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+      ENDIF
+!-----
+!---- Prepare : tmp_qair, tmp_eair, tmp_tair, tmp_pb
+!---- and     : for_u, for_v, for_lwdown, for_swnet, for_swdown
+!---- All the work is done in forcing_read
+!---- We do not need the no_inter options as we will
+!---- allways interpolate
+!----- 
+      IF (printlev_loc>=3) WRITE(numout,*) 'Prepare the atmospheric forcing'
+!----- 
+      IF (.NOT. is_watchout) THEN
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            eair_obs(i,j) = cp_air*tair_obs(i,j)+cte_grav*zlev_vec(i,j)
+            for_swnet(i,j) = (1.-(albedo(i,j,1)+albedo(i,j,2))/2.)*swdown(i,j)
+         ENDDO
+      ENDIF
+      DO ik=1,nbindex
+         i=ilandindex(ik)
+         j=jlandindex(ik)
+         for_swdown(i,j) = swdown(i,j)
+         for_coszang(i,j) = coszang(i,j)
+      ENDDO
+!----- 
+!---- Computing the buffer zone !
+!----- 
+      IF (relaxation) THEN
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_qair(i,j) = peqAcoef(i,j)*(-1.) * vevapp(i,j)*dt+peqBcoef(i,j)
+!-------
+            for_eair(i,j) = petAcoef(i,j)*(-1.) * fluxsens(i,j)+petBcoef(i,j)
+!-------
+         ENDDO
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_tair(i,j) = (for_eair(i,j) - cte_grav*zlev_vec(i,j))/cp_air
+!-------
+!!$        if (.NOT. is_watchout) &
+!!$             epot_sol(:,:) = cp_air*temp_sol_NEW(:,:)
+!-------
+         ENDDO
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_rau(i,j) = pb(i,j) / (cte_molr*for_tair(i,j))
+!-------
+            relax(i,j) = for_rau(i,j)*alpha 
+         ENDDO
+
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            zlflu = zlev_vec(i,j)/2.0*dt
+            peqAcoef(i,j) = 1.0/(zlflu+relax(i,j))
+            peqBcoef(i,j) = (relax(i,j) * qair_obs(i,j)/(zlflu+relax(i,j))) + & 
+                 & for_qair(i,j)/(1.0+relax(i,j)/zlflu)
+         ENDDO
+!-------
+!        relax(:,:) = for_rau(:,:)*alpha 
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            petAcoef(i,j) = 1.0/(zlflu+relax(i,j))
+            petBcoef(i,j) = ( relax(i,j) * eair_obs(i,j) / (zlflu+relax(i,j)) ) &
+                 & + for_eair(i,j)/(1.0+relax(i,j)/zlflu)
+         ENDDO
+      ELSE
+         for_qair(:,:) = fill_init
+         for_eair(:,:) = fill_init
+         for_tair(:,:) = fill_init
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_qair(i,j) = qair_obs(i,j)
+            for_eair(i,j) = eair_obs(i,j)
+            for_tair(i,j) = tair_obs(i,j)
+         ENDDO
+!-------
+!!$        if (.NOT. is_watchout) &
+!!$             epot_sol(:,:) =  cp_air*temp_sol_NEW(:,:)
+!-------
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_rau(i,j) = pb(i,j) / (cte_molr*for_tair(i,j))
+         ENDDO
+!-------
+         IF (.NOT. is_watchout) THEN
+           petAcoef(:,:) = 0.0
+           peqAcoef(:,:) = 0.0
+           DO ik=1,nbindex
+              i=ilandindex(ik)
+              j=jlandindex(ik)
+              petBcoef(i,j) = eair_obs(i,j)
+              peqBcoef(i,j) = qair_obs(i,j)
+           ENDDO
+        ENDIF
+      ENDIF
+!-----
+      IF (.NOT. is_watchout) &
+           cdrag(:,:)  = 0.0
+      for_ccanopy(:,:)=atmco2
+!-----
+!---- SECHIBA expects wind, temperature and humidity at the same height.
+!---- If this is not the case then we need to correct for that.
+!-----
+      DO ik=1,nbindex
+         i=ilandindex(ik) 
+         j=jlandindex(ik)
+         for_u(i,j) = u(i,j)*LOG(zlev_vec(i,j)/z0(i,j)) / &
+              LOG(zlevuv_vec(i,j)/z0(i,j)) 
+         for_v(i,j) = v(i,j)*LOG(zlev_vec(i,j)/z0(i,j)) / &
+              LOG(zlevuv_vec(i,j)/z0(i,j))
+      END DO
+            
+!-----
+!---- Prepare the other variables WITH the special CASE
+!---- of splited time steps
+!----
+!---- PRINT input value for printlev_loc>=3
+!-----
+      IF (printlev_loc>=3) THEN
+        WRITE(numout,*) ' >>>>>> time step it_force = ',it_force
+        WRITE(numout,*) &
+ &       ' tair, qair, eair = ', &
+ &       for_tair(itest,jtest),for_qair(itest,jtest), &
+ &       for_eair(itest,jtest)
+        WRITE(numout,*) &
+ &       ' OBS : tair, qair, eair = ', &
+ &       tair_obs(itest,jtest),qair_obs(itest,jtest), &
+ &       eair_obs(itest,jtest)
+        WRITE(numout,*) ' u et v = ',for_u(itest,jtest),for_v(itest,jtest)
+        WRITE(numout,*) ' precip rain et snow = ', &
+        & precip_rain(itest,jtest),precip_snow(itest,jtest)
+        WRITE(numout,*) ' lwdown et swnet = ', &
+        & for_lwdown(itest,jtest),for_swnet(itest,jtest)
+        WRITE(numout,*) ' petAcoef et peqAcoef = ', &
+        & petAcoef(itest,jtest), peqAcoef(itest,jtest)
+        WRITE(numout,*) ' petBcoef et peqAcoef = ', &
+        & petBcoef(itest,jtest),peqBcoef(itest,jtest)
+        WRITE(numout,*) ' zlev = ',zlev_vec(itest,jtest)
+      ENDIF
+!-----
+      IF (first_CALL) THEN
+
+        DO ik=1,nbindex
+           i=ilandindex(ik)
+           j=jlandindex(ik)
+           for_swdown(i,j) = swdown(i,j)
+           for_coszang(i,j) = coszang(i,j)
+        ENDDO
+        IF (printlev_loc>=4) THEN
+           WRITE(numout,*) "dim2_driver first_CALL ",it_force 
+           WRITE(numout,*) ">> Index of land points =",kindex(1:nbindex)
+           WRITE(numout,*) "Lowest level wind speed North = ", &
+             &     (/ ( for_u(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Lowest level wind speed East = ", &
+             &     (/ ( for_v(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "z0            ; Surface roughness = ", &
+             &     (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Height of first layer = ", &
+             &     (/ ( zlev_vec(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Lowest level specific humidity = ", &
+             &     (/ ( for_qair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Rain precipitation = ", &
+             &     (/ ( precip_rain(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+           WRITE(numout,*) "Snow precipitation = ", &
+             &     (/ ( precip_snow(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+           WRITE(numout,*) "Down-welling long-wave flux = ", &
+             &     (/ ( for_lwdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Net surface short-wave flux = ", &
+             &     (/ ( for_swnet(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Downwelling surface short-wave flux = ", &
+             &     (/ ( for_swdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Air temperature in Kelvin = ", &
+             &     (/ ( for_tair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Air potential energy = ", &
+             &     (/ ( for_eair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "CO2 concentration in the canopy = ", &
+             &     (/ ( for_ccanopy(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Coeficients A from the PBL resolution = ", &
+             &     (/ ( petAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "One for T and another for q = ", &
+             &     (/ ( peqAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Coeficients B from the PBL resolution = ", &
+             &     (/ ( petBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "One for T and another for q = ", &
+             &     (/ ( peqBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Cdrag = ", &
+             &     (/ ( cdrag(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Lowest level pressure = ", &
+             &     (/ ( for_psurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Geographical coordinates lon = ", &
+             &     (/ (  lon(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Geographical coordinates lat = ", &
+             &     (/ (  lat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Fraction of continent in the grid = ", &
+             &     (/ ( for_contfrac(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+        ENDIF
+!-------
+!------ CALL sechiba to initialize fields
+!------ and have some initial results: emis, albedo, z0
+!-------
+        CALL intersurf_initialize_2d &
+ &        (istp_old, iim, jjm, nbindex, kindex, dt, &
+ &         first_CALL, .FALSE., lon, lat, for_contfrac, for_resolution, date0_rest, &
+!       first level conditions
+ &         zlev_vec, for_u, for_v, &
+ &         for_qair, for_tair, for_eair, for_ccanopy, &
+!       Variables for the implicit coupling
+ &         cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+!       Rain, snow, radiation and surface pressure
+ &         precip_rain, precip_snow, &
+ &         for_lwdown, for_swnet, for_swdown, for_psurf, &
+!       Output : Fluxes
+ &         vevapp, fluxsens, fluxlat, coastalflow, riverflow,  &
+!       Surface temperatures and surface properties
+ &         tsol_rad, temp_sol_NEW, qsurf, albedo, emis, z0 )
+
+        CALL Stop_timer(timer_global)
+        CALL Stop_timer(timer_mpi)
+        CALL Start_timer(timer_global)
+        CALL Start_timer(timer_mpi)
+        !
+        first_CALL = .FALSE.
+        !
+        ! Get Restart values for albedo and z0, 
+        ! as they modify forcing variables swnet and wind.
+!-------
+        ! albedo 
+        IF (is_root_prc) THEN
+           ALLOCATE(albedo_g(iim_g,jjm_g))
+        ELSE
+           ALLOCATE(albedo_g(0,1))
+        ENDIF
+        !
+        IF (is_root_prc) THEN
+           var_name= 'albedo_vis'
+           CALL restget &
+                &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., albedo_g)
+           IF (ALL(albedo_g(:,:) == val_exp)) THEN
+              Flag=.TRUE.
+           ELSE
+              Flag=.FALSE.
+           ENDIF
+        ENDIF
+        CALL bcast(Flag)
+        IF ( .NOT. Flag ) THEN
+           CALL scatter2D_mpi(albedo_g,albedo_vis)
+           albedo(:,:,1)=albedo_vis(:,:)
+        ELSE
+           albedo_vis(:,:)=albedo(:,:,1)
+        ENDIF
+        !
+        IF (is_root_prc) THEN
+           var_name= 'albedo_nir'
+           CALL restget &
+                &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., albedo_g)
+           IF (ALL(albedo_g(:,:) == val_exp)) THEN
+              Flag=.TRUE.
+           ELSE
+              Flag=.FALSE.
+           ENDIF
+        ENDIF
+        CALL bcast(Flag)
+        IF ( .NOT. Flag ) THEN
+           CALL scatter2D_mpi(albedo_g,albedo_nir)
+           albedo(:,:,2)=albedo_nir(:,:)
+        ELSE
+           albedo_nir(:,:)=albedo(:,:,2)
+        ENDIF
+        !
+        DEALLOCATE(albedo_g)
+        !--
+        ! z0 
+        IF (is_root_prc) THEN
+           ALLOCATE(z0_g(iim_g,jjm_g))
+           var_name= 'z0'
+           CALL restget &
+                &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., z0_g)
+           IF (ALL(z0_g(:,:) == val_exp)) THEN
+              Flag=.TRUE.
+           ELSE
+              Flag=.FALSE.
+           ENDIF
+        ELSE
+           ALLOCATE(z0_g(0,1))
+        ENDIF
+        CALL bcast(Flag)
+        IF (.NOT. Flag) &
+             CALL scatter2D_mpi(z0_g,z0)
+        DEALLOCATE(z0_g)
+!-------
+        DO ik=1,nbindex
+           i=ilandindex(ik)
+           j=jlandindex(ik)
+           temp_sol_old(i,j) = temp_sol_NEW(i,j)
+           for_swnet(i,j) = (1.- (albedo(i,j,1)+albedo(i,j,2))/2.)*swdown(i,j)
+           for_swdown(i,j) = swdown(i,j)
+           for_coszang(i,j) = coszang(i,j)
+        ENDDO
+!
+!     MM : z0 have been modified then we must lower the wind again
+!-----
+!---- SECHIBA expects wind, temperature and humidity at the same height.
+!---- If this is not the case then we need to correct for that.
+!-----
+        DO ik=1,nbindex 
+           i=ilandindex(ik) 
+           j=jlandindex(ik) 
+           for_u(i,j) = u(i,j) * LOG(zlev_vec(i,j)/z0(i,j)) / & 
+                LOG(zlevuv_vec(i,j)/z0(i,j)) 
+           for_v(i,j) = v(i,j) * LOG(zlev_vec(i,j)/z0(i,j)) / &
+                LOG(zlevuv_vec(i,j)/z0(i,j)) 
+        END DO
+        
+!-----
+!---- PRINT input value after first_CALL for printlev_loc>=3
+!-----
+        IF (printlev_loc>=3) THEN
+           WRITE(numout,*) ' >>>>>> after first_CALL = ',first_CALL
+           WRITE(numout,*) ' u et v = ',for_u(itest,jtest),for_v(itest,jtest)
+           WRITE(numout,*) ' swnet = ', for_swnet(itest,jtest)
+        ENDIF
+!-------
+        IF (printlev_loc>=4) THEN
+           WRITE(numout,*) "dim2_driver first_CALL outputs"
+           !       Output : Fluxes
+           WRITE(numout,*) "vevapp        ; Total of evaporation = ", &
+             &     (/ ( vevapp(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Sensible heat flux = ", &
+             &     (/ ( fluxsens(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Latent heat flux = ", &
+             &     (/ ( fluxlat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "coastalflow   ; Diffuse flow of water into the ocean (m^3/dt) = ", &
+             &     (/ ( coastalflow(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "riverflow     ; Largest rivers flowing into the ocean (m^3/dt) = ", &
+             &     (/ ( riverflow(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           !       Surface temperatures and surface properties
+           WRITE(numout,*) "tsol_rad      ; Radiative surface temperature = ", &
+             &     (/ ( tsol_rad(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "temp_sol_new  ; New soil temperature = ", &
+             &     (/ ( temp_sol_NEW(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "qsurf         ; Surface specific humidity = ", &
+             &     (/ ( qsurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "albedoVIS = ", &
+             &     (/ ( albedo(ilandindex(ik), jlandindex(ik), 1),ik=1,nbindex ) /)
+           WRITE(numout,*) "albedoNIR = ", &
+             &     (/ ( albedo(ilandindex(ik), jlandindex(ik), 2),ik=1,nbindex ) /)
+           WRITE(numout,*) "emis          ; Emissivity = ", &
+             &     (/ ( emis(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "z0            ; Surface roughness = ", &
+             &     (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+        ENDIF
+!-------
+        IF (printlev_loc>=3) THEN
+          WRITE(numout,*) &
+ &         ' OUT rest : z0, albedoVIS, albedoNIR, emis = ', &
+ &         z0(itest,jtest),albedo(itest,jtest,1), &
+ &                         albedo(itest,jtest,2),emis(itest,jtest)
+          WRITE(numout,*) ' OUT rest : coastal and river flow = ', &
+ &         coastalflow(itest,jtest), riverflow(itest,jtest)
+          WRITE(numout,*) ' OUT rest : tsol_rad, vevapp = ', &
+ &         tsol_rad(itest,jtest), vevapp(itest,jtest)
+          WRITE(numout,*) ' OUT rest : temp_sol_new =', &
+ &         temp_sol_NEW(itest,jtest)
+        ENDIF
+    
+!ANNE/        CALL barrier_para
+!ANNE/        CALL start_timer(timer_global)
+!ANNE/        CALL start_timer(timer_mpi)
+   
+      ENDIF
+!-----
+!---- Calling SECHIBA and doing the number crunching.
+!---- Note that for the first time step SECHIBA is called twice.
+!----
+!---- All H_2O fluxes are now in Kg/m^2s
+!-----
+      IF (printlev_loc>=4) THEN
+         WRITE(numout,*) "dim2_driver ",it_force 
+         WRITE(numout,*) ">> Index of land points =",kindex(1:nbindex)
+         WRITE(numout,*) "Lowest level wind speed North = ", &
+           &     (/ ( for_u(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level wind speed East = ", &
+           &     (/ ( for_v(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "z0            ; Surface roughness = ", &
+           &     (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Height of first layer = ", &
+           &     (/ ( zlev_vec(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level specific humidity = ", &
+           &     (/ ( for_qair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Rain precipitation = ", &
+           &     (/ ( precip_rain(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+         WRITE(numout,*) "Snow precipitation = ", &
+           &     (/ ( precip_snow(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+         WRITE(numout,*) "Down-welling long-wave flux = ", &
+           &     (/ ( for_lwdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Net surface short-wave flux = ", &
+           &     (/ ( for_swnet(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Downwelling surface short-wave flux = ", &
+           &     (/ ( for_swdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Air temperature in Kelvin = ", &
+           &     (/ ( for_tair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Air potential energy = ", &
+           &     (/ ( for_eair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "CO2 concentration in the canopy = ", &
+           &     (/ ( for_ccanopy(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Coeficients A from the PBL resolution = ", &
+           &     (/ ( petAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "One for T and another for q = ", &
+           &     (/ ( peqAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Coeficients B from the PBL resolution = ", &
+           &     (/ ( petBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "One for T and another for q = ", &
+           &     (/ ( peqBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Cdrag = ", &
+           &     (/ ( cdrag(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level pressure = ", &
+           &     (/ ( for_psurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Geographical coordinates lon = ", &
+           &     (/ (  lon(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Geographical coordinates lat = ", &
+           &     (/ (  lat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Fraction of continent in the grid = ", &
+           &     (/ ( for_contfrac(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+      ENDIF
+      
+      CALL intersurf_main_2d &
+ &      (istp, iim, jjm, nbindex, kindex, dt, &
+ &       first_CALL, last_CALL, lon, lat, for_contfrac, for_resolution, date0_rest, &
+!     first level conditions
+ &       zlev_vec, for_u, for_v, &
+ &       for_qair, for_tair, for_eair, for_ccanopy, &
+!     Variables for the implicit coupling
+ &       cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+!     Rain, snow, radiation and surface pressure
+ &       precip_rain, precip_snow, &
+ &       for_lwdown, for_swnet, for_swdown, for_psurf, &
+!     Output : Fluxes
+ &       vevapp, fluxsens, fluxlat, coastalflow, riverflow,  &
+!     Surface temperatures and surface properties
+ &       tsol_rad, temp_sol_NEW, qsurf, albedo, emis, z0, &
+!       VOC : radiation
+ &       for_coszang)
+! &       for_coszang,soil_mc,litter_mc)
+!-------
+      IF (printlev_loc>=4) THEN
+         WRITE(numout,*) "dim2_driver outputs"
+         !       Output : Fluxes
+         WRITE(numout,*) "vevapp        ; Total of evaporation = ", &
+           &     (/ ( vevapp(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Sensible heat flux = ", &
+           &     (/ ( fluxsens(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Latent heat flux = ", &
+           &     (/ ( fluxlat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "coastalflow   ; Diffuse flow of water into the ocean (m^3/dt) = ", &
+           &     (/ ( coastalflow(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "riverflow     ; Largest rivers flowing into the ocean (m^3/dt) = ", &
+           &     (/ ( riverflow(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         !       Surface temperatures and surface properties
+         WRITE(numout,*) "tsol_rad      ; Radiative surface temperature = ", &
+           &     (/ ( tsol_rad(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "temp_sol_new  ; New soil temperature = ", &
+           &     (/ ( temp_sol_NEW(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "qsurf         ; Surface specific humidity = ", &
+           &     (/ ( qsurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "albedoVIS = ", &
+           &     (/ ( albedo(ilandindex(ik), jlandindex(ik), 1),ik=1,nbindex ) /)
+         WRITE(numout,*) "albedoNIR = ", &
+           &     (/ ( albedo(ilandindex(ik), jlandindex(ik), 2),ik=1,nbindex ) /)
+         WRITE(numout,*) "emis          ; Emissivity = ", &
+           &     (/ ( emis(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "z0            ; Surface roughness = ", &
+           &     (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+      ENDIF
+!-----
+      dtdt(:,:) = zero
+      DO ik=1,nbindex
+         i=ilandindex(ik)
+         j=jlandindex(ik)
+         dtdt(i,j) = ABS(temp_sol_NEW(i,j)-temp_sol_old(i,j))/dt
+      ENDDO
+!-----
+!---- Test if the point with the largest change has more than 5K per dt
+!-----
+      IF (MAXVAL(dtdt(:,:)) > 5./dt) THEN
+        ml = MAXLOC(dtdt)
+        CALL ju2ymds(julian, yy, mm, dd, ss)
+        WRITE(numout,"('ATT :',I5,' big temperature jumps on ', &
+ &       I4,'-',I2.2,'-',I2.2,':',F8.4)") &
+ &       COUNT(dtdt(:,:) > 5./dt),yy,mm,dd,ss/3600.
+        WRITE(numout,*) &
+ &       'Maximum change of surface temperature located at :', &
+ &       lon(ml(1),ml(2)),lat(ml(1),ml(2))
+        WRITE(numout,*) 'Coordinates in grid space: ',ml(1),ml(2)
+        WRITE(numout,*) 'Change from ',temp_sol_old(ml(1),ml(2)), &
+ &       ' to ',temp_sol_new(ml(1),ml(2)),&
+ &       'with sw_in = ',for_swnet(ml(1),ml(2))
+        old_tair = &
+ &        (old_eair(ml(1),ml(2))-cte_grav*old_zlev(ml(1),ml(2)))/cp_air
+        WRITE(numout,*) 'Air temperature change from ',old_tair, &
+ &       ' to ',for_tair(ml(1),ml(2))
+        WRITE(numout,*) 'Max of dtdt : ',dtdt(ml(1),ml(2)),' with dt = ',dt
+      ENDIF
+!-----
+      temp_sol_old(:,:) = temp_sol_NEW(:,:)
+!-----
+!---- PRINT output value for printlev_loc>=3
+!-----
+      IF (printlev_loc>=3) THEN
+        WRITE(numout,*) ' OUT : z0, albedoVIS, albedoNIR, emis = ', &
+ &       z0(itest,jtest),albedo(itest,jtest,1), &
+ &                       albedo(itest,jtest,2),emis(itest,jtest)
+        WRITE(numout,*) ' OUT : coastal and river flow = ',&
+ &       coastalflow(itest,jtest), riverflow(itest,jtest)
+        WRITE(numout,*) ' OUT : tsol_rad, vevapp = ', &
+ &       tsol_rad(itest,jtest), vevapp(itest,jtest)
+        WRITE(numout,*) ' OUT : temp_sol_new =', temp_sol_NEW(itest,jtest)
+      ENDIF
+!-----
+!---- Give some variables to the output package
+!---- for saving on the history tape
+!-----
+      IF (printlev_loc>=3) WRITE(numout,*) 'history written for ', istp
+!-----
+      istp_old = istp
+      istp = istp+1
+!-----
+      old_zlev(:,:) = zlev_vec(:,:)
+      old_qair(:,:) = for_qair(:,:)
+      old_eair(:,:) = for_eair(:,:)
+!-----
+      is = is + 1
+    ENDDO
+    split_start = 1
+!!$    it_force =it_force+1
+    IF (it==itau_fin-1) THEN
+     
+     CALL Write_Load_Balance(REAL(Get_cpu_time(timer_mpi),r_std))
+
+    ENDIF
+    it = it + 1
+  ENDDO
+!-
+! Archive in restart file the prognostic variables
+!-
+  IF (printlev_loc>=3) WRITE(numout,*) 'Write the restart for the driver', istp_old
+!-
+  var_name = 'fluxsens'
+  IF (is_root_prc) THEN
+     ALLOCATE(fluxsens_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(fluxsens_g(0,1))
+  ENDIF
+  CALL gather2D_mpi(fluxsens , fluxsens_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, fluxsens_g)
+  DEALLOCATE(fluxsens_g)
+  
+  var_name = 'vevapp'
+  IF (is_root_prc) THEN
+     ALLOCATE(vevapp_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(vevapp_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( vevapp, vevapp_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, vevapp_g)
+  DEALLOCATE(vevapp_g)
+  
+  var_name = 'zlev_old'
+  IF (is_root_prc) THEN
+     ALLOCATE(old_zlev_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(old_zlev_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( old_zlev, old_zlev_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, old_zlev_g)
+  DEALLOCATE(old_zlev_g)
+  
+  var_name = 'qair_old'
+  IF (is_root_prc) THEN
+     ALLOCATE(old_qair_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(old_qair_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( old_qair, old_qair_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, old_qair_g)
+  DEALLOCATE(old_qair_g)
+  
+  var_name = 'eair_old'
+  IF (is_root_prc) THEN
+     ALLOCATE(old_eair_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(old_eair_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( old_eair, old_eair_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, old_eair_g)
+  DEALLOCATE(old_eair_g)
+  
+  var_name = 'rau_old'
+  IF (is_root_prc) THEN
+     ALLOCATE(for_rau_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(for_rau_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( for_rau, for_rau_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, for_rau_g)
+  DEALLOCATE(for_rau_g)
+  
+  IF (is_root_prc) THEN
+     ALLOCATE(albedo_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(albedo_g(0,1))
+  ENDIF
+  var_name= 'albedo_vis'
+  albedo_vis(:,:)=albedo(:,:,1)
+  CALL gather2D_mpi(albedo_vis,albedo_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, albedo_g)  
+  !
+  var_name= 'albedo_nir'
+  albedo_nir(:,:)=albedo(:,:,2)
+  CALL gather2D_mpi(albedo_nir,albedo_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, albedo_g)  
+  DEALLOCATE(albedo_g)
+
+  IF (is_root_prc) THEN
+     ALLOCATE(z0_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(z0_g(0,1))
+  ENDIF
+  var_name= 'z0'
+  CALL gather2D_mpi(z0,z0_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, z0_g)  
+  DEALLOCATE(z0_g)
+
+  if (.NOT. is_watchout) THEN
+     var_name = 'petAcoef'
+     IF (is_root_prc) THEN
+        ALLOCATE(petAcoef_g(iim_g,jjm_g))
+     ELSE
+        ALLOCATE(petAcoef_g(0,1))
+     ENDIF
+     CALL gather2D_mpi( petAcoef, petAcoef_g)
+     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, petAcoef_g)
+     DEALLOCATE(petAcoef_g)
+  
+     var_name = 'petBcoef'
+     IF (is_root_prc) THEN
+        ALLOCATE(petBcoef_g(iim_g,jjm_g))
+     ELSE
+        ALLOCATE(petBcoef_g(0,1))
+     ENDIF
+     CALL gather2D_mpi( petBcoef, petBcoef_g)
+     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, petBcoef_g)
+     DEALLOCATE(petBcoef_g)
+  
+     var_name = 'peqAcoef'
+     IF (is_root_prc) THEN
+        ALLOCATE(peqAcoef_g(iim_g,jjm_g))
+     ELSE
+        ALLOCATE(peqAcoef_g(0,1))
+     ENDIF
+     CALL gather2D_mpi( peqAcoef, peqAcoef_g)
+     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, peqAcoef_g)
+     DEALLOCATE(peqAcoef_g)
+  
+     var_name = 'peqBcoef'
+     IF (is_root_prc) THEN
+        ALLOCATE(peqBcoef_g(iim_g,jjm_g))
+     ELSE
+        ALLOCATE(peqBcoef_g(0,1))
+     ENDIF
+     CALL gather2D_mpi( peqBcoef, peqBcoef_g)
+     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, peqBcoef_g)
+     DEALLOCATE(peqBcoef_g)
+  ENDIF
+!-
+  IF (printlev_loc>=3) WRITE(numout,*) 'Restart for the driver written'
+!=====================================================================
+!- 5.0 Closing all files
+!=====================================================================
+  CALL flinclo(force_id)
+  IF ( printlev_loc>=3 )  WRITE(numout,*) 'FLIN CLOSED'
+  CALL histclo
+  IF ( printlev_loc>=3 )   WRITE(numout,*) 'HIST CLOSED'      
+    
+  IF(is_root_prc) THEN
+     CALL restclo
+     IF ( printlev_loc>=3 )  WRITE(numout,*) 'REST CLOSED'
+     CALL getin_dump
+     IF ( printlev_loc>=3 )  WRITE(numout,*) 'GETIN CLOSED'
+  ENDIF
+
+  
+
+  WRITE(numout,*) '-------------------------------------------'
+  WRITE(numout,*) '------> CPU Time Global ',Get_cpu_Time(timer_global)
+  WRITE(numout,*) '------> CPU Time without mpi ',Get_cpu_Time(timer_mpi)
+  WRITE(numout,*) '------> Real Time Global ',Get_real_Time(timer_global)
+  WRITE(numout,*) '------> real Time without mpi ',Get_real_Time(timer_mpi)
+  WRITE(numout,*) '-------------------------------------------'
+  CALL Finalize_mpi
+!---------------
+!  CALL Write_Load_Balance(Get_cpu_time(timer_mpi))
+
+!-
+  WRITE(numout,*) 'END of dim2_driver'
+!---------------
+END PROGRAM driver
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/forcesoil.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/forcesoil.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/forcesoil.f90	(revision 5166)
@@ -0,0 +1,1592 @@
+! =================================================================================================================================
+! PROGRAM       : forcesoil
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This subroutine runs the soilcarbon submodel using specific initial conditions 
+!! and driving variables in order to obtain soil carbon stocks closed to the steady-state values 
+!! quicker than when using the ''full'' ORCHIDEE.  
+!!	
+!!\n DESCRIPTION: None
+!! This subroutine computes the soil carbon stocks by calling the soilcarbon routine at each time step. \n
+!! The aim is to obtain soil carbon stocks closed to the steady-state values and ultimately to create  
+!! an updated stomate restart file for the stomate component. The state variables of the subsystem are the clay content 
+!! (fixed value) and the soil carbon stocks. Initial conditions for the state variables are read in an  
+!! input stomate restart file. Driving variables are Soil carbon input, Water and Temperature stresses on 
+!! Organic Matter decomposition. Driving variables are read from a specific forcing file produced by a former run of ORCHIDEE
+!! (SECHIBA+STOMATE). \n 
+!! The FORCESOIL program first consists in reading a set of input files, allocating variables and 
+!! preparing output stomate restart file. \n                                                             
+!! Then, a loop over time is performed in which the soilcarbon routine is called at each time step. \n
+!! Last, final values of the soil carbon stocks are written into the output stomate restart file. \n
+!! No flag is associated with the use of the FORCESOIL program. \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) : None    
+!!
+!! FLOWCHART    : None
+!!
+!! SVN		:
+!! $HeadURL: $ 
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ =================================================================================================================================
+
+PROGRAM forcesoil
+ 
+  USE netcdf
+  !-
+  USE defprec
+  USE constantes
+  USE constantes_soil
+  USE constantes_mtc
+!  USE pft_parameters 
+  USE stomate_data
+  USE ioipsl_para
+  USE mod_orchidee_para
+  USE stomate_soilcarbon
+  USE vertical_soil
+  USE control
+!  USE constantes_var  
+
+!-
+  IMPLICIT NONE
+  !-
+  CHARACTER(LEN=80)                          :: sto_restname_in,sto_restname_out
+  INTEGER(i_std)                             :: iim,jjm                 !! Indices (unitless)
+
+  INTEGER(i_std),PARAMETER                   :: llm = 1                 !! Vertical Layers (requested by restini routine) (unitless)
+  INTEGER(i_std)                             :: kjpindex                !! Domain size (unitless)
+
+  INTEGER(i_std)                             :: itau_dep,itau_len       !! Time step read in the restart file (?) 
+                                                                        !! and number of time steps of the simulation (unitless) 
+  CHARACTER(LEN=30)                          :: time_str                !! Length of the simulation (year)
+  REAL(r_std)                                :: dt_files                !! time step between two successive itaus (?) 
+                                                                        !! (requested by restini routine) (seconds)
+  REAL(r_std)                                :: date0                   !! Time at which itau = 0 (requested by restini routine) (?)
+  INTEGER(i_std)                             :: rest_id_sto             !! ID of the input restart file (unitless)
+  CHARACTER(LEN=20), SAVE                    :: thecalendar = 'noleap'  !! Type of calendar defined in the input restart file 
+                                                                        !! (unitless)
+  !-
+  CHARACTER(LEN=100)                         :: Cforcing_name           !! Name of the forcing file (unitless)
+  INTEGER                                    :: Cforcing_id             !! ID of the forcing file (unitless)
+  INTEGER                                    :: v_id                    !! ID of the variable 'Index' stored in the forcing file 
+                                                                        !! (unitless)
+  REAL(r_std)                                :: dt_forcesoil            !! Time step at which soilcarbon routine is called (days) 
+  INTEGER                                    :: nparan                  !! Number of values stored per year in the forcing file 
+                                                                        !! (unitless)
+  INTEGER                                    :: nbyear
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE    :: indices                 !! Grid Point Index used per processor (unitless)
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE    :: indices_g               !! Grid Point Index for all processor (unitless)
+  REAL(r_std),DIMENSION(:),ALLOCATABLE       :: x_indices_g             !! Grid Point Index for all processor (unitless)
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE     :: lon, lat                !! Longitude and Latitude of each grid point defined 
+                                                                        !! in lat/lon (2D) (degrees)
+  REAL(r_std),DIMENSION(llm)                 :: lev                     !! Number of level (requested by restini routine) (unitless)
+
+
+  INTEGER                                    :: i,k,j,l,m,iatt,iv,iyear !! counters (unitless)
+  REAL(r_std)                                :: soil_depth              !! Soil depth (m)
+  CHARACTER(LEN=80)                          :: var_name
+  CHARACTER(LEN=20000)                       :: taboo_vars              !! string used for storing the name of the variables 
+                                                                        !! of the stomate restart file that are not automatically 
+                                                                        !! duplicated from input to output restart file (unitless)
+  REAL(r_std),DIMENSION(1)                   :: xtmp                    !! scalar read/written in restget/restput routines (unitless)
+  INTEGER(i_std),PARAMETER                   :: nbvarmax=8000           !! maximum # of variables assumed in the stomate restart file 
+                                                                        !! (unitless)
+  INTEGER(i_std)                             :: nbvar                   !! # of variables effectively present 
+                                                                        !! in the stomate restart file (unitless)
+  CHARACTER(LEN=100),DIMENSION(nbvarmax)     :: varnames                !! list of the names of the variables stored 
+                                                                        !! in the stomate restart file (unitless)
+  INTEGER(i_std)                             :: varnbdim                !! # of dimensions of a given variable 
+                                                                        !! of the stomate restart file
+  INTEGER(i_std),PARAMETER                   :: varnbdim_max=20         !! maximal # of dimensions assumed for any variable 
+                                                                        !! of the stomate restart file 
+  INTEGER,DIMENSION(varnbdim_max)            :: vardims                 !! length of each dimension of a given variable 
+                                                                        !! of the stomate restart file
+  LOGICAL                                    :: l1d                     !! boolean : TRUE if all dimensions of a given variable 
+                                                                        !! of the stomate restart file are of length 1 (ie scalar) 
+                                                                        !! (unitless)
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE     :: var_3d                  !! matrix read/written in restget/restput routines (unitless)
+  REAL(r_std)                                :: x_tmp                   !! temporary variable used to store return value 
+                                                                        !! from nf90_get_att (unitless)
+  CHARACTER(LEN=10)  :: part_str                                        !! string suffix indicating the index of a PFT 
+  CHARACTER(LEN=1),DIMENSION(nelements) :: element_str                  !! string suffix indicating element   
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)  :: soil_ph_g               !! Soil pH (0-14, pH unit)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)  :: clay_g                  !! clay fraction (nbpglo) (unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)  :: bulk_dens_g             !! soil bulk density (nbpglo) (g cm-3)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:):: soiltile_g              !! Fraction of each soil tile (0-1, unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:):: veget_max_g             !! PFT "Maximal" coverage fraction of a PFT defined in 
+                                                                        !! the input vegetation map 
+                                                                        !! @tex $(m^2 m^{-2})$ @endtex, parallel computing  
+  REAL(r_std),DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: soilcarbon_input_g  !! soil carbon input (nbpglob,npool,nvm,time) 
+                                                                        !! (\f$gC m^{-2} dt_forcesoil^{-1}\f$) 
+
+  REAL(r_std),DIMENSION(:,:,:,:),ALLOCATABLE   :: control_temp_soil_g     !! Temperature control (nbp_glo,nbdl,time) on OM decomposition 
+                                                                        !! (unitless)
+  REAL(r_std),DIMENSION(:,:,:,:),ALLOCATABLE   :: control_moist_soil_g    !! Moisture control (nbp_glo,nbdl,time) on OM decomposition 
+                                                                        !! ?? Should be defined per PFT as well (unitless)
+  REAL(r_std),DIMENSION (:,:,:), ALLOCATABLE   :: moist_soil_g          !! soil moisture content \f($m^3 \times m^3$)\f
+  REAL(r_std),DIMENSION (:,:,:,:), ALLOCATABLE :: soil_mc_g             !! soil moisture content per soil type \f($m^3 \times m^3$)\f
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: floodout_g             !! flux out of floodplains
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: wat_flux0_g          !! Water flux in the first soil layers exported for soil C calculations
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: wat_flux_g          !! Water flux in the soil layers exported for soil C calculations
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::runoff_per_soil_g     !! Runoff per soil type [mm]
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::drainage_per_soil_g   !! Drainage per soil type [mm]
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_topsoil_g     !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                        !! floodplains and from irrigation
+                                                                        !! @tex $(gC m^{-2} day{-1})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_subsoil_g     !! DOC inputs to bottom of the soil column, from returnflow
+                                                                        !! in swamps and lakes
+                                                                        !! @tex $(gC m^{-2} day{-1})$ @endtex
+  REAL(r_std),DIMENSION(:,:,:,:,:),ALLOCATABLE :: carbon_g                !! Soil carbon stocks (nbp_glo,ncarb,nvm) (\f$gC m^{-2}\f$)
+  REAL(r_std), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: DOC_g             !! Dissolved Organic Carbon in soil
+                                                                        !! The unit is given by m^3 of
+                                                                        !! ground @tex $(gC m{-2}) $ @endtex
+  REAL(r_std), ALLOCATABLE ::litter_above_g(:,:,:,:,:)                  !! Metabolic and structural litter, below ground
+                                                                        !! The unit is given by m^2 of
+                                                                        !! ground @tex $(gCi m{-2})$ @endtex
+  REAL(r_std), ALLOCATABLE ::litter_below_g(:,:,:,:,:,:)                !! Metabolic and structural litter, below ground
+                                                                        !! The unit is given by m^2 of
+                                                                        !! ground @tex $(gC m^{-2})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: lignin_struc_above_g !! Ratio Lignine/Carbon in structural litter for above
+                                                                        !! ground compartments (unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: lignin_struc_below_g   !! Ratio Lignine/Carbon in structural litter for below
+                                                                        !! ground compartments (unitless)
+  REAL(r_std),ALLOCATABLE :: clay(:)                                    !! clay fraction (nbp_loc) (unitless)
+  REAL(r_std),ALLOCATABLE :: soil_ph(:)                                 !! Soil pH (0-14 pH units)
+  REAL(r_std),ALLOCATABLE :: bulk_dens(:)                               !! soil bulk density (nbpglo) (g cm-3)
+  REAL(r_std),ALLOCATABLE :: soilcarbon_input(:,:,:,:,:,:)              !! soil carbon input (nbp_loc,npool,nvm,time) 
+                                                                        !! water @tex $(gC m{-2} of water)$ @endte
+  REAL(r_std),ALLOCATABLE :: control_temp_soil(:,:,:,:)                   !! Temperature control (nbp_loc,nbdl,time) on OM decomposition 
+                                                                        !! (unitless)
+  REAL(r_std),ALLOCATABLE :: control_moist_soil(:,:,:,:)                  !! Moisture control (nbp_loc,nbdl,time) on OM decomposition 
+                                                                        !! ?? Should be defined per PFT as well (unitless)
+
+  REAL(r_std),ALLOCATABLE :: carbon(:,:,:,:,:)                            !! Soil carbon stocks (nbp_loc,ncarb,nvm) (\f$gC m^{-2}\f$)
+  REAL(r_std), ALLOCATABLE ::litter_above(:,:,:,:,:)                    !! Metabolic and structural litter, below ground
+                                                                        !! The unit is given by m^2 of
+                                                                        !! ground @tex $(gCi m{-2})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: lignin_struc_above   !! Ratio Lignine/Carbon in structural litter for above
+                                                                        !! ground compartments (unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: lignin_struc_below   !! Ratio Lignine/Carbon in structural litter for below
+                                                                        !! ground compartments (unitless)
+  REAL(r_std),ALLOCATABLE :: veget_max(:,:)                             !! PFT "Maximal" coverage fraction of a PFT defined in 
+                                                                        !! the input vegetation map 
+                                                                        !! @tex $(m^2 m^{-2})$ @endtex  
+  REAL(r_std), ALLOCATABLE ::litter_below(:,:,:,:,:,:)                  !! Metabolic and structural litter, below ground
+                                                                        !! The unit is given by m^2 of
+                                                                        !! ground @tex $(gC m^{-2})$ @endtex
+  REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE     :: resp_hetero_soil      !! Heterotrophic respiration (\f$gC m^{-2} dt_forcesoil^{-1}\f$) 
+                                                                        !! (requested by soilcarbon routine but not used here) 
+  REAL(r_std), DIMENSION(:,:), ALLOCATABLE   :: soilhum                 !! Daily soil humidity of each soil layer 
+                                                                        !! (unitless) 
+  REAL(r_std),DIMENSION (:,:,:), ALLOCATABLE   :: moist_soil            !! soil moisture content \f($m^3 \times m^3$)\f
+  REAL(r_std),DIMENSION (:,:,:,:), ALLOCATABLE :: soil_mc               !! soil moisture content \f($m^3 \times m^3$)\f
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: floodout               !! flux out of floodplains
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: wat_flux0            !! Water flux in the first soil layers exported for soil C calculations
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: wat_flux            !! Water flux in the soil layers exported for soil C calculations
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::runoff_per_soil       !! Runoff per soil type [mm]
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::drainage_per_soil     !! Drainage per soil type [mm]
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_topsoil       !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                        !! floodplains and from irrigation
+                                                                        !! @tex $(gC m^{-2} day{-1})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_subsoil      !! DOC inputs to bottom of the soil column, from returnflow
+                                                                        !! in swamps and lakes
+                                                                        !! @tex $(gC m^{-2} day{-1})$ @endtex
+  REAL(r_std),DIMENSION (:,:), ALLOCATABLE    :: soiltile               !! Fraction of each soil tile (0-1, unitless)
+  REAL(r_std), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: DOC               !! Dissolved Organic Carbon in soil
+                                                                        !! The unit is given by m^3 of
+                                                                        !! ground @tex $(gC m{-2}) $ @endtex
+  REAL(r_std), DIMENSION(:,:,:,:), ALLOCATABLE :: DOC_EXP               !! Dissolved Organic Carbon in soil
+                                                                        !! The unit is given by m^3 of
+                                                                        !! water @tex $(gCm {-3}) $ @endtex
+
+  INTEGER(i_std)                             :: ier,iret                !! Used for hangling errors 
+
+  CHARACTER(LEN=30) :: temp_name 
+  LOGICAL :: debug                                                      !! boolean used for printing messages
+  LOGICAL :: l_error                                                    !! boolean for memory allocation
+
+!_ =================================================================================================================================
+ 
+  CALL Init_orchidee_para
+  CALL init_timer
+
+!-
+  debug = .FALSE.
+  CALL getin_p('DEBUG_INFO',debug)
+  !!- 
+  !! 1. Initialisation stage
+  !! Reading a set of input files, allocating variables and preparing output restart file.     
+  !!-
+  ! Define restart file name
+  ! for reading initial conditions (sto_restname_in var) and for writting final conditions (sto_restname_out var). 
+  ! User values are used if present in the .def file.
+  ! If not present, default values (stomate_start.nc and stomate_rest_out.c) are used.
+  !-
+  IF (is_root_prc) THEN
+     sto_restname_in = 'stomate_start.nc'
+     CALL getin ('STOMATE_RESTART_FILEIN',sto_restname_in)
+     WRITE(numout,*) 'STOMATE INPUT RESTART_FILE: ',TRIM(sto_restname_in)
+     sto_restname_out = 'stomate_rest_out.nc'
+     CALL getin ('STOMATE_RESTART_FILEOUT',sto_restname_out)
+     WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out)
+     !-
+     ! Open the input file and Get some Dimension and Attributes ID's 
+     !-!iret = NF90_OPEN (sto_restname_in, NF90_WRITE, rest_id_sto)
+
+     iret = NF90_OPEN (sto_restname_in, NF90_NOWRITE, rest_id_sto)
+     iret = NF90_INQUIRE_DIMENSION (rest_id_sto,1,len=iim_g)
+     iret = NF90_INQUIRE_DIMENSION (rest_id_sto,2,len=jjm_g)
+     iret = NF90_INQ_VARID (rest_id_sto, "time", iv)
+     iret = NF90_GET_ATT (rest_id_sto, iv, 'calendar',thecalendar)
+     iret = NF90_CLOSE (rest_id_sto)
+     i=INDEX(thecalendar,ACHAR(0))
+     IF ( i > 0 ) THEN
+        thecalendar(i:20)=' '
+     ENDIF
+     !-
+     ! Allocate longitudes and latitudes
+     !-
+     ALLOCATE (lon(iim_g,jjm_g))
+     ALLOCATE (lat(iim_g,jjm_g))
+     lon(:,:) = zero
+     lat(:,:) = zero
+     lev(1)   = zero
+     !-
+     CALL restini &
+          & (sto_restname_in, iim_g, jjm_g, lon, lat, llm, lev, &
+          &  sto_restname_out, itau_dep, date0, dt_files, rest_id_sto)
+  ENDIF
+  CALL control_initialize(dt_files)
+  CALL bcast(date0)
+  CALL bcast(thecalendar)
+  WRITE(numout,*) "calendar = ",thecalendar
+  !-
+  ! calendar
+  !-
+  CALL ioconf_calendar (thecalendar)
+  CALL ioget_calendar  (one_year,one_day)
+  CALL ioconf_startdate(date0)
+  !
+  !! For master process only
+  !
+  IF (is_root_prc) THEN
+     !-
+     ! define forcing file's name (Cforcing_name var)
+     ! User value is used if present in the .def file
+     ! If not, default (NONE) is used
+     !-
+     Cforcing_name = 'NONE'
+     CALL getin ('STOMATE_CFORCING_NAME',Cforcing_name)
+     !-
+     ! Open FORCESOIL's forcing file to read some basic info (dimensions, variable ID's)
+     ! and allocate variables.
+     !-
+     iret = NF90_OPEN (TRIM(Cforcing_name),NF90_NOWRITE,Cforcing_id)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'forcesoil', &
+             &        'Could not open file : ', &
+             &          Cforcing_name,'(Do you have forget it ?)')
+     ENDIF
+     !-
+     ! Total Domain size is stored in nbp_glo variable
+     !-
+     ier = NF90_GET_ATT (Cforcing_id,NF90_GLOBAL,'kjpindex',x_tmp)
+     nbp_glo = NINT(x_tmp)
+     !-
+     ! Number of values stored per year in the forcing file is stored in nparan var.
+     !-
+     ier = NF90_GET_ATT (Cforcing_id,NF90_GLOBAL,'nparan',x_tmp)
+     nparan = NINT(x_tmp)
+     ier = NF90_GET_ATT (Cforcing_id,NF90_GLOBAL,'nbyear',x_tmp)
+     nbyear = NINT(x_tmp)
+     !-
+     ALLOCATE (indices_g(nbp_glo))
+     ALLOCATE (clay_g(nbp_glo))
+     ALLOCATE (soil_ph_g(nbp_glo))
+     ALLOCATE (bulk_dens_g(nbp_glo))
+     ALLOCATE (soiltile_g(nbp_glo,nstm))
+     ALLOCATE (veget_max_g(nbp_glo,nvm))
+     !-
+     ALLOCATE (x_indices_g(nbp_glo),stat=ier)
+     ier = NF90_INQ_VARID (Cforcing_id,'index',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,x_indices_g)
+     indices_g(:) = NINT(x_indices_g(:))
+     WRITE(numout,*) mpi_rank,"indices globaux : ",indices_g
+     DEALLOCATE (x_indices_g)
+     !-
+     ier = NF90_INQ_VARID (Cforcing_id,'clay',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,clay_g)
+     ier = NF90_INQ_VARID (Cforcing_id,'soil_ph',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,soil_ph_g)
+     ier = NF90_INQ_VARID (Cforcing_id,'bulk_dens',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,bulk_dens_g)
+     ier = NF90_INQ_VARID (Cforcing_id,'soiltile',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,soiltile_g)
+     ier = NF90_INQ_VARID (Cforcing_id,'veget_max',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,veget_max_g)
+     !-
+     ! time step of forcesoil program (in days)
+     !-
+     dt_forcesoil = one_year / FLOAT(nparan)
+     WRITE(numout,*) 'time step (d): ',dt_forcesoil
+     WRITE(numout,*) 'nparan: ',nparan
+     WRITE(numout,*) 'nbyear: ',nbyear    
+     !-
+     ! read and write the variables in the output restart file we do not modify within the Forcesoil program
+     ! ie all variables stored in the input restart file except those stored in taboo_vars
+     !-
+     taboo_vars ='$lon$ $lat$ $lev$ $nav_lon$ $nav_lat$ $nav_lev$ $time$ $time_steps$ '// &
+          &             '$dt_days$ $date$'
+     !     &             '$day_counter$ $dt_days$ $date$ '
+     !-
+   
+DO l=1,nelements
+       IF     (l == icarbon) THEN
+          element_str(l) = 'carbon_total'
+       ELSEIF (l == icarbon14) THEN
+          element_str(l) = '_carbon14'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io readstart','Define element_str','','')
+       ENDIF
+    ENDDO
+
+DO k=1,nelements
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z01_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z02_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z03_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z04_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z05_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z06_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z07_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z08_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z09_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z1_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z2_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z3_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z4_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z5_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z6_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z7_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z8_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z9_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z1_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z2_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z3_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z4_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z5_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z6_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z7_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z8_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z9_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+ENDDO
+
+     !-
+     CALL ioget_vname(rest_id_sto, nbvar, varnames)
+     !-
+     ! read and write some special variables (1D or variables that we need)
+     !-
+     !var_name = 'day_counter'
+     !CALL restget (rest_id_sto, var_name, 1, 1, 1, itau_dep, .TRUE., xtmp)
+     !CALL restput (rest_id_sto, var_name, 1, 1, 1, itau_dep, xtmp)
+     !-
+     var_name = 'dt_days'
+     CALL restget (rest_id_sto, var_name, 1, 1, 1, itau_dep, .TRUE., xtmp)
+     CALL restput (rest_id_sto, var_name, 1, 1, 1, itau_dep, xtmp)
+     !-
+     var_name = 'date'
+     CALL restget (rest_id_sto, var_name, 1, 1, 1, itau_dep, .TRUE., xtmp)
+     CALL restput (rest_id_sto, var_name, 1, 1, 1, itau_dep, xtmp)
+     !-
+
+     DO iv=1,nbvar
+        !-- check if the variable is to be written here
+        IF (INDEX(taboo_vars,'$'//TRIM(varnames(iv))//'$') == 0 ) THEN
+           !---- get variable dimensions, especially 3rd dimension
+           CALL ioget_vdim &
+                &      (rest_id_sto, varnames(iv), varnbdim_max, varnbdim, vardims)
+           l1d = ALL(vardims(1:varnbdim) == 1)
+           !---- read it
+           IF (l1d) THEN
+              CALL restget &
+                   &        (rest_id_sto, TRIM(varnames(iv)), 1, vardims(3), &
+                   &         1, itau_dep, .TRUE., xtmp)
+           ELSE
+              ALLOCATE( var_3d(nbp_glo,vardims(3)), stat=ier)
+              IF (ier /= 0) STOP 'ALLOCATION PROBLEM'
+              !----
+
+              CALL restget &
+                   &        (rest_id_sto, TRIM(varnames(iv)), nbp_glo, vardims(3), &
+                   &         1, itau_dep, .TRUE., var_3d, 'gather', nbp_glo, indices_g)
+           ENDIF
+           !---- write it
+           IF (l1d) THEN
+              CALL restput &
+                   &        (rest_id_sto, TRIM(varnames(iv)), 1, vardims(3), &
+                   &         1, itau_dep, xtmp)
+           ELSE
+              CALL restput &
+                   &        (rest_id_sto, TRIM(varnames(iv)), nbp_glo, vardims(3), &
+                   &         1, itau_dep, var_3d, 'scatter',  nbp_glo, indices_g)
+              !----
+              DEALLOCATE(var_3d)
+           ENDIF
+        ENDIF
+     ENDDO
+     !-
+     ! read soil carbon stocks values stored in the input restart file
+     !-
+     ALLOCATE(carbon_g(nbp_glo,ncarb,nvm,nbdl,nelements),stat=ier)
+  IF (ier /= 0) THEN
+     WRITE(numout,*) 'Allocatoin error carbon_g ier = ',ier 
+     STOP 
+  END IF
+     carbon_g(:,:,:,:,:) = val_exp
+     ALLOCATE(DOC_g(nbp_glo,nvm,nbdl,ndoc,npool,nelements),stat=ier)
+  IF (ier /= 0) THEN
+     WRITE(numout,*) 'Allocatoin error DOC_g ier = ',ier 
+     STOP 
+  END IF
+
+     DOC_g(:,:,:,:,:,:) = val_exp
+DO k=1,nelements
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z01_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,1,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,1,k) == val_exp)) carbon_g(:,:,m,1,k) = zero
+    ENDDO
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z02_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,2,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,2,k) == val_exp)) carbon_g(:,:,m,2,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z03_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,3,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,3,k) == val_exp)) carbon_g(:,:,m,3,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z04_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,4,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,4,k) == val_exp)) carbon_g(:,:,m,4,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z05_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,5,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,5,k) == val_exp)) carbon_g(:,:,m,5,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z06_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,6,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,6,k) == val_exp)) carbon_g(:,:,m,6,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z07_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,7,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,7,k) == val_exp)) carbon_g(:,:,m,7,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z08_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,8,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,8,k) == val_exp)) carbon_g(:,:,m,8,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z09_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,9,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,9,k) == val_exp)) carbon_g(:,:,m,9,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,10,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,10,k) == val_exp)) carbon_g(:,:,m,10,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,11,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,11,k) == val_exp)) carbon_g(:,:,m,11,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z1_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,1,ifree,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,1,ifree,m,k) == val_exp)) DOC_g(:,:,1,ifree,m,k) = zero
+    ENDDO
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z2_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,2,ifree,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,2,ifree,m,k) == val_exp)) DOC_g(:,:,2,ifree,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z3_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,3,ifree,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,3,ifree,m,k) == val_exp)) DOC_g(:,:,3,ifree,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z4_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,4,ifree,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,4,ifree,m,k) == val_exp)) DOC_g(:,:,4,ifree,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z5_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,5,ifree,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,5,ifree,m,k) == val_exp)) DOC_g(:,:,5,ifree,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z6_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,6,ifree,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,6,ifree,m,k) == val_exp)) DOC_g(:,:,6,ifree,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z7_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,7,ifree,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,7,ifree,m,k) == val_exp)) DOC_g(:,:,7,ifree,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z8_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,8,ifree,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,8,ifree,m,k) == val_exp)) DOC_g(:,:,8,ifree,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z9_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,9,ifree,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,9,ifree,m,k) == val_exp)) DOC_g(:,:,9,ifree,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,10,ifree,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,10,ifree,m,k) == val_exp)) DOC_g(:,:,10,ifree,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,11,ifree,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,11,ifree,m,k) == val_exp)) DOC_g(:,:,11,ifree,m,k) = zero
+    ENDDO
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z1_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,1,iadsorbed,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,1,iadsorbed,m,k) == val_exp)) DOC_g(:,:,1,iadsorbed,m,k) = zero
+    ENDDO
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z2_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,2,iadsorbed,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,2,iadsorbed,m,k) == val_exp)) DOC_g(:,:,2,iadsorbed,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z3_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,3,iadsorbed,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,3,iadsorbed,m,k) == val_exp)) DOC_g(:,:,3,iadsorbed,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z4_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,4,iadsorbed,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,4,iadsorbed,m,k) == val_exp)) DOC_g(:,:,4,iadsorbed,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z5_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,5,iadsorbed,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,5,iadsorbed,m,k) == val_exp)) DOC_g(:,:,5,iadsorbed,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z6_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,6,iadsorbed,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,6,iadsorbed,m,k) == val_exp)) DOC_g(:,:,6,iadsorbed,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z7_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,7,iadsorbed,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,7,iadsorbed,m,k) == val_exp)) DOC_g(:,:,7,iadsorbed,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z8_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,8,iadsorbed,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,8,iadsorbed,m,k) == val_exp)) DOC_g(:,:,8,iadsorbed,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z9_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,9,iadsorbed,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,9,iadsorbed,m,k) == val_exp)) DOC_g(:,:,9,iadsorbed,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,10,iadsorbed,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,10,iadsorbed,m,k) == val_exp)) DOC_g(:,:,10,iadsorbed,m,k) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,11,iadsorbed,m,k), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,11,iadsorbed,m,k) == val_exp)) DOC_g(:,:,11,iadsorbed,m,k) = zero
+    ENDDO
+ENDDO
+
+     WRITE(numout,*) "date0 : ",date0, itau_dep
+     !-
+     ! Analytical spinup is set to false
+     !
+     spinup_analytic = .FALSE.
+
+     ! Length of the run (in Years)
+     ! User value is used if present in the .def file
+     ! If not, default value (10000 Years) is used
+     !-
+     WRITE(time_str,'(a)') '10000Y'
+     CALL getin('TIME_LENGTH', time_str)
+     write(numout,*) 'Number of years for carbon spinup : ',time_str
+     ! transform into itau
+     CALL tlen2itau(time_str, dt_forcesoil*one_day, date0, itau_len)
+     write(numout,*) 'Number of time steps to do: ',itau_len
+     !-
+     ! read soil carbon inputs, water and temperature stresses on OM decomposition 
+     ! into the forcing file - We read an average year.
+     !-
+     ALLOCATE(soilcarbon_input_g(nbp_glo,nvm,nbdl,npool,nelements,nparan*nbyear))
+     ALLOCATE(litter_above_g(nbp_glo,nlitt,nvm,nelements,nparan*nbyear))
+     ALLOCATE(litter_below_g(nbp_glo,nlitt,nvm,nbdl,nelements,nparan*nbyear))
+     ALLOCATE(lignin_struc_above_g(nbp_glo,nvm,nparan*nbyear))
+     ALLOCATE(lignin_struc_below_g(nbp_glo,nvm,nbdl,nparan*nbyear))
+     !-
+     ALLOCATE(control_temp_soil_g(nbp_glo,nbdl,npool*2,nparan*nbyear))
+     ALLOCATE(control_moist_soil_g(nbp_glo,nbdl,nvm,nparan*nbyear))
+     ALLOCATE(moist_soil_g(nbp_glo,nbdl,nparan*nbyear))
+     ALLOCATE(soil_mc_g(nbp_glo,nbdl,nstm,nparan*nbyear))
+     ALLOCATE(floodout_g(nbp_glo,nparan*nbyear))
+     ALLOCATE(wat_flux0_g(nbp_glo,nstm,nparan*nbyear))
+     ALLOCATE(wat_flux_g(nbp_glo,nbdl,nstm,nparan*nbyear))
+     ALLOCATE(runoff_per_soil_g(nbp_glo,nstm,nparan*nbyear))
+     ALLOCATE(drainage_per_soil_g(nbp_glo,nstm,nparan*nbyear))
+     ALLOCATE(DOC_to_topsoil_g(nbp_glo,nelements,nparan*nbyear))
+     ALLOCATE(DOC_to_subsoil_g(nbp_glo,nelements,nparan*nbyear))
+     !-
+     ier = NF90_INQ_VARID (Cforcing_id,'soilcarbon_input',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,soilcarbon_input_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'control_moist_soil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,control_moist_soil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,    'control_temp_soil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,control_temp_soil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,    'litter_above',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,litter_above_g)
+     ier = NF90_INQ_VARID (Cforcing_id,    'litter_below',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,litter_below_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'moist_soil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,moist_soil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'soil_mc',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,soil_mc_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'floodout',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,floodout_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'wat_flux0',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,wat_flux0_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'wat_flux',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,wat_flux_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'runoff_per_soil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,runoff_per_soil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'drainage_per_soil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,drainage_per_soil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'DOC_to_topsoil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,DOC_to_topsoil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'DOC_to_subsoil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,DOC_to_subsoil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,    'lignin_struc_above',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,lignin_struc_above_g)
+     ier = NF90_INQ_VARID (Cforcing_id,    'lignin_struc_below',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,lignin_struc_below_g)
+     !-
+     ier = NF90_CLOSE (Cforcing_id)
+     !-
+  ENDIF
+  CALL bcast(nparan)
+  CALL bcast(nbyear)
+  CALL bcast(dt_forcesoil)
+  CALL bcast(iim_g)
+  CALL bcast(jjm_g)
+  CALL bcast(nbp_glo)
+  CALL bcast(itau_dep)
+  CALL bcast(itau_len)
+  IF (.NOT. ALLOCATED(indices_g)) ALLOCATE (indices_g(nbp_glo))
+  CALL bcast(indices_g)
+ 
+  !
+  ! We must initialize data_para :
+  CALL init_orchidee_data_para_driver(nbp_glo,indices_g)
+
+  kjpindex=nbp_loc
+  jjm=jj_nb
+  iim=iim_g
+  IF (debug) WRITE(numout,*) "Local grid : ",kjpindex,iim,jjm
+
+  !---
+  !--- Create the index table
+  !---
+  !--- This job returns a LOCAL kindex.
+  !---
+  ALLOCATE (indices(kjpindex),stat=ier)
+  !
+  !! scattering to all processes in parallel mode
+  !
+  CALL scatter(indices_g,indices)
+  indices(1:kjpindex)=indices(1:kjpindex)-(jj_begin-1)*iim_g
+  IF (debug) WRITE(numout,*) mpi_rank,"indices locaux = ",indices(1:kjpindex)
+  !-
+  ! Allocation of the variables for a processor
+  !-
+  ALLOCATE(clay(kjpindex))
+  ALLOCATE(soil_ph(kjpindex))
+  ALLOCATE(bulk_dens(kjpindex))
+  ALLOCATE(soiltile(kjpindex,nstm))
+  ALLOCATE(veget_max(kjpindex,nvm))
+  ALLOCATE(soilcarbon_input(kjpindex,nvm,nbdl,npool,nelements,nparan*nbyear))
+  ALLOCATE(control_temp_soil(kjpindex,nbdl,npool*2,nparan*nbyear))
+  ALLOCATE(control_moist_soil(kjpindex,nbdl,nvm,nparan*nbyear))
+  ALLOCATE(carbon(kjpindex,ncarb,nvm,nbdl,nelements))
+  ALLOCATE(litter_above(kjpindex,nlitt,nvm,nelements,nparan*nbyear))
+  ALLOCATE(litter_below(kjpindex,nlitt,nvm,nbdl,nelements,nparan*nbyear))
+  ALLOCATE(resp_hetero_soil(kjpindex,nvm,nelements))
+  ALLOCATE(soilhum(kjpindex,nbdl))
+  ALLOCATE(moist_soil(kjpindex,nbdl,nparan*nbyear))
+  ALLOCATE(soil_mc(kjpindex,nbdl,nstm,nparan*nbyear))
+  ALLOCATE(floodout(kjpindex,nparan*nbyear))
+  ALLOCATE(wat_flux0(kjpindex,nstm,nparan*nbyear))
+  ALLOCATE(wat_flux(kjpindex,nbdl,nstm,nparan*nbyear))
+  ALLOCATE(runoff_per_soil(kjpindex,nstm,nparan*nbyear))
+  ALLOCATE(drainage_per_soil(kjpindex,nstm,nparan*nbyear))
+  ALLOCATE(DOC_to_topsoil(kjpindex,nelements,nparan*nbyear))
+  ALLOCATE(DOC_to_subsoil(kjpindex,nelements,nparan*nbyear))
+  ALLOCATE(DOC(kjpindex,nvm,nbdl,ndoc,npool,nelements))
+  ALLOCATE(DOC_EXP(kjpindex,nvm,nexp,nelements))
+  ALLOCATE(lignin_struc_above(kjpindex,nvm,nparan*nbyear))
+  ALLOCATE(lignin_struc_below(kjpindex,nvm,nbdl,nparan*nbyear))
+  iatt = 0
+  !-
+  ! Initialization of the variables for a processor
+  !-
+  CALL Scatter(clay_g,clay)
+  CALL Scatter(soil_ph_g,soil_ph)
+  CALL Scatter(bulk_dens_g,bulk_dens)
+  CALL Scatter(soiltile_g,soiltile)
+  CALL Scatter(veget_max_g,veget_max)
+          DO m =1,nvm
+             DO l=1,nbdl
+                DO i=1,npool
+  CALL Scatter(soilcarbon_input_g(:,m,l,i,:,:),soilcarbon_input(:,m,l,i,:,:))
+                ENDDO
+             ENDDO
+          ENDDO
+          DO i =1,nlitt
+             DO j=1,nvm
+  CALL Scatter(litter_above_g(:,i,j,:,:),litter_above(:,i,j,:,:))
+             ENDDO
+          ENDDO
+
+          DO i =1,nlitt
+             DO j=1,nvm
+                DO k = 1,nbdl
+  CALL Scatter(litter_below_g(:,i,j,k,:,:),litter_below(:,i,j,k,:,:))
+                ENDDO
+             ENDDO
+          ENDDO
+  CALL Scatter(control_temp_soil_g,control_temp_soil)
+  CALL Scatter(control_moist_soil_g,control_moist_soil)
+  CALL Scatter(moist_soil_g,moist_soil)
+  CALL Scatter(soil_mc_g,soil_mc)
+  CALL Scatter(floodout_g,floodout)
+  CALL Scatter(wat_flux0_g,wat_flux0)
+  CALL Scatter(wat_flux_g,wat_flux)
+  CALL Scatter(runoff_per_soil_g,runoff_per_soil)
+  CALL Scatter(drainage_per_soil_g,drainage_per_soil)
+  CALL Scatter(DOC_to_topsoil_g,DOC_to_topsoil)
+  CALL Scatter(DOC_to_subsoil_g,DOC_to_subsoil)
+          DO m =1,nvm
+             DO l=1,nbdl
+		DO k=1,nelements
+  CALL Scatter(carbon_g(:,:,m,l,k),carbon(:,:,m,l,k))  
+		ENDDO
+             ENDDO
+          ENDDO
+          DO m =1,nbdl
+             DO l=1,ndoc
+                DO i= 1,npool
+		   DO k=1,nelements
+  CALL Scatter(DOC_g(:,:,m,l,i,k),DOC(:,:,m,l,i,k))
+		   ENDDO
+                ENDDO
+             ENDDO
+          ENDDO
+          DO j=1,nvm
+  CALL Scatter(lignin_struc_above_g(:,j,:),lignin_struc_above(:,j,:))
+          ENDDO
+          DO j=1,nvm
+             DO k = 1,nbdl
+  CALL Scatter(lignin_struc_below_g(:,j,k,:),lignin_struc_below(:,j,k,:))
+             ENDDO
+          ENDDO
+!-
+! Configu
+!-
+
+  !Config Key   = FRAC_CARB_AP
+  !Config Desc  = frac carb coefficients from active pool: depends on clay content
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.004
+  !Config Help  = fraction of the active pool going to the passive pool
+  !Config Units = [-]
+  CALL getin_p('FRAC_CARB_AP',frac_carb_ap)  
+  !
+  !Config Key   = FRAC_CARB_SA
+  !Config Desc  = frac_carb_coefficients from slow pool
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.42
+  !Config Help  = fraction of the slow pool going to the active pool
+  !Config Units = [-] 
+  CALL getin_p('FRAC_CARB_SA',frac_carb_sa)
+  !
+  !Config Key   = FRAC_CARB_SP
+  !Config Desc  = frac_carb_coefficients from slow pool
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.03
+  !Config Help  = fraction of the slow pool going to the passive pool
+  !Config Units = [-] 
+  !CALL getin_p('FRAC_CARB_SP',frac_carb_sp)
+  !
+  !Config Key   = FRAC_CARB_PA
+  !Config Desc  = frac_carb_coefficients from passive pool
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.45
+  !Config Help  = fraction of the passive pool going to the passive pool
+  !Config Units = [-] 
+  CALL getin_p('FRAC_CARB_PA',frac_carb_pa)
+  !
+  !Config Key   = FRAC_CARB_PS
+  !Config Desc  = frac_carb_coefficients from passive pool
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.0
+  !Config Help  = fraction of the passive pool going to the passive pool
+  !Config Units = [-]
+  !CALL getin_p('FRAC_CARB_PS',frac_carb_ps)
+  !
+  !Config Key   = ACTIVE_TO_PASS_CLAY_FRAC
+  !Config Desc  = 
+  !Config if    = OK_STOMATE 
+  !Config Def   =  .68  
+  !Config Help  =
+  !Config Units = [-]
+  CALL getin_p('ACTIVE_TO_PASS_CLAY_FRAC',active_to_pass_clay_frac)
+!
+  !Config Key   = CARBON_TAU_IACTIVE
+  !Config Desc  = residence times in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.3
+  !Config Help  =
+  !Config Units =  [days] 
+  CALL getin_p('CARBON_TAU_IACTIVE',carbon_tau_iactive)
+  !
+  !Config Key   = CARBON_TAU_ISLOW
+  !Config Desc  = residence times in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 1.12
+  !Config Help  =
+  !Config Units = [days]
+  CALL getin_p('CARBON_TAU_ISLOW',carbon_tau_islow)
+  !
+  !Config Key   = CARBON_TAU_IPASSIVE
+  !Config Desc  = residence times in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 461.98
+  !Config Help  = residence time in the passive pool
+  !Config Units = [days] 
+  CALL getin_p('CARBON_TAU_IPASSIVE',carbon_tau_ipassive)
+  !
+  !Config Key   = PRIMING_PARAM_IACTIVE
+  !Config Desc  = priming parameter in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 493.66
+  !Config Help  =
+  !Config Units =  [-] 
+  CALL getin_p('PRIMING_PARAM_IACTIVE',priming_param_iactive)
+  !
+  !Config Key   = PRIMING_PARAM_ISLOW
+  !Config Desc  = priming parameter in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 194.03
+  !Config Help  =
+  !Config Units =  [-] 
+  CALL getin_p('PRIMING_PARAM_ISLOW',priming_param_islow)
+  !
+  !Config Key   = PRIMING_PARAM_IPASSIVE
+  !Config Desc  = priming parameter in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 136.54
+  !Config Help  =
+  !Config Units =  [-] 
+  CALL getin_p('PRIMING_PARAM_IPASSIVE',priming_param_ipassive)
+  !
+!  !Config Key   = BULK_DENSITY
+!  !Config Desc  = value of the soil bulk density 
+!  !Config if    = READ_BULK_DENSITY
+!  !Config Def   = 1.65
+!  !Config Help  =
+!  !Config Units =  [kg m-3] 
+!  CALL getin_p('BULK_DENSITY',bulk_dens)
+  !
+  !Config Key   = FLUX_TOT_COEFF
+  !Config Desc  =
+  !Config if    = OK_STOMATE 
+  !Config Def   = 1.2, 1.4,.75
+  !Config Help  =
+  !Config Units = [days]
+  CALL getin_p('FLUX_TOT_COEFF',flux_tot_coeff)
+  !
+  !Config Key   = PREF_SOIL_VEG
+  !Config Desc  = The soil tile number for each vegetation
+  !Config if    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3
+  !Config Help  = Gives the number of the soil tile on which we will
+  !Config         put each vegetation. This allows to divide the
+  !hydrological column
+  !Config Units = [-]        
+  CALL getin_p('PREF_SOIL_VEG',pref_soil_veg)
+  !
+  !Config Key   = DOC_tau_labile
+  !Config Desc  = residence time of labile DOC
+  !Config if    = OK_STOMATE 
+  !Config Def   = 3.76
+  !Config Help  = mean from Kalbitz et al., 2003 Geoderma
+  !Config Units =  [days] 
+  CALL getin_p('DOC_TAU_LABILE',DOC_tau_labile)
+  !
+  !Config Key   = DOC_tau_stable
+  !Config Desc  = residence time of stable DOC
+  !Config if    = OK_STOMATE 
+  !Config Def   = 602.41
+  !Config Help  = mean from Kalbitz et al., 2003 Geoderma
+  !Config Units =  [days] 
+  CALL getin_p('DOC_TAU_STABLE',DOC_tau_stable)
+  !
+  !!Config Key  = D_DOC
+  !Config Desc  = diffusion coefficient of DOC
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.0000004428
+  !Config Help  = from Burdige et al., 1999 in Ota et al., 2013
+  !Config Units =  [m^2 hr-1] 
+  CALL getin_p('D_DOC',D_DOC)
+  !
+  !!Config Key   = Dif
+  !Config Desc  = diffusion coefficient of POC
+  !Config if    = OK_STOMATE 
+  !Config Def   = 1E-4
+  !Config Help  = from Koven et al., 2013 BG
+  !Config Units =  [m^2 day-1] 
+  CALL getin_p('Dif',Dif)
+  !
+  !!Config Key   = CUE
+  !Config Desc  = Microbial carbon use efficiency
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.5
+  !Config Help  = Assumed value of CUE=0.5
+  !Config Units =  [-] 
+  CALL getin_p('CUE',CUE)
+
+  !!-
+  !! 2. Computational step
+  !! Loop over time - Call of soilcarbon routine at each time step 
+  !! Updated soil carbon stocks are stored into carbon variable
+  !! We only keep the last value of carbon variable (no time dimension).
+  !!-
+  iyear=1
+  DO i=1,itau_len
+     iatt = iatt+1
+     IF (iatt > nparan*nbyear) THEN
+        IF (debug) WRITE(numout,*) iyear
+        iatt = 1
+        iyear=iyear+1
+     ENDIF
+
+       ! Get diaglev from module vertical for CWRR
+       diaglev=znt(1:nbdl)
+
+     CALL soilcarbon &
+          &    (kjpindex, dt_forcesoil, clay, &
+          &     soilcarbon_input(:,:,:,:,:,iatt), control_temp_soil(:,:,:,iatt), control_moist_soil(:,:,:,iatt), &
+          &     carbon, resp_hetero_soil, &
+          &     litter_above(:,:,:,:,iatt),litter_below(:,:,:,:,:,iatt),&
+          &     soilhum, DOC, moist_soil(:,:,iatt), DOC_EXP,&
+          &     lignin_struc_above(:,:,iatt), lignin_struc_below(:,:,:,iatt),&
+          &     floodout(:,iatt), runoff_per_soil(:,:,iatt), drainage_per_soil(:,:,iatt), wat_flux0(:,:,iatt), &
+          &     wat_flux(:,:,:,iatt),bulk_dens, soil_ph,veget_max, soil_mc(:,:,:,iatt), soiltile, &
+          &     DOC_to_topsoil(:,:,iatt), DOC_to_subsoil(:,:,iatt))
+  ENDDO
+  WRITE(numout,*) "End of soilcarbon LOOP."
+
+  !
+  !! Gathering of variables towards main processor in parallel mode
+  !
+          DO m =1,nvm
+             DO l=1,nbdl
+		DO k=1,nelements
+  CALL Gather(carbon(:,:,m,l,k),carbon_g(:,:,m,l,k))
+		ENDDO
+             ENDDO
+          ENDDO
+          DO m =1,nbdl
+             DO l=1,ndoc
+                DO i= 1,npool
+		   DO k=1,nelements
+  CALL Gather(DOC(:,:,m,l,i,k),DOC_g(:,:,m,l,i,k))
+		   ENDDO
+                ENDDO
+             ENDDO
+          ENDDO
+  !!-
+  !! 3. write new carbon stocks into the ouput restart file
+  !!-
+  IF (is_root_prc) THEN
+DO k=1,nelements
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z01_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,1,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z02_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,2,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z03_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,3,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z04_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,4,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z05_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,5,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z06_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,6,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z07_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,7,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z08_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,8,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z09_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,9,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,10,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,11,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z1_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,1,ifree,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z2_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,2,ifree,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z3_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,3,ifree,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z4_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,4,ifree,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z5_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,5,ifree,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z6_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,6,ifree,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z7_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,7,ifree,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z8_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,8,ifree,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z9_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,9,ifree,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,10,ifree,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,11,ifree,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z1_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,1,iadsorbed,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z2_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,2,iadsorbed,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z3_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,3,iadsorbed,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z4_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,4,iadsorbed,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z5_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,5,iadsorbed,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z6_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,6,iadsorbed,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z7_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,7,iadsorbed,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z8_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,8,iadsorbed,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z9_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,9,iadsorbed,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,10,iadsorbed,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,11,iadsorbed,m,k), 'scatter', nbp_glo, indices_g)
+    ENDDO
+ENDDO
+
+     !-
+     CALL getin_dump
+     CALL restclo
+!     ier = NF90_CLOSE(rest_id_sto)
+!	IF (ier /= 0) THEN
+ !    	WRITE(numout,*) 'Error closing netcdf file = ',ier
+  !  	STOP
+  !	END IF
+
+  ENDIF
+
+#ifdef CPP_PARA
+  CALL MPI_FINALIZE(ier)
+#endif
+  WRITE(numout,*) "End of forcesoil."
+  !--------------------
+END PROGRAM forcesoil
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/getprec.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/getprec.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/getprec.f90	(revision 5166)
@@ -0,0 +1,57 @@
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+PROGRAM getprec
+!---------------------------------------------------------------------
+!- This program verifies that that the number representation
+!- between the different components of the model are compatible
+!---------------------------------------------------------------------
+  USE defprec
+!-
+  IMPLICIT NONE
+!-
+  INTEGER :: i
+  REAL    :: r
+!-
+  INTEGER :: range_int,range_real,precision_real
+!---------------------------------------------------------------------
+  range_int  = RANGE(i)
+  range_real = RANGE(r)
+  precision_real = PRECISION(r)
+!-
+  WRITE(*,*) 'The following ranges and precisions are standard'
+  WRITE(*,*) 'on this computer with your compiler options :'
+  WRITE(*,*) ' INTEGER range     :',range_int
+  WRITE(*,*) ' REAL    range     :',range_real
+  WRITE(*,*) ' REAL    precision :',precision_real
+!-
+  WRITE(*,*) 'The corresponding kinds are :'
+  WRITE(*,*) ' KIND for integer  :', &
+ & SELECTED_INT_KIND(range_int)
+  WRITE(*,*) ' KIND for real     :', &
+ & SELECTED_REAL_KIND(precision_real,range_real)
+!-
+  WRITE(*,*) 'We test if this corresponds to what is used'
+  WRITE(*,*) 'in various parts of the code :'
+!-
+! Real :
+!-
+  IF (SELECTED_REAL_KIND(precision_real,range_real) /= r_std) THEN
+    WRITE(*,*) ' REAL : ERROR, the wrong kind is specified.'
+    WRITE(*,*) ' Use the value above.'
+  ELSE
+    WRITE(*,*) ' REAL    : OK'
+  ENDIF
+!-
+! Integer :
+!-
+  IF (SELECTED_INT_KIND(range_int) /= i_std) THEN
+    WRITE(*,*) ' INTEGER : ERROR, the wrong kind is specified.'
+    WRITE(*,*) ' Use the value above.'
+  ELSE
+    WRITE(*,*) ' INTEGER : OK'
+  ENDIF
+!------------------
+END PROGRAM getprec
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/readdim2.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/readdim2.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/readdim2.f90	(revision 5166)
@@ -0,0 +1,2477 @@
+
+MODULE readdim2
+!---------------------------------------------------------------------
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!- IPSL (2006)
+!-  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!-
+   USE ioipsl_para
+   USE weather
+   USE TIMER
+   USE constantes
+   USE solar
+   USE grid
+   USE mod_orchidee_para
+!-
+   IMPLICIT NONE
+!-
+   PRIVATE
+   PUBLIC  :: forcing_read, forcing_info, forcing_grid
+!-
+   INTEGER, SAVE                            :: iim_full, jjm_full, llm_full, ttm_full
+   INTEGER, SAVE                            :: iim_zoom, jjm_zoom
+   INTEGER, SAVE                            :: iim_g_begin,jjm_g_begin,iim_g_end,jjm_g_end
+   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:)  :: data_full, lon_full, lat_full
+   REAL, SAVE, ALLOCATABLE, DIMENSION(:)    :: lev_full
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: itau, i_index, j_index,j_index_g
+   INTEGER, SAVE                            :: i_test, j_test
+   INTEGER, SAVE                            :: printlev_loc   !! Local printlev
+   LOGICAL, SAVE                            :: allow_weathergen, interpol, daily_interpol
+   LOGICAL, SAVE, PUBLIC                    :: weathergen, is_watchout
+   REAL, SAVE                               :: merid_res, zonal_res
+   LOGICAL, SAVE                            :: have_zaxis=.FALSE.
+!-
+!- Heigh controls and data 
+!- 
+   LOGICAL, SAVE                            :: zfixed, zsigma, zhybrid, zlevels, zheight 
+   LOGICAL, SAVE                            :: zsamelev_uv 
+   REAL, SAVE                               :: zlev_fixed, zlevuv_fixed 
+   REAL, SAVE                               :: zhybrid_a, zhybrid_b 
+   REAL, SAVE                               :: zhybriduv_a, zhybriduv_b 
+
+CONTAINS
+!-
+!=====================================================================
+!-
+  SUBROUTINE forcing_info(filename, iim, jjm, llm, tm, date0, dt_force,&
+       & force_id)
+
+    !---------------------------------------------------------------------
+    !
+    !- This subroutine will get all the info from the forcing file and
+    !- prepare for the zoom if needed.
+    !- It returns to the caller the sizes of the data it will receive at
+    !- the forcing_read call. This is important so that the caller can
+    !- allocate the right space.
+    !-
+    !- filename   : name of the file to be opened
+    !- iim        : size in x of the forcing data
+    !- jjm        : size in y of the forcing data
+    !- llm        : number of levels in the forcing data (not yet used)
+    !- tm         : Time dimension of the forcing
+    !- date0      : The date at which the forcing file starts (julian days)
+    !- dt_force   : time-step of the forcing file in seconds
+    !- force_id   : ID of the forcing file
+    !-
+    !- ARGUMENTS
+    !-
+    IMPLICIT NONE
+    !-
+    CHARACTER(LEN=*) :: filename
+    INTEGER          :: iim, jjm, llm, tm
+    REAL             :: date0, dt_force
+    INTEGER, INTENT(OUT) :: force_id
+    !- LOCAL
+    CHARACTER(LEN=20) :: calendar_str
+    CHARACTER(LEN=200):: printstr       !! temporary character string to contain error message 
+    REAL :: juld_1, juld_2
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: fcontfrac
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: qair
+    LOGICAL :: contfrac_exists=.FALSE.
+    INTEGER :: NbPoint
+    INTEGER :: i_test,j_test
+    INTEGER :: i,j,ind,ttm_part
+    INTEGER, ALLOCATABLE, DIMENSION(:)  :: index_l
+    REAL, ALLOCATABLE, DIMENSION(:,:)  :: lon, lat
+    REAL, ALLOCATABLE, DIMENSION(:)    :: lev, levuv
+
+    !-
+    CALL flininfo(filename,  iim_full, jjm_full, llm_full, ttm_full, force_id)
+    !-
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'forcing_info : Details from forcing file :', &
+         iim_full, jjm_full, llm_full, ttm_full
+    !-
+    IF ( llm_full < 1 ) THEN
+       have_zaxis = .FALSE.
+    ELSE
+       have_zaxis = .TRUE.
+    ENDIF
+    WRITE(numout,*) 'have_zaxis : ', llm_full, have_zaxis
+    !-
+    ttm_part = 2
+    ALLOCATE(itau(ttm_part))
+    ALLOCATE(data_full(iim_full, jjm_full),lon_full(iim_full, jjm_full),&
+         & lat_full(iim_full, jjm_full))
+    ALLOCATE(lev_full(llm_full))
+    ALLOCATE(fcontfrac(iim_full,jjm_full))
+    !-
+    lev_full(:) = zero
+    !-
+    dt_force=zero
+    CALL flinopen &
+         &  (filename, .FALSE., iim_full, jjm_full, llm_full, lon_full, lat_full, &
+         &   lev_full, ttm_part, itau, date0, dt_force, force_id)
+    IF ( dt_force == zero ) THEN
+       dt_force = itau(2) - itau(1) 
+       itau(:) = itau(:) / dt_force
+    ENDIF
+    !  WRITE(numout,*) "forcing_info : Forcing time step out of flinopen : ",dt_force
+    !-
+    !- What are the alowed options for the temportal interpolation
+    !-
+    !Config Key   = ALLOW_WEATHERGEN
+    !Config Desc  = Allow weather generator to create data
+    !Config If    = [-]
+    !Config Def   = n
+    !Config Help  = This flag allows the forcing-reader to generate
+    !Config         synthetic data if the data in the file is too sparse
+    !Config         and the temporal resolution would not be enough to
+    !Config         run the model.
+    !Config Units = [FLAG]
+    !-
+    allow_weathergen = .FALSE.
+    CALL getin_p('ALLOW_WEATHERGEN',allow_weathergen)
+    !-
+    !- The calendar was set by the forcing file. If no "calendar" attribute was
+    !- found then it is assumed to be gregorian, 
+    !MM => FALSE !! it is NOT assumed anything !
+    !- else it is what ever is written in this attribute.
+    !-
+    CALL ioget_calendar(calendar_str)
+    i=INDEX(calendar_str,ACHAR(0))
+    IF ( i > 0 ) THEN
+       calendar_str(i:20)=' '
+    ENDIF
+    !  WRITE(numout,*) "forcing_info : Calendar used : ",calendar_str
+    IF ( calendar_str == 'XXXX' ) THEN
+       WRITE(numout,*) "forcing_info : The calendar was not found in the forcing file."
+       IF (allow_weathergen) THEN
+          ! Then change the calendar
+          CALL ioconf_calendar("noleap") 
+       ELSE
+          WRITE(numout,*) "forcing_info : We will force it to gregorian by default."
+          CALL ioconf_calendar("gregorian") !! = 365.2425 ; "noleap" = 365.0; "360d"; "julian"=365.25
+       ENDIF
+    ENDIF
+    WRITE(numout,*) "readdim2 : Calendar used by the model : ",calendar_str
+    IF (ttm_full .GE. 2) THEN
+       juld_1 = itau2date(itau(1), date0, dt_force)
+       juld_2 = itau2date(itau(2), date0, dt_force)
+    ELSE
+       juld_1 = 0
+       juld_2 = 0
+       CALL ipslerr_p ( 3, 'forcing_info','What is that only one time step in the forcing file ?', &
+            &         ' That can not be right.','verify forcing file.')
+    ENDIF
+    !-
+    !- Initialize one_year / one_day
+    CALL ioget_calendar (one_year, one_day)
+    !-
+    !- What is the distance between the two first states. From this we will deduce what is
+    !- to be done.
+    weathergen = .FALSE.
+    interpol = .FALSE.
+    daily_interpol = .FALSE.
+    is_watchout = .FALSE.
+    !-
+    IF ( ABS(ABS(juld_2-juld_1)-30.) .LE. 2.) THEN
+       IF ( allow_weathergen ) THEN
+          weathergen = .TRUE.
+          WRITE(numout,*) 'Using weather generator.' 
+       ELSE
+          CALL ipslerr_p ( 3, 'forcing_info', &
+               &         'This seems to be a monthly file.', &
+               &         'We should use a weather generator with this file.', &
+               &         'This should be allowed in the run.def')
+       ENDIF
+    ELSEIF (( ABS(juld_1-juld_2) .LE. 1./4.) .OR. ( ABS(juld_1-juld_2) .EQ. 1.)) THEN
+       interpol = .TRUE.
+       WRITE(numout,*) 'We will interpolate between the forcing data time steps.' 
+       IF ( ABS(juld_1-juld_2) .EQ. 1.) THEN
+          daily_interpol = .TRUE.
+       ENDIF
+    ELSE
+       ! Using the weather generator with data other than monthly ones probably
+       ! needs some thinking.
+       WRITE(numout,*) 'The time step is not suitable:',ABS(juld_1-juld_2),' days.'
+       CALL ipslerr_p ( 3, 'forcing_info','The time step is not suitable.', &
+            &         '','We cannot do anything with these forcing data.')
+    ENDIF
+    !-
+    !- redefine the forcing time step if the weather generator is activated
+    !-
+    IF ( weathergen ) THEN
+       !Config Key   = DT_WEATHGEN
+       !Config Desc  = Calling frequency of weather generator
+       !Config If    = ALLOW_WEATHERGEN
+       !Config Def   = 1800.
+       !Config Help  = Determines how often the weather generator
+       !Config         is called (time step in s). Should be equal
+       !Config         to or larger than Sechiba's time step (say,
+       !Config         up to 6 times Sechiba's time step or so).
+       !Config Units = [seconds]
+       dt_force = 1800.
+       CALL getin_p('DT_WEATHGEN',dt_force)
+    ENDIF
+    !-
+    !- Define the zoom
+    !-
+    !Config Key   = LIMIT_WEST
+    !Config Desc  = Western limit of region
+    !Config If    = [-]
+    !Config Def   = -180.
+    !Config Help  = Western limit of the region we are 
+    !Config         interested in. Between -180 and +180 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees] 
+    !- 
+    limit_west = -180.
+    CALL getin_p('LIMIT_WEST',limit_west)
+    !-
+    !Config Key   = LIMIT_EAST
+    !Config Desc  = Eastern limit of region
+    !Config If    = [-]
+    !Config Def   = 180.
+    !Config Help  = Eastern limit of the region we are
+    !Config         interested in. Between -180 and +180 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees] 
+    !-
+    limit_east = 180.
+    CALL getin_p('LIMIT_EAST',limit_east)
+    !-
+    !Config Key   = LIMIT_NORTH
+    !Config Desc  = Northern limit of region
+    !Config If    = [-]
+    !Config Def   = 90.
+    !Config Help  = Northern limit of the region we are
+    !Config         interested in. Between +90 and -90 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees]
+    !-
+    limit_north = 90.
+    CALL getin_p('LIMIT_NORTH',limit_north)
+    !-
+    !Config Key   = LIMIT_SOUTH
+    !Config Desc  = Southern limit of region
+    !Config If    = [-]
+    !Config Def   = -90.
+    !Config Help  = Southern limit of the region we are
+    !Config         interested in. Between 90 and -90 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees]
+    !-
+    limit_south = -90.
+    CALL getin_p('LIMIT_SOUTH',limit_south)
+    !- 
+    !- Calculate domain size
+    !-
+    IF ( interpol ) THEN
+       !-
+       !- If we use temporal interpolation, then we cannot change the resolution (yet?)
+       !-
+       ALLOCATE(i_index(iim_full), j_index(jjm_full),j_index_g(jjm_full))
+       IF (is_root_prc) THEN
+
+          CALL domain_size (limit_west, limit_east, limit_north, limit_south,&
+               &         iim_full, jjm_full, lon_full, lat_full, iim_zoom, jjm_zoom,&
+               &         i_index, j_index_g)
+
+          j_index(:)=j_index_g(:)
+
+          ALLOCATE(qair(iim_full,jjm_full))
+          CALL flinget_buffer (force_id,'Qair',iim_full, jjm_full, 1, ttm_full,  1, 1, data_full)
+          CALL forcing_zoom(data_full, qair)
+
+          CALL flinquery_var(force_id, 'contfrac', contfrac_exists)
+          IF ( contfrac_exists ) THEN
+             WRITE(numout,*) "contfrac exist in the forcing file."
+             CALL flinget_buffer (force_id,'contfrac',iim_full, jjm_full, 1, ttm_full,  1, 1, data_full)
+             CALL forcing_zoom(data_full, fcontfrac)
+             WRITE(numout,*) "fcontfrac min/max :",MINVAL(fcontfrac(1:iim_zoom,1:jjm_zoom)),MAXVAL(fcontfrac(1:iim_zoom,1:jjm_zoom))
+          ELSE
+             fcontfrac(:,:)=1.
+          ENDIF
+
+
+          DO i=1,iim_zoom
+             DO j=1,jjm_zoom
+                IF ( fcontfrac(i,j) <= EPSILON(1.) ) THEN
+                   qair(i,j) = 999999.
+                ENDIF
+             ENDDO
+          ENDDO
+
+          ALLOCATE(index_l(iim_zoom*jjm_zoom))
+          !- In this point is returning the global NbPoint with the global index
+          CALL forcing_landind(iim_zoom,jjm_zoom,qair,.TRUE.,NbPoint,index_l,i_test,j_test)
+          ! 
+          ! Work out the vertical layers to be used 
+          ! 
+          CALL forcing_vertical(force_id) 
+       ELSE
+          ALLOCATE(index_l(1))
+       ENDIF
+
+       ! Initiate global grid and parallelism
+       CALL bcast(iim_zoom)
+       CALL bcast(jjm_zoom)
+       CALL bcast(NbPoint)
+       CALL set_grid_glo(iim_zoom,jjm_zoom,NbPoint)
+       CALL allocate_grid_glo
+
+       ! Check consistency in the number of mpi processors and the number of land points
+       ! in order to prevent an exception  
+       IF (NbPoint < mpi_size) THEN 
+          WRITE(printstr,*) 'The number of landpoints found (', NbPoint, &
+               ') is less than the number of processors selected (', mpi_size,')' 
+          CALL ipslerr_p(3, 'forcing_info', 'Wrong parallelization options', &
+               TRIM(printstr), &  
+               'Decrease the number of processors for the current grid') 
+       ENDIF
+       
+       !
+       !- global index index_g is the index_l of root proc 
+       IF (is_root_prc) index_g(:)=index_l(1:NbPoint)
+
+       DEALLOCATE(index_l)
+
+       ! 
+       ! Distribute to all processors the information on the forcing 
+       ! 
+       CALL bcast(index_g)
+       CALL Init_orchidee_data_para_driver(nbp_glo,index_g)
+       CALL init_ioipsl_para
+
+       ! Initialize printlev_loc
+       printlev_loc=get_printlev('readdim2')
+       WRITE(numout,*) 'In readdim2, : standard PRINTLEV= ', printlev
+       WRITE(numout,*) 'In readdim2, : local PRINTLEV_readdim2= ', printlev_loc
+
+!     CALL Init_writeField_p
+
+       CALL bcast(jjm_zoom)
+       CALL bcast(i_index)
+       CALL bcast(j_index_g)
+       CALL bcast(zfixed) 
+       CALL bcast(zsigma) 
+       CALL bcast(zhybrid) 
+       CALL bcast(zlevels) 
+       CALL bcast(zheight) 
+       CALL bcast(zsamelev_uv) 
+       CALL bcast(zlev_fixed) 
+       CALL bcast(zlevuv_fixed) 
+       CALL bcast(zhybrid_a) 
+       CALL bcast(zhybrid_b) 
+       CALL bcast(zhybriduv_a)  
+       CALL bcast(zhybriduv_b) 
+       ind=0
+       DO j=1,jjm_zoom
+          IF ( (j >= jj_begin) .AND. (j <= jj_end) ) THEN
+             ind=ind+1
+             j_index(ind)=j_index_g(j)
+          ENDIF
+       ENDDO
+
+       jjm_zoom=jj_nb
+       iim_zoom=iim_g
+
+       !-
+       !- If we use the weather generator, then we read zonal and meridional resolutions
+       !- This should be unified one day...
+       !-
+    ELSEIF ( weathergen ) THEN
+       !-
+       !Config Key   = MERID_RES
+       !Config Desc  = North-South Resolution
+       !Config Def   = 2.
+       !Config If    = ALLOW_WEATHERGEN
+       !Config Help  = North-South Resolution of the region we are
+       !Config         interested in. 
+       !Config Units = [Degrees]
+       !-
+       merid_res = 2.
+       CALL getin_p('MERID_RES',merid_res)
+       !-
+       !Config Key   = ZONAL_RES
+       !Config Desc  = East-West Resolution
+       !Config Def   = 2.
+       !Config If    = ALLOW_WEATHERGEN
+       !Config Help  = East-West Resolution of the region we are
+       !Config         interested in. In degrees
+       !Config Units = [Degrees] 
+       !-
+       zonal_res = 2.
+       CALL getin_p('ZONAL_RES',zonal_res)
+       !-
+       !- Number of time steps is meaningless in this case
+       !-
+       !    ttm_full = HUGE( ttm_full )
+       !MM Number (realistic) of time steps for half hour dt
+       ttm_full = NINT(one_year * 86400. / dt_force)
+       !-
+       IF (is_root_prc) THEN
+
+          !- In this point is returning the global NbPoint with the global index
+          CALL weathgen_domain_size (limit_west,limit_east,limit_north,limit_south, &
+               zonal_res,merid_res,iim_zoom,jjm_zoom)
+          ALLOCATE(index_l(iim_zoom*jjm_zoom))
+       ENDIF
+       CALL bcast(iim_zoom)
+       CALL bcast(jjm_zoom)
+
+       ALLOCATE(lon(iim_zoom,jjm_zoom))
+       ALLOCATE(lat(iim_zoom,jjm_zoom))
+       ALLOCATE(lev(llm_full),levuv(llm_full))
+       
+       ! We need lon and lat now for weathgen_init
+       CALL forcing_grid (iim_zoom,jjm_zoom,llm_full,lon,lat,init_f=.TRUE.)
+       CALL forcing_vertical(-1) 
+
+       IF (is_root_prc) THEN
+          CALL weathgen_init &
+               &        (filename,dt_force,force_id,iim_zoom,jjm_zoom, &
+               &         zonal_res,merid_res,lon,lat,index_l,NbPoint)
+!!$,&
+!!$               &         i_index,j_index_g)
+       ELSE
+          ALLOCATE(index_l(1))
+          index_l(1)=1
+       ENDIF
+
+       CALL bcast(NbPoint)
+       CALL set_grid_glo(iim_zoom,jjm_zoom,NbPoint)
+       CALL allocate_grid_glo
+
+       !
+       !- global index index_g is the index_l of root proc 
+       IF (is_root_prc) index_g(:)=index_l(1:NbPoint)
+
+       DEALLOCATE(index_l)
+
+     CALL bcast(index_g)
+     CALL Init_orchidee_data_para_driver(nbp_glo,index_g)
+     CALL init_ioipsl_para
+!     CALL Init_writeField_p
+     CALL bcast(jjm_zoom)
+!!$       CALL bcast(i_index)
+!!$       CALL bcast(j_index_g)
+
+!!$       ind=0
+!!$       DO j=1,jjm_zoom
+!!$          IF ( (j >= jj_begin) .AND. (j <= jj_end) ) THEN
+!!$             ind=ind+1
+!!$             j_index(ind)=j_index_g(j)
+!!$          ENDIF
+!!$       ENDDO
+
+       jjm_zoom=jj_nb
+       iim_zoom=iim_g
+       !
+       CALL weathgen_read_file(force_id,iim_zoom,jjm_zoom)
+
+       !-
+    ELSE
+       !-
+       CALL ipslerr_p(3,'forcing_info','Neither interpolation nor weather generator is specified.','','')
+       !-
+    ENDIF
+    !-
+    !- Transfer the right information to the caller
+    !-
+    iim = iim_zoom
+    jjm = jjm_zoom
+    llm = 1
+    tm = ttm_full
+    !-
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'forcing_info : end : ', iim,jjm, llm,tm
+    !-
+  END SUBROUTINE forcing_info
+!-
+!-
+!=====================================================================
+SUBROUTINE forcing_read &
+  & (filename, rest_id, lrstread, lrstwrite, &
+  &  itauin, istp, itau_split, split, nb_spread, netrad_cons, date0,   &
+  &  dt_force, iim, jjm, lon, lat, zlev, zlevuv, ttm, &
+  &  swdown, coszang, precip, snowf, tair, u, v, qair, pb, lwdown, &
+  &  fcontfrac, fneighbours, fresolution, &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+  &  kindex, nbindex, force_id)
+!---------------------------------------------------------------------
+!- filename   : name of the file to be opened
+!- rest_id    : ID of restart file
+!- lrstread   : read restart file?
+!- lrstwrite  : write restart file?
+!- itauin     : time step for which we need the data
+!- istp       : time step for restart file
+!- itau_split : Where are we within the splitting
+!-              of the time-steps of the forcing files
+!-              (it decides IF we READ or not)
+!- split      : The number of time steps we do
+!-              between two time-steps of the forcing
+!- nb_spread  : Over how many time steps do we spread the precipitation
+!- netrad_cons: flag that decides if net radiation should be conserved.
+!- date0      : The date at which the forcing file starts (julian days)
+!- dt_force   : time-step of the forcing file in seconds
+!- iim        : Size of the grid in x
+!- jjm        : size of the grid in y
+!- lon        : Longitudes
+!- lat        : Latitudes
+!- zlev       : First Levels if it exists (ie if watchout file)
+!- zlevuv     : First Levels of the wind (equal precedent, if it exists)
+!- ttm        : number of time steps in all in the forcing file
+!- swdown     : Downward solar radiation (W/m^2)
+!- coszang    : Cosine of the solar zenith angle (unitless)
+!- precip     : Precipitation (Rainfall) (kg/m^2s)
+!- snowf      : Snowfall (kg/m^2s)
+!- tair       : 1st level (2m ? in off-line) air temperature (K)
+!- u and v    : 1st level (2m/10m ? in off-line) (in theory !) wind speed (m/s)
+!- qair       : 1st level (2m ? in off-line) humidity (kg/kg)
+!- pb         : Surface pressure (Pa)
+!- lwdown     : Downward long wave radiation (W/m^2)
+!- fcontfrac  : Continental fraction (no unit)
+!- fneighbours: land neighbours
+!- fresolution: resolution in x and y dimensions for each points
+!-
+!- From a WATCHOUT file :
+!- SWnet      : Net surface short-wave flux
+!- Eair       : Air potential energy
+!- petAcoef   : Coeficients A from the PBL resolution for T
+!- peqAcoef   : Coeficients A from the PBL resolution for q
+!- petBcoef   : Coeficients B from the PBL resolution for T
+!- peqBcoef   : Coeficients B from the PBL resolution for q
+!- cdrag      : Surface drag
+!- ccanopy    : CO2 concentration in the canopy
+!-
+!- kindex     : Index of all land-points in the data
+!-              (used for the gathering)
+!- nbindex    : Number of land points
+!- force_id   : FLINCOM file id.
+!-              It is used to close the file at the end of the run.
+!-
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   CHARACTER(LEN=*) :: filename
+   INTEGER, INTENT(IN) :: force_id
+   INTEGER, INTENT(INOUT) :: nbindex
+   INTEGER :: rest_id
+   LOGICAL :: lrstread, lrstwrite
+   INTEGER :: itauin, istp, itau_split, split, nb_spread
+   LOGICAL :: netrad_cons
+   REAL    :: date0, dt_force
+   INTEGER :: iim, jjm, ttm
+   REAL,DIMENSION(iim,jjm) :: lon, lat, zlev, zlevuv, &
+  & swdown, coszang, precip, snowf, tair, u, v, qair, pb, lwdown, &
+  & fcontfrac
+   REAL,DIMENSION(iim,jjm,2) :: fresolution
+   INTEGER,DIMENSION(iim,jjm,8) :: fneighbours
+   ! for watchout files
+   REAL,DIMENSION(iim,jjm) :: &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy
+   INTEGER,DIMENSION(iim*jjm), INTENT(INOUT) :: kindex
+!-
+   INTEGER :: ik,i,j
+!
+   IF ( interpol ) THEN
+!-
+     CALL forcing_read_interpol &
+         (filename, itauin, itau_split, split, nb_spread, netrad_cons, date0,   &
+          dt_force, iim, jjm, lon, lat, zlev, zlevuv, ttm, &
+          swdown, coszang, precip, snowf, tair, u, v, qair, pb, lwdown, &
+          fcontfrac, fneighbours, fresolution, &
+          SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+          kindex, nbindex, force_id)
+!-
+   ELSEIF ( weathergen ) THEN
+!-
+      IF (lrstread) THEN
+         fcontfrac(:,:) = 1.0
+         WRITE(numout,*) 'contfrac : ', MINVAL(fcontfrac), MAXVAL(fcontfrac)
+      ENDIF
+
+      IF ( (itauin == 0).AND.(itau_split == 0) ) THEN
+         CALL weathgen_main (istp, istp, filename, force_id, iim, jjm, 1, &
+              rest_id, lrstread, lrstwrite, &
+              limit_west, limit_east, limit_north, limit_south, &
+              zonal_res, merid_res, lon, lat, date0, dt_force, &
+              kindex, nbindex, &
+              swdown, precip, snowf, tair, u, v, qair, pb, lwdown)
+      ELSE
+         CALL weathgen_main (itauin, istp, filename, force_id, iim, jjm, 1, &
+              rest_id, lrstread, lrstwrite, &
+              limit_west, limit_east, limit_north, limit_south, &
+              zonal_res, merid_res, lon, lat, date0, dt_force, &
+              kindex, nbindex, &
+              swdown, precip, snowf, tair, u, v, qair, pb, lwdown)
+      ENDIF
+!-
+      IF ( (itauin == 0).AND.(itau_split == 0) ) THEN
+         !---
+         !--- Allocate grid stuff
+         !---
+         CALL init_grid ( nbindex )
+         !---
+         !--- Compute
+         !---
+         CALL grid_stuff(nbp_glo, iim_g, jjm_g, lon_g, lat_g, kindex)
+         !CALL grid_stuff (nbindex, iim, jjm, lon, lat, kindex)
+         DO ik=1,nbindex
+         
+            j = ((kindex(ik)-1)/iim) + 1
+            i = (kindex(ik) - (j-1)*iim)
+            !-
+            !- Store variable to help describe the grid
+            !- once the points are gathered.
+            !-
+            fneighbours(i,j,:) = neighbours(ik,:)
+            !
+            fresolution(i,j,:) = resolution(ik,:)
+         ENDDO
+      ENDIF
+   ELSE
+!-
+
+      CALL ipslerr_p(3,'forcing_read','Neither interpolation nor weather generator is specified.','','')
+
+   ENDIF
+!-
+   IF (.NOT. is_watchout) THEN
+      ! We have to compute Potential air energy
+      WHERE(tair(:,:) < val_exp) 
+         eair(:,:) = cp_air*tair(:,:)+cte_grav*zlev(:,:)
+      ENDWHERE
+   ENDIF
+!-
+!
+!-------------------------
+END SUBROUTINE forcing_read
+!=====================================================================
+!-
+!-
+!=====================================================================
+SUBROUTINE forcing_read_interpol &
+  & (filename, itauin, itau_split, split, nb_spread, netrad_cons, date0,   &
+  &  dt_force, iim, jjm, lon, lat, zlev, zlevuv, ttm, swdown, coszang, rainf, snowf, tair, &
+  &  u, v, qair, pb, lwdown, &
+  &  fcontfrac, fneighbours, fresolution, &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+  &  kindex, nbindex, force_id)
+!---------------------------------------------------------------------
+!- filename   : name of the file to be opened
+!- itauin     : time step for which we need the data
+!- itau_split : Where are we within the splitting
+!-              of the time-steps of the forcing files
+!-              (it decides IF we READ or not)
+!- split      : The number of time steps we do
+!-              between two time-steps of the forcing
+!- nb_spread  : Over how many time steps do we spread the precipitation
+!- netrad_cons: flag that decides if net radiation should be conserved.
+!- date0      : The date at which the forcing file starts (julian days)
+!- dt_force   : time-step of the forcing file in seconds
+!- iim        : Size of the grid in x
+!- jjm        : size of the grid in y
+!- lon        : Longitudes
+!- lat        : Latitudes
+!- zlev       : First Levels if it exists (ie if watchout file)
+!- zlevuv     : First Levels of the wind (equal precedent, if it exists)
+!- ttm        : number of time steps in all in the forcing file
+!- swdown     : Downward solar radiation (W/m^2)
+!- coszang    : Cosine of the solar zenith angle (unitless)
+!- rainf      : Rainfall (kg/m^2s)
+!- snowf      : Snowfall (kg/m^2s)
+!- tair       : 2m air temperature (K)
+!- u and v    : 2m (in theory !) wind speed (m/s)
+!- qair       : 2m humidity (kg/kg)
+!- pb         : Surface pressure (Pa)
+!- lwdown     : Downward long wave radiation (W/m^2)
+!- fcontfrac  : Continental fraction (no unit)
+!- fneighbours: land neighbours
+!- fresolution: resolution in x and y dimensions for each points
+!-
+!- From a WATCHOUT file :
+!- SWnet      : Net surface short-wave flux
+!- Eair       : Air potential energy
+!- petAcoef   : Coeficients A from the PBL resolution for T
+!- peqAcoef   : Coeficients A from the PBL resolution for q
+!- petBcoef   : Coeficients B from the PBL resolution for T
+!- peqBcoef   : Coeficients B from the PBL resolution for q
+!- cdrag      : Surface drag
+!- ccanopy    : CO2 concentration in the canopy
+!- 
+!- kindex     : Index of all land-points in the data
+!-              (used for the gathering)
+!- nbindex    : Number of land points
+!- force_id   : FLINCOM file id.
+!-              It is used to close the file at the end of the run.
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER,PARAMETER :: lm=1
+!-
+!- Input variables
+!-
+   CHARACTER(LEN=*) :: filename
+   INTEGER :: itauin, itau_split, split, nb_spread
+   LOGICAL :: netrad_cons
+   REAL    :: date0, dt_force
+   INTEGER :: iim, jjm, ttm
+   REAL,DIMENSION(:,:),INTENT(IN) :: lon, lat   !- LOCAL data array (size=iim,jjm)
+   INTEGER, INTENT(IN) :: force_id
+!-
+!- Output variables
+!-
+   REAL,DIMENSION(:,:),INTENT(OUT) :: zlev, zlevuv, &  !- LOCAL data array (size=iim,jjm)
+  &  swdown, coszang, rainf, snowf, tair, u, v, qair, pb, lwdown, &
+  &  fcontfrac
+   REAL,DIMENSION(:,:,:),INTENT(OUT) :: fresolution    !- LOCAL data array (size=iim,jjm,2)
+   INTEGER,DIMENSION(:,:,:),INTENT(OUT) :: fneighbours !- LOCAL data array (size=iim,jjm,8)
+   ! for watchout files
+   REAL,DIMENSION(:,:),INTENT(OUT) :: &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy
+   INTEGER,DIMENSION(:),INTENT(INOUT) :: kindex    !- LOCAL index of the map
+   INTEGER, INTENT(INOUT) :: nbindex
+!-
+!- Local variables
+!-
+   INTEGER, SAVE :: last_read=0
+   INTEGER, SAVE :: itau_read, itau_read_nm1=0, itau_read_n=0
+   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:) :: &
+  &  zlev_nm1, zlevuv_nm1, swdown_nm1, rainf_nm1, snowf_nm1, tair_nm1, u_nm1, v_nm1, qair_nm1, & 
+  &  pb_nm1, lwdown_nm1, & 
+  &  zlev_n, zlevuv_n, swdown_n, rainf_n, snowf_n, tair_n, u_n, v_n, qair_n, &
+  &  pb_n, lwdown_n, mean_coszang
+
+   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:) :: &
+  &  startday_n, startday_nm1, daylength_n, daylength_nm1, tmax_n, tmax_nm1, tmin_nm1, tmin_nm2, tmin_n,   &
+  &  qsatta, qsattmin_n, qsattmin_nm1, qmin_n, qmin_nm1, qmax_n, qmax_nm1, qsa
+   REAL,SAVE    :: hour
+
+!  just for grid stuff if the forcing file is a watchout file
+   REAL, ALLOCATABLE, DIMENSION(:,:) :: tmpdata
+   ! variables to be read in watchout files
+   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:) :: &
+  &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+  &  SWnet_n, Eair_n, petAcoef_n, peqAcoef_n, petBcoef_n, peqBcoef_n, cdrag_n, ccanopy_n
+   REAL, SAVE :: julian_for ! Date of the forcing to be read
+   REAL :: julian, ss, rw
+!jur, 
+   REAL, SAVE :: julian0    ! First day of this year
+   INTEGER :: yy, mm, dd, is, i, j, ik
+!  if Wind_N and Wind_E are in the file (and not just Wind)
+   LOGICAL, SAVE :: wind_N_exists=.FALSE.
+   LOGICAL       :: wind_E_exists=.FALSE.
+   LOGICAL, SAVE :: contfrac_exists=.FALSE.
+   LOGICAL, SAVE :: neighbours_exists=.FALSE.
+   LOGICAL, SAVE :: initialized = .FALSE.
+   LOGICAL :: check=.FALSE.
+!  to bypass FPE problem on integer convertion with missing_value heigher than precision
+   INTEGER, PARAMETER                         :: undef_int = 999999999
+!---------------------------------------------------------------------
+
+   itau_read = MOD((itauin-1),ttm)+1
+
+   IF (check) THEN
+      WRITE(numout,*) &
+           " FORCING READ : itauin, itau_read, itau_split : ",&
+           itauin, itau_read, itau_split
+   ENDIF
+
+!-
+!- This part initializes the reading of the forcing. As you can see
+!- we only go through here if both time steps are zero.
+!- 
+   IF ( (itau_read == 0).AND.(itau_split == 0) ) THEN
+!-
+!- Tests on forcing file type
+     CALL flinquery_var(force_id, 'Wind_N', wind_N_exists)
+     IF ( wind_N_exists ) THEN
+        CALL flinquery_var(force_id, 'Wind_E', wind_E_exists)
+        IF ( .NOT. wind_E_exists ) THEN
+           CALL ipslerr_p(3,'forcing_read_interpol', &
+   &             'Variable Wind_E does not exist in forcing file', &
+   &             'But variable Wind_N exists.','Please, rename Wind_N to Wind;') 
+        ENDIF
+     ENDIF
+     CALL flinquery_var(force_id, 'levels', is_watchout)
+     IF ( is_watchout ) THEN
+        WRITE(numout,*) "Read a Watchout File."
+     ENDIF
+     CALL flinquery_var(force_id, 'contfrac', contfrac_exists)
+!-
+     IF (check) WRITE(numout,*) 'ALLOCATE all the memory needed'
+!-
+     ALLOCATE &
+    &  (swdown_nm1(iim,jjm), rainf_nm1(iim,jjm), snowf_nm1(iim,jjm), &
+    &   tair_nm1(iim,jjm), u_nm1(iim,jjm), v_nm1(iim,jjm), qair_nm1(iim,jjm), &
+    &   pb_nm1(iim,jjm), lwdown_nm1(iim,jjm))
+     ALLOCATE &
+    &  (swdown_n(iim,jjm), rainf_n(iim,jjm), snowf_n(iim,jjm), &
+    &   tair_n(iim,jjm), u_n(iim,jjm), v_n(iim,jjm), qair_n(iim,jjm), &
+    &   pb_n(iim,jjm), lwdown_n(iim,jjm))
+
+     IF(daily_interpol) THEN
+        ALLOCATE &
+       &  (startday_n(iim,jjm), startday_nm1(iim,jjm), daylength_n(iim,jjm), &
+       &   daylength_nm1(iim,jjm), tmax_n(iim,jjm), tmax_nm1(iim,jjm), tmin_n(iim,jjm), &
+       &   tmin_nm1(iim,jjm), tmin_nm2(iim,jjm), qsatta(iim,jjm), qsattmin_n(iim,jjm), qsattmin_nm1(iim,jjm), &
+       &   qmin_n(iim,jjm), qmin_nm1(iim,jjm), qmax_n(iim,jjm), qmax_nm1(iim,jjm), qsa(iim,jjm) )
+     ENDIF
+
+
+     ALLOCATE &
+    &  (zlev_nm1(iim,jjm), zlev_n(iim,jjm), zlevuv_nm1(iim,jjm), zlevuv_n(iim,jjm), &
+    &   SWnet_nm1(iim,jjm), Eair_nm1(iim,jjm), cdrag_nm1(iim,jjm), ccanopy_nm1(iim,jjm), &
+    &   petAcoef_nm1(iim,jjm), peqAcoef_nm1(iim,jjm), petBcoef_nm1(iim,jjm), peqBcoef_nm1(iim,jjm), &
+    &   SWnet_n(iim,jjm), Eair_n(iim,jjm), cdrag_n(iim,jjm), ccanopy_n(iim,jjm), &
+    &   petAcoef_n(iim,jjm), peqAcoef_n(iim,jjm), petBcoef_n(iim,jjm), peqBcoef_n(iim,jjm))
+     ALLOCATE &
+    &  (mean_coszang(iim,jjm))
+!-
+     IF (check) WRITE(numout,*) 'Memory ALLOCATED'
+!-
+!- We need for the driver surface air temperature and humidity before the
+!- the loop starts. Thus we read it here.
+!-     
+     CALL forcing_just_read (iim, jjm, zlev, zlevuv, ttm, 1, 1, &
+          &  swdown, rainf, snowf, tair, &
+          &  u, v, qair, pb, lwdown, &
+          &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+          &  force_id, wind_N_exists, check)
+!----
+
+!-- First in case it's not a watchout file
+     IF ( .NOT. is_watchout ) THEN
+        IF ( contfrac_exists ) THEN
+           WRITE(numout,*) "contfrac exist in the forcing file."
+           CALL flinget_buffer (force_id,'contfrac',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+           CALL forcing_zoom(data_full, fcontfrac)
+           WRITE(numout,*) "fcontfrac min/max :",MINVAL(fcontfrac(1:iim_zoom,jjm_zoom)),MAXVAL(fcontfrac(1:iim_zoom,jjm_zoom))
+           !
+           ! We need to make sure that when we gather the points we pick all
+           ! the points where contfrac is above 0. Thus we prepare tair for
+           ! subroutine forcing_landind
+           !
+           DO i=1,iim
+              DO j=1,jjm
+                 IF ( j==1 .AND. i<ii_begin) fcontfrac(i,j)=0.     ! bande de recouvrement du scatter2D 
+                 IF ( j==jjm .AND. i>ii_end) fcontfrac(i,j)=0.     ! => on mets les données qu'on veut pas du noeud à missing_value
+                 IF ( fcontfrac(i,j) <= EPSILON(1.) ) THEN
+                    tair(i,j) = 999999.
+                 ENDIF
+              ENDDO
+           ENDDO
+        ELSE
+           fcontfrac(:,:) = 1.0
+        ENDIF
+        !---
+        !--- Create the index table
+        !---
+        !--- This job return a LOCAL kindex
+        CALL forcing_landind(iim, jjm, tair, check, nbindex, kindex, i_test, j_test)
+#ifdef CPP_PARA
+        ! We keep previous function forcing_landind, only to get a valid (i_test,j_test) 
+        ! Force nbindex points for parallel computation
+        nbindex=nbp_loc
+        CALL scatter(index_g,kindex(1:nbindex))
+        kindex(1:nbindex)=kindex(1:nbindex)-(jj_begin-1)*iim_g
+#endif
+        ik=MAX(nbindex/2,1)
+        j_test = (((kindex(ik)-1)/iim) + 1)
+        i_test = (kindex(ik) - (j_test-1)*iim)
+        IF (check) THEN
+           WRITE(numout,*) 'New test point is : ', i_test, j_test
+        ENDIF
+        !---
+        !--- Allocate grid stuff
+        !---
+        CALL init_grid ( nbindex )
+        !---
+        !--- All grid variables
+        !---
+        CALL grid_stuff(nbp_glo, iim_g, jjm_g, lon_g, lat_g, kindex)
+        DO ik=1,nbindex
+           !
+           j = ((kindex(ik)-1)/iim) + 1
+           i = (kindex(ik) - (j-1)*iim)
+           !-
+           !- Store variable to help describe the grid
+           !- once the points are gathered.
+              !-
+           fneighbours(i,j,:) = neighbours(ik,:)
+           !
+           fresolution(i,j,:) = resolution(ik,:)
+        ENDDO
+     ELSE
+!-- Second, in case it is a watchout file
+        ALLOCATE (tmpdata(iim,jjm))
+        tmpdata(:,:) = 0.0
+!--
+        IF ( .NOT. contfrac_exists ) THEN
+           CALL ipslerr_p (3,'forcing_read_interpol', &
+ &          'Could get contfrac variable in a watchout file :',TRIM(filename), &
+ &          '(Problem with file ?)')
+        ENDIF
+        CALL flinget_buffer (force_id,'contfrac',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, fcontfrac)
+        !
+        ! We need to make sure that when we gather the points we pick all
+        ! the points where contfrac is above 0. Thus we prepare tair for
+        ! subroutine forcing_landind
+        !
+        DO i=1,iim
+           DO j=1,jjm
+	      IF ( j==1 .AND. i<ii_begin) fcontfrac(i,j)=0.
+	      IF ( j==jjm .AND. i>ii_end) fcontfrac(i,j)=0.
+              IF ( fcontfrac(i,j) <= EPSILON(1.) ) THEN
+                 tair(i,j) = 999999.
+              ENDIF
+           ENDDO
+        ENDDO
+        !---
+        !--- Create the index table
+        !---
+        !--- This job return a LOCAL kindex
+        CALL forcing_landind(iim, jjm, tair, check, nbindex, kindex, i_test, j_test)
+#ifdef CPP_PARA
+        ! We keep previous function forcing_landind, only to get a valid (i_test,j_test) 
+        ! Force nbindex points for parallel computation
+        nbindex=nbp_loc
+        CALL scatter(index_g,kindex)
+        kindex(:)=kindex(:)-offset
+!        kindex(:)=kindex(:)-(jj_begin-1)*iim_g
+#endif
+        ik=MAX(nbindex/2,1)
+        j_test = (((kindex(ik)-1)/iim) + 1)
+        i_test = (kindex(ik) - (j_test-1)*iim)
+        IF (check) THEN
+           WRITE(numout,*) 'New test point is : ', i_test, j_test
+        ENDIF
+        !---
+        !--- Allocate grid stuff
+        !---
+        CALL init_grid ( nbindex )
+        neighbours(:,:) = -1
+        resolution(:,:) = 0.
+        min_resol(:) = 1.e6
+        max_resol(:) = -1.
+        !---
+        !--- All grid variables
+        !---
+        !-
+        !- Get variables to help describe the grid
+        CALL flinquery_var(force_id, 'neighboursNN', neighbours_exists)
+        IF ( .NOT. neighbours_exists ) THEN
+           CALL ipslerr_p (3,'forcing_read_interpol', &
+ &          'Could get neighbours in a watchout file :',TRIM(filename), &
+ &          '(Problem with file ?)')
+        ELSE
+           WRITE(numout,*) "Watchout file contains neighbours and resolutions."
+        ENDIF
+        !
+        fneighbours(:,:,:) = undef_int
+        !
+        !- once the points are gathered.
+        CALL flinget_buffer (force_id,'neighboursNN',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,1) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursNE',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,2) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursEE',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,3) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursSE',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,4) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursSS',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,5) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursSW',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,6) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursWW',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,7) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget_buffer (force_id,'neighboursNW',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,8) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        ! now, resolution of the grid
+        CALL flinget_buffer (force_id,'resolutionX',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        fresolution(:,:,1) = tmpdata(:,:)
+        !
+        CALL flinget_buffer (force_id,'resolutionY',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        fresolution(:,:,2) = tmpdata(:,:)
+        !
+        DO ik=1,nbindex
+           !
+           j = ((kindex(ik)-1)/iim) + 1
+           i = (kindex(ik) - (j-1)*iim)
+           !-
+           !- Store variable to help describe the grid
+           !- once the points are gathered.
+           !-
+           neighbours(ik,:) = fneighbours(i,j,:)  
+           !
+           resolution(ik,:) = fresolution(i,j,:)
+           !
+        
+        ENDDO
+        CALL gather(neighbours,neighbours_g)
+        CALL gather(resolution,resolution_g)
+        min_resol(1) = MINVAL(resolution(:,1))
+        min_resol(2) = MAXVAL(resolution(:,2))
+        max_resol(1) = MAXVAL(resolution(:,1))
+        max_resol(2) = MAXVAL(resolution(:,2))
+        !
+        area(:) = resolution(:,1)*resolution(:,2)
+        CALL gather(area,area_g)
+!--
+        DEALLOCATE (tmpdata)
+     ENDIF
+     WRITE(numout,*) 'contfrac : ', MINVAL(fcontfrac), MAXVAL(fcontfrac)
+!---
+   ENDIF
+!---
+   IF (check) THEN
+      WRITE(numout,*) &
+           & 'The dates : ',itau_read,itau_split,itau_read_nm1,itau_read_n
+   ENDIF
+!---
+!--- Here we do the work in case only interpolation is needed.
+!---
+   IF ( initialized .AND. interpol ) THEN
+!---
+      IF ( daily_interpol ) THEN
+
+         IF (split > 1) THEN
+            IF ( itau_split <= (split/2.) ) THEN
+               rw = REAL(itau_split+split/2.)/split
+            ELSE 
+               rw = REAL(itau_split-split/2.)/split
+            ENDIF
+         ELSE
+            rw = 1.
+         ENDIF
+
+         IF ((last_read == 0) .OR. ( rw==(1./split)) ) THEN
+   !---
+   !-----   Start or Restart
+            IF (last_read == 0) THEN
+               ! Case of a restart or a shift in the forcing file.
+               IF (itau_read > 1) THEN
+                  itau_read_nm1=itau_read-1
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tmin_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists, check)
+                  CALL forcing_just_read_tmax (iim, jjm, ttm, itau_read_nm1, itau_read_nm1, tmax_nm1, force_id )
+               ! Case of a simple start.
+               ELSE 
+                  itau_read_nm1 = un
+                  WRITE(numout,*) "we will use the forcing of the first day to initialize "
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tmin_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists, check)
+                  CALL forcing_just_read_tmax (iim, jjm, ttm, itau_read_nm1, itau_read_nm1, tmax_nm1, force_id )
+               ENDIF
+               tmin_nm2(:,:)=tmin_nm1(:,:)
+               IF ( dt_force .GT. 3600. ) THEN
+                  mean_coszang(:,:) = 0.0
+                  daylength_n(:,:) = 0.
+                  DO is=1,split
+                     !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+                     julian = julian_for+((is-0.5)/split)*dt_force/one_day
+      !!$               julian = julian_for+(FLOAT(is)/split)*dt_force/one_day
+                     CALL solarang (julian, julian0, iim, jjm, lon*0, lat, coszang)
+                     mean_coszang(:,:) = mean_coszang(:,:)+coszang(:,:)
+                     WHERE( coszang(:,:) > 0. ) 
+                        daylength_n(:,:)=daylength_n(:,:)+1./split*24
+                     ENDWHERE
+                  ENDDO
+                  mean_coszang(:,:) = mean_coszang(:,:)/split
+                  daylength_nm1(:,:)=daylength_n(:,:)
+      !            WRITE(*,*) "mean_coszang =",MAXVAL(mean_coszang)
+               ENDIF
+            ELSE
+   !-----   Normal mode : copy old step
+               swdown_nm1(:,:) = swdown_n(:,:)
+               rainf_nm1(:,:) = rainf_n(:,:)
+               snowf_nm1(:,:)  = snowf_n(:,:) 
+               tair_nm1(:,:)   = tair_n(:,:)
+               u_nm1(:,:)      = u_n(:,:)
+               v_nm1(:,:)      = v_n(:,:)
+               qair_nm1(:,:)   = qair_n(:,:)
+               pb_nm1(:,:)     = pb_n(:,:)
+               lwdown_nm1(:,:) = lwdown_n(:,:)
+               tmin_nm2(:,:)   = tmin_nm1(:,:)
+               tmin_nm1(:,:)   = tmin_n(:,:)
+               tmax_nm1(:,:)   = tmax_n(:,:)
+
+               IF (is_watchout) THEN
+                  zlev_nm1(:,:)   = zlev_n(:,:)
+                  zlevuv_nm1(:,:) = zlevuv_n(:,:)
+                  ! Net surface short-wave flux
+                  SWnet_nm1(:,:) = SWnet_n(:,:)
+                  ! Air potential energy
+                  Eair_nm1(:,:)   = Eair_n(:,:)
+                  ! Coeficients A from the PBL resolution for T
+                  petAcoef_nm1(:,:) = petAcoef_n(:,:)
+                  ! Coeficients A from the PBL resolution for q
+                  peqAcoef_nm1(:,:) = peqAcoef_n(:,:)
+                  ! Coeficients B from the PBL resolution for T
+                  petBcoef_nm1(:,:) = petBcoef_n(:,:)
+                  ! Coeficients B from the PBL resolution for q
+                  peqBcoef_nm1(:,:) = peqBcoef_n(:,:)
+                  ! Surface drag
+                  cdrag_nm1(:,:) = cdrag_n(:,:)
+                  ! CO2 concentration in the canopy
+                  ccanopy_nm1(:,:) = ccanopy_n(:,:)
+               ENDIF
+               itau_read_nm1 = itau_read_n
+            ENDIF
+   !-----
+   !-----
+            IF(last_read==0)THEN
+               itau_read_n = itau_read
+            ELSE
+               itau_read_n = itau_read+1
+            ENDIF
+
+            IF (itau_read_n > ttm) THEN
+               WRITE(numout,*) 'WARNING --WARNING --WARNING --WARNING '
+               WRITE(numout,*) &
+                    &  'WARNING : We are going back to the start of the file'
+               itau_read_n =1
+            ENDIF
+            IF (check) THEN
+               WRITE(numout,*) &
+                    & 'The dates 2 : ',itau_read,itau_split,itau_read_nm1,itau_read_n
+            ENDIF
+   !-----
+   !----- Get a reduced julian day !
+   !----- This is needed because we lack the precision on 32 bit machines.
+   !-----
+            IF ( dt_force .GT. 3600. ) THEN
+               julian_for = itau2date(itau_read-1, date0, dt_force)
+               CALL ju2ymds (julian_for, yy, mm, dd, ss)
+   
+               ! first day of this year
+               CALL ymds2ju (yy,1,1,0.0, julian0)
+   !-----
+               IF (check) THEN
+                  WRITE(numout,*) 'Forcing for Julian day ',julian_for,'is read'
+                  WRITE(numout,*) 'Date for this day ',yy,' / ',mm,' / ',dd,"  ",ss
+               ENDIF
+            ENDIF
+   !-----
+            CALL forcing_just_read (iim, jjm, zlev_n, zlevuv_n, ttm, itau_read_n, itau_read_n, &
+                 &  swdown_n, rainf_n, snowf_n, tmin_n, &
+                 &  u_n, v_n, qair_n, pb_n, lwdown_n, &
+                 &  SWnet_n, Eair_n, petAcoef_n, peqAcoef_n, petBcoef_n, peqBcoef_n, cdrag_n, ccanopy_n, &
+                 &  force_id, wind_N_exists, check)
+            CALL forcing_just_read_tmax (iim, jjm, ttm, itau_read_n, itau_read_n, tmax_n, force_id )
+
+   !---
+            last_read = itau_read_n
+   !-----
+   !----- Compute mean solar angle for the comming period
+   !-----
+            IF (check) WRITE(numout,*) 'Going into  solarang', split, one_day
+   !-----
+
+   !-----
+         ENDIF
+   !---
+         IF ( itau_split == 1. ) THEN
+            IF ( dt_force .GT. 3600. ) THEN
+               mean_coszang(:,:) = 0.0
+               daylength_nm1(:,:)=daylength_n(:,:)
+               daylength_n(:,:) = 0.
+               DO is=1,split
+                  !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+                  julian = julian_for+((is-0.5)/split)*dt_force/one_day
+   !!$               julian = julian_for+(FLOAT(is)/split)*dt_force/one_day
+                  CALL solarang (julian, julian0, iim, jjm, lon*0, lat, coszang)
+                  mean_coszang(:,:) = mean_coszang(:,:)+coszang(:,:)
+                  WHERE( coszang(:,:) > 0. ) 
+                     daylength_n(:,:)=daylength_n(:,:)+1./split*24
+                  ENDWHERE
+               ENDDO
+               mean_coszang(:,:) = mean_coszang(:,:)/split
+   !            WRITE(*,*) "mean_coszang =",MAXVAL(mean_coszang)
+            ENDIF
+         ENDIF
+ 
+   !--- Do the interpolation
+         IF (check) WRITE(numout,*) 'Doing the interpolation between time steps'
+   !---
+
+         IF (check) WRITE(numout,*) 'Coeff of interpollation : ',rw
+   !---
+
+         pb(:,:) = (pb_n(:,:)-pb_nm1(:,:))*rw + pb_nm1(:,:)
+         u(:,:)  = (u_n(:,:)-u_nm1(:,:))*rw + u_nm1(:,:)
+         v(:,:)  = (v_n(:,:)-v_nm1(:,:))*rw + v_nm1(:,:)
+
+   !--- Take care of the height of the vertical levels 
+         zlev(:,:) = (zlev_n(:,:)-zlev_nm1(:,:))*rw + zlev_nm1(:,:) 
+         zlevuv(:,:) = (zlevuv_n(:,:)-zlevuv_nm1(:,:))*rw + zlevuv_nm1(:,:) 
+
+         hour=REAL(itau_split)/split*24
+         startday_n(:,:)=12.-daylength_n(:,:)/2.
+         startday_nm1(:,:)=12.-daylength_nm1(:,:)/2.
+
+         WHERE ( ( hour >= startday_n(:,:) ) .AND. ( hour > 12) .AND. ( hour <= 14) )
+            tair(:,:)=(tmax_nm1(:,:)-tmin_nm1(:,:))/2 * ( sin(pi/(14-startday_n(:,:))*(hour-0.5* &
+           &    (14.-startday_n(:,:))-startday_n(:,:))) )+ (tmax_nm1(:,:)+tmin_nm1(:,:))/2.
+         ELSEWHERE( ( hour >= startday_n(:,:) ) .AND. ( hour <= 12) )
+            tair(:,:)=(tmax_n(:,:)-tmin_n(:,:))/2 * ( sin(pi/(14-startday_n(:,:))*(hour-0.5* &
+           &    (14.-startday_n(:,:))-startday_n(:,:))) )+ (tmax_n(:,:)+tmin_n(:,:))/2.
+         ELSEWHERE ( hour < startday_n(:,:) )
+            tair(:,:)=(tmax_nm1(:,:)-tmin_n(:,:))/2.*sin(pi/(24.-14.+startday_nm1(:,:) )* &
+           &    (hour + 24.+0.5*(24.-14.+startday_nm1(:,:) )-14.))+(tmax_nm1(:,:)+tmin_n(:,:))/2.
+         ELSEWHERE
+            tair(:,:)=(tmax_nm1(:,:)-tmin_n(:,:))/2.*sin(pi/(24.-14.+startday_n(:,:))*(hour+0.5* &
+           &    (24.-14.+startday_n(:,:))-14.))+(tmax_nm1(:,:)+tmin_n(:,:))/2.
+         ENDWHERE
+
+         CALL weathgen_qsat_2d (iim,jjm,tmin_n,pb,qsattmin_n)
+         CALL weathgen_qsat_2d (iim,jjm,tmin_nm1,pb,qsattmin_nm1)
+         CALL weathgen_qsat_2d (iim,jjm,tair,pb,qsatta)
+
+         !---
+         qmin_nm1(:,:) = MIN(qair_nm1(:,:),0.99*qsattmin_nm1(:,:))
+         qmin_n(:,:) = MIN(qair_n(:,:),0.99*qsattmin_n(:,:))
+         qmax_nm1(:,:) = (qair_nm1(:,:)-qmin_nm1(:,:)) + qair_nm1(:,:)
+         qmax_n(:,:) = (qair_n(:,:)-qmin_n(:,:)) + qair_n(:,:)
+
+         qsa(:,:)  = 0.99*qsatta(:,:)
+
+
+         WHERE ( ( hour >= startday_n(:,:) ) .AND. ( hour > 12) .AND. ( hour <= 14) )
+            qair(:,:)=MIN(qsa(:,:),(qmax_nm1(:,:)-qmin_nm1(:,:))/2 * ( sin(pi/(14-startday_n(:,:))*(hour-0.5* &
+           &    (14.-startday_n(:,:))-startday_n(:,:))) )+ (qmax_nm1(:,:)+qmin_nm1(:,:))/2.)
+         ELSEWHERE( ( hour >= startday_n(:,:) ) .AND. ( hour <= 12) )
+            qair(:,:)=MIN(qsa(:,:),(qmax_n(:,:)-qmin_n(:,:))/2 * ( sin(pi/(14-startday_n(:,:))*(hour-0.5* &
+           &    (14.-startday_n(:,:))-startday_n(:,:))) )+ (qmax_n(:,:)+qmin_n(:,:))/2.)
+         ELSEWHERE ( hour < startday_n(:,:) )
+            qair(:,:)=MIN(qsa(:,:),(qmax_nm1(:,:)-qmin_n(:,:))/2.*sin(pi/(24.-14.+startday_nm1(:,:) )* &
+           &    (hour + 24.+0.5*(24.-14.+startday_nm1(:,:) )-14.))+(qmax_nm1(:,:)+qmin_n(:,:))/2.)
+         ELSEWHERE
+            qair(:,:)=MIN(qsa(:,:),(qmax_nm1(:,:)-qmin_n(:,:))/2.*sin(pi/(24.-14.+startday_n(:,:))*(hour+0.5* &
+           &    (24.-14.+startday_n(:,:))-14.))+(qmax_nm1(:,:)+qmin_n(:,:))/2.)
+         ENDWHERE
+
+         IF (is_watchout) THEN
+            SWnet(:,:) = (SWnet_n(:,:)-SWnet_nm1(:,:))*rw + SWnet_nm1(:,:)
+            Eair(:,:) = (Eair_n(:,:)-Eair_nm1(:,:))*rw + Eair_nm1(:,:)
+            petAcoef(:,:) = (petAcoef_n(:,:)-petAcoef_nm1(:,:))*rw + petAcoef_nm1(:,:)
+            peqAcoef(:,:) = (peqAcoef_n(:,:)-peqAcoef_nm1(:,:))*rw + peqAcoef_nm1(:,:)
+            petBcoef(:,:) = (petBcoef_n(:,:)-petBcoef_nm1(:,:))*rw + petBcoef_nm1(:,:)
+            peqBcoef(:,:) = (peqBcoef_n(:,:)-peqBcoef_nm1(:,:))*rw + peqBcoef_nm1(:,:)
+            cdrag(:,:) = (cdrag_n(:,:)-cdrag_nm1(:,:))*rw + cdrag_nm1(:,:)
+            ccanopy(:,:) = (ccanopy_n(:,:)-ccanopy_nm1(:,:))*rw + ccanopy_nm1(:,:)
+         ENDIF
+   !---
+   !--- Here we need to allow for an option
+   !--- where radiative energy is conserved
+   !---
+         IF ( netrad_cons ) THEN
+            lwdown(:,:) = lwdown_n(:,:)
+         ELSE
+            lwdown(:,:) = (lwdown_n(:,:)-lwdown_nm1(:,:))*rw + lwdown_nm1(:,:)
+         ENDIF
+   !---
+   !--- For the solar radiation we decompose the mean value
+   !--- using the zenith angle of the sun if the time step in the forcing data is 
+   !---- more than an hour. Else we use the standard linera interpolation
+   !----
+         IF (check) WRITE(numout,*) 'Ready to deal with the solar radiation'
+   !----
+         IF ( dt_force .GT. 3600. ) THEN
+   !---
+            IF ( netrad_cons ) THEN
+               WRITE(numout,*) 'Solar radiation can not be conserved with a timestep of ', dt_force
+            ENDIF
+   !---
+            !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+            julian = julian_for + (itau_split-0.5)/split*dt_force/one_day
+   !!$         julian = julian_for + rw*dt_force/one_day
+            IF (check) THEN
+               WRITE(numout,'(a,f20.10,2I3)') &
+                    &  'JULIAN BEFORE SOLARANG : ',julian,itau_split,split
+            ENDIF
+   !---
+            CALL solarang(julian, julian0, iim, jjm, lon*0, lat, coszang)
+   !---
+            
+            WHERE ((mean_coszang(:,:) > 0.) .AND. (hour <= 12 ))
+               swdown(:,:) = swdown_n(:,:) *coszang(:,:)/mean_coszang(:,:)
+            ELSEWHERE ((mean_coszang(:,:) > 0.) .AND. (hour > 12 ))
+               swdown(:,:) = swdown_nm1(:,:) *coszang(:,:)/mean_coszang(:,:)
+            ELSEWHERE
+               swdown(:,:) = 0.0
+            END WHERE
+   !---
+            WHERE (swdown(:,:) > 2000. )
+               swdown(:,:) = 2000.
+            END WHERE
+   !---
+         ELSE
+   !---
+            IF ( netrad_cons ) THEN
+               swdown(:,:) = swdown_n(:,:)
+            ELSE
+               swdown(:,:) = (swdown_n(:,:)-swdown_nm1(:,:))*rw + swdown_nm1(:,:)
+            ENDIF
+   !---
+         ENDIF
+   !---
+         IF (check) THEN
+            WRITE(numout,*) '__ Forcing read at ',itau_split,' :',i_test, j_test
+            WRITE(numout,*) 'SWdown  : ',swdown_nm1(i_test, j_test), &
+                 &           ' < ', swdown(i_test, j_test), ' < ', swdown_n(i_test, j_test)
+            IF (is_watchout) THEN
+               WRITE(numout,*) 'SWnet  : ',swnet_nm1(i_test, j_test), &
+                    &           ' < ', swnet(i_test, j_test), ' < ', swnet_n(i_test, j_test)
+               WRITE(numout,*) 'levels  :',zlev_nm1(i_test, j_test), &
+                    &           ' < ', zlev(i_test, j_test), ' < ', zlev_n(i_test, j_test)
+               WRITE(numout,*) 'EAIR  :',Eair_nm1(i_test, j_test), &
+                    &           ' < ', eair(i_test, j_test), ' < ', Eair_n(i_test, j_test)
+            ENDIF
+            WRITE(numout,*) 'TAIR  :',tair_nm1(i_test, j_test), &
+                 &           ' < ', tair(i_test, j_test), ' < ', tair_n(i_test, j_test)
+            WRITE(numout,*) 'QAIR  :',qair_nm1(i_test, j_test), &
+                 &           ' < ', qair(i_test, j_test), ' < ', qair_n(i_test, j_test)
+            WRITE(numout,*) 'U  :',u_nm1(i_test, j_test), &
+                 &           ' < ', u(i_test, j_test), ' < ', u_n(i_test, j_test)
+            WRITE(numout,*) 'V  :',v_nm1(i_test, j_test), &
+                 &           ' < ', v(i_test, j_test), ' < ', v_n(i_test, j_test)
+         ENDIF
+   !---
+   !--- For precip we suppose that the rain
+   !--- is the sum over the next 6 hours
+   !---
+         WHERE ((itau_split <= nb_spread).AND.(hour<=12).AND.(tair(:,:)>=273.15)) 
+            rainf(:,:) = rainf_n(:,:) *(split/REAL(nb_spread))
+            snowf(:,:) = 0.0
+         ELSEWHERE ((itau_split <= nb_spread).AND.(hour<=12).AND.(tair(:,:)<273.15)) 
+            snowf(:,:) = rainf_n(:,:) *(split/REAL(nb_spread))
+            rainf(:,:) = 0.0
+         ELSEWHERE ((itau_split <= nb_spread).AND.(hour>12).AND.(tair(:,:)>=273.15)) 
+            rainf(:,:) = rainf_nm1(:,:) *(split/REAL(nb_spread))
+            snowf(:,:) = 0.0
+         ELSEWHERE ((itau_split <= nb_spread).AND.(hour>12).AND.(tair(:,:)<273.15)) 
+            snowf(:,:) = rainf_nm1(:,:) *(split/REAL(nb_spread))
+            rainf(:,:) = 0.0
+         ELSEWHERE
+            snowf(:,:) = 0.0
+            rainf(:,:) = 0.0
+         ENDWHERE
+
+         IF (check) THEN
+            WRITE(numout,*) '__ Forcing read at ',itau_split,' :'
+            WRITE(numout,*) 'Rainf  : ',rainf_nm1(i_test, j_test), &
+                 &           ' < ', rainf(i_test, j_test), ' < ', rainf_n(i_test, j_test)
+            WRITE(numout,*) 'Snowf  : ',snowf_nm1(i_test, j_test), &
+                 &           ' < ', snowf(i_test, j_test), ' < ', snowf_n(i_test, j_test)
+         ENDIF
+   !---
+
+
+      ELSE
+      
+         IF (itau_read /= last_read) THEN
+   !---
+   !-----   Start or Restart
+            IF (itau_read_n == 0) THEN
+               ! Case of a restart or a shift in the forcing file.
+               IF (itau_read > 1) THEN
+                  itau_read_nm1=itau_read-1
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tair_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists, check)
+               ! Case of a simple start.
+               ELSE IF (dt_force*ttm > one_day-1. ) THEN
+                  ! if the forcing file contains at least 24 hours, 
+                  ! we will use the last forcing step of the first day
+                  ! as initiale condition to prevent first shift off reading.
+                  itau_read_nm1 = NINT (one_day/dt_force)
+                  WRITE(numout,*) "the forcing file contains 24 hours :",dt_force*ttm,one_day-1.
+                  WRITE(numout,*) "we will use the last forcing step of the first day : itau_read_nm1 ",itau_read_nm1
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tair_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists, check)
+               ELSE
+                  ! if the forcing file contains less than 24 hours, 
+                  ! just say error !
+                  CALL ipslerr_p(3,'forcing_read_interpol', &
+      &             'The forcing file contains less than 24 hours !', &
+      &             'We can''t intialize interpolation with such a file.','') 
+               ENDIF
+            ELSE
+   !-----   Normal mode : copy old step
+               swdown_nm1(:,:) = swdown_n(:,:)
+               rainf_nm1(:,:) = rainf_n(:,:)
+               snowf_nm1(:,:)  = snowf_n(:,:) 
+               tair_nm1(:,:)   = tair_n(:,:)
+               u_nm1(:,:)      = u_n(:,:)
+               v_nm1(:,:)      = v_n(:,:)
+               qair_nm1(:,:)   = qair_n(:,:)
+               pb_nm1(:,:)     = pb_n(:,:)
+               lwdown_nm1(:,:) = lwdown_n(:,:)
+               IF (is_watchout) THEN
+                  zlev_nm1(:,:)   = zlev_n(:,:)
+                  ! Net surface short-wave flux
+                  SWnet_nm1(:,:) = SWnet_n(:,:)
+                  ! Air potential energy
+                  Eair_nm1(:,:)   = Eair_n(:,:)
+                  ! Coeficients A from the PBL resolution for T
+                  petAcoef_nm1(:,:) = petAcoef_n(:,:)
+                  ! Coeficients A from the PBL resolution for q
+                  peqAcoef_nm1(:,:) = peqAcoef_n(:,:)
+                  ! Coeficients B from the PBL resolution for T
+                  petBcoef_nm1(:,:) = petBcoef_n(:,:)
+                  ! Coeficients B from the PBL resolution for q
+                  peqBcoef_nm1(:,:) = peqBcoef_n(:,:)
+                  ! Surface drag
+                  cdrag_nm1(:,:) = cdrag_n(:,:)
+                  ! CO2 concentration in the canopy
+                  ccanopy_nm1(:,:) = ccanopy_n(:,:)
+               ENDIF
+               itau_read_nm1 = itau_read_n
+            ENDIF
+   !-----
+            itau_read_n = itau_read
+            IF (itau_read_n > ttm) THEN
+               WRITE(numout,*) 'WARNING --WARNING --WARNING --WARNING '
+               WRITE(numout,*) &
+                    &  'WARNING : We are going back to the start of the file'
+               itau_read_n =1
+            ENDIF
+            IF (check) THEN
+               WRITE(numout,*) &
+                    & 'The dates 2 : ',itau_read,itau_split,itau_read_nm1,itau_read_n
+            ENDIF
+   !-----
+   !----- Get a reduced julian day !
+   !----- This is needed because we lack the precision on 32 bit machines.
+   !-----
+            IF ( dt_force .GT. 3600. ) THEN
+               julian_for = itau2date(itau_read-1, date0, dt_force)
+               CALL ju2ymds (julian_for, yy, mm, dd, ss)
+   
+               ! first day of this year
+               CALL ymds2ju (yy,1,1,0.0, julian0)
+   !-----
+               IF (check) THEN
+                  WRITE(numout,*) 'Forcing for Julian day ',julian_for,'is read'
+                  WRITE(numout,*) 'Date for this day ',yy,' / ',mm,' / ',dd,"  ",ss
+               ENDIF
+            ENDIF
+   !-----
+            CALL forcing_just_read (iim, jjm, zlev_n, zlevuv_n, ttm, itau_read_n, itau_read_n, &
+                 &  swdown_n, rainf_n, snowf_n, tair_n, &
+                 &  u_n, v_n, qair_n, pb_n, lwdown_n, &
+                 &  SWnet_n, Eair_n, petAcoef_n, peqAcoef_n, petBcoef_n, peqBcoef_n, cdrag_n, ccanopy_n, &
+                 &  force_id, wind_N_exists, check)
+   !---
+            last_read = itau_read_n
+   !-----
+   !----- Compute mean solar angle for the comming period
+   !-----
+            IF (check) WRITE(numout,*) 'Going into  solarang', split, one_day
+   !-----
+            IF ( dt_force .GT. 3600. ) THEN
+               mean_coszang(:,:) = 0.0
+               DO is=1,split
+                  !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+                  julian = julian_for+((is-0.5)/split)*dt_force/one_day
+   !!$               julian = julian_for+(FLOAT(is)/split)*dt_force/one_day
+                  CALL solarang (julian, julian0, iim, jjm, lon, lat, coszang)
+                  mean_coszang(:,:) = mean_coszang(:,:)+coszang(:,:)
+               ENDDO
+               mean_coszang(:,:) = mean_coszang(:,:)/split
+   !            WRITE(*,*) "mean_coszang =",MAXVAL(mean_coszang)
+            ENDIF
+   !-----
+         ENDIF
+   !---
+   !--- Do the interpolation
+         IF (check) WRITE(numout,*) 'Doing the interpolation between time steps'
+   !---
+         IF (split > 1) THEN
+            rw = REAL(itau_split)/split
+         ELSE
+            rw = 1.
+         ENDIF
+         IF (check) WRITE(numout,*) 'Coeff of interpollation : ',rw
+   !---
+         qair(:,:) = (qair_n(:,:)-qair_nm1(:,:))*rw + qair_nm1(:,:)
+         tair(:,:) = (tair_n(:,:)-tair_nm1(:,:))*rw + tair_nm1(:,:)
+         pb(:,:) = (pb_n(:,:)-pb_nm1(:,:))*rw + pb_nm1(:,:)
+         u(:,:)  = (u_n(:,:)-u_nm1(:,:))*rw + u_nm1(:,:)
+         v(:,:)  = (v_n(:,:)-v_nm1(:,:))*rw + v_nm1(:,:)
+         IF (is_watchout) THEN
+            zlev(:,:) = (zlev_n(:,:)-zlev_nm1(:,:))*rw + zlev_nm1(:,:)
+            zlevuv(:,:) = zlev(:,:)
+            SWnet(:,:) = (SWnet_n(:,:)-SWnet_nm1(:,:))*rw + SWnet_nm1(:,:)
+            Eair(:,:) = (Eair_n(:,:)-Eair_nm1(:,:))*rw + Eair_nm1(:,:)
+            petAcoef(:,:) = (petAcoef_n(:,:)-petAcoef_nm1(:,:))*rw + petAcoef_nm1(:,:)
+            peqAcoef(:,:) = (peqAcoef_n(:,:)-peqAcoef_nm1(:,:))*rw + peqAcoef_nm1(:,:)
+            petBcoef(:,:) = (petBcoef_n(:,:)-petBcoef_nm1(:,:))*rw + petBcoef_nm1(:,:)
+            peqBcoef(:,:) = (peqBcoef_n(:,:)-peqBcoef_nm1(:,:))*rw + peqBcoef_nm1(:,:)
+            cdrag(:,:) = (cdrag_n(:,:)-cdrag_nm1(:,:))*rw + cdrag_nm1(:,:)
+            ccanopy(:,:) = (ccanopy_n(:,:)-ccanopy_nm1(:,:))*rw + ccanopy_nm1(:,:)
+         ENDIF
+   !---
+   !--- Here we need to allow for an option
+   !--- where radiative energy is conserved
+   !---
+         IF ( netrad_cons ) THEN
+            lwdown(:,:) = lwdown_n(:,:)
+         ELSE
+            lwdown(:,:) = (lwdown_n(:,:)-lwdown_nm1(:,:))*rw + lwdown_nm1(:,:)
+         ENDIF
+   !---
+   !--- For the solar radiation we decompose the mean value
+   !--- using the zenith angle of the sun if the time step in the forcing data is 
+   !---- more than an hour. Else we use the standard linera interpolation
+   !----
+         IF (check) WRITE(numout,*) 'Ready to deal with the solar radiation'
+   !----
+         IF ( dt_force .GT. 3600. ) THEN
+   !---
+            IF ( netrad_cons ) THEN
+               WRITE(numout,*) 'Solar radiation can not be conserved with a timestep of ', dt_force
+            ENDIF
+   !---
+            !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+            julian = julian_for + (itau_split-0.5)/split*dt_force/one_day
+   !!$         julian = julian_for + rw*dt_force/one_day
+            IF (check) THEN
+               WRITE(numout,'(a,f20.10,2I3)') &
+                    &  'JULIAN BEFORE SOLARANG : ',julian,itau_split,split
+            ENDIF
+   !---
+            CALL solarang(julian, julian0, iim, jjm, lon, lat, coszang)
+   !---
+            WHERE (mean_coszang(:,:) > 0.)
+               swdown(:,:) = swdown_n(:,:) *coszang(:,:)/mean_coszang(:,:)
+            ELSEWHERE
+               swdown(:,:) = 0.0
+            END WHERE
+   !---
+            WHERE (swdown(:,:) > 2000. )
+               swdown(:,:) = 2000.
+            END WHERE
+   !---
+         ELSE
+   !---
+            IF ( netrad_cons ) THEN
+               swdown(:,:) = swdown_n(:,:)
+            ELSE
+               swdown(:,:) = (swdown_n(:,:)-swdown_nm1(:,:))*rw + swdown_nm1(:,:)
+            ENDIF
+   !---
+         ENDIF
+   !---
+         IF (check) THEN
+            WRITE(numout,*) '__ Forcing read at ',itau_split,' :',i_test, j_test
+            WRITE(numout,*) 'SWdown  : ',swdown_nm1(i_test, j_test), &
+                 &           ' < ', swdown(i_test, j_test), ' < ', swdown_n(i_test, j_test)
+            IF (is_watchout) THEN
+               WRITE(numout,*) 'SWnet  : ',swnet_nm1(i_test, j_test), &
+                    &           ' < ', swnet(i_test, j_test), ' < ', swnet_n(i_test, j_test)
+               WRITE(numout,*) 'levels  :',zlev_nm1(i_test, j_test), &
+                    &           ' < ', zlev(i_test, j_test), ' < ', zlev_n(i_test, j_test)
+               WRITE(numout,*) 'EAIR  :',Eair_nm1(i_test, j_test), &
+                    &           ' < ', eair(i_test, j_test), ' < ', Eair_n(i_test, j_test)
+            ENDIF
+            WRITE(numout,*) 'TAIR  :',tair_nm1(i_test, j_test), &
+                 &           ' < ', tair(i_test, j_test), ' < ', tair_n(i_test, j_test)
+            WRITE(numout,*) 'QAIR  :',qair_nm1(i_test, j_test), &
+                 &           ' < ', qair(i_test, j_test), ' < ', qair_n(i_test, j_test)
+            WRITE(numout,*) 'U  :',u_nm1(i_test, j_test), &
+                 &           ' < ', u(i_test, j_test), ' < ', u_n(i_test, j_test)
+            WRITE(numout,*) 'V  :',v_nm1(i_test, j_test), &
+                 &           ' < ', v(i_test, j_test), ' < ', v_n(i_test, j_test)
+         ENDIF
+   !---
+   !--- For precip we suppose that the rain
+   !--- is the sum over the next 6 hours
+   !---
+         IF (itau_split <= nb_spread) THEN
+            rainf(:,:) = rainf_n(:,:)*(split/REAL(nb_spread))
+            snowf(:,:) = snowf_n(:,:)*(split/REAL(nb_spread))
+         ELSE
+            rainf(:,:) = 0.0
+            snowf(:,:) = 0.0
+         ENDIF
+         IF (check) THEN
+            WRITE(numout,*) '__ Forcing read at ',itau_split,' :'
+            WRITE(numout,*) 'Rainf  : ',rainf_nm1(i_test, j_test), &
+                 &           ' < ', rainf(i_test, j_test), ' < ', rainf_n(i_test, j_test)
+            WRITE(numout,*) 'Snowf  : ',snowf_nm1(i_test, j_test), &
+                 &           ' < ', snowf(i_test, j_test), ' < ', snowf_n(i_test, j_test)
+         ENDIF
+   !---
+      ENDIF ! (daily_interpol)
+   ENDIF
+!---
+!--- Here we might put the call to the weather generator ... one day.
+!--- Pour le moment, le branchement entre interpolation et generateur de temps 
+!--- est fait au-dessus.
+!---
+!-   IF ( initialized .AND. weathergen ) THEN
+!-      ....
+!-   ENDIF
+!---
+!--- At this point the code should be initialized. If not we have a problem !
+!---
+   IF ( (itau_read == 0).AND.(itau_split == 0) ) THEN
+!---
+      initialized = .TRUE.
+!---
+   ELSE
+      IF ( .NOT. initialized ) THEN
+         WRITE(numout,*) 'Why is the code forcing_read not initialized ?'
+         WRITE(numout,*) 'Have you called it with both time-steps set to zero ?'
+         CALL ipslerr_p(3,'forcing_read_interpol','Pb in initialization','','')
+      ENDIF
+   ENDIF
+!
+!-------------------------
+END SUBROUTINE forcing_read_interpol
+!=====================================================================
+!-
+!=====================================================================
+SUBROUTINE forcing_just_read &
+  & (iim, jjm, zlev, zlev_uv, ttm, itb, ite, &
+  &  swdown, rainf, snowf, tair, &
+  &  u, v, qair, pb, lwdown, &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+  &  force_id, wind_N_exists, check)
+!---------------------------------------------------------------------
+!- iim        : Size of the grid in x
+!- jjm        : size of the grid in y
+!- zlev       : height of the varibales T and Q 
+!- zlev_uv    : height of the varibales U and V 
+!- ttm        : number of time steps in all in the forcing file
+!- itb, ite   : index of respectively begin and end of read for each variable
+!- swdown     : Downward solar radiation (W/m^2)
+!- rainf      : Rainfall (kg/m^2s)
+!- snowf      : Snowfall (kg/m^2s)
+!- tair       : 2m air temperature (K)
+!- u and v    : 2m (in theory !) wind speed (m/s)
+!- qair       : 2m humidity (kg/kg)
+!- pb         : Surface pressure (Pa)
+!- lwdown     : Downward long wave radiation (W/m^2)
+!-
+!- From a WATCHOUT file :
+!- SWnet      : Net surface short-wave flux
+!- Eair       : Air potential energy
+!- petAcoef   : Coeficients A from the PBL resolution for T
+!- peqAcoef   : Coeficients A from the PBL resolution for q
+!- petBcoef   : Coeficients B from the PBL resolution for T
+!- peqBcoef   : Coeficients B from the PBL resolution for q
+!- cdrag      : Surface drag
+!- ccanopy    : CO2 concentration in the canopy
+!- force_id   : FLINCOM file id.
+!-              It is used to close the file at the end of the run.
+!- wind_N_exists : if Wind_N and Wind_E are in the file (and not just Wind)
+!- check      : Prompt for reading
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER, INTENT(in) :: iim, jjm, ttm
+   INTEGER, INTENT(in) :: itb, ite
+   REAL, DIMENSION(iim,jjm), INTENT(out) ::  zlev, zlev_uv, &
+  &  swdown, rainf, snowf, tair, u, v, qair, pb, lwdown
+   ! for watchout files
+   REAL, DIMENSION(iim,jjm), INTENT(out) :: &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy
+   INTEGER, INTENT(in) :: force_id
+!  if Wind_N and Wind_E are in the file (and not just Wind)
+   LOGICAL, INTENT(in) :: wind_N_exists
+   LOGICAL :: check
+   INTEGER :: i, j 
+   REAL :: rau 
+
+!-
+!---------------------------------------------------------------------
+   IF ( daily_interpol ) THEN
+      CALL flinget_buffer (force_id,'Tmin'  , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, tair)
+      CALL flinget_buffer (force_id,'precip' , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, rainf)
+   ELSE
+      CALL flinget_buffer (force_id,'Tair'  , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, tair)
+      CALL flinget_buffer (force_id,'Snowf' , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, snowf)
+      CALL flinget_buffer (force_id,'Rainf' , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, rainf)
+   ENDIF
+
+
+   CALL flinget_buffer (force_id,'SWdown', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, swdown)
+   CALL flinget_buffer (force_id,'LWdown', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, lwdown)
+
+   CALL flinget_buffer (force_id,'PSurf' , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, pb)
+   CALL flinget_buffer (force_id,'Qair'  , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, qair)
+!---
+   IF ( wind_N_exists ) THEN
+      CALL flinget_buffer (force_id,'Wind_N', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, u)
+      CALL flinget_buffer (force_id,'Wind_E', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, v)
+   ELSE
+      CALL flinget_buffer (force_id,'Wind',   iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, u)
+      v=0.0
+   ENDIF
+
+!- 
+!- Deal with the height of the atmospheric forcing varibles 
+!- 
+!---- 
+   IF ( zheight ) THEN 
+      zlev(:,:) = zlev_fixed 
+   ELSE IF ( zsigma .OR. zhybrid ) THEN 
+      DO i=1,iim 
+         DO j=1,jjm 
+            IF ( tair(i,j) < val_exp ) THEN 
+               rau = pb(i,j)/(cte_molr*tair(i,j)) 
+ 	  	 
+               zlev(i,j) =  (pb(i,j) - (zhybrid_a + zhybrid_b*pb(i,j)))/(rau * cte_grav) 
+            ELSE 
+               zlev(i,j) = 0.0 
+            ENDIF
+         ENDDO
+      ENDDO
+   ELSE IF ( zlevels ) THEN 
+      CALL flinget_buffer (force_id,'Levels', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full) 
+      CALL forcing_zoom(data_full, zlev) 
+   ELSE 
+      CALL ipslerr(3, 'forcing_just_read','No case for the vertical levels was specified.', & 
+           &         'We cannot determine the height for T and Q.','stop readdim2') 
+   ENDIF
+   
+   IF ( zsamelev_uv ) THEN 
+      zlev_uv(:,:) = zlev(:,:) 
+   ELSE 
+      IF ( zheight ) THEN 
+         zlev_uv(:,:) = zlevuv_fixed 
+      ELSE IF ( zsigma .OR. zhybrid ) THEN 
+         DO i=1,iim 
+            DO j=1,jjm 
+               IF ( tair(i,j) < val_exp ) THEN 
+                  rau = pb(i,j)/(cte_molr*tair(i,j)) 
+                  
+                  zlev_uv(i,j) =  (pb(i,j) - (zhybriduv_a + zhybriduv_b*pb(i,j)))/(rau * cte_grav) 
+               ELSE 
+                  zlev_uv(i,j) = 0.0 
+               ENDIF
+            ENDDO
+         ENDDO
+      ELSE IF ( zlevels ) THEN 
+         CALL flinget_buffer (force_id,'Levels_uv', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full) 
+         CALL forcing_zoom(data_full, zlev_uv) 
+      ELSE 
+         CALL ipslerr(3, 'forcing_just_read','No case for the vertical levels was specified.', & 
+              &         'We cannot determine the height for U and V.','stop readdim2') 
+      ENDIF
+   ENDIF
+   !----
+   IF ( is_watchout ) THEN
+      CALL flinget_buffer (force_id,'levels', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, zlev)
+      ! 
+      ! If we are in WATHCOUT it means T,Q are at the same height as U,V 
+      ! 
+      zlev_uv(:,:) = zlev(:,:) 
+      ! Net surface short-wave flux
+      CALL flinget_buffer (force_id,'SWnet', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, SWnet)
+      ! Air potential energy
+      CALL flinget_buffer (force_id,'Eair', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, Eair)
+      ! Coeficients A from the PBL resolution for T
+      CALL flinget_buffer (force_id,'petAcoef', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, petAcoef)
+      ! Coeficients A from the PBL resolution for q
+      CALL flinget_buffer (force_id,'peqAcoef', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, peqAcoef)
+      ! Coeficients B from the PBL resolution for T
+      CALL flinget_buffer (force_id,'petBcoef', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, petBcoef)
+      ! Coeficients B from the PBL resolution for q
+      CALL flinget_buffer (force_id,'peqBcoef', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, peqBcoef)
+      ! Surface drag
+      CALL flinget_buffer (force_id,'cdrag', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, cdrag)
+      ! CO2 concentration in the canopy
+      CALL flinget_buffer (force_id,'ccanopy', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, ccanopy)
+   ENDIF
+!
+!----
+     IF (check) WRITE(numout,*) 'Variables have been extracted between ',itb,' and ',ite,' iterations of the forcing file.'
+!-------------------------
+END SUBROUTINE forcing_just_read
+!=====================================================================
+
+!-
+SUBROUTINE forcing_just_read_tmax &
+  & (iim, jjm, ttm, itb, ite, tmax, force_id )
+!---------------------------------------------------------------------
+!- iim        : Size of the grid in x
+!- jjm        : size of the grid in y
+!- ttm        : number of time steps in all in the forcing file
+!- itb, ite   : index of respectively begin and end of read for each variable
+!- tmax       : 2m air temperature (K)
+!- force_id   : FLINCOM file id.
+!-              It is used to close the file at the end of the run.
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER, INTENT(in) :: iim, jjm, ttm
+   INTEGER, INTENT(in) :: itb, ite
+   REAL, DIMENSION(iim,jjm), INTENT(out) ::  tmax
+   INTEGER, INTENT(in) :: force_id
+!-
+!---------------------------------------------------------------------
+   CALL flinget_buffer (force_id,'Tmax'  , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, tmax)
+!-------------------------
+END SUBROUTINE forcing_just_read_tmax
+!=====================================================================
+
+!-
+SUBROUTINE forcing_landind(iim, jjm, tair, check, nbindex, kindex, i_test, j_test)
+!---
+!--- This subroutine finds the indices of the land points over which the land
+!--- surface scheme is going to run.
+!---
+  IMPLICIT NONE
+!-
+!- ARGUMENTS
+!-
+  INTEGER, INTENT(IN) :: iim, jjm
+  REAL, INTENT(IN)    :: tair(iim,jjm)
+  INTEGER, INTENT(OUT) :: i_test, j_test, nbindex
+  INTEGER, INTENT(OUT) :: kindex(iim*jjm)
+  LOGICAL :: check
+!-
+!- LOCAL
+  INTEGER :: i, j, ig
+!-
+!-
+  ig = 0
+  i_test = 0
+  j_test = 0
+!---
+  IF (MINVAL(tair(:,:)) < 100.) THEN
+!----- In this case the 2m temperature is in Celsius
+     DO j=1,jjm
+        DO i=1,iim
+           IF (tair(i,j) < 100.) THEN
+              ig = ig+1
+              kindex(ig) = (j-1)*iim+i
+              !
+              !  Here we find at random a land-point on which we can do
+              !  some printouts for test.
+              !
+              IF (ig .GT. (iim*jjm)/2 .AND. i_test .LT. 1) THEN
+                 i_test = i
+                 j_test = j
+                 IF (check) THEN
+                    WRITE(numout,*) 'The test point chosen for output is : ', i_test, j_test
+                 ENDIF
+              ENDIF
+           ENDIF
+        ENDDO
+     ENDDO
+  ELSE 
+!----- 2m temperature is in Kelvin
+     DO j=1,jjm
+        DO i=1,iim
+           IF (tair(i,j) < 500.) THEN
+              ig = ig+1
+              kindex(ig) = (j-1)*iim+i
+              !
+              !  Here we find at random a land-point on which we can do
+              !  some printouts for test.
+              !
+              IF (ig .GT. (iim*jjm)/2 .AND. i_test .LT. 1) THEN
+                 i_test = i
+                 j_test = j
+                 IF (check) THEN
+                    WRITE(numout,*) 'The test point chosen for output is : ', i_test, j_test
+                 ENDIF
+              ENDIF
+           ENDIF
+        ENDDO
+     ENDDO
+  ENDIF
+!---
+  nbindex = ig
+!---
+END SUBROUTINE forcing_landind
+!-
+!=====================================================================
+!-
+SUBROUTINE forcing_grid(iim,jjm,llm,lon,lat,init_f)
+!-
+!- This subroutine calculates the longitudes and latitudes of the model grid.
+!-   
+  IMPLICIT NONE
+!-
+  INTEGER, INTENT(in)                   :: iim, jjm, llm
+  LOGICAL, INTENT(in)                   :: init_f
+  REAL, DIMENSION(iim,jjm), INTENT(out) :: lon, lat
+!-
+  INTEGER :: i,j
+!-
+!- Should be unified one day
+!-
+  IF ( printlev_loc>=3 ) WRITE(numout,*) 'forcing_grid : options : ', weathergen, interpol
+!-
+  IF ( weathergen ) THEN
+     IF (init_f) THEN
+        DO i = 1, iim
+           lon(i,:) = limit_west + merid_res/2. + &
+                FLOAT(i-1)*(limit_east-limit_west)/FLOAT(iim)
+        ENDDO
+        !-
+        DO j = 1, jjm
+           lat(:,j) = limit_north - zonal_res/2. - &
+                FLOAT(j-1)*(limit_north-limit_south)/FLOAT(jjm)
+        ENDDO
+     ELSE
+        IF (is_root_prc) THEN
+           DO i = 1, iim_g
+              lon_g(i,:) = limit_west + merid_res/2. + &
+                   FLOAT(i-1)*(limit_east-limit_west)/FLOAT(iim_g)
+           ENDDO
+           !-
+           DO j = 1, jjm_g
+              lat_g(:,j) = limit_north - zonal_res/2. - &
+                   FLOAT(j-1)*(limit_north-limit_south)/FLOAT(jjm_g)
+           ENDDO
+        ENDIF
+        CALL bcast(lon_g)
+        CALL bcast(lat_g)
+        lon=lon_g(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank))
+        lat=lat_g(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank))
+     ENDIF
+!-
+  ELSEIF ( interpol ) THEN
+!-
+    CALL forcing_zoom(lon_full, lon)
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'forcing_grid : out of zoom on lon'
+    CALL forcing_zoom(lat_full, lat)
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'forcing_grid : out of zoom on lat'
+ 
+ ELSE 
+    CALL ipslerr_p(3,'forcing_grid','Neither interpolation nor weather generator is specified.','','')
+ ENDIF
+ 
+ IF ( printlev_loc>=3 ) WRITE(numout,*) 'forcing_grid : ended'
+ 
+END SUBROUTINE forcing_grid
+!-
+!=====================================================================
+!-
+SUBROUTINE forcing_zoom(x_f, x_z)
+!-
+!- This subroutine takes the slab of data over which we wish to run the model.
+!-   
+  IMPLICIT NONE
+!-
+  REAL, INTENT(IN) :: x_f(iim_full, jjm_full)
+  REAL, INTENT(OUT) :: x_z(iim_zoom, jjm_zoom)
+!-
+  INTEGER :: i,j
+!-
+  DO i=1,iim_zoom
+     DO j=1,jjm_zoom
+        x_z(i,j) = x_f(i_index(i),j_index(j))
+     ENDDO
+  ENDDO
+!-
+END SUBROUTINE forcing_zoom
+
+!-
+!=====================================================================
+!-
+
+SUBROUTINE forcing_vertical(force_id)
+!
+!- This subroutine explores the forcing file to decide what information is available
+!- on the vertical coordinate.
+!
+  INTEGER, INTENT(IN) :: force_id
+  !
+  LOGICAL :: var_exists, vara_exists, varb_exists, varuv_exists
+  LOGICAL :: foundvar
+  LOGICAL :: levlegacy
+
+  !
+  !- Set all the defaults
+  !
+  zfixed=.FALSE.
+  zsigma=.FALSE.
+  zhybrid=.FALSE.
+  zlevels=.FALSE.
+  zheight=.FALSE.
+  zsamelev_uv = .TRUE.
+  levlegacy = .FALSE.
+  !
+  foundvar = .FALSE.
+  !
+  !- We have a forcing file to explore so let us see if we find any of the conventions
+  !- which allow us to find the height of T,Q,U and V.
+  !
+  IF ( force_id > 0 ) THEN
+     !
+     ! Case for sigma levels
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'Sigma', var_exists)
+        CALL flinquery_var(force_id, 'Sigma_uv', varuv_exists)
+        IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zsigma = .TRUE.
+           IF ( varuv_exists ) zsamelev_uv = .FALSE.
+        ENDIF
+     ENDIF
+     !
+     ! Case for Hybrid levels
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'HybSigA', vara_exists)
+        IF ( vara_exists ) THEN
+           CALL flinquery_var(force_id, 'HybSigB', varb_exists)
+           IF ( varb_exists ) THEN
+              var_exists=.TRUE.
+           ELSE
+              CALL ipslerr ( 3, 'forcing_vertical','Missing the B coefficient for', &
+                   &         'Hybrid vertical levels for T and Q','stop readdim2')
+           ENDIF
+        ENDIF
+        CALL flinquery_var(force_id, 'HybSigA_uv', vara_exists)
+        IF ( vara_exists ) THEN
+           CALL flinquery_var(force_id, 'HybSigB_uv', varb_exists)
+           IF ( varb_exists ) THEN
+              varuv_exists=.TRUE.
+           ELSE
+              CALL ipslerr ( 3, 'forcing_vertical','Missing the B coefficient for', &
+                   &         'Hybrid vertical levels for U and V','stop readdim2')
+           ENDIF
+        ENDIF
+        IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zhybrid = .TRUE.
+           IF ( varuv_exists ) zsamelev_uv = .FALSE.
+        ENDIF
+     ENDIF
+     !
+     ! Case for levels (i.e. a 2d time varying field with the height in meters)
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'Levels', var_exists)
+        CALL flinquery_var(force_id, 'Levels_uv', varuv_exists)
+        IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zlevels = .TRUE.
+           IF ( varuv_exists ) zsamelev_uv = .FALSE.
+        ENDIF
+     ENDIF
+     !
+     ! Case where a fixed height is provided in meters
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'Height_Lev1', var_exists)
+        CALL flinquery_var(force_id, 'Height_Levuv', varuv_exists)
+       IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zheight = .TRUE.
+           IF ( varuv_exists ) zsamelev_uv = .FALSE.
+        ENDIF
+     ENDIF
+     !
+     ! Case where a fixed height is provided in meters in the lev variable
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'lev', var_exists)
+        IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zheight = .TRUE.
+           levlegacy = .TRUE.
+        ENDIF
+     ENDIF
+     !
+  ENDIF
+  !
+  ! We found forcing variables so we need to extract the values if we are dealing with constant values (i.e. all
+  ! except the case zlevels
+  !
+  IF ( foundvar .AND. .NOT. zlevels ) THEN
+     !
+     IF ( zheight ) THEN
+        !
+        ! Constant height
+        !
+        IF ( levlegacy ) THEN
+           CALL flinget (force_id,'lev',1, 1, 1, 1,  1, 1, zlev_fixed)
+        ELSE
+           CALL flinget (force_id,'Height_Lev1',1, 1, 1, 1,  1, 1, zlev_fixed)
+           IF ( .NOT. zsamelev_uv ) THEN
+              CALL flinget (force_id,'Height_Levuv',1, 1, 1, 1,  1, 1, zlevuv_fixed)
+           ENDIF
+        ENDIF
+        WRITE(numout,*) "forcing_vertical : case ZLEV : Read from forcing file :", zlev_fixed, zlevuv_fixed
+        !
+     ELSE IF ( zsigma .OR. zhybrid ) THEN
+        !
+        ! Sigma or hybrid levels
+        !
+        IF ( zsigma ) THEN
+           CALL flinget (force_id,'Sigma',1, 1, 1, 1,  1, 1, zhybrid_b)
+           zhybrid_a = zero
+           IF ( .NOT. zsamelev_uv ) THEN
+              CALL flinget (force_id,'Sigma_uv',1, 1, 1, 1,  1, 1, zhybriduv_b)
+              zhybriduv_a = zero
+           ENDIF
+        ELSE
+           CALL flinget (force_id,'HybSigB',1, 1, 1, 1,  1, 1, zhybrid_b)
+           CALL flinget (force_id,'HybSigA',1, 1, 1, 1,  1, 1, zhybrid_a)
+           IF ( .NOT. zsamelev_uv ) THEN
+              CALL flinget (force_id,'HybSigB_uv',1, 1, 1, 1,  1, 1, zhybriduv_b)
+              CALL flinget (force_id,'HybSigA_uv',1, 1, 1, 1,  1, 1, zhybriduv_a)
+           ENDIF
+        ENDIF
+        WRITE(numout,*) "forcing_vertical : case Pressure coordinates : "
+        WRITE(numout,*) "Read from forcing file :", zhybrid_b, zhybrid_a, zhybriduv_b, zhybriduv_a
+     ELSE
+        !
+        ! Why are we here ???
+        !
+        CALL ipslerr ( 3, 'forcing_vertical','What is the option used to describe the height of', &
+             &         'the atmospheric forcing ?','Please check your forcing file.')
+     ENDIF
+  ENDIF
+  !
+  !- We have no forcing file to explore or we did not find anything. So revert back to the run.def and
+  !- read what has been specified by the user.
+  !
+  IF ( force_id < 0 .OR. .NOT. foundvar ) THEN
+     !
+     !-
+     !Config Key   = HEIGHT_LEV1
+     !Config Desc  = Height at which T and Q are given
+     !Config Def   = 2.0
+     !Config If    = offline mode
+     !Config Help  = The atmospheric variables (temperature and specific
+     !Config         humidity) are measured at a specific level.
+     !Config         The height of this level is needed to compute
+     !Config         correctly the turbulent transfer coefficients.
+     !Config         Look at the description of the forcing
+     !Config         DATA for the correct value.
+     !Config Units = [m]
+     !-
+     zlev_fixed = 2.0
+     CALL getin('HEIGHT_LEV1', zlev_fixed)
+
+     !-
+     !Config Key  = HEIGHT_LEVW
+     !Config Desc = Height at which the wind is given
+     !Config Def  = 10.0
+     !Config If   = offline mode
+     !Config Help = The height at which wind is needed to compute
+     !Config        correctly the turbulent transfer coefficients.
+     !Config Units= [m]
+     !-
+     zlevuv_fixed = 10.0
+     CALL getin('HEIGHT_LEVW', zlevuv_fixed)
+
+     zheight = .TRUE.
+
+     IF ( ABS(zlevuv_fixed-zlev_fixed) > EPSILON(zlev_fixed)) THEN
+        zsamelev_uv = .FALSE.
+     ENDIF
+
+     CALL ipslerr ( 2, 'forcing_vertical','The height of the atmospheric forcing variables', &
+          &         'was not found in the netCDF file.','Thus the values in run.def were used ... or their defaults.')
+  ENDIF
+
+END SUBROUTINE forcing_vertical
+
+!-
+!=====================================================================
+!-
+
+SUBROUTINE domain_size (limit_west, limit_east, limit_north, limit_south, &
+     &  iim_f, jjm_f, lon, lat, iim, jjm, iind, jind)
+  
+  IMPLICIT NONE
+  !
+  ! ARGUMENTS
+  !
+  REAL, INTENT(inout)  :: limit_west,limit_east,limit_north,limit_south
+  INTEGER, INTENT(in)  :: iim_f, jjm_f
+  REAL, INTENT(in)     :: lon(iim_f, jjm_f), lat(iim_f, jjm_f)
+  INTEGER, INTENT(out) :: iim,jjm
+  INTEGER, INTENT(out) :: iind(iim_f), jind(jjm_f)
+  !
+  ! LOCAL
+  !
+  INTEGER :: i, j
+  REAL :: lolo
+  LOGICAL :: over_dateline = .FALSE.
+  !
+  !
+  IF ( ( ABS(limit_east) .GT. 180. ) .OR. &
+       ( ABS(limit_west) .GT. 180. ) ) THEN
+     WRITE(numout,*) 'Limites Ouest, Est: ',limit_west,limit_east
+     CALL ipslerr_p (3,'domain_size', &
+ &        'Longitudes problem.','In run.def file :', &
+ &        'limit_east > 180. or limit_west > 180.')
+  ENDIF
+  !
+  IF ( limit_west .GT. limit_east ) over_dateline = .TRUE.
+  !
+  IF ( ( limit_south .LT. -90. ) .OR. &
+       ( limit_north .GT. 90. ) .OR. &
+       ( limit_south .GE. limit_north ) ) THEN
+     WRITE(numout,*) 'Limites Nord, Sud: ',limit_north,limit_south
+     CALL ipslerr_p (3,'domain_size', &
+ &        'Latitudes problem.','In run.def file :', &
+ &        'limit_south < -90. or limit_north > 90. or limit_south >= limit_north')
+  ENDIF
+  !
+  ! Here we assume that the grid of the forcing data is regular. Else we would have
+  ! to do more work to find the index table.
+  !
+  iim = 0
+  DO i=1,iim_f
+     !
+     lolo =  lon(i,1)
+     IF ( lon(i,1) .GT. 180. ) lolo =  lon(i,1) - 360.
+     IF ( lon(i,1) .LT. -180. ) lolo =  lon(i,1) + 360.
+     !
+     IF (lon(i,1) < limit_west) iim_g_begin = i+1
+     IF (lon(i,1) < limit_east) iim_g_end = i
+     !
+     IF ( over_dateline ) THEN
+        IF ( lolo .LE. limit_west .OR. lolo .GE. limit_east ) THEN
+           iim = iim + 1
+           iind(iim) = i
+        ENDIF
+     ELSE
+        IF ( lolo .GE. limit_west .AND. lolo .LE. limit_east ) THEN
+           iim = iim + 1
+           iind(iim) = i
+        ENDIF
+     ENDIF
+     !
+  ENDDO
+  !
+  jjm = 0
+  DO j=1,jjm_f
+     IF (lat(1,j) > limit_north) jjm_g_begin = j+1
+     IF (lat(1,j) > limit_south) jjm_g_end = j
+     !
+     IF ( lat(1,j) .GE. limit_south .AND. lat(1,j) .LE. limit_north) THEN
+        jjm = jjm + 1
+        jind(jjm) = j
+     ENDIF
+  ENDDO
+  !
+  WRITE(numout,*) 'Domain zoom size: iim, jjm = ', iim, jjm
+  END SUBROUTINE domain_size
+!-
+!=====================================================================
+!-
+  SUBROUTINE flinget_buffer(force_id, varname, iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+    
+    !! This subroutine is a wrap of flinget/IOIPSL. The arguments are the same. 
+    !! flinget_buffer will call flinget and buffer the forcing data localy in this subroutine. 
+    !! According to the variable NBUFF set in run.def, several time steps can be read at the same time 
+    !! from the forcing file. If NBUFF=0, the full forcing file is read. 
+    !! The output, data_full, from this subroutine is always only one time step of corresponding to itb.
+    !! itb must be equal to ite. 
+    
+    !! Input arguments 
+    INTEGER, INTENT(in)          :: force_id                      !! Id for forcing file
+    CHARACTER(len=*), INTENT(in) :: varname                       !! Name of current variable to be read
+    INTEGER, INTENT(in)          :: iim_full, jjm_full, llm_full  !! Horizontal and vertical domaine
+    INTEGER, INTENT(in)          :: ttm                           !! Full lenght of forcing file
+    INTEGER, INTENT(in)          :: itb, ite                      !! Time step to be read from forcing file. itb must be equal to ite
+
+    !! Output argument
+    REAL, DIMENSION(iim_full, jjm_full), INTENT(out) :: data_full !! Data for time step itb. 
+
+    !! Define specific type to buffer data together with name and index
+    TYPE buffer_type
+       CHARACTER(len=20) :: name                   !! Name of variable in forcing file
+       INTEGER :: istart                           !! Start index of current buffered data
+       INTEGER :: iend                             !! End index of current buffered data
+       REAL, ALLOCATABLE, DIMENSION(:,:,:) :: data !! Data read from forcing file for intervall [istart,iend]
+    END TYPE buffer_type
+    
+    !! Local variables 
+    INTEGER, PARAMETER :: maxvar=20                          !! Max number of variables to be buffered
+    TYPE(buffer_type), DIMENSION(maxvar),SAVE :: data_buffer !! Containing all variables and the current buffered data
+    INTEGER, SAVE   :: nbuff                                 !! Number of time steps to be buffered
+    INTEGER, SAVE   :: lastindex=0                           !! Current number of variables stored in data_buffer
+    INTEGER, SAVE   :: ttm0                                  !! Time lenght of forcing file, stored for test purpose
+    LOGICAL, SAVE   :: first=.TRUE.                          !! First call to this subroutine
+    INTEGER         :: index                                 !! Index in data_buffer for current variable
+    INTEGER         :: i, ierr                               !! Loop and error variables
+    
+    
+    !! 1. Initialization
+    IF (first) THEN
+       data_buffer(:)%name='undef'
+       ! Read NBUFF from run.def
+       ! Note that getin_p is not used because this subroutine might be called only by master process
+
+       !Config Key  = NBUFF
+       !Config Desc = Number of time steps of data to buffer between each reading of the forcing file
+       !Config If   = OFF_LINE
+       !Config Help = The full simulation time length will be read if NBUFF equal 0. NBUFF > 1 can be used for smaller regions or site simulations only. 
+       !Config Def  = 1
+       !Config Units= -
+
+       nbuff=1
+       CALL getin('NBUFF', nbuff)
+
+       IF (nbuff == 0 .OR. nbuff >ttm) THEN
+          ! Set nbuff as the full forcing file lenght
+          nbuff=ttm
+       ELSE IF (nbuff < 0) THEN
+          ! Negativ nbuff not possible
+          CALL ipslerr_p(3,'flinget_buffer','NBUFF must be a positiv number','Set NBUFF=0 for full simulation lenght','')
+       END IF
+       WRITE(numout,*)'flinget_buffer: NBUFF=',nbuff,' number of time step will be buffered'
+       WRITE(numout,*)'flinget_buffer: Choose a lower value for NBUFF if problem with memory'
+       
+       ! Save dimensions to check following timesteps
+       ! ttm is the full lenght of forcing file
+       ttm0=ttm
+       
+       first=.FALSE.
+    END IF
+
+    !! 2. Coeherence tests on input arguments
+    IF (ttm /= ttm0) THEN
+       WRITE(numout,*)'Problem with ttm=',ttm,' ttm0=',ttm0
+       CALL ipslerr_p(3,'flinget_buffer','Error with ttm and ttm0','','')
+    END IF
+    IF (itb /= ite) THEN
+       WRITE(numout,*) 'There is a problem. Why is itb not equal ite ?'
+       WRITE(numout,*) 'itb=',itb,' ite=',ite,' varname=',varname
+       CALL ipslerr_p(3,'flinget_buffer','ite not equal itb','','')
+    END IF
+
+
+    !! 3. Find index for current variable
+    index=0
+    DO i=1, maxvar
+       IF ( trim(varname) == data_buffer(i)%name ) THEN
+          index=i
+          CYCLE
+       END IF
+    END DO
+    
+    !! 4. Initialize and allocate if necesary the current variable
+    IF ( index == 0 ) THEN
+       ! The variable was not found
+       ! This must be the first time for current variable
+       index=lastindex+1
+       lastindex=index
+       IF (index > maxvar) CALL ipslerr_p(3,'flinget_buffer','to many variables','maxvar is too small','')
+       
+       ! Initialize the data_buffer for this index
+       data_buffer(index)%name=trim(varname)
+       ALLOCATE(data_buffer(index)%data(iim_full,jjm_full,nbuff),stat=ierr)
+       IF (ierr /= 0) CALL ipslerr_p(3,'flinget_buffer','pb alloc data_buffer%data','for variable=',varname)
+       data_buffer(index)%istart=0
+       data_buffer(index)%iend=0
+    END IF
+    
+    
+    !! 5. Call flinget if current time step (itb) is outside the buffered intervall
+    IF (( itb > data_buffer(index)%iend ) .OR. ( itb < data_buffer(index)%istart )) THEN
+       ! itb is not in the time slice previously read or it is the first time to read
+       ! Reading of forcing file will now be done
+       ! First recalculate index to be read
+       data_buffer(index)%istart = itb
+       data_buffer(index)%iend   = itb + nbuff - 1
+       
+!       WRITE(numout,*) 'Now do flinget for ',varname,', itb=',itb,', istart=',&
+!            data_buffer(index)%istart,', iend=',data_buffer(index)%iend
+       CALL flinget (force_id,varname, iim_full, jjm_full, llm_full, ttm, data_buffer(index)%istart, &
+            data_buffer(index)%iend, data_buffer(index)%data(:,:,:))
+    END IF
+    
+    !! 6. Initialize the output variable with data from buffered variable
+    ! Find index for the time step corrsponding to itb in the time slice previously read from forcing file
+    i=itb-data_buffer(index)%istart+1
+    ! Initialize output variable
+    data_full(:,:) = data_buffer(index)%data(:,:,i)
+    
+    
+  END SUBROUTINE flinget_buffer
+!------------------
+END MODULE readdim2
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/teststomate.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/teststomate.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/teststomate.f90	(revision 5166)
@@ -0,0 +1,1216 @@
+! =================================================================================================================================
+! PROGRAM       : teststomate
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This program runs the STOMATE submodel using specific initial conditions 
+!! and driving variables in order to obtain the state variables of STOMATE closed to the steady-state values  
+!! quicker than when using the 'full' ORCHIDEE. 
+!!                                        
+!! \n DESCRIPTION (functional, design, flags): 
+!! It integrates STOMATE for a given number of years using a specific forcing file.       
+!! The initial GPP from this forcing is scaled in agreement with the updated calculated LAI in STOMATE 
+!! Nothing is done for soil moisture which should actually evolve with the vegetation.            
+!! - 1. It first reads a set of parameters, allocates variables and initializes them.
+!! - 2. Then, a section on the set up of the STOMATE history file
+!! - 3. A first call to slowproc subroutine in order to initialize SECHIBA variables
+!! - 4. A loop over time in which slowproc is called at each time step
+!! - 5. A restart file is written
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S)     : None
+!!
+!! SVN              :   
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+PROGRAM teststomate
+
+  ! modules used;
+
+  USE netcdf
+  USE defprec
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE stomate_data
+  USE ioipsl_para
+  USE mod_orchidee_para
+  use tools_para
+  USE grid
+  USE slowproc
+  USE stomate
+  USE intersurf, ONLY:  intsurf_time, l_first_intersurf
+  USE ioipslctrl, ONLY : ioipslctrl_histstom, ioipslctrl_histstomipcc
+
+  IMPLICIT NONE
+
+  !! 0. Variable and parameter declaration
+
+  INTEGER(i_std)                            :: kjpij,kjpindex                       !! # of total/land points
+  REAL(r_std)                               :: dtradia,dt_force                     !! time step of sechiba and stomate components 
+                                                                                    !! read into the forcing file [second] 
+ 
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE   :: indices                              !! index over land points
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE   :: indexveg
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: soiltile, veget_x                    !! texture and fraction of vegetation type 
+                                                                                    !! (accounts for LAI dynamic) 
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: totfrac_nobio                        !! Total fraction of ice+lakes+cities etc. in 
+                                                                                    !! the mesh 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: frac_nobio                           !! Fraction of ice, lakes, cities etc. in the 
+                                                                                    !! mesh 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: veget_max_x                          !! Fraction of vegetation type
+  INTEGER(i_std), DIMENSION(:),ALLOCATABLE  :: njsc
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: lai_x                                !! Leaf Area Index as calculated in STOMATE 
+                                                                                    !! [m2/m2] 
+  REAL(r_std),DIMENSION (:,:,:), ALLOCATABLE:: frac_age_x                           !! Age efficacity from STOMATE for isoprene 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: veget_force_x                        !! Fraction of vegetation of PFTs in each grid 
+                                                                                    !! cell (read in the forcinng file) [-] 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: veget_max_force_x                    !! fraction of maximum vegetation of PFTs in 
+                                                                                    !! each grid cell (read in the forcinng file) 
+                                                                                    !! [-] 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: lai_force_x                          !! Leaf Area Index as read in the forcing file 
+                                                                                    !! [m2/m2] 
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: reinf_slope
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: t2m,t2m_min,temp_sol                 !! 2 m air temperature, min. 2 m air temp. 
+                                                                                    !! during forcing time step and Surface 
+                                                                                    !! temperature [K] 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: soiltemp,soilhum                     !!  Soil temperature and Relative soil moisture
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: humrel_x
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: litterhum                            !! Litter humidity
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: precip_rain,precip_snow              !! Rainfall, Snowfall
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: gpp_x                                !! GPP (gC/(m**2 of total ground)/time step)
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: deadleaf_cover                       !! fraction of soil covered by dead leaves
+  REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE  :: assim_param_x                        !! min/max/opt temperature for photosynthesis 
+                                                                                    !! and vcmax/vjmax parameters 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: height_x                             !! height (m)
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: qsintmax_x                           !! Maximum water on vegetation for interception
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: co2_flux                             !! CO2 flux in gC/m**2 of ground/second
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: fco2_lu                              !! Land Cover Change CO2 flux (gC/m**2 of 
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: temp_growth                          !! Growth temperature - Is equal to t2m_month (Â°C)
+                                                                                    !! average ground/s) 
+  REAL(r_std),DIMENSION (:,:,:),ALLOCATABLE:: soil_mc                               !! soil moisture content \f($m^3 \times m^3$)\f
+  REAL(r_std),DIMENSION (:,:),ALLOCATABLE  :: litter_mc                             !! litter moisture content \f($m^3 \times m^3$)\f
+  REAL(r_std),DIMENSION (:),ALLOCATABLE    :: floodout                              !! flux out of floodplains
+  REAL(r_std),DIMENSION (:),ALLOCATABLE    :: runoff                                !! Complete runoff
+  REAL(r_std),DIMENSION (:),ALLOCATABLE    :: drainage                              !! Drainage
+  REAL(r_std),DIMENSION (:),ALLOCATABLE    :: wat_flux0                             !! Water flux in the first soil layers exported for soil C calculations
+  REAL(r_std),DIMENSION (:,:),ALLOCATABLE  :: wat_flux                              !! Water flux in the soil layers exported for soil C calculations
+  REAL(r_std),DIMENSION (:,:),ALLOCATABLE  :: runoff_per_soil                       !! Runoff per soil type
+  REAL(r_std),DIMENSION (:,:),ALLOCATABLE  :: drainage_per_soil                     !! Drainage per soil type
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: tot_bare_soil                        !! Total evaporating bare soil fraction 
+
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE   :: indices_g                            !! Vector of indeces of land points, only known by root proc
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: x_indices_g                          !! Temporary vector of indeces of land points
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: x_neighbours_g                       !! Indeces of neighbours for each land point
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: DOC_EXP_agg_d                                 !! DOC exports, diffrenet paths (nexp), in  
+                                                                                    !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex  
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)  :: DOC_to_topsoil                       !! Sum of DOC fluxes from irrirgation and reinfiltration 
+                                                                                    !! @tex $(g m^{-2})$ @endtex                                           
+!$OMP THREADPRIVATE(DOC_to_topsoil)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)  :: DOC_to_subsoil                       !! DOC fluxes from returnflow in lakes and swamps 
+                                                                                    !! @tex $(g m^{-2})$ @endtex                                           
+!$OMP THREADPRIVATE(DOC_to_subsoil)  
+  INTEGER                                   :: ier,iret                             !! Return value of functions used to catch 
+                                                                                    !! errors 
+  INTEGER                                   :: ncfid                                !! Id of the restart file of SECHIBA used in 
+                                                                                    !! input 
+  CHARACTER(LEN=20),SAVE                    :: thecalendar='noleap'                 !! Type of calendar used
+  LOGICAL                                   :: a_er                                 !! Flag used to check errors when allocating
+  CHARACTER(LEN=80) :: &                                                            !! Name of the restart files used for
+       dri_restname_in,dri_restname_out, &                                          !! the driver in/out
+       sec_restname_in,sec_restname_out, &                                          !! the sechiba component in/out
+       sto_restname_in,sto_restname_out, &                                          !! the stomate component in/out
+       stom_histname, stom_ipcc_histname                                            !! Name of the history files for stomate 
+                                                                                    !! (standard and ippc format) 
+  INTEGER(i_std)                            :: iim,jjm,llm                          !! # of lon,lat and time-step in the restart 
+                                                                                    !! files 
+  REAL, ALLOCATABLE, DIMENSION(:,:)         :: lon, lat                             !! Arrays of Longitude and latitude (iim,jjm) 
+                                                                                    !! dimension for each processor 
+  REAL, ALLOCATABLE, DIMENSION(:)           :: lev                                  !! height level (required by the restini 
+                                                                                    !! interface) 
+  LOGICAL                                   :: rectilinear                          !! Is the grid rectilinear
+  REAL, ALLOCATABLE, DIMENSION(:)           :: lon_rect, lat_rect                   !! Vectors of Longitude and latitude (iim or 
+                                                                                    !! jjm) dimension used in case of a 
+                                                                                    !! rectilinear grid 
+  REAL(r_std)                               :: dt                                   !! Time step of sechiba component read in the 
+                                                                                    !! restart file [seconds] 
+  INTEGER(i_std)                            :: itau_dep,itau_fin,itau               !! First, last and current time step of SECHIBA 
+                                                                                    !! component 
+  INTEGER(i_std)                            :: itau_len,itau_step                   !! Total length of the simulation and length 
+                                                                                    !! between 2 calls of slowproc (expreseed in 
+                                                                                    !! time steps of SECHIBA component) 
+  REAL(r_std)                               :: date0                                !! Initial date
+  INTEGER(i_std)                            :: rest_id_sec,rest_id_sto              !! ID's of the restart files for the SECHIBA 
+                                                                                    !! and STOMATE components 
+  INTEGER(i_std)                            :: hist_id_sec,hist_id_sec2             !! ID's of the history files of SECHIBA 
+                                                                                    !! component (required by the interface of 
+                                                                                    !! slowproc but not used) 
+  INTEGER(i_std)                            :: hist_id_stom,hist_id_stom_IPCC       !! ID's of the history files of STOMATE 
+                                                                                    !! component 
+  CHARACTER(LEN=30)                         :: time_str                             !! String used for reading the length of 
+                                                                                    !! simulation in the .def file 
+  REAL(r_std)                               :: dt_stomate_loc                             !! 
+  REAL                                      :: hist_days_stom,hist_days_stom_ipcc   !! Time frequency at which variables are 
+                                                                                    !! written in the history file for the STOMATE 
+                                                                                    !! component (standard and ipcc format) [day] 
+  REAL                                      :: hist_dt_stom,hist_dt_stom_ipcc       !! Time frequency at which variables are 
+                                                                                    !! written in the history file for the STOMATE 
+                                                                                    !! component (standard and ipcc format) 
+                                                                                    !! [second] 
+  REAL(r_std), ALLOCATABLE, DIMENSION(:)    :: hist_PFTaxis                         !! Vector with PFT indeces used as axis in the 
+                                                                                    !! history file 
+  REAL(r_std),DIMENSION(10)                 :: hist_pool_10axis                     !! Vector with 10-year indeces used as axis in 
+                                                                                    !! the history file (for land-use change) 
+  REAL(r_std),DIMENSION(100)                :: hist_pool_100axis                    !! Vector with 100-year indeces used as axis in 
+                                                                                    !! the history file (for land-use change) 
+  REAL(r_std),DIMENSION(11)                 :: hist_pool_11axis                     !! Vector with 11-year indeces used as axis in 
+                                                                                    !! the history file (for land-use change) 
+  REAL(r_std),DIMENSION(101)                :: hist_pool_101axis                    !! Vector with 101-year indeces used as axis in 
+                                                                                    !! the history file (for land-use change) 
+  INTEGER                                   :: hist_PFTaxis_id,hist_IPCC_PFTaxis_id !! Id of the axis for PFT in the standard/IPCC 
+                                                                                    !! format 
+  INTEGER                                   :: hist_solax_id                        !! Id of the axis for soil layer in the standard 
+                                                                                    !! format
+  INTEGER                                   :: hori_id 
+  INTEGER                                   :: hist_pool_10axis_id                  !! Id of the axis for 10-year vector
+  INTEGER                                   :: hist_pool_100axis_id                 !! Id of the axis for the 100-year vector
+  INTEGER                                   :: hist_pool_11axis_id                  !! Id of the axis for the 11-year vector
+  INTEGER                                   :: hist_pool_101axis_id                 !! Id of the axis for the 101-year vector
+  INTEGER(i_std)                            :: i,j,iv                               !! used as counters
+  LOGICAL                                   :: ldrestart_read,ldrestart_write       !! Flags to activate reading/writing of the 
+                                                                                    !! restart file 
+  LOGICAL                                   :: l1d                                  !! Are vector elements 1-dimension size ?
+  INTEGER(i_std),PARAMETER                  :: nbvarmax=200                         !! Maximum number of variables assumed in the 
+                                                                                    !! restart file of SECHIBA component used as 
+                                                                                    !! input 
+  INTEGER(i_std)                            :: nbvar                                !! Number of variables present in the restart 
+                                                                                    !! file of SECHIBA component used as input 
+  CHARACTER(LEN=100),DIMENSION(nbvarmax)    :: varnames                             !! Name of the variables present in the restart 
+                                                                                    !! file of SECHIBA component used as input 
+  INTEGER(i_std)                            :: varnbdim                             !! Number of dimensions of a variable 
+                                                                                    !! varnames(i) 
+  INTEGER(i_std),PARAMETER                  :: varnbdim_max=20                      !! Maximum number of dimensions of a variable 
+                                                                                    !! varnames(i) 
+  INTEGER,DIMENSION(varnbdim_max)           :: vardims
+  CHARACTER(LEN=10000)                      :: taboo_vars
+  REAL(r_std),DIMENSION(1)                  :: xtmp
+  INTEGER                                   :: nsfm,nsft
+  INTEGER                                   :: iisf,iiisf
+  INTEGER(i_std)                            :: max_totsize,totsize_1step
+  INTEGER(i_std)                            :: totsize_tmp  
+  INTEGER                                   :: vid
+  CHARACTER(LEN=100)                        :: forcing_name
+  REAL                                      :: x
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: var_3d
+  REAL(r_std)                               :: var_1d(1)
+  REAL(r_std)                               :: time_sec,time_step_sec
+  REAL(r_std)                               :: time_dri,time_step_dri
+  REAL(r_std),DIMENSION(1)                  :: r1d
+  REAL(r_std)                               :: julian,djulian
+
+  INTEGER(i_std)                            :: ji,jv,l
+  INTEGER(i_std)                            :: printlev_loc
+
+!---------------------------------------------------------------------
+
+  !-
+  ! 1. Reading parameters, Allocating variables and Initializations
+  !-
+
+  CALL Init_orchidee_para
+  CALL init_timer
+
+! Set specific write level to forcesoil using PRINTLEV_teststomate=[0-4] in run.def. 
+! The global printlev is used as default value. 
+  printlev_loc=get_printlev('teststomate')
+
+  IF (is_root_prc) THEN
+     !-
+     ! open STOMATE's forcing file to read some basic info
+     !-
+     forcing_name = 'stomate_forcing.nc'
+     CALL getin ('STOMATE_FORCING_NAME',forcing_name)
+     iret = NF90_OPEN (TRIM(forcing_name),NF90_NOWRITE,forcing_id)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'teststomate', &
+             &        'Could not open file : ', &
+             &          forcing_name,'(Did you forget it ?)')
+     ENDIF
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'dt_sechiba',dtradia)
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'dt_stomate',dt_force)
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'nsft',x)
+     nsft = NINT(x)
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'kjpij',x)
+     kjpij = NINT(x)
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'kjpindex',x)
+     nbp_glo = NINT(x)
+  ENDIF
+
+  CALL bcast(dtradia)
+  CALL bcast(dt_force)
+  CALL bcast(nsft)
+  CALL bcast(nbp_glo)
+  !-
+  WRITE(numout,*) 'ATTENTION dtradia=',dtradia,' dt_force=',dt_force
+  ! Coherence test : stop if dtradia not equal dt_force
+  IF (dtradia /= dt_force) CALL ipslerr (3, 'teststomate','dtradia must be equal to dt_force','','')
+
+  ! Archive the sechiba time step in constantes_var module
+  dt_sechiba=dtradia
+
+  !-
+  ! read info about land points
+  !-
+  IF (is_root_prc) THEN
+     ALLOCATE (indices_g(nbp_glo),stat=ier)
+     IF (ier /= 0) THEN
+        CALL ipslerr (3,'teststomate', &
+             'PROBLEM WITH ALLOCATION', &
+             'for local variable indices_g','')
+     ENDIF
+     !
+     ALLOCATE (x_indices_g(nbp_glo),stat=ier)
+     IF (ier /= 0) THEN
+        CALL ipslerr (3,'teststomate', &
+             'PROBLEM WITH ALLOCATION', &
+             'for global variable x_indices_g','')
+     ENDIF
+
+     ier = NF90_INQ_VARID (forcing_id,'index',vid)
+     IF (ier /= NF90_NOERR) THEN
+        CALL ipslerr (3,'teststomate', &
+             'PROBLEM WITH READING VARIABLE ID', &
+             'for global variable index','')
+     ENDIF
+     ier = NF90_GET_VAR   (forcing_id,vid,x_indices_g)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'teststomate', &
+             'PROBLEM WITH variable "index" in file ', &
+             forcing_name,'(check this file)')
+     ENDIF
+     indices_g(:) = NINT(x_indices_g(:))
+     DEALLOCATE (x_indices_g)
+  ENDIF
+
+!---------------------------------------------------------------------
+!-
+  !-
+  ! activate CO2, STOMATE, but not sechiba
+  !-
+  river_routing = .FALSE.
+  hydrol_cwrr = .FALSE.
+  ok_sechiba = .FALSE.
+  ok_co2 = .TRUE.
+  ok_stomate = .TRUE.
+
+  ! Deactivate writing of stomate_forcing.nc file
+  allow_forcing_write=.FALSE.
+
+  !-
+  ! is DGVM activated?
+  !-
+  ok_dgvm = .FALSE.
+  CALL getin_p('STOMATE_OK_DGVM',ok_dgvm)
+  WRITE(numout,*) 'LPJ is activated: ',ok_dgvm
+
+  ! Initialize parameter for off-line use : no coupling to atmospheric model
+  OFF_LINE_MODE=.TRUE.
+!-
+! Configuration
+!-
+  ! 1. Number of PFTs defined by the user
+
+  !Config Key   = NVM
+  !Config Desc  = number of PFTs  
+  !Config If    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = 13
+  !Config Help  = The number of vegetation types define by the user
+  !Config Units = [-]
+  !
+  CALL getin_p('NVM',nvm)
+  WRITE(numout,*)'the number of pfts is : ', nvm
+
+  ! 2. Should we read the parameters in the run.def file ?
+  
+  !Config Key   = IMPOSE_PARAM
+  !Config Desc  = Do you impose the values of the parameters?
+  !Config if    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = y
+  !Config Help  = This flag can deactivate the reading of some parameters.
+  !Config         Useful if you want to use the standard values without commenting the run.def
+  !Config Units = [FLAG]
+  !
+  CALL getin_p('IMPOSE_PARAM',impose_param)
+
+  ! 3. Allocate and intialize the pft parameters
+
+  CALL pft_parameters_main()
+
+  ! 4. Activation sub-models of ORCHIDEE
+
+  CALL activate_sub_models()
+
+  ! 5. Vegetation configuration (impose_veg, land_use, lcchange...previously in slowproc)
+
+  CALL veget_config
+
+  ! 6. Read the parameters in the run.def file
+
+  IF (impose_param) THEN
+     CALL config_pft_parameters
+     CALL config_stomate_pft_parameters
+     CALL config_co2_parameters
+     CALL config_stomate_parameters
+  ENDIF
+  !-
+  IF (ok_dgvm) THEN
+     IF ( impose_param ) THEN
+        CALL config_dgvm_parameters
+     ENDIF
+  ENDIF
+!-
+  !-
+  ! restart files
+  !-
+  IF (is_root_prc) THEN
+     ! Sechiba's restart files
+     sec_restname_in = 'sechiba_start.nc'
+     CALL getin('SECHIBA_restart_in',sec_restname_in)
+     WRITE(numout,*) 'SECHIBA INPUT RESTART_FILE: ',TRIM(sec_restname_in)
+     IF ( TRIM(sec_restname_in) .EQ. 'NONE' ) THEN
+        STOP 'Need a restart file for Sechiba'
+     ENDIF
+     sec_restname_out = 'sechiba_rest_out.nc'
+     CALL getin('SECHIBA_rest_out',sec_restname_out)
+     WRITE(numout,*) 'SECHIBA OUTPUT RESTART_FILE: ',TRIM(sec_restname_out)
+     ! Stomate's restart files
+     sto_restname_in = 'stomate_start.nc'
+     CALL getin('STOMATE_RESTART_FILEIN',sto_restname_in)
+     WRITE(numout,*) 'STOMATE INPUT RESTART_FILE: ',TRIM(sto_restname_in)
+     sto_restname_out = 'stomate_rest_out.nc'
+     CALL getin('STOMATE_RESTART_FILEOUT',sto_restname_out)
+     WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out)
+
+     !-
+     ! We need to know iim, jjm.
+     ! Get them from the restart files themselves.
+     !-
+     iret = NF90_OPEN (sec_restname_in,NF90_NOWRITE,ncfid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'teststomate', &
+             &        'Could not open file : ', &
+             &          sec_restname_in,'(Do you have forget it ?)')
+     ENDIF
+     iret = NF90_INQUIRE_DIMENSION (ncfid,1,len=iim_g)
+     iret = NF90_INQUIRE_DIMENSION (ncfid,2,len=jjm_g)
+     iret = NF90_INQ_VARID (ncfid, "time", iv)
+     iret = NF90_GET_ATT (ncfid, iv, 'calendar',thecalendar)
+     iret = NF90_CLOSE (ncfid)
+     i=INDEX(thecalendar,ACHAR(0))
+     IF ( i > 0 ) THEN
+        thecalendar(i:20)=' '
+     ENDIF
+  ENDIF
+  CALL bcast(iim_g)
+  CALL bcast(jjm_g)
+  CALL bcast(thecalendar)
+  !-
+  ! calendar
+  !-
+  CALL ioconf_calendar (thecalendar)
+  CALL ioget_calendar  (one_year,one_day)
+  !
+  ! Parallelization :
+  !
+!  CALL init_data_para(iim_g,jjm_g,nbp_glo,indices_g)
+  CALL set_grid_glo(iim_g,jjm_g,nbp_glo)
+  CALL allocate_grid_glo
+
+  ! Initialize index_g needed for module grid
+  ! index_g is declared in mod_orchidee_para and allocated by allocate_grid_glo
+  ! index_g and indices_g are the same but indeces_g only declared on root proc. 
+  IF (is_root_prc) THEN
+     index_g(:)=indices_g(:)
+     ! Only use index_g from now and on => Deallocate indices_g.
+     DEALLOCATE(indices_g)
+  END IF
+  CALL bcast(index_g)
+
+  CALL init_orchidee_data_para_driver(nbp_glo, index_g)
+  kjpindex=nbp_loc
+  jjm=jj_nb
+  iim=iim_g
+  kjpij=iim*jjm
+  IF (printlev_loc>=3) WRITE(numout,*) "Local grid : ",kjpindex,iim,jjm
+  !-
+  !-
+  ! read info about grids
+  !-
+  !-
+  llm=1
+  ALLOCATE(lev(llm))
+  IF (is_root_prc) THEN
+     !-
+     ier = NF90_INQ_VARID (forcing_id,'lalo',vid)
+     ier = NF90_GET_VAR   (forcing_id,vid,lalo_g)
+     !-
+     ALLOCATE (x_neighbours_g(nbp_glo,8),stat=ier)
+     ier = NF90_INQ_VARID (forcing_id,'neighbours',vid)
+     ier = NF90_GET_VAR   (forcing_id,vid,x_neighbours_g)
+     neighbours_g(:,:) = NINT(x_neighbours_g(:,:))
+     DEALLOCATE (x_neighbours_g)
+     !-
+     ier = NF90_INQ_VARID (forcing_id,'resolution',vid)
+     ier = NF90_GET_VAR   (forcing_id,vid,resolution_g)
+     !-
+     ier = NF90_INQ_VARID (forcing_id,'contfrac',vid)
+     ier = NF90_GET_VAR   (forcing_id,vid,contfrac_g)
+
+     lon_g(:,:) = zero
+     lat_g(:,:) = zero
+     lev(1)   = zero
+     !-
+     CALL restini &
+          & (sec_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
+          &  sec_restname_out, itau_dep, date0, dt, rest_id_sec)
+     !-
+     IF ( dt .NE. dtradia ) THEN
+        WRITE(numout,*) 'dt',dt
+        WRITE(numout,*) 'dtradia',dtradia
+        CALL ipslerr (3,'teststomate', &
+             &        'PROBLEM with time steps.', &
+             &          sec_restname_in,'(dt .NE. dtradia)')
+     ENDIF
+     !-
+     CALL restini &
+          & (sto_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
+          &  sto_restname_out, itau_dep, date0, dt, rest_id_sto)
+     !-
+     IF ( dt .NE. dtradia ) THEN
+        WRITE(numout,*) 'dt',dt
+        WRITE(numout,*) 'dtradia',dtradia
+        CALL ipslerr (3,'teststomate', &
+             &        'PROBLEM with time steps.', &
+             &          sto_restname_in,'(dt .NE. dtradia)')
+     ENDIF
+  ENDIF
+  CALL bcast(rest_id_sec)
+  CALL bcast(rest_id_sto)
+  CALL bcast(itau_dep)
+  CALL bcast(date0)
+  CALL bcast(dt)
+  CALL bcast(lev)
+  !---
+  !--- Create the index table
+  !---
+  !--- This job return a LOCAL kindex
+  !---
+  ALLOCATE (indices(kjpindex),stat=ier)
+  IF (printlev_loc>=3 .AND. is_root_prc) WRITE(numout,*) "index_g = ",index_g(1:nbp_glo)
+  CALL scatter(index_g,indices)
+  indices(1:kjpindex)=indices(1:kjpindex)-(jj_begin-1)*iim_g
+  IF (printlev_loc>=3) WRITE(numout,*) "indices = ",indices(1:kjpindex)
+
+  !---
+  !--- initialize global grid
+  !---
+  CALL init_grid( kjpindex ) 
+  CALL grid_stuff (nbp_glo, iim_g, jjm_g, lon_g, lat_g, index_g)
+
+  !---
+  !--- initialize local grid
+  !---
+  jlandindex = (((indices(1:kjpindex)-1)/iim) + 1)
+  if (printlev_loc>=3) WRITE(numout,*) "jlandindex = ",jlandindex(1:kjpindex)
+  ilandindex = (indices(1:kjpindex) - (jlandindex(1:kjpindex)-1)*iim)
+  IF (printlev_loc>=3) WRITE(numout,*) "ilandindex = ",ilandindex(1:kjpindex)
+  ALLOCATE(lon(iim,jjm))
+  ALLOCATE(lat(iim,jjm))
+  lon=zero
+  lat=zero
+  CALL scatter2D_mpi(lon_g,lon)
+  CALL scatter2D_mpi(lat_g,lat)
+
+  DO ji=1,kjpindex
+
+     j = jlandindex(ji)
+     i = ilandindex(ji)
+
+     !- Create the internal coordinate table
+!-
+     lalo(ji,1) = lat(i,j)
+     lalo(ji,2) = lon(i,j)
+  ENDDO
+  CALL scatter(neighbours_g,neighbours)
+  CALL scatter(resolution_g,resolution)
+  CALL scatter(contfrac_g,contfrac)
+  CALL scatter(area_g,area)
+  !-
+  !- Check if we have by any chance a rectilinear grid. This would allow us to 
+  !- simplify the output files.
+  !
+  rectilinear = .FALSE.
+  IF (is_root_prc) THEN
+     IF ( ALL(lon_g(:,:) == SPREAD(lon_g(:,1), 2, SIZE(lon_g,2))) .AND. &
+       & ALL(lat_g(:,:) == SPREAD(lat_g(1,:), 1, SIZE(lat_g,1))) ) THEN
+        rectilinear = .TRUE.
+     ENDIF
+  ENDIF
+  CALL bcast(rectilinear)
+  IF (rectilinear) THEN
+     ALLOCATE(lon_rect(iim),stat=ier)
+     IF (ier .NE. 0) THEN
+        WRITE (numout,*) ' error in lon_rect allocation. We stop. We need iim words = ',iim
+        STOP 'intersurf_history'
+     ENDIF
+     ALLOCATE(lat_rect(jjm),stat=ier)
+     IF (ier .NE. 0) THEN
+        WRITE (numout,*) ' error in lat_rect allocation. We stop. We need jjm words = ',jjm
+        STOP 'intersurf_history'
+     ENDIF
+     lon_rect(:) = lon(:,1)
+     lat_rect(:) = lat(1,:)
+  ENDIF
+  !-
+  ! allocate arrays
+  !-
+  !
+  a_er = .FALSE.
+  ALLOCATE (hist_PFTaxis(nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (indexveg(kjpindex*nvm), stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (soiltile(kjpindex,nstm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (veget_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (totfrac_nobio(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (frac_nobio(kjpindex,nnobio),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (veget_max_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (lai_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (veget_force_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (veget_max_force_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (njsc(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (lai_force_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (reinf_slope(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (t2m(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (t2m_min(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (temp_sol(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (soiltemp(kjpindex,nbdl),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (soilhum(kjpindex,nbdl),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (humrel_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (litterhum(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (precip_rain(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (precip_snow(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (gpp_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (deadleaf_cover(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (assim_param_x(kjpindex,nvm,npco2),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (height_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (qsintmax_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (co2_flux(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (fco2_lu(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (temp_growth(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (tot_bare_soil(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (frac_age_x(kjpindex,nvm,nleafages),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (floodout(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (drainage(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (runoff(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (drainage_per_soil(kjpindex,nstm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (runoff_per_soil(kjpindex,nstm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (DOC_EXP_agg_d(kjpindex,nexp),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (DOC_to_topsoil(kjpindex,nelements),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (DOC_to_subsoil(kjpindex,nelements),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (wat_flux0(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (wat_flux(kjpindex,nbdl),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (soil_mc(kjpindex,nbdl,nstm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (litter_mc(kjpindex,nstm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+
+  IF (a_er) THEN
+     CALL ipslerr (3,'teststomate', &
+          &        'PROBLEM WITH ALLOCATION', &
+          &        'for local variables 1','')
+  ENDIF
+  !
+  ! prepare forcing
+  ! forcing file of STOMATE is read by block 
+  ! in order to minimize the reading frequency
+  ! Here is done the calculation of the number 
+  ! of time steps we load in memory 
+  !
+  max_totsize = 50
+  CALL getin_p ('STOMATE_FORCING_MEMSIZE',max_totsize)
+  max_totsize = max_totsize * 1000000
+
+  totsize_1step = SIZE(soiltile(:,3))*KIND(soiltile(:,3)) + &
+       SIZE(humrel_x)*KIND(humrel_x) + &
+       SIZE(litterhum)*KIND(litterhum) + &
+       SIZE(t2m)*KIND(t2m) + &
+       SIZE(t2m_min)*KIND(t2m_min) + &
+       SIZE(temp_sol)*KIND(temp_sol) + &
+       SIZE(soiltemp)*KIND(soiltemp) + &
+       SIZE(soilhum)*KIND(soilhum) + &
+       SIZE(precip_rain)*KIND(precip_rain) + &
+       SIZE(precip_snow)*KIND(precip_snow) + &
+       SIZE(gpp_x)*KIND(gpp_x) + &
+       SIZE(veget_force_x)*KIND(veget_force_x) + &
+       SIZE(veget_max_force_x)*KIND(veget_max_force_x) + &
+       SIZE(lai_force_x)*KIND(lai_force_x)
+  CALL reduce_sum(totsize_1step,totsize_tmp)
+  CALL bcast(totsize_tmp)
+  totsize_1step=totsize_tmp 
+
+  ! check for consistency of the total number of forcing steps
+  IF ( nsft .NE. INT(one_year/(dt_force/one_day)) ) THEN
+     CALL ipslerr_p (3,'teststomate', &
+          &        'stomate: error with total number of forcing steps', &
+          &        'nsft','teststomate computation different with forcing file value.')
+  ENDIF
+  ! number of forcing steps in memory
+  nsfm = MIN(nsft, &
+       &       MAX(1,NINT( REAL(max_totsize,r_std) &
+       &                  /REAL(totsize_1step,r_std))))
+  !-
+  WRITE(numout,*) 'Offline forcing of Stomate:'
+  WRITE(numout,*) '  Total number of forcing steps:',nsft
+  WRITE(numout,*) '  Number of forcing steps in memory:',nsfm
+  !-
+  ! init_forcing defined into stomate.f90
+  ! allocate and set to zero driving variables of STOMATE
+  ! ie variables that are read in the forcing file
+  !-
+  CALL init_forcing(kjpindex,nsfm,nsft)
+  !-
+  ! ensure that we read all new forcing states
+  iisf = nsfm
+  ! initialize the table that contains the indices
+  ! of the forcing states that will be in memory
+  isf(:) = (/ (i,i=1,nsfm) /)
+
+  nf_written(:) = .FALSE.
+  nf_written(isf(:)) = .TRUE.
+
+  !-
+  ! a time step for STOMATE corresponds to itau_step timesteps in SECHIBA
+  !-
+  itau_step = NINT(dt_force/dtradia)
+  IF (printlev_loc>=3) WRITE(numout,*) "dtradia, dt_rest, dt_force, itau_step",dtradia, dt, dt_force, itau_step
+  !
+  CALL ioconf_startdate(date0)
+  CALL intsurf_time( itau_dep, date0 )
+  !-
+  ! Length of integration
+  !-
+  WRITE(time_str,'(a)') '1Y'
+  CALL getin_p ('TIME_LENGTH', time_str)
+  ! transform into itau
+  CALL tlen2itau(time_str, dt, date0, itau_len)
+  ! itau_len*dtradia must be a multiple of dt_force
+  itau_len = NINT( MAX(1.,FLOAT(NINT(itau_len*dtradia/dt_force))) &
+       &                *dt_force/dtradia)
+  !-
+  itau_fin = itau_dep+itau_len
+  !-
+  ! 2. set up STOMATE history file
+  !
+  ! Initialize ioipsl_para module
+  CALL  init_ioipsl_para
+
+  !-
+  !Config Key   = STOMATE_OUTPUT_FILE
+  !Config Desc  = Name of file in which STOMATE's output is going to be written
+  !Config If    = 
+  !Config Def   = stomate_history.nc
+  !Config Help  = This file is going to be created by the model
+  !Config         and will contain the output from the model.
+  !Config         This file is a truly COADS compliant netCDF file.
+  !Config         It will be generated by the hist software from
+  !Config         the IOIPSL package.
+  !Config Units = FILE
+  !-
+  stom_histname='stomate_history.nc'
+  CALL getin_p ('STOMATE_OUTPUT_FILE', stom_histname)
+  WRITE(numout,*) 'STOMATE_OUTPUT_FILE', TRIM(stom_histname)
+  !-
+  !Config Key   = STOMATE_HIST_DT
+  !Config Desc  = STOMATE history time step 
+  !Config If    = 
+  !Config Def   = 10.
+  !Config Help  = Time step of the STOMATE history file
+  !Config Units = days [d]
+  !-
+  hist_days_stom = 10.
+  CALL getin_p ('STOMATE_HIST_DT', hist_days_stom)
+  IF ( hist_days_stom == -1. ) THEN
+     hist_dt_stom = -1.
+     WRITE(numout,*) 'output frequency for STOMATE history file (d): one month.'
+  ELSE
+     hist_dt_stom = NINT( hist_days_stom ) * one_day
+     WRITE(numout,*) 'output frequency for STOMATE history file (d): ', &
+             hist_dt_stom/one_day
+  ENDIF
+  !-
+  !- initialize
+  WRITE(numout,*) "before histbeg : ",date0,dt
+  IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+     CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+          &     itau_dep, date0, dt, hori_id, hist_id_stom, domain_id=orch_domain_id)
+#else
+     CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+          &     itau_dep, date0, dt, hori_id, hist_id_stom)
+#endif
+  ELSE
+#ifdef CPP_PARA
+     CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+          &     itau_dep, date0, dt, hori_id, hist_id_stom, domain_id=orch_domain_id)
+#else
+     CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+          &     itau_dep, date0, dt, hori_id, hist_id_stom)
+#endif
+  ENDIF
+  !- define PFT axis
+  hist_PFTaxis = (/ ( REAL(i,r_std), i=1,nvm ) /)
+  !- declare this axis
+  CALL histvert (hist_id_stom, 'PFT', 'Plant functional type', &
+       & '1', nvm, hist_PFTaxis, hist_PFTaxis_id)
+!- define Pool_10 axis
+   hist_pool_10axis = (/ ( REAL(i,r_std), i=1,10 ) /)
+!- declare this axis
+  CALL histvert (hist_id_stom, 'P10', 'Pool 10 years', &
+       & '1', 10, hist_pool_10axis, hist_pool_10axis_id)
+
+!- define Pool_100 axis
+   hist_pool_100axis = (/ ( REAL(i,r_std), i=1,100 ) /)
+!- declare this axis
+  CALL histvert (hist_id_stom, 'P100', 'Pool 100 years', &
+       & '1', 100, hist_pool_100axis, hist_pool_100axis_id)
+
+!- define Pool_11 axis
+   hist_pool_11axis = (/ ( REAL(i,r_std), i=1,11 ) /)
+!- declare this axis
+  CALL histvert (hist_id_stom, 'P11', 'Pool 10 years + 1', &
+       & '1', 11, hist_pool_11axis, hist_pool_11axis_id)
+
+!- define Pool_101 axis
+   hist_pool_101axis = (/ ( REAL(i,r_std), i=1,101 ) /)
+!- declare this axis
+  CALL histvert (hist_id_stom, 'P101', 'Pool 100 years + 1', &
+       & '1', 101, hist_pool_101axis, hist_pool_101axis_id)
+
+  !- define STOMATE history file
+  CALL ioipslctrl_histstom (hist_id_stom, nvm, iim, jjm, &
+       & dt, hist_dt_stom, hori_id, hist_PFTaxis_id, &
+ & hist_pool_10axis_id, hist_pool_100axis_id, &
+ & hist_pool_11axis_id, hist_pool_101axis_id, &
+ & hist_solax_id)
+
+
+
+  !- end definition
+  CALL histend(hist_id_stom)
+  !-
+  !-
+  ! STOMATE IPCC OUTPUTS IS ACTIVATED
+  !-
+  !Config Key   = STOMATE_IPCC_OUTPUT_FILE
+  !Config Desc  = Name of file in which STOMATE's output is going to be written
+  !Config If    = 
+  !Config Def   = stomate_ipcc_history.nc
+  !Config Help  = This file is going to be created by the model
+  !Config         and will contain the output from the model.
+  !Config         This file is a truly COADS compliant netCDF file.
+  !Config         It will be generated by the hist software from
+  !Config         the IOIPSL package.
+  !Config Units = FILE
+  !-
+  stom_ipcc_histname='stomate_ipcc_history.nc'
+  CALL getin_p('STOMATE_IPCC_OUTPUT_FILE', stom_ipcc_histname)       
+  WRITE(numout,*) 'STOMATE_IPCC_OUTPUT_FILE', TRIM(stom_ipcc_histname)
+  !-
+  !Config Key   = STOMATE_IPCC_HIST_DT
+  !Config Desc  = STOMATE IPCC history time step 
+  !Config If    = 
+  !Config Def   = 0.
+  !Config Help  = Time step of the STOMATE IPCC history file
+  !Config Units = days [d]
+  !-
+  hist_days_stom_ipcc = zero
+  CALL getin_p('STOMATE_IPCC_HIST_DT', hist_days_stom_ipcc)       
+  IF ( hist_days_stom_ipcc == moins_un ) THEN
+     hist_dt_stom_ipcc = moins_un
+     WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): one month.'
+  ELSE
+     hist_dt_stom_ipcc = NINT( hist_days_stom_ipcc ) * one_day
+     WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): ', &
+          hist_dt_stom_ipcc/one_day
+  ENDIF
+
+  ! test consistency between STOMATE_IPCC_HIST_DT and DT_STOMATE parameters
+  dt_stomate_loc = one_day
+  CALL getin_p('DT_STOMATE', dt_stomate_loc)
+  IF ( hist_days_stom_ipcc > zero ) THEN
+     IF (dt_stomate_loc > hist_dt_stom_ipcc) THEN
+        WRITE(numout,*) "DT_STOMATE = ",dt_stomate_loc,"  , STOMATE_IPCC_HIST_DT = ",hist_dt_stom_ipcc
+        CALL ipslerr_p (3,'intsurf_history', &
+             &          'Problem with DT_STOMATE > STOMATE_IPCC_HIST_DT','', &
+             &          '(must be less or equal)')
+     ENDIF
+  ENDIF
+
+  IF ( hist_dt_stom_ipcc == 0 ) THEN
+     hist_id_stom_ipcc = -1
+  ELSE
+     !-
+     !- initialize
+     IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+        CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
+#else
+        CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc)
+#endif
+     ELSE
+#ifdef CPP_PARA
+        CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
+#else
+        CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc)
+#endif
+     ENDIF
+     !- declare this axis
+     CALL histvert (hist_id_stom_IPCC, 'PFT', 'Plant functional type', &
+          & '1', nvm, hist_PFTaxis, hist_IPCC_PFTaxis_id)
+
+     !- define STOMATE history file
+     CALL ioipslctrl_histstomipcc(hist_id_stom_IPCC, nvm, iim, jjm, &
+          & dt, hist_dt_stom_ipcc, hori_id, hist_IPCC_PFTaxis_id)
+
+     !- end definition
+     CALL histend(hist_id_stom_IPCC)
+
+  ENDIF
+  !
+  CALL histwrite_p(hist_id_stom, 'Areas',  itau_dep+itau_step, area, kjpindex, indices)
+  IF ( hist_id_stom_IPCC > 0 ) THEN
+     CALL histwrite_p(hist_id_stom_IPCC, 'Areas',  itau_dep+itau_step, area, kjpindex, indices)
+  ENDIF
+  !
+  hist_id_sec = -1
+  hist_id_sec2 = -1
+  !-
+  ! 3. first call of slowproc to initialize variables
+  !-
+  itau = itau_dep
+  !  
+  DO ji=1,kjpindex
+     DO jv=1,nvm
+        indexveg((jv-1)*kjpindex + ji) = indices(ji) + (jv-1)*kjpij
+     ENDDO
+  ENDDO
+  !-
+  !
+  !Config key   = HYDROL_CWRR
+  !Config Desc  = Allows to switch on the multilayer hydrology of CWRR
+  !Config If    = OK_SECHIBA
+  !Config Def   = n
+  !Config Help  = This flag allows the user to decide if the vertical
+  !Config         hydrology should be treated using the multi-layer 
+  !Config         diffusion scheme adapted from CWRR by Patricia de Rosnay.
+  !Config         by default the Choisnel hydrology is used.
+  !Config Units = [FLAG]
+  CALL getin_p ("DEPTH_MAX_H", zmaxh)
+  !
+  !MM Problem here with dpu which depends on soil type           
+  DO l = 1, nbdl-1
+     ! first 2.0 is dpu 
+     ! second 2.0 is average
+     diaglev(l) = zmaxh/(2**(nbdl-1) -1) * ( ( 2**(l-1) -1) + ( 2**(l) -1) ) / 2.0
+  ENDDO
+  diaglev(nbdl) = zmaxh
+  !
+!-
+! Read the parameters in the "*.def" files
+!-
+  !
+  !Config Key   = CLAYFRACTION_DEFAULT
+  !Config Desc  = 
+  !Config If    = OK_SECHIBA 
+  !Config Def   = 0.2 
+  !Config Help  = 
+  !Config Units = [-]
+  CALL getin_p('CLAYFRACTION_DEFAULT',clayfraction_default)
+  !
+  !Config Key   = MIN_VEGFRAC 
+  !Config Desc  = Minimal fraction of mesh a vegetation type can occupy 
+  !Config If    = OK_SECHIBA 
+  !Config Def   = 0.001 
+  !Config Help  = 
+  !Config Units = [-]
+  CALL getin_p('MIN_VEGFRAC',min_vegfrac)
+  !
+  !Config Key   = STEMPDIAG_BID 
+  !Config Desc  = only needed for an initial LAI if there is no restart file
+  !Config If    = OK_SECHIBA 
+  !Config Def   = 280.
+  !Config Help  = 
+  !Config Units = [K]
+  CALL getin_p('STEMPDIAG_BID',stempdiag_bid)
+  !
+!-
+  CALL ioget_expval(val_exp)
+  ldrestart_read = .TRUE.
+  ldrestart_write = .FALSE.
+  !-
+  ! read some variables we need from SECHIBA's restart file
+  !-
+  CALL slowproc_initialize (itau,        kjpij,       kjpindex,       date0,             &
+                            rest_id_sec, rest_id_sto, hist_id_stom,   hist_id_stom_IPCC, &
+                            indices,     indexveg,    lalo,           neighbours,        &
+                            resolution,  contfrac,    t2m,                               &
+                            soiltile,    reinf_slope, deadleaf_cover, assim_param_x,     &
+                            lai_x,       frac_age_x,  height_x,       veget_x,           &
+                            frac_nobio,  njsc,        veget_max_x,    tot_bare_soil,     &
+                            totfrac_nobio, qsintmax_x, co2_flux,      fco2_lu, temp_growth)
+
+!  Old interface to slowproc_main, before revision 2581
+!  CALL slowproc_main &
+! &  (itau, kjpij, kjpindex, dt_force, date0, &
+! &   ldrestart_read, ldrestart_write, &
+! &   indices, indexveg, lalo, neighbours, resolution, contfrac, soiltile, reinf_slope, &
+! &   t2m, t2m_min, temp_sol, soiltemp, &
+! &   humrel_x, soilhum, litterhum, precip_rain, precip_snow, gpp_x, &
+! &   deadleaf_cover, assim_param_x, lai_x, frac_age_x, height_x, veget_x, &
+! &   frac_nobio, njsc, veget_max_x, totfrac_nobio, qsintmax_x, &
+! &   rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu, temp_growth)
+  ! correct date
+
+
+  date=1
+
+  CALL intsurf_time( itau_dep+itau_step, date0 )
+  l_first_intersurf=.FALSE.
+  !-
+  ! 4. Time loop
+  !â»
+  DO itau = itau_dep+itau_step,itau_fin,itau_step
+    !
+    CALL intsurf_time( itau, date0 )
+    !-
+    ! next forcing state
+    iisf = iisf+1
+    IF (printlev_loc>=3) WRITE(numout,*) "itau,iisf : ",itau,iisf
+    !---
+    IF (iisf .GT. nsfm) THEN
+!-----
+!---- we have to read new forcing states from the file
+!-----
+!---- determine blocks of forcing states that are contiguous in memory
+!-----
+        CALL stomate_forcing_read(forcing_id,nsfm)
+
+!--------------------------
+
+!-----
+!---- determine which forcing states must be read next time
+!-----
+      isf(1) = isf(nsfm)+1
+      IF ( isf(1) .GT. nsft ) isf(1) = 1
+        DO iiisf = 2, nsfm
+           isf(iiisf) = isf(iiisf-1)+1
+           IF ( isf(iiisf) .GT. nsft ) isf(iiisf) = 1
+        ENDDO
+        nf_written(isf(:)) = .TRUE.
+!---- start again at first forcing state
+        iisf = 1
+     ENDIF
+     humrel_x(:,:) = humrel_daily_fm(:,:,iisf)
+     litterhum(:) = litterhum_daily_fm(:,iisf)
+     t2m(:) = t2m_daily_fm(:,iisf)
+     t2m_min(:) = t2m_min_daily_fm(:,iisf)
+     temp_sol(:) = tsurf_daily_fm(:,iisf)
+     soiltemp(:,:) = tsoil_daily_fm(:,:,iisf)
+     soilhum(:,:) = soilhum_daily_fm(:,:,iisf)
+     precip_rain(:) = precip_fm(:,iisf)
+     gpp_x(:,:) = gpp_daily_fm(:,:,iisf)
+     veget_force_x(:,:) = veget_fm(:,:,iisf)
+     veget_max_force_x(:,:) = veget_max_fm(:,:,iisf)
+     lai_force_x(:,:) = lai_fm(:,:,iisf)
+     WHERE ( t2m(:) .LT. ZeroCelsius )
+        precip_snow(:) = precip_rain(:)
+        precip_rain(:) = zero
+     ELSEWHERE
+        precip_snow(:) = zero
+     ENDWHERE
+!---
+!-- scale GPP to new lai and veget_max
+!---
+     WHERE ( lai_x(:,:) .EQ. zero ) gpp_x(:,:) = zero
+!-- scale GPP to new LAI
+     WHERE (lai_force_x(:,:) .GT. zero )
+        gpp_x(:,:) = gpp_x(:,:)*ATAN(2.*lai_x(:,:)) &
+ &                           /ATAN( 2.*MAX(lai_force_x(:,:),0.01))
+    ENDWHERE
+    !- scale GPP to new veget_max
+    WHERE (veget_max_force_x(:,:) .GT. zero )
+        gpp_x(:,:) = gpp_x(:,:)*veget_max_x(:,:)/veget_max_force_x(:,:)
+    ENDWHERE
+    !-
+    !- number crunching
+    !-
+     ldrestart_read = .FALSE.
+     ldrestart_write = .FALSE.
+     CALL slowproc_main &
+ &    (itau, kjpij, kjpindex, date0, &
+ &     indices, indexveg, lalo, neighbours, resolution, contfrac, soiltile, &
+ &     t2m, t2m_min, temp_sol, soiltemp, &
+ &     humrel_x, soilhum, litterhum, precip_rain, precip_snow, gpp_x, &
+ &     deadleaf_cover, assim_param_x, lai_x, frac_age_x, height_x, veget_x, &
+ &     frac_nobio, njsc, veget_max_x, totfrac_nobio, qsintmax_x, &
+ &     rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, &
+ &     co2_flux, fco2_lu, temp_growth, tot_bare_soil, &
+ &     soil_mc, litter_mc,floodout, runoff, drainage, wat_flux0, wat_flux,&
+ &     drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, DOC_to_topsoil, DOC_to_subsoil)
+
+  ENDDO ! end of the time loop
+
+
+!-
+! 5. write restart files
+!-
+  IF (is_root_prc) THEN
+! first, read and write variables that are not managed otherwise
+     taboo_vars = &
+          &  '$lat$ $lon$ $lev$ $veget_year$ '// &
+          &  '$height$ $veget$ $veget_max$ $frac_nobio$ '// &
+          &  '$lai$ $soiltile_frac$ $clay_frac$ '// &
+          &  '$nav_lon$ $nav_lat$ $nav_lev$ $time$ $time_steps$'
+!-
+     CALL ioget_vname(rest_id_sec, nbvar, varnames)
+!-
+     DO iv = 1, nbvar
+!-- check if the variable is to be written here
+        IF (INDEX( taboo_vars,'$'//TRIM(varnames(iv))//'$') .EQ. 0 ) THEN
+           IF (printlev_loc>=3) WRITE(numout,*) "restart var : ",TRIM(varnames(iv)),itau_dep,itau_fin
+
+!---- get variable dimensions, especially 3rd dimension
+           CALL ioget_vdim &
+                &      (rest_id_sec, varnames(iv), varnbdim_max, varnbdim, vardims)
+           l1d = ALL(vardims(1:varnbdim) .EQ. 1)
+!---- read it
+           IF (l1d) THEN
+              CALL restget (rest_id_sec,TRIM(varnames(iv)), &
+                   1,1,1,itau_dep,.TRUE.,var_1d)
+           ELSE
+              ALLOCATE(var_3d(nbp_glo,vardims(3)),stat=ier)
+              IF (ier .NE. 0) STOP 'ALLOCATION PROBLEM'
+              CALL restget (rest_id_sec,TRIM(varnames(iv)), &
+                   nbp_glo,vardims(3),1,itau_dep,.TRUE.,var_3d, &
+                   "gather",nbp_glo,index_g)
+           ENDIF
+!---- write it
+           IF (l1d) THEN
+              CALL restput (rest_id_sec,TRIM(varnames(iv)), &
+                   1,1,1,itau_fin,var_1d)
+           ELSE
+              CALL restput (rest_id_sec,TRIM(varnames(iv)), &
+                   nbp_glo,vardims(3),1,itau_fin,var_3d, &
+                   'scatter',nbp_glo,index_g)
+              DEALLOCATE (var_3d)
+           ENDIF
+        ENDIF
+     ENDDO
+  ENDIF
+  CALL barrier_para()
+
+! call slowproc to write restart files
+  ldrestart_read = .FALSE.
+  ldrestart_write = .TRUE.
+!-
+  IF (printlev_loc>=3) WRITE(numout,*) "Call slowproc for restart."
+       CALL slowproc_finalize (itau_fin,   kjpindex,    rest_id_sec, indices,    &
+                               njsc,       lai_x,       height_x,    veget_x,    &
+                               frac_nobio, veget_max_x, reinf_slope,             &
+                               assim_param_x, frac_age_x, soiltile )
+!!$  CALL slowproc_main &
+!!$ &  (itau_fin, kjpij, kjpindex, dt_force, date0, &
+!!$ &   ldrestart_read, ldrestart_write, &
+!!$ &   indices, indexveg, lalo, neighbours, resolution, contfrac, soiltile, reinf_slope, &
+!!$ &   t2m, t2m_min, temp_sol, soiltemp, &
+!!$ &   humrel_x, soilhum, litterhum, precip_rain, precip_snow, gpp_x, &
+!!$ &   deadleaf_cover, assim_param_x, lai_x, frac_age_x, height_x, veget_x, &
+!!$ &   frac_nobio, njsc, veget_max_x, totfrac_nobio, qsintmax_x, &
+!!$ &   rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu, temp_growth)
+!-
+! close files
+!-
+  IF (is_root_prc) THEN
+     CALL restclo
+     IF ( printlev_loc>=3 )  WRITE(numout,*) 'REST CLOSED'
+  ENDIF
+  CALL histclo
+
+  IF (is_root_prc) &
+       ier = NF90_CLOSE (forcing_id)
+
+  IF (is_root_prc) THEN
+     CALL getin_dump()
+  ENDIF
+#ifdef CPP_PARA
+  CALL MPI_FINALIZE(ier)
+#endif
+  WRITE(numout,*) "End of teststomate."
+
+!---------------
+END PROGRAM teststomate
+!
+!===
+!
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/weather.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/weather.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_driver/weather.f90	(revision 5166)
@@ -0,0 +1,4004 @@
+! =================================================================================================================================
+! MODULE       : weather
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module simulates weather.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE weather
+
+  USE netcdf
+!-
+  USE defprec
+  USE ioipsl_para
+  USE constantes
+  USE mod_orchidee_para
+
+  USE solar
+  USE grid, ONLY : year,month,day,sec
+!-
+  IMPLICIT NONE
+!-
+  PRIVATE
+  PUBLIC weathgen_main, weathgen_domain_size, weathgen_init, weathgen_read_file, weathgen_qsat_2d
+!
+! Only for root proc
+  INTEGER, SAVE                              :: iim_file, jjm_file, llm_file, ttm_file !(unitless)
+  INTEGER,DIMENSION(:,:),SAVE,ALLOCATABLE    :: ncorr !(unitless)
+  INTEGER,DIMENSION(:,:,:),SAVE,ALLOCATABLE  :: icorr,jcorr !(unitless)
+  INTEGER,SAVE                               :: i_cut, n_agg !(unitless)
+
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xinwet   !! climatological wet days + anomaly @tex $(days.month^{-1})$ @endtex
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xinprec  !! climatological precipition + anomaly @tex $(mm.day^{-1})$ @endtex
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xint     !! climatological temp + anomaly (C)
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xinq     !! climatological relative humidity + anomaly (0-1, unitless)
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xinwind  !! climatological wind speed + anomaly @tex $(m.s^{-1})$ @endtex
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xincld   !! climatological cloudiness + anomaly (0-1, unitless)
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xintrng  !! climatological temp range + anomaly (C)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: xintopo  !! topography (m)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: lat_land !! latitudes of land points (unitless)
+!-
+! daily values
+!-
+  REAL,SAVE :: julian_last
+  INTEGER,DIMENSION(:),SAVE,ALLOCATABLE :: iwet    !! flag for wet day / dry day (0-1, unitless)
+!-
+! today's values (m0 means "minus 0")
+!-
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: psurfm0  !! surface pressure today(Pa)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: cloudm0  !! cloud fraction today (0-1, unitless)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: tmaxm0   !! maximum daily temperature today (K)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: tminm0   !! minimum daily temperature today (K)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: qdm0     !! daily average specific humidity today (kg_h2o/kg_air)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: udm0     !! daily average wind speed today  @tex $(m.s^{-1})$ @endtex
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: precipm0 !! daily precitation today @tex $(mm.day^{-1})$ @endtex
+!-
+! yesterday's values (m1 means "minus 1")
+!-
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: psurfm1  !! surface pressure yesterday (Pa)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: cloudm1  !! cloud fraction yesterday (0-1, unitless)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: tmaxm1   !! maximum daily temperature yesterday (K)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: tminm1   !! minimum daily temperature yesterday (K)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: qdm1     !! daily average specific humidity yesterday (kg_h2o/kg_air)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: udm1     !! daily average wind speed  yesterday  @tex $(m.s^{-1})$ @endtex 
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: precipm1 !! daily precitation  yesterday @tex $(mm.day^{-1})$ @endtex 
+!-
+! other
+!-
+  INTEGER,SAVE                  :: ipprec        !! statistical (0) or prescribed (1) daily values
+
+  LOGICAL,SAVE                  :: precip_exact  !! respect monthly precipitation
+  INTEGER,DIMENSION(31,12),SAVE :: jour_precip
+
+
+  INTEGER,PARAMETER      :: seedsize_max = 300  !! max size of random seed
+  LOGICAL,SAVE           :: dump_weather
+  CHARACTER(LEN=20),SAVE :: dump_weather_file
+  LOGICAL,SAVE           :: gathered
+  INTEGER,SAVE           :: dump_id
+
+!
+  REAL,PARAMETER         :: zero_t=273.15   !! Absolute zero
+! 
+  REAL,PARAMETER :: pir = pi/180.
+  REAL,PARAMETER :: rair = 287.
+!-
+  INTEGER,PARAMETER :: nmon = 12  !! Number of months
+
+!
+  CHARACTER(LEN=3),DIMENSION(12) :: cal = &             !! Months of the year (unitless)
+ &  (/ 'JAN','FEB','MAR','APR','MAY','JUN', &
+ &     'JUL','AUG','SEP','OCT','NOV','DEC' /)
+  INTEGER,DIMENSION(12),SAVE :: ndaypm = &              !! Number of days per month (noleap year) (unitless)
+ &  (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
+  INTEGER,SAVE :: soldownid, rainfid, snowfid, lwradid, &
+ &                tairid, qairid,  psolid, uid, vid, &
+ &                time_id, timestp_id
+!-
+  INTEGER,SAVE :: n_rtp = nf90_real4      !! Parameters for NETCDF 
+!- 
+  INTEGER  :: ALLOC_ERR                   !! Flag for dynamic allocations 
+!-
+  CHARACTER(LEN=20),SAVE :: calendar_str   !! Calendar type
+!-
+  INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: kindex_w  !! Land points index
+  INTEGER, SAVE                            :: nbindex_w  !! Land points index
+!-
+  INTEGER, PARAMETER :: termcol = 100     !! Plot of projection file => grid, number of column on terminal
+!80
+  CONTAINS
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : daily
+!!
+!>\BRIEF          This routine generates daily weather conditions from monthly-mean
+!! climatic parameters.
+!!
+!! DESCRIPTION  :  Specifically, this routine generates daily values of 
+!!                 - daily total precipitation \n
+!!                 - daily maximum temperature \n
+!!                 - daily minimum temperature \n
+!!                 - daily average cloud cover \n
+!!                 - daily average relative humidity \n
+!!                 - daily average wind speed \n
+!!                 In order to generate daily weather conditions, the model uses
+!!                 a series of 'weather generator' approaches,
+!!                 which generate random combinations of weather conditions
+!!                 based upon the climatological conditions in general. \n
+!!                 This weather generator is based upon the so-called Richardson
+!!                 weather generator. \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::psurf, ::cloud, ::tmax, ::tmin, ::qd, ::ud, ::precip 
+!!
+!! REFERENCE(S) :
+!! -  Geng, S., F.W.T. Penning de Vries, and L. Supit, 1985:  A simple
+!! method for generating rainfall data, Agricultural and Forest
+!! Meteorology, 36, 363-376.
+!! -  Richardson, C. W. and Wright, D. A., 1984: WGEN: A model for
+!! generating daily weather variables: U. S. Department of
+!! Agriculture, Agricultural Research Service. 
+!! - Richardson, C., 1981: Stochastic simulation of daily
+!! precipitation, temperature, and solar radiation. Water Resources
+!! Research 17, 182-190. 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE daily &
+ &  (npoi, imonth, iday, cloud, tmax, tmin, precip, qd, ud, psurf)
+
+!-
+! in & out: global variables
+!-
+
+! INTEGER,INTENT(INOUT):: iwet(npoi) !! wet day / dry day flag!*
+!-
+
+  !! 0. Parameters and variables declaration
+
+  REAL,PARAMETER :: rair = 287.     !! Molecular weight of one mole of dry air @tex $(g.mol{-1})$ @endtex
+  REAL,PARAMETER :: grav = 9.81     !! Acceleration of the gravity @tex $(m.s^{-2})$ @endtex
+  REAL,PARAMETER :: pi = 3.1415927  !! pi
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN) :: npoi         !! total number of land points
+  INTEGER,INTENT(IN) :: imonth, iday
+
+  !! 0.2 Output variables
+
+  REAL,INTENT(OUT) :: psurf(npoi)   !! surface pressure (Pa)
+  REAL,INTENT(OUT) :: cloud(npoi)   !! cloud fraction (0-1, unitless)
+  REAL,INTENT(OUT) :: tmax(npoi)    !! maximum daily temperature (K)
+  REAL,INTENT(OUT) :: tmin(npoi)    !! minimum daily temperature (K)
+  REAL,INTENT(OUT) :: qd(npoi)      !! daily average specific humidity (kg_h2o/kg_air)
+  REAL,INTENT(OUT) :: ud(npoi)      !! daily average wind speed  @tex $(m.s^{-1})$ @endtex
+  REAL,INTENT(OUT) :: precip(npoi)  !! daily precitation @tex $(mm.day^{-1})$ @endtex
+
+  !! 0.4 Local variables
+
+  REAL :: td(npoi)                                 !! daily average temperature (K)
+  REAL,allocatable,save,dimension(:,:) ::  xstore  !! weather generator 'memory' matrix
+  REAL :: ee(3), r(3), rr(npoi,3)
+  REAL :: alpha(npoi), rndnum, pwd, pww
+  REAL :: beta(npoi)
+  REAL :: pwet(npoi)
+  REAL :: rwork
+  REAL :: omcloud, omqd, omtmax
+  REAL :: cloudm, cloudw, cloudd
+  REAL :: cloude(npoi), clouds(npoi)
+  REAL :: tmaxd, tmaxw, tmaxm
+  REAL :: tminm
+  REAL :: tmins(npoi), tmaxs(npoi)
+  REAL :: tmine(npoi), tmaxe(npoi)
+  REAL :: qdm(npoi),qdd(npoi),qde(npoi),qdw(npoi),qdup(npoi),qdlow(npoi)
+  INTEGER :: i,j,k
+  REAL :: amn,b1,b2,b3,eud,rn,rn1,rn2,rn3,rn4,s1,s2,s12,x1,y, z(npoi)
+  REAL :: aa(npoi),ab(npoi),tr1(npoi), tr2(npoi)
+  REAL :: tdm,trngm,tdum
+  REAL :: qsattd(npoi)
+  INTEGER :: it1w, it2w
+  REAL :: dt
+  REAL :: rainpwd(npoi)
+  INTEGER :: not_ok(npoi)
+  INTEGER :: count_not_ok,count_not_ok_g
+  LOGICAL,SAVE :: firstcall_weather_daily = .TRUE.
+  INTEGER,save :: npoi0
+  REAL :: xx
+  REAL, DIMENSION(3,3) :: a,b              !! define autocorrelation matrices for Richardson generator
+                                           !!
+                                           !! note that this matrix should be based upon a statistical
+                                           !! analysis of regional weather patterns
+                                           !!
+                                           !! for global simulations, we use 'nominal' values
+
+  LOGICAL :: Warning_aa_ab(npoi), Warning_iwet(npoi) !! Warnings
+!---------------------------------------------------------------------
+!-
+! initial setup for daily climate calculations
+!-
+  a(1,:) = (/ 0.600,  0.500,  0.005 /)
+  a(2,:) = (/ 0.010,  0.250,  0.005 /)
+  a(3,:) = (/ 0.020,  0.125,  0.250 /)
+!-
+  b(1,:) = (/ 0.500,  0.250, -0.250 /)
+  b(2,:) = (/ 0.000,  0.500,  0.250 /)
+  b(3,:) = (/ 0.000,  0.000,  0.500 /)
+!-
+! GK240100
+  IF (firstcall_weather_daily) THEN
+    firstcall_weather_daily = .FALSE.
+    ALLOC_ERR=-1
+    ALLOCATE(xstore(npoi,3), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of xstore : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    xstore(:,:) = zero
+    npoi0 = npoi
+  ELSE IF (npoi /= npoi0) THEN
+    WRITE(numout,*) 'Domain size old, new: ',npoi0,npoi
+    STOP 'WG Daily: Problem: Domain has changed since last call'
+  ENDIF
+!-
+! define working variables
+!-
+  rwork = (cte_grav/rair/0.0065)
+!-
+! 'omega' parameters used to calculate differences in expected
+! climatic parameters on wet and dry days
+!
+! following logic of weather generator used in the EPIC crop model
+!
+! omcloud -- cloud cover
+! omqd    -- humidity
+! omtmax  -- maximum temperature
+!-
+  omcloud = 0.90    ! originally 0.90
+  omqd    = 0.50    ! originally 0.50
+  omtmax  = 0.75    ! originally 0.75
+!-
+! calculate weighting factors used in interpolating climatological
+! monthly-mean input values to daily-mean values
+!-
+! this is a simple linear interpolation technique that takes into
+! account the length of each month
+!-
+  IF (ipprec == 0) THEN
+    IF (REAL(iday) < REAL(ndaypm(imonth)+1)/2.0) then
+      it1w = imonth-1
+      it2w = imonth
+      dt   = (REAL(iday)-0.5)/ndaypm(imonth)+0.5
+    ELSE
+      it1w = imonth
+      it2w = imonth+1
+      dt   = (REAL(iday)-0.5)/ndaypm(imonth)-0.5
+    ENDIF
+    if (it1w <  1)  it1w = 12
+    if (it2w > 12)  it2w = 1
+  ELSE
+     dt = -1.
+     it1w = -1
+     it2w = -1
+  ENDIF
+!-
+  IF (ipprec == 0) THEN
+!---
+!-- use weather generator to create daily statistics
+!---
+! (1) determine if today will rain or not
+!---
+!-- calculate monthly-average probability of rainy day
+!---
+    DO i=1,npoi
+      pwet(i) = xinwet(i,imonth)/ndaypm(imonth)
+    ENDDO
+!---
+    IF (.NOT.precip_exact) THEN
+!-----
+!---- (1.1) following Geng et al.
+!-----
+      IF (is_root_prc) THEN
+         CALL random_number (rndnum)
+      ENDIF
+      CALL bcast(rndnum)
+!-----
+      DO i=1,npoi
+        IF (xinprec(i,imonth) > 1.e-6) THEN
+!---------
+!-------- implement simple first-order Markov-chain precipitation
+!-------- generator logic based on Geng et al. (1986),
+!-------- Richardson and Wright (1984), and Richardson (1981)
+!---------
+!-------- basically, this allows for the probability of today being
+!-------- a wet day (a day with measureable precipitation)
+!-------- to be a function of what yesterday was (wet or dry)
+!---------
+!-------- the logic here is that it is more likely that a wet day
+!-------- will follow another wet day -- allowing
+!-------- for 'storm events' to persist
+!---------
+!-------- estimate the probability of a wet day after a dry day
+!---------
+          pwd = 0.75*pwet(i)
+!---------
+!-------- estimate the probability of a wet day after a wet day
+!---------
+          pww = 0.25+pwd
+!---------
+!-------- decide if today is a wet day or a dry day
+!-------- using a random number
+!---------
+!-------- call random_number(rndnum) ! done before
+!---------
+          IF (iwet(i) == 0) then
+            IF (rndnum <= pwd) iwet(i) = 1
+          ELSE
+            IF (rndnum > pww) iwet(i) = 0
+          ENDIF
+        ELSE
+          iwet(i) = 0
+        ENDIF
+      ENDDO
+    ELSE
+!-----
+!---- (1.2) preserving the monthly number of precip days
+!----       and monthly precip
+!-----
+      DO i=1,npoi
+        IF (ABS(xinwet(i,imonth)) < 32.) THEN
+          IF (xinprec(i,imonth) > 1.e-6) THEN
+            IF (   jour_precip(iday,imonth) &
+ &              <= NINT(MAX(1.,xinwet(i,imonth))) ) THEN
+              iwet(i) = 1
+            ELSE
+              iwet(i) = 0
+            ENDIF
+          ELSE
+           iwet(i) = 0
+          ENDIF
+        ENDIF
+      ENDDO
+    ENDIF
+!---
+!-- (2) determine today's precipitation amount
+!---
+    IF (.not.precip_exact) THEN
+       Warning_aa_ab(:)=.FALSE.
+       Warning_iwet(:)=.FALSE.
+!-----
+!---- (2.1) following Geng et al.
+!-----
+      aa(:) = zero
+      ab(:) = zero
+      tr2(:)= zero
+      tr1(:)= zero
+      beta(:) = un
+      DO i=1,npoi
+!-------
+!------ initialize daily precipitation to zero
+!-------
+        precip(i) = zero
+!-------
+        IF (xinprec(i,imonth) > 1.e-6) THEN
+!---------
+!-------- if it is going to rain today
+!---------
+          IF (iwet(i) == 1) THEN
+!-----------
+!---------- calculate average rainfall per wet day
+!-----------
+            rainpwd(i) = xinprec(i,imonth) &
+ &                      *ndaypm(imonth)/MAX(0.1,xinwet(i,imonth))
+!-----------
+!---------- randomly select a daily rainfall amount
+!---------- from a probability density function of rainfall
+!----------
+!---------- method i --
+!-----------
+!---------- use the following technique from Geng et al. and Richardson
+!---------- to distribute rainfall probabilities
+!-----------
+!---------- pick a random rainfall amount
+!---------- from a two-parameter gamma function distribution function
+!-----------
+!---------- estimate two parameters for gamma function
+!---------- (following Geng et al.)
+!-----------
+            beta(i) = MAX(1.0,-2.16+1.83*rainpwd(i))
+            alpha(i) = rainpwd(i)/beta(i)
+!-----------
+!---------- determine daily precipitation amount
+!---------- from gamma distribution function
+!---------- (following WGEN code of Richardson and Wright (1984))
+!-----------
+            IF (ABS(1.-alpha(i)) < 1.e-6) THEN
+              alpha(i) = 1.e-6*(alpha(i)/ABS(alpha(i)))
+            ENDIF
+            aa(i) = 1.0/alpha(i)
+            ab(i) = 1.0/(1.0-alpha(i))
+!-----------
+            IF ( (ABS(aa(i)) < 1.e-6) .OR. (ABS(ab(i)) < 1.e-6) ) THEN
+               Warning_aa_ab(:)=.TRUE.
+            ENDIF
+            tr1(i) = exp(-18.42/aa(i))
+            tr2(i) = exp(-18.42/ab(i))
+          ENDIF
+        ELSE
+          IF (iwet(i) == 1) THEN
+            Warning_iwet(i)=.TRUE.
+          ENDIF
+        ENDIF
+      ENDDO
+
+      DO i=1,npoi
+         IF ( Warning_aa_ab(i) ) THEN
+            WRITE(numout,*) ' ATTENTION, aa ou ab:'
+            WRITE(numout,*) ' aa, ab = ',aa(i),ab(i)
+            WRITE(numout,*) '   alpha, rainpwd, beta =', &
+ &                       alpha(i),rainpwd(i),beta(i)
+         ENDIF
+         IF ( Warning_iwet(i) ) THEN
+            WRITE(numout,*) ' ATTENTION, iwet = 1 alors que xinprec = 0)'
+            WRITE(numout,*) '   xinprec, iwet = ',xinprec(i,imonth),iwet(i)
+          ENDIF
+      ENDDO
+!-----
+      where ( iwet(:) == 1 )
+        not_ok(:) = 1
+      elsewhere
+        not_ok(:) = 0
+      endwhere
+!-----
+      count_not_ok_g=0
+      count_not_ok=SUM(not_ok(:))
+      CALL reduce_sum(count_not_ok,count_not_ok_g)
+      CALL bcast(count_not_ok_g)
+!-
+      z(:) = zero
+      DO WHILE (count_not_ok_g > 0)
+        IF (is_root_prc) THEN
+        CALL random_number (rn1)
+        CALL random_number (rn2)
+        ENDIF
+        CALL bcast(rn1)
+        CALL bcast(rn2)
+
+        DO i=1,npoi
+          IF ((iwet(i) == 1).AND.(not_ok(i) == 1)) then
+            IF ( (rn1-tr1(i)) <= zero ) THEN
+              s1 = zero
+            ELSE
+              s1 = rn1**aa(i)
+            ENDIF
+!-----------
+            IF ((rn2-tr2(i)) <= zero) THEN
+              s2 = zero
+            ELSE
+              s2 = rn2**ab(i)
+            ENDIF
+!-----------
+            s12 = s1+s2
+            IF ((s12-1.0) <= zero) THEN
+              z(i) = s1/s12
+              not_ok(i) = 0
+            ENDIF
+          ENDIF
+        ENDDO
+
+        count_not_ok_g=0
+        count_not_ok=SUM(not_ok(:))
+        CALL reduce_sum(count_not_ok,count_not_ok_g)
+        CALL bcast(count_not_ok_g)
+      ENDDO
+!-----
+      IF (is_root_prc) THEN
+         CALL random_number (rn3)
+      ENDIF
+      CALL bcast(rn3)
+!      WRITE(*,*) mpi_rank,"rn3=",rn3
+!-----
+      DO i=1,npoi
+        IF (iwet(i) == 1) then
+          precip(i) = -z(i)*log(rn3)*beta(i)
+        ENDIF
+      ENDDO
+!-----
+!---- method ii --
+!-----
+!---- here we use a one-parameter Weibull distribution function
+!---- following the analysis of Selker and Haith (1990)
+!-----
+!---- Selker, J.S. and D.A. Haith, 1990: Development and testing
+!---- of single- parameter precipitation distributions,
+!---- Water Resources Research, 11, 2733-2740.
+!-----
+!---- this technique seems to have a significant advantage over other
+!---- means of generating rainfall distribution functions
+!-----
+!---- by calibrating the Weibull function to U.S. precipitation records,
+!---- Selker and Haith were able to establish the following relationship
+!-----
+!---- the cumulative probability of rainfall intensity x is given as:
+!-----
+!---- f(x) = 1.0-exp(-(1.191 x / rainpwd)**0.75)
+!-----
+!---- where x       : rainfall intensity
+!----       rainpwd : rainfall per wet day
+!-----
+!---- using transformation method, take uniform deviate and convert
+!---- it to a random number weighted by the following Weibull function
+!-----
+!----    call random_number(rndnum)
+!-----
+!----    precip(i) = rainpwd / 1.191*(-log(1.0-rndnum))**1.333333
+!-----
+!---- bound daily precipitation to "REAListic" range
+!-----
+      DO i=1,npoi
+        IF (iwet(i) == 1) THEN
+!---------
+!-------- lower end is determined by definition of a 'wet day'
+!-------- (at least 0.25 mm of total precipitation)
+!---------
+!-------- upper end is to prevent ibis from blowing up
+!---------
+          precip(i) = MAX(precip(i),  0.25) ! min =   0.25 mm/day
+          precip(i) = MIN(precip(i),150.00) ! max = 150.00 mm/day
+        ENDIF
+      ENDDO
+    ELSE
+!-----
+!---- (2.2) preserving the monthly number of precip days
+!----       and monthly precip
+!-----
+      DO i=1,npoi
+!-------
+!------ Correction Nathalie. C'est abs(xinwet) < 32 qu'il faut tester
+!------ et non pas abs(xinprec(i,imonth)) < 32.
+!-------
+!------ IF ( (iwet(i) == 1).and.(abs(xinprec(i,imonth)) < 32.) ) THEN
+        IF ( (iwet(i) == 1).and.(abs(xinwet(i,imonth)) < 32.) ) THEN
+          precip(i) = xinprec(i,imonth)*REAL(ndaypm(imonth)) &
+ &                   /REAL(NINT(MAX(1.,xinwet(i,imonth))))
+        ELSE
+          precip(i) = zero
+        ENDIF
+      ENDDO
+    ENDIF
+!---
+!-- (3) estimate expected minimum and maximum temperatures
+!---
+    DO i=1,npoi
+!-----
+!---- first determine the expected maximum and minimum temperatures
+!---- (from climatological means) for this day of the year
+!-----
+!---- mean daily mean temperature (K)
+      tdm = xint(i,it1w)+dt*(xint(i,it2w)-xint(i,it1w))+zero_t
+!---- mean daily temperature range (K)
+      trngm = xintrng(i,it1w)+dt*(xintrng(i,it2w)-xintrng(i,it1w))
+!---- mean minimum and maximum temperatures
+      tmaxm = tdm+0.56*trngm
+      tminm = tdm-0.44*trngm
+!-----
+!---- modify maximum temperatures for wet and dry days
+!-----
+      IF (pwet(i) /= zero) THEN
+        tmaxd = tmaxm+pwet(i)*omtmax*trngm
+        tmaxw = tmaxd-        omtmax*trngm
+      ELSE
+        tmaxd = tmaxm
+        tmaxw = tmaxm
+      ENDIF
+!-----
+!---- set the 'expected' maximum and minimum temperatures for today
+!-----
+!---- note that the expected minimum temperatures are the same for
+!---- both wet and dry days
+!-----
+      if (iwet(i) == 0)  tmaxe(i) = tmaxd
+      if (iwet(i) == 1)  tmaxe(i) = tmaxw
+!-----
+      tmine(i) = tminm
+!-----
+!---- estimate variability in minimum and maximum temperatures
+!-----
+!---- tmaxs : standard deviation in maximum temperature (K)
+!---- tmins : standard deviation in minimum temperature (K)
+!-----
+!---- Regression is based on analysis of 2-m air temperature data
+!---- from the NCEP/NCAR reanalysis (1958-1997) for 294 land points
+!---- over central North America
+!---- (24N-52N, 130W-60W, 0.5-degree resolution):
+!---- Daily max and min temperatures were calculated for each
+!---- land point from daily mean temperature and temperature range.
+!---- Anomalies were calculated
+!---- by subtracting similar max and min temperatures calculated from
+!---- monthly mean temperature and range (interpolated to daily).
+!---- The 40 years of anomalies were then binned by month
+!---- and the standard deviation calculated for each month.
+!---- The 294 x 12 standard deviations were then regressed
+!---- against the 3528 long-term monthly mean temperatures.
+!-----
+!---- note: the values are bound to be greater than 1.0 K
+!----       (at the very least they must be bound
+!----        so they don't go below zero)
+!-----
+      tmaxs(i) = MAX(1.0,-0.0713*(tdm-zero_t)+4.89)
+      tmins(i) = MAX(1.0,-0.1280*(tdm-zero_t)+5.73)
+    ENDDO
+!---
+!-- (4) estimate expected cloud cover
+!---
+!---
+!-- the formulation of dry and wet cloud cover has been
+!-- derived from the weather generator used in the epic crop model
+!---
+    DO i=1,npoi
+!-----
+!---- cloudm : mean cloud cover for today
+!---- cloudd : dry day cloud cover
+!---- cloudw : dry day cloud cover
+!---- cloude : expected cloud cover today
+!-----
+!---- mean cloud cover (%)
+!-----
+      cloudm = xincld(i,it1w)+dt*(xincld(i,it2w)-xincld(i,it1w))
+!-----
+!---- convert from percent to fraction
+!-----
+      cloudm = cloudm/100.0
+!-----
+!---- adjust cloud cover depending on dry day / rainy day
+!---- following logic of the EPIC weather generator code
+!-----
+      IF (pwet(i) /= zero) THEN
+        cloudd = (cloudm-pwet(i)*omcloud)/(un-pwet(i)*omcloud)
+        cloudd = MIN(un,MAX(zero,cloudd))
+        cloudw = (cloudm-(un-pwet(i))*cloudd)/pwet(i)
+      ELSE
+        cloudd = cloudm
+        cloudw = cloudm
+      ENDIF
+      IF (iwet(i) == 0)  cloude(i) = cloudd
+      IF (iwet(i) == 1)  cloude(i) = cloudw
+!-----
+!---- estimate variability in cloud cover for wet and dry days
+!---- following numbers proposed by Richardson
+!-----
+!---- clouds : standard deviation of cloud fraction
+!-----
+      IF (iwet(i) == 0)  clouds(i) = 0.24*cloude(i)
+      IF (iwet(i) == 1)  clouds(i) = 0.48*cloude(i)
+    ENDDO
+!---
+! (5) determine today's temperatures and cloud cover using
+!     first-order serial autoregressive technique
+!---
+!-- use the Richardson (1981) weather generator approach to simulate the
+!-- daily values of minimum / maximum temperature and cloud cover
+!---
+!-- following the implementation of the Richardson WGEN weather
+!-- generator used in the EPIC crop model
+!---
+!-- this approach uses a multivariate generator, which assumes that the
+!-- perturbation of minimum / maximum temperature and cloud cover are
+!-- normally distributed and that the serial correlation of each
+!-- variable may be described by a first-order autoregressive model
+!---
+!-- generate standard deviates for weather generator
+!---
+    DO j=1,3
+      ee(j) = 9999.
+      DO WHILE (ee(j) > 2.5)
+        IF (is_root_prc) THEN
+           CALL random_number (rn1)
+           CALL random_number (rn2)
+        ENDIF
+        CALL bcast(rn1)
+        CALL bcast(rn2)
+        ee(j) = SQRT(-2.0*LOG(rn1))*COS(6.283185*rn2)
+      ENDDO
+    ENDDO
+!---
+!-- zero out vectors
+!---
+    r(1:3)  = zero
+    rr(1:npoi,1:3) = zero
+!---
+!-- update working vectors
+!---
+    do j=1,3
+      do k=1,3
+        r(j) = r(j)+b(j,k)*ee(j)
+      enddo
+    enddo
+!---
+    do j=1,3
+      do k=1,3
+        do i=1,npoi
+          rr(i,j) = rr(i,j)+a(j,k)*xstore(i,k)
+        enddo
+      enddo
+    enddo
+!---
+!-- solve for x() perturbation vector and save current vector
+!-- into the xim1() storage vector (saved for each point)
+!---
+    do j=1,3
+      do i=1,npoi
+        xstore(i,j) = r(j)+rr(i,j)
+      enddo
+    enddo
+!---
+!-- determine today's minimum and maximum temperature
+!--
+    do i=1,npoi
+      tmax(i) = tmaxe(i)+tmaxs(i)*xstore(i,1)
+      tmin(i) = tmine(i)+tmins(i)*xstore(i,2)
+!-----
+!---- if tmin > tmax, then switch the two around
+!-----
+      if (tmin(i) > tmax(i)) then
+        tdum    = tmax(i)
+        tmax(i) = tmin(i)
+        tmin(i) = tdum
+      ENDIF
+!---- daily average temperature
+      td(i) = 0.44*tmax(i)+0.56*tmin(i)
+!---- determine today's cloud cover
+      cloud(i) = cloude(i)+clouds(i)*xstore(i,3)
+!---- constrain cloud cover to be between 0 and 100%
+      cloud(i) = MAX(zero,MIN(un,cloud(i)))
+    enddo
+!---
+!-- (6) estimate today's surface atmospheric pressure
+!---
+    do i=1,npoi
+!-----
+!---- simply a function of the daily average temperature
+!---- and topographic height -- nothing fancy here
+!-----
+      psurf(i) = 101325.0*(td(i)/(td(i)+0.0065*xintopo(i)))**rwork
+    enddo
+!---
+!-- (7) estimate today's relative humidity
+!---
+    IF (is_root_prc) THEN
+       CALL random_number (rn)
+    ENDIF
+    CALL bcast(rn)
+!---
+    CALL weathgen_qsat (npoi,td,psurf,qsattd)
+!---
+    do i=1,npoi
+!-----
+!---- the formulation of dry and wet relative humidities has been
+!---- derived from the weather generator used in the epic crop model
+!-----
+!---- qdm : mean relative humidity
+!---- qdd : dry day relative humidity
+!---- qdw : rainy day relative humidity
+!---- qde : expected relative humidity (based on wet/dry decision)
+!-----
+!---- mean relative humidity (%)
+      qdm(i) = xinq(i,it1w)+dt*(xinq(i,it2w)-xinq(i,it1w))
+!---- convert from percent to fraction
+      qdm(i) = qdm(i)/100.0
+!-----
+!---- adjust humidity depending on dry day / rainy day
+!---- following logic of the EPIC weather generator code
+!-----
+      if (pwet(i) /= zero) then
+        qdd(i) = (qdm(i)-pwet(i)*omqd)/(un-pwet(i)*omqd)
+        if (qdd(i) < 0.2) then
+          qdd(i) = 0.2
+          if (qdd(i) > qdm(i)) qdm(i) = qdd(i)
+        ENDIF
+        qdd(i) = MIN(un,qdd(i))
+        qdw(i) = (qdm(i)-(un-pwet(i))*qdd(i))/pwet(i)
+      ELSE
+        qdd(i) = qdm(i)
+        qdw(i) = qdm(i)
+      ENDIF
+!-----
+      if (iwet(i) == 0)  qde(i) = qdd(i)
+      if (iwet(i) == 1)  qde(i) = qdw(i)
+!-----
+!---- estimate lower and upper bounds of humidity distribution function
+!---- following logic of the EPIC weather generator code
+!-----
+      xx = exp(qde(i))
+      qdup(i)  = qde(i)+(un-qde(i))*xx/euler
+      qdlow(i) = qde(i)*(un-1./xx)
+!-----
+!---- randomlly select humidity from triangular distribution function
+!---- following logic of the EPIC weather generator code
+!-----
+!---- call random_number(rn) ! GK done before
+!-----
+      y  = 2.0/(qdup(i)-qdlow(i))
+!-----
+      b3 = qde(i)-qdlow(i)
+      b2 = qdup(i)-qde(i)
+      b1 = rn/y
+!-----
+      x1 = y*b3/2.0
+!-----
+      if (rn > x1) then
+        qd(i) = qdup(i)-sqrt (b2*b2-2.0*b2*(b1-0.5*b3))
+      ELSE
+        qd(i) = qdlow(i)+sqrt (2.0*b1*b3)
+      ENDIF
+!-----
+!---- adjust daily humidity to conserve monthly mean values
+!-----
+!---- note that this adjustment sometimes gives rise to humidity
+!---- values greater than 1.0 -- which is corrected below
+!-----
+      amn = (qdup(i)+qde(i)+qdlow(i))/3.0
+      qd(i) = qd(i)*qde(i)/amn
+!-----
+!---- constrain daily average relative humidity
+!-----
+      qd(i) = MAX(0.30,MIN(qd(i),0.99))
+!-----
+!---- convert from relative humidity to specific humidity at
+!---- daily mean temperature
+!-----
+      qd(i) = qd(i)*qsattd(i)
+    enddo
+!---
+!-- (8) estimate today's daily average wind speed
+!---
+    IF (is_root_prc) THEN
+        CALL random_number (rn4)
+    ENDIF
+    CALL bcast(rn4)
+
+    DO i=1,npoi
+!-----
+!---- first estimate the expected daily average wind speed (from monthly
+!---- means)
+!-----
+      eud = xinwind(i,it1w)+dt*(xinwind(i,it2w)-xinwind(i,it1w))
+!-----
+!---- following logic of the EPIC weather generator
+!---- select random wind speed following this equation
+!-----
+!---- call random_number(rn4)
+!-----
+      ud(i) = 1.13989*eud*(-log(rn4))**0.30
+!---- constrain daily wind speeds to be between 2.5 and 10.0 m/sec
+      ud(i) = MAX(2.5,MIN(ud(i),10.0))
+    ENDDO
+  ELSE
+!---
+!-- use REAL daily climate data
+!---
+    DO i=1,npoi
+!-----
+!---- use basic daily climate data, converting units
+!-----
+!---- daily total precipitation
+      precip(i) = xinprec(i,imonth)
+!---- daily average temperatures
+      td(i) = xint(i,imonth)+zero_t
+      trngm = MIN(44.0,xintrng(i,imonth))
+!-----
+      tmax(i) = td(i)+0.56*trngm
+      tmin(i) = td(i)-0.44*trngm
+!---- daily average cloud cover
+      cloud(i) = xincld(i,imonth)*0.01
+!---- daily average specific humidity
+      qd(i) = xinq(i,imonth)
+!---- daily average wind speed
+      ud(i) = xinwind(i,imonth)
+!-----
+!---- compute surface atmospheric pressure
+!-----
+      psurf(i) = 101325.0*(td(i)/(td(i)+0.0065*xintopo(i)))**rwork
+    ENDDO
+  ENDIF
+!-------------------
+END SUBROUTINE daily
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : diurnal
+!!
+!>\BRIEF          This routine interpolates values from the!* 
+!! subroutine daily into instantaneous values for simulating a diurnal cycle.
+!!
+!! DESCRIPTION  :  
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):  ::fira, ::solad, ::ua, ::ta, ::qa, ::raina, ::snowa, ::rh.
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE diurnal &
+& (npoi, nband, time, jday, plens, startp, endp, latitude, &
+&  cloud, tmax, tmin, precip, qd, ud, psurf, &
+&  fira, solad, solai, ua, ta, qa, raina, snowa, rh)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Parameter and variables declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN) :: npoi    !! number of grid points (unitless)
+  INTEGER,INTENT(IN) :: nband   !! number of visible bands (unitless)
+  REAL,INTENT(IN) :: time
+  INTEGER, INTENT(IN) :: jday
+  REAL,INTENT(IN) :: plens,startp,endp
+  REAL,INTENT(IN) :: latitude(npoi)   !! latitude in degrees
+  REAL,INTENT(IN) :: cloud(npoi)      !! cloud fraction (0-1, unitless)
+  REAL,INTENT(IN) :: tmax(npoi)       !! maximum daily temperature (K)
+  REAL,INTENT(IN) :: tmin(npoi)       !! maximum daily temperature (K)
+  REAL,INTENT(IN) :: precip(npoi)     !! daily precitation @tex $(mm.day^{-1})$ @endtex 
+  REAL,INTENT(IN) :: qd(npoi)         !! daily average specific humidity (kg_h2o/kg_air)
+  REAL,INTENT(IN) :: ud(npoi)         !! daily average wind speed @tex $(m.s^{-1})$ @endtex 
+  REAL,INTENT(IN) :: psurf(npoi)      !! surface pressure (Pa)
+
+  !! 0.2 Output variables
+
+  REAL,INTENT(OUT) :: fira(npoi)          !! incoming ir flux  @tex $(W.m^{-2})$ @endtex
+  REAL,INTENT(OUT) :: solad(npoi,nband)   !! direct downward solar flux @tex $(W.m^{-2})$ @endtex
+  REAL,INTENT(OUT) :: solai(npoi,nband)   !! diffuse downward solar flux @tex $(W.m^{-2})$ @endtex
+  REAL,INTENT(OUT) :: ua(npoi)            !! wind speed @tex $(m.s^{-1})$ @endtex 
+  REAL,INTENT(OUT) :: ta(npoi)            !! air temperature (K)
+  REAL,INTENT(OUT) :: qa(npoi)            !! specific humidity (kg_h2o/kg_air)
+  REAL,INTENT(OUT) :: raina(npoi)         !! rainfall rate @tex $(mm.day^{-1})$ @endtex 
+  REAL,INTENT(OUT) :: snowa(npoi)         !! snowfall rate @tex $(mm.day^{-1})$ @endtex 
+  REAL,INTENT(OUT) :: rh(npoi)            !! relative humidity (0-1, unitless)
+
+  !! 0.4 Local variables
+
+  REAL,SAVE      :: step
+  REAL :: xl,so,xllp,xee,xse
+  REAL :: xlam,dlamm,anm,ranm,ranv,anv,tls,rlam
+  REAL :: sd,cd,deltar,delta,Dis_ST,ddt
+!-
+  REAL :: coszen(npoi)                      !! cosine of solar zenith angle
+  REAL :: rtime
+  REAL :: sw,frac,gamma,qmin,qmax,qsa,emb,ea,ec,dtair,dtcloud,rn
+  REAL :: trans(npoi), fdiffuse(npoi), qsatta(npoi), qsattmin(npoi)
+  INTEGER :: i,ib
+  INTEGER,SAVE :: npoi0
+  LOGICAL,SAVE :: firstcall_weather_diurnal = .TRUE.
+
+!---------------------------------------------------------------------
+! GK240100
+  IF (firstcall_weather_diurnal) THEN
+    firstcall_weather_diurnal = .FALSE.
+    npoi0 = npoi
+  ELSE IF (npoi /= npoi0) THEN
+    WRITE(numout,*) 'Domain size old, new: ',npoi0,npoi
+    STOP 'WG Diurnal: Problem: Domain has changed since last call'
+  ENDIF
+
+! calculate time in hours
+  rtime = time/3600.0
+
+  CALL downward_solar_flux(npoi,latitude,calendar_str,REAL(jday),rtime,cloud,nband,solad,solai)
+!-
+! temperature calculations
+!-
+!---
+!-- assign hourly temperatures using tmax and tmin
+!-- following Environmental Biophysics, by Campbell and Norman, p.23
+!---
+!-- this function fits a fourier series to the diurnal temperature cycle
+!-- note that the maximum temperature occurs at 2:00 pm local solar time
+!---
+!-- note that the daily mean value of gamma is 0.44,
+!-- so td = 0.44*tmax+0.56*tmin,  instead of
+!--    td = 0.50*tmax+0.50*tmin
+!---
+  gamma = 0.44-0.46*SIN(    pi/12.0*rtime+0.9) &
+              +0.11*SIN(2.0*pi/12.0*rtime+0.9)
+  DO i=1,npoi
+    ta(i) = tmax(i)*gamma+tmin(i)*(1.0-gamma)
+  ENDDO
+!-
+! humidity calculations
+!-
+  CALL weathgen_qsat (npoi,tmin,psurf,qsattmin)
+  CALL weathgen_qsat (npoi,ta,psurf,qsatta)
+!-
+  DO i=1,npoi
+!---
+!-- adjust specific humidity against daily minimum temperatures
+!---
+!-- To do this, qa is written as an approximate sine function
+!-- (same as ta) to preserve the daily mean specific humidity,
+!-- while also preventing rh from exceeding 99% at night
+!---
+!-- Note that the daily mean RH is *not* preserved, and therefore the
+!-- output RH will be slightly different from what was read in.
+!---
+!-- first adjust so that maximum RH cannot exceed 99% at night
+!---
+    qmin = MIN(qd(i),0.99*qsattmin(i))
+    qmax = (qd(i)-0.56*qmin)/0.44
+!---
+!-- if needed, adjust again to 99% at other times of the day (in which
+!-- case the daily mean *specific* humidity is also not preserved)
+!---
+    qsa  = 0.99*qsatta(i)
+!---
+!-- calculate the hourly specific humidity, using the above adjustments
+!---
+    qa(i) = MIN(qsa,qmax*gamma+qmin*(1.0-gamma))
+!---
+!-- calculate the hourly relative humidity
+!--
+    rh(i) = 100.*qa(i)/qsatta(i)
+  ENDDO
+!-
+! wind speed calculations
+!-
+  IF (is_root_prc) THEN
+     CALL random_number (rn)
+  ENDIF
+  CALL bcast(rn)
+!-
+  DO i=1,npoi
+!---
+!-- following logic of the EPIC weather generator
+!-- select random wind speed following this equation
+!---
+!-- call random_number(rn) ! done before
+!---
+    ua(i) = 1.13989*ud(i)*(-log(rn))**0.30
+!---
+!-- fix wind speeds to always be above 2.5 m/sec and below 10.0 m/sec
+!---
+    ua(i) = MAX(2.5,MIN(10.0,ua(i)))
+  ENDDO
+!-
+! ir flux calculations
+!-
+  DO i=1,npoi
+!---
+!-- clear-sky emissivity as a function of water vapor pressure
+!-- and atmospheric temperature
+!---
+!-- calculate the ir emissivity of the clear sky
+!-- using equation from idso (1981) water resources res., 17, 295-304
+!---
+    emb = 0.01*(psurf(i)*qa(i)/(0.622+qa(i)))
+    ea  = 0.70+5.95e-5*emb*EXP(1500.0/ta(i))
+!---
+!-- assign the ir emissivity of clouds
+!-- (assume they are ~black in the ir)
+!---
+    ec = 0.950
+!---
+!-- assign the temperature difference of emissions (air+cloud) from
+!-- the surface air temperature
+!---
+    dtair   = zero
+    dtcloud = zero
+!---
+!-- total downward ir is equal to the sum of:
+!---
+!-- (1) clear sky contribution to downward ir radiation flux
+!-- (2) cloud contribution to downward ir radiation flux
+!---
+    fira(i) = (1.-cloud(i))*ea*c_stefan*(ta(i)-dtair)**4 &
+ &           +cloud(i)*ec*c_stefan*(ta(i)-dtcloud)**4
+  ENDDO
+!-
+! snow and rain calculations
+!-
+  DO i=1,npoi
+!---
+!-- reset snow and rain to zero
+!---
+    snowa(i) = zero
+    raina(i) = zero
+!---
+!-- if precipitation event then calculate
+!---
+    IF (time >= startp .and. time < endp) then
+!-----
+!---- for rain / snow partitioning, make it all rain if
+!---- ta > 2.5 C and all snow if ta <= 2.5 C
+!-----
+!---- reference:
+!-----
+!---- Auer, A. H., 1974: The rain versus snow threshold temperatures,
+!---- Weatherwise, 27, 67.
+!-----
+      IF (ta(i)-273.15 > 2.5) then
+        raina(i) = precip(i)/plens
+      ELSE
+        snowa(i) = precip(i)/plens
+      ENDIF
+    ENDIF
+  ENDDO
+!---------------------
+END SUBROUTINE diurnal
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_main
+!!
+!>\BRIEF        This subroutine manages the calls to the different subroutines of the weather module. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::tair, ::pb, ::qair, ::swdown, ::rainf, ::snowf, ::u, ::v, ::lwdown
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_main &
+& (itau, istp, filename, force_id, iim, jjm, nband, &
+&  rest_id, lrstread, lrstwrite, &
+&  limit_west, limit_east, limit_north, limit_south, &
+&  zonal_res, merid_res, lon, lat, date0, dt_force, &
+&  kindex, nbindex, &
+&  swdown, rainf, snowf, tair, u, v, qair, pb, lwdown)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                  :: itau,istp
+  CHARACTER(LEN=*),INTENT(IN)         :: filename
+  INTEGER,INTENT(IN)                  :: force_id
+  INTEGER,INTENT(IN)                  :: iim,jjm
+  INTEGER,INTENT(IN)                  :: nband
+  INTEGER,INTENT(IN)                  :: rest_id
+  LOGICAL,INTENT(IN)                  :: lrstread, lrstwrite
+  REAL,INTENT(IN)                     :: limit_west,limit_east
+  REAL,INTENT(IN)                     :: limit_north,limit_south
+  REAL,INTENT(IN)                     :: zonal_res,merid_res
+  REAL,INTENT(IN)                     :: date0,dt_force
+  REAL,DIMENSION(iim,jjm),INTENT(IN)  :: lon,lat  !! longitude, latitude
+
+  !! 0.2 Output variables 
+
+  REAL,DIMENSION(iim,jjm),INTENT(OUT) :: &
+ &  tair,pb,qair,swdown,rainf,snowf, u,v,lwdown
+
+  !! 0.3 Mofified variables
+
+  INTEGER,INTENT(INOUT)                    :: nbindex
+  INTEGER,DIMENSION(iim*jjm),INTENT(INOUT) :: kindex
+
+  !! 0.4 Local variables
+
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+ &  tair_g,pb_g,qair_g,swdown_g,rainf_g,snowf_g, u_g,v_g,lwdown_g
+  REAL,DIMENSION(nbindex) :: &
+ &  tairl,pbl,qairl,swdownl,rainfl,snowfl, ul,vl,lwdownl
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  IF (lrstread) THEN
+    CALL weathgen_begin ( &
+     & dt_force,itau, date0, &
+     & rest_id,iim,jjm, &
+     & lon,lat,tair,pb,qair,kindex,nbindex)
+        RETURN
+  ELSE
+    CALL weathgen_get &
+ &   (itau, date0, dt_force, nbindex, nband, lat_land, &
+ &    swdownl, rainfl, snowfl, tairl, ul, vl, qairl, pbl, lwdownl)
+
+    tair(:,:)=val_exp
+    qair(:,:)=val_exp
+    pb(:,:)=val_exp
+    DO ij=1,nbindex
+       j = (((kindex(ij)-1)/iim) + 1)
+       i = (kindex(ij) - (j-1)*iim)
+       !
+       swdown(i,j)=swdownl(ij)
+       rainf(i,j)=rainfl(ij)
+       snowf(i,j)=snowfl(ij)
+       tair(i,j)=tairl(ij)
+       u(i,j)=ul(ij)
+       v(i,j)=vl(ij)
+       qair(i,j)=qairl(ij)
+       pb(i,j)=pbl(ij)
+       lwdown(i,j)=lwdownl(ij)
+    ENDDO
+!---
+    IF (dump_weather) THEN
+      ALLOCATE(tair_g(iim_g,jjm_g))
+      ALLOCATE(pb_g(iim_g,jjm_g))
+      ALLOCATE(qair_g(iim_g,jjm_g))
+      ALLOCATE(swdown_g(iim_g,jjm_g))
+      ALLOCATE(rainf_g(iim_g,jjm_g))
+      ALLOCATE(snowf_g(iim_g,jjm_g))
+      ALLOCATE(u_g(iim_g,jjm_g))
+      ALLOCATE(v_g(iim_g,jjm_g))
+      ALLOCATE(lwdown_g(iim_g,jjm_g))
+
+      CALL gather2D_mpi(tair, tair_g)
+      CALL gather2D_mpi(pb, pb_g)
+      CALL gather2D_mpi(qair, qair_g)
+      CALL gather2D_mpi(swdown, swdown_g)
+      CALL gather2D_mpi(rainf, rainf_g)
+      CALL gather2D_mpi(snowf, snowf_g)
+      CALL gather2D_mpi(u, u_g)
+      CALL gather2D_mpi(v, v_g)
+      CALL gather2D_mpi(lwdown, lwdown_g)
+      IF (is_root_prc) THEN
+         CALL weathgen_dump &
+ &           (itau, dt_force, iim_g, jjm_g, nbp_glo, index_g, lrstwrite, &
+ &            swdown_g, rainf_g, snowf_g, tair_g, u_g, v_g, qair_g, pb_g, lwdown_g)
+      ENDIF
+    ENDIF
+!---
+    IF (lrstwrite) THEN
+      CALL weathgen_restwrite (rest_id,istp,iim,jjm,nbindex,kindex)
+    ENDIF
+  ENDIF
+!---------------------------
+END SUBROUTINE weathgen_main
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_init 
+!!
+!>\BRIEF         This subroutine initializes weather variables.
+!!
+!! DESCRIPTION  : None 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):  ::kindex, ::nbindex
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_init &
+     & (filename,dt_force,force_id,iim,jjm, &
+     &  zonal_res,merid_res,lon,lat,kindex,nbindex)
+!!$,iind,jind)
+  !---------------------------------------------------------------------
+  IMPLICIT NONE
+  !-
+
+  !! 0. Variables and parameters declaration
+
+  REAL,PARAMETER  :: fcrit = .5       !! Minimum land fraction on original grid
+
+  !! 0.1 Input variables
+
+  CHARACTER(LEN=*),INTENT(IN)         :: filename
+  REAL,INTENT(IN)                     :: dt_force
+  INTEGER,INTENT(IN)                  :: iim, jjm
+  REAL,INTENT(IN)                     :: zonal_res,merid_res
+  REAL,DIMENSION(iim,jjm),INTENT(IN)  :: lon,lat
+
+  !! 0.2 Output variables  
+
+  INTEGER,INTENT(OUT)                 :: nbindex
+  INTEGER,DIMENSION(iim*jjm),INTENT(OUT)  :: kindex
+!!$  INTEGER,DIMENSION(iim),INTENT(OUT) :: iind
+!!$  INTEGER,DIMENSION(jjm),INTENT(OUT) :: jind
+
+  !! 0.3 Modified variables 
+
+  INTEGER,INTENT(INOUT)               :: force_id
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(:),ALLOCATABLE         :: lon_file, lon_temp
+  REAL,DIMENSION(:,:),ALLOCATABLE       :: nav_lon, nav_lat
+  REAL,DIMENSION(:),ALLOCATABLE         :: lat_file, lat_temp
+  REAL,DIMENSION(:,:),ALLOCATABLE       :: lsm_file
+  REAL     :: xextent_file, yextent_file, xres_file, yres_file
+  INTEGER  :: i, j, plotstep
+  REAL,DIMENSION(iim,jjm)               :: mask
+  CHARACTER(LEN=1),DIMENSION(0:1)       :: maskchar
+  CHARACTER(LEN=30)                     :: var_name
+  REAL     :: x_cut
+  REAL,DIMENSION(iim) :: tmp_lon
+  REAL,DIMENSION(jjm) :: tmp_lat
+
+!_ ================================================================================================================================
+
+  !-
+  ! 0. messages, initialisations
+  !-
+  WRITE(numout,*) &
+       &  'weathgen_init: Minimum land fraction on original grid =',fcrit
+  CALL ioget_calendar(calendar_str)
+  !-
+  ! 1. on lit les longitudes et latitudes de la grille de depart
+  !    ainsi que le masque terre-ocean
+  !-
+  CALL flinclo(force_id)
+  CALL flininfo (filename,iim_file,jjm_file,llm_file,ttm_file,force_id)
+  !-
+  ALLOC_ERR=-1
+  ALLOCATE(nav_lon(iim_file,jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of nav_lon : ",ALLOC_ERR
+     STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(nav_lat(iim_file,jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of nav_lat : ",ALLOC_ERR
+     STOP 
+  ENDIF
+  !-
+  var_name='nav_lon'
+  CALL flinget (force_id,var_name,iim_file,jjm_file,0,0,1,1,nav_lon)
+  var_name='nav_lat'
+  CALL flinget (force_id,var_name,iim_file,jjm_file,0,0,1,1,nav_lat)
+  !-
+
+  ALLOC_ERR=-1
+  ALLOCATE(lon_file(iim_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of lon_file : ",ALLOC_ERR
+     STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(lat_file(jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of lat_file : ",ALLOC_ERR
+     STOP 
+  ENDIF
+  !-
+  DO i=1,iim_file
+     lon_file(i) = nav_lon(i,1)
+  ENDDO
+  DO j=1,jjm_file
+     lat_file(j) = nav_lat(1,j)
+  ENDDO
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(lsm_file(iim_file,jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of lsm_file : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+  var_name='lsmera'
+  CALL flinget (force_id,var_name,iim_file,jjm_file,0,0,1,1,lsm_file)
+!-
+! 2. La resolution du modele ne doit pas etre superieure
+!    a celle de la grille de depart
+!-
+  xextent_file = lon_file(iim_file)-lon_file(1)
+  yextent_file = lat_file(1)-lat_file(jjm_file)
+  xres_file = xextent_file/REAL(iim_file-1)
+  yres_file = yextent_file/REAL(jjm_file-1)
+!-
+  IF (xres_file > zonal_res) THEN
+    WRITE(numout,*) 'Zonal resolution of model grid too fine.'
+    WRITE(numout,*) 'Resolution of original data (deg): ', xres_file
+    STOP
+  ENDIF
+!-
+  IF (yres_file > merid_res) THEN
+    WRITE(numout,*) 'Meridional resolution of model grid too fine.'
+    WRITE(numout,*) 'Resolution of original data (deg): ', yres_file
+    STOP
+  ENDIF
+!-
+! 3. On verifie la coherence des coordonnees de depart et d'arrivee.
+!    Sinon, il faut deplacer une partie du monde (rien que ca).
+!-
+  i_cut = 0
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(lon_temp(iim_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of lon_temp : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(lat_temp(jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of lat_temp : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+  IF (lon(iim,1) > lon_file(iim_file)) THEN
+!-- A l'Est de la region d'interet, il n'y a pas de donnees
+!-- le bout a l'Ouest de la region d'interet est deplace de 360 deg
+!-- vers l'Est
+    x_cut = lon(1,1)
+    DO i=1,iim_file
+      IF (lon_file(i) < x_cut) i_cut = i
+    ENDDO
+    IF ((i_cut < 1).OR.(i_cut >= iim_file)) THEN
+        STOP 'Cannot find longitude for domain shift'
+    ENDIF
+!---
+    lon_temp(1:iim_file-i_cut-1) = lon_file(i_cut:iim_file)
+    lon_temp(iim_file-i_cut:iim_file) = lon_file(1:i_cut+1)+360.
+    lon_file(:) = lon_temp(:)
+  ELSEIF (lon(1,1) < lon_file(1)) THEN
+!-- A l'Ouest de la region d'interet, il n'y a pas de donnees
+!-- le bout a l'Est de la region d'interet est deplace de 360 deg
+!-- vers l'Ouest
+    x_cut = lon(iim,1)
+    DO i=1,iim_file
+      IF (lon_file(i) < x_cut) i_cut = i
+    ENDDO
+    IF ( ( i_cut < 1 ) .OR. ( i_cut >= iim_file ) ) THEN
+        STOP 'Cannot find longitude for domain shift'
+    ENDIF
+!---
+    lon_temp(1:iim_file-i_cut-1) = lon_file(i_cut:iim_file) -360.
+    lon_temp(iim_file-i_cut:iim_file) = lon_file(1:i_cut+1)
+    lon_file(:) = lon_temp(:)
+  ENDIF
+!-
+  DEALLOCATE (lon_temp)
+  DEALLOCATE (lat_temp)
+!-
+  IF (    (lon(1,1) < lon_file(1)) &
+ &    .OR.(     (lon(iim,1) > lon_file(iim_file)) &
+ &         .AND.(lon(iim,1) > lon_file(1)+360.) ) ) THEN
+    WRITE(numout,*) lon(:,1)
+    WRITE(numout,*)
+    WRITE(numout,*) lon_file(:)
+    STOP 'weathgen_init: cannot find coherent x-coordinates'
+  ENDIF
+!-
+  IF (i_cut /= 0) THEN
+    CALL shift_field (iim_file,jjm_file,i_cut,lsm_file)
+  ENDIF
+!-
+! 4. Verification
+!-
+  WRITE(numout,*)
+  WRITE(numout,*) 'Input File: (Shifted) Global Land-Sea Mask'
+  WRITE(numout,*)
+  maskchar(0) = '-'
+  maskchar(1) = 'X'
+  plotstep = INT(REAL(iim_file-1)/termcol)+1
+  DO j=1,jjm_file,plotstep
+    DO i=1,iim_file,plotstep
+      WRITE(numout,'(a1,$)') maskchar(NINT(lsm_file(i,j)))
+    ENDDO
+    WRITE(numout,*)
+  ENDDO
+  WRITE(numout,*)
+!-
+! 5. Prepare interpolation from fine grid land points to model grid
+!-
+! 5.1 how many grid points of the original grid fall into one grid
+!     box of the model grid?
+!-
+  n_agg = NINT((zonal_res/xres_file*merid_res/yres_file )+1.)
+!-
+! au diable l'avarice !
+!-
+  n_agg = n_agg*2
+!-
+! 5.2 Allocate arrays where we store information about which
+!     (and how many) points on the original grid fall
+!     into which box on the model grid
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(ncorr(iim,jjm), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of ncorr : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(icorr(iim,jjm,n_agg), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of icorr : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(jcorr(iim,jjm,n_agg), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of jcorr : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+! 6. Land-Ocean Mask on model grid
+!-
+  tmp_lon = lon(:,1)
+  tmp_lat = lat(1,:)
+
+  CALL mask_c_o &
+ &  (iim_file, jjm_file, lon_file, lat_file, lsm_file, fcrit, &
+ &   iim, jjm, zonal_res, merid_res, n_agg, tmp_lon, tmp_lat, &
+! &   iim, jjm, zonal_res, merid_res, n_agg, lon(:,1), lat(1,:), &
+ &   mask, ncorr, icorr, jcorr)
+!-
+  WRITE(numout,*) 'Land-Sea Mask on Model Grid'
+  WRITE(numout,*)
+  plotstep = INT(REAL(iim-1)/termcol)+1
+  DO j=1,jjm,plotstep
+    DO i=1,iim,plotstep
+      WRITE(numout,'(a1,$)') maskchar(NINT(mask(i,j)))
+    ENDDO
+    WRITE(numout,*)
+  ENDDO
+  WRITE(numout,*)
+!-
+! 7. kindex table.
+!-
+  nbindex = 0
+  DO j=1,jjm
+    DO i=1,iim
+      IF (NINT(mask(i,j)) == 1) THEN
+        nbindex = nbindex+1
+        kindex(nbindex) = (j-1)*iim+i
+      ENDIF
+    ENDDO
+  ENDDO
+  nbindex_w = nbindex
+  ALLOC_ERR=-1
+  ALLOCATE(kindex_w(nbindex_w), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of kindex_w : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  kindex_w(:)=kindex(1:nbindex)
+!-
+  IF ( nbindex == 0 ) THEN
+    WRITE(numout,*) 'Sorry, you are in the middle of the ocean. Check your coordinates.'
+    STOP 
+  ELSE
+    WRITE(numout,*) 'Number of continental points: ',nbindex
+  ENDIF
+
+!-
+! 10. clean up
+!-
+  DEALLOCATE (lon_file)
+  DEALLOCATE (lat_file)
+  DEALLOCATE (lsm_file)
+
+END SUBROUTINE weathgen_init
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_read_file
+!!
+!>\BRIEF         This subroutine allocates variables and reads files.  
+!!
+!! DESCRIPTION  :  
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_read_file &
+     & (force_id,iim,jjm)
+  !---------------------------------------------------------------------
+  IMPLICIT NONE
+  !-
+
+  !! 0. Variables and parameters declaration
+
+  REAL,PARAMETER  :: fcrit = .5
+
+  !! 0.1 Input variables 
+
+  INTEGER,INTENT(IN)                  :: force_id
+  INTEGER,INTENT(IN)                  :: iim, jjm
+
+  !! 0.4 Local variables
+
+  CHARACTER(LEN=30)               :: var_name
+
+  INTEGER,DIMENSION(iim*jjm)  :: kindex
+  INTEGER                     :: nbindex
+
+  REAL,DIMENSION(iim*jjm)     :: xchamp
+  REAL,DIMENSION(iim*jjm,nmon)  :: xchampm
+
+!_ ================================================================================================================================
+
+  kindex(:)=0
+
+#ifdef CPP_PARA
+  nbindex=nbp_loc
+  CALL scatter(index_g,kindex)
+  kindex(1:nbindex)=kindex(1:nbindex)-(jj_begin-1)*iim_g
+#else
+  ! Copy saved land points index
+  nbindex = nbindex_w
+  kindex(1:nbindex_w) = kindex_w(:)
+#endif
+
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(lat_land(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of lat_land : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+!-
+! 8 topography
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xintopo(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xintopo : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+  var_name='altitude'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,1,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchamp)
+  xintopo(:)=xchamp(kindex(1:nbindex))
+!-
+! 9. Allocate and read the monthly fields
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xinwet(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xinwet : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='prs'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xinwet(:,:)=xchampm(kindex(1:nbindex),:)
+  !-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xinprec(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xinprec : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='prm'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xinprec(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+  
+  ALLOC_ERR=-1
+  ALLOCATE(xint(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xint : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='t2m'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xint(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xinq(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xinq : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='r2m'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xinq(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xinwind(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xinwind : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='uv10m'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xinwind(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xincld(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xincld : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='tc'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                       iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xincld(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xintrng(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xintrng : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='t2a'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                       iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xintrng(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+! 10. clean up
+!-
+  IF (is_root_prc) THEN
+     DEALLOCATE (ncorr)
+     DEALLOCATE (icorr)
+     DEALLOCATE (jcorr)
+  ENDIF
+
+!-
+! 12. Allocate space for daily mean values
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(iwet(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of iwet : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(psurfm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of psurfm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(cloudm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of cloudm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(tmaxm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of tmaxm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(tminm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of tminm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(qdm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of qdm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(udm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of udm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(precipm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of precipm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(psurfm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of psurfm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(cloudm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of cloudm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(tmaxm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of tmaxm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(tminm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of tminm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(qdm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of qdm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(udm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of udm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(precipm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of precipm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+END SUBROUTINE weathgen_read_file
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_begin
+!!
+!>\BRIEF         This subroutines initializes variables or reads restart values. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::nbindex, ::tair, ::pb, ::qair, ::kindex
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_begin ( &
+     & dt_force,itau, date0, &
+     & rest_id,iim,jjm, &
+     & lon,lat,tair,pb,qair,kindex,nbindex)
+  !---------------------------------------------------------------------
+  IMPLICIT NONE
+
+  !-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN)                     :: dt_force, date0
+  INTEGER,INTENT(IN)                  :: itau
+  INTEGER,INTENT(IN)                  :: rest_id
+  INTEGER,INTENT(IN)                  :: iim, jjm
+  REAL,DIMENSION(iim,jjm),INTENT(IN)  :: lon,lat
+
+  !! 0.2 Output variables 
+
+  INTEGER,INTENT(OUT)                     :: nbindex
+  INTEGER,DIMENSION(iim*jjm),INTENT(OUT)  :: kindex
+  REAL,DIMENSION(iim,jjm),INTENT(OUT)     :: tair,pb,qair
+
+  !! 0.4 Local variables
+
+  INTEGER  :: i, j, ij
+  REAL     :: val_exp
+  REAL,DIMENSION(iim*jjm)               :: xchamp
+  REAL,DIMENSION(iim_g*jjm_g)           :: xchamp_g
+  CHARACTER(LEN=30)                     :: var_name
+  REAL,DIMENSION(1)                     :: jullasttab
+  REAL,DIMENSION(seedsize_max)          :: seed_in_file
+  INTEGER,DIMENSION(:), ALLOCATABLE     :: seed_in_proc
+  INTEGER  :: seedsize, iret
+  INTEGER  :: nlonid, nlatid, nlonid1, nlatid1, tdimid1, varid
+  INTEGER  :: ndim, dims(4)
+  CHARACTER(LEN=30) :: assoc
+  CHARACTER(LEN=70) :: str70
+  CHARACTER(LEN=80) :: stamp
+  INTEGER  :: yy_b, mm_b, dd_b, hh, mm
+  REAL     :: ss
+  CHARACTER(LEN=10) :: today, att
+  INTEGER  :: nlandid1, nlandid, nlevid, nlevid1
+  REAL     :: lev_max, lev_min
+  REAL     :: height_lev1
+  INTEGER  :: imois
+  REAL     :: xx, td
+
+!_ ================================================================================================================================
+
+  kindex(:)=0
+
+#ifdef CPP_PARA
+  nbindex=nbp_loc
+  CALL scatter(index_g,kindex)
+  kindex(1:nbindex)=kindex(1:nbindex)-(jj_begin-1)*iim_g
+#else
+  ! Copy saved land points index
+  nbindex = nbindex_w
+  kindex(1:nbindex_w) = kindex_w(:)
+#endif
+!-
+! 13. Prescribed or statistical values?
+!-
+  !Config Key   = IPPREC
+  !Config Desc  = Use prescribed values
+  !Config If    = ALLOW_WEATHERGEN
+  !Config Def   = 0
+  !Config Help  = If this is set to 1, the weather generator
+  !Config         uses the monthly mean values for daily means.
+  !Config         If it is set to 0, the weather generator
+  !Config         uses statistical relationships to derive daily
+  !Config         values from monthly means.
+  !Config Units = [-] 
+  ipprec = 0
+  CALL getin_p ('IPPREC',ipprec)
+  WRITE(numout,*) 'IPPREC: ',ipprec
+!-
+! 14. Do we want exact monthly precipitations even with ipprec=0 ?
+!-
+  !Config Key   = WEATHGEN_PRECIP_EXACT
+  !Config Desc  = Exact monthly precipitation
+  !Config If    = ALLOW_WEATHERGEN
+  !Config Def   = n
+  !Config Help  = If this is set to y, the weather generator
+  !Config         will generate pseudo-random precipitations
+  !Config         whose monthly mean is exactly the prescribed one.
+  !Config         In this case, the daily precipitation (for rainy
+  !Config         days) is constant (that is, some days have 0 precip,
+  !Config         the other days have precip=Precip_month/n_precip,
+  !Config         where n_precip is the prescribed number of rainy days
+  !Config         per month).
+  !Config Units = [FLAG]
+  precip_exact = .FALSE.
+  CALL getin_p ('WEATHGEN_PRECIP_EXACT',precip_exact)
+  WRITE(numout,*) 'PRECIP_EXACT: ',precip_exact
+
+!-
+! 15. Read restart file
+!-
+  CALL ioget_expval (val_exp)
+!-
+  var_name= 'julian'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id,var_name,1,1,1,itau,.TRUE.,jullasttab)
+     IF (jullasttab(1) == val_exp) THEN
+        jullasttab(1) = itau2date(itau-1, date0, dt_force)
+     ENDIF
+  ENDIF
+  CALL bcast(jullasttab)
+  julian_last = jullasttab(1)
+!-
+  var_name= 'seed'
+  IF (is_root_prc) &
+       CALL restget (rest_id,var_name,seedsize_max, &
+ &              1,1,itau,.TRUE.,seed_in_file)
+  CALL bcast(seed_in_file)
+  IF (ALL(seed_in_file(:) == val_exp)) THEN
+!---
+!-- there is no need to reinitialize the random number generator as
+!-- this does not seem to be a restart
+!---
+    CONTINUE
+  ELSE
+!---
+!-- reinitialize the random number generator
+!---
+     IF (is_root_prc) &
+          CALL RANDOM_SEED( SIZE = seedsize )
+     CALL bcast(seedsize)
+     IF (seedsize > seedsize_max) THEN
+        STOP 'weathgen_begin: increase seedsize_max'
+     ENDIF
+  
+     IF (precip_exact) THEN
+!---
+!-- preparer un tableau utilise pour determiner s'il pleut ou pas
+!-- (en fct. du nombre de jours de pluie par mois).
+!---
+        IF (is_root_prc) THEN
+           DO imois=1,12
+              CALL permute (ndaypm(imois),jour_precip(:,imois))
+           ENDDO
+        ENDIF
+       CALL bcast(jour_precip)
+    ENDIF
+
+    ALLOC_ERR=-1
+    ALLOCATE(seed_in_proc(seedsize), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of seed_in_proc : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    seed_in_proc(1:seedsize) = NINT( seed_in_file(1:seedsize) )
+    CALL RANDOM_SEED (PUT = seed_in_proc)
+    DEALLOCATE( seed_in_proc )
+ ENDIF
+!-
+  var_name= 'iwet'
+  IF (is_root_prc) THEN
+    CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+    IF (ALL(xchamp_g(:) == val_exp)) THEN
+      xchamp_g(:) = zero
+    ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  iwet(:) = NINT(xchamp(kindex(1:nbindex)))
+!-
+  var_name= 'psurfm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 100000.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  psurfm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'cloudm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = .5
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  cloudm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'tmaxm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 285.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  tmaxm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'tminm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 275.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  tminm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'qdm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 1.E-03
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  qdm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'udm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 2.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  udm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'precipm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 1.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  precipm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'psurfm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 100000.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  psurfm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'cloudm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = .5
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  cloudm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'tmaxm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 285.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  tmaxm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'tminm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 275.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  tminm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'qdm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 1.E-03
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  qdm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'udm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 2.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  udm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'precipm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 1.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  precipm1(:) = xchamp(kindex(1:nbindex))
+
+!-
+! 16. We still need instantaneous tair, qair, and the surface pressure
+!     We take daily mean values read from the restart file
+!-
+!!$  tair(:,:)=280.
+!!$  qair(:,:)=1.E-03
+!!$  pb(:,:)=101325
+  tair(:,:)=val_exp
+  qair(:,:)=val_exp
+  pb(:,:)=val_exp
+  xx = cte_grav/rair/0.0065
+  DO ij=1,nbindex
+     j = ((kindex(ij)-1)/iim) + 1
+     i = kindex(ij) - (j-1)*iim
+     
+     lat_land(ij) = lat(i,j)
+     
+     td =  (tmaxm0(ij)+tminm0(ij))/2.
+     tair(i,j) = td
+     qair(i,j) = qdm1(ij)
+     pb(i,j) = 101325.*(td/(td+0.0065*xintopo(ij)))**xx
+  ENDDO
+!-
+! 17. We can write a forcing file for Orchidee
+!     from this weather Generator run.
+!-
+  !Config Key   = DUMP_WEATHER
+  !Config Desc  = Write weather from generator into a forcing file
+  !Config If    = ALLOW_WEATHERGEN  
+  !Config Def   = n
+  !Config Help  = This flag makes the weather generator dump its
+  !Config         generated weather into a forcing file which can
+  !Config         then be used to get the same forcing on different
+  !Config         machines. This only works correctly if there is
+  !Config         a restart file (otherwise the forcing at the first
+  !Config         time step is slightly wrong).
+  !Config Units = [FLAG]
+  dump_weather = .FALSE.
+  CALL getin_p ('DUMP_WEATHER',dump_weather)
+!-
+  IF (dump_weather .AND. is_root_prc) THEN
+!---
+!-- Initialize the file
+!---
+     !Config Key   = DUMP_WEATHER_FILE
+     !Config Desc  = Name of the file that contains the weather from generator
+     !Config If    = DUMP_WEATHER
+     !Config Def   = weather_dump.nc
+     !Config Help  =
+     !Config Units = [FILE]
+    dump_weather_file = 'weather_dump.nc'
+    CALL getin ('DUMP_WEATHER_FILE',dump_weather_file)
+!---
+    !Config Key   = DUMP_WEATHER_GATHERED
+    !Config Desc  = Dump weather data on gathered grid
+    !Config If    = DUMP_WEATHER
+    !Config Def   = y
+    !Config Help  = If 'y', the weather data are gathered for all land points.
+    !Config Units = [FLAG]
+    gathered = .TRUE.
+    CALL getin ('DUMP_WEATHER_GATHERED',gathered)
+!---
+    iret = NF90_CREATE (TRIM(dump_weather_file),NF90_CLOBBER,dump_id)
+!---
+!-- Dimensions
+!---
+    iret = NF90_DEF_DIM (dump_id,'x',iim_g,nlonid1)
+    iret = NF90_DEF_DIM (dump_id,'y',jjm_g,nlatid1)
+    iret = NF90_DEF_DIM (dump_id,'z',  1,nlevid1)
+!---
+    IF (gathered) THEN
+      iret = NF90_DEF_DIM (dump_id,'land',nbp_glo,nlandid1)
+    ENDIF
+    iret = NF90_DEF_DIM (dump_id,'tstep',NF90_UNLIMITED,tdimid1)
+!---
+!-- Coordinate variables
+!---
+    dims(1:2) = (/ nlonid1, nlatid1 /)
+!---
+    iret = NF90_DEF_VAR (dump_id,'nav_lon',n_rtp,dims(1:2),nlonid)
+    iret = NF90_PUT_ATT (dump_id,nlonid,'units',"degrees_east")
+    iret = NF90_PUT_ATT (dump_id,nlonid,'valid_min',MINVAL(lon_g))
+    iret = NF90_PUT_ATT (dump_id,nlonid,'valid_max',MAXVAL(lon_g))
+    iret = NF90_PUT_ATT (dump_id,nlonid,'long_name',"Longitude")
+!---
+    iret = NF90_DEF_VAR (dump_id,'nav_lat',n_rtp,dims(1:2),nlatid)
+    iret = NF90_PUT_ATT (dump_id,nlatid,'units',"degrees_north")
+    iret = NF90_PUT_ATT (dump_id,nlatid,'valid_min',MINVAL(lat_g))
+    iret = NF90_PUT_ATT (dump_id,nlatid,'valid_max',MAXVAL(lat_g))
+    iret = NF90_PUT_ATT (dump_id,nlatid,'long_name',"Latitude")
+!---
+    height_lev1 = 10.
+    !Config Key   = HEIGHT_LEV1_DUMP
+    !Config Desc  = 
+    !Config If    = DUMP_WEATHER
+    !Config Def   = 10.
+    !Config Help  = 
+    !Config Units = [m]
+    CALL getin ('HEIGHT_LEV1_DUMP',height_lev1)
+    lev_min = height_lev1
+    lev_max = height_lev1
+!---
+    iret = NF90_DEF_VAR (dump_id,'level',n_rtp,(/ nlevid1 /),nlevid)
+    iret = NF90_PUT_ATT (dump_id,nlevid,'units',"m")
+    iret = NF90_PUT_ATT (dump_id,nlevid,'valid_min',lev_min)
+    iret = NF90_PUT_ATT (dump_id,nlevid,'valid_max',lev_max)
+    iret = NF90_PUT_ATT (dump_id,nlevid,'long_name',"Vertical levels")
+!---
+    IF (gathered) THEN
+      iret = NF90_DEF_VAR (dump_id,'land',NF90_INT,(/ nlandid1 /),nlandid)
+      iret = NF90_PUT_ATT (dump_id,nlandid,'compress',"y x")
+    ENDIF
+!---
+!-- Store the time axes.
+!---
+    iret = NF90_DEF_VAR (dump_id,'time',n_rtp,tdimid1,time_id)
+
+    yy_b=0
+    mm_b=1
+    dd_b=1
+    hh=00
+    mm=00
+    ss=0.
+
+    WRITE (str70,7000) yy_b, mm_b, dd_b, hh, mm, INT(ss)
+    iret = NF90_PUT_ATT (dump_id,time_id,'units',TRIM(str70))
+    iret = NF90_PUT_ATT (dump_id,time_id,'calendar',TRIM(calendar_str))
+    iret = NF90_PUT_ATT (dump_id,time_id,'title','Time')
+    iret = NF90_PUT_ATT (dump_id,time_id,'long_name','Time axis')
+    WRITE(str70,7001) yy_b, cal(mm_b), dd_b, hh, mm, INT(ss)
+    iret = NF90_PUT_ATT (dump_id,time_id,'time_origin',TRIM(str70))
+!---
+!-- Time steps
+!---
+    iret = NF90_DEF_VAR (dump_id,'timestp',NF90_INT,tdimid1,timestp_id)
+    WRITE(str70,7002) yy_b, mm_b, dd_b, hh, mm, INT(ss)
+    iret = NF90_PUT_ATT (dump_id,timestp_id,'units',TRIM(str70))
+    iret = NF90_PUT_ATT (dump_id,timestp_id,'title','Time steps')
+    iret = NF90_PUT_ATT (dump_id,timestp_id,'tstep_sec',dt_force)
+    iret = NF90_PUT_ATT &
+ &           (dump_id,timestp_id,'long_name','Time step axis')
+    WRITE(str70,7001) yy_b, cal(mm_b), dd_b, hh, mm, INT(ss)
+    iret = NF90_PUT_ATT (dump_id,timestp_id,'time_origin',TRIM(str70))
+!---
+7000 FORMAT('seconds since ',I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)
+7001 FORMAT(' ',I4.4,'-',A3,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)
+7002 FORMAT('timesteps since ', I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)
+!---
+!-- The variables in the file are declared and their attributes
+!-- written.
+!---
+    IF (gathered) THEN
+      ndim = 2
+      dims(1:2) = (/ nlandid1, tdimid1 /)
+      assoc = 'time (nav_lat nav_lon)'
+    ELSE
+      ndim = 3
+      dims(1:3) = (/ nlonid1, nlatid1, tdimid1 /)
+      assoc = 'time nav_lat nav_lon'
+    ENDIF
+!---
+    iret = NF90_DEF_VAR (dump_id,'SWdown',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','W/m^2')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Surface incident shortwave radiation')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    soldownid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Rainf',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','kg/m^2s')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Rainfall rate')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    rainfid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Snowf',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','kg/m^2s')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Snowfall rate')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    snowfid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'LWdown',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','W/m^2')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Surface incident longwave radiation')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    lwradid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'PSurf',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','Pa')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Surface pressure')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    psolid = varid
+!---
+!-- 3D Variables to be written
+!---
+    IF (gathered) THEN
+      ndim = 3
+      dims(1:3) = (/ nlandid1, nlevid1, tdimid1 /)
+      assoc = 'time level (nav_lat nav_lon)'
+    ELSE
+      ndim = 4
+      dims(1:4) = (/ nlonid1, nlatid1, nlevid1, tdimid1 /)
+      assoc = 'time level nav_lat nav_lon'
+    ENDIF
+!---
+    iret = NF90_DEF_VAR (dump_id,'Tair',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TZYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','K')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Near surface air temperature')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    tairid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Qair',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TZYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','kg/kg')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Near surface specific humidity')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    qairid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Wind_N',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TZYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','m/s')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Near surface northward wind component')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    uid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Wind_E',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TZYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','m/s')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Near surface eastward wind component')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    vid = varid
+!---
+!-- Global attributes
+!---
+    CALL DATE_AND_TIME (today, att)
+    stamp = "WG, date: "//TRIM(today)//" at "//TRIM(att)
+    iret = NF90_PUT_ATT (dump_id,NF90_GLOBAL,'Conventions',"GDT 1.2")
+    iret = NF90_PUT_ATT (dump_id,NF90_GLOBAL,'file_name', &
+ &                       TRIM(dump_weather_file))
+    iret = NF90_PUT_ATT (dump_id,NF90_GLOBAL,'production',TRIM(stamp))
+!---
+!-- Finish the definition phase
+!---
+    iret = NF90_ENDDEF (dump_id)
+!---
+!--    Write coordinates
+!---
+    iret = NF90_PUT_VAR (dump_id,nlonid,lon_g)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(numout,*) iret
+       CALL ipslerr_p (3,'weathgen_begin', &
+ &          'Could not put variable nav_lon in the file : ', &
+ &          TRIM(dump_weather_file),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_VAR (dump_id,nlatid,lat_g)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(numout,*) iret
+       CALL ipslerr_p (3,'weathgen_begin', &
+ &          'Could not put variable nav_lat in the file : ', &
+ &          TRIM(dump_weather_file),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_VAR (dump_id,nlevid,height_lev1)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(numout,*) iret
+       CALL ipslerr_p (3,'weathgen_begin', &
+ &          'Could not put variable level in the file : ', &
+ &          TRIM(dump_weather_file),'(Solution ?)')
+    ENDIF
+!---
+    IF (gathered) THEN
+       iret = NF90_PUT_VAR (dump_id,nlandid,index_g(1:nbp_glo))
+       IF (iret /= NF90_NOERR) THEN
+          WRITE(numout,*) iret
+          CALL ipslerr_p (3,'weathgen_begin', &
+ &          'Could not put variable land in the file : ', &
+ &          TRIM(dump_weather_file),'(Solution ?)')
+       ENDIF
+    ENDIF
+!---
+ ENDIF ! dump_weather
+!-----------------------------
+END SUBROUTINE weathgen_begin
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_get
+!!
+!>\BRIEF        This subroutine initializes forcing values. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::swdown, ::raina, ::snowa, ::tair, ::u, ::v, ::qair, ::psurf, ::lwdown
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_get &
+& (itau, date0, dt_force, nbindex, nband, lat, &
+&  swdown, raina, snowa, tair, u, v, qair, psurf, lwdown)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)               :: itau      !! number of time step
+  REAL,INTENT(IN)                  :: date0     !! date when itau was 0
+  REAL,INTENT(IN)                  :: dt_force  !! time step (s)
+  INTEGER,INTENT(IN)               :: nbindex   !! number of land points
+  INTEGER,INTENT(IN)               :: nband     !! number of visible bands
+  REAL,DIMENSION(nbindex),INTENT(IN)  :: lat    !! latitude (deg)
+
+  !! 0.2 Output variables  
+
+  REAL,DIMENSION(nbindex,nband),INTENT(OUT) :: swdown        !! Downward solar radiation @tex $(W.m^{-2})$ @endtex
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: raina, snowa  !! precipitations @tex $(mm.day^{-1})$ @endtex 
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: tair          !! air temperature (K)
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: u,v           !! wind speed @tex $(m.s^{-1})$ @endtex
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: qair          !! air humidity @tex $(kg_h2o.kg_air^{-1})$ @endtex
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: psurf         !! Surface pressure (Pa)
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: lwdown        !! Downward long wave radiation @tex $(W.m^{-2})$ @endtex
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(nbindex)        :: cloud, tmax, tmin, precipd, qd, ud
+  REAL,DIMENSION(nbindex)        :: rh
+  REAL,DIMENSION(nbindex,nband)  :: solai, solad
+  REAL                        :: julian, jur
+  REAL                        :: x
+  INTEGER                     :: yy, mm, dd
+  REAL                        :: ss, plens, time
+
+!_ ================================================================================================================================
+
+!-
+! 1. get a reduced julian day
+!-
+  julian = itau2date(itau-1, date0, dt_force)
+!S. Zaehle, test: solar noon at 12 o'clock!
+!  julian = itau2date(itau, date0, dt_force)
+  CALL ju2ymds (julian, yy, mm, dd, ss)
+  CALL ymds2ju (yy,1,1,0.0, jur)
+  julian = julian-jur
+  CALL ju2ymds (julian, yy, mm, dd, ss)
+!-
+! 2. daily values
+!-
+  IF (INT(julian_last) /= INT(julian)) THEN
+!-- today's values become yesterday's values
+    cloudm1(:) = cloudm0(:)
+    tmaxm1(:) = tmaxm0(:)
+    tminm1(:) = tminm0(:)
+    precipm1(:) = precipm0(:)
+    qdm1(:) = qdm0(:)
+    udm1(:) = udm0(:)
+    psurfm1(:) = psurfm0(:)
+!-- we have to get new daily values
+!!$    WRITE(*,*) mpi_rank, "weathgen_get : date ",yy, mm, dd, ss
+!!$    WRITE(*,*) mpi_rank, "weathgen_get : grid date ",year, month, day, sec
+    CALL daily (nbindex, mm, dd, cloudm0, tmaxm0, tminm0, &
+ &              precipm0, qdm0, udm0, psurfm0)
+  ENDIF
+!-
+! 3. interpolate daily values
+!    (otherwise we get ugly temperature jumps at midnight)
+!-
+  x = (julian-INT(julian))
+!-
+  cloud(:) = (1.-x)*cloudm1(:)+x*cloudm0(:)
+  tmax(:) = (1.-x)*tmaxm1(:)+x*tmaxm0(:)
+  tmin(:) = (1.-x)*tminm1(:)+x*tminm0(:)
+  precipd(:) = (1.-x)*precipm1(:)+x*precipm0(:)
+  qd(:) = (1.-x)*qdm1(:)+x*qdm0(:)
+  ud(:) = (1.-x)*udm1(:)+x*udm0(:)
+  psurf(:) = (1.-x)*psurfm1(:)+x*psurfm0(:)
+!-
+! 4. read instantaneous values
+!-
+  plens = one_day/dt_force
+  time = (julian-REAL(INT(julian)))*one_day
+!-
+  CALL diurnal (nbindex, nband, time, NINT(julian), plens, 0., one_day, &
+ &              lat, cloud, tmax, tmin, precipd, qd, ud, psurf, &
+ &              lwdown, solad, solai, u, tair, qair, raina, snowa, rh)
+!-
+  raina(:) = raina(:)/dt_force
+  snowa(:) = snowa(:)/dt_force
+!-
+  swdown(:,:) = solad(:,:)+solai(:,:)
+!-
+  v(:) = zero
+!-
+! 5. Store date
+!-
+  julian_last = julian
+!--------------------------
+END SUBROUTINE weathgen_get
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_restwrite
+!!
+!>\BRIEF         This subroutine writes data in the restart file.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_restwrite (rest_id,itau,iim,jjm,nbindex,kindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)  :: rest_id,itau,iim,jjm,nbindex
+  INTEGER,DIMENSION(iim*jjm),INTENT(IN) :: kindex
+
+  !! 0.4 Local variables
+
+  CHARACTER(LEN=30)                 :: var_name
+  INTEGER                           :: i,j,ij
+  REAL,DIMENSION(1)                 :: jullasttab
+  REAL,DIMENSION(seedsize_max)      :: seed_in_file
+  INTEGER,DIMENSION(:),ALLOCATABLE  :: seed_in_proc
+  INTEGER                           :: seedsize
+  REAL                              :: rndnum
+  REAL,DIMENSION(iim*jjm)           :: xchamp
+  REAL,DIMENSION(iim_g*jjm_g)       :: xchamp_g
+
+!_ ================================================================================================================================
+
+  var_name= 'julian'
+  jullasttab(:) = julian_last
+  IF (is_root_prc) CALL restput (rest_id, var_name, 1, 1, 1, itau, jullasttab)
+!-
+  IF (is_root_prc) THEN
+     CALL RANDOM_SEED( SIZE = seedsize )
+     IF (seedsize > seedsize_max) THEN
+        STOP 'weathgen_restwrite: increase seedsize_max'
+     ENDIF
+  ENDIF
+  CALL bcast(seedsize)
+
+  IF (is_root_prc) THEN
+     ALLOC_ERR=-1
+     ALLOCATE(seed_in_proc(seedsize), STAT=ALLOC_ERR)
+     IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of seed_in_proc : ",ALLOC_ERR
+        STOP 
+     ENDIF
+!-
+     CALL RANDOM_SEED (GET = seed_in_proc)
+!-
+     seed_in_file(1:seedsize) = REAL(seed_in_proc(1:seedsize))
+!-
+! fill in the seed up to seedsize_max
+! (useful in the case we restart on
+!  a machine with a longer seed vector:
+!  we do not want a degenerated seed)
+!-
+     DO i=seedsize+1,seedsize_max
+        CALL RANDOM_NUMBER( rndnum )
+        seed_in_file(i) = 100000.*rndnum
+     ENDDO
+  ENDIF
+  CALL bcast (seed_in_file)
+!-
+  IF (is_root_prc) THEN
+     DEALLOCATE( seed_in_proc )
+!-
+     var_name= 'seed'
+     CALL restput (rest_id,var_name,seedsize_max,1,1,itau,seed_in_file)
+  ENDIF
+!-
+
+  xchamp(:) = val_exp
+  
+!!$  DO j=1,jjm
+!!$    DO i=1,iim
+!!$      ij = (j-1)*iim+i
+!!$      xchamp(i,j) = REAL(iwet(ij))
+!!$    ENDDO
+!!$  ENDDO
+  DO ij=1,nbindex
+     xchamp(kindex(ij)) = REAL(iwet(ij))
+  ENDDO
+  var_name= 'iwet'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = psurfm0(ij)
+  ENDDO
+  var_name= 'psurfm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = cloudm0(ij)
+  ENDDO
+  var_name= 'cloudm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = tmaxm0(ij)
+  ENDDO
+  var_name= 'tmaxm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = tminm0(ij)
+  ENDDO
+  var_name= 'tminm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = qdm0(ij)
+  ENDDO
+  var_name= 'qdm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = udm0(ij)
+  ENDDO
+  var_name= 'udm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = precipm0(ij)
+  ENDDO
+  var_name= 'precipm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = psurfm1(ij)
+  ENDDO
+  var_name= 'psurfm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = cloudm1(ij)
+  ENDDO
+  var_name= 'cloudm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = tmaxm1(ij)
+  ENDDO
+  var_name= 'tmaxm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = tminm1(ij)
+  ENDDO
+  var_name= 'tminm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = qdm1(ij)
+  ENDDO
+  var_name= 'qdm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = udm1(ij)
+  ENDDO
+  var_name= 'udm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = precipm1(ij)
+  ENDDO
+  var_name= 'precipm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!--------------------------------
+END SUBROUTINE weathgen_restwrite
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_data
+!!
+!>\BRIEF         This subroutine reads data from an netcdf file. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::champout
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weather_read &
+& (force_id,nomvar,iim_file,jjm_file,n3,i_cut, &
+&  iim,jjm,n_agg,ncorr,icorr,jcorr,champout)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+  
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                          :: force_id
+  CHARACTER(LEN=*),INTENT(IN)                 :: nomvar
+  INTEGER,INTENT(IN)                          :: iim_file,jjm_file
+  INTEGER,INTENT(IN)                          :: n3
+  INTEGER,INTENT(IN)                          :: i_cut
+  INTEGER,INTENT(IN)                          :: iim,jjm
+  INTEGER,INTENT(IN)                          :: n_agg
+  INTEGER,DIMENSION(:,:),INTENT(IN)           :: ncorr
+  INTEGER,DIMENSION(:,:,:),INTENT(IN)         :: icorr,jcorr
+
+  !! 0.2 Output variables 
+
+  REAL,DIMENSION(iim*jjm,n3),INTENT(OUT)      :: champout
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(iim_file,jjm_file,n3)        :: champ_file
+  REAL,ALLOCATABLE,DIMENSION(:,:)             :: champout_g
+  INTEGER                                     :: i,j,ij,l,m
+
+!_ ================================================================================================================================
+
+  WRITE(numout,*) 'Lecture ',TRIM(nomvar)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(champout_g(iim_g*jjm_g,n3))
+     IF ( n3 == 1 ) THEN
+        CALL flinget (force_id,nomvar(1:LEN_TRIM(nomvar)), &
+             &                iim_file, jjm_file, 0, 0,  1, 1, champ_file)
+     ELSE
+        DO l=1,n3
+           CALL flinget &
+                &      (force_id,nomvar(1:LEN_TRIM(nomvar)), &
+                &       iim_file, jjm_file, 0, n3,  l, l, champ_file(:,:,l))
+        ENDDO
+     ENDIF
+     ! shift if necessary
+     IF (i_cut /= 0) THEN
+        DO l=1,n3
+           CALL shift_field (iim_file,jjm_file,i_cut,champ_file(:,:,l))
+        ENDDO
+     ENDIF
+     ! interpolate onto the model grid
+     DO l=1,n3
+        DO j=1,jjm_g
+           DO i=1,iim_g
+              ij = i+(j-1)*iim_g
+              champout_g(ij,l) = zero
+              DO m=1,ncorr(i,j)
+                 champout_g(ij,l) = champout_g(ij,l) &
+        &                        +champ_file(icorr(i,j,m),jcorr(i,j,m),l)
+              ENDDO
+              champout_g(ij,l) = champout_g(ij,l)/REAL(ncorr(i,j))
+           ENDDO
+        ENDDO
+     ENDDO
+!$     DO l=1,n3
+!$        DO j=1,jjm_g
+!$           WRITE(numout,*) j,(/ ( champout_g((j-1)*iim_g+i,l), i=1,iim_g ) /)
+!$        ENDDO
+!$     ENDDO
+  ELSE
+     ALLOCATE(champout_g(1,1))
+  ENDIF
+!!$  CALL scatter2D(champout_g,champout)
+#ifndef CPP_PARA
+  champout(:,:)=champout_g(:,:)
+#else
+  CALL orch_scatter2D_mpi_rgen(champout_g,champout,n3)
+#endif
+
+!$  DO l=1,n3
+!$     DO j=1,jjm
+!$        WRITE(numout,*) j,(/ ( champout((j-1)*iim_g+i,l), i=1,iim_g ) /)
+!$     ENDDO
+!$  ENDDO
+  !----------------------------
+END SUBROUTINE weather_read
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_dump
+!!
+!>\BRIEF        This subroutine "dumps" data before writing an netcdf file.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_dump &
+& (itau, dt_force, iim, jjm, nbindex, kindex, lrstwrite, &
+&  swdown, rainf, snowf, tair, u, v, qair, pb, lwdown )
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                     :: itau
+  REAL,INTENT(IN)                        :: dt_force
+  INTEGER,INTENT(IN)                     :: iim,jjm
+  INTEGER,INTENT(IN)                     :: nbindex
+  LOGICAL,INTENT(IN)                     :: lrstwrite
+  INTEGER,DIMENSION(iim*jjm),INTENT(IN)  :: kindex
+  REAL,DIMENSION(iim*jjm),INTENT(IN)     :: &
+ &  swdown, rainf, snowf, tair, u, v, qair, pb, lwdown
+
+  !! 0.4 Local variables
+
+  INTEGER                 :: iret,ndim
+  INTEGER,DIMENSION(4)    :: corner,edges
+  REAL,DIMENSION(iim*jjm) :: var_gather
+
+!_ ================================================================================================================================
+
+!-
+! time dimension
+!-
+  iret = NF90_PUT_VAR (dump_id,timestp_id,(/ REAL(itau) /), &
+ &                     start=(/ itau /),count=(/ 1 /))
+  iret = NF90_PUT_VAR (dump_id,time_id,(/ REAL(itau)*dt_force /), &
+ &                     start=(/ itau /),count=(/ 1 /))
+!-
+! 2D variables: pas de dimension verticale
+!-
+  IF (gathered) THEN
+    ndim = 2
+    corner(1:2) = (/ 1, itau /)
+    edges(1:2) = (/ nbindex, 1 /)
+  ELSE
+    ndim = 3
+    corner(1:3) = (/ 1, 1, itau /)
+    edges(1:3) = (/ iim, jjm, 1 /)
+  ENDIF
+!-
+  CALL gather_weather (iim*jjm,nbindex,kindex,swdown, var_gather)
+  iret = NF90_PUT_VAR (dump_id,soldownid, var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,rainf,  var_gather)
+  iret = NF90_PUT_VAR (dump_id,rainfid,   var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,snowf,  var_gather)
+  iret = NF90_PUT_VAR (dump_id,snowfid,   var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,pb,     var_gather)
+  iret = NF90_PUT_VAR (dump_id,psolid,    var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,lwdown, var_gather)
+  iret = NF90_PUT_VAR (dump_id,lwradid,   var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+!-
+! 3D variables
+!-
+  IF (gathered) THEN
+    ndim = 3
+    corner(1:3) = (/ 1, 1, itau /)
+    edges(1:3) = (/ nbindex, 1, 1 /)
+  ELSE
+    ndim = 4
+    corner(1:4) = (/ 1, 1, 1, itau /)
+    edges(1:4) = (/ iim, jjm, 1, 1 /)
+  ENDIF
+!-
+  CALL gather_weather (iim*jjm,nbindex,kindex,u,    var_gather)
+  iret = NF90_PUT_VAR (dump_id,uid,    var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,v,    var_gather)
+  iret = NF90_PUT_VAR (dump_id,vid,    var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,tair, var_gather)
+  iret = NF90_PUT_VAR (dump_id,tairid, var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,qair, var_gather)
+  iret = NF90_PUT_VAR (dump_id,qairid, var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+!-
+  IF (lrstwrite) THEN
+    iret = NF90_CLOSE (dump_id)
+  ENDIF
+!---------------------------
+END SUBROUTINE weathgen_dump
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gather_weather
+!!
+!>\BRIEF        This subroutine determines which points are not in the computational domain and
+!! creates a mask for these points. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::var_out
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE gather_weather (iimjjm, nbindex, kindex, var_in, var_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                     :: iimjjm,nbindex
+  INTEGER,DIMENSION(iimjjm),INTENT(IN)   :: kindex
+  REAL,DIMENSION(iimjjm),INTENT(IN)      :: var_in
+
+  !! 0.2 Output variables  
+
+  REAL,DIMENSION(iimjjm),INTENT(OUT)     :: var_out
+
+  !! 0.4 Local variables
+
+  INTEGER                                :: i
+  LOGICAL,SAVE                           :: firstcall_gather_weather = .TRUE.
+  INTEGER,SAVE                           :: nb_outside
+  INTEGER,ALLOCATABLE,SAVE,DIMENSION(:)  :: outside
+
+!_ ================================================================================================================================
+
+  IF (firstcall_gather_weather) THEN
+!---
+!-- determine which points are not in the computational domain and
+!-- create a mask for these points
+!---
+    firstcall_gather_weather = .FALSE.
+  
+    ALLOC_ERR=-1
+    ALLOCATE(outside(iimjjm), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of outside : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    outside(:) = zero
+    nb_outside = 0
+    DO i=1,iimjjm
+      IF ( ALL( kindex(:) /= i ) ) THEN
+        nb_outside = nb_outside+1
+        outside(nb_outside) = i
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+  IF ( gathered ) THEN
+    DO i=1,nbindex
+      var_out(i) = var_in(kindex(i))
+    ENDDO
+  ELSE
+    var_out(:) = var_in(:)
+    DO i=1,nb_outside
+      var_out(outside(i)) = undef_sechiba
+    ENDDO
+  ENDIF
+!--------------------
+END SUBROUTINE gather_weather
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : shift_shield
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::champ
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE shift_field (im,jm,i_cut,champ)
+!---------------------------------------------------------------------
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                  :: im,jm,i_cut
+
+  !! 0.3 Modified variables
+
+  REAL,DIMENSION(im,jm),INTENT(INOUT) :: champ
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(im,jm)               :: champ_temp
+
+!_ ================================================================================================================================
+
+  IF ( (i_cut >= 1).AND.(i_cut <= im) ) THEN
+    champ_temp(1:im-i_cut-1,:) = champ(i_cut:im,:)
+    champ_temp(im-i_cut:im,:)  = champ(1:i_cut+1,:)
+    champ(:,:) = champ_temp(:,:)
+  ENDIF
+!-------------------------
+END SUBROUTINE shift_field
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_domain_size
+!!
+!>\BRIEF        This subroutine determines the size of the domain.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::iim, ::jjm, ::limit_west, ::limit_east, ::limit_north, ::limit_south
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_domain_size &
+& (limit_west,limit_east,limit_north,limit_south, &
+&  zonal_res,merid_res,iim,jjm)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN)     :: zonal_res,merid_res
+
+  !! 0.2 Output variables 
+
+  INTEGER,INTENT(OUT) :: iim,jjm
+
+  !! 0.3 Modified variables
+
+  REAL,INTENT(INOUT)  :: limit_west,limit_east,limit_north,limit_south
+
+!_ ================================================================================================================================
+
+  IF (limit_west > limit_east)  limit_east = limit_east+360.
+!-
+  IF (    (limit_west >= limit_east) &
+ &    .OR.(limit_east > 360.) &
+ &    .OR.(limit_west < -180.) &
+ &    .OR.(limit_east-limit_west > 360.) ) THEN
+    WRITE(numout,*) 'PROBLEME longitudes.'
+    WRITE(numout,*) 'Limites Ouest, Est: ',limit_west,limit_east
+    STOP
+  ENDIF
+!-
+  IF (    (limit_south < -90.) &
+ &    .OR.(limit_north > 90.) &
+ &    .OR.(limit_south >= limit_north ) ) THEN
+    WRITE(numout,*) 'PROBLEME latitudes.'
+    WRITE(numout,*) 'Limites Nord, Sud: ',limit_north,limit_south
+    STOP
+  ENDIF
+!-
+  IF (    (zonal_res <= 0. ) &
+ &    .OR.(zonal_res > limit_east-limit_west) ) THEN
+    WRITE(numout,*) 'PROBLEME resolution zonale.'
+    WRITE(numout,*) 'Limites Ouest, Est, Resolution: ', &
+ &             limit_west,limit_east,zonal_res
+    STOP
+  ENDIF
+!-
+  IF (    (merid_res <= 0.) &
+ &    .OR.(merid_res > limit_north-limit_south) ) THEN
+    WRITE(numout,*) 'PROBLEME resolution meridionale.'
+    WRITE(numout,*) 'Limites Nord, Sud, Resolution: ', &
+ &             limit_north,limit_south,merid_res
+    STOP
+  ENDIF
+!-
+  iim = NINT(MAX((limit_east-limit_west)/zonal_res,1.))
+  jjm = NINT(MAX((limit_north-limit_south)/merid_res,1.))
+!-
+  WRITE(numout,*) 'Domain size: iim, jjm = ', iim, jjm
+!----------------------------------
+END SUBROUTINE weathgen_domain_size
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! FUNCTION     : tsat1 
+!!
+!>\BRIEF         This function computes the saturated temperature for vapor. 
+!!
+!! DESCRIPTION :  functions tsatl,tsati are used below so that Lowe's
+!!                polyomial for liquid is used if t gt 273.16, or for ice if
+!!                t lt 273.16. also impose range of validity for Lowe's polys.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : tsat
+!!
+!! REFERENCE(S) : 
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+FUNCTION tsatl (t) RESULT (tsat)
+
+  !! 0. Variables and parameters declaration
+  
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN) :: t
+
+  !! 0.2 Result
+  REAL            :: tsat
+
+!_ ================================================================================================================================
+
+  tsat = MIN(100.,MAX(t-zero_t,zero))
+!-----------------
+END FUNCTION tsatl
+!-
+!===
+!-
+!! ================================================================================================================================
+!! FUNCTION     : tsati 
+!!
+!>\BRIEF         This function computes the saturated temperature for ice. 
+!!
+!! DESCRIPTION :  functions tsatl,tsati are used below so that Lowe's
+!!                polyomial for liquid is used if t gt 273.16, or for ice if
+!!                t lt 273.16. also impose range of validity for Lowe's polys.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : tsat
+!!
+!! REFERENCE(S) : 
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+FUNCTION tsati (t) RESULT (tsat)
+
+  !! 0. Variables and parameters declaration
+  
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN) :: t
+
+  !! 0.2 Result
+  REAL            :: tsat
+
+!_ ================================================================================================================================
+
+  tsat = MAX(-60.,MIN(t-zero_t,zero))
+
+!-----------------
+END FUNCTION tsati
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! FUNCTION     : esat
+!!
+!>\BRIEF         This function computes specific humidity with the polynomials of Lowe.
+!!
+!! DESCRIPTION : The function esat is svp in n/m**2, with t in deg k.
+!!               (100 * lowe's poly since 1 mb = 100 n/m**2.). \n
+!!               Polynomials for svp(t), d(svp)/dt over water and ice 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : esatout
+!!
+!! REFERENCE(S) : 
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+FUNCTION esat (t) RESULT (esatout)
+
+  !! 0. Variables and parameters declaration
+
+  REAL,PARAMETER :: &                                                    !! polynomials for svp(t), d(svp)/dt over water and ice are from
+ & asat0 = 6.1078000,    asat1 = 4.4365185e-1, asat2 = 1.4289458e-2, &   !! lowe(1977),jam,16,101-103.
+ & asat3 = 2.6506485e-4, asat4 = 3.0312404e-6, asat5 = 2.0340809e-8, &
+ & asat6 = 6.1368209e-11, &
+ & bsat0 = 6.1091780,    bsat1 = 5.0346990e-1, bsat2 = 1.8860134e-2, &
+ & bsat3 = 4.1762237e-4, bsat4 = 5.8247203e-6, bsat5 = 4.8388032e-8, &
+ & bsat6 = 1.8388269e-10
+
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN) :: t
+
+  !! 0.2 Result
+
+  REAL             :: esatout
+
+  !! 0.4 Local variables
+
+  REAL             :: x
+
+!_ ================================================================================================================================
+
+  IF (t >= zero_t) THEN
+    x = asat0
+  ELSE
+    x = bsat0
+  ENDIF
+!-
+  esatout = 100.* &
+    ( x &
+     +tsatl(t)*(asat1+tsatl(t)*(asat2+tsatl(t)*(asat3 &
+     +tsatl(t)*(asat4+tsatl(t)*(asat5+tsatl(t)* asat6))))) &
+     +tsati(t)*(bsat1+tsati(t)*(bsat2+tsati(t)*(bsat3 &
+     +tsati(t)*(bsat4+tsati(t)*(bsat5+tsati(t)* bsat6)))))  )
+!----------------
+END FUNCTION esat
+!-
+!===
+!-
+! ================================================================================================================================
+!! FUNCTION     : qsat
+!!
+!>\BRIEF         This function computes the saturation specific humidity. 
+!!
+!! DESCRIPTION :  statement function qsat is saturation specific humidity,
+!! with svp e and ambient pressure p in n/m**2. impose an upper
+!! limit of 1 to avoid spurious values for very high svp
+!! and/or small p
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : qsatout
+!!
+!! REFERENCE(S) : 
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+FUNCTION qsat (e,p) RESULT (qsatout)
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  REAL, INTENT(IN) :: e,p
+
+  !! 0.2 Result
+  REAL             :: qsatout
+
+!_ ================================================================================================================================
+
+  qsatout = 0.622*e/MAX(p-(1.0-0.622)*e,0.622*e)
+!----------------
+END FUNCTION qsat
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_qsat
+!!
+!>\BRIEF        This subroutine calculates the saturation vapor pressure with the polynomials of Lowe. 
+!!
+!! DESCRIPTION  : Vectorized version of functions esat and qsat.
+!!                statement function esat is svp in n/m**2, with t in deg K.\n
+!!               (100 * lowe's poly since 1 mb = 100 n/m**2.)\n
+!!               Polynomials for svp(t), d(svp)/dt over water 
+!!               and ice are from Lowe(1977),jam,16,101-103 \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::qsat
+!!
+!! REFERENCE(S) :
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation 
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_qsat (npoi,t,p,qsat)
+
+
+  !! 0. Variables and parameters declaration
+
+ !-
+ ! polynomials for svp(t), d(svp)/dt over water and ice
+ ! are from lowe(1977),ja
+  REAL,PARAMETER :: &
+ & asat0 = 6.1078000,    asat1 = 4.4365185e-1, asat2 = 1.4289458e-2, &   !! polynomials for svp(t), d(svp)/dt over water and ice
+ & asat3 = 2.6506485e-4, asat4 = 3.0312404e-6, asat5 = 2.0340809e-8, &
+ & asat6 = 6.1368209e-11, &
+ & bsat0 = 6.1091780,    bsat1 = 5.0346990e-1, bsat2 = 1.8860134e-2, &
+ & bsat3 = 4.1762237e-4, bsat4 = 5.8247203e-6, bsat5 = 4.8388032e-8, &
+ & bsat6 = 1.8388269e-10
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)              :: npoi
+  REAL,DIMENSION(npoi),INTENT(IN) :: t,p
+
+  !! 0.2 Output variables 
+
+  REAL,DIMENSION(npoi),INTENT(OUT):: qsat
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(npoi) :: x, tl, ti, e
+
+!_ ================================================================================================================================
+
+  WHERE (t(:) > zero_t)
+    x(:) = asat0
+  ELSEWHERE
+    x(:) = bsat0
+  ENDWHERE
+!-
+  tl(:) = MIN(100.,MAX(t(:)-zero_t,zero))
+  ti(:) = MAX(-60.,MIN(t(:)-zero_t,zero))
+!-
+  e(:) =  100.* &
+    ( x(:) &
+     +tl(:)*(asat1+tl(:)*(asat2+tl(:)*(asat3 &
+     +tl(:)*(asat4+tl(:)*(asat5+tl(:)* asat6))))) &
+     +ti(:)*(bsat1+ti(:)*(bsat2+ti(:)*(bsat3 &
+     +ti(:)*(bsat4+ti(:)*(bsat5+ti(:)* bsat6)))))  )
+!-
+  qsat(:) = 0.622*e(:)/MAX(p(:)-(1.0-0.622)*e(:),0.622*e(:))
+!---------------------------
+END SUBROUTINE weathgen_qsat
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_qsat_2d
+!!
+!>\BRIEF        This subroutine calculates the saturation vapor pressure with the polynomials of Lowe. 
+!!
+!! DESCRIPTION  : Vectorized version of functions esat and qsat.
+!!                statement function esat is svp in n/m**2, with t in deg K.\n
+!!               (100 * lowe's poly since 1 mb = 100 n/m**2.)\n
+!!               Polynomials for svp(t), d(svp)/dt over water 
+!!               and ice are from Lowe(1977),jam,16,101-103 \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::qsat
+!!
+!! REFERENCE(S) :
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation 
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_qsat_2d (iim,jjm,t,p,qsat)
+
+  !! 0. Parameters and variable declaration
+
+  !! 0.1 Input variables
+
+  INTEGER, INTENT(IN) :: iim
+  INTEGER, INTENT(IN) :: jjm
+  REAL,DIMENSION(iim,jjm),INTENT(IN)  :: t,p
+
+   !! 0.2 Output variables
+   REAL,DIMENSION(iim,jjm),INTENT(OUT) :: qsat
+
+   !! 0.4 Local variables
+
+   REAL,DIMENSION(iim,jjm) :: x, tl, ti, e
+
+  REAL,PARAMETER :: &
+ & asat0 = 6.1078000,    asat1 = 4.4365185e-1, asat2 = 1.4289458e-2, &
+ & asat3 = 2.6506485e-4, asat4 = 3.0312404e-6, asat5 = 2.0340809e-8, &
+ & asat6 = 6.1368209e-11, &
+ & bsat0 = 6.1091780,    bsat1 = 5.0346990e-1, bsat2 = 1.8860134e-2, &
+ & bsat3 = 4.1762237e-4, bsat4 = 5.8247203e-6, bsat5 = 4.8388032e-8, &
+ & bsat6 = 1.8388269e-10
+
+!_ ================================================================================================================================
+
+  WHERE (t(:,:) > zero_t)
+    x(:,:) = asat0
+  ELSEWHERE
+    x(:,:) = bsat0
+  ENDWHERE
+!-
+  tl(:,:) = MIN(100.,MAX(t(:,:)-zero_t,0.))
+  ti(:,:) = MAX(-60.,MIN(t(:,:)-zero_t,0.))
+!-
+  e(:,:) =  100.* &
+    ( x(:,:) &
+     +tl(:,:)*(asat1+tl(:,:)*(asat2+tl(:,:)*(asat3 &
+     +tl(:,:)*(asat4+tl(:,:)*(asat5+tl(:,:)* asat6))))) &
+     +ti(:,:)*(bsat1+ti(:,:)*(bsat2+ti(:,:)*(bsat3 &
+     +ti(:,:)*(bsat4+ti(:,:)*(bsat5+ti(:,:)* bsat6)))))  )
+!-
+  qsat(:,:) = 0.622*e(:,:)/MAX(p(:,:)-(1.0-0.622)*e(:,:),0.622*e(:,:))
+!---------------------------
+END SUBROUTINE weathgen_qsat_2d
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : mask_c_o 
+!!
+!>\BRIEF        This subroutine computes a field which indicated if the point is terrestrial or oceanic.
+!!
+!! DESCRIPTION  : From a mask field, we make an indicator mask Earth/ocean. Earth : 1 ; ocean : 0.
+!!
+!! RECENT CHANGE(S): z.x.li,01/04/1994 : creation of the subroutine 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::mask, ::ncorr, ::icorr
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE mask_c_o &
+& (imdep, jmdep, xdata, ydata, mask_in, fcrit, &
+&  imar, jmar, zonal_res, merid_res, n_agg, x, y, mask, &
+&  ncorr, icorr, jcorr)
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER :: imdep,jmdep
+  REAL :: xdata(imdep),ydata(jmdep)
+  REAL :: mask_in(imdep,jmdep)
+  REAL :: fcrit
+  INTEGER :: imar,jmar
+  REAL :: zonal_res,merid_res
+  INTEGER :: n_agg
+  REAL :: x(imar),y(jmar)
+
+  !! 0.2 Output variables 
+
+  REAL, INTENT(OUT) :: mask(imar,jmar)
+  INTEGER :: ncorr(imar,jmar)
+  INTEGER,DIMENSION(imar,jmar,n_agg) :: icorr,jcorr
+
+  !! 0.4 Local variables 
+
+  INTEGER i, j, ii, jj
+  REAL a(imar),b(imar),c(jmar),d(jmar)
+  INTEGER num_tot(imar,jmar), num_oce(imar,jmar)
+  REAL,ALLOCATABLE :: distans(:)
+  INTEGER ij_proche(1),i_proche,j_proche
+!-
+  INTEGER,DIMENSION(imar,jmar) :: ncorr_oce , ncorr_land
+  INTEGER,DIMENSION(imar,jmar,n_agg) :: &
+ &  icorr_oce, jcorr_oce , icorr_land, jcorr_land
+!-
+  INTEGER imdepp
+  REAL,ALLOCATABLE :: xdatap(:)
+  REAL,ALLOCATABLE :: mask_inp(:,:)
+  LOGICAL :: extend
+
+!_ ================================================================================================================================
+
+  ncorr(:,:) = 0
+  icorr(:,:,:) = -1; jcorr(:,:,:) = -1
+  ncorr_land(:,:) = 0
+  icorr_land(:,:,:) = -1; jcorr_land(:,:,:) = -1
+  ncorr_oce(:,:) = 0
+  icorr_oce(:,:,:) = -1; jcorr_oce(:,:,:) = -1
+! do we have to extend the domain (-x...-x+360)?
+  IF ( xdata(1)+360.-xdata(imdep) > 0.01 ) THEN
+    extend = .TRUE.
+    imdepp = imdep+1
+  ELSE
+    extend = .FALSE.
+    imdepp = imdep
+  ENDIF
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xdatap(imdepp), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xdatap : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(mask_inp(imdepp,jmdep), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of mask_inp : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+  xdatap(1:imdep) = xdata(1:imdep)
+  mask_inp(1:imdep,:) = mask_in(1:imdep,:)
+!-
+  IF (extend) THEN
+    xdatap(imdepp) = xdatap(1)+360.
+    mask_inp(imdepp,:) = mask_inp(1,:)
+  ENDIF
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(distans(imdepp*jmdep), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of distans : ",ALLOC_ERR
+    STOP 
+  ENDIF
+! Definition des limites des boites de la grille d'arrivee.
+  IF (imar > 1) THEN
+    a(1) = x(1)-(x(2)-x(1))/2.0
+    b(1) = (x(1)+x(2))/2.0
+    DO i=2,imar-1
+      a(i) = b(i-1)
+      b(i) = (x(i)+x(i+1))/2.0
+    ENDDO
+    a(imar) = b(imar-1)
+    b(imar) = x(imar)+(x(imar)-x(imar-1))/2.0
+  ELSE
+    a(1) = x(1)-zonal_res/2.
+    b(1) = x(1)+zonal_res/2.
+  ENDIF
+!-
+  IF (jmar > 1) THEN
+    c(1) = y(1)-(y(2)-y(1))/2.0
+    d(1) = (y(1)+y(2))/2.0
+    DO j=2,jmar-1
+      c(j) = d(j-1)
+      d(j) = (y(j)+y(j+1))/2.0
+    ENDDO
+    c(jmar) = d(jmar-1)
+    d(jmar) = y(jmar)+(y(jmar)-y(jmar-1))/2.0
+  ELSE
+    c(1) = y(1)-merid_res/2.
+    d(1) = y(1)+merid_res/2.
+  ENDIF
+!-
+  num_oce(1:imar,1:jmar) = 0
+  num_tot(1:imar,1:jmar) = 0
+!-
+!  .....  Modif  P. Le Van ( 23/08/95 )  ....
+!-
+  DO ii=1,imar
+    DO jj=1,jmar
+      DO i=1,imdepp
+        IF (    (     (xdatap(i)-a(ii) >= 1.e-5) &
+ &               .AND.(xdatap(i)-b(ii) <= 1.e-5) ) &
+ &          .OR.(     (xdatap(i)-a(ii) <= 1.e-5) &
+ &               .AND.(xdatap(i)-b(ii) >= 1.e-5) ) ) THEN
+          DO j=1,jmdep
+            IF (    (     (ydata(j)-c(jj) >= 1.e-5) &
+ &                   .AND.(ydata(j)-d(jj) <= 1.e-5) ) &
+ &              .OR.(     (ydata(j)-c(jj) <= 1.e-5) &
+ &                   .AND.(ydata(j)-d(jj) >= 1.e-5) ) ) THEN
+              num_tot(ii,jj) = num_tot(ii,jj)+1
+              IF (mask_inp(i,j) < 0.5) THEN
+                num_oce(ii,jj) = num_oce(ii,jj)+1
+!-------------- on a trouve un point oceanique. On le memorise.
+                ncorr_oce(ii,jj) = ncorr_oce(ii,jj)+1
+                IF ((i == imdepp).AND.extend) THEN
+                  icorr_oce(ii,jj,ncorr_oce(ii,jj)) = 1
+                ELSE
+                  icorr_oce(ii,jj,ncorr_oce(ii,jj)) = i
+                ENDIF
+                jcorr_oce(ii,jj,ncorr_oce(ii,jj)) = j
+              ELSE
+!-------------- on a trouve un point continental. On le memorise.
+                ncorr_land(ii,jj) = ncorr_land(ii,jj)+1
+                IF ((i == imdepp).AND.extend) THEN
+                  icorr_land(ii,jj,ncorr_land(ii,jj)) = 1
+                ELSE
+                  icorr_land(ii,jj,ncorr_land(ii,jj)) = i
+                ENDIF
+                jcorr_land(ii,jj,ncorr_land(ii,jj)) = j
+              ENDIF
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  DO i=1,imar
+    DO j=1,jmar
+      IF (num_tot(i,j) > 0) THEN
+        IF (    (     (num_oce(i,j) == 0) &
+ &               .AND.(num_tot(i,j) > 0) ) &
+ &          .OR.(     (num_oce(i,j) > 0) &
+ &               .AND.(   REAL(num_oce(i,j)) &
+ &                     <= REAL(num_tot(i,j))*(1.-fcrit) ) ) ) THEN
+          mask(i,j) = un
+          ncorr(i,j) = ncorr_land(i,j)
+          icorr(i,j,:) = icorr_land(i,j,:)
+          jcorr(i,j,:) = jcorr_land(i,j,:)
+        ELSE
+          mask(i,j) = zero
+          ncorr(i,j) = ncorr_oce(i,j)
+          icorr(i,j,:) = icorr_oce(i,j,:)
+          jcorr(i,j,:) = jcorr_oce(i,j,:)
+        ENDIF
+      ELSE
+        CALL dist_sphe(x(i),y(j),xdatap,ydata,imdepp,jmdep,distans)
+        ij_proche(:) = MINLOC(distans)
+        j_proche = (ij_proche(1)-1)/imdepp+1
+        i_proche = ij_proche(1)-(j_proche-1)*imdepp
+        mask(i,j) = mask_inp(i_proche,j_proche)
+        IF ( (i_proche == imdepp).AND.extend)  i_proche=1
+        ncorr(i,j) = 1
+        icorr(i,j,1) = i_proche
+        jcorr(i,j,1) = j_proche
+      ENDIF
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE mask_c_o
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : dist_sphe
+!!
+!>\BRIEF        This subroutine computes the minimum distance between two points on Earth
+!! according the great circle. \n
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): Laurent Li, 30/12/1996 : creation of this subroutine
+!!
+!! MAIN OUTPUT VARIABLE(S): ::distance
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE dist_sphe (rf_lon,rf_lat,rlon,rlat,im,jm,distance)
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER :: im, jm    !! dimensions
+  REAL    :: rf_lon       !! longitude of the referenced point (degrees)
+  REAL    :: rf_lat       !! latitude of the referenced point (degrees)
+  REAL    :: rlon(im), rlat(jm) !! longitude and latitude of points
+
+  !! 0.2 Output variables
+
+  REAL :: distance(im,jm) !! distances in meters (m)
+
+  !! 0.4 Local variables
+
+  REAL :: rlon1, rlat1
+  REAL :: rlon2, rlat2
+  REAL :: dist
+  REAL :: pa, pb, p
+  INTEGER :: i,j
+
+!_ ================================================================================================================================
+
+  DO j=1,jm
+    DO i=1,im
+      rlon1=rf_lon
+      rlat1=rf_lat
+      rlon2=rlon(i)
+      rlat2=rlat(j)
+      pa = pi/2.0-rlat1*pir ! dist. entre pole n et point a
+      pb = pi/2.0-rlat2*pir ! dist. entre pole n et point b
+!-----
+      p = (rlon1-rlon2)*pir ! angle entre a et b (leurs meridiens)
+!-----
+      dist = ACOS( COS(pa)*COS(pb)+SIN(pa)*SIN(pb)*COS(p))
+      dist = R_Earth*dist      
+      distance(i,j) = dist
+    ENDDO
+  ENDDO
+!-----------------------
+END SUBROUTINE dist_sphe
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : permute
+!!
+!>\BRIEF         This subroutine initializes an array of size n by random integers between 1 and n.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::ordre
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE permute (n,ordre)
+!---------------------------------------------------------------------
+
+  !! 0. Variables and parameters declaration 
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN) :: n   !! size of the array
+
+  !! 0.2 Output variables 
+
+  INTEGER,DIMENSION(n),INTENT(OUT) :: ordre
+
+  !! 0.4 Local variables
+
+  INTEGER,DIMENSION(n) :: restant
+  INTEGER :: ipique, i, n_rest
+  REAL    :: rndnum
+
+!_ ================================================================================================================================
+
+  n_rest = n
+  restant(:) = (/ (i, i=1,n) /)
+!-
+  DO i=1,n
+    CALL random_number (rndnum)
+    ipique = INT(rndnum*n_rest)+1
+    ordre(i) = restant(ipique)
+    restant(ipique:n_rest-1) = restant(ipique+1:n_rest)
+    n_rest = n_rest-1
+  ENDDO
+!---------------------
+END SUBROUTINE permute
+!-
+!===
+!-----------------
+END MODULE weather
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/AA_make	(revision 5166)
@@ -0,0 +1,69 @@
+#-
+#- $Id$
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec  SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+MODS1 = grid.f90           \
+        solar.f90          \
+	interpol_help.f90  \
+	gauss_jordan_method.f90  
+
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libparallel
+	$(M_K) libparameters
+	$(M_K) m_all
+	@echo orglob is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+libparameters:
+	(cd ../src_parameters; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o) : %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+
+config : 
+	$(BINDIR)/Fparser -name ORGLOB $(MODS1)
+	echo 'Configuration of ORGLOB done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(grid.o): \
+  $(PARAM_LIB)(constantes.o)
+
+$(MODEL_LIB)(interpol_help.o): \
+  $(PARAM_LIB)(constantes.o)
+
+$(MODEL_LIB)(gauss_jordan_method.o): \
+  $(PARAM_LIB)(constantes.o)
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/AA_make.ldef	(revision 5166)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a ORGLOB
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/liborglob.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxorglob.a
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/gauss_jordan_method.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/gauss_jordan_method.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/gauss_jordan_method.f90	(revision 5166)
@@ -0,0 +1,304 @@
+! =================================================================================================================================
+! MODULE       : matrix_resolution
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         This module solves a linear system using the Gauss-Jordan elimination method. It also calculates relative errors
+!! globally and for the passive pools.        
+!! 
+!!
+!!\n DESCRIPTION:  This module solves a linear system AX = B with the Gauss Jordan elimination method
+!!                 (chosen because the system has no particular properties). \n
+!!                 The code has originally picked up in Numerical recipes in Fortran 90. \n
+!!                 We simplified the code in our case because we solve a basic (7,7) matrix for each point and each pft
+!!                 (so we have npts*nvm*(7,7) systems to solve each time we call this routine). \n
+!!                 We also calculate relative for biomass and passive carbon pools in order to test the threshold error. \n
+!!
+!! RECENT CHANGE(S): Didier Solyga - add subroutine for calculating relative error for passive pool.
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision:  $
+!! \n
+!_ ================================================================================================================================
+
+MODULE matrix_resolution
+
+  ! modules used 
+
+  USE ioipsl ! for precision
+  USE constantes
+
+  IMPLICIT NONE
+
+  CONTAINS
+    
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gauss-jordan_method 
+!!
+!>\BRIEF          This subroutine resolves a linear system by the Gauss-Jordan method.
+!! (inversion of the system - complexity O(n^3)) .
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): vector_b contains the solution of the system.
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+    SUBROUTINE gauss_jordan_method(n,matrix_a,vector_b)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration    
+
+      !! 0.1 Input variables 
+ 
+      INTEGER(i_std), INTENT(in) :: n  !! size of the system (1-N, unitless)
+
+      !! 0.3 Modified variables
+
+      REAL(r_std), DIMENSION(n,n), INTENT(inout) :: matrix_a   !! Matrix A of the linear system A.X = B
+      REAL(r_std), DIMENSION(n), INTENT(inout)   :: vector_b   !! Vector B in the linear system A.X = B
+      
+      !! 0.4 Local Variables
+
+      INTEGER(i_std) :: i,col,row,j,k,ii,jj        !! index (unitless)
+      INTEGER(i_std), DIMENSION(n) :: index_pivot  !! vector containing the pivot index
+      INTEGER(i_std), DIMENSION(n) :: index_col    !! vector containing the columns index
+      INTEGER(i_std), DIMENSION(n) :: index_row    !! vector containing the rows index
+      REAL(r_std) :: pivot_max,inv_pivot,temp      !! temporary variables
+      
+!_ ================================================================================================================================
+      
+      !! Initialization
+      index_pivot(:) = 0
+      col = 0
+      row = 0
+      
+      !! Search the pivot (strategy of full pivoting)
+      !! We search the greatest pivot (in order to reduce errors)
+      DO i = 1,n     
+         pivot_max = 0.
+         DO  j = 1,n
+            IF(index_pivot(j) /= 1) THEN
+               DO k = 1,n
+                  IF(index_pivot(k) .EQ. 0) THEN
+                     IF(ABS(matrix_a(j,k)) .GE. pivot_max) THEN  
+                        pivot_max = ABS(matrix_a(j,k))           
+                        row = j
+                        col = k
+                     ENDIF
+                  ENDIF
+               ENDDO
+            ENDIF
+         ENDDO
+
+         IF (col .EQ. 0) THEN
+            CALL ipslerr_p (3,'gauss_jordan_method','Method failed.','','')
+         ENDIF
+
+         index_pivot(col)=index_pivot(col) + 1
+
+         !! We exchange the rows and the lines if needed
+         IF(row /= col) THEN
+            DO j = 1,n
+               temp = matrix_a(row,j)
+               matrix_a(row,j) = matrix_a(col,j)
+               matrix_a(col,j) = temp
+            ENDDO
+            temp = vector_b(row)
+            vector_b(row) = vector_b(col)
+            vector_b(col) = temp
+         ENDIF
+         index_row(i) = row
+         index_col(i) = col
+         IF(matrix_a(col,col) .EQ. 0.) STOP 'the matrix A is not inversible'
+         inv_pivot = 1./matrix_a(col,col)
+         DO j = 1,n
+            matrix_a(col,j) = matrix_a(col,j) * inv_pivot 
+         ENDDO
+         vector_b(col) = vector_b(col) * inv_pivot
+         DO ii = 1,n
+            IF(ii /= col) THEN
+               temp = matrix_a(ii,col)
+               matrix_a(ii,col) = 0.
+               DO jj = 1,n
+                  matrix_a(ii,jj) = matrix_a(ii,jj) - matrix_a(col,jj)*temp
+               ENDDO
+               vector_b(ii) = vector_b(ii) - vector_b(col)*temp
+            ENDIF
+         ENDDO
+      ENDDO
+      
+      DO j = n,1,-1
+         IF(index_row(j) /= index_col(j)) THEN
+            DO i = 1,n
+               temp = matrix_a(i,index_row(j))
+               matrix_a(i,index_row(j)) = matrix_a(i,index_col(j)) 
+               matrix_a(i,index_col(j)) = temp
+          ENDDO
+       ENDIF
+    ENDDO
+    
+    
+  END SUBROUTINE gauss_jordan_method
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : error_L1_passive
+!!
+!>\BRIEF          This subroutine calculates relative errors of a vector by taking the relative error for the passive pool.
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): flag is to true if the maximum relative error is less than a threshold chosen by the user.
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE error_L1_passive(npts,nb_veget, nb_pools, current_value, previous_value, veget_max, criterion, flag)
+  
+    IMPLICIT NONE
+
+    !! 0. Parameters and variables declaration
+    
+    !! 0.1 Input variables    
+    
+    INTEGER(i_std), INTENT(in) :: npts                                             !! Number of continental grid cells (unitless)
+    INTEGER(i_std), INTENT(in) :: nb_veget                                         !! Number of vegetation types (2-N, unitless)
+    INTEGER(i_std), INTENT(in) :: nb_pools                                         !! Number of carbon pools (unitless)
+    REAL(r_std), DIMENSION(npts,nb_veget,nb_pools), INTENT(in) :: current_value    !! Previous values of carbon pools obtained
+                                                                                   !! by matrix resolution (gC.m^{-2})
+    REAL(r_std), DIMENSION(npts,nb_veget,nb_pools), INTENT(in) :: previous_value   !! Current values of carbon pools  obtained
+                                                                                   !! by matrix resolution (gC.m^{-2})   
+    REAL(r_std), DIMENSION(npts,nb_veget), INTENT(in) :: veget_max                 !! Fraction of vegetation (0-1, uniless)
+    REAL(r_std), INTENT(in) :: criterion                                           !! Threshold for the relativ error (0-1, unitless) 
+    
+    !! 0.2 Output variables
+    
+    LOGICAL, DIMENSION(npts), INTENT(out) :: flag   !! Logical array used only inside this subroutine (true/false)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std) :: j                                      !! Index (unitless)
+    REAL(r_std), DIMENSION(npts) :: previous_passive_stock   !! Previous value of total passive carbon (gC) 
+    REAL(r_std), DIMENSION(npts) :: current_passive_stock    !! Current value of total passive carbon (gC)
+    REAL(r_std), DIMENSION(npts) :: error_global             !! Temporary arrays containing the relative error for each grid cell 
+                                                             !! (unitless)         
+    REAL(r_std), DIMENSION(npts) :: temp_diff                !! Working array storing difference values between previous_passive_stock
+                                                             !! and current_passive_stock (gC)
+
+!_ ================================================================================================================================
+
+    !! Initialize flag and error_global
+    flag(:) = .FALSE.
+    error_global(:) = zero
+
+    !! Calculation previous_passive_stock
+    previous_passive_stock(:) = zero
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z1)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z2)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z3)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z4)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z5)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z6)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z7)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z8)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z9)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z10)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z11)*veget_max(:,j)
+    ENDDO
+
+    !! Calculation current_passive_stock
+    current_passive_stock(:) = zero
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z1)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z2)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z3)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z4)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z5)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z6)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z7)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z8)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z9)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z10)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z11)*veget_max(:,j)
+    ENDDO
+    
+    !! We calculate for the error for the passive pool for each pixel
+    temp_diff(:) = zero
+    temp_diff(:) =  current_passive_stock(:) - previous_passive_stock(:) 
+    WHERE ( previous_passive_stock(:) >  min_stomate )
+       error_global(:) = 100.*ABS(temp_diff(:))/previous_passive_stock(:) 
+    ELSEWHERE
+       error_global(:) = ABS(temp_diff(:))
+    ENDWHERE
+
+    !! if the criterion is reached, we can mark the point 
+    WHERE (error_global(:) <= criterion)
+       flag = .TRUE.
+    ENDWHERE
+       
+  END SUBROUTINE error_L1_passive       
+
+
+END MODULE matrix_resolution
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/grid.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/grid.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/grid.f90	(revision 5166)
@@ -0,0 +1,563 @@
+
+!! This module define variables for the grid to gathered points.
+!!
+!! @call sechiba_main
+!! @Version : $Revision$, $Date$
+!! 
+!< $HeadURL$
+!< $Date$
+!< $Author$
+!< $Revision$
+!!
+!! @author Marie-Alice Foujols, Jan Polcher and Martial Mancip
+!! 
+!!
+!f90doc MODULEgrid
+MODULE grid
+
+  USE defprec
+  USE constantes
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  !
+  ! PARAMETERS
+  ! default resolution (m)
+  REAL(r_std), PARAMETER :: default_resolution = 250000.
+  !
+  ! VARIABLES
+  !
+  ! Global map or not.
+  ! There is little change that if iim <=2 and jjm <= 2 that we have global grid.
+  ! Furthermore using the second line allows to avoid pole problems for global grids
+  LOGICAL, SAVE                                      :: global = .TRUE.
+!$OMP THREADPRIVATE(global)
+  !
+  !-
+  !- Variable to help describe the grid
+  !- once the points are gathered.
+  !-
+  !! Limits of the domain
+  REAL(r_std), SAVE                                   :: limit_west, limit_east, &
+       &                                                limit_north, limit_south
+!$OMP THREADPRIVATE(limit_west, limit_east, limit_north, limit_south)
+  !-
+  !! Geographical coordinates
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:), SAVE     :: lalo
+!$OMP THREADPRIVATE(lalo)
+  !! index  of land points
+  INTEGER, ALLOCATABLE, DIMENSION (:), SAVE          :: ilandindex,jlandindex
+!$OMP THREADPRIVATE(ilandindex, jlandindex)
+  !- 
+  !! Fraction of continents.
+  REAL(r_std), ALLOCATABLE, DIMENSION (:), SAVE       :: contfrac
+!$OMP THREADPRIVATE(contfrac)
+  !
+  ! indices of the 4 neighbours of each grid point (1=N, 2=E, 3=S, 4=W)
+  !   a zero or negative index means that this neighbour is not a land point
+  INTEGER(i_std), ALLOCATABLE, DIMENSION (:,:), SAVE :: neighbours
+!$OMP THREADPRIVATE(neighbours)
+  !
+  ! resolution at each grid point in m (1=E-W, 2=N-S)
+  ! (size in x an y of the grid)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:), SAVE     :: resolution
+!$OMP THREADPRIVATE(resolution)
+  REAL(r_std), DIMENSION(2), SAVE :: min_resol,max_resol
+!$OMP THREADPRIVATE(min_resol, max_resol)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:), SAVE     :: area
+!$OMP THREADPRIVATE(area)
+  !
+  !
+  ! Get the direction of the grid
+  !
+  CHARACTER(LEN=2), DIMENSION(2), SAVE, PRIVATE      :: grid_dir
+!$OMP THREADPRIVATE(grid_dir)
+  !
+  ! Rose gives the geographical direction for the various index increments
+  ! The following corespondences exist
+  !                       WE&NS  WE&SN and so on !
+  ! rose(1) = i+0 & j-1    NN     SS
+  ! rose(2) = i+1 & j-1    NE     SE
+  ! rose(3) = i+1 & j+0    EE     EE
+  ! rose(4) = i+1 & j+1    SE     NE
+  ! rose(5) = i+0 & j+1    SS     NN
+  ! rose(6) = i-1 & j+1    SW     NW
+  ! rose(7) = i-1 & j+0    WW     WW
+  ! rose(8) = i-1 & j-1    NW     SW
+  INTEGER(i_std), DIMENSION(8), SAVE, PRIVATE        :: rose
+!$OMP THREADPRIVATE(rose)
+  !
+  ! The calendar
+  CHARACTER(LEN=20), SAVE         :: calendar_str
+!$OMP THREADPRIVATE(calendar_str)
+  !
+  ! The date
+  REAL(r_std), SAVE                     :: in_julian
+!$OMP THREADPRIVATE(in_julian)
+  ! Diff with day 0
+  REAL(r_std), SAVE                     :: julian_diff
+!$OMP THREADPRIVATE(julian_diff)
+  !
+  INTEGER(i_std), SAVE                  :: year, month, day
+!$OMP THREADPRIVATE(year, month, day)
+  REAL(r_std), SAVE                     :: sec
+!$OMP THREADPRIVATE(sec)
+  !
+  ! month_len (d)
+  INTEGER(i_std), SAVE                  :: month_len
+!$OMP THREADPRIVATE(month_len)
+  !
+  ! year length (d)
+  INTEGER(i_std), SAVE            :: year_length=0
+!$OMP THREADPRIVATE(year_length)
+  !
+  ! Ration between calendar year in days (ie 360d or 365d ...) to gregorian year length 
+  REAL(r_std), SAVE :: year_spread
+!$OMP THREADPRIVATE(year_spread)
+  !
+CONTAINS
+  !
+  !f90doc CONTAINS
+  ! 
+  !
+  SUBROUTINE init_grid ( npts )
+    !
+    ! 0 interface
+    !
+    IMPLICIT NONE
+    !
+    ! 0.1 input  !
+    
+    ! Domain size
+    INTEGER(i_std), INTENT(in)                                 :: npts !! Number of local continental points 
+    !
+    !  Create the internal coordinate table
+    !
+    IF ( (.NOT.ALLOCATED(lalo))) THEN
+       ALLOCATE(lalo(npts,2))
+       lalo(:,:) = val_exp
+    ENDIF
+    !-
+    !- Store variable to help describe the grid
+    !- once the points are gathered.
+    !-
+    IF ( (.NOT.ALLOCATED(neighbours))) THEN
+       ALLOCATE(neighbours(npts,8))
+       neighbours(:,:) = -999999
+    ENDIF
+    IF ( (.NOT.ALLOCATED(resolution))) THEN
+       ALLOCATE(resolution(npts,2))
+       resolution(:,:) = val_exp
+    ENDIF
+    IF ( (.NOT.ALLOCATED(area))) THEN
+       ALLOCATE(area(npts))
+       area(:) = val_exp
+    ENDIF
+    !
+    !- Store the fraction of the continents only once so that the user
+    !- does not change them afterwards.
+    !
+    IF ( (.NOT.ALLOCATED(contfrac))) THEN
+       ALLOCATE(contfrac(npts))
+       contfrac(:) = val_exp
+    ENDIF
+    !
+    ! Allocation of index coordinates
+    IF (.NOT. ALLOCATED(ilandindex)) THEN
+       ALLOCATE(ilandindex(npts),jlandindex(npts))
+       ilandindex(:) = -10000000
+       jlandindex(:) = -10000000
+    ENDIF
+    !
+  END SUBROUTINE init_grid
+
+  SUBROUTINE grid_stuff (npts_glo, iim, jjm, grid_lon, grid_lat, kindex)
+    !
+    ! 0 interface
+    !
+    IMPLICIT NONE
+    !
+    ! 0.1 input  !
+    
+    ! Domain size
+    INTEGER(i_std), INTENT(in)                                 :: npts_glo
+    ! Size of cartesian grid
+    INTEGER(i_std), INTENT(in)                                 :: iim, jjm
+    ! Longitudes on cartesian grid
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(in)                 :: grid_lon
+    ! Latitudes on cartesian grid
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(in)                 :: grid_lat
+    ! Index of land point on 2D map (in local position)
+    INTEGER(i_std), DIMENSION(:), INTENT(in)                :: kindex    
+    !
+    ! 0.3 local
+    !
+    ! Index of land point on 2D map (in global position)
+    INTEGER, ALLOCATABLE, DIMENSION (:)                        :: index_p
+    !
+    ! which STOMATE point corresponds to the given point on the cartesian grid
+    INTEGER(i_std), DIMENSION(iim,jjm)                   :: correspondance
+    ! cosine of the latitude
+    REAL(r_std)                                           :: coslat
+    ! number of points where default resolution is used
+    INTEGER(i_std)                                       :: ndefault_lon, ndefault_lat
+    ! Indices
+    INTEGER(i_std)                                       :: i,ip,jp, imm1, imp1, imm1l, imp1l, ii
+    !
+    ! =========================================================================
+    
+    IF ( printlev >= 4 ) WRITE(numout,*) 'Entering grid_stuff'
+
+    ! default resolution
+    IF ( printlev >=2 ) WRITE(numout,*) 'grid stuff: default resolution (m): ',default_resolution
+    !
+    !-
+    IF (is_root_prc) THEN
+       ! Check if we have a global map or not.
+       ! There is little change that if iim <=2 and jjm <= 2 that we have global grid.
+       ! Furthermore using the second line allows to avoid pole problems for global grids
+       IF (iim <= 2 .OR. jjm <= 2) THEN
+          global = .FALSE.
+       ELSE
+          ! We assume here that the longitude is in increasing order and in degrees.
+          IF ( grid_lon(iim,2)-grid_lon(1,2) >= 360. - (grid_lon(2,2)-grid_lon(1,2)) ) THEN
+             global = .TRUE.
+          ELSE
+             global = .FALSE.
+          ENDIF
+       ENDIF
+       !
+       ! Get the direction of the grid
+       !
+       IF ( iim > 1 ) THEN
+          IF ( grid_lon(1,1) <= grid_lon(2,1) ) THEN
+             grid_dir(1) = 'WE'
+          ELSE
+             grid_dir(1) = 'EW'
+          ENDIF
+       ELSE
+          grid_dir(1) = 'WE'
+       ENDIF
+       !
+       IF ( jjm > 1 ) THEN
+          IF ( grid_lat(1,1) >= grid_lat(1,2) ) THEN
+             grid_dir(2) = 'NS'
+          ELSE
+             grid_dir(2) = 'SN'
+          ENDIF
+       ELSE
+          grid_dir(2) = 'NS'
+       ENDIF
+       !
+       !! WRITE(numout,*) 'Longitude direction :', grid_dir(1)
+       !! WRITE(numout,*) 'Latitude  direction :', grid_dir(2)
+       !
+       ndefault_lon = 0
+       ndefault_lat = 0
+       ! initialize output
+       neighbours_g(:,:) = -1
+       resolution_g(:,:) = zero
+       min_resol(:) = 1.e6
+       max_resol(:) = moins_un
+       
+       correspondance(:,:) = -1
+       DO i = 1, npts_glo          
+          !
+          ! 1 find numbers of the latitude and longitude of each point
+          !
+          
+          ! index of latitude
+          jp = INT( (index_g(i)-1) /iim ) + 1
+          
+          ! index of longitude
+          ip = index_g(i) - ( jp-1 ) * iim
+          !
+          !correspondance(ip,jp) = kindex(i)
+          !
+          correspondance(ip,jp) = i
+
+       ENDDO
+  
+       !
+       ! Get the "wind rose" for the various orientation of the grid
+       !
+       IF ( grid_dir(1) .EQ. 'WE' .AND.  grid_dir(2) .EQ. 'NS' ) THEN
+          rose(1) = 1
+          rose(2) = 2
+          rose(3) = 3
+          rose(4) = 4
+          rose(5) = 5
+          rose(6) = 6
+          rose(7) = 7
+          rose(8) = 8
+       ELSE IF ( grid_dir(1) .EQ. 'EW' .AND.  grid_dir(2) .EQ. 'NS' ) THEN
+          rose(1) = 1
+          rose(2) = 8
+          rose(3) = 7
+          rose(4) = 6
+          rose(5) = 5
+          rose(6) = 4
+          rose(7) = 3
+          rose(8) = 2
+       ELSE IF ( grid_dir(1) .EQ. 'WE' .AND.  grid_dir(2) .EQ. 'SN' ) THEN
+          rose(1) = 5
+          rose(2) = 4
+          rose(3) = 3
+          rose(4) = 2
+          rose(5) = 1
+          rose(6) = 8
+          rose(7) = 7
+          rose(8) = 6
+       ELSE IF ( grid_dir(1) .EQ. 'EW' .AND.  grid_dir(2) .EQ. 'SN' ) THEN
+          rose(1) = 5
+          rose(2) = 6
+          rose(3) = 7
+          rose(4) = 8
+          rose(5) = 1
+          rose(6) = 2
+          rose(7) = 3
+          rose(8) = 4
+       ELSE
+          WRITE(numout,*) 'We can not be here'
+          CALL ipslerr_p(3,'grid_stuff','We can not be here','','')
+       ENDIF
+
+       DO i = 1, npts_glo
+
+          ! index of latitude
+          jp = INT( (index_g(i)-1) /iim ) + 1
+          
+          ! index of longitude
+          ip = index_g(i) - ( jp-1 ) * iim
+          
+          !
+          ! 2 resolution
+          !
+          
+          !
+          ! 2.1 longitude
+          !
+          
+          ! prevent infinite resolution at the pole
+          coslat = MAX( COS( grid_lat(ip,jp) * pi/180. ), mincos )     
+          IF ( iim .GT. 1 ) THEN
+             
+             IF ( ip .EQ. 1 ) THEN
+                resolution_g(i,1) = &
+                     ABS( grid_lon(ip+1,jp) - grid_lon(ip,jp) ) * &
+                     pi/180. * R_Earth * coslat
+             ELSEIF ( ip .EQ. iim ) THEN
+                resolution_g(i,1) = &
+                     ABS( grid_lon(ip,jp) - grid_lon(ip-1,jp) ) * &
+                     pi/180. * R_Earth * coslat
+             ELSE
+                resolution_g(i,1) = &
+                     ABS( grid_lon(ip+1,jp) - grid_lon(ip-1,jp) )/2. *&
+                     pi/180. * R_Earth * coslat
+             ENDIF
+             
+          ELSE
+             
+             resolution_g(i,1) = default_resolution
+             
+             ndefault_lon = ndefault_lon + 1
+
+          ENDIF
+
+          !
+          ! 2.2 latitude
+          !
+          
+          IF ( jjm .GT. 1 ) THEN
+
+             IF ( jp .EQ. 1 ) THEN
+                resolution_g(i,2) = &
+                     ABS( grid_lat(ip,jp) - grid_lat(ip,jp+1) ) * &
+                     pi/180. * R_Earth
+             ELSEIF ( jp .EQ. jjm ) THEN
+                resolution_g(i,2) = &
+                     ABS( grid_lat(ip,jp-1) - grid_lat(ip,jp) ) * &
+                     pi/180. * R_Earth
+             ELSE
+                resolution_g(i,2) = &
+                     ABS( grid_lat(ip,jp-1) - grid_lat(ip,jp+1) )/2. *&
+                     pi/180. * R_Earth
+             ENDIF
+             
+          ELSE
+             
+             resolution_g(i,2) = default_resolution
+             
+             ndefault_lat = ndefault_lat + 1
+             
+          ENDIF
+          min_resol(1) = MIN(resolution_g(i,1),min_resol(1))
+          min_resol(2) = MIN(resolution_g(i,2),min_resol(2))
+          max_resol(1) = MAX(resolution_g(i,1),max_resol(1))
+          max_resol(2) = MAX(resolution_g(i,2),max_resol(2))
+
+          area_g(i) = resolution_g(i,1)*resolution_g(i,2)
+
+          !
+          ! 3 find neighbours 
+          !     
+          imm1 = 0
+          IF ( ip .GT. 1 ) THEN
+             imm1 = ip - 1
+          ELSEIF ( global ) THEN
+             imm1 = iim
+          ENDIF
+          
+          imp1 = 0
+          IF ( ip .LT. iim ) THEN
+             imp1 = ip + 1
+          ELSEIF ( global ) THEN
+             imp1 = 1
+          ENDIF
+          !
+          ! East and West
+          !
+          IF ( imp1 > 0 ) THEN
+             neighbours_g(i,rose(3)) = correspondance(imp1,jp)
+          ELSE
+             neighbours_g(i,rose(3)) = -1
+          ENDIF
+          IF ( imm1 > 0 ) THEN
+             neighbours_g(i,rose(7)) = correspondance(imm1,jp)
+          ELSE
+             neighbours_g(i,rose(7)) = -1
+          ENDIF
+          !
+          ! North
+          !
+          IF ( jp .GT. 1 ) THEN
+
+             neighbours_g(i,rose(1)) = correspondance(ip,jp-1)
+             IF ( imp1 > 0 ) THEN
+                neighbours_g(i,rose(2)) = correspondance(imp1,jp-1)
+             ELSE
+                neighbours_g(i,rose(2)) = -1
+             ENDIF
+             IF ( imm1 > 0 ) THEN
+                neighbours_g(i,rose(8)) = correspondance(imm1,jp-1)
+             ELSE
+                neighbours_g(i,rose(8)) = -1
+             ENDIF
+
+          ELSE
+             IF ( global ) THEN
+                
+                ! special treatment for the pole if we are really in a 2d grid
+                
+                IF ( ( iim .GT. 1 ) .AND. ( jjm .GT. 1 ) ) THEN
+                   !
+                   ii = MOD(ip+iim/2-1,iim)+1
+                   imm1l = ii - 1
+                   IF ( imm1l .LT. 1 ) imm1l = iim
+                   imp1l = ii + 1
+                   IF ( imp1l .GT. iim ) imp1l = 1
+                   !
+                   IF ( ABS( ( grid_lat(ip,jp) ) - 90. ) .LT. min_sechiba ) THEN
+                      ! the grid point sits exactly on the pole. The neighbour is situated
+                   ! at a lower latitude.
+                      neighbours_g(i,rose(1)) = correspondance( ii, jp+1 )
+                      neighbours_g(i,rose(2)) = correspondance( imm1l, jp+1 )
+                      neighbours_g(i,rose(8)) = correspondance( imp1l, jp+1 )
+                   ELSE
+                      ! look across the North Pole
+                      neighbours_g(i,rose(1)) = correspondance( ii, jp )
+                      neighbours_g(i,rose(2)) = correspondance( imm1l, jp )
+                      neighbours_g(i,rose(8)) = correspondance( imp1l, jp )
+                   ENDIF
+                ENDIF
+
+             ELSE
+
+                neighbours_g(i,rose(1)) = -1
+                neighbours_g(i,rose(2)) = -1
+                neighbours_g(i,rose(8)) = -1
+                
+             ENDIF
+
+          ENDIF
+          
+          ! South
+          IF ( jp .LT. jjm ) THEN
+
+             neighbours_g(i,rose(5)) = correspondance(ip,jp+1)
+             IF ( imp1 > 0 ) THEN
+                neighbours_g(i,rose(4)) = correspondance(imp1,jp+1)
+             ELSE
+                neighbours_g(i,rose(4)) = -1
+             ENDIF
+             IF ( imm1 > 0 ) THEN
+                neighbours_g(i,rose(6)) = correspondance(imm1,jp+1)
+             ELSE
+                neighbours_g(i,rose(6)) = -1
+             ENDIF
+
+          ELSE
+             
+             IF ( global ) THEN
+
+                ! special treatment for the pole if we are really in a 2d grid
+                
+                IF ( ( iim .GT. 1 ) .AND. ( jjm .GT. 1 ) ) THEN
+                   !
+                   ii = MOD(ip+iim/2-1,iim)+1
+                   imm1l = ii - 1
+                   IF ( imm1l .LT. 1 ) imm1l = iim
+                   imp1l = ii + 1
+                   IF ( imp1l .GT. iim ) imp1l = 1
+                   !
+                   IF ( ( ABS( grid_lat(ip,jp) ) - 90. ) .LT. min_sechiba ) THEN
+                      ! the grid point sits exactly on the pole. The neighbour is situated
+                      ! at a lower latitude.
+                      neighbours_g(i,rose(5)) = correspondance( ii, jp-1 )
+                      neighbours_g(i,rose(4)) = correspondance( imm1l, jp-1 )
+                      neighbours_g(i,rose(6)) = correspondance( imp1l, jp-1 )
+                   ELSE
+                      ! look across the South Pole
+                      neighbours_g(i,rose(5)) = correspondance( ii, jp )
+                      neighbours_g(i,rose(4)) = correspondance( imm1l, jp )
+                      neighbours_g(i,rose(6)) = correspondance( imp1l, jp )
+                   ENDIF
+                ENDIF
+
+             ELSE
+                
+                neighbours_g(i,rose(5)) = -1
+                neighbours_g(i,rose(4)) = -1
+                neighbours_g(i,rose(6)) = -1
+                
+             ENDIF
+          ENDIF
+
+       ENDDO
+
+       IF ( printlev >= 2 ) THEN
+          WRITE(numout,*) '  > Total number of points: ',npts_glo
+          WRITE(numout,*) '  > Using default zonal resolution at',ndefault_lon,' points.'
+          WRITE(numout,*) '  > Using default meridional resolution at',ndefault_lat,' points.'
+       ENDIF
+       !
+    ENDIF ! (root_prc)
+
+    CALL scatter(neighbours_g,neighbours)
+    CALL scatter(resolution_g,resolution)
+    CALL scatter(area_g,area)
+    CALL bcast(min_resol)
+    CALL bcast(max_resol)
+    IF ( printlev >=4 ) THEN
+       WRITE(numout,*) '  > resolution  = ',resolution
+       WRITE(numout,*) '  > rose = ',rose
+       WRITE(numout,*) '  > neighbours  = ',neighbours
+    ENDIF
+    IF ( printlev >= 3 ) WRITE(numout,*) 'Leaving grid_stuff'
+    
+  END SUBROUTINE grid_stuff
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+END MODULE grid
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/interpol_help.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/interpol_help.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/interpol_help.f90	(revision 5166)
@@ -0,0 +1,818 @@
+!
+! Aggregation routines. These routines allow to interpolate from the finer grid on which the 
+! surface parameter is available to the coarser one of the model.
+!
+! The routines work for the fine data on a regular lat/lon grid. This grid can come in as either
+! a rank2 array or a vector. Two procedure exist which require slightly different input fields.
+!
+!
+!< $HeadURL$
+!< $Date$
+!< $Author$
+!< $Revision$
+!
+!
+MODULE interpol_help
+
+  ! Modules used :
+
+  USE constantes
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC aggregate, aggregate_p
+  !
+  INTERFACE aggregate
+     MODULE PROCEDURE aggregate_2d, aggregate_vec
+  END INTERFACE
+  !
+  INTERFACE aggregate_p
+     MODULE PROCEDURE aggregate_2d_p, aggregate_vec_p
+  END INTERFACE
+  !
+  LOGICAL, PARAMETER                              :: check_grid=.FALSE.
+  !
+CONTAINS
+  !
+  ! This routing will get for each point of the coarse grid the
+  ! indexes of the finer grid and the area of overlap. 
+  ! This routine is designed for a fine grid which is regular in lat/lon.
+  !
+  SUBROUTINE aggregate_2d (nbpt, lalo, neighbours, resolution, contfrac, &
+       &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+       &                incmax, indinc, areaoverlap, ok)
+
+    USE grid, ONLY : global
+
+    !
+    ! INPUT
+    ! 
+    INTEGER(i_std), INTENT(in)   :: nbpt                 ! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)       :: lalo(nbpt,2)         ! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)   :: neighbours(nbpt,8)   ! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std), INTENT(in)       :: resolution(nbpt,2)   ! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)       ! Fraction of land in each grid box.
+    INTEGER(i_std), INTENT(in)   :: iml, jml             ! Size of the finer grid
+    REAL(r_std), INTENT(in)       :: lon_rel(iml, jml)    ! Longitudes for the finer grid
+    REAL(r_std), INTENT(in)       :: lat_rel(iml, jml)    ! Latitudes for the finer grid
+    INTEGER(i_std), INTENT(in)   :: mask(iml, jml)       ! Mask which retains only the significative points
+                                                         ! of the fine grid.
+    CHARACTER(LEN=*), INTENT(in) :: callsign             ! Allows to specify which variable is beeing treated
+    INTEGER(i_std), INTENT(in)    :: incmax              ! Maximum point of the fine grid we can store.
+    !
+    ! Output
+    !
+    INTEGER(i_std), INTENT(out)  :: indinc(nbpt,incmax,2)
+    REAL(r_std), INTENT(out)      :: areaoverlap(nbpt,incmax)
+    LOGICAL, OPTIONAL, INTENT(out)      :: ok            ! return code
+    !
+    ! Local Variables
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_ful, lon_ful
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: loup_rel, lolow_rel, laup_rel, lalow_rel
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: searchind
+    REAL(r_std) :: lon_up, lon_low, lat_up, lat_low
+    REAL(r_std) :: coslat, ax, ay, sgn, lonrel, lolowrel, louprel
+    INTEGER(i_std) :: fopt, fopt_max, ip, jp, ib, i, itmp, iprog, nbind
+    REAL(r_std) :: domain_minlon,domain_maxlon,domain_minlat,domain_maxlat
+    INTEGER(i_std) :: minLon(1), maxLon(1)
+
+    INTEGER                  :: ALLOC_ERR
+    LOGICAL :: err_fopt
+    err_fopt = .FALSE.
+    !
+    ! Some inital assignmens
+    !
+    areaoverlap(:,:) = moins_un
+    indinc(:,:,:) = zero
+
+    ALLOCATE (laup_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of laup_rel','','')
+
+    ALLOCATE (loup_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of loup_rel','','')
+
+    ALLOCATE (lalow_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of lalow_rel','','')
+
+    ALLOCATE (lolow_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of lolow_rel','','')
+
+    ALLOCATE (lat_ful(iml+2,jml+2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of lat_ful','','')
+
+    ALLOCATE (lon_ful(iml+2,jml+2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of lon_ful','','')
+
+    ALLOCATE (searchind(iml*jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_2d', 'ERROR IN ALLOCATION of searchind','','')
+
+    IF (PRESENT(ok)) ok = .TRUE.
+    !
+    !    Duplicate the border assuming we have a global grid going from west to east
+    !
+    lon_ful(2:iml+1,2:jml+1) = lon_rel(1:iml,1:jml)
+    lat_ful(2:iml+1,2:jml+1) = lat_rel(1:iml,1:jml)
+    !
+    IF ( lon_rel(iml,1) .LT. lon_ful(2,2)) THEN
+       lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)
+       lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
+    ELSE
+       lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)-360
+       lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
+    ENDIF
+
+    IF ( lon_rel(1,1) .GT. lon_ful(iml+1,2)) THEN
+       lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)
+       lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
+    ELSE
+       lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)+360
+       lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
+    ENDIF
+    !
+    sgn = lat_rel(1,1)/ABS(lat_rel(1,1))
+    lat_ful(2:iml+1,1) = sgn*180 - lat_rel(1:iml,1)
+    sgn = lat_rel(1,jml)/ABS(lat_rel(1,jml))
+    lat_ful(2:iml+1,jml+2) = sgn*180 - lat_rel(1:iml,jml)
+    lat_ful(1,1) = lat_ful(iml+1,1)
+    lat_ful(iml+2,1) = lat_ful(2,1)
+    lat_ful(1,jml+2) = lat_ful(iml+1,jml+2)
+    lat_ful(iml+2,jml+2) = lat_ful(2,jml+2)
+    !
+    ! Add the longitude lines to the top and bottom
+    !
+    lon_ful(:,1) = lon_ful(:,2) 
+    lon_ful(:,jml+2) = lon_ful(:,jml+1) 
+    !
+    !  Get the upper and lower limits of each grid box
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          loup_rel(ip,jp) =MAX(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)),&
+               & 0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
+          lolow_rel(ip,jp) =MIN(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)),&
+               & 0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
+          laup_rel(ip,jp) =MAX(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)),&
+               & 0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
+          lalow_rel(ip,jp) =MIN(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)),&
+               & 0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
+          !
+       ENDDO
+    ENDDO
+    IF (check_grid) THEN
+       WRITE(numout,*) "================================"
+       WRITE(numout,*) "interpol_aggregate_2d : "
+       WRITE(numout,*) "lalo(:,1) :",lalo(:,1)
+       WRITE(numout,*) "lalo(:,2) :",lalo(:,2)
+       WRITE(numout,*) "Map meshes : "
+       WRITE(numout,*) "lat read(1,:) :",lat_rel(1,:)
+       WRITE(numout,*) "lat_ful(1,:) :",lat_ful(1,:)
+       WRITE(numout,*) "lat_ful(2,:) :",lat_ful(2,:)
+       WRITE(numout,*) "lalow_rel(1,:) :",lalow_rel(1,:)
+       WRITE(numout,*) "laup_rel(1,:) :",laup_rel(1,:)
+       WRITE(numout,*) "================================"
+       WRITE(numout,*) "lon read(:,1) :",lon_rel(:,1)
+       WRITE(numout,*) "lon_ful(:,1) :",lon_ful(:,1)
+       WRITE(numout,*) "lon_ful(:,2) :",lon_ful(:,2)
+       WRITE(numout,*) "lolow_rel(:,1) :",lolow_rel(:,1)
+       WRITE(numout,*) "loup_rel(:,1) :",loup_rel(:,1)
+       WRITE(numout,*) "================================"
+    ENDIF
+    !
+    !
+    !  To speedup calculations we will get the limits of the domain of the 
+    !  coarse grid and select all the points of the fine grid which are potentialy
+    !  in this domain.
+    !
+    !
+    minLon = MINLOC(lalo(1:nbpt,2))
+    coslat = MAX(COS(lalo(minLon(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    domain_minlon = lalo(minLon(1),2) - resolution(minLon(1),1)/(2.0*coslat)
+    maxLon = MAXLOC(lalo(1:nbpt,2))
+    coslat = MAX(COS(lalo(maxLon(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    domain_maxlon = lalo(maxLon(1),2) + resolution(maxLon(1),1)/(2.0*coslat)
+    !
+    coslat = pi/180. * R_Earth
+    domain_minlat = MINVAL(lalo(1:nbpt,1)) - resolution(maxLon(1),2)/(2.0*coslat)
+    domain_maxlat = MAXVAL(lalo(1:nbpt,1)) + resolution(maxLon(1),2)/(2.0*coslat)
+    !
+    IF (check_grid) THEN
+       WRITE(numout,*) "indices min/max of longitude :",minLon,maxLon, &
+            & "; longitude min/max : ",lalo(minLon,1),lalo(maxLon,1)
+       WRITE(numout,*) "Domain for coarse grid :"
+       WRITE(numout,*) '(',domain_minlat,',',domain_minlon,')',&
+   &                   '(',domain_maxlat,',',domain_maxlon,')'
+       WRITE(numout,*) "================================"
+    ENDIF
+    !
+    ! we list a first approximation of all point we will need to 
+    ! scan to fill our coarse grid.
+    !
+    IF ( global ) THEN
+       ! Here we do the entire globe
+       WRITE(numout,*) 'In aggregate_p : do interpolation to global model domain'
+       nbind=0
+       DO ip=1,iml
+          DO jp=1,jml
+             IF (mask(ip,jp) == 1 ) THEN
+                nbind = nbind + 1
+                searchind(nbind,1) = ip
+                searchind(nbind,2) = jp
+             ENDIF
+          ENDDO
+       ENDDO
+       !
+    ELSE
+       ! Now we get a limited number of points
+       WRITE(numout,*) 'In aggregate_p : do interpolation to regional model domain'
+       nbind=0
+       DO ip=1,iml
+          DO jp=1,jml
+             IF ( loup_rel(ip,jp) >= domain_minlon .AND. lolow_rel(ip,jp) <= domain_maxlon .AND.&
+               &  laup_rel(ip,jp) >= domain_minlat .AND. lalow_rel(ip,jp) <= domain_maxlat ) THEN
+                IF (mask(ip,jp) == 1 ) THEN
+                   nbind = nbind + 1
+                   searchind(nbind,1) = ip
+                   searchind(nbind,2) = jp
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+    !
+    WRITE(numout,*) 'We will work with ', nbind, ' points of the fine grid'
+    !
+    WRITE(numout,*) 'Aggregate_2d : ', callsign
+#ifdef INTERPOL_ADVANCE
+    WRITE(numout,'(2a40)')'0%--------------------------------------', &
+         & '------------------------------------100%'
+#endif
+    !
+    !   Now we take each grid point and find out which values from the forcing we need to average
+    !
+    fopt_max = -1
+    DO ib =1, nbpt
+       !
+       !   Give a progress meter
+       !
+#ifdef INTERPOL_ADVANCE
+       iprog = NINT(REAL(ib,r_std)/REAL(nbpt,r_std)*79.) - NINT(REAL(ib-1,r_std)/REAL(nbpt,r_std)*79.)
+       IF ( iprog .NE. 0 ) THEN
+          WRITE(numout,'(a1,$)') 'x'
+       ENDIF
+#endif
+       !
+       !  We find the 4 limits of the grid-box. As we transform the resolution of the model
+       !  into longitudes and latitudes we do not have the problem of periodicity.
+       !  coslat is a help variable here !
+       !
+       coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+       !
+       lon_up = lalo(ib,2) + resolution(ib,1)/(2.0*coslat) 
+       lon_low =lalo(ib,2) - resolution(ib,1)/(2.0*coslat) 
+       !
+       coslat = pi/180. * R_Earth
+       !
+       lat_up =lalo(ib,1) + resolution(ib,2)/(2.0*coslat) 
+       lat_low =lalo(ib,1) - resolution(ib,2)/(2.0*coslat) 
+       !
+       !  Find the grid boxes from the data that go into the model's boxes
+       !  We still work as if we had a regular grid ! Well it needs to be localy regular so
+       !  so that the longitude at the latitude of the last found point is close to the one 
+       !  of the next point.
+       !
+       fopt = zero
+       !
+       DO i=1,nbind
+          !
+          ip = searchind(i,1)
+          jp = searchind(i,2)
+          !
+          !  Either the center of the data grid point is in the interval of the model grid or
+          !  the East and West limits of the data grid point are on either sides of the border of
+          !  the data grid.
+          !
+          !  To do that correctly we have to check if the grid box sits on the date-line.
+          !
+          IF ( lon_low < -180.0 ) THEN
+             ! -179 -> -179
+             ! 179 -> -181
+             lonrel = MOD( lon_rel(ip,jp) - 360.0, 360.0)
+             lolowrel = MOD( lolow_rel(ip,jp) - 360.0, 360.0)
+             louprel = MOD( loup_rel(ip,jp) - 360.0, 360.0)
+             !
+          ELSE IF ( lon_up > 180.0 ) THEN
+             ! -179 -> 181
+             !  179 -> 179
+             lonrel = MOD( lon_rel(ip,jp) + 360., 360.0)
+             lolowrel = MOD( lolow_rel(ip,jp) + 360., 360.0)
+             louprel = MOD( loup_rel(ip,jp) + 360., 360.0)
+          ELSE
+             lonrel = lon_rel(ip,jp)
+             lolowrel = lolow_rel(ip,jp)
+             louprel = loup_rel(ip,jp)
+          ENDIF
+          !
+          !
+          !
+          IF ( lonrel > lon_low .AND. lonrel < lon_up .OR. &
+               & lolowrel < lon_low .AND.  louprel > lon_low .OR. &
+               & lolowrel < lon_up  .AND.  louprel > lon_up ) THEN
+             !
+             ! Now that we have the longitude let us find the latitude
+             !
+             IF ( lat_rel(ip,jp) > lat_low .AND. lat_rel(ip,jp) < lat_up .OR. &
+                  & lalow_rel(ip,jp) < lat_low .AND. laup_rel(ip,jp) > lat_low .OR.&
+                  & lalow_rel(ip,jp) < lat_up .AND. laup_rel(ip,jp) > lat_up) THEN
+                   !
+                fopt = fopt + 1
+                IF ( fopt > incmax) THEN
+                   err_fopt=.TRUE.
+                   EXIT
+                ELSE
+                   !
+                   ! If we sit on the date line we need to do the same transformations as above.
+                   ! 
+                   IF ( lon_low < -180.0 ) THEN
+                      lolowrel = MOD( lolow_rel(ip,jp) - 360.0, 360.0)
+                      louprel = MOD( loup_rel(ip,jp) - 360.0, 360.0)
+                      !
+                   ELSE IF ( lon_up > 180.0 ) THEN
+                      lolowrel = MOD( lolow_rel(ip,jp) + 360., 360.0)
+                      louprel = MOD( loup_rel(ip,jp) + 360., 360.0)
+                   ELSE
+                      lolowrel = lolow_rel(ip,jp)
+                      louprel = loup_rel(ip,jp)
+                   ENDIF
+                   !
+                   ! Get the area of the fine grid in the model grid
+                   !
+                   coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )
+                   ax = (MIN(lon_up,louprel)-MAX(lon_low, lolowrel))*pi/180. * R_Earth * coslat
+                   ay = (MIN(lat_up, laup_rel(ip,jp))-MAX(lat_low,lalow_rel(ip,jp)))*pi/180. * R_Earth
+                   !
+                   areaoverlap(ib, fopt) = ax*ay
+                   indinc(ib, fopt, 1) = ip
+                   indinc(ib, fopt, 2) = jp
+                   !
+                   ! If this point was 100% within the grid then we can de-select it from our
+                   ! list as it can not be in another mesh of the coarse grid.
+                   !
+                   IF ( louprel < lon_up .AND. lolowrel > lon_low .AND. &
+                     &  laup_rel(ip,jp) < lat_up .AND. lalow_rel(ip,jp) > lat_low ) THEN
+                      searchind(i,1) = 0
+                      searchind(i,2) = 0
+                   ENDIF
+                   !
+                ENDIF
+             ENDIF       ! IF lat
+          ENDIF          ! IF lon
+       ENDDO
+
+       IF (err_fopt) THEN
+          WRITE(numout,*) 'Working on variable :', callsign
+          WRITE(numout,*) 'Reached value ', fopt,' for fopt on point', ib, lalo(ib,2), lalo(ib,1)
+          CALL ipslerr_p(2,'aggregate_2d', &
+               'Working on variable :'//callsign, &
+               'Reached incmax value for fopt.',&
+               'Please increase incmax in subroutine calling aggregate')                   
+          IF (PRESENT(ok)) THEN
+             ok = .FALSE.
+             RETURN
+          ELSE
+             CALL ipslerr_p(3,'aggregate_2d','Stop now','','')
+          ENDIF
+       ENDIF
+       fopt_max = MAX ( fopt, fopt_max )
+       !
+       ! De-select the marked points
+       !
+       itmp = nbind
+       nbind = 0
+       DO i=1,itmp
+          IF ( searchind(i,1) > 0 .AND. searchind(i,2) > 0 ) THEN
+             nbind = nbind + 1
+             searchind(nbind,1) = searchind(i,1)
+             searchind(nbind,2) = searchind(i,2)
+          ENDIF
+       ENDDO
+       !
+    ENDDO
+    !
+    DO ib=1,nbpt
+       DO fopt=1,incmax
+          IF (( indinc(ib,fopt,1) == 0 .AND. indinc(ib,fopt,2) > 0) .OR.&
+               & ( indinc(ib,fopt,2) == 0 .AND. indinc(ib,fopt,1) > 0) ) THEN
+             WRITE(*,*) "aggregate_2d PROBLEM : point =",ib, fopt," Indicies = ", &
+                  & indinc(ib,fopt,1), indinc(ib,fopt,2), areaoverlap(ib,fopt)
+          ENDIF
+       ENDDO
+    ENDDO
+
+
+    WRITE(numout,*) ""
+    WRITE(numout,*) "aggregate_2D nbvmax = ",incmax, "max used = ",fopt_max
+    !
+    ! Do some memory management.
+    !
+    DEALLOCATE (laup_rel)
+    DEALLOCATE (loup_rel)
+    DEALLOCATE (lalow_rel)
+    DEALLOCATE (lolow_rel)
+    DEALLOCATE (lat_ful)
+    DEALLOCATE (lon_ful)
+    DEALLOCATE (searchind)
+    !
+    ! Close the progress meter
+    !
+    WRITE(numout,*) '    '
+    !
+  END SUBROUTINE aggregate_2d
+
+  !
+  ! This routing will get for each point of the coarse grid the
+  ! indexes of the finer grid and the area of overlap. 
+  ! This routine is designed for a fine grid which is regular in meters along lat lon axes.
+  !
+  SUBROUTINE aggregate_vec (nbpt, lalo, neighbours, resolution, contfrac, &
+       &                iml, lon_rel, lat_rel, resol_lon, resol_lat, callsign, &
+       &                incmax, indinc, areaoverlap, ok)
+    !
+    ! INPUT
+    ! 
+    INTEGER(i_std), INTENT(in)   :: nbpt                 ! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)       :: lalo(nbpt,2)         ! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)   :: neighbours(nbpt,8)   ! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std), INTENT(in)       :: resolution(nbpt,2)   ! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)       ! Fraction of land in each grid box.
+    INTEGER(i_std), INTENT(in)   :: iml                  ! Size of the finer grid
+    REAL(r_std), INTENT(in)       :: lon_rel(iml)         ! Longitudes for the finer grid
+    REAL(r_std), INTENT(in)       :: lat_rel(iml)         ! Latitudes for the finer grid
+    REAL(r_std), INTENT(in)       :: resol_lon, resol_lat ! Resolution in meters of the fine grid
+    CHARACTER(LEN=*), INTENT(in) :: callsign             ! Allows to specify which variable is beeing treated
+    INTEGER(i_std), INTENT(in)    :: incmax              ! Maximum point of the fine grid we can store.
+    !
+    ! Output
+    !
+    INTEGER(i_std), INTENT(out)  :: indinc(nbpt,incmax)
+    REAL(r_std), INTENT(out)      :: areaoverlap(nbpt,incmax)
+    LOGICAL, OPTIONAL, INTENT(out)      :: ok            ! return code
+    !
+    ! Local Variables
+    !
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: searchind
+    REAL(r_std) :: lon_up, lon_low, lat_up, lat_low
+    REAL(r_std) :: coslat, ax, ay, lonrel, lolowrel, louprel
+    REAL(r_std) :: latrel, lauprel, lalowrel
+    INTEGER(i_std), DIMENSION(nbpt) :: fopt
+    INTEGER(i_std) :: fopt_max, not_found_fopt
+    INTEGER(i_std) :: ip, ib, i, j, itmp, iprog, nbind, pp, ipp
+    REAL(r_std) :: domain_minlon,domain_maxlon,domain_minlat,domain_maxlat
+    REAL(r_std) :: minlon, minlat, mini
+    INTEGER(i_std) :: ff(1), incp
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: fine_ind
+    INTEGER(i_std) :: pos_pnt(5)
+    INTEGER                  :: ALLOC_ERR
+    !
+    LOGICAL :: err_fopt
+    err_fopt = .FALSE.
+    !
+    ! Some inital assignmens
+    !
+    areaoverlap(:,:) = moins_un
+    indinc(:,:) = zero
+
+    ALLOCATE (searchind(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_vec','ERROR IN ALLOCATION of searchbind','','')
+
+    IF (PRESENT(ok)) ok = .TRUE.
+    !
+    !  To speedup calculations we will get the limits of the domain of the 
+    !  coarse grid and select all the points of the fine grid which are potentialy
+    !  in this domain.
+    !
+    !
+    ff = MINLOC(lalo(:,2))
+    coslat = MAX(COS(lalo(ff(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    domain_minlon = lalo(ff(1),2) - resolution(ff(1),1)/(2.0*coslat)
+    ff = MAXLOC(lalo(:,2))
+    coslat = MAX(COS(lalo(ff(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    domain_maxlon = lalo(ff(1),2) + resolution(ff(1),1)/(2.0*coslat)
+    !
+    coslat = pi/180. * R_Earth
+    domain_minlat = MINVAL(lalo(:,1)) - resolution(ff(1),2)/(2.0*coslat)
+    domain_maxlat = MAXVAL(lalo(:,1)) + resolution(ff(1),2)/(2.0*coslat)
+    !
+    ! Find appropriate resolution for index table
+    !
+    ff=MINLOC(resolution(:,1))
+    coslat = MAX(COS(lalo(ff(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    minlon=resolution(ff(1),1)/(2.0*coslat)
+    ff=MINLOC(resolution(:,2))
+    coslat = pi/180. * R_Earth
+    minlat=resolution(ff(1),2)/(2.0*coslat)
+    mini=MIN(minlon, minlat)
+    !
+    ! This interpolation only works if the model grid is coarser than the data grid
+    !
+    IF (MINVAL(resolution(:,1)) < resol_lon .OR. MINVAL(resolution(:,2)) < resol_lat) THEN
+       WRITE(numout,*) " === WARNING == "
+       WRITE(numout,*) "Resolution minima of the model (lon, lat) : ", &
+            & MINVAL(resolution(:,1)), MINVAL(resolution(:,2))
+       WRITE(numout,*) "Resolution of the file to be interpolated (fine grid) : ", resol_lon, resol_lat
+       WRITE(numout,*) "This interpolation assumes that we aggregate from a fine grid to a coarser grid"
+       WRITE(numout,*) "In the data submitted it apears that the model is runing on a finer grid than the data"
+    ENDIF
+    !
+    incp = 10
+    IF (mini < 0.1) THEN
+       incp=100
+    ELSE IF (mini < 0.01) THEN
+       incp = 1000
+    ENDIF
+    !
+    ! Allocate the needed memory for fine_ind
+    !
+    ALLOCATE (fine_ind(NINT(domain_minlon*incp)-2:NINT(domain_maxlon*incp)+2, &
+         & NINT(domain_minlat*incp)-2:NINT(domain_maxlat*incp)+2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'aggregate_vec','ERROR IN ALLOCATION of find_ind','','')
+    !
+    ! Generate a quick access table for the coarse grid
+    !
+    fine_ind(:,:) = zero
+    !
+    DO ib=1,nbpt
+       coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+       !
+       lon_up = lalo(ib,2) + resolution(ib,1)/(2.0*coslat) 
+       lon_low =lalo(ib,2) - resolution(ib,1)/(2.0*coslat) 
+       !
+       coslat = pi/180. * R_Earth
+       !
+       lat_up =lalo(ib,1) + resolution(ib,2)/(2.0*coslat) 
+       lat_low =lalo(ib,1) - resolution(ib,2)/(2.0*coslat) 
+       !
+       fine_ind(NINT(lon_low*incp):NINT(lon_up*incp),NINT(lat_low*incp):NINT(lat_up*incp))=ib
+       !
+    ENDDO
+    !
+    WRITE(numout,*) 'Domaine LON range : ', domain_minlon, domain_maxlon
+    WRITE(numout,*) 'Domaine LAT range : ', domain_minlat, domain_maxlat
+    !
+    ! we list a first approximation of all point we will need to 
+    ! scan to fill our coarse grid.
+    !
+    IF ( domain_minlon <= -179.5 .AND. domain_maxlon >= 179.5 .AND. &
+      &  domain_minlat <= -89.5  .AND. domain_maxlat >= 89.5 ) THEN
+       ! Here we do the entire globe
+       nbind=0
+       DO ip=1,iml
+          nbind = nbind + 1
+          searchind(nbind) = ip
+       ENDDO
+       !
+    ELSE
+       ! Now we get a limited number of points
+       nbind=0
+       DO ip=1,iml
+          ! Compute the limits of the meshes of the fine grid
+          coslat = MAX(COS(lat_rel(ip) * pi/180. ), mincos )*pi/180. * R_Earth
+          louprel = MIN(lon_rel(ip) + resol_lon/(2.0*coslat), 180.)
+          lolowrel = MAX(lon_rel(ip) - resol_lon/(2.0*coslat), -180.)
+          coslat = pi/180. * R_Earth
+          lauprel = MIN(lat_rel(ip) + resol_lat/(2.0*coslat), 90.)
+          lalowrel = MAX(lat_rel(ip) - resol_lat/(2.0*coslat), -90.)
+          !
+          IF ( louprel >= domain_minlon .AND. lolowrel <= domain_maxlon .AND.&
+            &  lauprel >= domain_minlat .AND. lalowrel <= domain_maxlat ) THEN
+             nbind = nbind + 1
+             searchind(nbind) = ip
+          ENDIF
+       ENDDO
+    ENDIF
+    !
+    WRITE(numout,*) 'We will work with ', nbind, ' points of the fine grid and ', nbpt, 'for the coarse grid'
+    !
+    WRITE(numout,*) 'Aggregate_vec : ', callsign
+    !
+    !   Now we take each grid point and find out which values from the forcing we need to average
+    !
+    fopt(:) = zero
+    fopt_max = -1
+    !
+    !
+    !
+    loopnbind : DO i=1,nbind
+       !
+       !
+       ip = searchind(i)
+       !
+       !  Either the center of the data grid point is in the interval of the model grid or
+       !  the East and West limits of the data grid point are on either sides of the border of
+       !  the data grid.
+       !
+       lonrel = lon_rel(ip)
+       coslat = MAX(COS(lat_rel(ip) * pi/180. ), mincos )*pi/180. * R_Earth
+       louprel = MIN(lon_rel(ip) + resol_lon/(2.0*coslat), domain_maxlon)
+       lolowrel = MAX(lon_rel(ip) - resol_lon/(2.0*coslat), domain_minlon)
+       !
+       latrel = lat_rel(ip)
+       coslat = pi/180. * R_Earth
+       lauprel = MIN(lat_rel(ip) + resol_lat/(2.0*coslat), domain_maxlat)
+       lalowrel = MAX(lat_rel(ip) - resol_lat/(2.0*coslat), domain_minlat)
+       !
+       !
+       pos_pnt(:) = zero
+       ipp = zero
+       pp = fine_ind(NINT(lonrel*incp),NINT(latrel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       pp = fine_ind(NINT(louprel*incp),NINT(lauprel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       pp = fine_ind(NINT(louprel*incp),NINT(lalowrel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       pp = fine_ind(NINT(lolowrel*incp),NINT(lauprel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       pp = fine_ind(NINT(lolowrel*incp),NINT(lalowrel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       !
+       !
+       IF ( ipp > zero ) THEN
+          !
+          DO pp=1,ipp
+             ib = pos_pnt(pp)
+             !
+             !  We find the 4 limits of the grid-box. As we transform the resolution of the model
+             !  into longitudes and latitudes we do not have the problem of periodicity.
+             !  coslat is a help variable here !
+             !
+             coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+             !
+             lon_up = lalo(ib,2) + resolution(ib,1)/(2.0*coslat) 
+             lon_low =lalo(ib,2) - resolution(ib,1)/(2.0*coslat) 
+             !
+             coslat = pi/180. * R_Earth
+             !
+             lat_up =lalo(ib,1) + resolution(ib,2)/(2.0*coslat) 
+             lat_low =lalo(ib,1) - resolution(ib,2)/(2.0*coslat) 
+             !
+             IF ( lonrel > lon_low .AND. lonrel < lon_up .OR. &
+                  & lolowrel < lon_low .AND.  louprel > lon_low .OR. &
+                  & lolowrel < lon_up  .AND.  louprel > lon_up ) THEN
+                !
+                ! Now that we have the longitude let us find the latitude
+                !             
+                IF ( latrel > lat_low .AND. latrel < lat_up .OR. &
+                     & lalowrel < lat_low .AND. lauprel > lat_low .OR.&
+                     & lalowrel < lat_up .AND. lauprel > lat_up) THEN
+                   !
+                   fopt(ib) = fopt(ib) + 1
+                   fopt_max = MAX ( fopt(ib), fopt_max )
+                   !
+                   IF ( fopt(ib) > incmax) THEN
+                      err_fopt=.TRUE.
+                      EXIT loopnbind
+                   ELSE
+                      !
+                      ! Get the area of the fine grid in the model grid
+                      !
+                      coslat = MAX( COS( lat_rel(ip) * pi/180. ), mincos )
+                      ax = (MIN(lon_up,louprel)-MAX(lon_low,lolowrel))*pi/180. * R_Earth * coslat
+                      ay = (MIN(lat_up,lauprel)-MAX(lat_low,lalowrel))*pi/180. * R_Earth
+                      !
+                      areaoverlap(ib, fopt(ib)) = ax*ay
+                      indinc(ib, fopt(ib)) = ip
+                      !
+                   ENDIF
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDIF
+    ENDDO loopnbind
+    !
+    IF (err_fopt) THEN
+       WRITE(numout,*) 'Reached value ', fopt(ib),' for fopt on point', ib
+       CALL ipslerr_p(2,'aggregate_vec (nbpt < nbind)', &
+            'Working on variable :'//callsign, &
+            'Reached incmax value for fopt.',&
+            'Please increase incmax in subroutine calling aggregate')
+       IF (PRESENT(ok)) THEN
+          ok = .FALSE.
+          RETURN
+       ELSE
+          CALL ipslerr_p(3,'aggregate_vec','Stop now','','')
+       ENDIF
+    ENDIF
+    !
+    WRITE(numout,*) 
+    not_found_fopt = COUNT(fopt(:) .EQ. zero)
+    WRITE(numout,*) "aggregate_vec : ",not_found_fopt, &
+         & "did not find any corresponding data in the input file."
+    WRITE(numout,*) "aggregate_vec : This is ", not_found_fopt/FLOAT(nbpt)*100., &
+         & " % of the grid"
+    WRITE(numout,*) "aggregate_vec : nbvmax = ",incmax, "max used = ",fopt_max
+    !
+    ! Do some memory management.
+    !
+    DEALLOCATE (searchind)
+    DEALLOCATE (fine_ind)
+    !
+    ! Close the progress meter
+    !
+    WRITE(numout,*) '    '
+    !
+  END SUBROUTINE aggregate_vec
+!
+!
+
+  SUBROUTINE aggregate_vec_p(nbpt, lalo, neighbours, resolution, contfrac,          &
+       &                 iml, lon_ful, lat_ful, resol_lon, resol_lat, callsign, &
+       &                 nbvmax, sub_index, sub_area, ok)
+    
+    IMPLICIT NONE
+    
+    INTEGER(i_std), INTENT(in)   :: nbpt                 
+    REAL(r_std), INTENT(in)       :: lalo(nbpt,2)        
+    INTEGER(i_std), INTENT(in)   :: neighbours(nbpt,8)   
+    REAL(r_std), INTENT(in)       :: resolution(nbpt,2)   
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)       
+    INTEGER(i_std), INTENT(in)   :: iml                 
+    REAL(r_std), INTENT(in)       :: lon_ful(iml)         
+    REAL(r_std), INTENT(in)       :: lat_ful(iml)         
+    REAL(r_std), INTENT(in)       :: resol_lon, resol_lat 
+    CHARACTER(LEN=*), INTENT(in) :: callsign             
+    INTEGER(i_std), INTENT(in)   :: nbvmax             
+    INTEGER(i_std), INTENT(out)  :: sub_index(nbpt,nbvmax)
+    REAL(r_std), INTENT(out)      :: sub_area(nbpt,nbvmax) 
+    LOGICAL, OPTIONAL, INTENT(out)      :: ok            ! return code
+
+    INTEGER(i_std)  :: sub_index_g(nbp_glo,nbvmax)
+    REAL(r_std)       :: sub_area_g(nbp_glo,nbvmax)
+        
+    IF (is_root_prc) CALL aggregate(nbp_glo, lalo_g, neighbours_g, resolution_g, contfrac_g, &
+   &                                  iml, lon_ful, lat_ful, resol_lon, resol_lat, callsign,   &
+   &                                  nbvmax, sub_index_g, sub_area_g, ok)
+
+    CALL BCAST(ok)
+    CALL scatter(sub_index_g,sub_index)
+    CALL scatter(sub_area_g,sub_area)
+   
+   
+  END SUBROUTINE aggregate_vec_p
+
+  SUBROUTINE aggregate_2d_p(nbpt, lalo, neighbours, resolution, contfrac,          &
+       &                 iml, jml, lon_ful, lat_ful, mask, callsign, &
+       &                 nbvmax, sub_index, sub_area, ok)
+    
+    IMPLICIT NONE
+    
+    INTEGER(i_std), INTENT(in)   :: nbpt                 
+    REAL(r_std), INTENT(in)       :: lalo(nbpt,2)        
+    INTEGER(i_std), INTENT(in)   :: neighbours(nbpt,8)   
+    REAL(r_std), INTENT(in)       :: resolution(nbpt,2)   
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)       
+    INTEGER(i_std), INTENT(in)   :: iml,jml                 
+    REAL(r_std), INTENT(in)       :: lon_ful(iml,jml)         
+    REAL(r_std), INTENT(in)       :: lat_ful(iml,jml)         
+    INTEGER(i_std), INTENT(in)   :: mask(iml, jml)
+    CHARACTER(LEN=*), INTENT(in) :: callsign             
+    INTEGER(i_std), INTENT(in)   :: nbvmax             
+    INTEGER(i_std), INTENT(out)  :: sub_index(nbpt,nbvmax,2)
+    REAL(r_std), INTENT(out)      :: sub_area(nbpt,nbvmax) 
+    LOGICAL, OPTIONAL, INTENT(out)      :: ok            ! return code
+
+    INTEGER(i_std)   :: sub_index_g(nbp_glo,nbvmax,2)
+    REAL(r_std)       :: sub_area_g(nbp_glo,nbvmax)
+    
+    IF (is_root_prc) CALL aggregate_2d(nbp_glo, lalo_g, neighbours_g, resolution_g, contfrac_g, &
+   &                                  iml, jml, lon_ful, lat_ful, mask, callsign,   &
+   &                                  nbvmax, sub_index_g, sub_area_g, ok)
+    CALL BCAST(ok)
+    CALL scatter(sub_index_g,sub_index)
+    CALL scatter(sub_area_g,sub_area)
+   
+  END SUBROUTINE aggregate_2d_p
+!
+END MODULE interpol_help
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/solar.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/solar.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_global/solar.f90	(revision 5166)
@@ -0,0 +1,600 @@
+! =================================================================================================================================
+! MODULE       : solar
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module define solar 
+!!
+!!\n DESCRIPTION: 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE solar
+
+  USE defprec
+  USE constantes
+  USE ioipsl_para 
+
+  IMPLICIT NONE
+
+
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : solarang
+!!
+!>\BRIEF         This subroutine computes the solar angle according to the method used by GSWP and developed by J.C. Morill.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::csang
+!!
+!! REFERENCE(S) : See for further details :
+!! http://www.atmo.arizona.edu/~morrill/swrad.html
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE solarang (julian, julian0, iim, jjm, lon, lat, csang)
+
+    USE calendar
+
+    IMPLICIT NONE
+
+    !! 0. Parameters and variables declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                      :: iim, jjm        !!
+    REAL, INTENT(in)                         :: julian          !!
+    REAL, INTENT(in)                         :: julian0         !!
+    REAL, DIMENSION(iim,jjm), INTENT(in)     :: lon, lat        !!
+
+    !! 0.2 Output variables
+
+    REAL, DIMENSION(iim,jjm), INTENT(out)    :: csang           !!
+
+    !! 0.4 Local variables
+
+    REAL                                     :: gamma           !!
+    REAL                                     :: dec             !!
+    REAL                                     :: decd            !!
+    REAL                                     :: et              !!
+    REAL                                     :: gmt             !!
+    REAL                                     :: le              !!
+    REAL                                     :: ls              !!
+    REAL                                     :: lcorr           !!
+    REAL                                     :: latime          !!
+    REAL                                     :: omega           !!
+    REAL                                     :: omegad          !!
+    REAL                                     :: llatd, llat     !!
+    INTEGER                                  :: igmt            !!
+    INTEGER                                  :: ilon, ilat      !!
+    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: zone            !!
+!$OMP THREADPRIVATE(zone)
+    REAL, SAVE, ALLOCATABLE, DIMENSION(:)    :: lhour           !!
+!$OMP THREADPRIVATE(lhour)
+    !
+    LOGICAL                                  :: check = .FALSE. !!
+!$OMP THREADPRIVATE(check)
+
+!_ ================================================================================================================================
+
+    IF (check) WRITE(numout,*) 'We get the right calendar information'
+    !-
+    !- 1) Day angle gamma
+    !-
+    !   gamma = 2.*pi*MOD(julian,one_year)/one_year
+    gamma = 2.*pi*(julian-julian0)/one_year
+    !-
+    !- 2) Solar declination (assumed constant for a 24 hour period)  page 7
+    !-    in radians
+    !-
+    IF (check) WRITE(numout,*) 'Solar declination'
+    !
+    dec = ( 0.006918-0.399912*COS(gamma)+0.070257*SIN(gamma) &
+         &       -0.006758*COS(2*gamma)+0.000907*SIN(2*gamma)      &
+         &       -0.002697*COS(3*gamma)+0.00148*SIN(3*gamma))
+    decd = dec*(180/pi)
+    !-
+    !- maximum error 0.0006 rad (<3'), leads to error
+    !- of less than 1/2 degree in zenith angle
+    !-
+    IF (check) WRITE(numout,*) 'Equation of time'
+    !- 3)  Equation of time  page 11
+    !-
+    et = ( 0.000075+0.001868*COS(gamma)-0.032077*SIN(gamma)&
+         &      -0.014615*COS(2*gamma)-0.04089*SIN(2*gamma))*229.18
+    !-
+    !- Get the time zones for the current time
+    !-
+    gmt = 24.*(julian-INT(julian))
+    IF (.NOT.ALLOCATED(zone))  ALLOCATE(zone(iim))
+    IF (.NOT.ALLOCATED(lhour)) ALLOCATE(lhour(iim))
+    !-
+    !igmt = NINT(gmt)
+    IF (check) WRITE(numout,*) 'Get time zone'
+    CALL time_zone(gmt, iim, jjm, lon, zone, lhour)
+    !-
+    !- Start a loop through the grid
+    !-
+    IF (check) WRITE(numout,*) 'Start a loop through the grid'
+    DO ilon=1,iim
+       !---
+       !--- 4) Local apparent time  page 13
+       !---
+       !--- ls     standard longitude (nearest 15 degree meridian)
+       !--- le     local longtitude
+       !--- lhour  local standard time
+       !--- latime local apparent time
+       !--- lcorr  longitudunal correction (minutes)
+       !---
+       le = lon(ilon,1)
+       ls = ((zone(ilon)-1)*15)-180.
+       lcorr = 4.*(ls-le)*(-1)
+       latime = lhour(ilon)+lcorr/60.+et/60.
+       IF (latime <  0.) latime = latime+24
+       IF (latime > 24.) latime = latime-24
+       !---
+       !--- 5) Hour angle omega  page 15
+       !---
+       !--- hour angle is zero at noon, positive in the morning
+       !--- It ranges from 180 to -180
+       !---
+       !--- omegad is omega in degrees, omega is in radians
+       !---
+       omegad = (latime-12.)*(-15.)
+       omega  = omegad*pi/180.
+       !---
+       DO ilat=1,jjm
+          !-----
+          !----- 6)  Zenith angle  page 15
+          !-----
+          !----- csang cosine of zenith angle (radians)
+          !----- llatd =  local latitude in degrees
+          !----- llat  =  local latitude in radians
+          !-----
+          llatd = lat(1,ilat)
+          llat  = llatd*pi/180.
+          csang(ilon,ilat) = &
+               &  MAX(zero,SIN(dec)*SIN(llat)+COS(dec)*COS(llat)*COS(omega))
+       ENDDO
+    ENDDO
+    !----------------------
+  END SUBROUTINE solarang
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : time_zone
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::zone, ::lhour
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE time_zone (gmt, iim, jjm, lon, zone, lhour)
+
+    IMPLICIT NONE
+
+    !! 0. Parameters and variables declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                   :: iim, jjm        !!
+    REAL, DIMENSION(iim,jjm), INTENT(in)  :: lon             !!
+    REAL, INTENT(in)                      :: gmt             !!
+
+    !! 0.2 Output variables
+
+    INTEGER, DIMENSION(iim), INTENT(out)  :: zone            !!
+    REAL, DIMENSION(iim), INTENT(out)     :: lhour           !!
+
+    !! 0.4 Local variables
+
+    INTEGER                               :: deg             !!
+    !!??   REAL :: deg
+    INTEGER                               :: i, ilon, change !! Indices
+
+!_ ================================================================================================================================
+
+    DO ilon=1,iim
+       !---
+       !--- Convert longitude index to longtitude in degrees
+       !---
+       deg = lon(ilon,1)
+       !---
+       !--- Determine into which time zone (15 degree interval) the
+       !--- longitude falls.
+       !---
+       DO i=1,25
+          IF (deg < (-187.5+(15*i))) THEN
+             zone(ilon) = i
+             IF (zone(ilon) == 25)   zone(ilon) = 1
+             EXIT
+          ENDIF
+       ENDDO
+       !---
+       !--- Calculate change (in number of hours) from GMT time to
+       !--- local hour.  Change will be negative for zones < 13 and
+       !--- positive for zones > 13.
+       !---
+       !--- There is also a correction for lhour < 0 and lhour > 23
+       !--- to lhour between 0 and 23.
+       !---
+       IF (zone(ilon) < 13) THEN
+          change = zone(ilon)-13
+          lhour(ilon) = gmt+change
+       ENDIF
+       !---
+       IF (zone(ilon) == 13) THEN
+          lhour(ilon) = gmt
+       ENDIF
+       !---
+       IF (zone(ilon) > 13) THEN
+          change = zone(ilon)-13
+          lhour(ilon) = gmt+change
+       ENDIF
+       IF (lhour(ilon) <  0) lhour(ilon) = lhour(ilon)+24
+       IF (lhour(ilon) >= 24) lhour(ilon) = lhour(ilon)-24
+       !---
+    ENDDO
+    !-----------------------
+  END SUBROUTINE time_zone
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : downward_solar_flux
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::solad, ::solai
+!!
+!! REFERENCE(S) :See for further details :
+!! http://www.atmo.arizona.edu/~morrill/swrad.html
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE downward_solar_flux (npoi,latitude,calendar_str,jday,rtime,cloud,nband,solad,solai)
+
+    IMPLICIT NONE
+
+    !! 0. Parameter and variables declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER, INTENT(in)                      :: npoi               !! number of grid points (unitless)
+    REAL, DIMENSION(npoi), INTENT(in)        :: latitude           !! latitude in degrees
+    CHARACTER(LEN=20),INTENT(in)             :: calendar_str       !! Calendar type
+    REAL, INTENT(in)                         :: jday
+    REAL,INTENT(in)                          :: rtime
+    REAL, DIMENSION(npoi), INTENT(in)        :: cloud              !! cloud fraction (0-1, unitless)
+    INTEGER,INTENT(in)                       :: nband              !! number of visible bands (unitless)
+
+    !! 0.2 Output variables
+
+    REAL, DIMENSION(npoi,nband), INTENT(out) :: solad              !! direct downward solar flux 
+                                                                   !! @tex $(W.m^{-2})$ @endtex
+    REAL, DIMENSION(npoi,nband), INTENT(out) :: solai              !! diffuse downward solar flux 
+                                                                   !! @tex $(W.m^{-2})$ @endtex
+
+    !! 0.4 Local variables
+
+    ! Parametres orbitaux:
+
+    REAL, SAVE                               :: ecc                !! Eccentricity
+!$OMP THREADPRIVATE(ecc)
+    REAL, SAVE                               :: perh               !! Longitude of perihelie
+!$OMP THREADPRIVATE(perh)
+    REAL, SAVE                               :: xob                !! obliquity
+!$OMP THREADPRIVATE(xob)
+    REAL, PARAMETER                          :: pir = pi/180.      !!
+    REAL, SAVE                               :: step               !!
+!$OMP THREADPRIVATE(step)
+    REAL                                     :: xl                 !!
+    REAL                                     :: so                 !!
+    REAL                                     :: xllp               !!
+    REAL                                     :: xee                !!
+    REAL                                     :: xse                !!  
+    REAL                                     :: xlam               !!
+    REAL                                     :: dlamm              !!
+    REAL                                     :: anm                !!
+    REAL                                     :: ranm               !!
+    REAL                                     :: ranv               !!
+    REAL                                     :: anv                !!
+    REAL                                     :: tls                !!
+    REAL                                     :: rlam               !!
+    REAL                                     :: sd                 !!
+    REAL                                     :: cd                 !!
+    REAL                                     :: deltar             !!
+    REAL                                     :: delta              !!
+    REAL                                     :: Dis_ST             !!  
+    REAL                                     :: ddt                !!
+    REAL                                     :: orbit              !!
+    REAL                                     :: angle              !!
+    REAL                                     :: xdecl              !!
+    REAL                                     :: xlat               !!
+    REAL, DIMENSION(npoi)                    :: trans              !!
+    REAL, DIMENSION(npoi)                    :: fdiffuse           !!
+    REAL, DIMENSION(npoi)                    :: coszen             !! cosine of solar zenith angle
+    REAL                                     :: sw                 !!
+    REAL                                     :: frac               !!
+    INTEGER                                  :: i,ib               !!
+    LOGICAL, SAVE                            :: firstcall_solar = .TRUE. !!
+!$OMP THREADPRIVATE(firstcall_solar)
+
+!_ ================================================================================================================================
+    
+    IF (firstcall_solar) THEN
+       IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN  
+          step = 1.0
+       ELSE
+          step = one_year/365.2425
+       ENDIF
+       !-
+       ! Read Orbital Parameters
+       !-
+
+       !Config Key   = ECCENTRICITY
+       !Config Desc  = Use prescribed values
+       !Config If    = ALLOW_WEATHERGEN
+       !Config Def   = 0.016724
+       !Config Help  =
+       !Config Units = [-]
+       ecc = 0.016724
+       CALL getin_p ('ECCENTRICITY',ecc)
+       WRITE(numout,*) 'ECCENTRICITY: ',ecc
+       !
+       !Config Key  = PERIHELIE
+       !Config Desc = Use prescribed values
+       !Config If   = ALLOW_WEATHERGEN
+       !Config Def  = 102.04
+       !Config Help  =
+       !Config Units = [-]
+       perh = 102.04
+       CALL getin_p ('PERIHELIE',perh)
+       WRITE(numout,*) 'PERIHELIE: ',perh
+       !
+       !Config Key  = OBLIQUITY
+       !Config Desc = Use prescribed values
+       !Config If   = ALLOW_WEATHERGEN
+       !Config Def  = 23.446
+       !Config Help  =
+       !Config Units = [Degrees]
+       xob = 23.446
+       CALL getin_p ('OBLIQUITY',xob)
+       WRITE(numout,*) 'OBLIQUITY: ',xob
+
+       firstcall_solar = .FALSE.
+    ENDIF
+
+    !-
+    ! calendar and orbital calculations
+    !-
+
+    !-
+    ! calculate the earth's orbital angle (around the sun) in radians
+    orbit = 2.0*pi*jday/365.2425
+    !-
+    ! calculate the solar hour angle in radians
+    angle = 2.0*pi*(rtime-12.0)/24.0
+    !-
+    ! calculate the current solar declination angle
+    ! ref: global physical climatology, hartmann, appendix a
+    !
+    ! xdecl = 0.006918 &
+    !        -0.399912*cos(orbit) &
+    !        +0.070257*sin(orbit) &
+    !        -0.006758*cos(2.0*orbit) &
+    !        +0.000907*sin(2.0*orbit) &
+    !        -0.002697*cos(3.0*orbit) &
+    !        +0.001480*sin(3.0*orbit)
+    !
+    ! calculate the effective solar constant,
+    ! including effects of eccentricity
+    ! ref: global physical climatology, hartmann, appendix a
+    !
+    ! sw = 1370.*( 1.000110 &
+    !             +0.034221*cos(orbit) &
+    !             +0.001280*sin(orbit) &
+    !             +0.000719*cos(2.0*orbit) &
+    !             +0.000077*sin(2.0*orbit))
+    !
+    ! correction Marie-France Loutre
+    !
+    !    orbital parameters
+    !
+    !    ecc = 0.016724
+    !    perh = 102.04
+    !    xob = 23.446
+    !-
+    xl = perh+180.0
+    ! so : sinus of obliquity
+    so = sin(xob*pir)
+    !-
+    xllp = xl*pir
+    xee  = ecc*ecc
+    xse  = sqrt(1.0d0-xee)
+    ! xlam : true long. sun for mean long. = 0
+    xlam = (ecc/2.0+ecc*xee/8.0d0)*(1.0+xse)*sin(xllp)-xee/4.0 &
+         &      *(0.5+xse)*sin(2.0*xllp)+ecc*xee/8.0*(1.0/3.0+xse) &
+         &      *sin(3.0*xllp)
+    xlam  =2.0d0*xlam/pir
+    ! dlamm : mean long. sun for ma-ja
+    dlamm =xlam+(INT(jday)-79)*step
+    anm   = dlamm-xl
+    ranm  = anm*pir
+    xee   = xee*ecc
+    ! ranv : anomalie vraie    (radian)
+    ranv = ranm+(2.0*ecc-xee/4.0)*sin(ranm)+5.0/4.0*ecc*ecc &
+         &      *sin(2.0*ranm)+13.0/12.0*xee*sin(3.0*ranm)
+    ! anv  : anomalie vraie    (degrees)
+    anv  = ranv/pir
+    ! tls  : longitude vraie   (degrees)
+    tls  = anv+xl
+    ! rlam : longitude vraie   (radian)
+    rlam = tls*pir
+    ! sd and cd: cosinus and sinus of solar declination angle (delta)
+    ! sinus delta = sin (obl)*sin(lambda) with lambda = real longitude
+    ! (Phd. thesis of Marie-France Loutre, ASTR-UCL, Belgium, 1993)
+    sd    = so*sin(rlam)
+    cd    = sqrt(1.0d0-sd*sd)
+    ! delta : Solar Declination (degrees, angle sun at equator)
+    deltar = atan(sd/cd)
+    delta  = deltar/pir
+    !-
+    ! Eccentricity Effect
+    !-
+    Dis_ST  =(1.0-ecc*ecc)/(1.0+ecc*cos(ranv))
+    ! ddt :    1 / normalized earth's sun distance
+    ddt = 1.0/Dis_ST
+    !-
+    ! Insolation normal to the atmosphere (W/m2)
+    !-
+    sw  = ddt *ddt *1370.d0
+    !-
+    xdecl = deltar
+    !-
+    ! solar calculations
+    !-
+    do i=1,npoi
+       !---
+       !-- calculate the latitude in radians
+       !---
+       xlat = latitude(i)*pi/180.0
+       !---
+       !-- calculate the cosine of the solar zenith angle
+       !---
+       coszen(i) = MAX(0.0, (sin(xlat)*sin(xdecl) &
+            &                      + cos(xlat)*cos(xdecl)*cos(angle)))
+       !---
+       !-- calculate the solar transmission through the atmosphere
+       !-- using simple linear function of tranmission and cloud cover
+       !---
+       !-- note that the 'cloud cover' data is typically obtained from
+       !-- sunshine hours -- not direct cloud observations
+       !---
+       !-- where, cloud cover = 1 - sunshine fraction
+       !---
+       !-- different authors present different values for the slope and
+       !-- intercept terms of this equation
+       !---
+       !-- Friend, A: Parameterization of a global daily weather generator
+       !-- for terrestrial ecosystem and biogeochemical modelling,
+       !-- Ecological Modelling
+       !---
+       !-- Spitters et al., 1986: Separating the diffuse and direct component
+       !-- of global radiation and its implications for modeling canopy
+       !-- photosynthesis, Part I: Components of incoming radiation,
+       !-- Agricultural and Forest Meteorology, 38, 217-229.
+       !---
+       !-- A. Friend       : trans = 0.251+0.509*(1.0-cloud(i))
+       !-- Spitters et al. : trans = 0.200+0.560*(1.0-cloud(i))
+       !---
+       !-- we are using the values from A. Friend
+       !---
+       trans(i) = 0.251+0.509*(1.0-cloud(i))
+       !---
+       !-- calculate the fraction of indirect (diffuse) solar radiation
+       !-- based upon the cloud cover
+       !---
+       !-- note that these relationships typically are measured for either
+       !-- monthly or daily timescales, and may not be exactly appropriate
+       !-- for hourly calculations -- however, in ibis, cloud cover is fixed
+       !-- through the entire day so it may not make much difference
+       !---
+       !-- method i --
+       !---
+       !-- we use a simple empirical relationships
+       !-- from Nikolov and Zeller (1992)
+       !---
+       !-- Nikolov, N. and K.F. Zeller, 1992:  A solar radiation algorithm
+       !-- for ecosystem dynamics models, Ecological Modelling, 61, 149-168.
+       !---
+       fdiffuse(i) = 1.0045+trans(i)*( 0.0435+trans(i) &
+            &                                 *(-3.5227+trans(i)*2.6313))
+       !---
+       IF (trans(i) > 0.75) fdiffuse(i) = 0.166
+       !---
+       !-- method ii --
+       !---
+       !-- another method was suggested by Spitters et al. (1986) based on
+       !-- long-term data from the Netherlands
+       !--
+       !-- Spitters et al., 1986: Separating the diffuse and direct component
+       !-- of global radiation and its implications for modeling canopy
+       !-- photosynthesis, Part I: Components of incoming radiation,
+       !-- Agricultural and Forest Meteorology, 38, 217-229.
+       !---
+       !--       if ((trans == 0.00).and.(trans < 0.07)) then
+       !--         fdiffuse = 1.0
+       !--       else if ((trans >= 0.07).and.(trans < 0.35)) then
+       !--         fdiffuse = 1.0-2.3*(trans-0.07)**2
+       !--       else if ((trans >= 0.35).and.(trans < 0.75)) then
+       !--         fdiffuse = 1.33-1.46*trans
+       !--       ELSE
+       !--         fdiffuse = 0.23
+       !--       endif
+       !---
+    ENDDO
+    !-----------------------
+    !-
+    ! do for each waveband
+    !-
+    DO ib=1,nband
+       !---
+       !-- calculate the fraction in each waveband
+       !---
+       !-- GK010200
+       IF (nband == 2) then
+          frac = 0.46+0.08*REAL(ib-1)
+       ELSE
+          frac = 1./REAL(nband)
+       ENDIF
+       !---
+       DO i=1,npoi
+          !-----
+          !---- calculate the direct and indirect solar radiation
+          !-----
+          solad(i,ib) = sw*coszen(i)*frac*trans(i)*(1.-fdiffuse(i))
+          solai(i,ib) = sw*coszen(i)*frac*trans(i)*fdiffuse(i)
+       ENDDO
+    ENDDO
+
+
+  END SUBROUTINE downward_solar_flux
+
+ 
+END MODULE solar
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/AA_make	(revision 5166)
@@ -0,0 +1,164 @@
+#-
+#- $Id$
+#-
+MODS1 = mod_orchidee_para_var.F90 \
+        xios_orchidee.f90 \
+        mod_orchidee_mpi_data.F90 \
+	mod_orchidee_omp_data.F90 \
+	timer.f90 \
+        mod_orchidee_mpi_transfert.F90 \
+        mod_orchidee_omp_transfert.F90 \
+        mod_orchidee_transfert_para.F90 \
+        mod_orchidee_para.F90 \
+	tools_para.f90 \
+	ioipsl_para.f90 \
+	orch_write_field.f90 \
+	write_field.f90 \
+	orch_write_field_p.f90 \
+	write_field_p.f90
+
+
+PARAM_LIB=$(LIBDIR)/libparameters.a
+FILTERf90=$(filter %.f90,$(MODS1))
+FILTERF90=$(filter %.F90,$(MODS1))
+OBJSMODS1=$(FILTERf90:.f90=.o) $(FILTERF90:.F90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) m_all
+	@echo parallel is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+#-Q- intel m_all: WORK_MOD $(MODEL_LIB)($(OBJSMODS1))
+
+$(MODEL_LIB)(%.o) : %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+#-Q- intel
+#-Q- intel WORK_MOD :
+#-Q- intel 	$(RM) work.pcl
+#-Q- intel 	@echo "work.pc" > work.pcl
+#-Q- intel 	@echo "../src_parameters/work.pc" >> work.pcl
+#-Q- intel 	@echo "../src_stomate/work.pc" >> work.pcl
+#-Q- intel 	@echo "../../IOIPSL/src/work.pc" >> work.pcl
+
+$(MODEL_LIB)(%.o) : %.F90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.F90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+
+
+$(PARAM_LIB)(pft_parameters_var.o) : ../src_parameters/pft_parameters_var.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) ../src_parameters/pft_parameters_var.f90
+	$(A_C) $(PARAM_LIB) pft_parameters_var.o
+	$(A_C) $(ORCHIDEE_LIB) pft_parameters_var.o
+	$(RM) ../src_parallel/pft_parameters_var.o
+
+$(PARAM_LIB)(constantes_var.o) : ../src_parameters/constantes_var.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) ../src_parameters/constantes_var.f90
+	$(A_C) $(PARAM_LIB) constantes_var.o
+	$(A_C) $(ORCHIDEE_LIB) constantes_var.o
+	$(RM) ../src_parallel/constantes_var.o
+
+$(PARAM_LIB)(constantes_soil_var.o) : ../src_parameters/constantes_soil_var.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) ../src_parameters/constantes_soil_var.f90
+	$(A_C) $(PARAM_LIB) constantes_soil_var.o
+	$(A_C) $(ORCHIDEE_LIB) constantes_soil_var.o
+	$(RM) ../src_parallel/constantes_soil_var.o
+
+config : 
+	$(BINDIR)/Fparser -name PARALLEL $(MODS1)
+	echo 'Configuration of PARALLEL done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(mpi_dummy.o):
+
+$(MODEL_LIB)(mod_orchidee_para_var.o):
+
+$(MODEL_LIB)(xios_orchidee.o): \
+       $(MODEL_LIB)(mod_orchidee_para_var.o) \
+       $(MODEL_LIB)(mod_orchidee_transfert_para.o) \
+       $(MODEL_LIB)(ioipsl_para.o) \
+       $(PARAM_LIB)(pft_parameters_var.o) \
+       $(PARAM_LIB)(constantes_var.o) \
+       $(PARAM_LIB)(constantes_soil_var.o)
+
+$(MODEL_LIB)(mod_orchidee_mpi_data.o): \
+    $(MODEL_LIB)(mod_orchidee_para_var.o) \
+    $(MODEL_LIB)(xios_orchidee.o) 
+
+$(MODEL_LIB)(mod_orchidee_omp_data.o): \
+    $(MODEL_LIB)(mod_orchidee_para_var.o)
+
+$(MODEL_LIB)(timer.o): \
+    $(MODEL_LIB)(mod_orchidee_para_var.o)
+
+$(MODEL_LIB)(orch_write_field.o): \
+    $(MODEL_LIB)(mod_orchidee_para.o)
+
+$(MODEL_LIB)(write_field.o): \
+  $(MODEL_LIB)(orch_write_field.o)
+
+$(MODEL_LIB)(mod_orchidee_mpi_transfert.o): \
+  $(MODEL_LIB)(mod_orchidee_para_var.o) \
+  $(MODEL_LIB)(timer.o)
+
+$(MODEL_LIB)(mod_orchidee_omp_transfert.o): \
+  $(MODEL_LIB)(mod_orchidee_omp_data.o)
+
+$(MODEL_LIB)(mod_orchidee_transfert_para.o): \
+  $(MODEL_LIB)(mod_orchidee_para_var.o) \
+  $(MODEL_LIB)(mod_orchidee_mpi_transfert.o) \
+  $(MODEL_LIB)(mod_orchidee_omp_transfert.o)
+
+$(MODEL_LIB)(mod_orchidee_para.o): \
+  $(MODEL_LIB)(mod_orchidee_mpi_data.o) \
+  $(MODEL_LIB)(mod_orchidee_omp_data.o) \
+  $(MODEL_LIB)(mod_orchidee_transfert_para.o)
+
+$(MODEL_LIB)(ioipsl_para.o): \
+  $(MODEL_LIB)(mod_orchidee_transfert_para.o) \
+  $(MODEL_LIB)(mod_orchidee_para_var.o)
+
+$(MODEL_LIB)(tools_para.o): \
+  $(MODEL_LIB)(mod_orchidee_para_var.o)
+
+$(MODEL_LIB)(orch_write_field_p.o): \
+  $(MODEL_LIB)(mod_orchidee_para.o) \
+  $(MODEL_LIB)(write_field.o)
+
+$(MODEL_LIB)(write_field_p.o): \
+  $(MODEL_LIB)(orch_write_field_p.o)
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/AA_make.ldef	(revision 5166)
@@ -0,0 +1,20 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a PARALLEL
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+ORDIR  = ..
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/libparallel.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxparallel.a
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/ioipsl_para.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/ioipsl_para.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/ioipsl_para.f90	(revision 5166)
@@ -0,0 +1,654 @@
+! Overlap of IOIPSL functions for specific parallel use in ORCHIDEE.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE ioipsl_para
+  USE ioipsl
+  USE mod_orchidee_para_var
+  USE mod_orchidee_transfert_para
+!-
+  IMPLICIT NONE
+
+  INTEGER, SAVE :: orch_domain_id 
+!-
+   INTEGER :: orch_ipslout=6, orch_ilv_cur=0, orch_ilv_max=0
+!$OMP THREADPRIVATE( orch_ipslout, orch_ilv_cur, orch_ilv_max )
+
+!-
+!-
+#include "src_parallel.h"
+!-
+  INTERFACE getin_p
+    MODULE PROCEDURE getin_p_c,getin_p_c1,   &
+         getin_p_i,getin_p_i1,getin_p_i2,&
+         getin_p_r,getin_p_r1,getin_p_r2,&
+         getin_p_l,getin_p_l1,getin_p_l2
+  END INTERFACE
+!-
+  INTERFACE restput_p
+     MODULE PROCEDURE &
+          restput_p_r3d, restput_p_r2d, restput_p_r1d, &
+          restput_p_opp_r2d, restput_p_opp_r1d
+  END INTERFACE
+!-
+  INTERFACE restget_p
+     MODULE PROCEDURE &
+          restget_p_r3d, restget_p_r2d, restget_p_r1d, &
+          restget_p_opp_r2d, restget_p_opp_r1d
+  END INTERFACE
+
+
+  INTERFACE histwrite_p
+     MODULE PROCEDURE &
+     histwrite_r1d_p,histwrite_r2d_p,histwrite_r3d_p     
+  END INTERFACE
+
+CONTAINS
+
+
+
+  SUBROUTINE Init_ioipsl_para
+
+    IMPLICIT NONE
+    
+    INTEGER,DIMENSION(2) :: ddid
+    INTEGER,DIMENSION(2) :: dsg
+    INTEGER,DIMENSION(2) :: dsl
+    INTEGER,DIMENSION(2) :: dpf
+    INTEGER,DIMENSION(2) :: dpl
+    INTEGER,DIMENSION(2) :: dhs
+    INTEGER,DIMENSION(2) :: dhe 
+
+    IF (is_omp_root) THEN
+      ddid=(/ 1,2 /)
+      dsg=(/ iim_g, jjm_g /)
+      dsl=(/ iim_g, jj_nb /)
+      dpf=(/ 1,jj_begin /)
+      dpl=(/ iim_g, jj_end /)
+      dhs=(/ ii_begin-1,0 /)
+      if (mpi_rank==mpi_size-1) then
+        dhe=(/0,0/)
+      else
+         dhe=(/ iim_g-ii_end,0 /)  
+      endif
+    
+      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
+                        'APPLE',orch_domain_id)
+     ENDIF
+     
+  END SUBROUTINE Init_ioipsl_para
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!   Definition de ioconf_setatt_p      !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE ioconf_setatt_p (attname,attvalue)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*), INTENT(in) :: attname,attvalue
+!---------------------------------------------------------------------
+
+  IF (is_root_prc) THEN 
+     CALL ioconf_setatt(attname,attvalue)
+  ENDIF
+
+END SUBROUTINE ioconf_setatt_p
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!   Definition de parallel ipslerr functions    !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!===
+SUBROUTINE ipslnlf_p (new_number,old_number)
+!!--------------------------------------------------------------------
+!! The "ipslnlf" routine allows to know and modify
+!! the current logical number for the messages.
+!!
+!! SUBROUTINE ipslnlf (new_number,old_number)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_number : new logical number of the file
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_number : current logical number of the file
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(IN)  :: new_number
+  INTEGER,OPTIONAL,INTENT(OUT) :: old_number
+!---------------------------------------------------------------------
+  IF (PRESENT(old_number)) THEN
+#ifndef CPP_OMP
+    CALL ipslnlf(old_number=orch_ipslout)
+#endif
+    old_number = orch_ipslout
+  ENDIF
+  IF (PRESENT(new_number)) THEN
+    orch_ipslout = new_number
+#ifndef CPP_OMP
+    CALL ipslnlf(new_number=orch_ipslout)
+#endif
+  ENDIF
+!---------------------
+END SUBROUTINE ipslnlf_p
+!===
+SUBROUTINE ipslerr_p (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!! The "ipslerr_p" routine
+!! allows to handle the messages to the user.
+!!
+!! parallel version of IOIPSL ipslerr
+!!
+!! INPUT
+!!
+!! plev   : Category of message to be reported to the user
+!!          1 = Note to the user
+!!          2 = Warning to the user
+!!          3 = Fatal error
+!! pcname : Name of subroutine which has called ipslerr
+!! pstr1   
+!! pstr2  : Strings containing the explanations to the user
+!! pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     orch_ilv_cur = plev
+     orch_ilv_max = MAX(orch_ilv_max,plev)
+     WRITE(orch_ipslout,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(orch_ipslout,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
+   ENDIF
+   IF (plev == 3) THEN
+     WRITE(orch_ipslout,'("Fatal error from ORCHIDEE. STOP in ipslerr_p with code")')
+#ifdef CPP_PARA
+    CALL MPI_ABORT(plev)
+#endif     
+    STOP 1
+   ENDIF
+!---------------------
+END SUBROUTINE ipslerr_p
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!   Definition des getin -> bcast      !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaines de caracteres -- !!
+  
+  SUBROUTINE getin_p_c(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    CHARACTER(LEN=*),INTENT(INOUT) :: VarOut    
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_c  
+
+
+  SUBROUTINE getin_p_c1(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    CHARACTER(LEN=*),INTENT(INOUT) :: VarOut(:)    
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_c1 
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE getin_p_i(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    INTEGER,INTENT(INOUT) :: VarOut    
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_i
+
+  SUBROUTINE getin_p_i1(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    INTEGER,INTENT(INOUT) :: VarOut(:)
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_i1
+
+  SUBROUTINE getin_p_i2(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    INTEGER,INTENT(INOUT) :: VarOut(:,:)
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_i2
+
+!! -- Les flottants -- !!
+  
+  SUBROUTINE getin_p_r(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    REAL,INTENT(INOUT) :: VarOut
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_r
+
+  SUBROUTINE getin_p_r1(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    REAL,INTENT(INOUT) :: VarOut(:)
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_r1
+
+  SUBROUTINE getin_p_r2(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    REAL,INTENT(INOUT) :: VarOut(:,:)
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_r2
+
+!! -- Les Booleens -- !!
+  
+  SUBROUTINE getin_p_l(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    LOGICAL,INTENT(INOUT) :: VarOut
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_l
+
+  SUBROUTINE getin_p_l1(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    LOGICAL,INTENT(INOUT) :: VarOut(:)
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_l1
+
+  SUBROUTINE getin_p_l2(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    LOGICAL,INTENT(INOUT) :: VarOut(:,:)
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_l2
+!-
+!-----------------------------
+!-----------------------------
+!-----------------------------
+!-
+  SUBROUTINE restget_p_opp_r1d &
+  (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+   var, MY_OPERATOR, nbindex, ijndex)
+! DO NOT USE THIS FUNCTION WITH NON GRID VARIABLE !
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL def_beha
+    REAL :: var(:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+       ALLOCATE( temp_g(1) )
+    ENDIF
+        
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+            temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_opp_r1d
+!-
+!===
+!-
+  SUBROUTINE restget_p_opp_r2d &
+  (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+   var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+    !-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL def_beha
+    REAL :: var(:,:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+      ALLOCATE( temp_g(1,1) )
+    ENDIF
+
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+            temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_opp_r2d
+!-
+!===
+!-
+  SUBROUTINE restget_p_r1d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+! DO NOT USE THIS FUNCTION WITH NON GRID VARIABLE !
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL :: def_beha
+    REAL :: var(:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+       ALLOCATE( temp_g(1) )
+    ENDIF
+
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_r1d
+!-
+!===
+!-
+  SUBROUTINE restget_p_r2d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL :: def_beha
+    REAL :: var(:,:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+       ALLOCATE( temp_g(1,1) )
+    ENDIF
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_r2d
+!-
+!===
+!-
+  SUBROUTINE restget_p_r3d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL def_beha
+    REAL :: var(:,:,:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim,jjm,llm) )
+    ELSE 
+       ALLOCATE( temp_g(1,1,1) )
+    ENDIF
+    
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_r3d
+!-
+!-----------------------------
+!-----------------------------
+!-
+  SUBROUTINE restput_p_opp_r1d &
+  (fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
+
+    IF (is_root_prc) THEN 
+      ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+      ALLOCATE ( temp_g(1) )
+    ENDIF
+    
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput &
+            (fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_opp_r1d
+!-
+!===
+!-
+  SUBROUTINE restput_p_opp_r2d &
+  (fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:,:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+      ALLOCATE( temp_g(1,1) )
+    ENDIF
+          
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput &
+            (fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_opp_r2d
+!-
+!===
+!-
+  SUBROUTINE restput_p_r1d (fid,vname_q,iim,jjm,llm,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+      ALLOCATE( temp_g(1) )
+    ENDIF
+    
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_r1d
+!-
+!===
+!-
+  SUBROUTINE restput_p_r2d (fid,vname_q,iim,jjm,llm,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:,:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+      ALLOCATE( temp_g(1,1) )
+    ENDIF
+    
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_r2d
+!-
+!===
+!-
+  SUBROUTINE restput_p_r3d (fid,vname_q,iim,jjm,llm,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:,:,:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim,jjm,llm) )
+    ELSE
+      ALLOCATE( temp_g(iim,jjm,llm) )
+    ENDIF
+    
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_r3d
+
+
+  SUBROUTINE histwrite_r1d_p(pfileid,pvarname,pitau,pdata,nbindex,nindex)
+    IMPLICIT NONE
+!-
+    INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex)
+    REAL,DIMENSION(:),INTENT(IN) :: pdata
+    CHARACTER(LEN=*),INTENT(IN) :: pvarname
+    
+    REAL,DIMENSION(nbp_mpi)    :: pdata_mpi
+    
+    IF (pfileid > 0) THEN 
+       ! Continue only if the file is initilalized
+       CALL gather_omp(pdata,pdata_mpi)
+       IF (is_omp_root) THEN
+          CALL histwrite(pfileid,pvarname,pitau,pdata_mpi,nbp_mpi,kindex_mpi) 
+       ENDIF
+    END IF
+      
+  END SUBROUTINE histwrite_r1d_p
+  
+
+  SUBROUTINE histwrite_r2d_p(pfileid,pvarname,pitau,pdata,nbindex,nindex)
+    IMPLICIT NONE
+!-
+    INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex)
+    REAL,DIMENSION(:,:),INTENT(IN) :: pdata
+    CHARACTER(LEN=*),INTENT(IN) :: pvarname
+
+    IF (pfileid > 0) THEN 
+       ! Continue only if the file is initilalized
+       CALL body(size(pdata,2),nindex)
+    END IF
+
+  CONTAINS 
+
+    SUBROUTINE body(dim,nindex)
+    INTEGER :: dim
+    INTEGER :: nindex(nbp_omp,dim)
+    
+    INTEGER :: nindex_mpi(nbp_mpi,dim)
+    REAL    :: pdata_mpi(nbp_mpi,dim)
+    
+      CALL gather_omp(pdata,pdata_mpi)
+      CALL gather_omp(nindex,nindex_mpi)
+    
+      IF (is_omp_root) THEN
+       CALL histwrite(pfileid,pvarname,pitau,pdata_mpi,nbp_mpi*dim,reshape(nindex_mpi,(/nbp_mpi*dim/)))
+      ENDIF
+    END SUBROUTINE body
+       
+  END SUBROUTINE histwrite_r2d_p
+
+  
+  SUBROUTINE histwrite_r3d_p(pfileid,pvarname,pitau,pdata,nbindex,nindex)
+    IMPLICIT NONE
+!-
+    INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex)
+    REAL,DIMENSION(:,:,:),INTENT(IN) :: pdata
+    CHARACTER(LEN=*),INTENT(IN) :: pvarname
+  
+    STOP 2 
+    
+  END SUBROUTINE histwrite_r3d_p
+
+
+END MODULE ioipsl_para
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_mpi_data.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_mpi_data.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_mpi_data.F90	(revision 5166)
@@ -0,0 +1,401 @@
+! Definition and allocation of parallel datas for MPI.
+! Initialization of parallel or sequentiel IOs.
+! Definition of Load Balancing functions.
+
+!-
+!- $Header: $
+!- 
+
+MODULE mod_orchidee_mpi_data
+
+!-
+  USE defprec
+  USE ioipsl
+  USE xios_orchidee
+  USE mod_orchidee_para_var
+
+  IMPLICIT NONE
+
+!-
+#include "src_parallel.h"
+!-
+!-
+
+CONTAINS
+ 
+  SUBROUTINE Init_orchidee_mpi(communicator)
+
+
+    IMPLICIT NONE
+    INTEGER, OPTIONAL, INTENT(in) :: communicator
+    INTEGER :: COMM
+    INTEGER :: ierr
+    
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    !Config Key   = XIOS_ORCHIDEE_OK
+    !Config Desc  = Use XIOS for writing diagnostics file
+    !Config If    = 
+    !Config Def   = y
+    !Config Help  = If XIOS_ORCHIDEE_OK=y then no output with IOIPSL can be done
+    !Config Units = [FLAG]
+    CALL getin('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
+    WRITE(numout,*)'In init_ochidee_mpi : xios_orchidee_ok=',xios_orchidee_ok
+
+#ifdef CPP_PARA
+    IF ( xios_orchidee_ok ) THEN
+       CALL MPI_INIT(ierr)
+       CALL xios_orchidee_comm_init(COMM)
+    ELSE IF ( PRESENT(communicator) ) THEN
+       COMM=communicator
+    ELSE
+       CALL MPI_INIT(ierr)
+       COMM=MPI_COMM_WORLD
+    ENDIF
+    CALL MPI_COMM_SIZE(COMM,mpi_size,ierr)
+    CALL MPI_COMM_RANK(COMM,mpi_rank,ierr)
+    is_ok_mpi=.TRUE.
+#else
+    mpi_rank=0
+    mpi_size=1
+    is_ok_mpi=.FALSE.
+    ! It is not possible to use XIOS without MPI
+    WRITE(numout,*)'XIOS cannot be run without MPI. xios_orchidee_ok is set to false.'
+    xios_orchidee_ok=.FALSE.
+#endif
+    
+    mpi_rank_root=0
+
+    IF (mpi_rank==mpi_rank_root) THEN 
+      is_mpi_root=.TRUE.
+    ELSE
+      is_mpi_root=.FALSE.
+    ENDIF
+  
+    CALL Init_const_mpi(COMM)
+      
+  END SUBROUTINE Init_orchidee_mpi
+
+
+
+  SUBROUTINE Init_orchidee_mpi_data(arg_nbp_mpi,arg_kindex_mpi,arg_offset_mpi,COMM)
+
+  IMPLICIT NONE
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER, INTENT(IN) :: arg_nbp_mpi
+    INTEGER, INTENT(IN) :: arg_kindex_mpi(arg_nbp_mpi)
+    INTEGER, INTENT(IN) :: arg_offset_mpi
+    INTEGER, INTENT(IN) :: COMM
+
+    INTEGER :: i
+  
+#ifdef CPP_PARA
+    INTEGER :: ierr
+    is_ok_mpi=.TRUE.
+#else
+    is_ok_mpi=.FALSE.
+#endif
+
+    ! Initialization of MPI_COMM_ORCH 
+    CALL init_const_mpi(COMM)
+    IF (is_ok_mpi) THEN    
+#ifdef CPP_PARA
+      CALL MPI_COMM_SIZE(MPI_COMM_ORCH,mpi_size,ierr)    
+      CALL MPI_COMM_RANK(MPI_COMM_ORCH,mpi_rank,ierr)
+#endif
+    ELSE
+      mpi_size=1
+      mpi_rank=0
+    ENDIF   
+    
+    IF (mpi_rank == 0) THEN
+      mpi_rank_root = 0
+      is_mpi_root = .true.
+    ENDIF
+    
+    ALLOCATE(nbp_mpi_para(0:mpi_size-1))
+    ALLOCATE(nbp_mpi_para_begin(0:mpi_size-1))
+    ALLOCATE(nbp_mpi_para_end(0:mpi_size-1))    
+    ALLOCATE(jj_para_nb(0:mpi_size-1))
+    ALLOCATE(jj_para_begin(0:mpi_size-1))
+    ALLOCATE(jj_para_end(0:mpi_size-1))
+    ALLOCATE(ii_para_begin(0:mpi_size-1))
+    ALLOCATE(ii_para_end(0:mpi_size-1))    
+    ALLOCATE(ij_para_nb(0:mpi_size-1))
+    ALLOCATE(ij_para_begin(0:mpi_size-1))
+    ALLOCATE(ij_para_end(0:mpi_size-1))
+    
+
+    nbp_mpi=arg_nbp_mpi
+    ALLOCATE(kindex_mpi(nbp_mpi))
+    kindex_mpi(:)=arg_kindex_mpi(:)
+    
+    offset_mpi=arg_offset_mpi
+    
+    IF (is_ok_mpi) THEN
+#ifdef CPP_PARA
+      CALL MPI_AllGather(nbp_mpi,1,MPI_INT_ORCH,nbp_mpi_para,1,MPI_INT_ORCH,MPI_COMM_ORCH,ierr)
+#endif
+    ELSE
+      nbp_mpi_para(0)=nbp_mpi
+    ENDIF
+    
+    nbp_mpi_para_begin(0)=1
+    nbp_mpi_para_end(0)=nbp_mpi_para(0)
+    DO i=1,mpi_size-1
+      nbp_mpi_para_begin(i)=nbp_mpi_para_end(i-1)+1
+      nbp_mpi_para_end(i)=nbp_mpi_para_begin(i)+nbp_mpi_para(i)-1
+    ENDDO
+    nbp_mpi_begin=nbp_mpi_para_begin(mpi_rank)
+    nbp_mpi_end=nbp_mpi_para_end(mpi_rank)
+    
+    
+    IF (mpi_rank==mpi_size-1) THEN
+      ij_end=iim_g*jjm_g
+    ELSE
+      ij_end=kindex_mpi(nbp_mpi)+offset_mpi
+    ENDIF
+
+    IF (is_ok_mpi) THEN    
+#ifdef CPP_PARA    
+      CALL MPI_Allgather(ij_end,1,MPI_INT_ORCH,ij_para_end,1,MPI_INT_ORCH,MPI_COMM_ORCH,ierr)
+#endif
+    ELSE
+      ij_para_end(0)=ij_end
+    ENDIF
+    
+    ij_para_begin(0)=1
+    ij_para_nb(0)=ij_para_end(0)-ij_para_begin(0)+1
+    
+    DO i=1,mpi_size-1
+      ij_para_begin(i)=ij_para_end(i-1)+1
+      ij_para_nb(i)=ij_para_end(i)-ij_para_begin(i)+1
+    ENDDO
+    
+    DO i=0,mpi_size-1
+      jj_para_begin(i)=(ij_para_begin(i)-1)/iim_g + 1
+      jj_para_end(i)=(ij_para_end(i)-1)/iim_g + 1
+      jj_para_nb(i)=jj_para_end(i)-jj_para_begin(i)+1
+          
+      ii_para_begin(i)=MOD(ij_para_begin(i)-1,iim_g)+1
+      ii_para_end(i)=MOD(ij_para_end(i)-1,iim_g)+1
+    ENDDO
+
+   
+    ij_nb=ij_para_nb(mpi_rank)
+    ij_begin=ij_para_begin(mpi_rank)
+    ij_end=ij_para_end(mpi_rank)
+        
+    jj_nb=jj_para_nb(mpi_rank)
+    jj_begin=jj_para_begin(mpi_rank)
+    jj_end=jj_para_end(mpi_rank)
+    
+    ii_begin=ii_para_begin(mpi_rank)
+    ii_end=ii_para_end(mpi_rank)
+        
+      
+    CALL print_mpi_data
+  
+    
+  END SUBROUTINE Init_orchidee_mpi_data
+  
+  SUBROUTINE init_const_mpi(COMM)
+
+  IMPLICIT NONE
+    INTEGER :: COMM
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+    
+    MPI_COMM_ORCH=COMM
+    
+    IF (i_std==i_4) THEN
+       MPI_INT_ORCH=MPI_INTEGER4
+    ELSEIF (i_std==i_8) THEN
+       MPI_INT_ORCH=MPI_INTEGER8
+    ELSE
+       MPI_INT_ORCH=MPI_INTEGER
+    ENDIF
+         
+    IF (r_std==r_4) THEN
+       MPI_REAL_ORCH=MPI_REAL4
+    ELSEIF (r_std==r_8) THEN
+       MPI_REAL_ORCH=MPI_REAL8
+    ELSE
+       MPI_REAL_ORCH=MPI_REAL
+    ENDIF
+#endif
+
+  END SUBROUTINE init_const_mpi
+
+  SUBROUTINE Finalize_mpi
+
+  IMPLICIT NONE
+#ifdef CPP_PARA
+  include 'mpif.h'  
+  INTEGER :: ierr
+
+  CALL xios_orchidee_finalize
+
+  CALL MPI_FINALIZE(ierr)
+#endif
+   
+  END SUBROUTINE Finalize_mpi
+  
+  SUBROUTINE print_mpi_data
+
+  IMPLICIT NONE
+    
+    WRITE(numout,*) '==== MPI DOMAIN ===='
+    WRITE(numout,*) '     ----------     '
+    WRITE(numout,*) 'mpi_size',mpi_size
+    WRITE(numout,*) 'mpi_rank',mpi_rank
+    WRITE(numout,*) 'is_mpi_root',is_mpi_root
+    WRITE(numout,*) 'mpi_rank_root',mpi_rank_root
+
+    WRITE(numout,*) 'nbp_mpi_begin=',nbp_mpi_begin
+    WRITE(numout,*) 'nbp_mpi_end  =',nbp_mpi_end
+    WRITE(numout,*) 'nbp_mpi=',nbp_mpi
+          
+    WRITE(numout,*) 'ij_begin=',ij_begin
+    WRITE(numout,*) 'ij_end=',ij_end
+    WRITE(numout,*) 'ij_nb=',ij_nb
+    WRITE(numout,*) 'jj_begin=',jj_begin
+    WRITE(numout,*) 'jj_end=',jj_end
+    WRITE(numout,*) 'jj_nb=',jj_nb	
+    WRITE(numout,*) 'ii_begin=',ii_begin
+    WRITE(numout,*) 'ii_end=',ii_end
+    
+    WRITE(numout,*) 'offset_mpi',offset_mpi
+    WRITE(numout,*) 'nbp_mpi_para_begin=',nbp_mpi_para_begin
+    WRITE(numout,*) 'nbp_mpi_para_end  =',nbp_mpi_para_end
+    WRITE(numout,*) 'nbp_mpi_para=',nbp_mpi_para
+          
+    WRITE(numout,*) 'ij_para_begin=',ij_para_begin
+    WRITE(numout,*) 'ij_para_end=',ij_para_end
+    WRITE(numout,*) 'ij_para_nb=',ij_para_nb
+    WRITE(numout,*) 'jj_para_begin=',jj_para_begin
+    WRITE(numout,*) 'jj_para_end=',jj_para_end
+    WRITE(numout,*) 'jj_para_nb=',jj_para_nb	
+    WRITE(numout,*) 'ii_para_begin=',ii_para_begin
+    WRITE(numout,*) 'ii_para_end=',ii_para_end
+  
+  END SUBROUTINE print_mpi_data
+  
+ SUBROUTINE Read_Load_balance(NbPoints,Nbpoints_loc)
+
+    IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: NbPoints
+    INTEGER,INTENT(OUT) :: Nbpoints_loc(0:mpi_size-1)
+    INTEGER :: i,s
+    INTEGER :: ierr
+    
+#ifdef CPP_PARA
+    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
+    INTEGER :: j
+    INTEGER :: unit_number=10
+#endif   
+
+#ifdef CPP_PARA
+    OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='old',FORM='formatted',IOSTAT=ierr) 
+#else
+    ierr=1
+#endif   
+    Nbpoints_loc(:) = 0
+
+    s=0
+#ifdef CPP_PARA  
+    IF (ierr==0) THEN
+       i=0
+       !- Reading for any balancing file (even with a bad structure)
+       DO WHILE (i < mpi_size .AND. ierr == 0) 
+          READ (unit_number,*,IOSTAT=ierr) j,Nbpoints_loc(i)
+          s=s+Nbpoints_loc(i)
+          i=i+1
+       ENDDO
+       CLOSE(unit_number)
+    ENDIF
+#endif   
+    
+    !- Correction of bad balancing file (or an empty file) => same nb of points for each procs
+    IF (ierr/=0 .OR. s/=Nbpoints) THEN
+       DO i=0,mpi_size-1
+          Nbpoints_loc(i)=Nbpoints/mpi_size
+          IF (MOD(Nbpoints,mpi_size) > i) Nbpoints_loc(i)=Nbpoints_loc(i)+1
+       ENDDO
+    ENDIF
+    
+  END SUBROUTINE Read_Load_balance
+  
+  SUBROUTINE Write_Load_balance(times)
+    IMPLICIT NONE
+    REAL,INTENT(IN) :: times
+  
+    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
+    INTEGER :: unit_number=10
+    INTEGER :: i,ierr
+    REAL :: All_Times(0:mpi_size-1)
+    REAL :: average
+    REAL :: efficiency
+    INTEGER :: dp,S
+    INTEGER :: New_nbpoints(0:mpi_size-1)
+    
+    WRITE(numout,*) 'time',times
+
+    IF (is_ok_mpi) THEN
+#ifdef CPP_PARA
+      CALL MPI_GATHER(times,1,MPI_REAL_ORCH,All_times,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+#endif
+    ELSE
+      All_times(:)=times
+    ENDIF
+    
+    IF (is_mpi_root) WRITE(numout,*) 'ALL_times',All_times
+
+    IF (is_mpi_root) THEN
+     
+       OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='replace',FORM='formatted',IOSTAT=ierr)
+       
+       average=sum(All_times(:))/mpi_size
+       DO i=0,mpi_size-1
+          efficiency=All_times(i)/nbp_mpi_para(i)
+          New_nbpoints(i)=Nbp_mpi_para(i)-(All_times(i)-average)/efficiency
+       ENDDO
+       
+       S=sum(new_nbpoints(:))
+       dp=nbp_glo-S
+       
+       IF ( dp > 0 ) THEN
+          DO WHILE ( dp > 0 )
+             New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))+1
+             dp=dp-1
+          ENDDO
+       ELSE
+          dp=-dp
+          DO WHILE ( dp > 0 )
+             New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))-1
+             dp=dp-1
+          ENDDO
+       ENDIF
+       
+
+       ! If this algorithm diverge, we use previous repartition.
+       IF ( ANY(New_nbpoints(:) .LE. 0) ) THEN
+          New_nbpoints(:)=Nbp_mpi_para(:)
+       ENDIF
+       
+       DO i=0,mpi_size-1
+          WRITE(Unit_number,*) i,New_nbpoints(i)
+       ENDDO
+       CLOSE(Unit_number)
+    ENDIF
+
+  END SUBROUTINE Write_Load_Balance
+  
+END MODULE mod_orchidee_mpi_data
+
+#include "mpi_dummy.h"
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_mpi_transfert.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_mpi_transfert.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_mpi_transfert.F90	(revision 5166)
@@ -0,0 +1,2939 @@
+! Low level MPI parallel communication encapsulations for ORCHIDEE.
+
+!-
+!- $Header: $
+!-
+
+MODULE mod_orchidee_mpi_transfert
+  !-
+  USE defprec
+  USE mod_orchidee_para_var
+  USE timer
+  !-
+  IMPLICIT NONE
+  !-
+#include "src_parallel.h"
+  !-
+
+  INTERFACE bcast_mpi
+     MODULE PROCEDURE bcast_mpi_c, bcast_mpi_c1,                           &
+          bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
+          bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
+          bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
+  END INTERFACE
+
+  INTERFACE scatter_mpi
+     MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3, &
+          scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, &
+          scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3
+  END INTERFACE
+
+  INTERFACE gather_mpi_s
+     MODULE PROCEDURE gather_mpi_is, &
+          gather_mpi_rs, &
+          gather_mpi_ls
+  END INTERFACE
+
+  INTERFACE gather_mpi
+     MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3, &
+          gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, &
+          gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3  
+  END INTERFACE
+
+  INTERFACE scatter2D_mpi
+     MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
+          scatter2D_mpi_r0,scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
+          scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
+  END INTERFACE
+
+  INTERFACE gather2D_mpi
+     MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
+          gather2D_mpi_r0,gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
+          gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
+  END INTERFACE
+
+  INTERFACE reduce_sum_mpi
+     MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, &
+          reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4
+  END INTERFACE
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_mpi_c(var)
+    IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=len(Var)),DIMENSION(1) :: Var1
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_mpi_root) &
+         Var1(1)=Var
+    CALL orch_bcast_mpi_cgen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_mpi_c
+
+  SUBROUTINE bcast_mpi_c1(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_cgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_c1
+
+
+  !! -- Les entiers -- !!
+
+  SUBROUTINE bcast_mpi_i(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var
+    INTEGER(i_std),DIMENSION(1) :: Var1
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_mpi_root) &
+         Var1(1)=Var
+    CALL orch_bcast_mpi_igen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_mpi_i
+
+  SUBROUTINE bcast_mpi_i1(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var(:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_i1
+
+  SUBROUTINE bcast_mpi_i2(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var(:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_i2
+
+  SUBROUTINE bcast_mpi_i3(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var(:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_i3
+
+  SUBROUTINE bcast_mpi_i4(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var(:,:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_i4
+
+
+  !! -- Les reels -- !!
+
+  SUBROUTINE bcast_mpi_r(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var
+    REAL(r_std),DIMENSION(1) :: Var1
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_mpi_root) &
+         Var1(1)=Var
+    CALL orch_bcast_mpi_rgen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_mpi_r
+
+  SUBROUTINE bcast_mpi_r1(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var(:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_r1
+
+  SUBROUTINE bcast_mpi_r2(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var(:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_r2
+
+  SUBROUTINE bcast_mpi_r3(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var(:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_r3
+
+  SUBROUTINE bcast_mpi_r4(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var(:,:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_r4
+
+  !! -- Les booleans -- !!
+
+  SUBROUTINE bcast_mpi_l(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL,DIMENSION(1) :: Var1
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_mpi_root) &
+         Var1(1)=Var
+    CALL orch_bcast_mpi_lgen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_mpi_l
+
+  SUBROUTINE bcast_mpi_l1(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_l1
+
+  SUBROUTINE bcast_mpi_l2(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_l2
+
+  SUBROUTINE bcast_mpi_l3(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_l3
+
+  SUBROUTINE bcast_mpi_l4(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_l4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(nbp_glo) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi) :: VarOut
+
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_i
+
+  SUBROUTINE scatter_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_i1
+
+  SUBROUTINE scatter_mpi_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else    
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_i2
+
+  SUBROUTINE scatter_mpi_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else    
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_i3
+
+
+  SUBROUTINE scatter_mpi_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,1)
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_r
+
+  SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_r1
+
+  SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_r2
+
+  SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_r3
+
+
+  SUBROUTINE scatter_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,1)
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l
+
+  SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l1
+
+  SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l2
+
+  SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather_mpi_is(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER(i_std),INTENT(IN) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std) :: nb,i,index_para,rank
+    INTEGER(i_std) :: ierr
+    LOGICAL :: flag=.FALSE.
+    LOGICAL, PARAMETER :: check=.FALSE.
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn
+    RETURN
+#else
+
+    IF (timer_state(timer_mpi)==running) THEN
+      flag=.TRUE.
+    ELSE
+      flag=.FALSE.
+    ENDIF
+    
+    IF (flag) CALL suspend_timer(timer_mpi)
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_is VarIn=",VarIn    
+
+#ifdef CPP_PARA
+    CALL MPI_GATHER(VarIn,1,MPI_INT_ORCH,VarOut,1,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+#endif
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_is VarOut=",VarOut
+    IF (flag) CALL resume_timer(timer_mpi)
+#endif
+  END SUBROUTINE gather_mpi_is
+
+  SUBROUTINE gather_mpi_rs(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    REAL(r_std),INTENT(IN) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std) :: nb,i,index_para,rank
+    INTEGER(i_std) :: ierr
+    LOGICAL :: flag=.FALSE.
+    LOGICAL, PARAMETER :: check=.FALSE.
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn
+    RETURN
+#else
+
+    IF (timer_state(timer_mpi)==running) THEN
+      flag=.TRUE.
+    ELSE
+      flag=.FALSE.
+    ENDIF
+    
+    IF (flag) CALL suspend_timer(timer_mpi)
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_rs VarIn=",VarIn    
+
+#ifdef CPP_PARA
+    CALL MPI_GATHER(VarIn,1,MPI_REAL_ORCH,VarOut,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+#endif
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_rs VarOut=",VarOut
+
+    IF (flag) CALL resume_timer(timer_mpi)
+#endif
+  END SUBROUTINE gather_mpi_rs
+
+  SUBROUTINE gather_mpi_ls(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    LOGICAL,INTENT(IN) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std) :: nb,i,index_para,rank
+    INTEGER(i_std) :: ierr
+    LOGICAL :: flag=.FALSE.
+    LOGICAL, PARAMETER :: check=.FALSE.
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn
+    RETURN
+#else
+
+    IF (timer_state(timer_mpi)==running) THEN
+      flag=.TRUE.
+    ELSE
+      flag=.FALSE.
+    ENDIF
+    
+    IF (flag) CALL suspend_timer(timer_mpi)
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_ls VarIn=",VarIn    
+
+#ifdef CPP_PARA
+    CALL MPI_GATHER(VarIn,1,MPI_LOGICAL,VarOut,1,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr)
+#endif
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_ls VarOut=",VarOut
+    IF (flag) CALL resume_timer(timer_mpi)
+#endif
+  END SUBROUTINE gather_mpi_ls
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i1
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i3
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_mpi_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r1
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r3
+
+!!!!! --> Les booleen
+
+  SUBROUTINE gather_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,1)      
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarIn,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l1
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
+    ELSE
+       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,1)
+    ENDIF
+
+
+#endif
+  END SUBROUTINE scatter2D_mpi_i
+
+  SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_i1
+
+  SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+
+#endif
+  END SUBROUTINE scatter2D_mpi_i2
+
+  SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_i3
+
+
+  SUBROUTINE scatter2D_mpi_r0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1)      
+    ENDIF
+
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r0
+
+  SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(INOUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r
+
+  SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r1
+
+  SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r2
+
+  SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:)  :: VarIn
+    REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r3
+
+
+  SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
+    ELSE
+       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_l
+
+  SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(INOUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_l1
+
+  SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_l2
+
+  SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:)  :: VarIn
+    LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
+    ELSE
+       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_i
+
+  SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_i1
+
+  SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_i2
+
+  SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_i3
+
+
+  SUBROUTINE gather2D_mpi_r0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r0
+
+  SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r
+
+  SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r1
+
+  SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r2
+
+  SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r3
+
+
+  SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
+    ELSE
+       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_l
+
+  SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_l1
+
+  SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_l2
+
+  SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN)  :: VarIn
+    INTEGER(i_std),INTENT(OUT) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: Var1
+    INTEGER(i_std),DIMENSION(1) :: Var2
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut=VarIn
+    RETURN
+#else
+    Var1(1)=VarIn
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(Var1,Var2,1)
+       VarOut=Var2(1)
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(Var1,dummy,1)
+       VarOut=VarIn
+    ENDIF
+#endif
+  END SUBROUTINE reduce_sum_mpi_i
+
+  SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_i1
+
+  SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_i2
+
+  SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_i3
+
+  SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_i4
+
+
+  SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN)  :: VarIn
+    REAL(r_std),INTENT(OUT) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: Var1
+    REAL(r_std),DIMENSION(1) :: Var2
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut=VarIn
+    RETURN
+#else
+
+    Var1(1)=VarIn
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(Var1,Var2,1)
+       VarOut=Var2(1)
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(Var1,dummy,1)
+       VarOut=VarIn
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r
+
+  SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r1
+
+  SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r2
+
+  SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r3
+
+  SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r4
+
+
+END MODULE mod_orchidee_mpi_transfert
+
+#ifdef CPP_PARA
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE orch_bcast_mpi_cgen(var,nb)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  CHARACTER(LEN=*),DIMENSION(nb),INTENT(INOUT) :: Var
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+  
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+  
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_cgen before bcast Var",Var    
+  IF (flag) CALL suspend_timer(timer_mpi)
+  CALL MPI_BCAST(Var,nb*LEN(Var(1)),MPI_CHARACTER,mpi_rank_root,MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_cgen after bcast Var",Var
+
+END SUBROUTINE orch_bcast_mpi_cgen
+
+SUBROUTINE orch_bcast_mpi_igen(var,nb)
+  USE mod_orchidee_para_var
+  USE timer
+  IMPLICIT NONE
+
+  INTEGER(i_std),DIMENSION(nb),INTENT(INOUT) :: Var
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_igen before bcast Var",Var
+  CALL MPI_BCAST(Var,nb,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_igen after bcast Var",Var    
+
+END SUBROUTINE orch_bcast_mpi_igen
+
+SUBROUTINE orch_bcast_mpi_rgen(var,nb)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  REAL(r_std),DIMENSION(nb),INTENT(INOUT) :: Var
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_rgen before bcast Var",Var
+  IF (flag) CALL suspend_timer(timer_mpi)
+  CALL MPI_BCAST(Var,nb,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_rgen after bcast Var",Var
+
+END SUBROUTINE orch_bcast_mpi_rgen
+
+SUBROUTINE orch_bcast_mpi_lgen(var,nb)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_lgen before bcast Var",Var
+  IF (flag) CALL suspend_timer(timer_mpi)
+  CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_lgen after bcast Var",Var
+
+END SUBROUTINE orch_bcast_mpi_lgen
+
+
+SUBROUTINE orch_scatter_mpi_igen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: nbp
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
+  INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  INTEGER(i_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_Para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_Para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter_mpi_igen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter_mpi_igen VarTmp",VarTmp
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INT_ORCH,VarOut,nbp_mpi*dimsize,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter_mpi_igen VarOut",VarOut
+
+END SUBROUTINE orch_scatter_mpi_igen
+
+SUBROUTINE orch_scatter_mpi_rgen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  REAL(r_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
+  REAL(r_std),INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  REAL(r_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter_mpi_rgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter_mpi_rgen VarTmp",VarTmp
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_ORCH,VarOut,nbp_mpi*dimsize,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter_mpi_rgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter_mpi_rgen
+
+SUBROUTINE orch_scatter_mpi_lgen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  LOGICAL,INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter_mpi_lgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter_mpi_lgen VarTmp",VarTmp
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,nbp_mpi*dimsize,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter_mpi_lgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter_mpi_lgen
+
+SUBROUTINE orch_gather_mpi_igen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  INTEGER(i_std),INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  INTEGER(i_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  INTEGER(i_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+
+  ENDIF
+
+  CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_INT_ORCH,VarTmp,counts,displs,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        DO i=1,dimsize
+           VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_igen VarOut=",VarOut
+  IF (flag) CALL resume_timer(timer_mpi)
+
+END SUBROUTINE orch_gather_mpi_igen
+
+SUBROUTINE orch_gather_mpi_rgen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  REAL(r_std),INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  REAL(r_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  REAL(r_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_rgen VarIn=",VarIn    
+  CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_REAL_ORCH,VarTmp,counts,displs,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_rgen dimsize,VarTmp=",dimsize,VarTmp
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        DO i=1,dimsize
+           VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_rgen VarOut=",VarOut
+  IF (flag) CALL resume_timer(timer_mpi)
+
+END SUBROUTINE orch_gather_mpi_rgen
+
+SUBROUTINE orch_gather_mpi_lgen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  LOGICAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_lgen VarIn=",VarIn    
+  CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_lgen dimsize,VarTmp=",dimsize,VarTmp
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        DO i=1,dimsize
+           VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_lgen VarOut=",VarOut
+  IF (flag) CALL resume_timer(timer_mpi)
+
+END SUBROUTINE orch_gather_mpi_lgen
+
+
+SUBROUTINE orch_scatter2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  INTEGER(i_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
+  INTEGER(i_std),INTENT(OUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: counts
+  INTEGER(i_std),DIMENSION(dimsize*iim*jjm)   :: VarTmp1
+  INTEGER(i_std),DIMENSION(ij_nb,dimsize)     :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter2D_mpi_igen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp1",VarTmp1
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_INT_ORCH,VarTmp2,ij_nb*dimsize,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp2",VarTmp2
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
+     ENDDO
+  ENDDO
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_igen VarOut",VarOut
+
+END SUBROUTINE orch_scatter2D_mpi_igen
+
+SUBROUTINE orch_scatter2D_mpi_rgen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  REAL(r_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
+  REAL(r_std),INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: counts
+  REAL(r_std),DIMENSION(dimsize*iim*jjm)   :: VarTmp1
+  REAL(r_std),DIMENSION(ij_nb,dimsize)     :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter2D_mpi_rgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp1",VarTmp1
+     ENDIF
+  ENDIF
+  nb=ij_nb*dimsize
+  IF (check) &
+       WRITE(numout,*) "ij_nb*dimsize",ij_nb*dimsize
+
+  CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_REAL_ORCH,VarTmp2,nb,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp2",VarTmp2
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
+     ENDDO
+  ENDDO
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_rgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter2D_mpi_rgen
+
+SUBROUTINE orch_scatter2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  LOGICAL,INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
+  LOGICAL,INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: counts
+  LOGICAL,DIMENSION(dimsize*iim*jjm)   :: VarTmp1
+  LOGICAL,DIMENSION(ij_nb,dimsize)     :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter2D_mpi_lgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp1",VarTmp1
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_LOGICAL,VarTmp2,ij_nb*dimsize,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp2",VarTmp2
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
+     ENDDO
+  ENDDO
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_lgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter2D_mpi_lgen
+
+
+SUBROUTINE orch_gather2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  INTEGER(i_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize)  :: VarIn
+  INTEGER(i_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: counts
+  INTEGER(i_std),DIMENSION(ij_nb,dimsize)   :: VarTmp1
+  INTEGER(i_std),DIMENSION(dimsize*iim*jjm) :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL,PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather2D_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+  ENDIF
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
+     ENDDO
+  ENDDO
+
+  IF (check) THEN
+     WRITE(numout,*) "orch_gather2D_mpi_igen VarIn=",VarIn    
+     WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp1=",VarTmp1
+  ENDIF
+  CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_INT_ORCH,VarTmp2,counts,displs,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp2=",VarTmp2
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        DO i=1,dimsize
+           VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_igen VarOut=",VarOut
+
+END SUBROUTINE orch_gather2D_mpi_igen
+
+SUBROUTINE orch_gather2D_mpi_rgen(VarIn, VarOut, nbp2D,dimsize)
+  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  REAL(r_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize)  :: VarIn
+  REAL(r_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: counts
+  REAL(r_std),DIMENSION(ij_nb,dimsize)   :: VarTmp1
+  REAL(r_std),DIMENSION(dimsize*iim*jjm) :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL,PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather2D_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
+     ENDDO
+  ENDDO
+
+  IF (check) THEN
+     WRITE(numout,*) "orch_gather2D_mpi_rgen VarIn=",VarIn    
+     WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp1=",VarTmp1
+  ENDIF
+  CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_REAL_ORCH,VarTmp2,counts,displs,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp2=",VarTmp2
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        DO i=1,dimsize
+           VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_rgen VarOut=",VarOut
+
+END SUBROUTINE orch_gather2D_mpi_rgen
+
+SUBROUTINE orch_gather2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_para_var, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  LOGICAL,INTENT(IN),DIMENSION(iim*jj_nb,dimsize)  :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: counts
+  LOGICAL,DIMENSION(ij_nb,dimsize)   :: VarTmp1
+  LOGICAL,DIMENSION(dimsize*iim*jjm) :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL,PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather2D_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
+     ENDDO
+  ENDDO
+
+  IF (check) THEN
+     WRITE(numout,*) "orch_gather2D_mpi_lgen VarIn=",VarIn    
+     WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp1=",VarTmp1
+  ENDIF
+  CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_LOGICAL,VarTmp2,counts,displs,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp2=",VarTmp2
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        DO i=1,dimsize
+           VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_lgen VarOut=",VarOut
+
+END SUBROUTINE orch_gather2D_mpi_lgen
+
+SUBROUTINE orch_reduce_sum_mpi_igen(VarIn,VarOut,nb)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),DIMENSION(nb),INTENT(IN) :: VarIn
+  INTEGER(i_std),DIMENSION(nb),INTENT(OUT) :: VarOut    
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_reduce_sum_mpi_igen VarIn",VarIn
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INT_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr)
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_reduce_sum_mpi_igen VarOut",VarOut
+
+END SUBROUTINE orch_reduce_sum_mpi_igen
+
+SUBROUTINE orch_reduce_sum_mpi_rgen(VarIn,VarOut,nb)
+  USE mod_orchidee_para_var
+  USE timer
+
+  IMPLICIT NONE
+
+  REAL(r_std),DIMENSION(nb),INTENT(IN) :: VarIn
+  REAL(r_std),DIMENSION(nb),INTENT(OUT) :: VarOut    
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarIn",VarIn
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr)
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarOut",VarOut
+
+END SUBROUTINE orch_reduce_sum_mpi_rgen
+
+#endif
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_omp_data.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_omp_data.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_omp_data.F90	(revision 5166)
@@ -0,0 +1,224 @@
+! Definition and allocation of parallel datas for OpenMP.
+
+!-
+!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/Attic/mod_orchidee_omp_data.F90,v 1.1.2.3 2008/11/05 10:08:25 ssipsl Exp $
+!- 
+
+MODULE mod_orchidee_omp_data
+
+!-
+  USE defprec
+  USE ioipsl
+  USE mod_orchidee_para_var
+
+  IMPLICIT NONE
+
+CONTAINS
+
+    SUBROUTINE barrier2_omp()
+
+    IMPLICIT NONE
+
+!$OMP BARRIER
+!$OMP BARRIER
+
+  END SUBROUTINE barrier2_omp
+
+
+
+  
+  SUBROUTINE Init_orchidee_omp
+  IMPLICIT NONE
+  
+#ifdef CPP_OMP
+    IF (is_omp_root) THEN
+        is_ok_omp=.TRUE.
+    ENDIF
+#else    
+    is_ok_omp=.FALSE.
+#endif
+
+
+    IF (is_ok_omp) THEN
+      STOP 'Open MP is not yet implemented for driver'
+    ELSE
+      omp_size=1
+      omp_rank=0
+      is_omp_root=.TRUE.
+    ENDIF
+
+  END SUBROUTINE Init_orchidee_omp
+
+  SUBROUTINE Init_numout_omp(numout)
+    INTEGER, INTENT(in) :: numout
+    numout_omp=numout
+  END SUBROUTINE Init_numout_omp
+
+
+  SUBROUTINE Init_orchidee_omp_data(arg_omp_size,arg_omp_rank,arg_nbp_omp,arg_offset_omp)
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: arg_omp_size
+    INTEGER, INTENT(IN) :: arg_omp_rank
+    INTEGER, INTENT(IN) :: arg_nbp_omp
+    INTEGER, INTENT(IN) :: arg_offset_omp
+    
+    INTEGER    :: i
+    
+    
+    IF (arg_omp_rank==0) THEN
+      is_omp_root=.TRUE.
+    ELSE
+      is_omp_root=.FALSE.
+    ENDIF
+    
+#ifdef CPP_OMP
+    IF (is_omp_root) THEN
+        is_ok_omp=.TRUE.
+    ENDIF
+#else    
+    is_ok_omp=.FALSE.
+#endif
+
+    IF (is_omp_root) omp_size=arg_omp_size
+
+    CALL barrier2_omp()
+
+     omp_rank=arg_omp_rank
+    
+    IF (is_omp_root) THEN 
+      ALLOCATE(nbp_omp_para_nb(0:omp_size-1))
+      ALLOCATE(nbp_omp_para_begin(0:omp_size-1))
+      ALLOCATE(nbp_omp_para_end(0:omp_size-1))
+    ENDIF
+    
+    CALL barrier2_omp()
+    nbp_omp_para_nb(omp_rank)=arg_nbp_omp
+    CALL barrier2_omp()
+    
+    IF (is_omp_root) THEN
+
+      nbp_omp_para_begin(0)=1
+      nbp_omp_para_end(0)=nbp_omp_para_nb(0)
+
+      DO i=1,omp_size-1
+        nbp_omp_para_begin(i)=nbp_omp_para_end(i-1)+1
+        nbp_omp_para_end(i)=nbp_omp_para_begin(i)+nbp_omp_para_nb(i)-1
+      ENDDO
+
+    ENDIF
+
+    CALL barrier2_omp()
+     
+    nbp_omp=nbp_omp_para_nb(omp_rank)
+    nbp_omp_begin=nbp_omp_para_begin(omp_rank)
+    nbp_omp_end=nbp_omp_para_end(omp_rank)
+    
+    offset_omp=arg_offset_omp          
+    CALL Print_omp_data
+    
+    CALL Init_synchro_omp()
+    
+  END SUBROUTINE Init_orchidee_omp_data
+
+  SUBROUTINE print_omp_data
+  IMPLICIT NONE
+
+!$OMP CRITICAL  
+  PRINT *,'--------> ORCHIDEE TASK ',omp_rank
+  PRINT *,'omp_size =',omp_size
+  PRINT *,'omp_rank =',omp_rank
+  PRINT *,'is_omp_root =',is_omp_root
+  PRINT *,'offset_omp',offset_omp
+  PRINT *,'nbp_omp_para_nb =',nbp_omp_para_nb
+  PRINT *,'nbp_omp_para_begin =',nbp_omp_para_begin
+  PRINT *,'nbp_omp_para_end =',nbp_omp_para_end    
+  PRINT *,'nbp_omp =',nbp_omp
+  PRINT *,'nbp_omp_begin =',nbp_omp_begin
+  PRINT *,'nbp_omp_end =',nbp_omp_end    
+!$OMP END CRITICAL
+
+  END SUBROUTINE print_omp_data
+
+  SUBROUTINE Init_synchro_omp
+  IMPLICIT NONE
+    
+    IF (is_omp_root) THEN
+      ALLOCATE(proc_synchro_omp(0:omp_size-1))
+      proc_synchro_omp(:)=.FALSE.
+
+      IF ( check_all_transfert ) THEN
+         ALLOCATE(omp_function(0:omp_size-1))
+         omp_function(:)=-1
+      ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+  END SUBROUTINE Init_Synchro_omp
+  
+  SUBROUTINE Synchro_omp
+  IMPLICIT NONE
+    INTEGER iter
+    LOGICAL, PARAMETER :: check=.TRUE.
+    INTEGER, PARAMETER :: iter_max=1
+    INTEGER, PARAMETER :: print_iter=1
+
+    proc_synchro_omp(omp_rank)=.TRUE.
+    CALL barrier2_omp()
+
+    iter=0
+    DO WHILE (.NOT. ALL(proc_synchro_omp))
+       iter=iter+1
+       IF ( mod(iter,print_iter) == 0 ) THEN
+          IF (numout_omp > 0) THEN
+             WRITE(numout_omp,*) "ORCHIDEE SYNCHRO OMP : iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
+          ELSE
+             WRITE(*,*) "ORCHIDEE SYNCHRO OMP : iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
+          ENDIF
+       ENDIF
+       IF (check) THEN
+          IF (iter > iter_max) THEN
+             IF (numout_omp > 0) THEN
+                WRITE(numout_omp,*) "TOO MUCH WAIT in Synchro_Omp !! iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
+                WRITE(numout_omp,*) "We stop here"
+                WRITE(numout_omp,*) "omp_function : ",omp_function(:)
+             ELSE
+                WRITE(*,*) "TOO MUCH WAIT in Synchro_Omp !! iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
+                WRITE(*,*) "We stop here"
+                WRITE(*,*) "omp_function : ",omp_function(:)
+             ENDIF
+#ifdef CPP_PARA
+             CALL MPI_ABORT(4)
+#endif     
+             STOP 'Fatal error from ORCHIDEE : Synchro_Omp failed'
+          ENDIF
+       ENDIF
+    CALL barrier2_omp()
+    ENDDO
+    CALL barrier2_omp()
+    proc_synchro_omp(omp_rank)=.FALSE.
+    CALL barrier2_omp()
+
+   END SUBROUTINE Synchro_omp
+
+   SUBROUTINE print_omp_function ()
+
+     IF ( check_all_transfert ) THEN
+        CALL barrier2_omp()
+        IF (numout_omp > 0) THEN
+           WRITE(numout_omp,*) omp_rank,&
+                " : ",omp_fct_name(omp_previous),'->',omp_fct_name(omp_function(omp_rank))
+           IF (MINVAL(omp_function(:)).LT.MAXVAL(omp_function(:))) &
+                WRITE(numout_omp,*) "!!! OMP ERROR : NO MORE SYNCHRO  !!!  ",omp_function(:)
+        ELSE
+           WRITE(*,*) omp_rank,&
+                " : ",omp_fct_name(omp_previous),'->',omp_fct_name(omp_function(omp_rank))
+           IF (MINVAL(omp_function(:)).LT.MAXVAL(omp_function(:))) &
+                WRITE(*,*) "!!! OMP ERROR : NO MORE SYNCHRO  !!!  ",omp_function(:)
+        ENDIF
+        CALL barrier2_omp()
+     ENDIF
+
+  END SUBROUTINE print_omp_function
+
+
+END MODULE mod_orchidee_omp_data
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_omp_transfert.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_omp_transfert.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_omp_transfert.F90	(revision 5166)
@@ -0,0 +1,2113 @@
+! Low level OpenMP parallel communication encapsulations for ORCHIDEE.
+
+!-
+!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/Attic/mod_orchidee_omp_transfert.F90,v 1.1.2.2 2008/08/29 14:01:40 ssipsl Exp $
+!-
+
+MODULE mod_orchidee_omp_transfert
+  !-
+  USE mod_orchidee_omp_data
+  USE ioipsl
+  !-
+  IMPLICIT NONE
+
+  PRIVATE
+  
+#ifdef CPP_OMP
+  ! Check OpenMP buffer sizes increase.
+  LOGICAL, PARAMETER :: check_size = .FALSE.
+
+  INTEGER,PARAMETER :: grow_factor=1.5
+  INTEGER,PARAMETER :: size_min=1024
+  PUBLIC size_min
+
+  INTEGER(i_std),SAVE,ALLOCATABLE,DIMENSION(:) :: omp_ibuffer
+  INTEGER,SAVE                            :: size_i=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: omp_lbuffer
+  INTEGER,SAVE                            :: size_l=0
+  REAL(r_std),SAVE,ALLOCATABLE,DIMENSION(:) :: omp_rbuffer
+  INTEGER,SAVE                            :: size_r=0
+  CHARACTER(len=size_min), SAVE,ALLOCATABLE,DIMENSION(:) :: omp_cbuffer
+  INTEGER,SAVE                            :: size_c=0
+
+#endif
+
+  INTERFACE bcast_omp
+     MODULE PROCEDURE bcast_omp_c, bcast_omp_c1,                                       &
+          bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
+          bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, &
+          bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
+  END INTERFACE
+
+  INTERFACE scatter_omp
+     MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, &
+          scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
+          scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
+  END INTERFACE
+
+
+  INTERFACE gather_omp
+     MODULE PROCEDURE gather_omp_i0,gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, &
+          gather_omp_r0,gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, &
+          gather_omp_l0,gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3  
+  END INTERFACE
+
+
+  INTERFACE reduce_sum_omp
+     MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
+          reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
+  END INTERFACE
+
+  PUBLIC  bcast_omp,scatter_omp,gather_omp,reduce_sum_omp
+
+CONTAINS
+
+  SUBROUTINE check_buffer_c(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 72 
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+    IF (is_omp_root) THEN
+       IF (buff_size>size_c) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for strings : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for strings : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_cbuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_cbuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_cbuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_cbuffer)) DEALLOCATE(omp_cbuffer)
+          size_c=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_c
+             ELSE
+               WRITE(*,*) size_c
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_cbuffer(size_c))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_c
+
+  SUBROUTINE check_buffer_i(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 1 
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+
+    IF (is_omp_root) THEN
+       IF (buff_size>size_i) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for integers : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for integers : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_ibuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_ibuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_ibuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_ibuffer)) DEALLOCATE(omp_ibuffer)
+          size_i=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_i
+             ELSE
+               WRITE(*,*) size_i
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_ibuffer(size_i))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_i
+  
+  SUBROUTINE check_buffer_r(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 2
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+
+    IF (is_omp_root) THEN
+       IF (buff_size>size_r) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for reals : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for reals : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_rbuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_rbuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_rbuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_rbuffer)) DEALLOCATE(omp_rbuffer)
+          size_r=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_r
+             ELSE
+               WRITE(*,*) size_r
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_rbuffer(size_r))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_r
+  
+  SUBROUTINE check_buffer_l(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 3
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+
+    IF (is_omp_root) THEN
+       IF (buff_size>size_l) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for logicals : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for logicals : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_lbuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_lbuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_lbuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_lbuffer)) DEALLOCATE(omp_lbuffer)
+          size_l=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_l
+             ELSE
+               WRITE(*,*) size_l
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_lbuffer(size_l))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_l
+    
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_omp_c(Var)
+    IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=len(Var)),DIMENSION(1) :: Var1
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 4
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var1(1)=Var
+    CALL check_buffer_c(1)
+    CALL orch_bcast_omp_cgen(Var1,1,omp_cbuffer)
+    Var=Var1(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_c
+
+  SUBROUTINE bcast_omp_c1(Var)
+    IMPLICIT NONE
+    CHARACTER(LEN=*),DIMENSION(:),INTENT(INOUT) :: Var
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 4
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_c(size(Var))
+    CALL orch_bcast_omp_cgen(Var,size(Var),omp_cbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_c1
+
+  !! -- Les entiers -- !!
+
+  SUBROUTINE bcast_omp_i(var1)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var1
+
+    INTEGER,DIMENSION(1) :: Var
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 5
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var(1)=Var1
+    CALL check_buffer_i(1)
+    CALL orch_bcast_omp_igen(Var,1,omp_ibuffer)
+    Var1=Var(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i
+
+  SUBROUTINE bcast_omp_i1(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 6
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i1
+
+  SUBROUTINE bcast_omp_i2(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 7
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i2
+
+  SUBROUTINE bcast_omp_i3(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 8
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i3
+
+  SUBROUTINE bcast_omp_i4(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 9
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i4
+
+
+  !! -- Les reels -- !!
+
+  SUBROUTINE bcast_omp_r(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+    REAL,DIMENSION(1) :: Var1
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=10
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var1(1)=Var
+    CALL check_buffer_r(1)
+    CALL orch_bcast_omp_rgen(Var1,1,omp_rbuffer)
+    Var=Var1(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r
+
+  SUBROUTINE bcast_omp_r1(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=11
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r1
+
+  SUBROUTINE bcast_omp_r2(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=12
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r2
+
+  SUBROUTINE bcast_omp_r3(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=13
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r3
+
+  SUBROUTINE bcast_omp_r4(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=14
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r4
+
+  !! -- Les booleans -- !!
+
+  SUBROUTINE bcast_omp_l(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+
+    LOGICAL,DIMENSION(1) :: Var1
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=15
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var1(1)=Var
+    CALL check_buffer_l(1)
+    CALL orch_bcast_omp_lgen(Var1,1,omp_lbuffer)
+    Var=Var1(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l
+
+  SUBROUTINE bcast_omp_l1(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=16
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l1
+
+  SUBROUTINE bcast_omp_l2(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=17
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l2
+
+  SUBROUTINE bcast_omp_l3(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=18
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l3
+
+  SUBROUTINE bcast_omp_l4(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=19
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_omp_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=20
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i
+
+  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=21
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i1
+
+  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=22
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else    
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i2
+
+  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=23
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else    
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i3
+
+
+  SUBROUTINE scatter_omp_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=24
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r
+
+  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=25
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r1
+
+  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=26
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r2
+
+  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=27
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r3
+
+
+  SUBROUTINE scatter_omp_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=28
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,1,omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l
+
+  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=29
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l1
+
+  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=30
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l2
+
+  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=31
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_lbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather_omp_i0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN)               :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=32
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_simple_igen(VarIn,Varout,omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i0
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_omp_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=33
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i
+
+
+  SUBROUTINE gather_omp_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=34
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i1
+
+
+  SUBROUTINE gather_omp_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=35
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i2
+
+
+  SUBROUTINE gather_omp_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=36
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i3
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_omp_r0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN)               :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=37
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_simple_rgen(VarIn,Varout,omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r0
+
+  SUBROUTINE gather_omp_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=38
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r
+
+
+  SUBROUTINE gather_omp_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=39
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r1
+
+
+  SUBROUTINE gather_omp_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=40
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r2
+
+
+  SUBROUTINE gather_omp_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=41
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r3
+
+!!!!! --> Les booleen
+
+  SUBROUTINE gather_omp_l0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN)               :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=42
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_simple_lgen(VarIn,Varout,omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l0
+
+  SUBROUTINE gather_omp_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=43
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,1,omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l
+
+
+  SUBROUTINE gather_omp_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=44
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l1
+
+
+  SUBROUTINE gather_omp_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=45
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l2
+
+
+  SUBROUTINE gather_omp_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=46
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=47
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut=VarIn
+    RETURN
+#else
+    CALL check_buffer_i(1)   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i
+
+  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=48
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif   
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i1
+
+  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=49
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i2
+
+  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=50
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i3
+
+  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=51
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i4
+
+
+  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=52
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut=VarIn
+    RETURN
+#else
+    CALL check_buffer_r(1)   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r
+
+  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=53
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif   
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r1
+
+  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=54
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r2
+
+  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=55
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r3
+
+  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=56
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r4
+
+END MODULE mod_orchidee_omp_transfert
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+#ifdef CPP_OMP
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE orch_bcast_omp_cgen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+  USE mod_orchidee_omp_transfert, ONLY : size_min
+
+  IMPLICIT NONE
+  INTEGER,INTENT(IN)              :: Nb 
+  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Var
+  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER :: i
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=57
+    CALL print_omp_function()
+  ENDIF
+
+  IF (check) THEN
+     IF (numout_omp > 0) THEN
+        WRITE(numout_omp,*) "orch_bcast_omp_cgen before bcast Var",Var
+     ELSE
+        WRITE(*,*) "orch_bcast_omp_cgen before bcast Var",Var
+     ENDIF
+  ENDIF
+
+  IF (is_omp_root) THEN
+     IF ( len(Var) > size_min ) &
+          CALL ipslerr (3,'orch_bcast_omp_cgen', &
+          &          'Error with omp_cbuffer.', 'len(Var) > size_min', &
+          &          '(Increase size_min in mod_orchidee_omp_transfert.)')
+     DO i=1,Nb
+        Buff(i)=TRIM(Var(i))
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+  CALL barrier2_omp()
+      
+  IF (check) THEN
+     IF (numout_omp > 0) THEN
+        WRITE(numout_omp,*) "orch_bcast_omp_cgen after bcast Var",Var
+     ELSE
+        WRITE(*,*) "orch_bcast_omp_cgen after bcast Var",Var
+     ENDIF
+  ENDIF
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_cgen
+
+
+
+SUBROUTINE orch_bcast_omp_igen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
+  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER,INTENT(IN) :: Nb  
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=58
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,Nb
+        Buff(i)=Var(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_igen
+
+
+
+SUBROUTINE orch_bcast_omp_rgen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+  REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER,INTENT(IN) :: Nb
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=59
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,Nb
+        Buff(i)=Var(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_rgen
+
+
+
+SUBROUTINE orch_bcast_omp_lgen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER,INTENT(IN) :: Nb
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=60
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,Nb
+        Buff(i)=Var(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_lgen
+
+
+
+SUBROUTINE orch_scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=61
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_omp_igen
+
+
+SUBROUTINE orch_scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=62
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_omp_rgen
+
+
+SUBROUTINE orch_scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  LOGICAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=63
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_omp_lgen
+
+
+
+SUBROUTINE orch_gather_omp_simple_igen(VarIn,VarOut,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN)                            :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
+
+  Buff(omp_rank)=VarIn
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=64
+    CALL print_omp_function()
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_simple_igen
+
+SUBROUTINE orch_gather_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=65
+    CALL print_omp_function()
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           VarOut(ij,i)=Buff(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_igen
+
+
+SUBROUTINE orch_gather_omp_simple_rgen(VarIn,VarOut,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  REAL,INTENT(IN)                            :: VarIn
+  REAL,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=66
+    CALL print_omp_function()
+  ENDIF
+
+  Buff(omp_rank)=VarIn
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_simple_rgen
+
+
+SUBROUTINE orch_gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=67
+    CALL print_omp_function()
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           VarOut(ij,i)=Buff(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_rgen
+
+
+SUBROUTINE orch_gather_omp_simple_lgen(VarIn,VarOut,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  LOGICAL,INTENT(IN)                            :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=68
+    CALL print_omp_function()
+  ENDIF
+
+  Buff(omp_rank)=VarIn
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_simple_lgen
+
+
+SUBROUTINE orch_gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_para_var, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  LOGICAL,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=69
+    CALL print_omp_function()
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           VarOut(ij,i)=Buff(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_lgen
+
+
+
+SUBROUTINE orch_reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=70
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) Buff(:)=0
+
+  CALL barrier2_omp()
+
+!$OMP CRITICAL     
+  DO i=1,dimsize
+     Buff(i)=Buff(i)+VarIn(i)
+  ENDDO
+!$OMP END CRITICAL
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        VarOut(i)=Buff(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_reduce_sum_omp_igen
+
+
+SUBROUTINE orch_reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=71
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) Buff(:)=0
+
+  CALL barrier2_omp()
+
+!$OMP CRITICAL     
+  DO i=1,dimsize
+     Buff(i)=Buff(i)+VarIn(i)
+  ENDDO
+!$OMP END CRITICAL
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        VarOut(i)=Buff(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_reduce_sum_omp_rgen
+
+#endif
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_para.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_para.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_para.F90	(revision 5166)
@@ -0,0 +1,259 @@
+! Initialization of parallel for MPI and OpenMP.
+
+!-
+!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/Attic/mod_orchidee_para.F90,v 1.1.2.4 2008/11/05 10:14:05 ssipsl Exp $
+!- 
+
+MODULE mod_orchidee_para
+
+  USE mod_orchidee_para_var
+  USE mod_orchidee_mpi_data
+  USE mod_orchidee_omp_data
+  USE mod_orchidee_transfert_para
+    
+CONTAINS
+    
+  SUBROUTINE Init_orchidee_para(communicator)
+    IMPLICIT NONE
+    INTEGER,OPTIONAL,INTENT(in) :: communicator	
+
+    CALL Init_orchidee_omp
+
+
+    IF ( PRESENT(communicator) ) THEN
+       CALL Init_orchidee_mpi(communicator)
+    ELSE
+       CALL Init_orchidee_mpi
+    ENDIF
+
+
+    IF (is_mpi_root .AND. is_omp_root) THEN
+       is_root_prc=.TRUE.
+    ELSE
+       is_root_prc=.FALSE.
+    ENDIF
+  END SUBROUTINE Init_orchidee_para
+    
+  
+  SUBROUTINE Init_orchidee_data_para_driver(nbp,kindex_glo)
+
+    IMPLICIT NONE
+    INTEGER,INTENT(IN) :: nbp
+    INTEGER,INTENT(IN) :: kindex_glo(nbp)
+      
+    INTEGER :: first_point
+    INTEGER :: last_point
+    INTEGER :: nbp_loc
+    INTEGER :: nbp_loc_para(0:mpi_size-1)
+    INTEGER,ALLOCATABLE :: kindex_loc(:)
+    INTEGER :: offset
+    INTEGER :: i
+    
+      
+    last_point=0
+    
+    CALL read_load_balance(nbp,nbp_loc_para)    
+    
+    DO i=0,mpi_rank
+       nbp_loc=nbp_loc_para(i)
+       First_point=last_point+1
+       Last_point=last_point+nbp_loc
+    ENDDO
+      
+    ALLOCATE(kindex_loc(nbp_loc))
+    DO i=1,nbp_loc
+       kindex_loc(i)=kindex_glo(i+First_Point-1)
+    ENDDO
+    
+    IF (mpi_rank==0) THEN
+       offset=0
+    ELSE
+       offset=kindex_glo(First_point-1)-MOD(kindex_glo(First_point-1),iim_g)
+    ENDIF
+    
+    kindex_loc(:)=kindex_loc(:)-offset
+    
+    CALL Init_orchidee_data_para(nbp_loc,kindex_loc,offset,omp_size,omp_rank,MPI_COMM_ORCH)
+    CALL Set_stdout_file('out_orchidee')
+    CALL ipslnlf(new_number=numout)
+    !    
+  END SUBROUTINE Init_orchidee_data_para_driver
+    
+  
+  SUBROUTINE Init_orchidee_data_para(nbp,kindex,arg_offset,arg_omp_size,arg_omp_rank,COMM)
+
+    IMPLICIT NONE
+    INTEGER,INTENT(IN)     :: nbp
+    INTEGER,INTENT(IN)     :: kindex(nbp)
+    INTEGER,INTENT(IN)     :: arg_offset
+    INTEGER,INTENT(IN)     :: arg_omp_size
+    INTEGER,INTENT(IN)     :: arg_omp_rank
+    INTEGER,INTENT(IN)     :: COMM
+    
+    INTEGER,SAVE              :: arg_nbp_mpi
+    INTEGER,ALLOCATABLE,SAVE  :: kindex_mpi(:)
+    
+    offset=arg_offset 
+    CALL init_orchidee_omp_data(arg_omp_size,arg_omp_rank,nbp,offset)
+    
+    IF (is_omp_root) THEN
+       arg_nbp_mpi=SUM(nbp_omp_para_nb(:))
+       ALLOCATE(kindex_mpi(arg_nbp_mpi))
+    ENDIF
+
+    CALL barrier2_omp()
+    kindex_mpi(nbp_omp_begin:nbp_omp_end)=kindex(:)+offset
+    CALL barrier2_omp()
+      
+    IF (is_omp_root) THEN      
+       kindex_mpi(:)=kindex_mpi(:)-offset
+       CALL init_orchidee_mpi_data(arg_nbp_mpi,kindex_mpi,offset,COMM)
+       nbp_glo=SUM(nbp_mpi_para(:))
+    ENDIF
+    CALL barrier2_omp()
+
+    nbp_loc=nbp
+    
+    IF (is_mpi_root .AND. is_omp_root) THEN
+       is_root_prc=.TRUE.
+    ELSE
+       is_root_prc=.FALSE.
+    ENDIF
+    
+    CALL Test_orchidee_para
+    
+  END SUBROUTINE Init_orchidee_data_para
+
+  SUBROUTINE set_grid_glo(arg_nbp_lon,arg_nbp_lat,arg_nbp_glo)
+    IMPLICIT NONE
+
+    INTEGER(i_std), INTENT(IN) :: arg_nbp_lon
+    INTEGER(i_std), INTENT(IN) :: arg_nbp_lat
+    INTEGER(i_std), INTENT(IN),OPTIONAL :: arg_nbp_glo
+    iim_g=arg_nbp_lon
+    jjm_g=arg_nbp_lat
+    IF (PRESENT(arg_nbp_glo)) nbp_glo=arg_nbp_glo
+  END SUBROUTINE set_grid_glo
+  
+  SUBROUTINE Allocate_grid_glo
+    IMPLICIT NONE
+  
+    ALLOCATE(resolution_g(nbp_glo,2),area_g(nbp_glo),lalo_g(nbp_glo,2), &
+         &   neighbours_g(nbp_glo,8),contfrac_g(nbp_glo),index_g(nbp_glo))
+    ALLOCATE(lon_g(iim_g, jjm_g), lat_g(iim_g, jjm_g), zlev_g(iim_g, jjm_g))
+  
+  END SUBROUTINE Allocate_grid_glo
+  
+    
+  SUBROUTINE Set_stdout_file(filename)
+
+    IMPLICIT NONE
+
+    CHARACTER(len=*), INTENT(IN) :: filename
+    CHARACTER(len=255) :: fileout
+    CHARACTER(len=4)  :: num_mpi
+    CHARACTER(len=4)  :: num_omp
+    INTEGER,PARAMETER :: base_numout=100
+    INTEGER           :: ierr
+
+    IF (is_ok_mpi) THEN
+       WRITE(num_mpi,'(I4.4)') mpi_rank
+    ENDIF
+    
+    IF (is_ok_omp) THEN
+       WRITE(num_omp,'(I4.4)') omp_rank
+    ENDIF
+    
+     
+    IF (is_ok_mpi .AND. is_ok_omp) THEN
+       fileout=TRIM(filename)//'_'//num_mpi//'.'//num_omp
+       numout=base_numout+omp_rank
+    ELSE IF (is_ok_mpi .AND. (.NOT. is_ok_omp)) THEN
+       fileout=TRIM(filename)//'_'//num_mpi
+       numout=base_numout
+    ELSE IF ((.NOT. is_ok_mpi) .AND. is_ok_omp) THEN
+       fileout=TRIM(filename)//'_'//num_omp
+       numout=base_numout+omp_rank
+    ELSE
+       fileout=TRIM(filename)
+       numout=base_numout
+    ENDIF
+!$OMP CRITICAL  
+    WRITE(*,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
+!$OMP END CRITICAL
+    
+    OPEN(UNIT=numout,FILE=TRIM(fileout),ACTION='write',STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
+    IF (ierr /= 0) THEN
+#ifdef CPP_PARA
+       CALL MPI_FINALIZE(ierr)
+#endif
+       WRITE(*,*) "In Set_stdout_file : Erreur can't open file ", filename
+       STOP 1
+    ENDIF
+ 
+!$OMP CRITICAL  
+    WRITE(numout,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
+!$OMP END CRITICAL
+
+    CALL Init_numout_omp(numout)
+
+  END SUBROUTINE Set_stdout_file
+      
+      
+  SUBROUTINE Test_orchidee_para
+
+    IMPLICIT NONE
+
+    INTEGER,PARAMETER :: dimsize=3
+    REAL :: Array(nbp_loc,dimsize)
+    REAL :: Array_glo(nbp_glo,dimsize)
+    REAL :: Array_glo_tmp(nbp_glo,dimsize)
+    REAL :: Array2D_loc(iim_g,jj_nb)
+    REAL :: Array2D_glo(iim_g,jjm_g)
+    REAL :: sum1,sum2,sum3
+    
+    INTEGER :: i,j
+    
+    DO j=1,dimsize
+       DO i=1,nbp_loc
+          Array(i,j)=10*j+omp_rank+i*1000
+       ENDDO
+    ENDDO
+      
+    CALL gather(Array,Array_glo)
+    CALL bcast(Array_glo)
+    CALL scatter(Array_glo,array)
+    CALL gather(array,array_glo_tmp)
+    CALL bcast(array_glo_tmp)    
+    WRITE(*,*) "Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",SUM(array_glo-array_glo_tmp)
+
+    sum1=SUM(array)
+    CALL reduce_sum(sum1,sum2)
+    CALL bcast(sum2)
+    sum3=SUM(array_glo)
+    WRITE(*,*) "Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum2
+    
+    IF (is_omp_root) THEN
+       DO j=1,jjm_g
+          DO i=1,iim_g
+             Array2D_glo(i,j)=(j-1)*iim_g+i
+          ENDDO
+       ENDDO
+        
+       array2D_loc(:,:)=0
+       CALL scatter2D_mpi(array2D_glo,array2D_loc)
+       array2D_glo(:,:)=0
+       CALL gather2D_mpi(array2D_loc,array2D_glo)
+       CALL bcast_mpi(array2D_glo)
+       sum1=SUM(array2D_glo)
+       sum2=SUM(array2D_loc)
+       CALL reduce_sum_mpi(sum2,sum3)
+       CALL bcast_mpi(sum3)
+       
+       WRITE(*,*) "Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum1
+    ENDIF
+    CALL barrier2_omp()
+
+  END SUBROUTINE  Test_orchidee_para
+  
+END MODULE mod_orchidee_para
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_para_var.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_para_var.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_para_var.F90	(revision 5166)
@@ -0,0 +1,232 @@
+! ================================================================================================================================
+!  MODULE       : mod_orchidee_para_var
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF   This module contains public variables for parallelization and domain decomposition 
+!!
+!!\n DESCRIPTION: \n
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE mod_orchidee_para_var
+
+  USE defprec
+
+  !
+  ! 1. Variables related to the MPI parallelization and the MPI horizontal domain decompostion. 
+  !    These variables were previously declared in mod_orchidee_mpi_data
+  !
+
+  ! Unit for output messages
+  INTEGER(i_std), SAVE :: numout = 6
+  !$OMP THREADPRIVATE(numout)
+
+  INTEGER,SAVE :: mpi_size                                            !! Number of parallel processes
+  INTEGER,SAVE :: mpi_rank                                            !! my rank num
+  INTEGER,SAVE :: mpi_rank_root                                       !! rank of MPI root
+  LOGICAL,SAVE :: is_mpi_root                                         !! Only MPI root proc is true
+  LOGICAL,SAVE :: is_ok_mpi                                           
+
+  INTEGER(i_std),SAVE              :: nbp_mpi                         !! number of local continental points in each mpi group
+  INTEGER(i_std),SAVE              :: nbp_glo                         !! number of global continental points
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_mpi_para
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_mpi_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_mpi_para_end 
+
+  INTEGER,SAVE :: nbp_mpi_begin
+  INTEGER,SAVE :: nbp_mpi_end
+
+
+  INTEGER(i_std),SAVE              :: iim_g                           !! Dimension of global fields for longitude
+  INTEGER(i_std),SAVE              :: jjm_g                           !! Dimension of global fields for latitude
+  ! i x j 2D points (not land points) index
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb           ! Number of 2D points for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin        ! First 2D point for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end          ! Last 2D point for each mpi_rank block
+  ! i 2D index 
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin        ! First i index of 2D point for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end          ! Last i index of 2D point for each mpi_rank block
+  ! j 2D index
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb           ! Number of complete j lines for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin        ! First j index of 2D point for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end          ! Last j index of 2D point for each mpi_rank block
+
+  INTEGER,SAVE :: ii_begin
+  INTEGER,SAVE :: ii_end
+  INTEGER,SAVE :: jj_begin
+  INTEGER,SAVE :: jj_end
+  INTEGER,SAVE :: jj_nb
+  INTEGER,SAVE :: ij_begin
+  INTEGER,SAVE :: ij_end
+  INTEGER,SAVE :: ij_nb
+
+  INTEGER,SAVE :: MPI_COMM_ORCH
+  INTEGER,SAVE :: MPI_REAL_ORCH
+  INTEGER,SAVE :: MPI_INT_ORCH
+  LOGICAL, SAVE :: cpl_lmdz
+
+  INTEGER,SAVE,ALLOCATABLE :: kindex_mpi (:)
+  INTEGER,SAVE             :: offset_mpi
+
+
+  !
+  ! 2. Variables related to the OpenMP paralelization and OpenMP horizontal domain decomposition 
+  !    These variables were previously declared in mod_orchidee_omp_data
+  !
+
+  ! Check all OpenMP transferts in ORCHIDEE : use this flag to debug synchronism with OpenMP 
+  LOGICAL, PARAMETER :: check_all_transfert=.FALSE.
+
+
+  INTEGER(i_std),SAVE :: omp_size
+  INTEGER(i_std),SAVE :: omp_rank
+  LOGICAL,SAVE :: is_omp_root
+  LOGICAL,SAVE :: is_ok_omp
+  !$OMP  THREADPRIVATE(omp_rank,is_omp_root)
+
+  INTEGER(i_std),SAVE,DIMENSION(:),ALLOCATABLE :: nbp_omp_para_nb
+  INTEGER(i_std),SAVE,DIMENSION(:),ALLOCATABLE :: nbp_omp_para_begin
+  INTEGER(i_std),SAVE,DIMENSION(:),ALLOCATABLE :: nbp_omp_para_end    
+
+  INTEGER(i_std),SAVE :: nbp_omp
+  INTEGER(i_std),SAVE :: nbp_omp_begin
+  INTEGER(i_std),SAVE :: nbp_omp_end
+  INTEGER(i_std),SAVE :: offset_omp
+  !$OMP  THREADPRIVATE(nbp_omp,nbp_omp_begin,nbp_omp_end,offset_omp)
+
+  ! Flag for each OMP process for ORCHIDEE to verify synchronization if function Synchro_Omp is used
+  LOGICAL,SAVE,ALLOCATABLE :: proc_synchro_omp(:)
+
+  INTEGER, SAVE :: numout_omp = -1
+  !$OMP  THREADPRIVATE(numout_omp)
+
+  ! For debugging OpenMP processes : id of OMP function for each task.
+  ! If one task is not in the same function, we can see it.
+  INTEGER(i_std),SAVE,ALLOCATABLE,DIMENSION(:) :: omp_function
+  ! It is not SHARED.
+  ! List of values :
+  CHARACTER(LEN=28), PARAMETER :: omp_fct_name(-1:72) = (/ &
+       "Initialization              ", &
+       "Synchro_Omp                 ", &
+       "check_buffer_i              ", &
+       "check_buffer_r              ", &
+       "check_buffer_l              ", &
+       "bcast_omp_c                 ", &
+       "bcast_omp_i                 ", &
+       "bcast_omp_i1                ", &
+       "bcast_omp_i2                ", &
+       "bcast_omp_i3                ", &
+       "bcast_omp_i4                ", &
+       "bcast_omp_r                 ", &
+       "bcast_omp_r1                ", &
+       "bcast_omp_r2                ", &
+       "bcast_omp_r3                ", &
+       "bcast_omp_r4                ", &
+       "bcast_omp_l                 ", &
+       "bcast_omp_l1                ", &
+       "bcast_omp_l2                ", &
+       "bcast_omp_l3                ", &
+       "bcast_omp_l4                ", &
+       "scatter_omp_i               ", &
+       "scatter_omp_i1              ", &
+       "scatter_omp_i2              ", &
+       "scatter_omp_i3              ", &
+       "scatter_omp_r               ", &
+       "scatter_omp_r1              ", &
+       "scatter_omp_r2              ", &
+       "scatter_omp_r3              ", &
+       "scatter_omp_l               ", &
+       "scatter_omp_l1              ", &
+       "scatter_omp_l2              ", &
+       "scatter_omp_l3              ", &
+       "gather_omp_i0               ", &
+       "gather_omp_i                ", &
+       "gather_omp_i1               ", &
+       "gather_omp_i2               ", &
+       "gather_omp_i3               ", &
+       "gather_omp_r0               ", &
+       "gather_omp_r                ", &
+       "gather_omp_r1               ", &
+       "gather_omp_r2               ", &
+       "gather_omp_r3               ", &
+       "gather_omp_l0               ", &
+       "gather_omp_l                ", &
+       "gather_omp_l1               ", &
+       "gather_omp_l2               ", &
+       "gather_omp_l3               ", &
+       "reduce_sum_omp_i            ", &
+       "reduce_sum_omp_i1           ", &
+       "reduce_sum_omp_i2           ", &
+       "reduce_sum_omp_i3           ", &
+       "reduce_sum_omp_i4           ", &
+       "reduce_sum_omp_r            ", &
+       "reduce_sum_omp_r1           ", &
+       "reduce_sum_omp_r2           ", &
+       "reduce_sum_omp_r3           ", &
+       "reduce_sum_omp_r4           ", &
+       "orch_bcast_omp_cgen         ", &
+       "orch_bcast_omp_igen         ", &
+       "orch_bcast_omp_rgen         ", &
+       "orch_bcast_omp_lgen         ", &
+       "orch_scatter_omp_igen       ", &
+       "orch_scatter_omp_rgen       ", &
+       "orch_scatter_omp_lgen       ", &
+       "orch_gather_omp_simple_igen ", &
+       "orch_gather_omp_igen        ", &
+       "orch_gather_omp_simple_rgen ", &
+       "orch_gather_omp_rgen        ", &
+       "orch_gather_omp_simple_lgen ", &
+       "orch_gather_omp_lgen        ", &
+       "orch_reduce_sum_omp_igen    ", &
+       "orch_reduce_sum_omp_rgen    ", &
+       "check_buffer_c              " /)
+
+  ! Previous value for own omp_function
+  INTEGER, SAVE :: omp_previous
+  !$OMP  THREADPRIVATE(omp_previous)
+
+  ! 
+  !! 3. Variables previously declared in mod_orchide_para
+  !
+
+  INTEGER,SAVE :: nbp_loc                                             !! number of local continental points
+  !$OMP THREADPRIVATE(nbp_loc)
+  INTEGER,SAVE :: offset
+  !$OMP THREADPRIVATE(offset)
+
+  LOGICAL,SAVE :: is_root_prc = .FALSE.                               !! Only root proc for MPI and OpenMP is true
+  !$OMP THREADPRIVATE(is_root_prc)
+
+  !! Global array used by stomate and sechiba
+  !-
+  !! index of land points on the 2D map
+  INTEGER(i_std),ALLOCATABLE,DIMENSION(:),SAVE   :: index_g
+  !-
+  !! indices of the 4 neighbours of each grid point (1=N, 2=E, 3=S, 4=W)
+  INTEGER(i_std),ALLOCATABLE,DIMENSION(:,:),SAVE :: neighbours_g
+  !-
+  !! resolution at each grid point in m (1=E-W, 2=N-S)
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:),SAVE    :: resolution_g 
+  REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE    :: area_g 
+  !-
+  !! Geographical coordinates
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:),SAVE    :: lalo_g
+  ! Global grid, for all process
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:), SAVE     :: lon_g, lat_g, zlev_g
+  !-
+  !! Fraction of continents
+  REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE      :: contfrac_g  
+
+
+END MODULE mod_orchidee_para_var
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_transfert_para.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_transfert_para.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mod_orchidee_transfert_para.F90	(revision 5166)
@@ -0,0 +1,770 @@
+! High level MPI/OpenMP parallel communication encapsulations for ORCHIDEE.
+
+!-
+!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/Attic/mod_orchidee_transfert_para.F90,v 1.1.2.2 2008/08/29 14:01:40 ssipsl Exp $
+!-
+
+MODULE mod_orchidee_transfert_para
+
+  USE mod_orchidee_para_var
+  USE mod_orchidee_mpi_transfert
+  USE mod_orchidee_omp_transfert 
+  
+
+
+  INTERFACE bcast
+    MODULE PROCEDURE bcast_c, bcast_c1,                           &
+                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
+                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
+		     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
+  END INTERFACE
+
+  INTERFACE scatter
+    MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3, &
+                     scatter_r,scatter_r1,scatter_r2,scatter_r3, &
+		     scatter_l,scatter_l1,scatter_l2,scatter_l3
+  END INTERFACE
+
+  
+  INTERFACE gather
+    MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3, &
+                     gather_r,gather_r1,gather_r2,gather_r3, &
+		     gather_l,gather_l1,gather_l2,gather_l3  
+  END INTERFACE
+  
+
+  INTERFACE reduce_sum
+    MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, &
+                     reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4
+  END INTERFACE 
+
+   
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_c(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_c
+
+  SUBROUTINE bcast_c1(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_c1
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_i(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i
+
+  SUBROUTINE bcast_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i1
+
+
+  SUBROUTINE bcast_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i2
+
+
+  SUBROUTINE bcast_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i3
+
+
+  SUBROUTINE bcast_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i4
+
+ 
+!! -- Les reels -- !!
+  
+  SUBROUTINE bcast_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r
+
+  SUBROUTINE bcast_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r1
+
+
+  SUBROUTINE bcast_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r2
+
+
+  SUBROUTINE bcast_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r3
+
+
+  SUBROUTINE bcast_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r4 
+
+
+!! -- Les booleens -- !!
+  
+  SUBROUTINE bcast_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l
+
+  SUBROUTINE bcast_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l1
+
+
+  SUBROUTINE bcast_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l2
+
+
+  SUBROUTINE bcast_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l3
+
+
+  SUBROUTINE bcast_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+     
+    IF (is_omp_root) CALL bcast_mpi(Var)
+
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l4
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_i(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(nbp_mpi) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i
+
+
+  SUBROUTINE scatter_i1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i1
+
+
+  SUBROUTINE scatter_i2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i2
+
+
+  SUBROUTINE scatter_i3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_i3
+
+
+  SUBROUTINE scatter_r(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r
+
+
+  SUBROUTINE scatter_r1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r1
+
+
+  SUBROUTINE scatter_r2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r2
+
+
+  SUBROUTINE scatter_r3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_r3
+  
+  
+
+  SUBROUTINE scatter_l(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l
+
+
+  SUBROUTINE scatter_l1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l1
+
+
+  SUBROUTINE scatter_l2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l2
+
+
+  SUBROUTINE scatter_l3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_l3
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_i(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
+  
+  END SUBROUTINE gather_i
+
+
+  SUBROUTINE gather_i1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
+
+  
+  END SUBROUTINE gather_i1
+
+
+  SUBROUTINE gather_i2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_i2
+
+
+  SUBROUTINE gather_i3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+
+  
+  END SUBROUTINE gather_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_r(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE gather_r
+
+
+  SUBROUTINE gather_r1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+
+  
+  END SUBROUTINE gather_r1
+
+
+  SUBROUTINE gather_r2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_r2
+
+
+  SUBROUTINE gather_r3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_r3
+
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather_l(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l
+
+
+  SUBROUTINE gather_l1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l1
+
+
+  SUBROUTINE gather_l2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l2
+
+
+  SUBROUTINE gather_l3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Les entiers
+
+  SUBROUTINE reduce_sum_i(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    
+    INTEGER             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_i  
+
+
+  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_i1  
+
+
+  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE reduce_sum_i2  
+  
+
+  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_i3  
+
+
+  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_i4  
+
+
+! Les reels
+
+  SUBROUTINE reduce_sum_r(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    
+    REAL             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r  
+
+
+  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r1  
+
+
+  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r2  
+  
+
+  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r3  
+
+
+  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r4  
+
+   
+END MODULE mod_orchidee_transfert_para
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mpi_dummy.h
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mpi_dummy.h	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/mpi_dummy.h	(revision 5166)
@@ -0,0 +1,60 @@
+! Overlapp of MPI functions not present in some MPI implementations.
+
+!-
+!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/mpi_dummy.h,v 1.2 2007/06/12 08:04:26 ssipsl Exp $
+!-
+#ifdef MPI_SECOND__
+
+SUBROUTINE MPI_NULL_COPY_FN
+END SUBROUTINE MPI_NULL_COPY_FN
+
+SUBROUTINE MPI_NULL_DELETE_FN
+END SUBROUTINE MPI_NULL_DELETE_FN
+
+SUBROUTINE MPI_COMM_NULL_COPY_FN
+END SUBROUTINE MPI_COMM_NULL_COPY_FN
+
+SUBROUTINE MPI_COMM_NULL_DELETE_FN
+END SUBROUTINE MPI_COMM_NULL_DELETE_FN
+
+SUBROUTINE MPI_TYPE_NULL_COPY_FN
+END SUBROUTINE MPI_TYPE_NULL_COPY_FN
+
+SUBROUTINE MPI_TYPE_NULL_DELETE_FN
+END SUBROUTINE MPI_TYPE_NULL_DELETE_FN
+
+SUBROUTINE MPI_WIN_NULL_COPY_FN
+END SUBROUTINE MPI_WIN_NULL_COPY_FN
+
+SUBROUTINE MPI_WIN_NULL_DELETE_FN
+END SUBROUTINE MPI_WIN_NULL_DELETE_FN
+
+SUBROUTINE MPI_DUP_FN
+END SUBROUTINE MPI_DUP_FN
+
+SUBROUTINE MPI_COMM_DUP_FN
+END SUBROUTINE MPI_COMM_DUP_FN
+
+SUBROUTINE MPI_TYPE_DUP_FN
+END SUBROUTINE MPI_TYPE_DUP_FN
+
+SUBROUTINE MPI_WIN_DUP_FN
+END SUBROUTINE MPI_WIN_DUP_FN
+
+FUNCTION MPI_WTIME () RESULT (R)
+  DOUBLE PRECISION R
+END FUNCTION MPI_WTIME
+
+FUNCTION MPI_WTICK () RESULT (R)
+  DOUBLE PRECISION :: R
+END FUNCTION MPI_WTICK
+
+FUNCTION PMPI_WTIME () RESULT (R)
+  DOUBLE PRECISION R
+END FUNCTION PMPI_WTIME
+
+FUNCTION PMPI_WTICK () RESULT (R)
+  DOUBLE PRECISION R
+END FUNCTION PMPI_WTICK
+
+#endif
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/orch_write_field.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/orch_write_field.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/orch_write_field.f90	(revision 5166)
@@ -0,0 +1,282 @@
+! Yann Meurdesoif functions for sequentiel tests.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+module orch_Write_Field
+  
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  integer, parameter :: MaxWriteField = 100
+  integer, dimension(MaxWriteField),save :: FieldId
+  integer, dimension(MaxWriteField),save :: FieldVarId
+  integer, dimension(MaxWriteField),save :: FieldIndex
+  character(len=255), dimension(MaxWriteField) ::  FieldName
+  
+  integer, save,dimension(:), allocatable :: Index_Write_Field
+  integer,save :: iim
+  integer,save :: jjm
+  integer,save :: NbPoint
+  real, parameter :: undef_var=0.
+  
+  integer,save :: NbField = 0
+  
+  interface WriteField
+    module procedure WriteField_4d,WriteField_3d,WriteField_2d,WriteField_1d
+  end interface WriteField
+ 
+  interface WriteFieldI
+    module procedure WriteFieldI_3d,WriteFieldI_2d,WriteFieldI_1d
+  end interface WriteFieldI
+
+  private :: iim,jjm,NbPoint 
+  contains
+  
+    subroutine Init_WriteField(iim0,jjm0,NbPoint0,Index0)
+    implicit none
+      integer,intent(in) :: iim0
+      integer,intent(in) :: jjm0
+      integer,intent(in) :: NbPoint0
+      integer,intent(in) :: Index0(NbPoint0)
+    
+      iim=iim0
+      jjm=jjm0
+      Nbpoint=Nbpoint0
+      ALLOCATE(Index_Write_Field(NbPoint))
+      Index_Write_Field(:)=Index0(:)
+    end subroutine Init_WriteField
+    
+    function GetFieldIndex(name)
+    implicit none
+      integer          :: GetFieldindex
+      character(len=*) :: name
+    
+      character(len=255) :: TrueName
+      integer            :: i
+       
+      
+      TrueName=TRIM(ADJUSTL(name))
+    
+      GetFieldIndex=-1
+      do i=1,NbField
+        if (TrueName==FieldName(i)) then
+          GetFieldIndex=i
+          exit
+        endif
+      enddo
+    end function GetFieldIndex
+
+    subroutine WriteFieldI_3d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:,:) :: Field 
+      integer, dimension(3) :: Dim
+      integer,dimension(4) :: Dim_tmp
+      integer :: i
+      
+      real, allocatable, dimension(:,:,:) :: Field_tmp 
+      
+      Dim=shape(Field)
+      allocate(Field_tmp(iim*jjm,Dim(2),dim(3)))
+      field_tmp(:,:,:)=undef_var
+      
+      do i=1,NbPoint
+        field_tmp(Index_Write_Field(i),:,:)=Field(i,:,:)
+      enddo
+      
+      Dim_tmp(1)=iim
+      Dim_tmp(2)=jjm
+      Dim_tmp(3)=dim(2)
+      Dim_tmp(4)=dim(3)
+      call WriteField_gen(name,Field_tmp,4,Dim_tmp)  
+  
+      deallocate(Field_tmp)
+    end subroutine WriteFieldI_3d
+
+    subroutine WriteFieldI_2d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:) :: Field 
+      integer, dimension(2) :: Dim
+      integer,dimension(3) :: Dim_tmp
+      integer :: i
+      
+      real, allocatable, dimension(:,:) :: Field_tmp 
+      
+      Dim=shape(Field)
+      allocate(Field_tmp(iim*jjm,Dim(2)))
+      field_tmp(:,:)=undef_var
+      
+      do i=1,NbPoint
+        field_tmp(Index_Write_Field(i),:)=Field(i,:)
+      enddo
+      
+      Dim_tmp(1)=iim
+      Dim_tmp(2)=jjm
+      Dim_tmp(3)=dim(2)
+
+      call WriteField_gen(name,Field_tmp,3,Dim_tmp)  
+  
+      deallocate(Field_tmp)
+    end subroutine WriteFieldI_2d
+
+    subroutine WriteFieldI_1d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:) :: Field 
+      integer, dimension(1) :: Dim
+      integer,dimension(2) :: Dim_tmp
+      integer :: i
+      
+      real, allocatable, dimension(:) :: Field_tmp 
+      
+      Dim=shape(Field)
+      allocate(Field_tmp(iim*jjm))
+      field_tmp(:)=undef_var
+      
+      do i=1,NbPoint
+        field_tmp(Index_Write_Field(i))=Field(i)
+      enddo
+      
+      Dim_tmp(1)=iim
+      Dim_tmp(2)=jjm
+
+      call WriteField_gen(name,Field_tmp,2,Dim_tmp)  
+  
+      deallocate(Field_tmp)
+    end subroutine WriteFieldI_1d
+        
+    subroutine WriteField_4d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:,:,:) :: Field 
+      integer, dimension(4) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,4,Dim)  
+  
+    end subroutine WriteField_4d
+     
+    subroutine WriteField_3d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:,:) :: Field 
+      integer, dimension(3) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,3,Dim)  
+  
+    end subroutine WriteField_3d
+    
+    subroutine WriteField_2d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:) :: Field 
+      integer, dimension(2) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,2,Dim)  
+  
+    end subroutine WriteField_2d
+    
+    subroutine WriteField_1d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:) :: Field 
+      integer, dimension(1) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,1,Dim)  
+  
+    end subroutine WriteField_1d
+        
+    subroutine CreateNewField(name,NbDim,DimSize)
+    USE ioipsl
+    implicit none
+    include 'netcdf.inc'  
+      character(len=*) :: name
+      integer :: NbDim
+      integer :: DimSize(NbDim)
+      integer :: TabDim(NbDim+1)
+      integer :: status
+      
+      
+      NbField=NbField+1
+      FieldName(NbField)=TRIM(ADJUSTL(name))
+      FieldIndex(NbField)=1
+      
+      WRITE(numout,*) 'CREATE_NEW_FIELD ',name,NbDim,DimSize
+      CALL flush(6)
+      status = NF_CREATE(TRIM(ADJUSTL(name))//'.nc', NF_CLOBBER, FieldId(NbField))
+      if (NbDim>=1) status = NF_DEF_DIM(FieldId(NbField),'I',DimSize(1),TabDim(1))
+      if (NbDim>=2) status = NF_DEF_DIM(FieldId(NbField),'J',DimSize(2),TabDim(2))
+      if (NbDim>=3) status = NF_DEF_DIM(FieldId(NbField),'K',DimSize(3),TabDim(3))
+      if (NbDim>=4) status = NF_DEF_DIM(FieldId(NbField),'L',DimSize(4),TabDim(4))
+      status = NF_DEF_DIM(FieldId(NbField),'iter',NF_UNLIMITED,TabDim(NbDim+1))
+      status = NF_DEF_VAR(FieldId(NbField),FieldName(NbField),NF_DOUBLE,NbDim+1,TabDim,FieldVarId(NbField))
+      status = NF_ENDDEF(FieldId(NbField))
+
+    end subroutine CreateNewField
+    
+  function int2str(int)
+    implicit none
+    integer, parameter :: MaxLen=10
+    integer,intent(in) :: int
+    character(len=MaxLen) :: int2str
+    logical :: flag
+    integer :: i
+    flag=.true.
+    
+    i=int
+    
+    int2str=''
+    do while (flag)
+      int2str=CHAR(MOD(i,10)+48)//int2str
+      i=i/10
+      if (i==0) flag=.false.
+    enddo
+  end function int2str
+
+
+end module Orch_Write_Field
+
+    subroutine WriteField_gen(name,Field,NbDim,DimSize)
+    use orch_write_field
+    implicit none
+    include 'netcdf.inc'
+      character(len=*) :: name
+      integer :: NbDim
+      integer,dimension(NbDim) :: DimSize
+      real,dimension(*) :: Field
+      
+      integer :: status
+      integer :: ind
+      integer :: start(NbDim+1)
+      integer :: count(NbDim+1)
+      integer :: i
+           
+      Ind=GetFieldIndex(name)
+      if (Ind==-1) then
+        call CreateNewField(name,NbDim,DimSize)
+	Ind=GetFieldIndex(name)
+      else
+        FieldIndex(Ind)=FieldIndex(Ind)+1
+      endif
+      
+      do i=1,NbDim
+        start(i)=1
+        count(i)=DimSize(i)
+      enddo
+      start(NbDim+1)=FieldIndex(Ind)
+      count(NbDim+1)=1
+
+      status = NF_PUT_VARA_DOUBLE(FieldId(Ind),FieldVarId(Ind),start,count,Field)
+      status = NF_SYNC(FieldId(Ind))
+      
+    end subroutine WriteField_gen
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/orch_write_field_p.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/orch_write_field_p.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/orch_write_field_p.f90	(revision 5166)
@@ -0,0 +1,156 @@
+! Yann Meurdesoif functions for parallel tests.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE Orch_Write_field_p
+  
+  interface WriteField_p
+    module procedure WriteField_4d_p,WriteField_3d_p,WriteField_2d_p
+  end interface WriteField_p
+ 
+  interface WriteFieldI_p
+    module procedure WriteFieldI_3d_p,WriteFieldI_2d_p,WriteFieldI_1d_p
+  end interface WriteFieldI_p  
+  
+  
+CONTAINS
+
+  SUBROUTINE init_WriteField_p
+  USE mod_orchidee_para
+  USE Write_Field, only : Init_WriteField
+  IMPLICIT NONE
+    IF (is_root_prc) CALL Init_WriteField(iim_g,jjm_g,nbp_glo,index_g)
+    
+  END SUBROUTINE init_WriteField_p
+
+  SUBROUTINE WriteField_4d_p(name,Field)
+    USE mod_orchidee_para
+    USE Write_field, only : WriteField
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:,:,:) :: Field 
+      INTEGER, DIMENSION(4) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: Field_g
+      
+      Dim=shape(Field)
+      
+      ALLOCATE(Field_g(iim_g,jjm_g,Dim(3),Dim(4)))
+      CALL Gather2D_mpi(Field,Field_g)
+
+      IF (is_root_prc) CALL WriteField(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteField_4d_p
+    
+  SUBROUTINE WriteField_3d_p(name,Field)
+    USE mod_orchidee_para
+    USE Write_field, only : WriteField
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:,:) :: Field 
+      INTEGER, DIMENSION(3) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: Field_g
+      
+      
+      Dim=shape(Field)
+      
+      ALLOCATE(Field_g(iim_g,jjm_g,Dim(3)))
+      CALL Gather2D_mpi(Field,Field_g)
+
+      IF (is_root_prc) CALL WriteField(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteField_3d_p
+
+  SUBROUTINE WriteField_2d_p(name,Field)
+    USE mod_orchidee_para
+    USE Write_field, only : WriteField
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:) :: Field 
+      INTEGER, DIMENSION(2) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: Field_g
+      
+      
+      Dim=shape(Field)
+      
+      ALLOCATE(Field_g(iim_g,jjm_g))
+      CALL Gather2D_mpi(Field,Field_g)
+
+      IF (is_root_prc) CALL WriteField_gen(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteField_2d_p
+
+  SUBROUTINE WriteFieldI_3d_p(name,Field)
+    USE mod_orchidee_para
+    USE Write_field, only : WriteFieldI
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:,:) :: Field 
+      INTEGER, DIMENSION(3) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: Field_g
+      
+      
+      Dim=shape(Field)
+      
+      ALLOCATE(Field_g(nbp_glo,Dim(2),Dim(3)))
+      CALL gather(Field,Field_g)
+      
+      IF (is_root_prc) CALL WriteFieldI(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteFieldI_3d_p
+
+  SUBROUTINE WriteFieldI_2d_p(name,Field)
+    USE mod_orchidee_para
+    USE Write_field, only : WriteFieldI
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:) :: Field 
+      INTEGER, DIMENSION(2) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: Field_g
+      
+      
+      Dim=shape(Field)
+      
+      ALLOCATE(Field_g(nbp_glo,Dim(2)))
+      CALL gather(Field,Field_g)
+      
+      IF (is_root_prc) CALL WriteFieldI(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteFieldI_2d_p    
+
+  SUBROUTINE WriteFieldI_1d_p(name,Field)
+    USE mod_orchidee_para
+    USE Write_field, only : WriteFieldI
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:) :: Field 
+      INTEGER, DIMENSION(1) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:) :: Field_g
+      
+      
+      Dim=shape(Field)
+      
+      ALLOCATE(Field_g(nbp_glo))
+      CALL gather(Field,Field_g)
+      
+      IF (is_root_prc) CALL WriteFieldI(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteFieldI_1d_p    
+    
+END MODULE Orch_Write_field_p
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/src_parallel.h
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/src_parallel.h	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/src_parallel.h	(revision 5166)
@@ -0,0 +1,646 @@
+! Redefinition of MPI function if not second underscore in MPI library.
+! One must use -DMPI_SECOND__ in precompilation to activate those definitions.
+
+!-
+!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/src_parallel.h,v 1.3 2009/06/24 10:15:00 ssipsl Exp $
+!-
+
+#ifdef MPI_SECOND__
+
+#define MPI_BARRIER MPI_BARRIER_
+#define MPI_FINALIZE MPI_FINALIZE_
+#define MPI_COMM_SIZE MPI_COMM_SIZE_
+#define MPI_INIT MPI_INIT_
+#define MPI_COMM_RANK MPI_COMM_RANK_
+#define MPI_GATHER MPI_GATHER_
+#define MPI_GATHERV MPI_GATHERV_
+#define MPI_BCAST MPI_BCAST_
+#define MPI_SCATTERV MPI_SCATTERV_
+#define MPI_REDUCE MPI_REDUCE_
+
+#endif
+
+#ifdef NF_SECOND__
+
+
+#define nf_get_varm_double nf_get_varm_double_
+#define nf_get_vara_text nf_get_vara_text_
+#define nf_get_vara_real nf_get_vara_real_
+#define nf_get_varm_int1 nf_get_varm_int1_
+#define nf_get_varm_int2 nf_get_varm_int2_
+#define nf_get_varm_text nf_get_varm_text_
+#define nf_get_varm_real nf_get_varm_real_
+#define nf_get_vars_int1 nf_get_vars_int1_
+#define nf_get_vars_int nf_get_vars_int_
+#define nf_get_vars_double nf_get_vars_double_
+#define nf_get_vars_text nf_get_vars_text_
+#define nf_inq_att nf_inq_att_
+#define nf_inq_attid nf_inq_attid_
+#define nf_inq_atttype nf_inq_atttype_
+#define nf_inq_attname nf_inq_attname_
+#define nf_inq_attlen nf_inq_attlen_
+#define nf_inq nf_inq_
+#define nf_inq_dim nf_inq_dim_
+#define nf_inq_dimlen nf_inq_dimlen_
+#define nf_inq_dimid nf_inq_dimid_
+#define nf_inq_libvers nf_inq_libvers_
+#define nf_inq_format nf_inq_format_
+#define nf_inq_natts nf_inq_natts_
+#define nf_inq_dimname nf_inq_dimname_
+#define nf_inq_base_pe nf_inq_base_pe_
+#define nf_get_vars_real nf_get_vars_real_
+#define nf_inq_nvars nf_inq_nvars_
+#define nf_inq_ndims nf_inq_ndims_
+#define nf_get_vars_int2 nf_get_vars_int2_
+#define nf_inq_var nf_inq_var_
+#define nf_inq_vardimid nf_inq_vardimid_
+#define nf_inq_varid nf_inq_varid_
+#define nf_inq_varnatts nf_inq_varnatts_
+#define nf_inq_varndims nf_inq_varndims_
+#define nf_inq_vartype nf_inq_vartype_
+#define nf_inq_varname nf_inq_varname_
+#define nf_issyserr nf_issyserr_
+#define nf_put_att_double nf_put_att_double_
+#define nf_open nf_open_
+#define nf_put_att_int1 nf_put_att_int1_
+#define nf_put_att_int nf_put_att_int_
+#define nf_put_att_text nf_put_att_text_
+#define nf_put_att_real nf_put_att_real_
+#define nf_put_att_int2 nf_put_att_int2_
+#define nf_inq_unlimdim nf_inq_unlimdim_
+#define nf_get_varm_int nf_get_varm_int_
+#define nf_put_var1_int nf_put_var1_int_
+#define nf_put_var1_int2 nf_put_var1_int2_
+#define nf_put_var1_int1 nf_put_var1_int1_
+#define nf_put_var1_text nf_put_var1_text_
+#define nf_put_var_int nf_put_var_int_
+#define nf_put_var_double nf_put_var_double_
+#define nf_put_var1_real nf_put_var1_real_
+#define nf_put_var_real nf_put_var_real_
+#define nf_put_vara_int2 nf_put_vara_int2_
+#define nf_put_vara_int1 nf_put_vara_int1_
+#define nf_put_vara_int nf_put_vara_int_
+#define nf_put_vara_double nf_put_vara_double_
+#define nf_put_vara_text nf_put_vara_text_
+#define nf_put_varm_int1 nf_put_varm_int1_
+#define nf_put_varm_int2 nf_put_varm_int2_
+#define nf_put_varm_int nf_put_varm_int_
+#define nf_put_varm_double nf_put_varm_double_
+#define nf_put_varm_real nf_put_varm_real_
+#define nf_put_vara_real nf_put_vara_real_
+#define nf_put_var_text nf_put_var_text_
+#define nf_put_var_int2 nf_put_var_int2_
+#define nf_put_var_int1 nf_put_var_int1_
+#define nf_put_vars_double nf_put_vars_double_
+#define nf_put_varm_text nf_put_varm_text_
+#define nf_put_var1_double nf_put_var1_double_
+#define nf_put_vars_int1 nf_put_vars_int1_
+#define nf_put_vars_int2 nf_put_vars_int2_
+#define nf_put_vars_text nf_put_vars_text_
+#define nf_put_vars_real nf_put_vars_real_
+#define nf_rename_att nf_rename_att_
+#define nf_set_base_pe nf_set_base_pe_
+#define nf_rename_var nf_rename_var_
+#define nf_rename_dim nf_rename_dim_
+#define nf_redef nf_redef_
+#define nf_sync nf_sync_
+#define nf_strerror nf_strerror_
+#define nf_set_fill nf_set_fill_
+#define nf_set_default_format nf_set_default_format_
+#define nf_put_vars_int nf_put_vars_int_
+#define nf_get_var_int2 nf_get_var_int2_
+#define nf__create_mp nf__create_mp_
+#define nf__open nf__open_
+#define nf__open_mp nf__open_mp_
+#define nf__enddef nf__enddef_
+#define nf_abort nf_abort_
+#define nf__create nf__create_
+#define nf_copy_att nf_copy_att_
+#define nf_create nf_create_
+#define nf_def_dim nf_def_dim_
+#define nf_copy_var nf_copy_var_
+#define nf_close nf_close_
+#define nf_del_att nf_del_att_
+#define nf_delete nf_delete_
+#define nf_def_var nf_def_var_
+#define nf_enddef nf_enddef_
+#define nf_get_att_real nf_get_att_real_
+#define nf_get_att_double nf_get_att_double_
+#define nf_get_att_int nf_get_att_int_
+#define nf_get_att_int2 nf_get_att_int2_
+#define nf_get_att_int1 nf_get_att_int1_
+#define nf_get_att_text nf_get_att_text_
+#define nf_get_var1_int nf_get_var1_int_
+#define nf_get_var1_int1 nf_get_var1_int1_
+#define nf_get_var1_text nf_get_var1_text_
+#define nf_get_var1_real nf_get_var1_real_
+#define nf_get_var1_int2 nf_get_var1_int2_
+#define nf_get_var1_double nf_get_var1_double_
+#define nf_get_var_int nf_get_var_int_
+#define nf_get_var_int2 nf_get_var_int2_
+#define nf_get_var_real nf_get_var_real_
+#define nf_get_var_int1 nf_get_var_int1_
+#define nf_get_var_text nf_get_var_text_
+#define nf_get_vara_int1 nf_get_vara_int1_
+#define nf_get_vara_int nf_get_vara_int_
+#define nf_get_vara_int2 nf_get_vara_int2_
+#define nf_get_vara_double nf_get_vara_double_
+#define nf_get_var_double nf_get_var_double_
+#define nf_get_varm_int nf_get_varm_int_
+#define nf_get_varm_double nf_get_varm_double_
+#define nf_get_varm_int2 nf_get_varm_int2_
+#define nf_get_vars_double nf_get_vars_double_
+#define nf_get_varm_text nf_get_varm_text_
+#define nf_get_varm_real nf_get_varm_real_
+#define nf_get_varm_int1 nf_get_varm_int1_
+#define nf_get_vara_text nf_get_vara_text_
+#define nf_get_vars_text nf_get_vars_text_
+#define nf_get_vars_real nf_get_vars_real_
+#define nf_get_vars_int2 nf_get_vars_int2_
+#define nf_get_vars_int1 nf_get_vars_int1_
+#define nf_inq_att nf_inq_att_
+#define nf_inq_attid nf_inq_attid_
+#define nf_inq nf_inq_
+#define nf_inq_atttype nf_inq_atttype_
+#define nf_inq_attname nf_inq_attname_
+#define nf_inq_dimlen nf_inq_dimlen_
+#define nf_inq_dimid nf_inq_dimid_
+#define nf_inq_libvers nf_inq_libvers_
+#define nf_inq_format nf_inq_format_
+#define nf_inq_dimname nf_inq_dimname_
+#define nf_inq_dim nf_inq_dim_
+#define nf_inq_base_pe nf_inq_base_pe_
+#define nf_inq_ndims nf_inq_ndims_
+#define nf_inq_unlimdim nf_inq_unlimdim_
+#define nf_inq_nvars nf_inq_nvars_
+#define nf_inq_var nf_inq_var_
+#define nf_inq_natts nf_inq_natts_
+#define nf_inq_varid nf_inq_varid_
+#define nf_inq_varname nf_inq_varname_
+#define nf_inq_varnatts nf_inq_varnatts_
+#define nf_inq_vardimid nf_inq_vardimid_
+#define nf_inq_attlen nf_inq_attlen_
+#define nf_get_vars_int nf_get_vars_int_
+#define nf_get_vara_real nf_get_vara_real_
+#define nf_inq_vartype nf_inq_vartype_
+#define nf_issyserr nf_issyserr_
+#define nf_open nf_open_
+#define nf_put_att_int1 nf_put_att_int1_
+#define nf_put_att_int2 nf_put_att_int2_
+#define nf_put_att_text nf_put_att_text_
+#define nf_put_var1_int nf_put_var1_int_
+#define nf_put_var1_int1 nf_put_var1_int1_
+#define nf_put_var1_double nf_put_var1_double_
+#define nf_put_var1_int2 nf_put_var1_int2_
+#define nf_put_var1_real nf_put_var1_real_
+#define nf_put_att_real nf_put_att_real_
+#define nf_put_var1_text nf_put_var1_text_
+#define nf_put_att_int nf_put_att_int_
+#define nf_put_att_double nf_put_att_double_
+#define nf_put_var_double nf_put_var_double_
+#define nf_put_var_int2 nf_put_var_int2_
+#define nf_put_var_int1 nf_put_var_int1_
+#define nf_put_var_real nf_put_var_real_
+#define nf_put_var_int nf_put_var_int_
+#define nf_inq_varndims nf_inq_varndims_
+#define nf_put_vara_int1 nf_put_vara_int1_
+#define nf_put_vara_text nf_put_vara_text_
+#define nf_put_vara_real nf_put_vara_real_
+#define nf_put_varm_int nf_put_varm_int_
+#define nf_put_varm_double nf_put_varm_double_
+#define nf_put_vara_int2 nf_put_vara_int2_
+#define nf_put_varm_int1 nf_put_varm_int1_
+#define nf_put_varm_real nf_put_varm_real_
+#define nf_put_varm_text nf_put_varm_text_
+#define nf_put_vars_int1 nf_put_vars_int1_
+#define nf_put_vars_int nf_put_vars_int_
+#define nf_put_vars_real nf_put_vars_real_
+#define nf_put_vars_int2 nf_put_vars_int2_
+#define nf_put_vars_text nf_put_vars_text_
+#define nf_put_vars_double nf_put_vars_double_
+#define nf_put_varm_int2 nf_put_varm_int2_
+#define nf_rename_dim nf_rename_dim_
+#define nf_rename_att nf_rename_att_
+#define nf_redef nf_redef_
+#define nf_set_base_pe nf_set_base_pe_
+#define nf_set_default_format nf_set_default_format_
+#define nf_rename_var nf_rename_var_
+#define nf_put_vara_int nf_put_vara_int_
+#define nf_strerror nf_strerror_
+#define nf_set_fill nf_set_fill_
+#define nf_put_var_text nf_put_var_text_
+        
+#define NF_GET_VARM_DOUBLE NF_GET_VARM_DOUBLE_
+#define NF_GET_VARA_TEXT NF_GET_VARA_TEXT_
+#define NF_GET_VARA_REAL NF_GET_VARA_REAL_
+#define NF_GET_VARM_INT1 NF_GET_VARM_INT1_
+#define NF_GET_VARM_INT2 NF_GET_VARM_INT2_
+#define NF_GET_VARM_TEXT NF_GET_VARM_TEXT_
+#define NF_GET_VARM_REAL NF_GET_VARM_REAL_
+#define NF_GET_VARS_INT1 NF_GET_VARS_INT1_
+#define NF_GET_VARS_INT NF_GET_VARS_INT_
+#define NF_GET_VARS_DOUBLE NF_GET_VARS_DOUBLE_
+#define NF_GET_VARS_TEXT NF_GET_VARS_TEXT_
+#define NF_INQ_ATT NF_INQ_ATT_
+#define NF_INQ_ATTID NF_INQ_ATTID_
+#define NF_INQ_ATTTYPE NF_INQ_ATTTYPE_
+#define NF_INQ_ATTNAME NF_INQ_ATTNAME_
+#define NF_INQ_ATTLEN NF_INQ_ATTLEN_
+#define NF_INQ NF_INQ_
+#define NF_INQ_DIM NF_INQ_DIM_
+#define NF_INQ_DIMLEN NF_INQ_DIMLEN_
+#define NF_INQ_DIMID NF_INQ_DIMID_
+#define NF_INQ_LIBVERS NF_INQ_LIBVERS_
+#define NF_INQ_FORMAT NF_INQ_FORMAT_
+#define NF_INQ_NATTS NF_INQ_NATTS_
+#define NF_INQ_DIMNAME NF_INQ_DIMNAME_
+#define NF_INQ_BASE_PE NF_INQ_BASE_PE_
+#define NF_GET_VARS_REAL NF_GET_VARS_REAL_
+#define NF_INQ_NVARS NF_INQ_NVARS_
+#define NF_INQ_NDIMS NF_INQ_NDIMS_
+#define NF_GET_VARS_INT2 NF_GET_VARS_INT2_
+#define NF_INQ_VAR NF_INQ_VAR_
+#define NF_INQ_VARDIMID NF_INQ_VARDIMID_
+#define NF_INQ_VARID NF_INQ_VARID_
+#define NF_INQ_VARNATTS NF_INQ_VARNATTS_
+#define NF_INQ_VARNDIMS NF_INQ_VARNDIMS_
+#define NF_INQ_VARTYPE NF_INQ_VARTYPE_
+#define NF_INQ_VARNAME NF_INQ_VARNAME_
+#define NF_ISSYSERR NF_ISSYSERR_
+#define NF_PUT_ATT_DOUBLE NF_PUT_ATT_DOUBLE_
+#define NF_OPEN NF_OPEN_
+#define NF_PUT_ATT_INT1 NF_PUT_ATT_INT1_
+#define NF_PUT_ATT_INT NF_PUT_ATT_INT_
+#define NF_PUT_ATT_TEXT NF_PUT_ATT_TEXT_
+#define NF_PUT_ATT_REAL NF_PUT_ATT_REAL_
+#define NF_PUT_ATT_INT2 NF_PUT_ATT_INT2_
+#define NF_INQ_UNLIMDIM NF_INQ_UNLIMDIM_
+#define NF_GET_VARM_INT NF_GET_VARM_INT_
+#define NF_PUT_VAR1_INT NF_PUT_VAR1_INT_
+#define NF_PUT_VAR1_INT2 NF_PUT_VAR1_INT2_
+#define NF_PUT_VAR1_INT1 NF_PUT_VAR1_INT1_
+#define NF_PUT_VAR1_TEXT NF_PUT_VAR1_TEXT_
+#define NF_PUT_VAR_INT NF_PUT_VAR_INT_
+#define NF_PUT_VAR_DOUBLE NF_PUT_VAR_DOUBLE_
+#define NF_PUT_VAR1_REAL NF_PUT_VAR1_REAL_
+#define NF_PUT_VAR_REAL NF_PUT_VAR_REAL_
+#define NF_PUT_VARA_INT2 NF_PUT_VARA_INT2_
+#define NF_PUT_VARA_INT1 NF_PUT_VARA_INT1_
+#define NF_PUT_VARA_INT NF_PUT_VARA_INT_
+#define NF_PUT_VARA_DOUBLE NF_PUT_VARA_DOUBLE_
+#define NF_PUT_VARA_TEXT NF_PUT_VARA_TEXT_
+#define NF_PUT_VARM_INT1 NF_PUT_VARM_INT1_
+#define NF_PUT_VARM_INT2 NF_PUT_VARM_INT2_
+#define NF_PUT_VARM_INT NF_PUT_VARM_INT_
+#define NF_PUT_VARM_DOUBLE NF_PUT_VARM_DOUBLE_
+#define NF_PUT_VARM_REAL NF_PUT_VARM_REAL_
+#define NF_PUT_VARA_REAL NF_PUT_VARA_REAL_
+#define NF_PUT_VAR_TEXT NF_PUT_VAR_TEXT_
+#define NF_PUT_VAR_INT2 NF_PUT_VAR_INT2_
+#define NF_PUT_VAR_INT1 NF_PUT_VAR_INT1_
+#define NF_PUT_VARS_DOUBLE NF_PUT_VARS_DOUBLE_
+#define NF_PUT_VARM_TEXT NF_PUT_VARM_TEXT_
+#define NF_PUT_VAR1_DOUBLE NF_PUT_VAR1_DOUBLE_
+#define NF_PUT_VARS_INT1 NF_PUT_VARS_INT1_
+#define NF_PUT_VARS_INT2 NF_PUT_VARS_INT2_
+#define NF_PUT_VARS_TEXT NF_PUT_VARS_TEXT_
+#define NF_PUT_VARS_REAL NF_PUT_VARS_REAL_
+#define NF_RENAME_ATT NF_RENAME_ATT_
+#define NF_SET_BASE_PE NF_SET_BASE_PE_
+#define NF_RENAME_VAR NF_RENAME_VAR_
+#define NF_RENAME_DIM NF_RENAME_DIM_
+#define NF_REDEF NF_REDEF_
+#define NF_SYNC NF_SYNC_
+#define NF_STRERROR NF_STRERROR_
+#define NF_SET_FILL NF_SET_FILL_
+#define NF_SET_DEFAULT_FORMAT NF_SET_DEFAULT_FORMAT_
+#define NF_PUT_VARS_INT NF_PUT_VARS_INT_
+#define NF_GET_VAR_INT2 NF_GET_VAR_INT2_
+#define NF__CREATE_MP NF__CREATE_MP_
+#define NF__OPEN NF__OPEN_
+#define NF__OPEN_MP NF__OPEN_MP_
+#define NF__ENDDEF NF__ENDDEF_
+#define NF_ABORT NF_ABORT_
+#define NF__CREATE NF__CREATE_
+#define NF_COPY_ATT NF_COPY_ATT_
+#define NF_CREATE NF_CREATE_
+#define NF_DEF_DIM NF_DEF_DIM_
+#define NF_COPY_VAR NF_COPY_VAR_
+#define NF_CLOSE NF_CLOSE_
+#define NF_DEL_ATT NF_DEL_ATT_
+#define NF_DELETE NF_DELETE_
+#define NF_DEF_VAR NF_DEF_VAR_
+#define NF_ENDDEF NF_ENDDEF_
+#define NF_GET_ATT_REAL NF_GET_ATT_REAL_
+#define NF_GET_ATT_DOUBLE NF_GET_ATT_DOUBLE_
+#define NF_GET_ATT_INT NF_GET_ATT_INT_
+#define NF_GET_ATT_INT2 NF_GET_ATT_INT2_
+#define NF_GET_ATT_INT1 NF_GET_ATT_INT1_
+#define NF_GET_ATT_TEXT NF_GET_ATT_TEXT_
+#define NF_GET_VAR1_INT NF_GET_VAR1_INT_
+#define NF_GET_VAR1_INT1 NF_GET_VAR1_INT1_
+#define NF_GET_VAR1_TEXT NF_GET_VAR1_TEXT_
+#define NF_GET_VAR1_REAL NF_GET_VAR1_REAL_
+#define NF_GET_VAR1_INT2 NF_GET_VAR1_INT2_
+#define NF_GET_VAR1_DOUBLE NF_GET_VAR1_DOUBLE_
+#define NF_GET_VAR_INT NF_GET_VAR_INT_
+#define NF_GET_VAR_INT2 NF_GET_VAR_INT2_
+#define NF_GET_VAR_REAL NF_GET_VAR_REAL_
+#define NF_GET_VAR_INT1 NF_GET_VAR_INT1_
+#define NF_GET_VAR_TEXT NF_GET_VAR_TEXT_
+#define NF_GET_VARA_INT1 NF_GET_VARA_INT1_
+#define NF_GET_VARA_INT NF_GET_VARA_INT_
+#define NF_GET_VARA_INT2 NF_GET_VARA_INT2_
+#define NF_GET_VARA_DOUBLE NF_GET_VARA_DOUBLE_
+#define NF_GET_VAR_DOUBLE NF_GET_VAR_DOUBLE_
+#define NF_GET_VARM_INT NF_GET_VARM_INT_
+#define NF_GET_VARM_DOUBLE NF_GET_VARM_DOUBLE_
+#define NF_GET_VARM_INT2 NF_GET_VARM_INT2_
+#define NF_GET_VARS_DOUBLE NF_GET_VARS_DOUBLE_
+#define NF_GET_VARM_TEXT NF_GET_VARM_TEXT_
+#define NF_GET_VARM_REAL NF_GET_VARM_REAL_
+#define NF_GET_VARM_INT1 NF_GET_VARM_INT1_
+#define NF_GET_VARA_TEXT NF_GET_VARA_TEXT_
+#define NF_GET_VARS_TEXT NF_GET_VARS_TEXT_
+#define NF_GET_VARS_REAL NF_GET_VARS_REAL_
+#define NF_GET_VARS_INT2 NF_GET_VARS_INT2_
+#define NF_GET_VARS_INT1 NF_GET_VARS_INT1_
+#define NF_INQ_ATT NF_INQ_ATT_
+#define NF_INQ_ATTID NF_INQ_ATTID_
+#define NF_INQ NF_INQ_
+#define NF_INQ_ATTTYPE NF_INQ_ATTTYPE_
+#define NF_INQ_ATTNAME NF_INQ_ATTNAME_
+#define NF_INQ_DIMLEN NF_INQ_DIMLEN_
+#define NF_INQ_DIMID NF_INQ_DIMID_
+#define NF_INQ_LIBVERS NF_INQ_LIBVERS_
+#define NF_INQ_FORMAT NF_INQ_FORMAT_
+#define NF_INQ_DIMNAME NF_INQ_DIMNAME_
+#define NF_INQ_DIM NF_INQ_DIM_
+#define NF_INQ_BASE_PE NF_INQ_BASE_PE_
+#define NF_INQ_NDIMS NF_INQ_NDIMS_
+#define NF_INQ_UNLIMDIM NF_INQ_UNLIMDIM_
+#define NF_INQ_NVARS NF_INQ_NVARS_
+#define NF_INQ_VAR NF_INQ_VAR_
+#define NF_INQ_NATTS NF_INQ_NATTS_
+#define NF_INQ_VARID NF_INQ_VARID_
+#define NF_INQ_VARNAME NF_INQ_VARNAME_
+#define NF_INQ_VARNATTS NF_INQ_VARNATTS_
+#define NF_INQ_VARDIMID NF_INQ_VARDIMID_
+#define NF_INQ_ATTLEN NF_INQ_ATTLEN_
+#define NF_GET_VARS_INT NF_GET_VARS_INT_
+#define NF_GET_VARA_REAL NF_GET_VARA_REAL_
+#define NF_INQ_VARTYPE NF_INQ_VARTYPE_
+#define NF_ISSYSERR NF_ISSYSERR_
+#define NF_OPEN NF_OPEN_
+#define NF_PUT_ATT_INT1 NF_PUT_ATT_INT1_
+#define NF_PUT_ATT_INT2 NF_PUT_ATT_INT2_
+#define NF_PUT_ATT_TEXT NF_PUT_ATT_TEXT_
+#define NF_PUT_VAR1_INT NF_PUT_VAR1_INT_
+#define NF_PUT_VAR1_INT1 NF_PUT_VAR1_INT1_
+#define NF_PUT_VAR1_DOUBLE NF_PUT_VAR1_DOUBLE_
+#define NF_PUT_VAR1_INT2 NF_PUT_VAR1_INT2_
+#define NF_PUT_VAR1_REAL NF_PUT_VAR1_REAL_
+#define NF_PUT_ATT_REAL NF_PUT_ATT_REAL_
+#define NF_PUT_VAR1_TEXT NF_PUT_VAR1_TEXT_
+#define NF_PUT_ATT_INT NF_PUT_ATT_INT_
+#define NF_PUT_ATT_DOUBLE NF_PUT_ATT_DOUBLE_
+#define NF_PUT_VAR_DOUBLE NF_PUT_VAR_DOUBLE_
+#define NF_PUT_VAR_INT2 NF_PUT_VAR_INT2_
+#define NF_PUT_VAR_INT1 NF_PUT_VAR_INT1_
+#define NF_PUT_VAR_REAL NF_PUT_VAR_REAL_
+#define NF_PUT_VAR_INT NF_PUT_VAR_INT_
+#define NF_INQ_VARNDIMS NF_INQ_VARNDIMS_
+#define NF_PUT_VARA_INT1 NF_PUT_VARA_INT1_
+#define NF_PUT_VARA_TEXT NF_PUT_VARA_TEXT_
+#define NF_PUT_VARA_REAL NF_PUT_VARA_REAL_
+#define NF_PUT_VARM_INT NF_PUT_VARM_INT_
+#define NF_PUT_VARM_DOUBLE NF_PUT_VARM_DOUBLE_
+#define NF_PUT_VARA_INT2 NF_PUT_VARA_INT2_
+#define NF_PUT_VARM_INT1 NF_PUT_VARM_INT1_
+#define NF_PUT_VARM_REAL NF_PUT_VARM_REAL_
+#define NF_PUT_VARM_TEXT NF_PUT_VARM_TEXT_
+#define NF_PUT_VARS_INT1 NF_PUT_VARS_INT1_
+#define NF_PUT_VARS_INT NF_PUT_VARS_INT_
+#define NF_PUT_VARS_REAL NF_PUT_VARS_REAL_
+#define NF_PUT_VARS_INT2 NF_PUT_VARS_INT2_
+#define NF_PUT_VARS_TEXT NF_PUT_VARS_TEXT_
+#define NF_PUT_VARS_DOUBLE NF_PUT_VARS_DOUBLE_
+#define NF_PUT_VARM_INT2 NF_PUT_VARM_INT2_
+#define NF_RENAME_DIM NF_RENAME_DIM_
+#define NF_RENAME_ATT NF_RENAME_ATT_
+#define NF_REDEF NF_REDEF_
+#define NF_SET_BASE_PE NF_SET_BASE_PE_
+#define NF_SET_DEFAULT_FORMAT NF_SET_DEFAULT_FORMAT_
+#define NF_RENAME_VAR NF_RENAME_VAR_
+#define NF_PUT_VARA_INT NF_PUT_VARA_INT_
+#define NF_STRERROR NF_STRERROR_
+#define NF_SET_FILL NF_SET_FILL_
+#define NF_PUT_VAR_TEXT NF_PUT_VAR_TEXT_
+
+#endif
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/timer.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/timer.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/timer.f90	(revision 5166)
@@ -0,0 +1,177 @@
+! Timer functions to calculate MPI use speed up.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE timer
+
+  USE mod_orchidee_para_var, ONLY : numout
+  
+  INTEGER, PARAMETER :: nb_timer=2
+  INTEGER, PARAMETER :: timer_global=1
+  INTEGER, PARAMETER :: timer_mpi=2
+  INTEGER, PARAMETER :: stopped = 1
+  INTEGER, PARAMETER :: running = 2
+  INTEGER, PARAMETER :: suspended = 3
+  
+  DOUBLE PRECISION, DIMENSION(nb_timer),SAVE :: cpu_timer
+  DOUBLE PRECISION, DIMENSION(nb_timer),SAVE :: real_timer
+  INTEGER, DIMENSION(nb_timer),SAVE :: timer_state
+  DOUBLE PRECISION, DIMENSION(nb_timer),SAVE :: last_cpu_time
+  INTEGER, DIMENSION(nb_timer),SAVE :: last_real_time
+  
+  
+  
+  
+  CONTAINS
+  
+  SUBROUTINE init_timer
+  IMPLICIT NONE
+    
+    cpu_timer(:)=0.
+    real_timer(:)=0.
+    timer_state(:)=stopped
+    last_cpu_time(:)=0.
+    last_real_time(:)=0
+    
+  END SUBROUTINE init_timer
+  
+  
+  SUBROUTINE start_timer(no_timer)
+  IMPLICIT NONE
+     INTEGER :: no_timer
+     DOUBLE PRECISION :: x
+     
+     IF (timer_state(no_timer)/=stopped) THEN
+       STOP 'start_timer :: timer is already running or suspended'
+     ELSE
+        timer_state(no_timer)=running
+     ENDIF
+      
+     cpu_timer(no_timer)=0. 
+     real_timer(no_timer)=0.
+     x=Diff_real_time(no_timer)
+     x=Diff_cpu_time(no_timer)
+     
+  END SUBROUTINE start_timer
+  
+  
+  
+  SUBROUTINE stop_timer(no_timer)
+  IMPLICIT NONE
+    INTEGER :: no_timer
+    
+     IF (timer_state(no_timer)==running) THEN
+        CALL suspend_timer(no_timer)
+     ELSE IF (timer_state(no_timer)==stopped) THEN
+       WRITE(numout,*) 'stop_timer :: timer is already stopped'
+     ENDIF
+
+     timer_state(no_timer)=stopped
+
+  END SUBROUTINE stop_timer
+  
+  
+  
+  SUBROUTINE resume_timer(no_timer)
+  IMPLICIT NONE
+    INTEGER :: no_timer
+    DOUBLE PRECISION :: x
+     IF (timer_state(no_timer)/=suspended) THEN
+       STOP 'resume_timer :: timer is not suspended'
+     ELSE
+        timer_state(no_timer)=running
+     ENDIF
+  
+     x=Diff_cpu_time(no_timer)
+     x=Diff_real_time(no_timer)  
+  
+  END SUBROUTINE resume_timer
+  
+  
+  
+  SUBROUTINE suspend_timer(no_timer)
+  
+    IMPLICIT NONE
+    INTEGER :: no_timer
+    
+     IF (timer_state(no_timer)/=running) THEN
+       STOP 'suspend_timer :: timer is not running'
+     ELSE
+        timer_state(no_timer)=suspended
+     ENDIF
+  
+     cpu_timer(no_timer)=cpu_timer(no_timer)+Diff_cpu_time(no_timer)
+     real_timer(no_timer)=real_timer(no_timer)+Diff_real_time(no_timer)
+  
+  END SUBROUTINE suspend_timer
+  
+  
+  FUNCTION diff_real_time(no_timer)
+  IMPLICIT NONE
+    INTEGER :: no_timer
+    DOUBLE PRECISION :: Diff_real_Time
+    integer :: Last_Count,count,count_rate,count_max
+    
+    Last_Count=Last_real_time(no_timer)
+    
+    call system_clock(count,count_rate,count_max)
+    if (Count>=Last_Count) then
+      Diff_real_time=(1.*(Count-last_Count))/count_rate
+    else
+      Diff_real_time=(1.*(Count-last_Count+Count_max))/count_rate
+    endif
+    Last_real_time(no_timer)=Count 
+    
+  END FUNCTION diff_real_time
+  
+  function Diff_Cpu_Time(no_timer)
+  implicit none
+    INTEGER :: no_timer
+    DOUBLE PRECISION :: Diff_Cpu_Time
+    DOUBLE PRECISION :: Last_Count,Count
+    
+    Last_Count=Last_cpu_time(no_timer)
+    
+    call cpu_time(Count)
+    Diff_Cpu_Time=Count-Last_Count
+    Last_cpu_time(no_timer)=Count 
+    
+  end function Diff_Cpu_Time
+  
+  FUNCTION Get_cpu_time(no_timer)
+  IMPLICIT NONE
+  INTEGER :: no_timer
+  DOUBLE PRECISION :: Get_cpu_time
+  
+    IF (timer_state(no_timer)==running) THEN
+      CALL suspend_timer(no_timer)
+      Get_cpu_time=cpu_timer(no_timer)
+      CALL resume_timer(no_timer)
+    ELSE
+      Get_cpu_time=cpu_timer(no_timer)
+    ENDIF
+    
+  END FUNCTION Get_cpu_time
+  
+  FUNCTION Get_real_time(no_timer)
+  IMPLICIT NONE
+  INTEGER :: no_timer
+  DOUBLE PRECISION :: Get_real_time
+  
+    IF (timer_state(no_timer)==running) THEN
+      CALL suspend_timer(no_timer)
+      Get_real_time=real_timer(no_timer)
+      CALL resume_timer(no_timer)
+    ELSE
+      Get_real_time=real_timer(no_timer)
+    ENDIF
+  
+  END FUNCTION Get_real_time
+  
+END MODULE Timer
+  
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/tools_para.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/tools_para.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/tools_para.f90	(revision 5166)
@@ -0,0 +1,24 @@
+! Obsolete parallel tools : Barrier
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE tools_para
+!-
+  USE mod_orchidee_para_var, ONLY : MPI_COMM_ORCH
+!-
+#include "src_parallel.h"
+!-
+CONTAINS
+
+  SUBROUTINE barrier_para()
+#ifdef CPP_PARA
+    CALL MPI_BARRIER(MPI_COMM_ORCH,ierr)
+#endif
+  END SUBROUTINE barrier_para
+
+END MODULE tools_para
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/write_field.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/write_field.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/write_field.f90	(revision 5166)
@@ -0,0 +1,12 @@
+! Yann Meurdesoif module for sequentiel tests.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE Write_Field
+  USE Orch_Write_Field
+END MODULE Write_Field
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/write_field_p.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/write_field_p.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/write_field_p.f90	(revision 5166)
@@ -0,0 +1,12 @@
+! Yann Meurdesoif module for parallel tests.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE Write_field_p
+  USE Orch_Write_Field_p
+END MODULE Write_field_p
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/xios_orchidee.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/xios_orchidee.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parallel/xios_orchidee.f90	(revision 5166)
@@ -0,0 +1,774 @@
+! ================================================================================================================================
+!  MODULE       : xios_orchidee
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF   This module contains the initialization and interface to the XIOS code.
+!!
+!!\n DESCRIPTION: This module contains the interface for the use of the XIOS code. All call to XIOS are done in this module.
+!!
+!!                Summury of subroutines
+!!                      xios_orchidee_comm_init       : First call to XIOS to get the MPI communicator 
+!!                      xios_orchidee_init            : Initialize variables needed for use of XIOS 
+!!                                                      Deactivation of fields not calculated due specific run options
+!!                      xios_orchidee_update_calendar : Update the calandar in XIOS
+!!                      xios_orchidee_finalize        : Last call to XIOS for finalization
+!!                      xios_orchidee_send_field      : Interface to send fields with 1, 2 or 3 dimensions to XIOS
+!!                      xios_orchidee_send_field_r1d  : Internal subroutine for 1D(array) fields
+!!                      xios_orchidee_send_field_r2d  : Internal subroutine for 2D fields
+!!                      xios_orchidee_send_field_r3d  : Internal subroutine for 3D fields
+!!
+!!                It is possible to use XIOS1 or XIOS2. Note that compilation must be done with the preprocessing key XIOS 
+!!                and CPP_PARA for use with XIOS1. Preprocessing key XIOS, XIOS2 and CPP_PARA must be set for the use with XIOS2. 
+!!                Compiling without these keys makes it impossible to activate XIOS. 
+!!                To activate running using XIOS, the flag XIOS_ORCHIDEE_OK=y must be set in run.def and the file iodef.xml must exist.  
+!!
+!! RECENT CHANGE(S): Created by Arnaud Caubel(LSCE), Josefine Ghattas (IPSL) 2013
+!!
+!! REFERENCE(S) : None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE xios_orchidee
+
+#ifdef XIOS
+  USE xios
+#endif
+  USE defprec
+  USE pft_parameters_var, ONLY : nvm
+  USE constantes_var
+  USE constantes_soil_var, ONLY : nstm, check_waterbal, diaglev
+  USE vertical_soil_var, ONLY : ngrnd, nslm, nbdl
+  USE IOIPSL, ONLY : ioget_calendar, ju2ymds
+  USE mod_orchidee_para_var
+  USE mod_orchidee_transfert_para
+  USE ioipsl_para
+
+  IMPLICIT NONE
+  PRIVATE
+  PUBLIC :: xios_orchidee_comm_init, xios_orchidee_init, xios_orchidee_change_context, &
+            xios_orchidee_update_calendar, xios_orchidee_context_finalize, xios_orchidee_finalize, &
+            xios_orchidee_send_field
+
+  !
+  !! Declaration of public variables
+  !
+  LOGICAL, PUBLIC, SAVE           :: xios_orchidee_ok=.TRUE.     !! Use XIOS for diagnostic files
+  !$OMP THREADPRIVATE(xios_orchidee_ok)
+
+  !
+  !! Declaration of internal variables
+  !
+#ifdef XIOS
+  TYPE(xios_context)              :: ctx_hdl_orchidee      !! Handel for ORCHIDEE
+  !$OMP THREADPRIVATE(ctx_hdl_orchidee)
+#endif
+  CHARACTER(len=*),PARAMETER      :: id="client"           !! Id for initialization of ORCHIDEE in XIOS
+
+
+
+  !! ==============================================================================================================================
+  !! INTERFACE   : xios_orchidee_send_field
+  !!
+  !>\BRIEF         Send a field to XIOS.
+  !!
+  !! DESCRIPTION  :\n Send a field to XIOS. The field can have 1, 2 or 3 dimensions.
+  !!                  This interface should be called at each time-step for each output varaiables.
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  INTERFACE xios_orchidee_send_field
+     MODULE PROCEDURE xios_orchidee_send_field_r1d, xios_orchidee_send_field_r2d, xios_orchidee_send_field_r3d
+  END INTERFACE
+
+
+CONTAINS
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_comm_init 
+  !!
+  !>\BRIEF         Get the MPI communicator.
+  !!
+  !! DESCRIPTION  :\n First call to XIOS to get the MPI communicator. 
+  !!                  Note that it is XIOS that initialize the MPI communicator.
+  !!                  This subroutine is only called in ORCHIDEE offline mode. When running in coupled mode, the 
+  !!                  atmospheric model must initlialize XIOS at the same time as initializing MPI. 
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_comm_init(comm_local)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !!    Output variables
+    INTEGER, INTENT(OUT) :: comm_local
+
+    !_ ================================================================================================================================
+
+    IF (is_omp_root) THEN
+#ifdef XIOS
+       CALL xios_initialize(id,return_comm=comm_local)
+#else
+       ! Write error messages and stop the model
+       WRITE(numout,*) 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS'
+       WRITE(numout,*) 'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def'
+       WRITE(numout,*) 'Fatal error from ORCHIDEE. STOP in xios_orchidee_comm_init'
+#ifdef CPP_PARA
+       CALL MPI_ABORT(3)
+#endif     
+       STOP 1       
+#endif
+    
+    END IF
+  END SUBROUTINE xios_orchidee_comm_init
+
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_init 
+  !!
+  !>\BRIEF         Initialize variables needed for use of XIOS.
+  !!
+  !! DESCRIPTION  :\n Initialization of specific varaiables needed to use XIOS such as model domain and time step. 
+  !!
+  !!                  In this subroutine also a section containg deactivation of some fields is found. The variables are 
+  !!                  deactivated of not according to the corresponding control flag. For exemple the variables cacluated by the 
+  !!                  routing scheme will be deactivated if the routing is deactivated. This is done to be able to keep the same 
+  !!                  iodef.xml input file for several options without geting empty fields in the output file. Note that a field that
+  !!                  is activated in the code can always be deactivated from the iodef.xml external file. 
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_init(MPI_COMM_ORCH,               &
+       date0,    year,      month,             day,          &
+       lon_mpi,  lat_mpi,   soilth_lev )
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                            :: MPI_COMM_ORCH    !! Orchidee MPI communicator (from module mod_orchidee_mpi_data)
+    REAL(r_std), INTENT(in)                               :: date0            !! Julian day at first time step
+    INTEGER(i_std), INTENT(in)                            :: year, month, day !! Current date information
+    REAL(r_std),DIMENSION (iim_g,jj_nb), INTENT(in)       :: lon_mpi, lat_mpi !! Longitudes and latitudes on MPI local domain 2D domain
+    REAL(r_std),DIMENSION (ngrnd), INTENT(in)             :: soilth_lev       !! Vertical soil levels for thermal scheme (m)
+    !
+    !! 0.2 Local variables
+    !
+#ifdef XIOS
+
+# ifdef XIOS2
+    TYPE(xios_duration)            :: dtime_xios
+    TYPE(xios_date)                :: start_date
+    TYPE(xios_date)                :: time_origin
+# else
+    TYPE(xios_time)                :: dtime_xios
+# endif
+    TYPE(xios_fieldgroup)          :: fieldgroup_handle
+    TYPE(xios_field)               :: field_handle
+    TYPE(xios_file)                :: file_handle
+#endif
+    INTEGER(i_std)                 :: i
+    INTEGER(i_std)                 :: year0, month0, day0 !! Time origin date information
+    REAL(r_std)                    :: sec0                !! Time origin date information
+    CHARACTER(LEN=20)              :: calendar_str        !! Name of current calendar
+    CHARACTER(LEN=30)              :: start_str           !! Current date as character string
+    CHARACTER(LEN=30)              :: startorig_str       !! Time origin date as character string
+    !_ ================================================================================================================================
+    
+    
+    IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_init'
+
+    !Config Key   = XIOS_ORCHIDEE_OK
+    !Config Desc  = Use XIOS for writing diagnostics file
+    !Config If    = 
+    !Config Def   = y 
+    !Config Help  = Compiling and linking with XIOS library is necessary. 
+    !Config Units = [FLAG]
+    CALL getin_p('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
+    WRITE(numout,*)'In xios_orchidee_init, xios_orchidee_ok=',xios_orchidee_ok
+
+    ! Coherence test between flag and preprocessing key
+#ifndef XIOS
+    IF (xios_orchidee_ok) THEN
+       ! Write error messages and stop the model
+       WRITE(numout,*) 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS'
+       WRITE(numout,*) 'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def'
+       WRITE(numout,*) 'Fatal error from ORCHIDEE. STOP in xios_orchidee_init'
+#ifdef CPP_PARA
+       CALL MPI_ABORT(3)
+#endif     
+       STOP 1
+    END IF
+#endif
+
+
+    !
+    !! 1. Set date and calendar information on the format needed by XIOS
+    !
+
+    ! Get the calendar from IOIPSL and modify the string to correspond to what XIOS expects
+    CALL ioget_calendar(calendar_str)
+#ifdef XIOS2
+    IF (calendar_str == 'gregorian') THEN
+       calendar_str='gregorian'
+    ELSE IF (calendar_str == 'noleap') THEN
+       calendar_str='noleap'
+    ELSE IF (calendar_str == '360d') THEN
+       calendar_str='d360'
+    END IF
+#else
+    IF (calendar_str == 'gregorian') THEN
+       calendar_str='Gregorian'
+    ELSE IF (calendar_str == 'noleap') THEN
+       calendar_str='NoLeap'
+    ELSE IF (calendar_str == '360d') THEN
+       calendar_str='D360'
+    END IF
+#endif
+    ! Transform the time origin from julian days into year, month, day and seconds
+    CALL ju2ymds(date0, year0, month0, day0, sec0)
+
+
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+#ifdef XIOS
+       !
+       !! 2. Context initialization
+       !
+       CALL xios_context_initialize("orchidee",MPI_COMM_ORCH)
+       CALL xios_get_handle("orchidee",ctx_hdl_orchidee)
+       CALL xios_set_current_context(ctx_hdl_orchidee)
+
+       !
+       !! 2. Calendar, timstep and date definition
+       !
+       dtime_xios%second=dt_sechiba
+
+#ifdef XIOS2
+       CALL xios_define_calendar(type=calendar_str, start_date=xios_date(year,month,day,0,0,0), &
+            time_origin=xios_date(year0,month0,day0,0,0,0), timestep=dtime_xios)
+#else
+       ! Transform the current date into character string as XIOS need
+       WRITE(start_str,"(I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)") year,month,day,0,0,0
+
+       ! Transform the time origin date into character string as XIOS need
+       WRITE(startorig_str,"(I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)") year0,month0,day0,0,0,0
+       IF (printlev>=3) THEN
+       WRITE(numout,*) 'In xios_orchidee_init : calendar_str=', calendar_str
+       WRITE(numout,*) 'In xios_orchidee_init : start_date=',   start_str
+       WRITE(numout,*) 'In xios_orchidee_init : time_origin=',  startorig_str
+       END IF
+
+       CALL xios_set_context_attr("orchidee",calendar_type=calendar_str)
+       CALL xios_set_context_attr("orchidee",start_date=start_str)
+       CALL xios_set_context_attr("orchidee",time_origin=startorig_str)      !
+       CALL xios_set_timestep(dtime_xios) 
+#endif
+       !
+       !! 3. Domain definition
+       !
+       ! Global domain
+       CALL xios_set_domain_attr("domain_landpoints", ni_glo=iim_g, nj_glo=jjm_g)
+
+#ifdef XIOS2
+       ! Local MPI domain
+       CALL xios_set_domain_attr("domain_landpoints",type="rectilinear", ibegin=0, ni=iim_g, jbegin=jj_begin-1, nj=jj_nb)
+
+       ! Define how data is stored on memory : 1D array for only continental points
+       CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ibegin=0, data_ni=nbp_mpi)
+       CALL xios_set_domain_attr("domain_landpoints",data_ni=nbp_mpi, data_i_index=kindex_mpi-1)     
+
+       ! Define longitudes and latitudes on local MPI domain
+       CALL xios_set_domain_attr("domain_landpoints",lonvalue_1d=lon_mpi(:,1),latvalue_1d=lat_mpi(1,:))
+
+#else
+       ! Local MPI domain
+       CALL xios_set_domain_attr("domain_landpoints",ibegin=1, iend=iim_g, jbegin=jj_begin, jend=jj_end)
+
+       ! Define how data is stored on memory : 1D array for only continental points
+       CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ibegin=0, data_ni=nbp_mpi)
+       CALL xios_set_domain_attr("domain_landpoints",data_n_index=nbp_mpi, data_i_index=kindex_mpi)     
+
+       ! Define longitudes and latitudes on local MPI domain
+       CALL xios_set_domain_attr("domain_landpoints",lonvalue=lon_mpi(:,1),latvalue=lat_mpi(1,:))
+#endif
+       !
+       !! 4. Axis definition
+       !
+#ifdef XIOS2
+       CALL xios_set_axis_attr("nvm",n_glo=nvm ,VALUE=(/(REAL(i,r_std),i=1,nvm)/))
+       CALL xios_set_axis_attr("nlaip1", n_glo=nlai+1,VALUE=(/(REAL(i,r_std),i=1,nlai+1)/))
+       CALL xios_set_axis_attr("ngrnd",n_glo=ngrnd ,VALUE=soilth_lev(:))
+       CALL xios_set_axis_attr("nstm", n_glo=nstm,VALUE=(/(REAL(i,r_std),i=1,nstm)/))
+       CALL xios_set_axis_attr("nnobio", n_glo=nnobio,VALUE=(/(REAL(i,r_std),i=1,nnobio)/))
+       CALL xios_set_axis_attr("albtyp", n_glo=2,VALUE=(/(REAL(i,r_std),i=1,2)/))
+       CALL xios_set_axis_attr("nslm", n_glo=nslm,VALUE=(/(REAL(i,r_std),i=1,nslm)/))
+       CALL xios_set_axis_attr("nbdl", n_glo=nbdl,VALUE=diaglev(:))
+       CALL xios_set_axis_attr("nsnow", n_glo=nsnow,VALUE=(/(REAL(i,r_std),i=1,nsnow)/))
+       CALL xios_set_axis_attr("P10", n_glo=10,VALUE=(/(REAL(i,r_std), i=1,10)/))
+       CALL xios_set_axis_attr("P100", n_glo=100,VALUE=(/(REAL(i,r_std), i=1,100)/))
+       CALL xios_set_axis_attr("P11", n_glo=11,VALUE=(/(REAL(i,r_std), i=1,11)/))
+       CALL xios_set_axis_attr("P101", n_glo=101,VALUE=(/(REAL(i,r_std), i=1,101)/))
+#else
+       CALL xios_set_axis_attr("nvm",size=nvm ,VALUE=(/(REAL(i,r_std),i=1,nvm)/))
+       CALL xios_set_axis_attr("nlaip1", size=nlai+1,VALUE=(/(REAL(i,r_std),i=1,nlai+1)/))
+       CALL xios_set_axis_attr("ngrnd",size=ngrnd ,VALUE=soilth_lev(:))
+       CALL xios_set_axis_attr("nstm", size=nstm,VALUE=(/(REAL(i,r_std),i=1,nstm)/))
+       CALL xios_set_axis_attr("nnobio", size=nnobio,VALUE=(/(REAL(i,r_std),i=1,nnobio)/))
+       CALL xios_set_axis_attr("albtyp", size=2,VALUE=(/(REAL(i,r_std),i=1,2)/))
+       CALL xios_set_axis_attr("nslm", size=nslm,VALUE=(/(REAL(i,r_std),i=1,nslm)/))
+       CALL xios_set_axis_attr("nbdl", size=nbdl,VALUE=diaglev(:))
+       CALL xios_set_axis_attr("nsnow", size=nsnow,VALUE=(/(REAL(i,r_std),i=1,nsnow)/))
+       CALL xios_set_axis_attr("P10", size=10,VALUE=(/(REAL(i,r_std), i=1,10)/))
+       CALL xios_set_axis_attr("P100", size=100,VALUE=(/(REAL(i,r_std), i=1,100)/))
+       CALL xios_set_axis_attr("P11", size=11,VALUE=(/(REAL(i,r_std), i=1,11)/))
+       CALL xios_set_axis_attr("P101", size=101,VALUE=(/(REAL(i,r_std), i=1,101)/))
+#endif
+
+ 
+
+       !
+       !! 5. Deactivation of some fields if they are not calculated
+       !
+       IF ( .NOT. river_routing ) THEN
+          CALL xios_set_field_attr("basinmap",enabled=.FALSE.)
+          CALL xios_set_field_attr("nbrivers",enabled=.FALSE.)
+          CALL xios_set_field_attr("riversret",enabled=.FALSE.)
+          CALL xios_set_field_attr("hydrographs",enabled=.FALSE.)
+          CALL xios_set_field_attr("fastr",enabled=.FALSE.)
+          CALL xios_set_field_attr("slowr",enabled=.FALSE.)
+          CALL xios_set_field_attr("streamr",enabled=.FALSE.)
+          CALL xios_set_field_attr("lakevol",enabled=.FALSE.)
+          CALL xios_set_field_attr("pondr",enabled=.FALSE.)
+          CALL xios_set_field_attr("Qb",enabled=.FALSE.)
+       END IF
+
+
+       IF (hydrol_cwrr ) THEN
+          CALL xios_set_field_attr("dss",enabled=.FALSE.)
+          CALL xios_set_field_attr("gqsb",enabled=.FALSE.)
+          CALL xios_set_field_attr("bqsb",enabled=.FALSE.)
+          CALL xios_set_field_attr("rsol",enabled=.FALSE.)
+       ELSE
+          CALL xios_set_field_attr("twbr",enabled=.FALSE.)
+          CALL xios_set_field_attr("RootDist",enabled=.FALSE.)
+          CALL xios_set_field_attr("SoilThick",enabled=.FALSE.)
+          CALL xios_set_field_attr("SoilSat",enabled=.FALSE.)
+          CALL xios_set_field_attr("water2infilt",enabled=.FALSE.)
+          CALL xios_set_field_attr("CanopInt",enabled=.FALSE.)
+          CALL xios_set_field_attr("reinf_slope",enabled=.FALSE.)
+          CALL xios_set_field_attr("soilindex",enabled=.FALSE.)
+          CALL xios_set_field_attr("evapnu_soil",enabled=.FALSE.)
+          CALL xios_set_field_attr("drainage_soil",enabled=.FALSE.)
+          CALL xios_set_field_attr("transpir_soil",enabled=.FALSE.)
+          CALL xios_set_field_attr("runoff_soil",enabled=.FALSE.)
+          CALL xios_set_field_attr("humtot",enabled=.FALSE.)
+          CALL xios_set_field_attr("humtot_soil",enabled=.FALSE.)
+          CALL xios_set_field_attr("humtot_pro",enabled=.FALSE.)
+          CALL xios_set_field_attr("SWI",enabled=.FALSE.)
+          CALL xios_set_field_attr("njsc",enabled=.FALSE.)
+          CALL xios_set_field_attr("k_litt",enabled=.FALSE.)
+          CALL xios_set_field_attr("SoilMoist",enabled=.FALSE.)
+          CALL xios_set_field_attr("moistc_1",enabled=.FALSE.)
+          CALL xios_set_field_attr("moistc_2",enabled=.FALSE.)
+          CALL xios_set_field_attr("moistc_3",enabled=.FALSE.)
+          CALL xios_set_field_attr("kfactroot_1",enabled=.FALSE.)
+          CALL xios_set_field_attr("kfactroot_2",enabled=.FALSE.)
+          CALL xios_set_field_attr("kfactroot_3",enabled=.FALSE.)
+          CALL xios_set_field_attr("vegetsoil_1",enabled=.FALSE.)
+          CALL xios_set_field_attr("vegetsoil_2",enabled=.FALSE.)
+          CALL xios_set_field_attr("vegetsoil_3",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. do_floodplains ) THEN
+          CALL xios_set_field_attr("flood_frac",enabled=.FALSE.)
+          CALL xios_set_field_attr("reinfiltration",enabled=.FALSE.)
+          CALL xios_set_field_attr("floodmap",enabled=.FALSE.)
+          CALL xios_set_field_attr("floodh",enabled=.FALSE.)       
+          CALL xios_set_field_attr("floodr",enabled=.FALSE.)       
+          CALL xios_set_field_attr("floodout",enabled=.FALSE.)       
+          CALL xios_set_field_attr("evapflo",enabled=.FALSE.) 
+          CALL xios_set_field_attr("evapflo_alma",enabled=.FALSE.) 
+       END IF
+
+       ! Deactivate some stomate fields. 
+       ! These fields were traditionally added in sechiba_history.nc output file.
+       IF ( .NOT. ok_stomate ) THEN
+          CALL xios_set_field_attr("nee",enabled=.FALSE.)
+          CALL xios_set_field_attr("maint_resp",enabled=.FALSE.)
+          CALL xios_set_field_attr("hetero_resp",enabled=.FALSE.)
+          CALL xios_set_field_attr("growth_resp",enabled=.FALSE.)
+          CALL xios_set_field_attr("npp",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. do_irrigation ) THEN
+          CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
+          CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
+          CALL xios_set_field_attr("irrigation_alma",enabled=.FALSE.)
+          CALL xios_set_field_attr("netirrig_alma",enabled=.FALSE.)
+          CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_co2)THEN
+          CALL xios_set_field_attr("cimean",enabled=.FALSE.)
+          CALL xios_set_field_attr("cim",enabled=.FALSE.)
+          CALL xios_set_field_attr("gpp",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_bvoc)THEN
+          CALL xios_set_field_attr("PAR",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_fertil_no",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_iso",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_mono",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_ORVOC",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_MBO",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_methanol",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_acetone",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_acetal",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_formal",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_acetic",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_formic",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_no_soil",enabled=.FALSE.)
+          CALL xios_set_field_attr("flx_no",enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_apinen'   ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_bpinen'   ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_limonen'  ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_myrcen'   ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_sabinen'  ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_camphen'  ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_3caren'   ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_tbocimen' ,enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_othermono',enabled=.FALSE.)
+          CALL xios_set_field_attr('flx_sesquiter',enabled=.FALSE.)
+          CALL xios_set_field_attr("CRF",enabled=.FALSE.)
+          CALL xios_set_field_attr("fco2",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy ) THEN
+          CALL xios_set_field_attr("PARdf",enabled=.FALSE.)
+          CALL xios_set_field_attr("PARdr",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy .OR. .NOT. ok_multilayer ) THEN
+          CALL xios_set_field_attr( 'PARsuntab',enabled=.FALSE.)
+          CALL xios_set_field_attr( 'PARshtab' ,enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy .OR. ok_multilayer ) THEN
+          CALL xios_set_field_attr("PARsun",enabled=.FALSE.)
+          CALL xios_set_field_attr("PARsh",enabled=.FALSE.)
+          CALL xios_set_field_attr("laisun",enabled=.FALSE.)
+          CALL xios_set_field_attr("laish",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_bvoc .OR. .NOT. ok_bbgfertil_Nox) THEN
+          CALL xios_set_field_attr("flx_co2_bbg_year",enabled=.FALSE.)
+       END IF
+
+       IF ( .NOT. ok_bvoc .OR. .NOT. ok_cropsfertil_Nox) THEN
+          CALL xios_set_field_attr("N_qt_WRICE_year",enabled=.FALSE.)
+          CALL xios_set_field_attr("N_qt_OTHER_year",enabled=.FALSE.)
+       END IF
+
+       IF (.NOT. check_waterbal) THEN
+          CALL xios_set_field_attr("TotWater",enabled=.FALSE.)
+          CALL xios_set_field_attr("TotWaterFlux",enabled=.FALSE.)
+       END IF
+
+       IF (impaze) THEN
+          CALL xios_set_field_attr("soilalb_vis",enabled=.FALSE.)
+          CALL xios_set_field_attr("soilalb_nir",enabled=.FALSE.)
+          CALL xios_set_field_attr("vegalb_vis",enabled=.FALSE.)
+          CALL xios_set_field_attr("vegalb_nir",enabled=.FALSE.)
+       END IF
+
+       IF (ok_explicitsnow) THEN
+          ! The variable fusion is not calculated for ok_explicitsnow
+          CALL xios_set_field_attr("Qf",enabled=.FALSE.)
+       END IF
+       !
+       !! 6. Close context
+       !
+       CALL xios_close_context_definition()      
+
+
+       !
+       !! 7. Activate almaoutput if needed 
+       !! Some extra calculations have to be done for the variables tot_watsoil_end("RootMoist"), 
+       !! delsoilmoist("DelSoilMoist"), delintercept, delswe("DelSWE") and soilwet("SoilWet").
+       !! Set almaoutput=true if at least one of these variables are defined in an output file. 
+       !! If not, keep the initial value of almaoutput. 
+       !
+
+       IF (xios_field_is_active("RootMoist") .OR. xios_field_is_active("DelSoilMoist") .OR. &
+            xios_field_is_active("DelIntercept") .OR. xios_field_is_active("DelSWE") .OR. &
+            xios_field_is_active("SoilWet") .OR. xios_field_is_active("twbr")) THEN
+
+          almaoutput=.TRUE.
+          WRITE(numout,*) 'The flag almaoutput has been activated in xios_orchidee_init'
+       END IF
+#endif
+    END IF
+
+    IF (xios_orchidee_ok) THEN
+       ! Send variable almaoutput to all processes
+       CALL bcast(almaoutput)
+    END IF
+
+    IF (printlev>=3) WRITE(numout,*) 'Exit xios_orchidee_init'
+  END SUBROUTINE xios_orchidee_init
+
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_change_context
+  !!
+  !>\BRIEF         Use this subroutine to switch between different context.
+  !!               This subroutine must be called when running in coupled mode at each time ORCHIDEE is called, in the
+  !!               begining and end of intersurf_gathered. First call is done after xios_orchidee_init is done. 
+  !!
+  !! DESCRIPTION  :\n 
+  !!                  
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_change_context(new_context)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !!    Input variable
+    CHARACTER(LEN=*),INTENT(IN)              :: new_context
+
+    !! Local variables
+#ifdef XIOS
+    TYPE(xios_context) :: ctx_hdl
+#endif
+    !_ ================================================================================================================================
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+#ifdef XIOS
+       CALL xios_get_handle(new_context,ctx_hdl)
+       CALL xios_set_current_context(ctx_hdl)
+#endif
+    END IF
+    
+  END SUBROUTINE xios_orchidee_change_context
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_update_calendar
+  !!
+  !>\BRIEF          Update the calandar in XIOS.
+  !!
+  !! DESCRIPTION  :\n Update the calendar in XIOS : let XIOS know that ORCHIDEE avanced one time-step.
+  !!                  This subroutine should be called in the beginning of each time-step. The first 
+  !!                  time-step in a new execution should always start at 1. Therefore, first calculate
+  !!                  an offset that is substracted to the current time step in sechiba. 
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_update_calendar(itau_sechiba)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(IN) :: itau_sechiba    !! Current time step of the model
+    !
+    !! 0.2 Local variables
+    !
+    LOGICAL, SAVE         :: first=.TRUE.         !! Flag for first entering in subroutine
+    INTEGER(i_std), SAVE  :: offset               !! Offset to substract from itau_sechiba
+    INTEGER(i_std)        :: itau_xios            !! Current time step for XIOS
+
+    !_ ================================================================================================================================
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+#ifdef XIOS
+       ! Calculate the offset
+       IF (first) THEN
+          offset=itau_sechiba-1
+          first=.FALSE.
+       END IF
+
+       ! Substract the offset to the current time step in sechiba
+       itau_xios=itau_sechiba-offset
+
+       ! Send the new time step to XIOS
+       IF (printlev>=3) WRITE(numout,*) 'xios_orchidee_update_calendar: itau_sechiba, itau_xios=',itau_sechiba,itau_xios
+       CALL xios_update_calendar(itau_xios)
+#endif
+    END IF
+  END SUBROUTINE xios_orchidee_update_calendar
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_context_finalize
+  !!
+  !>\BRIEF         Finalize orchidee context.
+  !!
+  !! DESCRIPTION  :\n This subroutine finalizes the orchidee context without finalizing XIOS. In coupled mode, the atmospheric
+  !!                  modele must finalize XIOS. This subroutine is called in the end of the execution of ORCHIDEE only in 
+  !!                  coupeld mode.
+  !!                  
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_context_finalize
+
+    !_ ================================================================================================================================
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+       IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_context_finalize'
+#ifdef XIOS
+       CALL xios_context_finalize()
+#endif
+    END IF
+  END SUBROUTINE xios_orchidee_context_finalize
+
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_finalize
+  !!
+  !>\BRIEF         Last call to XIOS for finalization.
+  !!
+  !! DESCRIPTION  :\n Last call to XIOS for finalization of the orchidee context and XIOS.
+  !!                  This subroutine is called only when ORCHIDEE is run in offline mode. In coupled mode it is the atmospheric
+  !!                  model that finalizes XIOS. In that case, the context orchidee must be finalized using the 
+  !!                  subroutine xios_orchidee_context_finalize
+  !!                  
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_finalize
+
+    !_ ================================================================================================================================
+
+    IF (xios_orchidee_ok .AND. is_omp_root) THEN
+       IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_finalize'
+#ifdef XIOS
+       CALL xios_context_finalize()
+       CALL xios_finalize()
+#endif
+    END IF
+  END SUBROUTINE xios_orchidee_finalize
+
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_send_field_r1d
+  !!
+  !>\BRIEF          Subroutine for sending 1D (array) fields to XIOS.
+  !!
+  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 1D fields (array).
+  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_send_field_r1d(field_id,field)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    CHARACTER(len=*), INTENT(IN)          :: field_id
+    REAL(r_std), DIMENSION(:), INTENT(IN) :: field
+
+    !! 0.2 Local variables
+    REAL(r_std), DIMENSION(nbp_mpi) :: field_mpi
+
+    !_ ================================================================================================================================
+    IF (xios_orchidee_ok) THEN
+       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r1d, field_id=',field_id
+
+       ! Gather all omp domains on the mpi domains
+       CALL gather_omp(field, field_mpi)
+
+       ! All master threads send the field to XIOS
+       IF (is_omp_root) THEN
+#ifdef XIOS
+          CALL xios_send_field(field_id,field_mpi)
+#endif
+       END IF
+    END IF
+  END SUBROUTINE xios_orchidee_send_field_r1d
+
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_send_field_r2d
+  !!
+  !>\BRIEF          Subroutine for sending 2D fields to XIOS.
+  !!
+  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 2D fields.
+  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_send_field_r2d(field_id,field)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    CHARACTER(len=*), INTENT(IN)            :: field_id
+    REAL(r_std), DIMENSION(:,:), INTENT(IN) :: field
+
+    !! 0.2 Local variables
+    REAL(r_std), DIMENSION(nbp_mpi,size(field,2)) :: field_mpi
+
+    !_ ================================================================================================================================
+    IF (xios_orchidee_ok) THEN
+       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r2d, field_id=',field_id
+
+       ! Gather all omp domains on the mpi domains
+       CALL gather_omp(field, field_mpi)
+
+       ! All master threads send the field to XIOS
+       IF (is_omp_root) THEN
+#ifdef XIOS
+          CALL xios_send_field(field_id,field_mpi)
+#endif
+       END IF
+    END IF
+  END SUBROUTINE xios_orchidee_send_field_r2d
+
+
+  !! ==============================================================================================================================
+  !! SUBROUTINE   : xios_orchidee_send_field_r3d
+  !!
+  !>\BRIEF          Subroutine for sending 3D fields to XIOS. 
+  !!
+  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 3D fields.
+  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
+  !!
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE xios_orchidee_send_field_r3d(field_id,field)
+    !
+    !! 0. Variable and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    CHARACTER(len=*), INTENT(IN)              :: field_id
+    REAL(r_std), DIMENSION(:,:,:), INTENT(IN) :: field
+
+    !! 0.2 Local variables
+    REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3)) :: field_mpi
+
+    !_ ================================================================================================================================
+    IF (xios_orchidee_ok) THEN
+       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r3d, field_id=',field_id
+
+       ! Gather all omp domains on the mpi domains
+       CALL gather_omp(field, field_mpi)
+
+       ! All master threads send the field to XIOS
+       IF (is_omp_root) THEN
+#ifdef XIOS
+          CALL xios_send_field(field_id,field_mpi)
+#endif
+       END IF
+    END IF
+  END SUBROUTINE xios_orchidee_send_field_r3d
+ 
+END MODULE xios_orchidee
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/AA_make	(revision 5166)
@@ -0,0 +1,89 @@
+#-
+#- $Id$
+#-
+IOIPSL_LIB = $(LIBDIR)/libioipsl.a
+SXIOIPSL_LIB = $(IOIPSL_LIB)
+#-Q- sxnec SXIOIPSL_LIB = $(LIBDIR)/libsxioipsl.a
+#-Q- sx6nec SXIOIPSL_LIB = $(LIBDIR)/libsxioipsl.a
+#-Q- eshpux SXIOIPSL_LIB = $(LIBDIR)/libsxioipsl.a
+#-Q- sx8brodie SXIOIPSL_LIB = $(LIBDIR)/libsxioipsl.a
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec  SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+MODS1 = constantes.f90 \
+	constantes_var.f90   \
+	constantes_soil.f90   \
+	constantes_soil_var.f90   \
+	constantes_mtc.f90   \
+	control.f90        \
+	pft_parameters.f90 \
+	pft_parameters_var.f90 
+#
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libioipsl
+	$(M_K) libparallel
+	$(M_K) m_all
+	@echo parameter is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+
+libioipsl:
+	(cd ../../IOIPSL/src; $(M_K) -f Makefile)
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o): %.f90
+	$(F_C) $(F_O) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+
+config:
+	$(BINDIR)/Fparser -name PARAMETERS  $(MODS1)
+	echo 'Configuration of PARAMETERS done'
+ 
+clean:
+	$(RM) $(MODEL_LIB)
+ 
+$(MODEL_LIB)(pft_parameters.o): \
+  $(MODEL_LIB)(pft_parameters_var.o) \
+  $(MODEL_LIB)(constantes_mtc.o)
+$(MODEL_LIB)(constantes_soil.o): \
+  $(MODEL_LIB)(constantes_soil_var.o) \
+  $(MODEL_LIB)(constantes.o)
+$(MODEL_LIB)(control.o): \
+  $(MODEL_LIB)(constantes_soil.o) \
+  $(MODEL_LIB)(constantes_var.o)  \
+  $(MODEL_LIB)(pft_parameters.o)
+
+$(MODEL_LIB)(constantes.o): \
+  $(MODEL_LIB)(constantes_var.o) \
+  $(MODEL_LIB)(constantes_soil_var.o) \
+  $(PARALLEL_LIB) \
+  $(IOIPSL_LIB)
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/AA_make.ldef	(revision 5166)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a PARAMETER
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/libparameters.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxparameters.a
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes.f90	(revision 5166)
@@ -0,0 +1,2394 @@
+! =================================================================================================================================
+! MODULE       : constantes
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        "constantes" module contains subroutines to initialize most of the exernalized parameters. This module
+!!              also make a use to the module constantes_var where the parameters are declared.
+!!
+!!\n DESCRIPTION: This module contains subroutines to initialize most of the exernalized parameters. This module
+!!                also make a use to the module constantes_var where the parameters are declared.\n
+!!                This module can be used to acces the subroutines and the constantes. The constantes declarations
+!!                can also be used seperatly with "USE constantes_var".
+!!
+!! RECENT CHANGE(S): Didier Solyga : This module contains now all the externalized parameters of ORCHIDEE 
+!!                   listed by modules which are not pft-dependent  
+!!                   Josefine Ghattas 2013 : The declaration part has been extracted and moved to module constates_var
+!!
+!! REFERENCE(S)	: 
+!! - Louis, Jean-Francois (1979), A parametric model of vertical eddy fluxes in the atmosphere. 
+!! Boundary Layer Meteorology, 187-202.
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes
+
+  USE constantes_var
+  USE defprec
+  USE ioipsl_para, ONLY : getin_p, ipslerr_p
+  USE mod_orchidee_para, ONLY : numout
+
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : activate_sub_models
+!!
+!>\BRIEF         This subroutine reads the flags in the configuration file to
+!! activate some sub-models like routing, irrigation, fire, herbivory, ...  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE activate_sub_models()
+
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+     !! 0.4 Local variables
+
+     LOGICAL, SAVE ::  first_call = .TRUE.             !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+
+     IF (first_call) THEN 
+           
+        IF (ok_stomate) THEN
+
+           !Config Key   = HERBIVORES
+           !Config Desc  = herbivores allowed?
+           !Config If    = OK_STOMATE 
+           !Config Def   = n
+           !Config Help  = With this variable, you can determine
+           !Config         if herbivores are activated
+           !Config Units = [FLAG]
+           CALL getin_p('HERBIVORES', ok_herbivores)
+           !
+           !Config Key   = TREAT_EXPANSION
+           !Config Desc  = treat expansion of PFTs across a grid cell?
+           !Config If    = OK_STOMATE 
+           !Config Def   = n
+           !Config Help  = With this variable, you can determine
+           !Config         whether we treat expansion of PFTs across a
+           !Config         grid cell.
+           !Config Units = [FLAG]
+           CALL getin_p('TREAT_EXPANSION', treat_expansion)
+           
+           !Config Key   = LPJ_GAP_CONST_MORT
+           !Config Desc  = Constant mortality
+           !Config If    = OK_STOMATE AND NOT OK_DGVM
+           !Config Def   = y/n depending on OK_DGVM
+           !Config Help  = set to TRUE if constant mortality is to be activated
+           !Config         
+           !Config Units = [FLAG]
+
+           ! Set Default value different if DGVM is activated.
+           IF ( ok_dgvm ) THEN
+              lpj_gap_const_mort=.FALSE.
+           ELSE
+              lpj_gap_const_mort=.TRUE.
+           END IF
+           CALL getin_p('LPJ_GAP_CONST_MORT', lpj_gap_const_mort)
+
+           IF (ok_dgvm .AND. lpj_gap_const_mort) THEN
+              CALL ipslerr_p(1,"activate_sub_models","Both OK_DGVM and LPJ_GAP_CONST_MORT are activated.",&
+                   "This combination is possible but unusual","The simulation will continue with these flags activated." )
+           END IF
+
+           !Config Key   = HARVEST_AGRI
+           !Config Desc  = Harvest model for agricultural PFTs.
+           !Config If    = OK_STOMATE 
+           !Config Def   = y
+           !Config Help  = Compute harvest above ground biomass for agriculture.
+           !Config         Change daily turnover.
+           !Config Units = [FLAG]
+           CALL getin_p('HARVEST_AGRI', harvest_agri)
+           !
+           !Config Key   = FIRE_DISABLE
+           !Config Desc  = no fire allowed
+           !Config If    = OK_STOMATE 
+           !Config Def   = n
+           !Config Help  = With this variable, you can allow or not
+           !Config         the estimation of CO2 lost by fire
+           !Config Units = [FLAG]
+           CALL getin_p('FIRE_DISABLE', disable_fire)
+           !
+           !Config Key   = SPINUP_ANALYTIC
+           !Config Desc  = Activation of the analytic resolution of the spinup.
+           !Config If    = OK_STOMATE
+           !Config Def   = n
+           !Config Help  = Activate this option if you want to solve the spinup by the Gauss-Jordan method.
+           !Config Units = BOOLEAN    
+           CALL getin_p('SPINUP_ANALYTIC',spinup_analytic)
+           !
+           !Config Key   = MOIST_FUNC_MOYANO 
+           !Config Desc  = Activation the calculation of moisture control
+           !function on soil C decomposition based on Moyano et al., 2012 BG 
+           !Config If    = OK_STOMATE
+           !Config Def   = n 
+           !Config Help  = Activate this option if you want to calculate
+           !moisture control function on soil C decomposition based on Moyano et
+           !al., 2012 BG
+           !Config Units = BOOLEAN    
+           CALL getin_p('MOIST_FUNC_MOYANO',moist_func_Moyano)
+
+        ENDIF
+
+        !
+        ! Check consistency (see later)
+        !
+!!$        IF(.NOT.(ok_routing) .AND. (doirrigation .OR. dofloodplains)) THEN
+!!$           CALL ipslerr_p(2,'activate_sub_models', &
+!!$               &     'Problem :you tried to activate the irrigation and floodplains without activating the routing',&
+!!$               &     'Are you sure ?', &
+!!$               &     '(check your parameters).')
+!!$        ENDIF
+       
+!!$        IF(.NOT.(ok_stomate) .AND. (ok_herbivores .OR. treat_expansion .OR. lpj_gap_const_mort &
+!!$            & .OR. harvest_agri .OR. disable_fire)) THEN
+!!$          CALL ipslerr_p(2,'activate_sub_models', &
+!!$               &     'Problem : try to activate the following options : herbivory, treat_expansion, fire,',&
+!!$               &     'harvest_agri and constant mortality without stomate activated.',&
+!!$               &     '(check your parameters).')
+!!$        ENDIF
+            
+        first_call =.FALSE.
+
+     ENDIF
+
+   END SUBROUTINE activate_sub_models
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : veget_config
+!!
+!>\BRIEF         This subroutine reads the flags controlling the configuration for
+!! the vegetation : impose_veg, veget_mpa, lai_map, etc...       
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE veget_config
+
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+     !! 0.4 Local variables  
+
+     LOGICAL, SAVE ::  first_call = .TRUE.        !! To keep first call trace (true/false)  
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+     
+     IF (first_call) THEN 
+
+        !Config Key   = AGRICULTURE
+        !Config Desc  = agriculture allowed?
+        !Config If    = OK_SECHIBA or OK_STOMATE
+        !Config Def   = y
+        !Config Help  = With this variable, you can determine
+        !Config         whether agriculture is allowed
+        !Config Units = [FLAG]
+        CALL getin_p('AGRICULTURE', agriculture)
+        !
+        !Config Key   = IMPOSE_VEG
+        !Config Desc  = Should the vegetation be prescribed ?
+        !Config If    = OK_SECHIBA or OK_STOMATE
+        !Config Def   = n
+        !Config Help  = This flag allows the user to impose a vegetation distribution
+        !Config         and its characteristics. It is espacially interesting for 0D
+        !Config         simulations. On the globe it does not make too much sense as
+        !Config         it imposes the same vegetation everywhere
+        !Config Units = [FLAG]
+        CALL getin_p('IMPOSE_VEG', impveg)
+
+        IF (impveg) THEN
+           !Config Key   = IMPOSE_SOILT
+           !Config Desc  = Should the soil type be prescribed ?
+           !Config Def   = n
+           !Config If    = IMPOSE_VEG
+           !Config Help  = This flag allows the user to impose a soil type distribution.
+           !Config         It is espacially interesting for 0D
+           !Config         simulations. On the globe it does not make too much sense as
+           !Config         it imposes the same soil everywhere
+           !Config Units = [FLAG]
+           CALL getin_p('IMPOSE_SOILT', impsoilt)     
+        ENDIF
+
+        !Config Key   = LAI_MAP
+        !Config Desc  = Read the LAI map
+        !Config If    = OK_SECHIBA or OK_STOMATE
+        !Config Def   = n
+        !Config Help  = It is possible to read a 12 month LAI map which will
+        !Config         then be interpolated to daily values as needed.
+        !Config Units = [FLAG]
+        CALL getin_p('LAI_MAP',read_lai)
+
+        !Config Key   = MAP_PFT_FORMAT
+        !Config Desc  = Read a land use vegetation map on PFT format
+        !Config If    = OK_SECHIBA or OK_STOMATE
+        !Config Def   = y
+        !Config Help  = pft values are needed, max time axis is 293
+        !Config Units = [FLAG]
+        CALL getin_p('MAP_PFT_FORMAT',map_pft_format)
+
+        IF(map_pft_format) THEN
+           !Config Key   = VEGET_REINIT
+           !Config Desc  = booleen to indicate that a new LAND USE file will be used.
+           !Config If    = MAP_PFT_FORMAT
+           !Config Def   = y
+           !Config Help  = The parameter is used to bypass veget_year count 
+           !Config         and reinitialize it with VEGET_YEAR parameter.
+           !Config         Then it is possible to change LAND USE file.
+           !Config Units = [FLAG] 
+           CALL getin_p('VEGET_REINIT', veget_reinit)
+           !
+           !Config Key   = VEGET_YEAR
+           !Config Desc  = Year of the vegetation map to be read
+           !Config If    = MAP_PFT_FORMAT
+           !Config Def   = 1
+           !Config Help  = First year for land use vegetation (2D map by pft).
+           !Config         If VEGET_YEAR is set to 0, this means there is no time axis.
+           !Config Units = [FLAG] 
+           CALL getin_p('VEGET_YEAR', veget_year_orig)
+        ENDIF
+
+        first_call = .FALSE.
+
+     ENDIF
+
+!!$        ! DS : Add warning in case of a wrong configuration (need to be discussed)
+!!$        ! 4. 
+!!$        IF ( .NOT.(impveg) .AND. impsoilt) THEN
+!!$           CALL ipslerr_p(2,'veget_config', &
+!!$               &     'Problem : try to activate impose_soilt without activating impose_veg.',&
+!!$               &     'Are you sure ?', &
+!!$               &     '(check your parameters).')
+!!$        ENDIF
+!!$
+           
+   END SUBROUTINE veget_config
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : veget_config
+!!
+!>\BRIEF         This subroutine reads in the configuration file the imposed values of the parameters for all SECHIBA modules.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE config_sechiba_parameters
+
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+     !! 0.4 Local variables
+     
+     LOGICAL, SAVE ::  first_call = .TRUE.    !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+     
+     IF(first_call) THEN 
+        
+        ! Global : parameters used by many modules
+        !
+        !Config Key   = MAXMASS_SNOW
+        !Config Desc  = The maximum mass of a snow
+        !Config If    = OK_SECHIBA or HYDROL_CWRR
+        !Config Def   = 3000.
+        !Config Help  = 
+        !Config Units = [kg/m^2]  
+        CALL getin_p('MAXMASS_SNOW',maxmass_snow)
+        !
+        !Config Key   = SNOWCRI
+        !Config Desc  = Sets the amount above which only sublimation occures 
+        !Config If    = OK_SECHIBA or HYDROL_CWRR
+        !Config Def   = 1.5
+        !Config Help  = 
+        !Config Units = [kg/m^2]  
+        CALL getin_p('SNOWCRI',snowcri)
+        !
+        !! Initialization of sneige
+        sneige = snowcri/mille
+        !
+        !Config Key   = MIN_WIND
+        !Config Desc  = Minimum wind speed
+        !Config If    = OK_SECHIBA
+        !Config Def   = 0.1
+        !Config Help  = 
+        !Config Units = [m/s]
+        CALL getin_p('MIN_WIND',min_wind)
+        !
+        !Config Key   = MAX_SNOW_AGE
+        !Config Desc  = Maximum period of snow aging 
+        !Config If    = OK_SECHIBA
+        !Config Def   = 50.
+        !Config Help  = 
+        !Config Units = [days?]
+        CALL getin_p('MAX_SNOW_AGE',max_snow_age)
+        !
+        !Config Key   = SNOW_TRANS
+        !Config Desc  = Transformation time constant for snow
+        !Config If    = OK_SECHIBA
+        !Config Def   = 0.3
+        !Config Help  = 
+        !Config Units = [m]   
+        CALL getin_p('SNOW_TRANS',snow_trans)
+ 
+        !-
+        ! condveg
+        !-
+        !
+        !Config Key   = Z0_OVER_HEIGHT
+        !Config Desc  = to get z0 from height 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 1/16.
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('Z0_OVER_HEIGHT',z0_over_height)
+        !
+        !Config Key   = HEIGHT_DISPLACEMENT
+        !Config Desc  = Magic number which relates the height to the displacement height.
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.75
+        !Config Help  = 
+        !Config Units = [m]  
+        CALL getin_p('HEIGHT_DISPLACEMENT',height_displacement)
+        !
+        !Config Key   = Z0_BARE
+        !Config Desc  = bare soil roughness length
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.01 
+        !Config Help  = 
+        !Config Units = [m]   
+        CALL getin_p('Z0_BARE',z0_bare)
+        !
+        !Config Key   = Z0_ICE
+        !Config Desc  = ice roughness length
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.001
+        !Config Help  = 
+        !Config Units = [m]   
+        CALL getin_p('Z0_ICE',z0_ice)
+        !
+        !Config Key   = TCST_SNOWA
+        !Config Desc  = Time constant of the albedo decay of snow
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 5.0 
+        !Config Help  = 
+        !Config Units = [days]
+        CALL getin_p('TCST_SNOWA',tcst_snowa)
+        !
+        !Config Key   = SNOWCRI_ALB
+        !Config Desc  = Critical value for computation of snow albedo
+        !Config If    = OK_SECHIBA
+        !Config Def   = 10. 
+        !Config Help  = 
+        !Config Units = [cm]  
+        CALL getin_p('SNOWCRI_ALB',snowcri_alb)
+        !
+        !
+        !Config Key   = VIS_DRY
+        !Config Desc  = The correspondance table for the soil color numbers and their albedo 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.27
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('VIS_DRY',vis_dry)
+        !
+        !Config Key   = NIR_DRY
+        !Config Desc  = The correspondance table for the soil color numbers and their albedo 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.48, 0.44, 0.40, 0.36, 0.32, 0.28, 0.24, 0.20, 0.55
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('NIR_DRY',nir_dry)
+        !
+        !Config Key   = VIS_WET 
+        !Config Desc  = The correspondance table for the soil color numbers and their albedo
+        !Config If    = OK_SECHIBA  
+        !Config Def   = 0.12, 0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.15
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('VIS_WET',vis_wet)
+        !
+        !Config Key   = NIR_WET
+        !Config Desc  = The correspondance table for the soil color numbers and their albedo 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.31
+        !Config Help  = 
+        !Config Units = [-]    
+        CALL getin_p('NIR_WET',nir_wet)
+        !
+        !Config Key   = ALBSOIL_VIS
+        !Config Desc  = 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.18, 0.16, 0.16, 0.15, 0.12, 0.105, 0.09, 0.075, 0.25
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('ALBSOIL_VIS',albsoil_vis)
+        !
+        !Config Key   = ALBSOIL_NIR 
+        !Config Desc  = 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.36, 0.34, 0.34, 0.33, 0.30, 0.25, 0.20, 0.15, 0.45
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('ALBSOIL_NIR',albsoil_nir)
+        !-
+        !
+        !Config Key   = ALB_DEADLEAF 
+        !Config Desc  = albedo of dead leaves, VIS+NIR 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.12, 0.35
+        !Config Help  = 
+        !Config Units = [-]     
+        CALL getin_p('ALB_DEADLEAF',alb_deadleaf)
+        !
+        !Config Key   = ALB_ICE
+        !Config Desc  = albedo of ice, VIS+NIR
+        !Config If    = OK_SECHIBA
+        !Config Def   = 0.60, 0.20
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('ALB_ICE',alb_ice)
+        !
+        ! Get the fixed snow albedo if needed
+        !
+        !Config Key   = CONDVEG_SNOWA
+        !Config Desc  = The snow albedo used by SECHIBA
+        !Config Def   = 1.E+20
+        !Config if    = OK_SECHIBA
+        !Config Help  = This option allows the user to impose a snow albedo.
+        !Config         Default behaviour is to use the model of snow albedo
+        !Config         developed by Chalita (1993).
+        !Config Units = [-]
+        CALL getin_p('CONDVEG_SNOWA',fixed_snow_albedo)
+        !
+        !Config Key   = ALB_BARE_MODEL
+        !Config Desc  = Switch bare soil albedo dependent (if TRUE) on soil wetness
+        !Config Def   = n
+        !Config if    = OK_SECHIBA
+        !Config Help  = If TRUE, the model for bare soil albedo is the old formulation.
+        !Config         Then it depend on the soil dry or wetness. If FALSE, it is the 
+        !Config         new computation that is taken, it is the mean of soil albedo.
+        !Config Units = [FLAG]
+        CALL getin_p('ALB_BARE_MODEL',alb_bare_model)
+        !
+        !Config Key   = ALB_BG_MODIS
+        !Config Desc  = Read bare soil albedo from file with background MODIS data
+        !Config Def   = n
+        !Config if    = OK_SECHIBA
+        !Config Help  = If TRUE, the bare soil albedo is read from file
+        !Config         based on background MODIS data.  
+        !Config         If FALSE, computaion depends on ALB_BARE_MODEL
+        !Config Units = [FLAG]
+        CALL getin_p('ALB_BG_MODIS',alb_bg_modis)
+        !
+        !Config Key   = Z0CDRAG_AVE
+        !Config Desc  = Average method for z0
+        !Config Def   = y
+        !Config if    = OK_SECHIBA
+        !Config Help  = If this flag is set to true (y) then the neutral Cdrag
+        !Config         is averaged instead of the log(z0). This should be
+        !Config         the prefered option. We still wish to keep the other
+        !Config         option so we can come back if needed. If this is
+        !Config         desired then one should set Z0CDRAG_AVE=n
+        !Config Units = [FLAG]
+        CALL getin_p('Z0CDRAG_AVE',z0cdrag_ave)
+        !
+        !Config Key   = IMPOSE_AZE
+        !Config Desc  = Should the surface parameters be prescribed
+        !Config Def   = n
+        !Config if    = OK_SECHIBA
+        !Config Help  = This flag allows the user to impose the surface parameters
+        !Config         (Albedo Roughness and Emissivity). It is espacially interesting for 0D
+        !Config         simulations. On the globe it does not make too much sense as
+        !Config         it imposes the same vegetation everywhere
+        !Config Units = [FLAG]
+        CALL getin_p('IMPOSE_AZE',impaze)
+        !
+        IF(impaze) THEN
+           !
+           !Config Key   = CONDVEG_Z0
+           !Config Desc  = Surface roughness
+           !Config Def   = 0.15
+           !Config If    = IMPOSE_AZE
+           !Config Help  = Surface rougness to be used on the point if a 0-dim version
+           !Config         of SECHIBA is used. Look at the description of the forcing  
+           !Config         data for the correct value.
+           !Config Units = [m]
+           CALL getin_p('CONDVEG_Z0', z0_scal)  
+           !
+           !Config Key   = ROUGHHEIGHT
+           !Config Desc  = Height to be added to the height of the first level
+           !Config Def   = 0.0
+           !Config If    = IMPOSE_AZE
+           !Config Help  = ORCHIDEE assumes that the atmospheric level height is counted
+           !Config         from the zero wind level. Thus to take into account the roughness
+           !Config         of tall vegetation we need to correct this by a certain fraction
+           !Config         of the vegetation height. This is called the roughness height in
+           !Config         ORCHIDEE talk.
+           !Config Units = [m] 
+           CALL getin_p('ROUGHHEIGHT', roughheight_scal)
+           ! 
+           !Config Key   = CONDVEG_ALBVIS
+           !Config Desc  = SW visible albedo for the surface
+           !Config Def   = 0.25
+           !Config If    = IMPOSE_AZE
+           !Config Help  = Surface albedo in visible wavelengths to be used 
+           !Config         on the point if a 0-dim version of SECHIBA is used. 
+           !Config         Look at the description of the forcing data for 
+           !Config         the correct value.
+           !Config Units = [-]
+           CALL getin_p('CONDVEG_ALBVIS', albedo_scal(ivis))
+           !
+           !Config Key   = CONDVEG_ALBNIR
+           !Config Desc  = SW near infrared albedo for the surface
+           !Config Def   = 0.25
+           !Config If    = IMPOSE_AZE
+           !Config Help  = Surface albedo in near infrared wavelengths to be used 
+           !Config         on the point if a 0-dim version of SECHIBA is used. 
+           !Config         Look at the description of the forcing data for 
+           !Config         the correct value.
+           !Config Units = [-]  
+           CALL getin_p('CONDVEG_ALBNIR', albedo_scal(inir))
+           !
+           !Config Key   = CONDVEG_EMIS
+           !Config Desc  = Emissivity of the surface for LW radiation
+           !Config Def   = 1.0
+           !Config If    = IMPOSE_AZE
+           !Config Help  = The surface emissivity used for compution the LE emission
+           !Config         of the surface in a 0-dim version. Values range between 
+           !Config         0.97 and 1.. The GCM uses 0.98.
+           !Config Units = [-] 
+           CALL getin_p('CONDVEG_EMIS', emis_scal)
+        ENDIF
+        !- 
+        ! Variables related to the explicitsnow module
+        !-
+        !Config Key = xansmax 
+        !Config Desc = maximum snow albedo
+        !Config If = OK_SECHIBA
+        !Config Def = 0.85
+        !Config Help = 
+        !Config Units = [-] 
+        CALL getin_p('XANSMAX',xansmax)
+        !
+        !Config Key = xansmin 
+        !Config Desc = minimum snow albedo
+        !Config If = OK_SECHIBA
+        !Config Def = 0.50
+        !Config Help = 
+        !Config Units = [-] 
+        CALL getin_p('XANSMIN',xansmin)
+        !
+        !Config Key = xans_todry 
+        !Config Desc = albedo decay rate for the dry snow 
+        !Config If = OK_SECHIBA
+        !Config Def = 0.008
+        !Config Help = 
+        !Config Units = [S-1] 
+        CALL getin_p('XANSDRY',xans_todry)
+        !
+        !Config Key = xans_t 
+        !Config Desc = albedo decay rate for the wet snow 
+        !Config If = OK_SECHIBA
+        !Config Def = 0.24
+        !Config Help = 
+        !Config Units = [S-1] 
+        CALL getin_p('XANS_T',xans_t)
+
+        !Config Key = xrhosmax 
+        !Config Desc = maximum snow density 
+        !Config If = OK_SECHIBA
+        !Config Def = 750
+        !Config Help = 
+        !Config Units = [-] 
+        CALL getin_p('XRHOSMAX',xrhosmax)
+        !
+        !Config Key = xwsnowholdmax1
+        !Config Desc = snow holding capacity 1
+        !Config If = OK_SECHIBA
+        !Config Def = 0.03
+        !Config Help = 
+        !Config Units = [-] 
+        CALL getin_p('XWSNOWHOLDMAX1',xwsnowholdmax1)
+        !
+        !Config Key = xwsnowholdmax2
+        !Config Desc = snow holding capacity 2
+        !Config If = OK_SECHIBA
+        !Config Def = 0.10
+        !Config Help = 
+        !Config Units = [-] 
+        CALL getin_p('XWSNOWHOLDMAX2',xwsnowholdmax2)
+        !
+        !Config Key = xsnowrhohold 
+        !Config Desc = snow density 
+        !Config If = OK_SECHIBA
+        !Config Def = 200.0
+        !Config Help = 
+        !Config Units = [kg/m3] 
+        CALL getin_p('XSNOWRHOHOLD',xsnowrhohold)
+        ! 
+        !Config Key = ZSNOWTHRMCOND1
+        !Config Desc = Thermal conductivity Coef 1
+        !Config If = OK_SECHIBA
+        !Config Def = 0.02 
+        !Config Help = 
+        !Config Units = [W/m/K] 
+        CALL getin_p('ZSNOWTHRMCOND1',ZSNOWTHRMCOND1)
+        !
+        !Config Key = ZSNOWTHRMCOND2
+        !Config Desc = Thermal conductivity Coef 2
+        !Config If = OK_SECHIBA
+        !Config Def = 2.5E-6
+        !Config Help = 
+        !Config Units = [W m5/(kg2 K)] 
+        CALL getin_p('ZSNOWTHRMCOND2',ZSNOWTHRMCOND2)
+        !
+        !Config Key = ZSNOWTHRMCOND_AVAP
+        !Config Desc = Thermal conductivity Coef 1 water vapor
+        !Config If = OK_SECHIBA
+        !Config Def = -0.06023
+        !Config Help = 
+        !Config Units = [W/m/K] 
+        CALL getin_p('ZSNOWTHRMCOND_AVAP',ZSNOWTHRMCOND_AVAP)
+        !
+        !Config Key = ZSNOWTHRMCOND_BVAP
+        !Config Desc = Thermal conductivity Coef 2 water vapor
+        !Config If = OK_SECHIBA
+        !Config Def = -2.5425
+        !Config Help = 
+        !Config Units = [W/m] 
+        CALL getin_p('ZSNOWTHRMCOND_BVAP',ZSNOWTHRMCOND_BVAP)
+        !
+        !Config Key = ZSNOWTHRMCOND_CVAP
+        !Config Desc = Thermal conductivity Coef 3 water vapor
+        !Config If = OK_SECHIBA
+        !Config Def = -289.99
+        !Config Help = 
+        !Config Units = [K] 
+        CALL getin_p('ZSNOWTHRMCOND_CVAP',ZSNOWTHRMCOND_CVAP)
+
+        !Snow compaction factors
+        !Config Key = ZSNOWCMPCT_RHOD
+        !Config Desc = Snow compaction coefficent
+        !Config If = OK_SECHIBA
+        !Config Def = 150.0
+        !Config Help = 
+        !Config Units = [kg/m3]
+        CALL getin_p('ZSNOWCMPCT_RHOD',ZSNOWCMPCT_RHOD)
+
+        !Config Key = ZSNOWCMPCT_ACM
+        !Config Desc = Coefficent for the thermal conductivity
+        !Config If = OK_SECHIBA
+        !Config Def = 2.8e-6
+        !Config Help = 
+        !Config Units = [1/s]
+        CALL getin_p('ZSNOWCMPCT_ACM',ZSNOWCMPCT_ACM)
+
+        !Config Key = ZSNOWCMPCT_BCM
+        !Config Desc = Coefficent for the thermal conductivity
+        !Config If = OK_SECHIBA
+        !Config Def = 0.04
+        !Config Help = 
+        !Config Units = [1/K]
+        CALL getin_p('ZSNOWCMPCT_BCM',ZSNOWCMPCT_BCM)
+
+        !Config Key = ZSNOWCMPCT_CCM
+        !Config Desc = Coefficent for the thermal conductivity
+        !Config If = OK_SECHIBA
+        !Config Def = 460.
+        !Config Help = 
+        !Config Units = [m3/kg] 
+        CALL getin_p('ZSNOWCMPCT_CCM',ZSNOWCMPCT_CCM)
+
+        !Config Key = ZSNOWCMPCT_V0
+        !Config Desc = Vapor coefficent for the thermal conductivity
+        !Config If = OK_SECHIBA
+        !Config Def = 3.7e7
+        !Config Help = 
+        !Config Units = [Pa/s]
+        CALL getin_p('ZSNOWCMPCT_V0',ZSNOWCMPCT_V0)
+
+        !Config Key = ZSNOWCMPCT_VT
+        !Config Desc = Vapor coefficent for the thermal conductivity
+        !Config If = OK_SECHIBA
+        !Config Def = 0.081
+        !Config Help = 
+        !Config Units = [1/K]
+        CALL getin_p('ZSNOWCMPCT_VT',ZSNOWCMPCT_VT)
+
+        !Config Key = ZSNOWCMPCT_VR
+        !Config Desc = Vapor coefficent for the thermal conductivity
+        !Config If = OK_SECHIBA
+        !Config Def = 0.018
+        !Config Help = 
+        !Config Units = [m3/kg]
+        CALL getin_p('ZSNOWCMPCT_VR',ZSNOWCMPCT_VR)
+
+
+        !Surface resistance
+        !
+        !Config Key = CB
+        !Config Desc = Constant of the Louis scheme 
+        !Config If = OK_SECHIBA
+        !Config Def = 5.0
+        !Config Help = 
+        !Config Units = [-] 
+        CALL getin_p('CB',cb)
+        !
+        !Config Key = CC
+        !Config Desc = Constant of the Louis scheme 
+        !Config If = OK_SECHIBA
+        !Config Def = 5.0
+        !Config Help = 
+        !Config Units = [-] 
+        CALL getin_p('CC',cc)
+        !
+        !Config Key = CD
+        !Config Desc = Constant of the Louis scheme 
+        !Config If = OK_SECHIBA
+        !Config Def = 5.0
+        !Config Help = 
+        !Config Units = [-] 
+        CALL getin_p('CD',cd)
+        !
+        !Config Key = RAYT_CSTE
+        !Config Desc = Constant in the computation of surface resistance  
+        !Config If = OK_SECHIBA
+        !Config Def = 125
+        !Config Help = 
+        !Config Units = [W.m^{-2}] 
+        CALL getin_p('RAYT_CSTE',rayt_cste)
+        !
+        !Config Key = DEFC_PLUS
+        !Config Desc = Constant in the computation of surface resistance  
+        !Config If = OK_SECHIBA
+        !Config Def = 23.E-3
+        !Config Help = 
+        !Config Units = [K.W^{-1}] 
+        CALL getin_p('DEFC_PLUS',defc_plus)
+        !
+        !Config Key = DEFC_MULT
+        !Config Desc = Constant in the computation of surface resistance  
+        !Config If = OK_SECHIBA
+        !Config Def = 1.5
+        !Config Help = 
+        !Config Units = [K.W^{-1}] 
+        CALL getin_p('DEFC_MULT',defc_mult)
+        !
+
+        !
+        !-
+        ! diffuco 
+        !-
+        !
+        !Config Key   = NLAI
+        !Config Desc  = Number of LAI levels
+        !Config If    = OK_SECHIBA
+        !Config Def   = 20
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('NLAI',nlai)
+        !
+        !Config Key   = LAIMAX
+        !Config Desc  = Maximum LAI
+        !Config If    = OK_SECHIBA
+        !Config Def   = 
+        !Config Help  = 
+        !Config Units = [m^2/m^2]   
+        CALL getin_p('LAIMAX',laimax)
+        !
+        !Config Key   = DEW_VEG_POLY_COEFF
+        !Config Desc  = coefficients of the polynome of degree 5 for the dew
+        !Config If    = OK_SECHIBA
+        !Config Def   = 0.887773, 0.205673, 0.110112, 0.014843, 0.000824, 0.000017 
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('DEW_VEG_POLY_COEFF',dew_veg_poly_coeff)
+        !
+        !Config Key   = DOWNREGULATION_CO2
+        !Config Desc  = Activation of CO2 downregulation
+        !Config If    = OK_SECHIBA
+        !Config Def   = n 
+        !Config Help  = 
+        !Config Units = [FLAG]   
+        CALL getin_p('DOWNREGULATION_CO2',downregulation_co2)
+        !
+        !Config Key   = DOWNREGULATION_CO2_BASELEVEL
+        !Config Desc  = CO2 base level
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 280.
+        !Config Help  = 
+        !Config Units = [ppm]   
+        CALL getin_p('DOWNREGULATION_CO2_BASELEVEL',downregulation_co2_baselevel)
+        !-
+        ! slowproc
+        !-
+        !
+        !Config Key   = CLAYFRACTION_DEFAULT
+        !Config Desc  = default fraction of clay
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.2 
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('CLAYFRACTION_DEFAULT',clayfraction_default)
+        !
+        !Config Key   = SILTFRACTION_DEFAULT
+        !Config Desc  = default fraction of silt
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.4 
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('SILTFRACTION_DEFAULT',siltfraction_default)
+        !
+        !Config Key   = SANDFRACTION_DEFAULT
+        !Config Desc  = default fraction of sand
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.4 
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('SANDFRACTION_DEFAULT',sandfraction_default)
+
+        !
+        !Config Key   = MIN_VEGFRAC 
+        !Config Desc  = Minimal fraction of mesh a vegetation type can occupy 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.001 
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('MIN_VEGFRAC',min_vegfrac)
+        !
+        !Config Key   = STEMPDIAG_BID 
+        !Config Desc  = only needed for an initial LAI if there is no restart file
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 280.
+        !Config Help  = 
+        !Config Units = [K]
+        CALL getin_p('STEMPDIAG_BID',stempdiag_bid)
+        !
+        first_call =.FALSE.
+        
+     ENDIF
+     
+   END SUBROUTINE config_sechiba_parameters
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_co2_parameters 
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters 
+!! needed when OK_CO2 is set to true. (ie : when the photosynthesis is activated) 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE config_co2_parameters
+     
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+     !! 0.4 Local variables
+     
+     LOGICAL, SAVE ::  first_call = .TRUE.      !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+     
+     IF(first_call) THEN
+        
+        !
+        !Config Key   = LAI_LEVEL_DEPTH
+        !Config Desc  = 
+        !Config If    = OK_CO2
+        !Config Def   = 0.15
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('LAI_LEVEL_DEPTH',lai_level_depth)
+        !
+        !Config Key   = Oi
+        !Config Desc  = Intercellular oxygen partial pressure
+        !Config If    = OK_CO2
+        !Config Def   = 210000.
+        !Config Help  = See Legend of Figure 6 of Yin et al. (2009)
+        !Config Units = [ubar]  
+        CALL getin_p('Oi',Oi)
+        
+        first_call = .FALSE.
+        
+     ENDIF
+     
+   END SUBROUTINE config_co2_parameters
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_stomate_parameters 
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters 
+!! needed when stomate is activated (ie : when OK_STOMATE is set to true).
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE config_stomate_parameters
+     
+    IMPLICIT NONE
+    
+    !! 0. Variables and parameters declaration
+
+    !! 0.4 Local variables   
+
+    LOGICAL, SAVE ::  first_call = .TRUE.  !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+    
+    IF(first_call) THEN
+       !-
+       ! constraints_parameters
+       !-
+       !
+       !Config Key   = TOO_LONG 
+       !Config Desc  = longest sustainable time without regeneration (vernalization)
+       !Config If    = OK_STOMATE
+       !Config Def   = 5.
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TOO_LONG',too_long)
+
+       !-
+       ! fire parameters
+       !-
+       !
+       !Config Key   = TAU_FIRE 
+       !Config Desc  = Time scale for memory of the fire index (days). Validated for one year in the DGVM. 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 30.
+       !Config Help  = 
+       !Config Units = [days]    
+       CALL getin_p('TAU_FIRE',tau_fire)
+       !
+       !Config Key   = LITTER_CRIT
+       !Config Desc  = Critical litter quantity for fire
+       !Config If    = OK_STOMATE 
+       !Config Def   = 200.
+       !Config Help  = 
+       !Config Units = [gC/m^2]  
+       CALL getin_p('LITTER_CRIT',litter_crit)
+       !
+       !Config Key   = FIRE_RESIST_STRUCT
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('FIRE_RESIST_STRUCT',fire_resist_struct)
+       !
+       !
+       !Config Key   = CO2FRAC
+       !Config Desc  = What fraction of a burned plant compartment goes into the atmosphere
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.95, 0.95, 0., 0.3, 0., 0., 0.95, 0.95
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('CO2FRAC',co2frac)
+       !
+       !Config Key   = BCFRAC_COEFF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3, 1.3, 88.2 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('BCFRAC_COEFF',bcfrac_coeff)
+       !
+       !Config Key   = FIREFRAC_COEFF 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.45, 0.8, 0.6, 0.13
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('FIREFRAC_COEFF',firefrac_coeff)
+
+       !Config Key   = REF_GREFF
+       !Config Desc  = Asymptotic maximum mortality rate
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.035
+       !Config Help  = Set asymptotic maximum mortality rate from Sitch 2003
+       !Config         (they use 0.01) (year^{-1})
+       !Config Units = [1/year]  
+       CALL getin_p('REF_GREFF',ref_greff)
+       !-
+       ! allocation parameters
+       !-
+       !
+       !Config Key   = OK_MINRES
+       !Config Desc  = Do we try to reach a minimum reservoir even if we are severely stressed?
+       !Config If    = OK_STOMATE 
+       !Config Def   = y
+       !Config Help  = 
+       !Config Units = [FLAG]
+       CALL getin_p('OK_MINRES',ok_minres)
+       !
+       !Config Key   = RESERVE_TIME_TREE 
+       !Config Desc  = maximum time during which reserve is used (trees) 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 30.
+       !Config Help  = 
+       !Config Units = [days]    
+       CALL getin_p('RESERVE_TIME_TREE',reserve_time_tree)
+       !
+       !Config Key   = RESERVE_TIME_GRASS 
+       !Config Desc  = maximum time during which reserve is used (grasses) 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20. 
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('RESERVE_TIME_GRASS',reserve_time_grass)
+       !
+       !Config Key   = F_FRUIT
+       !Config Desc  = Standard fruit allocation
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.1 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('F_FRUIT',f_fruit)
+       !
+       !Config Key   = ALLOC_SAP_ABOVE_GRASS 
+       !Config Desc  = fraction of sapwood allocation above ground 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.0 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('ALLOC_SAP_ABOVE_GRASS',alloc_sap_above_grass)
+       !
+       !Config Key   = MIN_LTOLSR 
+       !Config Desc  = extrema of leaf allocation fraction 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.2
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MIN_LTOLSR',min_LtoLSR)
+       !
+       !Config Key   = MAX_LTOLSR
+       !Config Desc  = extrema of leaf allocation fraction
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MAX_LTOLSR',max_LtoLSR)
+       !
+       !Config Key   = Z_NITROGEN
+       !Config Desc  = scaling depth for nitrogen limitation 
+       !Config If    = OK_STOMATE
+       !Config Def   = 0.2 
+       !Config Help  =
+       !Config Units = [m]  
+       CALL getin_p('Z_NITROGEN',z_nitrogen)
+       !
+       !Config Key   = NLIM_TREF 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 25. 
+       !Config Help  = 
+       !Config Units = [C]  
+       CALL getin_p('NLIM_TREF',Nlim_tref) 
+  
+       !-
+       ! data parameters
+       !-
+       !
+       !Config Key   = PIPE_TUNE1
+       !Config Desc  = crown area = pipe_tune1. stem diameter**(1.6) (Reinicke's theory)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 100.0
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('PIPE_TUNE1',pipe_tune1)
+       !
+       !Config Key   = PIPE_TUNE2 
+       !Config Desc  = height=pipe_tune2 * diameter**pipe_tune3
+       !Config If    = OK_STOMATE 
+       !Config Def   = 40.0 
+       !Config Help  = 
+       !Config Units = [-]      
+       CALL getin_p('PIPE_TUNE2',pipe_tune2) 
+        !
+       !Config Key   = PIPE_TUNE3
+       !Config Desc  = height=pipe_tune2 * diameter**pipe_tune3
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('PIPE_TUNE3',pipe_tune3)
+       !
+       !Config Key   = PIPE_TUNE4
+       !Config Desc  = needed for stem diameter
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('PIPE_TUNE4',pipe_tune4)
+       !
+       !Config Key   = PIPE_DENSITY 
+       !Config Desc  = Density
+       !Config If    = OK_STOMATE 
+       !Config Def   = 2.e5 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('PIPE_DENSITY',pipe_density)
+       !
+       !Config Key   = PIPE_K1 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 8.e3 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('PIPE_K1',pipe_k1)
+       !
+       !Config Key   = PIPE_TUNE_EXP_COEFF 
+       !Config Desc  = pipe tune exponential coeff 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.6 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('PIPE_TUNE_EXP_COEFF',pipe_tune_exp_coeff)
+       !
+       !
+       !Config Key   = PRECIP_CRIT 
+       !Config Desc  = minimum precip
+       !Config If    = OK_STOMATE 
+       !Config Def   = 100.
+       !Config Help  = 
+       !Config Units = [mm/year]  
+       CALL getin_p('PRECIP_CRIT',precip_crit)
+       !
+       !Config Key   = GDD_CRIT_ESTAB
+       !Config Desc  = minimum gdd for establishment of saplings
+       !Config If    = OK_STOMATE 
+       !Config Def   = 150. 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('GDD_CRIT_ESTAB',gdd_crit_estab)
+        !
+       !Config Key   = FPC_CRIT
+       !Config Desc  = critical fpc, needed for light competition and establishment
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.95
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('FPC_CRIT',fpc_crit)
+       !
+       !Config Key   = ALPHA_GRASS
+       !Config Desc  = sapling characteristics : alpha's
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('ALPHA_GRASS',alpha_grass)
+       !
+       !Config Key   = ALPHA_TREE
+       !Config Desc  = sapling characteristics : alpha's 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('ALPHA_TREE',alpha_tree)
+       !-
+       !
+       !Config Key   = MASS_RATIO_HEART_SAP
+       !Config Desc  = mass ratio (heartwood+sapwood)/sapwood
+       !Config If    = OK_STOMATE 
+       !Config Def   = 3.
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MASS_RATIO_HEART_SAP',mass_ratio_heart_sap)
+       !
+       !Config Key   = TAU_HUM_MONTH
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20. 
+       !Config Help  = 
+       !Config Units = [days]  
+       CALL getin_p('TAU_HUM_MONTH',tau_hum_month)
+       !
+       !Config Key   = TAU_HUM_WEEK
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 7.
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TAU_HUM_WEEK',tau_hum_week)
+       !
+       !Config Key   = TAU_T2M_MONTH
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20.
+       !Config Help  = 
+       !Config Units = [days]     
+       CALL getin_p('TAU_T2M_MONTH',tau_t2m_month)
+       !
+       !Config Key   = TAU_T2M_WEEK
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 7.
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TAU_T2M_WEEK',tau_t2m_week)
+       !
+       !Config Key   = TAU_TSOIL_MONTH 
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20. 
+       !Config Help  = 
+       !Config Units = [days]     
+       CALL getin_p('TAU_TSOIL_MONTH',tau_tsoil_month)
+       !
+       !Config Key   = TAU_SOILHUM_MONTH
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20. 
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TAU_SOILHUM_MONTH',tau_soilhum_month)
+       !
+       !Config Key   = TAU_GPP_WEEK 
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 7. 
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TAU_GPP_WEEK',tau_gpp_week)
+       !
+       !Config Key   = TAU_GDD
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 40. 
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TAU_GDD',tau_gdd)
+       !
+       !Config Key   = TAU_NGD
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 50.
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TAU_NGD',tau_ngd)
+       !
+       !Config Key   = COEFF_TAU_LONGTERM
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 3. 
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('COEFF_TAU_LONGTERM',coeff_tau_longterm)
+       !-
+       !
+       !Config Key   = BM_SAPL_CARBRES 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 5. 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('BM_SAPL_CARBRES',bm_sapl_carbres)
+       !
+       !Config Key   = BM_SAPL_SAPABOVE
+       !Config Desc  = 
+       !Config If    = OK_STOMATE
+       !Config Def   = 0.5 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('BM_SAPL_SAPABOVE',bm_sapl_sapabove)
+       !
+       !Config Key   = BM_SAPL_HEARTABOVE 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 2.
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('BM_SAPL_HEARTABOVE',bm_sapl_heartabove)
+       !
+       !Config Key   = BM_SAPL_HEARTBELOW 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 2. 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('BM_SAPL_HEARTBELOW',bm_sapl_heartbelow)
+       !
+       !Config Key   = INIT_SAPL_MASS_LEAF_NAT
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.1 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('INIT_SAPL_MASS_LEAF_NAT',init_sapl_mass_leaf_nat)
+       !
+       !Config Key   = INIT_SAPL_MASS_LEAF_AGRI
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1. 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('INIT_SAPL_MASS_LEAF_AGRI',init_sapl_mass_leaf_agri)
+       !
+       !Config Key   = INIT_SAPL_MASS_CARBRES
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 5. 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('INIT_SAPL_MASS_CARBRES',init_sapl_mass_carbres)
+       !
+       !Config Key   = INIT_SAPL_MASS_ROOT
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.1 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('INIT_SAPL_MASS_ROOT',init_sapl_mass_root)
+       !
+       !Config Key   = INIT_SAPL_MASS_FRUIT
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('INIT_SAPL_MASS_FRUIT',init_sapl_mass_fruit)
+       !
+       !Config Key   = CN_SAPL_INIT 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('CN_SAPL_INIT',cn_sapl_init)
+       !
+       !Config Key   = MIGRATE_TREE 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 10000.
+       !Config Help  = 
+       !Config Units = [m/year]   
+       CALL getin_p('MIGRATE_TREE',migrate_tree)
+       !
+       !Config Key   = MIGRATE_GRASS
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 10000.
+       !Config Help  = 
+       !Config Units = [m/year]   
+       CALL getin_p('MIGRATE_GRASS',migrate_grass)
+       !
+       !Config Key   = LAI_INITMIN_TREE
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3
+       !Config Help  = 
+       !Config Units = [m^2/m^2]  
+       CALL getin_p('LAI_INITMIN_TREE',lai_initmin_tree)
+       !
+       !Config Key   = LAI_INITMIN_GRASS 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.1
+       !Config Help  = 
+       !Config Units = [m^2/m^2]    
+       CALL getin_p('LAI_INITMIN_GRASS',lai_initmin_grass)
+       !
+       !Config Key   = DIA_COEFF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 4., 0.5
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('DIA_COEFF',dia_coeff)
+       !
+       !Config Key   = MAXDIA_COEFF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 100., 0.01 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MAXDIA_COEFF',maxdia_coeff)
+       !
+       !Config Key   = BM_SAPL_LEAF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 4., 4., 0.8, 5. 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('BM_SAPL_LEAF',bm_sapl_leaf)
+
+       !-
+       ! litter parameters
+       !-
+       !
+       !Config Key   = METABOLIC_REF_FRAC
+       !Config Desc  =
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.85  
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('METABOLIC_REF_FRAC',metabolic_ref_frac)
+       !
+       !Config Key   = Z_DECOMP
+       !Config Desc  = scaling depth for soil activity
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.2
+       !Config Help  = 
+       !Config Units = [m]   
+       CALL getin_p('Z_DECOMP',z_decomp)
+       !
+       !Config Key   = CN
+       !Config Desc  = C/N ratio
+       !Config If    = OK_STOMATE 
+       !Config Def   = 40., 40., 40., 40., 40., 40., 40., 40.
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('CN',CN)
+       !
+       !Config Key   = LC 
+       !Config Desc  = Lignine/C ratio of the different plant parts
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.22, 0.35, 0.35, 0.35, 0.35, 0.22, 0.22, 0.22
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('LC',LC)
+       !
+       !Config Key   = FRAC_SOIL_STRUCT_AA
+       !Config Desc  = frac_soil(istructural,iactive,iabove)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.55
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('FRAC_SOIL_STRUCT_AA',frac_soil_struct_aa)
+       !
+       !Config Key   = FRAC_SOIL_STRUCT_A 
+       !Config Desc  = frac_soil(istructural,iactive,ibelow)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.45
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('FRAC_SOIL_STRUCT_AB',frac_soil_struct_ab)
+       !
+       !Config Key   = FRAC_SOIL_STRUCT_SA
+       !Config Desc  = frac_soil(istructural,islow,iabove)
+       !Config If    = OK_STOMATE
+       !Config Def   = 0.7  
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('FRAC_SOIL_STRUCT_SA',frac_soil_struct_sa)
+       !
+       !Config Key   = FRAC_SOIL_STRUCT_SB
+       !Config Desc  = frac_soil(istructural,islow,ibelow) 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.7  
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('FRAC_SOIL_STRUCT_SB',frac_soil_struct_sb)
+       !
+       !Config Key   = FRAC_SOIL_METAB_AA 
+       !Config Desc  = frac_soil(imetabolic,iactive,iabove) 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.45 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('FRAC_SOIL_METAB_AA',frac_soil_metab_aa)
+       !
+       !Config Key   = FRAC_SOIL_METAB_AB 
+       !Config Desc  = frac_soil(imetabolic,iactive,ibelow)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.45  
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('FRAC_SOIL_METAB_AB',frac_soil_metab_ab)
+       !
+       !
+       !Config Key   = METABOLIC_LN_RATIO
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.018  
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('METABOLIC_LN_RATIO',metabolic_LN_ratio) 
+       !
+       !Config Key   = TAU_METABOLIC
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.066
+       !Config Help  = 
+       !Config Units = [days] 
+       CALL getin_p('TAU_METABOLIC',tau_metabolic)
+       !
+       !Config Key   = TAU_STRUCT 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.245 
+       !Config Help  = 
+       !Config Units = [days]
+       CALL getin_p('TAU_STRUCT',tau_struct)
+       !
+       !Config Key   = SOIL_Q10
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.69 (=ln2)
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('SOIL_Q10',soil_Q10)
+       !
+       !Config Key   = ratio_C/14C
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1 
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('ratio_C14C',ratio)
+       ! 
+       !Config Key   = 14C_decrease
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.000121 
+       !Config Help  = 
+       !Config Units = [year-1]
+       CALL getin_p('14C_decrease',k_decrease)
+       !
+       !Config Key   = a_term_Q10_soil
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 11.049
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('a_term_Q10_soil',a_term_Q10_soil)
+       !
+       !Config Key   = b_term_Q10_soil
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 35.003
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('b_term_Q10_soil',b_term_Q10_soil)
+       !
+       !Config Key   = TSOIL_REF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 30. 
+       !Config Help  = 
+       !Config Units = [C]   
+       CALL getin_p('TSOIL_REF',tsoil_ref)
+       !
+       !Config Key   = LITTER_STRUCT_COEF 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 3. 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('LITTER_STRUCT_COEF',litter_struct_coef)
+       !
+       !Config Key   = MOIST_COEFF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.1, 2.4, 0.29
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MOIST_COEFF',moist_coeff)
+       !
+       !Config Key   = MOISTCONT_MIN
+       !Config Desc  = minimum soil wetness to limit the heterotrophic respiration
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.25
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('MOISTCONT_MIN',moistcont_min)
+
+       !-
+       ! lpj parameters
+       !-
+       !
+       !Config Key   = FRAC_TURNOVER_DAILY 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.55
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('FRAC_TURNOVER_DAILY',frac_turnover_daily)   
+
+       !-
+       ! npp parameters
+       !-
+       !
+       !Config Key   = TAX_MAX
+       !Config Desc  = maximum fraction of allocatable biomass used for maintenance respiration
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.8
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('TAX_MAX',tax_max) 
+
+       !-
+       ! phenology parameters
+       !-
+       !
+       !Config Key   = ALWAYS_INIT
+       !Config Desc  = take carbon from atmosphere if carbohydrate reserve too small? 
+       !Config If    = OK_STOMATE 
+       !Config Def   = n 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('ALWAYS_INIT',always_init)
+       !
+       !Config Key   = MIN_GROWTHINIT_TIME 
+       !Config Desc  = minimum time since last beginning of a growing season
+       !Config If    = OK_STOMATE 
+       !Config Def   = 300. 
+       !Config Help  = 
+       !Config Units = [days]  
+       CALL getin_p('MIN_GROWTHINIT_TIME',min_growthinit_time)
+       !
+       !Config Key   = MOIAVAIL_ALWAYS_TREE
+       !Config Desc  = moisture availability above which moisture tendency doesn't matter 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.0 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MOIAVAIL_ALWAYS_TREE',moiavail_always_tree)
+       !
+       !Config Key   = MOIAVAIL_ALWAYS_GRASS 
+       !Config Desc  = moisture availability above which moisture tendency doesn't matter
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.6 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MOIAVAIL_ALWAYS_GRASS',moiavail_always_grass)
+       !
+       !Config Key   = T_ALWAYS_ADD
+       !Config Desc  = monthly temp. above which temp. tendency doesn't matter 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 10.
+       !Config Help  = 
+       !Config Units = [C]    
+       CALL getin_p('T_ALWAYS_ADD',t_always_add)
+       !
+       !
+       !Config Key   = GDDNCD_REF 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 603. 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('GDDNCD_REF',gddncd_ref)
+       !
+       !Config Key   = GDDNCD_CURVE
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.0091 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('GDDNCD_CURVE',gddncd_curve)
+       !
+       !Config Key   = GDDNCD_OFFSET
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 64. 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('GDDNCD_OFFSET',gddncd_offset)
+       !-
+       ! prescribe parameters
+       !-
+       !
+       !Config Key   = BM_SAPL_RESCALE 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 40. 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('BM_SAPL_RESCALE',bm_sapl_rescale)
+
+       !-
+       ! respiration parameters
+       !-
+       !
+       !Config Key   = MAINT_RESP_MIN_VMAX
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('MAINT_RESP_MIN_VMAX',maint_resp_min_vmax)  
+       !
+       !Config Key   = MAINT_RESP_COEFF 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.4 
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('MAINT_RESP_COEFF',maint_resp_coeff)
+
+       !-
+       ! soilcarbon parameters 
+       !-
+       !
+       !Config Key   = FRAC_CARB_AP
+       !Config Desc  = frac carb coefficients from active pool: depends on clay content
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.004
+       !Config Help  = fraction of the active pool going into the passive pool
+       !Config Units = [-]
+       CALL getin_p('FRAC_CARB_AP',frac_carb_ap)  
+       !
+       !Config Key   = FRAC_CARB_SA
+       !Config Desc  = frac_carb_coefficients from slow pool
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.42
+       !Config Help  = fraction of the slow pool going into the active pool
+       !Config Units = [-]
+       CALL getin_p('FRAC_CARB_SA',frac_carb_sa)
+       !
+       !Config Key   = FRAC_CARB_SP
+       !Config Desc  = frac_carb_coefficients from slow pool
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.03
+       !Config Help  = fraction of the slow pool going into the passive pool
+       !Config Units = [-] 
+       !CALL getin_p('FRAC_CARB_SP',frac_carb_sp)
+       !
+       !Config Key   = FRAC_CARB_PA
+       !Config Desc  = frac_carb_coefficients from passive pool
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.45
+       !Config Help  = fraction of the passive pool going into the active pool
+       !Config Units = [-]
+       CALL getin_p('FRAC_CARB_PA',frac_carb_pa)
+       !
+       !Config Key   = FRAC_CARB_PS
+       !Config Desc  = frac_carb_coefficients from passive pool
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.0
+       !Config Help  = fraction of the passive pool going into the slow pool
+       !Config Units = [-]
+       !CALL getin_p('FRAC_CARB_PS',frac_carb_ps)
+       !
+       !Config Key   = ACTIVE_TO_PASS_CLAY_FRAC
+       !Config Desc  = 
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.68  
+       !Config Help  =
+       !Config Units = [-] 
+       CALL getin_p('ACTIVE_TO_PASS_CLAY_FRAC',active_to_pass_clay_frac)
+       !
+       !Config Key   = CARBON_TAU_IACTIVE
+       !Config Desc  = residence times in carbon pools
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.149
+       !Config Help  =
+       !Config Units =  [days] 
+       CALL getin_p('CARBON_TAU_IACTIVE',carbon_tau_iactive)
+       !
+       !Config Key   = CARBON_TAU_ISLOW
+       !Config Desc  = residence times in carbon pools
+       !Config if    = OK_STOMATE 
+       !Config Def   = 5.48
+       !Config Help  =
+       !Config Units = [days]
+       CALL getin_p('CARBON_TAU_ISLOW',carbon_tau_islow)
+       !
+       !Config Key   = CARBON_TAU_IPASSIVE
+       !Config Desc  = residence times in carbon pools
+       !Config if    = OK_STOMATE 
+       !Config Def   = 241.
+       !Config Help  = residence time in the passive pool
+       !Config Units = [days] 
+       CALL getin_p('CARBON_TAU_IPASSIVE',carbon_tau_ipassive)
+       !
+       !Config Key   = PRIMING_PARAM_IACTIVE
+       !Config Desc  = priming parameter in carbon pools
+       !Config if    = OK_STOMATE 
+       !Config Def   = 493.66
+       !Config Help  =
+       !Config Units =  [-] 
+       CALL getin_p('PRIMING_PARAM_IACTIVE',priming_param_iactive)
+       !
+       !Config Key   = PRIMING_PARAM_ISLOW
+       !Config Desc  = priming parameter in carbon pools
+       !Config if    = OK_STOMATE 
+       !Config Def   = 194.03
+       !Config Help  =
+       !Config Units =  [-] 
+       CALL getin_p('PRIMING_PARAM_ISLOW',priming_param_islow)
+       !
+       !Config Key   = PRIMING_PARAM_IPASSIVE
+       !Config Desc  = priming parameter in carbon pools
+       !Config if    = OK_STOMATE 
+       !Config Def   = 136.54
+       !Config Help  =
+       !Config Units =  [-] 
+       CALL getin_p('PRIMING_PARAM_IPASSIVE',priming_param_ipassive)
+       !
+       !Config Key   = DOC_tau_labile
+       !Config Desc  = residence time of labile DOC
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.3
+       !Config Help  = tuning
+       !Config Units =  [days] 
+       CALL getin_p('DOC_TAU_LABILE',DOC_tau_labile)
+       !WHERE (DOC_tau_labile(:) .LT. un) 
+       !WRITE(numout,*) "A residence time < one day is incompatible with forcesoil"
+       !WRITE(numout,*) "Please correct"
+       !STOP
+       !ENDWHERE
+       !
+       !Config Key   = DOC_tau_stable
+       !Config Desc  = residence time of stable DOC
+       !Config if    = OK_STOMATE 
+       !Config Def   = 60.3
+       !Config Help  = tuning
+       !Config Units =  [days] 
+       CALL getin_p('DOC_TAU_STABLE',DOC_tau_stable)
+       !
+       !Config Key   = Dif
+       !Config Desc  = diffusion coefficient of POC
+       !Config if    = OK_STOMATE
+       !Config Def   = 1.E-4r
+       !Config Help  = from Koven et al., 2013 (BG)
+       !Config Units =  [m^2 day-1]
+       CALL getin_p('Dif',Dif)
+
+       !
+       !!Config Key  = D_DOC
+       !Config Desc  = diffusion coefficient of DOC
+       !Config if    = OK_STOMATE 
+       !Config Def   = 1.06272E-5
+       !Config Help  = from Burdige et al., 1999 in Ota et al., 2013
+       !Config Units =  [m^2 day-1] 
+       CALL getin_p('D_DOC',D_DOC)
+       !
+       !!Config Key  = red_factor
+       !Config Desc  = parameter to reduce the DOC flux due to water flux
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.5
+       !Config Help  = Pure tunning
+       !Config Units =  [-] 
+       CALL getin_p('RED_FACTOR',red_factor)
+       !
+       !!Config Key  = sro_bottom 
+       !Config Desc  = layer to which runoff DOC is taken 
+       !Config if    = OK_STOMATE 
+       !Config Def   = 10 
+       CALL getin_p('SRO_BOTTOM',sro_bottom) 
+       !
+       !!Config Key  = m_ads
+       !Config Desc  = partition coefficient for adsorption of DOC
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.45
+       !Config Help  = Mean from Kothawalla et al., 2008 and Kaiser et al., 1996
+       !Config Units =  [-] 
+       CALL getin_p('m_ads',m_ads)
+       !
+       !!Config Key  = b_ads
+       !Config Desc  = desorption coefficient for adsorption of DOC
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.17
+       !Config Help  = Mean from Kothawalla et al., 2008 and Kaiser et al., 1996
+       !Config Units =  [mg C g soil-1] 
+       CALL getin_p('b_ads',b_ads)
+       !
+       !!Config Key  = kd_ads
+       !Config Desc  = distribution coefficient in the mineral soil
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.00805
+       !Config Help  = Median from Moore et al., 1992
+       !Config Units =  [m3 water kg soil-1] 
+       CALL getin_p('kd_ads',kd_ads)
+       !
+       !!Config Key   = CUE
+       !Config Desc  = Microbial carbon use efficiency
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.5
+       !Config Help  = Assumed value of CUE=0.5
+       !Config Units =  [-] 
+       CALL getin_p('CUE',CUE)
+       !
+       !Config Key   = BULK_DENSITY
+       !Config Desc  = value of the soil bulk density 
+       !Config if    = IMPOSE_VEG and IMPOSE_SOIL
+       !Config Def   = 1.65
+       !Config Help  =
+       !Config Units =  [g cm-3] 
+       CALL getin_p('BULK_DENSITY',bulk_density_default)
+       !
+       !Config Key   = SOIL_PH
+       !Config Desc  = pH of the soil (0-dim mode)
+       !Config Def   = 7.0
+       !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+       !Config Help  = Determines the soil pH in the grid box.
+       !Config Units = [pH units] 
+       CALL getin_p('soil_ph',soil_ph_default)
+       !
+       !Config Key   = FLUX_TOT_COEFF
+       !Config Desc  =
+       !Config if    = OK_STOMATE 
+       !Config Def   = 1.2, 1.4,.75
+       !Config Help  =
+       !Config Units = [days] 
+       CALL getin_p('FLUX_TOT_COEFF',flux_tot_coeff)
+
+       !-
+       ! turnover parameters
+       !-
+       !
+       !Config Key   = NEW_TURNOVER_TIME_REF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20. 
+       !Config Help  = 
+       !Config Units = [days]  
+       CALL getin_p('NEW_TURNOVER_TIME_REF',new_turnover_time_ref)
+       
+       !Config Key   = LEAF_AGE_CRIT_TREF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20. 
+       !Config Help  = 
+       !Config Units = [days]  
+       CALL getin_p('LEAF_AGE_CRIT_TREF',leaf_age_crit_tref)
+       !
+       !Config Key   = LEAF_AGE_CRIT_COEFF 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.5, 0.75, 10. 
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('LEAF_AGE_CRIT_COEFF',leaf_age_crit_coeff)
+
+       !-
+       ! vmax parameters
+       !-
+       !
+       !Config Key   = VMAX_OFFSET 
+       !Config Desc  = offset (minimum relative vcmax)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3
+       !Config Help  = offset (minimum vcmax/vmax_opt)
+       !Config Units = [-]  
+       CALL getin_p('VMAX_OFFSET',vmax_offset)
+       !
+       !Config Key   = LEAFAGE_FIRSTMAX
+       !Config Desc  = leaf age at which vmax attains vcmax_opt (in fraction of critical leaf age)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.03 
+       !Config Help  = relative leaf age at which vmax attains vcmax_opt
+       !Config Units = [-] 
+       CALL getin_p('LEAFAGE_FIRSTMAX',leafage_firstmax)
+       !
+       !Config Key   = LEAFAGE_LASTMAX 
+       !Config Desc  = leaf age at which vmax falls below vcmax_opt (in fraction of critical leaf age) 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5 
+       !Config Help  = relative leaf age at which vmax falls below vcmax_opt
+       !Config Units = [-]  
+       CALL getin_p('LEAFAGE_LASTMAX',leafage_lastmax)
+       !
+       !Config Key   = LEAFAGE_OLD 
+       !Config Desc  = leaf age at which vmax attains its minimum (in fraction of critical leaf age)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.
+       !Config Help  = relative leaf age at which vmax attains its minimum
+       !Config Units = [-]  
+       CALL getin_p('LEAFAGE_OLD',leafage_old)
+
+       !-
+       ! season parameters
+       !-
+       !
+       !Config Key   = GPPFRAC_DORMANCE 
+       !Config Desc  = rapport maximal GPP/GGP_max pour dormance
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.2 
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('GPPFRAC_DORMANCE',gppfrac_dormance)
+       !
+       !Config Key   = TAU_CLIMATOLOGY
+       !Config Desc  = tau for "climatologic variables 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20
+       !Config Help  = 
+       !Config Units = [days]
+       CALL getin_p('TAU_CLIMATOLOGY',tau_climatology)
+       !
+       !Config Key   = HVC1 
+       !Config Desc  = parameters for herbivore activity
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.019
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('HVC1',hvc1)
+       !
+       !Config Key   = HVC2 
+       !Config Desc  = parameters for herbivore activity 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.38
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('HVC2',hvc2)
+       !
+       !Config Key   = LEAF_FRAC_HVC
+       !Config Desc  = parameters for herbivore activity 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.33
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('LEAF_FRAC_HVC',leaf_frac_hvc)
+       !
+       !Config Key   = TLONG_REF_MAX
+       !Config Desc  = maximum reference long term temperature 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 303.1
+       !Config Help  = 
+       !Config Units = [K]  
+       CALL getin_p('TLONG_REF_MAX',tlong_ref_max)
+       !
+       !Config Key   = TLONG_REF_MIN 
+       !Config Desc  = minimum reference long term temperature 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 253.1
+       !Config Help  = 
+       !Config Units = [K]  
+       CALL getin_p('TLONG_REF_MIN',tlong_ref_min)
+       !
+       !Config Key   = NCD_MAX_YEAR
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 3. 
+       !Config Help  = NCD : Number of Chilling Days
+       !Config Units = [days]
+       CALL getin_p('NCD_MAX_YEAR',ncd_max_year)
+       !
+       !Config Key   = GDD_THRESHOLD 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 5. 
+       !Config Help  = GDD : Growing-Degree-Day
+       !Config Units = [days] 
+       CALL getin_p('GDD_THRESHOLD',gdd_threshold)
+       !
+       !Config Key   = GREEN_AGE_EVER 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 2. 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('GREEN_AGE_EVER',green_age_ever)
+       !
+       !Config Key   = GREEN_AGE_DEC
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5 
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('GREEN_AGE_DEC',green_age_dec)
+       
+       first_call = .FALSE.
+       
+    ENDIF
+    
+  END SUBROUTINE config_stomate_parameters
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_dgvm_parameters 
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters 
+!! needed when the DGVM model is activated (ie : when ok_dgvm is set to true).
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE config_dgvm_parameters   
+    
+    IMPLICIT NONE
+    
+    !! 0. Variables and parameters declaration
+
+    !! 0.4 Local variables
+
+    LOGICAL, SAVE ::  first_call = .TRUE.         !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================    
+
+    IF(first_call) THEN
+  
+       !-
+       ! establish parameters
+       !-
+       !
+       !Config Key   = ESTAB_MAX_TREE
+       !Config Desc  = Maximum tree establishment rate 
+       !Config If    = OK_DGVM
+       !Config Def   = 0.12 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('ESTAB_MAX_TREE',estab_max_tree)
+       !
+       !Config Key   = ESTAB_MAX_GRASS
+       !Config Desc  = Maximum grass establishment rate
+       !Config If    = OK_DGVM
+       !Config Def   = 0.12 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('ESTAB_MAX_GRASS',estab_max_grass)
+       !
+       !Config Key   = ESTABLISH_SCAL_FACT
+       !Config Desc  = 
+       !Config If    = OK_DGVM 
+       !Config Def   = 5.
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('ESTABLISH_SCAL_FACT',establish_scal_fact)
+       !
+       !Config Key   = MAX_TREE_COVERAGE 
+       !Config Desc  = 
+       !Config If    = OK_DGVM 
+       !Config Def   = 0.98
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('MAX_TREE_COVERAGE',max_tree_coverage)
+       !
+       !Config Key   = IND_0_ESTAB
+       !Config Desc  = 
+       !Config If    = OK_DGVM 
+       !Config Def   = 0.2
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('IND_0_ESTAB',ind_0_estab)
+
+       !-
+       ! light parameters
+       !-
+       !
+       !Config Key   = ANNUAL_INCREASE
+       !Config Desc  = for diagnosis of fpc increase, compare today's fpc to last year's maximum (T) or to fpc of last time step (F)?
+       !Config If    = OK_DGVM
+       !Config Def   = y
+       !Config Help  = 
+       !Config Units = [FLAG]
+       CALL getin_p('ANNUAL_INCREASE',annual_increase)
+       !
+       !Config Key   = MIN_COVER 
+       !Config Desc  = For trees, minimum fraction of crown area occupied 
+       !Config If    = OK_DGVM
+       !Config Def   = 0.05 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('MIN_COVER',min_cover)
+
+       !-
+       ! pftinout parameters
+       !
+       !Config Key   = IND_0 
+       !Config Desc  = initial density of individuals
+       !Config If    = OK_DGVM
+       !Config Def   = 0.02 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('IND_0',ind_0)
+       !
+       !Config Key   = MIN_AVAIL
+       !Config Desc  = minimum availability
+       !Config If    = OK_DGVM
+       !Config Def   = 0.01
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('MIN_AVAIL',min_avail)
+       !
+       !Config Key   = RIP_TIME_MIN
+       !Config Desc  = 
+       !Config If    = OK_DGVM
+       !Config Def   = 1.25 
+       !Config Help  = 
+       !Config Units = [year]  
+       CALL getin_p('RIP_TIME_MIN',RIP_time_min)
+       !
+       !Config Key   = NPP_LONGTERM_INIT
+       !Config Desc  = 
+       !Config If    = OK_DGVM
+       !Config Def   = 10.
+       !Config Help  = 
+       !Config Units = [gC/m^2/year]
+       CALL getin_p('NPP_LONGTERM_INIT',npp_longterm_init)
+       !
+       !Config Key   = EVERYWHERE_INIT
+       !Config Desc  = 
+       !Config If    = OK_DGVM
+       !Config Def   = 0.05 
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('EVERYWHERE_INIT',everywhere_init)
+       
+       first_call = .FALSE.
+       
+    ENDIF
+    
+    
+  END SUBROUTINE config_dgvm_parameters
+
+
+!! ================================================================================================================================
+!! FUNCTION   : get_printlev
+!!
+!>\BRIEF        Read global PRINTLEV parmeter and local PRINTLEV_modname
+!!
+!! DESCRIPTION  : The first time this function is called the parameter PRINTLEV is read from run.def file. 
+!!                It is stored in the variable named printlev which is declared in constantes_var.f90. printlev 
+!!                can be accesed each module in ORCHIDEE which makes use of constantes_var module. 
+!!
+!!                This function also reads the parameter PRINTLEV_modname for run.def file. modname is the 
+!!                intent(in) character string to this function. If the variable is set in run.def file, the corresponding 
+!!                value is returned. Otherwise the value of printlev is returnd as default. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): The local output level for the module set as intent(in) argument.
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION get_printlev ( modname )
+
+    !! 0.1 Input arguments
+    CHARACTER(LEN=*), INTENT(IN) :: modname
+
+    !! 0.2 Returned variable
+    INTEGER       :: get_printlev
+
+    !! 0.3 Local variables
+    LOGICAL, SAVE :: first=.TRUE.
+
+!_ ================================================================================================================================
+
+    !! 1.0  Read the global PRINTLEV from run.def. This is only done at first call to this function. 
+    IF (first) THEN
+       ! Set default value for printlev
+       ! printlev is a public variable declared in constantes_var
+       printlev=1
+       !Config Key   = PRINTLEV
+       !Config Desc  = Print level for text output
+       !Config If    = 
+       !Config Help  = Possible values are:
+       !Config         0    No output, 
+       !Config         1    Minimum writing for long simulations, 
+       !Config         2    More basic information for long simulations, 
+       !Config         3    First debug level, 
+       !Config         4    Higher debug level
+       !Config Def   = 1
+       !Config Units = [0, 1, 2, 3, 4]
+       CALL getin_p('PRINTLEV',printlev)
+       first=.FALSE.
+
+       !Config Key   = PRINTLEV_modname
+       !Config Desc  = Specific print level of text output for the module "modname". Default as PRINTLEV.
+       !Config Def   = 1
+       !Config If    =
+       !Config Help  = Use this option to activate a different level of text output 
+       !Config         for a specific module. This can be activated for several modules 
+       !Config         at the same time. Use for example PRINTLEV_sechiba.
+       !Config Units = [0, 1, 2, 3, 4]
+    END IF
+
+    ! Set default value as the standard printlev
+    get_printlev=printlev
+    ! Read optional value from run.def file
+    CALL getin_p('PRINTLEV_'//modname, get_printlev)
+    
+  END FUNCTION get_printlev
+
+
+END MODULE constantes
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes_mtc.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes_mtc.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes_mtc.f90	(revision 5166)
@@ -0,0 +1,708 @@
+! =================================================================================================================================
+! MODULE       : constantes_mtc
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         This module contains the standard values of the parameters for the 13 metaclasses of vegetation used by ORCHIDEE.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): 
+!!
+!! REFERENCE(S)	: 
+!! - Kuppel, S. (2012): Doctoral Thesis, Assimilation de mesures de flux turbulents d'eau et de carbone dans un modÃšle de la biosphÃšre 
+!! continentale 
+!! - Kuppel, S., Peylin, P., Chevallier, F., Bacour, C., Maignan, F., and Richardson, A. D. (2012). Constraining a global ecosystem
+!! model with multi-site eddy-covariance data, Biogeosciences, 9, 3757-3776, DOI 10.5194/bg-9-3757-2012.
+!! - Wohlfahrt, G., M. Bahn, E. Haubner, I. Horak, W. Michaeler, K.Rottmar, U. Tappeiner, and A. Cemusca, 1999: Inter-specific 
+!! variation of the biochemical limitation to photosynthesis and related leaf traits of 30 species from mountain grassland 
+!! ecosystems under different land use. Plant Cell Environ., 22, 12811296.
+!! - Malhi, Y., Doughty, C., and Galbraith, D. (2011). The allocation of ecosystem net primary productivity in tropical forests, 
+!! Philosophical Transactions of the Royal Society B-Biological Sciences, 366, 3225-3245, DOI 10.1098/rstb.2011.0062.
+!! - Earles, J. M., Yeh, S., and Skog, K. E. (2012). Timing of carbon emissions from global forest clearance, Nature Climate Change, 2, 
+!! 682-685, Doi 10.1038/Nclimate1535.
+!! - Piao, S. L., Luyssaert, S., Ciais, P., Janssens, I. A., Chen, A. P., Cao, C., Fang, J. Y., Friedlingstein, P., Luo, Y. Q., and 
+!! Wang, S. P. (2010). Forest annual carbon cost: A global-scale analysis of autotrophic respiration, Ecology, 91, 652-661, 
+!! Doi 10.1890/08-2176.1.
+!! - Verbeeck, H., Peylin, P., Bacour, C., Bonal, D., Steppe, K., and Ciais, P. (2011). Seasonal patterns of co2 fluxes in amazon 
+!! forests: Fusion of eddy covariance data and the orchidee model, Journal of Geophysical Research-Biogeosciences, 116, 
+!! Artn G02018, Doi 10.1029/2010jg001544.
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_mtc
+
+  USE defprec
+  USE constantes
+
+  IMPLICIT NONE
+
+  !
+  ! METACLASSES CHARACTERISTICS
+  !
+
+  INTEGER(i_std), PARAMETER :: nvmc = 13                         !! Number of MTCS fixed in the code (unitless)
+
+  CHARACTER(len=34), PARAMETER, DIMENSION(nvmc) :: MTC_name = &  !! description of the MTC (unitless)
+  & (/ 'bare ground                       ', &          !  1
+  &    'tropical  broad-leaved evergreen  ', &          !  2
+  &    'tropical  broad-leaved raingreen  ', &          !  3
+  &    'temperate needleleaf   evergreen  ', &          !  4
+  &    'temperate broad-leaved evergreen  ', &          !  5
+  &    'temperate broad-leaved summergreen', &          !  6
+  &    'boreal    needleleaf   evergreen  ', &          !  7
+  &    'boreal    broad-leaved summergreen', &          !  8
+  &    'boreal    needleleaf   summergreen', &          !  9
+  &    '          C3           grass      ', &          ! 10
+  &    '          C4           grass      ', &          ! 11
+  &    '          C3           agriculture', &          ! 12
+  &    '          C4           agriculture'  /)         ! 13
+
+
+  !
+  ! VEGETATION STRUCTURE
+  !
+  INTEGER(i_std),PARAMETER, DIMENSION(nvmc) :: leaf_tab_mtc  =  &                 !! leaf type (1-4, unitless)
+  & (/  4,   1,   1,   2,   1,   1,   2,   &                                      !! 1=broad leaved tree, 2=needle leaved tree
+  &     1,   2,   3,   3,   3,   3   /)                                           !! 3=grass 4=bare ground
+
+  CHARACTER(len=6), PARAMETER, DIMENSION(nvmc) :: pheno_model_mtc  =  &  !! which phenology model is used? (tabulated) 
+  & (/  'none  ',   'none  ',   'moi   ',   'none  ',   'none  ',  &
+  &     'ncdgdd',   'none  ',   'ncdgdd',   'ngd   ',   'moigdd',  &
+  &     'moigdd',   'moigdd',   'moigdd'  /) 
+
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: is_tropical_mtc  =  &                       !! Is PFT tropical ? (true/false)
+  & (/ .FALSE.,   .TRUE.,    .TRUE.,    .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,  &
+  &    .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE. /)    
+
+  CHARACTER(LEN=5), PARAMETER, DIMENSION(nvmc) :: type_of_lai_mtc  =  &  !! Type of behaviour of the LAI evolution algorithm
+  & (/ 'inter', 'inter', 'inter', 'inter', 'inter',  &                   !! for each vegetation type. (unitless)
+  &    'inter', 'inter', 'inter', 'inter', 'inter',  &                   !! Value of type_of_lai : mean or interp
+  &    'inter', 'inter', 'inter' /)
+
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: natural_mtc =  &                         !! natural?  (true/false)
+  & (/ .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,    .TRUE.,   .TRUE.,  &
+  &    .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,   .FALSE.,   .FALSE.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: veget_ori_fixed_mtc  =  &  !! Value for veget_ori for tests in
+  & (/ 0.2,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                !! 0-dim simulations (0-1, unitless)
+  &    0.0,   0.0,   0.8,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: llaimax_mtc  =  &          !! laimax for maximum
+  & (/ 0.0,   8.0,   8.0,   4.0,   4.5,   4.5,   4.0,  &                !! See also type of lai interpolation
+  &    4.5,   4.0,   2.0,   2.0,   2.0,   2.0  /)                       !! @tex $(m^2.m^{-2})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: llaimin_mtc  = &           !! laimin for minimum lai
+  & (/ 0.0,   8.0,   0.0,   4.0,   4.5,   0.0,   4.0,  &                !! See also type of lai interpolation (m^2.m^{-2})
+  &    0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)                       !! @tex $(m^2.m^{-2})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: height_presc_mtc  =  &     !! prescribed height of vegetation (m)
+  & (/  0.0,   30.0,   30.0,   20.0,   20.0,   20.0,   15.0,  &         !! Value for height_presc : one for each vegetation type
+  &    15.0,   15.0,    0.5,    0.6,    1.0,    1.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: rveg_mtc  =  &             !! Potentiometer to set vegetation resistance (unitless)
+  & (/ 1.0,   1.0,   1.0,   1.0,   1.0,   1.0,   1.0,  &                !! Nathalie on March 28th, 2006 - from Fred Hourdin,
+  &    1.0,   1.0,   1.0,   1.0,   1.0,   1.0   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: sla_mtc  =  &                       !! specif leaf area @tex $(m^2.gC^{-1})$ @endtex
+  & (/ 1.5E-2,   1.53E-2,   2.6E-2,   9.26E-3,     2E-2,   2.6E-2,   9.26E-3,  &
+  &    2.6E-2,    1.9E-2,   2.6E-2,    2.6E-2,   2.6E-2,   2.6E-2  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: availability_fact_mtc  =  &     !! calculate mortality in lpj_gap
+  & (/ undef,   0.14,  0.14,   0.10,   0.10,   0.10,   0.05,  &
+  &     0.05,   0.05,  undef,  undef,  undef,  undef  /)
+
+  !
+  ! EVAPOTRANSPIRATION (sechiba)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: rstruct_const_mtc  =  &  !! Structural resistance.
+  & (/ 0.0,   25.0,   25.0,   25.0,   25.0,   25.0,   25.0,  &        !! @tex $(s.m^{-1})$ @endtex
+  &   25.0,   25.0,    2.5,    2.0,    2.0,    2.0   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: kzero_mtc  =  &                  !! A vegetation dependent constant used in the 
+  & (/    0.0,   12.E-5,   12.E-5,   12.E-5,   12.E-5,   25.E-5,   12.E-5,  & !! calculation  of the surface resistance. 
+  &    25.E-5,   25.E-5,   30.E-5,   30.E-5,   30.E-5,   30.E-5  /)           !! @tex $(kg.m^2.s^{-1})$ @endtex
+
+
+  !
+  ! WATER (sechiba)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: wmax_veg_mtc  =  &        !! Volumetric available soil water capacity in each PFT
+  & (/ 150.0,   150.0,   150.0,   150.0,   150.0,   150.0,   150.0,  & !! @tex $(kg.m^{-3} of soil)$ @endtex
+  &    150.0,   150.0,   150.0,   150.0,   150.0,   150.0  /)         
+                                                                      
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: humcste_ref4m  =  &       !! Root profile description for the different 
+  & (/ 5.0,   0.4,   0.4,   1.0,   0.8,   0.8,   1.0,  &               !! vegetations types. @tex $(m^{-1})$ @endtex
+  &    1.0,   0.8,   4.0,   1.0,   4.0,   1.0  /)                      !! These are the factor in the exponential which gets       
+                                                                       !! the root density as a function of depth
+                                                                       !! Values for zmaxh = 4.0  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: humcste_ref2m  =  &       !! Root profile description for the different
+  & (/ 5.0,   0.8,   0.8,   1.0,   0.8,   0.8,   1.0,  &               !! vegetations types.  @tex $(m^{-1})$ @endtex
+  &    1.0,   0.8,   4.0,   4.0,   4.0,   4.0  /)                      !! These are the factor in the exponential which gets       
+                                                                       !! the root density as a function of depth
+                                                                       !! Values for zmaxh = 2.0
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: throughfall_by_mtc  =  &  !! Fraction of rain intercepted by the canopy
+  & (/ 30.0,   30.0,   30.0,   30.0,   30.0,   30.0,   30.0,  &        !! (0-100, unitless)
+  &    30.0,   30.0,   30.0,   30.0,   30.0,   30.0  /)
+
+
+  !
+  ! ALBEDO (sechiba)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: snowa_aged_mtc  =  &    !! Minimum snow albedo value for each vegetation type
+  & (/ 0.35,    0.0,    0.0,   0.14,   0.14,   0.14,   0.14,  &      !! after aging (dirty old snow) (unitless)
+  &    0.14,   0.14,   0.18,   0.18,   0.18,   0.18  /)              !! Source : Values are from the Thesis of S. Chalita (1992)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: snowa_dec_mtc  =  &     !! Decay rate of snow albedo value for each vegetation type
+  & (/ 0.45,    0.0,    0.0,   0.06,   0.06,   0.11,   0.06,  &      !! as it will be used in condveg_snow (unitless)
+  &    0.11,   0.11,   0.52,   0.52,   0.52,   0.52  /)              !! Source : Values are from the Thesis of S. Chalita (1992)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alb_leaf_vis_mtc  =  &  !! leaf albedo of vegetation type, visible albedo 
+  & (/ 0.00,   0.04,   0.06,   0.06,   0.06,   0.06,   0.06,  &      !! (unitless)
+  &    0.06,   0.06,   0.10,   0.10,   0.10,   0.10  /) 
+!  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alb_leaf_vis_mtc  =  &  !! optimized set of parameter values, to be switched to after validation
+!  & (/ 0.00,   0.037,  0.047,  0.048,  0.06,   0.06,   0.06,  &      !! (values are different only for PFTs 2,3,4)
+!  &    0.06,   0.06,   0.10,   0.10,   0.10,   0.10  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alb_leaf_nir_mtc  =  &  !! leaf albedo of vegetation type, near infrared albedo
+  & (/ 0.00,   0.20,   0.22,   0.22,   0.22,   0.22,   0.22,  &      !! (unitless)
+  &    0.22,   0.22,   0.30,   0.30,   0.30,   0.30  /)
+!  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alb_leaf_nir_mtc  =  &  !! optimized set of parameter values, to be switched to after validation
+!  & (/ 0.00,   0.218,   0.198,   0.208,  0.197,   0.232,   0.2,  &   !! (for PFTs 2-13)
+!  &    0.217,  0.244,   0.246,   0.28,   0.291,   0.245  /)
+
+
+  !
+  ! SOIL - VEGETATION
+  !
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: pref_soil_veg_mtc  =  &       !! The soil tile number for each vegetation
+  & (/ 1,   2,   2,   2,   2,   2,   2,  &                                    
+  &    2,   2,   3,   3,   3,   3  /)                                         
+
+
+  !
+  ! PHOTOSYNTHESIS
+  !
+  !-
+  ! 1 .CO2
+  !-
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: is_c4_mtc  =  &                            !! flag for C4 vegetation types (true/false)
+  & (/ .FALSE.,  .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,  &
+  &    .FALSE.,  .FALSE.,   .FALSE.,   .TRUE.,    .FALSE.,   .TRUE.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: vcmax_fix_mtc  =  &     !! values used for vcmax when STOMATE is not
+  & (/  0.0,   40.0,   50.0,   30.0,   35.0,   40.0,   30.0,  &      !! activated @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+  &    40.0,   35.0,   60.0,   60.0,   70.0,   70.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: downregulation_co2_coeff_mtc  =  &  !! coefficient for CO2 downregulation 
+  & (/  0.0,   0.38,   0.38,   0.28,   0.28,   0.28,   0.22,  &
+  &     0.22,  0.22,   0.26,   0.26,   0.26,   0.26 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_KmC_mtc  = &            !! Energy of activation for KmC (J mol-1)
+  & (/undef,  79430.,  79430.,  79430.,  79430.,  79430.,  79430.,  &  !! See Medlyn et al. (2002) 
+  &  79430.,  79430.,  79430.,  79430.,  79430.,  79430.  /)           !! from Bernacchi al. (2001)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_KmO_mtc  = &            !! Energy of activation for KmO (J mol-1)
+  & (/undef,  36380.,  36380.,  36380.,  36380.,  36380.,  36380.,  &  !! See Medlyn et al. (2002) 
+  &  36380.,  36380.,  36380.,  36380.,  36380.,  36380.  /)           !! from Bernacchi al. (2001)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_gamma_star_mtc  = &     !! Energy of activation for gamma_star (J mol-1)
+  & (/undef,  37830.,  37830.,  37830.,  37830.,  37830.,  37830.,  &  !! See Medlyn et al. (2002) from Bernacchi al. (2001) 
+  &  37830.,  37830.,  37830.,  37830.,  37830.,  37830.  /)           !! for C3 plants - We use the same values for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_Vcmax_mtc  = &          !! Energy of activation for Vcmax (J mol-1)
+  & (/undef,  71513.,  71513.,  71513.,  71513.,  71513.,  71513.,  &  !! See Table 2 of Yin et al. (2009) for C4 plants
+  &  71513.,  71513.,  71513.,  67300.,  71513.,  67300.  /)           !! and Kattge & Knorr (2007) for C3 plants (table 3)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_Jmax_mtc  = &            !! Energy of activation for Jmax (J mol-1)
+  & (/undef,  49884.,  49884.,  49884.,  49884.,  49884.,  49884.,  &   !! See Table 2 of Yin et al. (2009) for C4 plants
+  &  49884.,  49884.,  49884.,  77900.,  49884.,  77900.  /)            !! and Kattge & Knorr (2007) for C3 plants (table 3)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: aSV_mtc     = &            !! a coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax (J K-1 mol-1)
+  & (/undef,  668.39,  668.39,  668.39,  668.39,  668.39,  668.39,  &   !! See Table 3 of Kattge & Knorr (2007)
+  &  668.39,  668.39,  668.39,  641.64,  668.39,  641.64  /)            !! For C4 plants, we assume that there is no
+                                                                        !! acclimation and that at for a temperature of 25Â°C, aSV is the same for both C4 and C3 plants (no strong jusitification - need further parametrization)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: bSV_mtc     = &            !! b coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax (J K-1 mol-1 Â°C-1)
+  & (/undef,   -1.07,   -1.07,   -1.07,   -1.07,   -1.07,   -1.07,  &   !! See Table 3 of Kattge & Knorr (2007)
+  &   -1.07,   -1.07,   -1.07,      0.,   -1.07,      0.  /)            !! We assume No acclimation term for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tphoto_min_mtc  =  &  !! minimum photosynthesis temperature (deg C) 
+  & (/  undef,   -4.0,    -4.0,   -4.0,   -4.0,   -4.0,   -4.0,  & 
+  &      -4.0,   -4.0,    -4.0,   -4.0,   -4.0,   -4.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tphoto_max_mtc  =  &  !! maximum photosynthesis temperature (deg C) 
+  & (/  undef,   55.0,    55.0,   55.0,   55.0,   55.0,   55.0,  & 
+  &      55.0,   55.0,    55.0,   55.0,   55.0,   55.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: aSJ_mtc     = &            !! a coefficient of the linear regression (a+bT) defining the Entropy term for Jmax (J K-1 mol-1)
+  & (/undef,  659.70,  659.70,  659.70,  659.70,  659.70,  659.70,  &   !! See Table 3 of Kattge & Knorr (2007)
+  &  659.70,  659.70,  659.70,    630.,  659.70,    630.  /)            !! and Table 2 of Yin et al. (2009) for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: bSJ_mtc     = &            !! b coefficient of the linear regression (a+bT) defining the Entropy term for Jmax (J K-1 mol-1 Â°C-1)
+  & (/undef,   -0.75,   -0.75,   -0.75,   -0.75,   -0.75,   -0.75,  &   !! See Table 3 of Kattge & Knorr (2007)
+  &   -0.75,   -0.75,   -0.75,      0.,   -0.75,      0.  /)            !! We assume no acclimation term for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: D_Vcmax_mtc  = &           !! Energy of deactivation for Vcmax (J mol-1)
+  & (/undef, 200000., 200000., 200000., 200000., 200000., 200000.,  &   !! Medlyn et al. (2002) also uses 200000. for C3 plants (same value than D_Jmax)
+  & 200000., 200000., 200000., 192000., 200000., 192000.  /)            !! 'Consequently', we use the value of D_Jmax for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: D_Jmax_mtc  = &            !! Energy of deactivation for Jmax (J mol-1)
+  & (/undef, 200000., 200000., 200000., 200000., 200000., 200000.,  &   !! See Table 2 of Yin et al. (2009)
+  & 200000., 200000., 200000., 192000., 200000., 192000.  /)            !! Medlyn et al. (2002) also uses 200000. for C3 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: E_Rd_mtc  = &              !! Energy of activation for Rd (J mol-1)
+  & (/undef,  46390.,  46390.,  46390.,  46390.,  46390.,  46390.,  &   !! See Table 2 of Yin et al. (2009)
+  &  46390.,  46390.,  46390.,  46390.,  46390.,  46390.  /)           
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: Vcmax25_mtc  =  &          !! Maximum rate of Rubisco activity-limited carboxylation at 25Â°C
+  & (/ undef,   65.0,    65.0,    45.0,   45.0,   55.0,   45.0,  &      !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+  &     45.0,   35.0,    70.0,    70.0,   70.0,   70.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: arJV_mtc    = &            !! a coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio (mu mol e- (mu mol CO2)-1)
+  & (/undef,    2.59,    2.59,    2.59,    2.59,    2.59,    2.59,  &   !! See Table 3 of Kattge & Knorr (2007)
+  &    2.59,    2.59,    2.59,   1.715,    2.59,   1.715  /)            !! For C4 plants, we assume that there is no
+                                                                        !! acclimation and that for a temperature of 25Â°C, aSV is the same for both C4 and C3 plants (no strong jusitification - need further parametrization)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: brJV_mtc    = &            !! b coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio ((mu mol e- (mu mol CO2)-1) (Â°C)-1)
+  & (/undef,  -0.035,  -0.035,  -0.035,  -0.035,  -0.035,  -0.035,  &   !! See Table 3 of Kattge & Knorr (2007)
+  &  -0.035,  -0.035,  -0.035,      0.,  -0.035,      0.  /)            !! We assume No acclimation term for C4 plants
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: KmC25_mtc  = &             !! MichaelisâMenten constant of Rubisco for CO2 at 25Â°C (ubar)
+  & (/undef,   404.9,   404.9,   404.9,   404.9,  404.9,   404.9,  &    !! See Table 2 of Yin et al. (2009) for C4
+  &   404.9,   404.9,   404.9,    650.,   404.9,   650.  /)             !! and Medlyn et al (2002) for C3
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: KmO25_mtc  = &             !! MichaelisâMenten constant of Rubisco for O2 at 25Â°C (ubar)
+  & (/undef, 278400., 278400., 278400., 278400., 278400., 278400.,  &   !! See Table 2 of Yin et al. (2009) for C4 plants and Medlyn et al. (2002) for C3
+  & 278400., 278400., 278400., 450000., 278400., 450000.  /)           
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: gamma_star25_mtc  = &      !! Ci-based CO2 compensation point in the absence of Rd at 25Â°C (ubar)
+  & (/undef,   42.75,   42.75,   42.75,   42.75,   42.75,   42.75,  &   !! See Medlyn et al. (2002) for C3 plants - For C4 plants, we use the same value (probably uncorrect)
+  &   42.75,   42.75,   42.75,   42.75,   42.75,   42.75  /)    
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: a1_mtc  = &                !! Empirical factor involved in the calculation of fvpd (-)
+  & (/undef,    0.85,    0.85,    0.85,    0.85,    0.85,  0.85,  &     !! See Table 2 of Yin et al. (2009)
+  &    0.85,    0.85,    0.85,    0.85,    0.85,    0.85  /)           
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: b1_mtc  = &                !! Empirical factor involved in the calculation of fvpd (-)
+  & (/undef,    0.14,    0.14,    0.14,    0.14,    0.14,  0.14,  &     !! See Table 2 of Yin et al. (2009)
+  &    0.14,    0.14,    0.14,    0.20,    0.14,    0.20  /)           
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: g0_mtc  = &                !! Residual stomatal conductance when irradiance approaches zero (mol CO2 mâ2 sâ1 barâ1)
+  & (/undef, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625,  &   !! Value from ORCHIDEE - No other reference.
+  & 0.00625, 0.00625, 0.00625, 0.01875, 0.00625, 0.01875  /)            !! modofy to account for the conversion for conductance to H2O to CO2 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: h_protons_mtc  = &         !! Number of protons required to produce one ATP (mol mol-1)
+  & (/undef,      4.,      4.,      4.,      4.,      4.,    4.,  &     !! See Table 2 of Yin et al. (2009) - h parameter
+  &      4.,      4.,      4.,      4.,      4.,      4.  /)           
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: fpsir_mtc = &              !! Fraction of PSII eâ transport rate 
+  & (/undef,   undef,   undef,   undef,   undef,  undef,  undef,  &     !! partitioned to the C4 cycle (-)
+  &   undef,   undef,   undef,     0.4,   undef,    0.4  /)             !! See Table 2 of Yin et al. (2009) - x parameter        
+ 
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: fQ_mtc = &                 !! Fraction of electrons at reduced plastoquinone 
+  & (/undef,   undef,   undef,   undef,   undef,  undef,  undef,  &     !! that follow the Q-cycle (-) - Values for C3 platns are not used
+  &   undef,   undef,   undef,      1.,   undef,     1.  /)             !! See Table 2 of Yin et al. (2009)          
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: fpseudo_mtc = &            !! Fraction of electrons at PSI that follow 
+  & (/undef,   undef,   undef,   undef,   undef,  undef,  undef,  &     !! pseudocyclic transport (-) - Values for C3 platns are not used
+  &   undef,   undef,   undef,     0.1,   undef,    0.1  /)             !! See Table 2 of Yin et al. (2009)    
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: kp_mtc = &                 !! Initial carboxylation efficiency of the PEP carboxylase (mol mâ2 sâ1 barâ1) 
+  & (/undef,   undef,   undef,   undef,   undef,  undef,  undef,  &     !! See Table 2 of Yin et al. (2009)
+  &   undef,   undef,   undef,     0.7,   undef,    0.7  /)                 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alpha_mtc = &              !! Fraction of PSII activity in the bundle sheath (-)
+  & (/undef,   undef,   undef,   undef,   undef,  undef,  undef,  &     !! See legend of Figure 6 of Yin et al. (2009)
+  &   undef,   undef,   undef,     0.1,   undef,    0.1  /)                 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: gbs_mtc = &                !! Bundle-sheath conductance (mol mâ2 sâ1 barâ1)
+  & (/undef,   undef,   undef,   undef,   undef,  undef,  undef,  &     !! See legend of Figure 6 of Yin et al. (2009)
+  &   undef,   undef,   undef,   0.003,   undef,  0.003  /)    
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: theta_mtc = &              !! Convexity factor for response of J to irradiance (-)
+  & (/undef,     0.7,     0.7,     0.7,     0.7,    0.7,    0.7,  &     !! See Table 2 of Yin et al. (2009) 
+  &     0.7,     0.7,     0.7,     0.7,     0.7,    0.7  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alpha_LL_mtc = &           !! Conversion efficiency of absorbed light into J at strictly limiting light (mol eâ (mol photon)â1)
+  & (/undef,     0.3,     0.3,     0.3,     0.3,    0.3,    0.3,  &     !! See comment from Yin et al. (2009) after eq. 4
+  &     0.3,     0.3,     0.3,     0.3,     0.3,    0.3  /)             !! alpha value from Medlyn et al. (2002)   
+                                                                        !! 0.093 mol CO2 fixed per mol absorbed photons
+                                                                        !! times 4 mol e- per mol CO2 produced
+    
+  !-
+  ! 2 .Stomate
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ext_coeff_mtc  =  &     !! extinction coefficient of the Monsi&Saeki
+  & (/ 0.5,   0.5,   0.5,   0.5,   0.5,   0.5,   0.5,  &             !! relationship (1953) (unitless)
+  &    0.5,   0.5,   0.5,   0.5,   0.5,   0.5  /)
+
+  !
+  ! ALLOCATION (stomate)
+  ! 
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: R0_mtc = &              !! Default root allocation (0-1, unitless)
+  & (/ undef,   0.30,   0.30,   0.30,   0.30,  0.30,    0.30, &
+  &     0.30,   0.30,   0.30,   0.30,   0.30,  0.30 /)                   
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: S0_mtc = &              !! Default sapwood allocation (0-1, unitless)
+  & (/ undef,   0.25,   0.25,   0.30,   0.30,  0.30,    0.30, &
+  &     0.30,   0.30,   0.30,   0.30,   0.30,  0.30 /)                   
+
+  !
+  ! RESPIRATION (stomate)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: frac_growthresp_mtc  =  &  !! fraction of GPP which is lost as growth respiration
+  & (/  undef,   0.28,   0.28,   0.28,   0.28,   0.28,   0.28,  &
+  &      0.28,   0.28,   0.28,   0.28,   0.28,   0.28  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: maint_resp_slope_c_mtc  =  &  !! slope of maintenance respiration coefficient (1/K),
+  & (/  undef,   0.20,   0.20,   0.16,   0.16,   0.16,   0.16,  &          !! constant c of aT^2+bT+c, tabulated
+  &      0.16,   0.16,   0.16,   0.12,   0.16,   0.12  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: maint_resp_slope_b_mtc  =  &  !! slope of maintenance respiration coefficient (1/K),
+  & (/  undef,   0.0,        0.0,   0.0,        0.0,   0.0,   0.0,  &      !! constant b of aT^2+bT+c, tabulated
+  &       0.0,   0.0,   -0.00133,   0.0,   -0.00133,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: maint_resp_slope_a_mtc  =  &  !! slope of maintenance respiration coefficient (1/K),
+  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                !! constant a of aT^2+bT+c, tabulated
+  &       0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_leaf_mtc  =   &                  !! maintenance respiration coefficient
+  & (/   undef,   2.35E-3,   2.62E-3,   1.01E-3,   2.35E-3,   2.62E-3,   1.01E-3,  &  !! at 0 deg C,for leaves, tabulated, 
+  &    2.62E-3,   2.05E-3,   2.62E-3,   2.62E-3,   2.62E-3,   2.62E-3  /)             !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_sapabove_mtc =  &                !! maintenance respiration coefficient 
+  & (/   undef,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,  &  !! at 0 deg C, for sapwood above,
+  &    1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4  /)             !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_sapbelow_mtc  =  &               !! maintenance respiration coefficient
+  & (/   undef,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,  &  !! at 0 deg C, for sapwood below, 
+  &    1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4  /)             !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_heartabove_mtc  =  &             !! maintenance respiration coefficient
+  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                           !! at 0 deg C, for heartwood above,
+  &       0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)                                  !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_heartbelow_mtc  =  &             !! maintenance respiration coefficient
+  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                           !! at 0 deg C, for heartwood below, 
+  &       0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)                                  !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_root_mtc  =  &                   !! maintenance respiration coefficient
+  & (/   undef,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,  &  !! at 0 deg C, for roots, tabulated,
+  &    1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3  /)             !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_fruit_mtc  =  &                  !! maintenance respiration coefficient
+  & (/   undef,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,  &  !! at 0 deg C, for fruits, tabulated,
+  &    1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4  /)             !!  @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_carbres_mtc  =  &                !! maintenance respiration coefficient
+  & (/   undef,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,  &  !! at 0 deg C, for carbohydrate reserve,
+  &    1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4  /)             !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+
+
+  !
+  ! FIRE (stomate)
+  !
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: flam_mtc  =  &         !! flamability: critical fraction of water 
+  & (/  undef,   0.15,   0.25,   0.25,   0.25,   0.25,   0.25,  &  !! holding capacity (0-1, unitless)
+  &      0.25,   0.25,   0.25,   0.25,   0.35,   0.35  /)
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: resist_mtc  =  &       !! fire resistance (0-1, unitless)
+  & (/ undef,   0.95,   0.90,   0.90,   0.90,   0.90,   0.90,  &
+  &    0.90,    0.90,    0.0,    0.0,    0.0,    0.0 /) 
+
+
+  !
+  ! FLUX - LUC
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_1_mtc  =  &   !! Coeff of biomass export for the year
+  & (/  undef,   0.897,   0.897,   0.597,   0.597,   0.597,   0.597,  &   !! (0-1, unitless)
+  &     0.597,   0.597,   0.597,   0.597,   0.597,   0.597  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_10_mtc  =  &  !! Coeff of biomass export for the decade 
+  & (/  undef,   0.103,   0.103,   0.299,   0.299,   0.299,   0.299,  &   !! (0-1, unitless)
+  &     0.299,   0.299,   0.299,   0.403,   0.299,   0.403  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_100_mtc  =  & !! Coeff of biomass export for the century
+  & (/  undef,     0.0,     0.0,   0.104,   0.104,   0.104,   0.104,  &   !! (0-1, unitless)
+  &     0.104,   0.104,   0.104,     0.0,   0.104,     0.0  /)
+
+
+  !
+  ! PHENOLOGY
+  !
+  !-
+  ! 1. Stomate
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: lai_max_to_happy_mtc  =  &  !! threshold of LAI below which plant uses carbohydrate reserves
+  & (/  undef,   0.5,   0.5,   0.5,   0.5,   0.5,   0.5,  &
+  &       0.5,   0.5,   0.5,   0.5,   0.5,   0.5  /)
+
+  REAL(r_std), PARAMETER, DIMENSION (nvmc) :: lai_max_mtc  =  &          !! maximum LAI, PFT-specific 
+  & (/ undef,   7.0,   7.0,   5.0,   5.0,   5.0,   4.5,  &               !! @tex $(m^2.m^{-2})$ @endtex
+  &      4.5,   3.0,   2.5,   2.5,   5.0,   5.0  /)
+
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: pheno_type_mtc  =  &     !! type of phenology (0-4, unitless)
+  & (/  0,   1,   3,   1,   1,   2,   1,  &                              !! 0=bare ground 1=evergreen,  2=summergreen, 
+  &     2,   2,   4,   4,   2,   3  /)                                   !! 3=raingreen,  4=perennial
+  !-
+  ! 2. Leaf Onset
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_gdd_crit_c_mtc  =  &    !! critical gdd, tabulated (C),
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &    !! constant c of aT^2+bT+c
+  &     undef,   undef,   320.0,   400.0,   320.0,   700.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_gdd_crit_b_mtc  =  &    !! critical gdd, tabulated (C),
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &    !! constant b of aT^2+bT+c
+  &     undef,   undef,    6.25,     0.0,    6.25,     0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_gdd_crit_a_mtc  =  &    !! critical gdd, tabulated (C),
+  & (/  undef,   undef,     undef,   undef,   undef,   undef,   undef,  &  !! constant a of aT^2+bT+c
+  &     undef,   undef,   0.03125,     0.0,  0.0315,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_moigdd_t_crit_mtc  = &  !! temperature threshold for C4 grass(C)
+  & (/  undef,   undef,     undef,   undef,   undef,   undef,   undef,  &  
+  &     undef,   undef,     undef,    22.0,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ngd_crit_mtc  =  &            !! critical ngd, tabulated. 
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &    !! Threshold -5 degrees (days)
+  &     undef,    17.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ncdgdd_temp_mtc  =  &         !! critical temperature for the ncd vs. gdd 
+  & (/  undef,   undef,   undef,   undef,   undef,     5.0,   undef,  &    !! function in phenology (C)
+  &       0.0,   undef,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: hum_frac_mtc  =  &            !! critical humidity (relative to min/max) 
+  & (/  undef,   undef,   0.5,   undef,   undef,   undef,   undef, &       !! for phenology (unitless)
+  &     undef,   undef,   0.5,     0.5,     0.5,     0.5  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: hum_min_time_mtc  =  &        !! minimum time elapsed since
+  & (/  undef,   undef,   50.0,   undef,   undef,   undef,   undef,  &     !! moisture minimum (days)
+  &     undef,   undef,   35.0,    35.0,    75.0,    75.0  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_sap_mtc  =  &             !! time (days)  
+  & (/  undef,   730.0,   730.0,   730.0,   730.0,   730.0,   730.0,  &
+  &     730.0,   730.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_leafinit_mtc  =  &  !! time to attain the initial foliage using the carbohydrate reserve
+  & (/  undef,   10.,   10.,   10.,   10.,   10.,   10.,  &
+  &       10.,   10.,   10.,   10.,   10.,   10.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_fruit_mtc  =  &           !! fruit lifetime (days)
+  & (/  undef,  90.0,    90.0,    90.0,    90.0,   90.0,   90.0,  &
+  &      90.0,  90.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ecureuil_mtc  =  &            !! fraction of primary leaf and root allocation
+  & (/  undef,   0.0,   1.0,   0.0,   0.0,   1.0,   0.0,  &                !! put into reserve (0-1, unitless)
+  &       1.0,   1.0,   1.0,   1.0,   1.0,   1.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alloc_min_mtc  =  &           !! NEW - allocation above/below = f(age) 
+  & (/  undef,   0.2,     0.2,     0.2,     0.2,    0.2,   0.2,  &         !! - 30/01/04 NV/JO/PF
+  &       0.2,   0.2,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alloc_max_mtc  =  &           !! NEW - allocation above/below = f(age) 
+  & (/  undef,   0.8,     0.8,     0.8,     0.8,    0.8,   0.8,  &         !! - 30/01/04 NV/JO/PF
+  &       0.8,   0.8,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: demi_alloc_mtc  =  &          !! NEW - allocation above/below = f(age) 
+  & (/  undef,   5.0,     5.0,     5.0,     5.0,    5.0,   5.0,  &         !! - 30/01/04 NV/JO/PF
+  &       5.0,   5.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaflife_mtc  =  &            !! leaf longevity, tabulated (??units??)
+  & (/  undef,   0.5,   2.0,   0.33,   1.0,   2.0,   0.33,  &
+  &       2.0,   2.0,   2.0,   2.0,    2.0,   2.0  /)
+  !-
+  ! 3. Senescence
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaffall_mtc  =  &             !! length of death of leaves, tabulated (days)
+  & (/  undef,   undef,   10.0,   undef,   undef,   10.0,   undef,  &
+  &      10.0,    10.0,   10.0,    10.0,    10.0,   10.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leafagecrit_mtc  =  &          !! critical leaf age, tabulated (days)
+  & (/  undef,   730.0,   180.0,   910.0,   730.0,   180.0,   910.0,  &
+  &     180.0,   180.0,   120.0,   120.0,    90.0,    90.0  /)
+
+  CHARACTER(LEN=6), PARAMETER, DIMENSION(nvmc) :: senescence_type_mtc  =  & !! type of senescence, tabulated (unitless)
+  & (/  'none  ',  'none  ',   'dry   ',  'none  ',  'none  ',  &
+  &     'cold  ',  'none  ',   'cold  ',  'cold  ',  'mixed ',  &
+  &     'mixed ',  'mixed ',   'mixed '            /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_hum_mtc  =  &       !! critical relative moisture availability
+  & (/  undef,   undef,   0.3,   undef,   undef,   undef,   undef,  &       !! for senescence (0-1, unitless)
+  &     undef,   undef,   0.2,     0.2,     0.3,     0.2  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: nosenescence_hum_mtc  =  &     !! relative moisture availability above which 
+  & (/  undef,   undef,   0.8,   undef,   undef,   undef,   undef,  &       !! there is no humidity-related senescence
+  &     undef,   undef,   0.3,     0.3,     0.3,     0.3  /)                !! (0-1, unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: max_turnover_time_mtc  =  &    !! maximum turnover time for grasses (days)
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &
+  &     undef,   undef,    80.0,    80.0,    80.0,    80.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: min_turnover_time_mtc  =  &    !! minimum turnover time for grasses (days)
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &
+  &     undef,   undef,    10.0,    10.0,    10.0,    10.0  /)
+ 
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: min_leaf_age_for_senescence_mtc  =  &  !! minimum leaf age to allow 
+  & (/  undef,   undef,   90.0,   undef,   undef,   90.0,   undef,  &               !! senescence g (days)
+  &      60.0,    60.0,   30.0,    30.0,    30.0,   30.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_temp_c_mtc  =  &    !! critical temperature for senescence (C)
+  & (/  undef,   undef,    undef,   undef,   undef,   12.0,   undef,  &     !! constant c of aT^2+bT+c, tabulated
+  &       7.0,     2.0,   -1.375,     5.0,    5.0,    10.0  /)              !! (unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_temp_b_mtc  =  &    !! critical temperature for senescence (C), 
+  & (/  undef,   undef,   undef,   undef,   undef,   0.0,   undef,  &       !! constant b of aT^2+bT+c, tabulated
+  &       0.0,     0.0,     0.1,     0.0,     0.0,   0.0  /)                !! (unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_temp_a_mtc  =  &    !! critical temperature for senescence (C), 
+  & (/  undef,   undef,     undef,   undef,   undef,   0.0,   undef,  &     !! constant a of aT^2+bT+c, tabulated
+  &       0.0,     0.0,   0.00375,     0.0,     0.0,   0.0  /)              !! (unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: gdd_senescence_mtc  =  &       !! minimum gdd to allow senescence of crops (days)
+  & (/  undef,   undef,    undef,   undef,     undef,    undef,    undef,  &
+  &     undef,   undef,    undef,   undef,      950.,    4000.  /)
+
+
+  !
+  ! DGVM
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: residence_time_mtc  =  &    !! residence time of trees (years)
+  & (/  undef,   30.0,   30.0,   40.0,   40.0,   40.0,   80.0,  &
+  &      80.0,   80.0,    0.0,    0.0,    0.0,    0.0  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tmin_crit_mtc  =  &
+  & (/  undef,     0.0,     0.0,   -30.0,   -14.0,   -30.0,   -45.0,  &  !! critical tmin, tabulated (C)
+  &     -45.0,   undef,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tcm_crit_mtc  =  &
+  & (/  undef,   undef,   undef,     5.0,    15.5,    15.5,   -8.0,  &   !! critical tcm, tabulated (C)
+  &      -8.0,    -8.0,   undef,   undef,   undef,   undef  /)
+
+
+
+  !
+  ! Biogenic Volatile Organic Compounds
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_isoprene_mtc = &     !! Isoprene emission factor 
+  & (/  0.,    24.,   24.,    8.,   16.,   45.,   8.,  &                    !!
+  &    18.,    0.5,   12.,   18.,    5.,    5.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_monoterpene_mtc = &  !! Monoterpene emission factor
+  & (/   0.,   2.0,    2.0,   1.8,    1.4,    1.6,    1.8,  &               !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    1.4,    1.8,    0.8,   0.8,    0.22,     0.22  /)
+
+  REAL(r_std), PARAMETER :: LDF_mono_mtc = 0.6                                  !! monoterpenes fraction dependancy to light
+  REAL(r_std), PARAMETER :: LDF_sesq_mtc = 0.5                                  !! sesquiterpenes fraction dependancy to light
+  REAL(r_std), PARAMETER :: LDF_meth_mtc = 0.8                                  !! methanol fraction dependancy to light
+  REAL(r_std), PARAMETER :: LDF_acet_mtc = 0.2                                  !! acetone fraction dependancy to light
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_apinene_mtc = &      !! Alfa pinene emission factor percentage
+  & (/   0.,   0.395,   0.395,   0.354,   0.463,   0.326,   0.354, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.316,   0.662,   0.231,   0.200,   0.277,   0.277 /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_bpinene_mtc = &      !! Beta pinene emission factor  percentage      
+  & (/   0.,   0.110,   0.110,   0.146,   0.122,   0.087,   0.146, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.063,   0.150,   0.123,   0.080,   0.154,   0.154  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_limonene_mtc = &     !! Limonene emission factor percentage
+  & (/   0.,   0.092,   0.092,   0.083,   0.122,   0.061,   0.083, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.071,   0.037,   0.146,   0.280,   0.092,   0.092  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_myrcene_mtc = &      !! Myrcene emission factor percentage
+  & (/   0.,   0.073,   0.073,   0.050,   0.054,   0.028,   0.050, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.019,   0.025,   0.062,   0.057,   0.046,   0.046  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_sabinene_mtc = &     !! Sabinene emission factor percentage
+  & (/   0.,   0.073,   0.073,   0.050,   0.083,   0.304,   0.050, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.263,   0.030,   0.065,   0.050,   0.062,   0.062  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_camphene_mtc = &     !! Camphene emission factor percentage
+  & (/   0.,   0.055,   0.055,   0.042,   0.049,   0.004,   0.042, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.005,   0.023,   0.054,   0.053,   0.031,   0.031  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_3carene_mtc = &      !! 3-carene emission factor percentage
+  & (/   0.,   0.048,   0.048,   0.175,   0.010,   0.024,   0.175, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.013,   0.042,   0.065,   0.057,   0.200,   0.200  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_tbocimene_mtc = &    !! T-beta-ocimene emission factor percentage
+  & (/   0.,   0.092,   0.092,   0.054,   0.044,   0.113,   0.054, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.105,   0.028,   0.138,   0.120,   0.031,   0.031  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_othermonot_mtc = &   !! Other monoterpenes emission factor percentage
+  & (/   0.,   0.062,   0.062,   0.046,   0.054,   0.052,   0.046, &        !! ATTENTION: for each PFT they are PERCENTAGE of monoterpene EF
+  &   0.144,   0.003,   0.115,   0.103,   0.108,   0.108  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_sesquiterp_mtc = &   !! Sesquiterpene emission factor
+  & (/   0.,  0.45,   0.45,   0.13,   0.30,   0.36,   0.15, &               !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    0.30,  0.25,   0.60,   0.60,   0.08,   0.08  /)
+
+  REAL(r_std), PARAMETER :: beta_mono_mtc = 0.10                            !! Monoterpenes temperature dependency coefficient 
+  REAL(r_std), PARAMETER :: beta_sesq_mtc = 0.17                            !! Sesquiterpenes temperature dependency coefficient 
+  REAL(r_std), PARAMETER :: beta_meth_mtc = 0.08                            !! Methanol temperature dependency coefficient 
+  REAL(r_std), PARAMETER :: beta_acet_mtc = 0.10                            !! Acetone temperature dependency coefficient 
+  REAL(r_std), PARAMETER :: beta_oxyVOC_mtc = 0.13                          !! Other oxygenated BVOC temperature dependency coefficient 
+
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_ORVOC_mtc = &        !! ORVOC emissions factor 
+  &  (/  0.,    1.5,    1.5,    1.5,    1.5,   1.5,    1.5,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &     1.5,    1.5,    1.5,    1.5,    1.5,   1.5  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_OVOC_mtc = &         !! OVOC emissions factor 
+  &  (/  0.,    1.5,    1.5,    1.5,    1.5,   1.5,    1.5,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &     1.5,    1.5,    1.5,    1.5,    1.5,   1.5  /)
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_MBO_mtc = &          !! MBO emissions factor
+  & (/     0., 2.e-5, 2.e-5,   1.4, 2.e-5, 2.e-5, 0.14,  &                  !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &     2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5  /)  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_methanol_mtc = &     !! Methanol emissions factor 
+  & (/  0.,    0.8,   0.8,   1.8,   0.9,   1.9,   1.8,  &                   !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    1.8,    1.8,   0.7,   0.9,    2.,     2.  /)  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_acetone_mtc = &      !! Acetone emissions factor
+  & (/  0.,   0.25,   0.25,   0.30,   0.20,   0.33,   0.30,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.25,   0.25,   0.20,   0.20,   0.08,   0.08  /)
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_acetal_mtc = &       !! Acetaldehyde emissions factor 
+  & (/  0.,   0.2,    0.2,     0.2,   0.2,   0.25,   0.25,   0.16,   &      !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.16,   0.12,   0.12,   0.035,   0.020  /)  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_formal_mtc = &       !! Formaldehyde emissions factor
+  & (/  0.,   0.04,   0.04,  0.08,    0.04,    0.04,  0.04,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.04,   0.04,  0.025, 0.025,   0.013,   0.013  /)  
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_acetic_mtc = &       !! Acetic Acid emissions factor
+  & (/   0.,   0.025,   0.025,   0.025,   0.022,   0.08,   0.025,   &      !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.022,   0.013,   0.012,   0.012,   0.008,   0.008  /)  
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_formic_mtc = &       !! Formic Acid emissions factor
+  & (/  0.,  0.015,  0.015,   0.02,    0.02,   0.025,  0.025,  &            !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &  0.015,  0.015,  0.010,  0.010,   0.008,   0.008  /)  
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: em_factor_no_wet_mtc = &        !! NOx emissions factor soil emissions and exponential
+  & (/  0.,   2.6,   0.06,   0.03,   0.03,   0.03,   0.03,  &               !! dependancy factor for wet soils
+  &  0.03,   0.03,   0.36,   0.36,   0.36,   0.36  /)                       !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: em_factor_no_dry_mtc = &        !! NOx emissions factor soil emissions and exponential
+  & (/  0.,   8.60,   0.40,   0.22,   0.22,   0.22,   0.22,  &              !! dependancy factor for dry soils
+  &   0.22,   0.22,   2.65,   2.65,   2.65,   2.65  /)                      !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: Larch_mtc = &                  !! Larcher 1991 SAI/LAI ratio (unitless)
+  & (/   0.,   0.015,   0.015,   0.003,   0.005,   0.005,   0.003,  &
+  &   0.005,   0.003,   0.005,   0.005,   0.008,   0.008  /)  
+
+
+
+END MODULE constantes_mtc
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes_soil.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes_soil.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes_soil.f90	(revision 5166)
@@ -0,0 +1,449 @@
+! =================================================================================================================================
+! MODULE 	: constantes_soil
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "constantes_soil" module contains subroutine to initialize the parameters related to soil and hydrology.
+!!
+!!\n DESCRIPTION : "constantes_soil" module contains subroutine to initialize the parameters related to soil and hydrology.
+!!                 This module alos USE constates_soil and can therfor be used to acces the subroutines and the constantes.
+!!                 The constantes declarations can also be used seperatly with "USE constantes_soil_var".
+!!
+!! RECENT CHANGE(S): 
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_soil
+
+  USE constantes_soil_var
+  USE constantes
+  USE ioipsl_para 
+
+  IMPLICIT NONE
+
+CONTAINS
+
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : config_soil_parameters
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters related to soil and hydrology. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE config_soil_parameters()
+     
+     USE ioipsl
+
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+    !! 0.4 Local variables 
+
+     INTEGER(i_std), PARAMETER      :: error_level = 3         !! Switch to 2 to turn fatal errors into warnings.(1-3, unitless)
+     LOGICAL, SAVE                  :: first_call = .TRUE.     !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+     LOGICAL                        :: ok_freeze               !! Local variable used to set default values for all flags 
+                                                               !! controling the soil freezing scheme
+
+!_ ================================================================================================================================
+     
+     IF ( first_call ) THEN
+
+        ! Following initializations are only done for option impose_param
+        IF ( ok_sechiba .AND. impose_param ) THEN
+
+        !Config Key   = DRY_SOIL_HEAT_CAPACITY
+        !Config Desc  = Dry soil Heat capacity of soils
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 1.80e+6
+        !Config Help  = Values taken from : PIELKE,'MESOSCALE METEOROLOGICAL MODELING',P.384.
+        !Config Units = [J.m^{-3}.K^{-1}] 
+        CALL getin_p("DRY_SOIL_HEAT_CAPACITY",so_capa_dry)
+        
+        !! Check parameter value (correct range)
+        IF ( so_capa_dry <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                &     "Wrong parameter value for DRY_SOIL_HEAT_CAPACITY.", &
+                &     "This parameter should be positive. ", &
+                &     "Please, check parameter value in run.def. ")
+        END IF
+        
+
+        !Config Key   = DRY_SOIL_HEAT_COND
+        !Config Desc  = Dry soil Thermal Conductivity of soils
+        !Config If    = OK_SECHIBA
+        !Config Def   = 0.40 
+        !Config Help  = Values taken from : PIELKE,'MESOSCALE METEOROLOGICAL MODELING',P.384.
+        !Config Units = [W.m^{-2}.K^{-1}] 
+        CALL getin_p("DRY_SOIL_HEAT_COND",so_cond_dry)
+
+        !! Check parameter value (correct range)
+        IF ( so_cond_dry <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                &     "Wrong parameter value for DRY_SOIL_HEAT_COND.", &
+                &     "This parameter should be positive. ", &
+                &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        !Config Key   = WET_SOIL_HEAT_CAPACITY
+        !Config Desc  = Wet soil Heat capacity of soils 
+        !Config If    = OK_SECHIBA
+        !Config Def   = 3.03e+6
+        !Config Help  = 
+        !Config Units = [J.m^{-3}.K^{-1}]
+        CALL getin_p("WET_SOIL_HEAT_CAPACITY",so_capa_wet)
+
+        !! Check parameter value (correct range)
+        IF ( so_capa_wet <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+               &     "Wrong parameter value for WET_SOIL_HEAT_CAPACITY.", &
+               &     "This parameter should be positive. ", &
+               &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        !Config Key   = WET_SOIL_HEAT_COND
+        !Config Desc  = Wet soil Thermal Conductivity of soils
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 1.89 
+        !Config Help  = 
+        !Config Units = [W.m^{-2}.K^{-1}]
+        CALL getin_p("WET_SOIL_HEAT_COND",so_cond_wet)
+
+        !! Check parameter value (correct range)
+        IF ( so_cond_wet <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+               &     "Wrong parameter value for WET_SOIL_HEAT_COND.", &
+               &     "This parameter should be positive. ", &
+               &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        !Config Key   = SNOW_HEAT_COND
+        !Config Desc  = Thermal Conductivity of snow
+        !Config If    = OK_SECHIBA  
+        !Config Def   = 0.3
+        !Config Help  = 
+        !Config Units = [W.m^{-2}.K^{-1}]
+        CALL getin_p("SNOW_HEAT_COND",sn_cond)
+
+        !! Check
+        IF ( sn_cond <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+               &     "Wrong parameter value for SNOW_HEAT_COND.", &
+               &     "This parameter should be positive. ", &
+               &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        !Config Key   = SNOW_DENSITY
+        !Config Desc  = Snow density for the soil thermodynamics 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 330.0
+        !Config Help  = 
+        !Config Units = [-] 
+        CALL getin_p("SNOW_DENSITY",sn_dens)
+        
+        !! Check parameter value (correct range)
+        IF ( sn_dens <= zero ) THEN
+          CALL ipslerr_p(error_level, "config_soil_parameters.", &
+               &     "Wrong parameter value for SNOW_DENSITY.", &
+               &     "This parameter should be positive. ", &
+               &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        !! Calculation of snow capacity
+        !! If sn_dens is redefined by the user, sn_capa needs to be reset
+        sn_capa = 2100.0_r_std*sn_dens
+
+
+        !Config Key   = NOBIO_WATER_CAPAC_VOLUMETRI
+        !Config Desc  = 
+        !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR)
+        !Config Def   = 150.
+        !Config Help  = 
+        !Config Units = [s/m^2]
+        CALL getin_p('NOBIO_WATER_CAPAC_VOLUMETRI',mx_eau_nobio)
+
+       !! Check parameter value (correct range)
+        IF ( mx_eau_nobio <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+               &     "Wrong parameter value for NOBIO_WATER_CAPAC_VOLUMETRI.", &
+               &     "This parameter should be positive. ", &
+               &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        !Config Key   = SECHIBA_QSINT 
+        !Config Desc  = Interception reservoir coefficient
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.1
+        !Config Help  = Transforms leaf area index into size of interception reservoir
+        !Config         for slowproc_derivvar or stomate
+        !Config Units = [m]
+        CALL getin_p('SECHIBA_QSINT',qsintcst)
+
+        !! Check parameter value (correct range)
+        IF ( qsintcst <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                &     "Wrong parameter value for SECHIBA_QSINT.", &
+                &     "This parameter should be positive. ", &
+                &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        IF ( .NOT.(hydrol_cwrr) ) THEN
+           
+           !Config Key   = CHOISNEL_DIFF_MIN
+           !Config Desc  = Diffusion constant for the slow regime
+           !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR)
+           !Config Def   = 0.001
+           !Config Help  = 
+           !Config Units = [kg/m^2/dt]
+           CALL getin_p('CHOISNEL_DIFF_MIN',min_drain)
+
+           !! Check parameter value (correct range)
+           IF ( min_drain <= zero ) THEN
+              CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                   &     "Wrong parameter value for CHOISNEL_DIFF_MIN.", &
+                   &     "This parameter should be positive. ", &
+                   &     "Please, check parameter value in run.def. ")
+            END IF
+
+
+           !Config Key   = CHOISNEL_DIFF_MAX
+           !Config Desc  = Diffusion constant for the fast regime
+           !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR)
+           !Config Def   = 0.1
+           !Config Help  = 
+           !Config Units = [kg/m^2/dt]
+           CALL getin_p('CHOISNEL_DIFF_MAX',max_drain)
+
+           !! Check parameter value (correct range)
+           IF (  ( max_drain <= zero ) .OR. ( max_drain <= min_drain ) ) THEN
+              CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                   &     "Wrong parameter value for CHOISNEL_DIFF_MAX.", &
+                   &     "This parameter should be positive or greater than CHOISNEL_DIFF_MIN.", &
+                   &     "Please, check parameter value in run.def. ")
+           END IF
+
+
+           !Config Key   = CHOISNEL_DIFF_EXP
+           !Config Desc  = The exponential in the diffusion law
+           !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR)
+           !Config Def   = 1.5
+           !Config Help  = 
+           !Config Units = [-]
+           CALL getin_p('CHOISNEL_DIFF_EXP',exp_drain)
+           
+           !! Check parameter value (correct range)
+           IF ( exp_drain <= zero ) THEN
+              CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                   &     "Wrong parameter value for CHOISNEL_DIFF_EXP.", &
+                   &     "This parameter should be positive. ", &
+                   &     "Please, check parameter value in run.def. ")
+           END IF
+
+
+           !Config Key   = CHOISNEL_RSOL_CSTE
+           !Config Desc  = Constant in the computation of resistance for bare  soil evaporation 
+           !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR)
+           !Config Def   = 33.E3
+           !Config Help  = 
+           !Config Units = [s/m^2]
+           CALL getin_p('CHOISNEL_RSOL_CSTE',rsol_cste)
+
+           !! Check parameter value (correct range)
+           IF ( rsol_cste <= zero ) THEN
+              CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                   &     "Wrong parameter value for CHOISNEL_RSOL_CSTE.", &
+                   &     "This parameter should be positive. ", &
+                   &     "Please, check parameter value in run.def. ")
+           END IF
+
+
+           !Config Key   = HCRIT_LITTER
+           !Config Desc  = Scaling depth for litter humidity
+           !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR) 
+           !Config Def   = 0.08 
+           !Config Help  = 
+           !Config Units = [m]
+           CALL getin_p('HCRIT_LITTER',hcrit_litter)
+
+           !! Check parameter value (correct range)
+           IF ( hcrit_litter <= zero ) THEN
+              CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                   &     "Wrong parameter value for HCRIT_LITTER.", &
+                   &     "This parameter should be positive. ", &
+                   &     "Please, check parameter value in run.def. ")
+           END IF
+
+        END IF
+     
+        END IF ! IF ( ok_sechiba .AND. impose_param ) THEN
+
+
+
+        !! Variables related to soil freezing in thermosoil module
+        !
+        !Config Key  = OK_FREEZE
+        !Config Desc = Activate the complet soil freezing scheme
+        !Config If   = OK_SECHIBA 
+        !Config Def  = FALSE
+        !Config Help = Activate soil freezing thermal effects. Activates soil freezing hydrological effects in CWRR scheme.
+        !Config Units= [FLAG]
+
+        ! ok_freeze is a flag that controls the default values for several flags controling 
+        ! the different soil freezing processes
+        ! Set ok_freeze=true for the complete soil freezing scheme
+        ! ok_freeze is a local variable only used in this subroutine
+        ok_freeze = .FALSE.
+        CALL getin_p('OK_FREEZE',ok_freeze)
+
+
+        !Config Key  = READ_REFTEMP
+        !Config Desc = Initialize soil temperature using climatological temperature
+        !Config If   = 
+        !Config Def  = True/False depening on OK_FREEZE
+        !Config Help = 
+        !Config Units= [FLAG]
+
+        IF (ok_freeze) THEN
+           read_reftemp = .TRUE.
+        ELSE
+           read_reftemp = .FALSE.
+        END IF
+        CALL getin_p ('READ_REFTEMP',read_reftemp)
+
+        !Config Key  = OK_FREEZE_THERMIX
+        !Config Desc = Activate thermal part of the soil freezing scheme
+        !Config If   = 
+        !Config Def  = True if OK_FREEZE else false
+        !Config Help = 
+        !Config Units= [FLAG]
+
+        IF (ok_freeze) THEN
+           ok_freeze_thermix = .TRUE.
+        ELSE
+           ok_freeze_thermix = .FALSE.
+        END IF
+        CALL getin_p ('OK_FREEZE_THERMIX',ok_freeze_thermix)
+
+
+        !Config Key  = OK_ECORR
+        !Config Desc = Energy correction for freezing
+        !Config If   = OK_FREEZE_THERMIX
+        !Config Def  = True if OK_FREEZE else false
+        !Config Help = Energy conservation : Correction to make sure that the same latent heat is 
+        !Config        released and consumed during freezing and thawing
+        !Config Units= [FLAG]
+        IF (ok_freeze) THEN
+           ok_Ecorr = .TRUE.
+        ELSE
+           ok_Ecorr = .FALSE.
+        END IF
+        CALL getin_p ('OK_ECORR',ok_Ecorr)
+        IF (ok_Ecorr .AND. .NOT. ok_freeze_thermix) THEN
+           CALL ipslerr_p(3,'thermosoil_init','OK_ECORR cannot be activated without OK_FREEZE_THERMIX', &
+                'Adapt run parameters with OK_FREEZE_THERMIX=y','')
+        END IF
+
+        !Config Key = POROS
+        !Config Desc = Soil porosity 
+        !Config If = OK_SECHIBA
+        !Config Def = 0.41
+        !Config Help = From USDA classification, mean value
+        !Config Units = [-] 
+        poros=0.41
+        CALL getin_p('POROS',poros)
+
+
+        !Config Key = fr_dT
+        !Config Desc = Freezing window    
+        !Config If = OK_SECHIBA
+        !Config Def = 2.0
+        !Config Help = 
+        !Config Units = [K] 
+        fr_dT=2.0
+        CALL getin_p('FR_DT',fr_dT)
+              
+
+        !! Variables related to soil Freezing in diffuco module
+
+        !Config Key  = OK_SNOWFACT
+        !Config Desc = Activates the smoothering of landscapes by snow,
+        !       e.g. reduces of the surface roughness length when snow is present.
+        !Config If   = 
+        !Config Def  = True if OK_FREEZE else false
+        !Config Help = 
+        !Config Units= [FLAG]
+
+        IF (ok_freeze) THEN
+           ok_snowfact = .TRUE.
+        ELSE
+           ok_snowfact = .FALSE.
+        END IF
+        CALL getin_p('OK_SNOWFACT', ok_snowfact)
+
+
+        !! Variables related to soil Freezing in hydrol module
+
+        !Config Key  = OK_FREEZE_CWRR
+        !Config Desc = CWRR freezing scheme by I. Gouttevin
+        !Config If   = 
+        !Config Def  = True if OK_FREEZE else false
+        !Config Help =
+        !Config Units= [FLAG]
+
+        IF (ok_freeze) THEN
+           ok_freeze_cwrr = .TRUE.
+        ELSE
+           ok_freeze_cwrr = .FALSE.
+        END IF
+        CALL getin_p('OK_FREEZE_CWRR',ok_freeze_cwrr)
+
+
+        IF (ok_freeze_cwrr) THEN
+           !Config Key  = OK_THERMODYNAMICAL_FREEZING
+           !Config Desc = Calculate frozen fraction thermodynamically 
+           !Config If   = HYDROL_CWRR .AND. OK_FREEZE_CWRR
+           !Config Def  = True
+           !Config Help = Calculate frozen fraction thermodynamically if true,
+           !Config      = else calculate frozen fraction linearly 
+           !Config Units= [FLAG]
+           ok_thermodynamical_freezing = .TRUE.
+           CALL getin_p('OK_THERMODYNAMICAL_FREEZING',ok_thermodynamical_freezing)
+        END IF
+     
+        first_call =.FALSE.
+        
+     ENDIF
+     
+   END SUBROUTINE config_soil_parameters
+   
+
+END MODULE constantes_soil
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes_soil_var.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes_soil_var.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes_soil_var.f90	(revision 5166)
@@ -0,0 +1,281 @@
+! =================================================================================================================================
+! MODULE 	: constantes_soil_var
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "constantes_soil_var" module contains the parameters related to soil and hydrology.
+!!
+!!\n DESCRIPTION : The non saturated hydraulic properties are defined from the  
+!!                 formulations of van Genuchten (1980) and Mualem (1976), combined as  
+!!                 explained in d'Orgeval (2006). \n
+!!                 The related parameters for three main  
+!!                 soil textures (coarse, medium and fine) come from Carsel and Parrish  
+!!                 (1988).
+!!
+!! RECENT CHANGE(S): Sonke Zaehle changed hcrit_litter value according to Shilong Piao from 0.03 to 0.08, 080806
+!!
+!! REFERENCE(S)	:
+!!- Roger A.Pielke, (2002), Mesoscale meteorological modeling, Academic Press Inc. 
+!!- Polcher, J., Laval, K., DÃŒmenil, L., Lean, J., et Rowntree, P. R. (1996).
+!! Comparing three land surface schemes used in general circulation models. Journal of Hydrology, 180(1-4), 373--394.
+!!- Ducharne, A., Laval, K., et Polcher, J. (1998). Sensitivity of the hydrological cycle
+!! to the parametrization of soil hydrology in a GCM. Climate Dynamics, 14, 307--327. 
+!!- Rosnay, P. de et Polcher, J. (1999). Modelling root water uptake in a complex land surface
+!! scheme coupled to a GCM. Hydrol. Earth Syst. Sci., 2(2/3), 239--255.
+!!- d'Orgeval, T. et Polcher, J. (2008). Impacts of precipitation events and land-use changes
+!! on West African river discharges during the years 1951--2000. Climate Dynamics, 31(2), 249--262. 
+!!- Carsel, R. and Parrish, R.: Developing joint probability distributions of soil water
+!! retention characteristics, Water Resour. Res.,24, 755â769, 1988.
+!!- Mualem Y (1976) A new model for predicting the hydraulic conductivity  
+!! of unsaturated porous media. Water Resources Research 12(3):513-522
+!!- Van Genuchten M (1980) A closed-form equation for predicting the  
+!! hydraulic conductivity of unsaturated soils. Soil Sci Soc Am J, 44(5):892-898
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_soil_var
+
+  USE defprec
+  USE vertical_soil_var
+
+  IMPLICIT NONE
+
+
+  LOGICAL, SAVE             :: check_waterbal=.TRUE.    !! The check the water balance (true/false)
+!$OMP THREADPRIVATE(check_waterbal)
+
+
+  !! Number of soil classes
+
+  INTEGER(i_std), PARAMETER :: ntext=3                  !! Number of soil textures (Silt, Sand, Clay)
+  INTEGER(i_std), PARAMETER :: nstm=3                   !! Number of soil tiles (unitless)
+  CHARACTER(LEN=30)         :: soil_classif             !! Type of classification used for the map of soil types.
+                                                        !! It must be consistent with soil file given by 
+                                                        !! SOILCLASS_FILE parameter.
+  INTEGER(i_std), PARAMETER :: nscm_fao=3               !! For FAO Classification (unitless)
+  INTEGER(i_std), PARAMETER :: nscm_usda=12             !! For USDA Classification (unitless)
+  INTEGER(i_std), SAVE      :: nscm=nscm_fao            !! Default value for nscm
+!$OMP THREADPRIVATE(nscm)
+
+  !! Parameters for soil thermodynamics
+
+  REAL(r_std), SAVE :: so_capa_dry = 1.80e+6            !! Dry soil Heat capacity of soils 
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex 
+!$OMP THREADPRIVATE(so_capa_dry)
+  REAL(r_std), SAVE :: so_cond_dry = 0.40               !! Dry soil Thermal Conductivity of soils
+                                                        !! @tex $(W.m^{-2}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(so_cond_dry)
+  REAL(r_std), SAVE :: so_capa_wet = 3.03e+6            !! Wet soil Heat capacity of soils 
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(so_capa_wet)
+  REAL(r_std), SAVE :: so_cond_wet = 1.89               !! Wet soil Thermal Conductivity of soils 
+                                                        !! @tex $(W.m^{-2}.K^{-1})$ @endtex 
+!$OMP THREADPRIVATE(so_cond_wet)
+  REAL(r_std), SAVE :: sn_cond = 0.3                    !! Thermal Conductivity of snow 
+                                                        !! @tex $(W.m^{-2}.K^{-1})$ @endtex  
+!$OMP THREADPRIVATE(sn_cond)
+  REAL(r_std), SAVE :: sn_dens = 330.0                  !! Snow density for the soil thermodynamics
+                                                        !! (kg/m3)
+!$OMP THREADPRIVATE(sn_dens)
+  REAL(r_std), SAVE :: sn_capa                          !! Heat capacity for snow 
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(sn_capa)
+  REAL(r_std), SAVE :: water_capa = 4.18e+6             !! Water heat capacity 
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(water_capa)
+  REAL(r_std), SAVE :: brk_capa = 2.0e+6                !! Heat capacity of generic rock
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(brk_capa)
+  REAL(r_std), SAVE :: brk_cond = 3.0                   !! Thermal conductivity of saturated granitic rock
+                                                        !! @tex $(W.m^{-1}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(brk_cond)
+
+
+  !! Specific parameters for the Choisnel hydrology
+
+  REAL(r_std), SAVE :: min_drain = 0.001                !! Diffusion constant for the slow regime
+                                                        !! (This is for the diffusion between reservoirs)
+                                                        !! @tex $(kg.m^{-2}.dt^{-1})$ @endtex
+!$OMP THREADPRIVATE(min_drain)
+  REAL(r_std), SAVE :: max_drain = 0.1                  !! Diffusion constant for the fast regime 
+                                                        !! @tex $(kg.m^{-2}.dt^{-1})$ @endtex
+!$OMP THREADPRIVATE(max_drain)
+  REAL(r_std), SAVE :: exp_drain = 1.5                  !! The exponential in the diffusion law (unitless)
+!$OMP THREADPRIVATE(exp_drain)
+  REAL(r_std), SAVE :: qsintcst = 0.1                   !! Transforms leaf area index into size of interception reservoir
+                                                        !! (unitless)
+!$OMP THREADPRIVATE(qsintcst)
+  REAL(r_std), SAVE :: mx_eau_nobio = 150.              !! Volumetric available soil water capacity in nobio fractions
+                                                        !! @tex $(kg.m^{-3} of soil)$ @endtex
+!$OMP THREADPRIVATE(mx_eau_nobio)
+  REAL(r_std), SAVE :: rsol_cste = 33.E3                !! Constant in the computation of resistance for bare soil evaporation
+                                                        !! @tex $(s.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(rsol_cste)
+  REAL(r_std), SAVE :: hcrit_litter=0.08_r_std          !! Scaling depth for litter humidity (m)
+!$OMP THREADPRIVATE(hcrit_litter)
+
+
+  !! Parameters specific for the CWRR hydrology.
+
+  !!  1. Parameters for FAO Classification
+
+  !! Parameters for soil type distribution
+
+  REAL(r_std),DIMENSION(nscm_fao),SAVE :: soilclass_default_fao = &   !! Default soil texture distribution for fao :
+ & (/ 0.28, 0.52, 0.20 /)                                             !! in the following order : COARSE, MEDIUM, FINE (unitless)
+!$OMP THREADPRIVATE(soilclass_default_fao)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: nvan_fao = &            !! Van Genuchten coefficient n (unitless)
+ & (/ 1.89_r_std, 1.56_r_std, 1.31_r_std /)                             !  RK: 1/n=1-m
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: avan_fao = &            !! Van Genuchten coefficient a 
+  & (/ 0.0075_r_std, 0.0036_r_std, 0.0019_r_std /)                     !!  @tex $(mm^{-1})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mcr_fao = &             !! Residual volumetric water content 
+ & (/ 0.065_r_std, 0.078_r_std, 0.095_r_std /)                         !!  @tex $(m^{3} m^{-3})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mcs_fao = &             !! Saturated volumetric water content 
+ & (/ 0.41_r_std, 0.43_r_std, 0.41_r_std /)                            !!  @tex $(m^{3} m^{-3})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: ks_fao = &              !! Hydraulic conductivity at saturation 
+ & (/ 1060.8_r_std, 249.6_r_std, 62.4_r_std /)                         !!  @tex $(mm d^{-1})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: pcent_fao = &           !! Fraction of saturated volumetric soil moisture 
+ & (/ 0.5_r_std, 0.5_r_std, 0.5_r_std /)                               !! above which transpir is max (0-1, unitless)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: free_drain_max_fao = &  !! Max=default value of the permeability coeff  
+ & (/ 1.0_r_std, 1.0_r_std, 1.0_r_std /)                               !! at the bottom of the soil (0-1, unitless)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mcf_fao = &             !! Volumetric water content at field capacity 
+ & (/ 0.32_r_std, 0.32_r_std, 0.32_r_std /)                            !!  @tex $(m^{3} m^{-3})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mcw_fao = &             !! Volumetric water content at wilting point 
+ & (/ 0.10_r_std, 0.10_r_std, 0.10_r_std /)                            !!  @tex $(m^{3} m^{-3})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mc_awet_fao = &         !! Vol. wat. cont. above which albedo is cst 
+ & (/ 0.25_r_std, 0.25_r_std, 0.25_r_std /)                            !!  @tex $(m^{3} m^{-3})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mc_adry_fao = &         !! Vol. wat. cont. below which albedo is cst
+ & (/ 0.1_r_std, 0.1_r_std, 0.1_r_std /)                               !!  @tex $(m^{3} m^{-3})$ @endtex
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: SMCMAX_fao = &          !! porosity
+ & (/ 0.41_r_std, 0.43_r_std, 0.41_r_std /)                            !! & (/ 0.434_r_std, 0.439_r_std, 0.465_r_std /) !!noah lsm
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: QZ_fao = &              !! QUARTZ CONTENT (SOIL TYPE DEPENDENT)
+ & (/ 0.60_r_std, 0.40_r_std, 0.35_r_std /)                            !! Peters et al [1998]
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: so_capa_dry_ns_fao = &  !! Dry soil Heat capacity of soils,J.m^{-3}.K^{-1}
+ & (/ 1.34e+6_r_std, 1.21e+6_r_std, 1.23e+6_r_std /)                   !! Pielke [2002, 2013]
+
+  !!  2. Parameters for USDA Classification
+
+  !! Parameters for soil type distribution :
+  !! Sand, Loamy Sand, Sandy Loam, Silt Loam, Silt, Loam, Sandy Clay Loam, Silty Clay Loam, Clay Loam, Sandy Clay, Silty Clay, Clay
+
+  REAL(r_std),DIMENSION(nscm_usda),SAVE :: soilclass_default_usda = &    !! Default soil texture distribution in the above order :
+ & (/ 0.28, 0.52, 0.20, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 /)   !! Thus different from "FAO"'s COARSE, MEDIUM, FINE
+                                                                         !! which have indices 3,6,9 in the 12-texture vector
+  !$OMP THREADPRIVATE(soilclass_default_usda)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: nvan_usda = &            !! Van Genuchten coefficient n (unitless)
+ & (/ 2.68_r_std, 2.28_r_std, 1.89_r_std, 1.41_r_std, &                   !  RK: 1/n=1-m
+ &    1.37_r_std, 1.56_r_std, 1.48_r_std, 1.23_r_std, &
+ &    1.31_r_std, 1.23_r_std, 1.09_r_std, 1.09_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: avan_usda = &            !! Van Genuchten coefficient a 
+ & (/ 0.0145_r_std, 0.0124_r_std, 0.0075_r_std, 0.0020_r_std, &          !!  @tex $(mm^{-1})$ @endtex
+ &    0.0016_r_std, 0.0036_r_std, 0.0059_r_std, 0.0010_r_std, &
+ &    0.0019_r_std, 0.0027_r_std, 0.0005_r_std, 0.0008_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mcr_usda = &             !! Residual volumetric water content 
+ & (/ 0.045_r_std, 0.057_r_std, 0.065_r_std, 0.067_r_std, &              !!  @tex $(m^{3} m^{-3})$ @endtex
+ &    0.034_r_std, 0.078_r_std, 0.100_r_std, 0.089_r_std, &
+ &    0.095_r_std, 0.100_r_std, 0.070_r_std, 0.068_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mcs_usda = &             !! Saturated volumetric water content 
+ & (/ 0.43_r_std, 0.41_r_std, 0.41_r_std, 0.45_r_std, &                  !!  @tex $(m^{3} m^{-3})$ @endtex
+ &    0.46_r_std, 0.43_r_std, 0.39_r_std, 0.43_r_std, &
+ &    0.41_r_std, 0.38_r_std, 0.36_r_std, 0.38_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: ks_usda = &              !! Hydraulic conductivity at saturation
+ & (/ 7128.0_r_std, 3501.6_r_std, 1060.8_r_std, 108.0_r_std, &           !!  @tex $(mm d^{-1})$ @endtex
+ &    60.0_r_std, 249.6_r_std, 314.4_r_std, 16.8_r_std, &
+ &    62.4_r_std, 28.8_r_std, 4.8_r_std, 48.0_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: pcent_usda = &           !! Fraction of saturated volumetric soil moisture
+ & (/ 0.5_r_std, 0.5_r_std, 0.5_r_std, 0.5_r_std, &                      !! above which transpir is max (0-1, unitless)
+ &    0.5_r_std, 0.5_r_std, 0.5_r_std, 0.5_r_std, &
+ &    0.5_r_std, 0.5_r_std, 0.5_r_std, 0.5_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: free_drain_max_usda = &  !! Max=default value of the permeability coeff 
+ & (/ 1.0_r_std, 1.0_r_std, 1.0_r_std, 1.0_r_std, &                      !! at the bottom of the soil (0-1, unitless)
+ &    1.0_r_std, 1.0_r_std, 1.0_r_std, 1.0_r_std, &
+ &    1.0_r_std, 1.0_r_std, 1.0_r_std, 1.0_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mcf_usda = &             !! Volumetric water content at field capacity
+ & (/ 0.32_r_std, 0.32_r_std, 0.32_r_std, 0.32_r_std, &                  !!  @tex $(m^{3} m^{-3})$ @endtex
+ &    0.32_r_std, 0.32_r_std, 0.32_r_std, 0.32_r_std, &
+ &    0.32_r_std, 0.32_r_std, 0.32_r_std, 0.32_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mcw_usda = &             !! Volumetric water content at wilting point
+ & (/ 0.10_r_std, 0.10_r_std, 0.10_r_std, 0.10_r_std, &                  !!  @tex $(m^{3} m^{-3})$ @endtex
+ &    0.10_r_std, 0.10_r_std, 0.10_r_std, 0.10_r_std, &
+ &    0.10_r_std, 0.10_r_std, 0.10_r_std, 0.10_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mc_awet_usda = &         !! Vol. wat. cont. above which albedo is cst
+ & (/ 0.25_r_std, 0.25_r_std, 0.25_r_std, 0.25_r_std, &                  !!  @tex $(m^{3} m^{-3})$ @endtex
+ &    0.25_r_std, 0.25_r_std, 0.25_r_std, 0.25_r_std, &
+ &    0.25_r_std, 0.25_r_std, 0.25_r_std, 0.25_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mc_adry_usda = &         !! Vol. wat. cont. below which albedo is cst
+ & (/ 0.1_r_std, 0.1_r_std, 0.1_r_std, 0.1_r_std, &                      !!  @tex $(m^{3} m^{-3})$ @endtex
+ &    0.1_r_std, 0.1_r_std, 0.1_r_std, 0.1_r_std, &
+ &    0.1_r_std, 0.1_r_std, 0.1_r_std, 0.1_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: SMCMAX_usda = &          !! porosity
+ & (/ 0.43_r_std, 0.41_r_std, 0.41_r_std, 0.45_r_std, &
+ &    0.46_r_std, 0.43_r_std, 0.39_r_std, 0.43_r_std, &
+ &    0.41_r_std, 0.38_r_std, 0.36_r_std, 0.38_r_std /)
+ 
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: QZ_usda = &              !! QUARTZ CONTENT (SOIL TYPE DEPENDENT)
+ & (/ 0.92_r_std, 0.82_r_std, 0.60_r_std, 0.25_r_std, &
+ &    0.10_r_std, 0.40_r_std, 0.60_r_std, 0.10_r_std, &
+ &    0.35_r_std, 0.52_r_std, 0.10_r_std, 0.25_r_std /)                  !! Peters et al [1998]
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: so_capa_dry_ns_usda = &  !! Dry soil Heat capacity of soils,J.m^{-3}.K^{-1}
+ & (/ 1.47e+6_r_std, 1.41e+6_r_std, 1.34e+6_r_std, 1.27e+6_r_std, &
+ &    1.21e+6_r_std, 1.21e+6_r_std, 1.18e+6_r_std, 1.32e+6_r_std, &
+ &    1.23e+6_r_std, 1.18e+6_r_std, 1.15e+6_r_std, 1.09e+6_r_std /)      !! Pielke [2002, 2013]
+  
+  !! Parameters for the numerical scheme used by CWRR
+
+  INTEGER(i_std), PARAMETER :: imin = 1                                 !! Start for CWRR linearisation (unitless)
+  INTEGER(i_std), PARAMETER :: nbint = 50                               !! Number of interval for CWRR linearisation (unitless)
+  INTEGER(i_std), PARAMETER :: imax = nbint+1                           !! Number of points for CWRR linearisation (unitless)
+  REAL(r_std), PARAMETER    :: w_time = 1.0_r_std                       !! Time weighting for CWRR numerical integration (unitless)
+
+
+  !! Variables related to soil freezing, in thermosoil : 
+  LOGICAL, SAVE        :: ok_Ecorr                    !! Flag for energy conservation correction
+  LOGICAL, SAVE        :: ok_freeze_thermix           !! Flag to activate thermal part of the soil freezing scheme
+  LOGICAL, SAVE        :: read_reftemp                !! Flag to initialize soil temperature using climatological temperature
+  REAL(r_std), SAVE    :: poros                       !! Soil porosity (from USDA classification, mean value)(-)
+  REAL(r_std), SAVE    :: fr_dT                       !! Freezing window (K)
+
+  !! Variables related to soil freezing, in diffuco : 
+  LOGICAL, SAVE        ::  ok_snowfact                !! Activate snow smoothering
+
+  !! Variables related to soil freezing, in hydrol : 
+  LOGICAL, SAVE        :: ok_freeze_cwrr              !! CWRR freezing scheme by I. Gouttevin
+  LOGICAL, SAVE        :: ok_thermodynamical_freezing !! Calculate frozen fraction thermodynamically
+
+  
+END MODULE constantes_soil_var
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes_var.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes_var.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/constantes_var.f90	(revision 5166)
@@ -0,0 +1,1402 @@
+! =================================================================================================================================
+! MODULE       : constantes_var
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        constantes_var module contains most constantes like pi, Earth radius, etc...
+!!              and all externalized parameters except pft-dependent constants.
+!!
+!!\n DESCRIPTION: This module contains most constantes and the externalized parameters of ORCHIDEE which 
+!!                are not pft-dependent.\n
+!!                In this module, you can set the flag diag_qsat in order to detect the pixel where the
+!!                temperature is out of range (look qsatcalc and dev_qsatcalc in qsat_moisture.f90).\n
+!!                The Earth radius is approximated by the Equatorial radius.The Earth's equatorial radius a,
+!!                or semi-major axis, is the distance from its center to the equator and equals 6,378.1370 km.
+!!                The equatorial radius is often used to compare Earth with other planets.\n
+!!                The meridional mean is well approximated by the semicubic mean of the two axe yielding 
+!!                6367.4491 km or less accurately by the quadratic mean of the two axes about 6,367.454 km
+!!                or even just the mean of the two axes about 6,367.445 km.\n
+!!                This module is already USE in module constantes. Therefor no need to USE it seperatly except
+!!                if the subroutines in module constantes are not needed.\n
+!!                
+!! RECENT CHANGE(S):
+!!
+!! REFERENCE(S)	: 
+!! - Louis, Jean-Francois (1979), A parametric model of vertical eddy fluxes in the atmosphere. 
+!! Boundary Layer Meteorology, 187-202.\n
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_var
+
+  USE defprec
+
+  IMPLICIT NONE
+!-
+
+                         !-----------------------!
+                         !  ORCHIDEE CONSTANTS   !
+                         !-----------------------!
+
+  !
+  ! FLAGS 
+  !
+  LOGICAL :: river_routing      !! activate river routing
+!$OMP THREADPRIVATE(river_routing)
+  LOGICAL :: hydrol_cwrr        !! activate 11 layers hydrolgy model
+!$OMP THREADPRIVATE(hydrol_cwrr)
+  LOGICAL :: do_floodplains     !! activate flood plains
+!$OMP THREADPRIVATE(do_floodplains)
+  LOGICAL :: do_irrigation      !! activate computation of irrigation flux
+!$OMP THREADPRIVATE(do_irrigation)
+  LOGICAL :: ok_sechiba         !! activate physic of the model
+!$OMP THREADPRIVATE(ok_sechiba)
+  LOGICAL :: ok_co2             !! activate photosynthesis
+!$OMP THREADPRIVATE(ok_co2)
+  LOGICAL :: ok_stomate         !! activate carbon cycle
+!$OMP THREADPRIVATE(ok_stomate)
+  LOGICAL :: ok_dgvm            !! activate dynamic vegetation
+!$OMP THREADPRIVATE(ok_dgvm)
+  LOGICAL :: ok_pheno           !! activate the calculation of lai using stomate rather than a prescription
+!$OMP THREADPRIVATE(ok_pheno)
+  LOGICAL :: ok_bvoc            !! activate biogenic volatile organic coumpounds
+!$OMP THREADPRIVATE(ok_bvoc)
+  LOGICAL :: ok_leafage         !! activate leafage
+!$OMP THREADPRIVATE(ok_leafage)
+  LOGICAL :: ok_radcanopy       !! use canopy radiative transfer model
+!$OMP THREADPRIVATE(ok_radcanopy)
+  LOGICAL :: ok_multilayer      !! use canopy radiative transfer model with multi-layers
+!$OMP THREADPRIVATE(ok_multilayer)
+  LOGICAL :: ok_pulse_NOx       !! calculate NOx emissions with pulse
+!$OMP THREADPRIVATE(ok_pulse_NOx)
+  LOGICAL :: ok_bbgfertil_NOx   !! calculate NOx emissions with bbg fertilizing effect
+!$OMP THREADPRIVATE(ok_bbgfertil_NOx)
+  LOGICAL :: ok_cropsfertil_NOx !! calculate NOx emissions with fertilizers use
+!$OMP THREADPRIVATE(ok_cropsfertil_NOx)
+
+  LOGICAL :: ok_co2bvoc_poss    !! CO2 inhibition on isoprene activated following Possell et al. (2005) model
+!$OMP THREADPRIVATE(ok_co2bvoc_poss)
+  LOGICAL :: ok_co2bvoc_wilk    !! CO2 inhibition on isoprene activated following Wilkinson et al. (2006) model
+!$OMP THREADPRIVATE(ok_co2bvoc_wilk)
+  LOGICAL :: ld_doc             !! activate the debug comments for the DOC module (true/false)  
+!$OMP THREADPRIVATE(ld_doc)
+  LOGICAL, SAVE :: OFF_LINE_MODE = .FALSE.  !! ORCHIDEE detects if it is coupled with a GCM or 
+                                            !! just use with one driver in OFF-LINE. (true/false)
+!$OMP THREADPRIVATE(OFF_LINE_MODE)  
+  LOGICAL, SAVE :: impose_param = .TRUE.    !! Flag impos_param : read all the parameters in the run.def file
+!$OMP THREADPRIVATE(impose_param)
+  CHARACTER(LEN=80), SAVE     :: restname_in       = 'NONE'                 !! Input Restart files name for Sechiba component  
+!$OMP THREADPRIVATE(restname_in)
+  CHARACTER(LEN=80), SAVE     :: restname_out      = 'sechiba_rest_out.nc'  !! Output Restart files name for Sechiba component
+!$OMP THREADPRIVATE(restname_out)
+  CHARACTER(LEN=80), SAVE     :: stom_restname_in  = 'NONE'                 !! Input Restart files name for Stomate component
+!$OMP THREADPRIVATE(stom_restname_in)
+  CHARACTER(LEN=80), SAVE     :: stom_restname_out = 'stomate_rest_out.nc'  !! Output Restart files name for Stomate component
+!$OMP THREADPRIVATE(stom_restname_out)
+  INTEGER, SAVE :: printlev=1       !! Standard level for text output [0, 1, 2, 3]
+!$OMP THREADPRIVATE(printlev)
+
+  !
+  ! TIME
+  !
+  REAL(r_std), SAVE :: one_day  !! One day in seconds (s)
+!$OMP THREADPRIVATE(one_day)
+  REAL(r_std), SAVE :: one_year !! One year in days
+!$OMP THREADPRIVATE(one_year)
+  REAL(r_std), PARAMETER :: one_hour = 3600.0  !! One hour in seconds (s)
+  INTEGER(i_std), PARAMETER  :: spring_days_max = 40  !! Maximum number of days during which we watch for possible spring frost damage
+
+  ! TIME STEP
+  REAL(r_std)            :: dt_sechiba         !! Time step in sechiba
+!$OMP THREADPRIVATE(dt_sechiba)
+  REAL(r_std)            :: dt_stomate         !! Time step in stomate
+!$OMP THREADPRIVATE(dt_stomate)
+
+  !
+  ! SPECIAL VALUES 
+  !
+  INTEGER(i_std), PARAMETER :: undef_int = 999999999     !! undef integer for integer arrays (unitless)
+  !-
+  REAL(r_std), SAVE :: val_exp = 999999.                 !! Specific value if no restart value  (unitless)
+!$OMP THREADPRIVATE(val_exp)
+  REAL(r_std), PARAMETER :: undef = -9999.               !! Special value for stomate (unitless)
+  
+  REAL(r_std), PARAMETER :: min_sechiba = 1.E-8_r_std    !! Epsilon to detect a near zero floating point (unitless)
+  REAL(r_std), PARAMETER :: undef_sechiba = 1.E+20_r_std !! The undef value used in SECHIBA (unitless)
+  
+  REAL(r_std), PARAMETER :: min_stomate = 1.E-8_r_std    !! Epsilon to detect a near zero floating point (unitless)
+  REAL(r_std), PARAMETER :: large_value = 1.E33_r_std    !! some large value (for stomate) (unitless)
+
+
+  !
+  !  DIMENSIONING AND INDICES PARAMETERS  
+  !
+  INTEGER(i_std), PARAMETER :: ibare_sechiba = 1 !! Index for bare soil in Sechiba (unitless)
+  INTEGER(i_std), PARAMETER :: ivis = 1          !! index for albedo in visible range (unitless)
+  INTEGER(i_std), PARAMETER :: inir = 2          !! index for albeod i near-infrared range (unitless) 
+  INTEGER(i_std), PARAMETER :: nnobio = 1        !! Number of other surface types: land ice (lakes,cities, ...) (unitless)
+  INTEGER(i_std), PARAMETER :: iice = 1          !! Index for land ice (see nnobio) (unitless)
+  !-
+  !! Soil
+  INTEGER(i_std), PARAMETER :: classnb = 9       !! Levels of soil colour classification (unitless)
+  !-
+  INTEGER(i_std), PARAMETER :: nleafages = 4     !! leaf age discretisation ( 1 = no discretisation )(unitless)
+  !-
+  !! litter fractions: indices (unitless)
+  INTEGER(i_std), PARAMETER :: ileaf = 1         !! Index for leaf compartment (unitless)
+  INTEGER(i_std), PARAMETER :: isapabove = 2     !! Index for sapwood above compartment (unitless)
+  INTEGER(i_std), PARAMETER :: isapbelow = 3     !! Index for sapwood below compartment (unitless)
+  INTEGER(i_std), PARAMETER :: iheartabove = 4   !! Index for heartwood above compartment (unitless)
+  INTEGER(i_std), PARAMETER :: iheartbelow = 5   !! Index for heartwood below compartment (unitless)
+  INTEGER(i_std), PARAMETER :: iroot = 6         !! Index for roots compartment (unitless)
+  INTEGER(i_std), PARAMETER :: ifruit = 7        !! Index for fruits compartment (unitless)
+  INTEGER(i_std), PARAMETER :: icarbres = 8      !! Index for reserve compartment (unitless)
+  INTEGER(i_std), PARAMETER :: nparts = 8        !! Number of biomass compartments (unitless)
+  !-
+  !! indices for assimilation parameters 
+  INTEGER(i_std), PARAMETER :: ivcmax = 1        !! Index for vcmax (assimilation parameters) (unitless)
+  INTEGER(i_std), PARAMETER :: npco2 = 1         !! Number of assimilation parameters (unitless)
+  !-
+  !! trees and litter: indices for the parts of heart-
+  !! and sapwood above and below the ground 
+  INTEGER(i_std), PARAMETER :: iabove = 1       !! Index for above part (unitless)
+  INTEGER(i_std), PARAMETER :: ibelow = 2       !! Index for below part (unitless)
+  INTEGER(i_std), PARAMETER :: nlevs = 2        !! Number of levels for trees and litter (unitless)
+  !-
+  !! litter: indices for metabolic and structural part
+  INTEGER(i_std), PARAMETER :: imetabolic = 1   !! Index for metabolic litter (unitless)
+  INTEGER(i_std), PARAMETER :: istructural = 2  !! Index for structural litter (unitless)
+  INTEGER(i_std), PARAMETER :: nlitt = 2        !! Number of levels for litter compartments (unitless)
+  !-
+  !! carbon pools: indices
+  INTEGER(i_std), PARAMETER :: iactive = 1      !! Index for active carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: islow = 2        !! Index for slow carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive = 3     !! Index for passive carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: ncarb = 3        !! Number of soil carbon pools (unitless)
+  !-
+  !! DOC pools: indices
+  INTEGER(i_std), PARAMETER :: ifree = 1        !! Index for free soil dissolved organic carbon (unitless)
+  INTEGER(i_std), PARAMETER :: iadsorbed = 2    !! Index for adsorbed soil dissolved organic carbon (unitless)
+  INTEGER(i_std), PARAMETER :: ndoc = 2         !! Number of soil dissolved organic carbon pools (unitless)
+  !-
+  !! DOC exportation pathways indices
+  INTEGER(i_std), PARAMETER :: irunoff = 1      !! Index for runoff (unitless)
+  INTEGER(i_std), PARAMETER :: iflooded = 2     !! Index for flooding (unitless)
+  INTEGER(i_std), PARAMETER :: idrainage = 3    !! Index for drainage (unitless)
+  INTEGER(i_std), PARAMETER :: nexp = 3         !! Number of DOC export pathways (unitless)
+  !-
+  !! carbon pools: indices
+  INTEGER(i_std), PARAMETER :: imetabo = 1      !! Index for aboveground metabolic litter pool(unitless)
+  INTEGER(i_std), PARAMETER :: istrabo = 2      !! Index for aboveground structural litter pool(unitless)
+  INTEGER(i_std), PARAMETER :: imetbel = 3      !! Index for belowground metabolic litter pool(unitless)
+  INTEGER(i_std), PARAMETER :: istrbel = 4      !! Index for belowground structural litter  pool(unitless)
+  INTEGER(i_std), PARAMETER :: iact = 5         !! Index for active carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: islo = 6         !! Index for slow carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: ipas = 7         !! Index for passive carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: npool = 7        !! Number of soil carbon pools (unitless)
+  !
+  !! carbon pools: indices
+  INTEGER(i_std), PARAMETER :: ico2 = 1         !! Index for CO2 (unitless)
+  INTEGER(i_std), PARAMETER :: io2 = 2          !! Index for O2 (unitless)
+  INTEGER(i_std), PARAMETER :: ich4 = 3         !! Index for CH4 (unitless)
+  INTEGER(i_std), PARAMETER :: ngaz = 3         !! Number of gaz in soil (unitless)
+  !-
+  !! For isotopes and nitrogen
+  INTEGER(i_std), PARAMETER :: nelements = 2    !! Number of isotopes considered
+  INTEGER(i_std), PARAMETER :: icarbon = 1      !! Index for carbon
+  INTEGER(i_std), PARAMETER :: icarbon14 = 2    !! Index for carbon14 
+  !
+  !! Indices for check mass balance
+  INTEGER(i_std), PARAMETER :: nmbcomp=5
+  INTEGER(i_std), PARAMETER :: iatm2land=1
+  INTEGER(i_std), PARAMETER :: iland2atm=2
+  INTEGER(i_std), PARAMETER :: ilat2out=3
+  INTEGER(i_std), PARAMETER :: ilat2in=4
+  INTEGER(i_std), PARAMETER :: ipoolchange=5
+  !
+  !! Indices used for analytical spin-up
+  INTEGER(i_std), PARAMETER :: nbpools = 211                     !! Total number of carbon pools (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_above = 1            !! Index for structural litter above (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z1 = 2         !! Index for structural litter below at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z2 = 3         !! Index for structural litter below at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z3 = 4         !! Index for structural litter below at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z4 = 5         !! Index for structural litter below at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z5 = 6         !! Index for structural litter below at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z6 = 7         !! Index for structural litter below at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z7 = 8         !! Index for structural litter below at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z8 = 9         !! Index for structural litter below at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z9 = 10        !! Index for structural litter below at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z10 = 11       !! Index for structural litter below at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z11 = 12       !! Index for structural litter below at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_above = 13            !! Index for metabolic litter above (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z1 = 14         !! Index for metabolic litter below at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z2 = 15         !! Index for metabolic litter below at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z3 = 16         !! Index for metabolic litter below at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z4 = 17         !! Index for metabolic litter below at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z5 = 18         !! Index for metabolic litter below at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z6 = 19         !! Index for metabolic litter below at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z7 = 20         !! Index for metabolic litter below at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z8 = 21         !! Index for metabolic litter below at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z9 = 22         !! Index for metabolic litter below at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z10 = 23        !! Index for metabolic litter below at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z11 = 24        !! Index for metabolic litter below at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z1 = 25             !! Index for active carbon pool at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z2 = 26             !! Index for active carbon pool at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z3 = 27             !! Index for active carbon pool at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z4 = 28             !! Index for active carbon pool at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z5 = 29             !! Index for active carbon pool at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z6 = 30             !! Index for active carbon pool at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z7 = 31             !! Index for active carbon pool at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z8 = 32             !! Index for active carbon pool at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z9 = 33             !! Index for active carbon pool at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z10 = 34            !! Index for active carbon pool at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z11 = 35            !! Index for active carbon pool at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z1   = 36             !! Index for slow carbon pool at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z2   = 37             !! Index for slow carbon pool at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z3   = 38             !! Index for slow carbon pool at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z4   = 39             !! Index for slow carbon pool at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z5   = 40             !! Index for slow carbon pool at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z6   = 41             !! Index for slow carbon pool at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z7   = 42             !! Index for slow carbon pool at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z8   = 43             !! Index for slow carbon pool at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z9   = 44             !! Index for slow carbon pool at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z10   = 45            !! Index for slow carbon pool at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z11   = 46            !! Index for slow carbon pool at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z1 = 47            !! Index for passive carbon pool at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z2 = 48            !! Index for passive carbon pool at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z3 = 49            !! Index for passive carbon pool at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z4 = 50            !! Index for passive carbon pool at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z5 = 51            !! Index for passive carbon pool at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z6 = 52            !! Index for passive carbon pool at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z7 = 53            !! Index for passive carbon pool at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z8 = 54            !! Index for passive carbon pool at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z9 = 55            !! Index for passive carbon pool at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z10 = 56           !! Index for passive carbon pool at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z11 = 57           !! Index for passive carbon pool at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_metabo = 58            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_metabo = 59            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_metabo = 60            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_metabo = 61            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_metabo = 62            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_metabo = 63            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_metabo = 64            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_metabo = 65            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_metabo = 66            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_metabo = 67           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_metabo = 68           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_metabo = 69             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_metabo = 70             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_metabo = 71             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_metabo = 72             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_metabo = 73             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_metabo = 74             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_metabo = 75             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_metabo = 76             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_metabo = 77             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_metabo = 78            !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_metabo = 79            !! Index for adsorbed DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_strabo = 80            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_strabo = 81            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_strabo = 82            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_strabo = 83            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_strabo = 84            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_strabo = 85            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_strabo = 86            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_strabo = 87            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_strabo = 88            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_strabo = 89           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_strabo = 90           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_strabo = 91             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_strabo = 92             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_strabo = 93             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_strabo = 94             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_strabo = 95             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_strabo = 96             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_strabo = 97             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_strabo = 98             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_strabo = 99             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_strabo = 100           !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_strabo = 101           !! Index for adsorbed DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_metbel = 102            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_metbel = 103            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_metbel = 104            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_metbel = 105            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_metbel = 106            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_metbel = 107            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_metbel = 108            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_metbel = 109            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_metbel = 110            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_metbel = 111           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_metbel = 112           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_metbel = 113             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_metbel = 114             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_metbel = 115             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_metbel = 116             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_metbel = 117             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_metbel = 118             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_metbel = 119             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_metbel = 120             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_metbel = 121             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_metbel = 122           !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_metbel = 123           !! Index for adsorbed DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_strbel = 124            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_strbel = 125            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_strbel = 126            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_strbel = 127            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_strbel = 128            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_strbel = 129            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_strbel = 130            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_strbel = 131            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_strbel = 132            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_strbel = 133           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_strbel = 134           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_strbel = 135             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_strbel = 136             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_strbel = 137             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_strbel = 138             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_strbel = 139             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_strbel = 140             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_strbel = 141             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_strbel = 142             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_strbel = 143             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_strbel = 144           !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_strbel = 145           !! Index for adsorbed DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_act = 146            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_act = 147            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_act = 148            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_act = 149            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_act = 150            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_act = 151            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_act = 152            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_act = 153            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_act = 154            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_act = 155           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_act = 156           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_act = 157             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_act = 158             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_act = 159             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_act = 160             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_act = 161             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_act = 162             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_act = 163             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_act = 164             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_act = 165             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_act = 166           !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_act = 167           !! Index for adsorbed DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_slo = 168            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_slo = 169            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_slo = 170            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_slo = 171            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_slo = 172            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_slo = 173            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_slo = 174            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_slo = 175            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_slo = 176            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_slo = 177           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_slo = 178           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_slo = 179             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_slo = 180             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_slo = 181             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_slo = 182             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_slo = 183             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_slo = 184             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_slo = 185             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_slo = 186             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_slo = 187             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_slo = 188           !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_slo = 189           !! Index for adsorbed DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_pas = 190            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_pas = 191            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_pas = 192            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_pas = 193            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_pas = 194            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_pas = 195            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_pas = 196            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_pas = 197            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_pas = 198            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_pas = 199           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_pas = 200           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_pas = 201             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_pas = 202             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_pas = 203             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_pas = 204             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_pas = 205             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_pas = 206             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_pas = 207             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_pas = 208             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_pas = 209             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_pas = 210           !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_pas = 211           !! Index for adsorbed DOC at 11th layer (unitless)
+
+  INTEGER(i_std), SAVE      :: sro_bottom = 5                        !! Layer down to which DOC for surface runoff is taken (max=10)
+
+  !! For the routing of C and CO2 outgassing
+  !! Indices used for matter transport with water flows
+  INTEGER(i_std), PARAMETER :: ih2o = 1        !! index for water (unitless)
+  INTEGER(i_std), PARAMETER :: idoc = 2        !! index for dissolved organic carbon (unitless)
+  INTEGER(i_std), PARAMETER :: ico2aq = 3      !! index for free dissolved carbon dioxide (unitless)
+  INTEGER(i_std), PARAMETER :: ico2ev = 4      !! index for evaded carbon dioxide (unitless)  
+  INTEGER(i_std), PARAMETER :: nflow = 4       !! number of compounds transported with water flows (unitless)
+  !! Indices used to distinguish different aquatic systems
+  INTEGER(i_std), PARAMETER :: ifastr = 1       !! index for fast reservoir (unitless)
+  INTEGER(i_std), PARAMETER :: islowr = 2       !! index for slow reservoir (unitless)  
+  INTEGER(i_std), PARAMETER :: istreamr = 3     !! index for stream reservoir (unitless)  
+  INTEGER(i_std), PARAMETER :: ifloodr = 4      !! index for flood reservoir (unitless) 
+  INTEGER(i_std), PARAMETER :: ipondr = 5       !! index for pond reservoir (unitless)  
+  INTEGER(i_std), PARAMETER :: naqsys = 5      !! number of aquatic systems considered (unitless) 
+
+  !
+  ! NUMERICAL AND PHYSICS CONSTANTS
+  !
+  !
+
+  !-
+  ! 1. Mathematical and numerical constants
+  !-
+  REAL(r_std), PARAMETER :: pi = 3.141592653589793238   !! pi souce : http://mathworld.wolfram.com/Pi.html (unitless)
+  REAL(r_std), PARAMETER :: euler = 2.71828182845904523 !! e source : http://mathworld.wolfram.com/e.html (unitless)
+  REAL(r_std), PARAMETER :: zero = 0._r_std             !! Numerical constant set to 0 (unitless)
+  REAL(r_std), PARAMETER :: undemi = 0.5_r_std          !! Numerical constant set to 1/2 (unitless)
+  REAL(r_std), PARAMETER :: un = 1._r_std               !! Numerical constant set to 1 (unitless)
+  REAL(r_std), PARAMETER :: moins_un = -1._r_std        !! Numerical constant set to -1 (unitless)
+  REAL(r_std), PARAMETER :: deux = 2._r_std             !! Numerical constant set to 2 (unitless)
+  REAL(r_std), PARAMETER :: trois = 3._r_std            !! Numerical constant set to 3 (unitless)
+  REAL(r_std), PARAMETER :: quatre = 4._r_std           !! Numerical constant set to 4 (unitless)
+  REAL(r_std), PARAMETER :: cinq = 5._r_std             !![DISPENSABLE] Numerical constant set to 5 (unitless)
+  REAL(r_std), PARAMETER :: six = 6._r_std              !![DISPENSABLE] Numerical constant set to 6 (unitless)
+  REAL(r_std), PARAMETER :: huit = 8._r_std             !! Numerical constant set to 8 (unitless)
+  REAL(r_std), PARAMETER :: dix = 10._r_std             !! Numerical constant set to 100 (unitless) 
+  REAL(r_std), PARAMETER :: cent = 100._r_std           !! Numerical constant set to 100 (unitless)
+  REAL(r_std), PARAMETER :: mille = 1000._r_std         !! Numerical constant set to 1000 (unitless)
+
+  !-
+  ! 2 . Physics
+  !-
+  REAL(r_std), PARAMETER :: R_Earth = 6378000.              !! radius of the Earth : Earth radius ~= Equatorial radius (m)
+  REAL(r_std), PARAMETER :: mincos  = 0.0001                !! Minimum cosine value used for interpolation (unitless) 
+  REAL(r_std), PARAMETER :: pb_std = 1013.                  !! standard pressure (hPa)
+  REAL(r_std), PARAMETER :: ZeroCelsius = 273.15            !! 0 degre Celsius in degre Kelvin (K)
+  REAL(r_std), PARAMETER :: tp_00 = 273.15                  !! 0 degre Celsius in degre Kelvin (K)
+  REAL(r_std), PARAMETER :: chalsu0 = 2.8345E06             !! Latent heat of sublimation (J.kg^{-1})
+  REAL(r_std), PARAMETER :: chalev0 = 2.5008E06             !! Latent heat of evaporation (J.kg^{-1}) 
+  REAL(r_std), PARAMETER :: chalfu0 = chalsu0-chalev0       !! Latent heat of fusion (J.kg^{-1}) 
+  REAL(r_std), PARAMETER :: c_stefan = 5.6697E-8            !! Stefan-Boltzman constant (W.m^{-2}.K^{-4})
+  REAL(r_std), PARAMETER :: cp_air = 1004.675               !! Specific heat of dry air (J.kg^{-1}.K^{-1}) 
+  REAL(r_std), PARAMETER :: cte_molr = 287.05               !! Specific constant of dry air (kg.mol^{-1}) 
+  REAL(r_std), PARAMETER :: kappa = cte_molr/cp_air         !! Kappa : ratio between specific constant and specific heat 
+                                                            !! of dry air (unitless)
+  REAL(r_std), PARAMETER :: msmlr_air = 28.964E-03          !! Molecular weight of dry air (kg.mol^{-1})
+  REAL(r_std), PARAMETER :: msmlr_h2o = 18.02E-03           !! Molecular weight of water vapor (kg.mol^{-1}) 
+  REAL(r_std), PARAMETER :: cp_h2o = &                      !! Specific heat of water vapor (J.kg^{-1}.K^{-1}) 
+       & cp_air*(quatre*msmlr_air)/( 3.5_r_std*msmlr_h2o) 
+  REAL(r_std), PARAMETER :: cte_molr_h2o = cte_molr/quatre  !! Specific constant of water vapor (J.kg^{-1}.K^{-1}) 
+  REAL(r_std), PARAMETER :: retv = msmlr_air/msmlr_h2o-un   !! Ratio between molecular weight of dry air and water 
+                                                            !! vapor minus 1(unitless)  
+  REAL(r_std), PARAMETER :: rvtmp2 = cp_h2o/cp_air-un       !! Ratio between specific heat of water vapor and dry air
+                                                            !! minus 1 (unitless)
+  REAL(r_std), PARAMETER :: cepdu2 = (0.1_r_std)**2         !! Squared wind shear (m^2.s^{-2}) 
+  REAL(r_std), PARAMETER :: ct_karman = 0.35_r_std          !! Van Karmann Constant (unitless)
+  REAL(r_std), PARAMETER :: cte_grav = 9.80665_r_std        !! Acceleration of the gravity (m.s^{-2})
+  REAL(r_std), PARAMETER :: pa_par_hpa = 100._r_std         !! Transform pascal into hectopascal (unitless)
+  REAL(r_std), PARAMETER :: RR = 8.314                      !! Ideal gas constant (J.mol^{-1}.K^{-1})
+  REAL(r_std), PARAMETER :: Sct = 1370.                     !! Solar constant (W.m^{-2}) 
+
+
+  !-
+  ! 3. Climatic constants
+  !-
+  !! Constantes of the Louis scheme 
+  REAL(r_std), SAVE :: cb = 5._r_std              !! Constant of the Louis scheme (unitless);
+                                                  !! reference to Louis (1979)
+!$OMP THREADPRIVATE(cb)
+  REAL(r_std), SAVE :: cc = 5._r_std              !! Constant of the Louis scheme (unitless);
+                                                  !! reference to Louis (1979)
+!$OMP THREADPRIVATE(cc)
+  REAL(r_std), SAVE :: cd = 5._r_std              !! Constant of the Louis scheme (unitless);
+                                                  !! reference to Louis (1979)
+!$OMP THREADPRIVATE(cd)
+  REAL(r_std), SAVE :: rayt_cste = 125.           !! Constant in the computation of surface resistance (W.m^{-2})
+!$OMP THREADPRIVATE(rayt_cste)
+  REAL(r_std), SAVE :: defc_plus = 23.E-3         !! Constant in the computation of surface resistance (K.W^{-1})
+!$OMP THREADPRIVATE(defc_plus)
+  REAL(r_std), SAVE :: defc_mult = 1.5            !! Constant in the computation of surface resistance (K.W^{-1})
+!$OMP THREADPRIVATE(defc_mult)
+
+  !-
+  ! 4. Soil thermodynamics constants
+  !-
+  ! Look at constantes_soil.f90
+
+
+  !
+  ! OPTIONAL PARTS OF THE MODEL
+  !
+  LOGICAL,PARAMETER :: diag_qsat = .TRUE.         !! One of the most frequent problems is a temperature out of range
+                                                  !! we provide here a way to catch that in the calling procedure. 
+                                                  !! (from Jan Polcher)(true/false) 
+  LOGICAL, SAVE     :: almaoutput =.FALSE.        !! Selects the type of output for the model.(true/false)
+                                                  !! Value is read from run.def in intersurf_history
+!$OMP THREADPRIVATE(almaoutput)
+
+  !
+  ! DIVERSE
+  !
+  CHARACTER(LEN=100), SAVE :: stomate_forcing_name='NONE'  !! NV080800 Name of STOMATE forcing file (unitless)
+                                                           ! Compatibility with Nicolas Viovy driver.
+!$OMP THREADPRIVATE(stomate_forcing_name)
+  CHARACTER(LEN=100), SAVE :: stomate_Cforcing_name='NONE' !! NV080800 Name of soil forcing file (unitless)
+                                                           ! Compatibility with Nicolas Viovy driver.
+!$OMP THREADPRIVATE(stomate_Cforcing_name)
+  INTEGER(i_std), SAVE :: forcing_id                 !! Index of the forcing file (unitless)
+!$OMP THREADPRIVATE(forcing_id)
+  LOGICAL, SAVE :: allow_forcing_write=.TRUE.        !! Allow writing of stomate_forcing file. 
+                                                     !! This variable will be set to false for teststomate. 
+
+
+
+                         !------------------------!
+                         !  SECHIBA PARAMETERS    !
+                         !------------------------!
+ 
+
+  !
+  ! GLOBAL PARAMETERS   
+  !
+  REAL(r_std), SAVE :: min_wind = 0.1      !! The minimum wind (m.s^{-1})
+!$OMP THREADPRIVATE(min_wind)
+  REAL(r_std), SAVE :: snowcri = 1.5       !! Sets the amount above which only sublimation occures (kg.m^{-2})
+!$OMP THREADPRIVATE(snowcri)
+
+
+  !
+  ! FLAGS ACTIVATING SUB-MODELS
+  !
+  LOGICAL, SAVE :: treat_expansion = .FALSE.   !! Do we treat PFT expansion across a grid point after introduction? (true/false)
+!$OMP THREADPRIVATE(treat_expansion)
+  LOGICAL, SAVE :: ok_herbivores = .FALSE.     !! flag to activate herbivores (true/false)
+!$OMP THREADPRIVATE(ok_herbivores)
+  LOGICAL, SAVE :: harvest_agri = .TRUE.       !! flag to harvest aboveground biomass from agricultural PFTs)(true/false)
+!$OMP THREADPRIVATE(harvest_agri)
+  LOGICAL, SAVE :: lpj_gap_const_mort          !! constant moratlity (true/false). Default value depend on OK_DGVM.
+!$OMP THREADPRIVATE(lpj_gap_const_mort)
+  LOGICAL, SAVE :: disable_fire = .FALSE.      !! flag that disable fire (true/false)
+!$OMP THREADPRIVATE(disable_fire)
+  LOGICAL, SAVE :: spinup_analytic = .FALSE.   !! Flag to activate analytical resolution for spinup (true/false)
+!$OMP THREADPRIVATE(spinup_analytic)
+  LOGICAL, SAVE :: ok_explicitsnow             !! Flag to activate explicit snow scheme instead of default snow scheme
+!$OMP THREADPRIVATE(ok_explicitsnow)
+  LOGICAL, SAVE :: moist_func_Moyano = .FALSE. !! Flag to activate the calculation of moisture control function on soil C decomposition based on Moyano et al., 2012 BG (true/false)
+!$OMP THREADPRIVATE(moist_func_Moyano)
+
+  !
+  ! CONFIGURATION VEGETATION
+  !
+  LOGICAL, SAVE :: agriculture = .TRUE.    !! allow agricultural PFTs (true/false)
+!$OMP THREADPRIVATE(agriculture)
+  LOGICAL, SAVE :: impveg = .FALSE.        !! Impose vegetation ? (true/false)
+!$OMP THREADPRIVATE(impveg)
+  LOGICAL, SAVE :: impsoilt = .FALSE.      !! Impose soil ? (true/false)
+!$OMP THREADPRIVATE(impsoilt)
+  LOGICAL, SAVE :: do_now_stomate_lcchange = .FALSE.  !! Time to call lcchange in stomate_lpj
+!$OMP THREADPRIVATE(do_now_stomate_lcchange)
+  LOGICAL, SAVE :: done_stomate_lcchange = .FALSE.    !! If true, call lcchange in stomate_lpj has just been done. 
+!$OMP THREADPRIVATE(done_stomate_lcchange)
+  LOGICAL, SAVE :: read_lai = .FALSE.      !! Flag to read a map of LAI if STOMATE is not activated (true/false)
+!$OMP THREADPRIVATE(read_lai)
+  LOGICAL, SAVE :: map_pft_format = .TRUE. !! Read a land use vegetation map on PFT format (true/false)
+!$OMP THREADPRIVATE(map_pft_format)
+  LOGICAL, SAVE :: veget_reinit = .TRUE.   !! To change LAND USE file in a run. (true/false)
+!$OMP THREADPRIVATE(veget_reinit)
+
+  !
+  ! PARAMETERS USED BY BOTH HYDROLOGY MODELS
+  !
+  REAL(r_std), SAVE :: max_snow_age = 50._r_std !! Maximum period of snow aging (days)
+!$OMP THREADPRIVATE(max_snow_age)
+  REAL(r_std), SAVE :: snow_trans = 0.3_r_std   !! Transformation time constant for snow (m)
+!$OMP THREADPRIVATE(snow_trans)
+  REAL(r_std), SAVE :: sneige                   !! Lower limit of snow amount (kg.m^{-2})
+!$OMP THREADPRIVATE(sneige)
+  REAL(r_std), SAVE :: maxmass_snow = 3000.     !! The maximum mass of snow (kg.m^{-2})
+!$OMP THREADPRIVATE(maxmass_snow)
+
+  !! Heat capacity
+  REAL(r_std), PARAMETER :: capa_ice = 2.228*1.E3       !! Heat capacity of ice (J/kg/K)
+  REAL(r_std), SAVE      :: so_capa_ice                 !! Heat capacity of saturated frozen soil (J/K/m3)
+!$OMP THREADPRIVATE(so_capa_ice)
+  REAL(r_std), PARAMETER :: rho_water = 1000.           !! Density of water (kg/m3)
+  REAL(r_std), PARAMETER :: rho_ice = 920.              !! Density of ice (kg/m3)
+
+  !! Thermal conductivities
+  REAL(r_std), PARAMETER :: cond_water = 0.6            !! Thermal conductivity of liquid water (W/m/K)
+  REAL(r_std), PARAMETER :: cond_ice = 2.2              !! Thermal conductivity of ice (W/m/K)
+  REAL(r_std), PARAMETER :: cond_solid = 2.32           !! Thermal conductivity of mineral soil particles (W/m/K)
+
+  !! Time constant of long-term soil humidity (s) 
+  REAL(r_std), PARAMETER :: lhf = 0.3336*1.E6           !! Latent heat of fusion (J/kg)
+
+  INTEGER(i_std), PARAMETER :: nsnow=3                  !! Number of levels in the snow for explicit snow scheme   
+  REAL(r_std), PARAMETER    :: XMD    = 28.9644E-3 
+  REAL(r_std), PARAMETER    :: XBOLTZ      = 1.380658E-23 
+  REAL(r_std), PARAMETER    :: XAVOGADRO   = 6.0221367E+23 
+  REAL(r_std), PARAMETER    :: XRD    = XAVOGADRO * XBOLTZ / XMD 
+  REAL(r_std), PARAMETER    :: XCPD   = 7.* XRD /2. 
+  REAL(r_std), PARAMETER    :: phigeoth = 0.057 ! 0. DKtest 
+  REAL(r_std), PARAMETER    :: thick_min_snow = .01 
+
+  !! The maximum snow density and water holding characterisicts 
+  REAL(r_std), SAVE         :: xrhosmax = 750.  ! (kg m-3) 
+  REAL(r_std), SAVE         :: xwsnowholdmax1   = 0.03  ! (-) 
+  REAL(r_std), SAVE         :: xwsnowholdmax2   = 0.10  ! (-) 
+  REAL(r_std), SAVE         :: xsnowrhohold     = 200.0 ! (kg/m3) 
+  REAL(r_std), SAVE         :: xrhosmin = 50. 
+  REAL(r_std), PARAMETER    :: xci = 2.106e+3 
+  REAL(r_std), PARAMETER    :: xrv = 6.0221367e+23 * 1.380658e-23 /18.0153e-3 
+
+  !! ISBA-ES Critical snow depth at which snow grid thicknesses constant 
+  REAL(r_std), PARAMETER    :: xsnowcritd = 0.03  ! (m) 
+
+  !! The threshold of snow depth used for preventing numerical problem in thermal calculations
+  REAL(r_std), PARAMETER    :: snowcritd_thermal = 0.01  ! (m)  
+  
+  !! ISBA-ES CROCUS (Pahaut 1976): snowfall density coefficients: 
+  REAL(r_std), PARAMETER       :: snowfall_a_sn = 109.0  !! (kg/m3) 
+  REAL(r_std), PARAMETER       :: snowfall_b_sn =   6.0  !! (kg/m3/K) 
+  REAL(r_std), PARAMETER       :: snowfall_c_sn =  26.0  !! [kg/(m7/2 s1/2)] 
+
+  REAL(r_std), PARAMETER       :: dgrain_new_max=  2.0e-4!! (m) : Maximum grain size of new snowfall 
+  
+  !! Used in explicitsnow to prevent numerical problems as snow becomes vanishingly thin. 
+  REAL(r_std), PARAMETER                :: psnowdzmin = .0001   ! m 
+  REAL(r_std), PARAMETER                :: xsnowdmin = .000001  ! m 
+
+  REAL(r_std), PARAMETER                :: ph2o = 1000.         !! Water density [kg/m3] 
+  
+  ! ISBA-ES Thermal conductivity coefficients from Anderson (1976): 
+  ! see Boone, Meteo-France/CNRM Note de Centre No. 70 (2002) 
+  REAL(r_std), SAVE                     :: ZSNOWTHRMCOND1 = 0.02    ! [W/m/K] 
+  REAL(r_std), SAVE                     :: ZSNOWTHRMCOND2 = 2.5E-6  ! [W m5/(kg2 K)] 
+  
+  ! ISBA-ES Thermal conductivity: Implicit vapor diffn effects 
+  ! (sig only for new snow OR high altitudes) 
+  ! from Sun et al. (1999): based on data from Jordan (1991) 
+  ! see Boone, Meteo-France/CNRM Note de Centre No. 70 (2002) 
+  ! 
+  REAL(r_std), SAVE                       :: ZSNOWTHRMCOND_AVAP  = -0.06023 ! (W/m/K) 
+  REAL(r_std), SAVE                       :: ZSNOWTHRMCOND_BVAP  = -2.5425  ! (W/m) 
+  REAL(r_std), SAVE                       :: ZSNOWTHRMCOND_CVAP  = -289.99  ! (K) 
+  
+  REAL(r_std),SAVE :: xansmax = 0.85      !! Maxmimum snow albedo
+  REAL(r_std),SAVE :: xansmin = 0.50      !! Miniumum snow albedo
+  REAL(r_std),SAVE :: xans_todry = 0.008  !! Albedo decay rate for dry snow
+  REAL(r_std),SAVE :: xans_t = 0.240      !! Albedo decay rate for wet snow
+
+  ! ISBA-ES Thermal conductivity coefficients from Anderson (1976):
+  ! see Boone, Meteo-France/CNRM Note de Centre No. 70 (2002)
+  REAL(r_std), PARAMETER                  :: XP00 = 1.E5
+
+  ! ISBA-ES Thermal conductivity: Implicit vapor diffn effects
+  ! (sig only for new snow OR high altitudes)
+  ! from Sun et al. (1999): based on data from Jordan (1991)
+  ! see Boone, Meteo-France/CNRM Note de Centre No. 70 (2002)
+  !
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_RHOD  = 150.0        !! (kg/m3)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_ACM   = 2.8e-6       !! (1/s)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_BCM   = 0.04         !! (1/K) 
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_CCM   = 460.         !! (m3/kg)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_V0    = 3.7e7        !! (Pa/s) 
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_VT    = 0.081        !! (1/K)
+  REAL(r_std), SAVE          :: ZSNOWCMPCT_VR    = 0.018        !! (m3/kg)
+
+  !
+  ! BVOC : Biogenic activity  for each age class
+  !
+  REAL(r_std), SAVE, DIMENSION(nleafages) :: iso_activity = (/0.5, 1.5, 1.5, 0.5/)     !! Biogenic activity for each 
+                                                                                       !! age class : isoprene (unitless)
+!$OMP THREADPRIVATE(iso_activity)
+  REAL(r_std), SAVE, DIMENSION(nleafages) :: methanol_activity = (/1., 1., 0.5, 0.5/)  !! Biogenic activity for each
+                                                                                       !! age class : methanol (unnitless)
+!$OMP THREADPRIVATE(methanol_activity)
+
+  !
+  ! condveg.f90
+  !
+
+  ! 1. Scalar
+
+  ! 1.1 Flags used inside the module
+
+  LOGICAL, SAVE :: alb_bare_model = .FALSE. !! Switch for choosing values of bare soil 
+                                            !! albedo (see header of subroutine)
+                                            !! (true/false)
+!$OMP THREADPRIVATE(alb_bare_model)
+  LOGICAL, SAVE :: alb_bg_modis = .FALSE.   !! Switch for choosing values of bare soil 
+                                            !! albedo read from file
+                                            !! (true/false)
+!$OMP THREADPRIVATE(alb_bg_modis)
+  LOGICAL, SAVE :: impaze = .FALSE.         !! Switch for choosing surface parameters
+                                            !! (see header of subroutine).  
+                                            !! (true/false)
+!$OMP THREADPRIVATE(impaze)
+  LOGICAL, SAVE :: z0cdrag_ave = .TRUE.     !! Chooses between two methods to calculate the 
+                                            !! grid average of the roughness (see header of subroutine)   
+                                            !! (true/false)
+!$OMP THREADPRIVATE(z0cdrag_ave)
+  ! 1.2 Others 
+
+  REAL(r_std), SAVE :: z0_over_height = un/16.           !! Factor to calculate roughness height from 
+                                                         !! vegetation height (unitless)   
+!$OMP THREADPRIVATE(z0_over_height)
+  REAL(r_std), SAVE :: height_displacement = 0.75        !! Factor to calculate the zero-plane displacement
+                                                         !! height from vegetation height (m)
+!$OMP THREADPRIVATE(height_displacement)
+  REAL(r_std), SAVE :: z0_bare = 0.01                    !! bare soil roughness length (m)
+!$OMP THREADPRIVATE(z0_bare)
+  REAL(r_std), SAVE :: z0_ice = 0.001                    !! ice roughness length (m)
+!$OMP THREADPRIVATE(z0_ice)
+  REAL(r_std), SAVE :: tcst_snowa = 5.0                  !! Time constant of the albedo decay of snow (days)
+!$OMP THREADPRIVATE(tcst_snowa)
+  REAL(r_std), SAVE :: snowcri_alb = 10.                 !! Critical value for computation of snow albedo (cm)
+!$OMP THREADPRIVATE(snowcri_alb)
+  REAL(r_std), SAVE :: fixed_snow_albedo = undef_sechiba !! To choose a fixed snow albedo value (unitless)
+!$OMP THREADPRIVATE(fixed_snow_albedo)
+  REAL(r_std), SAVE :: z0_scal = 0.15                    !! Surface roughness height imposed (m)
+!$OMP THREADPRIVATE(z0_scal)
+  REAL(r_std), SAVE :: roughheight_scal = zero           !! Effective roughness Height depending on zero-plane 
+                                                         !! displacement height (m) (imposed)
+!$OMP THREADPRIVATE(roughheight_scal)
+  REAL(r_std), SAVE :: emis_scal = 1.0                   !! Surface emissivity imposed (unitless)
+!$OMP THREADPRIVATE(emis_scal)
+  ! 2. Arrays
+
+  REAL(r_std), SAVE, DIMENSION(2) :: alb_deadleaf = (/ .12, .35/)    !! albedo of dead leaves, VIS+NIR (unitless)
+!$OMP THREADPRIVATE(alb_deadleaf)
+  REAL(r_std), SAVE, DIMENSION(2) :: alb_ice = (/ .60, .20/)         !! albedo of ice, VIS+NIR (unitless)
+!$OMP THREADPRIVATE(alb_ice)
+  REAL(r_std), SAVE, DIMENSION(2) :: albedo_scal = (/ 0.25, 0.25 /)  !! Albedo values for visible and near-infrared 
+                                                                     !! used imposed (unitless) 
+!$OMP THREADPRIVATE(albedo_scal)
+  REAL(r_std) , SAVE, DIMENSION(classnb) :: vis_dry = (/0.24,&
+       &0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.27/)  !! Soil albedo values to soil colour classification:
+                                                          !! dry soil albedo values in visible range
+!$OMP THREADPRIVATE(vis_dry)
+  REAL(r_std), SAVE, DIMENSION(classnb) :: nir_dry = (/0.48,&
+       &0.44, 0.40, 0.36, 0.32, 0.28, 0.24, 0.20, 0.55/)  !! Soil albedo values to soil colour classification:
+                                                          !! dry soil albedo values in near-infrared range 
+!$OMP THREADPRIVATE(nir_dry)
+  REAL(r_std), SAVE, DIMENSION(classnb) :: vis_wet = (/0.12,&
+       &0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.15/)  !! Soil albedo values to soil colour classification:
+                                                          !! wet soil albedo values in visible range 
+!$OMP THREADPRIVATE(vis_wet)
+  REAL(r_std), SAVE, DIMENSION(classnb) :: nir_wet = (/0.24,&
+       &0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.31/)  !! Soil albedo values to soil colour classification:
+                                                          !! wet soil albedo values in near-infrared range
+!$OMP THREADPRIVATE(nir_wet)
+  REAL(r_std), SAVE, DIMENSION(classnb) :: albsoil_vis = (/ &
+       &0.18, 0.16, 0.16, 0.15, 0.12, 0.105, 0.09, 0.075, 0.25/)   !! Soil albedo values to soil colour classification:
+                                                                   !! Averaged of wet and dry soil albedo values
+                                                                   !! in visible and near-infrared range
+!$OMP THREADPRIVATE(albsoil_vis) 
+  REAL(r_std), SAVE, DIMENSION(classnb) :: albsoil_nir = (/ &
+       &0.36, 0.34, 0.34, 0.33, 0.30, 0.25, 0.20, 0.15, 0.45/)  !! Soil albedo values to soil colour classification:
+                                                                !! Averaged of wet and dry soil albedo values
+                                                                !! in visible and near-infrared range
+!$OMP THREADPRIVATE(albsoil_nir)
+
+  !
+  ! diffuco.f90
+  !
+
+  ! 0. Constants
+
+  REAL(r_std), PARAMETER :: Tetens_1 = 0.622         !! Ratio between molecular weight of water vapor and molecular weight  
+                                                     !! of dry air (unitless)
+  REAL(r_std), PARAMETER :: Tetens_2 = 0.378         !!
+  REAL(r_std), PARAMETER :: ratio_H2O_to_CO2 = 1.6   !! Ratio of water vapor diffusivity to the CO2 diffusivity (unitless)
+  REAL(r_std), PARAMETER :: mmol_to_m_1 = 0.0244     !!
+  REAL(r_std), PARAMETER :: RG_to_PAR = 0.5          !!
+  REAL(r_std), PARAMETER :: W_to_mmol = 4.6          !! W_to_mmol * RG_to_PAR = 2.3
+
+  ! 1. Scalar
+
+  INTEGER(i_std), SAVE :: nlai = 20             !! Number of LAI levels (unitless)
+!$OMP THREADPRIVATE(nlai)
+  LOGICAL, SAVE :: ldq_cdrag_from_gcm = .FALSE. !! Set to .TRUE. if you want q_cdrag coming from GCM
+!$OMP THREADPRIVATE(ldq_cdrag_from_gcm)
+  REAL(r_std), SAVE :: laimax = 12.             !! Maximal LAI used for splitting LAI into N layers (m^2.m^{-2})
+!$OMP THREADPRIVATE(laimax)
+  LOGICAL, SAVE :: downregulation_co2 = .FALSE.            !! Set to .TRUE. if you want CO2 downregulation.
+!$OMP THREADPRIVATE(downregulation_co2)
+  REAL(r_std), SAVE :: downregulation_co2_baselevel = 280. !! CO2 base level (ppm)
+!$OMP THREADPRIVATE(downregulation_co2_baselevel)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: lai_level_depth = 0.15  !!
+!$OMP THREADPRIVATE(lai_level_depth)
+!
+  REAL(r_std), SAVE, DIMENSION(6) :: dew_veg_poly_coeff = &            !! coefficients of the 5 degree polynomomial used
+  & (/ 0.887773, 0.205673, 0.110112, 0.014843,  0.000824,  0.000017 /) !! in the equation of coeff_dew_veg
+!$OMP THREADPRIVATE(dew_veg_poly_coeff)
+!
+  REAL(r_std), SAVE               :: Oi=210000.    !! Intercellular oxygen partial pressure (ubar)
+!$OMP THREADPRIVATE(Oi)
+  !
+  ! slowproc.f90 
+  !
+
+  ! 1. Scalar
+
+  INTEGER(i_std), SAVE :: veget_year_orig = 0        !!  first year for landuse (number)
+!$OMP THREADPRIVATE(veget_year_orig)
+  REAL(r_std), SAVE :: clayfraction_default = 0.2    !! Default value for clay fraction (0-1, unitless)
+!$OMP THREADPRIVATE(clayfraction_default)
+  REAL(r_std), SAVE :: siltfraction_default = 0.4    !! Default value for silt fraction (0-1, unitless)
+!$OMP THREADPRIVATE(siltfraction_default)
+  REAL(r_std), SAVE :: sandfraction_default = 0.4    !! Default value for sand fraction (0-1, unitless)
+!$OMP THREADPRIVATE(sandfraction_default)
+  REAL(r_std), SAVE :: min_vegfrac = 0.001           !! Minimal fraction of mesh a vegetation type can occupy (0-1, unitless)
+!$OMP THREADPRIVATE(min_vegfrac)
+  REAL(r_std), SAVE :: frac_nobio_fixed_test_1 = 0.0 !! Value for frac_nobio for tests in 0-dim simulations (0-1, unitless)
+!$OMP THREADPRIVATE(frac_nobio_fixed_test_1)
+  
+  REAL(r_std), SAVE :: stempdiag_bid = 280.          !! only needed for an initial LAI if there is no restart file
+!$OMP THREADPRIVATE(stempdiag_bid)
+
+  ! routing.f90
+  ! 
+
+  ! 1. Constants
+  REAL(r_std), PARAMETER :: msmlr_C = 12.011E-03     !! Molecular weight of C (kg.mol^{-1})
+
+                           !-----------------------------!
+                           !  STOMATE AND LPJ PARAMETERS !
+                           !-----------------------------!
+
+
+  !
+  ! lpj_constraints.f90
+  !
+  
+  ! 1. Scalar
+
+  REAL(r_std), SAVE  :: too_long = 5.      !! longest sustainable time without 
+                                           !! regeneration (vernalization) (years)
+!$OMP THREADPRIVATE(too_long)
+
+
+  !
+  ! lpj_establish.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: estab_max_tree = 0.12   !! Maximum tree establishment rate (0-1, unitless)
+!$OMP THREADPRIVATE(estab_max_tree)
+  REAL(r_std), SAVE :: estab_max_grass = 0.12  !! Maximum grass establishment rate (0-1, unitless)
+!$OMP THREADPRIVATE(estab_max_grass)
+  
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: establish_scal_fact = 5.  !!
+!$OMP THREADPRIVATE(establish_scal_fact)
+  REAL(r_std), SAVE :: max_tree_coverage = 0.98  !! (0-1, unitless)
+!$OMP THREADPRIVATE(max_tree_coverage)
+  REAL(r_std), SAVE :: ind_0_estab = 0.2         !! = ind_0 * 10.
+!$OMP THREADPRIVATE(ind_0_estab)
+
+
+  !
+  ! lpj_fire.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: tau_fire = 30.           !! Time scale for memory of the fire index (days).
+!$OMP THREADPRIVATE(tau_fire)
+  REAL(r_std), SAVE :: litter_crit = 200.       !! Critical litter quantity for fire
+                                                !! below which iginitions extinguish 
+                                                !! @tex $(gC m^{-2})$ @endtex
+!$OMP THREADPRIVATE(litter_crit)
+  REAL(r_std), SAVE :: fire_resist_struct = 0.5 !!
+!$OMP THREADPRIVATE(fire_resist_struct)
+  ! 2. Arrays
+
+  REAL(r_std), SAVE, DIMENSION(nparts) :: co2frac = &    !! The fraction of the different biomass 
+       & (/ .95, .95, 0., 0.3, 0., 0., .95, .95 /)       !! compartments emitted to the atmosphere 
+!$OMP THREADPRIVATE(co2frac)                                                         !! when burned (unitless, 0-1)  
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE, DIMENSION(3) :: bcfrac_coeff = (/ .3,  1.3,  88.2 /)         !! (unitless)
+!$OMP THREADPRIVATE(bcfrac_coeff)
+  REAL(r_std), SAVE, DIMENSION(4) :: firefrac_coeff = (/ 0.45, 0.8, 0.6, 0.13 /)  !! (unitless)
+!$OMP THREADPRIVATE(firefrac_coeff)
+
+  !
+  ! lpj_gap.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: ref_greff = 0.035         !! Asymptotic maximum mortality rate
+                                                 !! @tex $(year^{-1})$ @endtex
+!$OMP THREADPRIVATE(ref_greff)
+
+  !               
+  ! lpj_light.f90 
+  !              
+
+  ! 1. Scalar
+  
+  LOGICAL, SAVE :: annual_increase = .TRUE. !! for diagnosis of fpc increase, compare today's fpc to last year's maximum (T) or
+                                            !! to fpc of last time step (F)? (true/false)
+!$OMP THREADPRIVATE(annual_increase)
+  REAL(r_std), SAVE :: min_cover = 0.05     !! For trees, minimum fraction of crown area occupied
+                                            !! (due to its branches etc.) (0-1, unitless)
+                                            !! This means that only a small fraction of its crown area
+                                            !! can be invaded by other trees.
+!$OMP THREADPRIVATE(min_cover)
+  !
+  ! lpj_pftinout.f90 
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: min_avail = 0.01         !! minimum availability
+!$OMP THREADPRIVATE(min_avail)
+  REAL(r_std), SAVE :: ind_0 = 0.02             !! initial density of individuals
+!$OMP THREADPRIVATE(ind_0)
+  ! 3. Coefficients of equations
+  
+  REAL(r_std), SAVE :: RIP_time_min = 1.25      !! test whether the PFT has been eliminated lately (years)
+!$OMP THREADPRIVATE(RIP_time_min)
+  REAL(r_std), SAVE :: npp_longterm_init = 10.  !! Initialisation value for npp_longterm (gC.m^{-2}.year^{-1})
+!$OMP THREADPRIVATE(npp_longterm_init)
+  REAL(r_std), SAVE :: everywhere_init = 0.05   !!
+!$OMP THREADPRIVATE(everywhere_init)
+
+
+  !
+  ! stomate_alloc.f90
+  !
+
+  ! 0. Constants
+
+  REAL(r_std), PARAMETER :: max_possible_lai = 10. !! (m^2.m^{-2})
+  REAL(r_std), PARAMETER :: Nlim_Q10 = 10.         !!
+
+  ! 1. Scalar
+
+  LOGICAL, SAVE :: ok_minres = .TRUE.              !! [DISPENSABLE] Do we try to reach a minimum reservoir even if
+                                                   !! we are severely stressed? (true/false)
+!$OMP THREADPRIVATE(ok_minres)
+  REAL(r_std), SAVE :: reserve_time_tree = 30.     !! Maximum number of days during which
+                                                   !! carbohydrate reserve may be used for 
+                                                   !! trees (days)
+!$OMP THREADPRIVATE(reserve_time_tree)
+  REAL(r_std), SAVE :: reserve_time_grass = 20.    !! Maximum number of days during which
+                                                   !! carbohydrate reserve may be used for 
+                                                   !! grasses (days)
+!$OMP THREADPRIVATE(reserve_time_grass)
+
+  REAL(r_std), SAVE :: f_fruit = 0.1               !! Default fruit allocation (0-1, unitless)
+!$OMP THREADPRIVATE(f_fruit)
+  REAL(r_std), SAVE :: alloc_sap_above_grass = 1.0 !! fraction of sapwood allocation above ground
+                                                   !! for grass (0-1, unitless)
+!$OMP THREADPRIVATE(alloc_sap_above_grass)
+  REAL(r_std), SAVE :: min_LtoLSR = 0.2            !! Prescribed lower bounds for leaf 
+                                                   !! allocation (0-1, unitless)
+!$OMP THREADPRIVATE(min_LtoLSR)
+  REAL(r_std), SAVE :: max_LtoLSR = 0.5            !! Prescribed upper bounds for leaf 
+                                                   !! allocation (0-1, unitless)
+!$OMP THREADPRIVATE(max_LtoLSR)
+  REAL(r_std), SAVE :: z_nitrogen = 0.2            !! Curvature of the root profile (m)
+!$OMP THREADPRIVATE(z_nitrogen)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: Nlim_tref = 25.             !! (C)
+!$OMP THREADPRIVATE(Nlim_tref)
+
+
+  !
+  ! stomate_data.f90 
+  !
+
+  ! 1. Scalar 
+
+  ! 1.1 Parameters for the pipe model
+
+  REAL(r_std), SAVE :: pipe_tune1 = 100.0        !! crown area = pipe_tune1. stem diameter**(1.6) (Reinicke's theory) (unitless)
+!$OMP THREADPRIVATE(pipe_tune1)
+  REAL(r_std), SAVE :: pipe_tune2 = 40.0         !! height=pipe_tune2 * diameter**pipe_tune3 (unitless)
+!$OMP THREADPRIVATE(pipe_tune2)
+  REAL(r_std), SAVE :: pipe_tune3 = 0.5          !! height=pipe_tune2 * diameter**pipe_tune3 (unitless)
+!$OMP THREADPRIVATE(pipe_tune3)
+  REAL(r_std), SAVE :: pipe_tune4 = 0.3          !! needed for stem diameter (unitless)
+!$OMP THREADPRIVATE(pipe_tune4)
+  REAL(r_std), SAVE :: pipe_density = 2.e5       !! Density
+!$OMP THREADPRIVATE(pipe_density)
+  REAL(r_std), SAVE :: pipe_k1 = 8.e3            !! one more SAVE
+!$OMP THREADPRIVATE(pipe_k1)
+  REAL(r_std), SAVE :: pipe_tune_exp_coeff = 1.6 !! pipe tune exponential coeff (unitless)
+!$OMP THREADPRIVATE(pipe_tune_exp_coeff)
+
+  ! 1.2 climatic parameters 
+
+  REAL(r_std), SAVE :: precip_crit = 100.        !! minimum precip, in (mm/year)
+!$OMP THREADPRIVATE(precip_crit)
+  REAL(r_std), SAVE :: gdd_crit_estab = 150.     !! minimum gdd for establishment of saplings
+!$OMP THREADPRIVATE(gdd_crit_estab)
+  REAL(r_std), SAVE :: fpc_crit = 0.95           !! critical fpc, needed for light competition and establishment (0-1, unitless)
+!$OMP THREADPRIVATE(fpc_crit)
+
+  ! 1.3 sapling characteristics
+
+  REAL(r_std), SAVE :: alpha_grass = 0.5         !! alpha coefficient for grasses (unitless)
+!$OMP THREADPRIVATE(alpha_grass)
+  REAL(r_std), SAVE :: alpha_tree = 1.           !! alpha coefficient for trees (unitless)
+!$OMP THREADPRIVATE(alpha_tree)
+  REAL(r_std), SAVE :: mass_ratio_heart_sap = 3. !! mass ratio (heartwood+sapwood)/sapwood (unitless)
+!$OMP THREADPRIVATE(mass_ratio_heart_sap)
+
+  ! 1.4  time scales for phenology and other processes (in days)
+
+  REAL(r_std), SAVE :: tau_hum_month = 20.        !! (days)       
+!$OMP THREADPRIVATE(tau_hum_month)
+  REAL(r_std), SAVE :: tau_hum_week = 7.          !! (days)  
+!$OMP THREADPRIVATE(tau_hum_week)
+  REAL(r_std), SAVE :: tau_t2m_month = 20.        !! (days)      
+!$OMP THREADPRIVATE(tau_t2m_month)
+  REAL(r_std), SAVE :: tau_t2m_week = 7.          !! (days)  
+!$OMP THREADPRIVATE(tau_t2m_week)
+  REAL(r_std), SAVE :: tau_tsoil_month = 20.      !! (days)     
+!$OMP THREADPRIVATE(tau_tsoil_month)
+  REAL(r_std), SAVE :: tau_soilhum_month = 20.    !! (days)     
+!$OMP THREADPRIVATE(tau_soilhum_month)
+  REAL(r_std), SAVE :: tau_gpp_week = 7.          !! (days)  
+!$OMP THREADPRIVATE(tau_gpp_week)
+  REAL(r_std), SAVE :: tau_gdd = 40.              !! (days)  
+!$OMP THREADPRIVATE(tau_gdd)
+  REAL(r_std), SAVE :: tau_ngd = 50.              !! (days)  
+!$OMP THREADPRIVATE(tau_ngd)
+  REAL(r_std), SAVE :: coeff_tau_longterm = 3.    !! (unitless)
+!$OMP THREADPRIVATE(coeff_tau_longterm)
+  REAL(r_std), SAVE :: tau_longterm_max           !! (days)  
+!$OMP THREADPRIVATE(tau_longterm_max)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: bm_sapl_carbres = 5.             !!
+!$OMP THREADPRIVATE(bm_sapl_carbres)
+  REAL(r_std), SAVE :: bm_sapl_sapabove = 0.5           !!
+!$OMP THREADPRIVATE(bm_sapl_sapabove)
+  REAL(r_std), SAVE :: bm_sapl_heartabove = 2.          !!
+!$OMP THREADPRIVATE(bm_sapl_heartabove)
+  REAL(r_std), SAVE :: bm_sapl_heartbelow = 2.          !!
+!$OMP THREADPRIVATE(bm_sapl_heartbelow)
+  REAL(r_std), SAVE :: init_sapl_mass_leaf_nat = 0.1    !!
+!$OMP THREADPRIVATE(init_sapl_mass_leaf_nat)
+  REAL(r_std), SAVE :: init_sapl_mass_leaf_agri = 1.    !!
+!$OMP THREADPRIVATE(init_sapl_mass_leaf_agri)
+  REAL(r_std), SAVE :: init_sapl_mass_carbres = 5.      !!
+!$OMP THREADPRIVATE(init_sapl_mass_carbres)
+  REAL(r_std), SAVE :: init_sapl_mass_root = 0.1        !!
+!$OMP THREADPRIVATE(init_sapl_mass_root)
+  REAL(r_std), SAVE :: init_sapl_mass_fruit = 0.3       !!  
+!$OMP THREADPRIVATE(init_sapl_mass_fruit)
+  REAL(r_std), SAVE :: cn_sapl_init = 0.5               !!
+!$OMP THREADPRIVATE(cn_sapl_init)
+  REAL(r_std), SAVE :: migrate_tree = 10.*1.E3          !!
+!$OMP THREADPRIVATE(migrate_tree)
+  REAL(r_std), SAVE :: migrate_grass = 10.*1.E3         !!
+!$OMP THREADPRIVATE(migrate_grass)
+  REAL(r_std), SAVE :: lai_initmin_tree = 0.3           !!
+!$OMP THREADPRIVATE(lai_initmin_tree)
+  REAL(r_std), SAVE :: lai_initmin_grass = 0.1          !!
+!$OMP THREADPRIVATE(lai_initmin_grass)
+  REAL(r_std), SAVE, DIMENSION(2) :: dia_coeff = (/ 4., 0.5 /)            !!
+!$OMP THREADPRIVATE(dia_coeff)
+  REAL(r_std), SAVE, DIMENSION(2) :: maxdia_coeff =(/ 100., 0.01/)        !!
+!$OMP THREADPRIVATE(maxdia_coeff)
+  REAL(r_std), SAVE, DIMENSION(4) :: bm_sapl_leaf = (/ 4., 4., 0.8, 5./)  !!
+!$OMP THREADPRIVATE(bm_sapl_leaf)
+
+
+
+  !
+  ! stomate_litter.f90 
+  !
+
+  ! 0. Constants
+
+  REAL(r_std), PARAMETER :: Q10 = 10.               !!
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: z_decomp = 0.2               !!  Maximum depth for soil decomposer's activity (m)
+!$OMP THREADPRIVATE(z_decomp)
+
+  ! 2. Arrays
+
+  REAL(r_std), SAVE :: frac_soil_struct_aa = 0.45   !! corresponding to frac_soil(istructural,iactive,iabove) 
+!$OMP THREADPRIVATE(frac_soil_struct_aa)
+  REAL(r_std), SAVE :: frac_soil_struct_ab = 0.45   !! corresponding to frac_soil(istructural,iactive,ibelow)
+!$OMP THREADPRIVATE(frac_soil_struct_ab)
+  REAL(r_std), SAVE :: frac_soil_struct_sa = 0.7    !! corresponding to frac_soil(istructural,islow,iabove)
+!$OMP THREADPRIVATE(frac_soil_struct_sa)
+  REAL(r_std), SAVE :: frac_soil_struct_sb = 0.7    !! corresponding to frac_soil(istructural,islow,ibelow)
+!$OMP THREADPRIVATE(frac_soil_struct_sb)
+  REAL(r_std), SAVE :: frac_soil_metab_aa = 0.45    !! corresponding to frac_soil(imetabolic,iactive,iabove)
+!$OMP THREADPRIVATE(frac_soil_metab_aa)
+  REAL(r_std), SAVE :: frac_soil_metab_ab = 0.45    !! corresponding to frac_soil(imetabolic,iactive,ibelow)
+!$OMP THREADPRIVATE(frac_soil_metab_ab)
+  REAL(r_std), SAVE, DIMENSION(nparts) :: CN = &    !! C/N ratio of each plant pool (0-100, unitless)
+       & (/ 40., 40., 40., 40., 40., 40., 40., 40. /) 
+!$OMP THREADPRIVATE(CN)
+  REAL(r_std), SAVE, DIMENSION(nparts) :: LC = &    !! Lignin/C ratio of different plant parts (0,22-0,35, unitless)
+       & (/ 0.22, 0.35, 0.35, 0.35, 0.35, 0.22, 0.22, 0.22 /)
+!$OMP THREADPRIVATE(LC)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: metabolic_ref_frac = 0.85    !! used by litter and soilcarbon (0-1, unitless)
+!$OMP THREADPRIVATE(metabolic_ref_frac)
+  REAL(r_std), SAVE :: metabolic_LN_ratio = 0.018   !! (0-1, unitless)   
+!$OMP THREADPRIVATE(metabolic_LN_ratio)
+  REAL(r_std), SAVE :: tau_metabolic = 0.066        !!
+!$OMP THREADPRIVATE(tau_metabolic)
+  REAL(r_std), SAVE :: tau_struct = 0.245           !!
+!$OMP THREADPRIVATE(tau_struct)
+  REAL(r_std), SAVE :: soil_Q10 = 0.69              !!= ln 2
+!$OMP THREADPRIVATE(soil_Q10)
+ REAL(r_std), SAVE :: ratio = 1                  !!= ratio C14C
+!$OMP THREADPRIVATE(ratio)
+ REAL(r_std), SAVE :: k_decrease = 0.000121       !!= 14C_decrease unit Year-1
+!$OMP THREADPRIVATE(k_decrease)
+  REAL(r_std), SAVE :: a_term_Q10_soil = 1.1756    !! used for Q10 calculation in soils
+!$OMP THREADPRIVATE(a_term_Q10_soil)
+  REAL(r_std), SAVE :: b_term_Q10_soil = 55.33     !! used for Q10 calculation in soils
+!$OMP THREADPRIVATE(b_term_Q10_soil)
+  REAL(r_std), SAVE :: tsoil_ref = 30.              !!
+!$OMP THREADPRIVATE(tsoil_ref)
+  REAL(r_std), SAVE :: litter_struct_coef = 3.      !! 
+!$OMP THREADPRIVATE(litter_struct_coef)
+  REAL(r_std), SAVE, DIMENSION(3) :: moist_coeff = (/ 1.1,  2.4,  0.29 /) !!
+!$OMP THREADPRIVATE(moist_coeff)
+  REAL(r_std), SAVE :: moistcont_min = 0.25  !! minimum soil wetness to limit the heterotrophic respiration
+!$OMP THREADPRIVATE(moistcont_min)
+  REAL(r_std), SAVE :: Dif = 1.E-4   !! diffusion coeficient for POC (m2 year-1) coming from Koven et al., 2013 BG.
+!$OMP THREADPRIVATE(Dif)
+ REAL(r_std), SAVE :: z_litter = 10.   !! Thickness of the above ground litter layer
+!$OMP THREADPRIVATE(z_litter)
+
+
+  !
+  ! stomate_lpj.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: frac_turnover_daily = 0.55  !! (0-1, unitless)
+!$OMP THREADPRIVATE(frac_turnover_daily)
+
+
+  !
+  ! stomate_npp.f90 
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: tax_max = 0.8 !! Maximum fraction of allocatable biomass used 
+                                     !! for maintenance respiration (0-1, unitless)
+!$OMP THREADPRIVATE(tax_max)
+
+
+  !
+  ! stomate_phenology.f90
+  !
+
+  ! 1. Scalar
+
+  LOGICAL, SAVE :: always_init = .FALSE.           !! take carbon from atmosphere if carbohydrate reserve too small? (true/false)
+!$OMP THREADPRIVATE(always_init)
+  REAL(r_std), SAVE :: min_growthinit_time = 300.  !! minimum time since last beginning of a growing season (days)
+!$OMP THREADPRIVATE(min_growthinit_time)
+  REAL(r_std), SAVE :: moiavail_always_tree = 1.0  !! moisture monthly availability above which moisture tendency doesn't matter
+                                                   !!  - for trees (0-1, unitless)
+!$OMP THREADPRIVATE(moiavail_always_tree)
+  REAL(r_std), SAVE :: moiavail_always_grass = 0.6 !! moisture monthly availability above which moisture tendency doesn't matter
+                                                   !! - for grass (0-1, unitless)
+!$OMP THREADPRIVATE(moiavail_always_grass)
+  REAL(r_std), SAVE :: t_always                    !! monthly temp. above which temp. tendency doesn't matter
+!$OMP THREADPRIVATE(t_always)
+  REAL(r_std), SAVE :: t_always_add = 10.          !! monthly temp. above which temp. tendency doesn't matter (C)
+!$OMP THREADPRIVATE(t_always_add)
+
+  ! 3. Coefficients of equations
+  
+  REAL(r_std), SAVE :: gddncd_ref = 603.           !!
+!$OMP THREADPRIVATE(gddncd_ref)
+  REAL(r_std), SAVE :: gddncd_curve = 0.0091       !!
+!$OMP THREADPRIVATE(gddncd_curve)
+  REAL(r_std), SAVE :: gddncd_offset = 64.         !!
+!$OMP THREADPRIVATE(gddncd_offset)
+
+
+  !
+  ! stomate_prescribe.f90
+  !
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: bm_sapl_rescale = 40.       !!
+!$OMP THREADPRIVATE(bm_sapl_rescale)
+
+
+  !
+  ! stomate_resp.f90
+  !
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: maint_resp_min_vmax = 0.3   !!
+!$OMP THREADPRIVATE(maint_resp_min_vmax)
+  REAL(r_std), SAVE :: maint_resp_coeff = 1.4      !!
+!$OMP THREADPRIVATE(maint_resp_coeff)
+
+
+  !
+  ! stomate_soilcarbon.f90 
+  !
+
+  ! 2. Arrays 
+
+  ! 2.1 frac_carb_coefficients
+
+  REAL(r_std), SAVE :: frac_carb_ap = 0.004  !! from active pool: depends on clay content  (0-1, unitless)
+                                             !! corresponding to frac_carb(:,iactive,ipassive)
+!$OMP THREADPRIVATE(frac_carb_ap)
+  REAL(r_std), SAVE :: frac_carb_sa = 0.93   !! from slow pool (0-1, unitless)
+                                             !! corresponding to frac_carb(:,islow,iactive)
+!$OMP THREADPRIVATE(frac_carb_sa)
+  REAL(r_std), SAVE :: frac_carb_pa = 1.0   !! from passive pool (0-1, unitless)
+                                             !! corresponding to frac_carb(:,ipassive,iactive)
+!$OMP THREADPRIVATE(frac_carb_pa)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: active_to_pass_clay_frac = 0.68  !! (0-1, unitless)
+!$OMP THREADPRIVATE(active_to_pass_clay_frac)
+  !! residence times in carbon pools (years)
+  REAL(r_std), SAVE :: carbon_tau_iactive = 1.0   !! residence times in active pool (years)
+!$OMP THREADPRIVATE(carbon_tau_iactive)
+  REAL(r_std), SAVE :: carbon_tau_islow = 6.0      !! residence times in slow pool (years)
+!$OMP THREADPRIVATE(carbon_tau_islow)
+  REAL(r_std), SAVE :: carbon_tau_ipassive = 462.0   !! residence times in passive pool (years)
+!$OMP THREADPRIVATE(carbon_tau_ipassive)
+  !! priming parameter (-)
+  REAL(r_std), SAVE :: priming_param_iactive = 493.66   !! priming parameter for the active pool (-)
+!$OMP THREADPRIVATE(priming_param_iactive)
+  REAL(r_std), SAVE :: priming_param_islow = 194.03   !! priming parameter for the slow pool (-)
+!$OMP THREADPRIVATE(priming_param_islow)
+  REAL(r_std), SAVE :: priming_param_ipassive = 136.54   !! priming parameter for the passive pool (-)
+!$OMP THREADPRIVATE(priming_param_ipassvie)
+  REAL(r_std), SAVE, DIMENSION(13) :: DOC_tau_labile = (/1.3,1.3,1.3,1.3,1.3,1.3,1.3,1.3,1.3,1.3,1.3,1.3,1.3/)   !! residence times of labile DOC (days) tuning
+!$OMP THREADPRIVATE(DOC_tau_labile)
+  REAL(r_std), SAVE, DIMENSION(13) :: DOC_tau_stable = (/60.4,1.3,1.3,60.4,1.3,1.3,60.4,1.3,60.4,1.3,1.3,1.3,1.3/)   !! residence times of labile DOC (days) tuning 
+!$OMP THREADPRIVATE(DOC_tau_stable)
+ REAL(r_std), SAVE :: D_DOC = 0.0000106272 !! diffusion coeficient for DOC (m2 day-1) coming from Burdige et al., 1999 in Ota et al., 2013
+!$OMP THREADPRIVATE(D_DOC)
+ REAL(r_std), SAVE :: red_factor = 1.  !! A parameter to reduce the DOC flux due to water flux in the soil column. Pure tunning set to 1 so no 
+                                       !! effect by default.
+!$OMP THREADPRIVATE(red_factor)
+ REAL(r_std), SAVE :: m_ads = 0.3   !! partition coeficient for adsorption of DOC (-) from Neff and Asner, 2001
+!$OMP THREADPRIVATE(m_ads)
+ REAL(r_std), SAVE :: b_ads = 0.15    !! desorption coeficient for adsorption of DOC (mg C g soil-1) from Neff and Asner, 2001
+!$OMP THREADPRIVATE(b_ads)
+REAL(r_std), SAVE :: kd_ads = 0.00805    !! distribution coefficient for adsorption of DOC (m3 water kg soil-1) from Moore et al., 1992
+!$OMP THREADPRIVATE(kd_ads)
+ REAL(r_std), SAVE, DIMENSION(13) :: CUE = (/0.5,0.35,0.35,0.5,0.35,0.35,0.5,0.35,0.5,0.5,0.5,0.5,0.5/)   !! Microbial carbon use efficiency(unitless, 0-1) from Camino-Serrano In prep     
+!$OMP THREADPRIVATE(CUE)
+  REAL(r_std), SAVE :: bulk_density_default = 1.65   !! soil bulk density (kg m-3)
+!$OMP THREADPRIVATE(bulk_density)
+  REAL(r_std), SAVE, DIMENSION(3) :: flux_tot_coeff = (/ 1.2, 1.4, .75/)
+!$OMP THREADPRIVATE(flux_tot_coeff)
+  REAL(r_std), SAVE :: soil_ph_default = 7.0   !! soil pH (pH units)
+!$OMP THREADPRIVATE(soil_ph)
+
+  !
+  ! stomate_turnover.f90
+  !
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: new_turnover_time_ref = 20. !!(days)
+!$OMP THREADPRIVATE(new_turnover_time_ref)
+  REAL(r_std), SAVE :: leaf_age_crit_tref = 20.    !! (C)
+!$OMP THREADPRIVATE(leaf_age_crit_tref)
+  REAL(r_std), SAVE, DIMENSION(3) :: leaf_age_crit_coeff = (/ 1.5, 0.75, 10./) !! (unitless)
+!$OMP THREADPRIVATE(leaf_age_crit_coeff)
+
+
+  !
+  ! stomate_vmax.f90
+  !
+ 
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: vmax_offset = 0.3        !! minimum leaf efficiency (unitless)
+!$OMP THREADPRIVATE(vmax_offset)
+  REAL(r_std), SAVE :: leafage_firstmax = 0.03  !! relative leaf age at which efficiency
+                                                !! reaches 1 (unitless)
+!$OMP THREADPRIVATE(leafage_firstmax)
+  REAL(r_std), SAVE :: leafage_lastmax = 0.5    !! relative leaf age at which efficiency
+                                                !! falls below 1 (unitless)
+!$OMP THREADPRIVATE(leafage_lastmax)
+  REAL(r_std), SAVE :: leafage_old = 1.         !! relative leaf age at which efficiency
+                                                !! reaches its minimum (vmax_offset) 
+                                                !! (unitless)
+!$OMP THREADPRIVATE(leafage_old)
+  !
+  ! stomate_season.f90 
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: gppfrac_dormance = 0.2  !! report maximal GPP/GGP_max for dormance (0-1, unitless)
+!$OMP THREADPRIVATE(gppfrac_dormance)
+  REAL(r_std), SAVE :: tau_climatology = 20.   !! tau for "climatologic variables (years)
+!$OMP THREADPRIVATE(tau_climatology)
+  REAL(r_std), SAVE :: hvc1 = 0.019            !! parameters for herbivore activity (unitless)
+!$OMP THREADPRIVATE(hvc1)
+  REAL(r_std), SAVE :: hvc2 = 1.38             !! parameters for herbivore activity (unitless)
+!$OMP THREADPRIVATE(hvc2)
+  REAL(r_std), SAVE :: leaf_frac_hvc = 0.33    !! leaf fraction (0-1, unitless)
+!$OMP THREADPRIVATE(leaf_frac_hvc)
+  REAL(r_std), SAVE :: tlong_ref_max = 303.1   !! maximum reference long term temperature (K)
+!$OMP THREADPRIVATE(tlong_ref_max)
+  REAL(r_std), SAVE :: tlong_ref_min = 253.1   !! minimum reference long term temperature (K)
+!$OMP THREADPRIVATE(tlong_ref_min)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: ncd_max_year = 3.
+!$OMP THREADPRIVATE(ncd_max_year)
+  REAL(r_std), SAVE :: gdd_threshold = 5.
+!$OMP THREADPRIVATE(gdd_threshold)
+  REAL(r_std), SAVE :: green_age_ever = 2.
+!$OMP THREADPRIVATE(green_age_ever)
+  REAL(r_std), SAVE :: green_age_dec = 0.5
+!$OMP THREADPRIVATE(green_age_dec)
+
+END MODULE constantes_var
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/control.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/control.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/control.f90	(revision 5166)
@@ -0,0 +1,504 @@
+! =================================================================================================================================
+! MODULE       : control
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        "control" module contains subroutines to initialize run time control parameters. 
+!!
+!!\n DESCRIPTION: 
+!!
+!! SVN          :
+!! $HeadURL: 
+!! $Date:  
+!! $Revision: 
+!! \n
+!_ ================================================================================================================================
+
+MODULE control
+  
+  USE constantes_soil
+  USE constantes_var
+  USE pft_parameters
+  USE vertical_soil
+
+  IMPLICIT NONE
+
+CONTAINS
+!! ================================================================================================================================
+!! SUBROUTINE   : control_initialize 
+!!
+!>\BRIEF        This subroutine reads the configuration flags which control the behaviour of the model
+!!              This subroutine was previsouly named intsurf_config and located in intersurf module. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE control_initialize(dt)
+
+    IMPLICIT NONE
+    
+    REAL(r_std), INTENT(in)                    :: dt            !! Time step in seconds
+    INTEGER(i_std)                             :: jv            !! Local index variable
+    INTEGER(i_std)                             :: ier           !! Error handeling
+
+    ! Archive the sechiba time step into module constantes_var 
+    dt_sechiba=dt
+
+    ! Start reading options from parameter file 
+
+    !Config Key   = SOILTYPE_CLASSIF
+    !Config Desc  = Type of classification used for the map of soil types 
+    !Config Def   = zobler
+    !Config If    = !IMPOSE_VEG
+    !Config Help  = The classification used in the file that we use here 
+    !Config         There are three classification supported:  
+    !Config         Zobler (7 converted to 3) and USDA (12) 
+    !Config Units = [-]
+    !
+    !-tdo- Suivant le type de classification utilisee pour le sol, on adapte nscm 
+    soil_classif = 'zobler'
+    CALL getin_p('SOILTYPE_CLASSIF',soil_classif)
+    SELECTCASE (soil_classif)
+    CASE ('zobler','none')
+       nscm = nscm_fao
+    CASE ('usda')
+       nscm = nscm_usda
+    CASE DEFAULT
+       WRITE(numout,*) "Unsupported soil type classification: soil_classif=",soil_classif
+       WRITE(numout,*) "Choose between zobler, usda and none according to the map"
+       CALL ipslerr_p(3,'control_initialize','Bad choice of soil_classif','Choose between zobler, usda and none','')
+    ENDSELECT
+
+
+    !Config Key   = RIVER_ROUTING
+    !Config Desc  = Decides if we route the water or not
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = This flag allows the user to decide if the runoff
+    !Config         and drainage should be routed to the ocean
+    !Config         and to downstream grid boxes.
+    !Config Units = [FLAG]
+    !
+    river_routing = .FALSE.
+    CALL getin_p('RIVER_ROUTING', river_routing)
+    WRITE(numout,*) "RIVER routing is activated : ",river_routing
+    !
+    !Config key   = HYDROL_CWRR
+    !Config Desc  = Allows to switch on the multilayer hydrology of CWRR
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = This flag allows the user to decide if the vertical
+    !Config         hydrology should be treated using the multi-layer 
+    !Config         diffusion scheme adapted from CWRR by Patricia de Rosnay.
+    !Config         by default the Choisnel hydrology is used.
+    !Config Units = [FLAG]
+    !
+    hydrol_cwrr = .FALSE.
+    CALL getin_p('HYDROL_CWRR', hydrol_cwrr)
+    WRITE(numout,*) "CWRR hydrology is activated : ",hydrol_cwrr
+    IF (hydrol_cwrr ) THEN
+    ELSE
+       WRITE(numout,*) "#################################################"
+       WRITE(numout,*) "################# WARNING #######################"
+       WRITE(numout,*) "#  THIS VERSION CAN RUN ONLY IF THE HYDROL_CWRR #"
+       WRITE(numout,*) "#          FLAG IS ACTIVATED PLEASE ADD         #"
+       WRITE(numout,*) "#       ok_newhydrol = y IN YOUR .card file     #"
+       WRITE(numout,*) "#################################################"
+       STOP
+    END IF
+
+
+    !Config Key   = DO_IRRIGATION
+    !Config Desc  = Should we compute an irrigation flux 
+    !Config If    = RIVER_ROUTING 
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to compute an irigation flux. This performed for the
+    !Config         on very simple hypothesis. The idea is to have a good
+    !Config         map of irrigated areas and a simple function which estimates
+    !Config         the need to irrigate.
+    !Config Units = [FLAG]
+    !
+    do_irrigation = .FALSE.
+    CALL getin_p('DO_IRRIGATION', do_irrigation)
+    !
+    !Config Key   = DO_FLOODPLAINS
+    !Config Desc  = Should we include floodplains 
+    !Config If    = RIVER_ROUTING 
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the flood plains and return 
+    !Config         the water into the soil moisture. It then can go 
+    !Config         back to the atmopshere. This tried to simulate 
+    !Config         internal deltas of rivers.
+    !Config Units = [FLAG]  
+    !
+    do_floodplains = .FALSE.
+    CALL getin_p('DO_FLOODPLAINS', do_floodplains)
+    !
+    !Config Key   = CHECK_WATERBAL
+    !Config Desc  = Should we check the global water balance 
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to check
+    !Config         the integrated water balance at the end
+    !Config         of each time step
+    !Config Units = [FLAG]  
+    !
+    check_waterbal = .FALSE.
+    CALL getin_p('CHECK_WATERBAL', check_waterbal)
+
+    !Config Key   = OK_EXPLICITSNOW
+    !Config Desc  = Activate explict snow scheme
+    !Config If    = OK_SECHIBA
+    !Config Def   = FALSE
+    !Config Help  = Activate explicit snow scheme instead of default snow scheme
+    !Config Units = [FLAG]
+    ok_explicitsnow = .FALSE.
+    CALL getin_p('OK_EXPLICITSNOW', ok_explicitsnow)
+
+    !
+    !Config Key   = STOMATE_OK_CO2
+    !Config Desc  = Activate CO2?
+    !Config If    = OK_SECHIBA 
+    !Config Def   = n
+    !Config Help  = set to TRUE if photosynthesis is to be activated
+    !Config Units = [FLAG]
+    !
+    ok_co2 = .FALSE.
+    CALL getin_p('STOMATE_OK_CO2', ok_co2)
+    WRITE(numout,*) 'photosynthesis: ', ok_co2
+    !
+    !Config Key   = STOMATE_OK_STOMATE
+    !Config Desc  = Activate STOMATE?
+    !Config If    = OK_SECHIBA and OK_CO2
+    !Config Def   = n
+    !Config Help  = set to TRUE if STOMATE is to be activated
+    !Config Units = [FLAG]
+    !
+    ok_stomate = .FALSE.
+    CALL getin_p('STOMATE_OK_STOMATE',ok_stomate)
+    WRITE(numout,*) 'STOMATE is activated: ',ok_stomate
+    !
+    !Config Key   = STOMATE_OK_DGVM
+    !Config Desc  = Activate DGVM?
+    !Config If    = OK_STOMATE
+    !Config Def   = n
+    !Config Help  = set to TRUE if DGVM is to be activated
+    !Config Units = [FLAG]
+    !
+    ok_dgvm = .FALSE.
+    CALL getin_p('STOMATE_OK_DGVM',ok_dgvm)
+    !
+    !Config Key   = CHEMISTRY_BVOC
+    !Config Desc  = Activate calculations for BVOC
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = set to TRUE if biogenic emissions calculation is to be activated
+    !Config Units = [FLAG]
+    !
+    ok_bvoc = .FALSE.
+    CALL getin_p('CHEMISTRY_BVOC', ok_bvoc)
+    WRITE(numout,*) 'Biogenic emissions: ', ok_bvoc
+
+    IF ( ok_bvoc ) THEN 
+       ok_leafage         = .TRUE. 
+       ok_radcanopy       = .TRUE. 
+       ok_multilayer      = .TRUE.
+       ok_pulse_NOx       = .TRUE.
+       ok_bbgfertil_NOx   = .TRUE.
+       ok_cropsfertil_NOx = .TRUE.
+    ELSE
+       ok_leafage         = .FALSE. 
+       ok_radcanopy       = .FALSE. 
+       ok_multilayer      = .FALSE.
+       ok_pulse_NOx       = .FALSE.
+       ok_bbgfertil_NOx   = .FALSE.
+       ok_cropsfertil_NOx = .FALSE.
+    ENDIF
+    !
+    !Config Key   = CHEMISTRY_LEAFAGE
+    !Config Desc  = Activate LEAFAGE?
+    !Config If    = CHEMISTRY_BVOC
+    !Config Def   = n
+    !Config Help  = set to TRUE if biogenic emissions calculation takes leaf age into account
+    !Config Units = [FLAG]
+    !
+    CALL getin_p('CHEMISTRY_LEAFAGE', ok_leafage)
+    WRITE(numout,*) 'Leaf Age: ', ok_leafage
+    !
+    !Config Key   = CANOPY_EXTINCTION 
+    !Config Desc  = Use canopy radiative transfer model?
+    !Config If    = CHEMISTRY_BVOC 
+    !Config Def   = n
+    !Config Help  = set to TRUE if canopy radiative transfer model is used for biogenic emissions 
+    !Config Units = [FLAG]
+    !
+    CALL getin_p('CANOPY_EXTINCTION', ok_radcanopy)
+    WRITE(numout,*) 'Canopy radiative transfer model: ', ok_radcanopy
+    !
+    !Config Key   = CANOPY_MULTILAYER
+    !Config Desc  = Use canopy radiative transfer model with multi-layers
+    !Config If    = CANOPY_EXTINCTION 
+    !Config Def   = n
+    !Config Help  = set to TRUE if canopy radiative transfer model is with multiple layers 
+    !Config Units = [FLAG]
+    !
+    CALL getin_p('CANOPY_MULTILAYER', ok_multilayer)
+    WRITE(numout,*) 'Multi-layer Canopy model: ', ok_multilayer
+    !
+    !Config Key   = NOx_RAIN_PULSE
+    !Config Desc  = Calculate NOx emissions with pulse?
+    !Config If    = CHEMISTRY_BVOC 
+    !Config Def   = n
+    !Config Help  = set to TRUE if NOx rain pulse is taken into account
+    !Config Units = [FLAG]
+    !
+    CALL getin_p('NOx_RAIN_PULSE', ok_pulse_NOx)
+    WRITE(numout,*) 'Rain NOx pulsing: ', ok_pulse_NOx
+    !
+    !Config Key   = NOx_BBG_FERTIL
+    !Config Desc  = Calculate NOx emissions with bbg fertilizing effect?
+    !Config If    = CHEMISTRY_BVOC 
+    !Config Def   = n
+    !Config Help  = set to TRUE if NOx emissions are calculated with bbg effect 
+    !Config         Fertil effect of bbg on NOx soil emissions 
+    !Config Units = [FLAG]
+    !
+    CALL getin_p('NOx_BBG_FERTIL', ok_bbgfertil_NOx)
+    WRITE(numout,*) 'NOx bbg fertil effect: ', ok_bbgfertil_NOx
+    !
+    !Config Key   = NOx_FERTILIZERS_USE
+    !Config Desc  = Calculate NOx emissions with fertilizers use?
+    !Config If    = CHEMISTRY_BVOC 
+    !Config Def   = n
+    !Config Help  = set to TRUE if NOx emissions are calculated with fertilizers use
+    !Config         Fertilizers use effect on NOx soil emissions  
+    !Config Units = [FLAG] 
+    !
+    CALL getin_p('NOx_FERTILIZERS_USE', ok_cropsfertil_NOx)
+    WRITE(numout,*) 'NOx Fertilizers use: ', ok_cropsfertil_NOx
+    !
+    !Config Key   = LD_DOC
+    !Config Desc  = activate debug comments for DOC module
+    !Config If    = ld_doc
+    !Config Def   = n
+    !Config Help  = set to TRUE if we want debug mode for DOC module
+    !Config       DOC processes commented 
+    !Config Units = [FLAG] 
+    !
+    ld_doc = .FALSE.
+    CALL getin_p('LD_DOC', ld_doc)
+    WRITE(numout,*) 'LD_DOC: ', ld_doc
+
+    !Config Key  = Is CO2 impact on BVOC accounted for using Possell 2005 ?
+    !Config Desc = In this case we use Possell 2005 parameterisation 
+    !Config Desc = to take into account the impact of CO2 on biogenic emissions for 
+    !Config Desc = isoprene 
+    !Config Def  = n 
+    !Config Help = set to TRUE if Possell parameterisation has to be considered for the CO2 impact
+    !
+    ok_co2bvoc_poss = .FALSE.
+    CALL getin_p('CO2_FOR_BVOC_POSSELL', ok_co2bvoc_poss)
+    WRITE(*,*) 'CO2 impact on BVOC - Possell parameterisation: ', ok_co2bvoc_poss
+    !
+    !Config Key  = Is CO2 impact on BVOC accounted for using Wilkinson 2009 ? 
+    !Config Desc = In this case we use Wilkinson 2009 parameterisation 
+    !Config Desc = to take into account the impact of CO2 on biogenic emissions for 
+    !Config Desc = isoprene 
+    !Config Def  = n 
+    !Config Help = set to TRUE if Wilkinson parameterisation has to be considered for the CO2 impact
+    !
+    ok_co2bvoc_wilk = .FALSE.
+    CALL getin_p('CO2_FOR_BVOC_WILKINSON', ok_co2bvoc_wilk)
+    WRITE(*,*) 'CO2 impact on BVOC - Wilkinson parameterisation: ', ok_co2bvoc_wilk
+    !
+
+    !
+    ! control initialisation with sechiba
+    !
+    ok_sechiba = .TRUE.
+    !
+    !
+    ! Ensure consistency
+    !
+    IF ( ok_dgvm ) ok_stomate = .TRUE.
+    IF ( ok_stomate ) ok_co2 = .TRUE.
+    IF ( ok_multilayer .AND. .NOT.(ok_radcanopy) ) THEN
+       ok_radcanopy  = .TRUE.
+       WRITE(numout,*) 'You want to use the multilayer model without activating the flag CANOPY_EXTINCTION'
+       WRITE(numout,*) 'We set CANOPY_EXTINCTION to TRUE to ensure consistency'
+    ENDIF
+
+
+
+    !
+    ! Here we need the same initialisation as above
+    !
+    ok_pheno = .TRUE.
+
+    !
+    ! Configuration : number of PFTs and parameters
+    !
+
+    ! 1. Number of PFTs defined by the user
+
+    !Config Key   = NVM
+    !Config Desc  = number of PFTs  
+    !Config If    = OK_SECHIBA or OK_STOMATE
+    !Config Def   = 13
+    !Config Help  = The number of vegetation types define by the user
+    !Config Units = [-]
+    !
+    CALL getin_p('NVM',nvm)
+    WRITE(numout,*)'the number of pfts used by the model is : ', nvm
+
+    ! 2. Should we read the parameters in the run.def file ?
+
+    !Config Key   = IMPOSE_PARAM
+    !Config Desc  = Do you impose the values of the parameters?
+    !Config if    = OK_SECHIBA or OK_STOMATE
+    !Config Def   = y
+    !Config Help  = This flag can deactivate the reading of some parameters.
+    !               Useful if you want to use the standard values without commenting the run.def
+    !Config Units = [FLAG]
+    !
+    CALL getin_p('IMPOSE_PARAM',impose_param)
+
+
+    !! Initialize vertical discretization
+    IF (hydrol_cwrr) THEN
+       !! Case CWRR : All initialization is done in the vertical module
+       !! Calculate ngrnd and nslm
+       CALL vertical_soil_init
+    ELSE
+       !! Case Choisnel : get depth of soil and number of soil levels
+       ! Remove Config Key description because this was already done in vertical_soil_init.
+       !Config Def   = 2.0 or 4.0 depending on hydrol_cwrr flag
+       !Config Help  = Maximum depth of soil for soil moisture
+       !Config Units = m
+       zmaxh=4.0
+       CALL getin_p("DEPTH_MAX_H",zmaxh)
+
+       !Config Key   = THERMOSOIL_NBLEV
+       !Config Desc  = Number of soil level
+       !Config If    = HDYROL_CWRR=FALSE
+       !Config Def   = 7
+       !Config Help  = Use at least 11 for long term simulation where soil thermal inertia matters
+       !Config Units = (-)
+       ngrnd=7
+       CALL getin_p("THERMOSOIL_NBLEV",ngrnd)
+
+       ! Define nslm, number of levels in CWRR. This variable will not be used for Choisnel but needs to be initialized.
+       nslm=11
+    END IF
+
+    ! 3. Allocate and intialize the pft parameters
+
+    CALL pft_parameters_main()
+
+    ! 4. Activation sub-models of ORCHIDEE
+
+    CALL activate_sub_models()
+
+    ! 5. Vegetation configuration
+
+    CALL veget_config
+
+    ! 6. Read the parameters in the run.def file  according the flags
+
+    IF (impose_param ) THEN 
+       CALL config_pft_parameters
+    ENDIF
+
+    IF ( ok_sechiba ) THEN
+       IF (impose_param ) THEN
+          CALL config_sechiba_parameters
+          CALL config_sechiba_pft_parameters()
+          WRITE(numout,*)'    some sechiba parameters have been imposed '
+       ENDIF
+    ENDIF
+
+
+    !! Initialize variables in constantes_soil
+    CALL config_soil_parameters()
+
+
+    !! Coherence check for depth of thermosoil for long term simulation where soil thermal inertia matters
+    !! ok_freeze_thermix is defined in config_soil_parameters
+    IF (hydrol_cwrr) THEN
+       ! Case CWRR
+       IF (ok_freeze_thermix .AND. zmaxt < 11) THEN
+          WRITE(numout,*) 'ERROR : Incoherence between ok_freeze_thermix activated and soil depth too small. '
+          WRITE(numout,*) 'Here a soil depth of ', zmaxt, 'm is used for the soil thermodynamics'
+          WRITE(numout,*) 'Set DEPTH_MAX_T=11 or higher in run.def parameter file or deactivate soil freezing'
+          CALL ipslerr_p(3,'control_initialize','Too shallow soil chosen for the thermodynamic for soil freezing', &
+               'Adapt run.def with at least DEPTH_MAX=11','')
+       END IF
+    ELSE
+       ! Case Choisnel
+       IF (ok_freeze_thermix .AND. ngrnd < 11) THEN
+          WRITE(numout,*) 'ERROR : Incoherence between ok_freeze_thermix activated and ngrnd to small. Here used ngrnd=',ngrnd
+          WRITE(numout,*) 'Set THERMOSOIL_NBLEV=11 or higher in run.def parameter file or deactivate soil freezing'
+          CALL ipslerr_p(3,'control_initialize','Not enough thermodynamic soil levels for soil freezing', &
+               'Adapt run.def with at least THERMOSOIL_NBLEV=11','')
+       END IF
+    END IF
+        
+    ! Define diaglev
+    ! We take the top nslm (number of layer in CWRR) layer of the thermodynamics 
+    ! for the diagnostics. The layers in the hydrology and the thermodynamics are
+    ! placed a the same depth (the top nslm layers) but the upper boundary condition
+    ! is simpler in the thermodynamics. 
+    nbdl = nslm
+    ALLOCATE(diaglev(nbdl), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'control_initialize','Pb in allocation of diaglev','','')
+
+    IF ( hydrol_cwrr ) THEN
+       ! Get diaglev from module vertical for CWRR
+       diaglev=znt(1:nbdl)
+    ELSE
+       ! Calculate diaglev for Choisnel
+       DO jv = 1, nbdl-1
+           diaglev(jv) = zmaxh/(2**(nbdl-1) -1) * ( ( 2**(jv-1) -1) + ( 2**(jv)-1) ) / deux
+      ENDDO
+      diaglev(nbdl) = zmaxh
+    END IF
+    WRITE(numout,*) 'In control_initialize, diaglev = ',diaglev
+
+    IF ( ok_co2 ) THEN
+       IF ( impose_param ) THEN
+          CALL config_co2_parameters
+          WRITE(numout,*)'    some co2 parameters have been imposed '         
+       ENDIF
+    ENDIF
+    
+    IF ( ok_stomate ) THEN
+       IF ( impose_param ) THEN
+          CALL config_stomate_parameters
+          CALL config_stomate_pft_parameters
+          WRITE(numout,*)'    some stomate parameters have been imposed '
+       ENDIF
+    ENDIF
+    
+    IF ( ok_dgvm ) THEN
+       IF ( impose_param ) THEN
+          CALL config_dgvm_parameters
+          WRITE(numout,*)'    some dgvm parameters have been imposed '         
+       ENDIF
+    ENDIF    
+  END SUBROUTINE control_initialize
+  
+END MODULE control
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/pft_parameters.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/pft_parameters.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/pft_parameters.f90	(revision 5166)
@@ -0,0 +1,3225 @@
+! =================================================================================================================================
+! MODULE       : pft_parameters
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module initializes all the pft parameters in function of the
+!!              number of vegetation types and of the values chosen by the user.
+!!
+!!\n DESCRIPTION:  This module allocates and initializes the pft parameters in function of the number of pfts
+!!                 and the values of the parameters. \n
+!!                 The number of PFTs is read in control.f90 (subroutine control_initialize). \n
+!!                 Then we can initialize the parameters. \n
+!!                 This module is the result of the merge of constantes_co2, constantes_veg, stomate_constants.\n
+!!
+!! RECENT CHANGE(S): Josefine Ghattas 2013 : The declaration part has been extracted and moved to module pft_parameters_var
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE pft_parameters
+
+  USE pft_parameters_var
+  USE vertical_soil_var
+  USE constantes_mtc
+  USE constantes
+  USE ioipsl
+  USE ioipsl_para 
+  USE defprec
+  
+  IMPLICIT NONE
+
+CONTAINS
+ !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_main
+!!
+!>\BRIEF          This subroutine initializes all the pft parameters in function of the
+!! number of vegetation types chosen by the user.
+!!
+!! DESCRIPTION  : This subroutine is called after the reading of the number of PFTS and the options 
+!!                activated by the user in the configuration files. \n
+!!                The allocation is done just before reading the correspondence table  between PFTs and MTCs
+!!                defined by the user in the configuration file.\n
+!!                With the correspondence table, the subroutine can initialize the pft parameters in function
+!!                of the flags activated (ok_sechiba, ok_stomate, ok_co2, routing, new_hydrol...) in order to
+!!                optimize the memory allocation. \n
+!!                If the number of PFTs and pft_to_mtc are not found, the standard configuration will be used
+!!                (13 PFTs, PFT = MTC). \n 
+!!                Some restrictions : the pft 1 can only be the bare soil and it is unique. \n
+!!                Algorithm : Build new PFT from 13 generic-PFT or meta-classes.
+!!                1. Read the number of PFTs in "run.def". If nothing is found, it is assumed that the user intend to use 
+!!                   the standard of PFTs (13).
+!!                2. Read the index vector in "run.def". The index vector associates one PFT to one meta-classe (or generic PFT).
+!!                   When the association is done, the PFT defined by the user inherited the default values from the meta classe.
+!!                   If nothing is found, it is assumed to use the standard index vector (PFT = MTC).
+!!                3. Check consistency
+!!                4. Memory allocation and initialization.
+!!                5. The parameters are read in the configuration file in config_initialize (control module).
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE pft_parameters_main()
+
+   IMPLICIT NONE
+
+   !! 0. Variables and parameters declaration
+
+   !! 0.4 Local variables  
+
+   INTEGER(i_std) :: j                             !! Index (unitless)
+
+!_ ================================================================================================================================ 
+   
+   !
+   ! PFT global
+   !
+
+   IF(l_first_pft_parameters) THEN
+
+      !! 1. First time step
+      IF(printlev>=3) THEN
+         WRITE(numout,*) 'l_first_pft_parameters :we read the parameters from the def files'
+      ENDIF
+
+      !! 2. Memory allocation for the pfts-parameters
+      CALL pft_parameters_alloc()
+
+      !! 3. Correspondance table 
+      
+      !! 3.1 Initialisation of the correspondance table
+      !! Initialisation of the correspondance table
+      IF (nvm == nvmc) THEN
+         WRITE(numout,*) 'Message to the user : we will use ORCHIDEE to its standard configuration' 
+         pft_to_mtc = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 /)
+      ELSE
+         pft_to_mtc(:) = undef_int
+      ENDIF !(nvm  == nvmc)
+      
+      !! 3.2 Reading of the conrrespondance table in the .def file
+      !
+      !Config Key   = PFT_TO_MTC
+      !Config Desc  = correspondance array linking a PFT to MTC
+      !Config if    = OK_SECHIBA or OK_STOMATE
+      !Config Def   = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('PFT_TO_MTC',pft_to_mtc)
+      
+      !! 3.3 If the user want to use the standard configuration, he needn't to fill the correspondance array
+      !!     If the configuration is wrong, send a error message to the user.
+      IF(nvm /= nvmc ) THEN
+         !
+         IF(pft_to_mtc(1) == undef_int) THEN
+            STOP ' The array PFT_TO_MTC is empty : we stop'
+         ENDIF !(pft_to_mtc(1) == undef_int)
+         !
+      ENDIF !(nvm /= nvmc )
+
+      !! 3.4 Some error messages
+
+      !! 3.4.1 What happened if pft_to_mtc(j) > nvmc or pft_to_mtc(j) <=0 (if the mtc doesn't exist)?
+       DO j = 1, nvm ! Loop over # PFTs  
+          !
+          IF( (pft_to_mtc(j) > nvmc) .OR. (pft_to_mtc(j) <= 0) ) THEN
+             WRITE(numout,*) 'the metaclass chosen does not exist'
+             STOP 'we stop reading pft_to_mtc'
+          ENDIF !( (pft_to_mtc(j) > nvmc) .OR. (pft_to_mtc(j) <= 0) )
+          !
+       ENDDO  ! Loop over # PFTs  
+
+
+       !! 3.4.2 Check if pft_to_mtc(1) = 1 
+       IF(pft_to_mtc(1) /= 1) THEN
+          !
+          WRITE(numout,*) 'the first pft has to be the bare soil'
+          STOP 'we stop reading next values of pft_to_mtc'
+          !
+       ELSE
+          !
+          DO j = 2,nvm ! Loop over # PFTs different from bare soil
+             !
+             IF(pft_to_mtc(j) == 1) THEN
+                WRITE(numout,*) 'only pft_to_mtc(1) has to be the bare soil'
+                STOP 'we stop reading pft_to_mtc'
+             ENDIF ! (pft_to_mtc(j) == 1)
+             !
+          ENDDO ! Loop over # PFTs different from bare soil
+          !
+       ENDIF !(pft_to_mtc(1) /= 1)
+      
+
+      !! 4.Initialisation of the pfts-parameters
+      CALL pft_parameters_init()
+
+      !! 5. Useful data
+
+      !! 5.1 Read the name of the PFTs given by the user
+      !
+      !Config Key   = PFT_NAME
+      !Config Desc  = Name of a PFT
+      !Config if    = OK_SECHIBA or OK_STOMATE
+      !Config Def   = bare ground, tropical broad-leaved evergreen, tropical broad-leaved raingreen, 
+      !Config         temperate needleleaf evergreen, temperate broad-leaved evergreen temperate broad-leaved summergreen,
+      !Config         boreal needleleaf evergreen, boreal broad-leaved summergreen, boreal needleleaf summergreen,
+      !Config         C3 grass, C4 grass, C3 agriculture, C4 agriculture    
+      !Config Help  = the user can name the new PFTs he/she introducing for new species
+      !Config Units = [-]
+      CALL getin_p('PFT_NAME',pft_name)
+
+      !! 5.2 A useful message to the user: correspondance between the number of the pft
+      !! and the name of the associated mtc 
+      DO j = 1,nvm ! Loop over # PFTs
+         !
+         WRITE(numout,*) 'the PFT',j, 'called  ', PFT_name(j),'corresponds to the MTC : ',MTC_name(pft_to_mtc(j))
+         !
+      ENDDO ! Loop over # PFTs
+
+
+      !! 6. End message
+      IF(printlev>=3) THEN
+         WRITE(numout,*) 'pft_parameters_done'
+      ENDIF
+
+      !! 8. Reset flag
+      l_first_pft_parameters = .FALSE.
+
+   ELSE 
+
+      RETURN
+
+   ENDIF !(l_first_pft_parameters)
+
+ END SUBROUTINE pft_parameters_main
+ !
+ !=
+ !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_init 
+!!
+!>\BRIEF          This subroutine initializes all the pft parameters by the default values
+!! of the corresponding metaclasse. 
+!!
+!! DESCRIPTION  : This subroutine is called after the reading of the number of PFTS and the correspondence
+!!                table defined by the user in the configuration files. \n
+!!                With the correspondence table, the subroutine can search the default values for the parameter
+!!                even if the PFTs are classified in a random order (except bare soil). \n
+!!                With the correspondence table, the subroutine can initialize the pft parameters in function
+!!                of the flags activated (ok_sechiba, ok_stomate, ok_co2, routing, new_hydrol...).\n
+!!
+!! RECENT CHANGE(S): Didier Solyga : Simplified PFT loops : use vector notation. 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE pft_parameters_init()
+  
+   IMPLICIT NONE
+   
+   !! 0. Variables and parameters declaration
+
+   !! 0.1 Input variables
+   
+   !! 0.4 Local variables
+
+   INTEGER(i_std)                :: jv            !! Index (unitless) 
+!_ ================================================================================================================================ 
+
+   !
+   ! 1. Correspondance between the PFTs values and thes MTCs values 
+   !
+ 
+
+   ! 1.1 For parameters used anytime
+   
+   PFT_name(:) = MTC_name(pft_to_mtc(:))
+   !
+   ! Vegetation structure 
+   !
+   veget_ori_fixed_test_1(:) = veget_ori_fixed_mtc(pft_to_mtc(:))
+   llaimax(:) = llaimax_mtc(pft_to_mtc(:))
+   llaimin(:) = llaimin_mtc(pft_to_mtc(:))
+   height_presc(:) = height_presc_mtc(pft_to_mtc(:))
+   type_of_lai(:) = type_of_lai_mtc(pft_to_mtc(:))
+   natural(:) = natural_mtc(pft_to_mtc(:))
+   !
+   ! Water - sechiba
+   !
+   IF (zmaxh == 2.0) THEN
+      WRITE(numout,*)'Initialize humcst using reference values for 2m soil depth'
+      humcste(:) = humcste_ref2m(pft_to_mtc(:))  ! values for 2m soil depth
+   ELSE IF (zmaxh == 4.0) THEN
+      WRITE(numout,*)'Initialize humcst using reference values for 4m soil depth'
+      humcste(:) = humcste_ref4m(pft_to_mtc(:))  ! values for 4m soil depth 
+   ELSE
+      WRITE(numout,*)'Note that humcste is initialized with values for 2m soil depth bur zmaxh=', zmaxh
+      humcste(:) = humcste_ref2m(pft_to_mtc(:))  ! values for 2m soil depth
+   END IF
+   !
+   ! Soil - vegetation
+   !
+   pref_soil_veg(:) = pref_soil_veg_mtc(pft_to_mtc(:))
+   !
+   ! Photosynthesis
+   !
+   is_c4(:) = is_c4_mtc(pft_to_mtc(:))
+   vcmax_fix(:) = vcmax_fix_mtc(pft_to_mtc(:))
+   downregulation_co2_coeff(:) = downregulation_co2_coeff_mtc(pft_to_mtc(:))
+   E_KmC(:)      = E_KmC_mtc(pft_to_mtc(:))
+   E_KmO(:)      = E_KmO_mtc(pft_to_mtc(:))
+   E_gamma_star(:) = E_gamma_star_mtc(pft_to_mtc(:))
+   E_Vcmax(:)    = E_Vcmax_mtc(pft_to_mtc(:))
+   E_Jmax(:)     = E_Jmax_mtc(pft_to_mtc(:))
+   aSV(:)        = aSV_mtc(pft_to_mtc(:))
+   bSV(:)        = bSV_mtc(pft_to_mtc(:))
+   tphoto_min(:) = tphoto_min_mtc(pft_to_mtc(:))
+   tphoto_max(:) = tphoto_max_mtc(pft_to_mtc(:))
+   aSJ(:)        = aSJ_mtc(pft_to_mtc(:))
+   bSJ(:)        = bSJ_mtc(pft_to_mtc(:))
+   D_Vcmax(:)     = D_Vcmax_mtc(pft_to_mtc(:))
+   D_Jmax(:)     = D_Jmax_mtc(pft_to_mtc(:))
+   E_Rd(:)       = E_Rd_mtc(pft_to_mtc(:))
+   Vcmax25(:)    = Vcmax25_mtc(pft_to_mtc(:))
+   arJV(:)       = arJV_mtc(pft_to_mtc(:))
+   brJV(:)       = brJV_mtc(pft_to_mtc(:))
+   KmC25(:)      = KmC25_mtc(pft_to_mtc(:))
+   KmO25(:)      = KmO25_mtc(pft_to_mtc(:))
+   gamma_star25(:)  = gamma_star25_mtc(pft_to_mtc(:))
+   a1(:)         = a1_mtc(pft_to_mtc(:))
+   b1(:)         = b1_mtc(pft_to_mtc(:))
+   g0(:)         = g0_mtc(pft_to_mtc(:))
+   h_protons(:)  = h_protons_mtc(pft_to_mtc(:))
+   fpsir(:)      = fpsir_mtc(pft_to_mtc(:))
+   fQ(:)         = fQ_mtc(pft_to_mtc(:))     
+   fpseudo(:)    = fpseudo_mtc(pft_to_mtc(:))    
+   kp(:)         = kp_mtc(pft_to_mtc(:))
+   alpha(:)      = alpha_mtc(pft_to_mtc(:))
+   gbs(:)        = gbs_mtc(pft_to_mtc(:))
+   theta(:)      = theta_mtc(pft_to_mtc(:))        
+   alpha_LL(:)   = alpha_LL_mtc(pft_to_mtc(:))
+   ext_coeff(:) = ext_coeff_mtc(pft_to_mtc(:))
+   !
+   !! Define labels from physiologic characteristics 
+   !
+   leaf_tab(:) = leaf_tab_mtc(pft_to_mtc(:)) 
+   pheno_model(:) = pheno_model_mtc(pft_to_mtc(:))   
+   !
+   is_tree(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( leaf_tab(jv) <= 2 ) is_tree(jv) = .TRUE.
+   END DO
+      !
+   is_deciduous(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( is_tree(jv) .AND. (pheno_model(jv) /= "none") ) is_deciduous(jv) = .TRUE.
+   END DO
+   !
+   is_evergreen(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( is_tree(jv) .AND. (pheno_model(jv) == "none") ) is_evergreen(jv) = .TRUE.
+   END DO
+   !
+   is_needleleaf(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( leaf_tab(jv) == 2 ) is_needleleaf(jv) = .TRUE.
+   END DO
+
+
+   ! 1.2 For sechiba parameters
+
+   IF (ok_sechiba) THEN
+      !
+      ! Vegetation structure - sechiba
+      !
+      rveg_pft(:) = rveg_mtc(pft_to_mtc(:))
+      !
+      ! Evapotranspiration -  sechiba
+      !
+      rstruct_const(:) = rstruct_const_mtc(pft_to_mtc(:))
+      kzero(:) = kzero_mtc(pft_to_mtc(:))
+      !
+      ! Water - sechiba
+      !
+      wmax_veg(:) = wmax_veg_mtc(pft_to_mtc(:))
+      IF ( hydrol_cwrr .AND. OFF_LINE_MODE ) THEN
+         throughfall_by_pft(:) = 0.
+      ELSE
+         throughfall_by_pft(:) = throughfall_by_mtc(pft_to_mtc(:))
+      ENDIF
+      !
+      ! Albedo - sechiba
+      !
+      snowa_aged(:) = snowa_aged_mtc(pft_to_mtc(:))
+      snowa_dec(:) = snowa_dec_mtc(pft_to_mtc(:)) 
+      alb_leaf_vis(:) = alb_leaf_vis_mtc(pft_to_mtc(:))  
+      alb_leaf_nir(:) = alb_leaf_nir_mtc(pft_to_mtc(:))
+      !-
+   ENDIF !(ok_sechiba)
+
+   ! 1.3 For BVOC parameters
+   
+   IF (ok_bvoc) THEN
+      !
+      ! Biogenic Volatile Organic Compounds
+      !
+      em_factor_isoprene(:) = em_factor_isoprene_mtc(pft_to_mtc(:))
+      em_factor_monoterpene(:) = em_factor_monoterpene_mtc(pft_to_mtc(:))
+      LDF_mono = LDF_mono_mtc 
+      LDF_sesq = LDF_sesq_mtc 
+      LDF_meth = LDF_meth_mtc 
+      LDF_acet = LDF_acet_mtc 
+
+      em_factor_apinene(:) = em_factor_apinene_mtc(pft_to_mtc(:))
+      em_factor_bpinene(:) = em_factor_bpinene_mtc(pft_to_mtc(:))
+      em_factor_limonene(:) = em_factor_limonene_mtc(pft_to_mtc(:))
+      em_factor_myrcene(:) = em_factor_myrcene_mtc(pft_to_mtc(:))
+      em_factor_sabinene(:) = em_factor_sabinene_mtc(pft_to_mtc(:))
+      em_factor_camphene(:) = em_factor_camphene_mtc(pft_to_mtc(:))
+      em_factor_3carene(:) = em_factor_3carene_mtc(pft_to_mtc(:))
+      em_factor_tbocimene(:) = em_factor_tbocimene_mtc(pft_to_mtc(:))
+      em_factor_othermonot(:) = em_factor_othermonot_mtc(pft_to_mtc(:))
+      em_factor_sesquiterp(:) = em_factor_sesquiterp_mtc(pft_to_mtc(:))
+
+      beta_mono = beta_mono_mtc
+      beta_sesq = beta_sesq_mtc
+      beta_meth = beta_meth_mtc
+      beta_acet = beta_acet_mtc
+      beta_oxyVOC = beta_oxyVOC_mtc
+      
+      em_factor_ORVOC(:) = em_factor_ORVOC_mtc(pft_to_mtc(:)) 
+      em_factor_OVOC(:) = em_factor_OVOC_mtc(pft_to_mtc(:))
+      em_factor_MBO(:) = em_factor_MBO_mtc(pft_to_mtc(:))
+      em_factor_methanol(:) = em_factor_methanol_mtc(pft_to_mtc(:))
+      em_factor_acetone(:) = em_factor_acetone_mtc(pft_to_mtc(:)) 
+      em_factor_acetal(:) = em_factor_acetal_mtc(pft_to_mtc(:))
+      em_factor_formal(:) = em_factor_formal_mtc(pft_to_mtc(:))
+      em_factor_acetic(:) = em_factor_acetic_mtc(pft_to_mtc(:))
+      em_factor_formic(:) = em_factor_formic_mtc(pft_to_mtc(:))
+      em_factor_no_wet(:) = em_factor_no_wet_mtc(pft_to_mtc(:))
+      em_factor_no_dry(:) = em_factor_no_dry_mtc(pft_to_mtc(:))
+      Larch(:) = Larch_mtc(pft_to_mtc(:)) 
+      !-
+   ENDIF !(ok_bvoc)
+
+   ! 1.4 For stomate parameters
+
+   IF (ok_stomate) THEN
+      !
+      ! Vegetation structure - stomate
+      !
+      sla(:) = sla_mtc(pft_to_mtc(:))
+      availability_fact(:) = availability_fact_mtc(pft_to_mtc(:))
+      !
+      ! Allocation - stomate
+      !
+      R0(:) = R0_mtc(pft_to_mtc(:)) 
+      S0(:) = S0_mtc(pft_to_mtc(:)) 
+      !
+      ! Respiration - stomate
+      !
+      frac_growthresp(:) = frac_growthresp_mtc(pft_to_mtc(:))  
+      maint_resp_slope_c(:) = maint_resp_slope_c_mtc(pft_to_mtc(:))               
+      maint_resp_slope_b(:) = maint_resp_slope_b_mtc(pft_to_mtc(:))
+      maint_resp_slope_a(:) = maint_resp_slope_a_mtc(pft_to_mtc(:))
+      cm_zero_leaf(:) = cm_zero_leaf_mtc(pft_to_mtc(:))
+      cm_zero_sapabove(:) = cm_zero_sapabove_mtc(pft_to_mtc(:))
+      cm_zero_sapbelow(:) = cm_zero_sapbelow_mtc(pft_to_mtc(:)) 
+      cm_zero_heartabove(:) = cm_zero_heartabove_mtc(pft_to_mtc(:)) 
+      cm_zero_heartbelow(:) = cm_zero_heartbelow_mtc(pft_to_mtc(:))
+      cm_zero_root(:) = cm_zero_root_mtc(pft_to_mtc(:))
+      cm_zero_fruit(:) = cm_zero_fruit_mtc(pft_to_mtc(:))
+      cm_zero_carbres(:) = cm_zero_carbres_mtc(pft_to_mtc(:))
+      !
+      ! Fire - stomate
+      !
+      flam(:) = flam_mtc(pft_to_mtc(:))
+      resist(:) = resist_mtc(pft_to_mtc(:))
+      !
+      ! Flux - LUC
+      !
+      coeff_lcchange_1(:) = coeff_lcchange_1_mtc(pft_to_mtc(:))
+      coeff_lcchange_10(:) = coeff_lcchange_10_mtc(pft_to_mtc(:))
+      coeff_lcchange_100(:) = coeff_lcchange_100_mtc(pft_to_mtc(:))
+      !
+      ! Phenology
+      !
+      !
+      ! 1. Stomate
+      !
+      lai_max_to_happy(:) = lai_max_to_happy_mtc(pft_to_mtc(:))  
+      lai_max(:) = lai_max_mtc(pft_to_mtc(:))
+      pheno_type(:) = pheno_type_mtc(pft_to_mtc(:))
+      !
+      ! 2. Leaf Onset
+      !
+      pheno_gdd_crit_c(:) = pheno_gdd_crit_c_mtc(pft_to_mtc(:))
+      pheno_gdd_crit_b(:) = pheno_gdd_crit_b_mtc(pft_to_mtc(:))         
+      pheno_gdd_crit_a(:) = pheno_gdd_crit_a_mtc(pft_to_mtc(:))
+      pheno_moigdd_t_crit(:) = pheno_moigdd_t_crit_mtc(pft_to_mtc(:))
+      ngd_crit(:) =  ngd_crit_mtc(pft_to_mtc(:))
+      ncdgdd_temp(:) = ncdgdd_temp_mtc(pft_to_mtc(:)) 
+      hum_frac(:) = hum_frac_mtc(pft_to_mtc(:))
+      hum_min_time(:) = hum_min_time_mtc(pft_to_mtc(:))
+      tau_sap(:) = tau_sap_mtc(pft_to_mtc(:))
+      tau_leafinit(:) = tau_leafinit_mtc(pft_to_mtc(:))  
+      tau_fruit(:) = tau_fruit_mtc(pft_to_mtc(:))
+      ecureuil(:) = ecureuil_mtc(pft_to_mtc(:))
+      alloc_min(:) = alloc_min_mtc(pft_to_mtc(:))
+      alloc_max(:) = alloc_max_mtc(pft_to_mtc(:))
+      demi_alloc(:) = demi_alloc_mtc(pft_to_mtc(:))
+      leaflife_tab(:) = leaflife_mtc(pft_to_mtc(:))
+      !
+      ! 3. Senescence
+      !
+      leaffall(:) = leaffall_mtc(pft_to_mtc(:))
+      leafagecrit(:) = leafagecrit_mtc(pft_to_mtc(:))
+      senescence_type(:) = senescence_type_mtc(pft_to_mtc(:)) 
+      senescence_hum(:) = senescence_hum_mtc(pft_to_mtc(:)) 
+      nosenescence_hum(:) = nosenescence_hum_mtc(pft_to_mtc(:)) 
+      max_turnover_time(:) = max_turnover_time_mtc(pft_to_mtc(:))
+      min_turnover_time(:) = min_turnover_time_mtc(pft_to_mtc(:))
+      min_leaf_age_for_senescence(:) = min_leaf_age_for_senescence_mtc(pft_to_mtc(:))
+      senescence_temp_c(:) = senescence_temp_c_mtc(pft_to_mtc(:))
+      senescence_temp_b(:) = senescence_temp_b_mtc(pft_to_mtc(:))
+      senescence_temp_a(:) = senescence_temp_a_mtc(pft_to_mtc(:))
+      gdd_senescence(:) = gdd_senescence_mtc(pft_to_mtc(:))
+      !
+      ! DGVM
+      !
+      residence_time(:) = residence_time_mtc(pft_to_mtc(:))
+      tmin_crit(:) = tmin_crit_mtc(pft_to_mtc(:))
+      tcm_crit(:) = tcm_crit_mtc(pft_to_mtc(:))
+      !-
+   ENDIF !(ok_stomate)
+
+ END SUBROUTINE pft_parameters_init
+ !
+ !=
+ !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_alloc
+!!
+!>\BRIEF         This subroutine allocates memory needed for the PFT parameters 
+!! in function  of the flags activated.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE pft_parameters_alloc()
+
+   IMPLICIT NONE
+
+   !! 0. Variables and parameters declaration
+
+   !! 0.1 Input variables 
+   
+   !! 0.4 Local variables
+   
+   LOGICAL :: l_error                             !! Diagnostic boolean for error allocation (true/false) 
+   INTEGER :: ier                                 !! Return value for memory allocation (0-N, unitless)
+
+!_ ================================================================================================================================
+
+
+   !
+   ! 1. Parameters used anytime
+   !
+
+   l_error = .FALSE.
+
+   ALLOCATE(pft_to_mtc(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for pft_to_mtc. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(PFT_name(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for PFT_name. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(height_presc(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for height_presc. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_tree(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_tree. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(natural(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for natural. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_c4(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_c4. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(humcste(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for humcste. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(downregulation_co2_coeff(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for downregulation_co2_coeff. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(E_KmC(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_KmC. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(E_KmO(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_KmO. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(E_gamma_star(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_gamma_star. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(E_vcmax(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_Vcmax. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(E_Jmax(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_Jmax. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(aSV(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for aSV. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(bSV(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for bSV. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(tphoto_min(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for tphoto_min. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(tphoto_max(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for tphoto_max. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(aSJ(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for aSJ. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(bSJ(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for bSJ. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(D_Vcmax(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for D_Vcmax. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(D_Jmax(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for D_Jmax. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(E_Rd(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for E_Rd. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(Vcmax25(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for Vcmax25. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(arJV(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for arJV. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(brJV(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for brJV. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(KmC25(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for KmC25. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(KmO25(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for KmO25. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(gamma_star25(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for gamma_star25. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(a1(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for a1. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(b1(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for b1. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(g0(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for g0. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(h_protons(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for h_protons. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(fpsir(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for fpsir. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(fQ(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for fQ. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(fpseudo(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for fpseudo. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(kp(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for kp. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(alpha(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for alpha. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(gbs(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for gbs. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(theta(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for theta. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(alpha_LL(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for alpha_LL. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(ext_coeff(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for ext_coeff. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(veget_ori_fixed_test_1(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for veget_ori_fixed_test_1. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(llaimax(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for llaimax. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(llaimin(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for llaimin. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(type_of_lai(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for type_of_lai. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(vcmax_fix(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for vcmax_fix. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(pref_soil_veg(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for pref_soil_veg. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(leaf_tab(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for leaf_tab. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(pheno_model(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for pheno_model. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+      
+   ALLOCATE(is_deciduous(nvm),stat=ier) 
+   l_error = l_error .OR. (ier /= 0) 
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_deciduous. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_evergreen(nvm),stat=ier) 
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_evergreen. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_needleleaf(nvm),stat=ier)  
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_needleleaf. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_tropical(nvm),stat=ier)   
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_tropical. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+
+   !
+   ! 2. Parameters used if ok_sechiba only
+   !
+   IF ( ok_sechiba ) THEN
+
+      l_error = .FALSE.
+
+      ALLOCATE(rstruct_const(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for rstruct_const. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(kzero(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for kzero. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(rveg_pft(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for rveg_pft. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(wmax_veg(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for wmax_veg. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(throughfall_by_pft(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for throughfall_by_pft. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+      
+      ALLOCATE(snowa_aged(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for snowa_aged. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(snowa_dec(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for snowa_dec. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(alb_leaf_vis(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alb_leaf_vis. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(alb_leaf_nir(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alb_leaf_nir. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      IF( ok_bvoc ) THEN
+         
+         l_error = .FALSE.
+         
+         ALLOCATE(em_factor_isoprene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_isoprene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_monoterpene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_monoterpene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_apinene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_apinene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_bpinene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_bpinene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_limonene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_limonene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_myrcene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_myrcene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_sabinene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_sabinene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_camphene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_camphene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_3carene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_3carene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_tbocimene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_tbocimene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_othermonot(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_othermonot. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_sesquiterp(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_sesquiterp. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+
+         ALLOCATE(em_factor_ORVOC(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_ORVOC. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_OVOC(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)       
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_OVOC. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_MBO(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_MBO. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_methanol(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_methanol. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_acetone(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_acetone. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_acetal(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_acetal. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_formal(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_formal. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_acetic(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)       
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_acetic. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_formic(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_formic. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_no_wet(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_no_wet. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_no_dry(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)       
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_no_dry. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(Larch(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for Larch. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+      ENDIF ! (ok_bvoc) 
+
+   ENDIF !(ok_sechiba)
+
+   !
+   ! 3. Parameters used if ok_stomate only
+   !
+   IF ( ok_stomate ) THEN
+
+      l_error = .FALSE.
+
+      ALLOCATE(sla(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for sla. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(availability_fact(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for availability_fact. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(R0(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for R0. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(S0(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for S0. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(L0(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for L0. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_gdd_crit_c(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit_c. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_gdd_crit_b(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit_b. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_gdd_crit_a(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit_a. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_gdd_crit(nvm,3),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit. We stop. We need nvm words = ',nvm*3
+         STOP 'pft_parameters_alloc'
+      END IF
+      pheno_gdd_crit(:,:) = zero
+
+      ALLOCATE(pheno_moigdd_t_crit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_moigdd_t_crit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(ngd_crit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for ngd_crit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(ncdgdd_temp(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for ncdgdd_temp. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(hum_frac(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for hum_frac. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(hum_min_time(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for hum_min_time. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tau_sap(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tau_sap. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tau_leafinit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tau_leafinit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tau_fruit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tau_fruit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(ecureuil(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for ecureuil. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(alloc_min(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alloc_min. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(alloc_max(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alloc_max. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(demi_alloc(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(frac_growthresp(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for frac_growthresp. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(maint_resp_slope(nvm,3),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maint_resp_slope. We stop. We need nvm*3 words = ',nvm*3
+         STOP 'pft_parameters_alloc'
+      END IF
+      maint_resp_slope(:,:) = zero
+
+      ALLOCATE(maint_resp_slope_c(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maint_resp_slope_c. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(maint_resp_slope_b(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maint_resp_slope_b. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(maint_resp_slope_a(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maint_resp_slope_a. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_maint_zero(nvm,nparts),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_maint_zero. We stop. We need nvm*nparts words = ',nvm*nparts
+         STOP 'pft_parameters_alloc'
+      END IF
+      coeff_maint_zero(:,:) = zero
+
+      ALLOCATE(cm_zero_leaf(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_leaf. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_sapabove(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_sapabove. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_sapbelow(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_sapbelow. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_heartabove(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_heartabove. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_heartbelow(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_heartbelow. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_root(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_root. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_fruit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_fruit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_carbres(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_carbres. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(flam(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(resist(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for resist. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_lcchange_1(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_lcchange_1. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_lcchange_10(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_lcchange_10. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_lcchange_100(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_lcchange_100. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(lai_max_to_happy(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for lai_max_to_happy. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(lai_max(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for lai_max. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_type(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_type. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leaffall(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leaffall. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leafagecrit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leafagecrit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_type(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_hum(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_hum. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(nosenescence_hum(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for nosenescence_hum. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(max_turnover_time(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for max_turnover_time. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(min_turnover_time(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for min_turnover_time. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(min_leaf_age_for_senescence(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for min_leaf_age_for_senescence. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_temp_c(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_temp_c. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_temp_b(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_temp_b. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_temp_a(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_temp_a. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_temp(nvm,3),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_temp. We stop. We need nvm*3 words = ',nvm*3
+         STOP 'pft_parameters_alloc'
+      END IF
+      senescence_temp(:,:) = zero
+
+      ALLOCATE(gdd_senescence(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for gdd_senescence. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(residence_time(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for residence_time. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tmin_crit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tmin_crit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tcm_crit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tcm_crit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(lai_initmin(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(bm_sapl(nvm,nparts,nelements),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for bm_sapl. We stop. We need nvm*nparts*nelements words = ',& 
+              &  nvm*nparts*nelements
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(migrate(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for migrate. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(maxdia(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maxdia. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cn_sapl(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cn_sapl. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leaf_timecst(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leaf_timecst. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leaflife_tab(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leaflife_tab. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+   ENDIF ! (ok_stomate)
+
+ END SUBROUTINE pft_parameters_alloc
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_pft_parameters 
+!!
+!>\BRIEF          This subroutine will read the imposed values for the global pft
+!! parameters (sechiba + stomate). It is not called if IMPOSE_PARAM is set to NO.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE config_pft_parameters
+   
+   IMPLICIT NONE
+
+   !! 0. Variables and parameters declaration
+  
+   !! 0.4 Local variable
+
+   LOGICAL, SAVE  :: first_call = .TRUE.  !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+   INTEGER(i_std) :: jv                   !! Index (untiless)
+
+!_ ================================================================================================================================ 
+
+   IF (first_call) THEN
+
+      !
+      ! Vegetation structure
+      !
+
+      !Config Key   = LEAF_TAB
+      !Config Desc  = leaf type : 1=broad leaved tree, 2=needle leaved tree, 3=grass 4=bare ground
+      !Config if    = OK_STOMATE
+      !Config Def   = 4, 1, 1, 2, 1, 1, 2, 1, 2, 3, 3, 3, 3 
+      !Config Help  = 
+      !Config Units = [-] 
+      CALL getin_p('LEAF_TAB',leaf_tab)
+      
+      !Config Key   = PHENO_MODEL
+      !Config Desc  = which phenology model is used? (tabulated) 
+      !Config if    = OK_STOMATE
+      !Config Def   = none, none, moi, none, none, ncdgdd, none, ncdgdd, ngd, moigdd, moigdd, moigdd, moigdd
+      !Config Help  =
+      !Config Units = [-] 
+      CALL getin_p('PHENO_MODEL',pheno_model)
+      
+      !! Redefine the values for is_tree, is_deciduous, is_needleleaf, is_evergreen if values have been modified
+      !! in run.def
+
+      is_tree(:) = .FALSE.
+      DO jv = 1,nvm
+         IF ( leaf_tab(jv) <= 2 ) is_tree(jv) = .TRUE.
+      END DO
+      !
+      is_deciduous(:) = .FALSE.
+      DO jv = 1,nvm
+         IF ( is_tree(jv) .AND. (pheno_model(jv) /= "none") ) is_deciduous(jv) = .TRUE.
+      END DO
+      !
+      is_evergreen(:) = .FALSE.
+      DO jv = 1,nvm
+         IF ( is_tree(jv) .AND. (pheno_model(jv) == "none") ) is_evergreen(jv) = .TRUE.
+      END DO
+      !
+      is_needleleaf(:) = .FALSE.
+      DO jv = 1,nvm
+         IF ( leaf_tab(jv) == 2 ) is_needleleaf(jv) = .TRUE.
+      END DO
+
+
+      !Config Key   = SECHIBA_LAI
+      !Config Desc  = laimax for maximum lai(see also type of lai interpolation)
+      !Config if    = OK_SECHIBA or IMPOSE_VEG
+      !Config Def   = 0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2.
+      !Config Help  = Maximum values of lai used for interpolation of the lai map
+      !Config Units = [m^2/m^2]
+      CALL getin_p('SECHIBA_LAI',llaimax)
+
+      !Config Key   = LLAIMIN
+      !Config Desc  = laimin for minimum lai(see also type of lai interpolation)
+      !Config if    = OK_SECHIBA or IMPOSE_VEG
+      !Config Def   = 0., 8., 0., 4., 4.5, 0., 4., 0., 0., 0., 0., 0., 0.
+      !Config Help  = Minimum values of lai used for interpolation of the lai map
+      !Config Units = [m^2/m^2]
+      CALL getin_p('LLAIMIN',llaimin)
+
+      !Config Key   = SLOWPROC_HEIGHT
+      !Config Desc  = prescribed height of vegetation 
+      !Config if    = OK_SECHIBA
+      !Config Def   = 0., 30., 30., 20., 20., 20., 15., 15., 15., .5, .6, 1., 1.
+      !Config Help  =
+      !Config Units = [m] 
+      CALL getin_p('SLOWPROC_HEIGHT',height_presc)
+
+      !Config Key   = TYPE_OF_LAI
+      !Config Desc  = Type of behaviour of the LAI evolution algorithm 
+      !Config if    = OK_SECHIBA
+      !Config Def   = inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('TYPE_OF_LAI',type_of_lai)
+
+      !Config Key   = NATURAL
+      !Config Desc  = natural? 
+      !Config if    = OK_SECHIBA, OK_STOMATE
+      !Config Def   = y, y, y, y, y, y, y, y, y, y, y, n, n 
+      !Config Help  =
+      !Config Units = [BOOLEAN]
+      CALL getin_p('NATURAL',natural)
+
+      
+      !
+      ! Photosynthesis
+      !
+
+      !Config Key   = IS_C4
+      !Config Desc  = flag for C4 vegetation types
+      !Config if    = OK_SECHIBA or OK_STOMATE
+      !Config Def   = n, n, n, n, n, n, n, n, n, n, n, y, n, y
+      !Config Help  =
+      !Config Units = [BOOLEAN]
+      CALL getin_p('IS_C4',is_c4)
+
+      !Config Key   = VCMAX_FIX
+      !Config Desc  = values used for vcmax when STOMATE is not activated
+      !Config if    = OK_SECHIBA and NOT(OK_STOMATE)
+      !Config Def   = 0., 40., 50., 30., 35., 40.,30., 40., 35., 60., 60., 70., 70.
+      !Config Help  =
+      !Config Units = [micromol/m^2/s] 
+      CALL getin_p('VCMAX_FIX',vcmax_fix)
+
+      !Config Key   = DOWNREG_CO2
+      !Config Desc  = coefficient for CO2 downregulation (unitless)
+      !Config if    = OK_CO2
+      !Config Def   = 0., 0.38, 0.38, 0.28, 0.28, 0.28, 0.22, 0.22, 0.22, 0.26, 0.26, 0.26, 0.26
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('DOWNREG_CO2',downregulation_co2_coeff)
+
+      !Config Key   = E_KmC
+      !Config Desc  = Energy of activation for KmC
+      !Config if    = OK_CO2
+      !Config Def   = undef,  79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430., 79430.
+      !Config Help  = See Medlyn et al. (2002) 
+      !Config Units = [J mol-1]
+      CALL getin_p('E_KMC',E_KmC)
+
+      !Config Key   = E_KmO
+      !Config Desc  = Energy of activation for KmO
+      !Config if    = OK_CO2
+      !Config Def   = undef, 36380.,  36380.,  36380.,  36380.,  36380., 36380., 36380., 36380., 36380., 36380., 36380., 36380.
+      !Config Help  = See Medlyn et al. (2002) 
+      !Config Units = [J mol-1]
+      CALL getin_p('E_KMO',E_KmO)
+
+      !Config Key   = E_gamma_star
+      !Config Desc  = Energy of activation for gamma_star
+      !Config if    = OK_CO2
+      !Config Def   = undef, 37830.,  37830.,  37830.,  37830.,  37830., 37830., 37830., 37830., 37830., 37830., 37830., 37830.
+      !Config Help  = See Medlyn et al. (2002) from Bernacchi al. (2001) 
+      !Config Units = [J mol-1]
+      CALL getin_p('E_GAMMA_STAR',E_gamma_star)
+
+      !Config Key   = E_Vcmax
+      !Config Desc  = Energy of activation for Vcmax
+      !Config if    = OK_CO2
+      !Config Def   = undef, 71513., 71513., 71513., 71513., 71513., 71513., 71513., 71513., 71513., 67300., 71513., 67300.
+      !Config Help  = See Table 2 of Yin et al. (2009) for C4 plants and Kattge & Knorr (2007) for C3 plants (table 3)
+      !Config Units = [J mol-1]
+      CALL getin_p('E_VCMAX',E_Vcmax)
+
+      !Config Key   = E_Jmax
+      !Config Desc  = Energy of activation for Jmax
+      !Config if    = OK_CO2
+      !Config Def   = undef, 49884., 49884., 49884., 49884., 49884., 49884., 49884., 49884., 49884., 77900., 49884., 77900. 
+      !Config Help  = See Table 2 of Yin et al. (2009) for C4 plants and Kattge & Knorr (2007) for C3 plants (table 3)
+      !Config Units = [J mol-1]
+      CALL getin_p('E_JMAX',E_Jmax)
+
+      !Config Key   = aSV
+      !Config Desc  = a coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax
+      !Config if    = OK_CO2
+      !Config Def   = undef, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 668.39, 641.64, 668.39, 641.64 
+      !Config Help  = See Table 3 of Kattge & Knorr (2007) - For C4 plants, we assume that there is no acclimation and that at for a temperature of 25Â°C, aSV is the same for both C4 and C3 plants (no strong jusitification - need further parametrization)
+      !Config Units = [J K-1 mol-1]
+      CALL getin_p('ASV',aSV)
+
+      !Config Key   = bSV
+      !Config Desc  = b coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax
+      !Config if    = OK_CO2
+      !Config Def   = undef, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, -1.07, 0., -1.07, 0. 
+      !Config Help  = See Table 3 of Kattge & Knorr (2007) - For C4 plants, we assume that there is no acclimation
+      !Config Units = [J K-1 mol-1 Â°C-1]
+      CALL getin_p('BSV',bSV)
+
+      !Config Key   = TPHOTO_MIN
+      !Config Desc  = minimum photosynthesis temperature (deg C)
+      !Config if    = OK_STOMATE
+      !Config Def   = undef,  -4., -4., -4., -4.,-4.,-4., -4., -4., -4., -4., -4., -4.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('TPHOTO_MIN',tphoto_min)
+
+      !Config Key   = TPHOTO_MAX
+      !Config Desc  = maximum photosynthesis temperature (deg C)
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 55., 55., 55., 55., 55., 55., 55., 55., 55., 55., 55., 55.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('TPHOTO_MAX',tphoto_max)
+
+      !Config Key   = aSJ
+      !Config Desc  = a coefficient of the linear regression (a+bT) defining the Entropy term for Jmax
+      !Config if    = OK_CO2
+      !Config Def   = undef, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 659.70, 630., 659.70, 630. 
+      !Config Help  = See Table 3 of Kattge & Knorr (2007) - and Table 2 of Yin et al. (2009) for C4 plants
+      !Config Units = [J K-1 mol-1]
+      CALL getin_p('ASJ',aSJ)
+
+      !Config Key   = bSJ
+      !Config Desc  = b coefficient of the linear regression (a+bT) defining the Entropy term for Jmax
+      !Config if    = OK_CO2
+      !Config Def   = undef, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, -0.75, 0., -0.75, 0. 
+      !Config Help  = See Table 3 of Kattge & Knorr (2007) - For C4 plants, we assume that there is no acclimation
+      !Config Units = [J K-1 mol-1 Â°C-1]
+      CALL getin_p('BSJ',bSJ)
+
+      !Config Key   = D_Vcmax
+      !Config Desc  = Energy of deactivation for Vcmax
+      !Config if    = OK_CO2
+      !Config Def   = undef, 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 192000., 200000., 192000.
+      !Config Help  = Medlyn et al. (2002) also uses 200000. for C3 plants (same value than D_Jmax). 'Consequently', we use the value of D_Jmax for C4 plants.
+      !Config Units = [J mol-1]
+      CALL getin_p('D_VCMAX',D_Vcmax)
+
+      !Config Key   = D_Jmax
+      !Config Desc  = Energy of deactivation for Jmax
+      !Config if    = OK_CO2
+      !Config Def   = undef, 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 200000., 192000., 200000., 192000.
+      !Config Help  = See Table 2 of Yin et al. (2009)
+      !Config Units = [J mol-1]
+      CALL getin_p('D_JMAX',D_Jmax)
+
+      !Config Key   = E_Rd
+      !Config Desc  = Energy of activation for Rd
+      !Config if    = OK_CO2
+      !Config Def   = undef, 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390., 46390.
+      !Config Help  = See Table 2 of Yin et al. (2009)
+      !Config Units = [J mol-1]
+      CALL getin_p('E_RD',E_Rd)
+
+      !Config Key   = VCMAX25
+      !Config Desc  = Maximum rate of Rubisco activity-limited carboxylation at 25Â°C
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 65., 65., 35., 45., 55., 35., 45., 35., 70., 70., 70., 70.
+      !Config Help  =
+      !Config Units = [micromol/m^2/s]
+      CALL getin_p('VCMAX25',Vcmax25)
+
+      !Config Key   = ARJV
+      !Config Desc  = a coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio 
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 2.59, 1.715, 2.59, 1.715
+      !Config Help  = See Table 3 of Kattge & Knorr (2007) - For C4 plants, we assume that there is no acclimation and that for a temperature of 25Â°C, aSV is the same for both C4 and C3 plants (no strong jusitification - need further parametrization)
+      !Config Units = [mu mol e- (mu mol CO2)-1]
+      CALL getin_p('ARJV',arJV)
+
+      !Config Key   = BRJV
+      !Config Desc  = b coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio 
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, -0.035, 0., -0.035, 0.
+      !Config Help  = See Table 3 of Kattge & Knorr (2007) -  We assume No acclimation term for C4 plants
+      !Config Units = [(mu mol e- (mu mol CO2)-1) (Â°C)-1]
+      CALL getin_p('BRJV',brJV)
+
+      !Config Key   = KmC25
+      !Config Desc  = MichaelisâMenten constant of Rubisco for CO2 at 25Â°C
+      !Config if    = OK_CO2
+      !Config Def   = undef, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 404.9, 650., 404.9, 650.
+      !Config Help  = See Table 2 of Yin et al. (2009) for C4 plants and Medlyn et al. (2002) for C3 plants
+      !Config Units = [ubar]
+      CALL getin_p('KMC25',KmC25)
+
+      !Config Key   = KmO25
+      !Config Desc  = MichaelisâMenten constant of Rubisco for O2 at 25Â°C
+      !Config if    = OK_CO2
+      !Config Def   = undef, 278400., 278400., 278400., 278400., 278400., 278400., 278400., 278400., 278400., 450000., 278400., 450000.
+      !Config Help  = See Table 2 of Yin et al. (2009) for C4 plants and Medlyn et al. (2002) for C3 plants
+      !Config Units = [ubar]
+      CALL getin_p('KMO25',KmO25)
+
+      !Config Key   = gamma_star25
+      !Config Desc  = Ci-based CO2 compensation point in the absence of Rd at 25Â°C (ubar)
+      !Config if    = OK_CO2
+      !Config Def   = undef, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75, 42.75
+      !Config Help  = See Medlyn et al. (2002) for C3 plants - For C4 plants, we use the same value (probably uncorrect)
+      !Config Units = [ubar]
+      CALL getin_p('gamma_star25',gamma_star25)
+
+      !Config Key   = a1
+      !Config Desc  = Empirical factor involved in the calculation of fvpd
+      !Config if    = OK_CO2
+      !Config Def   = undef, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85
+      !Config Help  = See Table 2 of Yin et al. (2009)
+      !Config Units = [-]
+      CALL getin_p('A1',a1)
+
+      !Config Key   = b1
+      !Config Desc  = Empirical factor involved in the calculation of fvpd
+      !Config if    = OK_CO2
+      !Config Def   = undef, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.20, 0.14, 0.20
+      !Config Help  = See Table 2 of Yin et al. (2009)
+      !Config Units = [-]
+      CALL getin_p('B1',b1)
+
+      !Config Key   = g0
+      !Config Desc  = Residual stomatal conductance when irradiance approaches zero 
+      !Config if    = OK_CO2
+      !Config Def   = undef, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.00625, 0.01875, 0.00625, 0.01875 
+      !Config Help  = Value from ORCHIDEE - No other reference.
+      !Config Units = [mol mâ2 sâ1 barâ1]
+      CALL getin_p('G0',g0)
+
+      !Config Key   = h_protons
+      !Config Desc  = Number of protons required to produce one ATP
+      !Config if    = OK_CO2
+      !Config Def   = undef, 4., 4., 4., 4., 4., 4., 4., 4., 4., 4., 4., 4. 
+      !Config Help  = See Table 2 of Yin et al. (2009) - h parameter
+      !Config Units = [mol mol-1]
+      CALL getin_p('H_PROTONS',h_protons)
+
+      !Config Key   = fpsir
+      !Config Desc  = Fraction of PSII eâ transport rate partitioned to the C4 cycle
+      !Config if    = OK_CO2
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.4, undef, 0.4 
+      !Config Help  = See Table 2 of Yin et al. (2009)
+      !Config Units = [-]
+      CALL getin_p('FPSIR',fpsir)
+
+      !Config Key   = fQ
+      !Config Desc  = Fraction of electrons at reduced plastoquinone that follow the Q-cycle
+      !Config if    = OK_CO2
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 1., undef, 1.
+      !Config Help  = See Table 2 of Yin et al. (2009) - Values for C3 plants are not used
+      !Config Units = [-]
+      CALL getin_p('FQ',fQ)
+
+      !Config Key   = fpseudo
+      !Config Desc  = Fraction of electrons at PSI that follow pseudocyclic transport 
+      !Config if    = OK_CO2
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.1, undef, 0.1
+      !Config Help  = See Table 2 of Yin et al. (2009) - Values for C3 plants are not used
+      !Config Units = [-]
+      CALL getin_p('FPSEUDO',fpseudo)
+
+      !Config Key   = kp
+      !Config Desc  = Initial carboxylation efficiency of the PEP carboxylase
+      !Config if    = OK_CO2
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.7, undef, 0.7
+      !Config Help  = See Table 2 of Yin et al. (2009) 
+      !Config Units = [mol mâ2 sâ1 barâ1]
+      CALL getin_p('KP',kp)
+
+      !Config Key   = alpha
+      !Config Desc  = Fraction of PSII activity in the bundle sheath
+      !Config if    = OK_CO2
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.1, undef, 0.1
+      !Config Help  = See legend of Figure 6 of Yin et al. (2009)
+      !Config Units = [-]
+      CALL getin_p('ALPHA',alpha)
+
+      !Config Key   = gbs
+      !Config Desc  = Bundle-sheath conductance
+      !Config if    = OK_CO2
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.003, undef, 0.003
+      !Config Help  = See legend of Figure 6 of Yin et al. (2009)
+      !Config Units = [mol mâ2 sâ1 barâ1]
+      CALL getin_p('GBS',gbs)
+
+      !Config Key   = theta
+      !Config Desc  = Convexity factor for response of J to irradiance
+      !Config if    = OK_CO2
+      !Config Def   = undef, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7
+      !Config Help  = See Table 2 of Yin et al. (2009)   
+      !Config Units = [â]
+      CALL getin_p('THETA',theta)
+
+      !Config Key   = alpha_LL
+      !Config Desc  = Conversion efficiency of absorbed light into J at strictly limiting light
+      !Config if    = OK_CO2
+      !Config Def   = undef, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372, 0.372
+      !Config Help  = See comment from Yin et al. (2009) after eq. 4
+      !Config Units = [mol eâ (mol photon)â1]
+      CALL getin_p('ALPHA_LL',alpha_LL)
+
+      !Config Key   = EXT_COEFF
+      !Config Desc  = extinction coefficient of the Monsi&Seaki relationship (1953)
+      !Config if    = OK_SECHIBA or OK_STOMATE
+      !Config Def   = .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('EXT_COEFF',ext_coeff)
+     
+      !
+      ! Water-hydrology - sechiba
+      !
+
+      !Config Key   = HYDROL_HUMCSTE
+      !Config Desc  = Root profile
+      !Config Def   = humcste_ref2m or humcste_ref4m depending on zmaxh
+      !Config if    = OK_SECHIBA
+      !Config Help  = See module constantes_mtc for different default values
+      !Config Units = [m]
+      CALL getin_p('HYDROL_HUMCSTE',humcste)
+
+      !
+      ! Soil - vegetation
+      !
+
+      !Config Key   = PREF_SOIL_VEG
+      !Config Desc  = The soil tile number for each vegetation
+      !Config if    = OK_SECHIBA or OK_STOMATE
+      !Config Def   = 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3
+      !Config Help  = Gives the number of the soil tile on which we will
+      !Config         put each vegetation. This allows to divide the hydrological column
+      !Config Units = [-]        
+      CALL getin_p('PREF_SOIL_VEG',pref_soil_veg)
+
+      first_call = .FALSE.
+
+   ENDIF !(first_call)
+
+ END SUBROUTINE config_pft_parameters
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_sechiba_pft_parameters
+!!
+!>\BRIEF        This subroutine will read the imposed values for the sechiba pft
+!! parameters. It is not called if IMPOSE_PARAM is set to NO. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE config_sechiba_pft_parameters()
+
+   IMPLICIT NONE
+  
+   !! 0. Variables and parameters declaration
+
+   !! 0.1 Input variables
+
+   !! 0.4 Local variable
+
+   LOGICAL, SAVE ::  first_call = .TRUE.   !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================ 
+
+   IF (first_call) THEN
+
+      !
+      ! Evapotranspiration -  sechiba
+      !
+      
+      !Config Key   = RSTRUCT_CONST
+      !Config Desc  = Structural resistance 
+      !Config if    = OK_SECHIBA
+      !Config Def   = 0.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0,  2.5,  2.0,  2.0,  2.0
+      !Config Help  =
+      !Config Units = [s/m]
+      CALL getin_p('RSTRUCT_CONST',rstruct_const)
+      
+      !Config Key   = KZERO
+      !Config Desc  = A vegetation dependent constant used in the calculation of the surface resistance.
+      !Config if    = OK_SECHIBA
+      !Config Def   = 0.0, 12.E-5, 12.E-5, 12.e-5, 12.e-5, 25.e-5, 12.e-5,25.e-5, 25.e-5, 30.e-5, 30.e-5, 30.e-5, 30.e-5 
+      !Config Help  =
+      !Config Units = [kg/m^2/s]
+      CALL getin_p('KZERO',kzero)
+      
+      !Config Key   = RVEG_PFT
+      !Config Desc  = Artificial parameter to increase or decrease canopy resistance.
+      !Config if    = OK_SECHIBA
+      !Config Def   = 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.
+      !Config Help  = This parameter is set by PFT.
+      !Config Units = [-]
+      CALL getin_p('RVEG_PFT',rveg_pft)    
+      
+      !
+      ! Water-hydrology - sechiba
+      !
+
+      !Config Key   = WMAX_VEG
+      !Config Desc  = Maximum field capacity for each of the vegetations (Temporary): max quantity of water
+      !Config if    = OK_SECHIBA
+      !Config Def   = 150., 150., 150., 150., 150., 150., 150.,150., 150., 150., 150., 150., 150.
+      !Config Help  =
+      !Config Units = [kg/m^3]
+      CALL getin_p('WMAX_VEG',wmax_veg)
+
+      !Config Key   = PERCENT_THROUGHFALL_PFT
+      !Config Desc  = Percent by PFT of precip that is not intercepted by the canopy. Default value depend on run mode.
+      !Config if    = OK_SECHIBA
+      !Config Def   = Case offline+CWRR [0. 0. 0....] else [30. 30. 30.....]
+      !Config Help  = During one rainfall event, PERCENT_THROUGHFALL_PFT% of the incident rainfall
+      !Config         will get directly to the ground without being intercepted, for each PFT.
+      !Config Units = [%]
+      CALL getin_p('PERCENT_THROUGHFALL_PFT',throughfall_by_pft)
+      throughfall_by_pft(:) = throughfall_by_pft(:) / 100. 
+      
+      
+      !
+      ! Albedo - sechiba
+      !
+
+      !Config Key   = SNOWA_AGED
+      !Config Desc  = Minimum snow albedo value for each vegetation type after aging (dirty old snow)
+      !Config if    = OK_SECHIBA
+      !Config Def   = 0.35, 0., 0., 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.18, 0.18, 0.18, 0.18
+      !Config Help  = Values are from the Thesis of S. Chalita (1992)
+      !Config Units = [-]
+      CALL getin_p('SNOWA_AGED',snowa_aged)
+
+      !Config Key   = SNOWA_DEC
+      !Config Desc  = Decay rate of snow albedo value for each vegetation type as it will be used in condveg_snow
+      !Config if    = OK_SECHIBA
+      !Config Def   = 0.45, 0.,  0., 0.06, 0.06, 0.11, 0.06, 0.11, 0.11, 0.52,0.52, 0.52, 0.52
+      !Config Help  = Values are from the Thesis of S. Chalita (1992)
+      !Config Units = [-]
+      CALL getin_p('SNOWA_DEC',snowa_dec)
+
+      !Config Key   = ALB_LEAF_VIS
+      !Config Desc  = leaf albedo of vegetation type, visible albedo
+      !Config if    = OK_SECHIBA
+      !Config Def   = .00, .04, .06, .06, .06,.06, .06, .06, .06, .10, .10, .10, .10
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('ALB_LEAF_VIS',alb_leaf_vis)
+
+      !Config Key   = ALB_LEAF_NIR
+      !Config Desc  = leaf albedo of vegetation type, near infrared albedo
+      !Config if    = OK_SECHIBA
+      !Config Def   = .00, .20, .22, .22, .22,.22, .22, .22, .22, .30, .30, .30, .30 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('ALB_LEAF_NIR',alb_leaf_nir)
+      
+      IF ( ok_bvoc ) THEN
+         !
+         ! BVOC
+         !
+
+         !Config Key   = ISO_ACTIVITY
+         !Config Desc  = Biogenic activity for each age class : isoprene
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0.5, 1.5, 1.5, 0.5
+         !Config Help  =
+         !Config Units = [-]
+         CALL getin_p('ISO_ACTIVITY',iso_activity)
+
+         !Config Key   = METHANOL_ACTIVITY
+         !Config Desc  = Isoprene emission factor for each age class : methanol
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 1., 1., 0.5, 0.5
+         !Config Help  =
+         !Config Units = [-]
+         CALL getin_p('METHANOL_ACTIVITY',methanol_activity)
+
+         !Config Key   = EM_FACTOR_ISOPRENE
+         !Config Desc  = Isoprene emission factor
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 24., 24., 8., 16., 45., 8., 18., 0.5, 12., 18., 5., 5.
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_ISOPRENE',em_factor_isoprene)
+
+         !Config Key   = EM_FACTOR_MONOTERPENE
+         !Config Desc  = Monoterpene emission factor 
+         !Config if    = CHEMISTRY_BVOC 
+         !Config Def   = 0., 2.0, 2.0, 1.8, 1.4, 1.6, 1.8, 1.4, 1.8, 0.8, 0.8,  0.22, 0.22
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_MONOTERPENE',em_factor_monoterpene)
+
+         !Config Key   = C_LDF_MONO 
+         !Config Desc  = Monoterpenes fraction dependancy to light
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0.6
+         !Config Help  =
+         !Config Units = []
+         CALL getin_p('C_LDF_MONO',LDF_mono)
+
+         !Config Key   = C_LDF_SESQ 
+         !Config Desc  = Sesquiterpenes fraction dependancy to light
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0.5
+         !Config Help  =
+         !Config Units = []
+         CALL getin_p('C_LDF_SESQ',LDF_sesq)
+
+         !Config Key   = C_LDF_METH 
+         !Config Desc  = Methanol fraction dependancy to light
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0.8
+         !Config Help  =
+         !Config Units = []
+         CALL getin_p('C_LDF_METH',LDF_meth)
+
+         !Config Key   = C_LDF_ACET 
+         !Config Desc  = Acetone fraction dependancy to light
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0.2
+         !Config Help  =
+         !Config Units = []
+         CALL getin_p('C_LDF_ACET',LDF_acet)
+
+         !Config Key   = EM_FACTOR_APINENE 
+         !Config Desc  = Alfa pinene  emission factor 
+         !Config if    = CHEMISTRY_BVOC 
+         !Config Def   = 0., 1.35, 1.35, 0.85, 0.95, 0.75, 0.85, 0.60, 1.98, 0.30, 0.30, 0.09, 0.09
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_APINENE',em_factor_apinene)
+
+         !Config Key   = EM_FACTOR_BPINENE
+         !Config Desc  = Beta pinene  emission factor
+         !Config if    = CHEMISTRY_BVOC 
+         !Config Def   = 0., 0.30, 0.30, 0.35, 0.25, 0.20, 0.35, 0.12, 0.45, 0.16, 0.12, 0.05, 0.05
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_BPINENE',em_factor_bpinene)
+
+         !Config Key   = EM_FACTOR_LIMONENE
+         !Config Desc  = Limonene  emission factor
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 0.25, 0.25, 0.20, 0.25, 0.14, 0.20, 0.135, 0.11, 0.19, 0.42, 0.03, 0.03
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_LIMONENE',em_factor_limonene)
+
+         !Config Key   = EM_FACTOR_MYRCENE
+         !Config Desc  = Myrcene  emission factor
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 0.20, 0.20, 0.12, 0.11, 0.065, 0.12, 0.036, 0.075, 0.08,  0.085, 0.015, 0.015
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_MYRCENE',em_factor_myrcene)
+
+         !Config Key   = EM_FACTOR_SABINENE
+         !Config Desc  = Sabinene  emission factor
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 0.20, 0.20, 0.12, 0.17, 0.70, 0.12, 0.50, 0.09, 0.085, 0.075, 0.02, 0.02
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_SABINENE',em_factor_sabinene)
+
+         !Config Key   = EM_FACTOR_CAMPHENE 
+         !Config Desc  = Camphene  emission factor 
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 0.15, 0.15, 0.10, 0.10, 0.01, 0.10, 0.01, 0.07, 0.07, 0.08, 0.01, 0.01
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_CAMPHENE',em_factor_camphene)
+
+         !Config Key   = EM_FACTOR_3CARENE 
+         !Config Desc  = 3-Carene  emission factor
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 0.13, 0.13, 0.42, 0.02, 0.055, 0.42,0.025, 0.125, 0.085, 0.085, 0.065, 0.065
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_3CARENE',em_factor_3carene)
+
+         !Config Key   = EM_FACTOR_TBOCIMENE
+         !Config Desc  = T-beta-ocimene  emission factor
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 0.25, 0.25, 0.13, 0.09, 0.26, 0.13, 0.20, 0.085, 0.18, 0.18, 0.01, 0.01
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_TBOCIMENE', em_factor_tbocimene)
+
+         !Config Key   = EM_FACTOR_OTHERMONOT
+         !Config Desc  = Other monoterpenes  emission factor
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 0.17, 0.17, 0.11, 0.11, 0.125, 0.11, 0.274, 0.01, 0.15, 0.155, 0.035, 0.035
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_OTHERMONOT',em_factor_othermonot)
+
+         !Config Key   = EM_FACTOR_SESQUITERP 
+         !Config Desc  = Sesquiterpenes  emission factor 
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 0.45, 0.45, 0.13, 0.3, 0.36, 0.15, 0.3, 0.25, 0.6, 0.6, 0.08, 0.08
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_SESQUITERP',em_factor_sesquiterp)
+
+
+
+         !Config Key   = C_BETA_MONO 
+         !Config Desc  = Monoterpenes temperature dependency coefficient
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0.1
+         !Config Help  =
+         !Config Units = []
+         CALL getin_p('C_BETA_MONO',beta_mono)
+
+         !Config Key   = C_BETA_SESQ 
+         !Config Desc  = Sesquiterpenes temperature dependency coefficient
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0.17
+         !Config Help  =
+         !Config Units = []
+         CALL getin_p('C_BETA_SESQ',beta_sesq)
+
+         !Config Key   = C_BETA_METH 
+         !Config Desc  = Methanol temperature dependency coefficient
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0.08
+         !Config Help  =
+         !Config Units = []
+         CALL getin_p('C_BETA_METH',beta_meth)
+
+         !Config Key   = C_BETA_ACET 
+         !Config Desc  = Acetone temperature dependency coefficient
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0.1
+         !Config Help  =
+         !Config Units = []
+         CALL getin_p('C_BETA_ACET',beta_acet)
+
+         !Config Key   = C_BETA_OXYVOC 
+         !Config Desc  = Other oxygenated BVOC temperature dependency coefficient
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0.13
+         !Config Help  =
+         !Config Units = []
+         CALL getin_p('C_BETA_OXYVOC',beta_oxyVOC)
+
+         !Config Key   = EM_FACTOR_ORVOC
+         !Config Desc  = ORVOC emissions factor 
+         !Config if    = CHEMISTRY_BVOC 
+         !Config Def   = 0., 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5
+         !Config Help  =
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_ORVOC',em_factor_ORVOC)
+
+         !Config Key   = EM_FACTOR_OVOC
+         !Config Desc  = OVOC emissions factor
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5
+         !Config Help  =
+         !Config Units = [ugC/g/h]        
+         CALL getin_p('EM_FACTOR_OVOC',em_factor_OVOC)
+
+         !Config Key   = EM_FACTOR_MBO
+         !Config Desc  = MBO emissions factor 
+         !Config if    = CHEMISTRY_BVOC 
+         !Config Def   = 0., 2.e-5, 2.e-5, 1.4, 2.e-5, 2.e-5, 0.14, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5, 2.e-5
+         !Config Help  =
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_MBO',em_factor_MBO)
+
+         !Config Key   = EM_FACTOR_METHANOL
+         !Config Desc  = Methanol emissions factor 
+         !Config if    = CHEMISTRY_BVOC 
+         !Config Def   = 0., 0.8, 0.8, 1.8, 0.9, 1.9, 1.8, 1.8, 1.8, 0.7, 0.9, 2., 2.
+         !Config Help  =
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_METHANOL',em_factor_methanol)
+
+         !Config Key   = EM_FACTOR_ACETONE
+         !Config Desc  = Acetone emissions factor
+         !Config if    = CHEMISTRY_BVOC 
+         !Config Def   = 0., 0.25, 0.25, 0.3, 0.2, 0.33, 0.3, 0.25, 0.25, 0.2, 0.2, 0.08, 0.08
+         !Config Help  =
+         !Config Units = [ugC/g/h]     
+         CALL getin_p('EM_FACTOR_ACETONE',em_factor_acetone)
+
+         !Config Key   = EM_FACTOR_ACETAL
+         !Config Desc  = Acetaldehyde emissions factor 
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 0.2, 0.2, 0.2, 0.2, 0.25, 0.25, 0.16, 0.16, 0.12, 0.12, 0.035, 0.02
+         !Config Help  =
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_ACETAL',em_factor_acetal)
+
+         !Config Key   = EM_FACTOR_FORMAL
+         !Config Desc  = Formaldehyde emissions factor
+         !Config if    = CHEMISTRY_BVOC 
+         !Config Def   = 0., 0.04, 0.04, 0.08, 0.04, 0.04, 0.04, 0.04, 0.04, 0.025, 0.025, 0.013, 0.013
+         !Config Help  = 
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_FORMAL',em_factor_formal)
+
+         !Config Key   = EM_FACTOR_ACETIC
+         !Config Desc  = Acetic Acid emissions factor
+         !Config if    = CHEMISTRY_BVOC 
+         !Config Def   = 0., 0.025, 0.025,0.025,0.022,0.08,0.025,0.022,0.013,0.012,0.012,0.008,0.008
+         !Config Help  =
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_ACETIC',em_factor_acetic)
+
+         !Config Key   = EM_FACTOR_FORMIC
+         !Config Desc  = Formic Acid emissions factor
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 0.015, 0.015, 0.02, 0.02, 0.025, 0.025, 0.015, 0.015,0.010,0.010,0.008,0.008
+         !Config Help  =
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_FORMIC',em_factor_formic)
+
+         !Config Key   = EM_FACTOR_NO_WET
+         !Config Desc  = NOx emissions factor wet soil emissions and exponential dependancy factor 
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 2.6, 0.06, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.36, 0.36, 0.36, 0.36
+         !Config Help  =
+         !Config Units = [ngN/m^2/s]
+         CALL getin_p('EM_FACTOR_NO_WET',em_factor_no_wet)
+
+         !Config Key   = EM_FACTOR_NO_DRY
+         !Config Desc  = NOx emissions factor dry soil emissions and exponential dependancy factor 
+         !Config if    = CHEMISTRY_BVOC
+         !Config Def   = 0., 8.60, 0.40, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22, 2.65, 2.65, 2.65, 2.65
+         !Config Help  =
+         !Config Units = [ngN/m^2/s] 
+         CALL getin_p('EM_FACTOR_NO_DRY',em_factor_no_dry)
+
+         !Config Key   = LARCH
+         !Config Desc  = Larcher 1991 SAI/LAI ratio
+         !Config if    = CHEMISTRY_BVOC 
+         !Config Def   = 0., 0.015, 0.015, 0.003, 0.005, 0.005, 0.003, 0.005, 0.003, 0.005, 0.005, 0.008, 0.008
+         !Config Help  =
+         !Config Units = [-]  
+         CALL getin_p('LARCH',Larch)
+         
+      ENDIF ! (ok_bvoc)
+
+      first_call = .FALSE.
+
+   ENDIF !(first_call)
+
+ END SUBROUTINE config_sechiba_pft_parameters
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_stomate_pft_parameters 
+!!
+!>\BRIEF         This subroutine will read the imposed values for the stomate pft
+!! parameters. It is not called if IMPOSE_PARAM is set to NO.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE config_stomate_pft_parameters
+
+   IMPLICIT NONE
+   
+   !! 0. Variables and parameters declaration
+
+   !! 0.4 Local variable
+
+   LOGICAL, SAVE ::  first_call = .TRUE.   !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+
+   IF (first_call) THEN
+      
+      !
+      ! Vegetation structure
+      !
+
+      !Config Key   = SLA
+      !Config Desc  = specif leaf area 
+      !Config if    = OK_STOMATE
+      !Config Def   = 1.5E-2, 1.53E-2, 2.6E-2, 9.26E-3, 2E-2, 2.6E-2, 9.26E-3, 2.6E-2, 1.9E-2, 2.6E-2, 2.6E-2, 2.6E-2, 2.6E-2
+      !Config Help  =
+      !Config Units = [m^2/gC]
+      CALL getin_p('SLA',sla)
+
+
+      !Config Key   = AVAILABILITY_FACT 
+      !Config Desc  = Calculate dynamic mortality in lpj_gap, pft dependent parameter
+      !Config If    = OK_STOMATE 
+      !Config Def   = undef, 0.14, 0.14, 0.10, 0.10, 0.10, 0.05, 0.05, 0.05, undef, undef, undef, undef 
+      !Config Help  = 
+      !Config Units = [-]   
+      CALL getin_p('AVAILABILITY_FACT',availability_fact)
+
+      !
+      ! Allocation - stomate
+      !
+      !
+      !Config Key   = R0 
+      !Config Desc  = Standard root allocation 
+      !Config If    = OK_STOMATE 
+      !Config Def   = undef, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30
+      !Config Help  = 
+      !Config Units = [-]    
+      CALL getin_p('R0',R0)
+
+      !Config Key   = S0 
+      !Config Desc  = Standard sapwood allocation 
+      !Config If    = OK_STOMATE 
+      !Config Def   = undef, .25, .25, .30, .30, .30, .30, .30, .30, .30, .30, .30, .30
+      !Config Help  = 
+      !Config Units = [-]    
+      CALL getin_p('S0',S0)
+
+      !
+      ! Respiration - stomate
+      !
+
+      !Config Key   = FRAC_GROWTHRESP
+      !Config Desc  = fraction of GPP which is lost as growth respiration
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .28, .28, .28, .28, .28, .28, .28, .28, .28, .28, .28, .28 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('FRAC_GROWTHRESP',frac_growthresp) 
+
+      !Config Key   = MAINT_RESP_SLOPE_C
+      !Config Desc  = slope of maintenance respiration coefficient (1/K), constant c of aT^2+bT+c , tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .20, .20, .16, .16, .16, .16, .16, .16, .16, .12, .16, .12 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('MAINT_RESP_SLOPE_C',maint_resp_slope_c) 
+
+      !Config Key   = MAINT_RESP_SLOPE_B
+      !Config Desc  = slope of maintenance respiration coefficient (1/K), constant b of aT^2+bT+c , tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .0, .0, .0, .0, .0, .0, .0, .0, -.00133, .0, -.00133, .0 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('MAINT_RESP_SLOPE_B',maint_resp_slope_b)
+
+      !Config Key   = MAINT_RESP_SLOPE_A
+      !Config Desc  = slope of maintenance respiration coefficient (1/K), constant a of aT^2+bT+c , tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0    
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('MAINT_RESP_SLOPE_A',maint_resp_slope_a)
+
+      !Config Key   = CM_ZERO_LEAF
+      !Config Desc  = maintenance respiration coefficient at 0 deg C, for leaves, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 2.35E-3, 2.62E-3, 1.01E-3, 2.35E-3, 2.62E-3, 1.01E-3,2.62E-3, 2.05E-3, 2.62E-3, 2.62E-3, 2.62E-3, 2.62E-3
+      !Config Help  =
+      !Config Units = [g/g/day]
+      CALL getin_p('CM_ZERO_LEAF',cm_zero_leaf)
+
+      !Config Key   = CM_ZERO_SAPABOVE
+      !Config Desc  = maintenance respiration coefficient at 0 deg C,for sapwood above, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4
+      !Config Help  =
+      !Config Units = [g/g/day]
+      CALL getin_p('CM_ZERO_SAPABOVE',cm_zero_sapabove)
+
+      !Config Key   = CM_ZERO_SAPBELOW
+      !Config Desc  = maintenance respiration coefficient at 0 deg C, for sapwood below, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4 
+      !Config Help  =
+      !Config Units = [g/g/day]
+      CALL getin_p('CM_ZERO_SAPBELOW',cm_zero_sapbelow)
+
+      !Config Key   = CM_ZERO_HEARTABOVE
+      !Config Desc  = maintenance respiration coefficient at 0 deg C, for heartwood above, tabulated
+      !Config if    = OK_STOMATE 
+      !Config Def   = undef, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. 
+      !Config Help  =
+      !Config Units = [g/g/day]
+      CALL getin_p('CM_ZERO_HEARTABOVE',cm_zero_heartabove)
+
+      !Config Key   = CM_ZERO_HEARTBELOW
+      !Config Desc  = maintenance respiration coefficient at 0 deg C,for heartwood below, tabulated
+      !Config if    = OK_STOMATE 
+      !Config Def   = undef, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. 
+      !Config Help  =
+      !Config Units = [g/g/day] 
+      CALL getin_p('CM_ZERO_HEARTBELOW',cm_zero_heartbelow)
+
+      !Config Key   = CM_ZERO_ROOT
+      !Config Desc  = maintenance respiration coefficient at 0 deg C, for roots, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef,1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3,1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3
+      !Config Help  =
+      !Config Units = [g/g/day] 
+      CALL getin_p('CM_ZERO_ROOT',cm_zero_root)
+
+      !Config Key   = CM_ZERO_FRUIT
+      !Config Desc  = maintenance respiration coefficient at 0 deg C, for fruits, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4,1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4    
+      !Config Help  =
+      !Config Units = [g/g/day] 
+      CALL getin_p('CM_ZERO_FRUIT',cm_zero_fruit)
+
+      !Config Key   = CM_ZERO_CARBRES
+      !Config Desc  = maintenance respiration coefficient at 0 deg C, for carbohydrate reserve, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4,1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4
+      !Config Help  =
+      !Config Units = [g/g/day] 
+      CALL getin_p('CM_ZERO_CARBRES',cm_zero_carbres)
+      
+      !
+      ! Fire - stomate
+      !
+
+      !Config Key   = FLAM
+      !Config Desc  = flamability: critical fraction of water holding capacity
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .15, .25, .25, .25, .25, .25, .25, .25, .25, .25, .35, .35
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('FLAM',flam)
+
+      !Config Key   = RESIST
+      !Config Desc  = fire resistance
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .95, .90, .12, .50, .12, .12, .12, .12, .0, .0, .0, .0 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('RESIST',resist)
+     
+      !
+      ! Flux - LUC
+      !
+
+      !Config Key   = COEFF_LCCHANGE_1
+      !Config Desc  = Coeff of biomass export for the year
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0.897, 0.897, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('COEFF_LCCHANGE_1',coeff_lcchange_1)
+
+      !Config Key   = COEFF_LCCHANGE_10
+      !Config Desc  = Coeff of biomass export for the decade
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0.103, 0.103, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.403, 0.299, 0.403
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('COEFF_LCCHANGE_10',coeff_lcchange_10)
+
+      !Config Key   = COEFF_LCCHANGE_100
+      !Config Desc  = Coeff of biomass export for the century
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0., 0., 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0., 0.104, 0.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('COEFF_LCCHANGE_100',coeff_lcchange_100)
+      
+      !
+      ! Phenology
+      !
+
+      !Config Key   = LAI_MAX_TO_HAPPY
+      !Config Desc  = threshold of LAI below which plant uses carbohydrate reserves
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('LAI_MAX_TO_HAPPY',lai_max_to_happy) 
+
+      !Config Key   = LAI_MAX
+      !Config Desc  = maximum LAI, PFT-specific
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 7., 7., 5., 5., 5., 4.5, 4.5, 3.0, 2.5, 2.5, 5.,5. 
+      !Config Help  =
+      !Config Units = [m^2/m^2]
+      CALL getin_p('LAI_MAX',lai_max)
+
+      !Config Key   = PHENO_TYPE
+      !Config Desc  = type of phenology, 0=bare ground 1=evergreen,  2=summergreen,  3=raingreen,  4=perennial
+      !Config if    = OK_STOMATE
+      !Config Def   = 0, 1, 3, 1, 1, 2, 1, 2, 2, 4, 4, 2, 3
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('PHENO_TYPE',pheno_type)
+
+      !
+      ! Phenology : Leaf Onset
+      !
+
+      !Config Key   = PHENO_GDD_CRIT_C
+      !Config Desc  = critical gdd, tabulated (C), constant c of aT^2+bT+c
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 270., 400., 125., 400.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('PHENO_GDD_CRIT_C',pheno_gdd_crit_c)
+
+      !Config Key   = PHENO_GDD_CRIT_B
+      !Config Desc  = critical gdd, tabulated (C), constant b of aT^2+bT+c
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef,undef, undef, 6.25, 0., 0., 0.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('PHENO_GDD_CRIT_B',pheno_gdd_crit_b)
+
+      !Config Key   = PHENO_GDD_CRIT_A
+      !Config Desc  = critical gdd, tabulated (C), constant a of aT^2+bT+c
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.03125,  0., 0., 0.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('PHENO_GDD_CRIT_A',pheno_gdd_crit_a)
+
+      !Config Key   = PHENO_MOIGDD_T_CRIT
+      !Config Desc  = Average temperature threashold for C4 grass used in pheno_moigdd
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 22.0, undef, undef
+      !Config Help  =
+      !Config Units = [C]
+      CALL getin_p('PHENO_MOIGDD_T_CRIT',pheno_moigdd_t_crit)
+
+      !Config Key   = NGD_CRIT
+      !Config Desc  = critical ngd, tabulated. Threshold -5 degrees
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, 0., undef, undef, undef, undef, undef
+      !Config Help  = NGD : Number of Growing Days.
+      !Config Units = [days]
+      CALL getin_p('NGD_CRIT',ngd_crit)
+
+      !Config Key   = NCDGDD_TEMP
+      !Config Desc  = critical temperature for the ncd vs. gdd function in phenology
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, 5., undef, 0., undef, undef, undef, undef, undef
+      !Config Help  =
+      !Config Units = [C] 
+      CALL getin_p('NCDGDD_TEMP',ncdgdd_temp)
+
+      !Config Key   = HUM_FRAC
+      !Config Desc  = critical humidity (relative to min/max) for phenology
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, .5, undef, undef, undef, undef, undef,  undef, .5, .5, .5,.5     
+      !Config Help  =
+      !Config Units = [%]
+      CALL getin_p('HUM_FRAC',hum_frac)
+
+      !Config Key   = HUM_MIN_TIME
+      !Config Desc  = minimum time elapsed since moisture minimum
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, 50., undef, undef, undef, undef, undef, undef, 35., 35., 75., 75.
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('HUM_MIN_TIME',hum_min_time)
+
+      !Config Key   = TAU_SAP
+      !Config Desc  = sapwood -> heartwood conversion time
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 730., 730., 730., 730., 730., 730., 730., 730., undef, undef, undef, undef
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('TAU_SAP',tau_sap)
+
+      !Config Key   = TAU_LEAFINIT
+      !Config Desc  = time to attain the initial foliage using the carbohydrate reserve
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 10., 10., 10., 10., 10., 10., 10., 10., 10., 10., 10., 10.
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('TAU_LEAFINIT',tau_leafinit) 
+
+      !Config Key   = TAU_FRUIT
+      !Config Desc  = fruit lifetime
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 90., 90., 90., 90., 90., 90., 90., 90., undef, undef, undef, undef
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('TAU_FRUIT',tau_fruit)
+
+      !Config Key   = ECUREUIL
+      !Config Desc  = fraction of primary leaf and root allocation put into reserve
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .0, 1., .0, .0, 1., .0, 1., 1., 1., 1., 1., 1.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('ECUREUIL',ecureuil)
+
+      !Config Key   = ALLOC_MIN
+      !Config Desc  = minimum allocation above/below = f(age) - 30/01/04 NV/JO/PF
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, undef, undef, undef, undef 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('ALLOC_MIN',alloc_min)
+
+      !Config Key   = ALLOC_MAX
+      !Config Desc  = maximum allocation above/below = f(age) - 30/01/04 NV/JO/PF
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, undef, undef, undef, undef
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('ALLOC_MAX',alloc_max)
+
+      !Config Key   = DEMI_ALLOC 
+      !Config Desc  = mean allocation above/below = f(age) - 30/01/04 NV/JO/PF
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 5., 5., 5., 5., 5., 5., 5., 5., undef, undef, undef, undef
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('DEMI_ALLOC',demi_alloc)
+
+      !Config Key   = LEAFLIFE_TAB
+      !Config Desc  = leaf longevity
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .5, 2., .33, 1., 2., .33, 2., 2., 2., 2., 2., 2. 
+      !Config Help  =
+      !Config Units = [years]
+      CALL getin_p('LEAFLIFE_TAB',leaflife_tab)
+
+      !
+      ! Phenology : Senescence
+      !
+      !
+      !Config Key   = LEAFFALL
+      !Config Desc  = length of death of leaves, tabulated 
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, 10., undef, undef, 10., undef, 10., 10., 10., 10., 10., 10. 
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('LEAFFALL',leaffall)
+
+      !Config Key   = LEAFAGECRIT
+      !Config Desc  = critical leaf age, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 730., 180., 910., 730., 180., 910., 180., 180., 120., 120., 90., 90.  
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('LEAFAGECRIT',leafagecrit) 
+
+      !Config Key   = SENESCENCE_TYPE
+      !Config Desc  = type of senescence, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = none, none, dry, none, none, cold, none, cold, cold, mixed, mixed, mixed, mixed 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('SENESCENCE_TYPE',senescence_type) 
+
+      !Config Key   = SENESCENCE_HUM
+      !Config Desc  = critical relative moisture availability for senescence
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, .3, undef, undef, undef, undef, undef, undef, .2, .2, .3, .2 
+      !Config Help  =
+      !Config Units = [-] 
+      CALL getin_p('SENESCENCE_HUM',senescence_hum)
+
+      !Config Key   = NOSENESCENCE_HUM
+      !Config Desc  = relative moisture availability above which there is no humidity-related senescence
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, .8, undef, undef, undef, undef, undef, undef, .3, .3, .3, .3 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('NOSENESCENCE_HUM',nosenescence_hum) 
+
+      !Config Key   = MAX_TURNOVER_TIME
+      !Config Desc  = maximum turnover time for grasse
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef,  80.,  80., 80., 80. 
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('MAX_TURNOVER_TIME',max_turnover_time)
+
+      !Config Key   = MIN_TURNOVER_TIME
+      !Config Desc  = minimum turnover time for grasse 
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 10., 10., 10., 10. 
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('MIN_TURNOVER_TIME',min_turnover_time)
+
+      !Config Key   = MIN_LEAF_AGE_FOR_SENESCENCE
+      !Config Desc  = minimum leaf age to allow senescence g
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, 90., undef, undef, 90., undef, 60., 60., 30., 30., 30., 30.
+      !Config Help  =
+      !Config Units = [days] 
+      CALL getin_p('MIN_LEAF_AGE_FOR_SENESCENCE',min_leaf_age_for_senescence)
+
+      !Config Key   = SENESCENCE_TEMP_C
+      !Config Desc  = critical temperature for senescence (C), constant c of aT^2+bT+c, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, 12., undef, 7., 2., -1.375, 5., 5., 10.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('SENESCENCE_TEMP_C',senescence_temp_c)
+
+      !Config Key   = SENESCENCE_TEMP_B
+      !Config Desc  = critical temperature for senescence (C), constant b of aT^2+bT+c ,tabulated
+      !Config if    = OK_STOMATE 
+      !Config Def   = undef, undef, undef, undef, undef, 0., undef, 0., 0., .1, 0., 0., 0.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('SENESCENCE_TEMP_B',senescence_temp_b)
+
+      !Config Key   = SENESCENCE_TEMP_A
+      !Config Desc  = critical temperature for senescence (C), constant a of aT^2+bT+c , tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, 0., undef, 0., 0.,.00375, 0., 0., 0. 
+      !Config Help  =
+      !Config Units = [-] 
+      CALL getin_p('SENESCENCE_TEMP_A',senescence_temp_a)
+
+      !Config Key   = GDD_SENESCENCE
+      !Config Desc  = minimum gdd to allow senescence of crops  
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 950., 4000.
+      !Config Help  =
+      !Config Units = [days] 
+      CALL getin_p("GDD_SENESCENCE", gdd_senescence)
+
+      
+      !
+      ! DGVM
+      !
+
+      !Config Key   = RESIDENCE_TIME
+      !Config Desc  = residence time of trees
+      !Config if    = OK_DGVM and NOT(LPJ_GAP_CONST_MORT)
+      !Config Def   = undef, 30.0, 30.0, 40.0, 40.0, 40.0, 80.0, 80.0, 80.0, 0.0, 0.0, 0.0, 0.0 
+      !Config Help  =
+      !Config Units = [years]
+      CALL getin_p('RESIDENCE_TIME',residence_time)
+
+      !Config Key   = TMIN_CRIT
+      !Config Desc  = critical tmin, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef,  0.0, 0.0, -30.0, -14.0, -30.0, -45.0, -45.0, undef, undef, undef, undef, undef
+      !Config Help  = 
+      !Config Units = [C]
+      CALL getin_p('TMIN_CRIT',tmin_crit)
+
+      !Config Key   = TCM_CRIT
+      !Config Desc  = critical tcm, tabulated 
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, 5.0, 15.5, 15.5, -8.0, -8.0, -8.0, undef, undef, undef, undef
+      !Config Help  =
+      !Config Units = [C]
+      CALL getin_p('TCM_CRIT',tcm_crit)
+      
+      first_call = .FALSE.
+       
+   ENDIF !(first_call)
+  
+ END SUBROUTINE config_stomate_pft_parameters
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_clear
+!!
+!>\BRIEF         This subroutine deallocates memory at the end of the simulation. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE pft_parameters_clear
+   
+   l_first_pft_parameters = .TRUE.
+   
+   IF (ALLOCATED(pft_to_mtc)) DEALLOCATE(pft_to_mtc)
+   IF (ALLOCATED(PFT_name)) DEALLOCATE(PFT_name)
+   IF (ALLOCATED(veget_ori_fixed_test_1)) DEALLOCATE(veget_ori_fixed_test_1)   
+   IF (ALLOCATED(llaimax)) DEALLOCATE(llaimax)
+   IF (ALLOCATED(llaimin)) DEALLOCATE(llaimin)
+   IF (ALLOCATED(height_presc)) DEALLOCATE(height_presc)   
+   IF (ALLOCATED(type_of_lai)) DEALLOCATE(type_of_lai)
+   IF (ALLOCATED(is_tree)) DEALLOCATE(is_tree)
+   IF (ALLOCATED(natural)) DEALLOCATE(natural)
+   IF (ALLOCATED(is_deciduous)) DEALLOCATE(is_deciduous)
+   IF (ALLOCATED(is_evergreen)) DEALLOCATE(is_evergreen)
+   IF (ALLOCATED(is_needleleaf)) DEALLOCATE(is_needleleaf)
+   IF (ALLOCATED(is_tropical)) DEALLOCATE(is_tropical)
+   IF (ALLOCATED(humcste)) DEALLOCATE(humcste)
+   IF (ALLOCATED(pref_soil_veg)) DEALLOCATE(pref_soil_veg)
+   IF (ALLOCATED(is_c4)) DEALLOCATE(is_c4)  
+   IF (ALLOCATED(vcmax_fix)) DEALLOCATE(vcmax_fix)
+   IF (ALLOCATED(downregulation_co2_coeff)) DEALLOCATE(downregulation_co2_coeff) 
+   IF (ALLOCATED(E_KmC)) DEALLOCATE(E_KmC)
+   IF (ALLOCATED(E_KmO)) DEALLOCATE(E_KmO)
+   IF (ALLOCATED(E_gamma_star)) DEALLOCATE(E_gamma_star)
+   IF (ALLOCATED(E_Vcmax)) DEALLOCATE(E_Vcmax)
+   IF (ALLOCATED(E_Jmax)) DEALLOCATE(E_Jmax)
+   IF (ALLOCATED(aSV)) DEALLOCATE(aSV)
+   IF (ALLOCATED(bSV)) DEALLOCATE(bSV)
+   IF (ALLOCATED(tphoto_min)) DEALLOCATE(tphoto_min)
+   IF (ALLOCATED(tphoto_max)) DEALLOCATE(tphoto_max)
+   IF (ALLOCATED(aSJ)) DEALLOCATE(aSJ)
+   IF (ALLOCATED(bSJ)) DEALLOCATE(bSJ)
+   IF (ALLOCATED(D_Vcmax)) DEALLOCATE(D_Vcmax)
+   IF (ALLOCATED(D_Jmax)) DEALLOCATE(D_Jmax)
+   IF (ALLOCATED(E_Rd)) DEALLOCATE(E_Rd)
+   IF (ALLOCATED(Vcmax25)) DEALLOCATE(Vcmax25)
+   IF (ALLOCATED(arJV)) DEALLOCATE(arJV)
+   IF (ALLOCATED(brJV)) DEALLOCATE(brJV)
+   IF (ALLOCATED(KmC25)) DEALLOCATE(KmC25)
+   IF (ALLOCATED(KmO25)) DEALLOCATE(KmO25)
+   IF (ALLOCATED(gamma_star25)) DEALLOCATE(gamma_star25)
+   IF (ALLOCATED(a1)) DEALLOCATE(a1)
+   IF (ALLOCATED(b1)) DEALLOCATE(b1)
+   IF (ALLOCATED(g0)) DEALLOCATE(g0)
+   IF (ALLOCATED(h_protons)) DEALLOCATE(h_protons)
+   IF (ALLOCATED(fpsir)) DEALLOCATE(fpsir)
+   IF (ALLOCATED(fQ)) DEALLOCATE(fQ)
+   IF (ALLOCATED(fpseudo)) DEALLOCATE(fpseudo)
+   IF (ALLOCATED(kp)) DEALLOCATE(kp)
+   IF (ALLOCATED(alpha)) DEALLOCATE(alpha)
+   IF (ALLOCATED(gbs)) DEALLOCATE(gbs)
+   IF (ALLOCATED(theta)) DEALLOCATE(theta)
+   IF (ALLOCATED(alpha_LL)) DEALLOCATE(alpha_LL)
+   IF (ALLOCATED(ext_coeff)) DEALLOCATE(ext_coeff)
+   IF (ALLOCATED(rveg_pft)) DEALLOCATE(rveg_pft)
+   IF (ALLOCATED(rstruct_const)) DEALLOCATE(rstruct_const)
+   IF (ALLOCATED(kzero)) DEALLOCATE(kzero)
+   IF (ALLOCATED(wmax_veg)) DEALLOCATE(wmax_veg)
+   IF (ALLOCATED(throughfall_by_pft)) DEALLOCATE(throughfall_by_pft)
+   IF (ALLOCATED(snowa_aged)) DEALLOCATE(snowa_aged)
+   IF (ALLOCATED(snowa_dec)) DEALLOCATE(snowa_dec)
+   IF (ALLOCATED(alb_leaf_vis)) DEALLOCATE(alb_leaf_vis)
+   IF (ALLOCATED(alb_leaf_nir)) DEALLOCATE(alb_leaf_nir)   
+   IF (ALLOCATED(em_factor_isoprene)) DEALLOCATE(em_factor_isoprene)
+   IF (ALLOCATED(em_factor_monoterpene)) DEALLOCATE(em_factor_monoterpene)
+   IF (ALLOCATED(em_factor_apinene)) DEALLOCATE(em_factor_apinene)
+   IF (ALLOCATED(em_factor_bpinene)) DEALLOCATE(em_factor_bpinene)
+   IF (ALLOCATED(em_factor_limonene)) DEALLOCATE(em_factor_limonene)
+   IF (ALLOCATED(em_factor_myrcene)) DEALLOCATE(em_factor_myrcene)
+   IF (ALLOCATED(em_factor_sabinene)) DEALLOCATE(em_factor_sabinene)
+   IF (ALLOCATED(em_factor_camphene)) DEALLOCATE(em_factor_camphene)
+   IF (ALLOCATED(em_factor_3carene)) DEALLOCATE(em_factor_3carene)
+   IF (ALLOCATED(em_factor_tbocimene)) DEALLOCATE(em_factor_tbocimene)
+   IF (ALLOCATED(em_factor_othermonot)) DEALLOCATE(em_factor_othermonot)
+   IF (ALLOCATED(em_factor_sesquiterp)) DEALLOCATE(em_factor_sesquiterp)
+   IF (ALLOCATED(em_factor_ORVOC)) DEALLOCATE(em_factor_ORVOC)
+   IF (ALLOCATED(em_factor_OVOC)) DEALLOCATE(em_factor_OVOC)
+   IF (ALLOCATED(em_factor_MBO)) DEALLOCATE(em_factor_MBO)
+   IF (ALLOCATED(em_factor_methanol)) DEALLOCATE(em_factor_methanol)
+   IF (ALLOCATED(em_factor_acetone)) DEALLOCATE(em_factor_acetone)
+   IF (ALLOCATED(em_factor_acetal)) DEALLOCATE(em_factor_acetal)
+   IF (ALLOCATED(em_factor_formal)) DEALLOCATE(em_factor_formal)
+   IF (ALLOCATED(em_factor_acetic)) DEALLOCATE(em_factor_acetic)
+   IF (ALLOCATED(em_factor_formic)) DEALLOCATE(em_factor_formic)
+   IF (ALLOCATED(em_factor_no_wet)) DEALLOCATE(em_factor_no_wet)
+   IF (ALLOCATED(em_factor_no_dry)) DEALLOCATE(em_factor_no_dry)
+   IF (ALLOCATED(Larch)) DEALLOCATE(Larch)
+   IF (ALLOCATED(leaf_tab)) DEALLOCATE(leaf_tab)
+   IF (ALLOCATED(sla)) DEALLOCATE(sla)
+   IF (ALLOCATED(availability_fact)) DEALLOCATE(availability_fact)
+   IF (ALLOCATED(R0)) DEALLOCATE(R0)
+   IF (ALLOCATED(S0)) DEALLOCATE(S0)
+   IF (ALLOCATED(L0)) DEALLOCATE(L0)
+   IF (ALLOCATED(frac_growthresp)) DEALLOCATE(frac_growthresp)
+   IF (ALLOCATED(maint_resp_slope)) DEALLOCATE(maint_resp_slope)
+   IF (ALLOCATED(maint_resp_slope_c)) DEALLOCATE(maint_resp_slope_c)
+   IF (ALLOCATED(maint_resp_slope_b)) DEALLOCATE(maint_resp_slope_b)
+   IF (ALLOCATED(maint_resp_slope_a)) DEALLOCATE(maint_resp_slope_a)
+   IF (ALLOCATED(coeff_maint_zero)) DEALLOCATE(coeff_maint_zero)
+   IF (ALLOCATED(cm_zero_leaf)) DEALLOCATE(cm_zero_leaf)
+   IF (ALLOCATED(cm_zero_sapabove)) DEALLOCATE(cm_zero_sapabove)
+   IF (ALLOCATED(cm_zero_sapbelow)) DEALLOCATE(cm_zero_sapbelow)
+   IF (ALLOCATED(cm_zero_heartabove)) DEALLOCATE(cm_zero_heartabove)
+   IF (ALLOCATED(cm_zero_heartbelow)) DEALLOCATE(cm_zero_heartbelow)
+   IF (ALLOCATED(cm_zero_root)) DEALLOCATE(cm_zero_root)
+   IF (ALLOCATED(cm_zero_fruit)) DEALLOCATE(cm_zero_fruit)
+   IF (ALLOCATED(cm_zero_carbres)) DEALLOCATE(cm_zero_carbres)
+   IF (ALLOCATED(flam)) DEALLOCATE(flam)
+   IF (ALLOCATED(resist)) DEALLOCATE(resist)
+   IF (ALLOCATED(coeff_lcchange_1)) DEALLOCATE(coeff_lcchange_1)
+   IF (ALLOCATED(coeff_lcchange_10)) DEALLOCATE(coeff_lcchange_10)
+   IF (ALLOCATED(coeff_lcchange_100)) DEALLOCATE(coeff_lcchange_100)
+   IF (ALLOCATED(lai_max_to_happy)) DEALLOCATE(lai_max_to_happy)
+   IF (ALLOCATED(lai_max)) DEALLOCATE(lai_max)
+   IF (ALLOCATED(pheno_model)) DEALLOCATE(pheno_model)
+   IF (ALLOCATED(pheno_type)) DEALLOCATE(pheno_type)
+   IF (ALLOCATED(pheno_gdd_crit_c)) DEALLOCATE(pheno_gdd_crit_c)
+   IF (ALLOCATED(pheno_gdd_crit_b)) DEALLOCATE(pheno_gdd_crit_b)
+   IF (ALLOCATED(pheno_gdd_crit_a)) DEALLOCATE(pheno_gdd_crit_a)
+   IF (ALLOCATED(pheno_gdd_crit)) DEALLOCATE(pheno_gdd_crit)
+   IF (ALLOCATED(pheno_moigdd_t_crit)) DEALLOCATE(pheno_moigdd_t_crit)
+   IF (ALLOCATED(ngd_crit)) DEALLOCATE(ngd_crit)
+   IF (ALLOCATED(ncdgdd_temp)) DEALLOCATE(ncdgdd_temp)
+   IF (ALLOCATED(hum_frac)) DEALLOCATE(hum_frac)
+   IF (ALLOCATED(hum_min_time)) DEALLOCATE(hum_min_time)
+   IF (ALLOCATED(tau_sap)) DEALLOCATE(tau_sap)
+   IF (ALLOCATED(tau_leafinit)) DEALLOCATE(tau_leafinit)
+   IF (ALLOCATED(tau_fruit)) DEALLOCATE(tau_fruit)
+   IF (ALLOCATED(ecureuil)) DEALLOCATE(ecureuil)
+   IF (ALLOCATED(alloc_min)) DEALLOCATE(alloc_min)
+   IF (ALLOCATED(alloc_max)) DEALLOCATE(alloc_max)
+   IF (ALLOCATED(demi_alloc)) DEALLOCATE(demi_alloc)
+   IF (ALLOCATED(leaflife_tab)) DEALLOCATE(leaflife_tab)
+   IF (ALLOCATED(leaffall)) DEALLOCATE(leaffall)
+   IF (ALLOCATED(leafagecrit)) DEALLOCATE(leafagecrit)
+   IF (ALLOCATED(senescence_type)) DEALLOCATE(senescence_type)
+   IF (ALLOCATED(senescence_hum)) DEALLOCATE(senescence_hum)
+   IF (ALLOCATED(nosenescence_hum)) DEALLOCATE(nosenescence_hum)
+   IF (ALLOCATED(max_turnover_time)) DEALLOCATE(max_turnover_time)
+   IF (ALLOCATED(min_turnover_time)) DEALLOCATE(min_turnover_time)
+   IF (ALLOCATED(min_leaf_age_for_senescence)) DEALLOCATE(min_leaf_age_for_senescence)
+   IF (ALLOCATED(senescence_temp_c)) DEALLOCATE(senescence_temp_c)
+   IF (ALLOCATED(senescence_temp_b)) DEALLOCATE(senescence_temp_b)
+   IF (ALLOCATED(senescence_temp_a)) DEALLOCATE(senescence_temp_a)
+   IF (ALLOCATED(senescence_temp)) DEALLOCATE(senescence_temp)
+   IF (ALLOCATED(gdd_senescence)) DEALLOCATE(gdd_senescence)
+   IF (ALLOCATED(residence_time)) DEALLOCATE(residence_time)
+   IF (ALLOCATED(tmin_crit)) DEALLOCATE(tmin_crit)
+   IF (ALLOCATED(tcm_crit)) DEALLOCATE(tcm_crit)
+   IF (ALLOCATED(lai_initmin)) DEALLOCATE(lai_initmin)
+   IF (ALLOCATED(bm_sapl)) DEALLOCATE(bm_sapl)
+   IF (ALLOCATED(migrate)) DEALLOCATE(migrate)
+   IF (ALLOCATED(maxdia)) DEALLOCATE(maxdia)
+   IF (ALLOCATED(cn_sapl)) DEALLOCATE(cn_sapl)
+   IF (ALLOCATED(leaf_timecst)) DEALLOCATE(leaf_timecst)
+   
+ END SUBROUTINE pft_parameters_clear
+
+END MODULE pft_parameters
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/pft_parameters_var.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/pft_parameters_var.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/pft_parameters_var.f90	(revision 5166)
@@ -0,0 +1,655 @@
+! =================================================================================================================================
+! MODULE       : pft_parameters_var
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module contains the variables in function of plant funtional type (pft).
+!!
+!!\n DESCRIPTION: This module contains the declarations for the externalized variables in function of the 
+!!                plant foncional type(pft). \n
+!!                The module is already USE in module pft_parameters. Therefor no need to USE it seperatly except
+!!                if the subroutines in module pft_parameters are not needed.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE pft_parameters_var
+
+  USE defprec
+  
+  IMPLICIT NONE
+
+
+  !
+  ! PFT GLOBAL
+  !
+  INTEGER(i_std), SAVE :: nvm = 13                               !! Number of vegetation types (2-N, unitless)
+!$OMP THREADPRIVATE(nvm)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pft_to_mtc  !! Table of conversion : we associate one pft to one metaclass 
+                                                                 !! (1-13, unitless)
+!$OMP THREADPRIVATE(pft_to_mtc)
+
+  CHARACTER(LEN=34), ALLOCATABLE, SAVE, DIMENSION(:) :: PFT_name !! Description of the PFT (unitless)
+!$OMP THREADPRIVATE(PFT_name)
+
+  LOGICAL, SAVE   :: l_first_pft_parameters = .TRUE.             !! To keep first call trace of the module (true/false)
+!$OMP THREADPRIVATE(l_first_pft_parameters)
+
+  !
+  ! VEGETATION STRUCTURE
+  !
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaf_tab       !! leaf type (1-4, unitless)
+                                                                    !! 1=broad leaved tree, 2=needle leaved tree, 
+                                                                    !! 3=grass 4=bare ground 
+!$OMP THREADPRIVATE(leaf_tab)
+
+  CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_model  !! which phenology model is used? (tabulated) (unitless)
+!$OMP THREADPRIVATE(pheno_model)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_tree               !! Is the vegetation type a tree ? (true/false)
+!$OMP THREADPRIVATE(is_tree)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_deciduous          !! Is PFT deciduous ? (true/false)
+!$OMP THREADPRIVATE(is_deciduous)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_evergreen          !! Is PFT evegreen ? (true/false)
+!$OMP THREADPRIVATE(is_evergreen)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_needleleaf         !! Is PFT needleleaf ? (true/false)
+!$OMP THREADPRIVATE(is_needleleaf)
+ 
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_tropical           !! Is PFT tropical ? (true/false)
+!$OMP THREADPRIVATE(is_tropical)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: natural               !! natural? (true/false)
+!$OMP THREADPRIVATE(natural)
+
+  CHARACTER(len=5), ALLOCATABLE, SAVE, DIMENSION(:) :: type_of_lai  !! Type of behaviour of the LAI evolution algorithm 
+                                                                    !! for each vegetation type.
+                                                                    !! Value of type_of_lai, one for each vegetation type :
+                                                                    !! mean or interp
+!$OMP THREADPRIVATE(type_of_lai)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: veget_ori_fixed_test_1 !! Value for veget_ori for tests in 0-dim simulations 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(veget_ori_fixed_test_1)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: llaimax                !! laimax for maximum lai see also type of lai 
+                                                                         !! interpolation
+                                                                         !! @tex $(m^2.m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(llaimax)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: llaimin                !! laimin for minimum lai see also type of lai 
+                                                                         !! interpolation 
+                                                                         !! @tex $(m^2.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(llaimin)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: height_presc           !! prescribed height of vegetation.(m)
+                                                                         !! Value for height_presc : one for each vegetation type
+!$OMP THREADPRIVATE(height_presc)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) ::  rveg_pft              !! Potentiometer to set vegetation resistance (unitless)
+                                                                         !! Nathalie on March 28th, 2006 - from Fred Hourdin,
+!$OMP THREADPRIVATE(rveg_pft)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: sla                    !! specif leaf area @tex $(m^2.gC^{-1})$ @endtex 
+!$OMP THREADPRIVATE(sla)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: availability_fact      !! calculate dynamic mortality in lpj_gap
+!$OMP THREADPRIVATE(availability_fact)
+
+  !
+  ! EVAPOTRANSPIRATION (sechiba)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: rstruct_const          !! Structural resistance. 
+                                                                         !! Value for rstruct_const : one for each vegetation type
+                                                                         !! @tex $(s.m^{-1})$ @endtex
+!$OMP THREADPRIVATE(rstruct_const)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: kzero                  !! A vegetation dependent constant used in the calculation
+                                                                         !! of the surface resistance. 
+                                                                         !! Value for kzero one for each vegetation type
+                                                                         !! @tex $(kg.m^2.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(kzero)
+
+  !
+  ! WATER (sechiba)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: wmax_veg  !! Volumetric available soil water capacity in each PFT
+                                                            !! @tex $(kg.m^{-3} of soil)$ @endtex
+!$OMP THREADPRIVATE(wmax_veg)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: humcste   !! Root profile description for the different vegetation types.
+                                                            !! These are the factor in the exponential which gets
+                                                            !! the root density as a function of depth 
+                                                            !! @tex $(m^{-1})$ @endtex
+!$OMP THREADPRIVATE(humcste)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: throughfall_by_pft !! Fraction of rain intercepted by the canopy (0-100, unitless)
+!$OMP THREADPRIVATE(throughfall_by_pft)
+
+  !
+  ! ALBEDO (sechiba)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_aged    !! Minimum snow albedo value for each vegetation type
+                                                                !! after aging (dirty old snow) (unitless)
+                                                                !! Source : Values are from the Thesis of S. Chalita (1992)
+!$OMP THREADPRIVATE(snowa_aged)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_dec     !! Decay rate of snow albedo value for each vegetation type
+                                                                !! as it will be used in condveg_snow (unitless)
+                                                                !! Source : Values are from the Thesis of S. Chalita (1992)
+!$OMP THREADPRIVATE(snowa_dec)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alb_leaf_vis  !! leaf albedo of vegetation type, visible albedo (unitless)
+!$OMP THREADPRIVATE(alb_leaf_vis)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alb_leaf_nir  !! leaf albedo of vegetation type, near infrared albedo (unitless)
+!$OMP THREADPRIVATE(alb_leaf_nir)
+
+  !
+  ! SOIL - VEGETATION
+  !
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pref_soil_veg      !! Table which contains the correlation between the soil
+                                                                        !! types and vegetation type. Two modes exist :
+                                                                        !! 1) pref_soil_veg = 0 then we have an equidistribution
+                                                                        !!    of vegetation on soil types
+                                                                        !! 2) Else for each pft the prefered soil type is given :
+                                                                        !!    1=sand, 2=loan, 3=clay
+                                                                        !! This variable is initialized in slowproc.(1-3, unitless)
+!$OMP THREADPRIVATE(pref_soil_veg)
+
+  !
+  ! PHOTOSYNTHESIS
+  !
+  !-
+  ! 1. CO2
+  !-
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_c4             !! flag for C4 vegetation types (true/false)
+!$OMP THREADPRIVATE(is_c4)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: vcmax_fix     !! values used for vcmax when STOMATE is not activated
+                                                                !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(vcmax_fix)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: downregulation_co2_coeff !! Coefficient for CO2 downregulation (unitless)
+!$OMP THREADPRIVATE(downregulation_co2_coeff)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_KmC         !! Energy of activation for KmC (J mol-1)
+!$OMP THREADPRIVATE(E_KmC)                                                               
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_KmO         !! Energy of activation for KmO (J mol-1)
+!$OMP THREADPRIVATE(E_KmO)          
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_gamma_star  !! Energy of activation for gamma_star (J mol-1)
+!$OMP THREADPRIVATE(E_gamma_star)    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_Vcmax       !! Energy of activation for Vcmax (J mol-1) 
+!$OMP THREADPRIVATE(E_Vcmax)                                                              
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_Jmax        !! Energy of activation for Jmax (J mol-1)
+!$OMP THREADPRIVATE(E_Jmax) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: aSV           !! a coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax (J K-1 mol-1)
+!$OMP THREADPRIVATE(aSV)    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: bSV           !! b coefficient of the linear regression (a+bT) defining the Entropy term for Vcmax (J K-1 mol-1 Â°C-1)
+!$OMP THREADPRIVATE(bSV)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_min   !! minimum photosynthesis temperature (deg C)
+!$OMP THREADPRIVATE(tphoto_min) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_max   !! maximum photosynthesis temperature (deg C)
+!$OMP THREADPRIVATE(tphoto_max) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: aSJ           !! a coefficient of the linear regression (a+bT) defining the Entropy term for Jmax (J K-1 mol-1)
+!$OMP THREADPRIVATE(aSJ)    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: bSJ           !! b coefficient of the linear regression (a+bT) defining the Entropy term for Jmax (J K-1 mol-1 Â°C-1)
+!$OMP THREADPRIVATE(bSJ)    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: D_Vcmax       !! Energy of deactivation for Vcmax (J mol-1)
+!$OMP THREADPRIVATE(D_Vcmax)                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: D_Jmax        !! Energy of deactivation for Jmax (J mol-1)
+!$OMP THREADPRIVATE(D_Jmax)                                    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: E_Rd          !! Energy of activation for Rd (J mol-1)
+!$OMP THREADPRIVATE(E_Rd)                                      
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: Vcmax25       !! Maximum rate of Rubisco activity-limited carboxylation at 25Â°C
+                                                                !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(Vcmax25)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: arJV          !! a coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio (mu mol e- (mu mol CO2)-1)
+!$OMP THREADPRIVATE(arJV)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: brJV          !! b coefficient of the linear regression (a+bT) defining the Jmax25/Vcmax25 ratio (mu mol e- (mu mol CO2)-1)
+!$OMP THREADPRIVATE(brJV)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: KmC25         !! MichaelisâMenten constant of Rubisco for CO2 at 25Â°C (ubar)
+!$OMP THREADPRIVATE(KmC25)                                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: KmO25         !! MichaelisâMenten constant of Rubisco for O2 at 25Â°C (ubar)
+!$OMP THREADPRIVATE(KmO25)                
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gamma_star25  !! Ci-based CO2 compensation point in the absence of Rd at 25Â°C (ubar)
+!$OMP THREADPRIVATE(gamma_star25)       
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: a1            !! Empirical factor involved in the calculation of fvpd (-)
+!$OMP THREADPRIVATE(a1)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: b1            !! Empirical factor involved in the calculation of fvpd (-)
+!$OMP THREADPRIVATE(b1)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: g0            !! Residual stomatal conductance when irradiance approaches zero (mol mâ2 sâ1 barâ1)
+!$OMP THREADPRIVATE(g0)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: h_protons     !! Number of protons required to produce one ATP (mol mol-1)
+!$OMP THREADPRIVATE(h_protons)                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fpsir         !! Fraction of PSII eâ transport rate partitioned to the C4 cycle (-)
+!$OMP THREADPRIVATE(fpsir)                                         
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fQ            !! Fraction of electrons at reduced plastoquinone that follow the Q-cycle (-) - Values for C3 platns are not used
+!$OMP THREADPRIVATE(fQ)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: fpseudo       !! Fraction of electrons at PSI that follow  pseudocyclic transport (-) - Values for C3 platns are not used
+!$OMP THREADPRIVATE(fpseudo)                                   
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: kp            !! Initial carboxylation efficiency of the PEP carboxylase (mol mâ2 sâ1 barâ1) 
+!$OMP THREADPRIVATE(kp)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alpha         !! Fraction of PSII activity in the bundle sheath (-)
+!$OMP THREADPRIVATE(alpha)                                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gbs           !! Bundle-sheath conductance (mol mâ2 sâ1 barâ1)
+!$OMP THREADPRIVATE(gbs)                                       
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: theta         !! Convexity factor for response of J to irradiance (-)
+!$OMP THREADPRIVATE(theta)                                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alpha_LL      !! Conversion efficiency of absorbed light into J at strictly limiting light (mol eâ (mol photon)â1)
+!$OMP THREADPRIVATE(alpha_LL)
+
+
+  !-
+  ! 2. Stomate
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ext_coeff     !! extinction coefficient of the Monsi&Saeki relationship (1953)
+                                                                !! (unitless)
+!$OMP THREADPRIVATE(ext_coeff)
+
+
+  !
+  ! ALLOCATION (stomate)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: R0            !! Default root allocation (0-1, unitless)
+!$OMP THREADPRIVATE(R0)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: S0            !! Default sapwood allocation (0-1, unitless)
+!$OMP THREADPRIVATE(S0)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: L0            !! Default leaf allocation (0-1, unitless)
+!$OMP THREADPRIVATE(L0)
+
+
+  !
+  ! RESPIRATION (stomate)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: frac_growthresp  !! fraction of GPP which is lost as growth respiration
+
+!$OMP THREADPRIVATE(frac_growthresp)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: maint_resp_slope  !! slope of maintenance respiration coefficient 
+                                                                      !! (1/K, 1/K^2, 1/K^3), used in the code
+!$OMP THREADPRIVATE(maint_resp_slope)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_c  !! slope of maintenance respiration coefficient (1/K),
+                                                                      !! constant c of aT^2+bT+c , tabulated
+!$OMP THREADPRIVATE(maint_resp_slope_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_b  !! slope of maintenance respiration coefficient (1/K), 
+                                                                      !! constant b of aT^2+bT+c , tabulated
+!$OMP THREADPRIVATE(maint_resp_slope_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_a  !! slope of maintenance respiration coefficient (1/K), 
+                                                                      !! constant a of aT^2+bT+c , tabulated
+!$OMP THREADPRIVATE(maint_resp_slope_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: coeff_maint_zero  !! maintenance respiration coefficient at 0 deg C, 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(coeff_maint_zero)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_leaf        !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for leaves, tabulated 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_leaf)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_sapabove    !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for sapwood above, tabulated
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_sapabove)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_sapbelow    !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for sapwood below, tabulated 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_sapbelow)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_heartabove  !! maintenance respiration coefficient at 0 deg C
+                                                                      !! for heartwood above, tabulated 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_heartabove)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_heartbelow  !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for heartwood below, tabulated 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_heartbelow)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_root        !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for roots, tabulated
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_root)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_fruit       !! maintenance respiration coefficient  at 0 deg C,
+                                                                      !! for fruits, tabulated
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_fruit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_carbres     !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for carbohydrate reserve, tabulated
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_carbres)
+
+ 
+  !
+  ! FIRE (stomate)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: flam              !! flamability : critical fraction of water holding 
+                                                                    !! capacity (0-1, unitless)
+!$OMP THREADPRIVATE(flam)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: resist            !! fire resistance (0-1, unitless)
+!$OMP THREADPRIVATE(resist)
+
+
+  !
+  ! FLUX - LUC (Land Use Change)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_1   !! Coeff of biomass export for the year (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_1)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_10  !! Coeff of biomass export for the decade (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_10)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_100 !! Coeff of biomass export for the century (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_100)
+ 
+ 
+  !
+  ! PHENOLOGY
+  !
+  !-
+  ! 1. Stomate
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_max_to_happy  !! threshold of LAI below which plant uses carbohydrate reserves
+!$OMP THREADPRIVATE(lai_max_to_happy)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_max           !! maximum LAI, PFT-specific @tex $(m^2.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(lai_max)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_type     !! type of phenology (0-4, unitless)
+                                                                    !! 0=bare ground 1=evergreen,  2=summergreen, 
+                                                                    !! 3=raingreen,  4=perennial
+                                                                    !! For the moment, the bare ground phenotype is not managed, 
+                                                                    !! so it is considered as "evergreen"
+!$OMP THREADPRIVATE(pheno_type)
+
+  !-
+  ! 2. Leaf Onset
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: pheno_gdd_crit   !! critical gdd,tabulated (C), used in the code
+!$OMP THREADPRIVATE(pheno_gdd_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_c   !! critical gdd,tabulated (C), 
+                                                                     !! constant c of aT^2+bT+c (unitless)
+!$OMP THREADPRIVATE(pheno_gdd_crit_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_b   !! critical gdd,tabulated (C), 
+                                                                     !! constant b of aT^2+bT+c (unitless)
+!$OMP THREADPRIVATE(pheno_gdd_crit_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_a   !! critical gdd,tabulated (C), 
+                                                                     !! constant a of aT^2+bT+c (unitless)
+!$OMP THREADPRIVATE(pheno_gdd_crit_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_moigdd_t_crit!! Monthly avearage temperature treashold used for C4 grass (C)
+!$OMP THREADPRIVATE(pheno_moigdd_t_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ngd_crit           !! critical ngd,tabulated. Threshold -5 degrees (days)
+!$OMP THREADPRIVATE(ngd_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ncdgdd_temp        !! critical temperature for the ncd vs. gdd function
+                                                                     !! in phenology (C)
+!$OMP THREADPRIVATE(ncdgdd_temp)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: hum_frac           !! critical humidity (relative to min/max) for phenology
+                                                                     !! (0-1, unitless)
+!$OMP THREADPRIVATE(hum_frac)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: hum_min_time       !! minimum time elapsed since moisture minimum (days)
+!$OMP THREADPRIVATE(hum_min_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_sap            !! sapwood -> heartwood conversion time (days)
+!$OMP THREADPRIVATE(tau_sap)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_fruit          !! fruit lifetime (days)
+!$OMP THREADPRIVATE(tau_fruit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_leafinit  !! time to attain the initial foliage using the carbohydrate reserve
+!$OMP THREADPRIVATE(tau_leafinit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ecureuil           !! fraction of primary leaf and root allocation put
+                                                                     !! into reserve (0-1, unitless)
+!$OMP THREADPRIVATE(ecureuil)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alloc_min          !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+!$OMP THREADPRIVATE(alloc_min)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alloc_max          !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+!$OMP THREADPRIVATE(alloc_max)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: demi_alloc         !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+!$OMP THREADPRIVATE(demi_alloc)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaflife_tab       !! leaf longevity, tabulated (??units??)
+!$OMP THREADPRIVATE(leaflife_tab)
+
+  !-
+  ! 3. Senescence
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaffall              !! length of death of leaves,tabulated (days)
+!$OMP THREADPRIVATE(leaffall)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leafagecrit           !! critical leaf age,tabulated (days)
+!$OMP THREADPRIVATE(leafagecrit)
+
+  CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_type  !! type of senescence,tabulated (unitless)
+                                                                        !! List of avaible types of senescence :
+                                                                        !! 'cold  ', 'dry   ', 'mixed ', 'none  '
+!$OMP THREADPRIVATE(senescence_type)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_hum        !! critical relative moisture availability for senescence
+                                                                        !! (0-1, unitless)
+!$OMP THREADPRIVATE(senescence_hum)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: nosenescence_hum      !! relative moisture availability above which there is
+                                                                        !! no humidity-related senescence (0-1, unitless)
+!$OMP THREADPRIVATE(nosenescence_hum)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: max_turnover_time     !! maximum turnover time for grasses (days)
+!$OMP THREADPRIVATE(max_turnover_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: min_turnover_time     !! minimum turnover time for grasses (days)
+!$OMP THREADPRIVATE(min_turnover_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: min_leaf_age_for_senescence  !! minimum leaf age to allow senescence g (days)
+!$OMP THREADPRIVATE(min_leaf_age_for_senescence)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: senescence_temp     !! critical temperature for senescence (C),
+                                                                        !! used in the code
+!$OMP THREADPRIVATE(senescence_temp)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_c     !! critical temperature for senescence (C), 
+                                                                        !! constant c of aT^2+bT+c , tabulated (unitless)
+!$OMP THREADPRIVATE(senescence_temp_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_b     !! critical temperature for senescence (C), 
+                                                                        !! constant b of aT^2+bT+c , tabulated (unitless)
+!$OMP THREADPRIVATE(senescence_temp_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_a     !! critical temperature for senescence (C),
+                                                                        !! constant a of aT^2+bT+c , tabulated (unitless)
+!$OMP THREADPRIVATE(senescence_temp_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gdd_senescence        !! minimum gdd to allow senescence of crops (days)
+!$OMP THREADPRIVATE(gdd_senescence)
+
+  !
+  ! DGVM
+  !
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: residence_time        !! residence time of trees (y) 
+!$OMP THREADPRIVATE(residence_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmin_crit             !! critical tmin, tabulated (C)
+!$OMP THREADPRIVATE(tmin_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tcm_crit              !! critical tcm, tabulated (C)
+!$OMP THREADPRIVATE(tcm_crit)
+
+  !
+  ! Biogenic Volatile Organic Compounds
+  !
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_isoprene       !! Isoprene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_isoprene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_monoterpene    !! Monoterpene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_monoterpene)
+
+  REAL(r_std), SAVE :: LDF_mono                                            !! monoterpenes fraction dependancy to light
+!$OMP THREADPRIVATE(LDF_mono) 
+  REAL(r_std), SAVE :: LDF_sesq                                            !! sesquiterpenes fraction dependancy to light
+!$OMP THREADPRIVATE(LDF_sesq)
+  REAL(r_std), SAVE :: LDF_meth                                            !! methanol fraction dependancy to light
+!$OMP THREADPRIVATE(LDF_meth)
+  REAL(r_std), SAVE :: LDF_acet                                            !! acetone fraction dependancy to light
+!$OMP THREADPRIVATE(LDF_acet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_apinene        !! Alfa pinene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_apinene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_bpinene        !! Beta pinene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_bpinene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_limonene       !! Limonene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_limonene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_myrcene        !! Myrcene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_myrcene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_sabinene       !! Sabinene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_sabinene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_camphene       !! Camphene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_camphene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_3carene        !! 3-carene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_3carene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_tbocimene      !! T-beta-ocimene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_tbocimene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_othermonot     !! Other monoterpenes emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_othermonot)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_sesquiterp     !! Sesquiterpene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_sesquiterp)
+
+  REAL(r_std), SAVE :: beta_mono                                           !! Monoterpenes temperature dependency coefficient 
+!$OMP THREADPRIVATE(beta_mono)
+  REAL(r_std), SAVE :: beta_sesq                                           !! Sesquiterpenes temperature dependency coefficient
+!$OMP THREADPRIVATE(beta_sesq)
+  REAL(r_std), SAVE :: beta_meth                                           !! Methanol temperature dependency coefficient 
+!$OMP THREADPRIVATE(beta_meth)
+  REAL(r_std), SAVE :: beta_acet                                           !! Acetone temperature dependency coefficient
+!$OMP THREADPRIVATE(beta_acet)
+  REAL(r_std), SAVE :: beta_oxyVOC                                         !! Other oxygenated BVOC temperature dependency coefficient
+!$OMP THREADPRIVATE(beta_oxyVOC)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_ORVOC          !! ORVOC emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_ORVOC)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_OVOC           !! OVOC emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_OVOC)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_MBO            !! MBO emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_MBO)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_methanol       !! Methanol emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_methanol)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetone        !! Acetone emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_acetone)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetal         !! Acetaldehyde emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_acetal)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_formal         !! Formaldehyde emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_formal)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetic         !! Acetic Acid emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_acetic)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_formic         !! Formic Acid emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_formic)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_no_wet         !! NOx emissions factor soil emissions and 
+                                                                           !! exponential dependancy factor for wet soils
+                                                                           !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_no_wet)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_no_dry         !! NOx emissions factor soil emissions and
+                                                                           !! exponential dependancy factor for dry soils
+                                                                           !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_no_dry)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: Larch                    !! Larcher 1991 SAI/LAI ratio (unitless)
+!$OMP THREADPRIVATE(Larch)
+
+  !
+  ! INTERNAL PARAMETERS USED IN STOMATE_DATA
+  !
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_initmin   !! Initial lai for trees/grass 
+                                                                !! @tex $(m^2.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(lai_initmin)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bm_sapl   !! sapling biomass @tex $(gC.ind^{-1})$ @endtex
+!$OMP THREADPRIVATE(bm_sapl)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: migrate       !! migration speed @tex $(m.year^{-1})$ @endtex
+!$OMP THREADPRIVATE(migrate)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maxdia        !! maximum stem diameter from which on crown area no longer 
+                                                                !! increases (m)
+!$OMP THREADPRIVATE(maxdia)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cn_sapl       !! crown of tree when sapling  @tex $(m^2$)$ @endtex
+!$OMP THREADPRIVATE(cn_sapl)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaf_timecst  !! time constant for leaf age discretisation (days)
+!$OMP THREADPRIVATE(leaf_timecst)
+
+
+END MODULE pft_parameters_var
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/vertical_soil.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/vertical_soil.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/vertical_soil.f90	(revision 5166)
@@ -0,0 +1,456 @@
+MODULE vertical_soil
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+
+  USE defprec
+  USE ioipsl_para
+  USE vertical_soil_var
+
+  IMPLICIT NONE
+
+
+  PUBLIC :: vertical_soil_init
+
+CONTAINS
+!! ================================================================================================================================
+!! SUBROUTINE   : vertical_soil_init
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : To define the total number of layers 
+!!                for hydrology model (nslm),  
+!!                and for thermodynamics model ngrnd.
+!!
+!! We have 2 type of levels in the hydrology and the thermodynamics :
+!!  (1) the nodes where the scalar variables are computed.
+!!  (2) the intermediate levels: these are the bounds of the layers and thus the
+!!      contact point between layer i and i+1.
+!!
+!! Situation in hydrol.f90
+!!   The CWRR model only uses two variables to describe the vertical discretization :
+!!   (1) znh : the depth of the nodes where soil moisture is computed. The nodes are not
+!!     supposed to be in the middle of the layer. For the first and last layers the
+!!     nodes are put onto the intermediate level. At 0 for the first layer and
+!!     zmaxh for the last layer.
+!!   (2) dnh : the distance between two nodes
+!!
+!! Situation in thermosoil.f90 :
+!!   For the thermodynamics other variables are needed to describe the vertical structure :
+!!   (1) znt(znh) : the depth of the nodes are the same as in hydrol.f90 except for
+!!     the first and last levels. In older versions than revision XXXX of thermosoil it is 
+!!     computed with fz(i+1/2)
+!!   (2) zlt (Zint) (zz_coef in thermosoil) : is the depth of the intermediate levels. 
+!!     In revision before XXXX of thermosoil.f90 it's computed by fz(i). 
+!!     Since revision XXXX, in the new formulation (vertical.f90) it is computed as 
+!!     zint(i) = (znh(i)+znh(i+1))/2
+!!   (3) dlt(dz_tmp) (dz2 in thermosoil): This is the thickness of the layer, i.e the
+!!     distance between the top and bottom of the layer. Thus it is given by
+!!     zint(i+1)-zint(i). It should not be confused with dnh in hydrology which is the
+!!     distance between nodes.
+!!
+!! in standard hydrology model (de Rosnay Patricia, 2000; depth_topthickness = 9.77517107e-04, zmaxh=2.0, refinebottom = .FALSE.):
+!!
+!! Example for standard depth of the hydrology
+!! Number of layers in hydrol =  11
+!! znh = depth of nodes
+!! [  0.00000000e+00   1.95503421e-03   5.86510264e-03 1.36852395e-02
+!!    2.93255132e-02   6.06060606e-02   1.23167155e-01 2.48289345e-01
+!!    4.98533725e-01   9.99022483e-01   2.00000000e+00 ]
+!! dnh = internode distance
+!! [ 0.          0.00195503  0.00391007  0.00782014  0.01564027 0.03128055
+!!   0.06256109  0.12512219  0.25024438  0.50048876  1.00097752 ]
+!! dlh = soil layer thickness
+!! [ 0.00097752  0.00293255  0.0058651   0.01173021  0.02346041 0.04692082
+!!   0.09384164  0.18768328  0.37536657  0.75073314  0.50048876 ]
+!! hcum = depth of soil layer bottom
+!! [  9.77517107e-04   3.91006843e-03   9.77517107e-03 2.15053764e-02
+!!    4.49657869e-02   9.18866081e-02   1.85728250e-01 3.73411535e-01
+!!    7.48778104e-01   1.49951124e+00   2.00000000e+00 ]
+!!
+!!
+!! In thermal model (an example of: depth_topthickness = 9.77517107e-04, zmaxt=10, depth_geom=10, refinebottom = .FALSE.): 
+!! Number of layers in thermosoil =  19
+!! The approximate maximal depth for thermosoil =  10.0078201332
+!! The actual maximal depth for thermosoil =  10.0
+!! znt= 
+!! [ 4.88758554e-04   1.95503421e-03   5.86510264e-03 1.36852395e-02
+!!   2.93255132e-02   6.06060606e-02   1.23167155e-01 2.48289345e-01
+!!   4.98533725e-01   9.99022483e-01   1.74975562e+00 2.50048876e+00
+!!   3.50146627e+00   4.50244379e+00   5.50342131e+00 6.50439882e+00
+!!   7.50537634e+00   8.50635386e+00   9.50733137e+00 ]
+!! dlt= 
+!! [ 9.77517107e-04   2.93255132e-03   5.86510264e-03 1.17302053e-02
+!!   2.34604106e-02   4.69208211e-02   9.38416423e-02 1.87683285e-01
+!!   3.75366569e-01   7.50733138e-01   5.00488758e-01 1.00097752e+00
+!!   1.00097752e+00   1.00097752e+00   1.00097752e+00 1.00097752e+00
+!!   1.00097752e+00   1.00097752e+00   9.93157383e-01 ]
+!! zlt= 
+!! [ 9.77517107e-04   3.91006843e-03   9.77517107e-03 2.15053764e-02
+!!   4.49657869e-02   9.18866081e-02   1.85728250e-01 3.73411535e-01
+!!   7.48778104e-01   1.49951124e+00   2.00000000e+00 3.00097752e+00
+!!   4.00195503e+00   5.00293255e+00   6.00391007e+00 7.00488758e+00
+!!   8.00586510e+00   9.00684262e+00   1.00000000e+01 ]
+!!
+!!
+!! A simple figure below shows the discretization.                       ^
+!!   '------' means interface; 'X' means node; '...' means many layers;  | means distance. 
+!!                                                                       v
+!! Keep in mind that the nodes are not necessarly in the middle of the layers. 
+!! 
+!!           Hydrology                     Thermodynamics
+!!
+!!    --------X------- znh(1) ^           ------------------- 1st   zlt(1)  ^
+!!                           |                                                    |
+!!                           |                   X        znt(1)               |depth_topthickness, dlt(1)  
+!!                           |dnh(2)                                               |
+!!    -----------------      |           ------------------- 2nd   zlt(2)  v   ^
+!!                           |                                                        |
+!!            X        znh(2) v  ^                X        znt(2)                   |dlt(2) 
+!!                              |                                                     |
+!!    -----------------         |dnh(3)   ------------------- 3rd   zlt(3)      v
+!!                              | 
+!!            X        znh(3)    v                X        znt(3)
+!!
+!!    ----------------- ...              ------------------- ...
+!!
+!!                      ...                      X           ...
+!!
+!!    --------X------- znh(nslm)        ------------------- nslm     zlt(nslm)
+!!
+!!                                               X        znt(nslm)
+!!
+!!                                       ------------------- nslm+1   zlt(nslm+1)
+!!
+!!                                               X        znt(nslm+1)
+!! 
+!!                                       ------------------- ...
+!! 
+!!                                               X        znt(ngrnd)
+!!
+!!                                       ------------------- ngrnd    zlt(ngrnd)
+!!
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE vertical_soil_init
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Local variables
+    INTEGER(i_std), PARAMETER            :: nblayermax=500    !! Preset 500 for max. number of soil layers.
+    INTEGER(i_std)                       :: i, irev, iref, ntmp, ier
+    REAL(r_std)                          :: zgeoend           !! The node position where the geometrical increases of nodes stopped. (m)
+    REAL(r_std)                          :: dgeoend           !! The distance of the node at zgeoend and the node above. (m)
+    REAL(r_std)                          :: dcst              !! Related to refine at bottom. Work in progress...
+    REAL(r_std)                          :: cstint            !! Related to refine at bottom. Work in progress...
+    REAL(r_std)                          :: hh                !! Temporay variable, to calculate the layer thickness for temperature at zmaxh. 
+    REAL(r_std)                          :: ratio             !! The ratio of geometric increas.
+    INTEGER(i_std)                       :: nbrefine          !! Related to refine at bottom. Work in progress...
+    INTEGER(i_std)                       :: nbcst             !! Related to refine at bottom. Work in progress...
+    INTEGER(i_std)                       :: igeo              !! Related to refine at bottom. Work in progress...
+    REAL(r_std), DIMENSION(nblayermax+1) :: ztmp              !! Depth at the node of each layer (m)
+    REAL(r_std), DIMENSION(nblayermax+1) :: zint              !! Depth at the interface of each layer (m)
+    REAL(r_std), DIMENSION(nblayermax+1) :: dtmp              !! Distance between the current node and the one above (m)
+    REAL(r_std), DIMENSION(nblayermax+1) :: drefine           !! Related to refine at bottom. Work in progress...
+    INTEGER(i_std), DIMENSION(1)         :: imin              !! Related to refine at bottom. Work in progress...
+
+    !! Variables controling the vertical discretiztaion
+    REAL(r_std)                          :: depth_topthickness   !! Thickness of the top Layer (m)
+    REAL(r_std)                          :: depth_cstthickness   !! Depth at which constant layer thickness start (m)
+    REAL(r_std)                          :: depth_geom           !! Depth at which we resume geometrical increases for temperature (m)
+    REAL(r_std)                          :: ratio_geom_below     !! Ratio of the geometrical series defining the thickness below DEPTH_GEOM.
+    LOGICAL                              :: refinebottom         !! Whether or not the hydrology layers will be refined towards the bottom.
+
+    
+    !! 1. Read parameters from run.def file
+    
+    !Config Key   = DEPTH_MAX_T
+    !Config Desc  = Maximum depth of the soil thermodynamics
+    !Config If    = 
+    !Config Def   = 10.0
+    !Config Help  = Maximum depth of soil for temperature.
+    !Config Units = m
+    zmaxt = 10.0
+    CALL getin_p("DEPTH_MAX_T",zmaxt)
+    
+    !Config Key   = DEPTH_MAX_H
+    !Config Desc  = Maximum depth of soil moisture
+    !Config If    = 
+    !Config Def   = 2.0 or 4.0 depending on hydrol_cwrr
+    !Config Help  = Maximum depth of soil for soil moisture (CWRR).
+    !Config Units = m
+    ! Default value for CWRR (only CWRR enters this subroutine)
+    zmaxh=2.0
+    CALL getin_p("DEPTH_MAX_H",zmaxh)
+    
+    ! Verification
+    IF ( zmaxh > zmaxt) THEN
+       CALL ipslerr_p(3,'vertical_soil_init',"ERROR : zmaxh needs to be smaller than zmaxt.", &
+            "Correction : zmaxh set to zmaxt", " ")
+    ENDIF
+    
+    !Config Key   = DEPTH_TOPTHICK
+    !Config Desc  = Thickness of upper most Layer 
+    !Config If    = 
+    !Config Def   = 9.77517107e-04
+    !Config Help  = Thickness of top hydrology layer for soil moisture (CWRR).
+    !Config Units = m
+    depth_topthickness = 9.77517107e-04
+    CALL getin_p("DEPTH_TOPTHICK",depth_topthickness)
+    
+    !Config Key   = DEPTH_CSTTHICK
+    !Config Desc  = Depth at which constant layer thickness start
+    !Config If    = 
+    !Config Def   = DEPTH_MAX_H 
+    !Config Help  = Depth at which constant layer thickness start (smaller than zmaxh/2)
+    !Config Units = m
+    depth_cstthickness=zmaxh
+    CALL getin_p("DEPTH_CSTTHICK",depth_cstthickness)
+    
+    IF ( (depth_cstthickness /= zmaxh) .AND. (depth_cstthickness > zmaxh/2.0) ) THEN
+       CALL ipslerr_p(2,'vertical_soil_init',"ERROR : depth_cstthickness needs to be smaller than zmaxh/2.0", &
+            "Correction : Constant thickness disabled", " ")
+       depth_cstthickness = zmaxh
+    ENDIF
+    
+    ! REFINEBOTTOM option is under work... This option can not be set from the parameter file for the moment. 
+    ! All the related code for refinebottom except this getin are found in this module but needs to be tested.
+!!$  !Config Key   = REFINEBOTTOM
+!!$  !Config Desc  = Depth at which the hydrology layers will be refined towards the bottom.
+!!$  !Config If    = 
+!!$  !Config Def   = .FALSE.
+!!$  !Config Help  = Depth at which the hydrology layers will be refined towards the bottom.
+!!$  !               This is important when lower boundary conditions is different from a free drainage.
+!!$  !Config Units = -
+!!$  ! 
+    refinebottom = .FALSE.
+!!$  CALL getin_p("REFINEBOTTOM",refinebottom)
+    
+    !Config Key   = DEPTH_GEOM
+    !Config Desc  = Depth at which we resume geometrical increases for temperature
+    !Config If    = 
+    !Config Def   = DEPTH_MAX_H 
+    !Config Help  = Depth at which the thickness increases again for temperature.
+    !               This depth has to be deeper than the bottom of the hydrology.
+    !Config Units = m
+    depth_geom=zmaxh
+    CALL getin_p("DEPTH_GEOM",depth_geom)
+    
+    IF ( depth_geom < zmaxh ) THEN
+       CALL ipslerr_p(3,'vertical_soil_init',"ERROR : depth_geom needs to be larger than zmaxh", &
+            "Correction : setting depth_geom to zmaxh", " ")
+    ENDIF
+    
+    !Config Key   = RATIO_GEOM_BELOW
+    !Config Desc  = Ratio of the geometrical series defining the thickness below DEPTH_GEOM
+    !Config If    = 
+    !Config Def   = 2
+    !Config Help  = Ratio of the geometrical series defining the thickness below DEPTH_GEOM.
+    !               This parameter allows to cover the depth needed for temperature with fewer layers.
+    !Config Units = -
+    ratio_geom_below=2
+    CALL getin_p("RATIO_GEOM_BELOW",ratio_geom_below)
+    
+    !
+    ! Computing the layer depth for soil moisture. This defines the number of layers needed.
+    !
+    ztmp(:) = 0.0
+    dtmp(:) = 0.0
+    DO i=1,nblayermax
+       IF ( ztmp(i) < depth_cstthickness ) THEN
+          ztmp(i+1) = depth_topthickness*2.0*((2**i)-1)
+          dtmp(i+1) = ztmp(i+1)-ztmp(i)
+          igeo=i+1
+          zgeoend=ztmp(i+1)
+          dgeoend=dtmp(i+1)
+       ELSE
+          ztmp(i+1) = ztmp(i)+dtmp(i)
+          dtmp(i+1) = dtmp(i)
+       ENDIF
+    ENDDO
+    !
+    ! refine at bottom. Work in progress...
+    !
+    nbrefine = 1
+    drefine(:) = 0.0
+    IF (refinebottom) THEN
+       !
+       ! Compute parameters for the constant increment interval before refining,
+       ! If needed !
+       cstint=zmaxh-(2.0*zgeoend)
+       nbcst=MAX(INT(cstint/dgeoend), 0)
+       IF ( nbcst > 0 ) THEN
+          dcst=cstint/nbcst
+       ELSE
+          dcst=dgeoend
+       ENDIF
+       !
+       ! If we have to add constant increments
+       !
+       IF ( nbcst > 0 ) THEN
+          ! Add linear levels
+          DO i=igeo,igeo+nbcst-1
+             ztmp(i+1) = ztmp(i)+dcst
+             dtmp(i+1) = dcst
+          ENDDO
+          ! Refine the levels toward the bottom
+          DO i=igeo+nbcst,2*igeo+nbcst-2
+             irev=(2*igeo+nbcst-1)-i
+             ztmp(i+1) = ztmp(i)+dtmp(irev+1)
+             dtmp(i+1) = ztmp(i+1)-ztmp(i)
+             drefine(nbrefine)=dtmp(i+1)
+             nbrefine=nbrefine+1
+          ENDDO
+          ! Without constant increments
+       ELSE
+          imin=MINLOC(ABS(ztmp(:)-(zmaxh/2.0)))
+          igeo=imin(1)
+          ztmp(igeo)=zmaxh/2.0
+          dtmp(igeo) = ztmp(igeo)-ztmp(igeo-1)
+          DO i=igeo,2*igeo
+             irev=(2*igeo)-i
+             ztmp(i+1) = ztmp(i)+dtmp(irev)
+             dtmp(i+1) = ztmp(i-1)-ztmp(i)
+             drefine(nbrefine)=dtmp(i+1)
+             nbrefine=nbrefine+1
+          ENDDO
+       ENDIF
+    ENDIF
+    
+    ! Find the index (nslm) of the node closest to the zmaxh
+    imin=MINLOC(ABS(ztmp(:)-zmaxh))
+    nslm=imin(1)
+    !
+    ! ALLOCATE the arrays we need to keep
+    !
+    ALLOCATE(znh(nslm), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable znh','','')
+    ALLOCATE(dnh(nslm), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable dnh','','')
+    ALLOCATE(dlh(nslm), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable dlh','','')
+    ALLOCATE(zlh(nslm), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable zlh','','')
+    !
+    ! Extract now the values we need to reach zmaxh
+    !
+    znh(:)=ztmp(1:nslm)
+    
+    ! Force the last hydrological layer and node to be zmaxh
+    znh(nslm)=zmaxh
+    dnh(:)=dtmp(1:nslm)
+    ! Recalculate the distance between the last 2 nodes
+    dnh(nslm) = ztmp(nslm)-ztmp(nslm-1)
+    
+    ! Calculate the thickness of the layers
+    DO i = 1, nslm-1
+       dlh(i) = (dnh(i) + dnh(i+1)) / 2.0
+    ENDDO
+    dlh(nslm) = dnh(nslm)/2
+    
+    WRITE(numout,*) "=========================================================="
+    WRITE(numout,*) "Number of layers in hydrol = ", nslm
+    WRITE(numout,*) "znh = depth of nodes"
+    WRITE(numout,*) znh(:)
+    WRITE(numout,*) "dnh = internode distance"
+    WRITE(numout,*) dnh(:)
+    WRITE(numout,*) "dlh = layer thickness"
+    WRITE(numout,*) dlh(:)
+    WRITE(numout,*) "Total depth in hydrol has been calculated to ", znh(nslm)
+    WRITE(numout,*) "======================================================================"
+    
+    !
+    ! Extension for the thermodynamics below zmaxh
+    !
+    ntmp = nslm
+    ztmp(:)=0.0
+    ! Exception for the first layer. It is at the top in the hydrology and in
+    ! the middle for temperature.
+    ztmp(1)=depth_topthickness/2
+    DO i=2,ntmp
+       ztmp(i)=znh(i)
+    ENDDO
+    
+    ! Exception for the last layer where again temperature needs to be in
+    ! the middle of the layer. Also add a layer with the same thickness
+    hh=dnh(ntmp)/2.0
+    ztmp(ntmp)=ztmp(ntmp)-hh/2.0
+    ztmp(ntmp+1)=ztmp(ntmp)+hh*1.5
+    ztmp(ntmp+2)=ztmp(ntmp+1)+hh*2.0
+    ntmp=ntmp+2
+    
+    ! If we have created a refined region at the bottom of the soil moisture. We need to
+    ! unwinde it for temperature below zmaxh
+    IF ( nbrefine > 1 ) THEN
+       DO i=ntmp,ntmp+nbrefine
+          iref=(nbrefine+1)-(i-ntmp)
+          ztmp(i+1)=ztmp(i)+drefine(iref)
+       ENDDO
+       ntmp=ntmp+nbrefine
+    ENDIF
+    !
+    ! Resume the geometric increas of thickness
+    DO i=ntmp,nblayermax
+       IF ( ztmp(i) < depth_geom ) THEN
+          ratio = 1.0
+       ELSE
+          ratio = ratio_geom_below
+       ENDIF
+       ztmp(i+1)=ztmp(i)+ratio*(ztmp(i)-ztmp(i-1))
+    ENDDO
+    
+    ! Compute the depth of the lower interface of each layer.
+    !
+    zint(1) = depth_topthickness
+    DO i=2,nblayermax-1
+       zint(i) = (ztmp(i)+ztmp(i+1))/2.0
+    ENDDO
+    zint(nslm-1) = (znh(nslm-1) + znh(nslm))/2.0
+    zint(nslm) = (znh(nslm))
+    zint(nblayermax) = ztmp(nblayermax)+(ztmp(nblayermax)-ztmp(nblayermax-1))/2.0
+    
+    ! Determine the total number of layers for thermal (ngrnd).
+    !
+    imin=MINLOC(ABS(zint(:)-zmaxt))
+    ngrnd=imin(1)
+    ALLOCATE(znt(ngrnd), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable znt','','')
+    ALLOCATE(dlt(ngrnd), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable dlt','','')
+    ALLOCATE(zlt(ngrnd), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'vertical_soil_init','Problem in allocate of variable zlt','','')
+    
+    ! Assign values for znt, zlt, dlt
+    !
+    znt(:)=ztmp(1:ngrnd)
+    zlt(:) = zint(1:ngrnd)
+    dlt(1) = zint(1)
+    DO i=2,ngrnd
+       dlt(i) = zint(i)-zint(i-1)
+    ENDDO
+    ! Depth of layers for the hydrology are the same as for thermosoil but only the upper nslm layers are used
+    zlh(:) = zlt(1:nslm)
+    
+    ! Force the last thermal layer and node to be zmaxt
+    zlt(ngrnd) = zmaxt
+    dlt(ngrnd) = zmaxt-zint(ngrnd-1)
+
+    WRITE(numout,*) "Number of layers in thermosoil = ", ngrnd
+    WRITE(numout,*) "The maximal depth for thermosoil (DEPTH_MAX_T) = ", zlt(ngrnd)
+    WRITE(numout,*) "to be compared with calculated maximal depth for thermosoil (not used) = ", zint(ngrnd)
+    WRITE(numout,*) "Depth of the nodes in thermosoil, znt=",znt
+    WRITE(numout,*) "Thickness of the layers, dlt=", dlt
+    WRITE(numout,*) "Depth of the interface between the layers, zlt=", zlt(1:ngrnd)
+    WRITE(numout,*) "======================================================================"
+    
+  END SUBROUTINE vertical_soil_init
+  
+END MODULE vertical_soil
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/vertical_soil_var.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/vertical_soil_var.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_parameters/vertical_soil_var.f90	(revision 5166)
@@ -0,0 +1,65 @@
+! =================================================================================================================================
+! MODULE       : vertical_soil_var
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        
+!!
+!!\n DESCRIPTION: 
+!!                
+!! RECENT CHANGE(S):
+!!
+!! REFERENCE(S)	: 
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE vertical_soil_var
+
+  USE defprec
+
+  IMPLICIT NONE
+  PUBLIC
+
+  !! Dimensioning parameters
+  INTEGER(i_std), SAVE      :: ngrnd     !! Number of soil layer for thermo (unitless)
+!$OMP THREADPRIVATE(ngrnd)
+  INTEGER(i_std), SAVE      :: nbdl      !! Number of diagnostic layers in the soil, not needed in CWRR (unitless)
+!$OMP THREADPRIVATE(nbdl)
+  INTEGER(i_std), SAVE      :: nslm      !! Number of levels in CWRR (unitless)
+!$OMP THREADPRIVATE(nslm)
+  REAL(r_std), SAVE         :: zmaxh     !! Maximum depth of soil reservoir in hydrol (m). Old name dpu_max or depth_Wmax
+!$OMP THREADPRIVATE(zmaxh)
+  REAL(r_std), SAVE         :: zmaxt     !! Maximum depth of the soil thermodynamics (m)
+!$OMP THREADPRIVATE(zmaxt)
+
+  !! Variables defining the vertical layering in soil moisture and temperature
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: znt          !! Depth of nodes for thermal (m) 
+!$OMP THREADPRIVATE(znt)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: znh          !! Depth of nodes for hydrology (m)
+!$OMP THREADPRIVATE(znh)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: dnh          !! Distance between the current node and the one above for hydrology (m)
+!$OMP THREADPRIVATE(dnh)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: dlh          !! Soil layer thickness for hydrology (m) 
+!$OMP THREADPRIVATE(dlh)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: dlt          !! Soil layer thickness for thermal (m)
+!$OMP THREADPRIVATE(dlt)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: zlh          !! Depth of lower layer-interface for hydrology (m)
+!$OMP THREADPRIVATE(zlh)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: zlt          !! Depth of lower layer-interface for thermal (m)
+!$OMP THREADPRIVATE(zlt)
+
+  REAL(r_std),ALLOCATABLE, DIMENSION(:),SAVE :: diaglev        !! The lower limit of the layer on which soil moisture
+                                                               !! (relative) and temperature are going to be diagnosed.
+                                                               !! These variables are made for transfering the information
+                                                               !! to the biogeophyical processes modelled in STOMATE. 
+!$OMP THREADPRIVATE(diaglev)
+
+END MODULE vertical_soil_var
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/AA_make	(revision 5166)
@@ -0,0 +1,195 @@
+#-
+#- $Id$
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec  SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec  SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+ORGLOB_LIB = $(LIBDIR)/liborglob.a
+SXORGLOB_LIB = $(ORGLOB_LIB)
+#-Q- sxnec  SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- eshpux SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-
+STOMATE_LIB = $(LIBDIR)/libstomate.a
+SXSTOMATE_LIB = $(STOMATE_LIB)
+#-Q- sxnec  SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx6nec SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- eshpux SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx8brodie SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-
+MODS1 =              \
+  qsat_moisture.f90 \
+  sechiba_io_p.f90   \
+  sechiba_io.f90     \
+  slowproc.f90       \
+  diffuco.f90        \
+  condveg.f90        \
+  enerbil.f90        \
+  explicitsnow.f90       \
+  hydrol.f90         \
+  hydrolc.f90        \
+  thermosoil.f90     \
+  routing.f90        \
+  sechiba.f90        \
+  ioipslctrl.f90     \
+  intersurf.f90 
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libparallel
+	$(M_K) libparameters
+	$(M_K) liborglob
+	$(M_K) libstomate
+	$(M_K) m_all
+	@echo sechiba is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+#-Q- intel m_all: WORK_MOD $(MODEL_LIB)($(OBJSMODS1))
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+libparameters:
+	(cd ../src_parameters; $(M_K) -f Makefile)
+
+liborglob:
+	(cd ../src_global; $(M_K) -f Makefile)
+
+libstomate:
+	(cd ../src_stomate; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o) : %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+#-Q- intel
+#-Q- intel WORK_MOD :
+#-Q- intel 	$(RM) work.pcl
+#-Q- intel 	@echo "work.pc" > work.pcl
+#-Q- intel 	@echo "../src_parameters/work.pc" >> work.pcl
+#-Q- intel 	@echo "../src_stomate/work.pc" >> work.pcl
+#-Q- intel 	@echo "../../IOIPSL/src/work.pc" >> work.pcl
+
+config : 
+	$(BINDIR)/Fparser -name SECHIBA $(MODS1)
+	echo 'Configuration of SECHIBA done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(sechiba.o):          \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(sechiba_io_p.o)    \
+  $(MODEL_LIB)(sechiba_io.o)      \
+  $(MODEL_LIB)(diffuco.o)         \
+  $(MODEL_LIB)(condveg.o)         \
+  $(MODEL_LIB)(enerbil.o)         \
+  $(MODEL_LIB)(hydrolc.o)         \
+  $(MODEL_LIB)(hydrol.o)          \
+  $(MODEL_LIB)(thermosoil.o)      \
+  $(MODEL_LIB)(slowproc.o)        \
+  $(MODEL_LIB)(routing.o)
+ 
+$(MODEL_LIB)(sechiba_io_p.o): \
+  $(PARAM_LIB)(constantes.o)  \
+  $(PARALLEL_LIB)(mod_orchidee_para.o)
+
+$(MODEL_LIB)(sechiba_io.o): \
+  $(MODEL_LIB)(sechiba_io_p.o) \
+  $(PARAM_LIB)(constantes.o)
+
+$(MODEL_LIB)(hydrol.o):           \
+  $(PARAM_LIB)(constantes.o)  \
+  $(MODEL_LIB)(explicitsnow.o)  \
+  $(MODEL_LIB)(sechiba_io.o)      \
+  $(ORGLOB_LIB)(grid.o)
+
+$(MODEL_LIB)(explicitsnow.o):         \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(PARAM_LIB)(constantes.o)      \
+  $(PARAM_LIB)(constantes_soil.o) \
+  $(MODEL_LIB)(qsat_moisture.o)   \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(hydrolc.o):          \
+  $(PARAM_LIB)(constantes.o)  \
+  $(MODEL_LIB)(explicitsnow.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(slowproc.o):         \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(STOMATE_LIB)(stomate.o)       \
+  $(MODEL_LIB)(sechiba_io.o)      \
+  $(ORGLOB_LIB)(interpol_help.o)
+
+$(MODEL_LIB)(diffuco.o):          \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(qsat_moisture.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(enerbil.o):          \
+  $(PARAM_LIB)(constantes.o)      \
+  $(MODEL_LIB)(qsat_moisture.o)   \
+  $(MODEL_LIB)(explicitsnow.o)        \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(condveg.o):          \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(PARAM_LIB)(constantes.o)  \
+  $(PARAM_LIB)(constantes_soil.o)  \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(sechiba_io.o) \
+  $(ORGLOB_LIB)(interpol_help.o)
+
+$(MODEL_LIB)(thermosoil.o): \
+  $(PARAM_LIB)(constantes.o)  \
+  $(PARAM_LIB)(constantes_soil.o)  \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(routing.o):          \
+  $(PARAM_LIB)(constantes.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(intersurf.o):   \
+  $(PARAM_LIB)(constantes.o)  \
+  $(PARAM_LIB)(control.o)    \
+  $(ORGLOB_LIB)(grid.o)      \
+  $(MODEL_LIB)(thermosoil.o) \
+  $(MODEL_LIB)(sechiba.o)
+
+$(MODEL_LIB)(ioipslctrl.o):   \
+  $(PARAM_LIB)(constantes.o)  \
+  $(PARAM_LIB)(constantes_soil.o)  \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(thermosoil.o) 
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/AA_make.ldef	(revision 5166)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a SECHIBA
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/libsechiba.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxsechiba.a
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/chemistry.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/chemistry.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/chemistry.f90	(revision 5166)
@@ -0,0 +1,2029 @@
+! ================================================================================================================================
+!  MODULE       : chemistry
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF   
+!!
+!!\n DESCRIPTION: 
+!!
+!! RECENT CHANGE(S): The content of this module were previously part of the diffuco module.
+!!                   ok_inca changed name into ok_bvoc and DIFFUCO_OK_INCA changed into CHEMISTRY_BVOC
+!!                   LEAFAGE_OK_INCA changed name into CHEMISTRY_LEAFAGE
+!!
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE chemistry
+
+  USE constantes
+  USE qsat_moisture
+  USE sechiba_io
+  USE ioipsl
+  USE pft_parameters
+  USE grid
+  USE ioipsl_para 
+  USE xios_orchidee
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: chemistry_initialize, chemistry_bvoc, chemistry_interface_orchidee_inca
+
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_iso            !! Isoprene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_iso)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_mono           !! Monoterpene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_mono)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_ORVOC          !! Other Volatile Organic Compound emissions from vegetation (kgC.m^{-2}.s^{-1}) 
+!$OMP THREADPRIVATE(flx_ORVOC)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_MBO            !! 2-methyl-3-buten-2-ol emissions from vegetation (mainly pines in America) (kgC.m^{-2}.s^{-1}) 
+!$OMP THREADPRIVATE(flx_MBO)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_methanol       !! Methanol emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_methanol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_acetone        !! Acetone emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_acetone)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_acetal         !! Acetaldehyde emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_acetal)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_formal         !! Formaldehyde emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_formal)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_acetic         !! Acetic acid emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_acetic)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_formic         !! Formic acid emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_formic)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_apinen         !! Alpha pinene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_apinen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_bpinen         !! Beta pinene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_bpinen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_limonen        !! Limonene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_limonen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_myrcen         !! Myrcene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_myrcen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_sabinen        !! Sabinene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_sabinen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_camphen        !! Camphene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_camphen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_3caren         !! 3-Carene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_3caren)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_tbocimen       !! T-beta Ocimene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_tbocimen)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_othermono      !! Emissions of other monoterpenes from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_othermono)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:)  :: flx_sesquiter      !! Sesquiterpene emissions from vegetation (kgC.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_sesquiter)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_fertil_no      !! Biogenic nitrogen oxide soil emission due to N-fertilisation (ngN.m^{-2}.s^{-1}) 
+!$OMP THREADPRIVATE(flx_fertil_no)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_no_soil        !! Nitrogen Oxide emissions from soil, before deposition on canopy 
+                                                                       !! (ngN.m^{-2}.s^{-1})
+!$OMP THREADPRIVATE(flx_no_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: flx_no             !! Net nitrogen Oxide emissions from soil, after deposition on canopy
+!$OMP THREADPRIVATE(flx_no)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: CRF                !! Canopy reduction factor for net NO flux calculation (kjpindex,nvm)    
+!$OMP THREADPRIVATE(CRF)
+
+  ! variables used inside diffuco_inca module 
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)     :: ok_siesta        !! Flag for controlling post-pulse period (true/false)
+!$OMP THREADPRIVATE(ok_siesta)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)     :: allow_pulse      !! Flag for controlling pulse period (true/false)
+!$OMP THREADPRIVATE(allow_pulse)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pulse            !! Pulse fonction 
+!$OMP THREADPRIVATE(pulse)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pulseday         !! Counter for pulse period
+!$OMP THREADPRIVATE(pulseday)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: siestaday        !! Counter for post-pulse period
+!$OMP THREADPRIVATE(siestaday)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pulselim         !! Pulse period length
+!$OMP THREADPRIVATE(pulselim)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: siestalim        !! Post-pulse period length
+!$OMP THREADPRIVATE(siestalim)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: area2            !! Grid cell area (m^2)
+!$OMP THREADPRIVATE(area2)
+  REAL(r_std), SAVE                            :: nbre_precip 
+!$OMP THREADPRIVATE(nbre_precip)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: flx_co2_bbg_year !! CO2 emissions from biomass burning 
+                                                                   !! Read in an input file (kgC.m^{-2}.year^{-1})
+!$OMP THREADPRIVATE(flx_co2_bbg_year)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: N_qt_WRICE_year  !! N fertilizers applied on wetland rice
+                                                                   !! Read in an input file (kgN.yr^{-1})
+!$OMP THREADPRIVATE(N_qt_WRICE_year)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: N_qt_OTHER_year  !! N fertilizers applied on other crops and grasses
+                                                                   !! Read in an input file (kgN.yr^{-1}) 
+!$OMP THREADPRIVATE(N_qt_OTHER_year)
+
+  REAL(r_std), DIMENSION(:,:), SAVE, ALLOCATABLE     :: veget_max_chem        !! Max. vegetation fraction (0-1, unitless)
+!$OMP THREADPRIVATE(veget_max_chem) 
+  REAL(r_std),DIMENSION (:), SAVE, ALLOCATABLE     :: snow_chem         !! Snow mass (kg)
+!$OMP THREADPRIVATE(snow_chem) 
+  REAL(r_std),DIMENSION (:,:), SAVE, ALLOCATABLE     :: veget_chem            !! Fraction of vegetation type (-)
+!$OMP THREADPRIVATE(veget_chem) 
+  REAL(r_std), DIMENSION(:,:), SAVE, ALLOCATABLE     :: lai_chem              !! Leaf area index (m^2.m^{-2})
+!$OMP THREADPRIVATE(lai_chem) 
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : chemistry_initialize
+!!
+!>\BRIEF         This subroutine initializes the chemistry module
+!!
+!! DESCRIPTION  : Some of the variables and flags used chemistry_bvoc are allocated and initialised here.
+!!
+!! RECENT CHANGE(S): Changed name from diffuco_inca_init to chemistry_initialize
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+
+  SUBROUTINE chemistry_initialize(kjpindex, lalo, neighbours, resolution)
+    
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (unitless) 
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT (in)    :: lalo             !! Geographical coordinates
+    INTEGER(i_std), DIMENSION(kjpindex,8), INTENT (in) :: neighbours       !! Vector of neighbours for each 
+                                                                           !! grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)     :: resolution       !! The size in km of each grid-box in X and Y
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    LOGICAL                             :: allow_weathergen, density
+    CHARACTER(LEN=80)                   :: filename
+    INTEGER(i_std)                      :: iml, jml, lml, tml, force_id
+    INTEGER(i_std)                      :: ier
+
+!_ ================================================================================================================================
+
+    ALLOCATE (pulse(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable pulse','','')
+    pulse(:) = un
+
+    ! If we acount for NOx pulse emissions
+    IF (ok_pulse_NOx) THEN
+
+       ALLOCATE (ok_siesta(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable ok_siesta','','')
+       ok_siesta(:) = .FALSE.
+
+       ALLOCATE (allow_pulse(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable allow_pulse','','')
+       allow_pulse(:) = .FALSE.
+
+       ALLOCATE (pulseday(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable pulseday','','')
+       pulseday(:) = zero
+
+       ALLOCATE (siestaday(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable siestaday','','')
+       siestaday(:) = zero
+
+       ALLOCATE (pulselim(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable pulselim','','')
+       pulselim(:) = zero
+
+       ALLOCATE (siestalim(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable siestalim','','')
+       siestalim(:) = zero
+
+    END IF ! (ok_pulse_NOx) 
+
+    ! If we acount for NOx emissions by N-fertilizers
+    IF (ok_cropsfertil_NOx) THEN
+
+       ALLOCATE (area2(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable area2','','')
+       area2(:) = resolution(:,1)*resolution(:,2) 
+
+       ALLOCATE (N_qt_WRICE_year(kjpindex),stat=ier)  !! N fertilizers on wetland rice, read in file 
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable N_qt_WRICE_year','','')
+       N_qt_WRICE_year(:) = zero
+    
+       ALLOCATE (N_qt_OTHER_year(kjpindex),stat=ier)  !! N fertilizers on other crops and grasses, read in file 
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable N_qt_OTHER_year','','')
+       N_qt_OTHER_year(:) = zero
+
+       WRITE (numout,*) ' *********************** Interpolating N fertilizers files for NOx emissions... '
+       density  = .FALSE. 
+
+       !Config Key   = N_FERTIL_FILE
+       !Config Desc  = File name
+       !Config If    = CHEMISTRY_BVOC and NOx_FERTILIZERS_USE
+       !Config Def   = orchidee_fertilizer_1995.nc
+       !Config Help  = 
+       !Config Units = - 
+       filename = 'orchidee_fertilizer_1995.nc'
+       CALL getin_p('N_FERTIL_FILE',filename)
+       CALL chemistry_read_p (kjpindex, lalo, neighbours, resolution, filename, 'N_qt_WRICE_year', density, &
+            N_qt_WRICE_year)
+       CALL chemistry_read_p (kjpindex, lalo, neighbours, resolution, filename, 'N_qt_OTHER_year', density, &
+            N_qt_OTHER_year)    
+
+    END IF
+
+    ALLOCATE (flx_iso(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_iso','','')
+    flx_iso(:,:) = 0. 
+
+    ALLOCATE (flx_mono(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_mono','','')
+    flx_mono(:,:) = 0. 
+
+    ALLOCATE (flx_ORVOC(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_ORVOC ','','')
+    flx_ORVOC(:,:) = 0. 
+
+    ALLOCATE (flx_MBO(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_MBO','','')
+    flx_MBO(:,:) = 0. 
+
+    ALLOCATE (flx_methanol(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_methanol','','')
+    flx_methanol(:,:) = 0. 
+
+    ALLOCATE (flx_acetone(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_acetone','','')
+    flx_acetone(:,:) = 0. 
+
+    ALLOCATE (flx_acetal(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_acetal','','')
+    flx_acetal(:,:) = 0. 
+
+    ALLOCATE (flx_formal(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_formal','','')
+    flx_formal(:,:) = 0. 
+
+    ALLOCATE (flx_acetic(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_acetic','','')
+    flx_acetic(:,:) = 0. 
+
+    ALLOCATE (flx_formic(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_formic','','')
+    flx_formic(:,:) = 0. 
+
+    ALLOCATE (flx_no_soil(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_no_soil','','')
+    flx_no_soil(:,:) = 0. 
+
+    ALLOCATE (flx_no(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_no','','')
+    flx_no(:,:) = 0. 
+       
+    ALLOCATE (flx_fertil_no(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_fertil_no','','')
+    flx_fertil_no(:,:) = 0. 
+
+    ALLOCATE (flx_apinen(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_apinen','','')
+    flx_apinen(:,:) = 0.       
+
+    ALLOCATE (flx_bpinen (kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_bpinen','','')
+    flx_bpinen(:,:) = 0.      
+
+    ALLOCATE (flx_limonen  (kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_limonen','','')
+    flx_limonen(:,:) = 0.    
+
+    ALLOCATE (flx_myrcen(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_myrcen','','')
+    flx_myrcen(:,:) = 0.       
+
+    ALLOCATE (flx_sabinen(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_sabinen','','')
+    flx_sabinen(:,:) = 0.      
+
+    ALLOCATE (flx_camphen(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_camphen','','')
+    flx_camphen(:,:) = 0.      
+
+    ALLOCATE (flx_3caren(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_3caren','','')
+    flx_3caren(:,:) = 0.       
+
+    ALLOCATE (flx_tbocimen(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_tbocimen','','')
+    flx_tbocimen(:,:) = 0.     
+
+    ALLOCATE (flx_othermono(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_othermono','','')
+    flx_othermono(:,:) = 0.    
+
+    ALLOCATE (flx_sesquiter(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable flx_sesquiter','','')
+    flx_sesquiter(:,:) = 0.    
+
+    ALLOCATE(CRF(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable CRF ','','')
+    CRF(:,:) = 0. 
+
+
+    ALLOCATE(veget_max_chem(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable veget_max_chem ','','')
+    veget_max_chem(:,:) = 0. 
+  
+    ALLOCATE(snow_chem(kjpindex), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable snow_chem ','','')
+    snow_chem(:) = 0. 
+
+    ALLOCATE(veget_chem(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable veget_chem ','','')
+    veget_chem(:,:) = 0. 
+
+    ALLOCATE(lai_chem(kjpindex,nvm), stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_init','Problem in allocate of variable lai_chem ','','')
+    lai_chem(:,:) = 0. 
+
+    ! If we acount for NOx emissions due to Biomass Burning
+    IF (ok_bbgfertil_NOx) THEN
+
+       ALLOCATE (flx_co2_bbg_year(kjpindex),stat=ier) !! CO2 emissions from bbg, read in file 
+       IF (ier /= 0) CALL ipslerr_p(3,'chemistry_initialize','Problem in allocate of variable flx_co2_bbg_year','','')
+       flx_co2_bbg_year(:) = zero    
+
+       WRITE (numout,*) ' *********************** Interpolating CO2 bbg files for NOx emissions... '
+       !Config Key   = N_FERTIL_FILE
+       !Config Desc  = File name
+       !Config If    = CHEMISTRY_BVOC and NOx_FERTILIZERS_USE
+       !Config Def   = orchidee_fertilizer_1995.nc
+       !Config Help  = ...
+       !Config Units = -
+       filename = 'orchidee_bbg_clim.nc'
+       CALL getin_p('CO2_BBG_FILE',filename)
+       density  = .TRUE.
+       CALL chemistry_read_p (kjpindex, lalo, neighbours, resolution, filename,'flx_co2_bbg_year',density, &
+            flx_co2_bbg_year)
+
+    END IF
+
+    IF ( OFF_LINE_MODE ) THEN
+
+       !-
+       !- What are the alowed options for the temporal interpolation
+       !-
+       ! ALLOW_WEATHERGEN : Allow weather generator to create data
+       ! This parameter is already read in the driver
+       allow_weathergen = .FALSE.
+       CALL getin_p('ALLOW_WEATHERGEN',allow_weathergen)
+       
+       ! FORCING_FILE : Name of file containing the forcing data
+       ! This parameter is already read in the driver
+       filename='forcing_file.nc'
+       CALL getin_p('FORCING_FILE',filename)
+       CALL flininfo(filename,iml, jml, lml, tml, force_id)   
+       WRITE(numout,*) 'Number of data per year in forcing file :', tml 
+       CALL flinclo(force_id)
+       WRITE(numout,*) 'Forcing file closed in chemistry_initialize'
+       
+       
+       IF ( allow_weathergen ) THEN
+          WRITE(numout,*) '**chemistry_initialize: Using weather generator, careful to precip division for NOx '
+          nbre_precip = un
+          WRITE(numout,*) 'Division pour les precip, NOx:', nbre_precip
+       ELSE
+          WRITE(numout,*) 'DT_SECHIBA :', dt_sechiba
+          nbre_precip = (one_day/dt_sechiba)/(tml/one_year)
+          WRITE(numout,*) 'Division pour les precip, NOx:', nbre_precip
+       END IF
+
+    ELSE ! (in coupled mode)
+
+       nbre_precip = un
+       
+    END IF  ! (OFF_LINE_MODE)
+
+       
+  END SUBROUTINE chemistry_initialize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : chemistry_bvoc
+!!
+!>\BRIEF         This subroutine computes biogenic emissions of reactive compounds, that is of
+!!               VOCs (volatile organic compounds) from vegetation and NOx (nitrogen oxides) from soils.
+!!               Calculation are mostly based on the works by Guenther et al. (1995) and Yienger and Levy (1995).\n 
+!!
+!! DESCRIPTION  : Biogenic VOC emissions from vegetation are based on the parameterisations developped by
+!!                Guenther et al. (1995). Biogenic VOCs considered here are: isoprene, monoterpenes, OVOC and ORVOC 
+!!                as bulked emissions, methanol, acetone, acetaldehyde, formaldehyde, acetic acid, formic acid
+!!                as single emissions.\n
+!!                For every biogenic VOCs an emission factor (EF), depending on the PFT considered, is used.\n
+!!                Isoprene emissions depend on temperature and radiation. A partition between sunlit and shaded
+!!                leaves is taken into account and either one (if ok_multilayer = FALSE) or several layers
+!!                (if ok_multilayer = TRUE) in the canopy can be used.\n
+!!                When radiation extinction is considered, the canopy radiative transfer model takes into 
+!!                account light extinction through canopy, calculating first need diffuse and direct radiation
+!!                based on Andrew Friend 2001 radiative model and Spitters et al. 1986. The calculation of lai, 
+!!                parscat, parsh and parsun, laisun and laishabsed based on Guenther et al.(JGR, 1995) and Norman (1982).\n
+!!                Emissions for other BVOCs (monoterpenes, OVOC, ORVOC and other single compounds such as
+!!                methanol, acetone...) depend only on temperature.\n   
+!!                The impact of leaf age, using an emission activity prescribed for each of the 4 leaf age
+!!                classes can also be considered for isoprene and methanol emissions when ok_leafage = TRUE.\n
+!!                NOx emissions from soils are based on Yienger and Levy (1995) and depend on soil moisture
+!!                and temperature and PFT. The pulse effect, related to significant rain occuring after severe
+!!                drought can also be considered (ok_pulse_NOx = TRUE), as well as the increase in emissions related to
+!!                biomass buring (ok_bbgfertil_NOx = TRUE) or use of fertilizers (ok_cropsfertil_NOx = TRUE). 
+!!                A net NO flux is eventually calculated taking into account loss by deposition on the surface, using
+!!                a Canopy Reduction Factor (CRF) based on stomatal and leaf area.\n 
+!!                This subroutine is called by diffuco_main only if biogenic emissions are activated
+!!                for sechiba (flag CHEMISTRY_BVOC=TRUE).\n
+!!
+!! RECENT CHANGE(S): Changed name from diffuco_inca to chemistry_bvoc
+!!
+!! MAIN OUTPUT VARIABLE(S): :: PAR, :: PARsun, :: PARsh, :: laisun, :: laish,
+!!                          :: flx_iso, :: flx_mono, :: flx_ORVOC, :: flx_MBO,
+!!                          :: flx_methanol, :: flx_acetone, :: flx_acetal, :: flx_formal,
+!!                          :: flx_acetic, :: flx_formic, :: flx_no_soil, :: flx_no,
+!!                          :: CRF, :: flx_fertil_no, :: Trans, :: Fdf,
+!!                          :: PARdf, :: PARdr, :: PARsuntab, :: PARshtab
+!!
+!! REFERENCE(S) :
+!! - Andrew Friend (2001), Modelling canopy CO2 fluxes: are 'big-leaf' simplifications justified? 
+!! Global Ecology and Biogeography, 10, 6, 603-619, doi: 10.1046/j.1466-822x.2001.00268.x 
+!! - Spitters, C.J.T, Toussaint, H.A.J.M, Groudriaan, J. (1986), Separating the diffuse and direct
+!! component of global radiation and its implications for modeling canopy photosynthesis, Agricultural
+!! and Forest Meteorology, 38, 1-3, 217-229, doi:10.1016/0168-1923(86)90060-2
+!! - Norman JM (1982) Simulation of microclimates. In: Hatfield JL, Thomason IJ (eds)
+!!  Biometeorology in integrated pest management. Academic, New York, pp 65â99
+!! - Guenther, A., Hewitt, C. N., Erickson, D., Fall, R., Geron, C., Graedel, T., Harley, P.,
+!! Klinger, L., Lerdau, M., McKay, W. A., Pierce, T., Scholes, B., Steinbrecher, R., Tallamraju,
+!! R., Taylor, J. et Zimmerman, P. (1995), A global model of natural volatile organic compound
+!! emissions, J. Geophys. Res., 100, 8873-8892.
+!! - MacDonald, R. et Fall, R. (1993), Detection of substantial emissions of methanol from
+!! plants to the atmosphere, Atmos. Environ., 27A, 1709-1713.
+!! - Guenther, A., Geron, C., Pierce, T., Lamb, B., Harley, P. et Fall, R. (2000), Natural emissions
+!! of non-methane volatile organic compounds, carbon monoxide, and oxides of nitrogen from
+!! North America, Atmos. Environ., 34, 2205-2230.
+!! - Yienger, J. J. et Levy II, H. (1995), Empirical model of global soil-biogenic NOx emissions,
+!! J. Geophys. Res., 100, 11,447-11,464.
+!! - Lathiere, J., D.A. Hauglustaine, A. Friend, N. De Noblet-Ducoudre, N. Viovy, and
+!!  G. Folberth (2006), Impact of climate variability and land use changes on global biogenic volatile 
+!! organic compound emissions, Atmospheric Chemistry and Physics, 6, 2129-2146. 
+!! - Lathiere, J., D.A. Hauglustaine, N. De Noblet-Ducoudre, G. Krinner et G.A. Folberth (2005),
+!! Past and future changes in biogenic volatile organic compound emissions simulated with a global
+!! dynamic vegetation model, Geophysical Research Letters, 32, doi: 10.1029/2005GL024164.
+!! - Lathiere, J. (2005), Evolution des emissions de composes organiques et azotes par la biosphere
+!!  continentale dans le modele LMDz-INCA-ORCHIDEE, These de doctorat, Universite Paris VI.
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+
+  SUBROUTINE chemistry_bvoc (kjpindex, swdown, coszang, temp_air, &
+       temp_sol, ptnlev1, precip_rain, humrel, veget_max, lai, &
+       frac_age, lalo, ccanopy, cim,  wind, snow, &
+       veget, hist_id, hist2_id,kjit, index, &
+       indexlai, indexveg)
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex         !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std), INTENT(in)                                 :: kjit             !! Time step number (-) 
+    INTEGER(i_std),INTENT (in)                                 :: hist_id          !! History file identifier (-)
+    INTEGER(i_std),INTENT (in)                                 :: hist2_id         !! History file 2 identifier (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)           :: index            !! Indeces of the points on the map (-)
+    INTEGER(i_std),DIMENSION (kjpindex*(nlai+1)), INTENT (in)  :: indexlai         !! Indeces of the points on the 3D map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in)       :: indexveg         !! Indeces of the points on the 3D map (-)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: swdown           !! Down-welling surface short-wave flux 
+                                                                                   !! (W.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: coszang          !! Cosine of the solar zenith angle (unitless) 
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: temp_air         !! Air temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: temp_sol         !! Skin temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: ptnlev1          !! 1st level of soil temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: precip_rain      !! Rain precipitation !!?? init
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)           :: humrel           !! Soil moisture stress (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)           :: veget_max        !! Max. vegetation fraction (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)              :: snow             !! Snow mass (kg)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)          :: veget            !! Fraction of vegetation type (-)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)           :: lai              !! Leaf area index (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm,nleafages), INTENT(in) :: frac_age         !! Age efficacity from STOMATE for iso 
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT(in)             :: lalo             !! Geographical coordinates for pixels (degrees)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)              :: ccanopy          !! CO2 concentration inside the canopy
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)          :: cim              !! Intercellular CO2 over nlai 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)              :: wind             !! Wind module (m s^{-1})
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables 
+
+    INTEGER(i_std)                             :: ji, jv, jf, jl    !! Indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: fol_dens          !! foliar density (gDM.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)           :: tleaf             !! Foliar temperature (K)
+    REAL(r_std), DIMENSION(kjpindex)           :: t_no              !! Temperature used for soil NO emissions (C)
+    REAL(r_std), DIMENSION(kjpindex)           :: exp_1             !! First exponential used in the calculation of 
+                                                                    !! isoprene dependancy to Temperature 
+    REAL(r_std), DIMENSION(kjpindex)           :: exp_2             !! Second exponential used in the calculation of 
+                                                                    !! Isoprene dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_iso            !! Isoprene dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Cl_iso            !! Isoprene dependancy to Light 
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_mono           !! Monoterpene dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_sesq           !! Sesquiterpenes dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_meth           !! Methanol dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_acet           !! Acetone dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_oxyVOC         !! Other oxygenated BVOC dependancy to Temperature
+    REAL(r_std)                                :: GAMMA_iso         !! Temperature and light dependancy for isoprene and fo each PFT
+    REAL(r_std)                                :: GAMMA_iso_m       !! Temperature and light dependancy for isoprene and fo each PFT for multilayer
+    REAL(r_std), DIMENSION(kjpindex)           :: Ylt_mono          !! Total Temperature and light dependancy for monoterpenes
+    REAL(r_std), DIMENSION(kjpindex)           :: Ylt_sesq          !! Total Temperature and light dependancy for sesquiterpens
+    REAL(r_std), DIMENSION(kjpindex)           :: Ylt_meth          !! Total Temperature and light dependancy for methanol
+    REAL(r_std), DIMENSION(kjpindex)           :: Ylt_acet          !! Total Temperature and light dependancy for acetone
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_MBO            !! MBO dependance to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Cl_MBO            !! MBO dependance to Light
+    REAL(r_std), DIMENSION(kjpindex)           :: Xvar              !! Parameter used in the calculation 
+                                                                    !! of MBO dependance to Temperature
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: flx_OVOC          !! Biogenic OVOC emission - 
+                                                                    !! Other Volatil Organic Components (kgC.m^{-2}.s^{-1})
+    !!Canopy radiative transfer model
+    REAL(r_std)                                :: day               !! Day of The Year
+    REAL(r_std), DIMENSION(kjpindex)           :: So                !! Maximum radiation at the Earth surface (W.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)           :: Rfrac             !! Parameter in the regression of diffuse 
+                                                                    !! share on transmission
+    REAL(r_std), DIMENSION(kjpindex)           :: Kfrac             !! Parameter in the regression of diffuse 
+                                                                    !! share on transmission
+    REAL(r_std), DIMENSION(kjpindex)           :: swdf              !! Sw diffuse radiation (W.m^{-2}) 
+    REAL(r_std), DIMENSION(kjpindex)           :: swdr              !! Sw direct radiation (W.m^{-2}) 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: PARscat           !! Scatter PAR @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Clsun_iso         !! Isoprene dependance to light for sun leaves 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Clsh_iso          !! Isoprene dependance to light for shaded leaves
+    !! for multilayer canopy model for iso flux
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARscattab        !! Scatter PAR @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nlai+1)             :: laitab            !! LAI per layer (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nlai)      :: laisuntabdep      !! LAI of sun leaves in each layer (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nlai)      :: laishtabdep       !! LAI of shaded leaves in each layer 
+                                                                    !! (m^2.m^{-2})
+    REAL(r_std)                                :: Clsun_iso_tab     !! Isoprene dependance to light 
+                                                                    !! for sun leaves and per layer 
+    REAL(r_std)                                :: Clsh_iso_tab      !! Isoprene dependance to light 
+                                                                    !! for shaded leaves and per layer
+    !for multilayer canopy model Spitter et al. 1986
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARnotscat        !! Not-Scattered PAR 
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARabsdir         !! Absorbed light of the PAR direct flux  
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARabsdiff        !! Absorbed light of the PAR diffuse flux  
+    REAL(r_std), PARAMETER                     :: sigma = 0.20      !! scattering coefficient of single leaves and for visible radiation
+    REAL(r_std), PARAMETER                     :: cluster = 0.85    !! clustering coefficient for leaves, the same that is setting for default in MEGAN V2.10
+    REAL(r_std)                                :: rho               !! reflection index of a green, closed vegetation
+    REAL(r_std)                                :: kbl               !! extinction coefficient of black leaves
+    REAL(r_std)                                :: kdf               !! extinction coefficient of diffuse flux
+    !!Leaf age
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Eff_age_iso       !! Isoprene emission dependance to Leaf Age 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Eff_age_meth      !! Methanol emission dependance to Leaf Age 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Eff_age_VOC       !! Other VOC emission dependance to Leaf Age 
+    !!BBG and Fertilizers for NOx soil emission
+    REAL(r_std), DIMENSION(kjpindex)           :: veget_max_nowoody !! sum of veget_max for non-woody PFT
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: N_qt_WRICE_pft    !! N fertiliser on RICE 
+                                                                    !! (kgN per year per grid cell)
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: N_qt_OTHER_pft    !! N fertiliser on other veg 
+                                                                    !! (kgN per year per grid cell)
+    !! CO2 inhibition effect on isoprene
+    REAL(r_std),DIMENSION (kjpindex,nvm)       :: fco2_wshort       !! Wilkinson short term function for CO2 impact on BVOC (isoprene) 
+    REAL(r_std),DIMENSION (kjpindex)           :: fco2_wlong        !! Wilkinson long term function for CO2 impact on BVOC (isoprene) 
+    REAL(r_std)                                :: fco2_ctrl
+    REAL(r_std),DIMENSION (kjpindex,nvm)       :: fco2              !! Function for CO2 impact on BVOC (isoprene)
+    REAL(r_std), DIMENSION(kjpindex)           :: Ismax_short
+    REAL(r_std), DIMENSION(kjpindex)           :: h_short
+    REAL(r_std), DIMENSION(kjpindex)           :: Cstar_short
+    REAL(r_std)                                :: Ismax_long
+    REAL(r_std)                                :: h_long
+    REAL(r_std)                                :: Cstar_long
+
+    !! 0.5 Parameters values
+
+    REAL(r_std), PARAMETER :: CT1 = 95000.0       !! Empirical coeffcient (see Guenther .et. al, 1995, eq(10)) (J.mol^{-1})
+    REAL(r_std), PARAMETER :: CT2 = 230000.0      !! Empirical coefficient (see Guenther .et. al, 1995, eq(10)) (J.mol^{-1})
+    REAL(r_std), PARAMETER :: TS = 303.0          !! Leaf temperature at standard condition
+                                                  !! (see Guenther .et. al, 1995, eq(10)) (K)
+    REAL(r_std), PARAMETER :: TM = 314.0          !! Leaf temperature (see Guenther .et. al, 1995, eq(10)) (K)
+
+    REAL(r_std), PARAMETER :: alpha_ = 0.0027     !! Empirical coeffcient (see Guenther .et. al, 1995, eq(9)) (unitless)
+    REAL(r_std), PARAMETER :: CL1 = 1.066         !! Empirical coeffcient (see Guenther .et. al, 1995, eq(9)) (unitless)
+    REAL(r_std), PARAMETER :: beta = 0.09         !! Empirical coeffcient (see Guenther .et. al, 1995, eq(11)) (K^{-1})
+    REAL(r_std), PARAMETER :: lai_threshold = 11. !! Lai threshold for the calculation of scattered radiation
+                                                  !! based on Guenther .et. al (1995) (m^2.m^{-2})
+
+                                              
+    ! Biogenic emissions
+    REAL(r_std),DIMENSION(kjpindex)          :: PAR                !! Photosynthetic active radiation, half of swdown
+                                                                   !! @tex ($\mu mol photons. m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: PARsun             !! PAR received by sun leaves
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: PARsh              !! PAR received by shaded leaves 
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: laisun             !! Leaf area index of Sun leaves (m^2.m^{-2})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: laish              !! Leaf area index of Shaded leaves (m^2.m^{-2}) 
+
+    CHARACTER(LEN=14)                        :: tleafsun_name      !! To store variables names for I/O
+    CHARACTER(LEN=13)                        :: tleafsh_name       !! To store variables names for I/O
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)  :: Tleafsun_temp      !! temporary sunlit leaf temperature matrix for writing
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)  :: Tleafsh_temp       !! temporary shade leaf temperature matrix for writing
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)  :: laisuntab          !! LAI of sun leaves per layer (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)  :: laishtab           !! LAI of shaded leaves per layer 
+    REAL(r_std),DIMENSION(kjpindex)          :: Fdf                !! Fraction of the radiation which is diffused (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex,nlai+1)   :: PARsuntab          !! PAR received by sun leaves over LAI layers
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nlai+1)   :: PARshtab           !! PAR received by shaded leaves over LAI layers
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex)          :: PARdf              !! Diffuse photosynthetic active radiation
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex)          :: PARdr              !! Direct photosynthetic active radiation
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex)          :: Trans              !! Atmospheric Transmissivity (unitless)
+
+!_ ================================================================================================================================
+        fco2 = 0.
+        fco2_wshort = 0.
+        fco2_wlong = 0.
+        Fdf(:) = 0.
+        PAR(:) = 0. 
+        PARsun(:,:) = 0. 
+        PARsh(:,:) = 0. 
+        laisun(:,:) = 0. 
+        laish(:,:) = 0. 
+        CRF(:,:) = 0.               
+        Trans(:) = 0.            
+        PARdf(:) = 0.           
+        PARdr(:) = 0.            
+        PARsuntab(:,:) = 0.        
+        PARshtab(:,:) = 0.        
+   
+
+        !! 0. mise a jour des variables pour le couplage avec inca 
+        veget_max_chem(:,:) = veget_max(:,:)
+        veget_chem(:,:) = veget(:,:) 
+        lai_chem(:,:) = lai(:,:) 
+        snow_chem(:) = snow(:) 
+
+    !! 1. Canopy radiative transfer model
+
+    !! Canopy radiative transfer model: takes into account light extinction through canopy
+    !! First need to calculate diffuse and direct radiation
+    !! Based on Andrew Friend radiative model (Global Ecology & Biogeography, 2001)
+    !! And Spitters et al. (Agricultural and Forest Meteorology, 1986)
+       
+    IF ( ok_radcanopy ) THEN
+
+       DO ji = 1, kjpindex
+          IF (coszang(ji) .GT. zero) THEN
+             day = julian_diff
+             !! 1.1 Extra-terrestrial solar irradiance at a plan parallel to Earh's surface
+             So(ji) = Sct*( un + 0.033*COS(360.*pi/180.*day/365.))*coszang(ji)
+             !! 1.2 Atmospheric transmissivity
+             Trans(ji) = swdown(ji)/So(ji)
+             !! 1.3 Empirical calculation of fraction diffuse from transmission based on Spitters et al. (1986)
+             Rfrac(ji) = 0.847 - 1.61*coszang(ji) + 1.04*(coszang(ji)**2.)
+             Kfrac(ji) = (1.47 - Rfrac(ji))/1.66      
+             IF (Trans(ji) .LE. 0.22) THEN
+                Fdf(ji) = un
+             ELSE IF (Trans(ji) .LE. 0.35) THEN
+                Fdf(ji) = un - 6.4*((Trans(ji) - 0.22)**2.) 
+             ELSE IF (Trans(ji) .LE. Kfrac(ji)) THEN
+                Fdf(ji) = 1.47 - 1.66*Trans(ji)
+             ELSE
+                Fdf(ji) = Rfrac(ji)
+             END IF
+             !! 1.4 Direct and diffuse sw radiation in W.m^{-2}
+             swdf(ji) = swdown(ji)*Fdf(ji)
+             swdr(ji) = swdown(ji)*(un-Fdf(ji))
+          ELSE
+             swdf(ji) = zero
+             swdr(ji) = zero
+          END IF
+
+          !! 1.5 PAR diffuse and direct in umol/m^2/s
+          PARdf(ji) = swdf(ji) * W_to_mmol * RG_to_PAR
+          PARdr(ji) = swdr(ji) * W_to_mmol * RG_to_PAR 
+       END DO
+
+       !! 1.6 Calculation of lai, parscat, parsh and parsun, laisun and laish !!?? define the terms
+       !! Based on Guenther et al. (JGR, 1995) and Norman (1982)
+       ! One-layer canopy model or multi-layer canopy model
+       IF (ok_multilayer) THEN 
+
+
+          ! Calculation PER LAYER
+          DO jl = 1, nlai+1
+            laitab(jl) = laimax*(EXP(lai_level_depth*(jl-1) - un)/(EXP(lai_level_depth*nlai) - un))
+
+         !introduction of the Spitter way to calculate radiation over the levels !!!!!!!
+             DO ji = 1, kjpindex
+                ! Coefficients calculation:
+                IF (ABS(ACOS(coszang(ji))) .LT. pi/2. .AND. coszang(ji) .NE. zero) THEN
+                   kbl = cluster*0.5/ABS(coszang(ji))
+                   rho = ((1-SQRT((1 - sigma)))/(1+SQRT((1 - sigma))))*(2/(1+1.6*ABS(coszang(ji))))
+                ELSE
+                   kbl = 0.
+                   rho = 0.
+                END IF 
+                kdf = cluster*0.8*SQRT((1 - sigma))
+                IF (ABS(ACOS(coszang(ji))) .LT. pi/2. .AND. coszang(ji) .NE. zero) THEN
+                   PARnotscat(ji,jl) = (1 - sigma)*PARdr(ji)*kbl*EXP(-SQRT((1 - sigma))*kbl*laitab(jl))
+                   PARabsdir(ji,jl) = (1 - rho)*SQRT((1 - sigma))*PARdr(ji)*kbl*EXP(-SQRT((1 - sigma))*kbl*laitab(jl))
+                   PARabsdiff(ji,jl) = (1 - rho)*PARdf(ji)*kdf*EXP(-kdf*laitab(jl))
+                   PARshtab(ji,jl) = (PARabsdiff(ji,jl) + (PARabsdir(ji,jl) - PARnotscat(ji,jl)))/(1 - sigma)
+                   PARsuntab(ji,jl) = PARshtab(ji,jl) + (1-sigma)*kbl*PARdr(ji)/(1 - sigma) 
+                   !correction using the equation (4) in Bodin et al 2012 and (7) or (8) in Spitter et al 1986 
+                   !using the extinction coefficient kbl = 0.5/coszang and not only 0.5
+                   IF (jl .NE. nlai+1) THEN
+                      laisuntabdep(ji,jl) =(laitab(jl+1)-laitab(jl))*EXP(-kbl*laitab(jl))
+                      laishtabdep(ji,jl) =(laitab(jl+1)-laitab(jl))*(1.-EXP(-kbl*laitab(jl)))
+                   ENDIF
+                ELSE
+                   PARshtab(ji,jl) = PARdf(ji)*kdf*EXP(-kdf*laitab(jl))
+                   PARsuntab(ji,jl) = 0.
+                   laisuntab(ji,jl) = 0. 
+                   laishtab(ji,jl) = laitab(jl)
+                   IF (jl .NE. nlai+1) THEN
+                      laisuntabdep(ji,jl) = 0.
+                      laishtabdep(ji,jl) = laitab(jl+1)-laitab(jl)
+                   ENDIF  
+                END IF
+             END DO
+          END DO
+
+
+
+       ! introduction of the Spitter way to calculate radiation over the levels !!!!!!!
+       ELSE
+          ! Calculation FOR one layer
+          DO jv = 1, nvm
+             DO ji = 1, kjpindex
+                IF (lai(ji,jv) .LE. lai_threshold) THEN
+                   PARscat(ji,jv) = 0.07*PARdr(ji)*(1.1 - 0.1*lai(ji,jv))*exp(-coszang(ji))
+                ELSE
+                   PARscat(ji,jv) = zero
+                END IF
+
+                IF (coszang(ji) .NE. zero ) THEN
+                   PARsh(ji,jv) = PARdf(ji)*exp(-0.5*((lai(ji,jv))**0.7)) + PARscat(ji,jv)
+                   PARsun(ji,jv) = PARdr(ji)*COS(60.*pi/180.)/coszang(ji) + PARsh(ji,jv)
+                ELSE
+                   PARsh(ji,jv) = PARdf(ji)*exp(-0.5*(lai(ji,jv)**0.7)) + PARscat(ji,jv)
+                   PARsun(ji,jv) = zero 
+                END IF
+                IF (ABS(ACOS(coszang(ji))) .LT. pi/2. .AND. coszang(ji) .NE. zero) THEN 
+                   ! calculation as in Lathiere (2005) = with correction removing lai in Guenther (1995)
+                   laisun(ji,jv) = (un - exp(-0.5*lai(ji,jv)/(coszang(ji))))*coszang(ji)/COS(60.*pi/180.)
+                   laish(ji,jv) = lai(ji,jv) - laisun(ji,jv)
+                ELSE
+                   laisun(ji,jv) = zero
+                   laish(ji,jv) = lai(ji,jv)
+                END IF
+             END DO
+          END DO
+       ENDIF
+    END IF
+
+
+    !! 2. Calculation of non-PFT dependant parameters used for VOC emissions
+    DO ji = 1, kjpindex ! (loop over # pixels)
+       !! 2.1 Calculation of Tleaf (based on Lathiere, 2005)
+
+
+       tleaf(ji) = temp_air(ji)
+
+       !! 2.2 Isoprene emission dependency - with no PARsun/PARshaded partitioning - Guenther et al. (1995) and Lathiere (2005)
+       !> @codeinc $$?? ecrire les equation en latex ? 
+       exp_1(ji) = exp( (CT1 * ( tleaf(ji) - TS )) / (RR*TS*tleaf(ji)) )
+       exp_2(ji) = exp( (CT2 *( tleaf(ji) - TM )) / (RR*TS*tleaf(ji)) )
+       PAR(ji)   = swdown(ji) * W_to_mmol * RG_to_PAR        ! from W/m^2 to umol photons/m^2/s and half of sw for PAR
+       Ct_iso(ji)    = exp_1(ji)/(un + exp_2(ji))            ! temperature dependance  
+       Cl_iso(ji)    = alpha_*CL1*PAR(ji)/sqrt(un + (alpha_**2) * (PAR(ji)**2) ) ! light dependance
+       !> @endcodeinc
+  
+       !! 2.3 Monoterpene and oxy VOB emission dependency to Temperature 
+       !!     light independant fraction
+       !> @codeinc
+       !Ct_mono(ji) = exp(beta*(tleaf(ji) - TS))  ! Old method
+       Ct_mono(ji) = exp(beta_mono*(tleaf(ji) - TS))
+       Ct_sesq(ji) = exp(beta_sesq*(tleaf(ji) - TS))
+       Ct_meth(ji) = exp(beta_meth*(tleaf(ji) - TS))
+       Ct_acet(ji) = exp(beta_acet*(tleaf(ji) - TS))
+       Ct_oxyVOC(ji) = exp(beta_oxyVOC*(tleaf(ji) - TS))     
+       !> @endcodeinc
+       !! 2.4 MBO biogenic emissions dependency, only from PFT7 and PFT4 for location of vegetation emitter
+       ! but in fact MBO fluxes only in America (ponderosa and lodgepole pines only found in these areas)
+       !> @codeinc
+       Xvar(ji) = ((un/312.3) - (un/tleaf(ji)))/RR
+       !> @endcodeinc
+       !! 2.4.1 temperature dependency
+       !> @codeinc
+       Ct_MBO(ji)    = (1.52*209000.0*exp(67000.0*Xvar(ji)))/(209000.0 - 67000.0*(un - exp(209000.0*Xvar(ji))))
+       !> @endcodeinc
+       !! 2.4.2 light dependency
+       Cl_MBO(ji)    = (0.0011*1.44*PAR(ji))/(sqrt(un + (0.0011**2)*(PAR(ji)**2)))
+       !! 2.5 NO biogenic emissions given in ngN/m^2/s, emission factor in ngN/m^2/s too
+       !! calculation of temperature used for NO soil emissions
+       t_no(ji) = ptnlev1(ji) - ZeroCelsius  !!temp must be in celsius to calculate no emissions
+       !! 2.6 calculation of non-woody veget_max fraction
+       IF (ok_cropsfertil_NOx) THEN
+          veget_max_nowoody(ji) = zero
+          DO jv = 1,nvm
+             IF ( (jv /= ibare_sechiba) .AND. .NOT.(is_tree(jv)) ) THEN
+                veget_max_nowoody(ji) = veget_max_nowoody(ji) + veget_max(ji,jv)
+             ENDIF
+          ENDDO
+       END IF
+    END DO ! (loop over # pixels)
+
+    !! 2bis. Calculation of CO2 function for inhibition effect on isoprene 
+    ! 2 approaches can be used: either Possell et al. (2005) or Wilkinson et al. (2006) 
+
+!! 19/04/2010 and then implemented in version revised by Nicolas Vuichard, 08042014
+!! Impact of atmospheric CO2 on isoprene emissions
+!! Can be activated or not
+!! If considered, can use either Possell 2005 or Wilkinson 2009 parameterisation 
+!! This is used to rescale the emission factor, considered to be measured at 350 ppm of CO2
+!! to the CO2 conditions of the run
+
+IF ( ok_co2bvoc_poss ) THEN
+   WRITE(numout,*) 'CO2 impact on isoprene: Possell calculation'
+
+   !! Possell function needs to be normalized (experiments at 400 ppm and EF before 1995)
+   !! Normalized at 350 ppm
+   fco2_ctrl = (-0.0123+(441.4795/350.)+(-1282.65/(350.**2)))
+
+   !! 2 tests: using the canopy (atmospheric) CO2 'ccanopy'
+   !! or the intercellular CO2 over nlai 'cim' 
+   !! with cim = ccanopy*0.667 
+   !! in the end I go for ccanopy for the Possell function since too much differences
+   !! when using cim and also the function has been derived based on atmospheric CO2
+   DO ji = 1, kjpindex
+
+      fco2(ji,:) = (-0.0123+(441.4795/ccanopy(ji))+(-1282.65/(ccanopy(ji)*ccanopy(ji))))/fco2_ctrl
+
+   END DO
+ELSE IF ( ok_co2bvoc_wilk ) THEN
+   WRITE(numout,*) 'CO2 impact on isoprene: Wilkinson calculation'
+
+   !! In the Wilkinson function, 2 impacts are considered:
+   !! -short-term impact for CO2 variation during a single day (seconds/minutes)
+   !! -long-term impact for CO2 variation during leaf-growth (weeks/month)
+
+
+   !! Long-term parameters
+   !! Constant
+   Ismax_long = 1.344
+   h_long = 1.4614
+   Cstar_long = 585.
+   !! Short-term parameters 
+   !! They have to be calculated based on atmospheric CO2
+   !! 10/05/2010
+   !! For atmospheric CO2 lower than 400 ppm or higher than 1200 ppm
+   !! (min and max CO2 level tested for short-term effect in Wilkinson et al. 2009)
+   !! we use the parameters calculated at 400/1200 ppm. For intermediate CO2 concentration,
+   !! parameters are calculated. 
+   !! Linear interpolation
+
+   DO ji = 1, kjpindex
+
+      IF (ccanopy(ji) .LE. 400.) THEN
+
+         Ismax_short(ji) = 1.072
+         h_short(ji) = 1.7
+         Cstar_short(ji) = 1218.
+
+      ELSE IF (ccanopy(ji) .EQ. 600.) THEN
+
+         Ismax_short(ji) = 1.036
+         h_short(ji) = 2.0125
+         Cstar_short(ji) = 1150.
+
+      ELSE IF (ccanopy(ji) .EQ. 800.) THEN
+
+         Ismax_short(ji) = 1.046
+         h_short(ji) = 1.5380
+         Cstar_short(ji) = 2025.
+
+      ELSE IF (ccanopy(ji) .GE. 1200.) THEN
+
+         Ismax_short(ji) = 1.014
+         h_short(ji) = 2.8610
+         Cstar_short(ji) = 1525.
+
+
+      ELSE IF ((ccanopy(ji) .GT. 400.) .AND. (ccanopy(ji) .LT. 600.)) THEN
+
+         Ismax_short(ji) = 1.036 + (ccanopy(ji)-600.)*(1.036-1.072)/(600.-400.)
+         h_short(ji) = 2.0125 + (ccanopy(ji)-600.)*(2.0125-1.7)/(600.-400.)
+         Cstar_short(ji) =  1150. + (ccanopy(ji)-600.)*(1150.-1218.)/(600.-400.)
+
+      ELSE IF ((ccanopy(ji) .GT. 600.) .AND. (ccanopy(ji) .LT. 800.)) THEN
+
+         Ismax_short(ji) = 1.046 + (ccanopy(ji)-800.)*(1.046-1.036)/(800.-600.)
+         h_short(ji) = 1.5380 + (ccanopy(ji)-800.)*(1.5380-2.0125)/(800.-600.)
+         Cstar_short(ji) = 2025. + (ccanopy(ji)-800.)*(2025.-1150.)/(800.-600.)
+
+      ELSE IF ((ccanopy(ji) .GT. 800.) .AND. (ccanopy(ji) .LT. 1200.)) THEN
+
+        Ismax_short(ji) = 1.014 + (ccanopy(ji)-1200.)*(1.014-1.046)/(1200.-800.)
+        h_short(ji) = 2.8610 + (ccanopy(ji)-1200.)*(2.8610-1.5380)/(1200.-800.)
+        Cstar_short(ji) = 1525. + (ccanopy(ji)-1200.)*(1525.-2025.)/(1200.-800.)
+
+
+      END IF
+
+   END DO
+
+   WRITE(numout,*) '***Wilkinson BVOC-CO2 function: parameters***'
+   WRITE(numout,*) 'Ismax_long: ', Ismax_long
+   WRITE(numout,*) 'h_long: ', h_long
+   WRITE(numout,*) 'Cstar_long: ', Cstar_long
+   WRITE(numout,*) 'Ismax_short: ', MAXVAL(Ismax_short(:)) , MINVAL(Ismax_short(:))
+   WRITE(numout,*) 'h_short: ', MAXVAL(h_short(:)) , MINVAL(h_short(:))
+   WRITE(numout,*) 'Cstar_short: ', MAXVAL(Cstar_short(:)) , MINVAL(Cstar_short(:))
+   WRITE(numout,*) '******'
+
+   DO ji = 1, kjpindex
+      fco2_wlong(ji) = (Ismax_long-((Ismax_long*((0.667*ccanopy(ji))**h_long))/&
+                     & ((Cstar_long**h_long)+(0.667*ccanopy(ji))**h_long)))/1.06566
+      DO jv = 1, nvm
+         fco2_wshort(ji,jv) = (Ismax_short(ji)-((Ismax_short(ji)*((cim(ji,jv))**h_short(ji)))/&
+                            & ((Cstar_short(ji)**h_short(ji))+(cim(ji,jv))**h_short(ji))))/1.010803
+      END DO
+   END DO
+
+   DO ji = 1, kjpindex
+      DO jv = 1, nvm
+         fco2(ji,jv) = fco2_wshort(ji,jv)*fco2_wlong(ji)
+      END DO
+   END DO
+
+ELSE
+      WRITE(numout,*) 'CO2 impact on isoprene not considered'
+      fco2(:,:) = 1.
+END IF
+
+
+    !! 3. Calculation of PFT dependant parameters and
+    ! Calculation of VOC emissions flux
+
+    Eff_age_iso(:,:) = zero
+    Eff_age_meth(:,:) = zero
+
+
+    DO jv = 1, nvm ! loop over the PDFs
+       DO ji = 1, kjpindex ! loop over the grid cell
+          ! 6-Calculation of Leaf Age Function (Lathiere 2005)
+          IF ( ok_leafage ) THEN
+             DO jf = 1, nleafages
+                !> @codeinc
+                Eff_age_iso(ji,jv) = Eff_age_iso(ji,jv) + frac_age(ji,jv,jf)*iso_activity(jf)
+                Eff_age_meth(ji,jv) = Eff_age_meth(ji,jv) + frac_age(ji,jv,jf)*methanol_activity(jf)
+                !> @endcodeinc 
+             END DO
+             !> @codeinc
+             Eff_age_VOC(ji,jv) = un
+             !> @endcodeinc
+          ELSE
+             Eff_age_iso(ji,jv) = un
+             Eff_age_meth(ji,jv) = un
+             Eff_age_VOC(ji,jv) = un
+          END IF
+          !! 5. Calculation of foliar density
+          IF ( sla(jv) .eq. zero ) THEN
+             fol_dens(ji,jv) = zero
+          ELSE
+             ! 2 factor for conversion from gC to gDM
+             fol_dens(ji,jv) = 2 * lai(ji,jv)/sla(jv)
+          ENDIF
+          !! 6. Calculation of VOC emissions from vegetation
+          IF ( ok_radcanopy ) THEN
+             ! if multi-layer canopy model
+             IF (ok_multilayer) THEN 
+
+                laisun(ji,jv) = zero
+                laish(ji,jv) = zero
+                GAMMA_iso_m  = zero
+                flx_iso(ji,jv) = zero
+                flx_mono(ji,jv) = zero
+                flx_apinen(ji,jv) = zero
+                flx_bpinen(ji,jv) = zero
+                flx_limonen(ji,jv) = zero
+                flx_myrcen(ji,jv) =  zero
+                flx_sabinen(ji,jv) =  zero
+                flx_camphen(ji,jv) = zero
+                flx_3caren(ji,jv) = zero
+                flx_tbocimen(ji,jv) = zero
+                flx_othermono(ji,jv) = zero
+                flx_sesquiter(ji,jv) =  zero
+                flx_methanol(ji,jv) = zero
+                flx_acetone(ji,jv) =  zero
+                flx_acetal(ji,jv) = zero
+                flx_formal(ji,jv) = zero
+                flx_acetic(ji,jv) = zero
+                flx_formic(ji,jv) = zero
+                ! loop over the NLAI canopy layers
+                DO jl = 1, nlai
+                   IF ((laitab(jl) .LE. lai(ji,jv)).AND.(lai(ji,jv).NE.zero)) THEN
+                      !sunlit vegetation 
+                      Clsun_iso_tab   = alpha_*CL1*PARsuntab(ji,jl)/sqrt(un + (alpha_**2) * (PARsuntab(ji,jl)**2) )
+                      ! shaded vegetation
+                      Clsh_iso_tab    = alpha_*CL1*PARshtab(ji,jl)/sqrt(un + (alpha_**2) * (PARshtab(ji,jl)**2) ) 
+                      flx_iso(ji,jv) = flx_iso(ji,jv) + (laisuntabdep(ji,jl)*Clsun_iso_tab+ &
+                           & laishtabdep(ji,jl)*Clsh_iso_tab)* &
+                           & fol_dens(ji,jv)/lai(ji,jv)*Ct_iso(ji)*em_factor_isoprene(jv)* &
+                           & Eff_age_iso(ji,jv)*fco2(ji,jv)*1e-9/one_hour
+
+                      GAMMA_iso_m = GAMMA_iso_m + (laisuntabdep(ji,jl)*Clsun_iso_tab+ &
+                           & laishtabdep(ji,jl)*Clsh_iso_tab)* &
+                           & fol_dens(ji,jv)/lai(ji,jv)*Ct_iso(ji)*1e-9/one_hour
+
+                      laisun(ji,jv) = laisun(ji,jv) + laisuntabdep(ji,jl)
+                      laish(ji,jv)  = laish(ji,jv) + laishtabdep(ji,jl)
+                   END IF
+                END DO
+
+                !! 6.1 Calculation of monoterpene biogenic emissions
+                flx_mono(ji,jv) = ((1-LDF_mono)*Ct_mono(ji)*1e-9/one_hour*fol_dens(ji,jv) + LDF_mono*GAMMA_iso_m)* &
+                     & em_factor_monoterpene(jv)*Eff_age_VOC(ji,jv) 
+                !! 6.12 Calculation of sesquiterpenes biogenic emission 
+                flx_sesquiter(ji,jv) = ((1-LDF_sesq)*Ct_sesq(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_sesq*GAMMA_iso_m)* &
+                     & em_factor_sesquiterp(jv)*Eff_age_VOC(ji,jv)
+                !! 6.13 Calculation of methanol biogenic emissions
+                flx_methanol(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_meth*GAMMA_iso_m)* &
+                     & em_factor_methanol(jv)*Eff_age_meth(ji,jv)
+                !! 6.14 Calculation of acetone biogenic emissions
+                flx_acetone(ji,jv) = ((1-LDF_acet)*Ct_acet(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_acet*GAMMA_iso_m)* &
+                     & em_factor_acetone(jv)*Eff_age_VOC(ji,jv)
+                !! 6.14 Calculation of acetaldehyde biogenic emissions
+                flx_acetal(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_meth*GAMMA_iso_m)* &
+                     & em_factor_acetal(jv)*Eff_age_VOC(ji,jv)
+                !! 6.16 Calculation of formaldehyde biogenic emissions
+                flx_formal(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_meth*GAMMA_iso_m)* &
+                     & em_factor_formal(jv)*Eff_age_VOC(ji,jv)
+                !! 6.17 Calculation of acetic acid biogenic emissions
+                flx_acetic(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_meth*GAMMA_iso_m)* &
+                     & em_factor_acetic(jv)*Eff_age_VOC(ji,jv)
+                !! 6.18 Calculation of formic acid biogenic emissions
+                flx_formic(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)*1e-9/one_hour*fol_dens(ji,jv) +LDF_meth*GAMMA_iso_m)* &
+                     & em_factor_formic(jv)*Eff_age_VOC(ji,jv)
+
+
+                !! 6.3 Calculation of alfa pinene biogenic emission 
+                flx_apinen(ji,jv) = em_factor_apinene(jv)*flx_mono(ji,jv) 
+                !! 6.4 Calculation of beta pinene biogenic emission 
+                flx_bpinen(ji,jv) = em_factor_bpinene(jv)*flx_mono(ji,jv) 
+                !! 6.5 Calculation of limonene biogenic emission 
+                flx_limonen(ji,jv) = em_factor_limonene(jv)*flx_mono(ji,jv) 
+                !! 6.6 Calculation of myrcene biogenic emission !! 
+                flx_myrcen(ji,jv) = em_factor_myrcene(jv)*flx_mono(ji,jv) 
+                !! 6.7 Calculation of sabinene biogenic emission
+                flx_sabinen(ji,jv) = em_factor_sabinene(jv)*flx_mono(ji,jv) 
+                !! 6.8 Calculation of camphene biogenic emission 
+                flx_camphen(ji,jv) = em_factor_camphene(jv)*flx_mono(ji,jv) 
+                !! 6.9 Calculation of 3-carene biogenic emission 
+                flx_3caren(ji,jv) = em_factor_3carene(jv)*flx_mono(ji,jv) 
+                !! 6.10 Calculation of t-beta-ocimene biogenic emission
+                flx_tbocimen(ji,jv) = em_factor_tbocimene(jv)*flx_mono(ji,jv) 
+                !! 6.11 Calculation of other monoterpenes biogenic emission
+                flx_othermono(ji,jv) = em_factor_othermonot(jv)*flx_mono(ji,jv) 
+
+                ! if mono-layer canopy model
+             ELSE
+                !sunlit vegetation 
+                Clsun_iso(ji,jv)   = alpha_*CL1*PARsun(ji,jv)/sqrt(un + (alpha_**2) * (PARsun(ji,jv)**2) )
+                ! shaded vegetation      
+                Clsh_iso(ji,jv)    = alpha_*CL1*PARsh(ji,jv)/sqrt(un + (alpha_**2) * (PARsh(ji,jv)**2) )       
+                IF (lai(ji,jv) .NE. zero) THEN
+                   !! 6.1 Calculation of isoprene biogenic emissions
+                   GAMMA_iso = (laisun(ji,jv)*Clsun_iso(ji,jv) + laish(ji,jv)*Clsh_iso(ji,jv))/lai(ji,jv)*Ct_iso(ji)
+                   flx_iso(ji,jv) = GAMMA_iso*fol_dens(ji,jv)*em_factor_isoprene(jv)*Eff_age_iso(ji,jv)*fco2(ji,jv)*1e-9/one_hour
+                   !! 6.2 Calculation of monoterpene biogenic emissions
+                   flx_mono(ji,jv) = ((1-LDF_mono)*Ct_mono(ji)+LDF_mono*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_monoterpene(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+                   !! 6.3 Calculation of alfa pinene biogenic emission 
+                   flx_apinen(ji,jv) = em_factor_apinene(jv)*flx_mono(ji,jv)
+                   !! 6.4 Calculation of beta pinene biogenic emission 
+                   flx_bpinen(ji,jv) = em_factor_bpinene(jv)*flx_mono(ji,jv)
+                   !! 6.5 Calculation of limonene biogenic emission 
+                   flx_limonen(ji,jv) = em_factor_limonene(jv)*flx_mono(ji,jv)
+                   !! 6.6 Calculation of myrcene biogenic emission 
+                   flx_myrcen(ji,jv) = em_factor_myrcene(jv)*flx_mono(ji,jv)
+                   !! 6.7 Calculation of sabinene biogenic emission 
+                   flx_sabinen(ji,jv) = em_factor_sabinene(jv)*flx_mono(ji,jv)
+                   !! 6.8 Calculation of camphene biogenic emission 
+                   flx_camphen(ji,jv) = em_factor_camphene(jv)*flx_mono(ji,jv)
+                   !! 6.9 Calculation of 3-carene biogenic emission 
+                   flx_3caren(ji,jv) = em_factor_3carene(jv)*flx_mono(ji,jv)
+                   !! 6.10 Calculation of t-beta-ocimene biogenic emission 
+                   flx_tbocimen(ji,jv) = em_factor_tbocimene(jv)*flx_mono(ji,jv)
+                   !! 6.11 Calculation of other monoterpenes biogenic emission 
+                   flx_othermono(ji,jv) = em_factor_othermonot(jv)*flx_mono(ji,jv)
+                   !! 6.12 Calculation of sesquiterpenes biogenic emission 
+                   flx_sesquiter(ji,jv) = ((1-LDF_sesq)*Ct_sesq(ji)+LDF_sesq*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_sesquiterp(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+                   !! 6.13 Calculation of methanol biogenic emissions
+                   flx_methanol(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)+LDF_meth*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_methanol(jv)*Eff_age_meth(ji,jv)*1e-9/one_hour
+                   !! 6.14 Calculation of acetone biogenic emissions
+                   flx_acetone(ji,jv) = ((1-LDF_acet)*Ct_acet(ji)+LDF_acet*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_acetone(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+                   !! 6.15 Calculation of acetaldehyde biogenic emissions
+                   flx_acetal(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)+LDF_meth*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_acetal(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+                   !! 6.16 Calculation of formaldehyde biogenic emissions
+                   flx_formal(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)+LDF_meth*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_formal(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+                   !! 6.17 Calculation of acetic acid biogenic emissions
+                   flx_acetic(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)+LDF_meth*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_acetic(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+                   !! 6.18 Calculation of formic acid biogenic emissions
+                   flx_formic(ji,jv) = ((1-LDF_meth)*Ct_meth(ji)+LDF_meth*GAMMA_iso)*fol_dens(ji,jv)* &
+                        & em_factor_formic(jv)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+ 
+                ELSE
+                   ! 
+                   flx_iso(ji,jv) = zero
+                   flx_mono(ji,jv) = zero
+                   flx_apinen(ji,jv) = zero 
+                   flx_bpinen(ji,jv) = zero 
+                   flx_limonen(ji,jv) = zero 
+                   flx_myrcen(ji,jv) =  zero
+                   flx_sabinen(ji,jv) =  zero 
+                   flx_camphen(ji,jv) = zero 
+                   flx_3caren(ji,jv) = zero 
+                   flx_tbocimen(ji,jv) = zero
+                   flx_othermono(ji,jv) = zero 
+                   flx_sesquiter(ji,jv) =  zero 
+                   flx_methanol(ji,jv) = zero
+                   flx_acetone(ji,jv) =  zero 
+                   flx_acetal(ji,jv) = zero
+                   flx_formal(ji,jv) = zero 
+                   flx_acetic(ji,jv) = zero 
+                   flx_formic(ji,jv) = zero 
+                END IF
+             END IF
+             ! if no light extinction due to vegetation  
+          ELSE
+             !! Isoprene emissions - general equation
+             flx_iso(ji,jv) = fol_dens(ji,jv)*Ct_iso(ji)*Cl_iso(ji)*Eff_age_iso(ji,jv)*fco2(ji,jv)* &
+                  em_factor_isoprene(jv)*1e-9/one_hour
+             !! 6.2 Calculation of monoterpene biogenic emissions
+             Ylt_mono(ji) = ((1-LDF_mono)*Ct_mono(ji)+LDF_mono*Ct_iso(ji)*Cl_iso(ji)) 
+             flx_mono(ji,jv) = fol_dens(ji,jv)*em_factor_monoterpene(jv)*Ylt_mono(ji)*Eff_age_VOC(ji,jv)*&
+                  1e-9/one_hour
+             !! 6.3 Calculation of alfa pinene biogenic emission 
+             flx_apinen(ji,jv) = em_factor_apinene(jv)*flx_mono(ji,jv)  
+             !! 6.4 Calculation of beta pinene biogenic emission 
+             flx_bpinen(ji,jv) = em_factor_bpinene(jv)*flx_mono(ji,jv)                       
+             !! 6.5 Calculation of limonene biogenic emission 
+             flx_limonen(ji,jv) = em_factor_limonene(jv)*flx_mono(ji,jv)                      
+             !! 6.6 Calculation of myrcene biogenic emission 
+             flx_myrcen(ji,jv) = em_factor_myrcene(jv)*flx_mono(ji,jv)                       
+             !! 6.7 Calculation of sabinene biogenic emission 
+             flx_sabinen(ji,jv) = em_factor_sabinene(jv)*flx_mono(ji,jv)           
+             !! 6.8 Calculation of camphene biogenic emission 
+             flx_camphen(ji,jv) = em_factor_camphene(jv)*flx_mono(ji,jv)
+             !! 6.9 Calculation of 3-carene biogenic emission 
+             flx_3caren(ji,jv) = em_factor_3carene(jv)*flx_mono(ji,jv)                       
+             !! 6.10 Calculation of t-beta-ocimene biogenic emission 
+             flx_tbocimen(ji,jv) = em_factor_tbocimene(jv)*flx_mono(ji,jv)                     
+             !! 6.11 Calculation of other monoterpenes biogenic emission 
+             flx_othermono(ji,jv) = em_factor_othermonot(jv)*flx_mono(ji,jv)                    
+             !! 6.12 Calculation of sesquiterpenes biogenic emission 
+             Ylt_sesq(ji) = ((1-LDF_sesq)*Ct_sesq(ji)+LDF_sesq*Ct_iso(ji)*Cl_iso(ji))
+             flx_sesquiter(ji,jv) = fol_dens(ji,jv)*em_factor_sesquiterp(jv)*Ylt_sesq(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour    
+             !! 6.16 Calculation of methanol biogenic emissions
+             Ylt_meth(ji) = ((1-LDF_meth)*Ct_meth(ji)+LDF_meth*Ct_iso(ji)*Cl_iso(ji))
+             flx_methanol(ji,jv) = fol_dens(ji,jv)*em_factor_methanol(jv)*Ylt_meth(ji)*Eff_age_meth(ji,jv)*1e-9/one_hour
+             !! 6.17 Calculation of acetone biogenic emissions
+             Ylt_acet(ji) = ((1-LDF_acet)*Ct_acet(ji)+LDF_acet*Ct_iso(ji)*Cl_iso(ji))
+             flx_acetone(ji,jv) = fol_dens(ji,jv)*em_factor_acetone(jv)*Ylt_acet(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+             !! 6.18 Calculation of acetaldehyde biogenic emissions
+             flx_acetal(ji,jv) = fol_dens(ji,jv)*em_factor_acetal(jv)*Ylt_meth(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+             !! 6.19 Calculation of formaldehyde biogenic emissions
+             flx_formal(ji,jv) = fol_dens(ji,jv)*em_factor_formal(jv)*Ylt_meth(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+             !! 6.20 Calculation of acetic acid biogenic emissions
+             flx_acetic(ji,jv) = fol_dens(ji,jv)*em_factor_acetic(jv)*Ylt_meth(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+             !! 6.21 Calculation of formic acid biogenic emissions
+             flx_formic(ji,jv) = fol_dens(ji,jv)*em_factor_formic(jv)*Ylt_meth(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+
+          END IF
+
+          !! 6.22 Calculation of ORVOC biogenic emissions
+          !! Other Reactive Volatile Organic Compounds
+          !> @codeinc
+          flx_ORVOC(ji,jv) = fol_dens(ji,jv)*em_factor_ORVOC(jv)*Ct_mono(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          !> @endcodeinc
+          !! 6.4 Calculation of OVOC biogenic emissions
+          !! Other Volatile Organic Compounds
+          flx_OVOC(ji,jv) = fol_dens(ji,jv)*em_factor_OVOC(jv)*Ct_mono(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          !! 6.5 Calculation of MBO biogenic emissions
+          !! 2-Methyl-3-Buten-2-ol 
+          IF(lalo(ji,1) .GE. 20. .AND. lalo(ji,2) .LE. -100) THEN
+             flx_MBO(ji,jv) = fol_dens(ji,jv)*em_factor_MBO(jv)*Ct_MBO(ji)*Cl_MBO(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          ELSE
+             flx_MBO(ji,jv) = zero
+          END IF
+       END DO
+
+    END DO
+
+
+    !! 7. Calculation of NOx emissions from soils
+    ! Based on Yienger & Levy (1995) and Lathiere (2005, chapter 3)
+    DO ji = 1, kjpindex
+       !! 7.1 Precipitation-related pulse function
+       IF (ok_pulse_NOx) THEN
+          ! if we are during a period where pulses are not allowed
+          IF (ok_siesta(ji)) THEN
+             ! if this period is not over 
+             IF (FLOOR(siestaday(ji)) .LE. siestalim(ji)) THEN
+                siestaday(ji) = siestaday(ji) + (dt_sechiba/one_day)
+                ! if this period is over
+             ELSE
+                ok_siesta(ji) = .FALSE.
+                siestaday(ji) = zero
+             END IF
+          END IF
+          ! if we are during a period where pulses are allowed
+          IF ((.NOT. ok_siesta(ji)) .AND. (.NOT. allow_pulse(ji))) THEN
+             IF (humrel(ji,1) .LT. 0.15) THEN
+                ! if precip exceeds 1 mm/day over one time step => a pulse occurs
+                IF(precip_rain(ji)/nbre_precip .GE. un/(one_day/dt_sechiba)) THEN
+                   ! if precip is up to 5 mm/day => pulse length is 3 days
+                   IF (precip_rain(ji)/nbre_precip .LT. 5./(one_day/dt_sechiba)) THEN
+                      pulselim(ji) = 3.
+                      ! if precip is up to 15 mm/day => pulse length is 7 days
+                   ELSE IF (precip_rain(ji)/nbre_precip .LT. 15./(one_day/dt_sechiba)) THEN
+                      pulselim(ji) = 7.
+                      ! if precip is upper than 15 mm/day => pulse length is 14 days
+                   ELSE IF (precip_rain(ji)/nbre_precip .GE. 15./(one_day/dt_sechiba)) THEN
+                      pulselim(ji) = 14.
+                   END IF
+                   allow_pulse(ji)=.TRUE.
+                   pulseday(ji) = un
+                END IF
+             END IF
+          END IF
+          ! if we were during a pulse period
+          IF (allow_pulse(ji)) THEN
+             ! if we are still during the pulse period
+             ! 16/06/2010 We assume a (pulselim-1) days for the pulse length (NVui+Jlath)
+             IF(FLOOR(pulseday(ji)) .LT. pulselim(ji)) THEN
+                ! calculation of the pulse function
+                IF (pulselim(ji).EQ.3) THEN
+                   pulse(ji) = 11.19*exp(-0.805*pulseday(ji))
+                ELSE IF (pulselim(ji).EQ.7) THEN
+                   pulse(ji) = 14.68*exp(-0.384*pulseday(ji))
+                ELSE IF (pulselim(ji).EQ.14) THEN 
+                   pulse(ji) = 18.46*exp(-0.208*pulseday(ji))
+                END IF
+                pulseday(ji) = pulseday(ji) + (dt_sechiba/one_day)
+                ! if the pulse period is over
+             ELSE
+                ! pulse function is set to 1 
+                pulse(ji) = un
+                allow_pulse(ji) = .FALSE.
+                siestaday(ji) = un
+                siestalim(ji) = pulselim(ji)
+                ok_siesta(ji) = .TRUE. 
+             END IF
+          END IF
+          ! no precipitation-related pulse function
+       ELSE
+          pulse(ji) = un
+       END IF
+    END DO
+
+    !! 7.2 Calculation of NO basal emissions including pulse effect
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          !Tropical forests
+          IF ( is_tropical(jv) .AND. is_evergreen(jv) ) THEN
+             ! Wet soils
+             IF (humrel(ji,1) .GT. 0.3) THEN
+                flx_no_soil(ji,jv) = 2.6*pulse(ji)
+                ! Dry soils
+             ELSE
+                flx_no_soil(ji,jv) = 8.6*pulse(ji)
+             END IF
+             !Else If agricultural lands OR Wet soils
+          ELSE IF ( ( .NOT.(natural(jv)) ) .OR. ( humrel(ji,1) .GT. 0.3 ) ) THEN
+             ! Calculation of NO emissions depending of Temperature
+             IF (t_no(ji) .LT. zero) THEN
+                flx_no_soil(ji,jv) = zero
+             ELSE IF (t_no(ji) .LE. 10.) THEN
+                flx_no_soil(ji,jv) = 0.28*em_factor_no_wet(jv)*t_no(ji)*pulse(ji)
+             ELSE IF (t_no(ji) .LE. 30.) THEN
+                flx_no_soil(ji,jv) = em_factor_no_wet(jv)*exp(0.103*t_no(ji))*pulse(ji)
+             ELSE
+                flx_no_soil(ji,jv) = 21.97*em_factor_no_wet(jv)*pulse(ji)
+             END IF
+             !Else if Temp negative
+          ELSE IF (t_no(ji) .LT. zero) THEN
+             flx_no_soil(ji,jv) = zero
+             !Else if Temp <= 30
+          ELSE IF (t_no(ji) .LE. 30.) THEN
+             flx_no_soil(ji,jv) = (em_factor_no_dry(jv)*t_no(ji))/30.*pulse(ji)
+          ELSE
+             flx_no_soil(ji,jv) = em_factor_no_dry(jv)*pulse(ji)
+          END IF
+
+          !! 7.3 IF ACTIVATED (ok_bbgfertil_NOx = TRUE) calculation of NOx soil emission increase due to biomass burning
+          ! Calculation of Biomass-Burning-induced NOx emissions (Lathiere, 2005)
+          ! => NOx emissions 3-fold increase
+          IF (ok_bbgfertil_NOx) THEN
+             IF ( natural(jv) ) THEN
+                ! North Tropical zone from May to June
+                IF ((lalo(ji,1) .LE. 30. .AND. lalo(ji,1) .GE. zero).AND. &
+                     (day .GE. 121. .AND. day .LE. 181).AND.(flx_co2_bbg_year(ji) .GT. 0.1)) THEN
+                   flx_no_soil(ji,jv) = flx_no_soil(ji,jv)*3.
+                   ! South Tropical zone from November to December
+                ELSE IF ((lalo(ji,1) .GE. -30. .AND. lalo(ji,1) .LT. zero).AND.(day .GE. 305.).AND. & 
+                        (flx_co2_bbg_year(ji) .GT. 0.1)) THEN
+                   flx_no_soil(ji,jv) = flx_no_soil(ji,jv)*3.
+                END IF
+             END IF
+          END IF
+
+          !! 7.4 IF ACTIVATED (ok_cropsfertil_NOx = TRUE) calculation of NOx soil emission increase due to fertilizer use 
+          ! Calculation of N-fertiliser-induced NOx emissions
+          flx_fertil_no(ji,jv) = zero
+          IF (ok_cropsfertil_NOx) THEN
+             IF (veget_max_nowoody(ji) .NE. zero) THEN
+                ! Non-agricultural lands
+                IF ( (jv == ibare_sechiba) .OR. is_tree(jv) ) THEN
+                   N_qt_WRICE_pft(ji,jv) = zero
+                   N_qt_OTHER_pft(ji,jv) = zero
+                ! Grasslands or Croplands
+                ELSE
+                   N_qt_WRICE_pft(ji,jv) = N_qt_WRICE_year(ji)*veget_max(ji,jv)/veget_max_nowoody(ji)
+                   N_qt_OTHER_pft(ji,jv) = N_qt_OTHER_year(ji)*veget_max(ji,jv)/veget_max_nowoody(ji)
+                END IF
+             ELSE
+                N_qt_WRICE_pft(ji,jv) = zero
+                N_qt_OTHER_pft(ji,jv) = zero
+             END IF
+
+             ! North temperate regions from May to August
+             ! OR South Temperate regions from November to February
+             IF (((lalo(ji,1) .GT. 30.) .AND. (day .GE. 121. .AND. day .LE. 243.).AND.(veget_max(ji,jv) .NE. zero)) .OR. & 
+             &  ((lalo(ji,1) .LT. -30.) .AND. (day .GE. 305. .OR. day .LE. 59.) .AND.(veget_max(ji,jv) .NE. zero))) THEN
+                ! 1e12 for conversion from kg to Ng
+                ! 1/(365/12*24*60*60*4) for conversion from year to seconds corrected for 4 months of emissions
+                flx_fertil_no(ji,jv) = (N_qt_WRICE_pft(ji,jv)*(1/30.)+N_qt_OTHER_pft(ji,jv))*(2.5/100.) &
+                     & *1e12/(365*24*60*60*4/12)/(area2(ji)*veget_max(ji,jv))
+                ! OR Tropical regions all the year
+             ELSE IF ((lalo(ji,1) .GE. -30.).AND.(lalo(ji,1) .LE. 30.).AND.(veget_max(ji,jv) .NE. zero)) THEN
+                flx_fertil_no(ji,jv) = (N_qt_WRICE_pft(ji,jv)*(1/30.)+N_qt_OTHER_pft(ji,jv))*(2.5/100.) &
+                     & *1e12/(365*24*60*60)/(area2(ji)*veget_max(ji,jv))
+             END IF
+             flx_no_soil(ji,jv) = flx_no_soil(ji,jv) + flx_fertil_no(ji,jv)
+          END IF
+
+          !! 7.5 Calculation of net NO flux above soil accounting for surface deposition, 
+          !! based on the Canopy Reduction Factor (CRF), calculated using Leaf Area and Stomatal Area
+          !kc=cuticle absorptivity = 0.24m^2/m^2
+          !ks=stomatal absorptivity = 8.75m^2/m^2
+          !Larch=Larcher SAI/LAI ratio given in Larcher 1991
+          !> @codeinc
+          CRF(ji,jv) = (exp(-8.75*Larch(jv)*lai(ji,jv)) + exp(-0.24*lai(ji,jv)))/2.
+          flx_no(ji,jv) = flx_no_soil(ji,jv)*CRF(ji,jv)
+          !> @endcodeinc
+       END DO
+    END DO
+
+
+    ! Write output with XIOS
+    CALL xios_orchidee_send_field("PAR",PAR)
+    CALL xios_orchidee_send_field("flx_fertil_no",flx_fertil_no)
+    CALL xios_orchidee_send_field("flx_iso",flx_iso)
+    CALL xios_orchidee_send_field("flx_mono",flx_mono)
+    CALL xios_orchidee_send_field("flx_ORVOC",flx_ORVOC)
+    CALL xios_orchidee_send_field("flx_MBO",flx_MBO)
+    CALL xios_orchidee_send_field("flx_methanol",flx_methanol)
+    CALL xios_orchidee_send_field("flx_acetone",flx_acetone)
+    CALL xios_orchidee_send_field("flx_acetal",flx_acetal)
+    CALL xios_orchidee_send_field("flx_formal",flx_formal)
+    CALL xios_orchidee_send_field("flx_acetic",flx_acetic)
+    CALL xios_orchidee_send_field("flx_formic",flx_formic)
+    CALL xios_orchidee_send_field("flx_no_soil",flx_no_soil)
+    CALL xios_orchidee_send_field("flx_no",flx_no)
+    CALL xios_orchidee_send_field('flx_apinen'   , flx_apinen)
+    CALL xios_orchidee_send_field('flx_bpinen'   , flx_bpinen)
+    CALL xios_orchidee_send_field('flx_limonen'  ,flx_limonen)
+    CALL xios_orchidee_send_field('flx_myrcen'   , flx_myrcen)
+    CALL xios_orchidee_send_field('flx_sabinen'  ,flx_sabinen)
+    CALL xios_orchidee_send_field('flx_camphen'  ,flx_camphen)
+    CALL xios_orchidee_send_field('flx_3caren'   , flx_3caren)
+    CALL xios_orchidee_send_field('flx_tbocimen' ,flx_tbocimen)
+    CALL xios_orchidee_send_field('flx_othermono',flx_othermono)
+    CALL xios_orchidee_send_field('flx_sesquiter',flx_sesquiter)
+    CALL xios_orchidee_send_field("CRF",CRF)
+    CALL xios_orchidee_send_field('fco2', fco2)
+
+    IF ( ok_radcanopy ) THEN
+       CALL xios_orchidee_send_field("PARdf",PARdf)
+       CALL xios_orchidee_send_field("PARdr",PARdr)
+       
+       IF (ok_multilayer) THEN
+          CALL xios_orchidee_send_field("PARsuntab",PARsuntab)
+          CALL xios_orchidee_send_field("PARshtab",PARshtab)
+       ELSE
+          CALL xios_orchidee_send_field("PARsun",PARsun)
+          CALL xios_orchidee_send_field("PARsh",PARsh)
+          CALL xios_orchidee_send_field("laisun",laisun)
+          CALL xios_orchidee_send_field("laish",laish)
+       ENDIF
+    ENDIF
+
+    IF ( ok_bbgfertil_Nox ) THEN
+       CALL xios_orchidee_send_field("flx_co2_bbg_year",flx_co2_bbg_year)
+    END IF
+
+    IF ( ok_cropsfertil_Nox ) THEN
+       CALL xios_orchidee_send_field("N_qt_WRICE_year",N_qt_WRICE_year)
+       CALL xios_orchidee_send_field("N_qt_OTHER_year",N_qt_OTHER_year)
+    END IF
+    
+
+    ! Write output with IOIPSL
+    IF ( .NOT. almaoutput ) THEN
+
+       CALL histwrite_p(hist_id, 'PAR', kjit, PAR, kjpindex, index)
+       IF ( ok_radcanopy ) THEN
+          CALL histwrite_p(hist_id, 'laisun', kjit, laisun, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'laish', kjit, laish, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'Fdf', kjit, Fdf, kjpindex, index)
+          IF (ok_multilayer) THEN 
+             CALL histwrite_p(hist_id, 'PARsuntab', kjit, PARsuntab, kjpindex*(nlai+1), indexlai)
+             CALL histwrite_p(hist_id, 'PARshtab', kjit, PARshtab, kjpindex*(nlai+1), indexlai)
+          ELSE
+             CALL histwrite_p(hist_id, 'PARsun', kjit, PARsun, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist_id, 'PARsh', kjit, PARsh, kjpindex*nvm, indexveg)
+          END IF
+          CALL histwrite_p(hist_id, 'coszang', kjit, coszang, kjpindex, index)
+          CALL histwrite_p(hist_id, 'PARdf', kjit, PARdf, kjpindex, index)
+          CALL histwrite_p(hist_id, 'PARdr', kjit, PARdr, kjpindex, index)
+          CALL histwrite_p(hist_id, 'Trans', kjit, Trans, kjpindex, index)
+       END IF
+       CALL histwrite_p(hist_id, 'flx_fertil_no', kjit, flx_fertil_no, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'CRF', kjit, CRF, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'fco2', kjit, fco2, kjpindex*nvm, indexveg)
+
+       IF ( ok_bbgfertil_Nox ) THEN
+          CALL histwrite_p(hist_id, 'flx_co2_bbg_year', 1, flx_co2_bbg_year, kjpindex, index)
+       ENDIF
+       IF ( ok_cropsfertil_Nox ) THEN
+          CALL histwrite_p(hist_id, 'N_qt_WRICE_year', 1, N_qt_WRICE_year, kjpindex, index)
+          CALL histwrite_p(hist_id, 'N_qt_OTHER_year', 1, N_qt_OTHER_year, kjpindex, index)
+       ENDIF
+       CALL histwrite_p(hist_id, 'flx_iso', kjit, flx_iso, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_mono', kjit, flx_mono, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_apinen', kjit, flx_apinen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_bpinen', kjit, flx_bpinen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_limonen', kjit, flx_limonen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_myrcen', kjit, flx_myrcen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_sabinen', kjit, flx_sabinen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_camphen', kjit, flx_camphen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_3caren', kjit, flx_3caren, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_tbocimen', kjit, flx_tbocimen, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_othermono', kjit, flx_othermono, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_sesquiter', kjit, flx_sesquiter, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_ORVOC', kjit, flx_ORVOC, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_MBO', kjit, flx_MBO, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_methanol', kjit, flx_methanol, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_acetone', kjit, flx_acetone, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_acetal', kjit, flx_acetal, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_formal', kjit, flx_formal, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_acetic', kjit, flx_acetic, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_formic', kjit, flx_formic, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_no_soil', kjit, flx_no_soil, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'flx_no', kjit, flx_no, kjpindex*nvm, indexveg)
+       
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'PAR', kjit, PAR, kjpindex, index)
+          IF ( ok_radcanopy ) THEN
+             CALL histwrite_p(hist2_id, 'PARsun', kjit, PARsun, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'PARsh', kjit, PARsh, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'laisun', kjit, laisun, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'laish', kjit, laish, kjpindex*nvm, indexveg)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'flx_fertil_no', kjit, flx_fertil_no, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'CRF', kjit, CRF, kjpindex*nvm, indexveg)
+          IF ( ok_bbgfertil_Nox ) THEN
+             CALL histwrite_p(hist2_id, 'flx_co2_bbg_year', 1, flx_co2_bbg_year, kjpindex, index)
+          ENDIF
+          IF ( ok_cropsfertil_Nox ) THEN
+             CALL histwrite_p(hist2_id, 'N_qt_WRICE_year', 1, N_qt_WRICE_year, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'N_qt_OTHER_year', 1, N_qt_OTHER_year, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'flx_iso', kjit, flx_iso, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_mono', kjit, flx_mono, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_apinen', kjit, flx_apinen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_bpinen', kjit, flx_bpinen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_limonen', kjit, flx_limonen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_myrcen', kjit, flx_myrcen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_sabinen', kjit, flx_sabinen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_camphen', kjit, flx_camphen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_3caren', kjit, flx_3caren, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_tbocimen', kjit, flx_tbocimen, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_othermono', kjit, flx_othermono, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_sesquiter', kjit, flx_sesquiter, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_ORVOC', kjit, flx_ORVOC, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_MBO', kjit, flx_MBO, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_methanol', kjit, flx_methanol, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_acetone', kjit, flx_acetone, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_acetal', kjit, flx_acetal, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_formal', kjit, flx_formal, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_acetic', kjit, flx_acetic, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_formic', kjit, flx_formic, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_no_soil', kjit, flx_no_soil, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'flx_no', kjit, flx_no, kjpindex*nvm, indexveg)
+       ENDIF
+    ENDIF
+
+    IF (printlev>=3) WRITE(numout,*) 'OK chemistry_bvoc'
+
+
+  END SUBROUTINE chemistry_bvoc
+
+!! ================================================================================================================================
+!! SUBROUTINE   : chemistry_read
+!!
+!>\BRIEF         This subroutine will read and interpolate the data set of CO2 emissions from biomass burning.\n
+!!
+!! DESCRIPTION  :  This subroutine will interpolate the 1 x 1 deg based data set of CO2 emissions from biomass burning
+!!                 expresssed in kgC/m^2 per year (=> density = TRUE), N fertiliser amount expressed in kgN per year and
+!!                 per grid cell (=> density = FALSE) to the resolution of the model.\ n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: data_year
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+  SUBROUTINE chemistry_read_p (nbpt,     lalo,      neighbours, resolution, &
+                               filename, fieldname, density,    data_year)
+
+    USE mod_orchidee_para
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)       :: nbpt                !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)          :: lalo(nbpt,2)        !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)       :: neighbours(nbpt,8)  !! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std), INTENT(in)          :: resolution(nbpt,2)  !! The size in m of each grid-box in X and Y 
+    CHARACTER(LEN=*), INTENT(in)     :: filename
+    CHARACTER(LEN=*), INTENT(in)     :: fieldname
+    LOGICAL, INTENT(in)              :: density
+
+    !! 0.2 Output variables
+
+    REAL(r_std), INTENT(out), dimension(nbpt) :: data_year  !! data per year (climatology) per unit area 
+
+    !! 0.3 Modified variables
+
+
+    REAL(r_std), dimension(nbp_glo) :: data_year_g
+
+
+    CALL gather(lalo,lalo_g)
+    call gather(neighbours, neighbours_g) 
+    call gather(resolution,resolution_g) 
+
+    IF (is_root_prc) CALL chemistry_read (&
+         nbp_glo, lalo_g, neighbours_g, resolution_g, &
+         filename, fieldname, density, data_year_g)
+    CALL scatter(data_year_g, data_year) 
+
+
+  END SUBROUTINE chemistry_read_p
+
+
+  SUBROUTINE chemistry_read (nbpt, lalo, neighbours, resolution, filename, fieldname, density, data_year)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)       :: nbpt                !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)          :: lalo(nbpt,2)        !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)       :: neighbours(nbpt,8)  !! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std), INTENT(in)          :: resolution(nbpt,2)  !! The size in m of each grid-box in X and Y 
+    CHARACTER(LEN=*), INTENT(in)     :: filename
+    CHARACTER(LEN=*), INTENT(in)     :: fieldname
+    LOGICAL, INTENT(in)              :: density
+
+    !! 0.2 Output variables
+
+    REAL(r_std), INTENT(out), DIMENSION(nbpt) :: data_year  !! data per year (climatology) per unit area 
+
+
+
+    !! 0.4 Local variables 
+
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, ilf, lastjp, nbexp
+    REAL(r_std) :: lev(1), date, dt, coslat
+    REAL(r_std) :: lon_up, lon_low, lat_up, lat_low
+    INTEGER(i_std) :: itau(1)
+    INTEGER(i_std) :: ier
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_rel, lon_rel, lat_ful, lon_ful
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: data_year_file
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: loup_rel, lolow_rel, laup_rel, lalow_rel
+    REAL(r_std) :: area2                                     !! total area of the final grid box 
+    REAL(r_std) :: data_grid                                 !! emissions for the final grid point before being 
+                                                             !! ponderated by area2
+    REAL(r_std) :: data_global                               !! global emissions to check
+    REAL(r_std) :: ax, ay, sgn, surp, ax_file, ay_file
+    REAL(r_std) :: lonrel, louprel, lolowrel
+
+!_ ================================================================================================================================
+
+    !
+    !
+    CALL flininfo(filename,iml, jml, lml, tml, fid)
+    !
+    !
+    ALLOCATE (lat_rel(iml,jml), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_read','Problem in allocate of variable lat_rel','','')
+    ALLOCATE (lon_rel(iml,jml), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_read','Problem in allocate of variable lon_rel','','')
+    ALLOCATE (laup_rel(iml,jml), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_read','Problem in allocate of variable laup_rel','','')
+    ALLOCATE (loup_rel(iml,jml), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_read','Problem in allocate of variable loup_rel','','')
+    ALLOCATE (lalow_rel(iml,jml), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_read','Problem in allocate of variable lalow_rel','','')
+    ALLOCATE (lolow_rel(iml,jml), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_read','Problem in allocate of variable lolow_rel','','')
+    ALLOCATE (lat_ful(iml+2,jml+2), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_read','Problem in allocate of variable lat_ful','','')
+    ALLOCATE (lon_ful(iml+2,jml+2), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_read','Problem in allocate of variable lon_ful','','')
+    ALLOCATE (data_year_file(iml,jml), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'chemistry_read','Problem in allocate of variable data_year_file','','')
+    !
+    CALL flinopen(filename, .FALSE., iml, jml, lml, lon_rel, lat_rel, lev, tml, itau, date, dt, fid)
+    !
+    CALL flinget(fid, trim(fieldname), iml, jml, lml, tml, 1, 1, data_year_file)
+    !
+    CALL flinclo(fid)
+    !
+    nbexp = 0
+    !
+    !    Duplicate the border assuming we have a global grid going from west to east
+    !
+    lon_ful(2:iml+1,2:jml+1) = lon_rel(1:iml,1:jml)
+    lat_ful(2:iml+1,2:jml+1) = lat_rel(1:iml,1:jml)
+    !
+    IF ( lon_rel(iml,1) .LT. lon_ful(2,2)) THEN
+       lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)
+       lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
+    ELSE
+       lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)-360
+       lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
+    ENDIF
+
+    IF ( lon_rel(1,1) .GT. lon_ful(iml+1,2)) THEN
+       lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)
+       lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
+    ELSE
+       lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)+360
+       lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
+    ENDIF
+    !
+    sgn = lat_rel(1,1)/ABS(lat_rel(1,1))
+    lat_ful(2:iml+1,1) = sgn*180 - lat_rel(1:iml,1)
+    sgn = lat_rel(1,jml)/ABS(lat_rel(1,jml))
+    lat_ful(2:iml+1,jml+2) = sgn*180 - lat_rel(1:iml,jml)
+    lat_ful(1,1) = lat_ful(iml+1,1)
+    lat_ful(iml+2,1) = lat_ful(2,1)
+    lat_ful(1,jml+2) = lat_ful(iml+1,jml+2)
+    lat_ful(iml+2,jml+2) = lat_ful(2,jml+2)
+    !
+    ! Add the longitude lines to the top and bottom
+    !
+    lon_ful(:,1) = lon_ful(:,2)
+    lon_ful(:,jml+2) = lon_ful(:,jml+1)
+    !
+    !  Get the upper and lower limits of each grid box
+    !
+    DO ip = 1,iml
+       DO jp = 1,jml
+          loup_rel(ip,jp) =MAX(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)), 0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
+          lolow_rel(ip,jp) =MIN(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)), 0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
+          laup_rel(ip,jp) =MAX(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)), 0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
+          lalow_rel(ip,jp) =MIN(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)), 0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
+       ENDDO
+    ENDDO
+    !
+    !   Now we take each grid point and find out which values from the forcing we need to average
+    !
+    DO ib =1, nbpt
+       !
+       !  We find the 4 limits of the grid-box. As we transform the resolution of the model
+       !  into longitudes and latitudes we do not have the problem of periodicity.
+       ! coslat is a help variable here !
+       !
+       coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+       !
+       lon_up = lalo(ib,2)+ resolution(ib,1)/(2.0*coslat)
+       lon_low =lalo(ib,2) - resolution(ib,1)/(2.0*coslat)
+       !
+       coslat = pi/180. * R_Earth
+       !
+       lat_up =lalo(ib,1)+resolution(ib,2)/(2.0*coslat)
+       lat_low =lalo(ib,1)-resolution(ib,2)/(2.0*coslat)
+       !
+       !
+       !  Find the grid boxes from the data that go into the model's boxes
+       !  We still work as if we had a regular grid ! Well it needs to be localy regular so
+       !  so that the longitude at the latitude of the last found point is close to the one of the next point.
+       !
+       lastjp = 1
+       data_grid = zero
+       area2 = zero
+
+       DO ip = 1,iml
+          !
+          !  Either the center of the data grid point is in the interval of the model grid or
+          !  the East and West limits of the data grid point are on either sides of the border of
+          !  the data grid.
+          !
+          !
+          !  We find the 4 limits of the grid-box. As we transform the resolution of the model
+          !  into longitudes and latitudes we do not have the problem of periodicity.
+          ! coslat is a help variable here !
+          !
+          !
+          !  To do that correctly we have to check if the grid box sits on the date-line.
+          !
+          IF ( lon_low < -180.0 ) THEN
+             lonrel = MOD( lon_rel(ip,lastjp) - 360.0, 360.0)
+             lolowrel = MOD( lolow_rel(ip,lastjp) - 360.0, 360.0)
+             louprel = MOD( loup_rel(ip,lastjp) - 360.0, 360.0)
+             !
+          ELSE IF ( lon_up > 180.0 ) THEN
+             lonrel = MOD( 360. - lon_rel(ip,lastjp), 360.0)
+             lolowrel = MOD( 360. - lolow_rel(ip,lastjp), 360.0)
+             louprel = MOD( 360. - loup_rel(ip,lastjp), 360.0)
+          ELSE
+             lonrel = lon_rel(ip,lastjp)
+             lolowrel = lolow_rel(ip,lastjp)
+             louprel = loup_rel(ip,lastjp)
+          ENDIF
+          !
+          !
+          !
+          IF ( lonrel > lon_low .AND. lonrel < lon_up .OR. &
+               & lolowrel < lon_low .AND.  louprel > lon_low .OR. &
+               & lolowrel < lon_up  .AND.  louprel > lon_up ) THEN
+             ! 
+             DO jp = 1, jml
+                !
+                ! Now that we have the longitude let us find the latitude
+                !
+                IF ( lat_rel(ip,jp) > lat_low .AND. lat_rel(ip,jp) < lat_up .OR. &
+                     & lalow_rel(ip,jp) < lat_low .AND. laup_rel(ip,jp) > lat_low .OR.&
+                     & lalow_rel(ip,jp) < lat_up .AND. laup_rel(ip,jp) > lat_up) THEN
+                   !
+                   lastjp = jp
+                   !
+                   ! Mising values in the file are assumed to be 1e20
+                   !
+                   IF ( lon_low < -180.0 ) THEN
+                      lolowrel = MOD( lolow_rel(ip,jp) - 360.0, 360.0)
+                      louprel = MOD( loup_rel(ip,jp) - 360.0, 360.0)
+                      !
+                   ELSE IF ( lon_up > 180.0 ) THEN
+                      lolowrel = MOD( 360. - lolow_rel(ip,jp), 360.0)
+                      louprel = MOD( 360. - loup_rel(ip,jp), 360.0)
+                   ELSE
+                      lolowrel = lolow_rel(ip,jp)
+                      louprel = loup_rel(ip,jp)
+                   ENDIF
+                   !
+                   ! Get the area of the fine grid in the model grid
+                   !
+                   coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )
+                   ax = (MIN(lon_up,louprel)-MAX(lon_low, lolowrel))*pi/180. * R_Earth * coslat
+                   ay = (MIN(lat_up, laup_rel(ip,jp))-MAX(lat_low,lalow_rel(ip,jp)))*pi/180. * R_Earth
+                   !!to calculate the surface of the initial grid box, ie data one
+                   ax_file = (louprel-lolowrel)*pi/180. * R_Earth * coslat
+                   ay_file = (laup_rel(ip,jp)-lalow_rel(ip,jp))*pi/180. * R_Earth
+                   !
+                   IF (data_year_file(ip,jp) .LT. undef_sechiba-un) THEN
+                      IF(density) THEN
+                         data_grid = data_grid + ax*ay*data_year_file(ip,jp)
+                      ELSE
+                         data_grid = data_grid + ax*ay*(data_year_file(ip,jp)/(ax_file*ay_file))
+                      ENDIF
+                      area2 = area2 + ax*ay
+                   ENDIF
+                   !
+                ENDIF
+                !
+                !
+             ENDDO
+             !
+          ENDIF
+          !
+       ENDDO
+       !
+       ! Put the total data_year areas in the output variables
+       !
+       IF(density) THEN
+          data_year(ib) = data_grid/area2 
+       ELSE
+          data_year(ib) = data_grid
+       ENDIF
+
+
+       IF ( data_year(ib) < 0 ) THEN
+          WRITE(numout,*) 'In chemistry_read', filename, fieldname 
+          WRITE(numout,*) 'we have a problem here : ', data_year(ib)
+          WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+          WRITE(numout,*) area2
+          CALL ipslerr_p(3,'dchemistry_read','Problem with data_year < 0','','')
+       ENDIF
+
+       !!Accumulates emissions (in Kg/year) per grid box to calculate global emissions
+       data_global = data_global + data_grid
+    ENDDO
+    
+    WRITE(numout,*) trim(filename), ' ', trim(fieldname), ' RESULT data_year : ', MINVAL(data_year), ' ', MAXVAL(data_year)
+    WRITE(numout,*) trim(filename), ' ', trim(fieldname), ' RESULT Global data emissions : ', data_global 
+    
+
+  END SUBROUTINE chemistry_read
+
+!! ================================================================================================================================
+!! SUBROUTINE   : chemistry_interface_orchidee_inca
+!!
+!>\BRIEF         This subroutine will make the interface between inca model and orchidee model 
+!!
+!! DESCRIPTION  :  This subroutine allow the transfer of fluxes between surface and atmospheric chemistry. It is called from Inca
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+
+ SUBROUTINE chemistry_interface_orchidee_inca( &
+     &  nvm_inca, veget_max_inca, veget_frac_inca, lai_inca, snow_inca, &
+     & field_out_names, fields_out, field_in_names, fields_in)
+
+
+     INTEGER, INTENT(out)                      :: nvm_inca            !! Number of vegetation types
+     REAL(r_std), DIMENSION (:,:), INTENT(out) :: veget_max_inca      !! Max. fraction of vegetation type (LAI -> infty)
+     REAL(r_std), DIMENSION (:,:), INTENT(out) :: veget_frac_inca     !! Fraction of vegetation type (unitless, 0-1)  
+     REAL(r_std), DIMENSION (:,:), INTENT(out) :: lai_inca            !! Surface foliere
+     REAL(r_std), DIMENSION (:)  , INTENT(out) :: snow_inca           !! Snow mass [Kg/m^2]
+
+     !
+     ! Optional arguments
+     !
+     ! Names and fields for emission variables : to be transport by Orchidee to Inca
+     CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_out_names
+     REAL(r_std),DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: fields_out
+     !
+     ! Names and fields for deposit variables : to be transport from chemistry model by INCA to ORCHIDEE.
+     CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_in_names
+     REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN)    :: fields_in
+     !
+     ! Number of fields to give (nb_fields_out) or get from (nb_fields_in) INCA :
+     INTEGER(i_std), SAVE   :: nb_fields_out, nb_fields_in
+!$OMP THREADPRIVATE(nb_fields_out, nb_fields_in)
+
+     ! Id of fields to give (nb_fields_out) or get from (nb_fields_in) INCA :
+     INTEGER(i_std)  :: i_fields_out, i_fields_in
+     LOGICAL, SAVE   :: l_first_chemistry_inca=.TRUE. !! Initialisation has to be done one time
+!$OMP THREADPRIVATE(l_first_chemistry_inca)
+     !
+     IF (l_first_chemistry_inca) THEN
+
+        ! il faut verifier que ok_bvoc (chemistry_ok_bvoc) est bien active sinon on arrete tout
+        if (.not.ok_bvoc) then 
+          CALL ipslerr_p (3,'chemistry_inca', &
+            &          'you need to activate chemistry_ok_bvoc in orchidee.def',&
+            &          'This model won''t be able to continue.', &
+            &          '')
+        endif
+
+        ! Prepare fieds out/in for interface with INCA.
+        IF (PRESENT(field_out_names)) THEN
+           nb_fields_out=SIZE(field_out_names)
+        ELSE
+           nb_fields_out=0
+        ENDIF
+
+        IF (PRESENT(field_in_names)) THEN
+           nb_fields_in=SIZE(field_in_names)
+        ELSE
+           nb_fields_in=0
+        ENDIF
+        l_first_chemistry_inca = .FALSE.
+
+     ENDIF
+
+     ! Give to Inca value save in Orchidee 
+     nvm_inca=nvm
+     veget_max_inca=veget_max_chem
+     veget_frac_inca=veget_chem
+     lai_inca = lai_chem
+     snow_inca=snow_chem
+     
+    ! Fields for deposit variables : to be transport from chemistry model by INCA to ORCHIDEE.
+    DO i_fields_in=1,nb_fields_in
+       SELECT CASE(TRIM(field_in_names(i_fields_in)))
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'chemistry_inca', &
+            &          'You ask in INCA an unknown field '//TRIM(field_in_names(i_fields_in))//&
+            &          ' to give to ORCHIDEE for this specific version.',&
+            &          'This model won''t be able to continue.', &
+            &          '(check your tracer parameters in INCA)')
+       END SELECT
+    ENDDO
+    
+    ! Fields for Biogenic emissions : to be transport by Orchidee to Inca
+    DO i_fields_out=1,nb_fields_out
+       SELECT CASE(TRIM(field_out_names(i_fields_out)))
+       CASE("flx_iso") 
+          fields_out(:,:,i_fields_out)=flx_iso(:,:)
+       CASE("flx_mono") 
+          fields_out(:,:,i_fields_out)=flx_mono(:,:)
+       CASE("flx_ORVOC") 
+          fields_out(:,:,i_fields_out)=flx_ORVOC(:,:)
+       CASE("flx_MBO") 
+          fields_out(:,:,i_fields_out)=flx_MBO(:,:)
+       CASE("flx_methanol") 
+          fields_out(:,:,i_fields_out)=flx_methanol(:,:)
+       CASE("flx_acetone") 
+          fields_out(:,:,i_fields_out)=flx_acetone(:,:)
+       CASE("flx_acetal") 
+          fields_out(:,:,i_fields_out)=flx_acetal(:,:)
+       CASE("flx_formal") 
+          fields_out(:,:,i_fields_out)=flx_formal(:,:)
+       CASE("flx_acetic") 
+          fields_out(:,:,i_fields_out)=flx_acetic(:,:)
+       CASE("flx_formic") 
+          fields_out(:,:,i_fields_out)=flx_formic(:,:)
+       CASE("flx_no_soil") 
+          fields_out(:,:,i_fields_out)=flx_no_soil(:,:)
+       CASE("flx_nox") 
+          fields_out(:,:,i_fields_out)=flx_no(:,:)
+       CASE("flx_fertil_no") 
+          fields_out(:,:,i_fields_out)=flx_fertil_no(:,:)
+       CASE("flx_apinen")
+          fields_out(:,:,i_fields_out)=flx_apinen(:,:)
+       CASE("flx_bpinen")
+          fields_out(:,:,i_fields_out)=flx_bpinen(:,:)
+       CASE("flx_limonen")
+          fields_out(:,:,i_fields_out)=flx_limonen(:,:)
+       CASE("flx_myrcen")
+          fields_out(:,:,i_fields_out)=flx_myrcen(:,:)
+       CASE("flx_sabinen")
+          fields_out(:,:,i_fields_out)=flx_sabinen(:,:)
+       CASE("flx_camphen")
+          fields_out(:,:,i_fields_out)=flx_camphen(:,:)
+       CASE("flx_3caren")
+          fields_out(:,:,i_fields_out)=flx_3caren(:,:)
+       CASE("flx_tbocimen")
+          fields_out(:,:,i_fields_out)=flx_tbocimen(:,:)
+       CASE("flx_othermono")
+          fields_out(:,:,i_fields_out)=flx_othermono(:,:)
+       CASE("flx_sesquiter")
+          fields_out(:,:,i_fields_out)=flx_sesquiter(:,:)
+
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'chemistry_inca', &
+            &          'You ask from INCA an unknown field '//TRIM(field_out_names(i_fields_out))//&
+            &          ' to ORCHIDEE for this specific version.',&
+            &          'This model won''t be able to continue.', &
+            &          '(check your tracer parameters in INCA)')
+       END SELECT
+    ENDDO
+    
+
+   END SUBROUTINE chemistry_interface_orchidee_inca
+
+
+END MODULE chemistry
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/condveg.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/condveg.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/condveg.f90	(revision 5166)
@@ -0,0 +1,1718 @@
+! ===============================================================================================================================
+! MODULE       : condveg
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Initialise, compute and update the surface parameters emissivity,
+!! roughness and albedo. 
+!!
+!! \n DESCRIPTION : The module uses 3 settings to control its flow:\n
+!! 1. :: z0cdrag_ave to choose between two methods to calculate the grid average of 
+!!    the roughness height. If set to true: the grid average is calculated by the drag coefficients 
+!!    per PFT. If set to false: the grid average is calculated by the logarithm of the 
+!!    roughness height per PFT.\n
+!! 2. :: impaze for choosing surface parameters. If set to false, the values for the 
+!!    soil albedo, emissivity and roughness height are set to default values which are read from 
+!!    the run.def. If set to true, the user imposes its own values, fixed for the grid point. This is useful if 
+!!    one performs site simulations, however, 
+!!    it is not recommended to do so for spatialized simulations.
+!!     roughheight_scal imposes the roughness height in (m) , 
+!!	same for emis_scal (in %), albedo_scal (in %), zo_scal (in m)                       
+!!     Note that these values are only used if 'impaze' is true.\n
+!! 3. :: alb_bare_model for choosing values of bare soil albedo. If set to TRUE bare 
+!!    soil albedo depends on soil wetness. If set to FALSE bare soil albedo is the mean 
+!!    values of wet and dry soil albedos.\n
+!!   The surface fluxes are calculated between two levels: the atmospheric level reference and the effective roughness height 
+!! defined as the difference between the mean height of the vegetation and the displacement height (zero wind 
+!!    level). Over bare soils, the zero wind level is equal to the soil roughness. Over vegetation, the zero wind level
+!!    is increased by the displacement height
+!!    which depends on the height of the vegetation. For a grid point composed of different types of vegetation, 
+!! an effective surface roughness has to be calculated
+
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE condveg
+
+  USE ioipsl
+  USE xios_orchidee
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE qsat_moisture
+  USE interpol_help
+  USE mod_orchidee_para
+  USE ioipsl_para 
+  USE sechiba_io
+  USE grid
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: condveg_main, condveg_initialize, condveg_finalize, condveg_clear 
+
+  !
+  ! Variables used inside condveg module
+  !
+  LOGICAL, SAVE                     :: l_first_condveg=.TRUE.           !! To keep first call's trace
+!$OMP THREADPRIVATE(l_first_condveg)
+  REAL(r_std), ALLOCATABLE, SAVE    :: soilalb_dry(:,:)                 !! Albedo values for the dry bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_dry)
+  REAL(r_std), ALLOCATABLE, SAVE    :: soilalb_wet(:,:)                 !! Albedo values for the wet bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_wet)
+  REAL(r_std), ALLOCATABLE, SAVE    :: soilalb_moy(:,:)                 !! Albedo values for the mean bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_moy)
+  REAL(r_std), ALLOCATABLE, SAVE    :: soilalb_bg(:,:,:)                !! Albedo values for the background bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_bg)
+  REAL(r_std), ALLOCATABLE, SAVE    :: alb_bare(:,:)                    !! Mean bare soil albedo for visible and near-infrared 
+                                                                        !! range (unitless) 
+!$OMP THREADPRIVATE(alb_bare)
+  REAL(r_std), ALLOCATABLE, SAVE    :: alb_veget(:,:)                   !! Mean vegetation albedo for visible and 
+                                                                        !! near-infrared range (unitless) 
+!$OMP THREADPRIVATE(alb_veget)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: albedo_snow         !! Mean snow albedo over visible and near-infrared 
+                                                                        !! range (unitless) 
+!$OMP THREADPRIVATE(albedo_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: albedo_glob         !! Mean surface albedo over visible and 
+                                                                        !! near-infrared range (unitless)
+!$OMP THREADPRIVATE(albedo_glob)
+  
+CONTAINS
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : condveg_initialize
+  !!
+  !>\BRIEF			            Allocate module variables, read from restart file or initialize with default values
+  !!
+  !! DESCRIPTION			    : Allocate module variables, read from restart file or initialize with default values.
+  !!                                          condveg_snow is called to initialize corresponding variables.
+  !!
+  !! RECENT CHANGE(S)			    : None
+  !!
+  !! MAIN OUTPUT VARIABLE(S)
+  !!
+  !! REFERENCE(S)			    : None
+  !! 
+  !! FLOWCHART                              : None
+  !! \n
+  !_ ==============================================================================================================================
+  SUBROUTINE condveg_initialize (kjit, kjpindex, index, rest_id, &
+       lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, &
+       zlev, snow, snow_age, snow_nobio, snow_nobio_age, &
+       drysoil_frac, height, snowdz, snowrho, tot_bare_soil, &
+       emis, albedo, z0, roughheight, &
+       frac_snow_veg,frac_snow_nobio)
+    
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables  
+    INTEGER(i_std), INTENT(in)                       :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                       :: kjpindex         !! Domain size
+    INTEGER(i_std),INTENT (in)                       :: rest_id          !! _Restart_ file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index            !! Indeces of the points on the map
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)  :: lalo             !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,8), INTENT(in):: neighbours       !! neighoring grid points if land
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)  :: resolution       !! size in x an y of the grid (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)    :: contfrac         ! Fraction of land in each grid box.
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: veget            !! Fraction of vegetation types
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: veget_max        !! Fraction of vegetation type
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio    !! Fraction of continental ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: totfrac_nobio    !! total fraction of continental ice+lakes+...
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)    :: zlev             !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow             !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow_age         !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio    !! Snow mass [Kg/m^2] on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow_nobio_age   !! Snow age on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: drysoil_frac     !! Fraction of visibly Dry soil(between 0 and 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: height           !! Vegetation Height (m)
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in):: snowdz           !! Snow depth at each snow layer
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in):: snowrho          !! Snow density at each snow layer
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)    :: tot_bare_soil    !! Total evaporating bare soil fraction 
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: emis             !! Emissivity
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out) :: albedo           !! Albedo, vis(1) and nir(2)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: z0               !! Roughness
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: roughheight      !! Effective height for roughness
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)    :: frac_snow_veg    !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(out):: frac_snow_nobio  !! Snow cover fraction on non-vegeted area
+
+    !! 0.4 Local variables   
+    INTEGER                                          :: ier
+!_ ================================================================================================================================
+  
+    IF (.NOT. l_first_condveg) CALL ipslerr_p(3,'condveg_initialize','Error: initialization already done','','')
+    l_first_condveg=.FALSE.
+    
+    IF (printlev>=3) WRITE (numout,*) 'Start condveg_initialize'
+
+    !! 1. Allocate module variables
+    ! Dry soil albedo
+    ALLOCATE (soilalb_dry(kjpindex,2),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for soilalb_dry','','')
+    
+    ! Wet soil albedo
+    ALLOCATE (soilalb_wet(kjpindex,2),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for soilalb_wet','','')
+    
+    ! Mean soil albedo
+    ALLOCATE (soilalb_moy(kjpindex,2),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for soilalb_moy','','')
+    
+    ! Background soil albedo
+    ALLOCATE (soilalb_bg(kjpindex,2,12),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for soilalb_bg','','')
+
+    ! Snow albedo of vegetative PFTs
+    ALLOCATE (albedo_snow(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for albedo_snow','','')
+    
+    ! Mean vegetation albedo over visible and near-infrared range 
+    ALLOCATE (albedo_glob(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for albedo_glob','','')
+    
+    IF (.NOT. impaze ) THEN
+       ! Initialization for alb_bare and alb_veget is done in condveg_albcalc
+       
+       ! Mean bare soil albedo
+       ALLOCATE (alb_bare(kjpindex,2),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for alb_bare','','')
+       
+       ! Mean vegetation albedo
+       ALLOCATE (alb_veget(kjpindex,2),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'condveg_initialize','Pb in allocation for alb_veget','','')
+    END IF
+    
+    !! 2. Read variables from restart file or initialize them
+    ! dry soil albedo
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Dry bare soil albedo')
+    CALL restget_p (rest_id,'soilalbedo_dry' , nbp_glo, 2, 1, kjit, .TRUE., soilalb_dry, "gather", nbp_glo, index_g)
+    
+    ! wet soil albedo
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Wet bare soil albedo')
+    CALL restget_p (rest_id, 'soilalbedo_wet', nbp_glo, 2, 1, kjit, .TRUE., soilalb_wet, "gather", nbp_glo, index_g)
+    
+    ! mean soil aledo
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Mean bare soil albedo')
+    CALL restget_p (rest_id, 'soilalbedo_moy', nbp_glo, 2, 1, kjit, .TRUE., soilalb_moy, "gather", nbp_glo, index_g)
+
+    ! background albedo map
+    IF ( alb_bg_modis ) THEN
+       ! Read background albedo from restart file
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Background soil albedo in visible interval')
+       CALL restget_p (rest_id, 'soilalbedo_bg_1', nbp_glo, 12, 1, kjit, .TRUE., soilalb_bg(:,1,:), "gather", nbp_glo, index_g)
+
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Background soil albedo in infra-red interval')
+       CALL restget_p (rest_id, 'soilalbedo_bg_2', nbp_glo, 12, 1, kjit, .TRUE., soilalb_bg(:,2,:), "gather", nbp_glo, index_g)
+
+       IF ( ALL(soilalb_bg(:,:,:) == val_exp) ) THEN
+          ! Variable not found in restart file. Read and interpolate it from file.
+          CALL condveg_background_soilalb(kjpindex, lalo, neighbours, resolution, contfrac)
+       END IF
+    ENDIF
+
+    ! z0
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Roughness')
+    CALL restget_p (rest_id, 'z0', nbp_glo, 1, 1, kjit, .TRUE., z0, "gather", nbp_glo, index_g)
+
+    ! roughness height
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Roughness height')
+    CALL restget_p (rest_id, 'roughheight', nbp_glo, 1, 1, kjit, .TRUE., roughheight, "gather", nbp_glo, index_g)
+
+    ! Initialize the variables if not found in restart file
+    IF ( ALL(soilalb_wet(:,:) == val_exp) .OR. &
+         ALL(soilalb_dry(:,:) == val_exp) .OR. &
+         ALL(soilalb_moy(:,:) == val_exp)) THEN
+       ! One or more of the variables were not in the restart file. 
+       ! Call routine condveg_soilalb to calculate them.
+       CALL condveg_soilalb(kjpindex, lalo, neighbours, resolution, contfrac)
+       WRITE(numout,*) '---> val_exp ', val_exp
+       WRITE(numout,*) '---> ALBEDO_wet VIS:', MINVAL(soilalb_wet(:,ivis)), MAXVAL(soilalb_wet(:,ivis))
+       WRITE(numout,*) '---> ALBEDO_wet NIR:', MINVAL(soilalb_wet(:,inir)), MAXVAL(soilalb_wet(:,inir))
+       WRITE(numout,*) '---> ALBEDO_dry VIS:', MINVAL(soilalb_dry(:,ivis)), MAXVAL(soilalb_dry(:,ivis))
+       WRITE(numout,*) '---> ALBEDO_dry NIR:', MINVAL(soilalb_dry(:,inir)), MAXVAL(soilalb_dry(:,inir))
+       WRITE(numout,*) '---> ALBEDO_moy VIS:', MINVAL(soilalb_moy(:,ivis)), MAXVAL(soilalb_moy(:,ivis))
+       WRITE(numout,*) '---> ALBEDO_moy NIR:', MINVAL(soilalb_moy(:,inir)), MAXVAL(soilalb_moy(:,inir))
+    ENDIF
+
+
+    !! 3. Calculate emissivity
+    IF ( impaze ) THEN
+       ! Use parameter CONDVEG_EMIS from run.def
+       emis(:) = emis_scal
+    ELSE
+       ! Set emissivity to 1.
+       emis_scal = un
+       emis(:) = emis_scal
+    ENDIF
+
+    !! 4. Calculate albedo
+    IF ( impaze ) THEN
+       ! Use parameter CONDVEG_ALBVIS and CONDVEG_ALBNIR from run.def
+       albedo(:,ivis) = albedo_scal(ivis)
+       albedo(:,inir) = albedo_scal(inir)
+    ELSE
+       ! Calucalte albedo
+       CALL condveg_albcalc (kjpindex, veget, drysoil_frac, tot_bare_soil, albedo)
+    ENDIF
+
+    !! 5. Calculate roughness height if it was not found in the restart file
+    IF ( ALL(z0(:) == val_exp) .OR. ALL(roughheight(:) == val_exp)) THEN
+       !! Calculate roughness height
+       ! Chooses between two methods to calculate the grid average of the roughness.
+       ! If impaze set to true:  The grid average is calculated by averaging the drag coefficients over PFT.
+       ! If impaze set to false: The grid average is calculated by averaging the logarithm of the roughness length per PFT.
+       IF ( impaze ) THEN
+          ! Use parameter CONDVEG_Z0 and ROUGHHEIGHT from run.def
+          z0(:) = z0_scal
+          roughheight(:) = roughheight_scal
+       ELSE
+          ! Caluculate roughness height
+          IF ( z0cdrag_ave ) THEN
+             CALL condveg_z0cdrag(kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, zlev, &
+                  height, tot_bare_soil, z0, roughheight)
+          ELSE
+             CALL condveg_z0logz(kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, height, tot_bare_soil, &
+                  z0, roughheight)
+          ENDIF
+       ENDIF
+    END IF
+
+   
+    !! 5. Call subroutine 'condveg snow'
+    CALL condveg_snow (kjpindex,       veget,       veget_max,      frac_nobio,     &
+                       totfrac_nobio,  snow,        snow_age,       snow_nobio,     &
+                       snow_nobio_age, z0,          snowdz,         snowrho,        &
+                       tot_bare_soil,                                               &
+                       albedo,                                                      &
+                       albedo_snow,    albedo_glob, frac_snow_veg,  frac_snow_nobio)
+    
+    IF (printlev>=3) WRITE (numout,*) 'condveg_initialize done '
+    
+  END SUBROUTINE condveg_initialize
+
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_main
+!!
+!>\BRIEF        Calls the subroutines update the variables for current time step
+!!
+!!
+!! MAIN OUTPUT VARIABLE(S):  emis (emissivity), albedo (albedo of 
+!! vegetative PFTs in visible and near-infrared range), z0 (surface roughness height),
+!! roughheight (grid effective roughness height), soil type (fraction of soil types) 
+!! 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!!
+!! REVISION(S)  : None
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_main (kjit, kjpindex, index, rest_id, hist_id, hist2_id, &
+       lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, &
+       zlev, snow, snow_age, snow_nobio, snow_nobio_age, &
+       drysoil_frac, height, snowdz, snowrho, tot_bare_soil, &
+       emis, albedo, z0, roughheight, &
+       frac_snow_veg, frac_snow_nobio )
+
+     !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables  
+
+    INTEGER(i_std), INTENT(in)                       :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                       :: kjpindex         !! Domain size
+    INTEGER(i_std),INTENT (in)                       :: rest_id          !! _Restart_ file identifier
+    INTEGER(i_std),INTENT (in)                       :: hist_id          !! _History_ file identifier
+    INTEGER(i_std), OPTIONAL, INTENT (in)            :: hist2_id          !! _History_ file 2 identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index            !! Indeces of the points on the map
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)  :: lalo             !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,8), INTENT(in):: neighbours       !! neighoring grid points if land
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)  :: resolution       !! size in x an y of the grid (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)    :: contfrac         ! Fraction of land in each grid box.
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: veget            !! Fraction of vegetation types
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: veget_max        !! Fraction of vegetation type
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio    !! Fraction of continental ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: totfrac_nobio    !! total fraction of continental ice+lakes+...
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)    :: zlev             !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow             !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow_age         !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio    !! Snow mass [Kg/m^2] on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow_nobio_age   !! Snow age on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: drysoil_frac     !! Fraction of visibly Dry soil(between 0 and 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: height           !! Vegetation Height (m)
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in):: snowdz           !! Snow depth at each snow layer
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in):: snowrho          !! Snow density at each snow layer
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)    :: tot_bare_soil    !! Total evaporating bare soil fraction 
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: emis             !! Emissivity
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out) :: albedo           !! Albedo, vis(1) and nir(2)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: z0               !! Roughness
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: roughheight      !! Effective height for roughness
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)    :: frac_snow_veg    !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(out):: frac_snow_nobio  !! Snow cover fraction on non-vegeted area
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables   
+
+    CHARACTER(LEN=80)                                :: var_name         !! To store variables names for I/O
+!_ ================================================================================================================================
+  
+    !! 3. Call subroutines to update fields
+
+    ! Call the routine 'condveg_var_update' to update the fields of albedo, emissivity and roughness
+    CALL condveg_var_update (kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, &
+         & drysoil_frac, zlev, height,  tot_bare_soil, emis, albedo, z0, roughheight)
+
+    ! Update snow parameters by calling subroutine 'condveg_snow'
+    CALL condveg_snow (kjpindex,       veget,       veget_max,     frac_nobio,     &
+                       totfrac_nobio,  snow,        snow_age,      snow_nobio,     &
+                       snow_nobio_age, z0,          snowdz,        snowrho,        &
+                       tot_bare_soil,                                              &
+                       albedo,                                                     &
+                       albedo_snow,    albedo_glob, frac_snow_veg, frac_snow_nobio)
+
+         
+
+    ! If this logical flag is set to true, the model
+    ! will output all its data according to the ALMA 
+    ! convention. 
+    ! To facilitate the exchange of forcing data for land-surface schemes and the results produced by these schemes, 
+    ! ALMA (Assistance for Land-surface Modelling activities) proposes to establish standards. 
+    ! http://www.lmd.jussieu.fr/~polcher/ALMA/
+    IF (.NOT. impaze) THEN
+       CALL xios_orchidee_send_field("soilalb_vis",alb_bare(:,1))
+       CALL xios_orchidee_send_field("soilalb_nir",alb_bare(:,2))
+       CALL xios_orchidee_send_field("vegalb_vis",alb_veget(:,1))
+       CALL xios_orchidee_send_field("vegalb_nir",alb_veget(:,2))
+    END If
+    CALL xios_orchidee_send_field("albedo_alma",albedo_glob)
+    CALL xios_orchidee_send_field("SAlbedo",albedo_snow)
+    
+    IF ( almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'Albedo', kjit, albedo_glob, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SAlbedo', kjit, albedo_snow, kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'Albedo', kjit, albedo_glob, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SAlbedo', kjit, albedo_snow, kjpindex, index)
+       ENDIF
+    ELSE
+       IF (.NOT. impaze) THEN
+          CALL histwrite_p(hist_id, 'soilalb_vis', kjit, alb_bare(:,1), kjpindex, index)
+          CALL histwrite_p(hist_id, 'soilalb_nir', kjit, alb_bare(:,2), kjpindex, index)
+          CALL histwrite_p(hist_id, 'vegalb_vis',  kjit, alb_veget(:,1), kjpindex, index)
+          CALL histwrite_p(hist_id, 'vegalb_nir',  kjit, alb_veget(:,2), kjpindex, index)
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite_p(hist2_id, 'soilalb_vis', kjit, alb_bare(:,1), kjpindex, index)
+             CALL histwrite_p(hist2_id, 'soilalb_nir', kjit, alb_bare(:,2), kjpindex, index)
+             CALL histwrite_p(hist2_id, 'vegalb_vis',  kjit, alb_veget(:,1), kjpindex, index)
+             CALL histwrite_p(hist2_id, 'vegalb_nir',  kjit, alb_veget(:,2), kjpindex, index)
+          ENDIF
+       END IF
+    ENDIF
+
+    IF (printlev>=3) WRITE (numout,*)' condveg_main done '
+
+  END SUBROUTINE condveg_main
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : condveg_finalize
+  !!
+  !>\BRIEF                                    Write to restart file
+  !!
+  !! DESCRIPTION			    : This subroutine writes the module variables and variables calculated in condveg
+  !!                                          to restart file
+  !!
+  !! RECENT CHANGE(S)			    : None
+  !!
+  !! REFERENCE(S)			    : None
+  !! 
+  !! FLOWCHART                              : None
+  !! \n
+  !_ ==============================================================================================================================
+  SUBROUTINE condveg_finalize (kjit, kjpindex, rest_id, z0, roughheight)
+    
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables  
+    INTEGER(i_std), INTENT(in)                  :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                  :: kjpindex         !! Domain size
+    INTEGER(i_std),INTENT (in)                  :: rest_id          !! Restart file identifier
+    REAL(r_std),DIMENSION(kjpindex), INTENT(in) :: z0               !! Roughness
+    REAL(r_std),DIMENSION(kjpindex), INTENT(in) :: roughheight      !! Grid effective roughness height (m)     
+    
+    !_ ================================================================================================================================
+    
+    CALL restput_p (rest_id, 'soilalbedo_dry', nbp_glo, 2, 1, kjit, soilalb_dry, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'soilalbedo_wet', nbp_glo, 2, 1, kjit, soilalb_wet, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'soilalbedo_moy', nbp_glo, 2, 1, kjit, soilalb_moy, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'z0', nbp_glo, 1, 1, kjit, z0, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'roughheight', nbp_glo, 1, 1, kjit, roughheight, 'scatter',  nbp_glo, index_g)
+    
+    IF ( alb_bg_modis ) THEN
+       CALL restput_p (rest_id, 'soilalbedo_bg_1', nbp_glo, 12, 1, kjit, soilalb_bg(:,1,:), 'scatter',  nbp_glo, index_g)
+       CALL restput_p (rest_id, 'soilalbedo_bg_2', nbp_glo, 12, 1, kjit, soilalb_bg(:,2,:), 'scatter',  nbp_glo, index_g)
+    END IF
+  END SUBROUTINE condveg_finalize
+
+!! ==============================================================================================================================
+!! SUBROUTINE 	: condveg_clear
+!!
+!>\BRIEF        Deallocate albedo variables
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_clear  ()
+
+      l_first_condveg=.TRUE.
+       
+      ! Dry soil albedo
+       IF (ALLOCATED (soilalb_dry)) DEALLOCATE (soilalb_dry)
+       ! Wet soil albedo
+       IF (ALLOCATED(soilalb_wet))  DEALLOCATE (soilalb_wet)
+       ! Mean soil albedo
+       IF (ALLOCATED(soilalb_moy))  DEALLOCATE (soilalb_moy)
+       ! BG soil albedo
+       IF (ALLOCATED(soilalb_bg))  DEALLOCATE (soilalb_bg)
+       ! Mean snow albedo
+       IF (ALLOCATED(albedo_snow))  DEALLOCATE (albedo_snow)
+       ! Mean albedo
+       IF (ALLOCATED(albedo_glob))  DEALLOCATE (albedo_glob)
+       ! Mean albedo of bare soil
+       IF (ALLOCATED(alb_bare))  DEALLOCATE (alb_bare)
+       ! Mean vegetation albedo
+       IF (ALLOCATED(alb_veget))  DEALLOCATE (alb_veget)
+
+  END SUBROUTINE condveg_clear
+  
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_var_update
+!!
+!>\BRIEF        Update emissivity, albedo and roughness height.
+!!
+!! DESCRIPTION  : None
+!!
+!! MAIN OUTPUT VARIABLE(S): \n
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_var_update  (kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, &
+       & drysoil_frac, zlev, height, tot_bare_soil, emis, albedo, z0, roughheight)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex         !! Domain size - Number of land pixels  (unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: veget            !! PFT coverage fraction of a PFT (= ind*cn_ind)
+                                                                            !! (m^2 m^{-2})  
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: veget_max        !! PFT "Maximal" coverage fraction of a PFT 
+                                                                            !! (= ind*cn_ind) (m^2 m^{-2})  
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio       !! Fraction of non-vegetative surfaces, i.e. 
+                                                                            !! continental ice, lakes, etc. (unitless)  
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: totfrac_nobio    !! Total fraction of non-vegetative surfaces, i.e. 
+                                                                            !! continental ice, lakes, etc. (unitless)   
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: drysoil_frac     !! Fraction of dry soil in visible range (unitless)   
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: zlev             !! Height of first layer (m)       
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: height           !! Vegetation height (m)         
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: tot_bare_soil    !! Total evaporating bare soil fraction 
+
+    !! 0.2 Output variables   
+       
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: emis             !! Emissivity (unitless)            
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out)    :: albedo           !! Albedo of vegetative PFTs in visible and 
+                                                                            !! near-infrared range  
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: z0               !! Roughness height (m)              
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: roughheight      !! Grid effective roughness height (m)     
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jv           !! Indeces
+!_ ================================================================================================================================
+
+    !! 1. Calculate emissivity
+    
+    emis(:) = emis_scal
+    
+    !! 2. Calculate albedo
+    
+    ! If TRUE read in prescribed values for albedo
+    IF ( impaze ) THEN
+
+       albedo(:,ivis) = albedo_scal(ivis)
+       albedo(:,inir) = albedo_scal(inir)
+
+    ! If FALSE calculate albedo from ORCHIDEE default values
+    ELSE
+
+       CALL condveg_albcalc (kjpindex, veget, drysoil_frac, tot_bare_soil, albedo)
+
+    ENDIF
+    
+    !! 3. Calculate roughness height
+    
+    ! If TRUE read in prescribed values for roughness height
+    IF ( impaze ) THEN
+
+       DO ji = 1, kjpindex
+         z0(ji) = z0_scal
+         roughheight(ji) = roughheight_scal
+      ENDDO
+
+    ! Calculate roughness height
+    ELSE
+     
+       IF ( z0cdrag_ave ) THEN
+          CALL condveg_z0cdrag (kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, zlev, height, tot_bare_soil, &
+               &                z0, roughheight)
+       ELSE
+          CALL condveg_z0logz (kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, height, tot_bare_soil, &
+               &               z0, roughheight)
+       ENDIF
+     
+    ENDIF
+
+    IF (printlev>=3) WRITE (numout,*) ' condveg_var_update done '
+
+  END SUBROUTINE condveg_var_update
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE   : condveg_snow
+!!
+!>\BRIEF        Calcuating snow albedo and snow cover fraction, which are then used to 
+!! update the gridbox surface albedo following Chalita and Treut (1994).
+!!
+!! DESCRIPTION  : The snow albedo scheme presented below belongs to prognostic albedo 
+!! category, i.e. the snow albedo value at a time step depends on the snow albedo value 
+!! at the previous time step.
+!!
+!! First, the following formula (described in Chalita and Treut 1994) is used to describe 
+!! the change in snow albedo with snow age on each PFT and each non-vegetative surfaces, 
+!! i.e. continental ice, lakes, etc.: \n 
+!! \latexonly 
+!! \input{SnowAlbedo.tex}
+!! \endlatexonly
+!! \n
+!! Where snowAge is snow age, tcstSnowa is a critical aging time (tcstSnowa=5 days)
+!! snowaIni and snowaIni+snowaDec corresponds to albedos measured for aged and
+!! fresh snow respectively, and their values for each PFT and each non-vegetative surfaces 
+!! is precribed in in constantes_veg.f90.\n
+!! In order to estimate gridbox snow albedo, snow albedo values for each PFT and 
+!! each  non-vegetative surfaces with a grid box are weightedly summed up by their 
+!! respective fractions.\n
+!! Secondly, the snow cover fraction is computed as:
+!! \latexonly 
+!! \input{SnowFraction.tex}
+!! \endlatexonly
+!! \n
+!! Where fracSnow is the fraction of snow on total vegetative or total non-vegetative
+!! surfaces, snow is snow mass (kg/m^2) on total vegetated or total nobio surfaces.\n 
+!! Finally, the surface albedo is then updated as the weighted sum of fracSnow, total
+!! vegetated fraction, total nobio fraction, gridbox snow albedo, and previous
+!! time step surface albedo.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: albedo; surface albedo. :: albedo_snow; snow
+!! albedo
+!!
+!! REFERENCE(S) :  
+!! Chalita, S. and H Le Treut (1994), The albedo of temperate and boreal forest and 
+!!  the Northern Hemisphere climate: a sensitivity experiment using the LMD GCM,
+!!  Climate Dynamics, 10 231-240.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_snow  (kjpindex,       veget,       veget_max,     frac_nobio,       &
+                            totfrac_nobio,  snow,        snow_age,      snow_nobio,       &
+                            snow_nobio_age, z0,          snowdz,        snowrho,          &
+                            tot_bare_soil,                                                &
+                            albedo,                                                       &
+                            albedo_snow,    albedo_glob, frac_snow_veg, frac_snow_nobio)
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex        !! Domain size - Number of land pixels  (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget           !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                           !! (m^2 m^{-2})   
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: veget_max
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio      !! Fraction of non-vegetative surfaces, i.e. 
+                                                                           !! continental ice, lakes, etc. (unitless)     
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: totfrac_nobio   !! Total fraction of non-vegetative surfaces, i.e. 
+                                                                           !! continental ice, lakes, etc. (unitless)   
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: snow            !! Snow mass in vegetation (kg m^{-2})           
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio      !! Snow mass on continental ice, lakes, etc. (kg m^{-2})      
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: snow_age        !! Snow age (days)        
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio_age  !! Snow age on continental ice, lakes, etc. (days)    
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)         :: z0              !! Roughness length
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in)   :: snowdz          !! Snow depth at each snow layer
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in)   :: snowrho         !! Snow density at each snow layer
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: tot_bare_soil   !! Total evaporating bare soil fraction 
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: albedo_snow     !! Snow albedo (unitless ratio)     
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: albedo_glob     !! Mean albedo (unitless ratio)     
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: frac_snow_veg   !! Fraction of snow on vegetation (unitless ratio)
+    REAL(r_std), DIMENSION(kjpindex,nnobio), INTENT(out):: frac_snow_nobio !! Fraction of snow on continental ice, lakes, etc. 
+                                                                           !! (unitless ratio)
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (inout)  :: albedo          !! Albedo (unitless ratio)          
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                      :: ji, jv, jb,iv   !! indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: snowa_veg       !! Albedo of snow covered area on vegetation
+                                                                           !! (unitless ratio)
+    REAL(r_std), DIMENSION(kjpindex,nnobio)             :: snowa_nobio     !! Albedo of snow covered area on continental ice, 
+                                                                           !! lakes, etc. (unitless ratio)     
+    REAL(r_std), DIMENSION(kjpindex)                    :: fraction_veg    !! Total vegetation fraction (unitless ratio)
+    REAL(r_std), DIMENSION(kjpindex)                    :: agefunc_veg     !! Age dependency of snow albedo on vegetation 
+                                                                           !! (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nnobio)             :: agefunc_nobio   !! Age dependency of snow albedo on ice, 
+                                                                           !! lakes, .. (unitless)
+    REAL(r_std)                                         :: alb_nobio       !! Albedo of continental ice, lakes, etc. 
+                                                                           !!(unitless ratio)
+    REAL(r_std),DIMENSION(kjpindex,nvm)                 :: zpcpalb         !! Increase of snow albedo due to snowfall
+    REAL(r_std),DIMENSION(kjpindex,nvm)                 :: zalbdry         !! Dry snow albedo rate of change
+    REAL(r_std),DIMENSION(kjpindex,nvm)                 :: zalbwet         !! Wet snow albedo rate of change
+    REAL(r_std),DIMENSION(kjpindex,nvm)                 :: zwholdmax       !! Water holding capacity in snowpack
+    REAL(r_std),DIMENSION(kjpindex,nvm)                 :: zfracliq        !! Fraction of liquid water content in snowpack
+    REAL(r_std), DIMENSION(kjpindex)                    :: snowrho_ave     !! Average snow density
+    REAL(r_std), DIMENSION(kjpindex)                    :: snowdepth       !! Snow depth
+!_ ================================================================================================================================
+
+    !! 2. Calculate snow albedos on both total vegetated and total nobio surfaces
+ 
+    ! The snow albedo could be either prescribed (in condveg_init.f90) or 
+    !  calculated following Chalita and Treut (1994).
+    ! Check if the precribed value fixed_snow_albedo exists
+    IF (ABS(fixed_snow_albedo - undef_sechiba) .GT. EPSILON(undef_sechiba)) THEN
+      snowa_veg(:) = fixed_snow_albedo
+      snowa_nobio(:,:) = fixed_snow_albedo
+    ELSE ! calculated following Chalita and Treut (1994)
+      
+      !! 2.1 Calculate age dependence
+
+      ! On vegetated surfaces
+      DO ji = 1, kjpindex
+        agefunc_veg(ji) = EXP(-snow_age(ji)/tcst_snowa)
+      ENDDO
+
+      ! On non-vegtative surfaces
+      DO jv = 1, nnobio ! Loop over # nobio types
+        DO ji = 1, kjpindex
+          agefunc_nobio(ji,jv) = EXP(-snow_nobio_age(ji,jv)/tcst_snowa)
+        ENDDO
+      ENDDO
+
+      !! 2.1 Calculate snow albedo 
+
+
+         ! For  vegetated surfaces
+         fraction_veg(:) = un - totfrac_nobio(:)
+         snowa_veg(:) = zero
+         IF (ok_dgvm) THEN
+            DO ji = 1, kjpindex
+               IF ( fraction_veg(ji) .GT. min_sechiba ) THEN
+                  snowa_veg(ji) = snowa_veg(ji) + &
+                       tot_bare_soil(ji)/fraction_veg(ji) * ( snowa_aged(1)+snowa_dec(1)*agefunc_veg(ji) )
+               END IF
+            END DO
+            
+            DO jv = 2, nvm
+               DO ji = 1, kjpindex
+                  IF ( fraction_veg(ji) .GT. min_sechiba ) THEN
+                     snowa_veg(ji) = snowa_veg(ji) + &
+                          veget(ji,jv)/fraction_veg(ji) * ( snowa_aged(jv)+snowa_dec(jv)*agefunc_veg(ji) )
+                  ENDIF
+               ENDDO
+            ENDDO
+         ELSE
+            DO jv = 1, nvm
+               DO ji = 1, kjpindex
+                  IF ( fraction_veg(ji) .GT. min_sechiba ) THEN
+                     snowa_veg(ji) = snowa_veg(ji) + &
+                          veget_max(ji,jv)/fraction_veg(ji) * ( snowa_aged(jv)+snowa_dec(jv)*agefunc_veg(ji) )
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDIF
+      !
+      ! snow albedo on other surfaces
+      !
+      DO jv = 1, nnobio
+         DO ji = 1, kjpindex
+            snowa_nobio(ji,jv) = ( snowa_aged(1) + snowa_dec(1) * agefunc_nobio(ji,jv) ) 
+         ENDDO
+      ENDDO
+   ENDIF
+   
+    !! 3. Calculate snow cover fraction for both total vegetated and total non-vegetative surfaces.
+    IF (ok_explicitsnow) THEN
+       snowrho_ave=sum(snowrho,2)/nsnow
+       snowdepth=sum(snowdz,2)
+       frac_snow_veg(:) = tanh(snowdepth(:)/(0.025*(snowrho_ave(:)/50.)))
+    ELSE
+       frac_snow_veg(:) = MIN(MAX(snow(:),zero)/(MAX(snow(:),zero)+snowcri_alb*sn_dens/100.0),un)
+    END IF
+
+    DO jv = 1, nnobio
+       frac_snow_nobio(:,jv) = MIN(MAX(snow_nobio(:,jv),zero)/(MAX(snow_nobio(:,jv),zero)+snowcri_alb*sn_dens/100.0),un)
+    ENDDO
+
+    !! 4. Update surface albedo
+    
+    ! Update surface albedo using the weighted sum of previous time step surface albedo,
+    ! total vegetated fraction, total nobio fraction, snow cover fraction (both vegetated and 
+    ! non-vegetative surfaces), and snow albedo (both vegetated and non-vegetative surfaces). 
+    ! Although both visible and near-infrared surface albedo are presented, their calculations 
+    ! are the same.
+    DO jb = 1, 2
+
+      albedo(:,jb) = ( fraction_veg(:) ) * &
+                         ( (un-frac_snow_veg(:)) * albedo(:,jb) + &
+                           ( frac_snow_veg(:)  ) * snowa_veg(:)    )
+      DO jv = 1, nnobio ! Loop over # nobio surfaces
+        ! 
+        IF ( jv .EQ. iice ) THEN
+          alb_nobio = alb_ice(jb)
+        ELSE
+          WRITE(numout,*) 'jv=',jv
+          WRITE(numout,*) 'DO NOT KNOW ALBEDO OF THIS SURFACE TYPE'
+          CALL ipslerr_p(3,'condveg_snow','DO NOT KNOW ALBEDO OF THIS SURFACE TYPE','','')
+        ENDIF
+        !
+        albedo(:,jb) = albedo(:,jb) + &
+                       ( frac_nobio(:,jv) ) * &
+                         ( (un-frac_snow_nobio(:,jv)) * alb_nobio + &
+                           ( frac_snow_nobio(:,jv)  ) * snowa_nobio(:,jv)   )
+      ENDDO
+    
+    END DO
+    
+    ! Calculate the mean albedo
+    albedo_glob(:) = (albedo(:,1) + albedo(:,2))/2
+
+    ! Calculate snow albedo
+    albedo_snow(:) =  fraction_veg(:) * frac_snow_veg(:) * snowa_veg(:)
+    DO jv = 1, nnobio 
+       albedo_snow(:) = albedo_snow(:) + &
+            frac_nobio(:,jv) * frac_snow_nobio(:,jv) * snowa_nobio(:,jv)
+    ENDDO
+   
+    IF (printlev>=3) WRITE (numout,*) ' condveg_snow done '
+
+  END SUBROUTINE condveg_snow
+  
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_soilalb
+!!
+!>\BRIEF        This subroutine calculates the albedo of soil (without snow).
+!!
+!! DESCRIPTION  This subroutine reads the soil colour maps in 1 x 1 deg resolution 
+!! from the Henderson-Sellers & Wilson database. These values are interpolated to 
+!! the model's resolution and transformed into 
+!! dry and wet albedos.\n
+!!
+!! If the soil albedo is calculated without the dependence of soil moisture, the
+!! soil colour values are transformed into mean soil albedo values.\n 
+!!
+!! The calculations follow the assumption that the grid of the data is regular and 
+!! it covers the globe. The calculation for the model grid are based on the borders 
+!! of the grid of the resolution.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! CALCULATED MODULE VARIABLE(S): soilalb_dry for visible and near-infrared range,
+!!                                soilalb_wet for visible and near-infrared range, 
+!!                                soilalb_moy for visible and near-infrared range 
+!!
+!! REFERENCE(S) : 
+!! -Wilson, M.F., and A. Henderson-Sellers, 1985: A global archive of land cover and
+!!  soils data for use in general circulation climate models. J. Clim., 5, 119-143.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE condveg_soilalb(nbpt, lalo, neighbours, resolution, contfrac)
+  
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                    :: nbpt                  !! Number of points for which the data needs to be 
+                                                                           !! interpolated (unitless)             
+    REAL(r_std), INTENT(in)                       :: lalo(nbpt,2)          !! Vector of latitude and longitudes (degree)        
+    INTEGER(i_std), INTENT(in)                    :: neighbours(nbpt,8)    !! Vector of neighbours for each grid point 
+                                                                           !! (1=N, 2=E, 3=S, 4=W)  
+    REAL(r_std), INTENT(in)                       :: resolution(nbpt,2)    !! The size of each grid cell in X and Y (km)
+    REAL(r_std), INTENT(in)                       :: contfrac(nbpt)        !! Fraction of land in each grid cell (unitless)   
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                :: nbvmax                !! nbvmax for interpolation (unitless). It is the 
+                                                                           !! dimension of the variables in which we store the list
+                                                                           !! of points of the source grid which fit into one grid 
+                                                                           !! box of the target. 
+    CHARACTER(LEN=80)                             :: filename              !! Filename of soil colour map
+    INTEGER(i_std)                                :: iml, jml, lml, &
+                      &tml, fid, ib, ip, jp, fopt, ilf, lastjp, nbexp      !! Indices
+    REAL(r_std)                                   :: lev(1), date, dt      !! Help variables to read in file data
+    INTEGER(i_std)                                :: itau(1)               !! Help variables to read in file data
+    REAL(r_std)                                   :: sgn                   !! Help variable to compute average bare soil albedo 
+    REAL(r_std)                                   :: coslat                !! [DISPENSABLE]
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lat_rel               !! Help variable to read file data and allocate memory
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lon_rel               !! Help variable to read file data and allocate memory
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: soilcol               !! Help variable to read file data and allocate memory
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: sub_area              !! Help variable to read file data and allocate memory
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sub_index             !! Help variable to read file data and allocate memory
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: mask                  !! Help variable to read file data and allocate memory
+    CHARACTER(LEN=30)                             :: callsign              !! Help variable to read file data and allocate memory
+    LOGICAL                                       :: ok_interpol           !! Optional return of aggregate_2d
+    INTEGER                                       :: ALLOC_ERR             !! Help varialbe to count allocation error
+!_ ================================================================================================================================
+  
+  !! 1. Open file and allocate memory
+
+  ! Open file with soil colours 
+
+  !Config Key   = SOILALB_FILE
+  !Config Desc  = Name of file from which the bare soil albedo
+  !Config Def   = soils_param.nc
+  !Config If    = NOT(IMPOSE_AZE)
+  !Config Help  = The name of the file to be opened to read the soil types from 
+  !Config         which we derive then the bare soil albedos. This file is 1x1 
+  !Config         deg and based on the soil colors defined by Wilson and Henderson-Seller.
+  !Config Units = [FILE]
+  !
+  filename = 'soils_param.nc'
+  CALL getin_p('SOILALB_FILE',filename)
+  
+  ! Read data from file
+  IF (is_root_prc) CALL flininfo(filename,iml, jml, lml, tml, fid)
+  CALL bcast(iml)
+  CALL bcast(jml)
+  CALL bcast(lml)
+  CALL bcast(tml)
+
+  ! Allocate memory for latitudes
+  ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_soilalb','Pb in allocation for lat_rel','','')
+
+  ! Allcoate memory for longitude
+  ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_soilalb','Pb in allocation for lon_rel','','')
+
+  ! Allocate memory for mask
+  ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_soilalb','Pb in allocation for mask','','')
+
+  ! Allocate memory for soil data
+  ALLOCATE(soilcol(iml,jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_soilalb','Pb in allocation for soilcol','','')
+  
+  ! Set values
+  IF (is_root_prc) CALL flinopen(filename, .FALSE., iml, jml, lml, lon_rel, lat_rel, lev, tml, itau, date, dt, fid)
+  CALL bcast(lon_rel)
+  CALL bcast(lat_rel)
+  
+  IF (is_root_prc) CALL flinget(fid, 'soilcolor', iml, jml, lml, tml, 1, 1, soilcol)
+  CALL bcast(soilcol)
+  
+  IF (is_root_prc) CALL flinclo(fid)
+  
+  ! Create mask with values of soil colour
+  mask(:,:) = zero
+  DO ip=1,iml
+     DO jp=1,jml
+        IF (soilcol(ip,jp) > min_sechiba) THEN
+           mask(ip,jp) = un
+        ENDIF
+     ENDDO
+  ENDDO
+  
+  ! Set nbvmax to 200 for interpolation
+  ! This number is the dimension of the variables in which we store 
+  ! the list of points of the source grid which fit into one grid box of the target. 
+  nbvmax = 200
+  
+  callsign = 'Soil color map'
+  
+  ! Start with interpolation
+  ok_interpol=.FALSE.
+  DO WHILE ( .NOT. ok_interpol )
+     WRITE(numout,*) "Projection arrays for ",callsign," : "
+     WRITE(numout,*) "nbvmax = ",nbvmax
+     
+     ALLOCATE(sub_area(nbpt,nbvmax), STAT=ALLOC_ERR)
+     IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_soilalb','Pb in allocation for sub_area','','')
+     sub_area(:,:)=zero
+
+     ALLOCATE(sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+     IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_soilalb','Pb in allocation for sub_index','','')
+     sub_index(:,:,:)=0
+     
+     CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+          &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+          &                nbvmax, sub_index, sub_area, ok_interpol)
+     
+     IF ( .NOT. ok_interpol ) THEN
+        DEALLOCATE(sub_area)
+        DEALLOCATE(sub_index)
+        nbvmax = nbvmax * 2
+     ENDIF
+     
+  ENDDO
+  
+  ! Check how many points with soil information are found
+  nbexp = 0
+
+  soilalb_dry(:,:) = zero
+  soilalb_wet(:,:) = zero
+  soilalb_moy(:,:) = zero
+
+  DO ib=1,nbpt ! Loop over domain size
+
+     fopt =  COUNT(sub_area(ib,:) > zero)
+
+     !! 3. Compute the average bare soil albedo parameters
+     
+     IF ( fopt .EQ. 0) THEN      ! If no points were interpolated
+        nbexp = nbexp + 1
+        soilalb_dry(ib,ivis) = (SUM(vis_dry)/classnb + SUM(vis_wet)/classnb)/deux
+        soilalb_dry(ib,inir) = (SUM(nir_dry)/classnb + SUM(nir_wet)/classnb)/deux
+        soilalb_wet(ib,ivis) = (SUM(vis_dry)/classnb + SUM(vis_wet)/classnb)/deux
+        soilalb_wet(ib,inir) = (SUM(nir_dry)/classnb + SUM(nir_wet)/classnb)/deux
+        soilalb_moy(ib,ivis) = SUM(albsoil_vis)/classnb
+        soilalb_moy(ib,inir) = SUM(albsoil_nir)/classnb
+     ELSE
+        sgn = zero
+
+        DO ilf = 1,fopt         ! If points were interpolated
+           
+           ip = sub_index(ib,ilf,1)
+           jp = sub_index(ib,ilf,2)
+
+           ! Weighted albedo values by interpolation area
+           IF ( NINT(soilcol(ip,jp)) .LE. classnb) THEN
+              soilalb_dry(ib,ivis) = soilalb_dry(ib,ivis) + vis_dry(NINT(soilcol(ip,jp))) * sub_area(ib,ilf)
+              soilalb_dry(ib,inir) = soilalb_dry(ib,inir) + nir_dry(NINT(soilcol(ip,jp))) * sub_area(ib,ilf)
+              soilalb_wet(ib,ivis) = soilalb_wet(ib,ivis) + vis_wet(NINT(soilcol(ip,jp))) * sub_area(ib,ilf)
+              soilalb_wet(ib,inir) = soilalb_wet(ib,inir) + nir_wet(NINT(soilcol(ip,jp))) * sub_area(ib,ilf)
+              soilalb_moy(ib,ivis) = soilalb_moy(ib,ivis) + albsoil_vis(NINT(soilcol(ip,jp))) * sub_area(ib,ilf)
+              soilalb_moy(ib,inir) = soilalb_moy(ib,inir) + albsoil_nir(NINT(soilcol(ip,jp))) * sub_area(ib,ilf)
+              sgn = sgn + sub_area(ib,ilf)
+           ELSE
+              CALL ipslerr_p(3,'condveg_soilalb','The file contains a soil color class which is incompatible with this program', &
+                   '','')
+           ENDIF
+           
+        ENDDO
+
+        ! Normalize the surface
+        IF ( sgn .LT. min_sechiba) THEN
+           nbexp = nbexp + 1
+           soilalb_dry(ib,ivis) = (SUM(vis_dry)/classnb + SUM(vis_wet)/classnb)/deux
+           soilalb_dry(ib,inir) = (SUM(nir_dry)/classnb + SUM(nir_wet)/classnb)/deux
+           soilalb_wet(ib,ivis) = (SUM(vis_dry)/classnb + SUM(vis_wet)/classnb)/deux
+           soilalb_wet(ib,inir) = (SUM(nir_dry)/classnb + SUM(nir_wet)/classnb)/deux
+           soilalb_moy(ib,ivis) = SUM(albsoil_vis)/classnb
+           soilalb_moy(ib,inir) = SUM(albsoil_nir)/classnb
+        ELSE
+           soilalb_dry(ib,ivis) = soilalb_dry(ib,ivis)/sgn
+           soilalb_dry(ib,inir) = soilalb_dry(ib,inir)/sgn
+           soilalb_wet(ib,ivis) = soilalb_wet(ib,ivis)/sgn
+           soilalb_wet(ib,inir) = soilalb_wet(ib,inir)/sgn
+           soilalb_moy(ib,ivis) = soilalb_moy(ib,ivis)/sgn
+           soilalb_moy(ib,inir) = soilalb_moy(ib,inir)/sgn           
+        ENDIF
+
+     ENDIF
+
+  ENDDO
+
+  IF ( nbexp .GT. 0 ) THEN
+     WRITE(numout,*) 'CONDVEG_soilalb : The interpolation of the bare soil albedo had ', nbexp
+     WRITE(numout,*) 'CONDVEG_soilalb : points without data. This are either coastal points or'
+     WRITE(numout,*) 'CONDVEG_soilalb : ice covered land.'
+     WRITE(numout,*) 'CONDVEG_soilalb : The problem was solved by using the average of all soils'
+     WRITE(numout,*) 'CONDVEG_soilalb : in dry and wet conditions'
+  ENDIF
+
+  DEALLOCATE (lat_rel)
+  DEALLOCATE (lon_rel)
+  DEALLOCATE (mask)
+  DEALLOCATE (sub_index)
+  DEALLOCATE (sub_area)
+  DEALLOCATE (soilcol)
+
+  END SUBROUTINE condveg_soilalb
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE 	: condveg_background_soilalb
+!!
+!>\BRIEF        This subroutine reads the albedo of bare soil
+!!
+!! DESCRIPTION  This subroutine reads the background albedo map in 0.5 x 0.5 deg resolution 
+!! derived from JRCTIP product to be used as bare soil albedo. These values are then interpolated
+!! to the model's resolution.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): soilalb_bg for visible and near-infrared range 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE condveg_background_soilalb(nbpt, lalo, neighbours, resolution, contfrac)
+  
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                    :: nbpt                  !! Number of points for which the data needs to be 
+                                                                           !! interpolated (unitless)             
+    REAL(r_std), INTENT(in)                       :: lalo(nbpt,2)          !! Vector of latitude and longitudes (degree)        
+    INTEGER(i_std), INTENT(in)                    :: neighbours(nbpt,8)    !! Vector of neighbours for each grid point 
+                                                                           !! (1=N, 2=E, 3=S, 4=W)  
+    REAL(r_std), INTENT(in)                       :: resolution(nbpt,2)    !! The size of each grid cell in X and Y (km)
+    REAL(r_std), INTENT(in)                       :: contfrac(nbpt)        !! Fraction of land in each grid cell (unitless)   
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                :: nbvmax                !! nbvmax for interpolation (unitless). It is the 
+                                                                           !! dimension of the variables in which we store the list
+                                                                           !! of points of the source grid which fit into one grid 
+                                                                           !! box of the target. 
+    CHARACTER(LEN=80)                             :: filename              !! Filename of background albedo
+    INTEGER(i_std)                                :: iml, jml, lml, tml    !! Indices
+    INTEGER(i_std)                                :: fid, ib, ip, jp, fopt !! Indices
+    INTEGER(i_std)                                :: ilf, ks, it           !! Indices
+    REAL(r_std)                                   :: totarea               !! Help variable to compute average bare soil albedo 
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)        :: lat_lu, lon_lu        !! Latitudes and longitudes read from input file
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lat_rel, lon_rel      !! Help variable to read file data and allocate memory
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: mask_lu               !! Help variable to read file data and allocate memory
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:)  :: bg_albedo             !! Help variable to read file data and allocate memory
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: sub_area              !! Help variable to read file data and allocate memory
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sub_index             !! Help variable to read file data and allocate memory
+    CHARACTER(LEN=30)                             :: callsign              !! Help variable to read file data and allocate memory
+    LOGICAL                                       :: ok_interpol           !! Optional return of aggregate_2d
+    INTEGER                                       :: ALLOC_ERR             !! Help varialbe to count allocation error
+!_ ================================================================================================================================
+  
+  !! 1. Open file and allocate memory
+
+  ! Open file with background albedo
+
+  !Config Key   = ALB_BG_FILE
+  !Config Desc  = Name of file from which the background albedo is read 
+  !Config Def   = alb_bg_jrctip.nc
+  !Config If    = 
+  !Config Help  = The name of the file to be opened to read background albedo 
+  !Config Units = [FILE]
+  !
+  filename = 'alb_bg_jrctip.nc'
+  CALL getin_p('ALB_BG_FILE',filename)
+  
+  ! Read data from file
+  IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+  CALL bcast(iml)
+  CALL bcast(jml)
+  CALL bcast(lml)
+  CALL bcast(tml)
+
+  ALLOCATE(lon_lu(iml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_background_soilalb','Problem in allocation of variable lon_lu','','')
+
+  ALLOCATE(lat_lu(jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_background_soilalb','Problem in allocation of variable lat_lu','','')
+
+  ALLOCATE(mask_lu(iml,jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_background_soilalb','Pb in allocation for mask_lu','','')
+
+  ALLOCATE(bg_albedo(iml,jml,2,tml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_background_soilalb','Pb in allocation for bg_albedo','','')
+
+  IF (is_root_prc) THEN
+     CALL flinget(fid, 'longitude', iml, 0, 0, 0, 1, 1, lon_lu)
+     CALL flinget(fid, 'latitude', jml, 0, 0, 0, 1, 1, lat_lu)
+     CALL flinget(fid, 'mask', iml, jml, 0, 0, 1, 1, mask_lu)
+     CALL flinget(fid, 'bg_albedo', iml, jml, 2, tml, 1, 12, bg_albedo)
+     CALL flinclo(fid)
+  ENDIF
+
+  CALL bcast(lon_lu)
+  CALL bcast(lat_lu)
+  CALL bcast(mask_lu)
+  CALL bcast(bg_albedo)
+  
+  ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_background_soilalb','Pb in allocation for lon_rel','','')
+
+  ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_background_soilalb','Pb in allocation for lat_rel','','')
+
+  ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_background_soilalb','Problem in allocation of variable mask','','')
+
+  DO jp=1,jml
+     lon_rel(:,jp) = lon_lu(:)
+  ENDDO
+  DO ip=1,iml
+     lat_rel(ip,:) = lat_lu(:)
+  ENDDO
+
+  mask(:,:) = zero
+  WHERE (mask_lu(:,:) > zero )
+     mask(:,:) = un
+  ENDWHERE
+
+  ! Set nbvmax to 200 for interpolation
+  ! This number is the dimension of the variables in which we store 
+  ! the list of points of the source grid which fit into one grid box of the target. 
+  nbvmax = 200
+  callsign = 'Background soil albedo'
+  
+  ! Start interpolation
+  ok_interpol=.FALSE.
+  DO WHILE ( .NOT. ok_interpol )
+     WRITE(numout,*) "Projection arrays for ",callsign," : "
+     WRITE(numout,*) "nbvmax = ",nbvmax
+     
+     ALLOCATE(sub_area(nbpt,nbvmax), STAT=ALLOC_ERR)
+     IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_background_soilalb','Pb in allocation for sub_area','','')
+     sub_area(:,:)=zero
+
+     ALLOCATE(sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+     IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'condveg_background_soilalb','Pb in allocation for sub_index','','')
+     sub_index(:,:,:)=0
+     
+     CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+          iml, jml, lon_rel, lat_rel, mask, callsign, &
+          nbvmax, sub_index, sub_area, ok_interpol)
+     
+     IF ( .NOT. ok_interpol ) THEN
+        DEALLOCATE(sub_area)
+        DEALLOCATE(sub_index)
+        nbvmax = nbvmax * 2
+     ENDIF
+  ENDDO
+
+  ! Compute the average
+  soilalb_bg(:,:,:) = zero
+  DO ib = 1, nbpt
+     fopt = COUNT(sub_area(ib,:) > zero)
+     IF ( fopt > 0 ) THEN
+        totarea = zero
+        DO ilf = 1, fopt
+           ip = sub_index(ib,ilf,1)
+           jp = sub_index(ib,ilf,2)
+           DO ks = 1,2
+              DO it = 1,12
+                 soilalb_bg(ib,ks,it) = soilalb_bg(ib,ks,it) + bg_albedo(ip,jp,ks,it)*sub_area(ib,ilf)
+              ENDDO
+           ENDDO
+           totarea = totarea + sub_area(ib,ilf)
+        ENDDO
+        ! Normalize
+        soilalb_bg(ib,:,:) = soilalb_bg(ib,:,:)/totarea
+     ELSE
+        ! Set defalut value for points where the interpolation fail
+        WRITE(numout,*) 'On point ', ib, ' no points were found for interpolation data. Mean value is used.'
+        WRITE(numout,*) 'Location : ', lalo(ib,2), lalo(ib,1)
+        soilalb_bg(ib,ivis,:) = 0.129
+        soilalb_bg(ib,inir,:) = 0.247
+     ENDIF
+  ENDDO
+
+  DEALLOCATE (lat_lu)
+  DEALLOCATE (lat_rel)
+  DEALLOCATE (lon_lu)
+  DEALLOCATE (lon_rel)
+  DEALLOCATE (mask_lu)
+  DEALLOCATE (mask)
+  DEALLOCATE (bg_albedo)
+  DEALLOCATE (sub_area)
+  DEALLOCATE (sub_index)
+
+  END SUBROUTINE condveg_background_soilalb
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_z0logz
+!!
+!>\BRIEF        Computation of grid average of roughness height by averaging  the 
+!! logarithm of the roughness height of each grid box components fracbio and fracnobio.
+!!
+!! DESCRIPTION  : Calculates mean roughness height
+!!  over the grid cell. The mean roughness height is derived from the vegetation 
+!! height which is scaled by the roughness parameter. The sum of the logarithm of the 
+!! roughness times the fraction per grid cell gives the average roughness height per 
+!! grid cell for the vegetative PFTs. The roughness height for the non-vegetative PFTs 
+!! is calculated in a second step. \n
+!!
+!! To compute the fluxes,  
+!! the difference between the height of the vegetation and the zero plane displacement height
+!! is needed and called roughheight .\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): roughness height (z0), grid effective roughness height (roughheight)
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_z0logz (kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, height, tot_bare_soil, &
+       &                     z0, roughheight)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                          :: kjpindex      !! Domain size - Number of land pixels  (unitless) 
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: veget         !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                         !! (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: veget_max     !! PFT "Maximal" coverage fraction of a PFT 
+                                                                         !! (= ind*cn_ind) (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nnobio), INTENT(in) :: frac_nobio    !! Fraction of non-vegetative surfaces, 
+                                                                         !! i.e. continental ice, lakes, etc. (unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: totfrac_nobio !! Total fraction of non-vegetative surfaces, 
+                                                                         !! i.e. continental ice, lakes, etc. (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: height        !! Vegetation height (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: tot_bare_soil !! Total evaporating bare soil fraction 
+    
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: z0            !! Soil roughness height (m) 
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: roughheight   !! Grid effective roughness height (m) 
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                      :: jv            !! Loop index over PFTs (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: sumveg        !! Fraction of bare soil (unitless) 
+    REAL(r_std), DIMENSION(kjpindex)                    :: ave_height    !! Average vegetation height (m)
+    REAL(r_std), DIMENSION(kjpindex)                    :: d_veg         !! PFT coverage of vegetative PFTs 
+                                                                         !! (= ind*cn_ind) (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)                    :: zhdispl       !! Zero plane displacement height (m)
+    REAL(r_std)                                         :: z0_nobio      !! Roughness of non-vegetative fraction (m),  
+                                                                         !! i.e. continental ice, lakes, etc. 
+!_ ================================================================================================================================
+    
+    !! 1. Preliminary calculation
+
+    ! Calculate the roughness (m) of bare soil, z0_bare
+    ! taken from constantes_veg.f90    
+    z0(:) = tot_bare_soil(:) * LOG(z0_bare)
+
+    ! Define fraction of bare soil
+    sumveg(:) = tot_bare_soil(:)
+
+    ! Set average vegetation height to zero
+    ave_height(:) = zero
+
+    !! 2. Calculate the mean roughness length 
+    
+    ! Calculate the mean roughness height of
+    ! vegetative PFTs over the grid cell
+    DO jv = 2, nvm !Loop over # vegetative PFTs
+
+       ! In the case of forest, use parameter veget_max because 
+       ! tree trunks influence the roughness even when there are no leaves
+       IF ( is_tree(jv) ) THEN
+          d_veg(:) = veget_max(:,jv)
+       ELSE
+
+          ! In the case of grass, use parameter veget because grasses 
+          ! only influence the roughness during the growing season
+          d_veg(:) = veget(:,jv)
+       ENDIF
+       
+       ! Calculate the average roughness over the grid cell:
+       ! The roughness for vegetative PFTs is calculated by
+       ! the vegetation height per PFT multiplied by the roughness 
+       ! parameter 'z0_over_height= 1/16'. If this scaled value is 
+       ! lower than 0.01 than the value for the roughness length 
+       ! of bare soil (0.01) is used. The sum of the logarithm of 
+       ! the roughness times the fraction per grid cell gives the 
+       ! logarithm of roughness length per grid cell for the vegetative
+       ! PFTs.
+       z0(:) = z0(:) + d_veg(:) * &
+            LOG( MAX(height(:,jv)*z0_over_height,z0_bare) )
+       ! Sum of bare soil and fraction vegetated fraction 
+       sumveg(:) = sumveg(:) + d_veg(:)
+
+       ! Weighted height of vegetation with maximal cover fraction
+       ave_height(:) = ave_height(:) + veget_max(:,jv)*height(:,jv)
+       
+    ENDDO !Loop over # vegetative PFTs
+    
+    !! 3. Calculate the mean roughness length of non-vegetative surfaces \n
+
+    ! Search for pixels with vegetated part to normalise 
+    ! roughness length
+    WHERE ( sumveg(:) > zero ) z0(:) = z0(:) / sumveg(:)
+    
+    ! Calculate fraction of roughness for vegetated part 
+    z0(:) = (un - totfrac_nobio(:)) * z0(:)
+    
+    DO jv = 1, nnobio ! Loop over # of non-vegative surfaces
+    
+       ! Set rougness for ice 
+       IF ( jv .EQ. iice ) THEN
+          z0_nobio = z0_ice
+       ELSE
+          WRITE(numout,*) 'jv=',jv
+          WRITE(numout,*) 'DO NOT KNOW ROUGHNESS OF THIS SURFACE TYPE'
+          CALL ipslerr_p(3,'condveg_Z0logz','DO NOT KNOW ROUGHNESS OF THIS SURFACE TYPE','','')
+       ENDIF
+       
+       ! Sum of vegetative roughness length and non-vegetative
+       ! roughness length
+       z0(:) = z0(:) + frac_nobio(:,jv) * LOG(z0_nobio)
+    
+    ENDDO ! loop over # of non-vegative surfaces
+    
+    !! 4. Calculate the zero plane displacement height and effective roughness length
+
+    !  Take the exponential of the roughness length 
+    z0(:) = EXP( z0(:) )
+
+    ! Compute the zero plane displacement height which
+    ! is an equivalent height of the vegetation for the absorption of momentum
+    zhdispl(:) = ave_height(:) * height_displacement
+
+    ! Then we compute what we call the grid effective roughness height.
+    ! This is the height over which the roughness acts. It combines the
+    ! zero plane displacement height and the vegetation height.  This 
+    ! effective value is the difference between the height of the 
+    ! vegetation and the zero plane displacement height.
+    roughheight(:) = ave_height(:) - zhdispl(:)
+
+  END SUBROUTINE condveg_z0logz
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_z0cdrag
+!!
+!>\BRIEF        Computation of grid average of roughness length by calculating 
+!! the drag coefficient.
+!!
+!! DESCRIPTION  : This routine calculates the mean roughness height and mean 
+!! effective roughness height over the grid cell. The mean roughness height (z0) 
+!! is computed by averaging the drag coefficients  \n
+!!
+!! \latexonly 
+!! \input{z0cdrag1.tex}
+!! \endlatexonly
+!! \n 
+!!
+!! where C is the drag coefficient at the height of the vegetation, kappa is the 
+!! von Karman constant, z (Ztmp) is the height at which the fluxes are estimated and z0 the roughness height. 
+!! The reference level for z needs to be high enough above the canopy to avoid 
+!! singularities of the LOG. This height is set to  minimum 10m above ground. 
+!! The drag coefficient increases with roughness height to represent the greater 
+!! turbulence generated by rougher surfaces. 
+!! The roughenss height is obtained by the inversion of the drag coefficient equation.\n
+!!
+!! The roughness height for the non-vegetative surfaces is calculated in a second step. 
+!! In order to calculate the transfer coefficients the 
+!! effective roughness height is calculated. This effective value is the difference
+!! between the height of the vegetation and the zero plane displacement height.\nn
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S):  :: roughness height(z0) and grid effective roughness height(roughheight)
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_z0cdrag (kjpindex,veget,veget_max,frac_nobio,totfrac_nobio,zlev, height, tot_bare_soil, &
+       &                      z0, roughheight)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+   
+    INTEGER(i_std), INTENT(in)                          :: kjpindex      !! Domain size - Number of land pixels  (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: veget         !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                         !! (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: veget_max     !! PFT "Maximal" coverage fraction of a PFT 
+                                                                         !! (= ind*cn_ind) (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nnobio), INTENT(in) :: frac_nobio    !! Fraction of non-vegetative surfaces, 
+                                                                         !! i.e. continental ice, lakes, etc. (unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: totfrac_nobio !! Total fraction of non-vegetative surfaces, 
+                                                                         !! i.e. continental ice, lakes, etc. (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: zlev          !! Height of first layer (m)           
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: height        !! Vegetation height (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: tot_bare_soil !! Total evaporating bare soil fraction 
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: z0            !! Roughness height (m)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: roughheight   !! Grid effective roughness height (m) 
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: jv            !! Loop index over PFTs (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: sumveg        !! Fraction of bare soil (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: ztmp          !! Max height of the atmospheric level (m)
+    REAL(r_std), DIMENSION(kjpindex)                    :: ave_height    !! Average vegetation height (m)
+    REAL(r_std), DIMENSION(kjpindex)                    :: d_veg         !! PFT coverage of vegetative PFTs 
+                                                                         !! (= ind*cn_ind) (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)                    :: zhdispl       !! Zero plane displacement height (m)
+    REAL(r_std)                                         :: z0_nobio      !! Roughness height of non-vegetative fraction (m),  
+                                                                         !! i.e. continental ice, lakes, etc. 
+
+!_ ================================================================================================================================
+    
+    !! 1. Preliminary calculation
+
+    ! Set maximal height of first layer
+    ztmp(:) = MAX(10., zlev(:))
+
+    ! Calculate roughness for non-vegetative surfaces
+    ! with the von Karman constant 
+    z0(:) = tot_bare_soil(:) * (ct_karman/LOG(ztmp(:)/z0_bare))**2
+
+    ! Fraction of bare soil
+    sumveg(:) = tot_bare_soil(:)
+
+    ! Set average vegetation height to zero
+    ave_height(:) = zero
+    
+    !! 2. Calculate the mean roughness height 
+    
+    ! Calculate the mean roughness height of
+    ! vegetative PFTs over the grid cell
+    DO jv = 2, nvm
+
+       ! In the case of forest, use parameter veget_max because 
+       ! tree trunks influence the roughness even when there are no leaves
+       IF ( is_tree(jv) ) THEN
+          ! In the case of grass, use parameter veget because grasses 
+          ! only influence the roughness during the growing season
+          d_veg(:) = veget_max(:,jv)
+       ELSE
+          ! grasses only have an influence if they are really there!
+          d_veg(:) = veget(:,jv)
+       ENDIF
+       
+       ! Calculate the average roughness over the grid cell:
+       ! The unitless drag coefficient is per vegetative PFT
+       ! calculated by use of the von Karman constant, the height 
+       ! of the first layer and the roughness. The roughness
+       ! is calculated as the vegetation height  per PFT 
+       ! multiplied by the roughness  parameter 'z0_over_height= 1/16'. 
+       ! If this scaled value is lower than 0.01 then the value for 
+       ! the roughness of bare soil (0.01) is used. 
+       ! The sum over all PFTs gives the average roughness 
+       ! per grid cell for the vegetative PFTs.
+       z0(:) = z0(:) + d_veg(:) * (ct_karman/LOG(ztmp(:)/MAX(height(:,jv)*z0_over_height,z0_bare)))**2
+
+       ! Sum of bare soil and fraction vegetated fraction
+       sumveg(:) = sumveg(:) + d_veg(:)
+       
+       ! Weigh height of vegetation with maximal cover fraction
+       ave_height(:) = ave_height(:) + veget_max(:,jv)*height(:,jv)
+       
+    ENDDO
+    
+    !! 3. Calculate the mean roughness height of vegetative PFTs over the grid cell
+    
+    !  Search for pixels with vegetated part to normalise 
+    !  roughness height
+    WHERE ( sumveg(:) .GT. zero ) z0(:) = z0(:) / sumveg(:)
+
+    ! Calculate fraction of roughness for vegetated part 
+    z0(:) = (un - totfrac_nobio(:)) * z0(:)
+
+    DO jv = 1, nnobio ! Loop over # of non-vegative surfaces
+
+       ! Set rougness for ice
+       IF ( jv .EQ. iice ) THEN
+          z0_nobio = z0_ice
+       ELSE
+          WRITE(numout,*) 'jv=',jv
+          WRITE(numout,*) 'DO NOT KNOW ROUGHNESS OF THIS SURFACE TYPE'
+          CALL ipslerr_p(3,'condveg_z0cdrag','DO NOT KNOW ROUGHNESS OF THIS SURFACE TYPE','','')
+       ENDIF
+       
+       ! Sum of vegetative roughness length and non-vegetative
+       ! roughness length
+       z0(:) = z0(:) + frac_nobio(:,jv) * (ct_karman/LOG(ztmp(:)/z0_nobio))**2
+       
+    ENDDO ! Loop over # of non-vegative surfaces
+    
+    !! 4. Calculate the zero plane displacement height and effective roughness length
+
+    !  Take the exponential of the roughness 
+    z0(:) = ztmp(:) / EXP(ct_karman/SQRT(z0(:)))
+
+    ! Compute the zero plane displacement height which
+    ! is an equivalent height for the absorption of momentum
+    zhdispl(:) = ave_height(:) * height_displacement
+
+    ! In order to calculate the fluxes we compute what we call the grid effective roughness height.
+    ! This is the height over which the roughness acts. It combines the
+    ! zero plane displacement height and the vegetation height.
+    roughheight(:) = ave_height(:) - zhdispl(:)
+
+  END SUBROUTINE condveg_z0cdrag
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_albcalc
+!!
+!>\BRIEF        This subroutine calculates the albedo without snow.
+!!
+!! DESCRIPTION  : The albedo is calculated for both the visible and near-infrared 
+!! domain. First the mean albedo of the bare soil is calculated. Two options exist: 
+!! either the soil albedo depends on soil wetness (drysoil_frac variable), or the soil albedo 
+!! is set to a mean soil albedo value.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): albedo 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_albcalc (kjpindex, veget, drysoil_frac, tot_bare_soil, albedo)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT(in)                       :: kjpindex       !! Domain size - Number of land pixels  (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: veget          !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                       !! (m^2 m^{-2})        
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)     :: drysoil_frac   !! Fraction of  dry soil (unitless) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)    :: tot_bare_soil  !! Total evaporating bare soil fraction 
+   
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out) :: albedo         !! Albedo for visible and near-infrared range 
+                                                                       !! (unitless)   
+ 
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+ 
+    REAL(r_std),DIMENSION (nvm,2)                    :: alb_leaf_tmp   !! Variable for albedo values for all PFTs and 
+                                                                       !! spectral domains (unitless) 
+    INTEGER(i_std)                                   :: ks             !! Index for visible and near-infraread range
+    INTEGER(i_std)                                   :: jv             !! Index for vegetative PFTs
+!_ ================================================================================================================================
+    
+ !! 1. Preliminary calculation
+
+    ! Assign values of leaf albedo for visible and near-infrared range
+    ! to local variable (constantes_veg.f90)
+    alb_leaf_tmp(:,ivis) = alb_leaf_vis(:)
+    alb_leaf_tmp(:,inir) = alb_leaf_nir(:)
+
+ !! 2. Calculation and assignment of soil albedo
+
+    DO ks = 1, 2! Loop over # of spectra
+
+       ! If alb_bg_modis=TRUE, the background soil albedo map for the current simulated month is used
+       ! If alb_bg_modis=FALSE and alb_bare_model=TRUE, the soil albedo calculation depends on soil moisture
+       ! If alb_bg_modis=FALSE and alb_bare_model=FALSE, the mean soil albedo is used without the dependance on soil moisture
+       ! see subroutines 'condveg_soilalb' and 'condveg_background_soilalb'
+       IF ( alb_bg_modis ) THEN
+          alb_bare(:,ks) = soilalb_bg(:,ks,month)
+       ELSE
+          IF ( alb_bare_model ) THEN
+             alb_bare(:,ks) = soilalb_wet(:,ks) + drysoil_frac(:) * (soilalb_dry(:,ks) -  soilalb_wet(:,ks))
+          ELSE
+             alb_bare(:,ks) = soilalb_moy(:,ks)
+          ENDIF
+       ENDIF
+
+       ! Soil albedo is weighed by fraction of bare soil          
+       albedo(:,ks) = tot_bare_soil(:) * alb_bare(:,ks)
+
+!! 3. Calculation of mean albedo of over the grid cell 
+  
+       ! Calculation of mean albedo of over the grid cell and
+       !    mean albedo of only vegetative PFTs over the grid cell
+       alb_veget(:,ks) = zero
+
+       DO jv = 2, nvm  ! Loop over # of PFTs
+
+          ! Mean albedo of grid cell for visible and near-infrared range
+          albedo(:,ks) = albedo(:,ks) + veget(:,jv)*alb_leaf_tmp(jv,ks)
+
+          ! Mean albedo of vegetation for visible and near-infrared range
+          alb_veget(:,ks) = alb_veget(:,ks) + veget(:,jv)*alb_leaf_tmp(jv,ks)
+       ENDDO ! Loop over # of PFTs
+
+    ENDDO
+
+  END SUBROUTINE condveg_albcalc
+
+END MODULE condveg
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/diffuco.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/diffuco.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/diffuco.f90	(revision 5166)
@@ -0,0 +1,2951 @@
+! ================================================================================================================================
+!  MODULE       : diffuco
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF   This module calculates the limiting coefficients, both aerodynamic
+!! and hydrological, for the turbulent heat fluxes.
+!!
+!!\n DESCRIPTION: The aerodynamic resistance R_a is used to limit
+!! the transport of fluxes from the surface layer of vegetation to the point in the atmosphere at which
+!! interaction with the LMDZ atmospheric circulation model takes place. The aerodynamic resistance is
+!! calculated either within the module r_aerod (if the surface drag coefficient is provided by the LMDZ, and 
+!! if the flag 'ldq_cdrag_from_gcm' is set to TRUE) or r_aero (if the surface drag coefficient must be calculated).\n
+!!
+!! Within ORCHIDEE, evapotranspiration is a function of the Evaporation Potential, but is modulated by a
+!! series of resistances (canopy and aerodynamic) of the surface layer, here represented by beta.\n
+!!
+!! DESCRIPTION	:
+!! \latexonly 
+!!     \input{diffuco_intro.tex}
+!! \endlatexonly
+!! \n
+!!
+!! This module calculates the beta for several different scenarios: 
+!! - diffuco_snow calculates the beta coefficient for sublimation by snow, 
+!! - diffuco_inter calculates the beta coefficient for interception loss by each type of vegetation, 
+!! - diffuco_bare calculates the beta coefficient for bare soil, 
+!! - diffuco_trans or diffuco_trans_co2 both calculate the beta coefficient for transpiration for each type
+!!   of vegetation. Those routines differ by the formulation used to calculate the canopy resistance (Jarvis in 
+!!   diffuco_trans, Farqhar in diffuco_trans_co2)
+!! - chemistry_bvoc calculates the beta coefficient for emissions of biogenic compounds \n
+!!
+!! Finally, the module diffuco_comb computes the combined $\alpha$ and $\beta$ coefficients for use 
+!! elsewhere in the module. \n
+
+!! RECENT CHANGE(S): Nathalie le 28 mars 2006 - sur proposition de Fred Hourdin, ajout
+!! d'un potentiometre pour regler la resistance de la vegetation (rveg is now in pft_parameters)
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE diffuco
+
+  ! modules used :
+  USE constantes
+  USE qsat_moisture
+  USE sechiba_io
+  USE ioipsl
+  USE pft_parameters
+  USE grid
+  USE ioipsl_para 
+  USE xios_orchidee
+  USE chemistry, ONLY : chemistry_initialize, chemistry_bvoc
+  IMPLICIT NONE
+
+  ! public routines :
+  PRIVATE
+  PUBLIC :: diffuco_main, diffuco_initialize, diffuco_finalize, diffuco_clear
+
+  !
+  ! variables used inside diffuco module : declaration and initialisation
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: leaf_ci                   !! intercellular CO2 concentration (ppm)
+!$OMP THREADPRIVATE(leaf_ci)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: wind                      !! Wind module (m s^{-1})
+!$OMP THREADPRIVATE(wind)
+
+CONTAINS
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    diffuco_initialize
+!!
+!>\BRIEF	  Allocate module variables, read from restart file or initialize with default values
+!!
+!! DESCRIPTION:	  Allocate module variables, read from restart file or initialize with default values.
+!!                Call chemistry_initialize for initialization of variables needed for the calculations of BVOCs.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S): None
+!! 
+!! FLOWCHART: None
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE diffuco_initialize (kjit,    kjpindex, index,                  &
+                                 rest_id, lalo,     neighbours, resolution, &
+                                 rstruct, q_cdrag)
+    
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number (-) 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index            !! Indeces of the points on the map (-)
+    INTEGER(i_std),INTENT (in)                         :: rest_id          !! _Restart_ file identifier (-)
+    REAL(r_std),DIMENSION (kjpindex,2),   INTENT (in)  :: lalo             !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,8),INTENT (in)  :: neighbours       !! Vector of neighbours for each 
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)     :: resolution       !! The size in km of each grid-box in X and Y
+    
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: rstruct          !! Structural resistance for the vegetation
+    
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: q_cdrag          !! Product of drag coefficient and wind speed (m s^{-1})
+    
+    !! 0.4 Local variables
+    INTEGER                                            :: ilai
+    INTEGER                                            :: jv
+    INTEGER                                            :: ier
+    CHARACTER(LEN=4)                                   :: laistring
+    CHARACTER(LEN=80)                                  :: var_name        
+    !_ ================================================================================================================================
+    
+    !! 1. Define flag ldq_cdrag_from_gcm. This flag determines if the cdrag should be taken from the GCM or be calculated. 
+    !!    The default value is true if the q_cdrag variables was already initialized. This is the case when coupled to the LMDZ.
+
+    !Config Key   = CDRAG_FROM_GCM
+    !Config Desc  = Keep cdrag coefficient from gcm.
+    !Config If    = OK_SECHIBA
+    !Config Def   = y
+    !Config Help  = Set to .TRUE. if you want q_cdrag coming from GCM (if q_cdrag on initialization is non zero).
+    !Config         Keep cdrag coefficient from gcm for latent and sensible heat fluxes.
+    !Config Units = [FLAG]
+    IF ( ABS(MAXVAL(q_cdrag)) .LE. EPSILON(q_cdrag)) THEN
+       ldq_cdrag_from_gcm = .FALSE.
+    ELSE
+       ldq_cdrag_from_gcm = .TRUE.
+    ENDIF
+    CALL getin_p('CDRAG_from_GCM', ldq_cdrag_from_gcm)
+    IF (printlev>=2) WRITE(numout,*) "ldq_cdrag_from_gcm = ",ldq_cdrag_from_gcm
+
+    !! 2. Allocate module variables
+
+    ! Allocate leaf_ci only if CO2 is calculated
+    IF ( ok_co2 ) THEN
+      ALLOCATE (leaf_ci(kjpindex,nvm,nlai),stat=ier)
+      IF (ier /= 0) CALL ipslerr_p(3,'diffuco_initialize','Problem in allocate of variable leaf_ci','','')
+    ENDIF
+
+    ALLOCATE (wind(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'diffuco_initialize','Problem in allocate of variable wind','','')
+
+    !! 3. Read variables from restart file
+    IF (printlev>=3) WRITE (numout,*) 'Read DIFFUCO variables from restart file'
+
+    CALL ioconf_setatt_p('UNITS', 's/m')
+    CALL ioconf_setatt_p('LONG_NAME','Structural resistance')
+    CALL restget_p (rest_id, 'rstruct', nbp_glo, nvm, 1, kjit, .TRUE., rstruct, "gather", nbp_glo, index_g)
+    IF ( ALL(rstruct(:,:) == val_exp) ) THEN
+       DO jv = 1, nvm
+          rstruct(:,jv) = rstruct_const(jv)
+       ENDDO
+    ENDIF
+    
+    ! the following variable is read only if CO2 is calculated
+    IF ( ok_co2 ) THEN
+       CALL ioconf_setatt_p('UNITS', 'ppm')
+       CALL ioconf_setatt_p('LONG_NAME','Leaf CO2')
+       DO ilai = 1, nlai
+          ! variable name is somewhat complicated as ioipsl does not allow 3d variables for the moment...
+          write(laistring,'(i4)') ilai
+          laistring=ADJUSTL(laistring)
+          var_name='leaf_ci_'//laistring(1:LEN_TRIM(laistring))
+          CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE.,leaf_ci(:,:,ilai), "gather", nbp_glo, index_g)
+       ENDDO
+       !Config Key   = DIFFUCO_LEAFCI
+       !Config Desc  = Initial leaf CO2 level if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 233.
+       !Config Help  = The initial value of leaf_ci if its value is not found
+       !Config         in the restart file. This should only be used if the model is
+       !Config         started without a restart file.
+       !Config Units = [ppm]
+       CALL setvar_p (leaf_ci, val_exp,'DIFFUCO_LEAFCI', 233._r_std)
+
+    ENDIF
+        
+    !! 4. Initialize chemistry module
+    IF (printlev>=3) WRITE(numout,*) "ok_bvoc:",ok_bvoc
+    IF ( ok_bvoc ) CALL chemistry_initialize(kjpindex, lalo, neighbours, resolution)
+    
+  END SUBROUTINE diffuco_initialize
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : diffuco_main
+!!
+!>\BRIEF	 The root subroutine for the module, which calls all other required
+!! subroutines.
+!! 
+!! DESCRIPTION   : 
+
+!! This is the main subroutine for the module. 
+!! First it calculates the surface drag coefficient (via a call to diffuco_aero), using available parameters to determine
+!! the stability of air in the surface layer by calculating the Richardson Nubmber. If a value for the 
+!! surface drag coefficient is passed down from the atmospheric model and and if the flag 'ldq_cdrag_from_gcm' 
+!! is set to TRUE, then the subroutine diffuco_aerod is called instead. This calculates the aerodynamic coefficient. \n
+!!
+!! Following this, an estimation of the saturated humidity at the surface is made (via a call
+!! to qsatcalc in the module qsat_moisture). Following this the beta coefficients for sublimation (via 
+!! diffuco_snow), interception (diffuco_inter), bare soil (diffuco_bare), and transpiration (via 
+!! diffuco_trans_co2 if co2 is considered, diffuco_trans otherwise) are calculated in sequence. Finally 
+!! the alpha and beta coefficients are combined (diffuco_comb). \n
+!!
+!! The surface drag coefficient is calculated for use within the module enerbil. It is required to to
+!! calculate the aerodynamic coefficient for every flux. \n
+!!
+!! The various beta coefficients are used within the module enerbil for modifying the rate of evaporation, 
+!! as appropriate for the surface. As explained in Chapter 2 of Guimberteau (2010), that module (enerbil) 
+!! calculates the rate of evaporation essentially according to the expression $E = /beta E_{pot}$, where
+!! E is the total evaporation and $E_{pot}$ the evaporation potential. If $\beta = 1$, there would be
+!! essentially no resistance to evaporation, whereas should $\beta = 0$, there would be no evaporation and
+!! the surface layer would be subject to some very stong hydrological stress. \n
+!!
+!! The following processes are calculated:
+!! - call diffuco_aero for aerodynamic transfer coeficient
+!! - call diffuco_snow for partial beta coefficient: sublimation
+!! - call diffuco_inter for partial beta coefficient: interception for each type of vegetation
+!! - call diffuco_bare for partial beta coefficient: bare soil
+!! - call diffuco_trans for partial beta coefficient: transpiration for each type of vegetation, using Jarvis formula
+!! - call diffuco_trans_co2 for partial beta coefficient: transpiration for each type of vegetation, using Farqhar's formula
+!! - call diffuco_comb for alpha and beta coefficient
+!! - call chemistry_bvoc for alpha and beta coefficients for biogenic emissions
+!!
+!! ATTENTION ::valpha [DISPOSABLE] is not used anymore ! Its value is always 1.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): humrel, q_cdrag, vbeta, valpha, vbeta1, vbeta4,
+!! vbeta2, vbeta3, rveget, cimean   
+!!
+!! REFERENCE(S) :				        
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273.
+!! - de Rosnay, P, 1999. ReprÃ©sentation des interactions sol-plante-atmosphÃšre dans le modÃšle de circulation gÃ©nÃ©rale
+!! du LMD, 1999. PhD Thesis, UniversitÃ© Paris 6, available (25/01/12): 
+!! http://www.ecmwf.int/staff/patricia_de_rosnay/publications.html#8
+!! - Ducharne, A, 1997. Le cycle de l'eau: modÃ©lisation de l'hydrologie continentale, Ã©tude de ses interactions avec 
+!! le climat, PhD Thesis, UniversitÃ© Paris 6
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available (25/01/12):
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!! - LathiÃšre, J, 2005. Evolution des Ã©missions de composÃ©s organiques et azotÃ©s par la biosphÃšre continentale dans le 
+!! modÃšle LMDz-INCA-ORCHIDEE, UniversitÃ© Paris 6
+!!
+!! FLOWCHART	:
+!! \latexonly 
+!!     \includegraphics[scale=0.5]{diffuco_main_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_main (kjit, kjpindex, index, indexveg, indexlai, u, v, &
+     & zlev, z0, roughheight, temp_sol, temp_air, temp_growth, rau, q_cdrag, qsurf, qair, q2m, t2m, pb, &
+     & rsol, evap_bare_lim, evapot, evapot_corr, snow, flood_frac, flood_res, frac_nobio, snow_nobio, totfrac_nobio, &
+     & swnet, swdown, coszang, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, &
+     & vbeta , valpha, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, gsmean, rveget, rstruct, cimean, gpp, &
+     & lalo, neighbours, resolution, ptnlev1, precip_rain, frac_age, tot_bare_soil, &
+     & hist_id, hist2_id)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number (-) 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),INTENT (in)                         :: hist_id          !! _History_ file identifier (-)
+    INTEGER(i_std),INTENT (in)                         :: hist2_id         !! _History_ file 2 identifier (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: index          !! Indeces of the points on the map (-)
+    INTEGER(i_std),DIMENSION (kjpindex*(nlai+1)), INTENT (in) :: indexlai  !! Indeces of the points on the 3D map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in) :: indexveg       !! Indeces of the points on the 3D map (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: u                !! Eastward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: v                !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: zlev             !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: z0               !! Surface roughness Length (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: roughheight      !! Effective height for roughness (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_sol         !! Skin temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_air         !! Lowest level temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_growth      !! Growth temperature (Â°C) - Is equal to t2m_month
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: rau              !! Air Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: qsurf            !! Near surface air specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: qair             !! Lowest level air specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: q2m              !! 2m air specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: t2m              !! 2m air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: snow             !! Snow mass (kg)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: flood_frac       !! Fraction of floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: flood_res        !! Reservoir in floodplains (estimation to avoid over-evaporation)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: pb               !! Surface level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: rsol             !! Bare soil evaporation resistance (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evap_bare_lim    !! Limit to the bare soil evaporation when the 
+                                                                           !! 11-layer hydrology is used (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot           !! Soil Potential Evaporation (mm day^{-1}) 
+                                                                           !! NdN This variable does not seem to be used at 
+                                                                           !! all in diffuco
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot_corr      !! Soil Potential Evaporation
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio     !! Fraction of ice,lakes,cities,... (-)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio     !! Snow on ice,lakes,cities,... (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: totfrac_nobio    !! Total fraction of ice+lakes+cities+... (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swnet            !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swdown           !! Down-welling surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: coszang          !! Cosine of the solar zenith angle (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: ccanopy          !! CO2 concentration inside the canopy (ppm)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget            !! Fraction of vegetation type (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max        !! Max. fraction of vegetation type (LAI->infty)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: lai              !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintveg         !! Water on vegetation due to interception (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintmax         !! Maximum water on vegetation for interception 
+                                                                           !! (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2), INTENT (in) :: assim_param !! min+max+opt temps, vcmax, vjmax
+                                                                           !! for photosynthesis (K ??)
+    REAL(r_std),DIMENSION (kjpindex,2),   INTENT (in)  :: lalo               !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,8),INTENT (in)  :: neighbours         !! Vector of neighbours for each 
+                                                                             !! grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)     :: resolution         !! The size in km of each grid-box in X and Y
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: ptnlev1            !! 1st level of soil temperature (Kelvin)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_rain        !! Rain precipitation expressed in mm/tstep
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT (in)  :: frac_age !! Age efficiency for isoprene emissions (from STOMATE)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: tot_bare_soil      !! Total evaporating bare soil fraction 
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta            !! Total beta coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: valpha           !! Total alpha coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta1           !! Beta for sublimation (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta4           !! Beta for bare soil evaporation (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta5           !! Beta for floodplains
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: gsmean           !! Mean stomatal conductance to CO2 (umol m-2 s-1) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta2           !! Beta for interception loss (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta3           !! Beta for transpiration (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta3pot        !! Beta for potential transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: rveget           !! Stomatal resistance for the whole canopy (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: rstruct          !! Structural resistance for the vegetation
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: cimean           !! Mean leaf Ci (ppm)  
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out)  :: gpp              !! Assimilation ((gC m^{-2} s^{-1}), total area)  
+
+    !! 0.3 Modified variables
+ 
+    REAL(r_std),DIMENSION (kjpindex, nvm), INTENT (inout) :: humrel        !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: q_cdrag       !! Product of drag coefficient and wind speed (m s^{-1})
+
+    !! 0.4 Local variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: vbeta23            !! Beta for fraction of wetted foliage that will
+                                                                   !! transpire once intercepted water has evaporated (-)
+    REAL(r_std),DIMENSION (kjpindex)         :: raero              !! Aerodynamic resistance (s m^{-1})
+    INTEGER(i_std)                           :: ilai
+    CHARACTER(LEN=4)                         :: laistring
+    CHARACTER(LEN=80)                        :: var_name           !! To store variables names for I/O
+    REAL(r_std),DIMENSION(kjpindex)          :: qsatt              !! Surface saturated humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm)     :: cim                !! Intercellular CO2 over nlai 
+
+!_ ================================================================================================================================
+    
+    wind(:) = SQRT (u(:)*u(:) + v(:)*v(:))
+  
+  !! 1. Calculate the different coefficients
+
+    IF (.NOT.ldq_cdrag_from_gcm) THEN
+        ! Case 1a)
+       CALL diffuco_aero (kjpindex, kjit, u, v, zlev, z0, roughheight, temp_sol, temp_air, &
+                          qsurf, qair, snow, q_cdrag)
+    ENDIF
+
+    ! Case 1b)
+    CALL diffuco_raerod (kjpindex, u, v, q_cdrag, raero)
+
+  !! 2. Make an estimation of the saturated humidity at the surface
+
+    CALL qsatcalc (kjpindex, temp_sol, pb, qsatt)
+
+  !! 3. Calculate the beta coefficient for sublimation
+  
+    CALL diffuco_snow (kjpindex, qair, qsatt, rau, u, v, q_cdrag, &
+         & snow, frac_nobio, totfrac_nobio, snow_nobio, vbeta1)
+
+
+    CALL diffuco_flood (kjpindex, qair, qsatt, rau, u, v, q_cdrag, evapot, evapot_corr, &
+         & flood_frac, flood_res, vbeta5)
+
+  !! 4. Calculate the beta coefficient for interception
+
+    CALL diffuco_inter (kjpindex, qair, qsatt, rau, u, v, q_cdrag, humrel, veget, &
+       & qsintveg, qsintmax, rstruct, vbeta2, vbeta23) 
+
+
+  !! 5. Calculate the beta coefficient for transpiration
+
+    IF ( ok_co2 ) THEN
+
+      ! case 5a)
+      CALL diffuco_trans_co2 (kjpindex, swdown, pb, qsurf, q2m, t2m, temp_growth, rau, u, v, q_cdrag, humrel, &
+                              assim_param, ccanopy, &
+                              veget, veget_max, lai, qsintveg, qsintmax, vbeta3, vbeta3pot, &
+                              rveget, rstruct, cimean, gsmean, gpp, vbeta23, cim)
+
+    ELSE
+
+      ! case 5b) 
+      CALL diffuco_trans (kjpindex, swnet, temp_air, pb, qair, rau, u, v, q_cdrag, humrel, &
+           & veget, veget_max, lai, qsintveg, qsintmax, vbeta3, vbeta3pot, rveget, rstruct, cimean, &
+           & gsmean, vbeta23)
+
+    ENDIF
+
+
+    !
+    !biogenic emissions
+    !
+    IF ( ok_bvoc ) THEN
+       CALL chemistry_bvoc (kjpindex, swdown, coszang, temp_air, &
+            temp_sol, ptnlev1, precip_rain, humrel, veget_max, &
+            lai, frac_age, lalo, ccanopy, cim, wind, snow, &
+            veget, hist_id, hist2_id, kjit, index, &
+            indexlai, indexveg)
+    ENDIF
+    !
+    ! combination of coefficient : alpha and beta coefficient
+    ! beta coefficient for bare soil
+    !
+
+    CALL diffuco_bare (kjpindex, u, v, q_cdrag, rsol, evap_bare_lim, humrel, &
+         veget, veget_max, tot_bare_soil, vbeta2, vbeta3, vbeta4)
+
+  !! 6. Combine the alpha and beta coefficients
+
+    ! Ajout qsintmax dans les arguments de la routine.... Nathalie / le 13-03-2006
+    CALL diffuco_comb (kjpindex, humrel, rau, u, v, q_cdrag, pb, qair, temp_sol, temp_air, snow, &
+       & veget, lai, tot_bare_soil, vbeta1, vbeta2, vbeta3, vbeta4, valpha, vbeta, qsintmax)
+
+    CALL xios_orchidee_send_field("cdrag",q_cdrag)
+    CALL xios_orchidee_send_field("raero",raero)
+    CALL xios_orchidee_send_field("Wind",wind)
+    CALL xios_orchidee_send_field("qsatt",qsatt)
+    CALL xios_orchidee_send_field("coszang",coszang)
+    IF ( ok_co2 ) CALL xios_orchidee_send_field('cim', cim)
+
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'raero', kjit, raero, kjpindex, index)
+       CALL histwrite_p(hist_id, 'cdrag', kjit, q_cdrag, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Wind', kjit, wind, kjpindex, index)
+       CALL histwrite_p(hist_id, 'qsatt', kjit, qsatt, kjpindex, index)
+       IF ( ok_co2 ) CALL histwrite_p(hist_id, 'cim', kjit, cim, kjpindex*nvm, indexveg)
+
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'raero', kjit, raero, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'cdrag', kjit, q_cdrag, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Wind', kjit, wind, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'qsatt', kjit, qsatt, kjpindex, index)
+       ENDIF
+    ELSE
+
+    ENDIF
+
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_main done '
+
+  END SUBROUTINE diffuco_main
+
+!!  =============================================================================================================================
+!! SUBROUTINE: diffuco_finalize
+!!
+!>\BRIEF          Write to restart file
+!!
+!! DESCRIPTION:   This subroutine writes the module variables and variables calculated in diffuco
+!!                to restart file
+!!
+!! RECENT CHANGE(S): None
+!! REFERENCE(S): None
+!! FLOWCHART: None
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE diffuco_finalize (kjit, kjpindex, rest_id, rstruct )
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number (-) 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),INTENT (in)                         :: rest_id          !! _Restart_ file identifier (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: rstruct          !! Structural resistance for the vegetation
+
+    !! 0.4 Local variables
+    INTEGER                                            :: ilai
+    CHARACTER(LEN=4)                                   :: laistring
+    CHARACTER(LEN=80)                                  :: var_name        
+
+!_ ================================================================================================================================
+    
+  !! 1. Prepare the restart file for the next simulation
+    IF (printlev>=3) WRITE (numout,*) 'Complete restart file with DIFFUCO variables '
+    CALL restput_p (rest_id, 'rstruct', nbp_glo, nvm, 1, kjit, rstruct, 'scatter',  nbp_glo, index_g)
+    
+    ! The following variable is written only if CO2 was calculated
+    IF ( ok_co2 ) THEN
+       DO ilai = 1, nlai
+          WRITE(laistring,'(i4)') ilai
+          laistring=ADJUSTL(laistring)
+          var_name='leaf_ci_'//laistring(1:LEN_TRIM(laistring))
+          CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, leaf_ci(:,:,ilai), 'scatter',  nbp_glo, index_g)
+       END DO
+    END IF
+  
+  END SUBROUTINE diffuco_finalize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE		 			: diffuco_clear
+!!
+!>\BRIEF					Housekeeping module to deallocate the variables
+!! leaf_ci, rstruct and raero
+!!
+!! DESCRIPTION				        : Housekeeping module to deallocate the variables
+!! leaf_ci, rstruct and raero
+!!
+!! RECENT CHANGE(S)                             : None
+!!
+!! MAIN OUTPUT VARIABLE(S)	                : None
+!!
+!! REFERENCE(S)				        : None
+!!
+!! FLOWCHART                                    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_clear()
+
+    IF (ALLOCATED (leaf_ci)) DEALLOCATE (leaf_ci)
+
+  END SUBROUTINE diffuco_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	: diffuco_aero
+!!
+!>\BRIEF	This module first calculates the surface drag 
+!! coefficient, for cases in which the surface drag coefficient is NOT provided by the coupled 
+!! atmospheric model LMDZ or when the flag ldq_cdrag_from_gcm is set to FALSE 
+!!
+!! DESCRIPTION	: Computes the surface drag coefficient, for cases 
+!! in which it is NOT provided by the coupled atmospheric model LMDZ. The module first uses the 
+!! meteorolgical input to calculate the Richardson Number, which is an indicator of atmospheric 
+!! stability in the surface layer. The formulation used to find this surface drag coefficient is 
+!! dependent on the stability determined. \n
+!!
+!! Designation of wind speed
+!! \latexonly 
+!!     \input{diffucoaero1.tex}
+!! \endlatexonly
+!!
+!! Calculation of geopotential. This is the definition of Geopotential height (e.g. Jacobson 
+!! eqn.4.47, 2005). (required for calculation of the Richardson Number)
+!! \latexonly 
+!!     \input{diffucoaero2.tex}
+!! \endlatexonly
+!! 
+!! \latexonly 
+!!     \input{diffucoaero3.tex}
+!! \endlatexonly
+!!
+!! Calculation of the virtual air temperature at the surface (required for calculation
+!! of the Richardson Number)
+!! \latexonly 
+!!     \input{diffucoaero4.tex}
+!! \endlatexonly
+!!
+!! Calculation of the virtual surface temperature (required for calculation of th
+!! Richardson Number)
+!! \latexonly 
+!!     \input{diffucoaero5.tex}
+!! \endlatexonly
+!!
+!! Calculation of the squared wind shear (required for calculation of the Richardson
+!! Number)
+!! \latexonly 
+!!     \input{diffucoaero6.tex}
+!! \endlatexonly
+!! 
+!! Calculation of the Richardson Number. The Richardson Number is defined as the ratio 
+!! of potential to kinetic energy, or, in the context of atmospheric science, of the
+!! generation of energy by wind shear against consumption
+!! by static stability and is an indicator of flow stability (i.e. for when laminar flow 
+!! becomes turbulent and vise versa). It is approximated using the expression below:
+!! \latexonly 
+!!     \input{diffucoaero7.tex}
+!! \endlatexonly
+!!
+!! The Richardson Number hence calculated is subject to a minimum value:
+!! \latexonly 
+!!     \input{diffucoaero8.tex}
+!! \endlatexonly
+!! 
+!! Computing the drag coefficient. We add the add the height of the vegetation to the 
+!! level height to take into account that the level 'seen' by the vegetation is actually 
+!! the top of the vegetation. Then we we can subtract the displacement height.
+!! \latexonly 
+!!     \input{diffucoaero9.tex}
+!! \endlatexonly
+!! 
+!! For the stable case (i.e $R_i$ $\geq$ 0)
+!! \latexonly 
+!!     \input{diffucoaero10.tex}
+!! \endlatexonly
+!!
+!! \latexonly 
+!!     \input{diffucoaero11.tex}
+!! \endlatexonly
+!!          
+!! For the unstable case (i.e. $R_i$ < 0)
+!! \latexonly 
+!!     \input{diffucoaero12.tex}
+!! \endlatexonly
+!!
+!! \latexonly 
+!!     \input{diffucoaero13.tex}
+!! \endlatexonly
+!!               
+!! If the Drag Coefficient becomes too small than the surface may uncouple from the atmosphere.
+!! To prevent this, a minimum limit to the drag coefficient is defined as:
+!!
+!! \latexonly 
+!!     \input{diffucoaero14.tex}
+!! \endlatexonly
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): q_cdrag
+!!
+!! REFERENCE(S)	: 
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!! - Jacobson M.Z., Fundamentals of Atmospheric Modeling (2nd Edition), published Cambridge 
+!! University Press, ISBN 0-521-54865-9
+!!
+!! FLOWCHART	:
+!! \latexonly 
+!!     \includegraphics[scale=0.5]{diffuco_aero_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_aero (kjpindex, kjit, u, v, zlev, z0, roughheight, temp_sol, temp_air, &
+                           qsurf, qair, snow, q_cdrag)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex, kjit   !! Domain size
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: u                !! Eastward Lowest level wind speed (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: v                !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: zlev             !! Height of first atmospheric layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: z0               !! Surface roughness Length (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: roughheight      !! Effective roughness height (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: temp_sol         !! Ground temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: temp_air         !! Lowest level temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: qsurf            !! near surface specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: qair             !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: snow             !! Snow mass (kg)
+
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: q_cdrag          !! Product of Surface drag coefficient and wind speed 
+                                                                            !! (m s^{-1})
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jv
+    REAL(r_std)                                         :: speed, zg, zdphi, ztvd, ztvs, zdu2
+    REAL(r_std)                                         :: zri, cd_neut, zscf, cd_tmp
+    REAL(r_std)                                         :: snowfact
+!_ ================================================================================================================================
+
+  !! 1. Initialisation
+
+    ! test if we have to work with q_cdrag or to calcul it
+    DO ji=1,kjpindex
+       
+       !! 1a).1 Designation of wind speed
+       !! \latexonly 
+       !!     \input{diffucoaero1.tex}
+       !! \endlatexonly
+       speed = wind(ji)
+    
+       !! 1a).2 Calculation of geopotentiel
+       !! This is the definition of Geopotential height (e.g. Jacobson eqn.4.47, 2005). (required
+       !! for calculation of the Richardson Number)
+       !! \latexonly 
+       !!     \input{diffucoaero2.tex}
+       !! \endlatexonly
+       zg = zlev(ji) * cte_grav
+      
+       !! \latexonly 
+       !!     \input{diffucoaero3.tex}
+       !! \endlatexonly
+       zdphi = zg/cp_air
+       
+       !! 1a).3 Calculation of the virtual air temperature at the surface 
+       !! required for calculation of the Richardson Number
+       !! \latexonly 
+       !!     \input{diffucoaero4.tex}
+       !! \endlatexonly
+       ztvd = (temp_air(ji) + zdphi / (un + rvtmp2 * qair(ji))) * (un + retv * qair(ji)) 
+       
+       !! 1a).4 Calculation of the virtual surface temperature 
+       !! required for calculation of the Richardson Number
+       !! \latexonly 
+       !!     \input{diffucoaero5.tex}
+       !! \endlatexonly
+       ztvs = temp_sol(ji) * (un + retv * qsurf(ji))
+     
+       !! 1a).5 Calculation of the squared wind shear 
+       !! required for calculation of the Richardson Number
+       !! \latexonly 
+       !!     \input{diffucoaero6.tex}
+       !! \endlatexonly
+       zdu2 = MAX(cepdu2,speed**2)
+       
+       !! 1a).6 Calculation of the Richardson Number
+       !!  The Richardson Number is defined as the ratio of potential to kinetic energy, or, in the 
+       !!  context of atmospheric science, of the generation of energy by wind shear against consumption
+       !!  by static stability and is an indicator of flow stability (i.e. for when laminar flow 
+       !!  becomes turbulent and vise versa).\n
+       !!  It is approximated using the expression below:
+       !!  \latexonly 
+       !!     \input{diffucoaero7.tex}
+       !! \endlatexonly
+       zri = zg * (ztvd - ztvs) / (zdu2 * ztvd)
+      
+       !! The Richardson Number hence calculated is subject to a minimum value:
+       !! \latexonly 
+       !!     \input{diffucoaero8.tex}
+       !! \endlatexonly       
+       zri = MAX(MIN(zri,5.),-5.)
+       
+       !! 1a).7 Computing the drag coefficient
+       !!  We add the add the height of the vegetation to the level height to take into account
+       !!  that the level 'seen' by the vegetation is actually the top of the vegetation. Then we 
+       !!  we can subtract the displacement height.
+       !! \latexonly 
+       !!     \input{diffucoaero9.tex}
+       !! \endlatexonly
+
+       !! 7.0 Snow smoothering
+       !! Snow induces low levels of turbulence.
+       !! Sensible heat fluxes can therefore be reduced of ~1/3. Pomeroy et al., 1998
+       snowfact=1.
+       IF (snow(ji).GT.snowcri .AND. ok_snowfact)  snowfact=10.
+
+       cd_neut = (ct_karman / LOG( (zlev(ji) + roughheight(ji)) / z0(ji) )) ** 2 
+       
+       !! 1a).7.1 - for the stable case (i.e $R_i$ $\geq$ 0)
+       IF (zri .GE. zero) THEN
+          
+          !! \latexonly 
+          !!     \input{diffucoaero10.tex}
+          !! \endlatexonly
+          zscf = SQRT(un + cd * ABS(zri))
+         
+          !! \latexonly 
+          !!     \input{diffucoaero11.tex}
+          !! \endlatexonly          
+          cd_tmp=cd_neut/(un + trois * cb * zri * zscf)
+       ELSE
+          
+          !! 1a).7.2 - for the unstable case (i.e. $R_i$ < 0)
+          !! \latexonly 
+          !!     \input{diffucoaero12.tex}
+          !! \endlatexonly
+          zscf = un / (un + trois * cb * cc * cd_neut * SQRT(ABS(zri) * &
+               & ((zlev(ji) + roughheight(ji)) / z0(ji)/snowfact)))
+
+          !! \latexonly 
+          !!     \input{diffucoaero13.tex}
+          !! \endlatexonly               
+          cd_tmp=cd_neut * (un - trois * cb * zri * zscf)
+       ENDIF
+       
+       !! If the Drag Coefficient becomes too small than the surface may uncouple from the atmosphere.
+       !! To prevent this, a minimum limit to the drag coefficient is defined as:
+       
+       !! \latexonly 
+       !!     \input{diffucoaero14.tex}
+       !! \endlatexonly
+       !!
+       q_cdrag(ji) = MAX(cd_tmp, 1.e-4/MAX(speed,min_wind))
+
+       ! In some situations it might be useful to give an upper limit on the cdrag as well. 
+       ! The line here should then be uncommented.
+      !q_cdrag(ji) = MIN(q_cdrag(ji), 0.5/MAX(speed,min_wind))
+
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' not ldqcdrag_from_gcm : diffuco_aero done '
+
+  END SUBROUTINE diffuco_aero
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : diffuco_snow
+!!
+!>\BRIEF         This subroutine computes the beta coefficient for snow sublimation.
+!!
+!! DESCRIPTION   : This routine computes beta coefficient for snow sublimation, which
+!! integrates the snow on both vegetation and other surface types (e.g. ice, lakes,
+!! cities etc.) \n
+!!
+!! A critical depth of snow (snowcri) is defined to calculate the fraction of each grid-cell
+!! that is covered with snow (snow/snowcri) while the remaining part is snow-free.
+!! We also carry out a first calculation of sublimation (subtest) to lower down the beta
+!! coefficient if necessary (if subtest > snow). This is a predictor-corrector test. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vbeta1 
+!!
+!! REFERENCE(S) :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp. 248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+SUBROUTINE diffuco_snow (kjpindex, qair, qsatt, rau, u, v,q_cdrag, &
+       & snow, frac_nobio, totfrac_nobio, snow_nobio, vbeta1)
+
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT(in)                           :: kjpindex       !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qair           !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qsatt          !! Surface saturated humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau            !! Air density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u              !! Eastward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v              !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag        !! Product of surface drag coefficient and wind speed (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: snow           !! Snow mass (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio     !! Fraction of ice, lakes, cities etc. (-)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio     !! Snow on ice, lakes, cities etc. (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: totfrac_nobio  !! Total fraction of ice, lakes, cities etc. (-)
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vbeta1         !! Beta for sublimation (dimensionless ratio) 
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    REAL(r_std)                                          :: subtest        !! Sublimation for test (kg m^{-2})
+    REAL(r_std)                                          :: zrapp          !! Modified factor (ratio)
+    REAL(r_std)                                          :: speed          !! Wind speed (m s^{-1})
+    REAL(r_std)                                          :: vbeta1_add     !! Beta for sublimation (ratio)
+    INTEGER(i_std)                                       :: ji, jv         !! Indices (-)
+!_ ================================================================================================================================
+
+  !! 1. Calculate beta coefficient for snow sublimation on the vegetation\n
+
+    DO ji=1,kjpindex  ! Loop over # pixels - domain size
+
+       ! Fraction of mesh that can sublimate snow
+       vbeta1(ji) = (un - totfrac_nobio(ji)) * MAX( MIN(snow(ji)/snowcri,un),zero)
+
+       ! Limitation of sublimation in case of snow amounts smaller than the atmospheric demand. 
+       speed = MAX(min_wind, wind(ji))
+
+       subtest = dt_sechiba * vbeta1(ji) * speed * q_cdrag(ji) * rau(ji) * &
+               & ( qsatt(ji) - qair(ji) )
+
+       IF ( subtest .GT. zero ) THEN
+          zrapp = snow(ji) / subtest
+          IF ( zrapp .LT. un ) THEN
+             vbeta1(ji) = vbeta1(ji) * zrapp
+          ENDIF
+       ENDIF
+
+    END DO ! Loop over # pixels - domain size
+
+  !! 2. Add the beta coefficients calculated from other surfaces types (snow on ice,lakes, cities...)
+
+    DO jv = 1, nnobio ! Loop over # other surface types
+!!$      !
+!!$      IF ( jv .EQ. iice ) THEN
+!!$        !
+!!$        !  Land ice is of course a particular case
+!!$        !
+!!$        DO ji=1,kjpindex
+!!$          vbeta1(ji) = vbeta1(ji) + frac_nobio(ji,jv)
+!!$        ENDDO
+!!$        !
+!!$      ELSE
+        !
+        DO ji=1,kjpindex ! Loop over # pixels - domain size
+
+           vbeta1_add = frac_nobio(ji,jv) * MAX(MIN(snow_nobio(ji,jv)/snowcri,un), zero)
+
+           ! Limitation of sublimation in case of snow amounts smaller than
+           ! the atmospheric demand. 
+           speed = MAX(min_wind, wind(ji))
+            
+            !!     Limitation of sublimation by the snow accumulated on the ground 
+            !!     A first approximation is obtained with the old values of
+            !!     qair and qsol_sat: function of temp-sol and pb. (see call of qsatcalc)
+           subtest = dt_sechiba * vbeta1_add * speed * q_cdrag(ji) * rau(ji) * &
+                & ( qsatt(ji) - qair(ji) )
+
+           IF ( subtest .GT. zero ) THEN
+              zrapp = snow_nobio(ji,jv) / subtest
+              IF ( zrapp .LT. un ) THEN
+                 vbeta1_add = vbeta1_add * zrapp
+              ENDIF
+           ENDIF
+
+           vbeta1(ji) = vbeta1(ji) + vbeta1_add
+
+        ENDDO ! Loop over # pixels - domain size
+
+!!$      ENDIF
+      
+    ENDDO ! Loop over # other surface types
+
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_snow done '
+
+  END SUBROUTINE diffuco_snow
+
+
+!! ================================================================================================================================
+!! SUBROUTINE		 			: diffuco_flood 
+!!
+!>\BRIEF				       	This routine computes partial beta coefficient : floodplains
+!!
+!! DESCRIPTION				        : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S)	                : vbeta5
+!!
+!! REFERENCE(S)				        : None
+!!
+!! FLOWCHART                                    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_flood (kjpindex, qair, qsatt, rau, u, v, q_cdrag, evapot, evapot_corr, &
+       & flood_frac, flood_res, vbeta5)
+
+    ! interface description
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex   !! Domain size
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair       !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qsatt      !! Surface saturated humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau        !! Density
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u          !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v          !! Lowest level wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag    !! Surface drag
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: flood_res  !! water mass in flood reservoir
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: flood_frac !! fraction of floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: evapot     !! Potential evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: evapot_corr!! Potential evaporation2
+    ! output fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: vbeta5     !! Beta for floodplains
+
+    ! local declaration
+    REAL(r_std)                                              :: subtest, zrapp, speed
+    INTEGER(i_std)                                           :: ji, jv
+
+!_ ================================================================================================================================
+    !
+    ! beta coefficient for sublimation for floodplains
+    !
+    DO ji=1,kjpindex
+       !
+       IF (evapot(ji) .GT. min_sechiba) THEN
+          vbeta5(ji) = flood_frac(ji) *evapot_corr(ji)/evapot(ji)
+       ELSE
+          vbeta5(ji) = flood_frac(ji)
+       ENDIF
+       !
+       ! -- Limitation of evaporation in case of water amounts smaller than
+       !    the atmospheric demand. 
+       
+       !
+       speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+       !
+       subtest = dt_sechiba * vbeta5(ji) * speed * q_cdrag(ji) * rau(ji) * &
+               & ( qsatt(ji) - qair(ji) )
+       !  
+       IF ( subtest .GT. zero ) THEN
+          zrapp = flood_res(ji) / subtest
+          IF ( zrapp .LT. un ) THEN
+             vbeta5(ji) = vbeta5(ji) * zrapp
+          ENDIF
+       ENDIF
+       !
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_flood done '
+
+  END SUBROUTINE diffuco_flood
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : diffuco_inter
+!!
+!>\BRIEF	 This routine computes the partial beta coefficient
+!! for the interception for each type of vegetation
+!!
+!! DESCRIPTION   : We first calculate the dry and wet parts of each PFT (wet part = qsintveg/qsintmax).
+!! The former is submitted to transpiration only (vbeta3 coefficient, calculated in 
+!! diffuco_trans or diffuco_trans_co2), while the latter is first submitted to interception loss 
+!! (vbeta2 coefficient) and then to transpiration once all the intercepted water has been evaporated 
+!! (vbeta23 coefficient). Interception loss is also submitted to a predictor-corrector test, 
+!! as for snow sublimation. \n
+!!
+!! \latexonly 
+!!     \input{diffucointer1.tex}
+!! \endlatexonly
+!! Calculate the wet fraction of vegetation as  the ration between the intercepted water and the maximum water 
+!! on the vegetation. This ratio defines the wet portion of vegetation that will be submitted to interception loss.
+!!
+!! \latexonly 
+!!     \input{diffucointer2.tex}
+!! \endlatexonly
+!!
+!! Calculation of $\beta_3$, the canopy transpiration resistance
+!! \latexonly 
+!!     \input{diffucointer3.tex}
+!! \endlatexonly            
+!! 
+!! We here determine the limitation of interception loss by the water stored on the leaf. 
+!! A first approximation of interception loss is obtained using the old values of
+!! qair and qsol_sat, which are functions of temp-sol and pb. (see call of 'qsatcalc')
+!! \latexonly 
+!!     \input{diffucointer4.tex}
+!! \endlatexonly
+!!
+!! \latexonly
+!!     \input{diffucointer5.tex}
+!! \endlatexonly
+!!
+!! \latexonly 
+!!     \input{diffucointer6.tex}
+!! \endlatexonly
+!!
+!! Once the whole water stored on foliage has evaporated, transpiration can take place on the fraction
+!! 'zqsvegrap'.
+!! \latexonly 
+!!     \input{diffucointer7.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vbeta2, ::vbeta23
+!!
+!! REFERENCE(S) :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp. 248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!! - Perrier, A, 1975. Etude physique de l'Ã©vaporation dans les conditions naturelles. Annales 
+!! Agronomiques, 26(1-18): pp. 105-123, pp. 229-243
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_inter (kjpindex, qair, qsatt, rau, u, v, q_cdrag, humrel, veget, &
+     & qsintveg, qsintmax, rstruct, vbeta2, vbeta23)
+   
+  !! 0 Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                           :: kjpindex   !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qair       !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qsatt      !! Surface saturated humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau        !! Air Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u          !! Eastward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v          !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag    !! Product of Surface drag coefficient and wind 
+                                                                       !! speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: humrel     !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget      !! vegetation fraction for each type (fraction)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintveg   !! Water on vegetation due to interception (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintmax   !! Maximum water on vegetation (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: rstruct    !! architectural resistance (s m^{-1})
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vbeta2     !! Beta for interception loss (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vbeta23    !! Beta for fraction of wetted foliage that will 
+                                                                       !! transpire (-)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                       :: ji, jv                               !! (-), (-)
+    REAL(r_std)                                          :: zqsvegrap, ziltest, zrapp, speed     !!
+!_ ================================================================================================================================
+
+  !! 1. Initialize
+
+    vbeta2(:,:) = zero
+    vbeta23(:,:) = zero
+   
+  !! 2. The beta coefficient for interception by vegetation. 
+    
+    DO jv = 2,nvm
+
+      DO ji=1,kjpindex
+
+         IF (veget(ji,jv) .GT. min_sechiba .AND. qsintveg(ji,jv) .GT. zero ) THEN
+
+            zqsvegrap = zero
+            IF (qsintmax(ji,jv) .GT. min_sechiba ) THEN
+
+            !! \latexonly 
+            !!     \input{diffucointer1.tex}
+            !! \endlatexonly
+            !!
+            !! We calculate the wet fraction of vegetation as  the ration between the intercepted water and the maximum water 
+            !! on the vegetation. This ratio defines the wet portion of vegetation that will be submitted to interception loss.
+            !!
+                zqsvegrap = MAX(zero, qsintveg(ji,jv) / qsintmax(ji,jv))
+            END IF
+
+            !! \latexonly 
+            !!     \input{diffucointer2.tex}
+            !! \endlatexonly
+            speed = MAX(min_wind, wind(ji))
+
+            !! Calculation of $\beta_3$, the canopy transpiration resistance
+            !! \latexonly 
+            !!     \input{diffucointer3.tex}
+            !! \endlatexonly
+            vbeta2(ji,jv) = veget(ji,jv) * zqsvegrap * (un / (un + speed * q_cdrag(ji) * rstruct(ji,jv)))
+            
+            !! We here determine the limitation of interception loss by the water stored on the leaf. 
+            !! A first approximation of interception loss is obtained using the old values of
+            !! qair and qsol_sat, which are functions of temp-sol and pb. (see call of 'qsatcalc')
+            !! \latexonly 
+            !!     \input{diffucointer4.tex}
+            !! \endlatexonly
+            ziltest = dt_sechiba * vbeta2(ji,jv) * speed * q_cdrag(ji) * rau(ji) * &
+               & ( qsatt(ji) - qair(ji) )
+
+            IF ( ziltest .GT. zero ) THEN
+
+                !! \latexonly 
+                !!     \input{diffucointer5.tex}
+                !! \endlatexonly
+                zrapp = qsintveg(ji,jv) / ziltest
+                IF ( zrapp .LT. un ) THEN
+                   
+                    !! \latexonly 
+                    !!     \input{diffucointer6.tex}
+                    !! \endlatexonly
+                    !!
+		    !! Once the whole water stored on foliage has evaporated, transpiration can take place on the fraction
+                    !! 'zqsvegrap'.
+                   IF ( humrel(ji,jv) >= min_sechiba ) THEN
+                      vbeta23(ji,jv) = MAX(vbeta2(ji,jv) - vbeta2(ji,jv) * zrapp, zero)
+                   ELSE
+                      ! We don't want transpiration when the soil cannot deliver it
+                      vbeta23(ji,jv) = zero
+                   ENDIF
+                    
+                    !! \latexonly 
+                    !!     \input{diffucointer7.tex}
+                    !! \endlatexonly
+                    vbeta2(ji,jv) = vbeta2(ji,jv) * zrapp
+                ENDIF
+            ENDIF
+        END IF
+!        ! Autre formulation possible pour l'evaporation permettant une transpiration sur tout le feuillage
+!        !commenter si formulation Nathalie sinon Tristan
+!        speed = MAX(min_wind, wind(ji))
+!        
+!        vbeta23(ji,jv) = MAX(zero, veget(ji,jv) * (un / (un + speed * q_cdrag(ji) * rstruct(ji,jv))) - vbeta2(ji,jv))
+
+      END DO
+
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_inter done '
+
+  END SUBROUTINE diffuco_inter
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE      : diffuco_bare
+!!
+!>\BRIEF	   This routine computes the partial beta coefficient corresponding to
+!! bare soil
+!!
+!! DESCRIPTION	   : Bare soil evaporation is either limited by a soil resistance 
+!! (rsol) that is calculated in hydrolc.f90, when Choisnel hydrology is used or 
+!! submitted to a maximum possible flow (evap_bare_lim) if the 11-layer hydrology is used.\n
+!! 
+!! Calculation of wind speed
+!! \latexonly 
+!!     \input{diffucobare1.tex}
+!! \endlatexonly
+!!             
+!! The calculation of $\beta_4$
+!! \latexonly 
+!!     \input{diffucobare2.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vbeta4
+!!
+!! REFERENCE(S)	 :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_bare (kjpindex, u, v, q_cdrag, rsol, evap_bare_lim, humrel, &
+       & veget, veget_max, tot_bare_soil, vbeta2, vbeta3, vbeta4)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjpindex       !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: u              !! Eastward Lowest level wind speed (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: v              !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: q_cdrag        !! Product of Surface drag coefficient and wind speed 
+                                                                         !! (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: rsol           !! resistance for bare soil evaporation  (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evap_bare_lim  !! limiting factor for bare soil evaporation when the 
+                                                                         !! 11-layer hydrology is used (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: humrel         !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget          !! Type of vegetation fraction (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max      !! Type of vegetation max fraction
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vbeta2         !! Beta for Interception 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vbeta3         !! Beta for Transpiration 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)      :: tot_bare_soil  !! Total evaporating bare soil fraction 
+
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta4         !! Beta for bare soil evaporation (-)
+    
+    !! 0.3 Modified variables
+        
+    !! 0.4 Local variables
+    REAL(r_std)                                    :: humveg_prod
+
+    INTEGER(i_std)                                     :: ji, jv
+    REAL(r_std)                                        :: speed          !! Surface wind speed (m s^{-1})
+!_ ================================================================================================================================
+
+  !! 1. Calculation of the soil resistance and the beta (beta_4) for bare soil
+
+    IF ( .NOT. hydrol_cwrr ) THEN
+       DO ji = 1, kjpindex
+          
+          vbeta4(ji) = zero
+          !     
+          ! 1.   Soil resistance and beta for bare soil
+          !      note: tot_bare_soil contains the fraction of bare soil
+          !            see slowproc module
+          !
+          speed = MAX(min_wind, wind(ji))
+          !
+          humveg_prod = tot_bare_soil(ji) * humrel(ji,1)
+          !
+          DO jv = 2, nvm
+             humveg_prod = humveg_prod + veget(ji,jv) * humrel(ji,jv)
+          ENDDO
+            
+             !! \latexonly 
+             !!     \input{diffucobare1.tex}
+             !! \endlatexonly
+          IF (tot_bare_soil(ji) .GE. min_sechiba) THEN
+             
+             ! Correction Nathalie de Noblet - le 27 Mars 2006
+             ! Selon recommandation de Frederic Hourdin: supprimer humrel dans formulation vbeta4
+             !vbeta4(ji) = tot_bare_soil(ji) *humrel(ji,1)* (un / (un + speed * q_cdrag(ji) * rsol(ji)))
+             ! Nathalie - le 28 mars 2006 - vbeta4 n'etait pas calcule en fonction de
+             ! rsol mais de rsol_cste * hdry! Dans ce cas inutile de calculer rsol(ji)!!
+             vbeta4(ji) = tot_bare_soil(ji) * (un / (un + speed * q_cdrag(ji) * rsol(ji)))
+             
+          ENDIF
+          !Commenter la ligne ci-dessous si calcul Nathalie sinon Tristan
+!          vbeta4(ji) = MIN(humveg_prod * (un / (un + speed * q_cdrag(ji) * rsol(ji))), &
+!               & un - SUM(vbeta2(ji,:)+vbeta3(ji,:)))
+          
+       END DO
+    ELSE
+       DO ji = 1, kjpindex
+
+          ! The limitation by 1-beta2-beta3 is due to the fact that evaporation under vegetation is possible
+          !! \latexonly 
+          !!     \input{diffucobare3.tex}
+          !! \endlatexonly
+          vbeta4(ji) = MIN(evap_bare_lim(ji), un - SUM(vbeta2(ji,:)+vbeta3(ji,:)))
+       END DO
+    ENDIF
+    
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_bare done '
+    
+  END SUBROUTINE diffuco_bare
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	: diffuco_trans 
+!!
+!>\BRIEF        This routine computes the partial beta coefficient 
+!! corresponding to transpiration for each vegetation type.
+!!
+!! DESCRIPTION  : Beta coefficients for transpiration are calculated 
+!! here using Jarvis formulation for stomatal resistance and
+!! the structural resistance to represent the vertical gradient of 
+!! transpiration within the canopy. \n
+!!
+!! The Jarvis formulation as used here is derived by Lohanner et al. (1980) from Jarvis (1976). This formulation is
+!! semi-empirical: \n
+!!
+!! \latexonly 
+!!     \input{diffucotrans4.tex}
+!! \endlatexonly
+!! \n
+!!            
+!! where in this expression LAI is the single sided Leaf Area Index, R_{new}^{SW} the net shortwave radiation,
+!! R_{SO} the half light saturation factor, \delta c the water vapour concentration deficit, and a, k_0 and \lambda
+!! are all parameters that are derived from extensive measurement of surface layer vegetation. \n
+!!
+!! Structural resistance (or architectural resistance) is a function of vegetation type and is assigned based on the
+!! particular Plant Functional Type (PFT) in question. The range of values for the structural resistance are listed
+!! in the module 'pft_parameters', and are described in de Noblet-DucoudrÃ© et al (1993). \n
+!!
+!! vbetaco2 is here set to zero as this way to compute canopy resistances is only used 
+!! without STOMATE, and there is therefore no photosynthesis. \n
+!!
+!! Moisture concentration at the leaf level.
+!! \latexonly 
+!!     \input{diffucotrans1.tex}
+!! \endlatexonly
+!!   
+!! Calulation of the beta coefficient for vegetation transpiration, beta_3.
+!! \latexonly 
+!!     \input{diffucotrans2.tex}
+!! \endlatexonly
+!! \latexonly             
+!!     \input{diffucotrans3.tex}
+!! \endlatexonly
+!!
+!! \latexonly 
+!!     \input{diffucotrans4.tex}
+!! \endlatexonly            
+!!
+!! This is the formulation for beta_3.
+!! \latexonly 
+!!     \input{diffucotrans5.tex}
+!! \endlatexonly
+!!
+!! \latexonly 
+!!     \input{diffucotrans6.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vbeta3, ::rveget, ::cimean and ::vbetaco2
+!!
+!! REFERENCE(S) :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!! - Jarvis, PG, 1976. The interpretation of the variations in leaf water potential and stomatal
+!! conductance found in canopies in the fields. Philosophical Transactions of the Royal Society of
+!! London, Series B, 273, pp. 593-610
+!! - Lohammer T, Larsson S, Linder S & Falk SO, 1980. Simulation models of gaseous exchange in Scotch
+!! pine. Structure and function of Northern Coniferous Forest, Ecological Bulletin, 32, pp. 505-523
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_trans (kjpindex, swnet, temp_air, pb, qair, rau, u, v, q_cdrag, humrel, &
+                            veget, veget_max, lai, qsintveg, qsintmax, vbeta3, vbeta3pot, rveget, rstruct, &
+                            cimean, vbetaco2, vbeta23)  
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                         :: kjpindex   !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swnet      !! Short wave net flux at surface (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_air   !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: pb         !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: qair       !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: rau        !! Air Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: u          !! Eastward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: v          !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: q_cdrag    !! Product of Surface drag coefficient and wind speed 
+                                                                     !! (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: humrel     !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget      !! Type of vegetation (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max  !! Max. vegetation fraction (LAI->infty) (fraction)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: lai        !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintveg   !! Water on vegetation due to interception (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintmax   !! Maximum water on vegetation (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: rstruct    !! Structural resistance (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vbeta23    !! Beta for wetted foliage fraction that will transpire (-)
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta3     !! Beta for Transpiration (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta3pot  !! Beta for Potential Transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: rveget     !! Stomatal resistance of the whole canopy (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: cimean     !! STOMATE: mean intercellular ci (see enerbil) 
+                                                                     !! (\mumol m^{-2} s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbetaco2   !! STOMATE: Beta for CO2 (-)
+
+    !! 0.3 Modified variables
+  
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ji, jv
+    REAL(r_std)                                        :: speed
+    REAL(r_std), DIMENSION(kjpindex)                   :: zdefconc, zqsvegrap
+    REAL(r_std), DIMENSION(kjpindex)                   :: qsatt
+    REAL(r_std),DIMENSION (kjpindex,nvm)               :: rveget_min           !! Minimal Surface resistance of vegetation
+!_ ================================================================================================================================
+
+
+  !! 1.  Moisture concentration at the leaf level.
+    
+    CALL qsatcalc (kjpindex, temp_air, pb, qsatt)
+    
+    !! \latexonly 
+    !!     \input{diffucotrans1.tex}
+    !! \endlatexonly
+    zdefconc(:) = rau(:) * MAX( qsatt(:) - qair(:), zero )
+
+   
+  !! 2. Calulation of the beta coefficient for vegetation transpiration, beta_3.
+
+    rveget(:,:) = undef_sechiba
+    rveget_min(:,:) = undef_sechiba
+    vbeta3(:,:) = zero
+    vbeta3pot(:,:) = zero
+
+    DO jv = 2,nvm
+
+      zqsvegrap(:) = zero
+
+      DO ji = 1, kjpindex
+
+         !! \latexonly 
+         !!     \input{diffucotrans2.tex}
+         !! \endlatexonly
+         speed = MAX(min_wind, wind(ji))
+
+         IF (qsintmax(ji,jv) .GT. min_sechiba) THEN
+        
+            !! \latexonly 
+            !!     \input{diffucotrans3.tex}
+            !! \endlatexonly
+            zqsvegrap(ji) = MAX(zero, qsintveg(ji,jv) / qsintmax(ji,jv))
+         ENDIF
+         
+         IF ( ( veget(ji,jv)*lai(ji,jv) .GT. min_sechiba ) .AND. &
+              ( kzero(jv) .GT. min_sechiba ) .AND. &
+              ( swnet(ji) .GT. min_sechiba ) ) THEN
+
+            !! \latexonly 
+            !!     \input{diffucotrans4.tex}
+            !! \endlatexonly            
+            rveget(ji,jv) = (( swnet(ji) + rayt_cste ) / swnet(ji) ) &
+                 * ((defc_plus + (defc_mult * zdefconc(ji) )) / kzero(jv)) * (un / lai(ji,jv))
+
+            rveget_min(ji,jv) = (defc_plus / kzero(jv)) * (un / lai(ji,jv))
+
+            ! Corrections Nathalie - le 28 mars 2006 - sur conseils Fred Hourdin
+            ! Introduction d'un potentiometre (rveg_pft) pour regler la somme rveg+rstruct
+            ! vbeta3(ji,jv) = veget(ji,jv) * (un - zqsvegrap(ji)) * humrel(ji,jv) * &
+            !     (un / (un + speed * q_cdrag(ji) * (rveget(ji,jv) + rstruct(ji,jv))))
+            
+            !! This is the formulation for $beta_3$.
+            !! \latexonly 
+            !!     \input{diffucotrans5.tex}
+            !! \endlatexonly
+            vbeta3(ji,jv) = veget(ji,jv) * (un - zqsvegrap(ji)) * humrel(ji,jv) * &
+                 (un / (un + speed * q_cdrag(ji) * (rveg_pft(jv)*(rveget(ji,jv) + rstruct(ji,jv)))))
+            
+            ! Fin ajout Nathalie
+            ! Ajout Nathalie - Juin 2006
+
+            !! \latexonly 
+            !!     \input{diffucotrans6.tex}
+            !! \endlatexonly
+            vbeta3(ji,jv) = vbeta3(ji,jv) + MIN( vbeta23(ji,jv), &
+                 veget(ji,jv) * zqsvegrap(ji) * humrel(ji,jv) * &
+                 (un / (un + speed * q_cdrag(ji) * (rveg_pft(jv)*(rveget(ji,jv) + rstruct(ji,jv))))))
+            ! Fin ajout Nathalie
+            ! Autre possibilite permettant la transpiration sur toute la canopee
+            !Commenter si formulation Nathalie sinon Tristan
+!            vbeta3(ji,jv) = MAX(zero, MIN(vbeta23(ji,jv), &
+!                 & veget_max(ji,jv) * humrel(ji,jv) / &
+!                 & (un + speed * q_cdrag(ji) * (rveg_pft(jv)*(rveget(ji,jv) + rstruct(ji,jv))))))
+
+           ! vbeta3pot for computation of potential transpiration (needed for irrigation)
+            vbeta3pot(ji,jv) = &
+                 &  MAX(zero, veget_max(ji,jv) / &
+                 & (un + speed * q_cdrag(ji) * (rveg_pft(jv)*(rveget_min(ji,jv) + rstruct(ji,jv)))))
+         ENDIF
+
+      ENDDO
+
+    ENDDO
+
+    ! STOMATE
+    cimean(:,:) = zero
+    vbetaco2(:,:) = zero
+
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_trans done '
+
+  END SUBROUTINE diffuco_trans
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : diffuco_trans_co2
+!!
+!>\BRIEF        This subroutine computes carbon assimilation and stomatal 
+!! conductance, following respectively Farqhuar et al. (1980) and Ball et al. (1987).
+!!
+!! DESCRIPTION  :\n
+!! *** General:\n 
+!! The equations are different depending on the photosynthesis mode (C3 versus C4).\n 
+!! Assimilation and conductance are computed over 20 levels of LAI and then 
+!! integrated at the canopy level.\n 
+!! This routine also computes partial beta coefficient: transpiration for each 
+!! type of vegetation.\n
+!! There is a main loop on the PFTs, then inner loops on the points where 
+!! assimilation has to be calculated.\n
+!! This subroutine is called by diffuco_main only if photosynthesis is activated
+!! for sechiba (flag STOMATE_OK_CO2=TRUE), otherwise diffuco_trans is called.\n
+!! This subroutine is called at each sechiba time step by sechiba_main.\n
+!! *** Details:
+!! - Integration at the canopy level\n
+!! \latexonly
+!! \input{diffuco_trans_co2_1.1.tex}
+!! \endlatexonly
+!! - Light''s extinction \n
+!! The available light follows a simple Beer extinction law. 
+!! The extinction coefficients (ext_coef) are PFT-dependant constants and are defined in constant_co2.f90.\n
+!! \latexonly
+!! \input{diffuco_trans_co2_1.2.tex}
+!! \endlatexonly
+!! - Estimation of relative humidity of air (for calculation of the stomatal conductance)\n
+!! \latexonly
+!! \input{diffuco_trans_co2_1.3.tex}
+!! \endlatexonly
+!! - Calculation of the water limitation factor\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.1.tex}
+!! \endlatexonly
+!! - Calculation of temperature dependent parameters for C4 plants\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.2.tex}
+!! \endlatexonly
+!! - Calculation of temperature dependent parameters for C3 plants\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.3.tex}
+!! \endlatexonly
+!! - Vmax scaling\n 
+!! Vmax is scaled into the canopy due to reduction of nitrogen 
+!! (Johnson and Thornley,1984).\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.4.1.tex}
+!! \endlatexonly
+!! - Assimilation for C4 plants (Collatz et al., 1992)\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.4.2.tex}
+!! \endlatexonly         
+!! - Assimilation for C3 plants (Farqhuar et al., 1980)\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.4.3.tex}
+!! \endlatexonly
+!! - Estimation of the stomatal conductance (Ball et al., 1987)\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.4.4.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): N. de Noblet          2006/06
+!!                - addition of q2m and t2m as input parameters for the 
+!!                calculation of Rveget
+!!                - introduction of vbeta23
+!!
+!! MAIN OUTPUT VARIABLE(S): beta coefficients, resistances, CO2 intercellular 
+!! concentration
+!!
+!! REFERENCE(S) :
+!! - Ball, J., T. Woodrow, and J. Berry (1987), A model predicting stomatal 
+!! conductance and its contribution to the control of photosynthesis under 
+!! different environmental conditions, Prog. Photosynthesis, 4, 221â 224.
+!! - Collatz, G., M. Ribas-Carbo, and J. Berry (1992), Coupled photosynthesis 
+!! stomatal conductance model for leaves of C4 plants, Aust. J. Plant Physiol.,
+!! 19, 519â538.
+!! - Farquhar, G., S. von Caemmener, and J. Berry (1980), A biochemical model of 
+!! photosynthesis CO2 fixation in leaves of C3 species, Planta, 149, 78â90.
+!! - Johnson, I. R., and J. Thornley (1984), A model of instantaneous and daily
+!! canopy photosynthesis, J Theor. Biol., 107, 531 545
+!! - McMurtrie, R.E., Rook, D.A. and Kelliher, F.M., 1990. Modelling the yield of Pinus radiata on a
+!! site limited by water and nitrogen. For. Ecol. Manage., 30: 381-413
+!! - Bounoua, L., Hall, F. G., Sellers, P. J., Kumar, A., Collatz, G. J., Tucker, C. J., and Imhoff, M. L. (2010), Quantifying the 
+!! negative feedback of vegetation to greenhouse warming: A modeling approach, Geophysical Research Letters, 37, Artn L23701, 
+!! Doi 10.1029/2010gl045338
+!! - Bounoua, L., Collatz, G. J., Sellers, P. J., Randall, D. A., Dazlich, D. A., Los, S. O., Berry, J. A., Fung, I., 
+!! Tucker, C. J., Field, C. B., and Jensen, T. G. (1999), Interactions between vegetation and climate: Radiative and physiological 
+!! effects of doubled atmospheric co2, Journal of Climate, 12, 309-324, Doi 10.1175/1520-0442(1999)012<0309:Ibvacr>2.0.Co;2
+!! - Sellers, P. J., Bounoua, L., Collatz, G. J., Randall, D. A., Dazlich, D. A., Los, S. O., Berry, J. A., Fung, I., 
+!! Tucker, C. J., Field, C. B., and Jensen, T. G. (1996), Comparison of radiative and physiological effects of doubled atmospheric
+!! co2 on climate, Science, 271, 1402-1406, DOI 10.1126/science.271.5254.1402
+!! - Lewis, J. D., Ward, J. K., and Tissue, D. T. (2010), Phosphorus supply drives nonlinear responses of cottonwood 
+!! (populus deltoides) to increases in co2 concentration from glacial to future concentrations, New Phytologist, 187, 438-448, 
+!! DOI 10.1111/j.1469-8137.2010.03307.x
+!! - Kattge, J., Knorr, W., Raddatz, T., and Wirth, C. (2009), Quantifying photosynthetic capacity and its relationship to leaf 
+!! nitrogen content for global-scale terrestrial biosphere models, Global Change Biology, 15, 976-991, 
+!! DOI 10.1111/j.1365-2486.2008.01744.x
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE diffuco_trans_co2 (kjpindex, swdown, pb, qsurf, q2m, t2m, temp_growth, rau, u, v, q_cdrag, humrel, &
+                                assim_param, Ca, &
+                                veget, veget_max, lai, qsintveg, qsintmax, vbeta3, vbeta3pot, rveget, rstruct, &
+                                cimean, gsmean, gpp, vbeta23, cim)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: kjpindex         !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swdown           !! Downwelling short wave flux 
+                                                                                 !! @tex ($W m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb               !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qsurf             !! Near surface specific humidity 
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+! N. de Noblet - 2006/06 - addition of q2m and t2m
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q2m              !! 2m specific humidity 
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+! In off-line mode q2m and qair are the same.
+! In off-line mode t2m and temp_air are the same.
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: t2m              !! 2m air temperature (K)
+! N. de Noblet - 2006/06 - addition of q2m and t2m
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_growth      !! Growth temperature (Â°C) - Is equal to t2m_month
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau              !! air density @tex ($kg m^{-3}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u                !! Lowest level wind speed 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v                !! Lowest level wind speed 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag          !! Surface drag 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2), INTENT (in)  :: assim_param      !! min+max+opt temps (K), vcmax, vjmax for 
+                                                                                 !! photosynthesis 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: Ca               !! CO2 concentration inside the canopy
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: humrel           !! Soil moisture stress (0-1,unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: veget            !! Coverage fraction of vegetation for each PFT 
+                                                                                 !! depending on LAI (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: veget_max        !! Maximum vegetation fraction of each PFT inside 
+                                                                                 !! the grid box (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: lai              !! Leaf area index @tex ($m^2 m^{-2}$) @endtex
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: qsintveg         !! Water on vegetation due to interception 
+                                                                                 !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: qsintmax         !! Maximum water on vegetation
+                                                                                 !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: vbeta23          !! Beta for fraction of wetted foliage that will 
+                                                                                 !! transpire (unitless) 
+    !
+    !! 0.2 Output variables
+    !
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: vbeta3           !! Beta for Transpiration (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: vbeta3pot        !! Beta for Potential Transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: rveget           !! stomatal resistance of vegetation 
+                                                                                 !! @tex ($s m^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: rstruct          !! structural resistance @tex ($s m^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: cimean           !! mean intercellular CO2 concentration 
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: gsmean           !! mean stomatal conductance to CO2 (umol m-2 s-1)
+    REAL(r_Std),DIMENSION (kjpindex,nvm), INTENT (out)       :: gpp
+ !! Assimilation ((gC m^{-2} s^{-1}), total area)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: cim              !! Intercellular CO2 over nlai 
+    !
+    !! 0.3 Modified variables
+    !
+ 
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: vcmax                               !! maximum rate of carboxylation 
+                                                                                 !! @tex ($\mu mol CO2 m^{-2} s^{-1}$) @endtex
+    INTEGER(i_std)                        :: ji, jv, jl, limit_photo             !! indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: leaf_ci_lowest                      !! intercellular CO2 concentration at the lowest 
+                                                                                 !! LAI level
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+    INTEGER(i_std), DIMENSION(kjpindex)   :: ilai                                !! counter for loops on LAI levels (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: zqsvegrap                           !! relative water quantity in the water 
+                                                                                 !! interception reservoir (0-1,unitless) 
+    REAL(r_std)                           :: speed                               !! wind speed @tex ($m s^{-1}$) @endtex
+    ! Assimilation
+    LOGICAL, DIMENSION(kjpindex)          :: assimilate                          !! where assimilation is to be calculated 
+                                                                                 !! (unitless) 
+    LOGICAL, DIMENSION(kjpindex)          :: calculate                           !! where assimilation is to be calculated for 
+                                                                                 !! in the PFTs loop (unitless) 
+    INTEGER(i_std)                        :: nic,inic,icinic                     !! counter/indices (unitless)
+    INTEGER(i_std), DIMENSION(kjpindex)   :: index_calc                          !! index (unitless)
+    INTEGER(i_std)                        :: nia,inia,nina,inina,iainia          !! counter/indices (unitless)
+    INTEGER(i_std), DIMENSION(kjpindex)   :: index_assi,index_non_assi           !! indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: vc2                                 !! rate of carboxylation (at a specific LAI level) 
+                                                                                 !! @tex ($\mu mol CO2 m^{-2} s^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(kjpindex)      :: vj2                                 !! rate of Rubisco regeneration (at a specific LAI 
+                                                                                 !! level) @tex ($\mu mol e- m^{-2} s^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(kjpindex)      :: assimi                              !! assimilation (at a specific LAI level) 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+                                                                                 !! (temporary variables)
+    REAL(r_std), DIMENSION(kjpindex)      :: gstop                               !! stomatal conductance to H2O at topmost level 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: gs                                  !! stomatal conductance to CO2 
+                                                                                 !! @tex ($\mol m^{-2} s^{-1}$) @endtex
+
+
+    REAL(r_std), DIMENSION(kjpindex)      :: gamma_star                          !! CO2 compensation point (ppm)
+                                                                                 !! @tex ($\mu mol mol^{-1}$) @endtex
+
+    REAL(r_std), DIMENSION(kjpindex)      :: air_relhum                          !! air relative humidity at 2m 
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: VPD                                 !! Vapor Pressure Deficit (kPa)
+    REAL(r_std), DIMENSION(kjpindex)      :: water_lim                           !! water limitation factor (0-1,unitless)
+
+    REAL(r_std), DIMENSION(kjpindex)      :: gstot                               !! total stomatal conductance to H2O
+                                                                                 !! Final unit is
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: assimtot                            !! total assimilation 
+                                                                                 !! @tex ($\mu mol CO2 m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: Rdtot                               !! Total Day respiration (respiratory CO2 release other than by photorespiration) (mumol CO2 mâ2 sâ1) 
+    REAL(r_std), DIMENSION(kjpindex)      :: leaf_gs_top                         !! leaf stomatal conductance to H2O at topmost level 
+                                                                                 !! @tex ($\mol H2O m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nlai+1)        :: laitab                              !! tabulated LAI steps @tex ($m^2 m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: qsatt                               !! surface saturated humidity at 2m (??) 
+                                                                                 !! @tex ($g g^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nvm,nlai)      :: light                               !! fraction of light that gets through upper LAI    
+                                                                                 !! levels (0-1,unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_Vcmax                             !! Temperature dependance of Vcmax (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: S_Vcmax_acclim_temp                 !! Entropy term for Vcmax 
+                                                                                 !! accounting for acclimation to temperature (J K-1 mol-1)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_Jmax                              !! Temperature dependance of Jmax
+    REAL(r_std), DIMENSION(kjpindex)      :: S_Jmax_acclim_temp                  !! Entropy term for Jmax 
+                                                                                 !! accounting for acclimation to temperature (J K-1 mol-1)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_Rd                                !! Temperature dependance of Rd (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_Kmc                               !! Temperature dependance of KmC (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_KmO                               !! Temperature dependance of KmO (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: T_gamma_star                        !! Temperature dependance of gamma_star (unitless)    
+    REAL(r_std), DIMENSION(kjpindex)      :: vc                                  !! Maximum rate of Rubisco activity-limited carboxylation (mumol CO2 mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)      :: vj                                  !! Maximum rate of e- transport under saturated light (mumol CO2 mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)      :: Rd                                  !! Day respiration (respiratory CO2 release other than by photorespiration) (mumol CO2 mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)      :: Kmc                                 !! MichaelisâMenten constant of Rubisco for CO2 (mubar)
+    REAL(r_std), DIMENSION(kjpindex)      :: KmO                                 !! MichaelisâMenten constant of Rubisco for O2 (mubar)
+    REAL(r_std), DIMENSION(kjpindex)      :: gb                                  !! Boundary-layer conductance (mol mâ2 sâ1 barâ1)
+    REAL(r_std), DIMENSION(kjpindex)      :: fvpd                                !! Factor for describing the effect of leaf-to-air vapour difference on gs (-)
+    REAL(r_std), DIMENSION(kjpindex)      :: low_gamma_star                      !! Half of the reciprocal of Sc/o (bar bar-1)
+    REAL(r_std)                           :: N_Vcmax                             !! Nitrogen level dependance of Vcmacx and Jmax 
+    REAL(r_std)                           :: fcyc                                !! Fraction of electrons at PSI that follow cyclic transport around PSI (-)
+    REAL(r_std)                           :: z                                   !! A lumped parameter (see Yin et al. 2009) ( mol mol-1)                          
+    REAL(r_std)                           :: Rm                                  !! Day respiration in the mesophyll (umol CO2 mâ2 sâ1)
+    REAL(r_std)                           :: Cs_star                             !! Cs -based CO2 compensation point in the absence of Rd (ubar)
+    REAL(r_std), DIMENSION(kjpindex)      :: Iabs                                !! Photon flux density absorbed by leaf photosynthetic pigments (umol photon mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)      :: Jmax                                !! Maximum value of J under saturated light (umol eâ mâ2 sâ1)
+    REAL(r_std), DIMENSION(kjpindex)      :: JJ                                  !! Rate of eâ transport (umol eâ mâ2 sâ1)
+    REAL(r_std)                           :: J2                                  !! Rate of all eâ transport through PSII (umol eâ mâ2 sâ1)
+    REAL(r_std)                           :: VpJ2                                !! eâ transport-limited PEP carboxylation rate (umol CO2 mâ2 sâ1)
+    REAL(r_std)                           :: A_1, A_3                            !! Lowest First and third roots of the analytical solution for a general cubic equation (see Appendix A of Yin et al. 2009) (umol CO2 mâ2 sâ1)
+    REAL(r_std)                           :: A_1_tmp, A_3_tmp                            !! Temporary First and third roots of the analytical solution for a general cubic equation (see Appendix A of Yin et al. 2009) (umol CO2 mâ2 sâ1)
+    REAL(r_std)                           :: Obs                                 !! Bundle-sheath oxygen partial pressure (ubar)
+    REAL(r_std)                           :: Cc                                  !! Chloroplast CO2 partial pressure (ubar)
+    REAL(r_std)                           :: ci_star                             !! Ci -based CO2 compensation point in the absence of Rd (ubar)        
+    REAL(r_std)                           :: a,b,c,d,m,f,j,g,h,i,l,p,q,r         !! Variables used for solving the cubic equation (see Yin et al. (2009))
+    REAL(r_std)                           :: QQ,UU,PSI,x1,x2,x3                      !! Variables used for solving the cubic equation (see Yin et al. (2009))
+                                        
+    REAL(r_std)                           :: cresist                             !! coefficient for resistances (??)
+    REAL(r_std), DIMENSION(kjpindex)      :: laisum                              !! when calculating cim over nlai
+
+! @defgroup Photosynthesis Photosynthesis
+! @{   
+    ! 1. Preliminary calculations\n
+    REAL(r_std),DIMENSION (kjpindex,nvm)           :: rveget_min                 !! Minimal Surface resistance of vegetation
+!_ ================================================================================================================================
+
+    !
+    ! 1.1 Calculate LAI steps\n
+    ! The integration at the canopy level is done over nlai fixed levels.
+    !! \latexonly
+    !! \input{diffuco_trans_co2_1.1.tex}
+    !! \endlatexonly
+! @}
+! @codeinc
+    DO jl = 1, nlai+1
+      laitab(jl) = laimax*(EXP(lai_level_depth*REAL(jl-1,r_std))-1.)/(EXP(lai_level_depth*REAL(nlai,r_std))-un)
+    ENDDO
+! @endcodeinc
+
+! @addtogroup Photosynthesis
+! @{   
+    !
+    ! 1.2 Calculate light fraction for each LAI step\n
+    ! The available light follows a simple Beer extinction law. 
+    ! The extinction coefficients (ext_coef) are PFT-dependant constants and are defined in constant_co2.f90.
+    !! \latexonly
+    !! \input{diffuco_trans_co2_1.2.tex}
+    !! \endlatexonly
+! @}
+! @codeinc
+    DO jl = 1, nlai
+      DO jv = 1, nvm
+        light(jv,jl) = exp( -ext_coeff(jv)*laitab(jl) )
+      ENDDO
+    ENDDO 
+! @endcodeinc
+    !
+    ! Photosynthesis parameters
+    !
+
+    IF (downregulation_co2) THEN
+       DO jv= 1, nvm
+          vcmax(:,jv) = assim_param(:,jv,ivcmax)*(un-downregulation_co2_coeff(jv)*log(Ca(:)/downregulation_co2_baselevel))
+       ENDDO
+    ELSE
+       vcmax(:,:) = assim_param(:,:,ivcmax)
+    ENDIF
+
+!    DO jv = 1, nvm
+!       vcmax(:,:) = Vcmax25(jv)
+!    ENDDO
+
+! @addtogroup Photosynthesis
+! @{   
+    !
+    ! 1.3 Estimate relative humidity of air (for calculation of the stomatal conductance).\n
+    !! \latexonly
+    !! \input{diffuco_trans_co2_1.3.tex}
+    !! \endlatexonly
+! @}
+    !
+! N. de Noblet - 2006/06 - We use q2m/t2m instead of qair.
+!    CALL qsatcalc (kjpindex, temp_air, pb, qsatt)
+!    air_relhum(:) = &
+!      ( qair(:) * pb(:) / (0.622+qair(:)*0.378) ) / &
+!      ( qsatt(:)*pb(:) / (0.622+qsatt(:)*0.378 ) )
+! @codeinc
+    CALL qsatcalc (kjpindex, t2m, pb, qsatt)
+    air_relhum(:) = &
+      ( qsurf(:) * pb(:) / (Tetens_1+qsurf(:)* Tetens_2) ) / &
+      ( qsatt(:)*pb(:) / (Tetens_1+qsatt(:)*Tetens_2 ) )
+
+
+    VPD(:) = ( qsatt(:)*pb(:) / (Tetens_1+qsatt(:)*Tetens_2 ) ) &
+         - ( qsurf(:) * pb(:) / (Tetens_1+qsurf(:)* Tetens_2) )
+    ! VPD is needed in kPa
+    ! We limit the impact of VPD in the range of [0:6] kPa
+    VPD(:) = MAX(0.,MIN(VPD(:)/10.,6.))
+
+! @endcodeinc
+! N. de Noblet - 2006/06 
+    !
+    !
+    ! 2. beta coefficient for vegetation transpiration
+    !
+    rstruct(:,1) = rstruct_const(1)
+    rveget(:,:) = undef_sechiba
+    rveget_min(:,:) = undef_sechiba
+    !
+    vbeta3(:,:) = zero
+    vbeta3pot(:,:) = zero
+    gsmean(:,:) = zero
+    gpp(:,:) = zero
+    !
+    cimean(:,1) = Ca(:)
+    !
+    ! @addtogroup Photosynthesis
+    ! @{   
+    ! 2. Loop over vegetation types\n
+    ! @} 
+    !
+    DO jv = 2,nvm
+      !
+      ! @addtogroup Photosynthesis
+      ! @{   
+      !
+      ! 2.1 Initializations\n
+      !! \latexonly
+      !! \input{diffuco_trans_co2_2.1.tex}
+      !! \endlatexonly
+      ! @}      
+      !
+      ! beta coefficient for vegetation transpiration
+      !
+      rstruct(:,jv) = rstruct_const(jv)
+      cimean(:,jv) = Ca(:)
+      !
+      !! mask that contains points where there is photosynthesis
+      !! For the sake of vectorisation [DISPENSABLE], computations are done only for convenient points.
+      !! nia is the number of points where the assimilation is calculated and nina the number of points where photosynthesis is not
+      !! calculated (based on criteria on minimum or maximum values on LAI, vegetation fraction, shortwave incoming radiation, 
+      !! temperature and relative humidity).
+      !! For the points where assimilation is not calculated, variables are initialized to specific values. 
+      !! The assimilate(kjpindex) array contains the logical value (TRUE/FALSE) relative to this photosynthesis calculation.
+      !! The index_assi(kjpindex) array indexes the nia points with assimilation, whereas the index_no_assi(kjpindex) array indexes
+      !! the nina points with no assimilation.
+      nia=0
+      nina=0
+      !
+      DO ji=1,kjpindex
+         !
+         IF ( ( lai(ji,jv) .GT. 0.01 ) .AND. &
+              ( veget_max(ji,jv) .GT. min_sechiba ) ) THEN
+            
+            IF ( ( veget(ji,jv) .GT. min_sechiba ) .AND. &
+                 ( swdown(ji) .GT. min_sechiba )   .AND. &
+                 ( temp_growth(ji) .GT. tphoto_min(jv) ) .AND. &
+                 ( temp_growth(ji) .LT. tphoto_max(jv) ) ) THEN
+               !
+               assimilate(ji) = .TRUE.
+               nia=nia+1
+               index_assi(nia)=ji
+               !
+            ELSE
+               !
+               assimilate(ji) = .FALSE.
+               nina=nina+1
+               index_non_assi(nina)=ji
+               !
+            ENDIF
+         ELSE
+            !
+            assimilate(ji) = .FALSE.
+            nina=nina+1
+            index_non_assi(nina)=ji
+            !
+         ENDIF
+         !
+
+      ENDDO
+      !
+
+      gstot(:) = zero
+      assimtot(:) = zero
+      Rdtot(:)=zero
+      leaf_gs_top(:) = zero
+      !
+      zqsvegrap(:) = zero
+      WHERE (qsintmax(:,jv) .GT. min_sechiba)
+      !! relative water quantity in the water interception reservoir
+          zqsvegrap(:) = MAX(zero, qsintveg(:,jv) / qsintmax(:,jv))
+      ENDWHERE
+      !
+      !! Calculates the water limitation factor.
+      water_lim(:) = MAX( min_sechiba, MIN( humrel(:,jv)/0.5, un ))
+
+      ! give a default value of ci for all pixel that do not assimilate
+      DO jl=1,nlai
+         DO inina=1,nina
+            leaf_ci(index_non_assi(inina),jv,jl) = Ca(index_non_assi(inina)) 
+         ENDDO
+      ENDDO
+      !
+      ilai(:) = 1
+      !
+      ! Here is the calculation of assimilation and stomatal conductance
+      ! based on the work of Farquahr, von Caemmerer and Berry (FvCB model) 
+      ! as described in Yin et al. 2009
+      ! Yin et al. developed a extended version of the FvCB model for C4 plants
+      ! and proposed an analytical solution for both photosynthesis pathways (C3 and C4)
+      ! Photosynthetic parameters used are those reported in Yin et al. 
+      ! Except For Vcmax25, relationships between Vcmax25 and Jmax25 for which we use 
+      ! Medlyn et al. (2002) and Kattge & Knorr (2007)
+      ! Because these 2 references do not consider mesophyll conductance, we neglect this term
+      ! in the formulations developed by Yin et al. 
+      ! Consequently, gm (the mesophyll conductance) tends to the infinite
+      ! This is of importance because as stated by Kattge & Knorr and Medlyn et al.,
+      ! values of Vcmax and Jmax derived with different model parametrizations are not 
+      ! directly comparable and the published values of Vcmax and Jmax had to be standardized
+      ! to one consistent formulation and parametrization
+
+      ! See eq. 6 of Yin et al. (2009)
+      ! Parametrization of Medlyn et al. (2002) - from Bernacchi et al. (2001)
+      T_KmC(:)        = Arrhenius(kjpindex,t2m,298.,E_KmC(jv))
+      T_KmO(:)        = Arrhenius(kjpindex,t2m,298.,E_KmO(jv))
+      T_gamma_star(:) = Arrhenius(kjpindex,t2m,298.,E_gamma_star(jv))
+
+
+      ! Parametrization of Yin et al. (2009) - from Bernacchi et al. (2001)
+      T_Rd(:)         = Arrhenius(kjpindex,t2m,298.,E_Rd(jv))
+
+
+      ! For C3 plants, we assume that the Entropy term for Vcmax and Jmax 
+      ! acclimates to temperature as shown by Kattge & Knorr (2007) - Eq. 9 and 10
+      ! and that Jmax and Vcmax respond to temperature following a modified Arrhenius function
+      ! (with a decrease of these parameters for high temperature) as in Medlyn et al. (2002) 
+      ! and Kattge & Knorr (2007).
+      ! In Yin et al. (2009), temperature dependance to Vcmax is based only on a Arrhenius function
+      ! Concerning this apparent unconsistency, have a look to the section 'Limitation of 
+      ! Photosynthesis by gm' of Bernacchi (2002) that may provide an explanation
+      
+      ! Growth temperature tested by Kattge & Knorr range from 11 to 35Â°C
+      ! So, we limit the relationship between these lower and upper limits
+      S_Jmax_acclim_temp(:) = aSJ(jv) + bSJ(jv) * MAX(11., MIN(temp_growth(:),35.))      
+      T_Jmax(:)  = Arrhenius_modified(kjpindex,t2m,298.,E_Jmax(jv),D_Jmax(jv),S_Jmax_acclim_temp)
+
+      S_Vcmax_acclim_temp(:) = aSV(jv) + bSV(jv) * MAX(11., MIN(temp_growth(:),35.))   
+      T_Vcmax(:) = Arrhenius_modified(kjpindex,t2m,298.,E_Vcmax(jv),D_Vcmax(jv),S_Vcmax_acclim_temp)
+       
+
+      
+      vc(:) = vcmax(:,jv) * T_Vcmax(:)
+      ! As shown by Kattge & Knorr (2007), we make use
+      ! of Jmax25/Vcmax25 ratio (rJV) that acclimates to temperature for C3 plants
+      ! rJV is written as a function of the growth temperature
+      ! rJV = arJV + brJV * T_month 
+      ! See eq. 10 of Kattge & Knorr (2007)
+      ! and Table 3 for Values of arJV anf brJV 
+      ! Growth temperature is monthly temperature (expressed in Â°C) - See first paragraph of
+      ! section Methods/Data of Kattge & Knorr
+      vj(:) = ( arJV(jv) + brJV(jv) *  MAX(11., MIN(temp_growth(:),35.)) ) * vcmax(:,jv) * T_Jmax(:)
+
+      
+
+
+      ! @endcodeinc
+      !
+      KmC(:)=KmC25(jv)*T_KmC(:)
+      KmO(:)=KmO25(jv)*T_KmO(:)
+      gamma_star(:) = gamma_star25(jv)*T_gamma_star(:)
+
+
+
+      ! low_gamma_star is defined by Yin et al. (2009)
+      ! as the half of the reciprocal of Sco - See Table 2
+      ! We derive its value from Equation 7 of Yin et al. (2009)
+      ! assuming a constant O2 concentration (Oi)
+      low_gamma_star(:) = gamma_star(:)/Oi
+
+      ! VPD expressed in kPa
+      fvpd(:) = 1. / ( 1. / (a1(jv) - b1(jv) * VPD(:)) - 1. ) 
+      ! * water_lim(:)
+
+      !???
+      !leaf boundary layer conductance
+      gb(:) = (1.0_r_std /25.0_r_std)/(22.4_r_std *t2m(:)/273._r_std/1000._r_std) 
+      !???
+
+      !
+      ! @addtogroup Photosynthesis
+      ! @{   
+      !
+      ! 2.4 Loop over LAI discretized levels to estimate assimilation and conductance\n
+      ! @}           
+      !
+      !! The calculate(kjpindex) array is of type logical to indicate wether we have to sum over this LAI fixed level (the LAI of
+      !! the point for the PFT is lower or equal to the LAI level value). The number of such points is incremented in nic and the 
+      !! corresponding point is indexed in the index_calc array.
+      DO jl = 1, nlai
+         !
+         nic=0
+         calculate(:) = .FALSE.
+         !
+         IF (nia .GT. 0) then
+            DO inia=1,nia
+               calculate(index_assi(inia)) = (laitab(jl) .LE. lai(index_assi(inia),jv) )
+               IF ( calculate(index_assi(inia)) ) THEN
+                  nic=nic+1
+                  index_calc(nic)=index_assi(inia)
+               ENDIF
+            ENDDO
+         ENDIF
+         !
+         ! @addtogroup Photosynthesis
+         ! @{   
+         !
+         ! 2.4.1 Vmax is scaled into the canopy due to reduction of nitrogen 
+         !! (Johnson and Thornley,1984).\n
+         !! \latexonly
+         !! \input{diffuco_trans_co2_2.4.1.tex}
+         !! \endlatexonly
+         ! @}           
+         !
+         N_Vcmax = ( un - .7_r_std * ( un - light(jv,jl) ) )
+         !
+
+         vc2(:) = vc(:) * N_Vcmax * water_lim(:)
+         vj2(:) = vj(:) * N_Vcmax * water_lim(:)
+
+         ! see Comment in legend of Fig. 6 of Yin et al. (2009)
+         ! Rd25 is assumed to equal 0.01 Vcmax25 
+         Rd(:) = vcmax(:,jv) * N_Vcmax * 0.01 * T_Rd(:) * water_lim(:)
+
+         Iabs(:)=swdown(:)*W_to_mmol*RG_to_PAR*ext_coeff(jv)*light(jv,jl)
+         
+         ! eq. 4 of Yin et al (2009)
+         Jmax(:)=vj2(:)
+         JJ(:) = ( alpha_LL(jv) * Iabs(:) + Jmax(:) - sqrt((alpha_LL(jv) * Iabs(:) + Jmax(:) )**2. &
+              - 4 * theta(jv) * Jmax(:) * alpha_LL(jv) * Iabs(:)) ) &
+              / ( 2 * theta(jv))
+
+         !
+         IF ( is_c4(jv) )  THEN
+            !
+            ! @addtogroup Photosynthesis
+            ! @{   
+            !
+            ! 2.4.2 Assimilation for C4 plants (Collatz et al., 1992)\n
+            !! \latexonly
+            !! \input{diffuco_trans_co2_2.4.2.tex}
+            !! \endlatexonly
+            ! @}           
+            !
+            !
+            !
+            IF (nic .GT. 0) THEN
+               DO inic=1,nic
+
+                  ! Analytical resolution of the Assimilation based Yin et al. (2009)
+                  icinic=index_calc(inic)
+
+                  ! Eq. 28 of Yin et al. (2009)
+                  fcyc= 1. - ( 4.*(1.-fpsir(jv))*(1.+fQ(jv)) + 3.*h_protons(jv)*fpseudo(jv) ) / &
+                       ( 3.*h_protons(jv) - 4.*(1.-fpsir(jv)))
+                                    
+                  ! See paragraph after eq. (20b) of Yin et al.
+                  Rm=Rd(icinic)/2.
+                                
+                  ! We assume that cs_star equals ci_star (see Comment in legend of Fig. 6 of Yin et al. (2009)
+                  ! Equation 26 of Yin et al. (2009)
+                  Cs_star = (gbs(jv) * low_gamma_star(icinic) * Oi - &
+                       ( 1. + low_gamma_star(icinic) * alpha(jv) / 0.047) * Rd(icinic) + Rm ) &
+                       / ( gbs(jv) + kp(jv) ) 
+
+                  ! eq. 11 of Yin et al (2009)
+                  J2 = JJ(icinic) / ( 1. - fpseudo(jv) / ( 1. - fcyc ) )
+
+                  ! Equation right after eq. (20d) of Yin et al. (2009)
+                  z = ( 2. + fQ(jv) - fcyc ) / ( h_protons(jv) * (1. - fcyc ))
+
+                  VpJ2 = fpsir(jv) * J2 * z / 2.
+
+                  A_3=9999.
+
+                  ! See eq. right after eq. 18 of Yin et al. (2009)
+                  DO limit_photo=1,2
+                     ! Is Vc limiting the Assimilation
+                     IF ( limit_photo .EQ. 1 ) THEN
+                        a = 1. + kp(jv) / gbs(jv)
+                        b = 0.
+                        x1 = Vc2(icinic)
+                        x2 = KmC(icinic)/KmO(icinic)
+                        x3 = KmC(icinic)
+                        ! Is J limiting the Assimilation
+                     ELSE
+                        a = 1.
+                        b = VpJ2
+                        x1 = (1.- fpsir(jv)) * J2 * z / 3.
+                        x2 = 7. * low_gamma_star(icinic) / 3.
+                        x3 = 0.
+                     ENDIF
+
+                     m=fvpd(icinic)-g0(jv)/gb(icinic)
+                     d=g0(jv)*(Ca(icinic)-Cs_star) + fvpd(icinic)*Rd(icinic)
+                     f=(b-Rm-low_gamma_star(icinic)*Oi*gbs(jv))*x1*d + a*gbs(jv)*x1*Ca(icinic)*d
+                     j=(b-Rm+gbs(jv)*x3 + x2*gbs(jv)*Oi)*m + (alpha(jv)*x2/0.047-1.)*d &
+                          + a*gbs(jv)*(Ca(icinic)*m - d/gb(icinic) - (Ca(icinic) - Cs_star ))
+ 
+                     g=(b-Rm-low_gamma_star(icinic)*Oi*gbs(jv))*x1*m - (alpha(jv)*low_gamma_star(icinic)/0.047+1.)*x1*d &
+                          + a*gbs(jv)*x1*(Ca(icinic)*m - d/gb(icinic) - (Ca(icinic)-Cs_star ))
+ 
+                     h=-((alpha(jv)*low_gamma_star(icinic)/0.047+1.)*x1*m + (a*gbs(jv)*x1*(m-1.))/gb(icinic) )
+                     i= ( b-Rm + gbs(jv)*x3 + x2*gbs(jv)*Oi )*d + a*gbs(jv)*Ca(icinic)*d
+                     l= ( alpha(jv)*x2/0.047 - 1.)*m - (a*gbs(jv)*(m-1.))/gb(icinic)
+ 
+                     p = (j-(h-l*Rd(icinic))) / l
+                     q = (i+j*Rd(icinic)-g) / l
+                     r = -(f-i*Rd(icinic)) / l 
+ 
+                     ! See Yin et al. (2009) and  Baldocchi (1994)
+                     QQ = ( (p**2._r_std) - 3._r_std * q) / 9._r_std
+                     UU = ( 2._r_std* (p**3._r_std) - 9._r_std *p*q + 27._r_std *r) /54._r_std
+
+                     IF ( (QQ .GE. 0._r_std) .AND. (ABS(UU/(QQ**1.5_r_std) ) .LE. 1._r_std) ) THEN
+                        PSI = ACOS(UU/(QQ**1.5_r_std))
+                        A_3_tmp = -2._r_std * SQRT(QQ) * COS(( PSI + 4._r_std * PI)/3._r_std ) - p / 3._r_std
+                        IF (( A_3_tmp .LT. A_3 )) THEN
+                           A_3 = A_3_tmp
+                        ELSE
+                        ! In case, J is not limiting the assimilation
+                        ! we have to re-initialise a, b, x1, x2 and x3 values
+                        ! in agreement with a Vc-limited assimilation 
+                           a = 1. + kp(jv) / gbs(jv)
+                           b = 0.
+                           x1 = Vc2(icinic)
+                           x2 = KmC(icinic)/KmO(icinic)
+                           x3 = KmC(icinic)
+                        ENDIF
+                     ENDIF
+
+                     IF ( ( A_3 .EQ. 9999. ) .OR. ( A_3 .LT. (-Rd(icinic)) ) ) THEN
+                        IF ( printlev>=4 ) THEN
+                           WRITE(numout,*) 'We have a problem in diffuco_trans_co2 for A_3'
+                           WRITE(numout,*) 'no real positive solution found for pft:',jv
+                           WRITE(numout,*) 't2m:',t2m(icinic)
+                           WRITE(numout,*) 'vpd:',vpd(icinic)
+                        END IF
+                        A_3 = -Rd(icinic)
+                     ENDIF
+                     assimi(icinic) = A_3
+
+                     ! Eq. 24 of Yin et al. (2009) 
+                     Obs = ( alpha(jv) * assimi(icinic) ) / ( 0.047 * gbs(jv) ) + Oi
+                     ! Eq. 23 of Yin et al. (2009)
+                     Cc = ( ( assimi(icinic) + Rd(icinic) ) * ( x2 * Obs + x3 ) + low_gamma_star(icinic) &
+                          * Obs * x1 ) &
+                          / ( x1 - ( assimi(icinic) + Rd(icinic) ))
+                     ! Eq. 22 of Yin et al. (2009)
+                     leaf_ci(icinic,jv,jl) = ( Cc - ( b - assimi(icinic) - Rm ) / gbs(jv) ) / a
+                     
+                     ! Eq. 25 of Yin et al. (2009)
+                     ! It should be Cs instead of Ca but it seems that 
+                     ! other equations in Appendix C make use of Ca
+                     IF ( ABS( assimi(icinic) + Rd(icinic) ) .LT. min_sechiba ) THEN
+                        gs(icinic) = g0(jv)
+                     ELSE
+                        gs(icinic) = g0(jv) + ( assimi(icinic) + Rd(icinic) ) / ( Ca(icinic) - Cs_star ) * fvpd(icinic)             
+                     ENDIF
+                  ENDDO                  
+               ENDDO
+            ENDIF
+         ELSE
+            !
+            ! @addtogroup Photosynthesis
+            ! @{   
+            !
+            ! 2.4.3 Assimilation for C3 plants (Farqhuar et al., 1980)\n
+            !! \latexonly
+            !! \input{diffuco_trans_co2_2.4.3.tex}
+            !! \endlatexonly
+            ! @}           
+            !
+            !
+            IF (nic .GT. 0) THEN
+               DO inic=1,nic
+                  icinic=index_calc(inic)
+			
+                  A_1=9999.
+
+                  ! See eq. right after eq. 18 of Yin et al. (2009)
+                  DO limit_photo=1,2
+                     ! Is Vc limiting the Assimilation
+                     IF ( limit_photo .EQ. 1 ) THEN
+                        x1 = vc2(icinic)
+                        ! It should be O not Oi (comment from Vuichard)
+                        x2 = KmC(icinic) * ( 1. + Oi / KmO(icinic) )
+                        ! Is J limiting the Assimilation
+                     ELSE
+                        x1 = JJ(icinic)/4.
+                        x2 = 2. * gamma_star(icinic)
+                     ENDIF
+
+
+                     ! See Appendix B of Yin et al. (2009)
+                     a = g0(jv) * ( x2 + gamma_star(icinic) ) + ( fvpd(icinic) ) * ( x1 - Rd(icinic) )
+                     b = Ca(icinic) * ( x1 - Rd(icinic) ) - gamma_star(icinic) * x1 - Rd(icinic) * x2
+                     c = Ca(icinic) + x2 + ( 1./gb(icinic) ) * ( x1 - Rd(icinic) ) 
+                     d = x2 + gamma_star(icinic)
+                     m = fvpd(icinic) / gb(icinic)  
+   
+                     p = - ( d + a / gb(icinic) + fvpd(icinic) * c ) / m
+   
+                     q = ( d * ( x1 - Rd(icinic) ) + a*c + ( fvpd(icinic) ) * b ) / m
+                     r = - a * b / m
+   
+                     ! See Yin et al. (2009) 
+                     QQ = ( (p**2._r_std) - 3._r_std * q) / 9._r_std
+                     UU = ( 2._r_std* (p**3._r_std) - 9._r_std *p*q + 27._r_std *r) /54._r_std
+               
+                     IF ( (QQ .GE. 0._r_std) .AND. (ABS(UU/(QQ**1.5_r_std) ) .LE. 1._r_std) ) THEN
+                        PSI = ACOS(UU/(QQ**1.5_r_std))
+                        A_1_tmp = -2._r_std * SQRT(QQ) * COS( PSI / 3._r_std ) - p / 3._r_std
+                        IF (( A_1_tmp .LT. A_1 )) THEN
+                           A_1 = A_1_tmp
+                        ELSE
+                        ! In case, J is not limiting the assimilation
+                        ! we have to re-initialise x1 and x2 values
+                        ! in agreement with a Vc-limited assimilation 
+                           x1 = vc2(icinic)
+                           ! It should be O not Oi (comment from Vuichard)
+                           x2 = KmC(icinic) * ( 1. + Oi / KmO(icinic) )                           
+                        ENDIF
+                     ENDIF
+                  ENDDO
+                  IF ( (A_1 .EQ. 9999.) .OR. ( A_1 .LT. (-Rd(icinic)) ) ) THEN
+                     IF ( printlev>=4 ) THEN
+                        WRITE(numout,*) 'We have a problem in diffuco_trans_co2 for A_1'
+                        WRITE(numout,*) 'no real positive solution found for pft:',jv
+                        WRITE(numout,*) 't2m:',t2m(icinic)
+                        WRITE(numout,*) 'vpd:',vpd(icinic)
+                     END IF
+                     A_1 = -Rd(icinic)
+                  ENDIF
+                  assimi(icinic) = A_1
+                  ! Eq. 18 of Yin et al. (2009)
+                  Cc = ( gamma_star(icinic) * x1 + ( assimi(icinic) + Rd(icinic) ) * x2 )  &
+                       / ( x1 - ( assimi(icinic) + Rd(icinic) ) )
+                  ! Eq. 17 of Yin et al. (2009)
+                  leaf_ci(icinic,jv,jl) = Cc 
+                  ! See eq. right after eq. 15 of Yin et al. (2009)
+                  ci_star = gamma_star(icinic) 
+                  ! 
+                  ! Eq. 15 of Yin et al. (2009)
+                  IF ( ABS( assimi(icinic) + Rd(icinic) ) .LT. min_sechiba ) THEN
+                     gs(icinic) = g0(jv)
+                  ELSE
+                     gs(icinic) = g0(jv) + ( assimi(icinic) + Rd(icinic) ) / ( leaf_ci(icinic,jv,jl) &
+                          - ci_star ) * fvpd(icinic)
+                  ENDIF
+               ENDDO
+            ENDIF
+         ENDIF
+         !
+         IF (nic .GT. 0) THEN
+            !
+            DO inic=1,nic
+               !
+               ! @addtogroup Photosynthesis
+               ! @{   
+               !
+               !! 2.4.4 Estimatation of the stomatal conductance (Ball et al., 1987).\n
+               !! \latexonly
+               !! \input{diffuco_trans_co2_2.4.4.tex}
+               !! \endlatexonly
+               ! @}           
+               !
+               icinic=index_calc(inic)
+               !
+               ! keep stomatal conductance of topmost level
+               !
+               IF ( jl .EQ. 1 ) THEN
+                  leaf_gs_top(icinic) = gs(icinic)
+                  !
+               ENDIF
+               !
+               ! @addtogroup Photosynthesis
+               ! @{   
+               !
+               !! 2.4.5 Integration at the canopy level\n
+               !! \latexonly
+               !! \input{diffuco_trans_co2_2.4.5.tex}
+               !! \endlatexonly
+               ! @}           
+               ! total assimilation and conductance
+               assimtot(icinic) = assimtot(icinic) + &
+                    assimi(icinic) * (laitab(jl+1)-laitab(jl))
+               Rdtot(icinic) = Rdtot(icinic) + &
+                    Rd(icinic) * (laitab(jl+1)-laitab(jl))
+               gstot(icinic) = gstot(icinic) + &
+                    gs(icinic) * (laitab(jl+1)-laitab(jl))
+               !
+               ilai(icinic) = jl
+               !
+            ENDDO
+            !
+         ENDIF
+      ENDDO  ! loop over LAI steps
+
+
+      !! Calculated intercellular CO2 over nlai needed for the chemistry module
+      cim(:,:)=0.
+      laisum(:)=0
+      DO jl=1,nlai
+         WHERE (laitab(jl) .LE. lai(:,jv) )
+            cim(:,jv)= cim(:,jv)+leaf_ci(:,jv,jl)*(laitab(jl+1)-laitab(jl))
+            laisum(:)=laisum(:)+ (laitab(jl+1)-laitab(jl))
+         ENDWHERE
+      ENDDO
+      WHERE (laisum(:)>0)
+         cim(:,jv)= cim(:,jv)/laisum(:)
+      ENDWHERE
+
+
+      !
+      !! 2.5 Calculate resistances
+      !
+      IF (nia .GT. 0) THEN
+         !
+         DO inia=1,nia
+            !
+            iainia=index_assi(inia)
+
+            !! Mean stomatal conductance for CO2 (mol m-2 s-1)
+            gsmean(iainia,jv) = gstot(iainia)
+            !
+            ! cimean is the "mean ci" calculated in such a way that assimilation 
+            ! calculated in enerbil is equivalent to assimtot
+            !
+            cimean(iainia,jv) = (gsmean(iainia,jv)-g0(jv)) &
+                 / (fvpd(iainia)*(assimtot(iainia)+Rdtot(iainia))) &
+                 + gamma_star(iainia) 
+                 
+            ! conversion from umol m-2 (PFT) s-1 to gC m-2 (mesh area) tstep-1
+            gpp(iainia,jv) = assimtot(iainia)*12e-6*veget_max(iainia,jv)*dt_sechiba
+            
+            ! conversion from (mol m-2 s-1) to (umol m-2 s-1)
+            gsmean(iainia,jv) = gsmean(iainia,jv)*1e-6
+            !
+            ! conversion from mol/m^2/s to m/s
+            !
+            ! As in Pearcy, Schulze and Zimmermann
+            ! Measurement of transpiration and leaf conductance
+            ! Chapter 8 of Plant Physiological Ecology
+            ! Field methods and instrumentation, 1991
+            ! Editors:
+            !
+            !    Robert W. Pearcy,
+            !    James R. Ehleringer,
+            !    Harold A. Mooney,
+            !    Philip W. Rundel
+            !
+            ! ISBN: 978-0-412-40730-7 (Print) 978-94-010-9013-1 (Online)
+
+            gstot(iainia) =  mmol_to_m_1 *(t2m(iainia)/tp_00)*&
+                 (pb_std/pb(iainia))*gstot(iainia)*ratio_H2O_to_CO2
+            gstop(iainia) =  mmol_to_m_1 * (t2m(iainia)/tp_00)*&
+                 (pb_std/pb(iainia))*leaf_gs_top(iainia)*ratio_H2O_to_CO2*&
+                 laitab(ilai(iainia)+1)
+            !
+            rveget(iainia,jv) = un/gstop(iainia)
+            rveget_min(iainia,jv) = (defc_plus / kzero(jv)) * (un / lai(iainia,jv))
+
+            !
+            !
+            ! rstruct is the difference between rtot (=1./gstot) and rveget
+            !
+            ! Correction Nathalie - le 27 Mars 2006 - Interdire a rstruct d'etre negatif
+            !rstruct(iainia,jv) = un/gstot(iainia) - &
+            !     rveget(iainia,jv)
+            rstruct(iainia,jv) = MAX( un/gstot(iainia) - &
+                 rveget(iainia,jv), min_sechiba)
+            !
+            !
+            !! wind is a global variable of the diffuco module.
+            speed = MAX(min_wind, wind(iainia))
+            !
+            ! beta for transpiration
+            !
+            ! Corrections Nathalie - 28 March 2006 - on advices of Fred Hourdin
+            !! Introduction of a potentiometer rveg_pft to settle the rveg+rstruct sum problem in the coupled mode.
+            !! rveg_pft=1 in the offline mode. rveg_pft is a global variable declared in the diffuco module.
+            !vbeta3(iainia,jv) = veget_max(iainia,jv) * &
+            !  (un - zqsvegrap(iainia)) * &
+            !  (un / (un + speed * q_cdrag(iainia) * (rveget(iainia,jv) + &
+            !   rstruct(iainia,jv))))
+            !! Global resistance of the canopy to evaporation
+            cresist=(un / (un + speed * q_cdrag(iainia) * &
+                 (rveg_pft(jv)*(rveget(iainia,jv) + rstruct(iainia,jv)))))
+
+            IF ( humrel(iainia,jv) >= min_sechiba ) THEN
+               vbeta3(iainia,jv) = veget_max(iainia,jv) * &
+                    (un - zqsvegrap(iainia)) * cresist + &
+                    MIN( vbeta23(iainia,jv), veget_max(iainia,jv) * &
+                    zqsvegrap(iainia) * cresist )
+            ELSE
+               ! Because of a minimum conductance g0, vbeta3 cannot be zero even if humrel=0
+               ! in the above equation.
+               ! Here, we force transpiration to be zero when the soil cannot deliver it
+               vbeta3(iainia,jv) = zero
+            END IF
+
+            ! vbeta3pot for computation of potential transpiration (needed for irrigation)
+            vbeta3pot(iainia,jv) = MAX(zero, veget_max(iainia,jv) * cresist)
+            !
+            !
+         ENDDO
+         !
+      ENDIF
+      !
+   END DO         ! loop over vegetation types
+   !
+   IF (printlev>=3) WRITE (numout,*) ' diffuco_trans_co2 done '
+
+
+END SUBROUTINE diffuco_trans_co2
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	   : diffuco_comb
+!!
+!>\BRIEF           This routine combines the previous partial beta 
+!! coefficients and calculates the total alpha and complete beta coefficients.
+!!
+!! DESCRIPTION	   : Those integrated coefficients are used to calculate (in enerbil.f90) the total evapotranspiration 
+!! from the grid-cell. \n
+!!
+!! In the case that air is more humid than surface, dew deposition can occur (negative latent heat flux). 
+!! In this instance, for temperature above zero, all of the beta coefficients are set to 0, except for 
+!! interception (vbeta2) and bare soil (vbeta4 with zero soil resistance). The amount of water that is 
+!! intercepted by leaves is calculated based on the value of LAI of the surface. In the case of freezing 
+!! temperatures, water is added to the snow reservoir, and so vbeta4 and vbeta2 are set to 0, and the 
+!! total vbeta and valpha is set to 1.\n
+!!
+!! \latexonly 
+!!     \input{diffucocomb1.tex}
+!! \endlatexonly
+!!
+!! The beta and alpha coefficients are initially set to 1.
+!! \latexonly 
+!!     \input{diffucocomb2.tex}
+!! \endlatexonly
+!!
+!! If snow is lower than the critical value:
+!! \latexonly 
+!!     \input{diffucocomb3.tex}
+!! \endlatexonly
+!! If in the presence of dew:
+!! \latexonly 
+!!     \input{diffucocomb4.tex}
+!! \endlatexonly
+!!
+!! Determine where the water goes (soil, vegetation, or snow)
+!! when air moisture exceeds saturation.
+!! \latexonly 
+!!     \input{diffucocomb5.tex}
+!! \endlatexonly
+!!
+!! If it is not freezing dew is put into the interception reservoir and onto the bare soil. If it is freezing, 
+!! water is put into the snow reservoir. 
+!! Now modify valpha and vbetas where necessary: for soil and snow
+!! \latexonly 
+!!     \input{diffucocomb6.tex}
+!! \endlatexonly
+!!
+!! and for vegetation
+!! \latexonly 
+!!     \input{diffucocomb7.tex}
+!! \endlatexonly
+!!
+!! Then compute part of dew that can be intercepted by leafs.
+!!
+!! There will be no transpiration when air moisture is too high, under any circumstance
+!! \latexonly 
+!!     \input{diffucocomb8.tex}
+!! \endlatexonly
+!!
+!! There will also be no interception loss on bare soil, under any circumstance.
+!! \latexonly 
+!!     \input{diffucocomb9.tex}
+!! \endlatexonly
+!!
+!! The flowchart details the 'decision tree' which underlies the module. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): vbeta1, vbeta4, humrel, vbeta2, vbeta3, valpha, vbeta
+!!
+!! REFERENCE(S) :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!!
+!! FLOWCHART    :
+!! \latexonly 
+!!     \includegraphics[scale=0.25]{diffuco_comb_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_comb (kjpindex, humrel, rau, u, v, q_cdrag, pb, qair, temp_sol, temp_air, &
+       & snow, veget, lai, tot_bare_soil, vbeta1, vbeta2, vbeta3 , vbeta4, valpha, vbeta, qsintmax)    
+    
+    ! Ajout qsintmax dans les arguments de la routine Nathalie / le 13-03-2006
+
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                           :: kjpindex   !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau        !! Air Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u          !! Eastward Lowest level wind speed (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v          !! Nortward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag    !! Product of Surface drag coefficient and wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: pb         !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qair       !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: temp_sol   !! Skin temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: temp_air   !! Lower air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: snow       !! Snow mass (kg)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget      !! Fraction of vegetation type (fraction)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: lai        !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintmax   !! Maximum water on vegetation (kg m^{-2})
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)        :: tot_bare_soil!! Total evaporating bare soil fraction 
+
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: valpha     !! Total Alpha coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vbeta      !! Total beta coefficient (-)
+
+    !! 0.3 Modified variables 
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: vbeta1     !! Beta for sublimation (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: vbeta4     !! Beta for Bare soil evaporation (-) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: humrel     !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: vbeta2     !! Beta for interception loss (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: vbeta3     !! Beta for Transpiration (-)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                       :: ji, jv
+    REAL(r_std)                                          :: zevtest, zsoil_moist, zrapp
+    REAL(r_std), DIMENSION(kjpindex)                     :: vbeta2sum, vbeta3sum
+!!    REAL(r_std), DIMENSION(kjpindex)                     :: vegetsum, vegetsum2
+    REAL(r_std), DIMENSION(kjpindex)                     :: qsatt
+    LOGICAL, DIMENSION(kjpindex)                         :: toveg, tosnow
+    REAL(r_std)                                          :: coeff_dew_veg
+!_ ================================================================================================================================
+    
+    !! \latexonly 
+    !!     \input{diffucocomb1.tex}
+    !! \endlatexonly
+    vbeta2sum(:) = zero
+    vbeta3sum(:) = zero
+    DO jv = 1, nvm
+      vbeta2sum(:) = vbeta2sum(:) + vbeta2(:,jv)
+      vbeta3sum(:) = vbeta3sum(:) + vbeta3(:,jv)
+    ENDDO 
+
+  !! 1. The beta and alpha coefficients are initially set to 1.
+     
+    !! \latexonly 
+    !!     \input{diffucocomb2.tex}
+    !! \endlatexonly
+    vbeta(:) = un
+    valpha(:) = un
+
+    
+  !! 2. if snow is lower than the critical value:
+    
+    !! \latexonly 
+    !!     \input{diffucocomb3.tex}
+    !! \endlatexonly
+    DO ji = 1, kjpindex
+
+      IF  (snow(ji) .LT. snowcri) THEN
+
+          vbeta(ji) = vbeta4(ji) + vbeta2sum(ji) + vbeta3sum(ji)
+
+          IF (vbeta(ji) .LT. min_sechiba) THEN
+             vbeta(ji) = zero
+          END IF
+
+      END IF
+
+    ENDDO
+
+    
+  !! 3 If we are in presence of dew:
+     
+    CALL qsatcalc (kjpindex, temp_sol, pb, qsatt)
+
+    
+    !! 9.3.1 Determine where the water goes 
+    !! Determine where the water goes (soil, vegetation, or snow)
+    !! when air moisture exceeds saturation.
+    !! \latexonly 
+    !!     \input{diffucocomb5.tex}
+    !! \endlatexonly
+    toveg(:) = .FALSE.
+    tosnow(:) = .FALSE.
+    DO ji = 1, kjpindex
+      IF ( qsatt(ji) .LT. qair(ji) ) THEN
+          IF (temp_air(ji) .GT. tp_00) THEN
+
+              !! 9.3.1.1  If it is not freezing, 
+              !! If it is not freezing dew is put into the 
+              !! interception reservoir and onto the bare soil.
+              toveg(ji) = .TRUE.
+          ELSE
+
+              !! 9.3.1.2  If it is freezing, 
+              !! If it is freezing water is put into the 
+              !! snow reservoir.
+              tosnow(ji) = .TRUE.
+          ENDIF
+      ENDIF
+    END DO
+
+
+    !! 9.3.1.3 Now modify valpha and vbetas where necessary.
+    
+    !! 9.3.1.3.1 Soil and snow (2d)
+    !! \latexonly 
+    !!     \input{diffucocomb6.tex}
+    !! \endlatexonly
+    DO ji = 1, kjpindex
+      IF ( toveg(ji) ) THEN
+        vbeta1(ji) = zero
+        vbeta4(ji) = tot_bare_soil(ji)
+        ! Correction Nathalie - le 13-03-2006: le vbeta ne sera calcule qu'une fois tous les vbeta2 redefinis
+        !vbeta(ji) = vegetsum(ji)
+        vbeta(ji) = vbeta4(ji)
+        valpha(ji) = un
+      ENDIF
+      IF ( tosnow(ji) ) THEN
+        vbeta1(ji) = un
+        vbeta4(ji) = zero
+        vbeta(ji) = un
+        valpha(ji) = un
+      ENDIF
+    ENDDO
+
+    !! 9.3.1.3.2 Vegetation (3d)
+    !! \latexonly 
+    !!     \input{diffucocomb7.tex}
+    !! \endlatexonly
+    DO jv = 1, nvm
+      
+      DO ji = 1, kjpindex
+        
+        ! Correction Nathalie - 13-03-2006 / si qsintmax=0, vbeta2=0
+        IF ( toveg(ji) ) THEN
+           IF (qsintmax(ji,jv) .GT. min_sechiba) THEN
+              
+              ! Compute part of dew that can be intercepted by leafs.
+              IF ( lai(ji,jv) .GT. min_sechiba) THEN
+                IF (lai(ji,jv) .GT. 1.5) THEN
+                   coeff_dew_veg= &
+                         &   dew_veg_poly_coeff(6)*lai(ji,jv)**5 &
+                         & - dew_veg_poly_coeff(5)*lai(ji,jv)**4 &
+                         & + dew_veg_poly_coeff(4)*lai(ji,jv)**3 &
+                         & - dew_veg_poly_coeff(3)*lai(ji,jv)**2 &
+                         & + dew_veg_poly_coeff(2)*lai(ji,jv) &
+                         & + dew_veg_poly_coeff(1)
+                 ELSE
+                    coeff_dew_veg=un
+                 ENDIF
+              ELSE
+                 coeff_dew_veg=zero
+              ENDIF
+              IF (jv .EQ. 1) THEN
+                 vbeta2(ji,jv) = coeff_dew_veg*tot_bare_soil(ji)
+              ELSE
+                 vbeta2(ji,jv) = coeff_dew_veg*veget(ji,jv)
+             !vbeta2(ji,jv) = veget(ji,jv)
+              ENDIF
+           ELSE
+              vbeta2(ji,jv) = zero
+           ENDIF
+           vbeta(ji) = vbeta(ji) + vbeta2(ji,jv)
+        ENDIF
+        IF ( tosnow(ji) ) vbeta2(ji,jv) = zero
+        
+      ENDDO
+      
+    ENDDO
+
+    !! 9.3.2a  There will be no transpiration when air moisture is too high, under any circumstance
+    !! \latexonly 
+    !!     \input{diffucocomb8.tex}
+    !! \endlatexonly
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+        IF ( qsatt(ji) .LT. qair(ji) ) THEN
+          vbeta3(ji,jv) = zero
+          humrel(ji,jv) = zero
+        ENDIF
+      ENDDO
+    ENDDO
+
+    
+    !! 9.3.2b  There will also be no interception loss on bare soil, under any circumstance.
+    !! \latexonly 
+    !!     \input{diffucocomb9.tex}
+    !! \endlatexonly
+    DO ji = 1, kjpindex
+       IF ( qsatt(ji) .LT. qair(ji) ) THEN
+          vbeta2(ji,1) = zero
+       ENDIF
+    ENDDO
+
+    IF (printlev>=3) WRITE (numout,*) ' diffuco_comb done '
+
+  END SUBROUTINE diffuco_comb
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	: diffuco_raerod
+!!
+!>\BRIEF	Computes the aerodynamic resistance, for cases in which the
+!! surface drag coefficient is provided by the coupled atmospheric model LMDZ and  when the flag
+!! 'ldq_cdrag_from_gcm' is set to TRUE
+!!
+!! DESCRIPTION	: Simply computes the aerodynamic resistance, for cases in which the
+!! surface drag coefficient is provided by the coupled atmospheric model LMDZ. If the surface drag coefficient
+!! is not provided by the LMDZ or signalled by the flag 'ldq_cdrag_from_gcm' set to FALSE, then the subroutine
+!! diffuco_aero is called instead of this one.
+!!
+!! Calculation of the aerodynamic resistance, for diganostic purposes. First calculate wind speed:
+!! \latexonly 
+!!     \input{diffucoaerod1.tex}
+!! \endlatexonly       
+!!
+!! next calculate ::raero
+!! \latexonly 
+!!     \input{diffucoaerod2.tex}
+!! \endlatexonly
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::raero
+!!
+!! REFERENCE(S)	:
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influence de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!!
+!! FLOWCHART    :  None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_raerod (kjpindex, u, v, q_cdrag, raero)
+    
+    IMPLICIT NONE
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                     :: kjpindex     !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: u            !! Eastward Lowest level wind velocity (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: v            !! Northward Lowest level wind velocity (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: q_cdrag      !! Product of Surface drag coefficient and wind speed (m s^{-1})
+    
+    !! 0.2 Output variables 
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: raero        !! Aerodynamic resistance (s m^{-1})
+     
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                 :: ji           !! (-)
+    REAL(r_std)                                    :: speed        !! (m s^{-1})
+!_ ================================================================================================================================
+   
+  !! 1. Simple calculation of the aerodynamic resistance, for diganostic purposes.
+
+    DO ji=1,kjpindex
+
+       !! \latexonly 
+       !!     \input{diffucoaerod1.tex}
+       !! \endlatexonly       
+       speed = MAX(min_wind, wind(ji))
+
+       !! \latexonly 
+       !!     \input{diffucoaerod2.tex}
+       !! \endlatexonly
+       raero(ji) = un / (q_cdrag(ji)*speed)
+       
+    ENDDO
+  
+  END SUBROUTINE diffuco_raerod
+
+
+  FUNCTION Arrhenius (kjpindex,temp,ref_temp,energy_act) RESULT ( val_arrhenius )
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                     :: kjpindex          !! Domain size (-)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)    :: temp              !! Temperature (K)
+    REAL(r_std), INTENT(in)                       :: ref_temp          !! Temperature of reference (K)
+    REAL(r_std),INTENT(in)                        :: energy_act        !! Activation Energy (J mol-1)
+    
+    !! 0.2 Result
+
+    REAL(r_std), DIMENSION(kjpindex)              :: val_arrhenius     !! Temperature dependance based on
+                                                                       !! a Arrhenius function (-)
+    
+    val_arrhenius(:)=EXP(((temp(:)-ref_temp)*energy_act)/(ref_temp*RR*(temp(:))))
+  END FUNCTION Arrhenius
+
+  FUNCTION Arrhenius_modified (kjpindex,temp,ref_temp,energy_act,energy_deact,entropy) RESULT ( val_arrhenius )
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                     :: kjpindex          !! Domain size (-)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)    :: temp              !! Temperature (K)
+    REAL(r_std), INTENT(in)                       :: ref_temp          !! Temperature of reference (K)
+    REAL(r_std),INTENT(in)                        :: energy_act        !! Activation Energy (J mol-1)
+    REAL(r_std),INTENT(in)                        :: energy_deact      !! Deactivation Energy (J mol-1)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)    :: entropy           !! Entropy term (J K-1 mol-1)
+        
+    !! 0.2 Result
+
+    REAL(r_std), DIMENSION(kjpindex)              :: val_arrhenius     !! Temperature dependance based on
+                                                                       !! a Arrhenius function (-)
+    
+    val_arrhenius(:)=EXP(((temp(:)-ref_temp)*energy_act)/(ref_temp*RR*(temp(:))))  &
+         * (1. + EXP( (ref_temp * entropy(:) - energy_deact) / (ref_temp * RR ))) &
+         / (1. + EXP( (temp(:) * entropy(:) - energy_deact) / ( RR*temp(:))))
+         
+  END FUNCTION Arrhenius_modified
+
+
+END MODULE diffuco
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/enerbil.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/enerbil.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/enerbil.f90	(revision 5166)
@@ -0,0 +1,1791 @@
+!  ==============================================================================================================================
+!  MODULE		 			: enerbil
+!
+!  CONTACT		 			: orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE	 			        : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF					This module computes the energy balance on 
+!! continental surfaces. The module contains the following subroutines: enerbil_initialize, enerbil_main,
+!! enerbil_clear, enerbil_begin, enerbil_surftemp, enerbil_flux, enerbil_evapveg,
+!! enerbil_fusion and enerbil_t2mdiag
+!!
+!!\n DESCRIPTION                                : 
+!! \n
+!! \latexonly 
+!!     \input{enerbil_intro2.tex}
+!! \endlatexonly
+!!
+!! IMPORTANT NOTE: The coefficients A and B are defined differently than those in the referenced 
+!! literature and from those in the code and documentation of the atmospheric model LMDZ. For the
+!! avoidance of doubt, the coefficients as described here always refer to the ORCHIDEE coefficients, 
+!! and are denoted as such (with the marker: ORC). The re-definition of the coefficients takes place 
+!! within LMDZ before they are passed to ORCHIDEE. The following sequence of expressions is to be 
+!! found within the LMDZ module 'surf_land_orchidee':\n
+!!
+!! \latexonly 
+!!     \input{surflandLMDZ1.tex}
+!!     \input{surflandLMDZ2.tex}
+!!     \input{surflandLMDZ3.tex}
+!!     \input{surflandLMDZ4.tex}
+!! \endlatexonly
+!! \n
+!!
+!! \latexonly 
+!!     \input{enerbil_symbols.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S)                             : None
+!!
+!! REFERENCE(S)	                                : None 
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE enerbil
+
+  ! routines called : restput, restget
+  !
+  ! modules used
+  USE ioipsl
+  USE xios_orchidee
+  USE ioipsl_para 
+  USE constantes
+  USE pft_parameters
+  USE qsat_moisture
+  USE sechiba_io
+  USE constantes_soil
+  USE explicitsnow
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: enerbil_main, enerbil_fusion, enerbil_initialize, enerbil_finalize, enerbil_clear
+
+  ! variables used inside enerbil module : declaration and initialisation
+ 
+  ! one dimension array allocated, computed and used in enerbil module exclusively
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: psold         !! Old surface dry static energy (J kg^{-1})
+!$OMP THREADPRIVATE(psold)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsol_sat      !! Saturated specific humudity for old temperature (kg kg^{-1})
+!$OMP THREADPRIVATE(qsol_sat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pdqsold       !! Deriv. of saturated specific humidity at old temp
+                                                                 !! (kg (kg s)^{-1})
+!$OMP THREADPRIVATE(pdqsold)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: psnew         !! New surface static energy (J kg^{-1})
+!$OMP THREADPRIVATE(psnew)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsol_sat_new  !! New saturated surface air moisture (kg kg^{-1})
+!$OMP THREADPRIVATE(qsol_sat_new)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: netrad        !! Net radiation (W m^{-2})
+!$OMP THREADPRIVATE(netrad)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwabs         !! LW radiation absorbed by the surface (W m^{-2})
+!$OMP THREADPRIVATE(lwabs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwup          !! Long-wave up radiation (W m^{-2})
+!$OMP THREADPRIVATE(lwup)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwnet         !! Net Long-wave radiation (W m^{-2})
+!$OMP THREADPRIVATE(lwnet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: fluxsubli     !! Energy of sublimation (mm day^{-1})
+!$OMP THREADPRIVATE(fluxsubli)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsat_air      !! Air saturated specific humidity (kg kg^{-1})
+!$OMP THREADPRIVATE(qsat_air)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tair          !! Air temperature (K)
+!$OMP THREADPRIVATE(tair)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: q_sol_pot               !! Potential surface humidity
+!$OMP THREADPRIVATE(q_sol_pot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: temp_sol_pot            !! Potential surface temperature (unstressed)
+!$OMP THREADPRIVATE(temp_sol_pot)
+
+  
+CONTAINS  
+!!  =============================================================================================================================
+!! SUBROUTINE:              enerbil_initialize
+!!
+!>\BRIEF		    Allocate module variables, read from restart file or initialize with default values
+!!
+!! DESCRIPTION:             The purpose of this module is, firstly, to allocate space
+!! in memory for key variables within the 'enerbil' module. The second task is to retrieve previous data
+!! from the restart file. If the variables are not in restart file, default initialization is done. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S): None
+!! 
+!! FLOWCHART: None
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_initialize (kjit,     kjpindex,     index,    rest_id,  &
+                                 temp_air, qair,                             &
+                                 temp_sol, temp_sol_new, tsol_rad, t2mdiag,  &
+                                 evapot,   evapot_corr,  qsurf,    fluxsens, &
+                                 fluxlat,  vevapp )
+ 
+    !! 0 Variable and parameter description
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number (-)
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index            !! Indeces of the points on the map (-)
+    INTEGER(i_std),INTENT (in)                         :: rest_id          !! Restart file identifier (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_air         !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: qair             !! Lowest level specific humidity (kg kg^{-1})
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: temp_sol         !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: temp_sol_new     !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: tsol_rad         !! Tsol_rad (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: t2mdiag          !! Diagnostic temperature at 2m above ground (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: evapot           !! Soil Potential Evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: evapot_corr      !! Soil Potential Evaporation Correction (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: qsurf            !! Surface specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: fluxsens         !! Sensible heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: fluxlat          !! Latent heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vevapp           !! Total of evaporation (mm day^{-1})
+
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                     :: ier
+
+!_ ================================================================================================================================
+    
+    IF (printlev>=3) WRITE (numout,*) 'enerbil_initialize : Start initillization'
+
+    !! 1. Allocate module variables
+    ALLOCATE (psold(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable ','','')
+
+    ALLOCATE (qsol_sat(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable ','','')
+
+    ALLOCATE (pdqsold(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable ','','')
+
+    ALLOCATE (psnew(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable ','','')
+
+    ALLOCATE (qsol_sat_new(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable qsol_sat_new','','')
+
+    ALLOCATE (netrad(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable netrad','','')
+
+    ALLOCATE (lwabs(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable lwabs','','')
+
+    ALLOCATE (lwup(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable lwup','','')
+
+    ALLOCATE (lwnet(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable lwnet','','')
+
+    ALLOCATE (fluxsubli(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable fluxsubli','','')
+
+    ALLOCATE (qsat_air(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable qsat_air','','')
+
+    ALLOCATE (tair(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable tair','','')
+
+    ALLOCATE (q_sol_pot(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable q_sol_pot','','')
+
+    ALLOCATE (temp_sol_pot(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'enerbil_initialize','Problem in allocation of variable temp_sol_pot','','')
+
+    !! 2. Initialize variables from restart file or by default values
+    !! The variables read are: temp_sol (surface temperature), qsurf (near surface specific humidity),
+    !! evapot (soil potential evaporation), evapot_corr (corrected soil potential evaporation), tsolrad
+    !! (radiative surface temperature), evapora (evaporation), fluxlat (latent heat flux), fluxsens
+    !! (sensible heat flux) and temp_sol_new (new surface temperature).
+    IF (printlev>=3) WRITE (numout,*) 'Read a restart file for ENERBIL variables'
+    
+    CALL ioconf_setatt_p('UNITS', 'K')
+    CALL ioconf_setatt_p('LONG_NAME','Surface temperature')
+    CALL restget_p (rest_id, 'temp_sol', nbp_glo, 1, 1, kjit, .TRUE., temp_sol, "gather", nbp_glo, index_g)
+    
+    !Config Key   = ENERBIL_TSURF
+    !Config Desc  = Initial temperature if not found in restart
+    !Config If    = OK_SECHIBA
+    !Config Def   = 280.
+    !Config Help  = The initial value of surface temperature if its value is not found
+    !Config         in the restart file. This should only be used if the model is 
+    !Config         started without a restart file.
+    !Config Units = Kelvin [K]
+    CALL setvar_p (temp_sol, val_exp,'ENERBIL_TSURF', 280._r_std)
+    
+    ! Initialize temp_sol_new with temp_sol. These variables are always equal in the beginning of a new time step.
+    temp_sol_new(:) = temp_sol(:)
+
+    CALL ioconf_setatt_p('UNITS', 'g/g')
+    CALL ioconf_setatt_p('LONG_NAME','near surface specific humidity')
+    CALL restget_p (rest_id, 'qsurf', nbp_glo, 1, 1, kjit, .TRUE., qsurf, "gather", nbp_glo, index_g)
+    IF ( ALL( qsurf(:) .EQ. val_exp ) ) THEN 
+       qsurf(:) = qair(:)
+    ENDIF
+    
+    CALL ioconf_setatt_p('UNITS', 'mm day^{-1}')
+    CALL ioconf_setatt_p('LONG_NAME','Soil Potential Evaporation')
+    CALL restget_p (rest_id, 'evapot', nbp_glo, 1, 1, kjit, .TRUE., evapot, "gather", nbp_glo, index_g)
+    CALL setvar_p (evapot, val_exp, 'ENERBIL_EVAPOT', zero)
+    
+    CALL ioconf_setatt_p('UNITS', 'mm day^{-1}')
+    CALL ioconf_setatt_p('LONG_NAME','Corrected Soil Potential Evaporation')
+    CALL restget_p (rest_id, 'evapot_corr', nbp_glo, 1, 1, kjit, .TRUE., evapot_corr, "gather", nbp_glo, index_g)
+    !Config Key   = ENERBIL_EVAPOT
+    !Config Desc  = Initial Soil Potential Evaporation
+    !Config If    = OK_SECHIBA       
+    !Config Def   = 0.0
+    !Config Help  = The initial value of soil potential evaporation if its value 
+    !Config         is not found in the restart file. This should only be used if
+    !Config         the model is started without a restart file. 
+    !Config Units = 
+    CALL setvar_p (evapot_corr, val_exp, 'ENERBIL_EVAPOT', zero)
+    
+    CALL ioconf_setatt_p('UNITS', 'K')
+    CALL ioconf_setatt_p('LONG_NAME','Radiative surface temperature')
+    CALL restget_p (rest_id, 'tsolrad', nbp_glo, 1, 1, kjit, .TRUE., tsol_rad, "gather", nbp_glo, index_g)
+    IF ( ALL( tsol_rad(:) .EQ. val_exp ) ) THEN 
+       tsol_rad(:) = temp_sol(:)
+    ENDIF
+    
+    !! 1.3 Set the fluxes so that we have something reasonable and not NaN on some machines
+    CALL ioconf_setatt_p('UNITS', 'Kg/m^2/dt')
+    CALL ioconf_setatt_p('LONG_NAME','Evaporation')
+    CALL restget_p (rest_id, 'evapora', nbp_glo, 1, 1, kjit, .TRUE., vevapp, "gather", nbp_glo, index_g)
+    IF ( ALL( vevapp(:) .EQ. val_exp ) ) THEN 
+       vevapp(:) = zero
+    ENDIF
+    
+    CALL ioconf_setatt_p('UNITS', 'W/m^2')
+    CALL ioconf_setatt_p('LONG_NAME','Latent heat flux')
+    CALL restget_p (rest_id, 'fluxlat', nbp_glo, 1, 1, kjit, .TRUE., fluxlat, "gather", nbp_glo, index_g)
+    IF ( ALL( fluxlat(:) .EQ. val_exp ) ) THEN 
+       fluxlat(:) = zero
+    ENDIF
+    
+    CALL ioconf_setatt_p('UNITS', 'W/m^2')
+    CALL ioconf_setatt_p('LONG_NAME','Sensible heat flux')
+    CALL restget_p (rest_id, 'fluxsens', nbp_glo, 1, 1, kjit, .TRUE., fluxsens, "gather", nbp_glo, index_g)
+    IF ( ALL( fluxsens(:) .EQ. val_exp ) ) THEN 
+       fluxsens(:) = zero
+    ENDIF
+    
+    CALL ioconf_setatt_p('UNITS', 'K')
+    CALL ioconf_setatt_p('LONG_NAME','Potential surface temperature')
+    CALL restget_p (rest_id, 'tempsolpot', nbp_glo, 1, 1, kjit, .TRUE., temp_sol_pot, "gather", nbp_glo, index_g)
+    IF ( ALL( temp_sol_pot(:) .EQ. val_exp ) ) THEN 
+       temp_sol_pot = temp_sol
+    ENDIF
+    
+    CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+    CALL ioconf_setatt_p('LONG_NAME','Potential saturated surface humidity')
+    CALL restget_p (rest_id, 'qsolpot', nbp_glo, 1, 1, kjit, .TRUE., q_sol_pot, "gather", nbp_glo, index_g)
+    IF ( ALL( q_sol_pot(:) .EQ. val_exp ) ) THEN 
+       q_sol_pot = qsurf
+    ENDIF
+    
+    !! 3. Initialize temperature at 2m  
+    CALL enerbil_t2mdiag (kjpindex, temp_air, t2mdiag)
+    
+  END SUBROUTINE enerbil_initialize
+   
+
+
+  !!  ===========================================================================================================================
+  !! SUBROUTINE		 		    : enerbil_main
+  !!
+  !!
+  !>\BRIEF				    Calls each part of the energy budget calculation in sequence 
+  !!
+  !! DESCRIPTION			    : 
+  !! This is the main routine for the 'enerbil' module. It is called
+  !! once during the initialisation of ORCHIDEE, and then once for each time step. It is called a final
+  !! time at the culmination of the last time step, for the writing of a restart file.\n
+  !!
+  !! The algorithm first calls 'enerbil_begin' for initialisation, followed by 'enerbil_surftemp' to
+  !! calculate the surface static energy and the saturated surface humidity for the new time step.
+  !! Next is the module 'enerbil_flux' which calculates the new surface temperature, the net radiation in
+  !! the surface layer, the total evaporation and the latent and sensible heat fluxes. Finally comes
+  !! 'enerbil_evapveg', which calculates the evaporation and transpiration from the vegetation.\n
+
+  !! \n
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	: evapot, evapot_corr, temp_sol, qsurf, fluxsens, fluxlat, tsol_rad,
+  !! vevapp, temp_sol_new, vevapnu, vevapsno, transpir, vevapwet, t2mdiag
+  !!
+  !! REFERENCE(S)		:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available (22/12/11):
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf 
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers\n
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART			:
+  !! \latexonly 
+  !!     \includegraphics[scale=0.5]{enerbil_main_flowchart.png}
+  !! \endlatexonly
+  !! \n
+  !_ ==============================================================================================================================
+   
+  SUBROUTINE enerbil_main (kjit, kjpindex, &
+       & index, indexveg, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef, &
+       & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, &
+       & emis, soilflx, soilcap, q_cdrag, humrel, fluxsens, fluxlat, &
+       & vevapp, transpir, transpot, vevapnu, vevapwet, vevapsno, vevapflo, t2mdiag, temp_sol, tsol_rad, &
+       & temp_sol_new, qsurf, evapot, evapot_corr, rest_id, hist_id, hist2_id, &
+       & precip_rain,  pgflux, snowdz, snowrho, temp_sol_add)
+ 
+
+    !! 0 Variable and parameter description
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                           :: kjit             !! Time step number (-)
+    INTEGER(i_std), INTENT(in)                           :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),INTENT (in)                           :: rest_id,hist_id  !! _Restart_ file and _history_ file identifier (-)
+    INTEGER(i_std),INTENT (in)                           :: hist2_id         !! _history_ file 2 identifier (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: index            !! Indeces of the points on the map (-)
+    INTEGER(i_std),DIMENSION(kjpindex*nvm), INTENT(in)   :: indexveg         !! Indeces of the points on the 3D map
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: zlev             !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: lwdown           !! Down-welling long-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: swnet            !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: epot_air         !! Air potential energy (?? J)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: temp_air         !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u                !! Eastward Lowest level wind speed  (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v                !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: petAcoef         !! PetAcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: petBcoef         !! PetBcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qair             !! Lowest level specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: peqAcoef         !! PeqAcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: peqBcoef         !! PeqBcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: pb               !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau              !! Air density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: vbeta            !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: valpha           !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: vbeta1           !! Snow resistance (-) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: vbeta4           !! Bare soil resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: vbeta5           !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: emis             !! Emissivity (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: soilflx          !! Effective ground heat flux including both snow and soil (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: soilcap          !! Soil calorific capacity including both snow and soil (J K^{-1])
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag          !! Surface drag (m s^{-1})
+
+    REAL(r_std),DIMENSION (kjpindex, nvm), INTENT (in)   :: humrel           !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vbeta2           !! Interception resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vbeta3           !! Vegetation resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vbeta3pot        !! Vegetation resistance for potential transpiration
+    REAL(r_std),DIMENSION (kjpindex),INTENT (in)         :: precip_rain      !! Rainfall
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vevapnu          !! Bare soil evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vevapsno         !! Snow evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vevapflo         !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: transpir         !! Transpiration (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: transpot         !! Potential transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vevapwet         !! Interception (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: t2mdiag          !! Diagnostic temperature at 2m above ground (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: temp_sol_new     !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: temp_sol_add     !! Additional energy to melt snow for snow ablation case (K)    
+    !! 0.3 Modified variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: evapot           !! Soil Potential Evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: evapot_corr      !! Soil Potential Evaporation Correction (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: temp_sol         !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: qsurf            !! Surface specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: fluxsens         !! Sensible heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: fluxlat          !! Latent heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: tsol_rad         !! Tsol_rad (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vevapp           !! Total of evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: pgflux           !! Net energy into snowpack(W/m^2)
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(inout) :: snowrho          !! Snow density at each snow layer
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(inout) :: snowdz           !! Snow depth at each snow layer
+
+    !! 0.4 Local variables
+    REAL(r_std),DIMENSION (kjpindex)                     :: epot_air_new, qair_new
+    INTEGER(i_std)                                       :: ji,ii,iv
+
+
+!_ ================================================================================================================================
+    
+    !! 1. Computes some initialisation variables
+ 
+    !  Computes some initialisation variables psold (the old surface static energy), qsol_sat
+    ! (the saturated surface humidity) and pdqsold (the derivative of the saturated surface humidity,
+    ! calculated with respect to the surface temperature at the 'old' timestep)
+    CALL enerbil_begin (kjpindex, temp_sol, lwdown, swnet, pb, psold, qsol_sat, pdqsold, netrad, emis)
+
+
+    !! 2. Computes psnew (the surface static energy at the 'new' timestep) 
+    
+    ! Computes psnew (the surface static energy at the 'new' timestep), qsol_sat_new (the surface
+    ! saturated humidity at the 'new' timestep), temp_sol_new (the surface temperature at the 'new'
+    ! timestep), qair_new (the lowest atmospheric humidity at the 'new' timestep) and epot_air_new
+    ! (the lowest atmospheric evaporation potential at the 'new' timestep)
+    CALL enerbil_surftemp (kjpindex, zlev, emis, &
+       & epot_air, petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, rau, u, v, q_cdrag, vbeta,&
+       & valpha, vbeta1, vbeta5, soilcap, lwdown, swnet, psnew, qsol_sat_new, temp_sol_new, &
+       & qair_new, epot_air_new, &
+       & snowdz)
+
+
+    ! 3. computes surface temperature and humidity for a saturated surface
+    !
+    CALL enerbil_pottemp (kjpindex, zlev, emis, &
+       & epot_air, petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, rau, u, v, q_cdrag, vbeta,&
+       & valpha, vbeta1, vbeta5, soilcap, lwdown, swnet, q_sol_pot, temp_sol_pot)
+
+
+    !! 4. Diagnoses components of the energy budget
+    
+    ! Diagnoses lwup (upwards long wave radiation), lwnet (net long wave radiation), tsol_rad (radiative
+    ! ground temperature), netrad (net radiation), qsurf (surface humidity), vevapp (total evaporation),
+    ! evapot (evaporation potential), evapot_corr (evaporation potential correction factor), 
+    ! fluxlat (latent heat flux), fluxsubli (sublimination heat flux) and fluxsens (sensible heat flux).
+
+    CALL enerbil_flux (kjpindex, emis, temp_sol, rau, u, v, q_cdrag, vbeta, valpha, vbeta1, vbeta5, &
+       & qair_new, epot_air_new, psnew, qsurf, &
+       & fluxsens , fluxlat , fluxsubli, vevapp, temp_sol_new, lwdown, swnet, &
+       & lwup, lwnet, pb, tsol_rad, netrad, evapot, evapot_corr, &
+       & precip_rain,snowdz,temp_air,pgflux, soilcap, temp_sol_add)
+
+    !! 5. Diagnoses the values for evaporation and transpiration 
+    
+    ! Diagnoses the values for evaporation and transpiration: vevapsno (snow evaporation), vevapnu 
+    ! (bare soil evaporation), transpir (transpiration) and vevapwet (interception)
+    CALL enerbil_evapveg (kjpindex, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5,  &
+       & rau, u, v, q_cdrag, qair_new, humrel, vevapsno, vevapnu , vevapflo, vevapwet, &
+       & transpir, transpot, evapot, &
+       & snowdz,snowrho,evapot_corr)
+
+
+    
+    !! 6. Assigns a temperature 2 metres above the ground 
+
+    ! Assigns a temperature 2 metres above the ground. The output variable - t2mdiag, is used just for
+    ! diagnostic purposes, for now.
+    CALL enerbil_t2mdiag (kjpindex, temp_air, t2mdiag)
+
+    CALL xios_orchidee_send_field("netrad",netrad)
+    CALL xios_orchidee_send_field("evapot",evapot*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("evapot_alma",evapot/dt_sechiba)
+    CALL xios_orchidee_send_field("evapot_corr",evapot_corr*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("evapot_corr_alma",evapot_corr/dt_sechiba)
+    CALL xios_orchidee_send_field("lwdown",lwabs)
+    CALL xios_orchidee_send_field("lwnet",lwnet)
+    CALL xios_orchidee_send_field("Qv",fluxsubli)
+    CALL xios_orchidee_send_field("PotSurfT",temp_sol_pot)
+          
+
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'netrad', kjit, netrad, kjpindex, index)
+       CALL histwrite_p(hist_id, 'evapot', kjit, evapot, kjpindex, index)
+       CALL histwrite_p(hist_id, 'evapot_corr', kjit, evapot_corr, kjpindex, index)
+       CALL histwrite_p(hist_id, 'lwdown', kjit, lwabs,  kjpindex, index)
+       CALL histwrite_p(hist_id, 'lwnet',  kjit, lwnet,  kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'netrad', kjit, netrad, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'evapot', kjit, evapot, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'evapot_corr', kjit, evapot_corr, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'lwdown', kjit, lwabs,  kjpindex, index)
+          CALL histwrite_p(hist2_id, 'lwnet',  kjit, lwnet,  kjpindex, index)
+       ENDIF
+    ELSE
+       CALL histwrite_p(hist_id, 'LWnet', kjit, lwnet, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Qv', kjit, fluxsubli, kjpindex, index)
+       CALL histwrite_p(hist_id, 'PotEvap', kjit, evapot_corr, kjpindex, index)
+       CALL histwrite_p(hist_id, 'PotEvapOld', kjit, evapot, kjpindex, index)
+       CALL histwrite_p(hist_id, 'PotSurfT', kjit, temp_sol_pot, kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'LWnet', kjit, lwnet, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qv', kjit, fluxsubli, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'PotEvap', kjit, evapot_corr, kjpindex, index)
+       ENDIF
+    ENDIF
+
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_main Done '
+
+  END SUBROUTINE enerbil_main
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:               enerbil_finalize
+!!
+!>\BRIEF                     Write to restart file
+!!
+!! DESCRIPTION:              This subroutine writes the module variables and variables calculated in enerbil
+!!                           to restart file
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S): None
+!! 
+!! FLOWCHART: None
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE enerbil_finalize (kjit,   kjpindex,    rest_id,            &
+                               evapot, evapot_corr, temp_sol, tsol_rad, &
+                               qsurf,  fluxsens,    fluxlat,  vevapp )
+ 
+    !! 0 Variable and parameter description
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                        :: kjit             !! Time step number (-)
+    INTEGER(i_std), INTENT(in)                        :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),INTENT (in)                        :: rest_id          !! Restart file identifier (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: evapot           !! Soil Potential Evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: evapot_corr      !! Soil Potential Evaporation Correction (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: temp_sol         !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: tsol_rad         !! Tsol_rad (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: qsurf            !! Surface specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: fluxsens         !! Sensible heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: fluxlat          !! Latent heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: vevapp           !! Total of evaporation (mm day^{-1})
+
+!_ ================================================================================================================================
+    
+    !! 1. Write variables to restart file to be used for the next simulation
+    IF (printlev>=3) WRITE (numout,*) 'Write restart file with ENERBIL variables'
+
+    CALL restput_p(rest_id, 'temp_sol', nbp_glo, 1, 1, kjit,  temp_sol, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'qsurf', nbp_glo, 1, 1, kjit,  qsurf, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'evapot', nbp_glo, 1, 1, kjit,  evapot, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'evapot_corr', nbp_glo, 1, 1, kjit,  evapot_corr, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'tsolrad', nbp_glo, 1, 1, kjit,  tsol_rad, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'evapora', nbp_glo, 1, 1, kjit,  vevapp, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'fluxlat', nbp_glo, 1, 1, kjit,  fluxlat, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'fluxsens', nbp_glo, 1, 1, kjit,  fluxsens, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'tempsolpot', nbp_glo, 1, 1, kjit, temp_sol_pot, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'qsolpot', nbp_glo, 1, 1, kjit, q_sol_pot, 'scatter',  nbp_glo, index_g)
+    
+  END SUBROUTINE enerbil_finalize
+
+
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : enerbil_clear
+  !!
+  !>\BRIEF				    Routine deallocates clear output variables if already allocated.
+  !!
+  !! DESCRIPTION			    : This is a 'housekeeping' routine that deallocates the key output
+  !! variables, if they have already been allocated. The variables that are deallocated are psold,
+  !! qsol_sat, pdqsold, psnew, qsol_sat_new, netrad, lwabs, lwup, lwnet, fluxsubli, qsat_air, tair
+  !!
+  !! RECENT CHANGE(S)			    : None
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	            : None
+  !!
+  !! REFERENCES				    : None
+  !! 
+  !! FLOWCHART                              : None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_clear ()
+    IF ( ALLOCATED (psold)) DEALLOCATE (psold)
+    IF ( ALLOCATED (qsol_sat)) DEALLOCATE (qsol_sat)
+    IF ( ALLOCATED (pdqsold)) DEALLOCATE (pdqsold)
+    IF ( ALLOCATED (psnew)) DEALLOCATE (psnew)
+    IF ( ALLOCATED (qsol_sat_new)) DEALLOCATE (qsol_sat_new)
+    IF ( ALLOCATED (netrad)) DEALLOCATE (netrad)
+    IF ( ALLOCATED (lwabs)) DEALLOCATE (lwabs)
+    IF ( ALLOCATED (lwup)) DEALLOCATE (lwup)
+    IF ( ALLOCATED (lwnet)) DEALLOCATE (lwnet)
+    IF ( ALLOCATED (fluxsubli)) DEALLOCATE (fluxsubli)
+    IF ( ALLOCATED (qsat_air)) DEALLOCATE (qsat_air)
+    IF ( ALLOCATED (tair)) DEALLOCATE (tair)
+    IF ( ALLOCATED (q_sol_pot)) DEALLOCATE (q_sol_pot)
+    IF ( ALLOCATED (temp_sol_pot)) DEALLOCATE (temp_sol_pot)
+   
+  END SUBROUTINE enerbil_clear
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_begin
+  !!
+  !>\BRIEF					Preliminary variables required for the calculation of
+  !! the energy budget are derived.
+  !!
+  !! DESCRIPTION				: This routines computes preliminary variables required
+  !! for the calculation of the energy budget: the old surface static energy (psold), the surface saturation
+  !! humidity (qsol_sat), the derivative of satured specific humidity at the old temperature (pdqsold) 
+  !! and the net radiation (netrad).
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	                : psold, qsol_sat, pdqsold, netrad
+  !!
+  !! REFERENCE(S)				:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers\n
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART  : None                     
+  !! \n
+  !_ ==============================================================================================================================
+  
+  SUBROUTINE enerbil_begin (kjpindex, temp_sol, lwdown, swnet, pb, psold, qsol_sat, pdqsold, netrad, emis)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_sol         !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: lwdown           !! Down-welling long-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swnet            !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: pb               !! Lowest level pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: emis             !! Emissivity (-)
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: psold            !! Old surface dry static energy (J kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: qsol_sat	   !! Saturated specific humudity for old temperature 
+                                                                           !! (kg kg^{-1})    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: pdqsold	   !! Derivative of satured specific humidity at the old 
+                                                                           !! temperature (kg (kg s)^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: netrad           !! Net radiation (W m^{-2})
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ji
+    REAL(r_std), DIMENSION(kjpindex)                   :: dev_qsol
+    REAL(r_std), PARAMETER                             :: missing = 999998.
+
+!_ ================================================================================================================================
+  
+  !! 1. Computes psold (the surface static energy for the old timestep)
+   
+    !! We here define the surface static energy for the 'old' timestep, in terms of the surface
+    !! temperature and heat capacity.
+    !! \latexonly 
+    !!     \input{enerbilbegin1.tex}
+    !! \endlatexonly
+    psold(:) = temp_sol(:)*cp_air
+  !! 2. Computes qsol_sat (the surface saturated humidity).
+ 
+    !! We call the routine 'qsatcalc' from within the module 'src_parameters/constantes_veg'.
+    CALL qsatcalc (kjpindex, temp_sol, pb, qsol_sat)
+    IF ( diag_qsat ) THEN
+      IF ( ANY(ABS(qsol_sat(:)) .GT. missing) ) THEN
+        DO ji = 1, kjpindex
+          IF ( ABS(qsol_sat(ji)) .GT. missing) THEN
+            WRITE(numout,*) 'ERROR on ji = ', ji
+            WRITE(numout,*) 'temp_sol(ji),  pb(ji) :', temp_sol(ji),  pb(ji)
+            CALL ipslerr_p (3,'enerbil_begin', &
+ &           'qsol too high ','','')
+          ENDIF
+        ENDDO
+      ENDIF
+    ENDIF
+    
+  !! 3. Computes pdqsold 
+    
+    !! Computes pdqsold (the derivative of the saturated humidity with respect to temperature
+    !! analysed at the surface temperature at the 'old' timestep.
+    !! We call the routine 'dev_qsatcalc' from qsat_moisture module.
+    CALL dev_qsatcalc (kjpindex, temp_sol, pb, dev_qsol)
+    
+    !! \latexonly 
+    !!     \input{enerbilbegin2.tex}
+    !! \endlatexonly
+    pdqsold(:) = dev_qsol(:)
+    
+
+    IF ( diag_qsat ) THEN
+      IF ( ANY(ABS( pdqsold(:)) .GT. missing) ) THEN
+        DO ji = 1, kjpindex
+          IF ( ABS( pdqsold(ji)) .GT. missing ) THEN
+            WRITE(numout,*) 'ERROR on ji = ', ji
+            WRITE(numout,*) 'temp_sol(ji),  pb(ji) :', temp_sol(ji),  pb(ji)
+            CALL ipslerr_p (3,'enerbil_begin', &
+ &           'pdqsold too high ','','')
+          ENDIF
+        ENDDO
+      ENDIF
+    ENDIF
+
+  !! 4. Computes the net radiation and the absorbed LW radiation absorbed at the surface. 
+
+    !! Long wave radiation absorbed by the surface is the product of emissivity and downwelling LW radiation    
+    !! \latexonly 
+    !!     \input{enerbilbegin3.tex}
+    !! \endlatexonly
+    lwabs(:) = emis(:) * lwdown(:)
+
+    !! Net radiation is calculated as:
+    !! \latexonly 
+    !!     \input{enerbilbegin4.tex}
+    !! \endlatexonly
+    netrad(:) = lwdown(:) + swnet (:) - (emis(:) * c_stefan * temp_sol(:)**4 + (un - emis(:)) * lwdown(:)) 
+
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_begin done '
+
+  END SUBROUTINE enerbil_begin
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_surftemp
+  !!
+  !>\BRIEF					This routine computes the new surface static energy
+  !! (psnew) and the saturated humidity at the surface (qsol_sat_new). 
+  !!
+  !! DESCRIPTION				: This is the key part of the enerbil module, for which
+  !! the energy budget in the surface layer is solved and changes over the model timestep 'dt_sechiba' are
+  !! quantified for the surface static energy, surface temperature, surface humidity, the 'air' (or lowest
+  !! level atmospheric model) temperature, the 'air' (or lowest level atmospheric model) humidity, 
+  !! according to the method that is laid out by Dufresne \& Ghattas (2009) and Shultz et al. (2001).
+  !!
+  !! It computes the energy balance at the surface with an implicit scheme, that is connected to the 
+  !! Richtmyer and Morton algorithm of the PBL. By computing the surface temperature and surface humidity 
+  !! the routine also implicitly estimates the various fluxes which balance in order to give the new 
+  !! temperature. Thus once the surface temperature has been obtained all the fluxes need to be diagnosed. 
+  !!
+  !! If ok_explicitsnow is used, the notion of skin layer in ORCHIDEE is abandoned and
+  !! the first thin snow layer is adopted to solve the surface energy budget.
+  !! Implicit method is still used for coupling to the atmosphere.
+  !! In this new scheme, the snow temperature profile is simulatenously solved
+  !! along with the surface snow temperature, and the details are referenced to Boone et al. (2010)
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	: psnew, qsol_sat_new, temp_sol_new, qair_new, epot_air_new
+  !!
+  !! REFERENCE(S)					:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available (22/12/11):
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pd 
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART    : None
+  !!
+  !_ ==============================================================================================================================  
+  
+
+  SUBROUTINE enerbil_surftemp (kjpindex, zlev, emis, epot_air, &
+     & petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, rau, u, v, q_cdrag, vbeta,&
+     & valpha, vbeta1, vbeta5, soilcap, lwdown, swnet, psnew, qsol_sat_new, temp_sol_new, &
+     & qair_new, epot_air_new, &
+     & snowdz)
+
+
+
+    !! 0. Variable and parameter declaration 
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: zlev          !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: emis          !! Emissivity (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air      !! Air potential energy (?? J)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef      !! PetAcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef      !! PetBcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair          !! Lowest level specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef      !! PeqAcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef      !! PeqBcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilflx       !! Soil flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau           !! Air density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u, v          !! Wind velocity by directional components 
+                                                                              !! u (Eastwards) and v (Northwards) (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag       !! Surface drag (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta         !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: valpha        !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta1        !! Snow resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta5        !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilcap       !! Soil calorific capacity (J K^{-1])
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown        !! Down-welling long-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet         !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)      :: snowdz        !! Snow depth
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: psnew         !! New surface static energy (J kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qsol_sat_new  !! New saturated surface air moisture (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: temp_sol_new  !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qair_new      !! New air moisture (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: epot_air_new  !! New air temperature (K)
+
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                   :: ji
+    REAL(r_std),DIMENSION (kjpindex) :: zicp
+    REAL(r_std)                      :: fevap
+    REAL(r_std)                      :: sensfl_old, larsub_old, lareva_old, dtheta, sum_old, sum_sns
+    REAL(r_std)                      :: zikt, zikq, netrad_sns, sensfl_sns, larsub_sns, lareva_sns
+    REAL(r_std)                      :: speed
+
+!_ ================================================================================================================================
+ 
+    zicp = un / cp_air
+    
+    DO ji=1,kjpindex
+    !! 1. Derivation of auxiliary variables
+      
+      !! \latexonly 
+      !!     \input{enerbilsurftemp1.tex}
+      !! \endlatexonly
+      speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+      !
+      !! \latexonly 
+      !!     \input{enerbilsurftemp2.tex}
+      !! \endlatexonly
+      zikt = 1/(rau(ji) * speed * q_cdrag(ji))
+      zikq = 1/(rau(ji) * speed * q_cdrag(ji))
+      
+    !! 2. Computation of fluxes for the old surface conditions
+     
+      !! As a reference, we first calculate the sensible and latent heat for the 'old' timestep.
+ 
+      !! 2.1 Sensible heat for the 'old' timestep
+      !! This is equation (64) of (Dufresne & Ghattas, 2009), rewritten in terms of H_old. We make the 
+      !! approximation that (P_r/P)^{kappa}=1 and convert the A and B coefficients to the ORCHIDEE
+      !! format (see introductory note, above). Also, the equation here is in terms of surface static
+      !! energy, which is defined as per section 3.1, above.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp3.tex}
+      !! \endlatexonly
+      sensfl_old = (petBcoef(ji) -  psold(ji)) / (zikt -  petAcoef(ji))
+      !! 2.2 Latent heat for the 'old' timestep
+      !! This is equation (70) of (Dufresne & Ghattas, 2009), rewritten in terms of {\lambda E}_{old}.
+      !! Again we convert the A and B coefficients from the LMDZ format to the ORCHIDEE format.\n
+      !! There are two forms of the equation - first for the latent heat as a result of sublimination
+      !! processes and then as a result of evaporative processes:
+      !! \latexonly 
+      !!     \input{enerbilsurftemp4.tex}
+      !! \endlatexonly
+      larsub_old = chalsu0 * vbeta1(ji) * (un - vbeta5(ji)) * &
+           (peqBcoef(ji) -  qsol_sat(ji)) / (zikq - vbeta1(ji) * (un - vbeta5(ji))* peqAcoef(ji))
+      !! \latexonly 
+      !!     \input{enerbilsurftemp5.tex}
+      !! \endlatexonly
+      lareva_old = chalev0 * (un - vbeta1(ji)) * (un - vbeta5(ji)) * vbeta(ji) * &
+           (peqBcoef(ji) -  valpha(ji) * qsol_sat(ji)) / &
+           (zikq - (un - vbeta1(ji)) * (un - vbeta5(ji)) * vbeta(ji) * peqAcoef(ji)) &
+           + chalev0 * vbeta5(ji) * (peqBcoef(ji) -  qsol_sat(ji)) / (zikq - vbeta5(ji) * peqAcoef(ji))
+      
+    !! 3. Calculation of sensitivity terms
+     
+      !! We here calculate the sensitivity for the different fluxes to changes in dtheta, which is the
+      !! change in the surface static energy over the model time step (dt_sechiba).
+      
+      !! 3.1 Net radiation sensitivity
+      !! This is an explicit-implicit representation of the Stefan-Boltzmann law - the explicit terms 
+      !! are ${ps}_{old}^3$, and it is completed when multiplied by dtheta (defined above).
+      !! \latexonly 
+      !!     \input{enerbilsurftemp6.tex}
+      !! \endlatexonly
+      netrad_sns = zicp(ji) * quatre * emis(ji) * c_stefan * ((zicp(ji) * psold(ji))**3)
+      
+      !! 3.2 Sensible heat flux sensitivity
+      !! This is the temperature sensitivity term N_1^h derived in equation (66) of (Dufresne & Ghattas, 2009),
+      !! where we again assume that (P_r/P)^{kappa}=1, convert the A and B coefficients to the ORCHIDEE format,
+      !! and rewrite in terms of surface static energy, rather than temperature (see section 3.1, above).
+      !! \latexonly 
+      !!     \input{enerbilsurftemp7.tex}
+      !! \endlatexonly
+      sensfl_sns = un / (zikt -  petAcoef(ji))
+      !! 3.3 Latent heat flux sensitivity 
+      !! This is the humidity sensitivity term N_1^q derived in equation (72) of (Dufresne & Ghattas, 2009), where
+      !! the A and B coefficients are written in the ORCHIDEE format.
+      !! larsub_sns is the latent heat sensitivity for sublimination. The coefficient vbeta1 is the evaporation
+      !! coefficient. It represents the relationship between the real and potential evaporation. It is derived
+      !! in the module 'src_sechiba/diffuco_snow'.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp8.tex}
+      !! \endlatexonly
+      larsub_sns = chalsu0 * vbeta1(ji) * (un - vbeta5(ji)) * zicp(ji) * &
+           pdqsold(ji) / (zikq - vbeta1(ji) * (un - vbeta5(ji)) * peqAcoef(ji))
+
+      !! lareva_sns is the latent heat sensitivity for evaporation. vbeta1 (src_sechiba/diffuco_snow), 
+      !! vbeta (src_sechiba/diffuco_comb) and valpha (src_sechiba/diffuco_comb) are the evaporation
+      !! coefficients.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp9.tex}
+      !! \endlatexonly
+      lareva_sns = chalev0 * ((un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) * valpha(ji) + vbeta5(ji)) * &
+           & zicp(ji) * pdqsold(ji) / &
+           (zikq - ((un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) * valpha(ji) + vbeta5(ji))* peqAcoef(ji))
+
+    !! 4. Solution of the energy balance
+      
+      !! 4.1 We calculate the total flux for the 'old' timestep.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp10.tex}
+      !! \endlatexonly
+      sum_old = netrad(ji) + sensfl_old + larsub_old + lareva_old + soilflx(ji)
+
+      !! 4.2 We calculate the total sensitivity dtheta (the change in the
+      !! surface static energy over the timestep.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp11.tex}
+      !! \endlatexonly
+      sum_sns = netrad_sns + sensfl_sns + larsub_sns + lareva_sns
+      !! 4.3 Calculation of dtheta (change in surface static energy over the
+      !! timestep.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp12.tex}
+      !! \endlatexonly
+
+      dtheta = dt_sechiba * sum_old / (zicp(ji) * soilcap(ji) + dt_sechiba * sum_sns)
+
+      !! 4.4 Determination of state variables for the 'new' timestep
+      !! No we have dtheta, we can determine the surface static energy that
+      !! corresponds to the 'new' timestep.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp13.tex}
+      !! \endlatexonly
+      psnew(ji) =  psold(ji) + dtheta
+      
+      !! The new surface saturated humidity can be calculated by equation (69)
+      !! of (Dufresne & Ghattas, 2009), in which we substitute dtheta for the
+      !! change between old and new temperature using the relationship from 3.1,
+      !! above.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp14.tex}
+      !! \endlatexonly
+      qsol_sat_new(ji) = qsol_sat(ji) + zicp(ji) * pdqsold(ji) * dtheta
+      !! The new surface temperature is determined from the new surface static temperature,
+      !! again by using the relationship in section 3.1.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp15.tex}
+      !! \endlatexonly
+      temp_sol_new(ji) = psnew(ji) / cp_air
+      
+      !! 4.5 Calculation of new evaporation potential and new evaporation latent heat
+      !! flux (???)
+      !! \latexonly 
+      !!     \input{enerbilsurftemp16.tex}
+      !! \endlatexonly
+      epot_air_new(ji) = zikt * (sensfl_old - sensfl_sns * dtheta) + psnew(ji)
+      
+      !! \latexonly 
+      !!     \input{enerbilsurftemp17.tex}
+      !! \endlatexonly
+      fevap = (lareva_old - lareva_sns * dtheta) + (larsub_old - larsub_sns * dtheta)
+
+      IF ( ABS(fevap) < EPSILON(un) ) THEN
+        
+        !! \latexonly 
+        !!     \input{enerbilsurftemp18.tex}
+        !! \endlatexonly
+        qair_new(ji) = qair(ji)
+      ELSE
+        !! \latexonly 
+        !!     \input{enerbilsurftemp19.tex}
+        !! \endlatexonly     
+        qair_new(ji) = zikq * un / ( chalsu0 *  vbeta1(ji) * (un - vbeta5(ji)) + &
+           & chalev0 * ((un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) * valpha(ji) + vbeta5(ji)) ) &
+           & * fevap + qsol_sat_new(ji)
+      ENDIF
+
+    ENDDO
+
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_surftemp done '
+
+  END SUBROUTINE enerbil_surftemp
+
+
+ !! =============================================================================================================================
+ !! SUBROUTINE		 			: enerbil_pottemp
+ !!
+ !>\BRIEF		This subroutine computes the surface temperature and humidity should the surface been unstressed	
+ !!
+ !! DESCRIPTION				: 
+ !!
+ !! MAIN OUTPUT VARIABLE(S)	: 
+ !!
+ !! REFERENCE(S)		:
+ !!
+ !! FLOWCHART    : None
+ !!
+ !_ ==============================================================================================================================  
+
+  SUBROUTINE enerbil_pottemp (kjpindex, zlev, emis, epot_air, &
+     & petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, rau, u, v, q_cdrag, vbeta,&
+     & valpha, vbeta1, vbeta5, soilcap, lwdown, swnet, q_sol_pot, temp_sol_pot) 
+
+    ! interface 
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: zlev          !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: emis          !! Emissivity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air      !! Air potential energy
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef      !! PetAcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef      !! PetBcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair          !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef      !! PeqAcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef      !! PeqBcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilflx       !! Soil flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau           !! Density
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u, v          !! Wind
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag       !!
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta         !! Resistance coefficient
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: valpha        !! Resistance coefficient
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta1        !! Snow resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta5        !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilcap       !! Soil calorific capacity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown        !! Down-welling long-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet         !! Net surface short-wave flux
+    ! output fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: q_sol_pot     !! Potential surface air moisture
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: temp_sol_pot  !! Potential soil temperature
+
+
+    ! local declaration
+    INTEGER(i_std)                  :: ji
+    REAL(r_std),DIMENSION (kjpindex) :: zicp
+    REAL(r_std)                      :: fevap
+    REAL(r_std)                      :: sensfl_old, larsub_old, lareva_old, dtheta, sum_old, sum_sns
+    REAL(r_std)                      :: zikt, zikq, netrad_sns, sensfl_sns, larsub_sns, lareva_sns
+    REAL(r_std)                      :: speed
+
+!_ ==============================================================================================================================
+
+    zicp = un / cp_air
+    !
+    DO ji=1,kjpindex
+
+       dtheta = zero
+       fevap = zero
+
+       temp_sol_pot(ji) = temp_sol_pot(ji) + dtheta
+
+       q_sol_pot(ji) = q_sol_pot(ji) + fevap
+
+    ENDDO
+
+  END SUBROUTINE enerbil_pottemp
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_flux
+  !!
+  !>\BRIEF					Computes the new soil temperature, net radiation and
+  !! latent and sensible heat flux for the new time step.
+  !!
+  !! DESCRIPTION				: This routine diagnoses, based on the new soil temperature, 
+  !! the net radiation, the total evaporation, the latent heat flux, the sensible heat flux and the 
+  !! sublimination flux. It also diagnoses the potential evaporation used for the fluxes (evapot) and the potential
+  !! as defined by Penman & Monteith (Monteith, 1965) based on the correction term developed by Chris 
+  !! Milly (1992). This Penman-Monteith formulation is required for the estimation of bare soil evaporation 
+  !! when the 11 layer CWRR moisture scheme is used for the soil hydrology.
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	: qsurf, fluxsens, fluxlat, fluxsubli, vevapp, lwup, lwnet,
+  !! tsol_rad, netrad, evapot, evapot_corr
+  !!
+  !! REFERENCE(S)					:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available (22/12/11):
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+  !! - Monteith, JL, 1965. Evaporation and Environment, paper presented at Symposium of the Society
+  !! for Experimental Biology
+  !! - Monteith & Unsworth, 2008. Principles of Environmental Physics (third edition), published Elsevier
+  !! ISBN 978-0-12-505103-3
+  !! - Milly, P. C. D., 1992: Potential Evaporation and Soil Moisture in General Circulation Models. 
+  !! Journal of Climate, 5, pp. 209â226.
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART					: None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_flux (kjpindex, emis, temp_sol, rau, u, v, q_cdrag, vbeta, valpha, vbeta1, vbeta5, &
+       & qair, epot_air, psnew, qsurf, fluxsens, fluxlat, fluxsubli, vevapp, temp_sol_new, &
+       & lwdown, swnet, lwup, lwnet, pb, tsol_rad, netrad, evapot, evapot_corr,&
+       & precip_rain,snowdz,temp_air,pgflux, soilcap, temp_sol_add)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: emis          !! Emissivity (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol      !! Surface temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau           !! Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u,v           !! Wind velocity in components u and v (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag       !! Surface drag (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta         !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: valpha        !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta1        !! Snow resistance  (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta5        !! Flood resistance 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair          !! Lowest level specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air      !! Air potential energy (J)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: psnew         !! New surface static energy (J kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol_new  !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb            !! Lowest level pressure (hPa)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)      :: snowdz        !! Snow depth
+    REAL(r_std), DIMENSION (kjpindex),INTENT(in)             :: precip_rain   !! Rainfall
+    REAL(r_std), DIMENSION (kjpindex),INTENT(in)             :: temp_air      !! Air temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown        !! Downward long wave radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet         !! Net short wave radiation (W m^{-2})
+    REAL(r_std), DIMENSION (kjpindex),INTENT(in)             :: soilcap       !! Soil calorific capacity including snow and soil (J K^{-1})       
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qsurf         !! Surface specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxsens      !! Sensible heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxlat       !! Latent heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxsubli     !! Energy of sublimation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: vevapp        !! Total of evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: lwup          !! Long-wave up radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: lwnet         !! Long-wave net radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: tsol_rad      !! Radiative surface temperature (W m^{-2})
+    REAL(r_std), DIMENSION (kjpindex),INTENT(out)            :: temp_sol_add  !! Additional energy to melt snow for snow ablation case (K)
+
+    
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: netrad        !! Net radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: evapot        !! Soil Potential Evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: evapot_corr   !! Soil Potential Evaporation Correction 
+                                                                              !! (?? mm day^{-1})
+    REAL(r_std), DIMENSION (kjpindex),INTENT(inout)          :: pgflux        !! Net energy into snowpack(W/m^2)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                               :: ji
+    REAL(r_std),DIMENSION (kjpindex)        		         :: grad_qsat
+    REAL(r_std)                               		         :: correction
+    REAL(r_std)                                			 :: speed              !! Speed (m s^{-1}), 
+    REAL(r_std)                                			 :: qc                 !! Surface drag coefficient (??)
+    LOGICAL,DIMENSION (kjpindex)            		         :: warning_correction
+    REAL(r_std), DIMENSION (kjpindex)                            :: zgflux
+    REAL(r_std), DIMENSION (kjpindex)                            :: qsol_sat_tmp
+    REAL(r_std), DIMENSION (kjpindex)                            :: zerocelcius
+    REAL(r_std), DIMENSION (kjpindex)                            :: PHPSNOW
+    REAL(r_std), DIMENSION (kjpindex)                            :: lwup_tmp
+    REAL(r_std), DIMENSION (kjpindex)                            :: netrad_tmp
+    REAL(r_std), DIMENSION (kjpindex)                            :: fluxsens_tmp
+    REAL(r_std), DIMENSION (kjpindex)                            :: fluxlat_tmp
+
+!_ ================================================================================================================================
+    
+    zerocelcius(:) = tp_00
+    CALL qsatcalc (kjpindex, zerocelcius, pb, qsol_sat_tmp)
+
+    DO ji=1,kjpindex
+       !! 1. Determination of 'housekeeping' variables
+      
+      !! The horizontal wind speed is calculated from the velocities along each axis using Pythagorus' theorem. 
+      !! \latexonly 
+      !!     \input{enerbilflux1.tex}
+      !! \endlatexonly
+      speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+      
+      !! From definition, the surface drag coefficient is defined:
+      !! \latexonly 
+      !!     \input{enerbilflux2.tex}
+      !! \endlatexonly
+      qc = speed * q_cdrag(ji)
+    
+    !! 2. Calculation of the net upward flux of longwave radiation
+      
+      !! We first of all calculate the radiation as a result of the Stefan-Boltzmann equation,
+      !! which is the sum of the calculated values at the surface temperature  at the 'old' 
+      !! temperature and the value that corresponds to the difference between the old temperature
+      !! and the temperature at the 'new' timestep.
+      !! \latexonly 
+      !!     \input{enerbilflux3.tex}
+      !! \endlatexonly
+      lwup(ji) = emis(ji) * c_stefan * temp_sol(ji)**4 + &
+           &     quatre * emis(ji) * c_stefan * temp_sol(ji)**3 * &
+           &     (temp_sol_new(ji) - temp_sol(ji))      
+      
+      !! We then add to this value that from the reflected longwave radiation:
+      !! \latexonly 
+      !!     \input{enerbilflux4.tex}
+      !! \endlatexonly
+      lwup(ji) = lwup(ji)  +  (un - emis(ji)) * lwdown(ji)
+      
+      !! The radiative surface temperature is calculated by inverting the Stefan-Boltzmann relation:
+      !! \latexonly 
+      !!     \input{enerbilflux5.tex}
+      !! \endlatexonly
+      !! The implicit solution computes an emitted long-wave flux which is a limited Taylor expansion
+      !! of the future surface temperature around the current values. Thus the long-wave flux does not 
+      !! correspond to the new surface temperature but some intermediate value. So we need to deduce the
+      !! radiative surface temperature to which this flux corresponds.
+      !!
+      tsol_rad(ji) = (lwup(ji)/ (emis(ji) * c_stefan)) **(1./quatre)
+     
+      !! qsurf (the surface specific humidity) is a simple diagnostic which will be used by the 
+      !! GCM to compute the dependence of of the surface layer stability on moisture.
+      !! \latexonly 
+      !!     \input{enerbilflux6.tex}
+      !! \endlatexonly
+      qsurf(ji) = (vbeta1(ji) * (un - vbeta5(ji)) + vbeta5(ji)) * qsol_sat_new(ji) + &
+           & (un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) * valpha(ji) * qsol_sat_new(ji)
+      
+      !! \latexonly 
+      !!     \input{enerbilflux7.tex}
+      !! \endlatexonly
+      qsurf(ji) = MAX(qsurf(ji), qair(ji))
+      
+      !! Net downward radiation is the sum of the down-welling less the up-welling long wave flux, plus
+      !! the short wave radiation.
+      !! \latexonly 
+      !!     \emissivity absorbed lw radiationinput{enerbilflux8.tex}
+      !! \endlatexonly
+      netrad(ji) = lwdown(ji) + swnet(ji) - lwup(ji) 
+      
+      !! 'vevapp' is the sum of the total evaporative processes (snow plus non-snow processes).
+      !! \latexonly 
+      !!     \input{enerbilflux9.tex}
+      !! \endlatexonly
+      vevapp(ji) = dt_sechiba * rau(ji) * qc * (vbeta1(ji) * (un - vbeta5(ji)) + vbeta5(ji)) * &
+           & (qsol_sat_new(ji) - qair(ji)) + &
+           &  dt_sechiba * rau(ji) * qc * (un - vbeta1(ji))*(un-vbeta5(ji)) * vbeta(ji) * &
+           & (valpha(ji) * qsol_sat_new(ji) - qair(ji))
+      
+      !! The total latent heat flux is the sum of the snow plus non-snow processes.
+      !! \latexonly 
+      !!     \input{enerbilflux10.tex}
+      !! \endlatexonly
+      fluxlat(ji) = chalsu0 * rau(ji) * qc * vbeta1(ji) * (un - vbeta5(ji)) * &
+           & (qsol_sat_new(ji) - qair(ji)) + &
+           &  chalev0 * rau(ji) * qc * vbeta5(ji) *&
+           & (qsol_sat_new(ji) - qair(ji)) + &
+           &  chalev0 * rau(ji) * qc * (un - vbeta1(ji)) * (un - vbeta5(ji)) * vbeta(ji) * &
+           & (valpha(ji) * qsol_sat_new(ji) - qair(ji))
+      
+      !! The sublimination flux concerns is calculated using vbeta1, the snow resistance.
+      !! \latexonly 
+      !!     \input{enerbilflux11.tex}
+      !! \endlatexonly
+      fluxsubli(ji) = chalsu0 * rau(ji) * qc * vbeta1(ji) * (un - vbeta5(ji)) * &
+           & (qsol_sat_new(ji) - qair(ji)) 
+      
+      !! The sensible heat flux is a factor of the difference between the new surface static energy
+      !! and the potential energy of air.
+      !! \latexonly 
+      !!     \input{enerbilflux12.tex}
+      !! \endlatexonly
+      fluxsens(ji) =  rau(ji) * qc * (psnew(ji) - epot_air(ji))
+      
+      !! This is the net longwave downwards radiation.
+      !! \latexonly 
+      !!     \input{enerbilflux13.tex}
+      !! \endlatexonly
+      lwnet(ji) = lwdown(ji) - lwup(ji)
+      
+      !! Diagnoses the potential evaporation used for the fluxes (evapot)
+      !! \latexonly 
+      !!     \input{enerbilflux14.tex}
+      !! \endlatexonly  
+      evapot(ji) =  MAX(zero, dt_sechiba * rau(ji) * qc * (qsol_sat_new(ji) - qair(ji)))
+     
+      !! From definition we can say:
+      !! \latexonly 
+      !!     \input{enerbilflux15.tex}
+      !! \endlatexonly 
+      tair(ji)  =  epot_air(ji) / cp_air
+
+
+      !! To calculate net energy flux into the snowpack
+      IF (ok_explicitsnow) THEN
+          PHPSNOW(ji) = precip_rain(ji)*(4.218E+3)*(MAX(tp_00,temp_air(ji))-tp_00)/dt_sechiba ! (w/m2)
+          pgflux(ji)  = netrad(ji) - fluxsens(ji) - fluxlat(ji) + PHPSNOW(ji)
+      ENDIF
+
+
+      !! To get the extra energy used to melt the snowpack
+      IF (ok_explicitsnow .AND. temp_sol_new (ji) > tp_00 .AND. &
+           SUM(snowdz(ji,:)) .GT. zero .AND. soilcap(ji) .GT. zero) THEN
+
+         lwup_tmp(ji) = emis(ji) * c_stefan * temp_sol(ji)**4 + &
+              quatre * emis(ji) * c_stefan * temp_sol(ji)**3 * (tp_00 - temp_sol(ji))
+              
+         lwup_tmp(ji) = lwup_tmp(ji)  +  (un - emis(ji)) * lwdown(ji)
+         netrad_tmp(ji) = lwdown(ji) + swnet(ji) - lwup_tmp(ji)
+         fluxsens_tmp(ji) =  rau(ji) * qc * cp_air * (tp_00 - epot_air(ji)/cp_air)
+         fluxlat_tmp(ji) = chalsu0 * rau(ji) * qc * vbeta1(ji) * (un-vbeta5(ji)) * &
+                        & (qsol_sat_tmp(ji) - qair(ji)) + &
+                        &  chalev0 * rau(ji) * qc * vbeta5(ji) *&
+                        & (qsol_sat_tmp(ji) - qair(ji)) + &
+                        &  chalev0 * rau(ji) * qc * (un - vbeta1(ji)) * (un-vbeta5(ji))* vbeta(ji) * &
+                        & (valpha(ji) * qsol_sat_tmp(ji) - qair(ji))
+
+         zgflux(ji)  = netrad_tmp(ji) - fluxsens_tmp(ji) - fluxlat_tmp(ji)+PHPSNOW(ji)
+
+         temp_sol_add(ji) = -(pgflux(ji) - zgflux(ji))*dt_sechiba/soilcap(ji)
+
+         pgflux(ji) = zgflux(ji)
+
+      ELSE
+
+         temp_sol_add(ji) = zero
+
+      ENDIF
+
+     ENDDO 
+
+  !! 3. Define qsat_air with the subroutine src_parameter:
+
+    CALL qsatcalc(kjpindex, tair, pb, qsat_air)
+
+    CALL dev_qsatcalc(kjpindex, tair, pb, grad_qsat)
+ 
+  ! grad_qsat(:)= (qsol_sat_new(:)- qsat_air(:)) / ((psnew(:) - epot_air(:)) / cp_air) ! * dt_sechiba
+    !- Penser a sortir evapot en meme temps qu'evapot_corr tdo.
+
+    warning_correction(:)=.FALSE.
+    DO ji=1,kjpindex
+      
+      !! \latexonly 
+      !!     \input{enerbilflux16.tex}
+      !! \endlatexonly 
+      speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+      
+      !! \latexonly 
+      !!     \input{enerbilflux17.tex}
+      !! \endlatexonly 
+      qc = speed * q_cdrag(ji)
+       
+      !! Derive the potential as defined by Penman & Monteith (Monteith, 1965) based on the correction 
+      !! term developed by Chris Milly (1992).
+       IF ((evapot(ji) .GT. zero) .AND. ((psnew(ji) - epot_air(ji)) .NE. zero )) THEN
+          !
+          !! \latexonly 
+          !!     \input{enerbilflux18.tex}
+          !! \endlatexonly 
+          correction =  (quatre * emis(ji) * c_stefan * tair(ji)**3 + rau(ji) * qc * cp_air + &
+               &                  chalev0 * rau(ji) * qc * grad_qsat(ji) * vevapp(ji) / evapot(ji) )
+          
+          !! \latexonly 
+          !!     \input{enerbilflux19.tex}
+          !! \endlatexonly 
+          IF (ABS(correction) .GT. min_sechiba) THEN
+             correction = chalev0 * rau(ji) * qc * grad_qsat(ji) * (un - vevapp(ji)/evapot(ji)) / correction
+          ELSE
+             warning_correction(ji)=.TRUE.
+          ENDIF
+       ELSE
+          correction = zero
+       ENDIF
+       correction = MAX (zero, correction)
+      
+      !! \latexonly 
+      !!     \input{enerbilflux20.tex}
+      !! \endlatexonly 
+       evapot_corr(ji) = evapot(ji) / (un + correction)
+       
+    ENDDO
+    IF ( ANY(warning_correction) ) THEN
+       DO ji=1,kjpindex
+          IF ( warning_correction(ji) ) THEN
+             WRITE(numout,*) ji,"Denominateur de la correction de milly nul! Aucune correction appliquee"
+          ENDIF
+       ENDDO
+    ENDIF
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_flux done '
+
+  END SUBROUTINE enerbil_flux
+
+
+  !!  ===========================================================================================================================
+  !! SUBROUTINE		 			: enerbil_evapveg
+  !!
+  !>\BRIEF					Splits total evaporation loss into individual process
+  !! components and calculates the assimilation.
+  !!
+  !! DESCRIPTION				: Based on the estimation of the fluxes in enerbil_flux, 
+  !! this routine splits the total evaporation into transpiration interception loss from vegetation, 
+  !! bare soil evaporation and snow sublimation. It then calculates the assimilation.
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	                : vevapsno, vevapnu, transpir, vevapwet
+  !!
+  !! REFERENCE(S)					:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available (22/12/11): 
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663. 
+  !!
+  !! FLOWCHART   : None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_evapveg (kjpindex, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, &
+     & rau, u, v, q_cdrag, qair, humrel, vevapsno, vevapnu , vevapflo, vevapwet, &
+     & transpir, transpot, evapot, &
+     & snowdz,snowrho,evapot_corr)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex          !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: vbeta1            !! Snow resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: vbeta4            !! Bare soil resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: vbeta5            !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: rau               !! Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: u, v              !! Wind velocity in directions u and v (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: q_cdrag           !! Surface drag (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: qair              !! Lowest level specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: evapot            !! Soil Potential Evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex, nvm), INTENT (in)  :: humrel            !! Soil moisture stress (within range 0 to 1)
+!!$ DS 15022011 humrel was used in a previous version of Orchidee, developped by Nathalie. Need to be discussed if it should be introduce again             
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbeta2            !! Interception resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbeta3            !! Vegetation resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbeta3pot         !! Vegetation resistance for potential transpiration
+    REAL(r_std), DIMENSION(kjpindex,nsnow),INTENT(in)   :: snowrho           !! Snow density
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: vevapsno          !! Snow evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: vevapnu           !! Bare soil evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: vevapflo          !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: transpir          !! Transpiration (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: transpot          !! Potential Transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: vevapwet          !! Interception (mm day^{-1})
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(kjpindex,nsnow),INTENT(inout):: snowdz            !! Snow depth
+    REAL(r_std), DIMENSION(kjpindex),INTENT(inout)      :: evapot_corr       !! Correction term in evapotranspiration
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jv
+    REAL(r_std), DIMENSION(kjpindex)                    :: xx
+    REAL(r_std), DIMENSION(kjpindex)                    :: vbeta2sum, vbeta3sum
+    REAL(r_std)                                    	:: speed	     !! Speed (m s^{-1})
+    REAL(r_std), DIMENSION(kjpindex)                    :: ZSNOWEVAPS,ZEVAPCOR,ZSNOWDZ
+
+!_ ==============================================================================================================================
+    ! initialisation: utile pour calculer l'evaporation des floodplains dans lesquelles il y a de la vegetation
+    vbeta2sum(:) = 0.
+    vbeta3sum(:) = 0.
+    DO jv = 1, nvm
+      vbeta2sum(:) = vbeta2sum(:) + vbeta2(:,jv)
+      vbeta3sum(:) = vbeta3sum(:) + vbeta3(:,jv)
+    ENDDO 
+    
+    !! 1. Compute vevapsno (evaporation from snow) and vevapnu (bare soil evaporation)
+        
+    DO ji=1,kjpindex 
+
+      !! \latexonly 
+      !!     \input{enerbilevapveg1.tex}
+      !! \endlatexonly
+      speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+
+      
+      !! 1.1 Snow sublimation
+      !! \latexonly 
+      !!     \input{enerbilevapveg2.tex}
+      !! \endlatexonly
+      vevapsno(ji) = (un - vbeta5(ji)) * vbeta1(ji) * dt_sechiba * rau(ji) * speed * q_cdrag(ji) * (qsol_sat_new(ji) - qair(ji))
+
+
+      ! For the case of ok_explicitsnow activated, remove mass from uppermost snow layer in 
+      ! response to sublimation. Do not take into account evaporation. The evaporation on the
+      ! snow surface could be possible in this case since the new snow model allows liquid water to be existed. 
+      IF ( ok_explicitsnow ) THEN
+         ! Sublimation of snow ice:
+         ! Reduce snow layer thickness and total snow depth if sublimation. 
+         ! Add to correction term if potential sublimation exceeds available snow cover.
+         
+         ZSNOWEVAPS(ji)  = vevapsno(ji)/(chalsu0*snowrho(ji,1))
+         ZSNOWDZ(ji)     = snowdz(ji,1) - ZSNOWEVAPS(ji)
+
+         ZEVAPCOR(ji)    = MAX(0.0,-ZSNOWDZ(ji))*snowrho(ji,1)/dt_sechiba
+
+         ! Update evaporation correction term:
+          evapot_corr(ji) = evapot_corr(ji) + ZEVAPCOR(ji)
+      ENDIF
+
+      !! 1.2 Bare soil evaporation
+      !! \latexonly 
+      !!     \input{enerbilevapveg3.tex}
+      !! \endlatexonly
+      vevapnu(ji) = (un - vbeta1(ji)) * (un-vbeta5(ji)) * vbeta4(ji) * dt_sechiba * rau(ji) * speed * q_cdrag(ji) &
+         & * (qsol_sat_new(ji) - qair(ji))
+      !
+      ! 1.3 floodplains evaporation - transpiration et interception prioritaires dans les floodplains
+      !
+      vevapflo(ji) = vbeta5(ji) * (1 - vbeta2sum(ji) - vbeta3sum(ji)) &
+           & * dt_sechiba * rau(ji) * speed * q_cdrag(ji) * (qsol_sat_new(ji) - qair(ji))
+
+    END DO
+
+    !! 2. Compute transpir (transpiration) and vevapwet (interception)
+  
+    !! Preliminaries
+    DO ji = 1, kjpindex
+       
+       !! \latexonly 
+       !!     \input{enerbilevapveg4.tex}
+       !! \endlatexonly
+       speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+       
+       !! \latexonly 
+       !!     \input{enerbilevapveg5.tex}
+       !! \endlatexonly
+       xx(ji) = dt_sechiba * (un-vbeta1(ji)) * (qsol_sat_new(ji)-qair(ji)) * rau(ji) * speed * q_cdrag(ji)
+     
+    ENDDO
+    
+    DO jv=1,nvm 
+      DO ji=1,kjpindex 
+        
+        !! 2.1 Calculate interception loss
+        !! \latexonly 
+        !!     \input{enerbilevapveg6.tex}
+        !! \endlatexonly
+        vevapwet(ji,jv) = xx(ji) * vbeta2(ji,jv)
+        ! 
+        !! 2.2 Calculate transpiration
+        !! \latexonly 
+        !!     \input{enerbilevapveg7.tex}
+        !! \endlatexonly
+        transpir (ji,jv) = xx(ji) * vbeta3(ji,jv)
+
+        transpot(ji,jv) = xx(ji) * vbeta3pot(ji,jv)
+
+      END DO
+    END DO
+
+    
+
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_evapveg done '
+
+  END SUBROUTINE enerbil_evapveg
+
+ 
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_fusion
+  !!
+  !>\BRIEF					Computes new soil temperature due to
+  !! ice and snow melt. 
+  !!
+  !! DESCRIPTION				: This routine computes new soil temperature due to
+  !! ice and snow melt. It is the second part of main routine for enerbil module, and is called every
+  !! time step. 
+  !!
+  !! MAIN OUTPUT VARIABLE(S)			: temp_sol_new, fusion
+  !!
+  !! REFERENCE(S)				:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ. Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau. PhD Thesis, available (22/12/11):
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART  : None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_fusion (kjpindex, tot_melt, soilcap, snowdz, &
+                             temp_sol_new, fusion)
+
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex       !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: tot_melt       !! Total melt (??)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilcap        !! Soil heat capacity (J K^{-1])
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in)        :: snowdz         !! Snow layer thickness (m)
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fusion         !! Fusion (??)
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: temp_sol_new   !! New soil temperature (K)
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                	     :: ji	       !! (-)
+
+  !_ ==============================================================================================================================
+    
+    !! Initialisation
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_fusion start ', MINVAL(soilcap), MINLOC(soilcap),&
+         & MAXVAL(soilcap), MAXLOC(soilcap)
+    
+    !! 1. Calculate new soil temperature due to ice and snow melt
+   
+    IF  (.NOT. ok_explicitsnow) THEN
+       !! Surface temperature is reduced if there is snow melt
+       
+       DO ji=1,kjpindex 
+          !! \latexonly 
+          !!     \input{enerbilfusion1.tex}
+          !! \endlatexonly
+          fusion(ji) = tot_melt(ji) * chalfu0 / dt_sechiba
+          
+          !! \latexonly 
+          !!     \input{enerbilfusion2.tex}
+          !! \endlatexonly
+          temp_sol_new(ji) = temp_sol_new(ji) - ((tot_melt(ji) * chalfu0) / soilcap(ji))
+       END DO
+    ENDIF
+           
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_fusion done '
+
+  END SUBROUTINE enerbil_fusion
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_t2mdiag
+  !!
+  !> BRIEF					This routine diagnoses the air temperature at 2
+  !! metres above ground.
+  !!
+  !! DESCRIPTION				: The 2 metre above ground air temperature is currently
+  !! set to be the same as the general air temperaturem, as the surface model currently simulates the 
+  !! above ground atmosphere as a uniform box (and the lowest layer of the LMDZ atmospheric model).
+  !!
+  !! MAIN OUTPUT VARIABLE(S)			: t2mdiag
+  !!
+  !! REFERENCE(S)				:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available from:
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available from:
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers\n
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART  : None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_t2mdiag (kjpindex, temp_air, t2mdiag)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         		:: kjpindex       !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      		:: temp_air       !! Air temperature (K)
+    
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)    		:: t2mdiag        !! 2-metre temperature (K)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+  !_ ==============================================================================================================================
+
+    !! The 2 metre air temperature is assumed to be the same of the value of temp_air - the atmospheric air
+    !! temperature, which also taken as the temperature at the lowest level of the LMDZ. 't2mdiag' is just
+    !! a value used for diagnostic purposes, admd it is no applied amywhere else.
+    !! \latexonly 
+ 	!!     \input{enerbilt2mdiag1.tex}
+    !! \endlatexonly
+    t2mdiag(:) = temp_air(:)
+
+    IF (printlev>=3) WRITE (numout,*) ' enerbil_t2mdiag done '
+
+  END SUBROUTINE enerbil_t2mdiag
+
+
+
+END MODULE enerbil
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/explicitsnow.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/explicitsnow.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/explicitsnow.f90	(revision 5166)
@@ -0,0 +1,1556 @@
+!!
+!! This module computes hydrologic snow processes on continental points.
+!!
+MODULE explicitsnow
+  USE ioipsl_para
+  USE constantes_soil
+  USE constantes
+  USE pft_parameters 
+  USE qsat_moisture 
+  USE sechiba_io
+
+  IMPLICIT NONE
+
+  ! Public routines :
+  PRIVATE
+  PUBLIC :: explicitsnow_main, explicitsnow_initialize, explicitsnow_finalize
+
+CONTAINS
+
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_initialize
+!!
+!>\BRIEF        Read variables for explictsnow module from restart file
+!!                
+!! DESCRIPTION  : 
+!!
+!! \n
+!_
+!================================================================================================================================
+  SUBROUTINE explicitsnow_initialize( kjit,     kjpindex, rest_id,    snowrho,   &
+                                      snowtemp, snowdz,   snowheat,   snowgrain)
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                           :: kjit           !! Time step number 
+    INTEGER(i_std), INTENT(in)                           :: kjpindex       !! Domain size
+    INTEGER(i_std),INTENT (in)                           :: rest_id        !! Restart file identifier
+    
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowrho        !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowtemp       !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowdz         !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowheat       !! Snow heat content
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowgrain      !! Snow grainsize
+    
+    
+    !! 1. Read from restart file
+    CALL restget_p (rest_id, 'snowrho', nbp_glo, nsnow, 1, kjit,.TRUE.,snowrho, "gather", nbp_glo, index_g)
+    CALL setvar_p (snowrho, val_exp, 'Snow Density profile', xrhosmin)
+    
+    CALL restget_p (rest_id, 'snowtemp', nbp_glo,  nsnow, 1, kjit,.TRUE.,snowtemp, "gather", nbp_glo,  index_g)
+    CALL setvar_p (snowtemp, val_exp, 'Snow Temperature profile', tp_00)
+    
+    CALL restget_p (rest_id, 'snowdz', nbp_glo,  nsnow, 1, kjit,.TRUE.,snowdz, "gather", nbp_glo,  index_g)
+    CALL setvar_p (snowdz, val_exp, 'Snow depth profile', 0.0)
+    
+    CALL restget_p (rest_id, 'snowheat', nbp_glo,  nsnow, 1, kjit,.TRUE.,snowheat, "gather", nbp_glo,  index_g)
+    CALL setvar_p (snowheat, val_exp, 'Snow Heat profile', 0.0)
+    
+    CALL restget_p (rest_id, 'snowgrain', nbp_glo,  nsnow, 1, kjit,.TRUE.,snowgrain, "gather", nbp_glo,  index_g)
+    CALL setvar_p (snowgrain, val_exp, 'Snow grain profile', 0.0)
+    
+  END SUBROUTINE explicitsnow_initialize
+  
+
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_main
+!!
+!>\BRIEF        
+!!                
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  SUBROUTINE explicitsnow_main(kjpindex,    precip_rain,  precip_snow,   temp_air,    pb,       & ! in
+                               u,           v,            temp_sol_new,  soilcap,     pgflux,   & ! in
+                               frac_nobio,  totfrac_nobio,gtemp,                                & ! in
+                               lambda_snow, cgrnd_snow,   dgrnd_snow,                           & ! in  
+                               vevapsno,    snow_age,     snow_nobio_age,snow_nobio,  snowrho,  & ! inout
+                               snowgrain,   snowdz,       snowtemp,      snowheat,    snow,     & ! inout
+                               temp_sol_add,          					        & ! inout
+                               snowliq,     subsnownobio, grndflux,      snowmelt,    tot_melt, & ! output
+                               subsinksoil )                                                      ! output
+             
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                               :: kjpindex         !! Domain size
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_rain      !! Rainfall
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_snow      !! Snowfall
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: temp_air         !! Air temperature
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: pb               !! Surface pressure
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: u,v              !! Horizontal wind speed
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: temp_sol_new     !! Surface temperature
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: soilcap          !! Soil capacity
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: pgflux           !! Net energy into snowpack
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(in)     :: frac_nobio       !! Fraction of continental ice, lakes, ...
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: totfrac_nobio    !! Total fraction of continental ice+lakes+ ...
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: gtemp            !! First soil layer temperature 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: lambda_snow      !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (in)     :: cgrnd_snow       !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (in)     :: dgrnd_snow       !! Integration coefficient for snow numerical scheme
+
+
+    !! 0.2 Output fields
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)     :: snowliq          !! Snow liquid content (m)
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(out)    :: subsnownobio     !! Sublimation of snow on other surface types (ice, lakes, ...)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: grndflux         !! Net flux into soil [W/m2]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: snowmelt         !! Snow melt
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: tot_melt         !! Total melt from ice and snow
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: subsinksoil      !! Excess of sublimation as a sink for the soil
+
+    !! 0.3 Modified fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapsno         !! Snow evaporation  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: snow_age         !! Snow age
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout)  :: snow_nobio       !! Ice water balance
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout)  :: snow_nobio_age   !! Snow age on ice, lakes, ...
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowrho          !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowgrain        !! Snow grainsize
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowdz           !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowtemp         !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowheat         !! Snow heat content
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: snow             !! Snow mass [Kg/m^2]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: temp_sol_add     !! Additional energy to melt snow for snow ablation case (K)
+
+ 
+    !! 0.4 Local declaration
+    INTEGER(i_std)                                           :: ji, iv, jj,m,jv
+    REAL(r_std),DIMENSION  (kjpindex)                        :: snow_depth_tmp
+    REAL(r_std),DIMENSION  (kjpindex)                        :: snowmelt_from_maxmass
+    REAL(r_std)                                              :: snowdzm1
+    REAL(r_std), DIMENSION (kjpindex)                        :: thrufal          !! Water leaving snow pack [kg/m2/s]
+    REAL(r_std), DIMENSION (kjpindex)                        :: d_age            !! Snow age change
+    REAL(r_std), DIMENSION (kjpindex)                        :: xx               !! Temporary
+    REAL(r_std), DIMENSION (kjpindex)                        :: snowmelt_tmp,snowmelt_ice,icemelt,temp_sol_new_old
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                  :: snowdz_old
+    REAL(r_std), DIMENSION (kjpindex)                        :: ZLIQHEATXS
+    REAL(r_std), DIMENSION (kjpindex)                        :: ZSNOWEVAPS, ZSNOWDZ,subsnowveg
+    REAL(r_std)                                              :: maxmass_snowdepth 
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                  :: WSNOWDZ,SMASS
+    REAL(r_std), DIMENSION (kjpindex)                        :: SMASSC,snowacc
+    INTEGER(i_std) :: locjj
+    REAL(r_std)                                              :: grndflux_tmp
+    REAL(r_std), DIMENSION (nsnow)                           :: snowtemp_tmp
+    REAL(r_std)                                              :: s2flux_tmp,fromsoilflux
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                  :: pcapa_snow 
+    REAL(r_std), DIMENSION (kjpindex)                        :: psnowhmass
+    REAL(r_std), PARAMETER                                   :: XP00 = 1.E5
+
+
+    !! 1. Initialization
+    
+    temp_sol_new_old = temp_sol_new
+    DO ji=1,kjpindex
+       snowmelt_ice(ji) = zero
+       icemelt(ji) = zero
+       tot_melt(ji) = zero
+       snowmelt(ji) = zero
+    ENDDO
+    
+    !! 2. on Vegetation
+    ! 2.1 Snow fall
+    CALL explicitsnow_fall(kjpindex,precip_snow,temp_air,u,v,totfrac_nobio,snowrho,snowdz,&
+         & snowheat,snowgrain,snowtemp,psnowhmass)
+    
+    ! 2.2 calculate the new snow discretization
+    snow_depth_tmp(:) = SUM(snowdz(:,:),2)
+    
+    snowdz_old = snowdz
+    
+    CALL explicitsnow_levels(kjpindex,snow_depth_tmp, snowdz)
+    
+    ! 2.3 Snow heat redistribution
+    CALL explicitsnow_transf(kjpindex,snowdz_old,snowdz,snowrho,snowheat,snowgrain)
+    
+    ! 2.4 Diagonize water portion of the snow from snow heat content:
+    DO ji=1, kjpindex
+       IF (SUM(snowdz(ji,:)) .GT. 0.0) THEN
+          snowtemp(ji,:) = snow3ltemp_1d(snowheat(ji,:),snowrho(ji,:),snowdz(ji,:))
+          snowliq(ji,:) = snow3lliq_1d(snowheat(ji,:),snowrho(ji,:),snowdz(ji,:),snowtemp(ji,:))
+       ELSE
+          snowliq(ji,:) = zero
+          snowtemp(ji,:) = tp_00
+       ENDIF
+    END DO
+    
+    ! 2.5 snow compaction
+    CALL explicitsnow_compactn(kjpindex,snowtemp,snowrho,snowdz)
+    ! Update snow heat 
+    DO ji = 1, kjpindex
+       snowheat(ji,:) = snow3lheat_1d(snowliq(ji,:),snowrho(ji,:),snowdz(ji,:),snowtemp(ji,:))
+    ENDDO
+
+    !2.6 Calculate the snow temperature profile based on heat diffusion
+    CALL explicitsnow_profile (kjpindex,cgrnd_snow,dgrnd_snow,lambda_snow,temp_sol_new, snowtemp,snowdz,temp_sol_add)
+    
+    !2.7 Test whether snow is existed on the ground or not
+    grndflux(:)=0.0
+    CALL explicitsnow_gone(kjpindex,pgflux,&
+         & snowheat,snowtemp,snowdz,snowrho,snowliq,grndflux,snowmelt)
+    
+    !2.8 Calculate snow melt/refreezing processes
+    CALL explicitsnow_melt_refrz(kjpindex,precip_rain,pgflux,soilcap,&
+         & snowtemp,snowdz,snowrho,snowliq,snowmelt,grndflux,temp_air)
+    
+    
+    ! 2.9 Snow sublimation changing snow thickness
+    snow(:) = 0.0
+    DO ji=1,kjpindex !domain size
+       snow(ji) = SUM(snowrho(ji,:) * snowdz(ji,:))
+    ENDDO
+    
+    subsnownobio(:,:) = zero
+    subsinksoil(:) = zero
+    
+    DO ji=1, kjpindex ! domain size
+       IF ( snow(ji) > snowcri ) THEN
+          subsnownobio(ji,iice) = frac_nobio(ji,iice)*vevapsno(ji)
+          subsnowveg(ji) = vevapsno(ji) - subsnownobio(ji,iice)
+       ELSE
+          IF ( frac_nobio(ji,iice) .GT. min_sechiba) THEN
+             subsnownobio(ji,iice) = vevapsno(ji)
+             subsnowveg(ji) = zero
+          ELSE
+             subsnownobio(ji,iice) = zero
+             subsnowveg(ji) = vevapsno(ji)
+          ENDIF
+       ENDIF
+       
+       !! 2.8.1 Check that sublimation on the vegetated fraction is possible.
+       IF (subsnowveg(ji) .GT. snow(ji)) THEN
+          IF( (un - totfrac_nobio(ji)).GT.min_sechiba) THEN
+             subsinksoil (ji) = (subsnowveg(ji) - snow(ji))/ (un - totfrac_nobio(ji))
+          END IF
+          ! Sublimation is thus limited to what is available
+          subsnowveg(ji) = snow(ji)
+          snow(ji) = zero
+          snowdz(ji,:)  =  0
+          snowliq(ji,:)   =  0
+          snowtemp(ji,:) = tp_00 
+          vevapsno(ji) = subsnowveg(ji) + subsnownobio(ji,iice)
+       ELSE
+          ! Calculating the snow accumulation  
+          WSNOWDZ(ji,:)= snowdz(ji,:)*snowrho(ji,:)
+          SMASSC (ji)= 0.0
+          DO jj=1,nsnow
+             SMASS(ji,jj)   = SMASSC(ji) + WSNOWDZ(ji,jj)
+             SMASSC(ji)      = SMASSC(ji) + WSNOWDZ(ji,jj)
+          ENDDO
+          ! Finding the layer
+          locjj=0
+          DO jj=1,nsnow-1
+             IF ((SMASS(ji,jj) .LE. subsnowveg(ji)) .AND. (SMASS(ji,jj+1) .GE. subsnowveg(ji)) ) THEN
+                locjj=jj+1
+             ENDIF
+          ENDDO
+          
+          ! Calculating the removal of snow depth
+          IF (locjj .EQ. 1) THEN
+             ZSNOWEVAPS(ji)  = subsnowveg(ji)/snowrho(ji,1)
+             ZSNOWDZ(ji)     = snowdz(ji,1) - ZSNOWEVAPS(ji)
+             snowdz(ji,1)     = MAX(0.0, ZSNOWDZ(ji))
+          ELSE IF (locjj .GT. 1) THEN
+             snowacc(ji)=0
+             DO jj=1,locjj-1
+                snowacc(ji)=snowacc(ji)+snowdz(ji,jj)*snowrho(ji,jj)
+                snowdz(ji,jj)=0
+             ENDDO
+             ZSNOWEVAPS(ji)  = (subsnowveg(ji)-snowacc(ji))/snowrho(ji,locjj)
+             ZSNOWDZ(ji)     = snowdz(ji,locjj) - ZSNOWEVAPS(ji)
+             snowdz(ji,locjj)     = MAX(0.0, ZSNOWDZ(ji))
+          ELSE
+             ZSNOWEVAPS(ji)  = subsnowveg(ji)/snowrho(ji,1)
+             ZSNOWDZ(ji)     = snowdz(ji,1) - ZSNOWEVAPS(ji)
+             snowdz(ji,1)     = MAX(0.0, ZSNOWDZ(ji))
+          ENDIF
+          
+       ENDIF
+    ENDDO
+    
+    !2.10 Calculate snow grain size using the updated thermal gradient
+    
+    CALL explicitsnow_grain(kjpindex,snowliq,snowdz,gtemp,snowtemp,pb,snowgrain)
+    
+    !2.11  Update snow heat
+    ! Update the heat content (variable stored each time step)
+    ! using current snow temperature and liquid water content:
+    !
+    ! First, make check to make sure heat content not too large
+    ! (this can result due to signifigant heating of thin snowpacks):
+    ! add any excess heat to ground flux:
+    !
+    DO ji=1,kjpindex
+       DO jj=1,nsnow
+          ZLIQHEATXS(ji)  = MAX(0.0, snowliq(ji,jj)*ph2o - 0.10*snowdz(ji,jj)*snowrho(ji,jj))*chalfu0/dt_sechiba
+          snowliq(ji,jj) = snowliq(ji,jj) - ZLIQHEATXS(ji)*dt_sechiba/(ph2o*chalfu0)
+          snowliq(ji,jj) = MAX(0.0, snowliq(ji,jj))
+          grndflux(ji)   = grndflux(ji)   + ZLIQHEATXS(ji)
+       ENDDO
+    ENDDO
+    
+    snow(:) = 0.0
+    DO ji=1,kjpindex !domain size
+       snow(ji) = SUM(snowrho(ji,:) * snowdz(ji,:))
+    ENDDO
+        
+    DO ji = 1, kjpindex
+       snowheat(ji,:) = snow3lheat_1d(snowliq(ji,:),snowrho(ji,:),snowdz(ji,:),snowtemp(ji,:))
+    ENDDO
+    
+    !3. on land ice (using the default ORCHIDEE snow scheme)
+    
+    DO ji = 1,kjpindex
+       
+       !! 3.1. It is snowing
+       
+       snow_nobio(ji,iice) = snow_nobio(ji,iice) + frac_nobio(ji,iice)*precip_snow(ji) + &
+            & frac_nobio(ji,iice)*precip_rain(ji)
+       
+       !! 3.2. Sublimation - was calculated before it can give us negative snow_nobio but that is OK
+       !!      Once it goes below a certain values (-maxmass_snow for instance) we should kill
+       !!      the frac_nobio(ji,iice) !
+       
+       snow_nobio(ji,iice) = snow_nobio(ji,iice) - subsnownobio(ji,iice)
+       
+       !! 3.3. ice melt only for continental ice fraction
+       
+       snowmelt_tmp(ji) = zero
+       IF (temp_sol_new_old(ji) .GT. tp_00) THEN
+          
+          !! 3.3.1 If there is snow on the ice-fraction it can melt
+          
+          snowmelt_tmp(ji) = frac_nobio(ji,iice)*(temp_sol_new_old(ji) - tp_00) * soilcap(ji) / chalfu0
+          
+          IF ( snowmelt_tmp(ji) .GT. snow_nobio(ji,iice) ) THEN
+             snowmelt_tmp(ji) = MAX( 0., snow_nobio(ji,iice))
+          ENDIF
+          snowmelt_ice(ji) = snowmelt_ice(ji) + snowmelt_tmp(ji)
+          snow_nobio(ji,iice) = snow_nobio(ji,iice) - snowmelt_tmp(ji)
+          
+       ENDIF
+
+       !! Ice melt only if there is more than a given mass : maxmass_snow, i.e. only weight melts glaciers !
+       
+       IF ( snow_nobio(ji,iice) .GE. maxmass_snow ) THEN
+          icemelt(ji) = snow_nobio(ji,iice) - maxmass_snow
+          snow_nobio(ji,iice) = maxmass_snow
+       ENDIF
+       
+    END DO
+    
+    
+    !! 4. On other surface types - not done yet
+    
+    IF ( nnobio .GT. 1 ) THEN
+       WRITE(numout,*) 'WE HAVE',nnobio-1,' SURFACE TYPES I DO NOT KNOW'
+       WRITE(numout,*) 'CANNOT TREAT SNOW ON THESE SURFACE TYPES'
+       CALL ipslerr_p(3,'explicitsnow_main','Cannot treat snow on these surface types.','','')
+    ENDIF
+    
+    !! 5. Computes snow age on land and land ice (for albedo)
+    
+    DO ji = 1, kjpindex
+       
+       !! 5.1. Snow age on land 
+       
+       IF (snow(ji) .LE. zero) THEN
+          snow_age(ji) = zero
+       ELSE
+          snow_age(ji) =(snow_age(ji) + (un - snow_age(ji)/max_snow_age) * dt_sechiba/one_day) &
+               & * EXP(-precip_snow(ji) / snow_trans)
+       ENDIF
+       
+       !! 5.2. Snow age on land ice
+       
+       !! Age of snow on ice: a little bit different because in cold regions, we really
+       !! cannot negect the effect of cold temperatures on snow metamorphism any more.
+       
+       IF (snow_nobio(ji,iice) .LE. zero) THEN
+          snow_nobio_age(ji,iice) = zero
+       ELSE
+          
+          d_age(ji) = ( snow_nobio_age(ji,iice) + &
+               &  (un - snow_nobio_age(ji,iice)/max_snow_age) * dt_sechiba/one_day ) * &
+               &  EXP(-precip_snow(ji) / snow_trans) - snow_nobio_age(ji,iice)
+          IF (d_age(ji) .GT. 0. ) THEN
+             xx(ji) = MAX( tp_00 - temp_sol_new(ji), zero )
+             xx(ji) = ( xx(ji) / 7._r_std ) ** 4._r_std
+             d_age(ji) = d_age(ji) / (un+xx(ji))
+          ENDIF
+          snow_nobio_age(ji,iice) = MAX( snow_nobio_age(ji,iice) + d_age(ji), zero )
+          
+       ENDIF
+       
+    ENDDO
+    
+    
+    !! 6. Check the snow on land 
+    DO ji=1,kjpindex
+       IF (snow(ji) .EQ. 0) THEN
+          snowrho(ji,:)=50.0
+          snowgrain(ji,:)=0.0
+          snowdz(ji,:)=0.0
+          snowliq(ji,:)=0.0
+       ENDIF
+    ENDDO
+    
+    
+    ! Snow melt only if there is more than a given mass : maxmass_snow
+    ! Here I suggest to remove the snow based on a certain threshold of snow
+    ! depth instead of snow mass because it is quite difficult for
+    ! explictsnow module to calculate other snow properties following the
+    ! removal of snow mass
+    ! to define the threshold of snow depth based on old snow density (330
+    ! kg/m3)
+    !       maxmass_snowdepth=maxmass_snow/sn_dens 
+    snowmelt_from_maxmass(:) = 0.0
+    
+    !! 7. compute total melt 
+    
+    DO ji=1,kjpindex 
+       tot_melt(ji) = icemelt(ji) + snowmelt(ji) + snowmelt_ice(ji) + snowmelt_from_maxmass(ji)
+    ENDDO
+    IF (printlev>=3) WRITE(numout,*) 'explicitsnow_main done'
+    
+  END SUBROUTINE explicitsnow_main
+  
+
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_finalize
+!!
+!>\BRIEF        Write variables for explictsnow module to restart file
+!!                
+!! DESCRIPTION  : Write variables for explictsnow module to restart file
+!!
+!! \n
+!_
+!================================================================================================================================
+  SUBROUTINE explicitsnow_finalize ( kjit,     kjpindex, rest_id,    snowrho,   &
+       snowtemp, snowdz,   snowheat,   snowgrain)
+    
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                           :: kjit           !! Time step number 
+    INTEGER(i_std), INTENT(in)                           :: kjpindex       !! Domain size
+    INTEGER(i_std),INTENT (in)                           :: rest_id        !! Restart file identifier
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowrho        !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowtemp       !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowdz         !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowheat       !! Snow heat content
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowgrain      !! Snow grainsize
+    
+    
+    !! 1. Write to restart file
+    CALL restput_p(rest_id, 'snowrho', nbp_glo, nsnow, 1, kjit, snowrho, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snowtemp', nbp_glo, nsnow, 1, kjit, snowtemp, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snowdz', nbp_glo, nsnow, 1, kjit, snowdz, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snowheat', nbp_glo, nsnow, 1, kjit, snowheat, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snowgrain', nbp_glo, nsnow, 1, kjit, snowgrain, 'scatter', nbp_glo, index_g)
+    
+  END SUBROUTINE explicitsnow_finalize
+  
+
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_grain
+!!
+!>\BRIEF        Compute evolution of snow grain size
+!!                
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : R. Jordan (1991)
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+
+
+ SUBROUTINE explicitsnow_grain(kjpindex,snowliq,snowdz,gtemp,snowtemp,pb,snowgrain)
+
+      !! 0.1 Input variables
+      INTEGER(i_std),INTENT(in)                                  :: kjpindex         !! Domain size
+      REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)           :: snowliq          !! Liquid water content
+      REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)           :: snowdz           !! Snow depth (m)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)                 :: gtemp            !! First soil layer temperature
+      REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)           :: snowtemp         !! Snow temperature
+      REAL(r_std),DIMENSION (kjpindex),INTENT(in)                :: pb               !! Surface pressure (hpa) 
+
+      !! 0.2 Output variables
+
+      !! 0.3 Modified variables
+
+      REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)        :: snowgrain        !! Snow grain size
+
+      !! 0.4 Local variables
+      REAL(r_std),DIMENSION(kjpindex,nsnow)                      :: zsnowdz,zdz,ztheta
+      REAL(r_std),DIMENSION(kjpindex,0:nsnow)                    :: ztemp,zdiff,ztgrad,zthetaa,zfrac,&
+                                                                    zexpo,zckt_liq,zckt_ice,zckt
+      REAL(r_std),DIMENSION(kjpindex,nsnow)                      :: zrhomin,zgrainmin
+      INTEGER(i_std) :: ji,jj
+
+      !! 0.5 Local parameters
+      REAL(r_std), PARAMETER                                     :: ztheta_crit = 0.02     !! m3 m-3
+      REAL(r_std), PARAMETER                                     :: zc1_ice     = 8.047E+9 !! kg m-3 K
+      REAL(r_std), PARAMETER                                     :: zc1_liq     = 5.726E+8 !! kg m-3 K
+      REAL(r_std), PARAMETER                                     :: zdeos       = 0.92E-4  !! effective diffusion
+                                                                                           !! coef for water vapor in snow
+                                                                                           !! at 0C and 1000 mb (m2 s-1)
+      REAL(r_std), PARAMETER                                     :: zg1         = 5.0E-7   !! m4 kg-1
+      REAL(r_std), PARAMETER                                     :: zg2         = 4.0E-12  !! m2 s-1
+      REAL(r_std), PARAMETER                                     :: ztheta_w      = 0.05   !! m3 m-3
+      REAL(r_std), PARAMETER                                     :: ztheta_crit_w = 0.14   !! m3 m-3
+      REAL(r_std), PARAMETER                                     :: zdzmin        = 0.01   !! m : minimum thickness
+                                                                                           !! for thermal gradient evaluation:
+                                                                                           !! to prevent excessive gradients
+                                                                                           !! for vanishingly thin snowpacks.
+      REAL(r_std), PARAMETER                                     :: xp00=1.E5 
+      !! 1. initialize
+ 
+      DO ji=1,kjpindex 
+
+
+         zsnowdz(ji,:)  = MAX(xsnowdmin/nsnow, snowdz(ji,:))
+
+         DO jj=1,nsnow-1
+            zdz(ji,jj)      = zsnowdz(ji,jj) + zsnowdz(ji,jj+1)
+         ENDDO
+            zdz(ji,nsnow)     = zsnowdz(ji,nsnow)
+
+         ! compute interface average volumetric water content (m3 m-3):
+         ! first, layer avg VWC:
+         !
+          ztheta(ji,:) = snowliq(ji,:)/MAX(xsnowdmin, zsnowdz(ji,:))
+
+         ! at interfaces:
+          zthetaa(ji,0)      = ztheta(ji,1)
+          DO jj=1,nsnow-1
+             zthetaa(ji,jj)  = (zsnowdz(ji,jj)  *ztheta(ji,jj)   +             &
+                                   zsnowdz(ji,jj+1)*ztheta(ji,jj+1))/zdz(ji,jj)
+          ENDDO
+          zthetaa(ji,nsnow) = ztheta(ji,nsnow)
+          ! compute interface average temperatures (K):
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          !
+          ztemp(ji,0)      = snowtemp(ji,1)
+          DO jj=1,nsnow-1
+             ztemp(ji,jj)  = (zsnowdz(ji,jj)  *snowtemp(ji,jj)   +             &
+                                 zsnowdz(ji,jj+1)*snowtemp(ji,jj+1))/zdz(ji,jj)
+          ENDDO
+          ztemp(ji,nsnow) = snowtemp(ji,nsnow)
+!
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          ! compute variation of saturation vapor pressure with temperature
+          ! for solid and liquid phases:
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          zexpo(ji,:)    = chalsu0/(xrv*ztemp(ji,:))
+          zckt_ice(ji,:) = (zc1_ice/ztemp(ji,:)**2)*(zexpo(ji,:) - 1.0)*EXP(-zexpo(ji,:))
+          !
+          zexpo(ji,:)    = chalev0/(xrv*ztemp(ji,:))
+          zckt_liq(ji,:) = (zc1_liq/ztemp(ji,:)**2)*(zexpo(ji,:) - 1.0)*EXP(-zexpo(ji,:))
+          !
+          ! compute the weighted ice/liquid total variation (N m-2 K):
+          !
+          zfrac(ji,:)    = MIN(1.0, zthetaa(ji,:)/ztheta_crit)
+          zckt(ji,:)     = zfrac(ji,:)*zckt_liq(ji,:) + (1.0 - zfrac(ji,:))*zckt_ice(ji,:)
+
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          ! Compute effective diffusion coefficient (m2 s-1):
+          ! -diffudivity relative to a reference diffusion at 1000 mb and freezing point
+          !  multiplied by phase energy coefficient
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          !
+          DO jj=0,nsnow
+             zdiff(ji,jj) = zdeos*(xp00/(pb(ji)*100.))*((ztemp(ji,jj)/tp_00)**6)*zckt(ji,jj)
+          ENDDO 
+
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          ! Temperature gradient (K m-1):
+
+          ztgrad(ji,0)      = 0.0 ! uppermost layer-mean and surface T's are assumed to be equal
+          DO jj=1,nsnow-1
+             ztgrad(ji,jj)  = 2*(snowtemp(ji,jj)-snowtemp(ji,jj+1))/MAX(zdzmin, zdz(ji,jj))
+          ENDDO
+          !
+          ! assume at base of snow, temperature is in equilibrium with soil
+          ! (but obviously must be at or below freezing point!)
+          !
+          ztgrad(ji,nsnow) = 2*(snowtemp(ji,nsnow) - MIN(tp_00, gtemp(ji)))/MAX(zdzmin, zdz(ji,nsnow))
+          ! prognostic grain size (m) equation:
+          !-------------------------------------------------------------------
+          ! first compute the minimum grain size (m):
+          !
+          zrhomin(ji,:)     = xrhosmin
+          zgrainmin(ji,:)   = snow3lgrain_1d(zrhomin(ji,:))
+
+          ! dry snow:
+          ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+          !
+          DO jj=1,nsnow
+
+             IF(ztheta(ji,jj) == 0.0) THEN
+
+              ! only allow growth due to vapor flux INTO layer: 
+              ! aab add sublimation(only condensation) as upper BC...?
+
+                snowgrain(ji,jj)  = snowgrain(ji,jj) +                                      &
+                                       (dt_sechiba*zg1/MAX(zgrainmin(ji,jj),snowgrain(ji,jj)))*      &
+                                       ( zdiff(ji,jj-1)*MAX(0.0,ztgrad(ji,jj-1)) -                &
+                                       zdiff(ji,jj)  *MIN(0.0,ztgrad(ji,jj)) )
+             ELSE
+ 
+              ! wet snow
+              ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+              !
+                snowgrain(ji,jj)  = snowgrain(ji,jj) +                                      &
+                                       (dt_sechiba*zg2/MAX(zgrainmin(ji,jj),snowgrain(ji,jj)))*      &
+                                       MIN(ztheta_crit_w, ztheta(ji,jj) + ztheta_w)
+             END IF
+
+          ENDDO
+
+
+      ENDDO
+
+
+    END SUBROUTINE explicitsnow_grain
+
+!!
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_compactn
+!!
+!>\BRIEF        Compute Compaction/Settling
+!!                
+!! DESCRIPTION  : 
+!!     Snow compaction due to overburden and settling.
+!!     Mass is unchanged: layer thickness is reduced
+!!     in proportion to density increases. Method
+!!     of Anderson (1976): see Loth and Graf, 1993,
+!!     J. of Geophys. Res., 98, 10,451-10,464.
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : Loth and Graf (1993), Mellor (1964) and Anderson (1976)
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+
+
+   SUBROUTINE explicitsnow_compactn(kjpindex,snowtemp,snowrho,snowdz)
+
+         !! 0.1 Input variables
+
+         INTEGER(i_std),INTENT(in)                                 :: kjpindex         !! Domain size
+         REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)          :: snowtemp         !! Snow temperature
+
+         !! 0.2 Output variables
+
+         !! 0.3 Modified variables
+
+         REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)       :: snowrho          !! Snow density
+         REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)       :: snowdz           !! Snow depth
+
+         !! 0.4 Local variables
+
+         REAL(r_std),DIMENSION(kjpindex,nsnow)                     :: zwsnowdz,zsmass,zsnowrho2,zviscocity,zsettle 
+         REAL(r_std),DIMENSION(kjpindex)                           :: zsmassc          !! cummulative snow mass (kg/m2)
+         REAL(r_std),DIMENSION(kjpindex)                           :: snowdepth_crit
+         INTEGER(i_std)                                            :: ji,jj
+
+        !! 1. initialize
+
+        zsnowrho2  = snowrho
+        zsettle(:,:)    = ZSNOWCMPCT_ACM
+        zviscocity(:,:) = ZSNOWCMPCT_V0
+
+        !! 2. Calculating Cumulative snow mass (kg/m2):
+
+        DO ji=1, kjpindex
+
+
+            IF (SUM(snowdz(ji,:)) .GT. 0.0) THEN 
+
+              zwsnowdz(ji,:)= snowdz(ji,:)*snowrho(ji,:)
+
+              zsmassc (ji)= 0.0
+
+              DO jj=1,nsnow
+                 zsmass(ji,jj)   = zsmassc(ji) + zwsnowdz(ji,jj)
+                 zsmassc(ji)      = zsmassc(ji) + zwsnowdz(ji,jj)
+              ENDDO
+
+
+              !! 3. Computing compaction/Settling
+              ! ----------------------
+              ! Compaction/settling if density below upper limit
+              ! (compaction is generally quite small above ~ 500 kg m-3):
+              !
+              DO jj=1,nsnow
+                 IF (snowrho(ji,jj) .LT. xrhosmax) THEN
+            
+              !
+              ! First calculate settling due to freshly fallen snow: (NOTE:bug here for the snow temperature profile)
+              !
+             
+              zsettle(ji,jj)     = ZSNOWCMPCT_ACM*EXP(                                      &
+                                     -ZSNOWCMPCT_BCM*(tp_00-MIN(tp_00,snowtemp(ji,jj)))                      &
+                                     -ZSNOWCMPCT_CCM*MAX(0.0,                                  &
+                                      snowrho(ji,jj)-ZSNOWCMPCT_RHOD))
+              !
+              ! Snow viscocity:
+              !
+              zviscocity(ji,jj)   = ZSNOWCMPCT_V0*EXP( ZSNOWCMPCT_VT*(tp_00-MIN(tp_00,snowtemp(ji,jj))) +        &
+                                  ZSNOWCMPCT_VR*snowrho(ji,jj) )
+
+              ! Calculate snow density: compaction from weight/over-burden
+              ! Anderson 1976 method:
+              zsnowrho2(ji,jj)    = snowrho(ji,jj) + snowrho(ji,jj)*dt_sechiba*(          &
+                                   (cte_grav*zsmass(ji,jj)/zviscocity(ji,jj))                 &
+                                    + zsettle(ji,jj) )
+              ! Conserve mass by decreasing grid thicknesses in response
+              ! to density increases
+              !
+              snowdz(ji,jj)  = snowdz(ji,jj)*(snowrho(ji,jj)/zsnowrho2(ji,jj))
+
+                 ENDIF
+              ENDDO
+
+              ! Update density (kg m-3):
+              snowrho(ji,:) = zsnowrho2(ji,:)
+
+            ENDIF
+
+        ENDDO
+
+      END SUBROUTINE explicitsnow_compactn
+
+!!
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_transf
+!!
+!>\BRIEF        Computing snow mass and heat redistribution due to grid thickness configuration resetting
+!!                
+!! DESCRIPTION  : Snow mass and heat redistibution due to grid thickness
+!!                configuration resetting. Total mass and heat content
+!!                of the overall snowpack unchanged/conserved within this routine. 
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+
+   SUBROUTINE explicitsnow_transf(kjpindex,snowdz_old,snowdz,snowrho,snowheat,snowgrain)
+
+     !! 0.1 Input variables
+
+     INTEGER(i_std),INTENT(in)                                           :: kjpindex         !! Domain size
+     REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)                    :: snowdz_old       !! Snow depth at the previous time step 
+
+     !! 0.2 Output variables
+
+     !! 0.3 Modified variables
+
+     REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)                 :: snowrho          !! Snow density 
+     REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)                 :: snowgrain        !! Snow grain size
+     REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)                 :: snowdz           !! Snow depth (m)
+     REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)                 :: snowheat         !! Snow heat content/enthalpy (J/m2)
+                                                                        
+     !! 0.4 Local varibles                                              
+      
+     REAL(r_std),DIMENSION(kjpindex,nsnow)                               :: zsnowzo
+     REAL(r_std),DIMENSION(kjpindex,nsnow)                               :: zsnowzn 
+     REAL(r_std),DIMENSION(kjpindex,nsnow)                               :: zsnowddz 
+     REAL(r_std),DIMENSION(kjpindex,nsnow)                               :: zdelta
+     REAL(r_std),DIMENSION(kjpindex,nsnow)                               :: zsnowrhon,zsnowheatn,zsnowgrainn
+     REAL(r_std),DIMENSION(kjpindex)                                     :: zsnowmix_delta
+     REAL(r_std),DIMENSION(kjpindex)                                     :: zsumheat, zsumswe, zsumgrain
+     INTEGER(i_std),DIMENSION(nsnow,2)                                   :: locflag
+     REAL(r_std)                                                         :: psnow
+     INTEGER(i_std)                                                      :: ji,jj,jjj
+
+     ! Initialization
+     zsumheat(:)       = 0.0
+     zsumswe(:)        = 0.0
+     zsumgrain(:)      = 0.0
+     zsnowmix_delta(:) = 0.0
+     locflag(:,:)        = 0
+
+     DO ji=1, kjpindex 
+ 
+
+        psnow = SUM(snowdz(ji,:))
+
+     IF (psnow .GE. xsnowcritd .AND. snowdz_old(ji,1) .NE. 0 .AND. snowdz_old(ji,2) .NE. 0 .AND. snowdz_old(ji,3) .NE. 0) THEN
+          !
+          zsnowzo(ji,1)     = snowdz_old(ji,1)
+          zsnowzn(ji,1)     = snowdz(ji,1)
+          !
+          DO jj=2,nsnow
+             zsnowzo(ji,jj) = zsnowzo(ji,jj-1) + snowdz_old(ji,jj)
+             zsnowzn(ji,jj) = zsnowzn(ji,jj-1) + snowdz(ji,jj)
+          ENDDO
+
+          !layer thickness change
+
+          zsnowddz(ji,:)    = zsnowzn(ji,:) - zsnowzo(ji,:)
+          !
+          ! Calculate the delta function:
+          !
+          zdelta(ji,:)    = 0.0
+          WHERE(zsnowddz(ji,:) > 0.0) zdelta(ji,:) = 1.0
+          !
+
+          ! Calculate mass and heat transfers due to grid adjustment/changes:
+          ! Upper layer:
+          !
+          zsnowrhon(ji,1)  = ( snowdz_old(ji,1)*snowrho(ji,1) + zsnowddz(ji,1)*      &
+                            (     zdelta(ji,1) *snowrho(ji,2) +                 &
+                            (1.0-zdelta(ji,1))*snowrho(ji,1) ) )               &
+                            /snowdz(ji,1)
+          !
+          IF (snowdz_old(ji,1) .GT. 0.0) THEN
+
+                zsnowheatn(ji,1) = snowheat(ji,1) + zsnowddz(ji,1)*                    &
+                                  ((    zdelta(ji,1) *snowheat(ji,2)/snowdz_old(ji,2)) +  &
+                                  ((1.0-zdelta(ji,1))*snowheat(ji,1)/snowdz_old(ji,1)) )
+          ELSE
+                zsnowheatn(ji,1) = snowheat(ji,2)/snowdz_old(ji,2)*zsnowddz(ji,1)
+
+          ENDIF
+                !
+          zsnowgrainn(ji,1)  = ( snowdz_old(ji,1)*snowgrain(ji,1) + zsnowddz(ji,1)*  &
+                            (     zdelta(ji,1) *snowgrain(ji,2) +               &
+                            (1.0-zdelta(ji,1))*snowgrain(ji,1) ) )             &
+                            /snowdz(ji,1)
+
+
+
+
+          ! Lowest layer:
+          !
+          zsnowrhon(ji,nsnow)  = ( snowdz_old(ji,nsnow)*snowrho(ji,nsnow) -      &
+                                    zsnowddz(ji,nsnow-1)*                                &
+                                    (     zdelta(ji,nsnow-1) *snowrho(ji,nsnow) +     &
+                                    (1.0-zdelta(ji,nsnow-1))*snowrho(ji,nsnow-1) ) )  &
+                                    /snowdz(ji,nsnow)
+          !
+          zsnowheatn(ji,nsnow) = snowheat(ji,nsnow) - zsnowddz(ji,nsnow-1)*   &
+                                 ((    zdelta(ji,nsnow-1) *snowheat(ji,nsnow)/     &
+                                 snowdz_old(ji,nsnow)) +                         &
+                                 ((1.0-zdelta(ji,nsnow-1))*snowheat(ji,nsnow-1)    &
+                                 /snowdz_old(ji,nsnow-1)) )
+          !
+          zsnowgrainn(ji,nsnow)  = ( snowdz_old(ji,nsnow)*snowgrain(ji,nsnow) -    &
+                                   zsnowddz(ji,nsnow-1)*                         &
+                                   (     zdelta(ji,nsnow-1) *snowgrain(ji,nsnow) +     &
+                                   (1.0-zdelta(ji,nsnow-1))*snowgrain(ji,nsnow-1) ) ) &
+                                  /snowdz(ji,nsnow)
+
+
+          !
+          zsnowzo(ji,1)     = snowdz_old(ji,1)
+          zsnowzn(ji,1)     = snowdz(ji,1)
+          !
+          DO jj=2,nsnow
+             zsnowzo(ji,jj) = zsnowzo(ji,jj-1) + snowdz_old(ji,jj)
+             zsnowzn(ji,jj) = zsnowzn(ji,jj-1) + snowdz(ji,jj)
+          ENDDO
+
+
+          DO jj=2,nsnow-1
+
+             !first diagonise where the new snow layer lies in the old snow discretization             
+             DO jjj=nsnow,1,-1
+
+                !upper bound of the snow layer
+                IF (zsnowzn(ji,jj-1) .LE. zsnowzo(ji,jjj)) THEN
+                   locflag(jj,1) = jjj
+                ENDIF
+
+                !lower bound of the snow layer
+                IF (zsnowzn(ji,jj)   .LE. zsnowzo(ji,jjj)) THEN
+                   locflag(jj,2) = jjj
+                ENDIF
+
+             ENDDO
+
+             !to interpolate
+             ! when heavy snow occurred
+             IF (locflag(jj,1) .EQ. locflag(jj,2)) THEN 
+
+                zsnowrhon(ji,jj) = snowrho(ji,locflag(jj,1))
+
+                zsnowheatn(ji,jj) = snowheat(ji,locflag(jj,1))*snowdz(ji,jj)/snowdz_old(ji,locflag(jj,1)) 
+
+                zsnowgrainn(ji,jj) = snowgrain(ji,locflag(jj,1)) 
+
+             ELSE 
+
+                !snow density
+
+                zsnowrhon(ji,jj) = snowrho(ji,locflag(jj,1)) * &
+                                      (zsnowzo(ji,locflag(jj,1))-zsnowzn(ji,jj-1)) + &
+                                      snowrho(ji,locflag(jj,2)) * &
+                                      (zsnowzn(ji,jj)-zsnowzo(ji,locflag(jj,2)-1))
+
+                DO jjj=locflag(jj,1),locflag(jj,2)-1
+                   zsnowrhon(ji,jj)=zsnowrhon(ji,jj) + &
+                   (jjj-locflag(jj,1))*snowrho(ji,jjj)*snowdz_old(ji,jjj)  
+                ENDDO
+
+                zsnowrhon(ji,jj) = zsnowrhon(ji,jj) / snowdz(ji,jj)
+
+
+                !snow heat
+
+                zsnowheatn(ji,jj) = snowheat(ji,locflag(jj,1)) * &
+                                 (zsnowzo(ji,locflag(jj,1))-zsnowzn(ji,jj-1))/snowdz_old(ji,locflag(jj,1)) + &
+                                       snowheat(ji,locflag(jj,2)) * &
+                                 (zsnowzn(ji,jj)-zsnowzo(ji,locflag(jj,2)-1))/snowdz_old(ji,locflag(jj,2))
+
+                DO jjj=locflag(jj,1),locflag(jj,2)-1
+                   zsnowheatn(ji,jj)=zsnowheatn(ji,jj) + &
+                                        (jjj-locflag(jj,1))*snowheat(ji,jjj)
+                ENDDO
+
+
+
+                !snow grain
+                zsnowgrainn(ji,jj) = snowgrain(ji,locflag(jj,1)) * &
+                                      (zsnowzo(ji,locflag(jj,1))-zsnowzn(ji,jj-1)) + &
+                                      snowgrain(ji,locflag(jj,2)) * &
+                                      (zsnowzn(ji,jj)-zsnowzo(ji,locflag(jj,2)-1))
+
+                DO jjj=locflag(jj,1),locflag(jj,2)-1
+                   zsnowgrainn(ji,jj)=zsnowgrainn(ji,jj) + &
+                   (jjj-locflag(jj,1))*snowgrain(ji,jjj)*snowdz_old(ji,jjj)
+                ENDDO
+
+                zsnowgrainn(ji,jj) = zsnowgrainn(ji,jj) / snowdz(ji,jj)
+
+
+             ENDIF
+                        
+          ENDDO
+          snowrho(ji,:)    = zsnowrhon(ji,:)
+          snowheat(ji,:)   = zsnowheatn(ji,:)
+          snowgrain(ji,:)  = zsnowgrainn(ji,:)
+
+     ENDIF
+
+          ! Vanishing or very thin snowpack check:
+          ! -----------------------------------------
+          !
+          ! NOTE: ONLY for very shallow snowpacks, mix properties (homogeneous):
+          ! this avoids problems related to heat and mass exchange for
+          ! thin layers during heavy snowfall or signifigant melt: one
+          ! new/old layer can exceed the thickness of several old/new layers.
+          ! Therefore, mix (conservative):
+          !
+          ! modified by Tao Wang
+            IF (psnow > 0 .AND. (psnow < xsnowcritd .OR. snowdz_old(ji,1) &
+            & .eq. 0 .OR. snowdz_old(ji,2) .eq. 0 .OR. snowdz_old(ji,3) .eq. 0)) THEN
+                zsumheat(ji) = SUM(snowheat(ji,:))
+                zsumswe(ji)  = SUM(snowrho(ji,:)*snowdz_old(ji,:))
+                zsumgrain(ji)= SUM(snowgrain(ji,:)*snowdz_old(ji,:))
+                zsnowmix_delta(ji) = 1.0
+                DO jj=1,nsnow
+                   zsnowheatn(ji,jj)  = zsnowmix_delta(ji)*(zsumheat(ji)/nsnow)
+                   snowdz(ji,jj)    = zsnowmix_delta(ji)*(psnow/nsnow) 
+                   zsnowrhon(ji,jj)   = zsnowmix_delta(ji)*(zsumswe(ji)/psnow)
+                   zsnowgrainn(ji,jj) = zsnowmix_delta(ji)*(zsumgrain(ji)/psnow)
+                ENDDO
+          ! Update mass (density and thickness), heat and grain size:
+          ! ------------------------------------------------------------
+          !
+          snowrho(ji,:)    = zsnowrhon(ji,:)
+          snowheat(ji,:)   = zsnowheatn(ji,:)
+          snowgrain(ji,:)  = zsnowgrainn(ji,:)
+
+        ENDIF
+
+     ENDDO
+
+
+   END SUBROUTINE explicitsnow_transf
+
+  
+!!
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_fall
+!!
+!>\BRIEF    Computes snowfall    
+!!                
+!! DESCRIPTION  : 
+!routine. 
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+ 
+   SUBROUTINE explicitsnow_fall(kjpindex,precip_snow,temp_air,u,v,totfrac_nobio,snowrho,snowdz,&
+                        & snowheat,snowgrain,snowtemp,psnowhmass)
+
+       !! 0.1 Input variables
+
+       INTEGER(i_std),INTENT(in)                              :: kjpindex            !! Domain size
+       REAL(r_std),DIMENSION(kjpindex),INTENT(in)             :: precip_snow         !! Snow rate (SWE) (kg/m2 per dt_sechiba)
+       REAL(r_std),DIMENSION(kjpindex),INTENT(in)             :: temp_air            !! Air temperature
+       REAL(r_std),DIMENSION(kjpindex),INTENT(in)             :: u,v                 !! Horizontal wind speed
+       REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)       :: snowtemp            !! Snow temperature
+       REAL(r_std),DIMENSION(kjpindex),INTENT(in)             :: totfrac_nobio
+       !! 0.2 Output variables
+
+       REAL(r_std), DIMENSION(kjpindex),INTENT(out)           :: psnowhmass          !! Heat content of snowfall (J/m2)
+
+       !! 0.3 Modified variables
+ 
+       REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)    :: snowrho             !! Snow density profile (kg/m3)
+       REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)    :: snowdz              !! Snow layer thickness profile (m)
+       REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)    :: snowheat            !! Snow heat content/enthalpy (J/m2)
+       REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(inout)    :: snowgrain           !! Snow grain size
+
+       !! 0.4 Local variables
+
+       REAL(r_std), DIMENSION(kjpindex)                       :: rhosnew             !! Snowfall density
+       REAL(r_std), DIMENSION(kjpindex)                       :: dsnowfall           !! Snowfall thickness (m)
+       REAL(r_std), DIMENSION(kjpindex,nsnow)                 :: snowdz_old
+       REAL(r_std), DIMENSION(kjpindex)                       :: snow_depth,snow_depth_old,newgrain
+       REAL(r_std)                                            :: snowfall_delta,speed
+       INTEGER(i_std)                                         :: ji,jj
+
+       !! 1. initialize the variables
+
+       snowdz_old = snowdz
+       DO ji=1,kjpindex
+                 snow_depth(ji) = SUM(snowdz(ji,:))
+       ENDDO
+
+       snow_depth_old = snow_depth
+ 
+       snowfall_delta = 0.0 
+
+       !! 2. incorporate snowfall into snowpack 
+       DO ji = 1, kjpindex
+   
+       speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+        
+          ! new snow fall on snowpack 
+          ! NOTE: when the surface temperature is zero, it means that snowfall has no
+          ! heat content but it can be used for increasing the thickness and changing the density (maybe it is a bug)
+          psnowhmass(ji) = 0.0
+          IF ( (precip_snow(ji) .GT. 0.0) ) THEN
+
+             !calculate
+
+             psnowhmass(ji) = precip_snow(ji)*(un-totfrac_nobio(ji))* &
+                                (xci*(snowtemp(ji,1)-tp_00)-chalfu0)
+            
+             ! Snowfall density: Following CROCUS (Pahaut 1976)
+             !
+             rhosnew(ji)   = MAX(xrhosmin, snowfall_a_sn + snowfall_b_sn*(temp_air(ji)-tp_00)+         &
+                   snowfall_c_sn*SQRT(speed))
+
+             ! Augment total pack depth:
+             ! Note that dsnowfall(ji) can be equal to zero if totfrac_nobio(ji)=1
+             dsnowfall(ji) = (precip_snow(ji)*(un-totfrac_nobio(ji)))/rhosnew(ji) !snowfall thickness (m)
+
+             snow_depth(ji) = snow_depth(ji) + dsnowfall(ji) 
+
+
+             ! Fresh snowfall changes the snowpack density and liquid content in uppermost layer 
+
+             IF (dsnowfall(ji) .GT. zero) THEN
+               snowrho(ji,1) = (snowdz(ji,1)*snowrho(ji,1) + dsnowfall(ji)*rhosnew(ji))/     &
+                                (snowdz(ji,1)+dsnowfall(ji))
+
+               snowdz(ji,1) = snowdz(ji,1) + dsnowfall(ji)
+
+               ! Add energy of snowfall to snowpack:
+               ! Update heat content (J/m2) (therefore the snow temperature
+               ! and liquid content):
+               !
+               snowheat(ji,1)  = snowheat(ji,1) + psnowhmass(ji)
+               !
+               ! Incorporate snowfall grain size:
+               !
+               newgrain(ji)    = MIN(dgrain_new_max, snow3lgrain_0d(rhosnew(ji)))
+               
+               snowgrain(ji,1) = (snowdz_old(ji,1)*snowgrain(ji,1) + dsnowfall(ji)*newgrain(ji))/ &
+                    snowdz(ji,1)
+            ENDIF
+          ELSE
+            dsnowfall(ji) = 0.
+          ENDIF
+
+          ! new snow fall on snow free surface. 
+          ! we use the linearization for the new snow fall on snow-free ground 
+
+          IF ( (dsnowfall(ji) .GT. zero) .AND. (snow_depth_old(ji) .EQ. zero) ) THEN
+
+             snowfall_delta = 1.0
+              
+             DO jj=1,nsnow
+
+                snowdz(ji,jj)   = snowfall_delta*(dsnowfall(ji)/nsnow) + &
+                                  (1.0-snowfall_delta)*snowdz(ji,jj)
+
+                snowheat(ji,jj)   = snowfall_delta*(psnowhmass(ji)/nsnow) + &
+                                  (1.0-snowfall_delta)*snowheat(ji,jj)
+
+                snowrho(ji,jj)    = snowfall_delta*rhosnew(ji)            + &
+                                  (1.0-snowfall_delta)*snowrho(ji,jj)
+
+                snowgrain(ji,jj)=   snowfall_delta*newgrain(ji)           + &
+                                  (1.0-snowfall_delta)*snowgrain(ji,jj)
+
+             ENDDO
+
+
+          ENDIF
+
+
+       ENDDO 
+
+     END SUBROUTINE explicitsnow_fall
+
+!!
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_gone
+!!
+!>\BRIEF        Check whether snow is gone 
+!!                
+!! DESCRIPTION  : If so, set thickness (and therefore mass and heat) and liquid
+!!                content to zero, and adjust fluxes of water, evaporation and
+!!                heat into underlying surface. 
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+
+   SUBROUTINE explicitsnow_gone(kjpindex,pgflux,&
+                        snowheat,snowtemp,snowdz,snowrho,snowliq,grndflux,snowmelt)
+
+     !! 0.1 Input variables
+
+     INTEGER(i_std), INTENT(in)                                 :: kjpindex     !! Domain size
+     REAL(r_std),DIMENSION (kjpindex), INTENT (in)              :: pgflux       !! Net energy into snow pack(w/m2)
+     REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(in)          :: snowheat     !! Snow heat content
+
+     !! 0.2 Output variables
+
+     !! 0.3 Modified variables
+
+     REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)     :: snowtemp     !! Snow temperature
+     REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)     :: snowdz       !! Snow depth
+     REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(inout)      :: snowrho      !! Snow density
+     REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(inout)      :: snowliq      !! Liquid water content
+     REAL(r_std),DIMENSION(kjpindex), INTENT(inout)             :: grndflux     !! Soil/snow interface heat flux (W/m2)
+     REAL(r_std),DIMENSION(kjpindex),INTENT(inout)              :: snowmelt     !! Snow melt
+     REAL(r_std),DIMENSION(kjpindex)                            :: thrufal      !! Water leaving snowpack(kg/m2/s)
+
+     !! 0.4 Local variables
+
+     INTEGER(i_std)                                             :: ji,jj
+     REAL(r_std),DIMENSION(kjpindex)                            :: snowgone_delta
+     REAL(r_std),DIMENSION (kjpindex)                           :: totsnowheat  !!snow heat content at each layer 
+     REAL(r_std),DIMENSION(kjpindex)                            :: snowdepth_crit
+
+     ! first caculate total snowpack snow heat content
+     snowgone_delta(:) = un
+     thrufal(:)=0.0
+     snowmelt(:)=0
+     totsnowheat(:)  = SUM(snowheat(:,:),2) 
+     
+     DO ji = 1, kjpindex 
+
+           IF ( (SUM(snowdz(ji,:)) .GT. zero)) THEN
+
+              IF( pgflux(ji) >= (-totsnowheat(ji)/dt_sechiba) ) THEN
+
+                 grndflux(ji) = pgflux(ji) + (totsnowheat(ji)/dt_sechiba)
+
+                 thrufal(ji)=SUM(snowrho(ji,:)*snowdz(ji,:))
+
+                 snowgone_delta(ji) = 0.0       
+
+                 snowmelt(ji) = snowmelt(ji)+thrufal(ji)
+
+              ENDIF
+
+              ! update of snow state (either still present or not)
+
+              DO jj=1,nsnow
+                 snowdz(ji,jj)  =   snowdz(ji,jj) *snowgone_delta(ji)
+                 snowliq(ji,jj)   =   snowliq(ji,jj) *snowgone_delta(ji)
+                 snowtemp(ji,jj) = (1.0-snowgone_delta(ji))*tp_00 + snowtemp(ji,jj)*snowgone_delta(ji)
+              ENDDO
+
+           ENDIF
+     ENDDO 
+
+   END SUBROUTINE explicitsnow_gone
+
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_melt_refrz
+!!
+!>\BRIEF        Computes snow melt and refreezing processes within snowpack
+!!                
+!! DESCRIPTION  : 
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+
+   SUBROUTINE explicitsnow_melt_refrz(kjpindex,precip_rain,pgflux,soilcap,&
+                     snowtemp,snowdz,snowrho,snowliq,snowmelt,grndflux,temp_air)
+
+      !! 0.1 Input variables
+
+      INTEGER(i_std), INTENT (in)                             :: kjpindex     !! Domain size
+      REAL(r_std),DIMENSION (kjpindex,nsnow)                  :: pcapa_snow   !! Heat capacity for snow
+      REAL(r_std),DIMENSION (kjpindex), INTENT(in)            :: precip_rain  !! Rainfall      
+      REAL(r_std),DIMENSION (kjpindex), INTENT(in)            :: temp_air     !! Air temperature
+      REAL(r_std),DIMENSION (kjpindex),INTENT(in)             :: pgflux       !! Net energy into snowpack(w/m2)
+      REAL(r_std),DIMENSION (kjpindex),INTENT(in)             :: soilcap      !! Soil heat capacity
+
+      !! 0.2 Output variables
+
+      !! 0.3 Modified variables
+
+      REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)  :: snowtemp     !! Snow temperature 
+      REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)  :: snowdz       !! Snow depth
+      REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowrho      !! Snow layer density
+      REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(inout)   :: snowliq      !! Liquid water content
+      REAL(r_std),DIMENSION(kjpindex),INTENT(inout)           :: grndflux     !! Net energy input to soil 
+      REAL(r_std),DIMENSION (kjpindex), INTENT(inout)         :: snowmelt     !! Snowmelt
+
+      !! 0.4 Local variables
+
+      REAL(r_std),DIMENSION (kjpindex)                        :: meltxs       !! Residual snowmelt energy applied to underlying soil
+      REAL(r_std)                                             :: enerin,melttot,hrain 
+      REAL(r_std),DIMENSION (nsnow)                           :: zsnowlwe
+      REAL(r_std),DIMENSION (nsnow)                           :: flowliq
+      REAL(r_std),DIMENSION (kjpindex)                        :: snowmass
+      REAL(r_std),DIMENSION (nsnow)                           :: zphase       !! Phase change (from ice to water) (J/m2)
+      REAL(r_std),DIMENSION (nsnow)                           :: zphase2      !! Phase change (from water to ice)
+      REAL(r_std),DIMENSION (nsnow)                           :: zphase3      !! Phase change related with net energy input to snowpack
+      REAL(r_std),DIMENSION (nsnow)                           :: zsnowdz      !! Snow layer depth
+      REAL(r_std),DIMENSION (nsnow)                           :: zsnowmelt    !! Snow melt (liquid water) (m)
+      REAL(r_std),DIMENSION (nsnow)                           :: zsnowtemp
+      REAL(r_std),DIMENSION (nsnow)                           :: zmeltxs      !! Excess melt
+      REAL(r_std),DIMENSION (nsnow)                           :: zwholdmax    !! Maximum liquid water holding (m)
+      REAL(r_std),DIMENSION (nsnow)                           :: zcmprsfact   !! Compression factor due to densification from melting
+      REAL(r_std),DIMENSION (nsnow)                           :: zscap        !! Snow heat capacity (J/m3 K)
+      REAL(r_std),DIMENSION (nsnow)                           :: zsnowliq     !! (m)
+      REAL(r_std),DIMENSION (nsnow)                           :: snowtemp_old
+      REAL(r_std),DIMENSION (0:nsnow)                         :: zflowliqt    !!(m)
+      REAL(r_std)                                             :: zrainfall,zpcpxs
+      REAL(r_std)                                             :: ztotwcap
+      REAL(r_std),DIMENSION(kjpindex,nsnow)                   :: snowdz_old,snowliq_old
+      INTEGER(i_std)                                          :: jj,ji, iv
+      REAL(r_std),DIMENSION(nsnow)                            :: snowdz_old2
+      REAL(r_std),DIMENSION(nsnow)                            :: zsnowrho 
+    
+      !initialize
+      snowdz_old = snowdz
+      snowliq_old = snowliq
+
+      DO ji = 1, kjpindex
+
+
+         snowmass(ji) = SUM(snowrho(ji,:) * snowdz(ji,:))
+         IF ((snowmass(ji) .GT. 0.)) THEN
+
+           !! 1 snow melting due to positive snowpack snow temperature
+ 
+             !! 1.0 total liquid equivalent water content of each snow layer
+
+               zsnowlwe(:) = snowrho(ji,:) * snowdz(ji,:)/ ph2o 
+
+             !! 1.1 phase change (J/m2)
+
+               pcapa_snow(ji,:) = snowrho(ji,:)*xci
+
+               zphase(:)  = MIN(pcapa_snow(ji,:)*MAX(0.0, snowtemp(ji,:)-tp_00)*      &
+                                snowdz(ji,:),                                       &
+                            MAX(0.0,zsnowlwe(:)-snowliq(ji,:))*chalfu0*ph2o)
+
+             !! 1.2 update snow liq water and temperature if melting
+
+               zsnowmelt(:) = zphase(:)/(chalfu0*ph2o)
+
+             !! 1.3 cool off the snow layer temperature due to melt
+
+               zsnowtemp(:) = snowtemp(ji,:) - zphase(:)/(pcapa_snow(ji,:)* snowdz(ji,:))
+
+               snowtemp(ji,:) = MIN(tp_00, zsnowtemp(:))
+
+               zmeltxs(:)   = (zsnowtemp(:)-snowtemp(ji,:))*pcapa_snow(ji,:)*snowdz(ji,:)
+
+             !! 1.4 loss of snowpack depth and liquid equivalent water
+
+               zwholdmax(:) = snow3lhold_1d(snowrho(ji,:),snowdz(ji,:)) ! 1 dimension
+
+               zcmprsfact(:) = (zsnowlwe(:)-MIN(snowliq(ji,:)+zsnowmelt(:),zwholdmax(:)))/ &
+                               (zsnowlwe(:)-MIN(snowliq(ji,:),zwholdmax(:)))
+
+               snowdz(ji,:)    = snowdz(ji,:)*zcmprsfact(:)
+
+               snowrho(ji,:)     = zsnowlwe(:)*ph2o/snowdz(ji,:)
+
+               snowliq(ji,:)   = snowliq(ji,:) + zsnowmelt(:)
+
+
+           !! 2 snow refreezing process
+              !! 2.1 freeze liquid water in any layer
+               zscap(:)     = snowrho(ji,:)*xci  !J K-1 m-3
+               zphase2(:)    = MIN(zscap(:)*                                          &
+                                MAX(0.0, tp_00 - snowtemp(ji,:))*snowdz(ji,:),             &
+                                snowliq(ji,:)*chalfu0*ph2o)
+
+               ! warm layer and reduce liquid if freezing occurs
+               zsnowdz(:) = MAX(xsnowdmin/nsnow, snowdz(ji,:))
+               snowtemp_old(:) = snowtemp(ji,:) 
+               snowtemp(ji,:) = snowtemp(ji,:) + zphase2(:)/(zscap(:)*zsnowdz(:))
+               
+               ! Reduce liquid portion if freezing occurs:
+               snowliq(ji,:) = snowliq(ji,:) - ( (snowtemp(ji,:)-snowtemp_old(:))*       &
+               zscap(:)*zsnowdz(:)/(chalfu0*ph2o) )
+               snowliq(ji,:) = MAX(snowliq(ji,:), 0.0)
+           !! 3. thickness change due to snowmelt in excess of holding capacity
+               zwholdmax(:) = snow3lhold_1d(snowrho(ji,:),snowdz(ji,:)) ! 1 dimension
+               flowliq(:) = MAX(0.,(snowliq(ji,:)-zwholdmax(:)))
+               snowliq(ji,:)  = snowliq(ji,:) - flowliq(:)
+               snowdz(ji,:) = snowdz(ji,:) - flowliq(:)*ph2o/snowrho(ji,:)
+               ! to prevent possible very small negative values (machine
+               ! prescision as snow vanishes
+               snowdz(ji,:) = MAX(0.0, snowdz(ji,:)) 
+
+           !! 4. liquid water flow
+               ztotwcap = SUM(zwholdmax(:)) 
+               ! Rain entering snow (m):
+               !ORCHIDEE has assumed that all precipitation entering snow has
+               !left the snowpack and finally become runoff in hydrolc_soil. Here we just put zrainfall as 0.0
+               !!zrainfall = precip_rain(ji)/ph2o ! rainfall (m)
+               zrainfall = 0.0
+
+               zflowliqt(0) = MIN(zrainfall,ztotwcap)
+               ! Rain assumed to directly pass through the pack to runoff (m):
+               zpcpxs = zrainfall - zflowliqt(0)
+               !
+               DO jj=1,nsnow
+                  zflowliqt(jj) = flowliq(jj)
+               ENDDO
+
+               ! translated into a density increase:
+               flowliq(:) = 0.0                ! clear this array for work
+               zsnowliq(:) = snowliq(ji,:)      ! reset liquid water content
+               !
+
+               DO jj=1,nsnow
+                  snowliq(ji,jj)  = snowliq(ji,jj) + zflowliqt(jj-1)
+                  flowliq(jj)   = MAX(0.0, (snowliq(ji,jj)-zwholdmax(jj)))
+                  snowliq(ji,jj)  = snowliq(ji,jj) - flowliq(jj)
+
+                  !Modified by Tao Wang based on previous ISBA-ES scheme
+                  snowrho(ji,jj)  = snowrho(ji,jj)  + (snowliq(ji,jj) - zsnowliq(jj))*       &
+                                        & ph2o/MAX(xsnowdmin/nsnow,snowdz(ji,jj))
+
+                  zflowliqt(jj) = zflowliqt(jj) + flowliq(jj)  
+               ENDDO
+
+               snowmelt(ji)  = snowmelt(ji) + (zflowliqt(nsnow) + zpcpxs) *  ph2o
+
+             ! excess heat from melting, using it to warm underlying ground to conserve energy
+               meltxs(ji) = SUM(zmeltxs(:))/dt_sechiba  ! (W/m2)
+
+             ! energy flux into the soil 
+               grndflux(ji) = grndflux(ji) + meltxs(ji)  
+
+         ENDIF
+
+      ENDDO
+
+    END SUBROUTINE explicitsnow_melt_refrz
+
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_levels
+!!
+!>\BRIEF        Computes snow discretization based on given total snow depth
+!!                
+!! DESCRIPTION  : 
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================ 
+  SUBROUTINE explicitsnow_levels( kjpindex,snow_thick, snowdz)
+    
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                                     :: kjpindex     !! Domain size
+    REAL(r_std),DIMENSION (kjpindex),   INTENT (in)                :: snow_thick   !! Total snow depth
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)         :: snowdz                           !! Snow depth
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                                 :: il,it,ji
+    INTEGER(i_std)                                                 :: i,j, ix
+    REAL(r_std), DIMENSION(kjpindex)                               :: xi, xf
+    REAL(r_std), PARAMETER, DIMENSION(3)                           :: ZSGCOEF1  = (/0.25, 0.50, 0.25/) !! Snow grid parameters 
+    REAL(r_std), PARAMETER, DIMENSION(2)                           :: ZSGCOEF2  = (/0.05, 0.34/)       !! Snow grid parameters 
+    REAL(r_std), PARAMETER                                         :: ZSNOWTRANS = 0.20                !! Minimum total snow depth at which surface layer thickness is constant (m)
+    REAL(r_std), PARAMETER                                         :: XSNOWCRITD = 0.03                !! (m)
+
+    DO ji=1,kjpindex
+       IF ( snow_thick(ji) .LE. (XSNOWCRITD+0.01)) THEN
+
+        snowdz(ji,1) = MIN(0.01, snow_thick(ji)/nsnow)
+        snowdz(ji,3) = MIN(0.01, snow_thick(ji)/nsnow)
+        snowdz(ji,2) = snow_thick(ji) - snowdz(ji,1) - snowdz(ji,3)
+   
+       ENDIF 
+    ENDDO
+
+    WHERE ( snow_thick(:) .LE. ZSNOWTRANS .AND. &
+            snow_thick(:) .GT. (XSNOWCRITD+0.01) )
+       !
+        snowdz(:,1) = snow_thick(:)*ZSGCOEF1(1)
+        snowdz(:,2) = snow_thick(:)*ZSGCOEF1(2) 
+        snowdz(:,3) = snow_thick(:)*ZSGCOEF1(3)
+       !
+    END WHERE
+
+     DO ji = 1,kjpindex
+      IF (snow_thick(ji) .GT. ZSNOWTRANS) THEN
+          snowdz(ji,1) = ZSGCOEF2(1)
+          snowdz(ji,2) = (snow_thick(ji)-ZSGCOEF2(1))*ZSGCOEF2(2) + ZSGCOEF2(1)
+        !When using simple finite differences, limit the thickness
+        !factor between the top and 2nd layers to at most 10
+          snowdz(ji,2)  = MIN(10*ZSGCOEF2(1),  snowdz(ji,2) )
+          snowdz(ji,3)  = snow_thick(ji) - snowdz(ji,2) - snowdz(ji,1)
+
+      ENDIF
+    ENDDO
+      
+
+  END SUBROUTINE explicitsnow_levels
+
+!!
+!================================================================================================================================
+!! SUBROUTINE   : explicitsnow_profile
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : In this routine solves the numerical soil thermal scheme, ie calculates the new soil temperature profile.
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_
+!================================================================================================================================
+  SUBROUTINE explicitsnow_profile (kjpindex, cgrnd_snow,dgrnd_snow,lambda_snow,temp_sol_new, snowtemp,snowdz,temp_sol_add)
+
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex     !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol_new !! skin temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow),INTENT (in)      :: cgrnd_snow   !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow),INTENT (in)      :: dgrnd_snow   !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex),INTENT(in)             :: lambda_snow  !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow),INTENT(in)       :: snowdz       !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex),INTENT(inout)          :: temp_sol_add !! Additional energy to melt snow for snow ablation case (K)
+
+    !! 0.3 Modified variable
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (inout)   :: snowtemp
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jg
+!_
+!================================================================================================================================
+  !! 1. Computes the snow temperatures ptn.
+    DO ji = 1,kjpindex
+      IF (SUM(snowdz(ji,:)) .GT. 0) THEN
+        snowtemp(ji,1) = (lambda_snow(ji) * cgrnd_snow(ji,1) + (temp_sol_new(ji)+temp_sol_add(ji))) / &
+             (lambda_snow(ji) * (un - dgrnd_snow(ji,1)) + un)
+        temp_sol_add(ji) = zero 
+        DO jg = 1,nsnow-1
+            snowtemp(ji,jg+1) = cgrnd_snow(ji,jg) + dgrnd_snow(ji,jg) * snowtemp(ji,jg)
+        ENDDO
+      ENDIF
+    ENDDO
+    IF (printlev>=3) WRITE (numout,*) ' explicitsnow_profile done '
+
+  END SUBROUTINE explicitsnow_profile
+
+END MODULE explicitsnow
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/hydrol.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/hydrol.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/hydrol.f90	(revision 5166)
@@ -0,0 +1,6806 @@
+! ===================================================================================================\n
+! MODULE        : hydrol
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module computes the soil moisture processes on continental points. 
+!!
+!!\n DESCRIPTION : contains hydrol_main, hydrol_initialize, hydrol_finalise, hydrol_init, 
+!!                 hydrol_var_init, hydrol_waterbal, hydrol_alma,
+!!                 hydrol_snow, hydrol_vegupd, hydrol_canop, hydrol_flood, hydrol_soil.
+!!                 The assumption in this module is that very high vertical resolution is
+!!                 needed in order to properly resolve the vertical diffusion of water in
+!!                 the soils. Furthermore we have taken into account the sub-grid variability
+!!                 of soil properties and vegetation cover by allowing the co-existence of
+!!                 different soil moisture columns in the same grid box.
+!!                 This routine was originaly developed by Patricia deRosnay.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) :
+!! - de Rosnay, P., J. Polcher, M. Bruen, and K. Laval, Impact of a physically based soil
+!! water flow and soil-plant interaction representation for modeling large-scale land surface
+!! processes, J. Geophys. Res, 107 (10.1029), 2002. \n
+!! - de Rosnay, P. and Polcher J. (1998) Modeling root water uptake in a complex land surface scheme coupled 
+!! to a GCM. Hydrology and Earth System Sciences, 2(2-3):239-256. \n
+!! - de Rosnay, P., M. Bruen, and J. Polcher, Sensitivity of surface fluxes to the number of layers in the soil 
+!! model used in GCMs, Geophysical research letters, 27 (20), 3329 - 3332, 2000. \n
+!! - dâOrgeval, T., J. Polcher, and P. De Rosnay, Sensitivity of the West African hydrological
+!! cycle in ORCHIDEE to infiltration processes, Hydrol. Earth Syst. Sci. Discuss, 5, 2251 - 2292, 2008. \n
+!! - Carsel, R., and R. Parrish, Developing joint probability distributions of soil water retention
+!! characteristics, Water Resources Research, 24 (5), 755 - 769, 1988. \n
+!! - Mualem, Y., A new model for predicting the hydraulic conductivity of unsaturated porous
+!! media, Water Resources Research, 12 (3), 513 - 522, 1976. \n
+!! - Van Genuchten, M., A closed-form equation for predicting the hydraulic conductivity of
+!! unsaturated soils, Soil Science Society of America Journal, 44 (5), 892 - 898, 1980. \n
+!! - Campoy, A., Ducharne, A., Cheruy, F., Hourdin, F., Polcher, J., and Dupont, J.-C., Response 
+!! of land surface fluxes and precipitation to different soil bottom hydrological conditions in a
+!! general circulation model,  J. Geophys. Res, in press, 2013. \n
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ===============================================================================================\n
+MODULE hydrol
+
+  USE ioipsl
+  USE xios_orchidee
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE sechiba_io
+  USE grid
+  USE explicitsnow
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: hydrol_main, hydrol_initialize, hydrol_finalize, hydrol_clear 
+
+  !
+  ! variables used inside hydrol module : declaration and initialisation
+  !
+  LOGICAL, SAVE                                   :: first_hydrol_main=.TRUE.  !! Initialisation has to be done one time (true/false)
+!$OMP THREADPRIVATE(first_hydrol_main)
+  !
+  LOGICAL, SAVE                                   :: check_cwrr=.FALSE.      !! To check the water balance (true/false)
+!$OMP THREADPRIVATE(check_cwrr)
+  LOGICAL, SAVE                                   :: doponds=.FALSE.         !! Reinfiltration flag (true/false)
+!$OMP THREADPRIVATE(doponds)
+  !
+  CHARACTER(LEN=80) , SAVE                        :: var_name                !! To store variables names for I/O
+!$OMP THREADPRIVATE(var_name)
+  !
+  REAL(r_std), PARAMETER                          :: allowed_err =  2.0E-8_r_std
+  REAL(r_std), PARAMETER                          :: EPS1 = EPSILON(un)      !! A small number
+  ! one dimension array allocated, computed, saved and got in hydrol module
+  ! Values per soil type
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: nvan                !! Van Genuchten coeficients n (unitless)
+                                                                          ! RK: 1/n=1-m
+!$OMP THREADPRIVATE(nvan)                                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: avan                !! Van Genuchten coeficients a
+                                                                         !!  @tex $(mm^{-1})$ @endtex
+!$OMP THREADPRIVATE(avan)                                                
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcr                 !! Residual volumetric water content
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex
+!$OMP THREADPRIVATE(mcr)                                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcs                 !! Saturated volumetric water content
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex
+!$OMP THREADPRIVATE(mcs)                                                  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: ks                  !! Hydraulic conductivity at saturation
+                                                                         !!  @tex $(mm d^{-1})$ @endtex
+!$OMP THREADPRIVATE(ks)                                                  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: pcent               !! Fraction of saturated volumetric soil moisture above 
+                                                                         !! which transpir is max (0-1, unitless)
+!$OMP THREADPRIVATE(pcent)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcf                 !! Volumetric water content at field capacity
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex 
+!$OMP THREADPRIVATE(mcf)                                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcw                 !! Volumetric water content at wilting point
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex 
+!$OMP THREADPRIVATE(mcw)                                                 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mc_awet             !! Vol. wat. cont. above which albedo is cst
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex 
+!$OMP THREADPRIVATE(mc_awet)                                             
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mc_adry             !! Vol. wat. cont. below which albedo is cst
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex 
+!$OMP THREADPRIVATE(mc_adry)                                             
+
+  ! Values per grid point
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_water_beg    !! Total amount of water at start of time step
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tot_water_beg)                                       
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_water_end    !! Total amount of water at end of time step
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tot_water_end)                                       
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_flux         !! Total water flux @tex $(kg m^{-2})$ @endtex 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tot_flux)                                            
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watveg_beg   !! Total amount of water on vegetation at start of time 
+                                                                         !! step @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tot_watveg_beg)                                      
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watveg_end   !! Total amount of water on vegetation at end of time step
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tot_watveg_end)                                      
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watsoil_beg  !! Total amount of water in the soil at start of time step
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tot_watsoil_beg)                                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watsoil_end  !! Total amount of water in the soil at end of time step
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tot_watsoil_end)                                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: snow_beg         !! Total amount of snow at start of time step
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(snow_beg)                                            
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: snow_end         !! Total amount of snow at end of time step
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(snow_end)                                           
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: delsoilmoist     !! Change in soil moisture @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(delsoilmoist)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: delintercept     !! Change in interception storage
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(delintercept)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: delswe           !! Change in SWE @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(delswe)                                        
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: swi              !! Integrated Soil Wetness Index with respect to (mcf-mcw)
+                                                                         !!  (unitless; can be out of 0-1)
+!$OMP THREADPRIVATE(swi)                                        
+
+  ! array allocated, computed, saved and got in hydrol module
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_veget       !! zero/one when veget fraction is zero/higher (1)
+!$OMP THREADPRIVATE(mask_veget)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_soiltile    !! zero/one where soil tile is zero/higher (1)
+!$OMP THREADPRIVATE(mask_soiltile)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: humrelv          !! Water stress index for transpiration
+                                                                         !! for each soiltile x PFT couple (0-1, unitless)
+!$OMP THREADPRIVATE(humrelv)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: vegstressv       !! Water stress index for vegetation growth
+                                                                         !! for each soiltile x PFT couple (0-1, unitless)
+!$OMP THREADPRIVATE(vegstressv)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:):: us               !! Water stress index for transpiration 
+                                                                         !! (by soil layer and PFT) (0-1, unitless)
+!$OMP THREADPRIVATE(us)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: precisol         !! Throughfall per PFT 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(precisol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: precisol_ns      !! Throughfall per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(precisol_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: ae_ns            !! Bare soil evaporation per soiltile
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(ae_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: evap_bare_lim_ns !! Limitation factor (beta) for bare soil evaporation 
+                                                                         !! per soiltile (used to deconvoluate vevapnu)  
+                                                                         !!  (0-1, unitless) 
+!$OMP THREADPRIVATE(evap_bare_lim_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: free_drain_coef  !! Coefficient for free drainage at bottom
+                                                                         !!  (0-1, unitless) 
+!$OMP THREADPRIVATE(free_drain_coef)                                     
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_bare_ns     !! Evaporating bare soil fraction per soiltile
+                                                                         !!  (0-1, unitless)
+!$OMP THREADPRIVATE(frac_bare_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: rootsink         !! Transpiration sink by soil layer and soiltile
+                                                                         !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(rootsink)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: subsnowveg       !! Sublimation of snow on vegetation 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(subsnowveg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: subsnownobio     !! Sublimation of snow on other surface types  
+                                                                         !! (ice, lakes,...) @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(subsnownobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: icemelt          !! Ice melt @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(icemelt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: subsinksoil      !! Excess of sublimation as a sink for the soil
+                                                                         !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(subsinksoil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: vegtot           !! Total Total fraction of grid-cell covered by PFTs
+                                                                         !! (bare soil + vegetation) (1; 1)
+!$OMP THREADPRIVATE(vegtot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: resdist          !! Soiltile values from previous time-step (1; 1)
+  
+!$OMP THREADPRIVATE(resdist)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: mx_eau_var       !! Maximum water content of the soil @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(mx_eau_var)
+
+  ! arrays used by cwrr scheme
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: nroot            !! Normalized root length fraction in each soil layer 
+                                                                         !! (0-1, unitless)
+                                                                         !! DIM = nvm * nstm * nslm
+!$OMP THREADPRIVATE(nroot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: kfact_root       !! Factor to increase Ks towards the surface
+                                                                         !! (unitless)
+                                                                         !! DIM = kjpindex * nslm * nstm
+!$OMP THREADPRIVATE(kfact_root)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: kfact            !! Factor to reduce Ks with depth (unitless)
+                                                                         !! DIM = nslm * nscm
+!$OMP THREADPRIVATE(kfact)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: zz               !! Depth of the calculation nodes (mm) 
+!$OMP THREADPRIVATE(zz)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: dz               !! Internode thickness (mm)
+!$OMP THREADPRIVATE(dz)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: dh               !! Layer thickness (mm)
+!$OMP THREADPRIVATE(dh)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: mc_lin   !! 50 Vol. Wat. Contents to linearize K and D, for each texture 
+                                                                 !!  @tex $(m^{3} m^{-3})$ @endtex
+                                                                 !! DIM = imin:imax * nscm
+!$OMP THREADPRIVATE(mc_lin)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: k_lin    !! 50 values of unsaturated K, for each soil layer and texture
+                                                                 !!  @tex $(mm d^{-1})$ @endtex
+                                                                 !! DIM = imin:imax * nslm * nscm
+!$OMP THREADPRIVATE(k_lin)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: d_lin    !! 50 values of diffusivity D, for each soil layer and texture
+                                                                 !!  @tex $(mm^2 d^{-1})$ @endtex
+                                                                 !! DIM = imin:imax * nslm * nscm
+!$OMP THREADPRIVATE(d_lin)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: a_lin    !! 50 values of the slope in K=a*mc+b, for each soil layer and texture
+                                                                 !!  @tex $(mm d^{-1})$ @endtex
+                                                                 !! DIM = imin:imax * nslm * nscm
+!$OMP THREADPRIVATE(a_lin)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: b_lin    !! 50 values of y-intercept in K=a*mc+b, for each soil layer and texture
+                                                                 !!  @tex $(m^{3} m^{-3})$ @endtex
+                                                                 !! DIM = imin:imax * nslm * nscm
+!$OMP THREADPRIVATE(b_lin)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: humtot   !! Total Soil Moisture @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(humtot)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:)          :: resolv   !! Mask of land points where to solve the diffusion equation
+                                                                 !! (true/false)
+!$OMP THREADPRIVATE(resolv)
+
+!! linarization coefficients of hydraulic conductivity K (hydrol_soil_coef)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: k        !! Hydraulic conductivity K for each soil layer
+                                                                 !!  @tex $(mm d^{-1})$ @endtex
+                                                                 !! DIM = (:,nslm)
+!$OMP THREADPRIVATE(k)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: kk_moy   !! Mean hydraulic conductivity over soiltiles (mm/d)
+!$OMP THREADPRIVATE(kk_moy)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: kk       !! Hydraulic conductivity for each soiltiles (mm/d)
+!$OMP THREADPRIVATE(kk)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: a        !! Slope in K=a*mc+b(:,nslm)
+                                                                 !!  @tex $(mm d^{-1})$ @endtex
+                                                                 !! DIM = (:,nslm)
+!$OMP THREADPRIVATE(a)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: b        !! y-intercept in K=a*mc+b
+                                                                 !!  @tex $(m^{3} m^{-3})$ @endtex
+                                                                 !! DIM = (:,nslm)
+!$OMP THREADPRIVATE(b)
+!! linarization coefficients of hydraulic diffusivity D (hydrol_soil_coef)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: d        !! Diffusivity D for each soil layer
+                                                                 !!  @tex $(mm^2 d^{-1})$ @endtex
+                                                                 !! DIM = (:,nslm)
+!$OMP THREADPRIVATE(d)
+!! matrix coefficients (hydrol_soil_tridiag and hydrol_soil_setup), see De Rosnay (1999), p155-157
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: e        !! Left-hand tridiagonal matrix coefficients
+!$OMP THREADPRIVATE(e)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: f        !! Left-hand tridiagonal matrix coefficients
+!$OMP THREADPRIVATE(f)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: g1       !! Left-hand tridiagonal matrix coefficients
+!$OMP THREADPRIVATE(g1)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: ep       !! Right-hand matrix coefficients
+!$OMP THREADPRIVATE(ep)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: fp       !! Right-hand atrix coefficients
+!$OMP THREADPRIVATE(fp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: gp       !! Right-hand atrix coefficients
+!$OMP THREADPRIVATE(gp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: rhs      !! Right-hand system
+!$OMP THREADPRIVATE(rhs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: srhs     !! Temporarily stored rhs
+!$OMP THREADPRIVATE(srhs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: tmat             !! Left-hand tridiagonal matrix
+!$OMP THREADPRIVATE(tmat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: stmat            !! Temporarily stored tmat
+  !$OMP THREADPRIVATE(stmat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: water2infilt     !! Water to be infiltrated
+                                                                         !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(water2infilt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc              !! Total moisture content per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(tmc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmcr             !! Total moisture constent at residual per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmcr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmcs             !! Total moisture constent at saturation per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmcs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter       !! Total moisture in the litter per soiltile
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tmc_litt_mea     !! Total moisture in the litter over the grid
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litt_mea)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_wilt  !! Total moisture of litter at wilt point per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter_wilt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_field !! Total moisture of litter at field cap. per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter_field)
+!!! A CHANGER DANS TOUT HYDROL: tmc_litter_res et sat ne devraient pas dependre de ji - tdo
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_res   !! Total moisture of litter at residual moisture per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter_res)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_sat   !! Total moisture of litter at saturation per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter_sat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_awet  !! Total moisture of litter at mc_awet per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter_awet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_adry  !! Total moisture of litter at mc_adry per soiltile 
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litter_adry)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tmc_litt_wet_mea !! Total moisture in the litter over the grid below which 
+                                                                         !! albedo is fixed constant
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litt_wet_mea)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tmc_litt_dry_mea !! Total moisture in the litter over the grid above which 
+                                                                         !! albedo is constant
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(tmc_litt_dry_mea)
+  LOGICAL, SAVE                                      :: tmc_init_updated = .FALSE. !! Flag allowing to determine if tmc is initialized.
+!$OMP THREADPRIVATE(tmc_init_updated)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: v1               !! Temporary variable (:)
+!$OMP THREADPRIVATE(v1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: qflux00          !! Flux at the top of the soil column
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(qflux00)
+
+  !! par type de sol :
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: ru_ns            !! Surface runoff per soiltile
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(ru_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: dr_ns            !! Drainage per soiltile
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(dr_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tr_ns            !! Transpiration per soiltile
+!$OMP THREADPRIVATE(tr_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: cvs_over_veg     !! (:,nvm,nstm) old value of corr_veg_soil/veget_max kept 
+                                                                         !! from diag to next split 
+!$OMP THREADPRIVATE(cvs_over_veg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: corr_veg_soil    !! (:,nvm,nstm) percentage of each veg. type on each soil 
+                                                                         !! of each grid point 
+!$OMP THREADPRIVATE(corr_veg_soil)
+REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: mc                 !! Total volumetric water content at the calculation nodes
+                                                                         !! (eg : liquid + frozen)
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex
+!$OMP THREADPRIVATE(mc)
+   REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: mcl              !! Liquid moisture content
+!$OMP THREADPRIVATE(mcl)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: soilmoist        !! (:,nslm) mean of mc across soiltiles
+                                                                         !!  @tex $(m^{3} m^{-3})$ @endtex 
+!$OMP THREADPRIVATE(soilmoist)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: soil_wet         !! Soil wetness above mcw (0-1, unitless)
+!$OMP THREADPRIVATE(soil_wet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: soil_wet_litter  !! Soil wetness aove mvw in the litter (0-1, unitless)
+!$OMP THREADPRIVATE(soil_wet_litter)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: qflux            !! Diffusive water fluxes between soil layers
+!$OMP THREADPRIVATE(qflux)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_hydro_diag       !! 
+!$OMP THREADPRIVATE(frac_hydro_diag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: profil_froz_hydro     !! Frozen fraction for each hydrological soil layer
+!$OMP THREADPRIVATE(profil_froz_hydro)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: profil_froz_hydro_ns  !! As  profil_froz_hydro per soiltile
+!$OMP THREADPRIVATE(profil_froz_hydro_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: temp_hydro            !! Temp profile on hydrological levels
+!$OMP THREADPRIVATE(temp_hydro)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_initialize
+!!
+!>\BRIEF         Allocate module variables, read from restart file or initialize with default values
+!!
+!! DESCRIPTION :
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_initialize ( kjit,           kjpindex,  index,         rest_id,          &
+                                 njsc,           soiltile,  veget,         veget_max,        &
+                                 humrel,         vegstress, drysoil_frac,                    &
+                                 shumdiag_perma, k_litt,    qsintveg,                        &
+                                 evap_bare_lim,  snow,      snow_age,      snow_nobio,       &
+                                 snow_nobio_age, snowrho,   snowtemp,      snowgrain,        &
+                                 snowdz,         snowheat,  &
+                                 mc_layh,       mcl_layh,  tmc_layh)
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index            !! Indeces of the points on the map
+    INTEGER(i_std),INTENT (in)                         :: rest_id          !! Restart file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile         !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget            !! Fraction of vegetation type           
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max        !! Max. fraction of vegetation type (LAI -> infty)
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: humrel         !! Relative humidity
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vegstress      !! Veg. moisture stress (only for vegetation growth)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: drysoil_frac   !! function of litter wetness
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)  :: shumdiag_perma !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: k_litt         !! litter approximate conductivity
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: qsintveg       !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)        :: evap_bare_lim  !! Limitation factor for bare soil evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: snow           !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: snow_age       !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out):: snow_nobio     !! Water balance on ice, lakes, .. [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out):: snow_nobio_age !! Snow age on ice, lakes, ...
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowrho        !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowtemp       !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowgrain      !! Snow grainsize
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowdz         !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowheat       !! Snow heat content
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out)  :: mc_layh        !! Volumetric moisture content for each layer in hydrol (liquid+ice) m3/m3
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out)  :: mcl_layh       !! Volumetric moisture content for each layer in hydrol (liquid) m3/m3
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out)  :: tmc_layh       !! Total soil moisture content for each layer in hydrol (liquid+ice), mm
+    REAL(r_std),DIMENSION (kjpindex)                     :: soilwetdummy   !! Temporary variable never used
+
+
+    !! 0.4 Local variables
+!_ ================================================================================================================================
+
+    CALL hydrol_init (kjit, kjpindex, index, rest_id, veget_max, soiltile, &
+         humrel, vegstress, snow,       snow_age,   snow_nobio, snow_nobio_age, qsintveg, &
+         snowdz, snowgrain, snowrho,    snowtemp,   snowheat, &
+         drysoil_frac, evap_bare_lim)
+    
+    CALL hydrol_var_init (kjpindex, veget, veget_max, &
+         soiltile, njsc, mx_eau_var, shumdiag_perma, k_litt, &
+         drysoil_frac, qsintveg, mc_layh, mcl_layh, tmc_layh) 
+
+    !! Initialize hydrol_alma routine if the variables were not found in the restart file. This is done in the end of 
+    !! hydrol_initialize so that all variables(humtot,..) that will be used are initialized.
+    IF (ALL(tot_watveg_beg(:)==val_exp) .OR.  ALL(tot_watsoil_beg(:)==val_exp) .OR. ALL(snow_beg(:)==val_exp)) THEN
+       ! The output variable soilwetdummy is not calculated at first call to hydrol_alma.
+       CALL hydrol_alma(kjpindex, index, .TRUE., qsintveg, snow, snow_nobio, soilwetdummy)
+    END IF
+    
+    !! If we check the water balance we first save the total amount of water
+    !! X if check_waterbal ==> hydrol_waterbal
+    IF (check_waterbal) CALL hydrol_waterbal_init (kjpindex, qsintveg, snow, snow_nobio)
+    
+  END SUBROUTINE hydrol_initialize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_main
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION :
+!! - called every time step
+!! - initialization and finalization part are not done in here
+!!
+!! - 1 computes snow  ==> hydrol_snow
+!! - 2 computes vegetations reservoirs  ==> hydrol_vegupd
+!! - 3 computes canopy  ==> hydrol_canop
+!! - 4 computes surface reservoir  ==> hydrol_flood
+!! - 5 computes soil hydrologie ==> hydrol_soil
+!! - X if check_waterbal ==> hydrol_waterbal
+!!
+!! IMPORTANT NOTICE : The water fluxes are used in their integrated form, over the time step 
+!! dt_sechiba, with a unit of kg m^{-2}.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_main (kjit, kjpindex, &
+       & index, indexveg, indexsoil, indexlayer, indexnbdl, &
+       & temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max, njsc, &
+       & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age,  &
+       & tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, &
+       & humrel, vegstress, drysoil_frac, evapot, evapot_penm, evap_bare_lim, flood_frac, flood_res, &
+       & shumdiag,shumdiag_perma, k_litt, litterhumdiag, soilcap, soiltile, reinf_slope, rest_id, hist_id, hist2_id,&
+       & stempdiag, &
+       & temp_air, pb, u, v, swnet, pgflux, &
+       & snowrho,snowtemp,snowgrain,snowdz,snowheat,snowliq, &
+       & grndflux,gtemp,tot_bare_soil, &
+       & lambda_snow,cgrnd_snow,dgrnd_snow,temp_sol_add, &
+       & mc_layh, mcl_layh, tmc_layh, runoff_per_soil, drainage_per_soil, soil_mc, &
+       & litter_mc, wat_flux0, wat_flux)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+  
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size
+    INTEGER(i_std),INTENT (in)                         :: rest_id,hist_id  !! _Restart_ file and _history_ file identifier
+    INTEGER(i_std),INTENT (in)                         :: hist2_id         !! _history_ file 2 identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index            !! Indeces of the points on the map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in):: indexveg        !! Indeces of the points on the 3D map for veg
+    INTEGER(i_std),DIMENSION (kjpindex*nstm), INTENT (in):: indexsoil      !! Indeces of the points on the 3D map for soil
+    INTEGER(i_std),DIMENSION (kjpindex*nslm), INTENT (in):: indexlayer     !! Indeces of the points on the 3D map for soil layers
+    INTEGER(i_std),DIMENSION (kjpindex*nslm), INTENT (in):: indexnbdl      !! Indeces of the points on the 3D map for of diagnostic soil layers
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_rain      !! Rain precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_snow      !! Snow precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: returnflow       !! Routed water which comes back into the soil (from the 
+                                                                           !! bottom) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: reinfiltration   !! Routed water which comes back into the soil (at the 
+                                                                           !! top) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: irrigation       !! Water from irrigation returning to soil moisture  
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_sol_new     !! New soil temperature
+
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio     !! Fraction of ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: totfrac_nobio    !! Total fraction of ice+lakes+...
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: soilcap          !! Soil capacity
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile         !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vevapwet         !! Interception loss
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget            !! Fraction of vegetation type           
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max        !! Max. fraction of vegetation type (LAI -> infty)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintmax         !! Maximum water on vegetation for interception
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: transpir         !! Transpiration
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: reinf_slope      !! Slope coef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot           !! Soil Potential Evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot_penm      !! Soil Potential Evaporation Correction
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: flood_frac       !! flood fraction
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in) :: stempdiag        !! Diagnostic temp profile from thermosoil
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: temp_air         !! Air temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: u,v              !! Horizontal wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: pb               !! Surface pressure
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: swnet            !! Net shortwave radiation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: pgflux           !! Net energy into snowpack
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: gtemp            !! First soil layer temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: tot_bare_soil    !! Total evaporating bare soil fraction 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)       :: lambda_snow      !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in):: cgrnd_snow       !! Integration coefficient for snow numerical scheme
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in):: dgrnd_snow       !! Integration coefficient for snow numerical scheme
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress        !! Veg. moisture stress (only for vegetation growth)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: drysoil_frac     !! function of litter wetness
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out):: shumdiag         !! Relative soil moisture in each soil layer 
+                                                                           !! with respect to (mcf-mcw)
+                                                                           !! (unitless; can be out of 0-1)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out):: shumdiag_perma   !! Percent of porosity filled with water (mc/mcs) used for the thermal computations 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: k_litt           !! litter approximate conductivity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: litterhumdiag    !! litter humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: tot_melt         !! Total melt    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: floodout         !! Flux out of floodplains
+    
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout):: qsintveg         !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex), INTENT(inout)    :: evap_bare_lim    !! Limitation factor (beta) for bare soil evaporation    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout):: humrel           !! Relative humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: vevapnu          !! Bare soil evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: vevapsno         !! Snow evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: vevapflo         !! Floodplain evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: flood_res        !! flood reservoir estimate
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: snow             !! Snow mass [kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: snow_age         !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio  !! Water balance on ice, lakes, .. [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio_age !! Snow age on ice, lakes, ...
+    !! We consider that any water on the ice is snow and we only peforme a water balance to have consistency.
+    !! The water balance is limite to + or - 10^6 so that accumulation is not endless
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: runoff       !! Complete surface runoff
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: drainage     !! Drainage
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)    :: runoff_per_soil !! runoff for each soil type[mm]
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)    :: drainage_per_soil !! drainage for each soil type [mm]
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowrho      !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowtemp     !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowgrain    !! Snow grainsize
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowdz       !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowheat     !! Snow heat content
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)   :: snowliq      !! Snow liquid content (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)         :: grndflux     !! Net flux into soil W/m2
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out)     :: mc_layh      !! Volumetric moisture content for each layer in hydrol(liquid + ice) [m3/m3)]
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out)     :: mcl_layh     !! Volumetric moisture content for each layer in hydrol(liquid) [m3/m3]
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out)     :: tmc_layh     !! Total soil moisture content for each layer in hydrol(liquid + ice) [mm]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)       :: temp_sol_add !! additional surface temperature due to the melt of first layer
+                                                                           !! at the present time-step @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(out)  :: soil_mc          !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out)       :: litter_mc        !! litter moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out)       :: wat_flux0        !! Water flux in the first soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(out)  :: wat_flux         !! Water flux in the soil layers exported for soil C calculations
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: jst              !! Index of soil tiles (unitless, 1-3)
+    INTEGER(i_std)                                     :: jsl              !! Index of soil layers (unitless)
+    INTEGER(i_std)                                     :: ji, jv
+    INTEGER(i_std)                                     :: itopmax          !! Indicating the layer corresponding to 0.1m depth
+    REAL(r_std),DIMENSION (kjpindex)                   :: soilwet          !! A temporary diagnostic of soil wetness
+    REAL(r_std),DIMENSION (kjpindex)                   :: snowdepth        !! Depth of snow layer
+    REAL(r_std),DIMENSION (kjpindex)                   :: njsc_tmp         !! Temporary REAL value for njsc to write it
+    REAL(r_std), DIMENSION (kjpindex)                  :: snowmelt         !! Snow melt
+    REAL(r_std), DIMENSION (kjpindex,nstm)             :: tmc_top          !! Moisture content in the itopmax upper layers, per tile
+    REAL(r_std), DIMENSION (kjpindex,nslm,nstm)        :: tmc_pro          !! Moisture content profile, per tile
+    REAL(r_std), DIMENSION (kjpindex,nslm)             :: humtot_pro       !! Moisture content profile, for diagnostics
+    REAL(r_std), DIMENSION (kjpindex)                  :: humtot_top       !! Moisture content in the itopmax upper layers, for diagnistics
+    REAL(r_std), DIMENSION(kjpindex)                   :: histvar          !! Temporary variable when computations are needed
+    REAL(r_std), DIMENSION (kjpindex,nvm)              :: frac_bare        !! Fraction(of veget_max) of bare soil in each vegetation type
+    INTEGER(i_std), DIMENSION(kjpindex*imax)           :: mc_lin_axis_index
+    REAL(r_std), DIMENSION(kjpindex)                   :: twbr             !! Grid-cell mean of TWBR Total Water Budget Residu[kg/m2/dt]
+    REAL(r_std),DIMENSION (kjpindex,nslm)              :: land_nroot       !! To ouput the grid-cell mean of nroot
+    REAL(r_std),DIMENSION (kjpindex,nslm)              :: land_dh          !! To ouput the soil layer thicknes on all grid points [m]
+    REAL(r_std),DIMENSION (kjpindex,nslm)              :: land_mcs         !! To ouput the grid-cell mean of mcs
+   
+
+!_ ================================================================================================================================
+
+    !! 3. Shared time step
+    IF (printlev>=3) WRITE (numout,*) 'hydrol pas de temps = ',dt_sechiba
+
+    !! Calculate kfact_root
+    !! An exponential factor is used to increase ks near the surface depending on the amount of roots in the soil 
+    !! through a geometric average over the vegets
+    !! This comes from the PhD thesis of d'Orgeval, 2006, p82; d'Orgeval et al. 2008, Eqs. 3-4
+    !! (Calibrated against Hapex-Sahel measurements)
+    !! Since rev 2916: veget_max/2 is used instead of veget
+    kfact_root(:,:,:) = un
+    DO jsl = 1, nslm
+       DO jv = 2, nvm
+          jst = pref_soil_veg(jv)
+          DO ji = 1, kjpindex
+             IF(soiltile(ji,jst) .GT. min_sechiba) THEN
+                kfact_root(ji,jsl,jst) = kfact_root(ji,jsl,jst) * &
+                     & MAX((MAXVAL(ks_usda)/ks(njsc(ji)))**(- veget_max(ji,jv)/2 * (humcste(jv)*zz(jsl)/mille - un)/deux), &
+                     un) 
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDDO
+
+    ! 
+    !! 3.1 Calculate snow processes with explicit method or bucket snow model
+    IF (ok_explicitsnow) THEN
+       ! Explicit snow model
+       IF (printlev>=3) WRITE (numout,*) ' ok_explicitsnow : use multi-snow layer '
+       CALL explicitsnow_main(kjpindex,    precip_rain,  precip_snow,   temp_air,    pb,       &
+                              u,           v,            temp_sol_new,  soilcap,     pgflux,   &
+                              frac_nobio,  totfrac_nobio,gtemp,          &
+                              lambda_snow, cgrnd_snow,   dgrnd_snow,                           & 
+                              vevapsno,    snow_age,     snow_nobio_age,snow_nobio,  snowrho,  &
+                              snowgrain,   snowdz,       snowtemp,      snowheat,    snow,     &
+                              temp_sol_add,          					       &
+                              snowliq,     subsnownobio, grndflux,      snowmelt,    tot_melt, &
+                              subsinksoil)            
+    ELSE
+       ! Bucket snow model
+       CALL hydrol_snow(kjpindex, precip_rain, precip_snow, temp_sol_new, soilcap, &
+            frac_nobio, totfrac_nobio, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age, &
+            tot_melt, snowdepth,snowmelt)
+    END IF
+        
+    !
+    !! 3.2 computes vegetations reservoirs  ==>hydrol_vegupd
+    CALL hydrol_vegupd(kjpindex, veget, veget_max, soiltile, qsintveg, resdist, frac_bare)
+
+    !
+    !! 3.3 computes canopy  ==>hydrol_canop
+    CALL hydrol_canop(kjpindex, precip_rain, vevapwet, veget_max, veget, qsintmax, qsintveg,precisol,tot_melt)
+
+    !
+    !! 3.4 computes surface reservoir  ==>hydrol_flood
+    CALL hydrol_flood(kjpindex,  vevapflo, flood_frac, flood_res, floodout)
+
+    !
+    !! 3.5 computes soil hydrologie ==>hydrol_soil
+
+    CALL hydrol_soil(kjpindex, veget_max, soiltile, njsc, reinf_slope,  &
+         transpir, vevapnu, evapot, evapot_penm, runoff, &
+         drainage, returnflow, reinfiltration, irrigation, &
+         tot_melt,evap_bare_lim, shumdiag, shumdiag_perma, &
+         k_litt, litterhumdiag, humrel, vegstress, drysoil_frac,&
+         stempdiag,snow,snowdz, tot_bare_soil, mc_layh, mcl_layh,tmc_layh, & 
+         soil_mc, litter_mc,wat_flux0, wat_flux,drainage_per_soil, runoff_per_soil)
+
+    ! If we check the water balance we end with the comparison of total water change and fluxes
+    !! X if check_waterbal ==> hydrol_waterbal
+    IF (check_waterbal) THEN
+       CALL hydrol_waterbal(kjpindex, index, .FALSE., veget_max, totfrac_nobio, &
+            & qsintveg, snow,snow_nobio, precip_rain, precip_snow, returnflow, reinfiltration, &
+            & irrigation, tot_melt, vevapwet, transpir, vevapnu, vevapsno, vevapflo, floodout, runoff, drainage)
+    ENDIF
+
+    !! 4 write out file  ==> hydrol_alma/histwrite(*)
+    !
+    ! If we use the ALMA standards
+    CALL hydrol_alma(kjpindex, index, .FALSE., qsintveg, snow, snow_nobio, soilwet)
+    
+
+    ! Calcuate the moisture in the upper itopmax layers (humtot_top): 
+    ! For ORCHIDEE with nslm=11 and zmaxh=2 this means the upper 10 cm. 
+    ! We compute tmc_top as tmc but only for the first itopmax layers. Then we compute a humtot with this variable.
+    ! Note: itopmax should depend on the vertical discretization, to be done. 
+    itopmax=6
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          tmc_top(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+          DO jsl = 2, itopmax
+             tmc_top(ji,jst) = tmc_top(ji,jst) + dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+       ENDDO
+    ENDDO
+ 
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          tmc_pro(ji,1,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+          DO jsl = 2,nslm-1
+             tmc_pro(ji,jsl,jst) =  dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+       ENDDO
+    ENDDO
+    humtot_top(:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          humtot_top(ji) = humtot_top(ji) + soiltile(ji,jst) * tmc_top(ji,jst)
+       ENDDO
+    ENDDO
+
+    humtot_pro(:,:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+           DO jsl=1,nslm-1
+             humtot_pro(ji,jsl) = humtot_pro(ji,jsl) + soiltile(ji,jst) * tmc_pro(ji,jsl,jst)
+           ENDDO
+       ENDDO
+    ENDDO
+
+    ! Calculcate the Total Water Budget Residu (in kg/m2 over dt_sechiba)
+    ! Consistent with hydrol_waterbal for the use of vegtot
+    ! snow_nobio included in delswe
+    ! Normally, correct equation if vegtot=1, else...?
+    ! Does not include the routing reservoirs, although the flux to/from routing are integrated
+    DO ji=1,kjpindex
+       twbr(ji) = (vegtot(ji)*delsoilmoist(ji) + delintercept(ji) + delswe(ji)) &
+            - ( precip_rain(ji) + precip_snow(ji) + irrigation(ji) + floodout(ji) &
+            + returnflow(ji) + reinfiltration(ji) ) &
+            + ( runoff(ji) + drainage(ji) + SUM(vevapwet(ji,:)) &
+            + SUM(transpir(ji,:)) + vevapnu(ji) + vevapsno(ji) + vevapflo(ji) ) 
+    ENDDO
+    ! Transform unit from kg/m2/dt to kg/m2/s (or mm/s)
+    CALL xios_orchidee_send_field("twbr",twbr/dt_sechiba)
+    
+    
+    ! Calculate land_nroot : grid-cell mean of nroot 
+    ! Here use only nroot(jv,1,jsl) with jst=1 as nroot is the same for all soiltile
+    ! Do not treat PFT1 because it has no roots
+    land_nroot(:,:) = zero
+    DO jsl=1,nslm
+       DO jv=2,nvm
+          DO ji=1,kjpindex
+               IF ( vegtot(ji) > min_sechiba ) THEN 
+               land_nroot(ji,jsl) = land_nroot(ji,jsl) + veget_max(ji,jv) * nroot(jv,1,jsl) / vegtot(ji) 
+            END IF
+          END DO
+       ENDDO
+    ENDDO
+    CALL xios_orchidee_send_field("RootDist",land_nroot)   
+
+    DO jsl=1,nslm
+       land_dh(:,jsl)=dh(jsl)/mille
+    ENDDO
+    CALL xios_orchidee_send_field("SoilThick",land_dh)
+
+    land_mcs(:,:) = zero
+    DO jsl=1,nslm
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             land_mcs(ji,jsl) = land_mcs(ji,jsl) + soiltile(ji,jst) * tmcs(ji,jst)
+          ENDDO
+       ENDDO
+    ENDDO
+    CALL xios_orchidee_send_field("SoilSat",land_mcs/(zmaxh* mille)) ! in m3/m3
+    CALL xios_orchidee_send_field("water2infilt",water2infilt)   
+
+    DO jst = 1, nstm
+       ! var_name= "mc_1" ... "mc_3"
+       WRITE (var_name,"('moistc_',i1)") jst
+       CALL xios_orchidee_send_field(TRIM(var_name),mc(:,:,jst))
+
+       ! var_name= "kfactroot_1" ... "kfactroot_3"
+       WRITE (var_name,"('kfactroot_',i1)") jst
+       CALL xios_orchidee_send_field(TRIM(var_name),kfact_root(:,:,jst))
+
+       ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+       WRITE (var_name,"('vegetsoil_',i1)") jst
+       CALL xios_orchidee_send_field(TRIM(var_name),corr_veg_soil(:,:,jst))
+    END DO
+
+    CALL xios_orchidee_send_field("evapnu_soil",ae_ns*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("drainage_soil",dr_ns*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("transpir_soil",tr_ns*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("runoff_soil",ru_ns*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("humtot_soil",tmc)
+    CALL xios_orchidee_send_field("humtot",humtot)
+    CALL xios_orchidee_send_field("humtot_pro",humtot_pro)
+    CALL xios_orchidee_send_field("mrso",humtot)
+    CALL xios_orchidee_send_field("mrsos",humtot_top)
+    njsc_tmp(:)=njsc(:)
+    CALL xios_orchidee_send_field("soilindex",njsc_tmp)
+    CALL xios_orchidee_send_field("humrel",humrel)     
+    CALL xios_orchidee_send_field("drainage",drainage*one_day/dt_sechiba) ! [kg m-2 d-1]
+    CALL xios_orchidee_send_field("runoff",runoff*one_day/dt_sechiba) ! [kg m-2 d-1]
+    CALL xios_orchidee_send_field("mrros",runoff/dt_sechiba) ! [kg m-2 s-1]
+    CALL xios_orchidee_send_field("mrro",(runoff+drainage)/dt_sechiba) ! [kg m-2 s-1]
+    CALL xios_orchidee_send_field("precisol",precisol*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("rain",precip_rain*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("rain_alma",precip_rain/dt_sechiba)
+    CALL xios_orchidee_send_field("snowf",precip_snow*one_day/dt_sechiba) ! [mm/d]
+    CALL xios_orchidee_send_field("snowf_alma",precip_snow/dt_sechiba)    ! [mm/s]
+    CALL xios_orchidee_send_field("qsintmax",qsintmax)
+    CALL xios_orchidee_send_field("qsintveg",qsintveg)
+    CALL xios_orchidee_send_field("CanopInt",SUM(qsintveg(:,:),dim=2))
+    CALL xios_orchidee_send_field("SWI",swi)
+
+    histvar(:)=(precip_rain(:)-SUM(precisol(:,:),dim=2))
+    CALL xios_orchidee_send_field("prveg",histvar/dt_sechiba)
+
+    IF ( do_floodplains ) THEN
+       CALL xios_orchidee_send_field("floodout",floodout*one_day/dt_sechiba)
+    END IF
+
+    IF (check_waterbal) THEN
+       CALL xios_orchidee_send_field("TotWater",tot_water_end)
+       CALL xios_orchidee_send_field("TotWaterFlux",tot_flux*one_day/dt_sechiba)
+    END IF
+
+    CALL xios_orchidee_send_field("Qs",runoff/dt_sechiba)
+    CALL xios_orchidee_send_field("Qsb",drainage/dt_sechiba)
+    CALL xios_orchidee_send_field("Qsm",snowmelt/dt_sechiba)
+    CALL xios_orchidee_send_field("SoilMoist",soilmoist)
+
+! Note that vevapsno has been changed compared to enerbil with respect to subsinksoil/cf vevapnu
+    CALL xios_orchidee_send_field("SubSnow",vevapsno/dt_sechiba)
+    CALL xios_orchidee_send_field("SnowDepth",snowdepth)
+    CALL xios_orchidee_send_field("frac_bare",frac_bare)
+
+    CALL xios_orchidee_send_field("SoilWet",soilwet)
+    CALL xios_orchidee_send_field("RootMoist",tot_watsoil_end)
+    CALL xios_orchidee_send_field("DelSoilMoist",delsoilmoist)
+    CALL xios_orchidee_send_field("DelSWE",delswe)
+    CALL xios_orchidee_send_field("DelIntercept",delintercept)  
+    
+
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'frac_bare', kjit, frac_bare, kjpindex*nvm, indexveg)
+
+       DO jst=1,nstm
+          ! var_name= "mc_1" ... "mc_3"
+          WRITE (var_name,"('moistc_',i1)") jst
+          CALL histwrite_p(hist_id, TRIM(var_name), kjit,mc(:,:,jst), kjpindex*nslm, indexlayer)
+
+          ! var_name= "kfactroot_1" ... "kfactroot_3"
+          WRITE (var_name,"('kfactroot_',i1)") jst
+          CALL histwrite_p(hist_id, TRIM(var_name), kjit, kfact_root(:,:,jst), kjpindex*nslm, indexlayer)
+
+          ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+          WRITE (var_name,"('vegetsoil_',i1)") jst
+          CALL histwrite_p(hist_id, TRIM(var_name), kjit,corr_veg_soil(:,:,jst), kjpindex*nvm, indexveg)
+       ENDDO
+       CALL histwrite_p(hist_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
+       ! mrso is a perfect duplicate of humtot
+       CALL histwrite_p(hist_id, 'humtot', kjit, humtot, kjpindex, index)
+       CALL histwrite_p(hist_id, 'mrso', kjit, humtot, kjpindex, index)
+       CALL histwrite_p(hist_id, 'mrsos', kjit, humtot_top, kjpindex, index)
+       CALL histwrite_p(hist_id, 'humtot_pro', kjit, humtot_pro, kjpindex*nslm, indexlayer)
+       njsc_tmp(:)=njsc(:)
+       CALL histwrite_p(hist_id, 'soilindex', kjit, njsc_tmp, kjpindex, index)
+       CALL histwrite_p(hist_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'drainage', kjit, drainage, kjpindex, index)
+       ! NB! According to histdef in intersurf, the variables 'runoff' and 'mrros' have different units
+       CALL histwrite_p(hist_id, 'runoff', kjit, runoff, kjpindex, index)
+       CALL histwrite_p(hist_id, 'mrros', kjit, runoff, kjpindex, index)
+       histvar(:)=(runoff(:)+drainage(:))
+       CALL histwrite_p(hist_id, 'mrro', kjit, histvar, kjpindex, index)
+       CALL histwrite_p(hist_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'rain', kjit, precip_rain, kjpindex, index)
+
+       histvar(:)=(precip_rain(:)-SUM(precisol(:,:),dim=2))
+       CALL histwrite_p(hist_id, 'prveg', kjit, histvar, kjpindex, index)
+
+       CALL histwrite_p(hist_id, 'snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'SWI', kjit, swi, kjpindex, index)
+       CALL histwrite_p(hist_id, 'snowmelt',kjit,snowmelt,kjpindex,index)
+       CALL histwrite_p(hist_id, 'shumdiag_perma',kjit,shumdiag_perma,kjpindex*nbdl,indexnbdl)
+
+       IF ( do_floodplains ) THEN
+          CALL histwrite_p(hist_id, 'floodout', kjit, floodout, kjpindex, index)
+       ENDIF
+       !
+       IF ( hist2_id > 0 ) THEN
+          DO jst=1,nstm
+             ! var_name= "mc_1" ... "mc_3"
+             WRITE (var_name,"('moistc_',i1)") jst
+             CALL histwrite_p(hist2_id, TRIM(var_name), kjit,mc(:,:,jst), kjpindex*nslm, indexlayer)
+
+             ! var_name= "kfactroot_1" ... "kfactroot_3"
+             WRITE (var_name,"('kfactroot_',i1)") jst
+             CALL histwrite_p(hist2_id, TRIM(var_name), kjit, kfact_root(:,:,jst), kjpindex*nslm, indexlayer)
+
+             ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+             WRITE (var_name,"('vegetsoil_',i1)") jst
+             CALL histwrite_p(hist2_id, TRIM(var_name), kjit,corr_veg_soil(:,:,jst), kjpindex*nvm, indexveg)
+          ENDDO
+          CALL histwrite_p(hist2_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
+          ! mrso is a perfect duplicate of humtot
+          CALL histwrite_p(hist2_id, 'humtot', kjit, humtot, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'mrso', kjit, humtot, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'mrsos', kjit, humtot_top, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'humtot_pro', kjit, humtot_pro, kjpindex*nslm, indexlayer)
+          njsc_tmp(:)=njsc(:)
+          CALL histwrite_p(hist2_id, 'soilindex', kjit, njsc_tmp, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'drainage', kjit, drainage, kjpindex, index)
+          ! NB! According to histdef in intersurf, the variables 'runoff' and 'mrros' have different units
+          CALL histwrite_p(hist2_id, 'runoff', kjit, runoff, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'mrros', kjit, runoff, kjpindex, index)
+          histvar(:)=(runoff(:)+drainage(:))
+          CALL histwrite_p(hist2_id, 'mrro', kjit, histvar, kjpindex, index)
+
+          IF ( do_floodplains ) THEN
+             CALL histwrite_p(hist2_id, 'floodout', kjit, floodout, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'rain', kjit, precip_rain, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snowmelt',kjit,snowmelt,kjpindex,index)
+          CALL histwrite_p(hist2_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'SWI', kjit, swi, kjpindex, index) 
+          !
+          IF (check_waterbal) THEN
+             CALL histwrite_p(hist2_id, 'TotWater', kjit, tot_water_end, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'TotWaterFlux', kjit, tot_flux, kjpindex, index)
+          ENDIF
+       ENDIF
+    ELSE
+       CALL histwrite_p(hist_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Qs', kjit, runoff, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Qsb', kjit, drainage, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Qsm', kjit, snowmelt, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelSWE', kjit, delswe, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
+       !
+       CALL histwrite_p(hist_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
+       CALL histwrite_p(hist_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+       !
+       CALL histwrite_p(hist_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+       !
+       CALL histwrite_p(hist_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
+       !
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qs', kjit, runoff, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qsb', kjit, drainage, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qsm', kjit, snowmelt, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSWE', kjit, delswe, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
+          !
+          CALL histwrite_p(hist2_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
+          CALL histwrite_p(hist2_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+          !
+          CALL histwrite_p(hist2_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+          !
+          CALL histwrite_p(hist2_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
+       ENDIF
+    ENDIF
+
+    IF (ok_freeze_cwrr) THEN
+       CALL histwrite_p(hist_id, 'profil_froz_hydro', kjit,profil_froz_hydro , kjpindex*nslm, indexlayer)
+       DO jst=1,nstm
+          WRITE (var_name,"('profil_froz_hydro_',i1)") jst
+          CALL histwrite_p(hist_id, TRIM(var_name), kjit, profil_froz_hydro_ns(:,:,jst), kjpindex*nslm, indexlayer)
+       ENDDO
+       CALL histwrite_p(hist_id, 'temp_hydro', kjit,temp_hydro , kjpindex*nslm, indexlayer)
+       CALL histwrite_p(hist_id, 'kk_moy', kjit, kk_moy,kjpindex*nslm, indexlayer) ! averaged over soiltiles
+    ENDIF
+
+    IF (first_hydrol_main) THEN 
+       first_hydrol_main=.FALSE.
+    ENDIF
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_main Done '
+    ! For dissolved organic carbon calulation in stomate
+    !soil_mc(:,:,:)=zero
+    !litter_mc(:,:)=zero
+    !soil_mc(:,:,:)=mc(:,:,:)
+    !litter_mc(:,:)= tmc_litter(:,:)
+
+  END SUBROUTINE hydrol_main
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_finalize
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION : This subroutine writes the module variables and variables calculated in hydrol to restart file
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_finalize( kjit,           kjpindex,   rest_id,  vegstress,  &
+                              qsintveg,       humrel,     snow,     snow_age, snow_nobio, &
+                              snow_nobio_age, snowrho,    snowtemp, snowdz,     &
+                              snowheat,       snowgrain,  &
+                              drysoil_frac, evap_bare_lim)
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                           :: kjit           !! Time step number 
+    INTEGER(i_std), INTENT(in)                           :: kjpindex       !! Domain size
+    INTEGER(i_std),INTENT (in)                           :: rest_id        !! Restart file identifier
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vegstress      !! Veg. moisture stress (only for vegetation growth)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintveg       !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: humrel
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: snow           !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: snow_age       !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio     !! Water balance on ice, lakes, .. [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio_age !! Snow age on ice, lakes, ...
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowrho        !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowtemp       !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowdz         !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowheat       !! Snow heat content
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowgrain      !! Snow grainsize
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)          :: drysoil_frac   !! function of litter wetness
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)          :: evap_bare_lim
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                       :: jst, jsl
+   
+!_ ================================================================================================================================
+
+
+    IF (printlev>=3) WRITE (numout,*) 'Write restart file with HYDROLOGIC variables '
+
+    DO jst=1,nstm
+       ! var_name= "mc_1" ... "mc_3"
+       WRITE (var_name,"('moistc_',i1)") jst
+       CALL restput_p(rest_id, var_name, nbp_glo,  nslm, 1, kjit, mc(:,:,jst), 'scatter',  nbp_glo, index_g)
+    END DO
+    
+    DO jst=1,nstm
+       DO jsl=1,nslm
+          ! var_name= "us_1_01" ... "us_3_11"
+          WRITE (var_name,"('us_',i1,'_',i2.2)") jst,jsl
+          CALL restput_p(rest_id, var_name, nbp_glo,nvm, 1,kjit,us(:,:,jst,jsl),'scatter',nbp_glo,index_g)
+       END DO
+    END DO
+    
+    CALL restput_p(rest_id, 'free_drain_coef', nbp_glo,   nstm, 1, kjit,  free_drain_coef, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'water2infilt', nbp_glo,   nstm, 1, kjit,  water2infilt, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'ae_ns', nbp_glo,   nstm, 1, kjit,  ae_ns, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'vegstress', nbp_glo,   nvm, 1, kjit,  vegstress, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow', nbp_glo,   1, 1, kjit,  snow, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow_age', nbp_glo,   1, 1, kjit,  snow_age, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow_nobio', nbp_glo,   nnobio, 1, kjit,  snow_nobio, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow_nobio_age', nbp_glo,   nnobio, 1, kjit,  snow_nobio_age, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'qsintveg', nbp_glo, nvm, 1, kjit,  qsintveg, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'evap_bare_lim_ns', nbp_glo, nstm, 1, kjit,  evap_bare_lim_ns, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'evap_bare_lim', nbp_glo, 1, 1, kjit,  evap_bare_lim, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'resdist', nbp_glo, nstm, 1, kjit,  resdist, 'scatter',  nbp_glo, index_g)       
+    CALL restput_p(rest_id, 'drysoil_frac', nbp_glo,   1, 1, kjit, drysoil_frac, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'humrel', nbp_glo,   nvm, 1, kjit,  humrel, 'scatter',  nbp_glo, index_g)
+
+    DO jst=1,nstm
+       ! var_name= "cvs_over_veg_1" ... "cvs_over_veg_3"
+       WRITE (var_name,"('cvs_over_veg_',i1)") jst
+       CALL restput_p(rest_id, var_name, nbp_glo,  nvm, 1, kjit, cvs_over_veg(:,:,jst), 'scatter',  nbp_glo, index_g)
+    END DO
+
+    CALL restput_p(rest_id, 'tot_watveg_beg', nbp_glo,  1, 1, kjit,  tot_watveg_beg, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'tot_watsoil_beg', nbp_glo, 1, 1, kjit,  tot_watsoil_beg, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow_beg', nbp_glo,        1, 1, kjit,  snow_beg, 'scatter',  nbp_glo, index_g)
+    
+    IF ( check_waterbal ) &
+         CALL restput_p(rest_id, 'tot_water_beg', nbp_glo,   1, 1, kjit,  tot_water_end, 'scatter', nbp_glo, index_g)
+    
+    ! Write variables for explictsnow module to restart file
+    IF (ok_explicitsnow) THEN
+       CALL explicitsnow_finalize ( kjit,     kjpindex, rest_id,    snowrho,   &
+                                    snowtemp, snowdz,   snowheat,   snowgrain)
+    END IF
+
+  END SUBROUTINE hydrol_finalize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_init
+!!
+!>\BRIEF        Initializations and memory allocation   
+!!
+!! DESCRIPTION  :
+!! - 1 Some initializations
+!! - 2 make dynamic allocation with good dimension
+!! - 2.1 array allocation for soil textur
+!! - 2.2 Soil texture choice
+!! - 3 Other array allocation
+!! - 4 Open restart input file and read data for HYDROLOGIC process
+!! - 5 get restart values if none were found in the restart file
+!! - 6 Vegetation array      
+!! - 7 set humrelv from us
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!!_ hydrol_init
+
+  SUBROUTINE hydrol_init(kjit, kjpindex, index, rest_id, veget_max, soiltile, &
+       humrel,  vegstress, snow,       snow_age,   snow_nobio, snow_nobio_age, qsintveg, &
+       snowdz,  snowgrain, snowrho,    snowtemp,   snowheat, &
+       drysoil_frac, evap_bare_lim)
+    
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                         :: kjit               !! Time step number 
+    INTEGER(i_std), INTENT (in)                         :: kjpindex           !! Domain size
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index              !! Indeces of the points on the map
+    INTEGER(i_std), INTENT (in)                         :: rest_id            !! _Restart_ file identifier 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget_max          !! Carte de vegetation max
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)  :: soiltile           !! Fraction of each soil tile (0-1, unitless)
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: humrel             !! Stress hydrique, relative humidity
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: vegstress          !! Veg. moisture stress (only for vegetation growth)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: snow               !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: snow_age           !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio       !! Snow on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio_age   !! Snow age on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: qsintveg         !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)    :: snowdz           !! Snow depth
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)    :: snowgrain        !! Snow grain size
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)    :: snowheat         !! Snow heat content
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)    :: snowtemp         !! Snow temperature
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)    :: snowrho          !! Snow density
+    REAL(r_std),DIMENSION (kjpindex),INTENT(out)          :: drysoil_frac     !! function of litter wetness
+    REAL(r_std),DIMENSION (kjpindex),INTENT(out)          :: evap_bare_lim
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ier                   !! Error code
+    INTEGER(i_std)                                     :: ji                    !! Index of land grid cells (1)
+    INTEGER(i_std)                                     :: jv                    !! Index of PFTs (1)
+    INTEGER(i_std)                                     :: jst                   !! Index of soil tiles (1)
+    INTEGER(i_std)                                     :: jsl                   !! Index of soil layers (1)
+    INTEGER(i_std)                                     :: jsc                   !! Index of soil texture (1)
+    INTEGER(i_std), PARAMETER                          :: error_level = 3       !! Error level for consistency check
+                                                                                !! Switch to 2 tu turn fatal errors into warnings  
+    REAL(r_std), ALLOCATABLE, DIMENSION (:)            :: free_drain_max        !! Temporary variable for initialization of free_drain_coef 
+
+!_ ================================================================================================================================
+
+    !! 1 Some initializations
+    !
+    !
+    !Config Key   = CHECK_CWRR
+    !Config Desc  = Should we check detailed CWRR water balance ?
+    !Config Def   = n
+    !Config If    = HYDROL_CWRR
+    !Config Help  = This parameters allows the user to check
+    !Config         the detailed water balance in each time step
+    !Config         of CWRR.
+    !Config Units = [FLAG]
+    !
+    check_cwrr = .FALSE.
+    CALL getin_p('CHECK_CWRR', check_cwrr)
+    !
+    !Config Key   = DO_PONDS
+    !Config Desc  = Should we include ponds 
+    !Config Def   = n
+    !Config If    = HYDROL_CWRR
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the ponds and return 
+    !Config         the water into the soil moisture. If this is 
+    !Config         activated, then there is no reinfiltration 
+    !Config         computed inside the hydrol module.
+    !Config Units = [FLAG]
+    !
+    doponds = .FALSE.
+    CALL getin_p('DO_PONDS', doponds)
+
+
+    !! 2 make dynamic allocation with good dimension
+
+    !! 2.1 array allocation for soil texture
+
+    ALLOCATE (nvan(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable nvan','','')
+
+    ALLOCATE (avan(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable avan','','')
+
+    ALLOCATE (mcr(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcr','','')
+
+    ALLOCATE (mcs(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcs','','')
+
+    ALLOCATE (ks(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ks','','')
+
+    ALLOCATE (pcent(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable pcent','','')
+
+    ALLOCATE (mcf(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcf','','')
+
+    ALLOCATE (mcw(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcw','','')
+    
+    ALLOCATE (mc_awet(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_awet','','')
+
+    ALLOCATE (mc_adry(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_adry','','')
+       
+    !!__2.2 Soil texture choose
+
+    SELECTCASE (nscm)
+    CASE (3)
+              
+       nvan(:) = nvan_fao(:)       
+       avan(:) = avan_fao(:)
+       mcr(:) = mcr_fao(:)
+       mcs(:) = mcs_fao(:)
+       ks(:) = ks_fao(:)
+       pcent(:) = pcent_fao(:)
+       mcf(:) = mcf_fao(:)
+       mcw(:) = mcw_fao(:)
+       mc_awet(:) = mc_awet_fao(:)
+       mc_adry(:) = mc_adry_fao(:)
+    CASE (12)
+       
+       nvan(:) = nvan_usda(:)
+       avan(:) = avan_usda(:)
+       mcr(:) = mcr_usda(:)
+       mcs(:) = mcs_usda(:)
+       ks(:) = ks_usda(:)
+       pcent(:) = pcent_usda(:)
+       mcf(:) = mcf_usda(:)
+       mcw(:) = mcw_usda(:)
+       mc_awet(:) = mc_awet_usda(:)
+       mc_adry(:) = mc_adry_usda(:)
+       
+    CASE DEFAULT
+       WRITE (numout,*) 'Unsupported soil type classification. Choose between zobler and usda according to the map'
+       CALL ipslerr_p(3,'hydrol_init','Unsupported soil type classification. ',&
+            'Choose between zobler and usda according to the map','')
+    ENDSELECT
+
+
+    !! 2.3 Read in the run.def the parameters values defined by the user
+
+    !Config Key   = CWRR_N_VANGENUCHTEN
+    !Config Desc  = Van genuchten coefficient n
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 1.89, 1.56, 1.31
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [-]
+    CALL getin_p("CWRR_N_VANGENUCHTEN",nvan)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(nvan(:) <= zero) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for CWRR_N_VANGENUCHTEN.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_A_VANGENUCHTEN
+    !Config Desc  = Van genuchten coefficient a
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.0075, 0.0036, 0.0019
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [1/mm]  
+    CALL getin_p("CWRR_A_VANGENUCHTEN",avan)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(avan(:) <= zero) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for CWRR_A_VANGENUCHTEN.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_RESIDUAL
+    !Config Desc  = Residual soil water content
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.065, 0.078, 0.095
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [m3/m3]  
+    CALL getin_p("VWC_RESIDUAL",mcr)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcr(:) < zero) .OR. ANY(mcr(:) > 1.)  ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_RESIDUAL.", &
+            &     "This parameter is ranged between 0 and 1. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+    
+    !Config Key   = VWC_SAT
+    !Config Desc  = Saturated soil water content
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.41, 0.43, 0.41
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [m3/m3]  
+    CALL getin_p("VWC_SAT",mcs)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcs(:) < zero) .OR. ANY(mcs(:) > 1.) .OR. ANY(mcs(:) <= mcr(:)) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_SAT.", &
+            &     "This parameter should be greater than VWC_RESIDUAL and less than 1. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_KS 
+    !Config Desc  = Hydraulic conductivity Saturation
+    !Config If    = HYDROL_CWRR 
+    !Config Def   = 1060.8, 249.6, 62.4
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [mm/d]   
+    CALL getin_p("CWRR_KS",ks)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(ks(:) <= zero) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for CWRR_KS.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = WETNESS_TRANSPIR_MAX
+    !Config Desc  = Soil moisture above which transpir is max
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.5, 0.5, 0.5
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [-]    
+    CALL getin_p("WETNESS_TRANSPIR_MAX",pcent)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(pcent(:) <= zero) .OR. ANY(pcent(:) > 1.) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for WETNESS_TRANSPIR_MAX.", &
+            &     "This parameter should be positive and less or equals than 1. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_FC 
+    !Config Desc  = Volumetric water content field capacity
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.32, 0.32, 0.32
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [m3/m3]   
+    CALL getin_p("VWC_FC",mcf)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcf(:) > mcs(:)) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_FC.", &
+            &     "This parameter should be less than VWC_SAT. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_WP
+    !Config Desc  = Volumetric water content Wilting pt
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.10, 0.10, 0.10 
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [m3/m3]   
+    CALL getin_p("VWC_WP",mcw)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcw(:) > mcf(:)) .OR. ANY(mcw(:) < mcr(:)) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_WP.", &
+            &     "This parameter should be greater or equal than VWC_RESIDUAL and less or equal than VWC_SAT.", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_MIN_FOR_WET_ALB
+    !Config Desc  = Vol. wat. cont. above which albedo is cst
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.25, 0.25, 0.25
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [m3/m3]  
+    CALL getin_p("VWC_MIN_FOR_WET_ALB",mc_awet)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mc_awet(:) < 0) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_MIN_FOR_WET_ALB.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+    
+    !Config Key   = VWC_MAX_FOR_DRY_ALB
+    !Config Desc  = Vol. wat. cont. below which albedo is cst
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.1, 0.1, 0.1
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [m3/m3]   
+    CALL getin_p("VWC_MAX_FOR_DRY_ALB",mc_adry)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mc_adry(:) < 0) .OR. ANY(mc_adry(:) > mc_awet(:)) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_MAX_FOR_DRY_ALB.", &
+            &     "This parameter should be positive and not greater than VWC_MIN_FOR_WET_ALB.", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !! 3 Other array allocation
+
+
+    ALLOCATE (mask_veget(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_veget','','')
+
+    ALLOCATE (mask_soiltile(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_soiltile','','')
+
+    ALLOCATE (humrelv(kjpindex,nvm,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable humrelv','','')
+
+    ALLOCATE (vegstressv(kjpindex,nvm,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegstressv','','')
+
+    ALLOCATE (us(kjpindex,nvm,nstm,nslm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable us','','')
+
+    ALLOCATE (precisol(kjpindex,nvm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable precisol','','')
+
+    ALLOCATE (precisol_ns(kjpindex,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable precisol_nc','','')
+
+    ALLOCATE (free_drain_coef(kjpindex,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable free_drain_coef','','')
+
+    ALLOCATE (frac_bare_ns(kjpindex,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable frac_bare_ns','','')
+
+    ALLOCATE (water2infilt(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable water2infilt','','')
+
+    ALLOCATE (ae_ns(kjpindex,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ae_ns','','')
+
+    ALLOCATE (evap_bare_lim_ns(kjpindex,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable evap_bare_lim_ns','','')
+
+    ALLOCATE (rootsink(kjpindex,nslm,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable rootsink','','')
+
+    ALLOCATE (subsnowveg(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsnowveg','','')
+
+    ALLOCATE (subsnownobio(kjpindex,nnobio),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsnownobio','','')
+
+    ALLOCATE (icemelt(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable icemelt','','')
+
+    ALLOCATE (subsinksoil(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsinksoil','','')
+
+    ALLOCATE (mx_eau_var(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mx_eau_var','','')
+
+    ALLOCATE (vegtot(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegtot','','')
+
+    ALLOCATE (resdist(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable resdist','','')
+
+    ALLOCATE (humtot(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable humtot','','')
+
+    ALLOCATE (resolv(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable resolv','','')
+
+    ALLOCATE (k(kjpindex,nslm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable k','','')
+
+    IF (ok_freeze_cwrr) THEN
+       ALLOCATE (kk_moy(kjpindex,nslm),stat=ier) 
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kk_moy','','')
+       kk_moy(:,:) = 276.48
+
+       ALLOCATE (kk(kjpindex,nslm,nstm),stat=ier) 
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kk','','')
+       kk(:,:,:) = 276.48
+    ENDIF
+
+    ALLOCATE (a(kjpindex,nslm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable a','','')
+
+    ALLOCATE (b(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable b','','')
+
+    ALLOCATE (d(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable d','','')
+
+    ALLOCATE (e(kjpindex,nslm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable e','','')
+
+    ALLOCATE (f(kjpindex,nslm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable f','','')
+
+    ALLOCATE (g1(kjpindex,nslm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable g1','','')
+
+    ALLOCATE (ep(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ep','','')
+
+    ALLOCATE (fp(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable fp','','')
+
+    ALLOCATE (gp(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable gp','','')
+
+    ALLOCATE (rhs(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable rhs','','')
+
+    ALLOCATE (srhs(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable srhs','','')
+
+    ALLOCATE (tmc(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc','','')
+
+    ALLOCATE (tmcs(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcs','','')
+
+    ALLOCATE (tmcr(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcr','','')
+
+    ALLOCATE (tmc_litter(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter','','')
+
+    ALLOCATE (tmc_litt_mea(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_mea','','')
+
+    ALLOCATE (tmc_litter_res(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_res','','')
+
+    ALLOCATE (tmc_litter_wilt(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_wilt','','')
+
+    ALLOCATE (tmc_litter_field(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_field','','')
+
+    ALLOCATE (tmc_litter_sat(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_sat','','')
+
+    ALLOCATE (tmc_litter_awet(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_awet','','')
+
+    ALLOCATE (tmc_litter_adry(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_adry','','')
+
+    ALLOCATE (tmc_litt_wet_mea(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_wet_mea','','')
+
+    ALLOCATE (tmc_litt_dry_mea(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_dry_mea','','')
+
+    ALLOCATE (v1(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable v1','','')
+
+    ALLOCATE (qflux00(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable qflux00','','')
+
+    ALLOCATE (ru_ns(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ru_ns','','')
+    ru_ns(:,:) = zero
+
+    ALLOCATE (dr_ns(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dr_ns','','')
+    dr_ns(:,:) = zero
+
+    ALLOCATE (tr_ns(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tr_ns','','')
+
+    ALLOCATE (cvs_over_veg(kjpindex,nvm,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable cvs_over_veg','','')
+
+    ALLOCATE (corr_veg_soil(kjpindex,nvm,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable corr_veg_soil','','')
+
+    ALLOCATE (mc(kjpindex,nslm,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc','','')
+
+    ALLOCATE (soilmoist(kjpindex,nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soilmoist','','')
+
+    ALLOCATE (soil_wet(kjpindex,nslm,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soil_wet','','')
+
+    ALLOCATE (soil_wet_litter(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soil_wet_litter','','')
+
+    ALLOCATE (qflux(kjpindex,nslm,nstm),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable qflux','','')
+
+    ALLOCATE (tmat(kjpindex,nslm,3),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmat','','')
+
+    ALLOCATE (stmat(kjpindex,nslm,3),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable stmat','','')
+
+    ALLOCATE (nroot(nvm, nstm, nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable nroot','','')
+
+    ALLOCATE (kfact_root(kjpindex, nslm, nstm), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kfact_root','','')
+
+    ALLOCATE (kfact(nslm, nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kfact','','')
+
+    ALLOCATE (zz(nslm+1),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zz','','')
+
+!jgjg    ALLOCATE (dz(nslm+1),stat=ier)
+    ALLOCATE (dz(nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dz','','')
+
+    ALLOCATE (dh(nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dh','','')
+
+    ALLOCATE (mc_lin(imin:imax, nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_lin','','')
+
+    ALLOCATE (k_lin(imin:imax, nslm, nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable k_lin','','')
+
+    ALLOCATE (d_lin(imin:imax, nslm, nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable d_lin','','')
+
+    ALLOCATE (a_lin(imin:imax, nslm, nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable a_lin','','')
+
+    ALLOCATE (b_lin(imin:imax, nslm, nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable b_lin','','')
+
+    IF (ok_freeze_cwrr) THEN
+       ALLOCATE (profil_froz_hydro(kjpindex, nslm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable profil_froz_hydrol','','')
+       profil_froz_hydro(:,:) = zero
+
+       ALLOCATE (profil_froz_hydro_ns(kjpindex, nslm, nstm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable profil_froz_hydro_ns','','')
+       profil_froz_hydro_ns(:,:,:) = zero
+
+       ALLOCATE (temp_hydro(kjpindex, nslm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable temp_hydro','','')
+       temp_hydro(:,:) = 280.
+    ENDIF
+
+    ALLOCATE (mcl(kjpindex, nslm, nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcl','','')
+
+    ALLOCATE (frac_hydro_diag(nslm, nbdl),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable frac_hydro_diag','','')
+
+    !  If we check the water balance we need two more variables
+    IF ( check_waterbal ) THEN
+       ALLOCATE (tot_water_beg(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_water_beg','','')
+
+       ALLOCATE (tot_water_end(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_water_end','','')
+
+       ALLOCATE (tot_flux(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_flux','','')
+    ENDIF
+
+    ! Soil Wetness Index
+    ALLOCATE (swi(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable swi','','')
+
+    ALLOCATE (tot_watveg_beg(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watveg_beg','','')
+    
+    ALLOCATE (tot_watveg_end(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watvag_end','','')
+    
+    ALLOCATE (tot_watsoil_beg(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watsoil_beg','','')
+    
+    ALLOCATE (tot_watsoil_end(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watsoil_end','','')
+    
+    ALLOCATE (delsoilmoist(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delsoilmoist','','')
+    
+    ALLOCATE (delintercept(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delintercept','','')
+    
+    ALLOCATE (delswe(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delswe','','')
+    
+    ALLOCATE (snow_beg(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snow_beg','','')
+    
+    ALLOCATE (snow_end(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snow_end','','')
+    
+    !! 4 Open restart input file and read data for HYDROLOGIC process
+       IF (printlev>=3) WRITE (numout,*) ' we have to read a restart file for HYDROLOGIC variables'
+
+       IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
+       !
+       DO jst=1,nstm
+          ! var_name= "mc_1" ... "mc_3"
+           WRITE (var_name,"('moistc_',I1)") jst
+           IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME',var_name)
+           CALL restget_p (rest_id, var_name, nbp_glo, nslm , 1, kjit, .TRUE., mc(:,:,jst), "gather", nbp_glo, index_g)
+       END DO
+       !
+       IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
+       DO jst=1,nstm
+          DO jsl=1,nslm
+             ! var_name= "us_1_01" ... "us_3_11"
+             WRITE (var_name,"('us_',i1,'_',i2.2)") jst,jsl
+             IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME',var_name)
+             CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., us(:,:,jst,jsl), "gather", nbp_glo, index_g)
+          END DO
+       END DO
+       !
+       var_name= 'free_drain_coef'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Coefficient for free drainage at bottom of soil')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., free_drain_coef, "gather", nbp_glo, index_g)
+       !
+       var_name= 'water2infilt'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Remaining water to be infiltrated on top of the soil')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., water2infilt, "gather", nbp_glo, index_g)
+       !
+       var_name= 'ae_ns'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+          CALL ioconf_setatt_p('LONG_NAME','Bare soil evap on each soil type')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., ae_ns, "gather", nbp_glo, index_g)
+       !
+       var_name= 'snow'        
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+          CALL ioconf_setatt_p('LONG_NAME','Snow mass')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, 1  , 1, kjit, .TRUE., snow, "gather", nbp_glo, index_g)
+       !
+       var_name= 'snow_age'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', 'd')
+          CALL ioconf_setatt_p('LONG_NAME','Snow age')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, 1  , 1, kjit, .TRUE., snow_age, "gather", nbp_glo, index_g)
+       !
+       var_name= 'snow_nobio'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+          CALL ioconf_setatt_p('LONG_NAME','Snow on other surface types')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nnobio  , 1, kjit, .TRUE., snow_nobio, "gather", nbp_glo, index_g)
+       !
+       var_name= 'snow_nobio_age'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', 'd')
+          CALL ioconf_setatt_p('LONG_NAME','Snow age on other surface types')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nnobio  , 1, kjit, .TRUE., snow_nobio_age, "gather", nbp_glo, index_g)
+       !
+       var_name= 'vegstress'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Vegetation growth moisture stress')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., vegstress, "gather", nbp_glo, index_g)
+       !
+       var_name= 'qsintveg'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+          CALL ioconf_setatt_p('LONG_NAME','Intercepted moisture')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., qsintveg, "gather", nbp_glo, index_g)
+
+       var_name= 'evap_bare_lim_ns'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '?')
+          CALL ioconf_setatt_p('LONG_NAME','?')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., evap_bare_lim_ns, "gather", nbp_glo, index_g)
+       CALL setvar_p (evap_bare_lim_ns, val_exp, 'NO_KEYWORD', 0.0)
+
+
+       var_name= 'resdist'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','soiltile values from previous time-step')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., resdist, "gather", nbp_glo, index_g)
+       
+       IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
+       DO jst=1,nstm
+          ! var_name= "cvs_over_veg_1" ... "cvs_over_veg_3"
+          WRITE (var_name,"('cvs_over_veg_',i1)") jst
+          IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME',var_name)
+          CALL restget_p (rest_id, var_name, nbp_glo,  nvm, 1, kjit, .TRUE., cvs_over_veg(:,:,jst), "gather",  nbp_glo, index_g)
+       END DO
+       
+       IF ( check_waterbal ) THEN
+          var_name= 'tot_water_beg'
+          IF (is_root_prc) THEN
+             CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+             CALL ioconf_setatt_p('LONG_NAME','Previous Total water')
+          ENDIF
+          CALL restget_p (rest_id, var_name, nbp_glo, 1  , 1, kjit, .TRUE., tot_water_beg, "gather", nbp_glo, index_g)
+       ENDIF
+
+       ! Read drysoil_frac. It will be initalized later in hydrol_var_init if the varaible is not find in restart file.
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '')
+          CALL ioconf_setatt_p('LONG_NAME','Function of litter wetness')
+       ENDIF
+       CALL restget_p (rest_id, 'drysoil_frac', nbp_glo, 1  , 1, kjit, .TRUE., drysoil_frac, "gather", nbp_glo, index_g)
+
+
+    !! 5 get restart values if none were found in the restart file
+       !
+       !Config Key   = HYDROL_MOISTURE_CONTENT
+       !Config Desc  = Soil moisture on each soil tile and levels
+       !Config If    = HYDROL_CWRR       
+       !Config Def   = 0.3
+       !Config Help  = The initial value of mc if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = [m3/m3]
+       !
+       CALL setvar_p (mc, val_exp, 'HYDROL_MOISTURE_CONTENT', 0.3_r_std)
+       !
+       !Config Key   = US_INIT
+       !Config Desc  = US_NVM_NSTM_NSLM
+       !Config If    = HYDROL_CWRR       
+       !Config Def   = 0.0
+       !Config Help  = The initial value of us (relative moisture) if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = [-]
+       !
+       DO jsl=1,nslm
+          CALL setvar_p (us(:,:,:,jsl), val_exp, 'US_INIT', zero)
+       ENDDO
+       !
+       !Config Key   = FREE_DRAIN_COEF
+       !Config Desc  = Coefficient for free drainage at bottom, dimension nstm
+       !Config If    = HYDROL_CWRR       
+       !Config Def   = 1.0 1.0 1.0
+       !Config Help  = The initial value of free drainage coefficient if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = [-]
+              
+       ALLOCATE (free_drain_max(nstm),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable free_drain_max','','')
+       free_drain_max(:)=1.0
+
+       CALL setvar_p (free_drain_coef, val_exp, 'FREE_DRAIN_COEF', free_drain_max)
+       DEALLOCATE(free_drain_max)
+
+       !
+       !Config Key   = WATER_TO_INFILT
+       !Config Desc  = Water to be infiltrated on top of the soil
+       !Config If    = HYDROL_CWRR    
+       !Config Def   = 0.0
+       !Config Help  = The initial value of free drainage if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = [mm]
+       !
+       CALL setvar_p (water2infilt, val_exp, 'WATER_TO_INFILT', zero)
+       !
+       !Config Key   = EVAPNU_SOIL
+       !Config Desc  = Bare soil evap on each soil if not found in restart
+       !Config If    = HYDROL_CWRR  
+       !Config Def   = 0.0
+       !Config Help  = The initial value of bare soils evap if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = [mm]
+       !
+       CALL setvar_p (ae_ns, val_exp, 'EVAPNU_SOIL', zero)
+       !
+       !Config Key  = HYDROL_SNOW
+       !Config Desc  = Initial snow mass if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of snow mass if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units =
+       !
+       CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', zero)
+       !
+       !Config Key   = HYDROL_SNOWAGE
+       !Config Desc  = Initial snow age if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of snow age if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = ***
+       !
+       CALL setvar_p (snow_age, val_exp, 'HYDROL_SNOWAGE', zero)
+       !
+       !Config Key   = HYDROL_SNOW_NOBIO
+       !Config Desc  = Initial snow amount on ice, lakes, etc. if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of snow if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = [mm]
+       !
+       CALL setvar_p (snow_nobio, val_exp, 'HYDROL_SNOW_NOBIO', zero)
+       !
+       !Config Key   = HYDROL_SNOW_NOBIO_AGE
+       !Config Desc  = Initial snow age on ice, lakes, etc. if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of snow age if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units = ***
+       !
+       CALL setvar_p (snow_nobio_age, val_exp, 'HYDROL_SNOW_NOBIO_AGE', zero)
+       !
+       !Config Key   = HYDROL_QSV
+       !Config Desc  = Initial water on canopy if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of moisture on canopy if its value 
+       !Config         is not found in the restart file. This should only be used if
+       !Config         the model is started without a restart file. 
+       !Config Units = [mm]
+       !
+       CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', zero)
+
+    !! 6 Vegetation array      
+       !
+       ! If resdist is not in restart file, initialize with soiltile
+       IF ( MINVAL(resdist) .EQ.  MAXVAL(resdist) .AND. MINVAL(resdist) .EQ. val_exp) THEN
+          resdist(:,:) = soiltile(:,:)
+       ENDIF
+       !
+       !  Remember that it is only frac_nobio + SUM(veget_max(,:)) that is equal to 1. Thus we need vegtot
+       !
+       DO ji = 1, kjpindex
+          vegtot(ji) = SUM(veget_max(ji,:))
+       ENDDO
+       !
+       !
+       ! compute the masks for veget
+
+
+       mask_veget(:,:) = 0
+       mask_soiltile(:,:) = 0
+
+       DO jst=1,nstm
+          DO ji = 1, kjpindex
+             IF(soiltile(ji,jst) .GT. min_sechiba) THEN
+                mask_soiltile(ji,jst) = 1
+             ENDIF
+          END DO
+       ENDDO
+          
+       DO jv = 1, nvm
+          DO ji = 1, kjpindex
+             IF(veget_max(ji,jv) .GT. min_sechiba) THEN
+                mask_veget(ji,jv) = 1
+             ENDIF
+          END DO
+       END DO
+          
+    !! 7. set humrelv from us
+! soiltile(ji,jst) * cvs_over_veg(ji,jv,jst) * vegtot(ji) = 1 if PFT jv belongs to soiltile jst
+!                                                         = 0 else
+! here cvs_over_veg defines the vegetation cover of the previous timestep, consistently with vegstressv and humrelv
+
+       humrelv(:,:,:) = SUM(us,dim=4)
+       vegstressv(:,:,:) = humrelv(:,:,:)
+
+       CALL setvar_p (cvs_over_veg, val_exp, 'NO_KEYWORD', un)
+
+       DO jst=1,nstm
+          DO jv=1,nvm
+             DO ji=1,kjpindex
+                vegstress(ji,jv)=vegstress(ji,jv) + vegstressv(ji,jv,jst) * &
+                     & soiltile(ji,jst) * cvs_over_veg(ji,jv,jst) * vegtot(ji)
+             END DO
+          END DO
+       END DO
+   
+       ! Read humrel from restart file
+       var_name= 'humrel'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '')
+          CALL ioconf_setatt_p('LONG_NAME','Relative humidity')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., humrel, "gather", nbp_glo, index_g)
+
+       ! Calculate humrel if it is not found in restart file
+       IF (ALL(humrel(:,:)==val_exp)) THEN
+          ! set humrel from humrelv, assuming equi-repartition for the first time step
+          humrel(:,:) = zero
+          DO jst=1,nstm
+             DO jv=1,nvm
+                DO ji=1,kjpindex
+                   humrel(ji,jv)=humrel(ji,jv) + humrelv(ji,jv,jst) * & 
+                        & soiltile(ji,jst) * cvs_over_veg(ji,jv,jst) * vegtot(ji)
+                   humrel(ji,jv)=MAX(humrel(ji,jv), zero)* mask_veget(ji,jv)           
+                END DO
+             END DO
+          END DO
+       END IF
+
+       ! Read evap_bare_lim from restart file
+       var_name= 'evap_bare_lim'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '')
+          CALL ioconf_setatt_p('LONG_NAME','Limitation factor for bare soil evaporation')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., evap_bare_lim, "gather", nbp_glo, index_g)
+
+       ! Calculate evap_bare_lim if it was not found in the restart file.
+       IF ( ALL(evap_bare_lim(:) == val_exp) ) THEN
+          DO ji = 1, kjpindex
+             evap_bare_lim(ji) =  SUM(evap_bare_lim_ns(ji,:)*vegtot(ji)*soiltile(ji,:))
+          ENDDO
+       END IF
+
+
+    ! Read from restart file       
+    ! The variables tot_watsoil_beg, tot_watsoil_beg and snwo_beg will be initialized in the end of 
+    ! hydrol_initialize if they were not found in the restart file.
+       
+    var_name= 'tot_watveg_beg'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', '?')
+       CALL ioconf_setatt_p('LONG_NAME','?')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tot_watveg_beg, "gather", nbp_glo, index_g)
+    
+    var_name= 'tot_watsoil_beg'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', '?')
+       CALL ioconf_setatt_p('LONG_NAME','?')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tot_watsoil_beg, "gather", nbp_glo, index_g)
+    
+    var_name= 'snow_beg'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p('UNITS', '?')
+       CALL ioconf_setatt_p('LONG_NAME','?')
+    ENDIF
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., snow_beg, "gather", nbp_glo, index_g)
+       
+ 
+    ! Initialize variables for explictsnow module by reading restart file
+    IF (ok_explicitsnow) THEN
+       CALL explicitsnow_initialize( kjit,     kjpindex, rest_id,    snowrho,   &
+                                     snowtemp, snowdz,   snowheat,   snowgrain)
+    END IF
+
+    
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_init done '
+    
+  END SUBROUTINE hydrol_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_clear
+!!
+!>\BRIEF        Deallocate arrays 
+!!
+!_ ================================================================================================================================
+!_ hydrol_clear
+
+  SUBROUTINE hydrol_clear()
+
+    ! Allocation for soiltile related parameters
+    IF ( ALLOCATED (nvan)) DEALLOCATE (nvan)
+    IF ( ALLOCATED (avan)) DEALLOCATE (avan)
+    IF ( ALLOCATED (mcr)) DEALLOCATE (mcr)
+    IF ( ALLOCATED (mcs)) DEALLOCATE (mcs)
+    IF ( ALLOCATED (ks)) DEALLOCATE (ks)
+    IF ( ALLOCATED (pcent)) DEALLOCATE (pcent)
+    IF ( ALLOCATED (mcf)) DEALLOCATE (mcf)
+    IF ( ALLOCATED (mcw)) DEALLOCATE (mcw)
+    IF ( ALLOCATED (mc_awet)) DEALLOCATE (mc_awet)
+    IF ( ALLOCATED (mc_adry)) DEALLOCATE (mc_adry)
+    ! Other arrays
+    IF (ALLOCATED (mask_veget)) DEALLOCATE (mask_veget)
+    IF (ALLOCATED (mask_soiltile)) DEALLOCATE (mask_soiltile)
+    IF (ALLOCATED (humrelv)) DEALLOCATE (humrelv)
+    IF (ALLOCATED (vegstressv)) DEALLOCATE (vegstressv)
+    IF (ALLOCATED (us)) DEALLOCATE (us)
+    IF (ALLOCATED  (precisol)) DEALLOCATE (precisol)
+    IF (ALLOCATED  (precisol_ns)) DEALLOCATE (precisol_ns)
+    IF (ALLOCATED  (free_drain_coef)) DEALLOCATE (free_drain_coef)
+    IF (ALLOCATED  (frac_bare_ns)) DEALLOCATE (frac_bare_ns)
+    IF (ALLOCATED  (water2infilt)) DEALLOCATE (water2infilt)
+    IF (ALLOCATED  (ae_ns)) DEALLOCATE (ae_ns)
+    IF (ALLOCATED  (evap_bare_lim_ns)) DEALLOCATE (evap_bare_lim_ns)
+    IF (ALLOCATED  (rootsink)) DEALLOCATE (rootsink)
+    IF (ALLOCATED  (subsnowveg)) DEALLOCATE (subsnowveg)
+    IF (ALLOCATED  (subsnownobio)) DEALLOCATE (subsnownobio)
+    IF (ALLOCATED  (icemelt)) DEALLOCATE (icemelt)
+    IF (ALLOCATED  (subsinksoil)) DEALLOCATE (subsinksoil)
+    IF (ALLOCATED  (mx_eau_var)) DEALLOCATE (mx_eau_var)
+    IF (ALLOCATED  (vegtot)) DEALLOCATE (vegtot)
+    IF (ALLOCATED  (resdist)) DEALLOCATE (resdist)
+    IF (ALLOCATED  (tot_water_beg)) DEALLOCATE (tot_water_beg)
+    IF (ALLOCATED  (tot_water_end)) DEALLOCATE (tot_water_end)
+    IF (ALLOCATED  (tot_flux)) DEALLOCATE (tot_flux)
+    IF (ALLOCATED  (tot_watveg_beg)) DEALLOCATE (tot_watveg_beg)
+    IF (ALLOCATED  (tot_watveg_end)) DEALLOCATE (tot_watveg_end)
+    IF (ALLOCATED  (tot_watsoil_beg)) DEALLOCATE (tot_watsoil_beg)
+    IF (ALLOCATED  (tot_watsoil_end)) DEALLOCATE (tot_watsoil_end)
+    IF (ALLOCATED  (delsoilmoist)) DEALLOCATE (delsoilmoist)
+    IF (ALLOCATED  (delintercept)) DEALLOCATE (delintercept)
+    IF (ALLOCATED  (snow_beg)) DEALLOCATE (snow_beg)
+    IF (ALLOCATED  (snow_end)) DEALLOCATE (snow_end)
+    IF (ALLOCATED  (delswe)) DEALLOCATE (delswe)
+    IF (ALLOCATED  (swi)) DEALLOCATE (swi)
+    IF (ALLOCATED  (v1)) DEALLOCATE (v1)
+    IF (ALLOCATED  (humtot)) DEALLOCATE (humtot)
+    IF (ALLOCATED  (resolv)) DEALLOCATE (resolv)
+    IF (ALLOCATED  (k)) DEALLOCATE (k)
+    IF (ALLOCATED  (kk)) DEALLOCATE (kk)
+    IF (ALLOCATED  (kk_moy)) DEALLOCATE (kk_moy)
+    IF (ALLOCATED  (a)) DEALLOCATE (a)
+    IF (ALLOCATED  (b)) DEALLOCATE (b)
+    IF (ALLOCATED  (d)) DEALLOCATE (d)
+    IF (ALLOCATED  (e)) DEALLOCATE (e)
+    IF (ALLOCATED  (f)) DEALLOCATE (f)
+    IF (ALLOCATED  (g1)) DEALLOCATE (g1)
+    IF (ALLOCATED  (ep)) DEALLOCATE (ep)
+    IF (ALLOCATED  (fp)) DEALLOCATE (fp)
+    IF (ALLOCATED  (gp)) DEALLOCATE (gp)
+    IF (ALLOCATED  (rhs)) DEALLOCATE (rhs)
+    IF (ALLOCATED  (srhs)) DEALLOCATE (srhs)
+    IF (ALLOCATED  (tmc)) DEALLOCATE (tmc)
+    IF (ALLOCATED  (tmcs)) DEALLOCATE (tmcs)
+    IF (ALLOCATED  (tmcr)) DEALLOCATE (tmcr)
+    IF (ALLOCATED  (tmc_litter)) DEALLOCATE (tmc_litter)
+    IF (ALLOCATED  (tmc_litt_mea)) DEALLOCATE (tmc_litt_mea)
+    IF (ALLOCATED  (tmc_litter_res)) DEALLOCATE (tmc_litter_res)
+    IF (ALLOCATED  (tmc_litter_wilt)) DEALLOCATE (tmc_litter_wilt)
+    IF (ALLOCATED  (tmc_litter_field)) DEALLOCATE (tmc_litter_field)
+    IF (ALLOCATED  (tmc_litter_sat)) DEALLOCATE (tmc_litter_sat)
+    IF (ALLOCATED  (tmc_litter_awet)) DEALLOCATE (tmc_litter_awet)
+    IF (ALLOCATED  (tmc_litter_adry)) DEALLOCATE (tmc_litter_adry)
+    IF (ALLOCATED  (tmc_litt_wet_mea)) DEALLOCATE (tmc_litt_wet_mea)
+    IF (ALLOCATED  (tmc_litt_dry_mea)) DEALLOCATE (tmc_litt_dry_mea)
+    IF (ALLOCATED  (qflux00)) DEALLOCATE (qflux00)
+    IF (ALLOCATED  (ru_ns)) DEALLOCATE (ru_ns)
+    IF (ALLOCATED  (dr_ns)) DEALLOCATE (dr_ns)
+    IF (ALLOCATED  (tr_ns)) DEALLOCATE (tr_ns)
+    IF (ALLOCATED  (cvs_over_veg)) DEALLOCATE (cvs_over_veg)
+    IF (ALLOCATED  (corr_veg_soil)) DEALLOCATE (corr_veg_soil)
+    IF (ALLOCATED  (mc)) DEALLOCATE (mc)
+    IF (ALLOCATED  (soilmoist)) DEALLOCATE (soilmoist)
+    IF (ALLOCATED  (soil_wet)) DEALLOCATE (soil_wet)
+    IF (ALLOCATED  (soil_wet_litter)) DEALLOCATE (soil_wet_litter)
+    IF (ALLOCATED  (qflux)) DEALLOCATE (qflux)
+    IF (ALLOCATED  (tmat)) DEALLOCATE (tmat)
+    IF (ALLOCATED  (stmat)) DEALLOCATE (stmat)
+    IF (ALLOCATED  (nroot)) DEALLOCATE (nroot)
+    IF (ALLOCATED  (kfact_root)) DEALLOCATE (kfact_root)
+    IF (ALLOCATED  (kfact)) DEALLOCATE (kfact)
+    IF (ALLOCATED  (zz)) DEALLOCATE (zz)
+    IF (ALLOCATED  (dz)) DEALLOCATE (dz)
+    IF (ALLOCATED  (dh)) DEALLOCATE (dh)
+    IF (ALLOCATED  (mc_lin)) DEALLOCATE (mc_lin)
+    IF (ALLOCATED  (k_lin)) DEALLOCATE (k_lin)
+    IF (ALLOCATED  (d_lin)) DEALLOCATE (d_lin)
+    IF (ALLOCATED  (a_lin)) DEALLOCATE (a_lin)
+    IF (ALLOCATED  (b_lin)) DEALLOCATE (b_lin)
+    IF (ALLOCATED  (frac_hydro_diag)) DEALLOCATE (frac_hydro_diag)
+    
+
+  END SUBROUTINE hydrol_clear
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_tmc_update
+!!
+!>\BRIEF        This routine updates the soil moisture profiles when the vegetation fraction have changed. 
+!!
+!! DESCRIPTION  :
+!! 
+!!    This routine update tmc and mc with variation of veget_max (LAND_USE or DGVM activated)
+!! 
+!!
+!!
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_tmc_update
+  SUBROUTINE hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, resdist )
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                          :: kjpindex      !! domain size
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget_max     !! max fraction of vegetation type
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile      !! Fraction of each soil tile (0-1, unitless)
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)   :: qsintveg   !! Amount of water in the canopy interception 
+    REAL(r_std), DIMENSION (kjpindex, nstm), INTENT(inout) :: resdist    !! Soiltile from previous time-step
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                           :: ji, jv, jst,jsl
+    LOGICAL                                  :: soil_upd        !! True if soiltile changed since last time step
+    LOGICAL                                  :: error=.FALSE.   !! If true, exit in the end of subroutine
+    REAL(r_std), DIMENSION(kjpindex,nstm)    :: vmr             !! Change in soiltile
+    REAL(r_std), DIMENSION(kjpindex)         :: vmr_sum
+    REAL(r_std), DIMENSION(kjpindex,nslm)    :: mc_dilu         !! Total loss of moisture content
+    REAL(r_std), DIMENSION(kjpindex)         :: infil_dilu      !! Total loss for water2infilt
+    REAL(r_std), DIMENSION(kjpindex,nstm)    :: tmc_old         !! tmc before calculations
+    REAL(r_std), DIMENSION(kjpindex,nstm)    :: water2infilt_old!! water2infilt before calculations
+    REAL(r_std), DIMENSION (kjpindex,nvm)    :: qsintveg_old    !! qsintveg before calculations
+    REAL(r_std), DIMENSION(kjpindex)         :: test
+
+    !! 0. Check if soiltiles changed since last time step
+    soil_upd=SUM(ABS(soiltile(:,:)-resdist(:,:))) .GT. zero
+    IF (printlev>=3) WRITE (numout,*) 'soil_upd ', soil_upd
+
+    IF (check_cwrr) THEN
+       ! Save soil moisture for later use
+       tmc_old(:,:) = tmc(:,:) 
+       water2infilt_old(:,:) = water2infilt(:,:)
+       qsintveg_old(:,:) = qsintveg(:,:)
+    ENDIF
+
+    !! 1. If a PFT has disapperead as result from a veget_max change, 
+    !!    then add canopy water to surface water.
+
+    DO ji=1,kjpindex
+       DO jv=1,nvm
+          IF ((veget_max(ji,jv).LT.min_sechiba).AND.(qsintveg(ji,jv).GT.0.)) THEN
+             jst=pref_soil_veg(jv) ! soil tile index
+             water2infilt(ji,jst) = water2infilt(ji,jst) + qsintveg(ji,jv)/resdist(ji,jst)
+             qsintveg(ji,jv) = zero
+          ENDIF
+       ENDDO
+    ENDDO
+    
+    !! 2. Compute new soil moisture if soiltile changed due to veget_max's change
+    IF (soil_upd) THEN
+       !! 2.1 Define the change in soiltile
+       vmr(:,:) = soiltile(:,:) - resdist(:,:)  ! resdist is the previous values of soiltiles 
+
+       ! Total area loss by the three soil tiles
+       DO ji=1,kjpindex
+          vmr_sum(ji)=SUM(vmr(ji,:),MASK=vmr(ji,:).LT.zero)
+       ENDDO
+
+       !! 2.2 Shrinking soil tiles
+       !! 2.2.1 Total loss of moisture content from the shrinking soil tiles, expressed by soil layer
+       mc_dilu(:,:)=zero
+       DO jst=1,nstm
+          DO jsl = 1, nslm
+             DO ji=1,kjpindex
+                IF ( vmr(ji,jst) < zero ) THEN
+                   mc_dilu(ji,jsl) = mc_dilu(ji,jsl) + mc(ji,jsl,jst) * vmr(ji,jst) / vmr_sum(ji)
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+
+       !! 2.2.2 Total loss of water2inft from the shrinking soil tiles
+       infil_dilu(:)=zero
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF ( vmr(ji,jst) < zero ) THEN
+                infil_dilu(ji) = infil_dilu(ji) + water2infilt(ji,jst) * vmr(ji,jst) / vmr_sum(ji)
+             ENDIF
+          ENDDO
+       ENDDO
+
+       !! 2.3 Each gaining soil tile gets moisture proportionally to both the total loss and its areal increase 
+
+       ! As the original mc from each soil tile are in [mcr,mcs] and we do weighted avrage, the new mc are in [mcr,mcs]
+       ! The case where the soiltile is created (soiltile_old=0) works as the other cases
+
+       ! 2.3.1 Update mc(kjpindex,nslm,nstm) !m3/m3
+       DO jst=1,nstm
+          DO jsl = 1, nslm
+             DO ji=1,kjpindex
+                IF ( vmr(ji,jst) > zero ) THEN
+                   mc(ji,jsl,jst) = ( mc(ji,jsl,jst) * resdist(ji,jst) + mc_dilu(ji,jsl) * vmr(ji,jst) ) / soiltile(ji,jst)
+                   ! NB : soiltile can not be zero for case vmr > zero, see slowproc_veget
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+       
+       ! 2.3.2 Update water2inft
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF ( vmr(ji,jst) > zero ) THEN !donc soiltile>0     
+                water2infilt(ji,jst) = ( water2infilt(ji,jst) * resdist(ji,jst) + infil_dilu(ji) * vmr(ji,jst) ) / soiltile(ji,jst)
+             ENDIF !donc resdist>0
+          ENDDO
+       ENDDO
+
+       ! 2.3.3 Case where soiltile < min_sechiba 
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF ( soiltile(ji,jst) .LT. min_sechiba ) THEN
+                water2infilt(ji,jst) = zero
+                mc(ji,:,jst) = zero
+             ENDIF
+          ENDDO
+       ENDDO
+
+
+    ENDIF ! soil_upd 
+
+
+    !2.3.3 we compute tmc(kjpindex,nstm) and humtot!
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+             tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+             DO jsl = 2,nslm-1
+                tmc(ji,jst) = tmc(ji,jst) + dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                     + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+             ENDDO
+             tmc(ji,jst) = tmc(ji,jst) + dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+             tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
+             ! WARNING tmc is increased by water2infilt(ji,jst), but mc is not modified !
+       ENDDO
+    ENDDO
+
+    humtot(:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          humtot(ji) = humtot(ji) + soiltile(ji,jst) * tmc(ji,jst)
+       ENDDO
+    ENDDO
+
+    !! 4 check
+    IF (check_cwrr) THEN
+       DO ji=1,kjpindex
+          test(ji) = ABS(SUM(tmc(ji,:)*soiltile(ji,:)) - SUM(tmc_old(ji,:)*resdist(ji,:)) + &
+               SUM(qsintveg(ji,:)) - SUM(qsintveg_old(ji,:))) ! sum(soiltile)=1
+          IF ( test(ji) .GT.  10.*allowed_err ) THEN
+             WRITE(numout,*) 'tmc update WRONG: ji',ji
+             WRITE(numout,*) 'tot water avant:',SUM(tmc_old(ji,:)*resdist(ji,:)) + SUM(qsintveg_old(ji,:))
+             WRITE(numout,*) 'tot water apres:',SUM(tmc(ji,:)*soiltile(ji,:)) + SUM(qsintveg(ji,:))
+             WRITE(numout,*) 'err:',test(ji)
+             WRITE(numout,*) 'allowed_err:',allowed_err
+             WRITE(numout,*) 'tmc:',tmc(ji,:)
+             WRITE(numout,*) 'tmc_old:',tmc_old(ji,:)
+             WRITE(numout,*) 'qsintveg:',qsintveg(ji,:)
+             WRITE(numout,*) 'qsintveg_old:',qsintveg_old(ji,:)
+             WRITE(numout,*) 'SUMqsintveg:',SUM(qsintveg(ji,:))
+             WRITE(numout,*) 'SUMqsintveg_old:',SUM(qsintveg_old(ji,:))
+             WRITE(numout,*) 'veget_max:',veget_max(ji,:)
+             WRITE(numout,*) 'soiltile:',soiltile(ji,:)
+             WRITE(numout,*) 'resdist:',resdist(ji,:)
+             WRITE(numout,*) 'vmr:',vmr(ji,:)
+             WRITE(numout,*) 'vmr_sum:',vmr_sum(ji)
+             DO jst=1,nstm
+                WRITE(numout,*) 'mc(',jst,'):',mc(ji,:,jst)
+             ENDDO
+             WRITE(numout,*) 'water2infilt:',water2infilt(ji,:)
+             WRITE(numout,*) 'water2infilt_old:',water2infilt_old(ji,:)
+             WRITE(numout,*) 'infil_dilu:',infil_dilu(ji)
+             WRITE(numout,*) 'mc_dilu:',mc_dilu(ji,:)
+
+             error=.TRUE.
+             CALL ipslerr_p(2, 'hydrol_tmc_update', 'Error in water balance', 'We STOP in the end of this subroutine','')
+          ENDIF
+       ENDDO
+    ENDIF
+
+    !! Now that the work is done, update resdist
+    resdist(:,:) = soiltile(:,:)
+
+    !
+    !!  Exit if error was found previously in this subroutine
+    !
+    IF ( error ) THEN
+       WRITE(numout,*) 'One or more errors have been detected in hydrol_tmc_update. Model stops.'
+       CALL ipslerr_p(3, 'hydrol_tmc_update', 'We will STOP now.',&
+                  & 'One or several fatal errors were found previously.','')
+    END IF
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_tmc_update done '
+
+  END SUBROUTINE hydrol_tmc_update
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_var_init
+!!
+!>\BRIEF        This routine initializes hydrologic parameters to define K and D, and diagnostic hydrologic variables.  
+!!
+!! DESCRIPTION  :
+!! - 1 compute the depths
+!! - 2 compute the profile for roots
+!! - 3 compute the profile for ksat, a and n Van Genuchten parameter
+!! - 4 compute the linearized values of k, a, b and d for the resolution of Fokker Planck equation
+!! - 5 water reservoirs initialisation
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_var_init
+
+  SUBROUTINE hydrol_var_init (kjpindex, veget, veget_max, soiltile, njsc, &
+       mx_eau_var, shumdiag_perma, k_litt, &
+       drysoil_frac, qsintveg, mc_layh, mcl_layh, tmc_layh) 
+
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                          :: kjpindex      !! Domain size (number of grid cells) (1)
+    ! input fields
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget_max     !! PFT fractions within grid-cells (1; 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget         !! Effective fraction of vegetation by PFT (1; 1)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: njsc          !! Index of the dominant soil textural class 
+                                                                         !! in the grid cell (1-nscm, unitless) 
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile      !! Fraction of each soil tile (0-1, unitless)
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: mx_eau_var    !! Maximum water content of the soil 
+                                                                         !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out) :: shumdiag_perma!! Percent of porosity filled with water (mc/mcs)
+                                                                         !! used for the thermal computations
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: k_litt        !! Mean litter hydraulic conductivity
+                                                                         !! @tex $(mm d^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)    :: drysoil_frac  !! function of litter humidity
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out):: mc_layh       !! Volumetric soil moisture content for each layer in hydrol(liquid+ice) [m3/m3]
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out):: mcl_layh      !! Volumetric soil moisture content for each layer in hydrol(liquid) [m3/m3]
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out):: tmc_layh      !! Total soil moisture content for each layer in hydrol(liquid+ice) [mm]
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)  :: qsintveg    !! Water on vegetation due to interception
+                                                                         !! @tex $(kg m^{-2})$ @endtex  
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jv        !! Grid-cell and PFT indices (1)
+    INTEGER(i_std)                                      :: jst, jsc, jsl !! Soiltile, Soil Texture, and Soil layer indices (1)
+    INTEGER(i_std)                                      :: i, jd         !! Index (1)
+    REAL(r_std)                                         :: m             !! m=1-1/n (unitless)
+    REAL(r_std)                                         :: frac          !! Relative linearized VWC (unitless)
+    REAL(r_std)                                         :: avan_mod      !! VG parameter a modified from  exponantial profile
+                                                                         !! @tex $(mm^{-1})$ @endtex
+    REAL(r_std)                                         :: nvan_mod      !! VG parameter n  modified from  exponantial profile
+                                                                         !! (unitless)
+    REAL(r_std), DIMENSION(nslm,nscm)                   :: afact, nfact  !! Multiplicative factor for decay of a and n with depth
+                                                                         !! (unitless)
+    ! parameters for "soil densification" with depth
+    REAL(r_std)                                         :: dp_comp       !! Depth at which the 'compacted' value of ksat
+                                                                         !! is reached (m)
+    REAL(r_std)                                         :: f_ks          !! Exponential factor for decay of ksat with depth 
+                                                                         !! @tex $(m^{-1})$ @endtex 
+    ! Fixed parameters from fitted relationships
+    REAL(r_std)                                         :: n0            !! fitted value for relation log((n-n0)/(n_ref-n0)) = 
+                                                                         !! nk_rel * log(k/k_ref) 
+                                                                         !! (unitless)
+    REAL(r_std)                                         :: nk_rel        !! fitted value for relation log((n-n0)/(n_ref-n0)) = 
+                                                                         !! nk_rel * log(k/k_ref) 
+                                                                         !! (unitless)
+    REAL(r_std)                                         :: a0            !! fitted value for relation log((a-a0)/(a_ref-a0)) = 
+                                                                         !! ak_rel * log(k/k_ref) 
+                                                                         !! @tex $(mm^{-1})$ @endtex
+    REAL(r_std)                                         :: ak_rel        !! fitted value for relation log((a-a0)/(a_ref-a0)) = 
+                                                                         !! ak_rel * log(k/k_ref)
+                                                                         !! (unitless) 
+    REAL(r_std)                                         :: kfact_max     !! Maximum factor for Ks decay with depth (unitless)
+    REAL(r_std)                                         :: k_tmp, tmc_litter_ratio
+    INTEGER(i_std), PARAMETER                           :: error_level = 3 !! Error level for consistency check
+                                                                           !! Switch to 2 tu turn fatal errors into warnings
+    REAL(r_std), DIMENSION (kjpindex,nslm,nstm)         :: tmc_layh_s      !! total soil moisture content for each layer in hydrol and for each soiltile (mm)
+    INTEGER(i_std)                                      :: jiref           !! To identify the mc_lins where k_lin and d_lin 
+                                                                           !! need special treatment
+
+!_ ================================================================================================================================
+
+!!??Aurelien: Les 3 parametres qui suient pourait peut-être mis dans hydrol_init?
+    !
+    !
+    !Config Key   = CWRR_NKS_N0 
+    !Config Desc  = fitted value for relation log((n-n0)/(n_ref-n0)) = nk_rel * log(k/k_ref)
+    !Config Def   = 0.95
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =
+    !Config Units = [-]
+    n0 = 0.95
+    CALL getin_p("CWRR_NKS_N0",n0)
+
+    !! Check parameter value (correct range)
+    IF ( n0 < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for CWRR_NKS_N0.", &
+            &     "This parameter should be non-negative. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_NKS_POWER
+    !Config Desc  = fitted value for relation log((n-n0)/(n_ref-n0)) = nk_rel * log(k/k_ref)
+    !Config Def   = 0.34
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =
+    !Config Units = [-]
+    nk_rel = 0.34
+    CALL getin_p("CWRR_NKS_POWER",nk_rel)
+
+    !! Check parameter value (correct range)
+    IF ( nk_rel < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for CWRR_NKS_POWER.", &
+            &     "This parameter should be non-negative. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_AKS_A0 
+    !Config Desc  = fitted value for relation log((a-a0)/(a_ref-a0)) = ak_rel * log(k/k_ref)
+    !Config Def   = 0.00012
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =
+    !Config Units = [1/mm]
+    a0 = 0.00012
+    CALL getin_p("CWRR_AKS_A0",a0)
+
+    !! Check parameter value (correct range)
+    IF ( a0 < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for CWRR_AKS_A0.", &
+            &     "This parameter should be non-negative. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_AKS_POWER
+    !Config Desc  = fitted value for relation log((a-a0)/(a_ref-a0)) = ak_rel * log(k/k_ref)
+    !Config Def   = 0.53
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =
+    !Config Units = [-]
+    ak_rel = 0.53
+    CALL getin_p("CWRR_AKS_POWER",ak_rel)
+
+    !! Check parameter value (correct range)
+    IF ( nk_rel < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for CWRR_AKS_POWER.", &
+            &     "This parameter should be non-negative. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = KFACT_DECAY_RATE
+    !Config Desc  = Factor for Ks decay with depth
+    !Config Def   = 2.0
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =  
+    !Config Units = [1/m]
+    f_ks = 2.0
+    CALL getin_p ("KFACT_DECAY_RATE", f_ks)
+
+    !! Check parameter value (correct range)
+    IF ( f_ks <= zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for KFACT_DECAY_RATE.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = KFACT_STARTING_DEPTH
+    !Config Desc  = Depth for compacted value of Ks 
+    !Config Def   = 0.3
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =  
+    !Config Units = [m]
+    dp_comp = 0.3
+    CALL getin_p ("KFACT_STARTING_DEPTH", dp_comp)
+
+    !! Check parameter value (correct range)
+    IF ( dp_comp <= zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for KFACT_STARTING_DEPTH.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = KFACT_MAX
+    !Config Desc  = Maximum Factor for Ks increase due to vegetation
+    !Config Def   = 10.0
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =
+    !Config Units = [-]
+    kfact_max = 10.0
+    CALL getin_p ("KFACT_MAX", kfact_max)
+
+    !! Check parameter value (correct range)
+    IF ( kfact_max < 10. ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for KFACT_MAX.", &
+            &     "This parameter should be greater than 10. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+    
+    !-
+    !! 1 Depths are stored in module vertical_soil_var
+    !-
+    ! Transform from m into mm
+    DO jsl=1,nslm
+       zz(jsl) = znh(jsl)*mille
+       dz(jsl) = dnh(jsl)*mille
+       dh(jsl) = dlh(jsl)*mille
+    ENDDO
+    zz(nslm+1) = zz(nslm)
+
+    ! ** AD ** there are a lot of confusions among soiltiles and texture classes !
+    DO jst=1,nstm ! ** AD ** loop on soiltiles ; here it shoud be independent from the soiltiles
+
+       !-
+       !! 2 compute the root density profile
+       !-
+       !! The three following equations concerning nroot computation are derived from the integrals 
+       !! of equations C9 to C11 of De Rosnay's (1999) PhD thesis (page 158).
+       !! The occasional absence of minus sign before humcste parameter is correct.
+       DO jv = 1,nvm
+          DO jsl = 2, nslm-1
+             nroot(jv,jst,jsl) = (EXP(-humcste(jv)*zz(jsl)/mille)) * &
+                     & (EXP(humcste(jv)*dz(jsl)/mille/deux) - &
+                     & EXP(-humcste(jv)*dz(jsl+1)/mille/deux))/ &
+                     & (EXP(-humcste(jv)*dz(2)/mille/deux) &
+                     & -EXP(-humcste(jv)*zz(nslm)/mille))
+          ENDDO
+       ENDDO
+       DO jv=1,nvm
+          nroot(jv,jst,1) = zero
+          nroot(jv,jst,nslm) = (EXP(humcste(jv)*dz(nslm)/mille/deux) -un) * &
+                  & EXP(-humcste(jv)*zz(nslm)/mille) / &
+                  & (EXP(-humcste(jv)*dz(2)/mille/deux) &
+                  & -EXP(-humcste(jv)*zz(nslm)/mille))
+       ENDDO
+    ENDDO
+
+       !! An exponential factor is used to increase ks near the surface depending on the amount of roots in the soil 
+       !! through a geometric average over the vegets
+       !! This comes from the PhD thesis of d'Orgeval, 2006, p82; d'Orgeval et al. 2008, Eqs. 3-4
+       !! (Calibrated against Hapex-Sahel measurements)
+    kfact_root(:,:,:) = un
+    DO jsl = 1, nslm
+       DO jv = 2, nvm
+          jst = pref_soil_veg(jv)
+          DO ji = 1, kjpindex
+             IF(soiltile(ji,jst) .GT. min_sechiba) THEN
+                kfact_root(ji,jsl,jst) = kfact_root(ji,jsl,jst) * &
+                     & MAX((MAXVAL(ks_usda)/ks(njsc(ji)))**(- veget_max(ji,jv)/2 * (humcste(jv)*zz(jsl)/mille - un)/deux), &
+                     un) 
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDDO
+    !-
+    !! 3 Compute the profile for ksat, a and n
+    !-
+
+    ! For every soil texture
+    DO jsc = 1, nscm ! ** AD ** loop on soil textures, using zz defined on soiltiles
+       DO jsl=1,nslm
+          ! PhD thesis of d'Orgeval, 2006, p81, Eq. 4.38; d'Orgeval et al. 2008, Eq. 2
+          ! Calibrated against Hapex-Sahel measurements
+          kfact(jsl,jsc) = MIN(MAX(EXP(- f_ks * (zz(jsl)/mille - dp_comp)), un/kfact_max),un)
+          ! PhD thesis of d'Orgeval, 2006, p81, Eqs. 4.39; 4.42, and Fig 4.14 
+          
+          nfact(jsl,jsc) = ( kfact(jsl,jsc) )**nk_rel
+          afact(jsl,jsc) = ( kfact(jsl,jsc) )**ak_rel
+       ENDDO
+    ENDDO
+
+    ! For every soil texture
+    DO jsc = 1, nscm ! ** AD ** loop on soil textures, which is good here
+       !-
+       !! 4 compute the linearized values of k, a, b and d
+       !-
+       ! Calculate the matrix coef for Dublin model (de Rosnay, 1999; p149)
+       ! piece-wise linearised hydraulic conductivity k_lin=alin * mc_lin + b_lin
+       ! and diffusivity d_lin in each interval of mc, called mc_lin,
+       ! between imin, for residual mcr, and imax for saturation mcs.
+
+       ! We define 51 bounds for 50 bins of mc between mcr and mcs
+       mc_lin(imin,jsc)=mcr(jsc)
+       mc_lin(imax,jsc)=mcs(jsc)
+       DO ji= imin+1, imax-1 ! ji=2,50
+          mc_lin(ji,jsc) = mcr(jsc) + (ji-imin)*(mcs(jsc)-mcr(jsc))/(imax-imin)
+       ENDDO
+       DO jsl = 1, nslm
+          ! From PhD thesis of d'Orgeval, 2006, p81, Eq. 4.42
+          nvan_mod = n0 + (nvan(jsc)-n0) * nfact(jsl,jsc)
+          avan_mod = a0 + (avan(jsc)-a0) * afact(jsl,jsc)
+          m = un - un / nvan_mod
+          ! We apply Van Genuchten equation for K(theta) based on Ks(z)=ks(jsc) * kfact(jsl,jsc)
+          DO ji = imax,imin,-1 
+             frac=MIN(un,(mc_lin(ji,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
+             k_lin(ji,jsl,jsc) = ks(jsc) * kfact(jsl,jsc) * (frac**0.5) * ( un - ( un - frac ** (un/m)) ** m )**2
+          ENDDO
+
+          ! k_lin should not be zero, nor too small
+          ! We track jiref, the bin under which mc is too small and we may get zero k_lin     
+          ji=imax-1
+          DO WHILE ((k_lin(ji,jsl,jsc) > 1.e-32) .and. (ji>0))
+             jiref=ji
+             ji=ji-1
+          ENDDO
+          DO ji=jiref-1,imin,-1
+             k_lin(ji,jsl,jsc)=k_lin(ji+1,jsl,jsc)/10.
+          ENDDO
+         
+          DO ji = imin,imax-1 ! ji=1,50
+             ! We deduce a_lin and b_lin based on continuity between segments k_lin = a_lin*mc-lin+b_lin
+             a_lin(ji,jsl,jsc) = (k_lin(ji+1,jsl,jsc)-k_lin(ji,jsl,jsc)) / (mc_lin(ji+1,jsc)-mc_lin(ji,jsc))
+             b_lin(ji,jsl,jsc)  = k_lin(ji,jsl,jsc) - a_lin(ji,jsl,jsc)*mc_lin(ji,jsc)
+
+             ! We calculate the d_lin for each mc bin, from Van Genuchten equation for D(theta)
+             ! d_lin is constant and taken as the arithmetic mean between the values at the bounds of each bin 
+             IF (ji.NE.imin .AND. ji.NE.imax-1) THEN
+                frac=MIN(un,(mc_lin(ji,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
+                d_lin(ji,jsl,jsc) =(k_lin(ji,jsl,jsc) / (avan_mod*m*nvan_mod)) *  &
+                     ( (frac**(-un/m))/(mc_lin(ji,jsc)-mcr(jsc)) ) * &
+                     (  frac**(-un/m) -un ) ** (-m)
+                frac=MIN(un,(mc_lin(ji+1,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
+                d_lin(ji+1,jsl,jsc) =(k_lin(ji+1,jsl,jsc) / (avan_mod*m*nvan_mod))*&
+                     ( (frac**(-un/m))/(mc_lin(ji+1,jsc)-mcr(jsc)) ) * &
+                     (  frac**(-un/m) -un ) ** (-m)
+                d_lin(ji,jsl,jsc) = undemi * (d_lin(ji,jsl,jsc)+d_lin(ji+1,jsl,jsc))
+             ELSE IF(ji.EQ.imax-1) THEN
+                d_lin(ji,jsl,jsc) =(k_lin(ji,jsl,jsc) / (avan_mod*m*nvan_mod)) * &
+                     ( (frac**(-un/m))/(mc_lin(ji,jsc)-mcr(jsc)) ) *  &
+                     (  frac**(-un/m) -un ) ** (-m)
+             ENDIF
+          ENDDO
+
+          ! Special case for ji=imin
+          d_lin(imin,jsl,jsc) = d_lin(imin+1,jsl,jsc)/1000.
+
+          ! We adjust d_lin where k_lin was previously adjusted otherwise we might get non-monotonous variations
+          ! We don't want d_lin = zero
+          DO ji=jiref-1,imin,-1
+             d_lin(ji,jsl,jsc)=d_lin(ji+1,jsl,jsc)/10.
+          ENDDO
+
+       ENDDO
+    ENDDO
+    
+
+    !! 5 Water reservoir initialisation
+    !
+!!$    DO jst = 1,nstm
+!!$       DO ji = 1, kjpindex
+!!$          mx_eau_var(ji) = mx_eau_var(ji) + soiltile(ji,jst)*&
+!!$               &   zmaxh*mille*mcs(njsc(ji))
+!!$       END DO
+!!$    END DO
+!!$    IF (check_CWRR) THEN
+!!$       IF ( ANY ( ABS( mx_eau_var(:) - zmaxh*mille*mcs(njsc(:)) ) > min_sechiba ) ) THEN
+!!$          ji=MAXLOC ( ABS( mx_eau_var(:) - zmaxh*mille*mcs(njsc(:)) ) , 1)
+!!$          WRITE(numout, *) "Erreur formule simplifiÃÂ©e mx_eau_var ! ", mx_eau_var(ji), zmaxh*mille*mcs(njsc(ji))
+!!$          WRITE(numout, *) "err = ",ABS(mx_eau_var(ji) - zmaxh*mille*mcs(njsc(ji)))
+!!$          STOP 1
+!!$       ENDIF
+!!$    ENDIF
+
+    mx_eau_var(:) = zero
+    mx_eau_var(:) = zmaxh*mille*mcs(njsc(:)) 
+
+    DO ji = 1,kjpindex 
+       IF (vegtot(ji) .LE. zero) THEN
+          mx_eau_var(ji) = mx_eau_nobio*zmaxh
+          ! Aurelien: what does vegtot=0 mean? is it like frac_nobio=1? But if 0<frac_nobio<1 ???
+       ENDIF
+
+    END DO
+
+    ! Compute the litter humidity, shumdiag_perma and fry
+    k_litt(:) = zero
+    tmc_litt_mea(:) = zero
+    tmc_litt_wet_mea(:) = zero
+    tmc_litt_dry_mea(:) = zero
+    shumdiag_perma(:,:) = zero
+    humtot(:) = zero
+    tmc(:,:) = zero
+
+    ! Loop on soiltiles to compute the variables (ji,jst)
+    DO jst=1,nstm 
+       DO ji = 1, kjpindex
+          tmcs(ji,jst)=zmaxh* mille*mcs(njsc(ji))
+          tmcr(ji,jst)=zmaxh* mille*mcr(njsc(ji))
+       ENDDO
+    ENDDO
+       
+    ! The total soil moisture for each soiltile:
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          tmc(ji,jst)= dz(2) * ( trois*mc(ji,1,jst)+ mc(ji,2,jst))/huit
+       END DO
+    ENDDO
+
+    DO jst=1,nstm 
+       DO jsl=2,nslm-1
+          DO ji=1,kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl) * ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1)*(trois*mc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
+          END DO
+       END DO
+    ENDDO
+
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          tmc(ji,jst) = tmc(ji,jst) +  dz(nslm) * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+          tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
+       ENDDO
+    END DO
+
+!JG: hydrol_tmc_update should not be called in the initialization phase. Call of hydrol_tmc_update makes the model restart differenlty.    
+!    ! If veget has been updated before restart (with LAND USE or DGVM),
+!    ! tmc and mc must be modified with respect to humtot conservation.
+!   CALL hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, resdist )
+
+    ! The litter variables:
+    ! level 1
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          tmc_litter(ji,jst) = dz(2) * (trois*mc(ji,1,jst)+mc(ji,2,jst))/huit
+          tmc_litter_wilt(ji,jst) = dz(2) * mcw(njsc(ji)) / deux
+          tmc_litter_res(ji,jst) = dz(2) * mcr(njsc(ji)) / deux
+          tmc_litter_field(ji,jst) = dz(2) * mcf(njsc(ji)) / deux
+          tmc_litter_sat(ji,jst) = dz(2) * mcs(njsc(ji)) / deux
+          tmc_litter_awet(ji,jst) = dz(2) * mc_awet(njsc(ji)) / deux
+          tmc_litter_adry(ji,jst) = dz(2) * mc_adry(njsc(ji)) / deux
+       ENDDO
+    END DO
+    ! sum from level 2 to 4
+    DO jst=1,nstm 
+       DO jsl=2,4
+          DO ji=1,kjpindex
+             tmc_litter(ji,jst) = tmc_litter(ji,jst) + dz(jsl) * & 
+                  & ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1)*(trois*mc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
+             tmc_litter_wilt(ji,jst) = tmc_litter_wilt(ji,jst) + &
+                  &(dz(jsl)+ dz(jsl+1))*& 
+                  & mcw(njsc(ji))/deux
+             tmc_litter_res(ji,jst) = tmc_litter_res(ji,jst) + &
+                  &(dz(jsl)+ dz(jsl+1))*& 
+                  & mcr(njsc(ji))/deux
+             tmc_litter_sat(ji,jst) = tmc_litter_sat(ji,jst) + &
+                  &(dz(jsl)+ dz(jsl+1))* & 
+                  & mcs(njsc(ji))/deux
+             tmc_litter_field(ji,jst) = tmc_litter_field(ji,jst) + &
+                  & (dz(jsl)+ dz(jsl+1))* & 
+                  & mcf(njsc(ji))/deux
+             tmc_litter_awet(ji,jst) = tmc_litter_awet(ji,jst) + &
+                  &(dz(jsl)+ dz(jsl+1))* & 
+                  & mc_awet(njsc(ji))/deux
+             tmc_litter_adry(ji,jst) = tmc_litter_adry(ji,jst) + &
+                  & (dz(jsl)+ dz(jsl+1))* & 
+                  & mc_adry(njsc(ji))/deux
+          END DO
+       END DO
+    END DO
+
+    ! Soil wetness profiles (mc-mcw)/(mcs-mcw)
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          soil_wet(ji,1,jst) = MIN(un, MAX(zero,&
+               &(trois*mc(ji,1,jst) + mc(ji,2,jst) - quatre*mcw(njsc(ji)))&
+               & /(quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+    !!??Aurelien: a quoi sert cette ligne?
+          humrelv(ji,1,jst) = zero
+       ENDDO
+    END DO
+
+    DO jst=1,nstm 
+       DO jsl=2,nslm-1
+          DO ji=1,kjpindex
+             soil_wet(ji,jsl,jst) = MIN(un, MAX(zero,&
+                  & (trois*mc(ji,jsl,jst) + & 
+                  & mc(ji,jsl-1,jst) *(dz(jsl)/(dz(jsl)+dz(jsl+1))) &
+                  & + mc(ji,jsl+1,jst)*(dz(jsl+1)/(dz(jsl)+dz(jsl+1))) &
+                  & - quatre*mcw(njsc(ji))) / (quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+          END DO
+       END DO
+    END DO
+
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          soil_wet(ji,nslm,jst) = MIN(un, MAX(zero,&
+               & (trois*mc(ji,nslm,jst) &
+               & + mc(ji,nslm-1,jst)-quatre*mcw(njsc(ji)))/(quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+       ENDDO
+    END DO
+
+    ! Compute the grid averaged values
+    DO jst=1,nstm        
+       DO ji=1,kjpindex
+          !
+          IF ( tmc_litter(ji,jst) < tmc_litter_res(ji,jst)) THEN
+             i = imin
+          ELSE
+             tmc_litter_ratio = (tmc_litter(ji,jst)-tmc_litter_res(ji,jst)) / &
+                  & (tmc_litter_sat(ji,jst)-tmc_litter_res(ji,jst))
+             i= MAX(MIN(INT((imax-imin)*tmc_litter_ratio)+imin , imax-1), imin)
+          ENDIF
+          ! k_litt is an averaged conductivity for saturated infiltration in the 'litter' layer
+          ! This is used for reinfiltration from surface water
+          k_tmp = MAX(k_lin(i,1,njsc(ji))*ks(njsc(ji)), zero)
+          k_litt(ji) = k_litt(ji) + soiltile(ji,jst) * SQRT(k_tmp)
+       ENDDO
+    ENDDO
+
+    DO jst=1,nstm        
+       DO ji=1,kjpindex
+          tmc_litt_wet_mea(ji) =  tmc_litt_wet_mea(ji) + & 
+               & tmc_litter_awet(ji,jst)* soiltile(ji,jst)
+
+          tmc_litt_dry_mea(ji) = tmc_litt_dry_mea(ji) + &
+               & tmc_litter_adry(ji,jst) * soiltile(ji,jst) 
+
+          tmc_litt_mea(ji) = tmc_litt_mea(ji) + &
+               & tmc_litter(ji,jst) * soiltile(ji,jst) 
+       ENDDO
+    ENDDO
+
+    ! Caluculate frac_hydro_diag for interpolation between hydrological and diagnostic axes
+    CALL hydrol_calculate_frac_hydro_diag
+
+    ! Calculate shumdiag_perma
+    ! Use resdist instead of soiltile because we here need to have 
+    ! shumdiag at the value from previous time step. 
+    DO jst=1,nstm 
+       DO jd=1,nbdl
+          DO ji=1,kjpindex
+             DO jsl = 1, nslm
+                shumdiag_perma(ji,jd)= shumdiag_perma(ji,jd)  &
+                     + mc(ji,jsl,jst) *frac_hydro_diag(jsl,jd) &
+                     /mcs(njsc(ji))*resdist(ji,jst)
+             END DO
+             shumdiag_perma(ji,jd) = MAX(MIN(shumdiag_perma(ji,jd), un), zero) 
+          END DO
+       END DO
+    END DO
+    
+    ! Calculate soilmoist
+    soilmoist(:,:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+             soilmoist(ji,1) = soilmoist(ji,1) + soiltile(ji,jst) * &
+                  dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+             DO jsl = 2,nslm-1
+                soilmoist(ji,jsl) = soilmoist(ji,jsl) + soiltile(ji,jst) * &
+                     ( dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                     + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit )
+             END DO
+             soilmoist(ji,nslm) = soilmoist(ji,nslm) + soiltile(ji,jst) * &
+                  dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+       END DO
+    END DO
+
+
+    ! Calclate drysoil_frac if it was not found in the restart file
+    IF (ALL(drysoil_frac(:) == val_exp)) THEN
+       DO ji=1,kjpindex
+          IF ( tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji) > zero ) THEN
+             drysoil_frac(ji) = un + MAX( MIN( (tmc_litt_dry_mea(ji) - tmc_litt_mea(ji)) / &
+                  (tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji)), zero), - un)
+          ELSE
+             drysoil_frac(ji) = zero
+          ENDIF
+       END DO
+    END IF
+
+    !! Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in 
+    !! thermosoil for the thermal conductivity. Calculate also total soil moisture content(tmc_layh) 
+    !! needed in thermosoil for the heat capacity.
+    mc_layh(:,:) = zero
+    mcl_layh(:,:) = zero
+    tmc_layh(:,:) = zero
+    DO jst=1,nstm
+      DO ji=1,kjpindex
+         DO jsl=1,nslm
+            mc_layh(ji,jsl) = mc_layh(ji,jsl) + mc(ji,jsl,jst) * soiltile(ji,jst) 
+            mcl_layh(ji,jsl) = mc_layh(ji,jsl)
+         ENDDO
+         tmc_layh_s(ji,1,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit 
+         DO jsl = 2,nslm-1
+            tmc_layh_s(ji,jsl,jst) = dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit 
+         ENDDO
+         tmc_layh_s(ji,nslm,jst) = dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+         DO jsl = 1,nslm
+            tmc_layh(ji,jsl) = tmc_layh(ji,jsl) + tmc_layh_s(ji,jsl,jst) * soiltile(ji,jst)
+         ENDDO
+      END DO
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_var_init done '
+
+  END SUBROUTINE hydrol_var_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_snow
+!!
+!>\BRIEF        This routine computes snow processes. 
+!!
+!! DESCRIPTION  :
+!! - 0 initialisation
+!! - 1 On vegetation
+!! - 1.1 Compute snow masse
+!! - 1.2 Sublimation 
+!! - 1.2.1 Check that sublimation on the vegetated fraction is possible.
+!! - 1.3. snow melt only if temperature positive
+!! - 1.3.1 enough snow for melting or not
+!! - 1.3.2 not enough snow
+!! - 1.3.3 negative snow - now snow melt
+!! - 1.4 Snow melts only on weight glaciers
+!! - 2 On Land ice
+!! - 2.1 Compute snow
+!! - 2.2 Sublimation 
+!! - 2.3 Snow melt only for continental ice fraction
+!! - 2.3.1 If there is snow on the ice-fraction it can melt
+!! - 2.4 Snow melts only on weight glaciers 
+!! - 3 On other surface types - not done yet
+!! - 4 computes total melt (snow and ice)
+!! - 5 computes snow age on veg and ice (for albedo)
+!! - 5.1 Snow age on vegetation
+!! - 5.2 Snow age on ice
+!! - 6 Diagnose the depth of the snow layer
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_snow
+
+  SUBROUTINE hydrol_snow (kjpindex, precip_rain, precip_snow , temp_sol_new, soilcap,&
+       & frac_nobio, totfrac_nobio, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age, &
+       & tot_melt, snowdepth,snowmelt)
+
+    ! 
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_rain   !! Rainfall
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_snow   !! Snow precipitation
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: temp_sol_new  !! New soil temperature
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: soilcap       !! Soil capacity
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(in)     :: frac_nobio    !! Fraction of continental ice, lakes, ...
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: totfrac_nobio !! Total fraction of continental ice+lakes+ ...
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: tot_melt      !! Total melt from snow and ice  
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: snowmelt      !! Snow melt
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: snowdepth     !! Snow depth
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapsno      !! Snow evaporation
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: snow          !! Snow mass [Kg/m^2]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: snow_age      !! Snow age
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout)  :: snow_nobio    !! Ice water balance
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout)  :: snow_nobio_age!! Snow age on ice, lakes, ...
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                               :: ji, jv
+    REAL(r_std), DIMENSION (kjpindex)             :: d_age  !! Snow age change
+    REAL(r_std), DIMENSION (kjpindex)             :: xx     !! temporary
+    REAL(r_std)                                   :: snowmelt_tmp !! The name says it all !
+    REAL(r_std)                                   :: snow_d1k !! The amount of snow that corresponds to a 1K cooling
+
+!_ ================================================================================================================================
+
+    !
+    ! for continental points
+    !
+
+    !
+    !!_0 initialisation
+    !
+    DO jv = 1, nnobio
+       DO ji=1,kjpindex
+          subsnownobio(ji,jv) = zero
+       ENDDO
+    ENDDO
+    DO ji=1,kjpindex
+       subsnowveg(ji) = zero
+       snowmelt(ji) = zero
+       icemelt(ji) = zero
+       subsinksoil(ji) = zero
+       tot_melt(ji) = zero
+    ENDDO
+    !
+    !! 1 On vegetation
+    !
+    DO ji=1,kjpindex
+       !
+    !! 1.1 Compute snow masse
+       !
+       snow(ji) = snow(ji) + (un - totfrac_nobio(ji))*precip_snow(ji)
+       !
+       !
+    !! 1.2 Sublimation 
+       !      Separate between vegetated and no-veget fractions 
+       !      Care has to be taken as we might have sublimation from the
+       !      the frac_nobio while there is no snow on the rest of the grid.
+       !
+       IF ( snow(ji) > snowcri ) THEN
+          subsnownobio(ji,iice) = frac_nobio(ji,iice)*vevapsno(ji)
+          subsnowveg(ji) = vevapsno(ji) - subsnownobio(ji,iice)
+       ELSE
+          ! Correction Nathalie - Juillet 2006.
+          ! On doit d'abord tester s'il existe un frac_nobio!
+          ! Pour le moment je ne regarde que le iice
+          IF ( frac_nobio(ji,iice) .GT. min_sechiba) THEN
+             subsnownobio(ji,iice) = vevapsno(ji)
+             subsnowveg(ji) = zero
+          ELSE 
+             subsnownobio(ji,iice) = zero
+             subsnowveg(ji) = vevapsno(ji)
+          ENDIF
+       ENDIF
+       !
+       !
+    !! 1.2.1 Check that sublimation on the vegetated fraction is possible.
+       !
+       IF (subsnowveg(ji) .GT. snow(ji)) THEN
+          ! What could not be sublimated goes into subsinksoil
+          IF( (un - totfrac_nobio(ji)).GT.min_sechiba) THEN
+             subsinksoil (ji) = (subsnowveg(ji) - snow(ji))/ (un - totfrac_nobio(ji))
+          END IF
+          ! Sublimation is thus limited to what is available
+          subsnowveg(ji) = snow(ji)
+          snow(ji) = zero
+          vevapsno(ji) = subsnowveg(ji) + subsnownobio(ji,iice)
+       ELSE
+          snow(ji) = snow(ji) - subsnowveg(ji)
+       ENDIF
+       !
+    !! 1.3. snow melt only if temperature positive
+       !
+       IF (temp_sol_new(ji).GT.tp_00) THEN
+          !
+          IF (snow(ji).GT.sneige) THEN
+             !
+             snowmelt(ji) = (un - frac_nobio(ji,iice))*(temp_sol_new(ji) - tp_00) * soilcap(ji) / chalfu0
+             !
+    !! 1.3.1 enough snow for melting or not
+             !
+             IF (snowmelt(ji).LT.snow(ji)) THEN
+                snow(ji) = snow(ji) - snowmelt(ji)
+             ELSE
+                snowmelt(ji) = snow(ji)
+                snow(ji) = zero
+             END IF
+             !
+          ELSEIF (snow(ji).GE.zero) THEN
+             !
+    !! 1.3.2 not enough snow
+             !
+             snowmelt(ji) = snow(ji)
+             snow(ji) = zero
+          ELSE
+             !
+    !! 1.3.3 negative snow - now snow melt
+             !
+             snow(ji) = zero
+             snowmelt(ji) = zero
+             WRITE(numout,*) 'hydrol_snow: WARNING! snow was negative and was reset to zero. '
+             !
+          END IF
+
+       ENDIF
+    !! 1.4 Snow melts above a threshold
+       ! Ice melt only if there is more than a given mass : maxmass_snow,
+       ! But the snow cannot melt more in one time step to what corresponds to
+       ! a 1K cooling. This will lead to a progressive melting of snow above
+       ! maxmass_snow but it is needed as a too strong cooling can destabilise the model.
+       IF ( snow(ji) .GT. maxmass_snow ) THEN
+          snow_d1k = un * soilcap(ji) / chalfu0
+          snowmelt(ji) = snowmelt(ji) + MIN((snow(ji) - maxmass_snow),snow_d1k)
+          snow(ji) = snow(ji) - snowmelt(ji)
+          IF ( printlev >= 3 ) WRITE (numout,*) "Snow was above maxmass_snow (", maxmass_snow,") and we melted ", snowmelt(ji)
+       ENDIF
+       
+    END DO
+    !
+    !! 2 On Land ice
+    !
+    DO ji=1,kjpindex
+       !
+    !! 2.1 Compute snow
+       !
+       !!??Aurelien: pkoi mettre precip_rain en dessous? We considere liquid precipitations becomes instantly snow?  
+       snow_nobio(ji,iice) = snow_nobio(ji,iice) + frac_nobio(ji,iice)*precip_snow(ji) + &
+            & frac_nobio(ji,iice)*precip_rain(ji)
+       !
+    !! 2.2 Sublimation 
+       !      Was calculated before it can give us negative snow_nobio but that is OK
+       !      Once it goes below a certain values (-maxmass_snow for instance) we should kill
+       !      the frac_nobio(ji,iice) !
+       !
+       snow_nobio(ji,iice) = snow_nobio(ji,iice) - subsnownobio(ji,iice)
+       !
+    !! 2.3 Snow melt only for continental ice fraction
+       !
+       snowmelt_tmp = zero
+       IF (temp_sol_new(ji) .GT. tp_00) THEN
+          !
+    !! 2.3.1 If there is snow on the ice-fraction it can melt
+          !
+          snowmelt_tmp = frac_nobio(ji,iice)*(temp_sol_new(ji) - tp_00) * soilcap(ji) / chalfu0
+          !
+          IF ( snowmelt_tmp .GT. snow_nobio(ji,iice) ) THEN
+             snowmelt_tmp = MAX( zero, snow_nobio(ji,iice))
+          ENDIF
+          snowmelt(ji) = snowmelt(ji) + snowmelt_tmp
+          snow_nobio(ji,iice) = snow_nobio(ji,iice) - snowmelt_tmp
+          !
+       ENDIF
+       !
+    !! 2.4 Snow melts over a threshold
+       !   Ice melt only if there is more than a given mass : maxmass_snow, 
+       !   But the snow cannot melt more in one time step to what corresponds to
+       !   a 1K cooling. This will lead to a progressive melting of snow above
+       !   maxmass_snow but it is needed as a too strong cooling can destabilise the model.
+       !
+       IF ( snow_nobio(ji,iice) .GT. maxmass_snow ) THEN
+          snow_d1k = un * soilcap(ji) / chalfu0
+          icemelt(ji) = MIN((snow_nobio(ji,iice) - maxmass_snow),snow_d1k)
+          snow_nobio(ji,iice) = snow_nobio(ji,iice) - icemelt(ji)
+
+          IF ( printlev >= 3 ) WRITE (numout,*) "Snow was above maxmass_snow ON ICE (", maxmass_snow,") and we melted ", icemelt(ji)
+       ENDIF
+
+    END DO
+
+    !
+    !! 3 On other surface types - not done yet
+    !
+    IF ( nnobio .GT. 1 ) THEN
+       WRITE(numout,*) 'WE HAVE',nnobio-1,' SURFACE TYPES I DO NOT KNOW'
+       WRITE(numout,*) 'CANNOT TREAT SNOW ON THESE SURFACE TYPES'
+       CALL ipslerr_p(3,'hydrol_snow','nnobio > 1 not allowded','Cannot treat snow on these surface types.','')
+    ENDIF
+
+    !
+    !! 4 computes total melt (snow and ice)
+    !
+    DO ji = 1, kjpindex
+       tot_melt(ji) = icemelt(ji) + snowmelt(ji)
+    ENDDO
+
+    !
+    !! 5 computes snow age on veg and ice (for albedo)
+    !
+    DO ji = 1, kjpindex
+       !
+    !! 5.1 Snow age on vegetation
+       !
+       IF (snow(ji) .LE. zero) THEN
+          snow_age(ji) = zero
+       ELSE
+          snow_age(ji) =(snow_age(ji) + (un - snow_age(ji)/max_snow_age) * dt_sechiba/one_day) &
+               & * EXP(-precip_snow(ji) / snow_trans)
+       ENDIF
+       !
+    !! 5.2 Snow age on ice
+       !
+       ! age of snow on ice: a little bit different because in cold regions, we really
+       ! cannot negect the effect of cold temperatures on snow metamorphism any more.
+       !
+       IF (snow_nobio(ji,iice) .LE. zero) THEN
+          snow_nobio_age(ji,iice) = zero
+       ELSE
+          !
+          d_age(ji) = ( snow_nobio_age(ji,iice) + &
+               &  (un - snow_nobio_age(ji,iice)/max_snow_age) * dt_sechiba/one_day ) * &
+               &  EXP(-precip_snow(ji) / snow_trans) - snow_nobio_age(ji,iice)
+          IF (d_age(ji) .GT. min_sechiba ) THEN
+             xx(ji) = MAX( tp_00 - temp_sol_new(ji), zero )
+             xx(ji) = ( xx(ji) / 7._r_std ) ** 4._r_std
+             d_age(ji) = d_age(ji) / (un+xx(ji))
+          ENDIF
+          snow_nobio_age(ji,iice) = MAX( snow_nobio_age(ji,iice) + d_age(ji), zero )
+          !
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 6 Diagnose the depth of the snow layer
+    !
+
+    DO ji = 1, kjpindex
+       snowdepth(ji) = snow(ji) /sn_dens
+    ENDDO
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_snow done '
+
+  END SUBROUTINE hydrol_snow
+
+   
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_canop
+!!
+!>\BRIEF        This routine computes canopy processes.
+!!
+!! DESCRIPTION  :
+!! - 1 evaporation off the continents
+!! - 1.1 The interception loss is take off the canopy. 
+!! - 1.2 precip_rain is shared for each vegetation type
+!! - 1.3 Limits the effect and sum what receives soil
+!! - 1.4 swap qsintveg to the new value
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_canop
+
+  SUBROUTINE hydrol_canop (kjpindex, precip_rain, vevapwet, veget_max, veget, qsintmax, &
+       & qsintveg,precisol,tot_melt)
+
+    ! 
+    ! interface description
+    !
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex    !! Domain size
+    ! input fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_rain !! Rain precipitation
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: vevapwet    !! Interception loss
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: veget_max   !! max fraction of vegetation type
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: veget       !! Fraction of vegetation type 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: qsintmax    !! Maximum water on vegetation for interception
+    REAL(r_std), DIMENSION  (kjpindex), INTENT (in)          :: tot_melt    !! Total melt
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)       :: precisol    !! Water fallen onto the ground (throughfall)
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: qsintveg    !! Water on vegetation due to interception
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jv
+    REAL(r_std), DIMENSION (kjpindex,nvm)                    :: zqsintvegnew
+
+!_ ================================================================================================================================
+
+    ! boucle sur les points continentaux
+    ! calcul de qsintveg au pas de temps suivant
+    ! par ajout du flux interception loss
+    ! calcule par enerbil en fonction
+    ! des calculs faits dans diffuco
+    ! calcul de ce qui tombe sur le sol
+    ! avec accumulation dans precisol
+    ! essayer d'harmoniser le traitement du sol nu
+    ! avec celui des differents types de vegetation
+    ! fait si on impose qsintmax ( ,1) = 0.0
+    !
+    ! loop for continental subdomain
+    !
+    !
+    !! 1 evaporation off the continents
+    !
+    !! 1.1 The interception loss is take off the canopy. 
+    DO jv=2,nvm
+       qsintveg(:,jv) = qsintveg(:,jv) - vevapwet(:,jv)
+    END DO
+
+    !     It is raining :
+    !! 1.2 precip_rain is shared for each vegetation type
+    !     sum (veget (1,nvm)) must be egal to 1-totfrac_nobio.
+    !     iniveget computes veget each day
+    !
+    qsintveg(:,1) = zero
+    DO jv=2,nvm
+       qsintveg(:,jv) = qsintveg(:,jv) + veget(:,jv) * ((1-throughfall_by_pft(jv))*precip_rain(:))
+    END DO
+
+    !
+    !! 1.3 Limits the effect and sum what receives soil
+    !
+    precisol(:,1)=veget_max(:,1)*precip_rain(:)
+    DO jv=2,nvm
+       DO ji = 1, kjpindex
+          zqsintvegnew(ji,jv) = MIN (qsintveg(ji,jv),qsintmax(ji,jv)) 
+          precisol(ji,jv) = (veget(ji,jv)*throughfall_by_pft(jv)*precip_rain(ji)) + &
+               qsintveg(ji,jv) - zqsintvegnew (ji,jv) + &
+               (veget_max(ji,jv) - veget(ji,jv))*precip_rain(ji)
+       ENDDO
+    END DO
+    !    
+    DO jv=1,nvm
+       DO ji = 1, kjpindex
+          IF (vegtot(ji).GT.min_sechiba) THEN
+             precisol(ji,jv) = precisol(ji,jv)+tot_melt(ji)*veget_max(ji,jv)/vegtot(ji)
+          ENDIF
+       ENDDO
+    END DO
+    !   
+    !
+    !! 1.4 swap qsintveg to the new value
+    !
+    DO jv=2,nvm
+       qsintveg(:,jv) = zqsintvegnew (:,jv)
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_canop done '
+
+  END SUBROUTINE hydrol_canop
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_vegupd
+!!
+!>\BRIEF        Vegetation update   
+!!
+!! DESCRIPTION  :
+!!   The vegetation cover has changed and we need to adapt the reservoir distribution 
+!!   and the distribution of plants on different soil types.
+!!   You may note that this occurs after evaporation and so on have been computed. It is
+!!   not a problem as a new vegetation fraction will start with humrel=0 and thus will have no
+!!   evaporation. If this is not the case it should have been caught above.
+!!
+!! - 1 Update of vegetation is it needed?
+!! - 2 calculate water mass that we have to redistribute
+!! - 3 put it into reservoir of plant whose surface area has grown
+!! - 4 Soil tile gestion
+!! - 5 update the corresponding masks
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_vegupd
+
+  SUBROUTINE hydrol_vegupd(kjpindex, veget, veget_max, soiltile, qsintveg, resdist, frac_bare)
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex 
+    ! input fields
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in)    :: veget            !! New vegetation map
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)     :: veget_max        !! Max. fraction of vegetation type
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)   :: soiltile         !! Fraction of each soil tile (0-1, unitless)
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)    :: frac_bare        !! Fraction(of veget_max) of bare soil in each vegetation type
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)  :: qsintveg         !! Water on old vegetation 
+    REAL(r_std), DIMENSION (kjpindex, nstm), INTENT(inout) :: resdist         !! Soiltile from previous time-step
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                 :: ji,jv,jst
+    REAL(r_std), DIMENSION(kjpindex)               :: tot_corr_veg_soil
+
+!_ ================================================================================================================================
+
+    !! 1 If veget has been updated at last time step (with LAND USE or DGVM),
+    !! tmc and mc must be modified with respect to humtot conservation.
+    CALL hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, resdist )
+
+    ! Remember that it is only frac_nobio + SUM(veget_max(,:)) that is equal to 1. Thus we need vegtot
+    DO ji = 1, kjpindex
+       vegtot(ji) = SUM(veget_max(ji,:))
+    ENDDO
+
+    ! Compute the masks for veget
+    
+    mask_veget(:,:) = 0
+    mask_soiltile(:,:) = 0
+    
+    DO jst=1,nstm
+       DO ji = 1, kjpindex
+          IF(soiltile(ji,jst) .GT. min_sechiba) THEN
+             mask_soiltile(ji,jst) = 1
+          ENDIF
+       END DO
+    ENDDO
+          
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          IF(veget_max(ji,jv) .GT. min_sechiba) THEN
+             mask_veget(ji,jv) = 1
+          ENDIF
+       END DO
+    END DO
+
+    ! Compute corr_veg_soil 
+    corr_veg_soil(:,:,:) = zero
+    DO jv = 1, nvm
+       jst = pref_soil_veg(jv)
+       DO ji=1,kjpindex
+          ! for veget distribution used in sechiba via humrel
+          IF (mask_soiltile(ji,jst).GT.0 .AND. vegtot(ji) > min_sechiba) THEN
+             corr_veg_soil(ji,jv,jst)=veget_max(ji,jv)/soiltile(ji,jst)
+          ENDIF
+       END DO
+    ENDDO
+
+    IF (check_cwrr .AND. first_hydrol_main) THEN
+       ! somme(soiltile * corr_veg_soil ) = 1
+       tot_corr_veg_soil(:)=zero
+       DO jst = 1, nstm
+          DO jv = 1,nvm
+             DO ji=1,kjpindex
+                tot_corr_veg_soil(ji)=tot_corr_veg_soil(ji)+soiltile(ji,jst)*corr_veg_soil(ji,jv,jst)
+             ENDDO
+          ENDDO
+       ENDDO
+
+       DO ji=1,kjpindex
+          IF ( ABS( tot_corr_veg_soil(ji) - vegtot(ji) ) > 10*EPS1 ) THEN
+             WRITE(numout,*) 'corr_veg_soil SPLIT FALSE:ji=',ji,&
+                  tot_corr_veg_soil(ji)
+             WRITE(numout,*) 'err',ABS( tot_corr_veg_soil(ji) - vegtot(ji) )
+             WRITE(numout,*) 'vegtot',vegtot(ji)
+             DO jv=1,nvm
+                WRITE(numout,*) 'jv,veget_max,corr_veg_soil',jv,veget_max(ji,jv),corr_veg_soil(ji,jv,:)
+             END DO
+             CALL ipslerr_p(3, 'hydrol_vegupd', 'Error in tot_corr_veg_soil or vegtot','','')
+          ENDIF
+       ENDDO
+    ENDIF
+
+    ! Calculate frac_bare (previosly done in slowproc_veget)
+    DO ji =1, kjpindex
+       IF( veget_max(ji,1) .GT. min_sechiba ) THEN
+          frac_bare(ji,1) = un
+       ELSE
+          frac_bare(ji,1) = zero
+       ENDIF
+    ENDDO
+    DO jv = 2, nvm
+       DO ji =1, kjpindex
+          IF( veget_max(ji,jv) .GT. min_sechiba ) THEN
+             frac_bare(ji,jv) = un - veget(ji,jv)/veget_max(ji,jv)
+          ELSE
+             frac_bare(ji,jv) = zero
+          ENDIF
+       ENDDO
+    ENDDO
+
+    ! Tout dans cette routine est maintenant certainement obsolete (veget_max etant constant) en dehors des lignes 
+    ! suivantes et le calcul de frac_bare:
+    frac_bare_ns(:,:) = zero
+    DO jst = 1, nstm
+       DO jv = 1, nvm
+          DO ji =1, kjpindex
+             IF(vegtot(ji) .GT. min_sechiba) THEN
+                frac_bare_ns(ji,jst) = frac_bare_ns(ji,jst) + corr_veg_soil(ji,jv,jst) * frac_bare(ji,jv) / vegtot(ji)
+             ENDIF
+          END DO
+       ENDDO
+    END DO
+    
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_vegupd done '
+
+  END SUBROUTINE hydrol_vegupd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_flood
+!!
+!>\BRIEF        This routine computes the evolution of the surface reservoir (floodplain).  
+!!
+!! DESCRIPTION  :
+!! - 1 Take out vevapflo from the reservoir and transfer the remaining to subsinksoil
+!! - 2 Compute the total flux from floodplain floodout (transfered to routing)
+!! - 3 Discriminate between precip over land and over floodplain
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_flood
+
+  SUBROUTINE hydrol_flood (kjpindex, vevapflo, flood_frac, flood_res, floodout)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex         !!
+    ! input fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: flood_frac       !! Fraction of floodplains in grid box
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: floodout         !! Flux to take out from floodplains
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: flood_res        !! Floodplains reservoir estimate
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapflo         !! Evaporation over floodplains
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jv           !! Indices
+    REAL(r_std), DIMENSION (kjpindex)                        :: temp             !! 
+
+!_ ================================================================================================================================
+    !- 
+    !! 1 Take out vevapflo from the reservoir and transfer the remaining to subsinksoil 
+    !-
+    DO ji = 1,kjpindex
+       temp(ji) = MIN(flood_res(ji), vevapflo(ji))
+    ENDDO
+    DO ji = 1,kjpindex
+       flood_res(ji) = flood_res(ji) - temp(ji)
+       subsinksoil(ji) = subsinksoil(ji) + vevapflo(ji) - temp(ji)
+       vevapflo(ji) = temp(ji)
+    ENDDO
+
+    !- 
+    !! 2 Compute the total flux from floodplain floodout (transfered to routing) 
+    !-
+    DO ji = 1,kjpindex
+       floodout(ji) = vevapflo(ji) - flood_frac(ji) * SUM(precisol(ji,:))
+    ENDDO
+
+    !-
+    !! 3 Discriminate between precip over land and over floodplain
+    !-
+    DO jv=1, nvm
+       DO ji = 1,kjpindex
+          precisol(ji,jv) = precisol(ji,jv) * (1 - flood_frac(ji))
+       ENDDO
+    ENDDO 
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrol_flood done'
+
+  END SUBROUTINE hydrol_flood
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_soil
+!!
+!>\BRIEF        This routine computes soil processes with CWRR scheme.
+!!
+!! DESCRIPTION  :
+!! - 0 Arrays initialisation
+!! -   for each soil type
+!! - 1 We compare water2infilt and water2extract to keep only difference
+!! - 1.1 add to the first layer
+!! - 1.2 filling layers
+!! - 2 Before diffusion scheme
+!! - 2.1 Some initialisation necessary for the diffusion scheme to work
+!! - 2.2 coefficients are computed for the profile of mc before infiltration:
+!! - 3 The infiltration is computed 
+!! - 4 Coefficient are recomputed for the profile of mc after infiltration:
+!! - 5 Prepar the diffusion scheme
+!! - 5.1 Set the values for diffusion scheme
+!! - 5.2 verifications for a good soil humidity
+!! - 5.3 compute matrix coefficients
+!! - 6 Resolve diffusion scheme
+!! - 6.1 solve equations assuming atmosphere limiting
+!! - 6.2 check if really atmosphere limiting
+!! - 6.3 Reset the coefficient for diffusion (only used if resolv(ji) = .TRUE.)
+!! - 6.4 resolve the equations with new boundary conditions if necessary
+!! - 7 close the water balance
+!! - 7.1 compute dr_ns with the bottom boundary condition 
+!! - 7.2 compute total soil moisture content
+!! - 7.3 deduction of upper flux from soil moisture variation and bottom flux
+!! - 7.4 deduction of ae_ns and ru_ns:
+!! - 8 Special treatment for the unstable cases
+!! - 9 Then compute the temporary surface water and correct the outgoing runoff
+!! - 10 smooth again
+!! - 11 Optional computation of the fluxes 
+!! - 12 We make some useful output
+!! - 13 before closing the soil water, we check the water balance of soil
+!! - 14 sum 3d variables into 2d variables
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil
+
+  SUBROUTINE hydrol_soil (kjpindex, veget_max, soiltile, njsc, reinf_slope, &
+       & transpir, vevapnu, evapot, evapot_penm, runoff, drainage, &
+       & returnflow, reinfiltration, irrigation, &
+       & tot_melt, evap_bare_lim, shumdiag, shumdiag_perma,&
+       & k_litt, litterhumdiag, humrel,vegstress, drysoil_frac, &
+       & stempdiag,snow, &
+       & snowdz, tot_bare_soil, mc_layh, mcl_layh, tmc_layh, soil_mc, &
+       & litter_mc,wat_flux0, wat_flux, drainage_per_soil, runoff_per_soil)
+    ! 
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !AD*** UNITS have not yet been fully commented; mm = @tex $(kg m^{-2})$ @endtex 
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex 
+    ! input fields
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)       :: veget_max        !! Map of max vegetation types [-]
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: njsc             !! Index of the dominant soil textural class 
+                                                                                 !!   in the grid cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltile         !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: transpir         !! Transpiration [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)           :: reinf_slope      !! Slope coef
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: returnflow       !! Water returning to the soil from the bottom [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: reinfiltration   !! Water returning to the top of the soil [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: irrigation       !! Irrigation [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evapot           !! Potential evaporation [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evapot_penm      !! Potential evaporation Penman [mm] 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: tot_melt         !! Total melt from snow and ice [mm]
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)       :: stempdiag        !! Diagnostic temp profile from thermosoil
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: snow             !! Snow mass [Kg/m^2]
+    REAL(r_std), DIMENSION (kjpindex,nsnow),INTENT(in)       :: snowdz           !! Snow depth [m]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: tot_bare_soil    !! Total evaporating bare soil fraction 
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: runoff           !! complete surface runoff [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: drainage         !! complete drainage [mm]
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)      :: runoff_per_soil  !! runoff for each soil type[mm]
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)      :: drainage_per_soil!! drainage for each soil type [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: evap_bare_lim    !! limitation factor (beta) for bare soil evaporation  
+                                                                                 !! on each soil column [mm] 
+    REAL(r_std), DIMENSION (kjpindex,nbdl), INTENT (out)     :: shumdiag         !! Relative soil moisture in each soil layer 
+                                                                                 !! with respect to (mcf-mcw)
+    REAL(r_std), DIMENSION (kjpindex,nbdl), INTENT (out)     :: shumdiag_perma   !! Percent of porosity filled with water (mc/mcs)
+                                                                                 !! used for the thermal computations
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: k_litt           !! Litter approximated hydraulic conductivity
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: litterhumdiag    !! Litter diagnosed humidity
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out)      :: vegstress        !! Veg. moisture stress (only for vegetation 
+                                                                                 !! growth) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: drysoil_frac     !! Function of the litter humidity
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out)     :: mc_layh          !! Volumetric soil moisture content for each layer in hydrol(liquid + ice) [m3/m3]
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out)     :: mcl_layh         !! Volumetric soil moisture content for each layer in hydrol(liquid) [m3/m3]
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out)     :: tmc_layh         !! Total soil moisture content for each layer in hydrol(liquid + ice) [mm]
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(out)  :: soil_mc          !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out)       :: litter_mc        !! litter moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out)       :: wat_flux0        !! Water flux in the first soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(out)  :: wat_flux         !! Water flux in the soil layers exported for soil C calculations
+
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapnu          !! Bare soil evaporation
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (inout)    :: humrel           !! Relative humidity [0-1, dimensionless]
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                 :: ji, jv, jsl, jst           !! indices
+    REAL(r_std), PARAMETER                         :: frac_mcs = 0.66            !! Temporary depth
+    REAL(r_std)                                    :: us_tmp                     !! Temporary stress
+    REAL(r_std), DIMENSION(kjpindex)               :: temp                       !! Temporary value for fluxes
+    REAL(r_std), DIMENSION(kjpindex)               :: tmcold                     !!
+    REAL(r_std), DIMENSION(kjpindex)               :: tmcint                     !!
+    REAL(r_std), DIMENSION(kjpindex,nslm,nstm)     :: moderwilt                  !!
+    REAL(r_std), DIMENSION(kjpindex,nslm)          :: mcint                      !! To save mc values for future use
+    LOGICAL, DIMENSION(kjpindex)                   :: is_under_mcr               !! Allows under residual soil moisture due to evap 
+    LOGICAL, DIMENSION(kjpindex)                   :: is_over_mcs                !! Allows over saturated soil moisture due to 
+                                                                                 !! returnflow 
+    REAL(r_std), DIMENSION(kjpindex)               :: sum_rootsink               !! Sum of the root sink
+    REAL(r_std), DIMENSION(kjpindex)               :: deltahum,diff              !!
+    LOGICAL(r_std), DIMENSION(kjpindex)            :: test                       !!
+    REAL(r_std), DIMENSION(kjpindex)               :: tsink                      !!
+    REAL(r_std), DIMENSION(kjpindex)               :: water2extract              !! Temporary variable [mm]
+    REAL(r_std), DIMENSION(kjpindex)               :: returnflow_soil            !! Water from the routing back to the bottom of 
+                                                                                 !! the soil [mm] 
+    REAL(r_std), DIMENSION(kjpindex)               :: reinfiltration_soil        !! Water from the routing back to the top of the 
+                                                                                 !! soil [mm] 
+    REAL(r_std), DIMENSION(kjpindex)               :: irrigation_soil            !! Water from irrigation returning to soil 
+                                                                                 !! moisture for each soil type [mm] 
+    REAL(r_std), DIMENSION(kjpindex)               :: flux_infilt                !! Water to infiltrate
+                                                                                 !!  @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: flux_bottom                !! Flux at bottom of the soil column
+    REAL(r_std), DIMENSION(kjpindex)               :: flux_top                   !! Flux at top of the soil column (for bare soil evap)
+    LOGICAL                                        :: error=.FALSE.              !! If true, exit in the end of subroutine
+    REAL(r_std), DIMENSION (kjpindex,nslm,nstm)    :: tmc_layh_s                 !! total soil moisture content for each layer in hydrol and each soiltile (mm)
+
+!_ ================================================================================================================================
+
+    !! 0 Initialisation
+    !
+    !! 0.1 Arrays with DIMENSION(kjpindex)
+    !
+    returnflow_soil(:) = zero
+    reinfiltration_soil(:) = zero
+    irrigation_soil(:) = zero
+    qflux(:,:,:) = zero
+    is_under_mcr(:) = .FALSE.
+    is_over_mcs(:) = .FALSE.
+    flux_infilt(:) = zero
+    mc_layh(:,:) = zero
+    mcl_layh(:,:) = zero
+    tmc_layh(:,:) = zero
+    tmc_layh_s(:,:,:) = zero
+    IF (ok_freeze_cwrr) THEN
+       kk(:,:,:)=zero
+       kk_moy(:,:)=zero
+    ENDIF
+    
+    IF (ok_freeze_cwrr) THEN
+       !
+       ! 1.1 Calculate the temperature at hydrological levels
+       !
+       CALL hydrol_calculate_temp_hydro(kjpindex, stempdiag, snow,snowdz)
+    ENDIF
+    !
+    !! 0.2 Split 2d variables to 3d variables, per soil tile
+    !
+    CALL hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, evap_bare_lim, tot_bare_soil)
+    !
+    !! 0.3 Common variables related to routing, with all return flow applied to the soil surface
+    ! AD*** redundancies with first three lines of step 0.1
+    ! AD*** why dividing by vegtot if returnflow(ji), reinfiltration(ji),irrigation(ji) are in kg/m2 ??
+    ! AD*** ces flux sont-ils supposes constants sur les 3 soiltiles ?
+    !
+    DO ji=1,kjpindex
+       IF(vegtot(ji).GT.min_sechiba) THEN
+          returnflow_soil(ji) = zero
+          reinfiltration_soil(ji) = (returnflow(ji) + reinfiltration(ji))/vegtot(ji)
+          irrigation_soil(ji) = irrigation(ji)/vegtot(ji)
+       ELSE
+          returnflow_soil(ji) = zero
+          reinfiltration_soil(ji) = zero
+          irrigation_soil(ji) = zero
+       ENDIF
+    ENDDO       
+    !
+    !! -- START MAIN LOOP OVER SOILTILES
+    !!    The called subroutines work on arrays with DIMENSION(kjpindex), recursively used for each soiltile jst
+    !
+    DO jst = 1,nstm
+       !
+       !! 0.4. Keep initial values for future check-up
+       !
+       ! Sum of sinks 
+       sum_rootsink(:)=SUM(rootsink(:,:,jst),dim=2)
+       DO ji=1,kjpindex
+          tsink(ji) = sum_rootsink(ji)+MAX(ae_ns(ji,jst),zero)+subsinksoil(ji)
+       ENDDO
+       !
+       ! Total moisture content (including water2infilt) is saved for balance checks at the end
+       ! In hydrol_tmc_update, tmc is increased by water2infilt(ji,jst), but mc is not modified !
+       tmcold(:) = tmc(:,jst)
+       !
+       ! The value of mc is kept in mcint (nstm dimension removed), used in the flux computation after diffusion
+       DO jsl = 1, nslm
+          DO ji = 1, kjpindex
+             mcint(ji,jsl) = mask_soiltile(ji,jst) * mc(ji,jsl,jst)
+          ENDDO
+       ENDDO
+       !
+       ! Initial total moisture content : tmcint does not include water2infilt, contrarily to tmcold
+       DO ji = 1, kjpindex
+          tmcint(ji) = dz(2) * ( trois*mcint(ji,1) + mcint(ji,2) )/huit 
+       ENDDO
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmcint(ji) = tmcint(ji) + dz(jsl) &
+                  & * (trois*mcint(ji,jsl)+mcint(ji,jsl-1))/huit &
+                  & + dz(jsl+1) * (trois*mcint(ji,jsl)+mcint(ji,jsl+1))/huit
+          ENDDO
+       ENDDO
+       DO ji = 1, kjpindex
+          tmcint(ji) = tmcint(ji) + dz(nslm) &
+               & * (trois * mcint(ji,nslm) + mcint(ji,nslm-1))/huit
+       ENDDO
+
+       !! FIRSTLY, WE CHANGE MC BASED ON EXTERNAL FLUXES, ALL APPLIED AT THE SOIL SURFACE
+       !!   Input = water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) + precisol_ns(ji,jst)
+       !!   Output = MAX(ae_ns(ji,jst),zero) + subsinksoil(ji)
+       ! AD*** what is the fate of negative ae_ns ???
+
+       !! 1 Reduces water2infilt and water2extract to their difference + extracts water2extract (including bare soil evap)
+
+       !! 1.1 compares water2infilt and water2extract to keep only difference
+
+       ! Here, water2extract is used as a temporary variable to store the difference the min of water to infiltrate vs evaporate
+       DO ji = 1, kjpindex
+          water2extract(ji) = MIN(water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji), &
+               & MAX(ae_ns(ji,jst),zero) + subsinksoil(ji))
+       ENDDO
+
+       ! The water to infiltrate at the soil surface is either 0, or the difference to what has to be evaporated
+       !   - the initial water2infilt (right hand side) results from qsintveg changes with vegetation updates
+       !   - irrigation_soil is the input flux to the soil surface from irrigation 
+       !   - reinfiltration_soil is the input flux to the soil surface from routing 'including returnflow)
+       !   - eventually, water2infilt holds all fluxes to the soil surface except precisol (reduced by water2extract)
+       DO ji = 1, kjpindex
+          water2infilt(ji,jst) = water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) - water2extract(ji)
+       ENDDO       
+             
+       ! The water to evaporate from the soil surface is either the difference to what has to be infiltrated, or 0
+       !   - subsinksoil is the residual from sublimation is the snowpack is not sufficient
+       !   - how are the negative values of ae_ns taken into account ??? 
+       DO ji = 1, kjpindex
+          water2extract(ji) =  MAX(ae_ns(ji,jst),zero) + subsinksoil(ji) - water2extract(ji)
+       ENDDO
+
+       !! 1.2 Removes water2extract (including ae_ns) from top layer,
+       !!     and from layers below in case it creates under residual value
+       !!     This is done by hydrol_soil_smooth ("like for mcs in case of reinfiltration")
+       !      ...but where ? AD***???
+       DO ji = 1, kjpindex
+          mc(ji,1,jst) = mc(ji,1,jst) - water2extract(ji) * deux / dz(2)
+       ENDDO
+
+       CALL hydrol_soil_smooth(kjpindex,jst, njsc, is_under_mcr, is_over_mcs)
+
+       !! 2 Before the diffusion scheme
+
+       !! 2.1 We correct rootsink in the first two layers so that it is not too low in the first layer
+       DO ji = 1, kjpindex
+          v1(ji,jst) = dz(2)/huit * (trois * mc(ji,1,jst)+ mc(ji,2,jst))
+          rootsink(ji,2,jst) = rootsink(ji,2,jst) + MAX(rootsink(ji,1,jst)-v1(ji,jst), zero) 
+          rootsink(ji,1,jst) = MIN(rootsink(ji,1,jst),v1(ji,jst))
+       ENDDO
+       !- Flux at top of the soil column is zero
+       flux_top(:) = zero
+
+       !! 2.2 Definition of flux_infilt and flux, which corresponds to bare soil evaporation in the top layer
+       !!     This flux needs to be set to zero, as ae_ns has already been withdrawn in step 1.2 
+       DO ji = 1, kjpindex
+          ! Initialise the flux to be infiltrated 
+          flux_infilt(ji) = water2infilt(ji,jst) + precisol_ns(ji,jst) 
+          ! This incoming flux is first dedicated to fill the soil up to mcr (in case needed, see 2.3)
+       ENDDO
+
+       !! 2.3 Treat problem with too low soil moisture content in soil column : is_under_mcr
+       DO ji = 1, kjpindex
+          IF (is_under_mcr(ji)) THEN
+             ! If is_under_mcr, the water deficit should be equally split over all soil layers (cf hydrol_soil_smooth)
+             ! Calculate minimum mc 
+             temp(ji)=mc(ji,1,jst)
+             DO jsl=2,nslm
+                IF (mc(ji,jsl,jst) .LT. temp(ji)) THEN
+                   temp(ji)=mc(ji,jsl,jst)
+                END IF
+             END DO     
+             ! Calculate water deficit
+             temp(ji)=mcr(njsc(ji))-temp(ji)
+             ! Add to each soil layer
+             DO jsl=1,nslm
+                mc(ji,jsl,jst) = mc(ji,jsl,jst) + temp(ji)
+             END DO
+             ! Remove added water from flux_infilt
+             flux_infilt(ji)=flux_infilt(ji)-temp(ji)*(zmaxh*mille)
+             IF (flux_infilt(ji) .LT. 0.) THEN
+                WRITE(numout,*) 'BIG PROBLEM at grid cell ',ji
+                WRITE(numout,*) 'No available water in soil column!!!'
+                flux_infilt(ji) = 0.
+                ! AD *** This violates water conservation, unless the difference is reported to another flux (see 5.3 ?)
+             END IF
+          END IF
+       END DO
+
+       !! 2.4 K and D are computed for the profile of mc before infiltration
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+       !! 2.5 The infiltration is computed 
+       CALL hydrol_soil_infilt(kjpindex, jst, njsc, flux_infilt)
+
+       !! 2.6 K and D are recomputed for the profile of mc after infiltration
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+       !! -- SECONDLY, WE UPDATE MC FROM DIFFUSION, INCLUDING DRAINAGE AND ROOTSINK
+
+       !! 3 Prepare for diffusion based on the initial SM profile modified by infiltration and bare soil evaporation
+       !!   Thus, flux=0
+ 
+       !! 3.1 Set the tridiagonal matrix coefficients for the diffusion scheme
+       CALL hydrol_soil_setup(kjpindex,jst)
+
+       !! 3.2 Verifications for good soil humidity
+       !
+       !! 3.2.1 resolv serves to only run diffusion if we are not under mcr nor over mcs (for hydrol_soil_tridiag)
+       resolv(:) = (mask_soiltile(:,jst) .GT. 0) .AND. & 
+               & (.NOT. is_under_mcr(:)) .AND. (.NOT. is_over_mcs(:))    
+       !
+       !! 3.2.2 Else, we equally spread the transpiration over the layers
+       sum_rootsink(:)=SUM(rootsink(:,:,jst),dim=2)
+       ! AD***  since flux=0, the next 3 lines are useless
+       WHERE (is_over_mcs(:))
+          mc(:,1,jst) = mc(:,1,jst) - flux_top(:) * deux / dz(2)
+       ENDWHERE
+       ! transpiration via root_sink
+       DO jsl=1, nslm
+          WHERE (is_over_mcs(:))
+             mc(:,jsl,jst) = mc(:,jsl,jst) - sum_rootsink(:) / (zmaxh*mille) 
+          ENDWHERE
+       ENDDO
+       ! the rootsink will exacerbate the under_mcr problem
+       DO jsl = 1, nslm
+          WHERE (is_under_mcr(:))
+             mc(:,jsl,jst) = mc(:,jsl,jst) - sum_rootsink(:) / (zmaxh*mille) 
+          ENDWHERE
+       ENDDO
+
+       ! Update coefficients depending on mc
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+       IF (ok_freeze_cwrr) THEN
+          DO ji =1, kjpindex
+             DO jsl = 1, nslm
+                mcl(ji,jsl,jst)= MIN(mc(ji,jsl,jst),mcr(njsc(ji))+(1-profil_froz_hydro_ns(ji,jsl, jst))&
+                     *(mc(ji,jsl,jst)-mcr(njsc(ji))))
+             ENDDO
+          ENDDO
+       ELSE
+          mcl(:,:,jst)=mc(:,:,jst)
+       ENDIF
+
+       !! 3.3 We define the system of linear equations, based on matrix coefficients, 
+       !! following the PhD thesis of de Rosnay (1999), p155-157
+       ! rhs for right-hand side term; fp for f'; gp for g'; ep for e'; with flux=0 !
+       ! 
+       !- First layer
+       DO ji = 1, kjpindex
+          tmat(ji,1,1) = zero
+          tmat(ji,1,2) = f(ji,1)
+          tmat(ji,1,3) = g1(ji,1)
+          rhs(ji,1)    = fp(ji,1) * mcl(ji,1,jst) + gp(ji,1)*mcl(ji,2,jst) &
+               &  - flux_top(ji) - (b(ji,1)+b(ji,2))/deux *(dt_sechiba/one_day) - rootsink(ji,1,jst)
+       ENDDO
+       !- soil body
+       DO jsl=2, nslm-1
+          DO ji = 1, kjpindex
+             tmat(ji,jsl,1) = e(ji,jsl)
+             tmat(ji,jsl,2) = f(ji,jsl)
+             tmat(ji,jsl,3) = g1(ji,jsl)
+             rhs(ji,jsl) = ep(ji,jsl)*mcl(ji,jsl-1,jst) + fp(ji,jsl)*mcl(ji,jsl,jst) &
+                  & +  gp(ji,jsl) * mcl(ji,jsl+1,jst) & 
+                  & + (b(ji,jsl-1) - b(ji,jsl+1)) * (dt_sechiba/one_day) / deux & 
+                  & - rootsink(ji,jsl,jst) 
+          ENDDO
+       ENDDO       
+       !- Last layer, including drainage
+       DO ji = 1, kjpindex
+          jsl=nslm
+          tmat(ji,jsl,1) = e(ji,jsl)
+          tmat(ji,jsl,2) = f(ji,jsl)
+          tmat(ji,jsl,3) = zero
+          rhs(ji,jsl) = ep(ji,jsl)*mcl(ji,jsl-1,jst) + fp(ji,jsl)*mcl(ji,jsl,jst) &
+               & + (b(ji,jsl-1) + b(ji,jsl)*(un-deux*free_drain_coef(ji,jst))) * (dt_sechiba/one_day) / deux &
+               & - rootsink(ji,jsl,jst)
+       ENDDO
+       !- Store the equations in case needed again
+       DO jsl=1,nslm
+          DO ji = 1, kjpindex
+             srhs(ji,jsl) = rhs(ji,jsl)
+             stmat(ji,jsl,1) = tmat(ji,jsl,1)
+             stmat(ji,jsl,2) = tmat(ji,jsl,2)
+             stmat(ji,jsl,3) = tmat(ji,jsl,3) 
+          ENDDO
+       ENDDO
+       
+       !! 4 Resolves diffusion based on the initial SM profile modified by infiltration and bare soil evaporation
+       
+       !! 4.1 Solves diffusion equations, but only in grid-cells where tmc is OK (else, see step 3.2.2)
+       !!     The result is an updated mcl profile
+
+       CALL hydrol_soil_tridiag(kjpindex,jst)
+       
+       !! 4.2 Correct bad moisture contents due to numerical errors before water balance
+       ! AD*** shouldn't this be done only where resolv = TRUE ??
+       ! AD*** even where the diffusion was solved, don't these corrections create water conservation pbs ??
+       DO ji = 1, kjpindex
+          DO jsl = 1,nslm
+             IF (mcl(ji,jsl,jst) .LT. mcr(njsc(ji)) .AND. mcl(ji,jsl,jst) .NE. 0.) THEN
+                mcl(ji,jsl,jst)=mcr(njsc(ji))
+             END IF
+             IF (mcl(ji,jsl,jst) .GT. mcs(njsc(ji)) .AND. mcl(ji,jsl,jst) .NE. 0.) THEN
+                mcl(ji,jsl,jst)=mcs(njsc(ji))
+             END IF
+          ENDDO
+       ENDDO
+
+       ! Update coefficients depending on mc
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+       ! Calculation of total soil moisture content (liquid + frozen)
+       IF (ok_freeze_cwrr) THEN
+          DO ji =1, kjpindex
+             DO jsl = 1, nslm
+                mc(ji,jsl,jst)=MAX(mcl(ji,jsl,jst), mcl(ji,jsl,jst)+profil_froz_hydro_ns(ji,jsl,jst)*(mc(ji,jsl,jst)-mcr(njsc(ji))))
+             ENDDO
+          ENDDO
+       ELSE
+          mc(:,:,jst)=mcl(:,:,jst)
+       ENDIF
+
+       !! -- THEN, FLUXES ALLOW TO CLOSE THE WATER BALANCE
+
+       !! 5 Closing water balance
+
+       !! 5.1 Computes dr_ns = bottom boundary condition, consistent with rhs(ji,jsl=nslm)
+       DO ji = 1, kjpindex
+          dr_ns(ji,jst)=zero
+          jsl=nslm
+          IF (.NOT. is_under_mcr(ji)) THEN ! AD*** what happens if is_over_mcs ???
+             dr_ns(ji,jst) = mask_soiltile(ji,jst)*k(ji,jsl)*free_drain_coef(ji,jst) * (dt_sechiba/one_day)
+          ENDIF
+       ENDDO
+          
+       !! 5.2 Computes total soil moisture content
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit 
+       ENDDO          
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl) &
+                  & * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+       ENDDO
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = tmc(ji,jst) + dz(nslm) &
+               & * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+       END DO
+
+       !! 5.3 Diagnostic of upper fluxes from soil moisture variation and bottom flux
+       ! AD*** should this be done where resolv=FALSE ?
+       ! AD*** shouldn't we initialize run_ns to zero ?
+
+       DO ji = 1, kjpindex
+          ! qflux00 balances soil moisture variation and bottom flux+rootsink-returnflow
+          ! AD*** why do we use the MIN(tmcs, tmc) ??? doesn't this create conservation flaws ?
+          ! AD*** returnflow_soil=0
+          qflux00(ji,jst) = mask_soiltile(ji,jst) * &
+               & (MIN(tmcs(ji,jst),tmc(ji,jst))-tmcint(ji)+SUM(rootsink(ji,:,jst))+dr_ns(ji,jst)-returnflow_soil(ji))
+          ! We should also have that qflux00=precisol_ns+water2infilt-water2extract
+          ! unless the adjustements to mc with respect to mcr/mcs created water imbalance
+          ! In such a case, the imbalance (whether positive or negative) is reported to surface runoff
+          ru_ns(ji,jst) = (precisol_ns(ji,jst) + water2infilt(ji,jst)  &
+               & - water2extract(ji) - qflux00(ji,jst)) * mask_soiltile(ji,jst)
+          ! AD*** why do we further change ae_ns ??? and why has MAX(ae_ns,0) disappeared (ask A. Campoy)
+          ! ae_ns+ru_ns=precisol_ns+irrigation-q0 ?
+          ae_ns(ji,jst) = ae_ns(ji,jst) + subsinksoil(ji)
+       ENDDO
+
+       !! 6 Special treatment for the unstable cases
+       ! AD*** NOT COMMENTED ***
+
+       !! 6.1 Negative runoff
+
+       IF (printlev>=3) THEN
+          DO ji = 1, kjpindex
+             IF (ru_ns(ji,jst) .LT. zero) THEN
+                WRITE (numout,*) 'Negative runoff corrected', ji,jst,ru_ns(ji,jst), mc(ji,1,jst), tmc(ji,jst)
+             ENDIF
+          ENDDO
+       ENDIF
+
+       DO ji = 1, kjpindex
+          IF (ru_ns(ji,jst) .LT. zero) THEN
+             ! Available water in first layer
+             temp(ji)=MAX(((mc(ji,1,jst)-mcr(njsc(ji))) * dz(2) / deux), zero)
+             ! Calculate and add maximum water to runoff
+             temp(ji)=MIN(temp(ji),ABS(ru_ns(ji,jst)))
+             ru_ns(ji,jst)=ru_ns(ji,jst)+temp(ji)
+             ! Update water balance
+             qflux00(ji,jst) = qflux00(ji,jst) - temp(ji)
+             mc(ji,1,jst)=mc(ji,1,jst)-(temp(ji) * deux / dz(2))
+          END IF
+
+          ! If still negative runoff, take water from deeper layers
+          DO jsl = 2, nslm-1
+             IF (ru_ns(ji,jst) .LT. zero) THEN
+                temp(ji)= MAX((mc(ji,jsl,jst)-mcr(njsc(ji)))*(dz(jsl)+dz(jsl+1)) / deux, zero)
+                temp(ji)=MIN(temp(ji),ABS(ru_ns(ji,jst)))
+                ru_ns(ji,jst)=ru_ns(ji,jst)+temp(ji)
+                qflux00(ji,jst) = qflux00(ji,jst) - temp(ji)
+                mc(ji,jsl,jst)=mc(ji,jsl,jst)-temp(ji) * deux / (dz(jsl)+dz(jsl+1))
+             END IF
+          ENDDO
+          
+          ! Last layer
+          IF (ru_ns(ji,jst) .LT. zero) THEN
+             temp(ji)=MAX((mc(ji,nslm,jst)-mcr(njsc(ji))) * dz(nslm) / deux, zero)
+             temp(ji)=MIN(temp(ji),ABS(ru_ns(ji,jst)))
+             ru_ns(ji,jst)=ru_ns(ji,jst)+temp(ji)
+             qflux00(ji,jst) = qflux00(ji,jst) - temp(ji)
+             mc(ji,nslm,jst)=mc(ji,nslm,jst)-temp(ji) * deux / dz(nslm)
+          END IF
+          ! If still negative runoff, take water from bottom drainage
+          IF (ru_ns(ji,jst) .LT. zero) THEN
+             IF (printlev>=3)  WRITE (numout,*) 'runoff and drainage before correction',&
+                  ru_ns(ji,jst),dr_ns(ji,jst)
+             dr_ns(ji,jst)=dr_ns(ji,jst)+ru_ns(ji,jst)
+             qflux00(ji,jst) = qflux00(ji,jst) + ru_ns(ji,jst)
+             ru_ns(ji,jst)= 0.
+          END IF
+          
+       ENDDO
+
+       !! 6.2 Compute total soil moisture content
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+       ENDDO
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl) &
+                  & * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+       ENDDO
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = tmc(ji,jst) + dz(nslm) &
+               & * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+       END DO
+
+       !! 6.3 Avoid under-precision value for the 3 outward flux
+       ! AD*** and the third one ?
+       DO ji = 1, kjpindex  
+          IF (ABS(ae_ns(ji,jst)).LT.min_sechiba) THEN
+             ae_ns(ji,jst) = zero
+          ENDIF
+
+          IF(ABS(ru_ns(ji,jst)).LT.min_sechiba) THEN
+             ru_ns(ji,jst) = zero
+          ENDIF
+       ENDDO
+
+       !! 7 Surface runoff : compute temporary surface water and extract from runoff
+       IF ( .NOT. doponds ) THEN
+          DO ji = 1, kjpindex
+             water2infilt(ji,jst) = reinf_slope(ji) * ru_ns(ji,jst)
+          ENDDO
+       ELSE
+          DO ji = 1, kjpindex           
+             water2infilt(ji,jst) = zero
+          ENDDO
+       ENDIF
+       !
+       DO ji = 1, kjpindex           
+          ru_ns(ji,jst) = ru_ns(ji,jst) - water2infilt(ji,jst)
+       END DO
+
+       !! 8 Smooth again
+       ! Probably not necessary but harmless (Aurelien)
+       CALL hydrol_soil_smooth(kjpindex, jst, njsc, is_under_mcr, is_over_mcs)
+
+       !! 9 Optional computation of the fluxes 
+       IF ( check_cwrr ) THEN
+          CALL hydrol_soil_flux(kjpindex,jst,mcint,returnflow_soil)
+       ENDIF
+
+       !! -- SM DIAGNOSTICS FOR OTHER ROUTINES, MODULES, OR NEXT STEP
+
+       !! 10 We make some useful output
+       !  Total soil moisture, soil moisture at litter levels, soil wetness...
+
+       ! total soil moisture ! AD*** why include water2infilt here ???
+       DO ji=1,kjpindex
+          tmc(ji,jst)= dz(2) * (trois*mc(ji,1,jst) + mc(ji,2,jst))/huit
+       END DO
+       DO jsl=2,nslm-1
+          DO ji=1,kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl) * ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1)*(trois*mc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
+          END DO
+       END DO
+       DO ji=1,kjpindex
+          tmc(ji,jst) = tmc(ji,jst) +  dz(nslm) * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+          tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
+       END DO
+
+       ! The litter is the 4 top levels of the soil
+       ! Compute various field of soil moisture for the litter (used for stomate and for albedo)
+
+       DO ji=1,kjpindex
+          tmc_litter(ji,jst) = dz(2) * ( trois*mc(ji,1,jst)+ mc(ji,2,jst))/huit
+       END DO
+       ! sum from level 1 to 4
+       DO jsl=2,4
+          DO ji=1,kjpindex
+             tmc_litter(ji,jst) = tmc_litter(ji,jst) + dz(jsl) * & 
+                  & ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1)*(trois*mc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
+          END DO
+       END DO
+
+       ! subsequent calculation of soil_wet_litter (tmc-tmcw)/(tmcf-tmcw)
+
+       DO ji=1,kjpindex
+          soil_wet_litter(ji,jst) = MIN(un, MAX(zero,&
+               & (tmc_litter(ji,jst)-tmc_litter_wilt(ji,jst)) / &
+               & (tmc_litter_field(ji,jst)-tmc_litter_wilt(ji,jst)) ))
+       END DO
+
+       ! Soil wetness profiles (mc-mcw)/(mcs-mcw)
+       ! soil_wet is the ratio of soil moisture to available soil moisture for plant
+       ! (ie soil moisture at saturation minus soil moisture at wilting point).
+
+       DO ji=1,kjpindex
+          soil_wet(ji,1,jst) = MIN(un, MAX(zero,&
+               & (trois*mc(ji,1,jst) + mc(ji,2,jst) - quatre*mcw(njsc(ji)))&
+               & /(quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+          humrelv(ji,1,jst) = zero
+       END DO
+       DO jsl=2,nslm-1
+          DO ji=1,kjpindex
+             soil_wet(ji,jsl,jst) = MIN(un, MAX(zero,&
+                  & (trois*mc(ji,jsl,jst) + & 
+                  & mc(ji,jsl-1,jst) *(dz(jsl)/(dz(jsl)+dz(jsl+1))) &
+                  & + mc(ji,jsl+1,jst)*(dz(jsl+1)/(dz(jsl)+dz(jsl+1))) &
+                  & - quatre*mcw(njsc(ji))) / (quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+          END DO
+       END DO
+       DO ji=1,kjpindex
+          soil_wet(ji,nslm,jst) = MIN(un, MAX(zero,&
+               & (trois*mc(ji,nslm,jst) &
+               & + mc(ji,nslm-1,jst)-quatre*mcw(njsc(ji)))/(quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+       END DO
+
+       ! Compute the moderation of transpiration due to wilting point
+       ! moderwilt is a factor which is zero if soil moisture is below the wilting point
+       ! and is un if soil moisture is above the wilting point.
+
+       DO jsl=1,nslm
+          DO ji=1,kjpindex
+             moderwilt(ji,jsl,jst) = INT( MAX(soil_wet(ji,jsl,jst), zero) + un - min_sechiba )
+          END DO
+       END DO
+
+       ! Compute the new humrelv to use in sechiba:
+       ! loop on each vegetation type
+       humrelv(:,1,jst) = zero   
+
+       ! calculation of us for each layer and vegetation type.
+       DO jv = 2,nvm
+          DO ji=1,kjpindex
+             !- Here we make the assumption that roots do not take water from the 1st layer. 
+             !- Comment the us=0 if you want to change this.
+!             us(ji,jv,jst,1) = moderwilt(ji,1,jst)*MIN(un,((trois*mc(ji,1,jst) + mc(ji,2,jst)) &
+!                  & /(quatre*mcs(njsc(ji))*pcent(jst))) )* (un-EXP(-humcste(jv)*dz(2)/mille/deux)) &
+!                  & /(un-EXP(-humcste(jv)*zz(nslm)/mille))
+             us(ji,jv,jst,1) = zero
+             humrelv(ji,jv,jst) = MAX(us(ji,jv,jst,1),zero) ! initialisation, to zero as us(:,:,:,1)=0
+          END DO
+       ENDDO
+
+       ! Update coefficients depending on mc
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+       DO jsl = 2,nslm-1
+          DO jv = 2, nvm
+             DO ji=1,kjpindex
+                ! Influence of freezing in the soil on the soil moisture
+                IF (ok_freeze_cwrr) THEN
+                   us_tmp= (trois*(1-profil_froz_hydro_ns(ji,jsl, jst))*mc(ji,jsl,jst)+ &
+                        (1-profil_froz_hydro_ns(ji,jsl-1, jst))*mc(ji,jsl-1,jst) &
+                        *(dz(jsl)/(dz(jsl)+dz(jsl+1)))+ &
+                        (1-profil_froz_hydro_ns(ji,jsl+1, jst))*mc(ji,jsl+1,jst) &
+                        *(dz(jsl+1)/(dz(jsl)+dz(jsl+1)))) &
+                        /(quatre*mcs(njsc(ji))*pcent(njsc(ji)))
+
+                ELSE
+                   us_tmp= (trois*mc(ji,jsl,jst) + &
+                        mc(ji,jsl-1,jst)*(dz(jsl)/(dz(jsl)+dz(jsl+1)))+ &
+                        mc(ji,jsl+1,jst)*(dz(jsl+1)/(dz(jsl)+dz(jsl+1)))) &
+                        /(quatre*mcs(njsc(ji))*pcent(njsc(ji)))
+                ENDIF
+
+                ! us_tmp should not be negative
+                !!??Aurelien: Useless, here we are sure mc between mcr and mcs
+                us_tmp=MAX(us_tmp, zero)
+                ! us is computed with a SQRT in order for it to grow more rapidly with soil moisture.
+                ! it is not essential
+                us(ji,jv,jst,jsl) = moderwilt(ji,jsl,jst) * MIN( un, SQRT(us_tmp) ) * nroot(jv,jst,jsl)
+                !
+                us(ji,jv,jst,jsl) = MAX(us (ji,jv,jst,jsl), zero)
+                
+                humrelv(ji,jv,jst) = MAX((humrelv(ji,jv,jst) + us(ji,jv,jst,jsl)),zero)
+             END DO
+          END DO
+       ENDDO
+
+       DO jv = 2, nvm
+          DO ji=1,kjpindex
+
+             IF (ok_freeze_cwrr) THEN
+                us_tmp = (trois*(1-profil_froz_hydro_ns(ji,nslm, jst))*mc(ji,nslm,jst)  &
+                     + (1-profil_froz_hydro_ns(ji,nslm-1, jst))*mc(ji,nslm-1,jst))  &
+                     / (quatre*mcs(njsc(ji))*pcent(njsc(ji)))
+             ELSE 
+                us_tmp = (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))  &
+                     / (quatre*mcs(njsc(ji))*pcent(njsc(ji)))
+             ENDIF
+
+             ! us_tmp should not be negative
+             us_tmp=MAX(us_tmp, zero)
+             !
+             us(ji,jv,jst,nslm) =moderwilt(ji,nslm,jst)*  &
+                  & MIN( un, SQRT(us_tmp) ) * nroot(jv,jst,nslm)
+
+             us(ji,jv,jst,nslm) = MAX(us(ji,jv,jst,nslm), zero)
+             humrelv(ji,jv,jst) = MAX(zero,MIN(un, humrelv(ji,jv,jst) + us(ji,jv,jst,nslm)))
+             vegstressv(ji,jv,jst) = humrelv(ji,jv,jst)
+          END DO
+       END DO
+
+       DO jv = 2, nvm
+          DO ji = 1, kjpindex
+             IF (corr_veg_soil(ji,jv,jst) .LT. min_sechiba) THEN
+                humrelv(ji,jv,jst) = zero  
+             ENDIF
+          END DO
+       END DO
+
+       !! We need to turn off evaporation when is_under_mcr
+       !! We set us, humrelv and vegstressv to zero in this case
+       DO jsl = 1,nslm
+          DO jv = 2, nvm
+             WHERE (is_under_mcr(:))
+                us(:,jv,jst,jsl) = zero
+             ENDWHERE
+          ENDDO
+       ENDDO
+       DO jv = 2, nvm
+          WHERE (is_under_mcr(:))
+             humrelv(:,jv,jst) = zero
+             vegstressv(:,jv,jst) = zero 
+          ENDWHERE
+       ENDDO
+       
+       !! For consistency in stomate, we also set moderwilt and soil_wet to zero in this case. 
+       !! They are used later for shumdiag and shumdiag_perma
+       DO jsl = 1,nslm
+          WHERE (is_under_mcr(:))
+             moderwilt(:,jsl,jst) = zero 
+             soil_wet(:,jsl,jst) = zero
+          ENDWHERE
+       ENDDO
+
+       !! Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in 
+       !! thermosoil for the thermal conductivity. Calculate also total soil moisture content(tmc_layh) 
+       !! needed in thermosoil for the heat capacity.
+       DO ji=1,kjpindex
+          DO jsl=1,nslm
+             mc_layh(ji,jsl) = mc_layh(ji,jsl) + mc(ji,jsl,jst) * soiltile(ji,jst) 
+             mcl_layh(ji,jsl) = mcl_layh(ji,jsl) + mcl(ji,jsl,jst) * soiltile(ji,jst)
+          ENDDO
+          tmc_layh_s(ji,1,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+          DO jsl = 2,nslm-1
+             tmc_layh_s(ji,jsl,jst) = dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+          tmc_layh_s(ji,nslm,jst) = dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+          DO jsl = 1,nslm
+             tmc_layh(ji,jsl) = tmc_layh(ji,jsl) + tmc_layh_s(ji,jsl,jst) * soiltile(ji,jst)
+          ENDDO
+       END DO
+
+    !! 10bis before closing the soil water, we check the water balance of soil
+
+       IF(check_cwrr) THEN
+          DO ji = 1,kjpindex
+             
+             deltahum(ji) = (tmc(ji,jst) - tmcold(ji))
+             diff(ji)     = precisol_ns(ji,jst)-ru_ns(ji,jst)-dr_ns(ji,jst)-tsink(ji) &
+                  & + irrigation_soil(ji) + returnflow_soil(ji) + reinfiltration_soil(ji)
+
+             test(ji) = (ABS(deltahum(ji)-diff(ji))*mask_soiltile(ji,jst) .GT. allowed_err)
+          ENDDO
+             
+          DO ji = 1,kjpindex
+             IF(test(ji)) THEN
+                
+                WRITE (numout,*)'CWRR pat: bilan non nul',ji,jst,njsc(ji),deltahum(ji)-diff(ji)
+                WRITE (numout,*)'tmc,tmcold,diff',tmc(ji,jst),tmcold(ji),deltahum(ji)
+                WRITE(numout,*) 'evapot,evapot_penm,ae_ns',evapot(ji),evapot_penm(ji),ae_ns(ji,jst)
+                WRITE (numout,*)'flux_top,ru_ns,qdrain,tsink,q0,precisol',flux_top(ji),ru_ns(ji,jst), &
+                     &      dr_ns(ji,jst),tsink(ji),qflux00(ji,jst),precisol_ns(ji,jst)
+                WRITE (numout,*)'water2infilt',water2infilt(ji,jst)
+                WRITE (numout,*)'soiltile',soiltile(ji,jst)
+                WRITE (numout,*)'irrigation, returnflow, reinfiltration', &
+                     & irrigation_soil(ji),returnflow_soil(ji),reinfiltration_soil(ji)
+                WRITE (numout,*)'mc',mc(ji,:,jst)
+                WRITE (numout,*)'qflux',qflux(ji,:,jst)
+                WRITE (numout,*)'veget_max', veget_max(ji,:)
+                WRITE (numout,*)'k', k(ji,:)
+                
+                error=.TRUE.
+                CALL ipslerr_p(2, 'hydrol_soil', 'We will STOP in the end of this subroutine.',&
+                     & 'CWRR water balance check','')
+             ENDIF
+          ENDDO
+
+          DO ji = 1,kjpindex
+             
+             IF(MINVAL(mc(ji,:,jst)).LT.-min_sechiba) THEN
+                WRITE (numout,*)'CWRR MC NEGATIVE', &
+                     & ji,lalo(ji,:),MINLOC(mc(ji,:,jst)),jst,mc(ji,:,jst)
+                WRITE (numout,*)'evapot,evapot_penm,ae_ns',evapot(ji),evapot_penm(ji),ae_ns(ji,jst)
+                WRITE (numout,*)'flux_top,ru_ns,qdrain,tsink,q0,precisol',flux_top(ji),ru_ns(ji,jst), &
+                     &      dr_ns(ji,jst),tsink(ji),qflux00(ji,jst),precisol_ns(ji,jst)
+                WRITE (numout,*)'water2infilt',water2infilt(ji,jst)
+                WRITE (numout,*)'soiltile',soiltile(ji,jst)
+                WRITE (numout,*)'irrigation, returnflow, reinfiltration', &
+                     & irrigation_soil(ji),returnflow_soil(ji),reinfiltration_soil(ji)
+                WRITE (numout,*)'mc',mc(ji,:,jst)
+                WRITE (numout,*)'qflux',qflux(ji,:,jst)
+                WRITE (numout,*)'veget_max', veget_max(ji,:)
+                WRITE (numout,*)'k', k(ji,:)
+                WRITE (numout,*)'soiltile',soiltile(ji,jst)
+
+                error=.TRUE.
+                CALL ipslerr_p(2, 'hydrol_soil', 'We will STOP in the end of this subroutine.',&
+                     & 'CWRR MC NEGATIVE','')
+             ENDIF
+          END DO
+
+          DO ji=1,kjpindex
+             IF (ru_ns(ji,jst)*soiltile(ji,jst).LT.-min_sechiba) THEN
+                WRITE (numout,*) 'Negative runoff', ji,jst, mask_soiltile(ji,jst) 
+                WRITE (numout,*) 'mc1, mc2', mc(ji,1,jst), mc(ji,2,jst)
+                WRITE (numout,*) 'mcint1, mcint2', mcint(ji,1), mcint(ji,2)
+                WRITE (numout,*) 'qflux1, flux_top', qflux(ji,nslm,jst), flux_top(ji)
+                WRITE (numout,*) 'is_over_mcs, is_under_mcr, test', &
+                     & is_over_mcs(ji), is_under_mcr(ji), tmc(ji,jst)-tmcint(ji)+qflux(ji,nslm,jst)+SUM(rootsink(ji,:,jst))
+                WRITE (numout,*)'mc', mc(ji,:,jst)
+                WRITE (numout,*)'mcint', mcint(ji,:)
+                WRITE (numout,*)'qflux', qflux(ji,:,jst)
+                WRITE (numout,*)'rootsink1,evapot_penm,vegtot', rootsink(ji,1,jst), evapot_penm(ji), vegtot(ji)
+                WRITE (numout,*) 'ae_ns, tsink, returnflow, reinfiltration, precisol_ns, irrigation, qflux0, ru_ns', &
+                     & ae_ns(ji,jst), tsink(ji), returnflow_soil(ji), reinfiltration_soil(ji), &
+                     & precisol_ns(ji,jst), irrigation_soil(ji), qflux00(ji,jst), ru_ns(ji,jst)
+
+                error=.TRUE.
+                CALL ipslerr_p(2, 'hydrol_soil', 'We will STOP in the end of this subroutine.',&
+                     & 'Negative runoff, non-saturated soil','')
+             ENDIF
+          ENDDO
+       ENDIF
+
+       IF (printlev>=3) WRITE (numout,*) ' hydrol_soil done for jst =', jst     
+
+       IF (ok_freeze_cwrr) THEN
+          DO ji = 1, kjpindex
+             kk_moy(ji,:) =kk_moy(ji,:)+soiltile(ji,jst)*k(ji,:) 
+             kk(ji,:,jst)=k(ji,:)
+          ENDDO
+       ENDIF
+
+    END DO  ! end of loop on soiltile
+
+    !! -- ENDING THE MAIN LOOP ON SOILTILES
+
+    !! 11 Summing 3d variables into 2d variables
+    !
+    CALL hydrol_diag_soil (kjpindex, veget_max, soiltile, njsc, runoff, drainage, &
+         & evapot, vevapnu, returnflow, reinfiltration, irrigation, &
+         & shumdiag,shumdiag_perma, k_litt, litterhumdiag, humrel, vegstress, drysoil_frac,tot_melt)
+
+    !! -- COMPUTING EVAP_BARE_LIM_NS FOR NEXT TIME STEP, WITH A LOOP ON SOILTILES
+    !
+    !! 12 Calculation of evap_bare_limit : limitation factor for bare soil evaporation
+    !
+    evap_bare_lim(:) = zero
+    evap_bare_lim_ns(:,:) = zero
+
+    !!_  for each soil tile
+    !   
+    DO jst = 1,nstm
+
+   !! 12.1 Save mc and tmc for use at the end of the time step
+   !!      and calculate tmcint corresponding to mc without water2infilt
+       DO jsl = 1, nslm
+          DO ji = 1, kjpindex
+             mcint(ji,jsl) = mask_soiltile(ji,jst) * mc(ji,jsl,jst)
+          ENDDO
+       ENDDO
+
+       DO ji = 1, kjpindex
+          temp(ji) = tmc(ji,jst)
+       ENDDO
+
+       ! Calculate tmc corresponding to mc without water2infilt and save it for later use
+       DO ji = 1, kjpindex
+          tmcint(ji) = dz(2) * ( trois*mcint(ji,1) + mcint(ji,2) )/huit
+       ENDDO
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmcint(ji) = tmcint(ji) + dz(jsl) &
+                  * (trois*mcint(ji,jsl)+mcint(ji,jsl-1))/huit &
+                  + dz(jsl+1) * (trois*mcint(ji,jsl)+mcint(ji,jsl+1))/huit
+          ENDDO
+       ENDDO
+       DO ji = 1, kjpindex
+          tmcint(ji) = tmcint(ji) + dz(nslm) &
+               * (trois * mcint(ji,nslm) + mcint(ji,nslm-1))/huit
+       ENDDO
+
+     !! 12.2 K and D are recomputed for the profile of mc
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+     !! 12.3 Set the values for diffusion scheme
+       CALL hydrol_soil_setup(kjpindex,jst)
+       resolv(:) = (mask_soiltile(:,jst) .GT. 0)
+
+     !! 12.3 compute matrix coefficients 
+     !- estimate maximum evaporation flux_top in mm/step, assuming the water is available
+     ! AD*** this should lead to never have evapnu>evapot_penm(ji)
+     ! AD*** why isn't there rootsinks ?
+       DO ji = 1, kjpindex
+          IF(vegtot(ji).GT.min_sechiba) THEN
+             flux_top(ji) = evapot_penm(ji) * &
+                  AINT(frac_bare_ns(ji,jst)+un-min_sechiba)
+          ELSE
+             flux_top(ji) = zero
+          ENDIF
+       ENDDO
+
+       ! Update coefficients depending on mc
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+       IF (ok_freeze_cwrr) THEN
+          DO ji =1, kjpindex
+             DO jsl = 1, nslm
+                mcl(ji,jsl,jst)= MIN(mc(ji,jsl,jst),mcr(njsc(ji))+(1-profil_froz_hydro_ns(ji,jsl,jst))&
+                     *(mc(ji,jsl,jst)-mcr(njsc(ji))))
+             ENDDO
+          ENDDO
+       ELSE
+          mcl(:,:,jst)=mc(:,:,jst)
+       ENDIF
+
+       !- First layer
+       DO ji = 1, kjpindex
+          tmat(ji,1,1) = zero
+          tmat(ji,1,2) = f(ji,1)
+          tmat(ji,1,3) = g1(ji,1)
+          rhs(ji,1)    = fp(ji,1) * mcl(ji,1,jst) + gp(ji,1)*mcl(ji,2,jst) &
+               - flux_top(ji) - (b(ji,1)+b(ji,2))/deux *(dt_sechiba/one_day)
+       ENDDO
+       !- soil body
+       DO jsl=2, nslm-1
+          DO ji = 1, kjpindex
+             tmat(ji,jsl,1) = e(ji,jsl)
+             tmat(ji,jsl,2) = f(ji,jsl)
+             tmat(ji,jsl,3) = g1(ji,jsl)
+             rhs(ji,jsl) = ep(ji,jsl)*mcl(ji,jsl-1,jst) + fp(ji,jsl)*mcl(ji,jsl,jst) &
+                  +  gp(ji,jsl) * mcl(ji,jsl+1,jst) &
+                  + (b(ji,jsl-1) - b(ji,jsl+1)) * (dt_sechiba/one_day) / deux
+          ENDDO
+       ENDDO
+       !- Last layer
+       DO ji = 1, kjpindex
+          jsl=nslm
+          tmat(ji,jsl,1) = e(ji,jsl)
+          tmat(ji,jsl,2) = f(ji,jsl)
+          tmat(ji,jsl,3) = zero
+          rhs(ji,jsl) = ep(ji,jsl)*mcl(ji,jsl-1,jst) + fp(ji,jsl)*mcl(ji,jsl,jst) &
+               + (b(ji,jsl-1) + b(ji,jsl)*(un-deux*free_drain_coef(ji,jst))) * (dt_sechiba/one_day) / deux
+       ENDDO
+       !- Store the equations for later use (15.5.2)
+       DO jsl=1,nslm
+          DO ji = 1, kjpindex
+             srhs(ji,jsl) = rhs(ji,jsl)
+             stmat(ji,jsl,1) = tmat(ji,jsl,1)
+             stmat(ji,jsl,2) = tmat(ji,jsl,2)
+             stmat(ji,jsl,3) = tmat(ji,jsl,3)
+          ENDDO
+       ENDDO
+
+    !! 12.5.1 Resolution with flux=evapot_penm (update mcl)
+       CALL hydrol_soil_tridiag(kjpindex,jst)
+
+    !! 12.5.2 Resolution with mc(1)=mcr
+       ! hydrol_soil_tridiag calcule les mc recursivement
+       ! a partir du haut en fonction de rhs et tmat. Ci-dessous, on reutilise ces valeurs, sauf pour mc(1)=mcr et tmat associes
+
+       !! Reset the coefficient for diffusion (only used if resolv(ji) = .TRUE.)
+       DO ji = 1, kjpindex
+          resolv(ji) = (mcl(ji,1,jst).LT.(mcr(njsc(ji))).AND.flux_top(ji).GT.min_sechiba)
+       ENDDO
+       DO jsl=1,nslm
+          !- The new condition is to put the upper layer at residual soil moisture
+          DO ji = 1, kjpindex
+             rhs(ji,jsl) = srhs(ji,jsl)
+             tmat(ji,jsl,1) = stmat(ji,jsl,1)
+             tmat(ji,jsl,2) = stmat(ji,jsl,2)
+             tmat(ji,jsl,3) = stmat(ji,jsl,3)
+          END DO
+       END DO
+       
+       DO ji = 1, kjpindex
+          tmat(ji,1,2) = un
+          tmat(ji,1,3) = zero
+          rhs(ji,1) = mcr(njsc(ji))
+       ENDDO
+       
+       !! Resolve the equations with new boundary conditions if necessary (update mcl)
+       CALL hydrol_soil_tridiag(kjpindex,jst)
+
+       ! Update coefficients depending on mc
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+       ! Calculation of total soil moisture content (liquid + frozen)
+       IF (ok_freeze_cwrr) THEN
+          DO ji =1, kjpindex
+             DO jsl = 1, nslm
+                mc(ji,jsl,jst)=MAX(mcl(ji,jsl,jst), mcl(ji,jsl,jst)+profil_froz_hydro_ns(ji,jsl,jst)*(mc(ji,jsl,jst)-mcr(njsc(ji))))
+             ENDDO
+          ENDDO
+       ELSE
+          mc(:,:,jst)=mcl(:,:,jst)
+       ENDIF
+
+
+       !! Correct bad moisture content due to numerical errors before water balance
+       DO ji = 1, kjpindex
+          DO jsl = 1,nslm
+             IF (mc(ji,jsl,jst) .LT. mcr(njsc(ji)) .AND. mc(ji,jsl,jst) .NE. 0.) THEN
+                mc(ji,jsl,jst)=mcr(njsc(ji))
+             END IF
+             IF (mc(ji,jsl,jst) .GT. mcs(njsc(ji)) .AND. mc(ji,jsl,jst) .NE. 0.) THEN
+                mc(ji,jsl,jst)=mcs(njsc(ji))
+             END IF
+          ENDDO
+       ENDDO
+
+    !! 12.6 Water balance
+
+    !! 12.6.1 Compute dr_ns with the bottom boundary condition 
+
+    ! Initialize qflux at bottom of diffusion
+       DO ji = 1, kjpindex
+          flux_bottom(ji) = mask_soiltile(ji,jst)*k(ji,nslm)*free_drain_coef(ji,jst) * (dt_sechiba/one_day)
+       ENDDO
+
+    !! 12.6.2 Compute total soil moisture content
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+       ENDDO       
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl) &
+                  * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+       ENDDO
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = tmc(ji,jst) + dz(nslm) &
+               * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+       END DO
+    
+    !! 12.6.3 Deduce upper flux from soil moisture variation and bottom flux
+    !! TMCi-D-E=TMC   
+       ! AD*** what about rootsink ??? + shouldn't we check/force that evap_bare_lim_ns LE evapot_penman ?
+       ! AD*** et pourquoi c'est l'humidite totale qui intervient ici ??? 
+       ! c'est pour deduire flux au top quand on ne le connait pas : cas ou on impose mc1=mcr
+       ! AD*** et si evap_bare_lim_ns<0 ?? car on suppose que tmcint > tmc(new)
+       ! water2inflit permet de propager de la ponded water d'un pas de temps a l'autre:
+       ! peut-on s'en servir pour creer des cas d'evapnu potentielle ? a gerer dans diffuco ?
+       DO ji = 1, kjpindex
+          evap_bare_lim_ns(ji,jst) = mask_soiltile(ji,jst) * &
+               (tmcint(ji)-tmc(ji,jst)-flux_bottom(ji))
+       END DO
+
+    !! 12.7 Determination of evap_bare_lim_ns
+       DO ji = 1, kjpindex
+          ! Here we weight evap_bare_lim_ns by the fraction of bare evaporating soil. 
+          ! This is given by frac_bare_ns, taking into account bare soil under vegetation
+          IF(vegtot(ji) .GT. min_sechiba) THEN
+             evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) * frac_bare_ns(ji,jst)
+          ELSE
+             evap_bare_lim_ns(ji,jst) = 0.
+          ENDIF
+       END DO
+
+       ! We divide by evapot, which is consistent with diffuco (evap_bare_lim_ns < evapot_penm/evapot)
+       ! Further decrease if tmc_litter is below the wilting point
+       DO ji=1,kjpindex
+          IF ((evapot(ji).GT.min_sechiba) .AND. &
+               (tmc_litter(ji,jst).GT.(tmc_litter_wilt(ji,jst)))) THEN
+             evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) / evapot(ji)
+          ELSEIF((evapot(ji).GT.min_sechiba).AND. &
+               (tmc_litter(ji,jst).GT.(tmc_litter_res(ji,jst)))) THEN
+             evap_bare_lim_ns(ji,jst) =  (un/deux) * evap_bare_lim_ns(ji,jst) / evapot(ji)
+             ! AD*** ceci, tres arbitraire, non modifie par AC
+             ! on peut reduire evap_bare_lim_ns en passant au carre par exemple....
+          ELSE
+             evap_bare_lim_ns(ji,jst) = zero
+          END IF
+          evap_bare_lim_ns(ji,jst)=MAX(MIN(evap_bare_lim_ns(ji,jst),1.),0.)
+       END DO
+
+       ! Set evap_bare_lim_ns to zero if is_under_mcr (cf us, humrelv, vegstressv)
+       WHERE (is_under_mcr(:))
+          evap_bare_lim_ns(:,jst) = zero
+       ENDWHERE
+
+    !! 12.8 Restore mc and tmc
+       DO jsl = 1, nslm
+          DO ji = 1, kjpindex
+             mc(ji,jsl,jst) = mask_soiltile(ji,jst) * mcint(ji,jsl)
+          ENDDO
+       ENDDO
+
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = temp(ji)
+       ENDDO
+
+    ENDDO !end loop on tiles
+
+    !! 12.9 Deduction of evap_bar_lim
+    DO ji = 1, kjpindex
+       evap_bare_lim(ji) =  SUM(evap_bare_lim_ns(ji,:)*vegtot(ji)*soiltile(ji,:))
+    ENDDO
+
+    !! 12.10 Writing variables to DOC calculation in stomate
+    wat_flux(:,:,:) = zero
+    wat_flux0(:,:) = zero
+    soil_mc(:,:,:)=zero
+    litter_mc(:,:)=zero
+    drainage_per_soil(:,:) = zero
+    runoff_per_soil(:,:) = zero
+    soil_mc(:,:,:)=mc(:,:,:)
+    litter_mc(:,:)=tmc_litter(:,:)
+    drainage_per_soil(:,:) = dr_ns(:,:)
+    runoff_per_soil(:,:) = ru_ns(:,:)
+    wat_flux(:,:,:) = qflux(:,:,:)
+    wat_flux0(:,:) = qflux00(:,:)
+    !
+    !! 13 Exit if error was found previously in this subroutine
+    !
+    IF ( error ) THEN
+       WRITE(numout,*) 'One or more errors have been detected in hydrol_soil. Model stops.'
+       CALL ipslerr_p(3, 'hydrol_soil', 'We will STOP now.',&
+                  & 'One or several fatal errors were found previously.','')
+    END IF
+
+  END SUBROUTINE hydrol_soil
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_infilt
+!!
+!>\BRIEF        Infiltration
+!!
+!! DESCRIPTION  :
+!! - 1 First layer
+!! - 2 Infiltration layer by layer 
+!! - 2.1 Initialisation
+!! - 2.2 Infiltrability of each layer if under a saturated one
+!! - 2.3 Compute the mean rate at which water actually infiltrate:
+!! - 2.4 From which we deduce the time it takes to fill up the layer or to end the time step...
+!! - 2.5 The water enters in the layer
+!! - 3 Verification
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_infilt
+
+  SUBROUTINE hydrol_soil_infilt(kjpindex, ins, njsc, flux_infilt)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! GLOBAL (in or inout)
+    INTEGER(i_std), INTENT(in)                        :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                        :: ins
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)  :: njsc            !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)    :: flux_infilt     !! Water to infiltrate
+                                                                         !!  @tex $(kg m^{-2})$ @endtex
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                :: ji, jsl             !! Indices
+    REAL(r_std), DIMENSION (kjpindex)             :: wat_inf_pot         !! infiltrable water in the layer
+    REAL(r_std), DIMENSION (kjpindex)             :: wat_inf             !! infiltrated water in the layer
+    REAL(r_std), DIMENSION (kjpindex)             :: dt_tmp              !! time remaining before the end of the time step
+    REAL(r_std), DIMENSION (kjpindex)             :: dt_inf              !! the time it takes to complete the infiltration in the 
+                                                                         !! layer 
+    REAL(r_std)                                   :: k_m                 !! the mean conductivity used for the saturated front
+    REAL(r_std), DIMENSION (kjpindex)             :: infilt_tmp          !! infiltration rate for the considered layer 
+    REAL(r_std), DIMENSION (kjpindex)             :: infilt_tot          !! total infiltration 
+    REAL(r_std), DIMENSION (kjpindex)             :: flux_tmp            !! rate at which precip hits the ground
+
+!_ ================================================================================================================================
+
+    ! If data (or coupling with GCM) was available, a parameterization for subgrid rainfall could be performed
+
+    DO ji = 1, kjpindex
+       !-
+    !_ 1 First layer
+       !-
+       ! First we fill up the first layer (about 1mm) without any resistance and quasi-immediately
+       wat_inf_pot(ji) = MAX((mcs(njsc(ji))-mc(ji,1,ins)) * dz(2) / deux, zero)
+       wat_inf(ji) = MIN(wat_inf_pot(ji), flux_infilt(ji))
+       mc(ji,1,ins) = mc(ji,1,ins) + wat_inf(ji) * deux / dz(2)
+       !
+    ENDDO
+    !-
+    !! 2 Infiltration layer by layer 
+    !! 2.1 Initialisation
+    ! Initialize a countdown for infiltration during the time-step and the value of potential runoff
+    dt_tmp(:) = dt_sechiba / one_day
+    infilt_tot(:) = wat_inf(:)
+    ! Compute the rate at which water will try to infiltrate each layer
+    ! flux_temp is converted here to the same unit as k_m
+    flux_tmp(:) = (flux_infilt(:)-wat_inf(:)) / dt_tmp(:)
+    !
+    DO jsl = 2, nslm-1
+       DO ji = 1, kjpindex
+    !! 2.2 Infiltrability of each layer if under a saturated one
+          ! This is computed by an simple arithmetic average because 
+          ! the time step (30min) is not appropriate for a geometric average (advised by Haverkamp and Vauclin)
+          k_m = (k(ji,jsl) + ks(njsc(ji))*kfact(jsl-1,njsc(ji))*kfact_root(ji,jsl,ins)) / deux 
+
+          IF (ok_freeze_cwrr) THEN
+             IF (temp_hydro(ji, jsl) .LT. ZeroCelsius) THEN
+                k_m = k(ji,jsl)
+             ENDIF
+          ENDIF
+
+    !! 2.3 We compute the mean rate at which water actually infiltrate:
+          ! Subgrid: Exponential distribution of k around k_m, but average p directly used 
+          ! See d'Orgeval 2006, p 78, but it's not fully clear to me (AD***)
+          infilt_tmp(ji) = k_m * (un - EXP(- flux_tmp(ji) / k_m)) 
+
+    !! 2.4 From which we deduce the time it takes to fill up the layer or to end the time step...
+          wat_inf_pot(ji) =  MAX((mcs(njsc(ji))-mc(ji,jsl,ins)) * (dz(jsl) + dz(jsl+1)) / deux, zero)
+          IF ( infilt_tmp(ji) > min_sechiba) THEN
+             dt_inf(ji) =  MIN(wat_inf_pot(ji)/infilt_tmp(ji), dt_tmp(ji))
+             ! The water infiltration TIME has to limited by what is still available for infiltration.
+             IF ( dt_inf(ji) * infilt_tmp(ji) > flux_infilt(ji)-infilt_tot(ji) ) THEN
+                dt_inf(ji) = MAX(flux_infilt(ji)-infilt_tot(ji),zero)/infilt_tmp(ji)
+             ENDIF
+          ELSE
+             dt_inf(ji) = dt_tmp(ji)
+          ENDIF
+
+    !! 2.5 The water enters in the layer
+          wat_inf(ji) = dt_inf(ji) * infilt_tmp(ji)
+          ! bviously the moisture content
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) + &
+               & wat_inf(ji) * deux / (dz(jsl) + dz(jsl+1))
+          ! the time remaining before the next time step
+          dt_tmp(ji) = dt_tmp(ji) - dt_inf(ji)
+          ! and finally the infilt_tot (which is just used to check if there is a problem, below) 
+          infilt_tot(ji) = infilt_tot(ji) + infilt_tmp(ji) * dt_inf(ji)
+       ENDDO
+    ENDDO
+    
+    !! 3 Verification
+    DO ji = 1, kjpindex
+       IF (infilt_tot(ji) .LT. -min_sechiba .OR. infilt_tot(ji) .GT. flux_infilt(ji) + min_sechiba) THEN
+          WRITE (numout,*) 'Error in the calculation of infilt tot', infilt_tot(ji)
+          WRITE (numout,*) 'k, ji, jst, mc', k(ji,1:2), ji, ins, mc(ji,1,ins)
+          CALL ipslerr_p(3, 'hydrol_soil_infilt', 'We will STOP now.','Error in calculation of infilt tot','')
+       ENDIF
+    ENDDO
+
+  END SUBROUTINE hydrol_soil_infilt
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_smooth
+!!
+!>\BRIEF        : Modifies the soil moisture profile to avoid over-saturation or under-residual values, 
+!!                then diagnoses the points where such "excess" values remain. 
+!!
+!! DESCRIPTION  :
+!! The "excesses" (over-saturation or under-residual) are corrected from top to bottom, by transfer of excesses 
+!! to the lower layers. The reverse transfer is performed to smooth any remaining "excess" in the bottom layer.
+!! If some "excess" remain afterwards, the entire soil profile is at the threshold value (mcs or mcr), 
+!! and the remaining "excess" is necessarily concentrated in the top layer. 
+!! This allowing diagnosing the flags is_over_mcs and is_under_mcr. 
+!! Eventually, the remaining "excess" is split over the entire profile
+! AD*** but I don't undersand the weighting scheme
+!! - 1 Avoid over-saturation values
+!! - 1.1 smoothing from top to bottom
+!! - 1.2 smoothing from bottom to top
+!! - 1.3 diagnoses is_over_mcs(ji), and updates the entire profile
+!! - 2 Avoid below residual values
+!! - 2.1 smoothing from top to bottom
+!! - 2.2 smoothing from bottom to top
+!! - 2.3 diagnoses is_under_mcr(ji), and updates the entire profile
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_smooth
+
+  SUBROUTINE hydrol_soil_smooth(kjpindex, ins, njsc, is_under_mcr, is_over_mcs)
+
+    !- arguments
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                         :: ins             !! Soiltile index (1-nstm, unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: njsc            !! Index of the dominant soil textural class in grid cell 
+                                                                          !! (1-nscm, unitless)
+
+    !! 0.2 Output variables
+
+    LOGICAL, DIMENSION(kjpindex), INTENT(out)          :: is_under_mcr    !! Flag diagnosing under residual soil moisture  
+    LOGICAL, DIMENSION(kjpindex), INTENT(out)          :: is_over_mcs     !! Flag diagnosing over saturated soil moisture 
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                       :: ji,jsl
+    REAL(r_std)                          :: excess
+    REAL(r_std), DIMENSION(kjpindex)     :: excessji
+
+!_ ================================================================================================================================       
+    !-
+    !! 1 Avoid over-saturation values
+    !-
+
+    ! in case of over-saturation we put the water where it is possible
+
+    !! 1.1 smoothing from top to bottom
+    DO jsl = 1, nslm-2
+       DO ji=1, kjpindex
+          excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
+          mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) + excess * &
+               &  (dz(jsl)+dz(jsl+1))/(dz(jsl+1)+dz(jsl+2))
+       ENDDO
+    ENDDO
+
+    jsl = nslm-1
+    DO ji=1, kjpindex
+       excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
+       mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
+       mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) + excess * &
+            &  (dz(jsl)+dz(jsl+1))/dz(jsl+1)
+    ENDDO
+
+    jsl = nslm
+    DO ji=1, kjpindex
+       excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
+       mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
+       mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) + excess * &
+            &  dz(jsl)/(dz(jsl-1)+dz(jsl))
+    ENDDO
+
+    !! 1.2 smoothing from bottom to top
+    DO jsl = nslm-1,2,-1
+       DO ji=1, kjpindex
+          excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
+          mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) + excess * &
+               &  (dz(jsl)+dz(jsl+1))/(dz(jsl-1)+dz(jsl))
+       ENDDO
+    ENDDO
+
+    !! 1.3 diagnoses is_over_mcs(ji), and updates the entire profile 
+    DO ji=1, kjpindex
+       excessji(ji) = mask_soiltile(ji,ins) * MAX(mc(ji,1,ins)-mcs(njsc(ji)),zero)
+    ENDDO
+
+    DO ji=1, kjpindex
+       mc(ji,1,ins) = mc(ji,1,ins) - excessji(ji) ! then mc(1)=mcs
+
+       is_over_mcs(ji) = (excessji(ji) .GT. min_sechiba)
+    ENDDO
+    ! the amount of water corresponding to excess in the top soil layer is redistributed in all soil layers
+    ! AD*** I don't understand the weighting by dz(2) / (deux * zmaxh*mille)
+    DO jsl = 1, nslm
+       DO ji=1, kjpindex
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) + excessji(ji) * dz(2) / (deux * zmaxh*mille)
+       ENDDO
+    ENDDO
+    ! AD*** it can lead to mc(jsl) > mcs depending on the value of excess
+    ! AD*** does it make sense to start the last loop at jsl=1 ?? as mc(1) has already been corrected
+
+    !-
+    !! 2 Avoid below residual values
+    !-
+
+    ! Smoothes the profile to avoid negative values of punctual soil moisture
+
+    !! 2.1 smoothing from top to bottom
+    DO jsl = 1,nslm-2
+       DO ji=1, kjpindex
+          excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
+          mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) - excess * &
+               &  (dz(jsl)+dz(jsl+1))/(dz(jsl+1)+dz(jsl+2))
+       ENDDO
+    ENDDO
+
+    jsl = nslm-1
+    DO ji=1, kjpindex
+       excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
+       mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
+       mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) - excess * &
+            &  (dz(jsl)+dz(jsl+1))/dz(jsl+1)
+    ENDDO
+
+    jsl = nslm
+    DO ji=1, kjpindex
+       excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
+       mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
+       mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) - excess * &
+            &  dz(jsl)/(dz(jsl-1)+dz(jsl))
+    ENDDO
+
+    !! 2.2 smoothing from bottom to top
+    DO jsl = nslm-1,2,-1
+       DO ji=1, kjpindex
+          excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
+          mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) - excess * &
+               &  (dz(jsl)+dz(jsl+1))/(dz(jsl-1)+dz(jsl))
+       ENDDO
+    ENDDO
+
+    !! 2.3 diagnoses is_under_mcr(ji), and updates the entire profile 
+    DO ji=1, kjpindex
+       excessji(ji) = mask_soiltile(ji,ins) * MAX(mcr(njsc(ji))-mc(ji,1,ins),zero)
+    ENDDO
+    DO ji=1, kjpindex
+       mc(ji,1,ins) = mc(ji,1,ins) + excessji(ji) ! then mc(1)=mcr
+       is_under_mcr(ji) = (excessji(ji) .GT. min_sechiba)
+    ENDDO
+
+    ! the amount of water corresponding to excess in the top soil layer is redistributed in all soil layers
+    ! AD*** I don't understand the weighting by dz(2) / (deux * zmaxh*mille)
+    DO jsl = 1, nslm
+       DO ji=1, kjpindex
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) - excessji(ji) * dz(2) / (deux * zmaxh*mille)
+       ENDDO
+    ENDDO
+    ! AD*** this can lead to mc(jsl) < mcr depending on the value of excess
+    ! AD*** does it make sense to start the last loop at jsl=1 ?? as mc(1) has already been corrected
+
+    ! We just make sure that mc remains at 0 where soiltile=0
+    DO jsl = 1, nslm
+       DO ji=1, kjpindex
+          mc(ji,jsl,ins) = mask_soiltile(ji,ins) * mc(ji,jsl,ins)
+       ENDDO
+    ENDDO
+    
+  END SUBROUTINE hydrol_soil_smooth
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_flux
+!!
+!>\BRIEF        This subroutine computes the hydrological fluxes between the different soil layers.
+!!
+!! DESCRIPTION  :
+!! - 1 Initialize qflux from the bottom, with dr_ns
+!! - 2 between layer nslm and nslm-1   
+!! - 3 we go to top and deduct qflux(1:nslm-2)   
+!! - 4 Water balance verification
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_flux
+
+  SUBROUTINE hydrol_soil_flux(kjpindex,ins,mcint,returnflow_soil)
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                         :: ins             !! index of soil type
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT(in) :: mcint           !! mc values at the beginning of the time step
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)      :: returnflow_soil !! returnflow
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: jsl,ji
+    REAL(r_std), DIMENSION(kjpindex)                   :: temp
+
+!_ ================================================================================================================================    
+    !- Compute the flux at every level from bottom to top (using mc and sink values)
+    DO ji = 1, kjpindex
+    !! 1 Initialize qflux from the bottom, with dr_ns
+       jsl = nslm
+       qflux(ji,jsl,ins) = dr_ns(ji,ins) - returnflow_soil(ji)
+    !!_ between layer nslm and nslm-1   
+       jsl = nslm-1
+       qflux(ji,jsl,ins) = qflux(ji,jsl+1,ins) & 
+            &  + (mc(ji,jsl,ins)-mcint(ji,jsl) &
+            &  + trois*mc(ji,jsl+1,ins) - trois*mcint(ji,jsl+1)) &
+            &  * (dz(jsl+1)/huit) &
+            &  + rootsink(ji,jsl+1,ins) 
+    ENDDO
+    !! 3 we go to top and deduct qflux(1:nslm-2)   
+    DO jsl = nslm-2,1,-1
+       DO ji = 1, kjpindex
+          qflux(ji,jsl,ins) = qflux(ji,jsl+1,ins) & 
+               &  + (mc(ji,jsl,ins)-mcint(ji,jsl) &
+               &  + trois*mc(ji,jsl+1,ins) - trois*mcint(ji,jsl+1)) &
+               &  * (dz(jsl+1)/huit) &
+               &  + rootsink(ji,jsl+1,ins) &
+               &  + (dz(jsl+2)/huit) &
+               &  * (trois*mc(ji,jsl+1,ins) - trois*mcint(ji,jsl+1) &
+               &  + mc(ji,jsl+2,ins)-mcint(ji,jsl+2)) 
+       END DO
+    ENDDO
+    
+    !! 4 Water balance verification  
+    DO ji = 1, kjpindex
+       temp(ji) =  qflux(ji,1,ins) + (dz(2)/huit) &
+            &  * (trois* (mc(ji,1,ins)-mcint(ji,1)) + (mc(ji,2,ins)-mcint(ji,2))) &
+            &  + rootsink(ji,1,ins)
+    ENDDO
+
+    DO ji = 1, kjpindex
+       IF (ABS(qflux00(ji,ins)-temp(ji)).GT. deux*min_sechiba) THEN
+          WRITE(numout,*) 'Problem in the water balance, qflux computation', qflux00(ji,ins),temp(ji)
+          WRITE (numout,*) 'returnflow_soil', returnflow_soil(ji)
+          WRITE(numout,*) 'ji', ji, 'jsl',jsl,'ins',ins
+          WRITE(numout,*) 'mcint', mcint(ji,:)
+          WRITE(numout,*) 'mc', mc(ji,:,ins)
+          WRITE (numout,*) 'rootsink', rootsink(ji,1,ins)
+          CALL ipslerr_p(3, 'hydrol_soil_flux', 'We will STOP now.',&
+               & 'Problem in the water balance, qflux computation','')
+       ENDIF
+    ENDDO
+
+  END SUBROUTINE hydrol_soil_flux
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_tridiag
+!!
+!>\BRIEF        This subroutine solves a set of linear equations which has a tridiagonal coefficient matrix. 
+!!
+!! DESCRIPTION  : It is only applied in the grid-cells where resolv(ji)=TRUE
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : mcl (global module variable)
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_tridiag 
+
+  SUBROUTINE hydrol_soil_tridiag(kjpindex,ins)
+
+    !- arguments
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                         :: ins             !! number of soil type
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ji,jsl
+    REAL(r_std), DIMENSION(kjpindex)                   :: bet
+    REAL(r_std), DIMENSION(kjpindex,nslm)              :: gam
+
+!_ ================================================================================================================================
+    DO ji = 1, kjpindex
+
+       IF (resolv(ji)) THEN
+          bet(ji) = tmat(ji,1,2)
+          mcl(ji,1,ins) = rhs(ji,1)/bet(ji)
+       ENDIF
+    ENDDO
+
+    DO jsl = 2,nslm
+       DO ji = 1, kjpindex
+          
+          IF (resolv(ji)) THEN
+
+             gam(ji,jsl) = tmat(ji,jsl-1,3)/bet(ji)
+             bet(ji) = tmat(ji,jsl,2) - tmat(ji,jsl,1)*gam(ji,jsl)
+             mcl(ji,jsl,ins) = (rhs(ji,jsl)-tmat(ji,jsl,1)*mcl(ji,jsl-1,ins))/bet(ji)
+          ENDIF
+
+       ENDDO
+    ENDDO
+
+    DO ji = 1, kjpindex
+       IF (resolv(ji)) THEN
+          DO jsl = nslm-1,1,-1
+             mcl(ji,jsl,ins) = mcl(ji,jsl,ins) - gam(ji,jsl+1)*mcl(ji,jsl+1,ins)
+          ENDDO
+       ENDIF
+    ENDDO
+
+  END SUBROUTINE hydrol_soil_tridiag
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_coef
+!!
+!>\BRIEF        Computes coef for the linearised hydraulic conductivity 
+!! k_lin=a_lin mc_lin+b_lin and the linearised diffusivity d_lin. 
+!!
+!! DESCRIPTION  :
+!! First, we identify the interval i in which the current value of mc is located.
+!! Then, we give the values of the linearized parameters to compute 
+!! conductivity and diffusivity as K=a*mc+b and d.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_coef
+ 
+  SUBROUTINE hydrol_soil_coef(kjpindex,ins,njsc)
+
+    IMPLICIT NONE
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                        :: kjpindex         !! Domain size
+    INTEGER(i_std), INTENT(in)                        :: ins              !! Index of soil type
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)  :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                    :: jsl,ji,i
+    REAL(r_std)                                       :: mc_ratio
+    REAL(r_std)                                       :: mc_used    !! Used liquid water content
+    REAL(r_std)                                       :: x,m
+    
+!_ ================================================================================================================================
+
+    IF (ok_freeze_cwrr) THEN
+    
+       ! Calculation of liquid and frozen saturation degrees with respect to residual
+       ! x=liquid saturation degree/residual=(mcl-mcr)/(mcs-mcr)
+       ! 1-x=frozen saturation degree/residual=(mcf-mcr)/(mcs-mcr) (=profil_froz_hydro)
+       
+       DO jsl=1,nslm
+          DO ji=1,kjpindex
+             ! Van Genuchten parameter for thermodynamical calculation
+             m = 1. -1./nvan(njsc(ji))
+           
+             IF ((.NOT. ok_thermodynamical_freezing).OR.(mc(ji,jsl, ins).LT.(mcr(njsc(ji))+min_sechiba))) THEN
+                ! Linear soil freezing or soil moisture below residual
+                IF (temp_hydro(ji, jsl).GE.(ZeroCelsius+fr_dT/2.)) THEN
+                   x=1._r_std
+                ELSE IF ( (temp_hydro(ji,jsl) .GE. (ZeroCelsius-fr_dT/2.)) .AND. &
+                     (temp_hydro(ji,jsl) .LT. (ZeroCelsius+fr_dT/2.)) ) THEN 
+                   x=(temp_hydro(ji, jsl)-(ZeroCelsius-fr_dT/2.))/fr_dT
+                ELSE 
+                   x=0._r_std
+                ENDIF
+             ELSE IF (ok_thermodynamical_freezing) THEN
+                ! Thermodynamical soil freezing
+                IF (temp_hydro(ji, jsl).GE.(ZeroCelsius+fr_dT/2.)) THEN
+                   x=1._r_std
+                ELSE IF ( (temp_hydro(ji,jsl) .GE. (ZeroCelsius-fr_dT/2.)) .AND. &
+                     (temp_hydro(ji,jsl) .LT. (ZeroCelsius+fr_dT/2.)) ) THEN 
+                   x=MIN(((mcs(njsc(ji))-mcr(njsc(ji))) &
+                        *((1000.*avan(njsc(ji))*(ZeroCelsius+fr_dT/2.-temp_hydro(ji, jsl)) &
+                        *lhf/ZeroCelsius/10.)**nvan(njsc(ji))+1.)**(-m)) / &
+                        (mc(ji,jsl, ins)-mcr(njsc(ji))),1._r_std)                
+                ELSE
+                   x=0._r_std
+                ENDIF
+             ENDIF
+             profil_froz_hydro_ns(ji, jsl,ins)=1._r_std-x
+             
+             ! mc_used is used in the calculation of hydrological properties
+             mc_used = mcr(njsc(ji))+x*(mc(ji,jsl, ins)-mcr(njsc(ji))) 
+             !
+             ! calcul de k based on mc_liq
+             !
+             i= MAX(imin, MIN(imax-1, INT(imin +(imax-imin)*(mc_used-mcr(njsc(ji)))/(mcs(njsc(ji))-mcr(njsc(ji))))))
+             a(ji,jsl) = a_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins)
+             b(ji,jsl) = b_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins)
+             d(ji,jsl) = d_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins)
+             k(ji,jsl) = MAX(k_lin(imin+1,jsl,njsc(ji)), &
+                  a_lin(i,jsl,njsc(ji)) * mc_used + b_lin(i,jsl,njsc(ji)))
+          ENDDO ! loop on grid
+       ENDDO
+             
+    ELSE
+       ! .NOT. ok_freeze_cwrr
+       DO jsl=1,nslm
+          DO ji=1,kjpindex 
+             
+             mc_ratio = MAX(mc(ji,jsl,ins)-mcr(njsc(ji)), zero)/(mcs(njsc(ji))-mcr(njsc(ji)))
+             
+             i= MAX(MIN(INT((imax-imin)*mc_ratio)+imin , imax-1), imin)
+             a(ji,jsl) = a_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
+             b(ji,jsl) = b_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
+             d(ji,jsl) = d_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm^2/d
+             k(ji,jsl) = MAX(k_lin(imin+1,jsl,njsc(ji)), &
+                  a_lin(i,jsl,njsc(ji)) * mc(ji,jsl,ins) + b_lin(i,jsl,njsc(ji))) 
+          END DO ! loop on grid
+       END DO
+    ENDIF
+    
+  END SUBROUTINE hydrol_soil_coef
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_setup
+!!
+!>\BRIEF        This subroutine computes the matrix coef.  
+!!
+!! DESCRIPTION  : None 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : matrix coef
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_soil_setup(kjpindex,ins)
+
+
+    IMPLICIT NONE
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                        :: kjpindex          !! Domain size
+    INTEGER(i_std), INTENT(in)                        :: ins               !! index of soil type
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std) :: jsl,ji
+    REAL(r_std)                        :: temp3, temp4
+
+!_ ================================================================================================================================
+    !-we compute tridiag matrix coefficients (LEFT and RIGHT) 
+    ! of the system to solve [LEFT]*mc_{t+1}=[RIGHT]*mc{t}+[add terms]: 
+    ! e(nslm),f(nslm),g1(nslm) for the [left] vector
+    ! and ep(nslm),fp(nslm),gp(nslm) for the [right] vector
+
+    ! w_time=1 (in constantes_soil) indicates implicit computation for diffusion 
+    temp3 = w_time*(dt_sechiba/one_day)/deux
+    temp4 = (un-w_time)*(dt_sechiba/one_day)/deux
+
+    ! Passage to arithmetic means for layer averages also in this subroutine : Aurelien 11/05/10
+
+    !- coefficient for first layer
+    DO ji = 1, kjpindex
+       e(ji,1) = zero
+       f(ji,1) = trois * dz(2)/huit  + temp3 &
+            & * ((d(ji,1)+d(ji,2))/(dz(2))+a(ji,1))
+       g1(ji,1) = dz(2)/(huit)       - temp3 &
+            & * ((d(ji,1)+d(ji,2))/(dz(2))-a(ji,2))
+       ep(ji,1) = zero
+       fp(ji,1) = trois * dz(2)/huit - temp4 &
+            & * ((d(ji,1)+d(ji,2))/(dz(2))+a(ji,1))
+       gp(ji,1) = dz(2)/(huit)       + temp4 &
+            & * ((d(ji,1)+d(ji,2))/(dz(2))-a(ji,2))
+    ENDDO
+
+    !- coefficient for medium layers
+
+    DO jsl = 2, nslm-1
+       DO ji = 1, kjpindex
+          e(ji,jsl) = dz(jsl)/(huit)                        - temp3 &
+               & * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl))+a(ji,jsl-1))
+
+          f(ji,jsl) = trois * (dz(jsl)+dz(jsl+1))/huit  + temp3 &
+               & * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl)) + &
+               & (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1)) )
+
+          g1(ji,jsl) = dz(jsl+1)/(huit)                     - temp3 &
+               & * ((d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1))-a(ji,jsl+1))
+
+          ep(ji,jsl) = dz(jsl)/(huit)                       + temp4 &
+               & * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl))+a(ji,jsl-1))
+
+          fp(ji,jsl) = trois * (dz(jsl)+dz(jsl+1))/huit - temp4 &
+               & * ( (d(ji,jsl)+d(ji,jsl-1))/(dz(jsl)) + &
+               & (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1)) )
+
+          gp(ji,jsl) = dz(jsl+1)/(huit)                     + temp4 &
+               & *((d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1))-a(ji,jsl+1))
+       ENDDO
+    ENDDO
+
+    !- coefficient for last layer
+    DO ji = 1, kjpindex
+       e(ji,nslm) = dz(nslm)/(huit)        - temp3 &
+            & * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm))+a(ji,nslm-1))
+       f(ji,nslm) = trois * dz(nslm)/huit  + temp3 &
+            & * ((d(ji,nslm)+d(ji,nslm-1)) / (dz(nslm)) &
+            & -a(ji,nslm)*(un-deux*free_drain_coef(ji,ins)))
+       g1(ji,nslm) = zero
+       ep(ji,nslm) = dz(nslm)/(huit)       + temp4 &
+            & * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm))+a(ji,nslm-1))
+       fp(ji,nslm) = trois * dz(nslm)/huit - temp4 &
+            & * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm)) &
+            & -a(ji,nslm)*(un-deux*free_drain_coef(ji,ins)))
+       gp(ji,nslm) = zero
+    ENDDO
+
+  END SUBROUTINE hydrol_soil_setup
+
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_split_soil
+!!
+!>\BRIEF        Splits 2d variables into 3d variables, per soiltile (_ns suffix), at the beginning of hydrol
+!!
+!! DESCRIPTION  :
+!! - 1 Split 2d variables into 3d variables, per soiltile
+!! - 1.1 Throughfall
+!! - 1.2 evaporation
+!! - 1.2.1 vevapnu_old
+!! - 1.2.2 ae_ns new
+!! - 1.3 transpiration
+!! - 1.4 root sink
+!! - 2 Verification
+!! - 2.1 Check of mc
+!! - 2.2 Check if the deconvolution is correct and conserves the fluxes
+!! - 2.2.1 the precisol and evapnu
+!! - 2.2.2 the transpiration and root sink
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_split_soil
+
+  SUBROUTINE hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, evap_bare_lim, tot_bare_soil)
+    ! 
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in)       :: veget_max        !! max Vegetation map 
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltile         !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)           :: vevapnu          !! Bare soil evaporation
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)       :: transpir         !! Transpiration
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)       :: humrel           !! Relative humidity
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evap_bare_lim    !!   
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: tot_bare_soil    !! Total evaporating bare soil fraction 
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                :: ji, jv, jsl, jst
+    REAL(r_std), DIMENSION (kjpindex)             :: vevapnu_old
+    REAL(r_std), DIMENSION (kjpindex)             :: tmp_check1
+    REAL(r_std), DIMENSION (kjpindex)             :: tmp_check2
+    REAL(r_std), DIMENSION (kjpindex,nstm)        :: tmp_check3
+    LOGICAL                                       :: error=.FALSE. !! If true, exit in the end of subroutine
+
+!_ ================================================================================================================================
+    !
+    !
+    !! 1 Split 2d variables into 3d variables, per soiltile
+    !
+    ! Reminders:
+    !  corr_veg_soil(:,nvm,nstm) = PFT fraction per soiltile in each grid-cell
+    !      corr_veg_soil(ji,jv,jst)=veget_max(ji,jv)/soiltile(ji,jst) 
+    !  cvs_over_veg(:,nvm,nstm) = old value of corr_veg_soil/veget_max/vegtot, kept from diag to next split 
+    !  soiltile(:,nstm) = fraction (of vegtot+totfrac_nobio) covered by each soiltile in a grid-cell (0-[1-fracnobio], unitless)  
+    !      soiltile #1 includes nobio 
+    !  vegtot(:) = total fraction of grid-cell covered by PFTs (fraction with bare soil + vegetation)
+    !  veget_max(:,nvm) = PFT fractions of vegtot+frac_nobio 
+    !  veget(:,nvm) =  fractions (of vegtot+frac_nobio) covered by vegetation in each PFT 
+    !       BUT veget(:,1)=veget_max(:,1) 
+    !  frac_bare(:,nvm) = fraction (of veget_max) with bare soil in each PFT
+    !  tot_bare_soil(:) = total evaporating bare soil fraction (=SUM(frac_bare*veget_max))
+    !  frac_bare_ns(:,nstm) = evaporating bare soil fraction (of vegtot) per soiltile (defined in hydrol_vegupd)
+    ! 
+    ! AD *** isn't there a pb in corr_veg_soil as SUM(soiltiles)=totfrac_nobio + vegtot ???
+    !
+    !! 1.1 Throughfall
+    !      We use corr_veg_soil, i.e. the vegetation cover of this timestep, which is normal for interception processes
+    precisol_ns(:,:)=zero
+    DO jv=1,nvm
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF(veget_max(ji,jv).GT.min_sechiba) THEN
+                precisol_ns(ji,jst)=precisol_ns(ji,jst)+precisol(ji,jv)* &
+                     & corr_veg_soil(ji,jv,jst) /vegtot(ji) / veget_max(ji,jv)
+             ENDIF
+          END DO
+       END DO
+    END DO
+    !
+    !
+    !! 1.2 Bare soil evaporation
+    !! 1.2.1 vevapnu_old
+    vevapnu_old(:)=zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          IF ( vegtot(ji) .GT. min_sechiba) THEN
+             vevapnu_old(ji)=vevapnu_old(ji)+ &
+                  & ae_ns(ji,jst)*soiltile(ji,jst)*vegtot(ji)
+          ENDIF
+       END DO
+    END DO
+    !
+    !
+    !! 1.2.2 ae_ns new
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          IF (vevapnu_old(ji).GT.min_sechiba) THEN   
+             IF(evap_bare_lim(ji).GT.min_sechiba) THEN       
+                ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji)
+             ELSE
+                IF(vevapnu_old(ji).GT.min_sechiba) THEN  
+                   ae_ns(ji,jst)=ae_ns(ji,jst) * vevapnu(ji)/vevapnu_old(ji)
+                ELSE
+                   ae_ns(ji,jst)=zero
+                ENDIF
+             ENDIF
+          ELSEIF(frac_bare_ns(ji,jst).GT.min_sechiba) THEN
+             IF(evap_bare_lim(ji).GT.min_sechiba) THEN  
+                ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji)
+             ELSE
+                IF(tot_bare_soil(ji).GT.min_sechiba) THEN  
+                   ae_ns(ji,jst) = vevapnu(ji) * frac_bare_ns(ji,jst)/tot_bare_soil(ji)
+                ELSE
+                   ae_ns(ji,jst) = zero
+                ENDIF
+             ENDIF
+          ENDIF
+          precisol_ns(ji,jst)=precisol_ns(ji,jst)+MAX(-ae_ns(ji,jst),zero)
+       END DO
+    END DO
+    !
+    !
+    !! 1.3 transpiration
+    tr_ns(:,:)=zero
+    DO jv=1,nvm
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF (humrel(ji,jv).GT.min_sechiba) THEN 
+                tr_ns(ji,jst)=tr_ns(ji,jst)+ cvs_over_veg(ji,jv,jst)*humrelv(ji,jv,jst)* & 
+                     & transpir(ji,jv)/humrel(ji,jv)
+             ENDIF
+          END DO
+       END DO
+    END DO
+
+    !
+    !
+    !! 1.4 root sink
+    rootsink(:,:,:)=zero
+    DO jv=1,nvm
+       DO jsl=1,nslm
+          DO jst=1,nstm
+             DO ji=1,kjpindex
+                IF (humrel(ji,jv).GT.min_sechiba) THEN 
+                   rootsink(ji,jsl,jst) = rootsink(ji,jsl,jst) &
+                        & + cvs_over_veg(ji,jv,jst)* (transpir(ji,jv)*us(ji,jv,jst,jsl))/ &
+                        & humrel(ji,jv)
+                END IF
+             END DO
+          END DO
+       END DO
+    END DO
+
+    !! 2 Verification
+    !! 2.1 Check of mc
+    IF(check_cwrr) THEN
+       DO jsl=1,nslm
+          DO jst=1,nstm
+             DO ji=1,kjpindex
+                IF(mc(ji,jsl,jst).LT.-0.05) THEN
+                   WRITE(numout,*) 'CWRR split-----------------------------------------------'
+                   WRITE(numout,*) 'ji,jst,jsl',ji,jst,jsl
+                   WRITE(numout,*) 'mc',mc(ji,jsl,jst)
+                   WRITE(numout,*) 'rootsink,us',rootsink(ji,:,jst),us(ji,:,jst,jsl)
+                   WRITE(numout,*) 'corr_veg_soil',corr_veg_soil(ji,:,jst)
+                   WRITE(numout,*) 'transpir',transpir(ji,:)
+                   WRITE(numout,*) 'veget_max',veget_max(ji,:)
+                   WRITE(numout,*) 'cvs_over_veg',cvs_over_veg(ji,:,jst)
+                   WRITE(numout,*) 'humrel',humrel(ji,:)
+                   WRITE(numout,*) 'humrelv (pour ce jst)',humrelv(ji,:,jst)
+                   WRITE(numout,*) 'ae_ns',ae_ns(ji,jst)
+                   WRITE(numout,*) 'tr_ns',tr_ns(ji,jst)
+                   WRITE(numout,*) 'vevapnuold',vevapnu_old(ji)
+                ENDIF
+             END DO
+          END DO
+       END DO
+    ENDIF
+
+
+    !! 2.2 Check if the deconvolution is correct and conserves the fluxes
+
+    IF (check_cwrr) THEN
+
+
+       tmp_check1(:)=zero
+       tmp_check2(:)=zero  
+
+    !! 2.2.1 the precisol and evapnu
+
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             tmp_check1(ji)=tmp_check1(ji) + &
+                  & (precisol_ns(ji,jst)-MAX(-ae_ns(ji,jst),zero))* &
+                  & soiltile(ji,jst)*vegtot(ji)
+          END DO
+       END DO
+
+       DO jv=1,nvm
+          DO ji=1,kjpindex
+             tmp_check2(ji)=tmp_check2(ji) + precisol(ji,jv)
+          END DO
+       END DO
+
+
+       DO ji=1,kjpindex   
+
+          IF(ABS(tmp_check1(ji)- tmp_check2(ji)).GT.allowed_err) THEN
+             WRITE(numout,*) 'PRECISOL SPLIT FALSE:ji=',ji,tmp_check1(ji),tmp_check2(ji)
+             WRITE(numout,*) 'err',ABS(tmp_check1(ji)- tmp_check2(ji))
+             WRITE(numout,*) 'vegtot',vegtot(ji)
+
+             DO jv=1,nvm
+                WRITE(numout,'(a,i2.2,"|",F13.4,"|",F13.4,"|",3(F9.6))') 'jv,veget_max, precisol, corr_veg_soil ',&
+                     jv,veget_max(ji,jv),precisol(ji,jv),corr_veg_soil(ji,jv,:)
+             END DO
+
+             DO jst=1,nstm
+                WRITE(numout,*) 'jst,precisol_ns',jst,precisol_ns(ji,jst)
+                WRITE(numout,*) 'soiltile', soiltile(ji,jst)
+             END DO
+
+             error=.TRUE.
+             CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
+                  & 'check_CWRR','PRECISOL SPLIT FALSE')
+          ENDIF
+
+       END DO
+
+
+       tmp_check1(:)=zero
+
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             tmp_check1(ji)=tmp_check1(ji) + ae_ns(ji,jst)* &
+                  & soiltile(ji,jst)*vegtot(ji)
+          END DO
+       END DO
+
+       DO ji=1,kjpindex   
+
+          IF(ABS(tmp_check1(ji)- vevapnu(ji)).GT.allowed_err) THEN
+             WRITE(numout,*) 'VEVAPNU SPLIT FALSE:ji, Sum(ae_ns), vevapnu =',ji,tmp_check1(ji),vevapnu(ji)
+             WRITE(numout,*) 'err',ABS(tmp_check1(ji)- vevapnu(ji))
+             WRITE(numout,*) 'ae_ns',ae_ns(ji,:)
+             WRITE(numout,*) 'vegtot',vegtot(ji)
+             WRITE(numout,*) 'evap_bare_lim, evap_bare_lim_ns',evap_bare_lim(ji), evap_bare_lim_ns(ji,:)
+             WRITE(numout,*) 'tot_bare_soil,frac_bare_ns',tot_bare_soil(ji),frac_bare_ns(ji,:)
+             WRITE(numout,*) 'vevapnu_old',vevapnu_old(ji)
+             DO jst=1,nstm
+                WRITE(numout,*) 'jst,ae_ns',jst,ae_ns(ji,jst)
+                WRITE(numout,*) 'soiltile', soiltile(ji,jst)
+                WRITE(numout,*) 'veget_max/vegtot/soiltile', veget_max(ji,:)/vegtot(ji)/soiltile(ji,jst)
+                WRITE(numout,*) "corr_veg_soil",corr_veg_soil(ji,:,jst)
+             END DO
+
+             error=.TRUE.
+             CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
+                  & 'check_CWRR','VEVAPNU SPLIT FALSE')
+          ENDIF
+       ENDDO
+
+    !! 2.2.2 the transpiration and root sink
+
+       tmp_check1(:)=zero
+       tmp_check2(:)=zero  
+
+
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             tmp_check1(ji)=tmp_check1(ji) + tr_ns(ji,jst)* &
+                  & soiltile(ji,jst)*vegtot(ji)
+          END DO
+       END DO
+
+       DO jv=1,nvm
+          DO ji=1,kjpindex
+             tmp_check2(ji)=tmp_check2(ji) + transpir(ji,jv)
+          END DO
+       END DO
+
+       DO ji=1,kjpindex   
+
+          IF(ABS(tmp_check1(ji)- tmp_check2(ji)).GT.allowed_err) THEN
+             WRITE(numout,*) 'TRANSPIR SPLIT FALSE:ji=',ji,tmp_check1(ji),tmp_check2(ji)
+             WRITE(numout,*) 'err',ABS(tmp_check1(ji)- tmp_check2(ji))
+             WRITE(numout,*) 'vegtot',vegtot(ji)
+
+             DO jv=1,nvm
+                WRITE(numout,*) 'jv,veget_max, transpir',jv,veget_max(ji,jv),transpir(ji,jv)
+                DO jst=1,nstm
+                   WRITE(numout,*) 'corr_veg_soil:ji,jv,jst',ji,jv,jst,corr_veg_soil(ji,jv,jst)
+                END DO
+             END DO
+
+             DO jst=1,nstm
+                WRITE(numout,*) 'jst,tr_ns',jst,tr_ns(ji,jst)
+                WRITE(numout,*) 'soiltile', soiltile(ji,jst)
+             END DO
+
+             error=.TRUE.
+             CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
+                  & 'check_CWRR','TRANSPIR SPLIT FALSE')
+          ENDIF
+
+       END DO
+
+
+       tmp_check3(:,:)=zero
+
+       DO jst=1,nstm
+          DO jsl=1,nslm
+             DO ji=1,kjpindex
+                tmp_check3(ji,jst)=tmp_check3(ji,jst) + rootsink(ji,jsl,jst)
+             END DO
+          END DO
+       ENDDO
+
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF(ABS(tmp_check3(ji,jst)- tr_ns(ji,jst)).GT.allowed_err) THEN
+                WRITE(numout,*) 'ROOTSINK SPLIT FALSE:ji,jst=', ji,jst,&
+                     & tmp_check3(ji,jst),tr_ns(ji,jst)
+                WRITE(numout,*) 'err',ABS(tmp_check3(ji,jst)- tr_ns(ji,jst))
+                WRITE(numout,*) 'HUMREL(jv=1:13)',humrel(ji,:)
+                WRITE(numout,*) 'TRANSPIR',transpir(ji,:)
+                DO jv=1,nvm 
+                   WRITE(numout,*) 'jv=',jv,'us=',us(ji,jv,jst,:)
+                ENDDO
+
+                error=.TRUE.
+                CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
+                  & 'check_CWRR','ROOTSINK SPLIT FALSE')
+             ENDIF
+          END DO
+       END DO
+
+    ENDIF
+
+!! Exit if error was found previously in this subroutine
+    IF ( error ) THEN
+       WRITE(numout,*) 'One or more errors have been detected in hydrol_split_soil. Model stops.'
+       CALL ipslerr_p(3, 'hydrol_split_soil', 'We will STOP now.',&
+                  & 'One or several fatal errors were found previously.','')
+    END IF
+
+  END SUBROUTINE hydrol_split_soil
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_diag_soil
+!!
+!>\BRIEF        ??
+!!
+!! DESCRIPTION  :
+!! - 1 Apply mask_soiltile
+!! - 2 sum 3d variables in 2d variables with fraction of vegetation per soil type
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_diag_soil
+
+  SUBROUTINE hydrol_diag_soil (kjpindex, veget_max, soiltile, njsc, runoff, drainage, &
+       & evapot, vevapnu, returnflow, reinfiltration, irrigation, &
+       & shumdiag,shumdiag_perma, k_litt, litterhumdiag, humrel, vegstress, drysoil_frac, tot_melt)
+    ! 
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: veget_max       !! Max. vegetation type
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: njsc            !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltile        !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evapot          !! 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: returnflow      !! Water returning to the deep reservoir
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: reinfiltration  !! Water returning to the top of the soil
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: irrigation      !! Water from irrigation
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: tot_melt        !!
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: drysoil_frac    !! Function of litter wetness
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: runoff          !! complete runoff
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: drainage        !! Drainage
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)      :: shumdiag        !! relative soil moisture
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)      :: shumdiag_perma  !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: k_litt          !! litter cond.
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: litterhumdiag   !! litter humidity
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: humrel          !! Relative humidity
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out)      :: vegstress       !! Veg. moisture stress (only for vegetation growth)
+ 
+    !! 0.3 Modified variables 
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapnu         !!
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jv, jsl, jst, i, jd
+    REAL(r_std), DIMENSION (kjpindex)                        :: mask_vegtot
+    REAL(r_std)                                              :: k_tmp, tmc_litter_ratio
+
+!_ ================================================================================================================================
+    !
+    ! Put the prognostics variables of soil to zero if soiltype is zero
+
+    !! 1 Apply mask_soiltile
+    DO jst=1,nstm 
+
+       DO ji=1,kjpindex
+
+!!??Aurelien: who and why coment this line
+!          IF(soiltile(ji,jst).EQ.zero) THEN
+
+             ae_ns(ji,jst) = ae_ns(ji,jst) * mask_soiltile(ji,jst)
+             dr_ns(ji,jst) = dr_ns(ji,jst) * mask_soiltile(ji,jst)
+             ru_ns(ji,jst) = ru_ns(ji,jst) * mask_soiltile(ji,jst)
+             tmc(ji,jst) =  tmc(ji,jst) * mask_soiltile(ji,jst)
+             IF (ok_freeze_cwrr) THEN
+                profil_froz_hydro_ns(ji,:,jst)=profil_froz_hydro_ns(ji,:,jst)*mask_soiltile(ji,jst)
+             ENDIF !if (ok_freeze_cwrr) then
+
+             DO jv=1,nvm
+                humrelv(ji,jv,jst) = humrelv(ji,jv,jst) * mask_soiltile(ji,jst)
+                DO jsl=1,nslm
+                   us(ji,jv,jst,jsl) = us(ji,jv,jst,jsl)  * mask_soiltile(ji,jst)
+                END DO
+             END DO
+
+             DO jsl=1,nslm          
+                mc(ji,jsl,jst) = mc(ji,jsl,jst)  * mask_soiltile(ji,jst)
+             END DO
+
+!          ENDIF
+
+       END DO
+    END DO
+
+    runoff(:) = zero
+    drainage(:) = zero
+    humtot(:) = zero
+    shumdiag(:,:)= zero
+    shumdiag_perma(:,:)=zero
+    k_litt(:) = zero
+    litterhumdiag(:) = zero
+    tmc_litt_dry_mea(:) = zero
+    tmc_litt_wet_mea(:) = zero
+    tmc_litt_mea(:) = zero
+    humrel(:,:) = zero
+    vegstress(:,:) = zero
+    swi(:) = zero
+    IF (ok_freeze_cwrr) THEN
+       profil_froz_hydro(:,:)=zero
+    ENDIF
+    
+    !! 2 sum 3d variables in 2d variables with fraction of vegetation per soil type
+
+    DO ji = 1, kjpindex
+       mask_vegtot(ji) = 0
+       IF(vegtot(ji) .GT. min_sechiba) THEN
+          mask_vegtot(ji) = 1
+       ENDIF
+    END DO
+    
+    DO ji = 1, kjpindex 
+       ! Here we weight ae_ns by the fraction of bare evaporating soil. 
+       ! This is given by frac_bare_ns, taking into account bare soil under vegetation
+       ae_ns(ji,:) = mask_vegtot(ji) * ae_ns(ji,:) * frac_bare_ns(ji,:)
+    END DO
+
+    DO jst = 1, nstm
+       DO ji = 1, kjpindex 
+          drainage(ji) = mask_vegtot(ji) * (drainage(ji) + vegtot(ji)*soiltile(ji,jst) * dr_ns(ji,jst))
+          runoff(ji) = mask_vegtot(ji) *  (runoff(ji) +   vegtot(ji)*soiltile(ji,jst) * ru_ns(ji,jst)) &
+               & + (1 - mask_vegtot(ji)) * (tot_melt(ji) + irrigation(ji) + returnflow(ji) + reinfiltration(ji))
+          humtot(ji) = mask_vegtot(ji) * (humtot(ji) + soiltile(ji,jst) * tmc(ji,jst)) 
+          IF (ok_freeze_cwrr) THEN 
+             profil_froz_hydro(ji,:)=mask_vegtot(ji) * &
+                  (profil_froz_hydro(ji,:) + soiltile(ji,jst) * profil_froz_hydro_ns(ji,:, jst))
+          ENDIF
+       END DO
+    END DO
+
+    ! we add the excess of snow sublimation to vevapnu
+
+    DO ji = 1,kjpindex
+       vevapnu(ji) = vevapnu (ji) + subsinksoil(ji)*vegtot(ji)
+    END DO
+
+! AD *** en quoi est-ce different de vegstress(ji,jv)=vegstress(ji,jv)+vegstressv(ji,jv,jst)*vegtot(ji) ???
+!        Ã  quoi sert vegtot ici ? 
+    DO jst=1,nstm
+       DO jv=1,nvm
+          DO ji=1,kjpindex
+             IF(veget_max(ji,jv).GT.min_sechiba) THEN
+                vegstress(ji,jv)=vegstress(ji,jv)+vegstressv(ji,jv,jst)*soiltile(ji,jst) &
+                     & * corr_veg_soil(ji,jv,jst) *vegtot(ji)/veget_max(ji,jv)
+                vegstress(ji,jv)= MAX(vegstress(ji,jv),zero)
+             ENDIF
+          END DO
+       END DO
+    END DO
+
+    cvs_over_veg(:,:,:) = zero
+    DO jv=1,nvm
+       DO ji=1,kjpindex
+          IF(veget_max(ji,jv).GT.min_sechiba) THEN
+             DO jst=1,nstm
+                cvs_over_veg(ji,jv,jst) = corr_veg_soil(ji,jv,jst)/vegtot(ji) / veget_max(ji,jv)
+             ENDDO
+          ENDIF
+       END DO
+    END DO
+
+! AD *** en quoi est-ce different de humrel(ji,jv)=humrel(ji,jv)+humrelv(ji,jv,jst) ???
+!        pourquoi procÃšde-t-on diffÃ©remment de vegstress ?
+!        y a-t-il vraiment une difference de pas de temps entre corr_veg_soil et cvs_over_veg ?
+!        non dans cette routine (step 14 of hydrol)
+!        oui si cvs_over_veg est utilisÃ© avant l'appel Ã  cette routine
+    DO jst=1,nstm
+       DO jv=1,nvm
+          DO ji=1,kjpindex
+             humrel(ji,jv)=humrel(ji,jv)+humrelv(ji,jv,jst)*soiltile(ji,jst) &
+                  & * cvs_over_veg(ji,jv,jst)*vegtot(ji)
+             humrel(ji,jv)=MAX(humrel(ji,jv),zero)
+          END DO
+       END DO
+    END DO
+
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          ! We compute here a mean k for the 'litter' used for reinfiltration from floodplains of ponds
+          !
+          IF ( tmc_litter(ji,jst) < tmc_litter_res(ji,jst)) THEN
+             i = imin
+          ELSE
+             tmc_litter_ratio = (tmc_litter(ji,jst)-tmc_litter_res(ji,jst)) / &
+                  & (tmc_litter_sat(ji,jst)-tmc_litter_res(ji,jst))
+             i= MAX(MIN(INT((imax-imin)*tmc_litter_ratio)+imin, imax-1), imin)
+          ENDIF
+          !
+          !
+          k_tmp = MAX(k_lin(i,1,njsc(ji))*ks(njsc(ji)), zero)
+          k_litt(ji) = k_litt(ji) + soiltile(ji,jst) * SQRT(k_tmp)
+       ENDDO
+    ENDDO
+
+    DO jst=1,nstm        
+
+       DO ji=1,kjpindex
+          litterhumdiag(ji) = litterhumdiag(ji) + &
+               & soil_wet_litter(ji,jst) * soiltile(ji,jst)
+
+          tmc_litt_wet_mea(ji) =  tmc_litt_wet_mea(ji) + & 
+               & tmc_litter_awet(ji,jst)* soiltile(ji,jst)
+
+          tmc_litt_dry_mea(ji) = tmc_litt_dry_mea(ji) + &
+               & tmc_litter_adry(ji,jst) * soiltile(ji,jst) 
+
+          tmc_litt_mea(ji) = tmc_litt_mea(ji) + &
+               & tmc_litter(ji,jst) * soiltile(ji,jst) 
+      END DO
+
+       DO jd=1,nbdl
+          DO ji=1,kjpindex
+               DO jsl=1,nslm  
+                  shumdiag(ji,jd)= shumdiag(ji,jd) + soil_wet(ji,jsl,jst)  &
+                       *frac_hydro_diag(jsl,jd)* &
+                       ((mcs(njsc(ji))-mcw(njsc(ji)))/(mcf(njsc(ji))-mcw(njsc(ji)))) * &
+                       soiltile(ji,jst)
+                  
+                  shumdiag_perma(ji,jd)= shumdiag_perma(ji,jd)  &
+                       + mc(ji,jsl,jst) *frac_hydro_diag(jsl,jd) &
+                       /mcs(njsc(ji))*soiltile(ji,jst)
+               ENDDO
+               shumdiag(ji,jd) = MAX(MIN(shumdiag(ji,jd), un), zero) 
+               shumdiag_perma(ji,jd) = MAX(MIN(shumdiag_perma(ji,jd), un), zero) 
+          END DO
+       END DO
+
+    END DO
+
+    ! Calculate soilmoist
+    soilmoist(:,:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+             soilmoist(ji,1) = soilmoist(ji,1) + soiltile(ji,jst) * &
+                  dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+             DO jsl = 2,nslm-1
+                soilmoist(ji,jsl) = soilmoist(ji,jsl) + soiltile(ji,jst) * &
+                     ( dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                     + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit )
+             END DO
+             soilmoist(ji,nslm) = soilmoist(ji,nslm) + soiltile(ji,jst) * &
+                  dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+       END DO
+    END DO
+
+    DO ji=1,kjpindex
+       swi(ji) = swi(ji) + shumdiag(ji,1) * (dz(2))/(deux*zmaxh*mille)
+       
+       DO jsl=2,nbdl-1 
+          swi(ji) = swi(ji) + shumdiag(ji,jsl) * (dz(jsl)+dz(jsl+1))/(deux*zmaxh*mille)
+       ENDDO
+       swi(ji) = swi(ji) + shumdiag(ji,nbdl) * (dz(nbdl))/(deux*zmaxh*mille)
+    END DO
+
+    DO ji=1,kjpindex
+       IF ( tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji) > zero ) THEN
+          drysoil_frac(ji) = un + MAX( MIN( (tmc_litt_dry_mea(ji) - tmc_litt_mea(ji)) / &
+               & (tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji)), zero), - un)
+       ELSE
+          drysoil_frac(ji) = zero
+       ENDIF
+    END DO
+
+  END SUBROUTINE hydrol_diag_soil  
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_waterbal_init
+!!
+!>\BRIEF        Initialize variables needed for hydrol_waterbal
+!!
+!! DESCRIPTION  : Initialize variables needed for hydrol_waterbal
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE hydrol_waterbal_init(kjpindex, qsintveg, snow, snow_nobio)
+    
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT (in)                          :: kjpindex     !! Domain size
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintveg     !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: snow         !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio   !! Ice water balance
+    
+    !! 0.2 Local variables
+    INTEGER(i_std) :: ji
+    REAL(r_std) :: watveg
+
+!_ ================================================================================================================================
+    !
+    !
+    !
+    IF ( ALL( tot_water_beg(:) == val_exp ) ) THEN
+       ! tot_water_beg was not found in restart file
+       DO ji = 1, kjpindex
+          watveg = SUM(qsintveg(ji,:))
+          tot_water_beg(ji) = humtot(ji)*vegtot(ji) + watveg + snow(ji)&
+               & + SUM(snow_nobio(ji,:))
+       ENDDO
+       tot_water_end(:) = tot_water_beg(:)
+       tot_flux(:) = zero
+    ELSE 
+       tot_water_end(:) = tot_water_beg(:)
+       tot_flux(:) = zero
+    ENDIF
+
+  END SUBROUTINE hydrol_waterbal_init
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_waterbal 
+!!
+!>\BRIEF        Checks the water balance.
+!!
+!! DESCRIPTION  :
+!! This routine checks the water balance. First it gets the total
+!! amount of water and then it compares the increments with the fluxes.
+!! The computation is only done over the soil area as over glaciers (and lakes?)
+!! we do not have water conservation.
+!! This verification does not make much sense in REAL*4 as the precision is the same as some
+!! of the fluxes
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_waterbal
+
+  SUBROUTINE hydrol_waterbal (kjpindex, index, first_call, veget_max, totfrac_nobio, &
+       & qsintveg, snow,snow_nobio, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, tot_melt, &
+       & vevapwet, transpir, vevapnu, vevapsno, vevapflo, floodout, runoff, drainage)
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                        :: kjpindex     !! Domain size
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index        !! Indeces of the points on the map
+    LOGICAL, INTENT (in)                               :: first_call   !! At which time is this routine called ?
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max    !! Max Fraction of vegetation type 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: totfrac_nobio!! Total fraction of continental ice+lakes+...
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintveg     !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: snow         !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio !!Ice water balance
+    !
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_rain  !! Rain precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_snow  !! Snow precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: returnflow   !! Water to the bottom
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: reinfiltration !! Water to the top
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: irrigation   !! Water from irrigation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: tot_melt     !! Total melt
+    !
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vevapwet     !! Interception loss
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: transpir     !! Transpiration
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: vevapnu      !! Bare soil evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: vevapsno     !! Snow evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: vevapflo     !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: floodout     !! flow out of floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: runoff       !! complete runoff
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: drainage     !! Drainage
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std) :: ji
+    REAL(r_std) :: watveg, delta_water
+    LOGICAL     :: error=.FALSE.  !! If true, exit in the end of subroutine
+
+!_ ================================================================================================================================
+    tot_water_end(:) = zero
+    tot_flux(:) = zero
+    !
+    DO ji = 1, kjpindex
+       !
+       ! If the fraction of ice, lakes, etc. does not complement the vegetation fraction then we do not
+       ! need to go any further
+       !
+       IF ( ABS(un - (totfrac_nobio(ji) + vegtot(ji))) .GT. allowed_err ) THEN
+          WRITE(numout,*) 'HYDROL problem in vegetation or frac_nobio on point ', ji
+          WRITE(numout,*) 'totfrac_nobio : ', totfrac_nobio(ji)
+          WRITE(numout,*) 'vegetation fraction : ', vegtot(ji)
+
+          error=.TRUE.
+          CALL ipslerr_p(2, 'hydrol_waterbal', 'We will STOP in the end of hydrol_waterbal.','','')
+       ENDIF
+    ENDDO
+
+    DO ji = 1, kjpindex
+       !
+       watveg = SUM(qsintveg(ji,:))
+       tot_water_end(ji) = humtot(ji)*vegtot(ji) + watveg + &
+            & snow(ji) + SUM(snow_nobio(ji,:))
+       !
+       tot_flux(ji) =  precip_rain(ji) + precip_snow(ji) + irrigation (ji) - &
+            & SUM(vevapwet(ji,:)) - SUM(transpir(ji,:)) - vevapnu(ji) - vevapsno(ji) - vevapflo(ji) + &
+            & floodout(ji) - runoff(ji) - drainage(ji) + returnflow(ji) + reinfiltration(ji)
+    ENDDO
+    
+    DO ji = 1, kjpindex
+       !
+       delta_water = tot_water_end(ji) - tot_water_beg(ji)
+       !
+       !
+       !  Set some precision ! This is a wild guess and corresponds to what works on an IEEE machine
+       !  under double precision (REAL*8).
+       !
+       !
+       IF ( ABS(delta_water-tot_flux(ji)) .GT. deux*allowed_err ) THEN
+          WRITE(numout,*) '------------------------------------------------------------------------- '
+          WRITE(numout,*) 'HYDROL does not conserve water. The erroneous point is : ', ji
+          WRITE(numout,*) 'Coord erroneous point', lalo(ji,:)
+          WRITE(numout,*) 'The error in mm/s is :', (delta_water-tot_flux(ji))/dt_sechiba, ' and in mm/dt : ', &
+               & delta_water-tot_flux(ji)
+          WRITE(numout,*) 'delta_water : ', delta_water, ' tot_flux : ', tot_flux(ji)
+          WRITE(numout,*) 'Actual and allowed error : ', ABS(delta_water-tot_flux(ji)), allowed_err
+          WRITE(numout,*) 'vegtot : ', vegtot(ji)
+          WRITE(numout,*) 'precip_rain : ', precip_rain(ji)
+          WRITE(numout,*) 'precip_snow : ',  precip_snow(ji)
+          WRITE(numout,*) 'Water from routing. Reinfiltration/returnflow/irrigation : ', reinfiltration(ji), &
+               & returnflow(ji),irrigation(ji)
+          WRITE(numout,*) 'Total water in soil humtot:',  humtot(ji)
+          WRITE(numout,*) 'mc:' , mc(ji,:,:)
+          WRITE(numout,*) 'Water on vegetation watveg:', watveg
+          WRITE(numout,*) 'Snow mass snow:', snow(ji)
+          WRITE(numout,*) 'Snow mass on ice snow_nobio:', SUM(snow_nobio(ji,:))
+          WRITE(numout,*) 'Melt water tot_melt:', tot_melt(ji)
+          WRITE(numout,*) 'evapwet : ', vevapwet(ji,:)
+          WRITE(numout,*) 'transpir : ', transpir(ji,:)
+          WRITE(numout,*) 'evapnu, evapsno, evapflo: ', vevapnu(ji), vevapsno(ji), vevapflo(ji)
+          WRITE(numout,*) 'drainage,runoff,floodout : ', drainage(ji),runoff(ji),floodout(ji)
+          
+          error=.TRUE.
+          CALL ipslerr_p(2, 'hydrol_waterbal', 'We will STOP in the end of hydrol_waterbal.','','')
+       ENDIF
+       !
+    ENDDO
+    !
+    ! Transfer the total water amount at the end of the current timestep top the begining of the next one.
+    !
+    tot_water_beg = tot_water_end
+    !
+    
+    ! Exit if one or more errors were found
+    IF ( error ) THEN
+       WRITE(numout,*) 'One or more errors have been detected in hydrol_waterbal. Model stops.'
+       CALL ipslerr_p(3, 'hydrol_waterbal', 'We will STOP now.',&
+            'One or several fatal errors were found previously.','')
+    END IF
+    
+  END SUBROUTINE hydrol_waterbal
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_alma 
+!!
+!>\BRIEF        This routine computes the changes in soil moisture and interception storage for the ALMA outputs.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_alma
+
+  SUBROUTINE hydrol_alma (kjpindex, index, first_call, qsintveg, snow, snow_nobio, soilwet)
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                        :: kjpindex     !! Domain size
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index        !! Indeces of the points on the map
+    LOGICAL, INTENT (in)                               :: first_call   !! At which time is this routine called ?
+    !
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintveg     !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: snow         !! Snow water equivalent
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio     !! Water balance on ice, lakes, .. [Kg/m^2]
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: soilwet     !! Soil wetness
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std) :: ji
+    REAL(r_std) :: watveg
+
+!_ ================================================================================================================================
+    !
+    !
+    IF ( first_call ) THEN
+       ! Initialize variables if they were not found in the restart file
+
+       DO ji = 1, kjpindex
+          watveg = SUM(qsintveg(ji,:))
+          tot_watveg_beg(ji) = watveg
+          tot_watsoil_beg(ji) = humtot(ji)
+          snow_beg(ji)        = snow(ji)+ SUM(snow_nobio(ji,:))
+       ENDDO
+
+       RETURN
+
+    ENDIF
+    !
+    ! Calculate the values for the end of the time step
+    !
+    DO ji = 1, kjpindex
+       watveg = SUM(qsintveg(ji,:))
+       tot_watveg_end(ji) = watveg
+       tot_watsoil_end(ji) = humtot(ji)
+       snow_end(ji) = snow(ji)+ SUM(snow_nobio(ji,:))
+
+       delintercept(ji) = tot_watveg_end(ji) - tot_watveg_beg(ji)
+       delsoilmoist(ji) = tot_watsoil_end(ji) - tot_watsoil_beg(ji)
+       delswe(ji)       = snow_end(ji) - snow_beg(ji)
+    ENDDO
+    !
+    !
+    ! Transfer the total water amount at the end of the current timestep top the begining of the next one.
+    !
+    tot_watveg_beg = tot_watveg_end
+    tot_watsoil_beg = tot_watsoil_end
+    snow_beg(:) = snow_end(:)
+    !
+    DO ji = 1,kjpindex
+       IF ( mx_eau_var(ji) > 0 ) THEN
+          soilwet(ji) = tot_watsoil_end(ji) / mx_eau_var(ji)
+       ELSE
+          soilwet(ji) = zero
+       ENDIF
+    ENDDO
+    !
+  END SUBROUTINE hydrol_alma
+  !
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_calculate_temp_hydro
+!!
+!>\BRIEF         Calculate the temperature at hydrological levels  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+
+  SUBROUTINE hydrol_calculate_temp_hydro(kjpindex, stempdiag, snow,snowdz)
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                             :: kjpindex 
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)     :: stempdiag
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: snow
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in)    :: snowdz
+
+
+    !! 0.2 Local variables
+    
+    INTEGER jh, jd, ji
+    REAL(r_std) :: snow_h
+    REAL(r_std)  :: lev_diag, prev_diag, lev_prog, prev_prog
+    REAL(r_std), DIMENSION(nslm,nbdl) :: intfactt
+    
+    
+    DO ji=1,kjpindex
+       IF (ok_explicitsnow) THEN 
+          !The snow pack is above the surface soil in the new snow model.
+          snow_h=0
+       ELSE  
+          snow_h=snow(ji)/sn_dens
+       ENDIF
+       
+       intfactt(:,:)=0.
+       prev_diag = snow_h
+       DO jh = 1, nslm
+          IF (jh.EQ.1) THEN
+             lev_diag = zz(2)/1000./2.+snow_h
+          ELSEIF (jh.EQ.nslm) THEN
+             lev_diag = zz(nslm)/1000.+snow_h
+             
+          ELSE
+             lev_diag = zz(jh)/1000. &
+                  & +(zz(jh+1)-zz(jh))/1000./2.+snow_h
+             
+          ENDIF
+          prev_prog = 0.0
+          DO jd = 1, nbdl
+             lev_prog = diaglev(jd)
+             IF ((lev_diag.GT.diaglev(nbdl).AND. &
+                  & prev_diag.LT.diaglev(nbdl)-min_sechiba)) THEN
+                lev_diag=diaglev(nbdl)          
+             ENDIF
+             intfactt(jh,jd) = MAX(MIN(lev_diag,lev_prog)-MAX(prev_diag, prev_prog),&
+                  & 0.0)/(lev_diag-prev_diag)
+             prev_prog = lev_prog
+          ENDDO
+          IF (lev_diag.GT.diaglev(nbdl).AND. &
+               & prev_diag.GE.diaglev(nbdl)-min_sechiba) intfactt(jh,nbdl)=1.
+          prev_diag = lev_diag
+       ENDDO
+    ENDDO
+    
+    temp_hydro(:,:)=0.
+    DO jd= 1, nbdl
+       DO jh= 1, nslm
+          DO ji = 1, kjpindex
+             temp_hydro(ji,jh) = temp_hydro(ji,jh) + stempdiag(ji,jd)*intfactt(jh,jd)
+          ENDDO
+       ENDDO
+    ENDDO
+    
+  END SUBROUTINE hydrol_calculate_temp_hydro
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_calculate_frac_hydro_diag
+!!
+!>\BRIEF         Caluculate frac_hydro_diag for interpolation between hydrological and diagnostic axes
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_calculate_frac_hydro_diag
+
+    !! 0.1 Local variables
+
+    INTEGER(i_std) :: jd, jh
+    REAL(r_std)    :: prev_hydro, next_hydro, prev_diag, next_diag
+    
+
+    frac_hydro_diag(:,:)=0.
+    prev_diag = 0.0
+    
+    DO jd = 1, nbdl 
+       
+       next_diag = diaglev(jd)
+       prev_hydro = 0.0
+       DO jh = 1, nslm
+          IF (jh.EQ.1) THEN
+             next_hydro = zz(2)/1000./2.
+          ELSEIF (jh.EQ.nslm) THEN
+             next_hydro = zz(nslm)/1000.
+          ELSE
+             next_hydro = zz(jh)/1000.+(zz(jh+1)-zz(jh))/1000./2.
+          ENDIF
+          frac_hydro_diag(jh,jd) = MAX(MIN(next_hydro, next_diag)-MAX(prev_hydro, prev_diag), 0.)/(next_diag - prev_diag)
+          prev_hydro=next_hydro
+       ENDDO
+       
+       prev_diag = next_diag
+    ENDDO
+
+  END SUBROUTINE hydrol_calculate_frac_hydro_diag
+  
+END MODULE hydrol
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/hydrolc.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/hydrolc.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/hydrolc.f90	(revision 5166)
@@ -0,0 +1,3778 @@
+! =================================================================================================================================
+! MODULE          : hydrolc
+!
+! CONTACT         : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE         : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF          This module computes the water budget of 
+!! land surfaces. It distinguishes three main reservoirs with separate water budgets : 
+!! the canopy interception reservoir, the snow pack, and the soil, described here using two
+!! soil layers, following the so-called Choisnel scheme. The module contains the  
+!! following subroutines: hydrolc_main, hydrolc_init, hydrolc_clear, hydrolc_var_init, 
+!! hydrolc_snow, hydrolc_vegupd, hydrolc_canop, hydrolc_soil, hydrolc_waterbal, hydrolc_alma, 
+!! hydrolc_hdiff.  
+!!
+!! \n DESCRIPTION : The aim of this module is to update the different water prognostic variables 
+!! (within canopy, snow and soil) and to compute the related liquid water fluxes (e.g. 
+!! throughfall, runoff, snow melt) and diagnostic variables used in other modules (e.g. 
+!! humrel and rsol to compute latent heat fluxes ; shumdiag for soil thermodynamics; snow mass 
+!! and snow age for snow albedo). 
+!! 
+!! The main input variables are precipitation (liquid and solid) and the different terms of 
+!! evapotranspiration (transpiration, bare soil evaporation, interception loss, sublimation). 
+!! The module organizes the required initialisation of water prognostic variables, their
+!! integration at each timestep given the above forcings, and the required output (writing 
+!! of restart file, updated prognostic variables, diagnostic variables). 
+!! 
+!! The specificity of hydrolc in ORCHIDEE is to describe the soil using two soil layers, 
+!! following the so-called Choisnel scheme. The upper layer has a variable depth
+!! and can disappear after dry spells (DucoudrÃ© et al., 1993). Soil moisture stress on 
+!! transpiration and bare soil evaporation acts via the height of dry soil at the top of soil.
+!!
+!! Runoff is produced when the entire soil column is saturated, as in the bucket scheme 
+!! of Manabe (1969). Drainage and surface runoff are only diagnosed,  mostly for use in 
+!! the routing module, using a constant 95% - 5% redistribution (Ngo-Duc et al., 2005).
+!! Irrigation can interact with the soil columns (de Rosnay et al., 2003), as well as 
+!! river discharge in floodplains (Ngo-Duc et al., 2005).
+!!
+!! The dynamic of the one-layer snow pack results from accumulation, sublimation and 
+!! snowmelt. Snow ageing is accounted for but it does not influence snow density.  
+!!
+!! The subgrid variability of soil follows the one of vegetation, by introducing as many 
+!! soil columns as PFTs (de Rosnay & Polcher, 1998). The water budget is performed 
+!! independently in each PFT/soil column, but water can be exchanged laterally. 
+!! The soil moisture of the bottom layer is homogenized between the soil columns at 
+!! each timestep, and a diffusion between the top soil layers can be allowed if the
+!! flag ok_hdiff is true (the default value is false).
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! REFERENCE(S)     : 
+!!  - DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp. 248-273. 
+!!  - Ducharne, A. Laval, K. and Polcher, J. (1998) Sensitivity of the hydrological cycle to the 
+!! parameterization of soil hydrology in a GCM. Climate Dynamics, 14:307-327. 
+!!  - de Rosnay, P. and Polcher J. (1998) Modeling root water uptake in a complex land surface scheme
+!!  coupled to a GCM. Hydrology and Earth System Sciences, 2(2-3):239-256. 
+!!  - de Rosnay, P., Polcher, J., Laval, K. et Sabre, M. (2003). Integrated parameterization of 
+!! irrigation in the land surface model ORCHIDEE. Validation over Indian Peninsula. Geophys. Res.
+!! Lett, 30(19):HLS2-1 -
+!! HLS2-4. 
+!!  - Krinner, G., Viovy, N., de Noblet-DucoudrÃ©, N., Ogee, J., Polcher, J., Friedlingstein, P., 
+!! Ciais, P., Sitch, S. et Prentice, I. (2005). A dynamic global vegetation model for studies of the 
+!! coupled atmosphere-biosphere system. Global Biogeochem. Cycles, 19(1).
+!!  - Ngo-Duc, T., Laval, K., Ramillien, G., Polcher, J. et Cazenave, A. (2007). Validation of the land
+!!  water storage simulated by Organising Carbon and Hydrology in Dynamic Ecosystems (ORCHIDEE) with 
+!! Gravity Recovery and Climate Experiment (GRACE) data. Water Resour. Res, 43:W04427. 
+!!  - ALMA : http://www.lmd.jussieu.fr/~polcher/ALMA/
+!!  - DucoudrÃ©, N. (1990). Sensibilite du climat simule a la parametrisation des echanges de vapeur 
+!! d'eau entre la biosphere et l'atmosphere. These de Doctorat, UniversitÃ© Paris 6. 
+!!  - Ducharne A (1997). Le cycle de l'eau : modelisation de l'hydrologie continentale, etude de ses 
+!! interactions avec le climat, These de Doctorat, UniversitÃ© Paris 6. 
+!!  - de Rosnay, P. (1999). Representation des interactions sol-plante-atmosphere dans le modele de 
+!! circulation generale du LMD. These de doctorat, UniversitÃ© Paris 6. 
+!!  - Guimberteau, M. (2010). Modelisation de l'hydrologie continentale et influences de l'irrigation 
+!! sur le cycle de l'eau, these de doctorat, UniversitÃ© Paris 6. 
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+ 
+MODULE hydrolc
+  
+  ! modules used
+  USE ioipsl
+  USE xios_orchidee
+  USE ioipsl_para 
+  USE constantes        ! contains technical constants
+  USE constantes_soil   ! soil properties and geometry (underground)
+  USE pft_parameters    ! surface and vegetation properties
+  USE sechiba_io        ! for inpout/output
+  USE grid              ! for grid, masks and calendar
+  USE mod_orchidee_para ! for variable and subroutines realted to the parallelism of orchidee
+  USE explicitsnow
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: hydrolc_main, hydrolc_initialize, hydrolc_finalize, hydrolc_clear 
+
+
+  LOGICAL, SAVE                                   :: ok_hdiff        !! To do horizontal diffusion between soil columns
+!$OMP THREADPRIVATE(ok_hdiff)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: bqsb            !! Water content in the bottom layer  
+                                                                     !! @tex ($kg m^{-2}$) @endtex 
+!$OMP THREADPRIVATE(bqsb)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: gqsb            !! Water content in the top layer @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(gqsb)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dsg             !! Depth of the top layer (m) 
+!$OMP THREADPRIVATE(dsg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dsp             !! Depth of dry soil in the bottom layer plus depth of top 
+                                                                     !! layer (m)
+!$OMP THREADPRIVATE(dsp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mean_bqsb       !! Mean water content in the bottom layer, averaged over the 
+                                                                     !! soil columns @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(mean_bqsb)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mean_gqsb       !! Mean water content in the top layer, averaged over the   
+                                                                     !! soil columns @tex ($kg m^{-2}$) @endtex 
+!$OMP THREADPRIVATE(mean_gqsb)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_flux        !! Total water flux
+!$OMP THREADPRIVATE(tot_flux)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_water_beg   !! Total amount of water at start of time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(tot_water_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_water_end   !! Total amount of water at end of time step  
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(tot_water_end)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_watveg_beg  !! Total amount of intercepted water on vegetation at start of
+                                                                     !! time step  @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(tot_watveg_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_watveg_end  !! Total amount of intercepted water on vegetation at end of 
+                                                                     !! time step  @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(tot_watveg_end)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_watsoil_beg !! Total amount of water in the soil at start of time step  
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(tot_watsoil_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_watsoil_end !! Total amount of water in the soil at end of time step  
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(tot_watsoil_end)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: snow_beg        !! Total snow water equivalent at start of time step  
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(snow_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: snow_end        !! Total snow water equivalent at end of time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(snow_end)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: delsoilmoist    !! Change in soil moisture during time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(delsoilmoist)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: delintercept    !! Change in interception storage during time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(delintercept)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: delswe          !! Change in snow water equivalent during time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(delswe)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dss             !! Depth of dry soil at the top, whether in the top or bottom 
+                                                                     !! layer (m) 
+!$OMP THREADPRIVATE(dss)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: hdry            !! Mean top dry soil height (m) version beton
+!$OMP THREADPRIVATE(hdry)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: precisol        !! Throughfall @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(precisol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: subsnowveg      !! Sublimation of snow on vegetation 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(subsnowveg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: subsnownobio    !! Sublimation of snow on other surface types (ice, lakes,...)
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(subsnownobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: snowmelt        !! Snow melt @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(snowmelt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: icemelt         !! Ice melt @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(icemelt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: gdrainage       !! Drainage between the two soil layers 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(gdrainage)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: vegtot          !! Total fraction of grid-cell covered by PFTs (bare soil + 
+                                                                     !! vegetation) (0-1, unitless)
+!$OMP THREADPRIVATE(vegtot)  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: resdist         !! Previous values of "veget" (0-1, unitless) ! Last map of 
+                                                                     !! PFT fractions used to define the soil columns 
+!$OMP THREADPRIVATE(resdist)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mx_eau_var      !! Maximum water content of the soil 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(mx_eau_var)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: ruu_ch          !! Volumetric soil water capacity @tex ($kg m^{-3}$) @endtex
+!$OMP THREADPRIVATE(ruu_ch)
+  REAL(r_std), PARAMETER                          :: dsg_min = 0.001 !! Reference depth to define subgrid variability of saturated
+                                                                     !! top soil layer (m) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: subsinksoil     !! Excess of sublimation as a sink for the soil
+!$OMP THREADPRIVATE(subsinksoil)
+
+!_ ================================================================================================================================      
+                                                               
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrolc_initialize
+!!
+!>\BRIEF         Allocate module variables, read from restart file or initialize with default values
+!!
+!! DESCRIPTION :
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrolc_initialize( kjit,      kjpindex,     index,          rest_id, &
+                                 veget,     veget_max,    tot_bare_soil,           &
+                                 rsol,      drysoil_frac, snow,                    &
+                                 snow_age,  snow_nobio,   snow_nobio_age, humrel,  &
+                                 vegstress, qsintveg,     shumdiag,       snowrho, &
+                                 snowtemp,  snowgrain,    snowdz,         snowheat )
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+    INTEGER(i_std), INTENT(in)                            :: kjit             !! Current time step number (unitless)
+    INTEGER(i_std), INTENT(in)                            :: kjpindex         !! Domain size (number of grid cells) (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: index            !! Indices of the land grid points on the map 
+    INTEGER(i_std),INTENT (in)                            :: rest_id          !! Restart file identifier 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)     :: veget            !! Grid-cell fraction effectively covered by 
+                                                                              !! vegetation for each PFT, except for soil 
+                                                                              !! (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)     :: veget_max        !! PFT fractions within grid-cells: max value of 
+                                                                              !! veget for vegetation PFTs and min value for 
+                                                                              !! bare soil (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: tot_bare_soil    !! Total evaporating bare soil fraction 
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: rsol             !! Resistance to bare soil evaporation 
+                                                                              !! @tex ($s m^{-1}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: drysoil_frac     !! Fraction of visibly dry soil, for bare soil 
+                                                                              !! albedo calculation in condveg.f90 
+                                                                              !! (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: snow             !! Snow water equivalent @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: snow_age         !! Snow age (days)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio       !! Snow water equivalent on nobio areas  
+                                                                              !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio_age   !! Snow age on ice, lakes, ...  (days)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: humrel           !! Soil moisture stress factor on transpiration and
+                                   
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: vegstress        !! Vegetation moisture stress (only for vegetation 
+                                                                              !! growth) (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: qsintveg         !! Amount of water in the canopy interception 
+                                                                              !! reservoir @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)   :: shumdiag         !! Mean relative soil moisture in the different
+                                                                              !! levels used by thermosoil.f90 (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowrho          !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowtemp         !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowgrain        !! Snow grainsize
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowdz           !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)  :: snowheat         !! Snow heat content
+
+    !! 0.4 Local variables
+
+!_ ================================================================================================================================
+    
+  !! 1.  Initialisation
+    CALL hydrolc_init (kjit, kjpindex, index, rest_id, &
+         veget,  tot_bare_soil, &
+         humrel, vegstress, shumdiag,      &
+         snow,   snow_age,  snow_nobio,  snow_nobio_age, qsintveg, &
+         snowdz, snowgrain, snowrho,     snowtemp,snowheat, &
+         drysoil_frac, rsol)
+
+    CALL hydrolc_var_init (kjpindex, veget, veget_max, tot_bare_soil, &
+         rsol, drysoil_frac, mx_eau_var, ruu_ch, shumdiag)
+    
+    ! If we check the water balance, we first save the total amount of water
+    IF (check_waterbal) CALL hydrolc_waterbal_init (kjpindex, qsintveg, snow, snow_nobio)
+    
+    IF (almaoutput) THEN
+       CALL hydrolc_alma_init(kjpindex, index, qsintveg, snow, snow_nobio)
+    ENDIF
+    
+  END SUBROUTINE hydrolc_initialize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE            : hydrolc_main 
+!!
+!>\BRIEF                 Main routine for water budget calculation on land surfaces. 
+!!
+!! DESCRIPTION           : This routine drives all the calls pertaining 
+!! to the land-surface water budget. It is called once during the initialisation of 
+!! ORCHIDEE, and then once for each time step, to drive the water budget calculations, 
+!! and the link to history files processing (histwrite). It is called one more time 
+!! at the last time step, for the writing of the restart file. 
+!!
+!! The initialisation step calls hydrolc_init and hydrolc_var_init, plus hydrolc_waterbal 
+!! if we choose to check the water balance. Writing is performed to the restart file, 
+!! before the water budget calculations, at a timestep that is controlled by the flag
+!! "ldrestart_write".
+!!
+!! The water budget calculations are separated into four subroutines related to the 
+!! main three water reservoirs over land grid-cells, and called at each time step : \n
+!!  - hydrolc_snow for snow process (including age of snow)
+!!  - hydrolc_vegupd to manage the required redistribution of water between reservoirs 
+!! when the vegetation fraction of PFTs has changed
+!!  - hydrolc_canop for canopy process (interception)
+!!  - hydrolc_soil for soil hydrological process (soil moisture and runoff), followed by 
+!! hydrolc_hdiff if we choose to account for horizontal diffusion between the soil columns.
+!! If we choose to check the water balance, this is done over each timestep dt_sechiba, 
+!! by hydrolc_waterbal. 
+!!
+!! The link to "hist" files processing has two kinds of controls: 
+!! - the standard output ncdf file corresponds to hist_id ; if hist2_id positive, a second  
+!! ncdf file is output, with a different frequency
+!! - almaoutput defines the nature/name of the written variables, whether following the 
+!! ALMA norm or not
+!! Note that histwrite does different actions depending on the current time step : 
+!! writing on "hist" files at a selected frequency ; summing of the output variables 
+!! in between in view of averaging.
+!! The subroutine also handles some "CMIP5" output (mrro, mrros and prveg).
+!!
+!! We consider that any water on ice (nobio) is snow and we only peform a water balance to have consistency. 
+!! The water balance is limited to + or - \f$10^6\f$ so that accumulation is not endless
+!!
+!! IMPORTANT NOTE : The water fluxes are used in their integrated form, over the time step 
+!! dt_sechiba, with a unit of \f$kg.m^{-2}\f$.
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S) : snow, snow_age, snow_nobio, snow_nobio_age, tot_melt, 
+!! returnflow, irrigation, humrel, vegstress, rsol, drysoil_frac, shumdiag, litterhumdiag 
+!! + variables declared in the module
+!! + variables sent for ouput by histwrite
+!!
+!! REFERENCE(S) : Same as for module hydrolc
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrolc_main (kjit, kjpindex, index, indexveg, &
+     & temp_sol_new, floodout, run_off_tot, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+     & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age, tot_melt, transpir, &
+     & precip_rain, precip_snow, returnflow, reinfiltration, irrigation, humrel, vegstress, rsol, drysoil_frac, &
+     & evapot, evapot_corr, flood_frac, flood_res, shumdiag, litterhumdiag, soilcap, rest_id, hist_id, hist2_id, &
+     & temp_air, pb, u, v, swnet, pgflux, &
+     & snowrho,snowtemp,snowgrain,snowdz,snowheat,snowliq, &
+     & grndflux,gtemp,tot_bare_soil, &
+     & lambda_snow,cgrnd_snow,dgrnd_snow,temp_sol_add)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+ 
+    INTEGER(i_std), INTENT(in)                              :: kjit             !! Current time step number (unitless)
+    INTEGER(i_std), INTENT(in)                              :: kjpindex         !! Domain size (number of grid cells) (unitless)
+    INTEGER(i_std),INTENT (in)                              :: rest_id,hist_id  !! _Restart_ file and _history_ file identifier 
+                                                                                !! (unitless)
+    INTEGER(i_std),INTENT (in)                              :: hist2_id         !! Second _history_ file identifier (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)        :: index            !! Indices of the land grid points on the map 
+                                                                                !! (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in)    :: indexveg         !! Indices of the PFT tiles / soil columns on 
+                                                                                !! the 3D map (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: precip_rain      !! Rainfall @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: precip_snow      !! Snowfall  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: returnflow       !! Routed water which comes back into the soil 
+                                                                                !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: reinfiltration   !! Routed water which comes back into the soil
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: irrigation       !! Irrigation water applied to soils 
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: temp_sol_new     !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in)    :: frac_nobio       !! Fraction of terrestrial ice, lakes, ... 
+                                                                                !! (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: totfrac_nobio    !! Total fraction of terrestrial ice+lakes+...
+                                                                                !! (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: soilcap          !! Soil heat capacity @tex ($J K^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)       :: vevapwet         !! Interception loss over each PFT 
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)       :: veget            !! Grid-cell fraction effectively covered by 
+                                                                                !! vegetation for each PFT, except for soil 
+                                                                                !! (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)       :: veget_max        !! PFT fractions within grid-cells: max value of 
+                                                                                !! veget for vegetation PFTs and min value for bare soil (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)       :: qsintmax         !! Maximum amount of water in the canopy 
+                                                                                !! interception reservoir 
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)       :: transpir         !! Transpiration over each PFT 
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: evapot           !! [DISPENSABLE] Soil Potential Evaporation  
+                                                                                !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: evapot_corr      !! [DISPENSABLE] Soil Potential Evaporation 
+                                                                                !! Correction
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: flood_frac       !! Flooded fraction 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)            :: temp_air         !! Air temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)            :: u,v              !! Horizontal wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)            :: pb               !! Surface pressure
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)            :: swnet            !! Net short wave radiation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)            :: pgflux           !! Net energy into snowpack
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)             :: gtemp            !! First soil layer temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)            :: tot_bare_soil    !! Total evaporating bare soil fraction  
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)            :: lambda_snow      !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in)     :: cgrnd_snow       !! Integration coefficient for snow numerical scheme
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in)     :: dgrnd_snow       !! Integration coefficient for snow numerical scheme
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)          :: run_off_tot      !! Diagnosed surface runoff  
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: flood_res        !! Flood reservoir estimate 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)          :: drainage         !! Diagnosed rainage at the bottom of soil
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)          :: rsol             !! Resistance to bare soil evaporation 
+                                                                                !! @tex ($s m^{-1}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)          :: drysoil_frac     !! Fraction of visibly dry soil, for bare soil 
+                                                                                !! albedo calculation in condveg.f90 
+                                                                                !! (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)          :: litterhumdiag    !! Litter humidity factor (0-1, unitless), used
+                                                                                !! in stomate
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)          :: tot_melt         !! Total melt @tex ($kg m^{-2}$) @endtex
+
+
+    !! 0.3  Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: vevapnu          !! Bare soil evaporation @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: vevapsno         !! Snow evaporation  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: vevapflo         !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: snow             !! Snow water equivalent @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: snow_age         !! Snow age (days)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio       !! Snow water equivalent on nobio areas  
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio_age   !! Snow age on ice, lakes, ...  (days)
+    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)    :: humrel           !! Soil moisture stress factor on transpiration and
+                                                                                !! bare soil evaporation (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)    :: vegstress        !! Vegetation moisture stress (only for vegetation 
+                                                                                !! growth) (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)    :: qsintveg         !! Amount of water in the canopy interception 
+                                                                                !! reservoir @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: floodout         !! flux out of floodplains
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (inout)   :: shumdiag         !! Mean relative soil moisture in the different
+                                                                                !! levels used by thermosoil.f90 (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)  :: snowrho          !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)  :: snowtemp         !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)  :: snowgrain        !! Snow grainsize
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)  :: snowdz           !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout)  :: snowheat         !! Snow heat content
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out)    :: snowliq          !! Liquid water content (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)          :: grndflux         !! Net flux into soil W/m2
+    REAL(r_std), DIMENSION (kjpindex), INTENT (inout)       :: temp_sol_add     !! additional surface temperature due to the melt of first layer
+                                                                                !! at the present time-step @tex ($K$) @endtex
+ 
+
+    !! 0.4 Local variables
+    
+    REAL(r_std),DIMENSION (kjpindex)                        :: soilwet          !! Temporary diagnostic of relative humidity of 
+                                                                                !! total soil (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex)                        :: snowdepth        !! Snow Depth (m)
+    INTEGER(i_std)                                          :: ji,jv            !! Grid-cell and PFT indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                        :: histvar          !! Ancillary variable when computations are needed
+                                                                                !! before writing to history files
+    CHARACTER(LEN=80)                                       :: var_name         !! To store variables names for I/O
+
+!_ ================================================================================================================================
+
+  !! 1. Water budget calculations:
+    
+    !! 1.a snow processes
+    IF (ok_explicitsnow) THEN 
+
+       IF (printlev>=3) WRITE (numout,*) ' ok_explicitsnow : use multi-snow layer '
+       CALL explicitsnow_main(kjpindex,    precip_rain,  precip_snow,   temp_air,    pb,       &
+                              u,           v,            temp_sol_new,  soilcap,     pgflux,   &
+                              frac_nobio,  totfrac_nobio,gtemp,          &
+                              lambda_snow, cgrnd_snow,   dgrnd_snow,                           & 
+                              vevapsno,    snow_age,     snow_nobio_age,snow_nobio,  snowrho,  &
+                              snowgrain,   snowdz,       snowtemp,      snowheat,    snow,     &
+                              temp_sol_add,          					       &
+                              snowliq,     subsnownobio, grndflux,      snowmelt,    tot_melt, &
+                              subsinksoil)             
+    ELSE
+       CALL hydrolc_snow(kjpindex, precip_rain, precip_snow, temp_sol_new, soilcap, &
+            frac_nobio, totfrac_nobio, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age, &
+            tot_melt, snowdepth)
+    END IF
+    
+    !! 1.b canopy processes
+    CALL hydrolc_vegupd(kjpindex, veget, tot_bare_soil, ruu_ch, qsintveg, gqsb, bqsb, dsg, dss,dsp, resdist)
+    
+    CALL hydrolc_canop(kjpindex, precip_rain, vevapwet, veget, qsintmax, tot_bare_soil, qsintveg, precisol)
+    !
+    ! computes surface reservoir
+    !
+    CALL hydrolc_flood(kjpindex, vevapnu, vevapflo, flood_frac, flood_res, floodout)
+   
+    !! 1.c soil hydrology processes
+    CALL hydrolc_soil(kjpindex, vevapnu, precisol, returnflow, reinfiltration, irrigation, tot_melt, mx_eau_var, &
+         & veget, tot_bare_soil, ruu_ch, transpir,&
+         & gqsb, bqsb, dsg, dss, rsol, drysoil_frac, hdry, dsp, run_off_tot, drainage, humrel, &
+         & vegstress, shumdiag, litterhumdiag)
+    
+    ! computes horizontal diffusion between the water reservoirs
+    IF ( ok_hdiff ) THEN
+      CALL hydrolc_hdiff(kjpindex, veget, tot_bare_soil, ruu_ch, gqsb, bqsb, dsg, dss, dsp)
+    ENDIF
+    
+    ! If we check the water balance, we end with the comparison of total water change and fluxes
+    IF (check_waterbal) THEN
+       CALL hydrolc_waterbal(kjpindex, index, veget, totfrac_nobio, qsintveg, snow, snow_nobio,&
+            & precip_rain, precip_snow, returnflow, reinfiltration, irrigation, tot_melt, vevapwet, transpir, vevapnu, vevapsno,&
+            & vevapflo, floodout, run_off_tot, drainage )
+    ENDIF
+    
+  !! 2. Output
+    
+    ! If we use the ALMA standards (then 'humrel' is not written)
+    IF (almaoutput) THEN
+       CALL hydrolc_alma(kjpindex, index, qsintveg, snow, snow_nobio, soilwet)
+    ENDIF
+
+    CALL xios_orchidee_send_field("runoff",run_off_tot*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("drainage",drainage*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("rain",precip_rain*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("snowf",precip_snow*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("rain_alma",precip_rain/dt_sechiba)
+    CALL xios_orchidee_send_field("snowf_alma",precip_snow/dt_sechiba)
+    CALL xios_orchidee_send_field("dss",dss)
+    CALL xios_orchidee_send_field("bqsb",mean_bqsb)
+    CALL xios_orchidee_send_field("gqsb",mean_gqsb)
+    CALL xios_orchidee_send_field("qsintveg",qsintveg)
+    CALL xios_orchidee_send_field("precisol",precisol*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("floodout",floodout*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("humrel",humrel)     
+    CALL xios_orchidee_send_field("qsintmax",qsintmax)
+    CALL xios_orchidee_send_field("mrros",run_off_tot/dt_sechiba)
+    
+    histvar(:)=run_off_tot(:)+drainage(:)
+    CALL xios_orchidee_send_field("mrro",histvar/dt_sechiba)
+    
+    histvar(:)=(precip_rain(:)-SUM(precisol(:,:),dim=2))
+    CALL xios_orchidee_send_field("prveg",histvar/dt_sechiba)
+    
+    histvar(:)=zero
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          IF ( vegtot(ji) .GT. zero ) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+             IF (jv .EQ. 1) THEN
+                histvar(ji)=histvar(ji)+tot_bare_soil(ji)/vegtot(ji)*MAX((0.1-dss(ji,jv))*wmax_veg(jv), zero)
+             ELSE
+                histvar(ji)=histvar(ji)+veget(ji,jv)/vegtot(ji)*MAX((0.1-dss(ji,jv))*wmax_veg(jv), zero)
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    CALL xios_orchidee_send_field("mrsos",histvar)
+
+    ! Total soil moisture
+    histvar(:)=mean_bqsb(:)+mean_gqsb(:)
+    CALL xios_orchidee_send_field("mrso",histvar)
+    CALL xios_orchidee_send_field("SubSnow",vevapsno/dt_sechiba)
+    CALL xios_orchidee_send_field("SnowDepth",snowdepth)
+    CALL xios_orchidee_send_field("Qs",run_off_tot/dt_sechiba)
+    CALL xios_orchidee_send_field("Qsb",drainage/dt_sechiba)
+    CALL xios_orchidee_send_field("Qsm",tot_melt/dt_sechiba)
+
+    IF (almaoutput) THEN
+       CALL xios_orchidee_send_field("SoilWet",soilwet)
+       CALL xios_orchidee_send_field("DelSoilMoist",delsoilmoist)
+       CALL xios_orchidee_send_field("DelSWE",delswe)
+       CALL xios_orchidee_send_field("DelIntercept",delintercept)
+       CALL xios_orchidee_send_field("RootMoist",tot_watsoil_end)
+    END IF
+
+
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'dss', kjit, dss, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'bqsb', kjit, mean_bqsb, kjpindex, index)
+       CALL histwrite_p(hist_id, 'gqsb', kjit, mean_gqsb, kjpindex, index)
+       CALL histwrite_p(hist_id, 'runoff', kjit, run_off_tot, kjpindex, index) ! this is surface runoff = 5% of total runoff
+       CALL histwrite_p(hist_id, 'drainage', kjit, drainage, kjpindex, index) ! this 95% of total runoff
+       IF ( do_floodplains ) THEN
+          CALL histwrite_p(hist_id, 'floodout', kjit, floodout, kjpindex, index)
+       ENDIF
+       CALL histwrite_p(hist_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'rain', kjit, precip_rain, kjpindex, index)
+       CALL histwrite_p(hist_id, 'snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg) ! this the transpiration stress factor
+
+    !! The output for "CMIP5" is handled here, assuming that fluxes in kg m^{-2} s^{-1}
+    !!  But the transformation below on mrro, mrros and prveg lead to fluxes that are 48 times too small !***
+
+       histvar(:)=zero
+       DO jv = 1, nvm
+          DO ji = 1, kjpindex
+             IF ( vegtot(ji) .GT. zero ) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+                IF (jv .EQ. 1) THEN
+                   histvar(ji)=histvar(ji)+tot_bare_soil(ji)/vegtot(ji)*MAX((0.1-dss(ji,jv))*wmax_veg(jv), zero)
+                ELSE
+                   histvar(ji)=histvar(ji)+veget(ji,jv)/vegtot(ji)*MAX((0.1-dss(ji,jv))*wmax_veg(jv), zero)
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDDO
+       ! this is soil moisture in the top 10 cms
+       CALL histwrite_p(hist_id, 'mrsos', kjit, histvar, kjpindex, index) 
+
+       ! this is total soil moisture
+       histvar(:)=mean_bqsb(:)+mean_gqsb(:)
+       CALL histwrite_p(hist_id, 'mrso', kjit, histvar, kjpindex, index) 
+
+       CALL histwrite_p(hist_id, 'mrros', kjit, run_off_tot, kjpindex, index)
+
+       histvar(:)=run_off_tot(:)+drainage(:)
+       CALL histwrite_p(hist_id, 'mrro', kjit, histvar, kjpindex, index)
+
+       histvar(:)=(precip_rain(:)-SUM(precisol(:,:),dim=2))
+       CALL histwrite_p(hist_id, 'prveg', kjit, histvar, kjpindex, index)
+       CALL histwrite_p(hist_id, 'snowmelt',kjit,snowmelt,kjpindex,index)
+
+    ELSE 
+       
+       ! almaoutput=true
+       CALL histwrite_p(hist_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+   
+       ! surface runoff = 5% of total runoff
+       CALL histwrite_p(hist_id, 'Qs', kjit, run_off_tot, kjpindex, index)
+
+       ! drainage = 95% of total runoff
+       CALL histwrite_p(hist_id, 'Qsb', kjit, drainage, kjpindex, index) 
+       CALL histwrite_p(hist_id, 'Qsm', kjit, snowmelt, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelSWE', kjit, delswe, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelIntercept', kjit, delintercept, kjpindex, index)      
+       CALL histwrite_p(hist_id, 'SoilMoist', kjit, tot_watsoil_end, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+       
+       ! this the transpiration stress factor
+       CALL histwrite_p(hist_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg) 
+       
+       CALL histwrite_p(hist_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
+       
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist2_id, 'dss', kjit, dss, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'bqsb', kjit, mean_bqsb, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'gqsb', kjit, mean_gqsb, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'runoff', kjit, run_off_tot, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'drainage', kjit, drainage, kjpindex, index)
+          IF ( do_floodplains ) THEN
+             CALL histwrite_p(hist2_id, 'floodout', kjit, floodout, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'rain', kjit, precip_rain, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'snowmelt',kjit,snowmelt,kjpindex,index)
+
+          IF (check_waterbal) THEN
+             CALL histwrite_p(hist2_id, 'TotWater', kjit, tot_water_end, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'TotWaterFlux', kjit, tot_flux, kjpindex, index)
+          ENDIF
+
+          histvar(:)=zero
+          DO jv = 1, nvm
+             DO ji = 1, kjpindex
+                IF ( vegtot(ji) .GT. zero ) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+                   IF (jv .EQ. 1) THEN
+                      histvar(ji)=histvar(ji)+tot_bare_soil(ji)/vegtot(ji)*MAX((0.1-dss(ji,jv))*wmax_veg(jv), zero)
+                   ELSE
+                      histvar(ji)=histvar(ji)+veget(ji,jv)/vegtot(ji)*MAX((0.1-dss(ji,jv))*wmax_veg(jv), zero)
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+          CALL histwrite_p(hist2_id, 'mrsos', kjit, histvar, kjpindex, index)
+
+          histvar(:)=run_off_tot(:)+drainage(:)
+          CALL histwrite_p(hist2_id, 'mrro', kjit, histvar, kjpindex, index)
+
+
+          ! this is total soil moisture
+          histvar(:)=mean_bqsb(:)+mean_gqsb(:)
+          CALL histwrite_p(hist2_id, 'mrso', kjit, histvar, kjpindex, index) 
+          CALL histwrite_p(hist2_id, 'mrros', kjit, run_off_tot, kjpindex, index)
+
+       ELSE
+          CALL histwrite_p(hist2_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qs', kjit, run_off_tot, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qsb', kjit, drainage, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qsm', kjit, snowmelt, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSWE', kjit, delswe, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SoilMoist', kjit, tot_watsoil_end, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+          
+          CALL histwrite_p(hist2_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+          
+          CALL histwrite_p(hist2_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
+          
+       ENDIF
+    ENDIF
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrolc_main Done '
+
+  END SUBROUTINE hydrolc_main
+ 
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrolc_finalize
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION : This subroutine writes the module variables and variables calculated in hydrolc to restart file
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrolc_finalize( kjit,      kjpindex,   rest_id,        snow,       &
+                               snow_age,  snow_nobio, snow_nobio_age, humrel,     &
+                               vegstress, qsintveg,   snowrho,        snowtemp,   &
+                               snowdz,    snowheat,   snowgrain,       &
+                               drysoil_frac, rsol, shumdiag)
+
+
+    !! 0. Variable and parameter declaration
+    !! 0.1  Input variables
+    INTEGER(i_std), INTENT(in)                           :: kjit             !! Current time step number (unitless)
+    INTEGER(i_std), INTENT(in)                           :: kjpindex         !! Domain size (number of grid cells) (unitless)
+    INTEGER(i_std),INTENT (in)                           :: rest_id          !! Restart file identifier 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: snow             !! Snow water equivalent 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: snow_age         !! Snow age (days)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio       !! Snow water equivalent on nobio areas
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio_age   !! Snow age on ice, lakes, ...  (days)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: humrel           !! Soil moisture stress factor on transpiration and
+                                                                             !! bare soil evaporation (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vegstress        !! Vegetation moisture stress (only for vegetation 
+                                                                             !! growth) (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintveg         !! Amount of water in the canopy interception 
+                                                                             !! reservoir @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowrho          !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowtemp         !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowdz           !! Snow layer thickness
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowheat         !! Snow heat content
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)  :: snowgrain        !! Snow grain size
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)          :: drysoil_frac
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)          :: rsol
+    REAL(r_std),DIMENSION (kjpindex,nbdl),INTENT(in)     :: shumdiag
+!_ ================================================================================================================================
+    
+    IF (printlev>=3) WRITE (numout,*) ' we have to complete restart file with HYDROLOGIC variables '
+    
+    CALL restput_p(rest_id, 'humrel', nbp_glo,   nvm, 1, kjit,  humrel, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'vegstress', nbp_glo,   nvm, 1, kjit,  vegstress, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow', nbp_glo,   1, 1, kjit,  snow, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow_age', nbp_glo,   1, 1, kjit,  snow_age, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow_nobio', nbp_glo, nnobio, 1, kjit,  snow_nobio, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'snow_nobio_age', nbp_glo, nnobio, 1, kjit, snow_nobio_age, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'bqsb', nbp_glo,   nvm, 1, kjit,  bqsb, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'gqsb', nbp_glo,   nvm, 1, kjit,  gqsb, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'dsg', nbp_glo,  nvm, 1, kjit,  dsg, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'dsp', nbp_glo,   nvm, 1, kjit,  dsp, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'dss', nbp_glo,   nvm, 1, kjit,  dss, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'hdry', nbp_glo,   1, 1, kjit,  hdry, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'qsintveg', nbp_glo, nvm, 1, kjit,  qsintveg, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'resdist', nbp_glo, nvm, 1, kjit,  resdist, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'drysoil_frac', nbp_glo, 1, 1, kjit, drysoil_frac, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'rsol', nbp_glo, 1, 1, kjit, rsol, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'shumdiag', nbp_glo, nbdl, 1, kjit,  shumdiag, 'scatter',  nbp_glo, index_g)
+    CALL restput_p(rest_id, 'mean_gqsb', nbp_glo, 1, 1, kjit, mean_gqsb, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'mean_bqsb', nbp_glo, 1, 1, kjit, mean_bqsb, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'mx_eau_var', nbp_glo, 1, 1, kjit, mx_eau_var, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'vegtot', nbp_glo, 1, 1, kjit, vegtot, 'scatter', nbp_glo, index_g)
+
+
+    ! Write variables for explictsnow module to restart file
+    IF (ok_explicitsnow) THEN
+       CALL explicitsnow_finalize ( kjit,     kjpindex, rest_id,    snowrho,   &
+                                    snowtemp, snowdz,   snowheat,   snowgrain)
+    END IF
+    
+  END SUBROUTINE hydrolc_finalize
+
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrolc_init
+!!
+!>\BRIEF        This routine drives the initialisation of the water budget calculations. 
+!!
+!! DESCRIPTION : The following sequences are performed :
+!!  - Setting ok_hdiff (default is false) for horizontal diffusion between soil columns
+!!  - Dynamic allocation of arrays that are local to module hydrolc
+!!  - Initializing prognostic variables from input restart file
+!!  - Default attribution is performed in case the model is started without a restart file
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : humrel, vegstress,snow, snow_age, snow_nobio, snow_nobio_age, qsintveg
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_ ================================================================================================================================  
+  
+  SUBROUTINE hydrolc_init(kjit, kjpindex, index, rest_id, &
+       veget,  tot_bare_soil, &
+       humrel, vegstress, shumdiag, & 
+       snow,   snow_age,  snow_nobio, snow_nobio_age, qsintveg, &
+       snowdz, snowgrain, snowrho,    snowtemp,       snowheat, &
+       drysoil_frac, rsol)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+ 
+    INTEGER(i_std), INTENT (in)                          :: kjit                !! Current time step number (unitless)
+    INTEGER(i_std), INTENT (in)                          :: kjpindex            !! Domain size (number of grid cells) (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: index               !! Indices of the land grid points on the map 
+                                                                                !! (unitless)
+    INTEGER(i_std), INTENT (in)                          :: rest_id             !! _Restart_ file identifier (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget               !! Grid-cell fraction effectively covered by 
+                                                                                !! vegetation for each PFT, except for soil 
+                                                                                !! (0-1, unitless) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)        :: tot_bare_soil       !! Total evaporating bare soil fraction    
+
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: humrel              !! Soil moisture stress factor on transpiration
+                                                                                !! and bare soil evaporation (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vegstress           !! Vegetation moisture stress (only for 
+                                                                                !! vegetation growth) (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)  :: shumdiag            !! Mean relative soil moisture in the different
+                                                                                !! levels used by thermosoil.f90 (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: snow                !! Snow water equivalent @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: snow_age            !! Snow age (days)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out):: snow_nobio          !! Snow water equivalent on nobio areas 
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out):: snow_nobio_age      !! Snow age on ice, lakes, ...  (days)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: qsintveg            !! Amount of water in the canopy interception 
+                                                                                !! reservoir @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)   :: snowdz              !! Snow depth
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)   :: snowgrain           !! Snow grain size
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)   :: snowheat            !! Snow heat content
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)   :: snowtemp            !! Snow temperature
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out)   :: snowrho             !! Snow density
+    REAL(r_std),DIMENSION (kjpindex),INTENT(out)         :: drysoil_frac
+    REAL(r_std),DIMENSION (kjpindex),INTENT(out)         :: rsol                !! Resistance to bare soil evaporation 
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                       :: ier                 !! To receive error flag during allocation
+    INTEGER(i_std)                                       :: ji,jv,ik            !! Indices for grid-cells, PFTs, and grid-cells 
+                                                                                !! (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm)                :: zdsp, tmpdss        !! Ancillary variables for initializing dsp 
+                                                                                !! and dss (m)
+    REAL(r_std), ALLOCATABLE, DIMENSION (:,:)            :: dsp_g               !! Ancillary variable for initializing dsp (m)
+                                                                                !! dss (m)   
+    REAL(r_std), DIMENSION(kjpindex)                     :: a_subgrd            !! Diagnosed subgrid fraction of saturated soil in
+                                                                                !! the top layer, to calculate hdry (0-1, unitless)
+    CHARACTER(LEN=80)                                    :: var_name            !! To store variables names for I/O
+!_ ================================================================================================================================
+
+  !! 1. Setting ok_hdiff for horizontal diffusion between soil columns
+
+    !Config Key   = HYDROL_OK_HDIFF
+    !Config Desc  = do horizontal diffusion?
+    !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR)  
+    !Config Def   = n
+    !Config Help  = If TRUE, then water can diffuse horizontally between
+    !Config         the PFTs' water reservoirs.
+    !Config Units = [FLAG]
+    ok_hdiff = .FALSE.
+    CALL getin_p('HYDROL_OK_HDIFF',ok_hdiff) 
+
+  !! 2. Make dynamic allocation with the good dimensions
+
+    ! one dimension array allocation with possible restart value
+    ALLOCATE (bqsb(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in bqsb allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    bqsb(:,:) = zero
+
+    ALLOCATE (gqsb(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in gqsb allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    gqsb(:,:) = zero
+
+    ALLOCATE (dsg(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in dsg allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    dsg(:,:) = zero
+
+    ALLOCATE (dsp(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in dsp allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    dsp(:,:) = zero
+
+    ! one dimension array allocation 
+    ALLOCATE (mean_bqsb(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in mean_bqsb allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    mean_bqsb(:) = zero
+
+    ALLOCATE (mean_gqsb(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in mean_gqsb allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    mean_gqsb(:) = zero
+
+    ALLOCATE (dss(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in dss allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    dss(:,:) = zero
+
+    ALLOCATE (hdry(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in hdry allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    hdry(:) = zero
+
+    ALLOCATE (precisol(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in precisol allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    precisol(:,:) = zero
+
+    ALLOCATE (gdrainage(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in precisol allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    gdrainage(:,:) = zero
+
+    ALLOCATE (subsnowveg(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in subsnowveg allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    subsnowveg(:) = zero
+
+    ALLOCATE (subsnownobio(kjpindex,nnobio),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in subsnownobio allocation. We stop. We need kjpindex*nnobio words = ', &
+          kjpindex*nnobio
+        STOP 'hydrolc_init'
+    END IF
+    subsnownobio(:,:) = zero
+
+    ALLOCATE (snowmelt(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in snowmelt allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    snowmelt(:) = zero
+
+    ALLOCATE (icemelt(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in icemelt allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    icemelt(:) = zero
+
+    ALLOCATE (subsinksoil(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in subsinksoil allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrolc_init'
+    END IF
+
+
+    ALLOCATE (mx_eau_var(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in mx_eau_var allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    mx_eau_var(:) = zero
+
+    ALLOCATE (ruu_ch(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in ruu_ch allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    ruu_ch(:) = zero
+
+    ALLOCATE (vegtot(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in vegtot allocation. We stop. We need kjpindex words = ',kjpindex*nvm
+        STOP 'hydrolc_init'
+    END IF
+    vegtot(:) = zero
+
+    ALLOCATE (resdist(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in resdist allocation. We stop. We need kjpindex words = ',kjpindex*nvm
+        STOP 'hydrolc_init'
+    END IF
+    resdist(:,:) = zero
+
+    !  If we check the water balance we need two more variables
+    IF ( check_waterbal ) THEN
+
+       ALLOCATE (tot_water_beg(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_water_beg allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (tot_water_end(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_water_end allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (tot_flux(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_flux allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+    ENDIF
+    
+    !  If we use the almaoutputs we need four more variables
+    IF ( almaoutput ) THEN
+
+       ALLOCATE (tot_watveg_beg(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_watveg_beg allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (tot_watveg_end(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_watveg_end allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (tot_watsoil_beg(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_watsoil_beg allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (tot_watsoil_end(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_watsoil_end allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (delsoilmoist(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in delsoilmoist allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (delintercept(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in delintercept. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (delswe(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in delswe. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       ENDIF
+
+       ALLOCATE (snow_beg(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in snow_beg allocation. We stop. We need kjpindex words =',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (snow_end(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in snow_end allocation. We stop. We need kjpindex words =',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+    ENDIF
+
+  !!  3. Initialization of hydrologic variables:
+
+    !! 3.a Read data from restart input file (opened by sechiba_init)
+    !! for HYDROLOGIC processes
+        IF (printlev>=3) WRITE (numout,*) ' we have to read a restart file for HYDROLOGIC variables'
+
+        var_name= 'snow'        
+        CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Snow mass')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1  , 1, kjit, .TRUE., snow, "gather", nbp_glo, index_g)
+        
+        var_name= 'snow_age'
+        CALL ioconf_setatt_p('UNITS', 'd')
+        CALL ioconf_setatt_p('LONG_NAME','Snow age')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1  , 1, kjit, .TRUE., snow_age, "gather", nbp_glo, index_g)
+        
+        var_name= 'snow_nobio'
+        CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Snow on other surface types')
+        CALL restget_p (rest_id, var_name, nbp_glo, nnobio  , 1, kjit, .TRUE., snow_nobio, "gather", nbp_glo, index_g)
+        
+        var_name= 'snow_nobio_age'
+        CALL ioconf_setatt_p('UNITS', 'd')
+        CALL ioconf_setatt_p('LONG_NAME','Snow age on other surface types')
+        CALL restget_p (rest_id, var_name, nbp_glo, nnobio  , 1, kjit, .TRUE., snow_nobio_age, "gather", nbp_glo, index_g)
+        
+        var_name= 'humrel'
+        CALL ioconf_setatt_p('UNITS', '-')
+        CALL ioconf_setatt_p('LONG_NAME','Soil moisture stress')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., humrel, "gather", nbp_glo, index_g)
+        
+        var_name= 'vegstress'
+        CALL ioconf_setatt_p('UNITS', '-')
+        CALL ioconf_setatt_p('LONG_NAME','Vegetation growth moisture stress')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., vegstress, "gather", nbp_glo, index_g)
+        
+        var_name= 'bqsb'
+        CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Deep soil moisture')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm , 1, kjit, .TRUE., bqsb, "gather", nbp_glo, index_g)
+        
+        var_name= 'gqsb'
+        CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Surface soil moisture')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm , 1, kjit, .TRUE., gqsb, "gather", nbp_glo, index_g)
+        
+        var_name= 'dsg'
+        CALL ioconf_setatt_p('UNITS', 'm')
+        CALL ioconf_setatt_p('LONG_NAME','Depth of upper reservoir')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm  , 1, kjit, .TRUE., dsg, "gather", nbp_glo, index_g)
+        
+        var_name= 'dsp'
+        CALL ioconf_setatt_p('UNITS', 'm')
+        CALL ioconf_setatt_p('LONG_NAME','Depth to lower reservoir')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm  , 1, kjit, .TRUE., dsp, "gather", nbp_glo, index_g)
+        
+        var_name= 'dss'
+        CALL ioconf_setatt_p('UNITS', 'm')
+        CALL ioconf_setatt_p('LONG_NAME','Hauteur au dessus du reservoir de surface')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm  , 1, kjit, .TRUE., dss, "gather", nbp_glo, index_g)
+                
+        var_name= 'hdry'
+        CALL ioconf_setatt_p('UNITS', 'm')
+        CALL ioconf_setatt_p('LONG_NAME','Dry soil heigth in meters')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1 , 1, kjit, .TRUE., hdry, "gather", nbp_glo, index_g)
+                
+        var_name= 'qsintveg'
+        CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Intercepted moisture')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., qsintveg, "gather", nbp_glo, index_g)
+        
+        var_name= 'resdist'
+        CALL ioconf_setatt_p('UNITS', '-')
+        CALL ioconf_setatt_p('LONG_NAME','Distribution of reservoirs')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., resdist, "gather", nbp_glo, index_g)
+        
+        ! Read drysoil_frac. It will be initalized later in hydrolc_var_init if the varaible is not find in restart file.
+        CALL restget_p (rest_id, 'drysoil_frac', nbp_glo, 1  , 1, kjit, .TRUE., drysoil_frac, "gather", nbp_glo, index_g)
+
+        ! Read rsol. It will be initalized later in hydrolc_var_init if the varaible is not find in restart file.
+        CALL restget_p (rest_id, 'rsol', nbp_glo, 1  , 1, kjit, .TRUE., rsol, "gather", nbp_glo, index_g)
+
+        ! shumdiag : initialization if not in restart file will be done in hydrolc_var_init
+        CALL restget_p (rest_id, 'shumdiag', nbp_glo, nbdl  , 1, kjit, .TRUE., shumdiag, "gather", nbp_glo, index_g)
+
+        CALL restget_p (rest_id, 'mean_bqsb', nbp_glo, 1  , 1, kjit, .TRUE., mean_bqsb, "gather", nbp_glo, index_g)
+        CALL restget_p (rest_id, 'mean_gqsb', nbp_glo, 1  , 1, kjit, .TRUE., mean_gqsb, "gather", nbp_glo, index_g)
+
+        var_name= 'mx_eau_var'
+        CALL ioconf_setatt_p('UNITS', '')
+        CALL ioconf_setatt_p('LONG_NAME','')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1 , 1, kjit, .TRUE., mx_eau_var, "gather", nbp_glo, index_g)
+
+        var_name= 'vegtot'
+        CALL ioconf_setatt_p('UNITS', '')
+        CALL ioconf_setatt_p('LONG_NAME','')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1 , 1, kjit, .TRUE., vegtot, "gather", nbp_glo, index_g)
+
+
+        !! 3.b Assign default values if non were found in the restart file
+        !Config Key   = HYDROL_SNOW
+        !Config Desc  = Initial snow mass if not found in restart
+        !Config If    = OK_SECHIBA
+        !Config Def   = 0.0
+        !Config Help  = The initial value of snow mass if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [kg/m^2]
+        CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', zero)
+        
+        !Config Key   = HYDROL_SNOWAGE
+        !Config Desc  = Initial snow age if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.0
+        !Config Help  = The initial value of snow age if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [days]
+        CALL setvar_p (snow_age, val_exp, 'HYDROL_SNOWAGE', zero)
+        
+        !Config Key   = HYDROL_SNOW_NOBIO
+        !Config Desc  = Initial snow amount on ice, lakes, etc. if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.0
+        !Config Help  = The initial value of snow if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [m]
+        CALL setvar_p (snow_nobio, val_exp, 'HYDROL_SNOW_NOBIO', zero)
+        
+        !Config Key   = HYDROL_SNOW_NOBIO_AGE
+        !Config Desc  = Initial snow age on ice, lakes, etc. if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.0
+        !Config Help  = The initial value of snow age if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [days]
+        CALL setvar_p (snow_nobio_age, val_exp, 'HYDROL_SNOW_NOBIO_AGE', zero)
+        
+        !Config Key   = HYDROL_HUMR
+        !Config Desc  = Initial soil moisture stress if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 1.0
+        !Config Help  = The initial value of soil moisture stress if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [-]
+        CALL setvar_p (humrel, val_exp,'HYDROL_HUMR', un)
+        CALL setvar_p (vegstress, val_exp,'HYDROL_HUMR', un)
+        
+        !Config Key   = HYDROL_BQSB
+        !Config Desc  = Initial restart deep soil moisture if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 999999. 
+        !Config Help  = The initial value of deep soil moisture if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file. Default behaviour is a saturated soil.
+        !Config Units = [kg/m^2]
+        CALL setvar_p (bqsb, val_exp, 'HYDROL_BQSB', wmax_veg*zmaxh)
+        
+        !Config Key   = HYDROL_GQSB
+        !Config Desc  = Initial upper soil moisture if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.0
+        !Config Help  = The initial value of upper soil moisture if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [kg/m^2]
+        CALL setvar_p (gqsb, val_exp, 'HYDROL_GQSB', zero)
+        
+        !Config Key   = HYDROL_DSG
+        !Config Desc  = Initial upper reservoir depth if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.0
+        !Config Help  = The initial value of upper reservoir depth if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [m]
+        CALL setvar_p (dsg, val_exp, 'HYDROL_DSG', zero)
+        
+        !Config Key   = HYDROL_QSV
+        !Config Desc  = Initial water on canopy if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.0
+        !Config Help  = The initial value of moisture on canopy if its value 
+        !Config         is not found in the restart file. This should only be used if
+        !Config         the model is started without a restart file. 
+        !Config Units = [kg/m^2]
+        CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', zero)
+        
+        !! 3.c Specific calculations to define default values for dry soil depths : dsp, dss, and hdry
+        ! set inital value for dsp if needed
+        !Config Key   = HYDROL_DSP
+        !Config Desc  = Initial dry soil above upper reservoir if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 999999.
+        !Config Help  = The initial value of dry soil above upper reservoir if its value 
+        !Config         is not found in the restart file. This should only be used if
+        !Config         the model is started without a restart file. The default behaviour
+        !Config         is to compute it from the variables above. Should be OK most of 
+        !Config         the time.
+        !Config Units = [m]
+        !
+        ! Calculate temporary variable to use for initialiaion of dsp.
+        ! This variable will only be used if no value is set in run.def
+	DO jv = 1,nvm
+           zdsp(:,jv) = zmaxh - bqsb(:,jv) / wmax_veg(jv)
+        END DO
+
+        CALL setvar_p(dsp, val_exp, 'HYDROL_DSP', zdsp) 
+
+        ! set inital value for dss 
+        DO jv = 1,nvm
+           tmpdss(:,jv) = dsg(:,jv) - gqsb(:,jv) / wmax_veg(jv)
+        END DO
+        
+        ! Initialize dss if it is not found in restart file
+        IF ( ALL( dss(:,:) == val_exp ) ) THEN
+           dss(:,:)=tmpdss(:,:)
+        END IF
+                
+        ! set inital value for hdry if not found in restart file
+        ! see hydrolc_soil, step 8.4
+        IF ( ALL( hdry(:) == val_exp ) ) THEN
+           a_subgrd(:) = zero
+           DO ji=1,kjpindex
+              IF ( gqsb(ji,1)+bqsb(ji,1) .GT. zero ) THEN
+                 
+                 IF (.NOT. (dsg(ji,1).EQ. zero .OR. gqsb(ji,1).EQ.zero)) THEN
+                    
+                    ! Ajouts Nathalie - Fred - le 28 Mars 2006
+                    a_subgrd(ji)=MIN(MAX(dsg(ji,1)-dss(ji,1),zero)/dsg_min,un)
+                    
+                 ENDIF
+              ENDIF
+           ENDDO
+           
+           ! Correction Nathalie - le 28 Mars 2006 - re-ecriture drysoil_frac/hdry - Fred Hourdin
+           ! revu 22 novembre 2007
+           hdry(:) = a_subgrd(:)*dss(:,1) + (un-a_subgrd(:))*dsp(:,1)
+        ENDIF
+        
+        ! There is no need to configure the initialisation of resdist. If not available it is the vegetation map
+        IF ( MINVAL(resdist) .EQ.  MAXVAL(resdist) .AND. MINVAL(resdist) .EQ. val_exp) THEN
+            resdist(:,1) = tot_bare_soil(:)
+            resdist(:,2:nvm) = veget(:,2:nvm)
+         ENDIF
+        
+         !! 3.d Compute vegtot (remember that it is only frac_nobio + SUM(veget(,:)) that is equal to 1)
+         IF (ALL(vegtot(:)==val_exp)) THEN
+            DO ji = 1, kjpindex
+               vegtot(ji) = SUM(veget(ji,2:nvm)) + tot_bare_soil(ji)
+            ENDDO
+         END IF
+        
+    ! Initialize variables for explictsnow module by reading restart file
+    IF (ok_explicitsnow) THEN
+       CALL explicitsnow_initialize( kjit,     kjpindex, rest_id,    snowrho,   &
+                                     snowtemp, snowdz,   snowheat,   snowgrain )
+    END IF
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrolc_init done '
+    
+  END SUBROUTINE hydrolc_init
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrolc_clear
+!!
+!>\BRIEF        Deallocates arrays that were allocated in hydrolc_init and hydrolc_var_init. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGES : None
+!! 
+!! MAIN OUTPUT VARIABLE(S) : None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+  
+  SUBROUTINE hydrolc_clear()
+ 
+    IF (ALLOCATED (bqsb)) DEALLOCATE (bqsb)
+    IF (ALLOCATED  (gqsb)) DEALLOCATE (gqsb)
+    IF (ALLOCATED  (dsg))  DEALLOCATE (dsg)
+    IF (ALLOCATED  (dsp))  DEALLOCATE (dsp)
+    IF (ALLOCATED  (mean_bqsb))  DEALLOCATE (mean_bqsb)
+    IF (ALLOCATED  (mean_gqsb)) DEALLOCATE (mean_gqsb)
+    IF (ALLOCATED  (dss)) DEALLOCATE (dss)
+    IF (ALLOCATED  (hdry)) DEALLOCATE (hdry)
+    IF (ALLOCATED  (precisol)) DEALLOCATE (precisol)
+    IF (ALLOCATED  (gdrainage)) DEALLOCATE (gdrainage)
+    IF (ALLOCATED  (subsnowveg)) DEALLOCATE (subsnowveg)
+    IF (ALLOCATED  (subsnownobio)) DEALLOCATE (subsnownobio)
+    IF (ALLOCATED  (snowmelt)) DEALLOCATE (snowmelt)
+    IF (ALLOCATED  (icemelt)) DEALLOCATE (icemelt)
+    IF (ALLOCATED  (subsinksoil)) DEALLOCATE (subsinksoil)
+    IF (ALLOCATED  (mx_eau_var)) DEALLOCATE (mx_eau_var)
+    IF (ALLOCATED  (ruu_ch)) DEALLOCATE (ruu_ch)
+    IF (ALLOCATED  (vegtot)) DEALLOCATE (vegtot)
+    IF (ALLOCATED  (resdist)) DEALLOCATE (resdist)
+    IF (ALLOCATED  (tot_water_beg)) DEALLOCATE (tot_water_beg)
+    IF (ALLOCATED  (tot_water_end)) DEALLOCATE (tot_water_end)
+    IF (ALLOCATED  (tot_flux)) DEALLOCATE (tot_flux)
+    IF (ALLOCATED  (tot_watveg_beg)) DEALLOCATE (tot_watveg_beg)
+    IF (ALLOCATED  (tot_watveg_end)) DEALLOCATE (tot_watveg_end)
+    IF (ALLOCATED  (tot_watsoil_beg)) DEALLOCATE (tot_watsoil_beg)
+    IF (ALLOCATED  (tot_watsoil_end)) DEALLOCATE (tot_watsoil_end)
+    IF (ALLOCATED  (delsoilmoist)) DEALLOCATE (delsoilmoist)
+    IF (ALLOCATED  (delintercept)) DEALLOCATE (delintercept)
+    IF (ALLOCATED  (snow_beg)) DEALLOCATE (snow_beg)
+    IF (ALLOCATED  (snow_end)) DEALLOCATE (snow_end)
+    IF (ALLOCATED  (delswe)) DEALLOCATE (delswe)
+    
+ END SUBROUTINE hydrolc_clear
+ 
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrolc_var_init
+!!
+!>\BRIEF        This routine initializes diagnostic hydrologic variables.
+!!
+!! DESCRIPTION  : The following variables are assigned :
+!!  - Soil characteristics : soil water capacities mx_eau_var and ruu_ch \f$(kg m^{-2})\f$ and \f$(kg m^{-3})\f$
+!!  - Initial values for diagnostic variables : mean_bqsb, mean_gqsb, mean_dsg, shumdiag, drysoil_frac, rsol, litterhumdiag
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : rsol, drysoil_frac, mx_eau_var, ruu_ch, shumdiag, litterhumdiag
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================  
+
+  SUBROUTINE hydrolc_var_init (kjpindex, veget, veget_max, tot_bare_soil, &
+                               rsol, drysoil_frac, mx_eau_var, ruu_ch, shumdiag)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables 
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex      !! Domain size (number of grid cells) (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget         !! Grid-cell fraction effectively covered by vegetation for
+                                                                        !! each PFT, except for soil (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max     !! PFT fractions within grid-cells: max value of veget for 
+                                                                        !! vegetation PFTs and min value for bare soil (0-1, 
+                                                                        !! unitless) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)      :: tot_bare_soil !! Total evaporating bare soil fraction 
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: rsol          !! Resistance to bare soil evaporation 
+                                                                        !! @tex ($s m^{-1}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: drysoil_frac  !! Fraction of visible dry soil  (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: mx_eau_var    !! Maximum water content of the soil 
+                                                                        !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: ruu_ch        !! Volumetric soil water capacity 
+                                                                        !! @tex ($kg m^{-3}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (inout):: shumdiag    !! Mean relative soil moisture, diagnosed for 
+                                                                        !! thermosoil.f90 (0-1, unitless) 
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ji,jv, jd     !! Indices for grid-cells, PFTs and diagnostic levels in 
+                                                                        !! the soil (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                   :: mean_dsg      !! Mean Depth of the top layer, averaged over the soil 
+                                                                        !! columns (m)
+    REAL(r_std)                                        :: gtr, btr      !! Ancillary variables to compute shumdiag (0-1, unitless) 
+    REAL(r_std), DIMENSION(nbdl+1)                     :: tmp_dl        !! Temporary diagnostic levels in the soil (m)
+!_ ================================================================================================================================
+
+  !! 1. Vertical diagnostic levels to compute shumdiag (relative moisture for thermosoil)
+    
+    tmp_dl(1) = 0
+    tmp_dl(2:nbdl+1) = diaglev(1:nbdl)
+    
+  !! 2. Calculation of mx_eau_var and ruu_ch (soil water capacities)
+     
+    IF (ALL(mx_eau_var(:)==val_exp)) THEN
+       mx_eau_var(:) = zero
+    
+       DO ji = 1,kjpindex
+          DO jv = 1,nvm
+             !MM veget(:,1) BUG ??!!!!!!!!!!!
+             IF (jv .EQ. 1) THEN
+                mx_eau_var(ji) = mx_eau_var(ji) + tot_bare_soil(ji)*wmax_veg(jv)*zmaxh
+             ELSE
+                mx_eau_var(ji) = mx_eau_var(ji) + veget(ji,jv)*wmax_veg(jv)*zmaxh
+             ENDIF
+          END DO
+          IF (vegtot(ji) .GT. zero) THEN
+             mx_eau_var(ji) = mx_eau_var(ji)/vegtot(ji)
+          ELSE
+             ! lakes, ice, cities...
+             mx_eau_var(ji) = mx_eau_nobio*zmaxh
+          ENDIF
+       END DO
+    END IF
+    !! Initialize ruu_ch
+    ruu_ch(:) = mx_eau_var(:) / zmaxh
+
+    !! 3.-4. Initial values of the mean soil layer depths and water contents and shumdiag
+    
+    IF (ALL(mean_bqsb(:)==val_exp) .OR. ALL(mean_gqsb(:)==val_exp) .OR. ALL(shumdiag(:,:)==val_exp)) THEN
+       !! 3. Initial values of the mean soil layer depths and water contents
+       ! could be done with SUM instruction but this kills vectorization
+       mean_bqsb(:) = zero
+       mean_gqsb(:) = zero
+       mean_dsg(:) = zero
+       DO jv = 1, nvm
+          DO ji = 1, kjpindex
+             mean_bqsb(ji) = mean_bqsb(ji) + resdist(ji,jv)*bqsb(ji,jv)
+             mean_gqsb(ji) = mean_gqsb(ji) + resdist(ji,jv)*gqsb(ji,jv)
+             mean_dsg(ji) = mean_dsg(ji) + resdist(ji,jv)*dsg(ji,jv)
+          ENDDO
+       ENDDO
+       mean_dsg(:) = MAX( mean_dsg(:), mean_gqsb(:)/ruu_ch(:) )
+
+       DO ji = 1, kjpindex
+          IF (vegtot(ji) .GT. zero) THEN
+             mean_bqsb(ji) = mean_bqsb(ji)/vegtot(ji)
+             mean_gqsb(ji) = mean_gqsb(ji)/vegtot(ji)
+             mean_dsg(ji) = mean_dsg(ji)/vegtot(ji)
+          ENDIF
+       ENDDO
+
+    
+       !! 4. Initial value of shumdiag (see hydrolc_soil, 8.2 for details)
+       DO jd = 1,nbdl
+          DO ji = 1,kjpindex
+             IF ( tmp_dl(jd+1) .LT. mean_dsg(ji)) THEN
+                shumdiag(ji,jd) = mean_gqsb(ji)/mx_eau_var(ji)
+             ELSE
+                IF ( tmp_dl(jd) .LT. mean_dsg(ji)) THEN
+                   gtr = (mean_dsg(ji)-tmp_dl(jd))/(tmp_dl(jd+1)-tmp_dl(jd))
+                   btr = 1 - gtr
+                   shumdiag(ji,jd) = gtr*mean_gqsb(ji)/mx_eau_var(ji) + &
+                        & btr*mean_bqsb(ji)/mx_eau_var(ji)
+                ELSE
+                   shumdiag(ji,jd) = mean_bqsb(ji)/mx_eau_var(ji)
+                ENDIF
+             ENDIF
+             shumdiag(ji,jd) = MAX(MIN(shumdiag(ji,jd), un), zero)
+          ENDDO
+       ENDDO
+    END IF
+
+    !! 5. Initialize drysoil_frac if it was not found in the restart file
+    IF (ALL(drysoil_frac(:) == val_exp)) THEN
+       drysoil_frac(:) = MIN(MAX(dss(:,1),zero)*10._r_std, un)
+    END IF
+
+  !! 6. Initial value of the resistance to bare soil evaporation (see hydrolc_soil, 8.4 for details)
+    
+    IF (ALL(rsol(:)==val_exp)) THEN
+       rsol(:) = -un
+       DO ji = 1, kjpindex
+          IF (tot_bare_soil(ji) .GE. min_sechiba) THEN
+          
+             ! Correction Nathalie - le 28 mars 2006 - sur conseils Fred Hourdin
+             ! on modifie le rsol pour que la resistance croisse subitement si on s'approche
+             ! du fond. En gros, rsol=hdry*rsol_cste pour hdry < 1m70
+             !rsol(ji) = dss(ji,1) * rsol_cste
+             !rsol(ji) =  ( drysoil_frac(ji) + un/(10.*(zmaxh - drysoil_frac(ji))+1.e-10)**2 ) * rsol_cste
+             rsol(ji) =  ( hdry(ji) + un/(10.*(zmaxh - hdry(ji))+1.e-10)**2 ) * rsol_cste
+          ENDIF
+       ENDDO
+    END IF
+    
+    IF (printlev>=3) WRITE (numout,*) ' hydrolc_var_init done '
+
+  END SUBROUTINE hydrolc_var_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrolc_snow
+!!
+!>\BRIEF        This routine computes accumulation, sublimation, snowmelt and snow ageing 
+!! over vegetated and nobio (eg land-ice) areas. Snowdepth is then updated.
+!! 
+!! DESCRIPTION  : In this routine the snow-related processes accumulation, sublimation, 
+!! melting and ageing are computed separately on vegetated and nobio areas. This subroutine 
+!! is the first one among the ones that compute the physical processes. The water budgets 
+!! of the interception reservoir and the soil are performed afterwards.\n
+!!
+!! - Values of the main parameters used in this routine are :\n
+!! tp_00=273.15K : freezing point\n
+!! snowcri=1.5\f$kg m^{-2}\f$ : critical snowmass for sublimation\n
+!! sneige=snowcri/1000._r_std : critical snowmass for snow melt\n
+!! maxmass_snow=3000 \f$kg m^{-2}\f$ (~ 10m snow) : critical snowmass for snow stock\n
+!! snow_trans=0.3 (\f$kg m^{-2}\f$) : critical constant for snow ageing\n
+!! max_snow_age=50 (days) : maximum snow age\n
+!! sn_dens=330 (\f$kg m^{-3}\f$) : snow density\n
+!! one_day=86400 (s) : one day, expressed in seconds...
+!!
+!! - Accumulation\n
+!! On the vegetated areas, the snow mass increases due to area-weighted snow
+!! precipitations precip_snow; on nobio areas, rain additionnaly converts into snow.\n
+!!
+!! - Sublimation\n
+!! Sublimation on vegetated and nobio areas is calculated as the area-weighed fraction
+!! of vevapsno (from enerbil). In case snow on vegetated areas is limited (less than snowcri) 
+!! and a significant nobio area exists, the nobio area accomodates the whole sublimation 
+!! vevapsno. The nobio area also accomodates the possible excess sublimation from vegetated 
+!! areas, which otherwise goes into bare soil evaporation. In this case vevapsno is updated.\n
+!!
+!! - Melting\n
+!! Over vegetated and nobio areas, snowmelt occurs if the calculated soil temperature 
+!! temp_soil_new(ji) exceeds the freezing point tp_00. The energy required to warm up the soil
+!! surface above tp_00 is converted into melting, according to the following equation :
+!! \latexonly
+!! \input{hydrolcsnow1.tex}
+!! \endlatexonly
+!! \n
+!! with soilcap the soil heat capacity @tex ($J K^{-1}$) @endtex and chalfu0 the latent heat of
+!! fusion.\n
+!! A special case occurs in areas with snowmass exceeding maxmass_snow, where
+!! all the snow in excess of maxmass_snow adds to the total melting tot_melt.
+!! This excess melting is considered as additionnal snowmelt for vegetated areas
+!! and as ice_melt for nobio areas.\n
+!!
+!! - Ageing\n
+!! Over vegetated areas, during the time step dt_radia (usually 1800 s), the snow age is 
+!! incremented by a d_age calculated as follow:
+!! \latexonly
+!! \input{hydrolcsnow2.tex}
+!! \endlatexonly
+!! \n
+!! Over nobio areas and at subfreezing temperatures, snow ageing is limited by very 
+!! slow snow metamorphism, hence d_age is reduced as follow:
+!! \latexonly
+!! \input{hydrolcsnow3.tex}
+!! \endlatexonly
+!! \n
+!! Scientific reference for this parametrization choice is obviously missing !
+!! At the end of the routine the snowheight is diagnosed using the fixed
+!! snow density sn_dens.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLES:
+!! for vegetated and nobio areas respectively:\n
+!! snow(kjpindex) and snow_nobio(kjpindex)\n
+!! snow_age(kjpindex) and snow_nobio_age(kjpindex)\n
+!! for the whole grid-cell:\n
+!! vevapnu(kjpindex)
+!! vevapsno(kjpindex)
+!! tot_melt(kjpindex)
+!! snowdepth(kjpindex)
+!!   
+!! REFERENCES : None
+!! 
+!! FLOWCHART  : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrolc_snow (kjpindex, precip_rain, precip_snow , temp_sol_new, soilcap,&
+       & frac_nobio, totfrac_nobio, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age, &
+       & tot_melt, snowdepth)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variabless
+ 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex        !! Domain size  (unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_rain     !! Rainfall @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_snow     !! Snow precipitation @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: temp_sol_new    !! New soil temperature (K)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: soilcap         !! Soil heat capacity @tex ($J K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(in)     :: frac_nobio      !! Fraction of continental ice, lakes, ... 
+                                                                                !! (unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: totfrac_nobio   !! Total fraction of continental ice+lakes+ ... 
+                                                                                !! (unitless)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: tot_melt        !! Total melt @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: snowdepth       !! Snow depth (m)
+    
+    !! 0.3  Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapnu         !! Bare soil evaporation @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapsno        !! Snow evaporation @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: snow            !! Snow mass @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: snow_age        !! Snow age (days)
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout)  :: snow_nobio      !! Snomass on nobio areas 
+                                                                                !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout)  :: snow_nobio_age  !! Snow age on ice, lakes, ...(days)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                           :: ji, jv          !! indices (unitless)
+    REAL(r_std), DIMENSION (kjpindex)                        :: d_age           !! Snow age change (days)
+    REAL(r_std), DIMENSION (kjpindex)                        :: xx              !! temporary
+    REAL(r_std)                                              :: snowmelt_tmp    !! temporary @tex ($kg m^{-2}$) @endtex
+    REAL(r_std)                                              :: snow_d1k        !! The amount of snow that corresponds to a 1K cooling
+    LOGICAL, DIMENSION (kjpindex)                            :: warnings 
+    LOGICAL                                                  :: any_warning
+!_ ================================================================================================================================
+    
+  !! 1. initialisation
+    
+    DO jv = 1, nnobio
+      DO ji=1,kjpindex
+        subsnownobio(ji,jv) = zero
+      ENDDO
+    ENDDO
+    DO ji=1,kjpindex
+      subsnowveg(ji) = zero
+      snowmelt(ji) = zero
+      icemelt(ji) = zero
+      tot_melt(ji) = zero
+    ENDDO
+  
+  !! 2. On vegetation
+        
+    ! 2.1. It is snowing 
+    DO ji=1,kjpindex
+      snow(ji) = snow(ji) + (un - totfrac_nobio(ji))*precip_snow(ji)
+    ENDDO
+
+    DO ji=1,kjpindex
+      
+      ! 2.2. Sublimation - separate between vegetated and no-veget fractions
+      !      Care has to be taken as we might have sublimation from the
+      !      the frac_nobio while there is no snow on the rest of the grid.
+      IF ( snow(ji) > snowcri ) THEN
+         subsnownobio(ji,iice) = frac_nobio(ji,iice)*vevapsno(ji)
+         subsnowveg(ji) = vevapsno(ji) - subsnownobio(ji,iice)
+      ELSE
+
+         ! Correction Nathalie - Juillet 2006.
+         ! On doit d'abord tester s'il existe un frac_nobio!
+         ! Pour le moment je ne regarde que le iice
+         IF ( frac_nobio(ji,iice) .GT. min_sechiba) THEN
+            subsnownobio(ji,iice) = vevapsno(ji)
+            subsnowveg(ji) = zero
+         ELSE 
+            subsnownobio(ji,iice) = zero
+            subsnowveg(ji) = vevapsno(ji)
+         ENDIF
+      ENDIF
+    ENDDO
+    
+    warnings(:) = .FALSE.
+    any_warning = .FALSE.
+    DO ji=1,kjpindex
+      
+      ! 2.2.1 Check that sublimation on the vegetated fraction is possible.
+      IF (subsnowveg(ji) .GT. snow(ji)) THEN 
+
+         ! What could not be sublimated goes into bare soil evaporation
+         ! Nathalie - Juillet 2006 - il faut avant tout tester s'il existe du
+         ! frac_nobio sur ce pixel pour eviter de puiser dans le sol!         
+         IF ( frac_nobio(ji,iice) .GT. min_sechiba) THEN
+            subsnownobio(ji,iice) = subsnownobio(ji,iice) + (subsnowveg(ji) - snow(ji))
+         ELSE  
+            vevapnu(ji) = vevapnu(ji) + (subsnowveg(ji) - snow(ji))
+            warnings(ji) = .TRUE.
+            any_warning = .TRUE.
+         ENDIF
+
+         ! Sublimation is thus limited to what is available
+         subsnowveg(ji) = snow(ji)
+         snow(ji) = zero
+         vevapsno(ji) = subsnowveg(ji) + subsnownobio(ji,iice)
+      ELSE 
+         snow(ji) = snow(ji) - subsnowveg(ji)
+      ENDIF
+    ENDDO
+    IF ( any_warning ) THEN
+       WRITE(numout,*)' ATTENTION on prend de l eau au sol nu sur au moins un point car evapsno est trop fort!'
+!!$       DO ji=1,kjpindex
+!!$          IF ( warnings(ji) ) THEN
+!!$             WRITE(numout,*)' ATTENTION on prend de l eau au sol nu car evapsno est trop fort!'
+!!$             WRITE(numout,*)' ',ji,'   vevapnu (en mm/jour) = ',vevapnu(ji)*one_day/dt_sechiba
+!!$          ENDIF
+!!$       ENDDO
+    ENDIF
+    
+    warnings(:) = .FALSE.
+    any_warning = .FALSE.
+    DO ji=1,kjpindex
+      
+      ! 2.3. snow melt only if temperature positive
+      IF (temp_sol_new(ji).GT.tp_00) THEN 
+         
+         IF (snow(ji).GT.sneige) THEN 
+            
+            snowmelt(ji) = (un - frac_nobio(ji,iice))*(temp_sol_new(ji) - tp_00) * soilcap(ji) / chalfu0 
+            
+            ! 2.3.1 enough snow for melting or not
+            IF (snowmelt(ji).LT.snow(ji)) THEN 
+               snow(ji) = snow(ji) - snowmelt(ji)
+            ELSE 
+               snowmelt(ji) = snow(ji)
+               snow(ji) = zero
+            END IF
+            
+         ELSEIF (snow(ji).GE.zero) THEN 
+            
+            ! 2.3.2 not enough snow
+            snowmelt(ji) = snow(ji)
+            snow(ji) = zero
+         ELSE 
+            
+            ! 2.3.3 negative snow - now snow melt
+            snow(ji) = zero
+            snowmelt(ji) = zero
+            warnings(ji) = .TRUE.
+            any_warning = .TRUE.
+            
+         END IF
+
+      ENDIF
+    ENDDO
+    IF ( any_warning ) THEN
+       DO ji=1,kjpindex
+          IF ( warnings(ji) ) THEN
+             WRITE(numout,*) 'hydrolc_snow: WARNING! snow was negative and was reset to zero for point ',ji,'. '
+          ENDIF
+       ENDDO
+    ENDIF
+    
+
+      
+    !! 2.4 Snow melts above a threshold
+    ! Ice melt only if there is more than a given mass : maxmass_snow,
+    ! But the snow cannot melt more in one time step to what corresponds to
+    ! a 1K cooling. This will lead to a progressive melting of snow above
+    ! maxmass_snow but it is needed as a too strong cooling can destabilise the model.
+    DO ji=1,kjpindex
+       IF ( snow(ji) .GT. maxmass_snow ) THEN
+          snow_d1k = un * soilcap(ji) / chalfu0
+          snowmelt(ji) = snowmelt(ji) + MIN((snow(ji) - maxmass_snow),snow_d1k)
+          snow(ji) = snow(ji) - snowmelt(ji)
+          IF ( printlev >= 3 ) WRITE (numout,*) "Snow was above maxmass_snow (", maxmass_snow,") and we melted ", snowmelt(ji)
+       ENDIF
+    END DO
+    
+   !! 3. On Land ice
+    
+    DO ji=1,kjpindex
+      
+      !! 3.1. It is snowing
+      snow_nobio(ji,iice) = snow_nobio(ji,iice) + frac_nobio(ji,iice)*precip_snow(ji) + &
+           & frac_nobio(ji,iice)*precip_rain(ji)
+      
+      !! 3.2. Sublimation - was calculated before it can give us negative snow_nobio but that is OK
+      !      Once it goes below a certain values (-maxmass_snow for instance) we should kill
+      !      the frac_nobio(ji,iice) !
+      snow_nobio(ji,iice) = snow_nobio(ji,iice) - subsnownobio(ji,iice)
+      
+      !! 3.3. snow melt only for continental ice fraction
+      snowmelt_tmp = zero
+      IF (temp_sol_new(ji) .GT. tp_00) THEN 
+         
+         ! 3.3.1 If there is snow on the ice-fraction it can melt 
+         snowmelt_tmp = frac_nobio(ji,iice)*(temp_sol_new(ji) - tp_00) * soilcap(ji) / chalfu0
+         
+         IF ( snowmelt_tmp .GT. snow_nobio(ji,iice) ) THEN
+             snowmelt_tmp = MAX( zero, snow_nobio(ji,iice))
+         ENDIF
+         snowmelt(ji) = snowmelt(ji) + snowmelt_tmp
+         snow_nobio(ji,iice) = snow_nobio(ji,iice) - snowmelt_tmp
+         
+      ENDIF
+      
+      !! 3.4 Snow melts over a threshold
+      !   Ice melt only if there is more than a given mass : maxmass_snow, 
+      !   But the snow cannot melt more in one time step to what corresponds to
+      !   a 1K cooling. This will lead to a progressive melting of snow above
+      !   maxmass_snow but it is needed as a too strong cooling can destabilise the model.
+      !
+      IF ( snow_nobio(ji,iice) .GT. maxmass_snow ) THEN
+         snow_d1k = un * soilcap(ji) / chalfu0
+         icemelt(ji) = MIN((snow_nobio(ji,iice) - maxmass_snow),snow_d1k)
+         snow_nobio(ji,iice) = snow_nobio(ji,iice) - icemelt(ji)
+         
+         IF ( printlev >= 3 ) WRITE (numout,*) "Snow was above maxmass_snow ON ICE (", maxmass_snow,") and we melted ", icemelt(ji)
+      ENDIF
+      
+    END DO
+
+    
+  !! 4. On other surface types - not done yet
+  
+    IF ( nnobio .GT. 1 ) THEN
+      WRITE(numout,*) 'WE HAVE',nnobio-1,' SURFACE TYPES I DO NOT KNOW'
+      CALL ipslerr_p (3,'hydrolc_snow', '', &
+ &         'CANNOT TREAT SNOW ON THESE SURFACE TYPES', '')
+    ENDIF
+
+    
+  !! 5. computes total melt (snow and ice)
+ 
+
+    DO ji = 1, kjpindex
+      tot_melt(ji) = icemelt(ji) + snowmelt(ji)
+    ENDDO
+ 
+  !! 6. computes snow age on veg and ice (for albedo)
+    
+    DO ji = 1, kjpindex
+      
+      !! 6.1 Snow age on vegetation
+      IF (snow(ji) .LE. zero) THEN
+        snow_age(ji) = zero
+      ELSE
+        snow_age(ji) =(snow_age(ji) + (un - snow_age(ji)/max_snow_age) * dt_sechiba/one_day) &
+          & * EXP(-precip_snow(ji) / snow_trans)
+      ENDIF
+      
+      !! 6.2 Snow age on ice
+      ! age of snow on ice: a little bit different because in cold regions, we really
+      ! cannot negect the effect of cold temperatures on snow metamorphism any more.
+      IF (snow_nobio(ji,iice) .LE. zero) THEN 
+        snow_nobio_age(ji,iice) = zero
+      ELSE
+      
+        d_age(ji) = ( snow_nobio_age(ji,iice) + &
+                    &  (un - snow_nobio_age(ji,iice)/max_snow_age) * dt_sechiba/one_day ) * &
+                    &  EXP(-precip_snow(ji) / snow_trans) - snow_nobio_age(ji,iice)
+        IF (d_age(ji) .GT. zero ) THEN
+          xx(ji) = MAX( tp_00 - temp_sol_new(ji), zero )
+          xx(ji) = ( xx(ji) / 7._r_std ) ** 4._r_std
+          d_age(ji) = d_age(ji) / (un+xx(ji))
+        ENDIF
+        snow_nobio_age(ji,iice) = MAX( snow_nobio_age(ji,iice) + d_age(ji), zero )
+      
+      ENDIF
+
+    ENDDO
+
+  !! 7. Diagnose the depth of the snow layer
+
+    DO ji = 1, kjpindex
+      snowdepth(ji) = snow(ji) /sn_dens
+    ENDDO
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrolc_snow done '
+
+  END SUBROUTINE hydrolc_snow
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE      : hydrolc_canop 
+!!
+!>\BRIEF           This routine computes the water budget of the canopy interception reservoir. 
+!!
+!! DESCRIPTION     : The first sequence is to withdraw interception loss from the interception 
+!! reservoir, with independent values for each PFT. The reservoir loading happens afterwards. 
+!! Rain falls uniformly over the PFTs. It uniformly loads the canopy interception 
+!! reservoir of each PFT, up to the interception capacity, but a fraction of rainfall always falls to the ground.
+!! Throughfall is thus comprised of the fraction that always falls through, plus the remining fraction of rainfall that 
+!! exceeds the interception capacity, the interception loss having been removed. 
+!! \latexonly
+!! \input{interception.tex}
+!! \endlatexonly
+!! 
+!! IMPORTANT NOTE : Bare soil treatment is complex in hydrolc :
+!!  - veget_max(:,1) is the fraction of bare soil from the "annual" vegetation map 
+!!  - veget(:,1) is not the fraction of vegetation over bare soil but the total fraction of bare soil in the grid-cell 
+!! (including the bare soil fractions over the vegetation PFTs). 
+!! *** A diagram should be added in the spatial entry of the "umbrella"
+!!  - For interception to be zero on bare soil, we thus need to impose qsintmax(:,1)=0
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : precisol (throughfall), qsintveg (amount of water in the canopy interception reservoir)
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================  
+
+  SUBROUTINE hydrolc_canop (kjpindex, precip_rain, vevapwet, veget, qsintmax, tot_bare_soil, qsintveg, precisol)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                           :: kjpindex           !! Domain size (number of grid cells) (unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)        :: precip_rain        !! Rainfall @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)    :: vevapwet           !! Interception loss over each PFT 
+                                                                               !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)    :: veget              !! Grid-cell fraction effectively covered by 
+                                                                               !! vegetation for each PFT, except for soil 
+                                                                               !! (0-1, unitless) 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)    :: qsintmax           !! Maximum amount of water in the canopy 
+                                                                               !! interception reservoir @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)        :: tot_bare_soil      !! Total evaporating bare soil fraction 
+   
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)   :: precisol           !! Throughfall @tex ($kg m^{-2}$) @endtex
+
+    !! 0.3  Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: qsintveg           !! Amount of water in the canopy interception 
+                                                                               !! reservoir @tex ($kg m^{-2}$) @endtex
+    
+    !! 0.4 Local variabless
+  
+    INTEGER(i_std)                                       :: ji, jv             !! Grid-cell and PFT indices (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm)                :: zqsintvegnew       !! Temporary variable for intercepted water 
+                                                                               !! amount  @tex ($kg m^{-2}$) @endtex 
+
+!_ ================================================================================================================================
+
+    ! calcul de qsintmax a prevoir a chaque pas de temps
+    ! dans ini_sechiba
+    ! boucle sur les points continentaux
+    ! calcul de qsintveg au pas de temps suivant
+    ! par ajout du flux interception loss
+    ! calcule par enerbil en fonction
+    ! des calculs faits dans diffuco
+    ! calcul de ce qui tombe sur le sol
+    ! avec accumulation dans precisol
+    ! essayer d'harmoniser le traitement du sol nu
+    ! avec celui des differents types de vegetation
+    ! fait si on impose qsintmax ( ,1) = 0.0
+    !
+    ! loop for continental subdomain
+    !
+
+    !
+    ! 1. evaporation off the continents
+    !
+    ! 1.1 The interception loss is take off the canopy. 
+
+    DO jv=1,nvm
+      qsintveg(:,jv) = qsintveg(:,jv) - vevapwet(:,jv)
+    END DO
+
+    ! 1.2 It is raining : precip_rain is shared for each vegetation
+    ! type
+    !     sum (veget (1,nvm)) must be egal to 1-totfrac_nobio.
+    !     iniveget computes veget each day
+    !
+    DO jv=1,nvm
+      ! Correction Nathalie - Juin 2006 - une partie de la pluie arrivera toujours sur le sol
+      ! sorte de throughfall supplementaire
+      !qsintveg(:,jv) = qsintveg(:,jv) + veget(:,jv) * precip_rain(:)
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+       IF (jv .EQ. 1) THEN
+          qsintveg(:,jv) = qsintveg(:,jv) + tot_bare_soil(:) * ((1-throughfall_by_pft(jv))*precip_rain(:))
+       ELSE
+          qsintveg(:,jv) = qsintveg(:,jv) + veget(:,jv) * ((1-throughfall_by_pft(jv))*precip_rain(:))
+       ENDIF
+    END DO
+
+    !
+    ! 1.3 Limits the effect and sum what receives soil
+    !
+    precisol(:,:) = zero
+    DO jv=1,nvm
+      DO ji = 1, kjpindex
+        zqsintvegnew(ji,jv) = MIN (qsintveg(ji,jv),qsintmax(ji,jv)) 
+        ! correction throughfall Nathalie - Juin 2006
+        !precisol(ji,jv) = qsintveg(ji,jv ) - zqsintvegnew (ji,jv)
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+        IF (jv .EQ. 1) THEN
+           precisol(ji,jv) = (tot_bare_soil(ji)*throughfall_by_pft(jv)*precip_rain(ji)) + qsintveg(ji,jv ) - zqsintvegnew (ji,jv)
+        ELSE
+           precisol(ji,jv) = (veget(ji,jv)*throughfall_by_pft(jv)*precip_rain(ji)) + qsintveg(ji,jv ) - zqsintvegnew (ji,jv)
+        ENDIF
+      ENDDO
+    ENDDO
+    !
+    ! 1.4 swap qsintveg to the new value
+    !
+
+    DO jv=1,nvm
+      qsintveg(:,jv) = zqsintvegnew (:,jv)
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrolc_canop done '
+
+  END SUBROUTINE hydrolc_canop
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrolc_vegupd 
+!!
+!>\BRIEF        This subroutines works at adapting the distribution of water
+!! in the soil and interception reservoirs between the different soil columns when the vegetation 
+!! fraction of the PFTs (veget) has changed in slowproc.  
+!!
+!! DESCRIPTION  : Different vegetation changes are allowed in ORCHIDEE:\n 
+!!  - veget_max can be updated annually in slowproc (dynamic vegetation or prescribed vegetation change)\n
+!!  - veget can be updated daily in slowproc (because of changes in veget_max or depending on LAI)
+!!
+!! This subroutine aims at adapting the distribution of water among the different liquid water reservoirs 
+!! (interception reservoir and soil moisture) after these changes of veget :
+!! - the variable veget holds the "new" vegetation map
+!! - the variable resdist holds the previous vegetation map 
+!! *** I see no flag or time step dependance to control the call to vegupd : is it called at each time step ?
+!!
+!! The principle is that PFTs where "veget" has shrunk keep the same water contents in kg.m^{-2},
+!! whereas the water contents are increased in PFTs where "veget" has grown.
+!! *** I still have questions about redistribution to interception reservoirs which have shrunk
+!! *** and about thresholding to the reservoirs' capacities (is it ensured that the capacities are not exceeded ?)
+!! You may note that this occurs after evaporation and so on have been computed. It is not a 
+!! problem as a new vegetation fraction will start with humrel=0 and thus will have no evaporation. 
+!! If this is not the case it should have been caught above.
+!! 
+!! IMPORTANT NOTE : the definition of veget is not simple :
+!!  - for the non-bare soil PFTs (iv > 2), veget is the fraction effectively covered by 
+!! vegetation : veget \f$\le\f$ veget_max\n
+!!  - for the bare soil PFT (iv=1), veget holds the fraction of bare soil, from all 
+!! PFTs : veget(:,1) \f$\ge\f$ veget_max(:,1)\n
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S) : qsintveg, gqsb, bqsb, dsg, dss, dsp, resdist
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART   : None
+!! \n
+!_ ================================================================================================================================  
+  
+  SUBROUTINE hydrolc_vegupd(kjpindex, veget, tot_bare_soil, ruu_ch, qsintveg, gqsb, bqsb, dsg, dss, dsp, resdist)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+ 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex   !! Domain size (number of grid cells) (unitless)
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in)       :: veget      !! Grid-cell fraction effectively covered by vegetation 
+                                                                           !! for each PFT, except for soil (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: tot_bare_soil !! Total evaporating bare soil fraction    
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: ruu_ch     !! Volumetric soil water capacity 
+                                                                           !! @tex ($kg m^{-3}$) @endtex
+
+    !! 0.2 Output variables
+
+    !! 0.3  Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)  :: qsintveg      !! Water on vegetation due to interception
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: gqsb       !! Water content in the top layer 
+                                                                           !! @tex ($kg m^{-2}$) @endtex    
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: bqsb       !! Water content in the bottom layer 
+                                                                           !! @tex ($kg m^{-2}$) @endtex     
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: dsg        !! Depth of the top layer (m)   
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: dss        !! Depth of dry soil at the top, whether in the top or
+                                                                           !! bottom layer (m)   
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: dsp        !! Depth of dry soil in the bottom layer plus depth of
+                                                                           !! top layer (m) 
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(inout)    :: resdist    !! Previous values of "veget" (0-1, unitless)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                :: ji,jv                 !!  Grid-cell and PFT indices (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm)           :: qsintveg2            !! Ancillary qsintveg @tex ($kg m^{-2}$) @endtex  
+    REAL(r_std), DIMENSION (kjpindex,nvm)          :: bdq, gdq             !! Changes in surface and bottom soil layer water 
+                                                                           !! content @tex ($kg m^{-2}; positive$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nvm)          :: qsdq                 !! Changes in interception reservoir water content  
+                                                                           !! @tex ($kg m^{-2}; positive$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nvm)          :: vmr                  !! Variation of "veget" since previous values 
+                                                                           !! (-1,1; unitless)
+    REAL(r_std), DIMENSION(kjpindex)               :: gtr                  !! Total water mass to redistribute between the top 
+                                                                           !! layers of a grid-cell @tex ($kg m^{-2}; positive) 
+                                                                           !! @ endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: btr                  !! Total water mass to redistribute between the bottom
+                                                                           !! layers of a grid-cell @tex ($kg m^{-2}; positive) 
+                                                                           !! @ endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: vtr                  !! Total fraction  over which "veget" has decreased 
+                                                                           !! (dimensionless; positive)
+    REAL(r_std), DIMENSION(kjpindex)               :: qstr                 !! Total water mass to redistribute between the 
+                                                                           !! interception reservoirs of a grid-cell 
+                                                                           !! @tex ($kg m^{-2}; positive$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: fra                  !! Weight for redistribution (dimensionless; negative)
+    REAL(r_std), DIMENSION(kjpindex) :: vegchtot                           !! Total change of "veget" in the grid-point 
+                                                                           !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), PARAMETER                         :: EPS1 = EPSILON(un)   !! Very small (scalar) *** why not use min_sechiba ?
+!_ ================================================================================================================================ 
+    
+  !! 1. vmr is the change in veget in the different PFTs
+
+    ! vmr is the change in veget in the different PFTs
+    ! (dimensionless; negative if the new "veget" is smaller, i.e. if the PFT has shrunk)
+    ! By construction, the algebraic sum of vmr in a grid-cell is zero
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+         IF (jv .EQ. 1) THEN 
+            IF ( ABS(tot_bare_soil(ji)-resdist(ji,jv)) .GT. EPS1 ) THEN
+               vmr(ji,jv) = tot_bare_soil(ji)-resdist(ji,jv)
+            ELSE
+               vmr(ji,jv) = zero
+            ENDIF
+         ELSE
+            IF ( ABS(veget(ji,jv)-resdist(ji,jv)) .GT. EPS1 ) THEN
+               vmr(ji,jv) = veget(ji,jv)-resdist(ji,jv)
+            ELSE
+               vmr(ji,jv) = zero
+            ENDIF
+         ENDIF
+  !! 2. qsintveg2 is the intercepted water in mm 
+
+        ! qsintveg2 is the intercepted water in mmif the total volume 
+        ! was redistributed over the previous "veget" fractions 
+        ! This the distribution of intercepted water that needs to be 
+        ! changed if "veget" changes 
+
+         IF (resdist(ji,jv) .GT. zero) THEN
+            qsintveg2(ji,jv) = qsintveg(ji,jv)/resdist(ji,jv)
+         ELSE
+            qsintveg2(ji,jv) = zero
+         ENDIF
+      ENDDO
+    ENDDO
+
+
+ !! 3. vegchtot is the total change of "veget" in the grid-points
+
+    ! vegchtot is the total change of "veget" in the grid-points, 
+    ! integrated over the PFTs (vegchtot in kg m^{-2})
+    ! It is the sum of the absolute values of changes, it may thus 
+    ! be larger than 1 : it serves as a flag of change in each grid-point
+    vegchtot(:) = zero
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+        vegchtot(ji) = vegchtot(ji) + ABS( vmr(ji,jv) )
+      ENDDO
+    ENDDO
+    
+
+  !! 4. In the grid-points with "veget" change, we define changes in water content
+    
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+        IF ( vegchtot(ji) .GT. zero ) THEN
+
+           ! change in surface soil layer water content @tex ($kg m^{-2}$) @endtex
+          gdq(ji,jv) = ABS(vmr(ji,jv)) * gqsb(ji,jv)
+
+          ! change in bottom soil layer water content @tex ($kg m^{-2}$) @endtex
+          bdq(ji,jv) = ABS(vmr(ji,jv)) * bqsb(ji,jv)
+
+          ! change in interception reservoir water content  @tex ($kg m^{-2}$) @endtex
+          qsdq(ji,jv) = ABS(vmr(ji,jv)) * qsintveg2(ji,jv)
+        ENDIF
+      ENDDO
+    ENDDO
+
+  !! 5. Total water mass to redistribute in a grid-point = sum of water changes from PFTs where "veget" decreases
+
+    !  Calculate the total water mass that we need to redistribute by grid-point, for each water reservoir
+    !  We sum up the water changes from PFTs where "veget" decreases : this is the water that needs to be redistributed
+    !  vtr is the total fraction  over which "veget" has decreased (> 0)
+    !  By construction, it is balanced by the total fraction where "veget" has increased
+
+    gtr(:) = zero
+    btr(:) = zero
+    qstr(:) = zero
+    vtr(:) = zero
+    !
+    !
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+        IF ( ( vegchtot(ji) .GT. zero ) .AND. ( vmr(ji,jv) .LT. zero ) ) THEN
+          gtr(ji) = gtr(ji) + gdq(ji,jv)
+          btr(ji) = btr(ji) + bdq(ji,jv)
+          qstr(ji) = qstr(ji) + qsdq(ji,jv) 
+
+          ! vtr is necessarily le 0 since we enter here only if vmr <0
+          vtr(ji) = vtr(ji) - vmr(ji,jv)
+        ENDIF
+      ENDDO
+    ENDDO
+   
+
+!! 6. Put the water to redistribute from the PFTs that "shrank" into the PFTs that "growed"
+
+    !     In doing so, water contents are kept constant in PFTs that shrank, and they increase in PFTs that growed
+    !     fra is the weight for that redistribution, scaled to vtr which is the total amount to redistribute 
+    !  *** Feasability of the redistribution : it doesn't seem to be checked ???
+    !  *** In the soil, if the water capacities are constant between PFTs, it's OK ;this is the default for wmax_veg in 
+    !  *** constantes_veg.f90
+    !  *** But qsintmax is different between PFTsand also evolves in time : how is this managed ???
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+
+        ! "veget" changed
+        IF ( vegchtot(ji) .GT. zero .AND. ABS(vtr(ji)) .GT. EPS1) THEN
+
+            ! negative when vmr positive, thus in the condition below 
+            fra(ji) = vmr(ji,jv) / vtr(ji)
+
+            ! the PFT growed, thus its water contents must be updated
+             IF ( vmr(ji,jv) .GT. zero)  THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+              IF (jv .EQ. 1) THEN
+                 IF (tot_bare_soil(ji) .GT. zero) THEN
+                    gqsb(ji,jv) = (resdist(ji,jv)*gqsb(ji,jv) + fra(ji)*gtr(ji))/tot_bare_soil(ji)
+                    bqsb(ji,jv) = (resdist(ji,jv)*bqsb(ji,jv) + fra(ji)*btr(ji))/tot_bare_soil(ji)
+                 ENDIF
+              ELSE
+                 IF (veget(ji,jv) .GT. zero) THEN
+                    gqsb(ji,jv) = (resdist(ji,jv)*gqsb(ji,jv) + fra(ji)*gtr(ji))/veget(ji,jv)
+                    bqsb(ji,jv) = (resdist(ji,jv)*bqsb(ji,jv) + fra(ji)*btr(ji))/veget(ji,jv)
+                 ENDIF
+              ENDIF
+              qsintveg(ji,jv) = qsintveg(ji,jv) + fra(ji)* qstr(ji)
+             ELSE
+
+              ! vmr negative *** I don't understand why we remove water from the interception reservoir in PFTs which shrank
+              qsintveg(ji,jv) = qsintveg(ji,jv) - qsdq(ji,jv)
+             ENDIF
+
+             ! Then we update the soil layers depths.
+             ! But we do not  change dss, so that the redistribution does directly affect transpiration
+             ! constantes : min_sechiba = 1.E-8_r_std
+             IF (gqsb(ji,jv) .LT. min_sechiba) THEN
+                dsg(ji,jv) = zero
+             ELSE
+                dsg(ji,jv) = (dss(ji,jv) * ruu_ch(ji) + gqsb(ji,jv)) &
+                             / ruu_ch(ji)
+             ENDIF
+             dsp(ji,jv) = zmaxh - bqsb(ji,jv) / ruu_ch(ji)
+        ENDIF
+      ENDDO
+    ENDDO
+
+
+    !! 7. We update resdist for the next "veget" change
+    
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+    resdist(:,1) = tot_bare_soil(:)
+    DO jv = 2, nvm
+       resdist(:,jv) = veget(:,jv)
+    ENDDO
+
+
+  !! 8. Where vegetation fraction is zero, set water to that of bare soil.
+
+    !   This does not create any additional water.
+    DO jv = 2, nvm
+      DO ji = 1, kjpindex
+        IF ( veget(ji,jv) .LT. EPS1 ) THEN
+          gqsb(ji,jv) = gqsb(ji,1)
+          bqsb(ji,jv) = bqsb(ji,1)
+          dsg(ji,jv) = dsg(ji,1)
+          dss(ji,jv) = dss(ji,1)
+          dsp(ji,jv) = dsp(ji,1)
+        ENDIF
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE hydrolc_vegupd
+
+!! ================================================================================================================================
+!! SUBROUTINE            : hydrolc_flood
+!!
+!>\BRIEF                   this routine computes the evolution of the surface reservoir (floodplain)
+!!
+!! DESCRIPTION           : 
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S) : floodout
+!!
+!! REFERENCE(S) : Same as for module hydrolc
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrolc_flood (kjpindex, vevapnu, vevapflo, flood_frac, flood_res, floodout)
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex 
+    ! input fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: flood_frac       !! Fraction of floodplains in grid box
+    ! modified fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: floodout         !! Flux to take out from floodplains
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: flood_res        !! Floodplains reservoir estimate
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapnu          !! Bare soil evaporation
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapflo         !! Floodplains evaporation
+    ! local declaration
+    INTEGER(i_std)                                          :: ji, jst, jv       !! indices
+    REAL(r_std)                                              :: k_m              !! conductivity in the soil
+    REAL(r_std)                                              :: temp             !! 
+
+!_ ================================================================================================================================
+
+    !- 
+    !- 1. Take out vevapflo from the reservoir and transfer the remaining to vevapnu 
+    !-
+    DO ji = 1,kjpindex
+       temp = MIN(flood_res(ji), vevapflo(ji))
+       flood_res(ji) = flood_res(ji) - temp
+       vevapnu(ji) = vevapnu(ji) + vevapflo(ji) - temp
+       vevapflo(ji) = temp
+    ENDDO
+
+    !- 
+    !- 2. Compute the total flux from floodplain floodout (transfered to routing) 
+    !-
+    DO ji = 1,kjpindex
+       floodout(ji) = vevapflo(ji) - flood_frac(ji) * SUM(precisol(ji,:))
+    ENDDO
+
+    !-
+    !- 3. Discriminate between precip over land and over floodplain
+    !-
+    DO jv=1, nvm
+       DO ji = 1,kjpindex
+          precisol(ji,jv) = precisol(ji,jv) * (1 - flood_frac(ji))
+       ENDDO
+    ENDDO 
+
+    IF (printlev>=3) WRITE (numout,*) ' hydrolc_flood done'
+
+  END SUBROUTINE hydrolc_flood
+
+!! ================================================================================================================================
+!! SUBROUTINE      : hydrolc_soil
+!!
+!>\BRIEF           This routines computes the soil water budget and the related soil water 
+!! fluxes and soil moisture diagnostics using the two-layer Choisnel scheme.
+!!
+!! DESCRIPTION     : 
+!!
+!! 1. Main processes: The Choisnel scheme relies on two soil layers. 
+!! As show in the figure below, the upper one has a variable depth 
+!! and can disappear after dry spells. It is created by infiltration (of throughfall or snow melt), 
+!! in which case the layer is saturated. If this top layer is already present, infiltration can either 
+!! fill it or make it deeper (DucoudrÃ© et al., 1993). 
+!! \latexonly
+!! \includegraphics[scale = 0.5]{choisnelvariables.pdf}
+!! \endlatexonly
+!!
+!! In this framework, most water fluxes updating soil moisture act from top:\n
+!!  - throughfall, melted snow and ice, and irrigation increase soil moisture (of the top layer if present);
+!!  - transpiration and bare soil evaporation reduce soil moisture (of the top layer if present);
+!!  - return flow from rivers increases bottom soil moisture. \n
+!!
+!! Soil moisture stress on bare soil evaporation and transpiration (for diffuco), vegetation growth and 
+!! litter processes (for stomate), proceed respectively via a soil resistance (rsol), and three soil 
+!! moisture stress factor (humrel, vegstress, and litterhumdiag), which are all controlled by the 
+!! height of dry soil at the top of soil: \n
+!! - Soil moisture stress factor on transpiration and bare soil evaporation: humrel = \f$U_s\f$ \n
+!! \latexonly
+!! \input{humrel.tex}
+!! \endlatexonly \n
+!! - Resistance to bare soil evaporation: rsol = \f$r_\mathrm{soil}\f$ \n
+!! \latexonly
+!! \input{rsol.tex}
+!! \endlatexonly
+!!
+!! Runoff is only produced when the entire soil column is saturated, as in the bucket 
+!! scheme of Manabe (1969). Drainage at the bottom of soil and surface runoff are only diagnosed,  
+!! mostly for use in the routing module, using a constant 95% - 5% redistribution (Ngo-Duc et al., 2005).
+!! Internal drainage is allowed from the top to the bottom layer, following Ducharne et al. (1998).
+!! \latexonly
+!! \input{gdrainage.tex}
+!! \endlatexonly
+!!
+!! Irrigation (de Rosnay et al., 2003) and return flow are optional inflows, calculated by the 
+!! routing scheme (Ngo-Duc et al., 2005; Guimberteau, 2010).
+!! 
+!! 2. Subgrid variability:
+!! The subgrid variability of soil is described by introducing as many soil columns as PFTs 
+!! (de Rosnay & Polcher, 1998). The water budget is performed independently in each PFT/soil 
+!! column, but the bottom soil moisture is merged between all PFTs at the end of the calculations.
+!! Therefore, vegetation withdraws from a shared bottom moisture (grid-cell weighted average).
+!! There can also be horizontal diffusion between the top layers, if the flag ok_hdiff is true (the default value 
+!! is false). This is performed in the subroutine hydrolc_hdiff, call after the present subroutine.
+!!
+!! The areas of each soil column are defined by veget (the vegetation fraction of the PFTs),
+!! and not by veget_max (the maximum area of the PFT defined annually in slowproc). 
+!! As veget can change at a daily time step, a redistribution of water between the soil 
+!! columns is required : this is done in hydrolc_vegupd.
+!! 
+!! 3. Water budget issues :
+!! Different issues can arise when solving the above processes :
+!!  - negative total soil moisture (tracked using flag warning, but no action taken, cf. 4)
+!!  - dsg > dsp after merging the bottom layers, solved iteratively (6.2)
+!!  - we may also have a pathological behavior of rsol if hdry > dpu_cste (8.4)
+!!
+!! 4. Diagnostics for other subroutines: humrel for diffuco (7.1), vegstress for stomate (8.1),
+!! shumdiag for stomate (8.2), drysoil_frac for condveg (8.3), rsol for diffuco (8.4), 
+!! litterhumdiag for stomate (8.5).
+!!
+!! MAIN OUTPUT VARIABLE(S) : rsol, drysoil_frac, hdry,  
+!! run_off_tot (surface runoff), drainage, humrel, vegstress, shumdiag, litterhumdiag
+!! gqsb, bqsb, dsg, dss, dsp 
+!!
+!! REFERENCE(S) :
+!!  - DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp. 248-273.
+!!  - Ducharne, A. Laval, K. and Polcher, J. (1998) Sensitivity of the hydrological cycle to the parameterization 
+!! of soil hydrology in a GCM. Climate Dynamics, 14:307-327.
+!!  - de Rosnay, P. and Polcher J. (1998) Modeling root water uptake in a complex land surface scheme coupled 
+!! to a GCM. Hydrology and Earth System Sciences, 2(2-3):239-256.
+!!  - de Rosnay, P., Polcher, J., Laval, K. et Sabre, M. (2003). Integrated parameterization of irrigation in
+!! the land surface model ORCHIDEE. Validation over Indian Peninsula. Geophys. Res. Lett, 30(19):HLS2-1 -
+!! HLS2-4.
+!!  - Ngo-Duc, T., J. Polcher, and K. Laval (2005), A 53-year forcing data set for land surface models, 
+!! J. Geophys. Res., 110, D06116.
+!!  - ALMA : http://www.lmd.jussieu.fr/~polcher/ALMA/
+!!  - DucoudrÃ©, N. (1990). Sensibilite du climat simule a la parametrisation des echanges de vapeur d'eau entre 
+!! la biosphere et l'atmosphere. These de Doctorat, UniversitÃ© Paris 6.
+!!  - Ducharne A (1997). Le cycle de l'eau : modelisation de l'hydrologie continentale, etude de ses interactions 
+!! avec le climat, These de Doctorat, UniversitÃ© Paris 6.
+!!  - de Rosnay, P. (1999). Representation des interactions sol-plante-atmosphere dans le modele de circulation generale
+!! du LMD. These de doctorat, UniversitÃ© Paris 6.
+!!  - Guimberteau, M, 2010. Modelisation de l'hydrologie continentale et influences de l'irrigation sur le cycle de l'eau, 
+!! These de doctorat, UniversitÃ© Paris 6.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+    
+
+  SUBROUTINE hydrolc_soil(kjpindex, vevapnu, precisol, returnflow, reinfiltration, irrigation, tot_melt, mx_eau_var, &
+       & veget, tot_bare_soil, ruu_ch, transpir,&
+       & gqsb, bqsb, dsg, dss, rsol, drysoil_frac, hdry, dsp, run_off_tot, drainage, &
+       & humrel, vegstress, shumdiag, litterhumdiag)
+     
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+ 
+    INTEGER(i_std), INTENT(in)                          :: kjpindex       !! Domain size (number of grid cells) (unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: vevapnu        !! Bare soil evaporation  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)   :: precisol       !! Throughfall  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: returnflow     !! Routed water which comes back into the soil 
+                                                                          !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: reinfiltration !! Water returning to the top reservoir
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: irrigation     !! Irrigation water applied to soils 
+                                                                          !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: tot_melt       !! Total melt @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: mx_eau_var     !! Maximum water content of the soil 
+                                                                          !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in)  :: veget          !! Grid-cell fraction effectively covered by vegetation 
+                                                                          !! for each PFT, except for soil (0-1, unitless) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: tot_bare_soil  !! Total evaporating bare soil fraction    
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: ruu_ch         !! Volumetric soil water capacity 
+                                                                          !! @tex ($kg m^{-3}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)   :: transpir       !! Transpiration over each PFT @tex ($kg m^{-2}$) @endtex 
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: run_off_tot    !! Diagnosed surface runoff  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: drainage       !! Diagnosed drainage at the bottom of soil
+                                                                          !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out) :: humrel         !! Soil moisture stress factor on transpiration and bare
+                                                                          !! soil evaporation (0-1, unitless) ! Relative humidity
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out) :: vegstress      !! Vegetation moisture stress (only for vegetation
+                                                                          !!  growth) (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out) :: shumdiag       !! Mean relative soil moisture in the different levels 
+                                                                          !! used by thermosoil.f90 (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: litterhumdiag  !! Litter humidity factor (0-1, unitless), used in 
+                                                                          !! stomate
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: rsol           !! Resistance to bare soil evaporation (s m^{-1}) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: drysoil_frac   !! Fraction of visible dry soil  (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: hdry           !! Mean top dry soil height (m) version beton
+
+    !! 0.3  Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout):: gqsb           !! Water content in the top layer 
+                                                                          !! @tex ($kg m^{-2}$) @endtex              
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout):: bqsb           !! Water content in the bottom layer 
+                                                                          !! @tex ($kg m^{-2}$) @endtex     
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout):: dsg            !! Depth of the top layer (m) 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout):: dss            !! Depth of dry soil at the top, whether in the top or 
+                                                                          !! bottom layer (m)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout):: dsp            !! Depth of dry soil in the bottom layer plus depth of
+                                                                          !! top layer (m) 
+    
+    !! 0.4 Local variables
+   
+    INTEGER(i_std)                                      :: ji,jv, jd      !! Indices for grid-cells, PFTs and diagnostic levels in
+                                                                          !! the soil (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm)                :: runoff         !! Total runoff @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)                    :: zhumrel_lo     !! Soil moisture stress factors on transpiration for the
+                                                                          !! bottom and top layers (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: zhumrel_up     !! Soil moisture stress factors on transpiration for the
+                                                                          !! bottom and top layers (0-1, unitless)    
+    REAL(r_std), DIMENSION(kjpindex,nvm)                :: zeflux         !! Evaporation to be withdrawn from soil 
+                                                                          !! @tex ($kg m^{-2}) @endtex ! *** why divided by veget ?
+    REAL(r_std), DIMENSION(kjpindex,nvm)                :: zpreci         !! Throughfall @tex ($kg m^{-2}$) @endtex  
+                                                                          !! ! *** why divided by veget ?
+    LOGICAL, DIMENSION(kjpindex,nvm)                    :: warning        !! To track negative total soil moisture cases in soil 
+                                                                          !! columns (true/false)
+    REAL(r_std)                                         :: gtr, btr       !! Fractions of top and botttom soil layers to the 
+                                                                          !! different diagnostic soil layers (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: mean_dsg       !! Mean depth of water in top soil layer (m)
+    LOGICAL                                             :: OnceMore       !! To repeat the correction to solve dsg > dsp after 
+                                                                          !! diffusion between the bottom layers (true/false)
+    INTEGER(i_std), PARAMETER                           :: nitermax = 100 !! Maximum number of iterations to dsg > dsp after 
+                                                                          !! diffusion between the bottom layers (unitless) 
+    INTEGER(i_std)                                      :: niter          !! Counter of iterations to solve dsg > dsp after 
+                                                                          !! diffusion between the bottom layers (unitless) 
+    INTEGER(i_std)                                      :: nbad           !! Number of negative total soil moisture cases 
+                                                                          !! (unitless); this is before diffusion between the 
+                                                                          !! bottom layers, cf. "warning" ***
+    LOGICAL, DIMENSION(kjpindex,nvm)                    :: lbad           !! Tags "bad" PFTs where dsg > dsp after diffusion 
+                                                                          !! between the bottom layers (true/false)
+    LOGICAL, DIMENSION(kjpindex)                        :: lbad_ij        !! Tags "bad" grid-points where at least one PFT exhibits
+                                                                          !!  dsg > dsp after diffusion between the bottom layers 
+                                                                          !! (true/false) 
+    REAL(r_std)                                         :: gqseuil        !! Ancillary variables to compute drainage between the 
+                                                                          !! two soil layers @tex ($kg m^{-2}$) @endtex
+    REAL(r_std)                                         :: eausup         !! Ancillary variables to compute drainage between the 
+                                                                          !! two soil layers @tex ($kg m^{-2}$) @endtex
+    REAL(r_std)                                         :: wd1            !! Ancillary variables to compute drainage between the 
+                                                                          !! two soil layers @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nbdl+1)                      :: tmp_dl         !! Temporary diagnostic levels in the soil (m)
+    REAL(r_std), DIMENSION(kjpindex,nvm)                :: a_subgrd       !! Diagnosed subgrid fraction of saturated soil in the 
+                                                                          !! top layer, to calculate hdry (0-1, unitless)
+!_ ================================================================================================================================
+    
+  !! 1. Preliminary calculations
+    
+    !!  We define input and output fluxes at the soil surface, for each PFT
+    !!  The input flux is throughfall.
+    !!  The ouput flux is the total evaporation withdrawn from the soil (transpiration and bare soil evaporation, BSE)
+    ! *** I don't understand why the fluxes are divided by veget if they are in kg.m^{-2} within each PFT *** 
+    DO jv=1,nvm
+      DO ji = 1, kjpindex
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+         IF (jv .EQ. 1) THEN
+            IF ( tot_bare_soil(ji) .GT. zero ) THEN
+               zeflux(ji,jv) = transpir(ji,jv)/tot_bare_soil(ji)
+               zpreci(ji,jv) = precisol(ji,jv)/tot_bare_soil(ji)
+            ELSE
+               zeflux(ji,jv) = zero
+               zpreci(ji,jv) = zero
+            ENDIF
+         ELSE
+            IF ( veget(ji,jv) .GT. zero ) THEN
+               zeflux(ji,jv) = transpir(ji,jv)/veget(ji,jv)
+               zpreci(ji,jv) = precisol(ji,jv)/veget(ji,jv)
+            ELSE
+               zeflux(ji,jv) = zero
+               zpreci(ji,jv) = zero
+            ENDIF
+         ENDIF
+      ENDDO
+    ENDDO
+    
+    !!  For bare soil evaporation, we need to distinguish two cases. 
+    !!  This should only apply if there is vegetation but we do not test this case.
+    !!  Case 1 - if bare soil is present, BSE is extracted from the bare soil fraction
+    DO ji = 1, kjpindex
+      IF ( (vegtot(ji) .GT. zero) .AND. (tot_bare_soil(ji) .GT. min_sechiba) ) THEN
+        zeflux(ji,1) = vevapnu(ji)/tot_bare_soil(ji)
+      ENDIF
+    ENDDO
+
+    !!   Case 2 - if bare soil is not present, BSE is uniformly redistributed among the vegetation fractions
+    !!   This case is possible because of transfers (snow for instance). 
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+    DO jv = 2, nvm
+      DO ji = 1, kjpindex
+        IF ( (vegtot(ji) .GT. zero) .AND. (tot_bare_soil(ji) .LE. min_sechiba)&
+             & .AND. (veget(ji,jv) .GT. min_sechiba)) THEN
+          zeflux(ji,jv) =  zeflux(ji,jv) + vevapnu(ji)/vegtot(ji)
+        ENDIF
+      ENDDO
+    ENDDO
+    
+    ! Temporary diagnostic levels in the soil to diagnose shumdiag
+    tmp_dl(1) = 0
+    tmp_dl(2:nbdl+1) = diaglev(1:nbdl)
+
+  !! 2. Updating soil moisture
+
+    !!  We update soil moisture:
+    !!  The top soil moisture reacts to evaporation, throughfall, snow and ice melt, and inflow from irrigation
+    !!  The bottom soil moisture can receive returnflow from routing.f90
+    DO jv=1,nvm
+      DO ji=1,kjpindex
+      
+        ! Evaporated water is taken out of the ground
+        gqsb(ji,jv) = gqsb(ji,jv) - zeflux(ji,jv)
+        !
+        ! 1.2 Add snow and ice melt, troughfall from vegetation, reinfiltration and irrigation.
+        !
+        IF(vegtot(ji) .NE. zero) THEN
+
+           !  snow and ice melt, reinfiltration and troughfall from vegetation
+           gqsb(ji,jv) = gqsb(ji,jv) + zpreci(ji,jv) + (tot_melt(ji)+reinfiltration(ji))/vegtot(ji)
+           
+           ! We take care to add the irrigation only to the vegetated part if possible
+           !
+           IF (ABS(vegtot(ji)-tot_bare_soil(ji)) .LE. min_sechiba) THEN
+              gqsb(ji,jv) = gqsb(ji,jv) + irrigation(ji)/vegtot(ji)
+           ELSE
+
+              ! no vegetation, : we only add irrigation in the PFTs where vegetation can grow  
+              IF ( jv > 1 ) THEN
+
+                 ! Only add the irrigation to the upper soil if there is a reservoir.
+                 ! Without this the water evaporates right away.
+                 IF ( gqsb(ji,jv) > zero ) THEN
+                    gqsb(ji,jv) = gqsb(ji,jv) + irrigation(ji)/(vegtot(ji)-tot_bare_soil(ji))
+                 ELSE
+                    bqsb(ji,jv) = bqsb(ji,jv) + irrigation(ji)/(vegtot(ji)-tot_bare_soil(ji))
+                 ENDIF
+              ENDIF
+           ENDIF
+           
+           ! We add the water returning from rivers to the lower reservoir.
+           bqsb(ji,jv) = bqsb(ji,jv) + returnflow(ji)/vegtot(ji)
+           
+        ENDIF
+        
+      END DO
+    ENDDO
+    
+  !! 3. We compute runoff and adjust the soil layers' depth and water content
+
+    !!     The depth of top dry soil, dss, is of particular importance as it controls the soil moisture stresses 
+    !!     to transpiration and BSE     
+    runoff(:,:) = zero
+    
+    warning(:,:) = .FALSE.
+    DO jv=1,nvm
+      DO ji = 1, kjpindex
+        
+        !! 3.1 Soil moisture in excess of total water holding capacity runs off
+        runoff(ji,jv) = MAX(gqsb(ji,jv) + bqsb(ji,jv) - mx_eau_var(ji), zero)
+        
+        !! 3.2 If the soil is saturated (runoff is generated): no top layer; dss = dsp 
+        IF (mx_eau_var(ji) .LE. (gqsb(ji,jv) + bqsb(ji,jv))) THEN
+            !
+            gqsb(ji,jv) = zero
+            dsg(ji,jv) = zero
+            bqsb(ji,jv) = mx_eau_var(ji)
+            dsp(ji,jv) = zero
+            dss(ji,jv) = dsp (ji,jv)
+
+        ELSEIF ((gqsb(ji,jv) + bqsb(ji,jv)).GE.zero) THEN
+            
+            !! 3.3 Else, if the top layer holds more water than allowed by its depth, the top layer deepens
+            !! The top layer is saturated, so that dss=0.
+            !! In this case, dsp is useless, and is not updated, 
+            !! even if bqsb has changed because of irrigation and return flow.
+            IF (gqsb(ji,jv) .GT. dsg(ji,jv) * ruu_ch(ji)) THEN
+                !
+                dsg(ji,jv) = gqsb(ji,jv) / ruu_ch(ji)
+                dss(ji,jv) = zero
+            ELSEIF (gqsb(ji,jv) .GT. zero ) THEN
+ 
+            !! 3.4 If the top layer is not saturated, its total depth does not change and we only update its dry soil depth
+            !! In this case, dsp is useless, and is not updated, 
+            !! even if bqsb has changed because of irrigation and return flow.
+                !
+                dss(ji,jv) = ((dsg(ji,jv) * ruu_ch(ji)) - gqsb(ji,jv)) / ruu_ch(ji) 
+            ELSE
+
+            !! 3.5 If the top layer's moisture is negative, it vanishes and the required moisture is withdrawn from the bottom layer
+            !! dsp is updated accordingly, and defines the depth of top dray soil dss.
+                !
+                bqsb(ji,jv) = bqsb(ji,jv) + gqsb(ji,jv)
+                dsp(ji,jv) = zmaxh - bqsb(ji,jv) / ruu_ch(ji) ! dsp>dpu if bqsb<0 *** we can be here with bsqb<0 and bqsb+gqsb>0
+                gqsb(ji,jv) = zero
+                dsg(ji,jv) = zero
+                dss(ji,jv) = dsp(ji,jv)
+            END IF
+
+        ELSE 
+
+        !! 3.6 If the total soil moisture is negative: we keep track of the problem for further warning.
+        !! In this extreme case of dry soil, the top layer is absent.
+        !! The top dry soil depth, dsp, is equal to the soil depth.
+        !! But we keep the negative moisture for water budget closure, and assign it to the bottom layer.
+        ! Ceci ne devrait jamais arriver plus d'une fois par point. C-a-d une fois la valeur negative
+        ! atteinte les flux doivent etre nuls. On ne signale que ce cas donc. 
+        ! *** But this is obviously not the case in CMIP5 runs ***
+        ! *** Also, I don't see the use of conditionning upon zeflux(ji,jv) .GT. zero : negative moisture is always a problem !
+            
+            IF ( ( zeflux(ji,jv) .GT. zero ) .AND. &
+                 ( gqsb(ji,jv) + bqsb(ji,jv) .LT. -1.e-10 ) ) THEN
+               warning(ji,jv) = .TRUE.
+
+               ! WRITE (numout,*) 'WARNING! Soil Moisture will be negative' 
+               ! WRITE (numout,*) 'ji, jv = ', ji,jv
+               ! WRITE (numout,*) 'mx_eau_var = ', mx_eau_var(ji)
+               ! WRITE (numout,*) 'veget, resdist =', veget(ji,jv), resdist(ji,jv)
+               ! WRITE (numout,*) 'bqsb = ', bqsb(ji,jv)
+               ! WRITE (numout,*) 'gqsb = ', gqsb(ji,jv)
+               ! WRITE (numout,*) 'dss = ', dss(ji,jv)
+               ! WRITE (numout,*) 'dsg = ', dsg(ji,jv)
+               ! WRITE (numout,*) 'dsp = ', dsp(ji,jv)
+               ! WRITE (numout,*) 'humrel = ', humrel(ji, jv)
+               ! WRITE (numout,*) 'Soil evaporation = ', zeflux(ji,jv)
+               ! WRITE (numout,*) 'input = ',precisol(ji, jv), tot_melt(ji)
+               ! WRITE (numout,*) '============================'
+            ENDIF
+
+            
+            bqsb(ji,jv) = gqsb(ji,jv) + bqsb(ji,jv) ! this will be negative 
+            dsp(ji,jv) = zmaxh
+            gqsb(ji,jv) = zero
+            dsg(ji,jv) = zero
+            dss(ji,jv) = dsp(ji,jv)
+            
+        ENDIF
+        
+      ENDDO
+    ENDDO
+    
+  !! 4. If there are some PFTs with negative moisture, it is written in the run log
+    
+    nbad = COUNT( warning(:,:) .EQV. .TRUE. )
+    IF ( nbad .GT. 0 ) THEN
+      WRITE(numout,*) 'hydrolc_soil: WARNING! Soil moisture was negative at', &
+                       nbad, ' points:'
+      !DO jv = 1, nvm
+      !  DO ji = 1, kjpindex
+      !    IF ( warning(ji,jv) ) THEN
+      !      WRITE(numout,*) '  ji,jv = ', ji,jv
+      !      WRITE (numout,*) 'mx_eau_var = ', mx_eau_var(ji)
+      !      WRITE (numout,*) 'veget, resdist =', veget(ji,jv), resdist(ji,jv)
+      !      WRITE (numout,*) 'bqsb = ', bqsb(ji,jv)
+      !      WRITE (numout,*) 'gqsb = ', gqsb(ji,jv)
+      !      WRITE (numout,*) 'runoff = ',runoff(ji,jv)
+      !      WRITE (numout,*) 'dss = ', dss(ji,jv)
+      !      WRITE (numout,*) 'dsg = ', dsg(ji,jv)
+      !      WRITE (numout,*) 'dsp = ', dsp(ji,jv)
+      !      WRITE (numout,*) 'humrel = ', humrel(ji, jv)
+      !      WRITE (numout,*) 'Soil evaporation = ', zeflux(ji,jv)
+      !      WRITE (numout,*) 'Soil precipitation = ',zpreci(ji,jv)
+      !      WRITE (numout,*) 'input = ',precisol(ji, jv), tot_melt(ji)
+      !      WRITE (numout,*) 'returnflow = ',returnflow(ji)
+      !      WRITE (numout,*) '============================'
+      !    ENDIF
+      !  ENDDO
+      !ENDDO
+    ENDIF
+    
+  !! 5. Top layers that are very large or very dry can be deadlock situations for the Choisnel scheme
+ 
+    !!  Top layers that are very large or that hold a tiny amount of water .
+    !!  They are handled here.
+    IF (printlev>=3) WRITE(numout,*)  'hydro_soil 2.0 : Resolve deadlocks'
+    DO jv=1,nvm
+      DO ji=1,kjpindex
+        
+        !! 5.1 If the top layer is almost dry, we merge the two layers 
+        IF ( ABS(dsp(ji,jv)-dsg(ji,jv)) .LT. min_sechiba ) THEN ! min_sechiba = 1.e-8 (constantes.f90)
+            bqsb(ji,jv) = bqsb(ji,jv) + gqsb(ji,jv)
+            dsp(ji,jv) = zmaxh - bqsb(ji,jv) / ruu_ch(ji) ! *** can this make dsp > dpu_cste
+            gqsb(ji,jv) = zero
+            dsg(ji,jv) = zero
+            dss(ji,jv) = dsp(ji,jv)
+        ENDIF
+        
+        !!  5.2 Internal drainage from the top to the bottom layer
+        !!   Much faster when the relative moisture of the top layer exceeds 75\% of the water holding capacity.
+        !!   The parameters are exp_drain = 1.5, min_drain = 0.002 mm/h and max_drain = 0.2 mm/h
+        gqseuil = min_sechiba * deux * ruu_ch(ji) ! min_sechiba = 1.e-8 (constantes.f90)
+        eausup = dsg(ji,jv) * ruu_ch(ji)
+        wd1 = .75*eausup
+        
+        IF (eausup .GT. gqseuil) THEN ! dsg > 2.e-8 m
+            gdrainage(ji,jv) = min_drain *  (gqsb(ji,jv)/eausup)
+            
+            IF ( gqsb(ji,jv) .GE. wd1 .AND. dsg(ji,jv) .GT. 0.10 ) THEN
+                
+                gdrainage(ji,jv) = gdrainage(ji,jv) + &
+                   (max_drain-min_drain)*((gqsb(ji,jv)-wd1) / (eausup-wd1))**exp_drain
+                
+            ENDIF
+            
+            gdrainage(ji,jv)=MIN(gdrainage(ji,jv), MAX(gqsb(ji,jv), zero))
+            
+        ELSE
+            gdrainage(ji,jv)=zero ! *** why not remove the top layer in that case ?? 
+        ENDIF
+        !
+        gqsb(ji,jv) = gqsb(ji,jv) -  gdrainage(ji,jv)
+        bqsb(ji,jv) = bqsb(ji,jv) + gdrainage(ji,jv)
+        dsg(ji,jv) = dsg(ji,jv) -  gdrainage(ji,jv) / ruu_ch(ji)
+        dsp(ji,jv) = zmaxh - bqsb(ji,jv)/ruu_ch(ji) ! *** this line shouldn't make dsp>dpu_cste
+      ENDDO
+    ENDDO
+    
+  !! 6. We want the vegetation to share a common bottom moisture:
+    !! Thus, we must account for moisture diffusion between the soil columns.
+    IF (printlev>=3) WRITE(numout,*)  'hydrolc_soil 3.0 : Vertical diffusion'
+
+    !!  6.1 Average of bottom and top moisture over the "veget" fractions
+    mean_bqsb(:) = zero
+    mean_gqsb(:) = zero
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+        IF ( vegtot(ji) .GT. zero ) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+           IF (jv .EQ. 1) THEN
+              mean_bqsb(ji) = mean_bqsb(ji) + tot_bare_soil(ji)/vegtot(ji)*bqsb(ji,jv)
+              mean_gqsb(ji) = mean_gqsb(ji) + tot_bare_soil(ji)/vegtot(ji)*gqsb(ji,jv)
+           ELSE
+              mean_bqsb(ji) = mean_bqsb(ji) + veget(ji,jv)/vegtot(ji)*bqsb(ji,jv)
+              mean_gqsb(ji) = mean_gqsb(ji) + veget(ji,jv)/vegtot(ji)*gqsb(ji,jv)
+           ENDIF
+        ENDIF
+      ENDDO
+    ENDDO
+    
+    OnceMore = .TRUE.
+    niter = 0
+    lbad_ij(:)=.TRUE. 
+    DO WHILE ( OnceMore .AND. ( niter .LT. nitermax ) )  ! nitermax prevents infinite loops (should actually never occur)
+      
+      niter = niter + 1
+      
+      !! 6.2 We assign the mean value in all the soil columns in a grid-cell
+      DO jv = 1, nvm
+        DO ji = 1, kjpindex
+           IF (lbad_ij(ji)) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+              IF (jv .EQ. 1) THEN
+                 IF (tot_bare_soil(ji).GT.zero) THEN
+                    !
+                    bqsb(ji,jv) = mean_bqsb(ji)
+                    dsp(ji,jv) = zmaxh - bqsb(ji,jv)/ruu_ch(ji)
+                 ENDIF
+              ELSE IF ( veget(ji,jv) .GT. zero ) THEN
+                 !
+                 bqsb(ji,jv) = mean_bqsb(ji)
+                 dsp(ji,jv) = zmaxh - bqsb(ji,jv)/ruu_ch(ji) ! *** can this line make dsp>dpu_cste ?
+              ENDIF
+           ENDIF
+           
+        ENDDO
+      ENDDO    
+      
+      !! 6.3 Iterative adjustment if top layer larger than new average dsp
+      !! After averaging the bottom moistures, dsp becomes the mean depth of soil that is not filled by bottom moisture.
+      !! In "bad" points where dsg > dsp, we merge the two soil layers.
+      !! This adjustment needs to be done iteratively (WHILE loop)     
+      !! We diagnose the bad points where dsg>dsp
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+!!$      lbad(:,:) = ( ( dsp(:,:) .LT. dsg(:,:) ) .AND. &
+!!$                    ( dsg(:,:) .GT. zero ) .AND. &
+!!$                    ( veget(:,:) .GT. zero ) )
+      lbad(:,:) = ( ( dsp(:,:) .LT. dsg(:,:) ) .AND. &
+                    ( dsg(:,:) .GT. zero ) )
+      DO jv = 1, nvm
+         DO ji = 1, kjpindex
+            IF (jv .EQ. 1) THEN
+               lbad(ji,jv) = lbad(ji,jv) .AND. ( tot_bare_soil(ji) .GT. zero )
+            ELSE
+               lbad(ji,jv) = lbad(ji,jv) .AND. ( veget(ji,jv) .GT. zero )
+            ENDIF
+         ENDDO
+      ENDDO
+
+      
+      !! If there are no such points, we'll do no further iteration 
+      IF ( COUNT( lbad(:,:) ) .EQ. 0 ) OnceMore = .FALSE.
+      DO ji = 1, kjpindex
+        IF (COUNT(lbad(ji,:)) == 0 ) lbad_ij(ji)=.FALSE.
+      ENDDO
+      
+      !! In the bad PFTs, we merge the two soil layers.
+      DO jv = 1, nvm
+!YM
+!        !
+!        DO ji = 1, kjpindex
+!          IF ( veget(ji,jv) .GT. zero ) THEN
+!            !
+!            bqsb(ji,jv) = mean_bqsb(ji)
+!            dsp(ji,jv) = zmaxh - bqsb(ji,jv)/ruu_ch(ji)
+!          ENDIF
+!          !
+!        ENDDO
+        !
+        DO ji = 1, kjpindex
+          IF ( lbad(ji,jv) ) THEN
+            !
+            runoff(ji,jv) = runoff(ji,jv) + &
+                            MAX( bqsb(ji,jv) + gqsb(ji,jv) - mx_eau_var(ji), zero)
+            !
+            bqsb(ji,jv) = MIN( bqsb(ji,jv) + gqsb(ji,jv), mx_eau_var(ji))
+            !
+            gqsb(ji,jv) = zero
+            dsp(ji,jv) = zmaxh - bqsb(ji,jv)/ruu_ch(ji)  ! *** could this line make dsp>dpu_cste ? 
+                                                           ! *** set a max to dpu_cste to be sure !
+            dss(ji,jv) = dsp(ji,jv)
+            dsg(ji,jv) = zero
+            
+          ENDIF
+        ENDDO
+      ENDDO  
+      
+      !! New average of bottom and top moisture over the "veget" fractions, for the next iteration
+      mean_bqsb(:) = zero
+      mean_gqsb(:) = zero
+      DO jv = 1, nvm
+        DO ji = 1, kjpindex
+          IF ( vegtot(ji) .GT. zero ) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+             IF (jv .EQ. 1) THEN
+                mean_bqsb(ji) = mean_bqsb(ji) + tot_bare_soil(ji)/vegtot(ji)*bqsb(ji,jv)
+                mean_gqsb(ji) = mean_gqsb(ji) + tot_bare_soil(ji)/vegtot(ji)*gqsb(ji,jv)
+             ELSE
+                mean_bqsb(ji) = mean_bqsb(ji) + veget(ji,jv)/vegtot(ji)*bqsb(ji,jv)
+                mean_gqsb(ji) = mean_gqsb(ji) + veget(ji,jv)/vegtot(ji)*gqsb(ji,jv)
+             ENDIF
+          ENDIF
+        ENDDO
+      ENDDO
+      
+    ENDDO ! end while, but no warning if nitermax has been reached ***
+    
+  !! 7. Compute total runoff from all soil columns and partition it into drainage and surface runoff
+
+    ! *** why isn't run_off_tot divided by vegtot ?
+    IF (printlev>=3) WRITE(numout,*)  'hydrolc_soil 4.0: Computes total runoff'
+
+    !! 7.1 Average total runoff
+    run_off_tot(:) = zero
+    DO ji = 1, kjpindex
+       IF ( vegtot(ji) .GT. zero ) THEN
+          run_off_tot(ji) = runoff(ji,1)*tot_bare_soil(ji) + SUM(runoff(ji,2:nvm)*veget(ji,2:nvm))
+       ELSE
+          run_off_tot(ji) = tot_melt(ji) + irrigation(ji) + reinfiltration(ji)
+       ENDIF
+    ENDDO
+    
+    !! 7.2 Diagnose drainage and surface runoff (95% and 5%)
+    drainage(:) = 0.95 * run_off_tot(:)
+    run_off_tot(:) = run_off_tot(:) - drainage(:)       
+    ! *** from now on, we lost track of total runoff
+    ! *** the name "run_off_tot" is VERY misleading
+    
+  !! 8. Diagnostics which are needed to carry information to other modules:
+
+    IF (printlev>=3) WRITE(numout,*)  'hydro_soil 5.0: Diagnostics'
+    
+    ! Reset dsg if necessary
+    WHERE (gqsb(:,:) .LE. zero) dsg(:,:) = zero
+    
+    ! Average moisture profile for shumdiag
+    DO ji=1,kjpindex
+      mean_dsg(ji) = mean_gqsb(ji)/ruu_ch(ji) ! mean depth of water in top layer in meters
+    ENDDO
+    
+    !! 8.1 Moisture stress factors on vegetation (humrel and vegstress)
+    !! Moisture stress factors on vegetation:
+    !!  - "humrel" on transpiration (for condveg) exponentially decreases with top dry soil depth;
+    !!  the decay factor is the one of root density with depth (from 1 to 8 depending on PFTs),
+    !!  following de Rosnay and Polcher (1998) 
+    !!  - "vegstress" on vegetation growth (for stomate) 
+    IF (printlev>=3) WRITE(numout,*)  'hydro_soil 6.0 : Moisture stress'
+
+    a_subgrd(:,:) = zero
+
+    DO jv = 1, nvm
+      DO ji=1,kjpindex
+         !
+         ! computes relative surface humidity
+         !
+         ! Only use the standard formulas if total soil moisture is larger than zero.
+         ! Else stress functions are set to zero. 
+         ! This will avoid that large negative soil moisture accumulate over time by the
+         ! the creation of small skin reservoirs which evaporate quickly.
+         !
+         IF ( gqsb(ji,jv)+bqsb(ji,jv) .GT. zero ) THEN
+            !
+            IF (dsg(ji,jv).EQ. zero .OR. gqsb(ji,jv).EQ.zero) THEN
+               humrel(ji,jv) = EXP( - humcste(jv) * zmaxh * (dsp(ji,jv)/zmaxh) )
+               dsg(ji,jv) = zero
+                   
+               ! humrel = 0 if dsp is larger than its value at the wilting point, or if the bottom layer's soil is negative
+               ! *** the condition based on qwilt (= 5.0) doesn't make much sense: (i) the Choisnel scheme works in available  
+               ! *** moisture, i.e. above wilting point (Ducharne & Laval, 2000), so that the moisture at withing point is ZERO; 
+               ! *** (ii) with the chosen values in constantes_soil.f90, qwilt/ruu_ch is around 0.033 and dpu_cste-qwilt/ruu_ch
+               ! *** is around dpu
+               IF (dsp(ji,jv).GT.(zmaxh - min_sechiba) .OR. bqsb(ji,jv).LT.zero) THEN
+                  humrel(ji,jv) = zero
+               ENDIF
+
+               vegstress(ji,jv) = humrel(ji,jv)
+               
+            ELSE
+
+               !! 8.1.2 If there are two soil layers, we need the "transpiring" fraction "a_subgrd"
+               !! We compute humrel as the average of the values defined by dss and dsp.
+	       !! The weights depend on "a_subgrd", which is defined by redistributing the top layer's 
+	       !! moisture in a virtual layer of depth dsg_min (set to 1 mm in hydrolc), 
+               !! what defines a totally dry and a totally saturated fraction (a_subgrd):
+               !!  - if the top layer's moisture > 1mm, then a_subgrd=1, and the humrel is normally deduced from dss only
+               !!  - if the top layer's moisture is very small, a_subgrd decreases from 1 to 0 as the top layer's moisture 
+               !!    vanishes, and it serves to describe a smooth transition to the case where the top soil layer has
+               !!    vanished and humrel depends on dsp.
+               !! \latexonly
+ 	       !! \includegraphics[scale = 1]{asubgrid.pdf}
+               !! \endlatexonly
+               !
+               zhumrel_lo(ji) = EXP( - humcste(jv) * dsp(ji,jv)) 
+               zhumrel_up(ji) = EXP( - humcste(jv) * dss(ji,jv))
+               a_subgrd(ji,jv)=MIN(MAX(dsg(ji,jv)-dss(ji,jv),zero)/dsg_min,un)
+               humrel(ji,jv)=a_subgrd(ji,jv)*zhumrel_up(ji)+(un-a_subgrd(ji,jv))*zhumrel_lo(ji)
+               
+               !! As we need a slower variable for vegetation growth, vegstress is computed differently from humrel.
+               ! *** la formule ci-dessous est d'un empirisme absolu : on ajoute deux stresses, on en retranche un autre...????
+               ! que veut dire slower variable ??
+               vegstress(ji,jv) = zhumrel_lo(ji) + zhumrel_up(ji) - EXP( - humcste(jv) * dsg(ji,jv) ) 
+               
+            ENDIF
+            
+         ELSE 
+ 
+            !! 8.1.3 If total moisture is negative, the two moisture stress factors are set to zero. 
+            !! This should avoid that large negative soil moisture accumulate over time because of small skin layers
+            !! which transpire quickly.
+            ! *** Yet, CMIP5 exhibits such behaviors => because of rsol ?? or other reasons ?? The routing shouldn't 
+            ! *** create such situations, but couldn't some patches here or there ???
+            humrel(ji,jv) = zero
+            vegstress(ji,jv) = zero
+            
+         ENDIF
+        !
+      ENDDO
+    ENDDO
+    
+    !! 8.2 Mean relative soil moisture in the diagnostic soil levels: shumdiag (for thermosoil)
+    !! It is deduced from the mean moisture and depth of the two soil layers in the grid cell,
+    !! depending on how the soil diagnostic levels intersect the two mean soil depths
+    DO jd = 1,nbdl
+      DO ji = 1, kjpindex
+         IF ( tmp_dl(jd+1) .LT. mean_dsg(ji)) THEN ! mean_dsg = mean depth of water in top layer in meters
+
+            ! If the diagnostic soil level entirely fits into the mean top soil layer depth, they have the same 
+            ! relative moisture
+            shumdiag(ji,jd) = mean_gqsb(ji)/mx_eau_var(ji)
+         ELSE 
+            IF ( tmp_dl(jd) .LT. mean_dsg(ji)) THEN
+
+               ! If the diagnostic soil level intersects both soil layers, its relative moisture is the weighted
+               ! mean of the ones of two soil layers
+               gtr = (mean_dsg(ji)-tmp_dl(jd))/(tmp_dl(jd+1)-tmp_dl(jd))
+               btr = 1 - gtr
+               shumdiag(ji,jd) = gtr*mean_gqsb(ji)/mx_eau_var(ji) + &
+                    & btr*mean_bqsb(ji)/mx_eau_var(ji)
+            ELSE
+
+               ! If the diagnostic soil level entirely fits into the mean bottom soil layer depth,
+               ! they have the same relative moisture 
+               shumdiag(ji,jd) = mean_bqsb(ji)/mx_eau_var(ji)
+            ENDIF
+         ENDIF
+         shumdiag(ji,jd) = MAX(MIN(shumdiag(ji,jd), un), zero)
+      ENDDO
+    ENDDO
+
+    !! 8.3 Fraction of visibly dry soil in the bare soil fraction for soil albedo
+    !!  if we want to account for its dependance on soil moisture in condveg.
+    !!  We redistribute the top layer's moisture in a virtual layer of depth 0.1 m,
+    !!  what defines a totally saturated and a totally dry fraction (drysoil_frac). 
+    !!  The latter is thus 1 if dss > 0.1 m. 
+    drysoil_frac(:) = MIN(MAX(dss(:,1),zero)*10._r_std, un)
+
+    !! 8.4 Resistance to bare soil evaporation
+    !!  This resistance increases with the height of top dry soil, described by hdry.
+    !!  It depends on both dss and dsp (dry soil heights) in the bare soil fraction, 
+    !!  and, as for the soil moisture stress factor on transpiration (humrel), 
+    !!  we use "a_subgrd" (see 8.1.2) to describe a smooth transition between cases 
+    !!  when the top layer's moisture > 1mm and hdry=dss and cases when the top layer's 
+    !!  has vanished and hdy=dsp. 
+    !!  The relationship between rsol and dry soil height has been changed since 
+    !!  de Rosnay and Polcher (1998), to make rsol becomes VERY large when hdry 
+    !!  gets close to dpu_cste 
+    !!  Owing to this non-linear dependance, BSE tends to zero when the depth of dry reaches dpu_cste.
+    ! *** if hdry > dpu (several cases might lead to this pathological situation), 
+    ! *** we shift to the other limb of the hyperbolic function, and rsol decreases towards hdry*rsol_cste 
+    ! *** can this explain the accumulation of very negative soil moisture in arid zones in CMIP5 ???
+    ! *** COULD'NT WE SIMPLY SET THAT hdry CANNOT EXCEED dpu_cste ???
+    hdry(:) = a_subgrd(:,1)*dss(:,1) + (un-a_subgrd(:,1))*dsp(:,1) 
+    
+    rsol(:) = -un
+    DO ji = 1, kjpindex
+       IF (tot_bare_soil(ji) .GE. min_sechiba) THEN
+          
+          ! Correction Nathalie - le 28 mars 2006 - sur conseils Fred Hourdin
+          ! on modifie le rsol pour que la resistance croisse subitement si on s'approche
+          ! du fond. En gros, rsol=hdry*rsol_cste pour hdry < 1m70
+          !rsol(ji) = dss(ji,1) * rsol_cste
+          rsol(ji) =  ( hdry(ji) + un/(10.*(zmaxh - hdry(ji))+1.e-10)**2 ) * rsol_cste
+       ENDIF
+    ENDDO
+    
+    !! 8.5 Litter humidity factor, used in stomate
+    !!  It varies from 1 when mean top dry soil height is 0, and decreases as mean top dry soil height increases
+    litterhumdiag(:) = EXP( - hdry(:) / hcrit_litter ) ! hcrit_litter=0.08_r_std
+
+    !!  Special case of it has just been raining a few drops: the top layer exists, but its height 
+    !!  is ridiculously small and the mean top dry soil height is almost zero: we assume a dry litter 
+    WHERE ( ( hdry(:) .LT. min_sechiba ) .AND. &  ! constantes : min_sechiba = 1.E-8_r_std
+            ( mean_dsg(:) .GT. min_sechiba ) .AND. ( mean_dsg(:) .LT. 5.E-4 ) )
+      litterhumdiag(:) = zero
+    ENDWHERE
+    
+    IF (printlev>=3) WRITE (numout,*) ' hydrolc_soil done '
+
+  END SUBROUTINE hydrolc_soil
+  
+
+  SUBROUTINE hydrolc_waterbal_init (kjpindex, qsintveg, snow, snow_nobio)
+    
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT (in)                            :: kjpindex       !! Domain size (number of grid cells) (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)      :: qsintveg       !! Amount of water in the canopy interception 
+                                                                             !! reservoir @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: snow           !! Snow water equivalent @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(in)   :: snow_nobio     !! Snow water equivalent on nobio areas  
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    !! 0.4 Local variables
+    INTEGER(i_std)                                         :: ji, jv, jn
+    REAL(r_std),DIMENSION (kjpindex)                       :: watveg         !! Total amount of intercepted water in a grid-cell
+    REAL(r_std),DIMENSION (kjpindex)                       :: sum_snow_nobio !! Total amount of snow from the "nobio" fraction 
+                                                                             !! in a grid-cell @tex ($kg m^{-2}$) @endtex 
+!_ ================================================================================================================================
+
+  !! 1. We initialize the total amount of water in terrestrial grid-cells at the beginning of the first time step
+    
+    tot_water_beg(:) = zero
+    watveg(:) = zero
+    sum_snow_nobio(:) = zero
+    
+    DO jv = 1, nvm
+       watveg(:) = watveg(:) + qsintveg(:,jv)
+    ENDDO
+    
+    DO jn = 1, nnobio ! nnobio=1
+       sum_snow_nobio(:) = sum_snow_nobio(:) + snow_nobio(:,jn)
+    ENDDO
+    
+    DO ji = 1, kjpindex
+       tot_water_beg(ji) = (mean_bqsb(ji) + mean_gqsb(ji))*vegtot(ji) + &
+            &  watveg(ji) + snow(ji) + sum_snow_nobio(ji)
+    ENDDO
+    tot_water_end(:) = tot_water_beg(:)
+    
+  END SUBROUTINE hydrolc_waterbal_init
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrolc_waterbal 
+!!
+!>\BRIEF        This subroutine checks the water balance closure in each terrestrial grid-cell
+!! over a time step.
+!!
+!! DESCRIPTION  : The change in total water amount over the time step must equal the algebraic sum of the  
+!! water fluxes causing the change, integrated over the timestep. The equality is checked to some precision, 
+!! set for double precision calculations (REAL*8). Note that this precision depends on the time step.
+!! This verification does not make much sense in REAL*4 as the precision is the same as some of the fluxes.
+!! The computation is only done over the soil area, as over glaciers (and lakes?) we do not have 
+!! water conservation. 
+!! *** The above sentence is not consistent with what I understand from the code, since snow_nobio is accounted for.
+!! *** what is the value of epsilon(1) ?
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : None
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================   
+  
+  SUBROUTINE hydrolc_waterbal (kjpindex, index, veget, totfrac_nobio, qsintveg, snow, snow_nobio,&
+       & precip_rain, precip_snow, returnflow, reinfiltration, irrigation, tot_melt, vevapwet, transpir, vevapnu,&
+       & vevapsno, vevapflo, floodout, run_off_tot, drainage)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                            :: kjpindex       !! Domain size (number of grid cells) (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)       :: index          !! Indices of the points on the map
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)      :: veget          !! Grid-cell fraction effectively covered by 
+                                                                             !! vegetation for each PFT, except for soil 
+                                                                             !! (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: totfrac_nobio  !! Total fraction of terrestrial ice+lakes+...
+                                                                             !! (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)      :: qsintveg       !! Amount of water in the canopy interception 
+                                                                             !! reservoir @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: snow           !! Snow water equivalent @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout):: snow_nobio     !! Snow water equivalent on nobio areas  
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+									     ! Ice water balance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: precip_rain    !! Rainfall @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: precip_snow    !! Snowfall  @tex ($kg m^{-2}$) @endtex  
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: returnflow     !! Routed water which comes back into the soil 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: reinfiltration !! Water returning from routing to the top reservoir
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: irrigation     !! Irrigation water applied to soils 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: tot_melt       !! Total melt @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)      :: vevapwet       !! Interception loss over each PFT 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)      :: transpir       !! Transpiration over each PFT 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: vevapnu        !! Bare soil evaporation @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: vevapflo       !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: vevapsno       !! Snow evaporation @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: floodout       !! Outflow from floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: run_off_tot    !! Diagnosed surface runoff @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: drainage       !! Diagnosed rainage at the bottom of soil  
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    
+    !! 0.2 Output variables
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                         :: ji, jv, jn     !!  Grid-cell, PFT and "nobio" fraction indices 
+                                                                             !! (unitless)
+    REAL(r_std)                                            :: allowed_err    !! Allowed error in the water budget closure 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                       :: watveg         !! Total amount of intercepted water in a grid-cell  
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                       :: delta_water    !! Change in total water amount 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                       :: tot_flux       !! Algebraic sum of the water fluxes integrated over 
+                                                                             !! the timestep @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                       :: sum_snow_nobio !! Total amount of snow from the "nobio" fraction 
+                                                                             !! in a grid-cell @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                       :: sum_vevapwet   !! Sum of interception loss in the grid-cell 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                       :: sum_transpir   !! Sum of  transpiration in the grid-cell 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+!_ ================================================================================================================================
+
+  !! 1. We check the water balance : this is done at the end of a time step
+    tot_water_end(:) = zero
+    
+    !! 1.1 If the "nobio" fraction does not complement the "bio" fraction, we issue a warning
+    !!   If the "nobio" fraction (ice, lakes, etc.) does not complement the "bio" fraction (vegetation and bare soil),
+    !!   we do not need to go any further, and we output a warning ! *** how are oceans treated ?
+    DO ji = 1, kjpindex
+
+       ! Modif Nathalie
+       ! IF ( (un - (totfrac_nobio(ji) + vegtot(ji))) .GT. EPSILON(un) ) THEN
+       IF ( (un - (totfrac_nobio(ji) + vegtot(ji))) .GT. (100*EPSILON(un)) ) THEN
+          WRITE(numout,*) 'HYDROL problem in vegetation or frac_nobio on point ', ji
+          WRITE(numout,*) 'totfrac_nobio : ', totfrac_nobio(ji)
+          WRITE(numout,*) 'vegetation fraction : ', vegtot(ji)
+          !STOP 'in hydrolc_waterbal'
+       ENDIF
+    ENDDO
+    
+    !! 1.2 We calculate the total amount of water in grid-cells at the end the time step
+    watveg(:) = zero
+    sum_vevapwet(:) = zero
+    sum_transpir(:) = zero
+    sum_snow_nobio(:) = zero
+
+    !cdir NODEP
+    DO jv = 1,nvm
+       watveg(:) = watveg(:) + qsintveg(:,jv)
+       sum_vevapwet(:) = sum_vevapwet(:) + vevapwet(:,jv)
+       sum_transpir(:) = sum_transpir(:) + transpir(:,jv)
+    ENDDO
+
+    !cdir NODEP
+    DO jn = 1,nnobio
+       sum_snow_nobio(:) = sum_snow_nobio(:) + snow_nobio(:,jn)
+    ENDDO
+    
+    !cdir NODEP
+    DO ji = 1, kjpindex
+       tot_water_end(ji) = (mean_bqsb(ji) + mean_gqsb(ji))*vegtot(ji) + &
+            & watveg(ji) + snow(ji) + sum_snow_nobio(ji)
+    ENDDO
+     
+    !! 2.3 Calculate the change in total water amount during the time step
+    !!  Calculate the change in total water amount during the time, stepand the algebraic sum
+    !!  of the water fluxes supposed to cause the total water amount change.
+    !!  If the model conserves water, they should be equal, since the fluxes are used in their integrated form, 
+    !!  over the time step dt_sechiba, with a unit of kg m^{-2}.
+    DO ji = 1, kjpindex
+       
+       delta_water(ji) = tot_water_end(ji) - tot_water_beg(ji)
+       
+       tot_flux(ji) =  precip_rain(ji) + precip_snow(ji) + returnflow(ji) + reinfiltration(ji) + irrigation(ji) - &
+             & sum_vevapwet(ji) - sum_transpir(ji) - vevapnu(ji) - vevapsno(ji) - vevapflo(ji) + &
+             & floodout(ji)- run_off_tot(ji) - drainage(ji) 
+       
+    ENDDO
+    
+       !! 1.4 We do the check, given some minimum required precision
+       !!       This is a wild guess and corresponds to what works on an IEEE machine under double precision (REAL*8).
+       !!       If the water balance is not closed at this precision, we issue a warning with some diagnostics.
+       allowed_err = 50000*EPSILON(un) ! *** how much is epsilon(1) ? where is it defined ?
+       
+    DO ji = 1, kjpindex
+       IF ( ABS(delta_water(ji)-tot_flux(ji)) .GT. allowed_err ) THEN
+          WRITE(numout,*) 'HYDROL does not conserve water. The erroneous point is : ', ji
+          WRITE(numout,*) 'The error in mm/d is :', (delta_water(ji)-tot_flux(ji))/dt_sechiba*one_day, &
+               & ' and in mm/dt : ', delta_water(ji)-tot_flux(ji)
+          WRITE(numout,*) 'delta_water : ', delta_water(ji), ' tot_flux : ', tot_flux(ji)
+          WRITE(numout,*) 'Actual and allowed error : ', ABS(delta_water(ji)-tot_flux(ji)), allowed_err
+          WRITE(numout,*) 'vegtot : ', vegtot(ji)
+          WRITE(numout,*) 'precip_rain : ', precip_rain(ji)
+          WRITE(numout,*) 'precip_snow : ',  precip_snow(ji)
+          WRITE(numout,*) 'Water from irrigation, floodplains:', reinfiltration(ji), returnflow(ji), irrigation(ji)
+          WRITE(numout,*) 'Total water in soil :', mean_bqsb(ji) + mean_gqsb(ji)
+          WRITE(numout,*) 'Water on vegetation :', watveg(ji)
+          WRITE(numout,*) 'Snow mass :', snow(ji)
+          WRITE(numout,*) 'Snow mass on ice :', sum_snow_nobio(ji)
+          WRITE(numout,*) 'Melt water :', tot_melt(ji)
+          WRITE(numout,*) 'evapwet : ', vevapwet(ji,:)
+          WRITE(numout,*) 'transpir : ', transpir(ji,:)
+          WRITE(numout,*) 'evapnu, evapsno, evapflo : ', vevapnu(ji), vevapsno(ji), vevapflo(ji)
+          WRITE(numout,*) 'floodout : ', floodout(ji)
+          WRITE(numout,*) 'drainage : ', drainage(ji)
+          STOP 'in hydrolc_waterbal'
+       ENDIF
+       
+    ENDDO
+    
+  !! 2. Transfer the total water amount at the end of the current timestep to the begining of the next one
+    
+    tot_water_beg = tot_water_end
+    
+  END SUBROUTINE hydrolc_waterbal
+ 
+
+!! ================================================================================================================================
+!! SUBROUTINE  : hydrolc_alma_init 
+!!
+!>\BRIEF       Initialize variables needed in hydrolc_alma
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n   
+!_ ================================================================================================================================   
+
+  SUBROUTINE hydrolc_alma_init (kjpindex, index, qsintveg, snow, snow_nobio)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                         :: kjpindex    !! Domain size (number of grid cells) (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index       !! Indices of the points on the map (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: qsintveg    !! Amount of water in the canopy interception reservoir 
+                                                                       !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: snow        !! Snow water equivalent  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in):: snow_nobio  !! Snow water equivalent on nobio areas 
+                                                                       !! @tex ($kg m^{-2}$) @endtex 
+    
+    !! 0.4 Local variabless
+    
+    INTEGER(i_std)                                      :: ji          !! Grid-cell indices (unitless)
+    REAL(r_std)                                         :: watveg      !! Total amount of intercepted water in a grid-cell 
+                                                                       !! @tex ($kg m^{-2}$) @endtex 
+!_ ================================================================================================================================
+
+    !! 1. Initialize water in terrestrial grid-cells at the beginning of the first time step
+
+    !! Initialize the amounts of water in terrestrial grid-cells at the beginning of the first time step, 
+    !! for the three water reservoirs (interception, soil and snow). 
+    tot_watveg_beg(:) = zero
+    tot_watsoil_beg(:) = zero
+    snow_beg(:)        = zero 
+    
+    DO ji = 1, kjpindex
+       watveg = SUM(qsintveg(ji,:))
+       tot_watveg_beg(ji) = watveg
+       tot_watsoil_beg(ji) = mean_bqsb(ji) + mean_gqsb(ji)
+       snow_beg(ji)        = snow(ji)+ SUM(snow_nobio(ji,:))  
+    ENDDO
+    
+    tot_watveg_end(:) = tot_watveg_beg(:)
+    tot_watsoil_end(:) = tot_watsoil_beg(:)
+    snow_end(:)        = snow_beg(:)
+    
+  END SUBROUTINE hydrolc_alma_init
+
+!! ================================================================================================================================
+!! SUBROUTINE  : hydrolc_alma 
+!!
+!>\BRIEF       This routine computes diagnostic variables required under the ALMA standards:
+!! changes in water amounts over the time steps (in the soil, snow and interception reservoirs); total water amount 
+!! at the end of the time steps; soil relative humidity.
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!  - soilwet: mean relative humidity of soil in the grid-cells (0-1, unitless)
+!!  - delsoilmoist, delswe, delintercept: changes in water amount during the time step @tex ($kg m^{-2}$) @endtex, 
+!!    for the three water reservoirs (soil,snow,interception)
+!!  - tot_watsoil_end: total water amount at the end of the time steps aincluding the three water resrevoirs  
+!! @tex ($kg m^{-2}$) @endtex. 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n   
+!_ ================================================================================================================================   
+  
+  SUBROUTINE hydrolc_alma (kjpindex, index, qsintveg, snow, snow_nobio, soilwet)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                         :: kjpindex    !! Domain size (number of grid cells) (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index       !! Indices of the points on the map (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: qsintveg    !! Amount of water in the canopy interception reservoir 
+                                                                       !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: snow        !! Snow water equivalent  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in):: snow_nobio  !! Snow water equivalent on nobio areas 
+                                                                       !! @tex ($kg m^{-2}$) @endtex 
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: soilwet     !! Mean relative humidity of soil in the grid-cells 
+                                                                       !! (0-1, unitless)
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variabless
+    
+    INTEGER(i_std)                                      :: ji          !! Grid-cell indices (unitless)
+    REAL(r_std)                                         :: watveg      !! Total amount of intercepted water in a grid-cell 
+                                                                       !! @tex ($kg m^{-2}$) @endtex 
+!_ ================================================================================================================================
+
+  !! 1. We calculate the required variables at the end of each time step 
+    
+    tot_watveg_end(:) = zero
+    tot_watsoil_end(:) = zero
+    snow_end(:) = zero
+    delintercept(:) = zero
+    delsoilmoist(:) = zero
+    delswe(:) = zero
+    
+    DO ji = 1, kjpindex
+       watveg = SUM(qsintveg(ji,:))
+       tot_watveg_end(ji) = watveg
+       tot_watsoil_end(ji) = mean_bqsb(ji) + mean_gqsb(ji)
+       snow_end(ji) = snow(ji)+ SUM(snow_nobio(ji,:))
+       !  
+       delintercept(ji) = tot_watveg_end(ji) - tot_watveg_beg(ji)
+       delsoilmoist(ji) = tot_watsoil_end(ji) - tot_watsoil_beg(ji)
+       delswe(ji)       = snow_end(ji) - snow_beg(ji)
+       !
+    ENDDO
+    
+  !! 2. Transfer the total water amount at the end of the current timestep to the begining of the next one.
+    
+    tot_watveg_beg = tot_watveg_end
+    tot_watsoil_beg = tot_watsoil_end
+    snow_beg(:) = snow_end(:)
+    
+  !! 3. We calculate the mean relative humidity of soil in the grid-cells
+    
+    DO ji = 1,kjpindex
+       soilwet(ji) = tot_watsoil_end(ji) / mx_eau_var(ji)
+    ENDDO
+    
+  END SUBROUTINE hydrolc_alma
+ 
+  
+!! ================================================================================================================================
+!! SUBROUTINE     : hydrolc_hdiff 
+!!
+!>\BRIEF          This subroutine performs horizontal diffusion of water between each PFT/soil column, 
+!! if the flag ok_hdiff is true. 
+!!
+!! DESCRIPTION    : The diffusion is realized on the water contents of both the top and bottom 
+!! soil layers, but the bottom soil layers share the same soil moisture since the end of hydrolc_soil (step 6).
+!! This subroutine thus only modifies the moisture of the top soil layer.
+!!  \latexonly
+!!  \input{hdiff.tex}
+!!  \endlatexonly
+!!
+!! RECENT CHANGE(S) : None
+!!      
+!! MAIN OUTPUT VARIABLE(S) : gqsb, bqsb, dsg, dss, dsp
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrolc_hdiff(kjpindex, veget, tot_bare_soil, ruu_ch, gqsb, bqsb, dsg, dss, dsp)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                          :: kjpindex         !! Domain size  (number of grid cells) (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget            !! Grid-cell fraction effectively covered by 
+                                                                             !! vegetation for each PFT, except for soil 
+                                                                             !! (0-1, unitless) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)        :: tot_bare_soil    !! Total evaporating bare soil fraction 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: ruu_ch           !! Volumetric soil water capacity 
+                                                                             !! @tex ($kg m^{-3}$) @endtex
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: gqsb             !! Water content in the top layer 
+                                                                             !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: bqsb             !! Water content in the bottom layer 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: dsg              !! Depth of the top layer (m) 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: dss              !! Depth of dry soil at the top, whether in the top
+                                                                             !! or bottom layer (m)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: dsp              !! Depth of dry soil in the bottom layer plus depth
+                                                                             !! of top layer (m)
+    
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION (kjpindex)                    :: bqsb_mean        !! Mean value of bqsb in each grid-cell 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex)                    :: gqsb_mean        !! Mean value of gqsb in each grid-cell 
+                                                                             !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex)                    :: dss_mean         !! Mean value of dss in each grid-cell (m)
+    REAL(r_std), DIMENSION (kjpindex)                    :: vegtot           !! Total fraction of grid-cell covered by PFTs (bare
+                                                                             !! soil + vegetation) (0-1, unitless) 
+                                                                             ! *** this variable is declared at the module level
+    REAL(r_std)                                          :: x                !! Coefficient of diffusion by time step 
+                                                                             !! (0-1, unitless)
+    INTEGER(i_std)                                       :: ji,jv            !! Indices for grid-cells and PFTs (unitless)
+    REAL(r_std), SAVE                                    :: tau_hdiff        !! Time scale for horizontal water diffusion (s) 
+!$OMP THREADPRIVATE(tau_hdiff)
+    LOGICAL, SAVE                                        :: firstcall_hydrolc=.TRUE. !! Flag to set tau_hdiff at the first time step 
+                                                                             !! ! *** why not define this parameter in 
+                                                                             !! constantes_soil.f90 ?
+!$OMP THREADPRIVATE(firstcall_hydrolc)
+!_ ================================================================================================================================
+
+  !! 1. First time step: we assign a value to the time scale for horizontal water diffusion (in seconds) 
+    
+    IF ( firstcall_hydrolc ) THEN
+
+      !Config Key   = HYDROL_TAU_HDIFF
+      !Config Desc  = time scale (s) for horizontal diffusion of water
+      !Config Def   = one_day
+      !Config If    = HYDROL_OK_HDIFF
+      !Config Help  = Defines how fast diffusion occurs horizontally between
+      !Config         the individual PFTs' water reservoirs. If infinite, no
+      !Config         diffusion.
+      !Config Units = [seconds]
+      tau_hdiff = one_day   ! 86400 s
+      CALL getin_p('HYDROL_TAU_HDIFF',tau_hdiff)
+
+      WRITE (numout,*) 'Hydrol: Horizontal diffusion, tau (s)=',tau_hdiff
+
+      firstcall_hydrolc = .FALSE.
+
+    ENDIF
+
+  !! 2. We calculate mean values of bqsb, gqsb and dss over the grid-cell ("bio" fraction).
+
+    ! Calculate mean values of bqsb, gqsb and dss over the grid-cell ("bio" fraction)
+    ! This could be done with SUM instruction but this kills vectorization
+    ! *** We compute here vegtot=SUM(veget), but it is already defined at a higher level (declared in the module) ***
+    bqsb_mean(:) = zero
+    gqsb_mean(:) = zero
+    dss_mean(:) = zero
+    vegtot(:) = zero
+    !
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+           IF (jv .EQ. 1) THEN
+              bqsb_mean(ji) = bqsb_mean(ji) + tot_bare_soil(ji)*bqsb(ji,jv)
+              gqsb_mean(ji) = gqsb_mean(ji) + tot_bare_soil(ji)*gqsb(ji,jv)
+              dss_mean(ji) = dss_mean(ji) + tot_bare_soil(ji)*dss(ji,jv)
+              vegtot(ji) = vegtot(ji) + tot_bare_soil(ji)
+           ELSE
+              bqsb_mean(ji) = bqsb_mean(ji) + veget(ji,jv)*bqsb(ji,jv)
+              gqsb_mean(ji) = gqsb_mean(ji) + veget(ji,jv)*gqsb(ji,jv)
+              dss_mean(ji) = dss_mean(ji) + veget(ji,jv)*dss(ji,jv)
+              vegtot(ji) = vegtot(ji) + veget(ji,jv)
+           ENDIF
+      ENDDO
+    ENDDO
+ 
+    DO ji = 1, kjpindex
+      IF (vegtot(ji) .GT. zero) THEN
+        bqsb_mean(ji) = bqsb_mean(ji)/vegtot(ji)
+        gqsb_mean(ji) = gqsb_mean(ji)/vegtot(ji)
+        dss_mean(ji) = dss_mean(ji)/vegtot(ji)
+      ENDIF
+    ENDDO
+
+  !! 3.  Relax PFT values towards grid-cell mean
+   
+    !! Relax values towards mean : the diffusion is proportional to the deviation to the mean,
+    !!  and inversely proportional to the timescale tau_hdiff
+    !!  We change the moisture of two soil layers, but also the depth of dry in the top soil layer. 
+    !!  Therefore, we need to accordingly adjust the top soil layer depth 
+    !!  and the dry soil depth above the bottom moisture (dsp).
+    ! *** This sequence does not seem to be fully consistent with the variable definitions, 
+    ! *** especially for the dry soil depths dss and dsp:
+    ! *** (i) is the "diffusion" of dss correct is some PFTs only have one soil layer (dss=dsp), 
+    ! *** given that hydrolc_soil acted to merge the bottom soil moistures bqsb
+    ! *** (ii) if gqsb is very small, we let the top layer vanish, but dss is not updated to dsp 
+    !
+    ! *** Also, it would be make much more sense to perform the diffusion in hydrolc_soil, when the 
+    ! *** bottom soil moistures are homogenized. It would benefit from the iterative consistency 
+    ! *** check between the dsg and dsp, and it would prevent from doing some calculations twice. 
+    ! *** Finally, it would be better to keep the water balance calculation for the real end of the 
+    ! *** hydrological processes.
+    !    
+    ! *** FORTUNATELY, the default value of ok_hdiff is false (hydrolc_init.f90)
+    x = MAX( zero, MIN( dt_sechiba/tau_hdiff, un ) )
+    
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+
+        ! *** bqsb does not change as bqsb(ji,jv)=bqsb_mean(ji) since hydrolc_soil, step 6
+        bqsb(ji,jv) = (un-x) * bqsb(ji,jv) + x * bqsb_mean(ji) 
+        gqsb(ji,jv) = (un-x) * gqsb(ji,jv) + x * gqsb_mean(ji)
+
+        ! *** is it meaningful to apply the diffusion equation to dss ?
+        dss(ji,jv) = (un-x) * dss(ji,jv) + x * dss_mean(ji) 
+        
+        IF (gqsb(ji,jv) .LT. min_sechiba) THEN
+          dsg(ji,jv) = zero ! *** in this case, we should also set dss to dsp (defined below)
+        ELSE
+          dsg(ji,jv) = (dss(ji,jv) * ruu_ch(ji) + gqsb(ji,jv)) / ruu_ch(ji)
+        ENDIF
+        dsp(ji,jv) = zmaxh - bqsb(ji,jv) / ruu_ch(ji) ! no change here since bqsb does not change
+
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE hydrolc_hdiff
+  
+END MODULE hydrolc
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/intersurf.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/intersurf.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/intersurf.f90	(revision 5166)
@@ -0,0 +1,1993 @@
+!! This subroutine is the interface between the main program 
+!! (LMDZ or dim2_driver) and SECHIBA.
+!! - Input fields are gathered to keep just continental points
+!! - call sechiba_main That's SECHIBA process.
+!! - Output fields are scattered to complete global fields
+!!
+!! @call sechiba_main
+!! @Version : $Revision$, $Date$
+!!
+!! @author Marie-Alice Foujols and Jan Polcher
+!! 
+!< $HeadURL$
+!< $Date$
+!< $Author$
+!< $Revision$
+!! IPSL (2006)
+!!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!!
+!f90doc MODULEintersurf
+MODULE intersurf
+
+  USE IOIPSL
+  USE xios_orchidee
+  USE ioipsl_para 
+  USE defprec
+  USE sechiba
+  USE constantes
+  USE constantes_soil
+  USE control
+  USE pft_parameters
+  USE mod_orchidee_para
+  USE solar
+  USE grid
+  USE Orch_Write_field_p
+  USE thermosoilc, ONLY : thermosoilc_levels
+  USE ioipslctrl, ONLY : ioipslctrl_history, ioipslctrl_restini, ok_histsync, max_hist_level, dw
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: Init_intersurf, intersurf_main, intersurf_main_2d, intersurf_main_gathered, intsurf_time
+  PUBLIC :: intersurf_initialize_2d, intersurf_initialize_gathered
+
+
+  ! Interface called from LMDZ
+  INTERFACE intersurf_main
+    MODULE PROCEDURE intersurf_main_gathered
+  END INTERFACE
+
+  !
+  !  Global variables
+  !
+  !
+  LOGICAL, SAVE                                      :: l_first_intersurf=.TRUE.!! Initialisation has to be done one time
+!$OMP THREADPRIVATE(l_first_intersurf)
+  INTEGER(i_std), SAVE                               :: printlev_loc            !! Write level to this module
+!$OMP THREADPRIVATE(printlev_loc)
+  INTEGER(i_std), SAVE                               :: hist_id, rest_id        !! IDs for history and restart files
+!$OMP THREADPRIVATE(hist_id, rest_id)
+  INTEGER(i_std), SAVE                               :: hist2_id                !! ID for the second history files (Hi-frequency ?)
+!$OMP THREADPRIVATE(hist2_id)
+  INTEGER(i_std), SAVE                               :: hist_id_stom, hist_id_stom_IPCC, rest_id_stom !! Dito for STOMATE
+!$OMP THREADPRIVATE(hist_id_stom, hist_id_stom_IPCC, rest_id_stom)
+  !
+  INTEGER(i_std), SAVE                               :: itau_offset  !! This offset is used to phase the 
+  !                                                                  !! calendar of the GCM or the driver.
+!$OMP THREADPRIVATE(itau_offset)
+  REAL(r_std), SAVE                                  :: date0_shifted
+!$OMP THREADPRIVATE(date0_shifted)
+  !
+  !! first day of this year
+  REAL(r_std), SAVE :: julian0
+!$OMP THREADPRIVATE(julian0)
+  !
+  LOGICAL, PARAMETER :: check_INPUTS = .false.         !! (very) long print of INPUTs in intersurf 
+
+  LOGICAL, SAVE                                      :: ok_q2m_t2m=.TRUE. !! Flag ok if the variables are present in the call in gcm.
+!$OMP THREADPRIVATE(ok_q2m_t2m)
+  LOGICAL, SAVE                                      :: fatmco2           !! Flag to force the value of atmospheric CO2 for vegetation.
+!$OMP THREADPRIVATE(fatmco2)
+  REAL(r_std), SAVE                                  :: atmco2            !! atmospheric CO2 
+!$OMP THREADPRIVATE(atmco2)
+  INTEGER(i_std), SAVE                               :: nb_fields_in=-1   !!  Number of fields to give to the GCM
+!$OMP THREADPRIVATE(nb_fields_in)  
+  INTEGER(i_std), SAVE                               :: nb_fields_out=-1  !!  Number of fields to get from the GCM
+!$OMP THREADPRIVATE(nb_fields_out)  
+
+  PUBLIC l_first_intersurf
+  
+CONTAINS
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    intersurf_initialize_2d
+!!
+!>\BRIEF	  Initialization and call to sechiba_initialize
+!!
+!! DESCRIPTION:	  Initialization of module variables, read options from parameter file, initialize output files and call to 
+!!                sechiba_initialize.
+!!
+!!                This subroutine is called from dim2_driver before the first call to intersurf_main_2d.
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE intersurf_initialize_2d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
+       lrestart_read, lrestart_write, lon, lat, zcontfrac, zresolution, date0, &
+       zlev, u, v, qair, temp_air, epot_air, ccanopy, &
+       cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+       precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+       vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
+       tsol_rad, temp_sol_new, qsurf, albedo, emis, z0)
+
+    IMPLICIT NONE
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT (in)                            :: kjit            !! Time step number
+    INTEGER(i_std),INTENT (in)                            :: iim, jjm        !! Dimension of input fields
+    INTEGER(i_std),INTENT (in)                            :: kjpindex        !! Number of continental points
+    REAL(r_std),INTENT (in)                               :: xrdt            !! Time step in seconds
+    LOGICAL, INTENT (in)                                 :: lrestart_read    !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                 :: lrestart_write   !! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                              :: date0           !! Date at which kjit = 0
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: kindex          !! Index for continental points
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: u             !! Lowest level wind speed
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: v             !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: zlev          !! Height of first layer
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: qair          !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: precip_rain   !! Rain precipitation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: precip_snow   !! Snow precipitation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: lwdown        !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: swnet         !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: swdown        !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: temp_air      !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: epot_air      !! Air potential energy
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: ccanopy       !! CO2 concentration in the canopy
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: petAcoef      !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: peqAcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: petBcoef      !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: peqBcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: pb            !! Surface pressure
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: lon, lat      !! Geographical coordinates
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: zcontfrac     !! Fraction of continent in the grid
+    REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in)           :: zresolution   !! resolution in x and y dimensions
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: z0            !! Surface roughness
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: coastalflow   !! Diffuse flow of water into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: riverflow     !! Largest rivers flowing into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: tsol_rad      !! Radiative surface temperature
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: vevapp        !! Total of evaporation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: temp_sol_new  !! New soil temperature
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: qsurf         !! Surface specific humidity
+    REAL(r_std),DIMENSION (iim,jjm,2), INTENT(out)          :: albedo        !! Albedo
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: fluxsens      !! Sensible chaleur flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: fluxlat       !! Latent chaleur flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: emis          !! Emissivity
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(inout)          :: cdrag         !! Cdrag
+
+    !! 0.4 Local variables
+    REAL(r_std),DIMENSION (kjpindex)                      :: zu            !! Work array to keep u
+    REAL(r_std),DIMENSION (kjpindex)                      :: zv            !! Work array to keep v
+    REAL(r_std),DIMENSION (kjpindex)                      :: zzlev         !! Work array to keep zlev
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqair         !! Work array to keep qair
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_rain  !! Work array to keep precip_rain
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_snow  !! Work array to keep precip_snow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zlwdown       !! Work array to keep lwdown
+    REAL(r_std),DIMENSION (kjpindex)                      :: zswnet        !! Work array to keep swnet
+    REAL(r_std),DIMENSION (kjpindex)                      :: zswdown       !! Work array to keep swdown
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_air     !! Work array to keep temp_air
+    REAL(r_std),DIMENSION (kjpindex)                      :: zepot_air     !! Work array to keep epot_air
+    REAL(r_std),DIMENSION (kjpindex)                      :: zccanopy      !! Work array to keep ccanopy
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpetAcoef     !! Work array to keep petAcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpeqAcoef     !! Work array to keep peqAcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpetBcoef     !! Work array to keep petBcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpeqBcoef     !! Work array to keep peqVcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcdrag        !! Work array to keep cdrag
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpb           !! Work array to keep pb
+    REAL(r_std),DIMENSION (kjpindex)                      :: zz0           !! Work array to keep z0
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoastal      !! Work array to keep coastalflow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep riverflow
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    REAL(r_std),ALLOCATABLE, DIMENSION (:)                :: soilth_lev    !! Vertical soil axis for thermal scheme (m)
+    INTEGER(i_std)                                       :: i, j, ik
+    INTEGER(i_std)                                       :: ier
+    INTEGER(i_std)                                       :: itau_sechiba
+    REAL(r_std)                                          :: zlev_mean
+    INTEGER                                              :: old_fileout   !! old Logical Int for std IO output
+
+
+    CALL ipslnlf_p(new_number=numout,old_number=old_fileout)
+    !
+    !  Configuration of SSL specific parameters
+    !
+    CALL control_initialize(xrdt)
+
+    CALL intsurf_time( kjit, date0)
+    
+    ! Initialize specific write level
+    printlev_loc=get_printlev('instersurf')
+    
+    IF ( printlev_loc >=1 ) WRITE(numout,*) 'Initialisation of intersurf_main_2d'
+    OFF_LINE_MODE = .TRUE. 
+    
+    DO ik=1,kjpindex
+       
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+       
+       !- Create the internal coordinate table
+       !-
+       lalo(ik,1) = lat(i,j)
+       lalo(ik,2) = lon(i,j)
+       !
+       !- Store the fraction of the continents only once so that the user
+       !- does not change them afterwards.
+       !-
+       contfrac(ik) = zcontfrac(i,j)
+    ENDDO
+    CALL gather(contfrac,contfrac_g)
+    CALL gather(lalo,lalo_g)
+    CALL gather2D_mpi(lon,lon_g)
+    CALL gather2D_mpi(lat,lat_g)
+    CALL gather2D_mpi(zlev,zlev_g)
+    
+    CALL ioipslctrl_restini(kjit, date0, xrdt, rest_id, rest_id_stom, itau_offset, date0_shifted)
+    itau_sechiba = kjit + itau_offset
+    
+    !!- Initialize module for output with XIOS
+    !
+    ! Get the vertical soil levels for the thermal scheme, to be used in xios_orchidee_init
+    ! Get the vertical soil levels for the thermal scheme, to be used in xios_orchidee_init
+    ALLOCATE(soilth_lev(ngrnd), stat=ier)
+    IF (ier /= 0) THEN
+       CALL ipslerr_p(3,'intersurf_main_2d', 'Error in allocation of soilth_lev','','')
+    END IF
+    IF (hydrol_cwrr) THEN
+       soilth_lev(1:ngrnd) = znt(:)
+    ELSE
+       soilth_lev(1:ngrnd) = thermosoilc_levels()
+    END IF
+
+    CALL xios_orchidee_init( MPI_COMM_ORCH,                &
+         date0,    year,    month,           day,          &
+         lon,      lat,     soilth_lev )
+    
+    !- Initialize IOIPSL sechiba output files
+    CALL ioipslctrl_history(iim, jjm, lon, lat,  kindex, kjpindex, itau_sechiba, date0_shifted, xrdt, hist_id, &
+         hist2_id, hist_id_stom, hist_id_stom_IPCC)
+ 
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'End of Initialisation of intersurf'
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    
+    ! Update the calendar in xios by sending the new time step
+    ! Special case : the model is only in initialization phase and the current itau_sechiba is not a real time step. 
+    ! Therefor give itau_sechiba+1 to xios to have a correct time axis in output files. 
+    CALL xios_orchidee_update_calendar(itau_sechiba+1)
+    
+    CALL intsurf_time( itau_sechiba, date0_shifted )
+    !
+    ! 1. gather input fields from kindex array
+    !    Warning : I'm not sure this interface with one dimension array is the good one
+    !
+    DO ik=1, kjpindex
+      
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+       
+       zu(ik)           = u(i,j)
+       zv(ik)           = v(i,j)
+       zzlev(ik)        = zlev(i,j)
+       zqair(ik)        = qair(i,j)
+       zprecip_rain(ik) = precip_rain(i,j)*xrdt
+       zprecip_snow(ik) = precip_snow(i,j)*xrdt
+       zlwdown(ik)      = lwdown(i,j)
+       zswnet(ik)       = swnet(i,j)
+       zswdown(ik)      = swdown(i,j)
+       ztemp_air(ik)    = temp_air(i,j)
+       zepot_air(ik)    = epot_air(i,j)
+       zccanopy(ik)     = ccanopy(i,j)
+       zpetAcoef(ik)    = petAcoef(i,j)
+       zpeqAcoef(ik)    = peqAcoef(i,j)
+       zpetBcoef(ik)    = petBcoef(i,j)
+       zpeqBcoef(ik)    = peqBcoef(i,j)
+       zcdrag(ik)       = cdrag(i,j)
+       zpb(ik)          = pb(i,j)
+       
+    ENDDO
+    !
+    IF (check_INPUTS) THEN
+       WRITE(numout,*) "Intersurf_main_2D :"
+       WRITE(numout,*) "Time step number = ",kjit
+       WRITE(numout,*) "Dimension of input fields = ",iim, jjm
+       WRITE(numout,*) "Number of continental points = ",kjpindex
+       WRITE(numout,*) "Time step in seconds = ",xrdt
+       WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
+       WRITE(numout,*) "Date at which kjit = 0  =  ",date0
+       WRITE(numout,*) "Index for continental points = ",kindex
+       WRITE(numout,*) "Lowest level wind speed North = ",zu
+       WRITE(numout,*) "Lowest level wind speed East = ",zv
+       WRITE(numout,*) "Height of first layer = ",zzlev
+       WRITE(numout,*) "Lowest level specific humidity = ",zqair
+       WRITE(numout,*) "Rain precipitation = ",zprecip_rain
+       WRITE(numout,*) "Snow precipitation = ",zprecip_snow
+       WRITE(numout,*) "Down-welling long-wave flux = ",zlwdown
+       WRITE(numout,*) "Net surface short-wave flux = ",zswnet
+       WRITE(numout,*) "Downwelling surface short-wave flux = ",zswdown
+       WRITE(numout,*) "Air temperature in Kelvin = ",ztemp_air
+       WRITE(numout,*) "Air potential energy = ",zepot_air
+       WRITE(numout,*) "CO2 concentration in the canopy = ",zccanopy
+       WRITE(numout,*) "Coeficients A from the PBL resolution = ",zpetAcoef
+       WRITE(numout,*) "One for T and another for q = ",zpeqAcoef
+       WRITE(numout,*) "Coeficients B from the PBL resolution = ",zpetBcoef
+       WRITE(numout,*) "One for T and another for q = ",zpeqBcoef
+       WRITE(numout,*) "Cdrag = ",zcdrag
+       WRITE(numout,*) "Surface pressure = ",zpb
+       WRITE(numout,*) "Geographical coordinates lon = ", (/ ( lon(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /)
+       WRITE(numout,*) "Geographical coordinates lat = ", (/ ( lat(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /) 
+       WRITE(numout,*) "Fraction of continent in the grid = ",contfrac
+    ENDIF
+    !
+    ! 2. save the grid
+    !
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'Save the grid'
+    CALL histwrite_p(hist_id, 'LandPoints',  itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
+    CALL histwrite_p(hist_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+    IF ( ok_stomate ) THEN
+       CALL histwrite_p(hist_id_stom, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+       CALL histwrite_p(hist_id_stom_IPCC, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+    ENDIF
+    
+    CALL histwrite_p(hist_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+    IF ( is_omp_root .AND. hist_id > 0 ) THEN
+       ! Always syncronize output after initialization 
+       CALL histsync(hist_id)
+    END IF
+    
+    CALL histwrite_p(hist2_id, 'LandPoints',  itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
+    CALL histwrite_p(hist2_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+    CALL histwrite_p(hist2_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+    IF ( is_omp_root .AND. hist2_id > 0 ) THEN
+       ! Always syncronize output after initialization 
+       CALL histsync(hist2_id)
+    ENDIF
+    
+    !
+    ! 3. call sechiba for continental points only
+    !
+    IF ( printlev_loc >= 3 ) WRITE(numout,*) 'Calling sechiba_initialize'
+    
+    CALL sechiba_initialize( &
+         itau_sechiba, iim*jjm,      kjpindex,      kindex,      date0_shifted, &
+         lalo,         contfrac,     neighbours,    resolution,  zzlev,         &
+         zu,           zv,           zqair,         ztemp_air,   ztemp_air,     &
+         zpetAcoef,    zpeqAcoef,    zpetBcoef,     zpeqBcoef,                  &
+         zprecip_rain, zprecip_snow, zlwdown,       zswnet,      zswdown,       &
+         zpb,          rest_id,      hist_id,       hist2_id,                   &
+         rest_id_stom, hist_id_stom, hist_id_stom_IPCC,                         &
+         zcoastal,     zriver,       ztsol_rad,     zvevapp,     zqsurf,        &
+         zz0,          zalbedo,      zfluxsens,     zfluxlat,    zemis,         &
+         znetco2,      zcarblu,      ztemp_sol_new, zcdrag)
+    
+    IF ( printlev_loc >= 3 ) WRITE(numout,*) 'out of sechiba_initialize'
+    !
+    ! 5. scatter output fields
+    !
+    z0(:,:)           = undef_sechiba
+    coastalflow(:,:)  = undef_sechiba
+    riverflow(:,:)    = undef_sechiba
+    tsol_rad(:,:)     = undef_sechiba
+    vevapp(:,:)       = undef_sechiba
+    temp_sol_new(:,:) = undef_sechiba 
+    qsurf(:,:)        = undef_sechiba 
+    albedo(:,:,:)     = undef_sechiba
+    fluxsens(:,:)     = undef_sechiba
+    fluxlat(:,:)      = undef_sechiba
+    emis(:,:)         = undef_sechiba 
+    cdrag(:,:)        = undef_sechiba 
+    
+    DO ik=1, kjpindex
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+       
+       z0(i,j)           = zz0(ik)
+       coastalflow(i,j)  = zcoastal(ik)
+       riverflow(i,j)    = zriver(ik)
+       tsol_rad(i,j)     = ztsol_rad(ik)
+       vevapp(i,j)       = zvevapp(ik)
+       temp_sol_new(i,j) = ztemp_sol_new(ik)
+       qsurf(i,j)        = zqsurf(ik)
+       albedo(i,j,1)     = zalbedo(ik,1)
+       albedo(i,j,2)     = zalbedo(ik,2)
+       fluxsens(i,j)     = zfluxsens(ik)
+       fluxlat(i,j)      = zfluxlat(ik)
+       emis(i,j)         = zemis(ik)
+       cdrag(i,j)        = zcdrag(ik)
+
+    ENDDO
+
+    !
+    ! 6. Transform the water fluxes into Kg/m^2s and m^3/s
+    !
+    DO ik=1, kjpindex
+    
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+
+       vevapp(i,j) = vevapp(i,j)/xrdt
+       coastalflow(i,j) = coastalflow(i,j)/xrdt
+       riverflow(i,j) = riverflow(i,j)/xrdt
+
+    ENDDO
+
+    IF (is_root_prc) CALL getin_dump
+
+    l_first_intersurf = .FALSE.
+    IF (printlev_loc >=3) WRITE (numout,*) ' intersurf_main done '
+    CALL ipslnlf_p(new_number=old_fileout)
+  END SUBROUTINE intersurf_initialize_2d
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    intersurf_main_2d
+!!
+!>\BRIEF	  Main subroutine to call ORCHIDEE from dim2_driver using variables on a 2d grid.
+!!
+!! DESCRIPTION:	  This subroutine is the main interface for ORCHIDEE when it is called from the offline driver dim2_driver.
+!!                The variables are all on the 2D grid including ocean points. intersurf_initialize_2d should be called before
+!!                this subroutine is called. This subroutine is called at each time step.
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE intersurf_main_2d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
+       lrestart_read, lrestart_write, lon, lat, zcontfrac, zresolution, date0, &
+       zlev, u, v, qair, temp_air, epot_air, ccanopy, &
+       cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+       precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+       vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
+       tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, &
+       coszang)
+!       coszang,soil_mc,litter_mc)
+    IMPLICIT NONE
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT (in)                              :: kjit            !! Time step number
+    INTEGER(i_std),INTENT (in)                              :: iim, jjm        !! Dimension of input fields
+    INTEGER(i_std),INTENT (in)                              :: kjpindex        !! Number of continental points
+    REAL(r_std),INTENT (in)                                 :: xrdt            !! Time step in seconds
+    LOGICAL, INTENT (in)                                    :: lrestart_read   !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                    :: lrestart_write  !! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                                :: date0           !! Date at which kjit = 0
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)        :: kindex          !! Index for continental points
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: u             !! Lowest level wind speed
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: v             !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: zlev          !! Height of first layer
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: qair          !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: precip_rain   !! Rain precipitation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: precip_snow   !! Snow precipitation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: lwdown        !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: swnet         !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: swdown        !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: coszang       !! Cosine of the solar zenith angle (unitless)
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: temp_air      !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: epot_air      !! Air potential energy
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: ccanopy       !! CO2 concentration in the canopy
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: petAcoef      !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: peqAcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: petBcoef      !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: peqBcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: pb            !! Surface pressure
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: lon, lat      !! Geographical coordinates
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: zcontfrac     !! Fraction of continent in the grid
+    REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in)           :: zresolution   !! resolution in x and y dimensions
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: z0            !! Surface roughness
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: coastalflow   !! Diffuse flow of water into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: riverflow     !! Largest rivers flowing into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: tsol_rad      !! Radiative surface temperature
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: vevapp        !! Total of evaporation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: temp_sol_new  !! New soil temperature
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: qsurf         !! Surface specific humidity
+    REAL(r_std),DIMENSION (iim,jjm,2), INTENT(out)          :: albedo        !! Albedo
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: fluxsens      !! Sensible chaleur flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: fluxlat       !! Latent chaleur flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: emis          !! Emissivity
+!    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(inout)   :: soil_mc   !! soil moisture content \f($m^3 \times m^3$)\f
+!    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(inout)    :: litter_mc     !! litter moisture content \f($m^3 \times m^3$)\f
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(inout)          :: cdrag         !! Cdrag
+
+    !! 0.4 Local variables
+    REAL(r_std),DIMENSION (kjpindex)                      :: zu            !! Work array to keep u
+    REAL(r_std),DIMENSION (kjpindex)                      :: zv            !! Work array to keep v
+    REAL(r_std),DIMENSION (kjpindex)                      :: zzlev         !! Work array to keep zlev
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqair         !! Work array to keep qair
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_rain  !! Work array to keep precip_rain
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_snow  !! Work array to keep precip_snow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zlwdown       !! Work array to keep lwdown
+    REAL(r_std),DIMENSION (kjpindex)                      :: zswnet        !! Work array to keep swnet
+    REAL(r_std),DIMENSION (kjpindex)                      :: zswdown       !! Work array to keep swdown
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoszang      !! Work array to keep coszang
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_air     !! Work array to keep temp_air
+    REAL(r_std),DIMENSION (kjpindex)                      :: zepot_air     !! Work array to keep epot_air
+    REAL(r_std),DIMENSION (kjpindex)                      :: zccanopy      !! Work array to keep ccanopy
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpetAcoef     !! Work array to keep petAcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpeqAcoef     !! Work array to keep peqAcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpetBcoef     !! Work array to keep petBcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpeqBcoef     !! Work array to keep peqVcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcdrag        !! Work array to keep cdrag
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpb           !! Work array to keep pb
+    REAL(r_std),DIMENSION (kjpindex)                      :: zz0           !! Work array to keep z0
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoastal      !! Work array to keep coastalflow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep riverflow
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    REAL(r_std),ALLOCATABLE, DIMENSION (:)                :: soilth_lev    !! Vertical soil axis for thermal scheme (m)
+    INTEGER(i_std)                                        :: i, j, ik
+    INTEGER(i_std)                                        :: ier
+    INTEGER(i_std)                                        :: itau_sechiba
+    REAL(r_std)                                           :: zlev_mean
+    INTEGER                                               :: old_fileout   !! old Logical Int for std IO output
+
+    CALL ipslnlf_p(new_number=numout,old_number=old_fileout)
+
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    !
+
+    ! Update the calendar in xios by sending the new time step
+    CALL xios_orchidee_update_calendar(itau_sechiba)
+    
+    CALL intsurf_time( itau_sechiba, date0_shifted )
+    !
+    ! 1. gather input fields from kindex array
+    !    Warning : I'm not sure this interface with one dimension array is the good one
+    !
+    DO ik=1, kjpindex
+      
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+       
+       zu(ik)           = u(i,j)
+       zv(ik)           = v(i,j)
+       zzlev(ik)        = zlev(i,j)
+       zqair(ik)        = qair(i,j)
+       zprecip_rain(ik) = precip_rain(i,j)*xrdt
+       zprecip_snow(ik) = precip_snow(i,j)*xrdt
+       zlwdown(ik)      = lwdown(i,j)
+       zswnet(ik)       = swnet(i,j)
+       zswdown(ik)      = swdown(i,j)
+       zcoszang(ik)     = coszang(i,j)
+       ztemp_air(ik)    = temp_air(i,j)
+       zepot_air(ik)    = epot_air(i,j)
+       zccanopy(ik)     = ccanopy(i,j)
+       zpetAcoef(ik)    = petAcoef(i,j)
+       zpeqAcoef(ik)    = peqAcoef(i,j)
+       zpetBcoef(ik)    = petBcoef(i,j)
+       zpeqBcoef(ik)    = peqBcoef(i,j)
+       zcdrag(ik)       = cdrag(i,j)
+       zpb(ik)          = pb(i,j)
+       
+    ENDDO
+    !
+    IF (check_INPUTS) THEN
+       WRITE(numout,*) "Intersurf_main_2D :"
+       WRITE(numout,*) "Time step number = ",kjit
+       WRITE(numout,*) "Dimension of input fields = ",iim, jjm
+       WRITE(numout,*) "Number of continental points = ",kjpindex
+       WRITE(numout,*) "Time step in seconds = ",xrdt
+       WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
+       WRITE(numout,*) "Date at which kjit = 0  =  ",date0
+       WRITE(numout,*) "Index for continental points = ",kindex
+       WRITE(numout,*) "Lowest level wind speed North = ",zu
+       WRITE(numout,*) "Lowest level wind speed East = ",zv
+       WRITE(numout,*) "Height of first layer = ",zzlev
+       WRITE(numout,*) "Lowest level specific humidity = ",zqair
+       WRITE(numout,*) "Rain precipitation = ",zprecip_rain
+       WRITE(numout,*) "Snow precipitation = ",zprecip_snow
+       WRITE(numout,*) "Down-welling long-wave flux = ",zlwdown
+       WRITE(numout,*) "Net surface short-wave flux = ",zswnet
+       WRITE(numout,*) "Downwelling surface short-wave flux = ",zswdown
+       WRITE(numout,*) "Air temperature in Kelvin = ",ztemp_air
+       WRITE(numout,*) "Air potential energy = ",zepot_air
+       WRITE(numout,*) "CO2 concentration in the canopy = ",zccanopy
+       WRITE(numout,*) "Coeficients A from the PBL resolution = ",zpetAcoef
+       WRITE(numout,*) "One for T and another for q = ",zpeqAcoef
+       WRITE(numout,*) "Coeficients B from the PBL resolution = ",zpetBcoef
+       WRITE(numout,*) "One for T and another for q = ",zpeqBcoef
+       WRITE(numout,*) "Cdrag = ",zcdrag
+       WRITE(numout,*) "Surface pressure = ",zpb
+       WRITE(numout,*) "Geographical coordinates lon = ", (/ ( lon(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /)
+       WRITE(numout,*) "Geographical coordinates lat = ", (/ ( lat(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /) 
+       WRITE(numout,*) "Fraction of continent in the grid = ",contfrac
+    ENDIF
+
+    !
+    ! 3. call sechiba for continental points only
+    !
+    IF ( printlev_loc >= 3 ) WRITE(numout,*) 'Calling sechiba_main'
+    
+    CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, date0_shifted, &
+         lrestart_read, lrestart_write, &
+         lalo, contfrac, neighbours, resolution, &
+         zzlev, zu, zv, zqair, zqair, ztemp_air, ztemp_air, zepot_air, zccanopy, &
+         zcdrag, zpetAcoef, zpeqAcoef, zpetBcoef, zpeqBcoef, &
+         zprecip_rain ,zprecip_snow,  zlwdown, zswnet, zswdown, zcoszang, zpb, &
+         zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
+         ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, &
+         rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC ) 
+!         rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, &
+!         hist_id_stom_IPCC,soil_mc,litter_mc )    
+    IF ( printlev_loc >= 3 ) WRITE(numout,*) 'out of sechiba_main'
+
+    !
+    ! 5. scatter output fields
+    !
+    z0(:,:)           = undef_sechiba
+    coastalflow(:,:)  = undef_sechiba
+    riverflow(:,:)    = undef_sechiba
+    tsol_rad(:,:)     = undef_sechiba
+    vevapp(:,:)       = undef_sechiba
+    temp_sol_new(:,:) = undef_sechiba 
+    qsurf(:,:)        = undef_sechiba 
+    albedo(:,:,:)     = undef_sechiba
+    fluxsens(:,:)     = undef_sechiba
+    fluxlat(:,:)      = undef_sechiba
+    emis(:,:)         = undef_sechiba 
+    cdrag(:,:)        = undef_sechiba 
+    !
+    DO ik=1, kjpindex
+      
+    
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+
+       z0(i,j)           = zz0(ik)
+       coastalflow(i,j)  = zcoastal(ik)
+       riverflow(i,j)    = zriver(ik)
+       tsol_rad(i,j)     = ztsol_rad(ik)
+       vevapp(i,j)       = zvevapp(ik)
+       temp_sol_new(i,j) = ztemp_sol_new(ik)
+       qsurf(i,j)        = zqsurf(ik)
+       albedo(i,j,1)     = zalbedo(ik,1)
+       albedo(i,j,2)     = zalbedo(ik,2)
+       fluxsens(i,j)     = zfluxsens(ik)
+       fluxlat(i,j)      = zfluxlat(ik)
+       emis(i,j)         = zemis(ik)
+       cdrag(i,j)        = zcdrag(ik)
+
+    ENDDO
+
+    CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
+    CALL xios_orchidee_send_field("Areas", area)
+    CALL xios_orchidee_send_field("Contfrac",contfrac)
+    CALL xios_orchidee_send_field("evap",zvevapp*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("evap_alma",zvevapp/dt_sechiba)
+    CALL xios_orchidee_send_field("coastalflow",zcoastal/dt_sechiba)
+    CALL xios_orchidee_send_field("riverflow",zriver/dt_sechiba)
+    CALL xios_orchidee_send_field("temp_sol_C",ztemp_sol_new-ZeroCelsius)
+    CALL xios_orchidee_send_field("temp_sol_K",ztemp_sol_new)
+    CALL xios_orchidee_send_field("fluxsens",zfluxsens)
+    CALL xios_orchidee_send_field("fluxlat",zfluxlat)
+    CALL xios_orchidee_send_field("alb_vis",zalbedo(:,1))
+    CALL xios_orchidee_send_field("alb_nir",zalbedo(:,2))
+    CALL xios_orchidee_send_field("tair",ztemp_air)
+    CALL xios_orchidee_send_field("qair",zqair)
+    CALL xios_orchidee_send_field("q2m",zqair)
+    CALL xios_orchidee_send_field("t2m",ztemp_air)
+    CALL xios_orchidee_send_field("swnet",zswnet)
+    CALL xios_orchidee_send_field("swdown",zswdown)
+    ! zpb in hPa, output in Pa
+    CALL xios_orchidee_send_field("Psurf",zpb*100.)
+    
+    IF ( .NOT. almaoutput ) THEN
+       !
+       !  scattered during the writing
+       ! 
+       CALL histwrite_p (hist_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'fluxlat',  itau_sechiba, zfluxlat, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'swnet',    itau_sechiba, zswnet, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'swdown',   itau_sechiba, zswdown, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'tair',     itau_sechiba, ztemp_air, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'qair',     itau_sechiba, zqair, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'q2m',     itau_sechiba, zqair, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 't2m',     itau_sechiba, ztemp_air, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'fluxlat',  itau_sechiba, zfluxlat, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'swnet',    itau_sechiba, zswnet, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'swdown',   itau_sechiba, zswdown, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'tair',     itau_sechiba, ztemp_air, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'qair',     itau_sechiba, zqair, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'q2m',     itau_sechiba, zqair, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 't2m',     itau_sechiba, ztemp_air, kjpindex, kindex)
+    ELSE
+       CALL histwrite_p (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'SWnet',    itau_sechiba, zswnet, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'Tair', itau_sechiba, ztemp_air, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'Qair', itau_sechiba, zqair, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'SWnet',    itau_sechiba, zswnet, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+       CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+    ENDIF
+    !
+    IF ( is_omp_root ) THEN
+       IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
+          ! Syncronize output but only if flag ok_histsync is set to true
+          IF (ok_histsync) CALL histsync(hist_id)
+       ENDIF
+    END IF
+
+    !
+    ! 6. Transform the water fluxes into Kg/m^2s and m^3/s
+    !
+    DO ik=1, kjpindex
+       
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+       
+       vevapp(i,j) = vevapp(i,j)/xrdt
+       coastalflow(i,j) = coastalflow(i,j)/xrdt
+       riverflow(i,j) = riverflow(i,j)/xrdt
+       
+    ENDDO
+    
+    IF (printlev_loc >=3) WRITE (numout,*) ' intersurf_main done '
+
+    CALL ipslnlf_p(new_number=old_fileout)
+
+  END SUBROUTINE intersurf_main_2d
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    init_intersurf
+!!
+!>\BRIEF	  Initialize grid information
+!!
+!! DESCRIPTION:	  This subroutine is called from LMDZ before first call to intersurf_main_gathered or 
+!!                intersurf_initialize_gathered
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE init_intersurf(nbp_l_lon,nbp_l_lat,kjpindex,kindex,orch_offset,orch_omp_size,orch_omp_rank,COMM)
+
+    USE mod_orchidee_para
+    USE timer
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN)  :: nbp_l_lon
+    INTEGER,INTENT(IN)  :: nbp_l_lat
+    INTEGER,INTENT(IN)  :: kjpindex
+    INTEGER,INTENT(IN)  :: kindex(:)
+    INTEGER,INTENT(IN)  :: orch_offset
+    INTEGER,INTENT(IN)  :: COMM
+    INTEGER,INTENT(IN)  :: orch_omp_size
+    INTEGER,INTENT(IN)  :: orch_omp_rank
+
+    INTEGER,DIMENSION(kjpindex)  :: kindex_offset
+
+    IF (orch_omp_rank==0) THEN
+      CALL Init_timer
+      CALL start_timer(timer_mpi)
+      CALL set_grid_glo(nbp_l_lon,nbp_l_lat)
+    ENDIF
+    CALL barrier2_omp()    
+    CALL init_orchidee_data_para(kjpindex,kindex,orch_offset,orch_omp_size,orch_omp_rank,COMM)
+    CALL Set_stdout_file('out_orchidee')
+    
+    IF (is_omp_root) CALL Allocate_grid_glo
+    CALL barrier2_omp()
+    CALL init_ioipsl_para
+          
+    kindex_offset(:)=kindex(:)+offset
+    CALL gather(kindex_offset,index_g)
+    CALL bcast(index_g)  
+
+    WRITE(numout,*) "kjpindex = ",kjpindex
+    WRITE(numout,*) "offset for OMP = ",offset_omp
+    WRITE(numout,*) "Index num local for continental points = ",kindex
+    WRITE(numout,*) "Index num global for continental points = ",kindex_offset
+    IF (is_omp_root) THEN
+       WRITE(numout,*) "ROOT OMP, Index global MPI : ",kindex_mpi(:)
+    ENDIF
+    IF (is_root_prc) THEN
+       WRITE(numout,*) "ROOT global, Index global : ",index_g(:)
+    ENDIF
+    
+  END SUBROUTINE init_intersurf
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    intersurf_initialize_gathered
+!!
+!>\BRIEF	  Initialization and call to sechiba_initialize
+!!
+!! DESCRIPTION:	  Initialization of module variables, read options from parameter file, initialize output files and call to 
+!!                sechiba_initialize.
+!!
+!!                This subroutine can be called directly from GCM(LMDZ). If it is not called before the first call to 
+!!                intersurf_main_gathered, then it will be done from there. This possibility is done to keep backward 
+!!                compatibility with LMDZ. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE intersurf_initialize_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
+       lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
+       zlev,  u, v, qair, temp_air, epot_air, &
+       cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+       precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+       vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
+       tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, q2m, t2m, &
+       field_out_names, fields_out, field_in_names, fields_in)
+
+    USE mod_orchidee_para
+    IMPLICIT NONE
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input 
+    INTEGER(i_std),INTENT (in)                             :: kjit           !! Time step number
+    INTEGER(i_std),INTENT (in)                             :: iim_glo        !! Dimension of global fields
+    INTEGER(i_std),INTENT (in)                             :: jjm_glo        !! Dimension of global fields
+    INTEGER(i_std),INTENT (in)                             :: kjpindex       !! Number of continental points
+    REAL(r_std),INTENT (in)                                :: xrdt           !! Time step in seconds
+    LOGICAL, INTENT (in)                                   :: lrestart_read  !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                   :: lrestart_write !! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                               :: date0          !! Date at which kjit = 0
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)       :: kindex         !! Index for continental points
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: u              !! Lowest level wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: v              !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: zlev           !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: qair           !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: precip_rain    !! Rain precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: precip_snow    !! Snow precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: lwdown         !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: swnet          !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: swdown         !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: temp_air       !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: epot_air       !! Air potential energy
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: petAcoef       !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: peqAcoef       !! One for T and another for q
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: petBcoef       !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: peqBcoef       !! One for T and another for q
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: pb             !! Surface pressure
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)         :: latlon         !! Geographical coordinates
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: zcontfrac      !! Fraction of continent
+    INTEGER(i_std),DIMENSION (kjpindex,8), INTENT(in)      :: zneighbours    !! neighbours
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)         :: zresolution    !! size of the grid box
+    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN)    :: lon_scat_g     !! The scattered values for longitude 
+    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN)    :: lat_scat_g     !! The scattered values for latitudes
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: z0             !! Surface roughness
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: coastalflow    !! Diffuse flow of water into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: riverflow      !! Largest rivers flowing into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: tsol_rad       !! Radiative surface temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: vevapp         !! Total of evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: temp_sol_new   !! New soil temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: qsurf          !! Surface specific humidity
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(out)        :: albedo         !! Albedo
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: fluxsens       !! Sensible chaleur flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: fluxlat        !! Latent chaleur flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: emis           !! Emissivity
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(inout)        :: cdrag          !! Cdrag
+
+    !! 0.4 Optional input and output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL :: q2m            !! Surface specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL :: t2m            !! Surface air temperature
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN)    :: field_in_names !! Names for deposit variables to be transported
+                                                                             !! from chemistry model by GCM to ORCHIDEE
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN)       :: fields_in      !! Fields for deposit variables to be transported 
+                                                                             !! from chemistry model by GCM to ORCHIDEE
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN)    :: field_out_names!! Names for emission variables to be transported 
+                                                                             !! to chemistry model by GCM from ORCHIDEE
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT)      :: fields_out     !! Fields for emission variables to be transported
+                                                                             !! to chemistry model by GCM from ORCHIDEE
+
+
+    !! 0.5 Local variables
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_rain  !! Work array to keep precip_rain
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_snow  !! Work array to keep precip_snow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zz0           !! Work array to keep z0
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcdrag        !! Work array for surface drag
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoastal      !! Work array to keep coastal flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep river out flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    REAL(r_std),ALLOCATABLE, DIMENSION (:)                :: soilth_lev    !! Vertical soil axis for thermal scheme (m)
+    REAL(r_std),DIMENSION (kjpindex)                      :: q2m_loc       !! Work array for q2m or qair
+    REAL(r_std),DIMENSION (kjpindex)                      :: t2m_loc       !! Work array for t2m or temp_air
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE               :: lon_scat      !! The scattered values for longitude 
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE               :: lat_scat      !! The scattered values for latitude
+    INTEGER(i_std)                                        :: i, j, ik
+    INTEGER(i_std)                                        :: ier
+    INTEGER(i_std)                                        :: itau_sechiba
+    REAL(r_std)                                           :: mx, zlev_mean
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)              :: tmp_lon, tmp_lat, tmp_lev
+    INTEGER                                               :: old_fileout   !! old Logical Int for std IO output
+    REAL,ALLOCATABLE,DIMENSION(:,:)                       :: lalo_mpi
+    REAL,ALLOCATABLE,DIMENSION(:)                         :: zlev_glo1D
+    REAL(r_std),DIMENSION (kjpindex)                      :: landpoints    !! Land point vector
+    
+    
+
+    CALL ipslnlf_p(new_number=numout, old_number=old_fileout)
+    !
+    !  Configuration of SSL specific parameters
+    !
+    CALL control_initialize(xrdt)
+
+    ! Initialize specific write level
+    printlev_loc=get_printlev('instersurf')
+
+    IF ( printlev_loc>=1 ) WRITE(numout,*) 'Entering intersurf_initialize_gathered'
+
+    ! Set the variable ok_q2m_t2m=true if q2m and t2m are present in the call from the gcm. 
+    ! If one of the variables are not present in this subroutine, set ok_q2m_t2m=.FALSE.
+    ! Otherwise do not change the current value. Note that the current value for ok_q2m_t2m comes 
+    ! either from default initialization (true) or from intersurf_main_gathered.
+    IF (.NOT. PRESENT(q2m) .OR. .NOT. PRESENT(t2m)) THEN
+       ok_q2m_t2m=.FALSE.
+    END IF
+    
+    IF (ok_q2m_t2m) THEN
+       t2m_loc=t2m
+       q2m_loc=q2m
+    ELSE
+       t2m_loc=temp_air
+       q2m_loc=qair
+    END IF
+
+    CALL intsurf_time( kjit, date0 )
+    
+    
+    CALL ioget_calendar (one_year, one_day)
+    
+    IF (is_omp_root) THEN
+       ALLOCATE(lon_scat(iim_g,jj_nb))
+       ALLOCATE(lat_scat(iim_g,jj_nb))
+    ELSE
+       ALLOCATE(lon_scat(1,1))
+       ALLOCATE(lat_scat(1,1))
+    ENDIF
+    
+    CALL init_WriteField_p
+    !
+    ! Allocation of grid variables
+    !
+    CALL init_grid ( kjpindex )
+    !
+    !  Create the internal coordinate table
+    !
+    lalo(:,:) = latlon(:,:)
+    CALL gather(lalo,lalo_g)
+    !
+    !-
+    !- Store variable to help describe the grid
+    !- once the points are gathered.
+    !-
+    neighbours(:,:) = zneighbours(:,:)
+    CALL gather(neighbours,neighbours_g)
+    !
+    resolution(:,:) = zresolution(:,:)
+    CALL gather(resolution,resolution_g)
+    !
+    area(:) = resolution(:,1)*resolution(:,2)
+    CALL gather(area,area_g)
+    !
+    !- Store the fraction of the continents only once so that the user
+    !- does not change them afterwards.
+    !
+    contfrac(:) = zcontfrac(:)
+    CALL gather(contfrac,contfrac_g)
+    !
+    !
+    !  Create the internal coordinate table
+    !
+    IF ( (.NOT.ALLOCATED(tmp_lon))) THEN
+       ALLOCATE(tmp_lon(iim_g,jj_nb))
+    ENDIF
+    IF ( (.NOT.ALLOCATED(tmp_lat))) THEN
+       ALLOCATE(tmp_lat(iim_g,jj_nb))
+    ENDIF
+    IF ( (.NOT.ALLOCATED(tmp_lev))) THEN
+       ALLOCATE(tmp_lev(iim_g,jj_nb))
+    ENDIF
+    !
+    !  Either we have the scattered coordinates as arguments or
+    !  we have to do the work here.
+    !
+    IF (is_omp_root) THEN
+       lon_scat(:,:)=zero
+       lat_scat(:,:)=zero 
+       CALL scatter2D_mpi(lon_scat_g,lon_scat)
+       CALL scatter2D_mpi(lat_scat_g,lat_scat)
+       lon_scat(:,1)=lon_scat(:,2)
+       lon_scat(:,jj_nb)=lon_scat(:,2)
+       lat_scat(:,1)=lat_scat(iim_g,1)
+       lat_scat(:,jj_nb)=lat_scat(1,jj_nb)
+       
+       tmp_lon(:,:) = lon_scat(:,:)
+       tmp_lat(:,:) = lat_scat(:,:)
+       
+       IF (is_mpi_root) THEN
+          lon_g(:,:) = lon_scat_g(:,:)
+          lat_g(:,:) = lat_scat_g(:,:)
+       ENDIF
+    ENDIF
+    !
+    
+    !ANNE ici possibilite de calculer la grille du modele ? (lignes 965 ??
+    
+    
+    !ANNE calcul zlev, conserve la version de Martial
+    IF (is_root_prc) ALLOCATE(zlev_glo1D(nbp_glo))
+    CALL gather(zlev,zlev_glo1D)
+    
+    IF (is_root_prc) THEN
+       DO ik=1, nbp_glo
+          j = INT( (index_g(ik)-1) / iim_g ) + 1
+          i = index_g(ik) - (j-1) * iim_g
+          zlev_g(i,j) = zlev_glo1D(ik)
+       ENDDO
+    ENDIF
+
+    !Config Key  = FORCE_CO2_VEG
+    !Config Desc = Flag to force the value of atmospheric CO2 for vegetation.
+    !Config If   = Only in coupled mode
+    !Config Def  = FALSE
+    !Config Help = If this flag is set to true, the ATM_CO2 parameter is used
+    !Config        to prescribe the atmospheric CO2.
+    !Config        This Flag is only use in couple mode.
+    !Config Units = [FLAG]
+    fatmco2=.FALSE.
+    CALL getin_p('FORCE_CO2_VEG',fatmco2)
+    !
+    ! Next flag is only use in couple mode with a gcm in intersurf.
+    ! In forced mode, it has already been read and set in driver.
+    IF ( fatmco2 ) THEN
+       !Config Key  = ATM_CO2
+       !Config IF   = FORCE_CO2_VEG (only in coupled mode)
+       !Config Desc = Value for atm CO2 
+       !Config Def  = 350.
+       !Config Help = Value to prescribe the atm CO2.
+       !Config        For pre-industrial simulations, the value is 286.2 .
+       !Config        348. for 1990 year.
+       !Config Units = [ppm]
+       atmco2=350.
+       CALL getin_p('ATM_CO2',atmco2)
+       WRITE(numout,*) 'atmco2 ',atmco2
+    ENDIF
+    
+    CALL ioipslctrl_restini(kjit, date0, xrdt, rest_id, rest_id_stom, itau_offset, date0_shifted)
+    itau_sechiba = kjit + itau_offset
+    
+    !!- Initialize module for output with XIOS
+    !
+    ! Get the vertical soil levels for the thermal scheme, to be used in xios_orchidee_init
+    ALLOCATE(soilth_lev(ngrnd), stat=ier)
+    IF (ier /= 0) THEN
+       CALL ipslerr_p(3,'intersurf_main_gathered', 'Error in allocation of soilth_lev','','')
+    END IF
+    IF (hydrol_cwrr) THEN
+       soilth_lev(1:ngrnd) = znt(:)
+    ELSE
+       soilth_lev(1:ngrnd) = thermosoilc_levels()
+    END IF
+
+    CALL xios_orchidee_init( MPI_COMM_ORCH,               &
+         date0,    year,    month,          day,          &
+         tmp_lon,  tmp_lat, soilth_lev )
+    
+    !- Initialize IOIPSL sechiba output files
+    CALL ioipslctrl_history(iim_g, jj_nb, tmp_lon, tmp_lat,  kindex, kjpindex, itau_sechiba, &
+         date0_shifted, xrdt, hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC)
+    
+    CALL bcast_omp(hist_id)
+    CALL bcast_omp(hist2_id)
+    CALL bcast_omp(hist_id_stom)
+    CALL bcast_omp(hist_id_stom_IPCC)
+    
+    ! Count number of extra output fields to the GCM if it is not already done. 
+    IF (nb_fields_out == -1) THEN
+       ! nb_fields_out is not yet calculated. Do it now.  
+       ! This means that the call is done directly from GCM.
+       IF (PRESENT(field_out_names)) THEN
+          nb_fields_out=SIZE(field_out_names)
+       ELSE
+          nb_fields_out=0
+       ENDIF
+    END IF
+
+    ! Count number of extra input fields to the GCM if it is not already done. 
+    IF (nb_fields_in == -1) THEN
+       ! nb_fields_in is not yet calculated. Do it now.  
+       ! This means that the call is done directly from GCM.
+       IF (PRESENT(field_in_names)) THEN
+          nb_fields_in=SIZE(field_in_names)
+       ELSE
+          nb_fields_in=0
+       ENDIF
+    END IF
+
+
+    !
+    !! Change to be in the orchidee context for XIOS
+    !
+    CALL xios_orchidee_change_context("orchidee")
+    
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    
+    ! Update the calendar in xios by sending the new time step
+    ! Special case : the model is only in initialization phase and the current itau_sechiba is not a real time step. 
+    ! Therefor give itau_sechiba+1 to xios to have a correct time axis in output files. 
+    CALL xios_orchidee_update_calendar(itau_sechiba+1)
+    
+    CALL intsurf_time( itau_sechiba, date0_shifted )
+    
+    !
+    ! 1. Just change the units of some input fields
+    !
+    DO ik=1, kjpindex
+       
+       zprecip_rain(ik) = precip_rain(ik)*xrdt
+       zprecip_snow(ik) = precip_snow(ik)*xrdt
+       zcdrag(ik)       = cdrag(ik)
+       
+    ENDDO
+ 
+    ! Fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE.
+    ! There are currently no fields to be transported into ORCHIDEE in this way
+    DO i = 1, nb_fields_in
+       WRITE(numout,*) i," Champ = ",TRIM(field_in_names(i)) 
+       SELECT CASE(TRIM(field_in_names(i)))
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'intsurf_gathered', &
+               'You ask in GCM an unknown field '//TRIM(field_in_names(i))//&
+               ' to give to ORCHIDEE for this specific version.',&
+               'This model won''t be able to continue.', &
+               '(check your tracer parameters in GCM)')
+       END SELECT
+    ENDDO
+
+    !
+    ! 3. save the grid
+    !
+    landpoints(:)=(/ ( REAL(ik), ik=1,kjpindex ) /)
+    CALL histwrite_p(hist_id, 'LandPoints',  itau_sechiba+1, landpoints, kjpindex, kindex)
+    CALL histwrite_p(hist_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+    IF ( ok_stomate ) THEN
+       CALL histwrite_p(hist_id_stom, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+       IF ( hist_id_stom_ipcc > 0 ) &
+            CALL histwrite_p(hist_id_stom_IPCC, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+    ENDIF
+    CALL histwrite_p(hist_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+    
+    ! Syncronize output but only if flag ok_histsync is set to true       
+    IF (ok_histsync) THEN
+       IF (is_omp_root .AND. hist_id > 0) THEN
+          CALL histsync(hist_id)
+       END IF
+    END IF
+    
+    IF ( hist2_id > 0 ) THEN
+       CALL histwrite_p(hist2_id, 'LandPoints',  itau_sechiba+1, landpoints, kjpindex, kindex)
+       CALL histwrite_p(hist2_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+       CALL histwrite_p(hist2_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+       
+       ! Syncronize output but only if flag ok_histsync is set to true
+       IF (ok_histsync .AND. is_omp_root) THEN
+          CALL histsync(hist2_id)
+       ENDIF
+    ENDIF
+    !
+    
+    !
+    ! 4. call sechiba for continental points only
+    !
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'Calling sechiba_initialize'
+
+    CALL sechiba_initialize( &
+         itau_sechiba, iim_g*jj_nb,  kjpindex,      kindex,      date0_shifted, &
+         lalo,         contfrac,     neighbours,    resolution,  zlev,          &
+         u,            v,            qair,          t2m_loc,     temp_air,      &
+         petAcoef,     peqAcoef,     petBcoef,      peqBcoef,                   &
+         zprecip_rain, zprecip_snow, lwdown,        swnet,       swdown,        &
+         pb,           rest_id,      hist_id,       hist2_id,                   &
+         rest_id_stom, hist_id_stom, hist_id_stom_IPCC,                         &
+         zcoastal,     zriver,       ztsol_rad,     zvevapp,     zqsurf,        &
+         zz0,          zalbedo,      zfluxsens,     zfluxlat,    zemis,         &
+         znetco2,      zcarblu,      ztemp_sol_new, zcdrag)
+    
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'Out of sechiba_initialize'
+
+    !
+    ! 6. scatter output fields
+    !
+    z0(:)           = undef_sechiba
+    coastalflow(:)  = undef_sechiba
+    riverflow(:)    = undef_sechiba
+    tsol_rad(:)     = undef_sechiba
+    vevapp(:)       = undef_sechiba
+    temp_sol_new(:) = undef_sechiba
+    qsurf(:)        = undef_sechiba
+    albedo(:,1)     = undef_sechiba
+    albedo(:,2)     = undef_sechiba
+    fluxsens(:)     = undef_sechiba
+    fluxlat(:)      = undef_sechiba
+    emis(:)         = undef_sechiba
+    cdrag(:)        = undef_sechiba
+
+    DO ik=1, kjpindex
+       z0(ik)           = zz0(ik)
+       coastalflow(ik)  = zcoastal(ik)
+       riverflow(ik)    = zriver(ik)
+       tsol_rad(ik)     = ztsol_rad(ik)
+       vevapp(ik)       = zvevapp(ik)
+       temp_sol_new(ik) = ztemp_sol_new(ik)
+       qsurf(ik)        = zqsurf(ik)
+       albedo(ik,1)     = zalbedo(ik,1)
+       albedo(ik,2)     = zalbedo(ik,2)
+       fluxsens(ik)     = zfluxsens(ik)
+       fluxlat(ik)      = zfluxlat(ik)
+       emis(ik)         = zemis(ik)
+       cdrag(ik)        = zcdrag(ik)
+    ENDDO
+
+    !
+    ! 7. Transform the water fluxes into Kg/m^2s and m^3/s
+    !
+    DO ik=1, kjpindex
+       vevapp(ik) = vevapp(ik)/xrdt
+       coastalflow(ik) = coastalflow(ik)/xrdt
+       riverflow(ik) = riverflow(ik)/xrdt
+    ENDDO
+    
+    ! Fields for emission variables : to be transport by GCM to chemistry model.
+    DO i = 1, nb_fields_out
+       SELECT CASE(TRIM(field_out_names(i)))
+       CASE("fCO2_land") 
+          fields_out(:,i)=znetco2(:)
+       CASE("fCO2_land_use")
+          fields_out(:,i)=zcarblu(:)
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'intsurf_gathered', &
+               'You ask from GCM an unknown field '//TRIM(field_out_names(i))//&
+               ' to ORCHIDEE for this specific version.',&
+               'This model won''t be able to continue.', &
+               '(check your tracer parameters in GCM)')
+       END SELECT
+    END  DO
+
+    IF(is_root_prc) CALL getin_dump
+    l_first_intersurf = .FALSE.
+    
+    CALL ipslnlf_p(new_number=old_fileout)
+    !
+    !! Change back to be in the LMDZ context for XIOS
+    !
+    CALL xios_orchidee_change_context("LMDZ")
+
+  END SUBROUTINE intersurf_initialize_gathered
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    intersurf_main_gathered
+!!
+!>\BRIEF	  Main subroutine to call ORCHIDEE from the gcm (LMDZ) using variables on a 1D grid with only land points.
+!!
+!! DESCRIPTION:	  This subroutine is the main interface for ORCHIDEE when it is called from the gcm (LMDZ).
+!!                The variables are all gathered before entering this subroutine on the 1D grid with only landpoints.
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE intersurf_main_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
+       lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
+       zlev,  u, v, qair, temp_air, epot_air, ccanopy, &
+       cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+       precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+       vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
+       tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, q2m, t2m, &
+       field_out_names, fields_out, field_in_names, fields_in, &
+       coszang)  
+!       coszang,soil_mc,litter_mc)
+    USE mod_orchidee_para
+    IMPLICIT NONE
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT (in)                            :: kjit            !! Time step number
+    INTEGER(i_std),INTENT (in)                            :: iim_glo         !! Dimension of global fields
+    INTEGER(i_std),INTENT (in)                            :: jjm_glo         !! Dimension of global fields
+    INTEGER(i_std),INTENT (in)                            :: kjpindex        !! Number of continental points
+    REAL(r_std),INTENT (in)                               :: xrdt            !! Time step in seconds
+    LOGICAL, INTENT (in)                                  :: lrestart_read   !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                  :: lrestart_write  !! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                              :: date0           !! Date at which kjit = 0
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: kindex          !! Index for continental points
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: u               !! Lowest level wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: v               !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: zlev            !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: qair            !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: precip_rain     !! Rain precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: precip_snow     !! Snow precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: lwdown          !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: swnet           !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: swdown          !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: temp_air        !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: epot_air        !! Air potential energy
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: ccanopy         !! CO2 concentration in the canopy
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: petAcoef        !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: peqAcoef        !! One for T and another for q
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: petBcoef        !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: peqBcoef        !! One for T and another for q
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: pb              !! Surface pressure
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)        :: latlon          !! Geographical coordinates
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: zcontfrac       !! Fraction of continent
+    INTEGER(i_std),DIMENSION (kjpindex,8), INTENT(in)     :: zneighbours     !! neighbours
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)        :: zresolution     !! size of the grid box
+    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN)   :: lon_scat_g      !! The scattered values for longitude 
+    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN)   :: lat_scat_g      !! The scattered values for latitude
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: z0              !! Surface roughness
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: coastalflow     !! Diffuse flow of water into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: riverflow       !! Largest rivers flowing into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: tsol_rad        !! Radiative surface temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: vevapp          !! Total of evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: temp_sol_new    !! New soil temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: qsurf           !! Surface specific humidity
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(out)       :: albedo          !! Albedo
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: fluxsens        !! Sensible chaleur flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: fluxlat         !! Latent chaleur flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: emis            !! Emissivity
+!    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(inout)   :: soil_mc   !! soil moisture content \f($m^3 \times m^3$)\f
+!    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(inout)    :: litter_mc     !! litter moisture content \f($m^3 \times m^3$)\f
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(inout)       :: cdrag           !! Cdrag
+
+    !! 0.4 Optional input and output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL:: q2m             !! Surface specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL:: t2m             !! Surface air temperature
+    REAL(r_std), DIMENSION(kjpindex), OPTIONAL, INTENT(in):: coszang         !! Cosine of the solar zenith angle (unitless)
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN)   :: field_in_names  !! Names for deposit variables to be transported
+                                                                             !! from chemistry model by GCM to ORCHIDEE
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN)      :: fields_in       !! Fields for deposit variables to be transported 
+                                                                             !! from chemistry model by GCM to ORCHIDEE
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN)   :: field_out_names !! Names for emission variables to be transported 
+                                                                             !! to chemistry model by GCM from ORCHIDEE
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT)     :: fields_out      !! Fields for emission variables to be transported
+                                                                             !! to chemistry model by GCM from ORCHIDEE
+
+    !! 0.5 Local variables
+    REAL(r_std),DIMENSION (kjpindex)                      :: zccanopy      !! Work array to keep ccanopy
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_rain  !! Work array to keep precip_rain
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_snow  !! Work array to keep precip_snow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zz0           !! Work array to keep z0
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcdrag        !! Work array for surface drag
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoastal      !! Work array to keep coastal flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep river out flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoszang      !! Work array to keep coszang
+    REAL(r_std),ALLOCATABLE, DIMENSION (:)                :: soilth_lev    !! Vertical soil axis for thermal scheme (m)
+    REAL(r_std),DIMENSION (kjpindex)                      :: q2m_loc       !! Work array for q2m or qair
+    REAL(r_std),DIMENSION (kjpindex)                      :: t2m_loc       !! Work array for t2m or temp_air
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE               :: lon_scat      !! The scattered values for longitude 
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE               :: lat_scat      !! The scattered values for latitude
+    INTEGER(i_std)                                        :: i, j, ik
+    INTEGER(i_std)                                        :: ier
+    INTEGER(i_std)                                        :: itau_sechiba
+    REAL(r_std)                                           :: mx, zlev_mean
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)              :: tmp_lon, tmp_lat, tmp_lev
+    INTEGER                                               :: old_fileout   !! old Logical Int for std IO output
+    REAL,ALLOCATABLE,DIMENSION(:,:)                       :: lalo_mpi
+    REAL,ALLOCATABLE,DIMENSION(:)                         :: zlev_glo1D
+    REAL(r_std),DIMENSION (kjpindex)                      :: landpoints    !! Local landpoints vector
+    
+
+    CALL ipslnlf_p(new_number=numout, old_number=old_fileout)
+    
+    IF (l_first_intersurf) THEN
+       ! Test if q2m and t2m are present
+       IF (PRESENT(q2m) .AND. PRESENT(t2m)) THEN
+          ok_q2m_t2m=.TRUE.
+       ELSE
+          ok_q2m_t2m=.FALSE.
+       ENDIF
+
+       ! Test if field_out_names and field_in_names are present and if so, count 
+       ! the number of extra fields to exchange.
+       IF (PRESENT(field_out_names)) THEN
+          nb_fields_out=SIZE(field_out_names)
+       ELSE
+          nb_fields_out=0
+       ENDIF
+
+       IF (PRESENT(field_in_names)) THEN
+          nb_fields_in=SIZE(field_in_names)
+       ELSE
+          nb_fields_in=0
+       ENDIF
+    
+       CALL intersurf_initialize_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
+            lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
+            zlev,  u, v, qair, temp_air, epot_air, &
+            cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+            precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+            vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
+            tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, q2m, t2m, &
+            field_out_names, fields_out, field_in_names, fields_in )  
+
+       ! Return from subroutine intersurf_main_gathered
+       RETURN
+    END IF
+
+    !
+    !! Change to be in the orchidee context for XIOS
+    !
+    CALL xios_orchidee_change_context("orchidee")
+    
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    
+    ! Update the calendar in xios by sending the new time step
+    CALL xios_orchidee_update_calendar(itau_sechiba)
+    
+    CALL intsurf_time( itau_sechiba, date0_shifted )
+
+    ! Test LMDz inputs
+    IF (check_INPUTS) THEN
+       IF ( sec <= 7200 ) THEN
+          WRITE(numout,*) "sec = ",sec
+          CALL WriteFieldI_p("Wu",u)
+          WRITE(numout,*) "Lowest level wind speed :",u
+          CALL WriteFieldI_p("Wv",v)
+          WRITE(numout,*) "Lowest level wind speed  :",v
+          CALL WriteFieldI_p("Wzlev",zlev)
+          WRITE(numout,*) "Height of first layer :",zlev
+          CALL WriteFieldI_p("Wqair",qair)
+          WRITE(numout,*) "Lowest level specific humidity :",qair
+          CALL WriteFieldI_p("Wprecip_rain",precip_rain)
+          WRITE(numout,*) "Rain precipitation :",precip_rain
+          CALL WriteFieldI_p("Wprecip_snow",precip_snow)
+          WRITE(numout,*) "Snow precipitation :",precip_snow
+          CALL WriteFieldI_p("Wlwdown",lwdown)
+          WRITE(numout,*) "Down-welling long-wave flux  :",lwdown
+          CALL WriteFieldI_p("Wswnet",swnet)
+          WRITE(numout,*) "Net surface short-wave flux :",swnet
+          CALL WriteFieldI_p("Wswdown",swdown)
+          WRITE(numout,*) "Downwelling surface short-wave flux :",swdown
+          CALL WriteFieldI_p("Wtemp_air",temp_air)
+          WRITE(numout,*) "Air temperature in Kelvin :",temp_air
+          CALL WriteFieldI_p("Wepot_air",epot_air)
+          WRITE(numout,*) "Air potential energy :",epot_air
+          CALL WriteFieldI_p("Wccanopy",ccanopy)
+          WRITE(numout,*) "CO2 concentration in the canopy :",ccanopy
+          CALL WriteFieldI_p("WpetAcoef",petAcoef)
+          WRITE(numout,*) "Coeficients A from the PBL resolution :",petAcoef
+          CALL WriteFieldI_p("WpeqAcoef",peqAcoef)
+          WRITE(numout,*) "One for T and another for q :",peqAcoef
+          CALL WriteFieldI_p("WpetBcoef",petBcoef)
+          WRITE(numout,*) "Coeficients B from the PBL resolution :",petBcoef
+          CALL WriteFieldI_p("WpeqBcoef",peqBcoef)
+          WRITE(numout,*) "One for T and another for q :",peqBcoef
+          CALL WriteFieldI_p("Wcdrag",cdrag)
+          WRITE(numout,*) "Cdrag :",cdrag
+          CALL WriteFieldI_p("Wpb",pb)
+          WRITE(numout,*) "Surface pressure :",pb
+          CALL WriteFieldI_p("Wzcontfrac",zcontfrac)
+          WRITE(numout,*) "Fraction of continent :",zcontfrac
+          IF ( ok_q2m_t2m) THEN
+             CALL WriteFieldI_p("Wq2m",q2m)
+             WRITE(numout,*) "Surface specific humidity :",q2m
+             CALL WriteFieldI_p("Wt2m",t2m)
+             WRITE(numout,*) "Surface air temperature :",t2m
+          ENDIF
+       ENDIF
+    ENDIF
+
+    !
+    ! 1. Just change the units of some input fields
+    !
+    DO ik=1, kjpindex
+       
+       zprecip_rain(ik) = precip_rain(ik)*xrdt
+       zprecip_snow(ik) = precip_snow(ik)*xrdt
+       zcdrag(ik)       = cdrag(ik)
+       
+    ENDDO
+
+    !>> VOC in coupled mode 
+    IF ( PRESENT(coszang) )  THEN 
+       zcoszang(:) = coszang(:)
+    ELSE
+       zcoszang(:) = zero
+    ENDIF
+ 
+    IF (check_INPUTS) THEN
+       WRITE(numout,*) "Intersurf_main_gathered :"
+       WRITE(numout,*) "Time step number = ",kjit
+       WRITE(numout,*) "Dimension of input fields for local mpi process = ",iim_g, jj_nb
+       WRITE(numout,*) "Number of continental points = ",kjpindex
+       WRITE(numout,*) "Time step in seconds = ",xrdt
+       WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
+       WRITE(numout,*) "Date at which kjit = 0  =  ",date0
+       WRITE(numout,*) "offset for OMP = ",offset_omp
+       WRITE(numout,*) "Index for continental points = ",kindex
+       IF (is_omp_root) THEN
+          WRITE(numout,*) "ROOT OMP, Index global MPI : ",kindex_mpi(:)
+       ENDIF
+       IF (is_root_prc) THEN
+          WRITE(numout,*) "ROOT global, Index global : ",index_g(:)
+       ENDIF
+       WRITE(numout,*) "Lowest level wind speed North = ",u
+       WRITE(numout,*) "Lowest level wind speed East = ",v
+       WRITE(numout,*) "Height of first layer = ",zlev
+       WRITE(numout,*) "Lowest level specific humidity = ",qair
+       WRITE(numout,*) "Rain precipitation = ",zprecip_rain
+       WRITE(numout,*) "Snow precipitation = ",zprecip_snow
+       WRITE(numout,*) "Down-welling long-wave flux = ",lwdown
+       WRITE(numout,*) "Net surface short-wave flux = ",swnet
+       WRITE(numout,*) "Downwelling surface short-wave flux = ",swdown
+       WRITE(numout,*) "Air temperature in Kelvin = ",temp_air
+       WRITE(numout,*) "Air potential energy = ",epot_air
+       WRITE(numout,*) "CO2 concentration in the canopy = ",ccanopy
+       WRITE(numout,*) "Coeficients A from the PBL resolution = ",petAcoef
+       WRITE(numout,*) "One for T and another for q = ",peqAcoef
+       WRITE(numout,*) "Coeficients B from the PBL resolution = ",petBcoef
+       WRITE(numout,*) "One for T and another for q = ",peqBcoef
+       WRITE(numout,*) "Cdrag = ",zcdrag
+       WRITE(numout,*) "Surface pressure = ",pb
+       WRITE(numout,*) "Geographical land coordinates lon = ", lalo(:,2)
+       WRITE(numout,*) "Geographical land coordinates lat = ", lalo(:,1)
+       WRITE(numout,*) "Fraction of continent in the grid = ",zcontfrac
+    ENDIF
+
+
+    ! Fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE.
+    DO i = 1, nb_fields_in
+       WRITE(numout,*) i," Champ = ",TRIM(field_in_names(i)) 
+       SELECT CASE(TRIM(field_in_names(i)))
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'intsurf_gathered', &
+               'You ask in GCM an unknown field '//TRIM(field_in_names(i))//&
+               ' to give to ORCHIDEE for this specific version.',&
+               'This model won''t be able to continue.', &
+               '(check your tracer parameters in GCM)')
+       END SELECT
+    ENDDO
+
+    !
+    ! 2. modification of co2
+    !
+    IF ( fatmco2 ) THEN
+       zccanopy(:) = atmco2
+       WRITE (numout,*) 'Modification of the ccanopy value. CO2 = ',atmco2
+    ELSE
+       zccanopy(:) = ccanopy(:)
+    ENDIF
+
+    !
+    ! 4. call sechiba for continental points only
+    !
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'Calling sechiba'
+   
+
+    IF (ok_q2m_t2m) THEN
+       t2m_loc=t2m
+       q2m_loc=q2m
+    ELSE
+       t2m_loc=temp_air
+       q2m_loc=qair
+    END IF
+
+    CALL sechiba_main (itau_sechiba, iim_g*jj_nb, kjpindex, kindex, date0_shifted, &
+         lrestart_read, lrestart_write, &
+         lalo, contfrac, neighbours, resolution, &
+         zlev, u, v, qair, q2m_loc, t2m_loc, temp_air, epot_air, zccanopy, &
+         zcdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+         zprecip_rain ,zprecip_snow,  lwdown, swnet, swdown, zcoszang, pb, &
+         zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
+         ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, &
+         rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC ) 
+!         rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, &
+!         hist_id_stom_IPCC,soil_mc,litter_mc )
+    IF ( printlev_loc>=3 ) WRITE(numout,*) 'out of SECHIBA'
+
+    !
+    ! 6. scatter output fields
+    !
+    z0(:)           = undef_sechiba
+    coastalflow(:)  = undef_sechiba
+    riverflow(:)    = undef_sechiba
+    tsol_rad(:)     = undef_sechiba
+    vevapp(:)       = undef_sechiba
+    temp_sol_new(:) = undef_sechiba
+    qsurf(:)        = undef_sechiba
+    albedo(:,1)     = undef_sechiba
+    albedo(:,2)     = undef_sechiba
+    fluxsens(:)     = undef_sechiba
+    fluxlat(:)      = undef_sechiba
+    emis(:)         = undef_sechiba
+    cdrag(:)        = undef_sechiba
+    !    
+
+    DO ik=1, kjpindex
+       
+       z0(ik)           = zz0(ik)
+       coastalflow(ik)  = zcoastal(ik)
+       riverflow(ik)    = zriver(ik)
+       tsol_rad(ik)     = ztsol_rad(ik)
+       vevapp(ik)       = zvevapp(ik)
+       temp_sol_new(ik) = ztemp_sol_new(ik)
+       qsurf(ik)        = zqsurf(ik)
+       albedo(ik,1)     = zalbedo(ik,1)
+       albedo(ik,2)     = zalbedo(ik,2)
+       fluxsens(ik)     = zfluxsens(ik)
+       fluxlat(ik)      = zfluxlat(ik)
+       emis(ik)         = zemis(ik)
+       cdrag(ik)        = zcdrag(ik)
+       
+      
+
+       
+    ENDDO
+
+       
+    CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
+    CALL xios_orchidee_send_field("Areas", area)
+    CALL xios_orchidee_send_field("Contfrac",contfrac)
+    CALL xios_orchidee_send_field("evap",zvevapp*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("evap_alma",zvevapp/dt_sechiba)
+    CALL xios_orchidee_send_field("coastalflow",zcoastal/dt_sechiba)
+    CALL xios_orchidee_send_field("riverflow",zriver/dt_sechiba)
+    CALL xios_orchidee_send_field("temp_sol_C",ztemp_sol_new-ZeroCelsius)
+    CALL xios_orchidee_send_field("temp_sol_K",ztemp_sol_new)
+    CALL xios_orchidee_send_field("fluxsens",zfluxsens)
+    CALL xios_orchidee_send_field("fluxlat",zfluxlat)
+    CALL xios_orchidee_send_field("alb_vis",zalbedo(:,1))
+    CALL xios_orchidee_send_field("alb_nir",zalbedo(:,2))
+    CALL xios_orchidee_send_field("tair",temp_air)
+    CALL xios_orchidee_send_field("qair",qair)
+    CALL xios_orchidee_send_field("swnet",swnet)
+    CALL xios_orchidee_send_field("swdown",swdown)
+    ! pb in hPa, output in Pa
+    CALL xios_orchidee_send_field("Psurf",pb*100.)
+
+ 
+    IF (ok_q2m_t2m) THEN
+       CALL xios_orchidee_send_field("t2m",t2m)
+       CALL xios_orchidee_send_field("q2m",q2m)
+    ELSE
+       CALL xios_orchidee_send_field("t2m",temp_air)
+       CALL xios_orchidee_send_field("q2m",qair)
+    ENDIF
+    
+    IF ( .NOT. almaoutput ) THEN
+       !
+       !  scattered during the writing
+       !           
+       CALL histwrite_p (hist_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
+       ! 
+       CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+       
+       CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'fluxlat',  itau_sechiba, zfluxlat,  kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'swnet',    itau_sechiba, swnet,    kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'swdown',   itau_sechiba, swdown,   kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'tair',     itau_sechiba, temp_air, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'qair',     itau_sechiba, qair, kjpindex, kindex)
+       IF (ok_q2m_t2m) THEN
+          CALL histwrite_p (hist_id, 't2m',      itau_sechiba, t2m, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'q2m',      itau_sechiba, q2m, kjpindex, kindex)
+       ELSE
+          CALL histwrite_p (hist_id, 't2m',      itau_sechiba, temp_air, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'q2m',      itau_sechiba, qair, kjpindex, kindex)
+       ENDIF
+       !
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p (hist2_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
+          ! 
+          CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, temp_sol_new, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, temp_sol_new, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, temp_sol_new, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'fluxlat',  itau_sechiba, zfluxlat,  kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'swnet',    itau_sechiba, swnet,    kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'swdown',   itau_sechiba, swdown,   kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'tair',     itau_sechiba, temp_air, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'qair',     itau_sechiba, qair, kjpindex, kindex)
+          IF (ok_q2m_t2m) THEN
+             CALL histwrite_p (hist2_id, 't2m',      itau_sechiba, t2m, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'q2m',      itau_sechiba, q2m, kjpindex, kindex)
+          ELSE
+             CALL histwrite_p (hist2_id, 't2m',      itau_sechiba, temp_air, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'q2m',      itau_sechiba, qair, kjpindex, kindex)
+          ENDIF
+       ENDIF
+    ELSE
+       CALL histwrite_p (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'SWnet',    itau_sechiba, swnet, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+       CALL histwrite_p (hist_id, 'RadT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+       !
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'SWnet',    itau_sechiba, swnet, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+          CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+       ENDIF
+    ENDIF
+    
+    ! Syncronize output but only if flag ok_histsync is set to true
+    IF (ok_histsync .AND. is_omp_root) THEN
+       IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
+          CALL histsync(hist_id)
+       ENDIF
+    ENDIF
+    
+    !
+    ! 7. Transform the water fluxes into Kg/m^2s and m^3/s
+    !
+    DO ik=1, kjpindex
+       
+       vevapp(ik) = vevapp(ik)/xrdt
+       coastalflow(ik) = coastalflow(ik)/xrdt
+       riverflow(ik) = riverflow(ik)/xrdt
+       
+    ENDDO
+    
+    ! Fields for emission variables : to be transport by GCM to chemistry model.
+    DO i = 1, nb_fields_out
+       SELECT CASE(TRIM(field_out_names(i)))
+       CASE("fCO2_land") 
+          fields_out(:,i)=znetco2(:)
+       CASE("fCO2_land_use")
+          fields_out(:,i)=zcarblu(:)
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'intsurf_gathered', &
+            &          'You ask from GCM an unknown field '//TRIM(field_out_names(i))//&
+            &          ' to ORCHIDEE for this specific version.',&
+            &          'This model won''t be able to continue.', &
+            &          '(check your tracer parameters in GCM)')
+       END SELECT
+    ENDDO
+
+    IF (printlev_loc >=3) WRITE (numout,*) ' intersurf_main done '
+
+!Test ORCHIDEE Outputs
+    IF (check_INPUTS) THEN
+       IF ( sec <= 7200 ) THEN
+          CALL WriteFieldI_p("Wcdrag",cdrag)
+          WRITE(numout,*) "Cdrag :",cdrag
+          CALL WriteFieldI_p("Wz0",z0)
+          WRITE(numout,*) "Surface roughness :",z0
+          CALL WriteFieldI_p("Wcoastalflow",coastalflow)
+          WRITE(numout,*) "Diffuse flow of water into the ocean (m^3/dt) :",coastalflow
+          CALL WriteFieldI_p("Wriverflow",riverflow)
+          WRITE(numout,*) "Largest rivers flowing into the ocean (m^3/dt) :",riverflow
+          CALL WriteFieldI_p("Wtsol_rad",tsol_rad)
+          WRITE(numout,*) "Radiative surface temperature :",tsol_rad
+          CALL WriteFieldI_p("Wvevapp",vevapp)
+          WRITE(numout,*) "Total of evaporation :",vevapp
+          CALL WriteFieldI_p("Wtemp_sol_new",temp_sol_new)
+          WRITE(numout,*) "New soil temperature :",temp_sol_new
+          CALL WriteFieldI_p("Wqsurf",qsurf)
+          WRITE(numout,*) "Surface specific humidity :",qsurf
+          CALL WriteFieldI_p("Walbedo_nir",albedo(:,1))
+          WRITE(numout,*) "Albedo nir:",albedo(:,1)
+          CALL WriteFieldI_p("Walbedo_vis",albedo(:,2))
+          WRITE(numout,*) "Albedo vir :",albedo(:,2)
+          CALL WriteFieldI_p("Wfluxsens",fluxsens)
+          WRITE(numout,*) "Sensible chaleur flux :",fluxsens
+          CALL WriteFieldI_p("Wfluxlat",fluxlat)
+          WRITE(numout,*) "Latent chaleur flux :",fluxlat
+          CALL WriteFieldI_p("Wemis",emis)
+          WRITE(numout,*) "Emissivity :",emis
+       ENDIF
+    ENDIF
+    !
+    CALL ipslnlf_p(new_number=old_fileout)
+    !        
+
+    !
+    !! Finalize the XIOS orchidee context if it is the last call
+    !
+    IF (lrestart_write) THEN
+       CALL xios_orchidee_context_finalize
+    END IF
+    !
+    !! Change back to be in the LMDZ context for XIOS
+    !
+    CALL xios_orchidee_change_context("LMDZ")
+
+    
+  END SUBROUTINE intersurf_main_gathered
+
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    intsurf_time
+!!
+!>\BRIEF	  Initalize and update time information
+!!
+!! DESCRIPTION:	  Initialize and update time information. This subroutine is called in the initialization phase and at each 
+!!                time step from the different intersurf subroutines. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE intsurf_time(istp, date0)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std), INTENT(in)                  :: istp      !! Time step of the restart file
+    REAL(r_std), INTENT(in)                     :: date0     !! The date at which itau = 0
+
+    IF (l_first_intersurf) THEN
+       CALL ioget_calendar(calendar_str)
+       CALL ioget_calendar(one_year, one_day)
+       CALL tlen2itau('1Y',dt_sechiba,date0,year_length)
+       IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN  
+          year_spread=un
+       ELSE
+          year_spread = one_year/365.2425
+       ENDIF
+
+       IF (printlev_loc >=3) THEN
+          write(numout,*) "calendar_str =",calendar_str
+          write(numout,*) "one_year=",one_year,", one_day=",one_day
+          write(numout,*) "dt_sechiba=",dt_sechiba,", date0=",date0,", year_length=",year_length,", year_spread=",year_spread
+       ENDIF
+    ENDIF
+
+    IF ( printlev_loc >=4 ) WRITE(numout,*) "---" 
+    ! Dans diffuco (ie date0 == date0_shift !!) 
+
+    IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN  
+       !
+       ! Get Julian date
+       in_julian = itau2date(istp, date0, dt_sechiba)
+
+       ! Real date
+       CALL ju2ymds (in_julian, year, month, day, sec)
+!!$       jur=zero
+!!$       julian_diff = in_julian
+!!$       month_len = ioget_mon_len (year,month)
+!!$       IF ( printlev_loc >=4 ) THEN
+!!$          write(numout,*) "in_julian, jur, julian_diff=",in_julian, jur, julian_diff
+!!$          write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+!!$       ENDIF
+
+       ! julian number for january, the first.
+       CALL ymds2ju (year,1,1,zero, julian0)
+       julian_diff = in_julian-julian0
+       ! real number of seconds
+!       sec = (julian_diff-REAL(INT(julian_diff)))*one_day
+       sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day)
+       month_len = ioget_mon_len (year,month)
+       IF ( printlev_loc >=4 ) THEN
+          write(numout,*) "2 in_julian, julian0, julian_diff=",in_julian, julian0, julian_diff
+          write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+       ENDIF
+    ELSE 
+!!$       in_julian = itau2date(istp-1, zero, dt)
+!!$       CALL ju2ymds (in_julian, year, month, day, sec)
+!!$       jur=zero
+!!$       julian_diff = in_julian
+!!$       month_len = ioget_mon_len (year,month)
+!!$       IF (printlev_loc >=4) THEN
+!!$          write(numout,*) "in_julian=",in_julian, jur, julian_diff
+!!$          write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+!!$       ENDIF
+!!$
+!!$
+!!$       CALL ymds2ju (year,1,1,zero, jur)
+!!$       julian_diff = in_julian-jur
+!!$       CALL ju2ymds (julian_diff, year, month, day, sec)
+!!$!       sec = (julian_diff-REAL(INT(julian_diff)))*one_day
+!!$       sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day)
+!!$       month_len = ioget_mon_len (year,month)
+!!$       IF (printlev_loc >=4) THEN
+!!$          write(numout,*) "2 in_julian, jur, julian_diff=",in_julian, jur, julian_diff
+!!$          write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+!!$       ENDIF
+
+!MM
+!PB date0 = celui de Soenke (Ã  tester avec un autre date0)
+!       in_julian = itau2date(istp, 153116., dt)
+       in_julian = itau2date(istp, date0, dt_sechiba)
+       CALL itau2ymds(istp, dt_sechiba, year, month, day, sec)
+       CALL ymds2ju (year,1,1,zero, julian0)
+       julian_diff = in_julian - julian0
+       month_len = ioget_mon_len (year,month)
+       IF (printlev_loc >=4) THEN
+          write(numout,*) "in_julian=",in_julian, julian0, julian_diff
+          write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+       ENDIF
+    ENDIF
+
+  END SUBROUTINE intsurf_time
+
+END MODULE intersurf
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/ioipslctrl.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/ioipslctrl.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/ioipslctrl.f90	(revision 5166)
@@ -0,0 +1,3469 @@
+! ================================================================================================================================
+!  MODULE       : ioipslctrl
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF          This module contains subroutine for initialisation of IOIPSL history files and restart files
+!!
+!!\n DESCRIPTION: This module contains subroutine for initialisation of IOIPSL history files and restart files. The subroutines
+!!                ioipslctrl_history, ioipslctrl_histstom, ioipslctrl_histstomipcc, ioipslctrl_restini where previously stored in
+!!                intersurf module. 
+!!
+!! RECENT CHANGE(S): 
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/trunk/ORCHIDEE/src_sechiba/ioipslctrl.f90 $
+!! $Date: 2015-02-19 18:42:48 +0100 (jeu. 19 fÃ©vr. 2015) $
+!! $Revision: 2548 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE ioipslctrl
+
+  USE IOIPSL
+  USE ioipsl_para 
+  USE defprec
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE thermosoilc, ONLY : thermosoilc_levels
+
+  IMPLICIT NONE
+
+
+  LOGICAL, SAVE                    :: ok_histsync             !! Flag activate syncronization of IOIPSL output
+  !$OMP THREADPRIVATE(ok_histsync)
+   REAL(r_std), SAVE               :: dw                      !! Frequency of history write (sec.)
+!$OMP THREADPRIVATE(dw)
+  INTEGER(i_std),PARAMETER         :: max_hist_level = 11     !! 
+
+  PRIVATE
+  PUBLIC :: ioipslctrl_history, ioipslctrl_histstom, ioipslctrl_histstomipcc, ioipslctrl_restini
+  PUBLIC :: dw, max_hist_level, ok_histsync
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE    : ioipslctrl_history
+!!
+!>\BRIEF	 This subroutine initialize the IOIPSL output files
+!! 
+!! DESCRIPTION   : This subroutine initialize the IOIPSL output files sechiab_history.nc and sechiba_out_2.nc. It also calls the
+!!                 the subroutines ioipslctrl_histstom and ioipslctrl_histstomipcc for initialization of the IOIPSL stomate output files.
+!!                 This subroutine was previously called intsurf_history and located in module intersurf.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE ioipslctrl_history(iim, jjm, lon, lat, kindex, kjpindex, istp_old, date0, dt, hist_id, hist2_id, &
+       hist_id_stom, hist_id_stom_IPCC)
+    
+    USE mod_orchidee_para
+    !   
+    !  This subroutine initialized the history files for the land-surface scheme
+    !
+    IMPLICIT NONE
+    
+    INTEGER(i_std), INTENT(in)                  :: iim, jjm  !! Size in x and y of the data to be handeled
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat  !! Longitude and latitude of the data points
+    INTEGER(i_std),INTENT (in)                            :: kjpindex
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: kindex
+    
+    INTEGER(i_std), INTENT(in)                  :: istp_old  !! Time step counter
+    REAL(r_std), INTENT(in)                     :: date0     !! Julian day at which istp=0
+    REAL(r_std), INTENT(in)                     :: dt        !! Time step of the counter in seconds
+
+    INTEGER(i_std), INTENT(out)                 :: hist_id   !! History file identification for SECHIBA
+    INTEGER(i_std), INTENT(out)                 :: hist2_id  !! History file 2 identification for SECHIBA
+    !! History file identification for STOMATE and IPCC
+    INTEGER(i_std), INTENT(out)                 :: hist_id_stom, hist_id_stom_IPCC 
+    !
+    !  LOCAL
+    !
+    CHARACTER(LEN=80) :: histname,histname2                    !! Name of history files for SECHIBA
+    CHARACTER(LEN=80) :: stom_histname, stom_ipcc_histname     !! Name of history files for STOMATE
+    LOGICAL           :: ok_histfile2                 !! Flag to switch on histfile 2 for SECHIBA
+    REAL(r_std)       :: dw2                          !! frequency of history write (sec.)
+    CHARACTER(LEN=30)   :: flux_op                    !! Operations to be performed on fluxes
+    CHARACTER(LEN=40)   :: flux_insec, flux_scinsec   !! Operation in seconds
+    INTEGER(i_std)     :: hist_level, hist2_level     !! history output level (default is 10 => maximum output)
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: &
+         & ave, avecels, avescatter, fluxop, &
+         & fluxop_scinsec, tmincels, tmaxcels, once, sumscatter  !! The various operation to be performed
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: &
+         & ave2, avecels2, avescatter2, fluxop2, &
+         & fluxop_scinsec2, tmincels2, tmaxcels2, once2, sumscatter2  !! The various operation to be performed
+    CHARACTER(LEN=80) :: global_attribute              !! for writing attributes in the output files
+    INTEGER(i_std)     :: i, jst
+    ! SECHIBA AXIS
+    INTEGER(i_std)     :: hori_id                      !! ID of the default horizontal longitude and latitude map.
+    INTEGER(i_std)     :: vegax_id, laiax_id, solax_id, soltax_id, nobioax_id !! ID's for two vertical coordinates
+    INTEGER(i_std)     :: soildiagax_id                !! ID for diagnostic soil levels
+    INTEGER(i_std)     :: solayax_id                   !! ID for the vertical axis of the CWRR hydrology 
+    INTEGER(i_std)     :: hori_id2                      !! ID of the default horizontal longitude and latitude map.
+    INTEGER(i_std)     :: vegax_id2, laiax_id2, solax_id2, soltax_id2, nobioax_id2, albax_id2 !! ID's for two vertical coordinates
+    INTEGER(i_std)     :: solayax_id2                   !! ID for the vertical axis of the CWRR hydrology 
+    INTEGER(i_std)     :: snowax_id                     !! ID for snow level axis
+
+    ! STOMATE AXIS
+    INTEGER(i_std)     :: hist_PFTaxis_id
+    INTEGER(i_std)     :: hist_solax_id
+! deforestation
+    INTEGER(i_std)     :: hist_pool_10axis_id
+    INTEGER(i_std)     :: hist_pool_100axis_id
+    INTEGER(i_std)     :: hist_pool_11axis_id
+    INTEGER(i_std)     :: hist_pool_101axis_id
+    ! STOMATE IPCC AXIS
+    INTEGER(i_std)     :: hist_IPCC_PFTaxis_id
+    !
+    LOGICAL                               :: rectilinear
+    INTEGER(i_std)                         :: ier
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lon_rect, lat_rect
+    !
+    REAL(r_std),DIMENSION(nvm)   :: veg
+    REAL(r_std),DIMENSION(nlai+1):: lai
+    REAL(r_std),DIMENSION(ngrnd) :: sol
+    REAL(r_std),DIMENSION(nstm)  :: soltyp
+    REAL(r_std),DIMENSION(nnobio):: nobiotyp
+    REAL(r_std),DIMENSION(2)     :: albtyp
+    REAL(r_std),DIMENSION(nslm)  :: solay
+    REAL(r_std),DIMENSION(nsnow) :: snowlev           !! Layers for snow axis
+    !
+    CHARACTER(LEN=80)           :: var_name           !! To store variables names
+    !
+    ! STOMATE history file
+    REAL(r_std)                  :: hist_days_stom     !!- GK time step in days for this history file
+    REAL(r_std)                  :: hist_dt_stom       !!- GK time step in seconds for this history file
+    REAL(r_std)                  :: dt_stomate_loc     !!  for test : time step of slow processes and STOMATE
+    REAL(r_std),DIMENSION(nvm)   :: hist_PFTaxis       !!- GK An axis we need for the history files
+!
+    REAL(r_std),DIMENSION(10)  :: hist_pool_10axis     !! Deforestation axis
+    REAL(r_std),DIMENSION(100)  :: hist_pool_100axis     !! Deforestation axis
+    REAL(r_std),DIMENSION(11)  :: hist_pool_11axis     !! Deforestation axis
+    REAL(r_std),DIMENSION(101)  :: hist_pool_101axis     !! Deforestation axis
+    !
+    ! IPCC history file
+    REAL(r_std)                  :: hist_days_stom_ipcc     !!- GK time step in days for this history file
+    REAL(r_std)                  :: hist_dt_stom_ipcc       !!- GK time step in seconds for this history file
+!
+    !
+    !=====================================================================
+    !- 3.0 Setting up the history files
+    !=====================================================================
+    !- 3.1 SECHIBA
+    !=====================================================================
+    !Config Key   = ALMA_OUTPUT
+    !Config Desc  = Should the output follow the ALMA convention
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = If this logical flag is set to true the model
+    !Config         will output all its data according to the ALMA 
+    !Config         convention. It is the recommended way to write
+    !Config         data out of ORCHIDEE.
+    !Config Units = [FLAG]
+    CALL getin_p('ALMA_OUTPUT', almaoutput)    
+    WRITE(numout,*) 'ALMA_OUTPUT', almaoutput
+    !-
+    !Config Key   = OUTPUT_FILE
+    !Config Desc  = Name of file in which the output is going to be written
+    !Config If    = OK_SECHIBA
+    !Config Def   = sechiba_history.nc
+    !Config Help  = This file is going to be created by the model
+    !Config         and will contain the output from the model.
+    !Config         This file is a truly COADS compliant netCDF file.
+    !Config         It will be generated by the hist software from
+    !Config         the IOIPSL package.
+    !Config Units = [FILE]
+    !-
+    histname='sechiba_history.nc'
+    CALL getin_p('OUTPUT_FILE', histname)
+    WRITE(numout,*) 'OUTPUT_FILE', histname
+    !-
+    !Config Key   = WRITE_STEP
+    !Config Desc  = Frequency in seconds for sechiba_history.nc file with IOIPSL
+    !Config If    = OK_SECHIBA, NOT XIOS_ORCHIDEE_OK
+    !Config Def   = one_day
+    !Config Help  = This variables gives the frequency in the output
+    !Config         file sechiba_history.nc if using IOIPSL.
+    !Config         This variable is not read if XIOS is activated.
+    !Config Units = [seconds]
+    !-
+    dw = one_day
+    IF (xios_orchidee_ok) THEN
+      dw=0
+      IF (printlev>=3) WRITE(numout,*) 'All IOIPSL output are deactivated because this run uses XIOS'
+    ELSE
+      CALL getin_p('WRITE_STEP', dw)
+      IF ( dw == 0 ) WRITE(numout,*) 'sechiba_history file will not be created'
+    END IF
+    !
+    veg(1:nvm)   = (/ (REAL(i,r_std),i=1,nvm) /)
+    lai(1:nlai+1) = (/ (REAL(i,r_std),i=1,nlai+1) /)
+    soltyp(1:nstm) = (/ (REAL(i,r_std),i=1,nstm) /)
+    nobiotyp(1:nnobio) = (/ (REAL(i,r_std),i=1,nnobio) /)
+    albtyp(1:2) = (/ (REAL(i,r_std),i=1,2) /)
+    solay(1:nslm) = (/ (REAL(i,r_std),i=1,nslm) /)
+    snowlev =  (/ (REAL(i,r_std),i=1,nsnow) /)
+
+    ! Get the vertical soil levels for the thermal scheme
+    IF (hydrol_cwrr) THEN
+       sol(1:ngrnd) = znt(:)
+    ELSE
+       sol(1:ngrnd) = thermosoilc_levels()
+    END IF
+
+    !
+    !- We need to flux averaging operation as when the data is written
+    !- from within SECHIBA a scatter is needed. In the driver on the other
+    !- hand the data is 2D and can be written is it is.
+    !-
+    WRITE(flux_op,'("ave(scatter(X*",F8.1,"))")') one_day/dt
+    ! WRITE(flux_op,'("(ave(scatter(X))*",F8.1,")")') one_day/dt
+!    WRITE(flux_sc,'("ave(X*",F8.1,")")') one_day/dt
+!    WRITE(flux_insec,'("ave(X*",F8.6,")")') un/dt
+!    WRITE(flux_insec,'("ave(X*",F12.10,")")') un/dt
+    WRITE(flux_scinsec,'("ave(scatter(X*",F12.10,"))")') un/dt
+    WRITE(numout,*) 'flux_op=',flux_op,' one_day/dt=', one_day/dt, ' dt=',dt,' dw=', dw
+    !-
+    !Config Key   = SECHIBA_HISTLEVEL
+    !Config Desc  = SECHIBA history output level (0..10)
+    !Config If    = OK_SECHIBA and HF
+    !Config Def   = 5
+    !Config Help  = Chooses the list of variables in the history file. 
+    !Config         Values between 0: nothing is written; 10: everything is 
+    !Config         written are available More details can be found on the web under documentation.
+    !Config Units = [-]
+    !-
+    hist_level = 5
+    CALL getin_p('SECHIBA_HISTLEVEL', hist_level)
+    !-
+    WRITE(numout,*) 'SECHIBA history level: ',hist_level
+    IF ( (hist_level > max_hist_level).OR.(hist_level < 0) ) THEN
+       STOP 'This history level is not allowed'
+    ENDIF
+    !-
+    !- define operations as a function of history level.
+    !- Above hist_level, operation='never'
+    !-
+    ave(1:max_hist_level) = 'ave(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       ave(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    sumscatter(1:max_hist_level) = 't_sum(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       sumscatter(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    avecels(1:max_hist_level) = 'ave(cels(scatter(X)))'
+    IF (hist_level < max_hist_level) THEN
+       avecels(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    avescatter(1:max_hist_level) = 'ave(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       avescatter(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    tmincels(1:max_hist_level) = 't_min(cels(scatter(X)))'
+    IF (hist_level < max_hist_level) THEN
+       tmincels(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    tmaxcels(1:max_hist_level) = 't_max(cels(scatter(X)))'
+    IF (hist_level < max_hist_level) THEN
+       tmaxcels(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    fluxop(1:max_hist_level) = flux_op
+    IF (hist_level < max_hist_level) THEN
+       fluxop(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    fluxop_scinsec(1:max_hist_level) = flux_scinsec
+    IF (hist_level < max_hist_level) THEN
+       fluxop_scinsec(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    once(1:max_hist_level) = 'once(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       once(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+
+    !- Initialize sechiba_history output file
+    !- 
+    IF ( dw == 0 ) THEN
+       ! sechiba_history file will not be created.
+       hist_id = -1
+
+    ELSE
+       ! sechiba_history file will be created
+
+       !- Calculation necessary for initialization of sechiba_history file
+       !- Check if we have by any change a rectilinear grid. This would allow us to 
+       !- simplify the output files.
+    IF (is_omp_root) THEN
+
+       rectilinear = .FALSE.
+       IF ( ALL(lon(:,:) == SPREAD(lon(:,1), 2, SIZE(lon,2))) .AND. &
+            & ALL(lat(:,:) == SPREAD(lat(1,:), 1, SIZE(lat,1))) ) THEN
+          rectilinear = .TRUE.
+          ALLOCATE(lon_rect(iim),stat=ier)
+          IF (ier .NE. 0) THEN
+             WRITE (numout,*) ' error in lon_rect allocation. We stop. We need iim words = ',iim
+             STOP 'intersurf_history'
+          ENDIF
+          ALLOCATE(lat_rect(jjm),stat=ier)
+          IF (ier .NE. 0) THEN
+             WRITE (numout,*) ' error in lat_rect allocation. We stop. We need jjm words = ',jjm
+             STOP 'intersurf_history'
+          ENDIF
+          lon_rect(:) = lon(:,1)
+          lat_rect(:) = lat(1,:)
+       ENDIF
+       !-
+       !-
+       !-
+       ! Initialize sechiba_history file
+       IF ( .NOT. almaoutput ) THEN
+          !- 
+          IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+             CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id,orch_domain_id)
+#else
+             CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id)
+#endif
+             WRITE(numout,*)  'HISTBEG --->',istp_old,date0,dt,dw,hist_id
+          ELSE
+#ifdef CPP_PARA
+             CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id,domain_id=orch_domain_id)
+#else
+             CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id)
+#endif
+          ENDIF
+          !-
+          CALL histvert(hist_id, 'veget', 'Vegetation types', '1', &
+               &    nvm,   veg, vegax_id)
+          CALL histvert(hist_id, 'laiax', 'Nb LAI', '1', &
+               &    nlai+1,   lai, laiax_id)
+          CALL histvert(hist_id, 'solth', 'Soil levels',      'm', &
+               &    ngrnd, sol, solax_id)
+          CALL histvert(hist_id, 'soiltyp', 'Soil types',      '1', &
+               &    nstm, soltyp, soltax_id)
+          CALL histvert(hist_id, 'nobio', 'Other surface types',      '1', &
+               &    nnobio, nobiotyp, nobioax_id)
+          IF (  hydrol_cwrr ) THEN
+             CALL histvert(hist_id, 'solay', 'Hydrol soil levels',      'm', &
+                  &    nslm, diaglev(1:nslm), solayax_id)
+             CALL histvert(hist_id, 'soildiag', 'Diagnostic soil levels', 'm', &
+                  &    nbdl, diaglev(1:nbdl), soildiagax_id)
+          ENDIF
+
+          CALL histvert(hist_id, 'snowlev', 'Snow levels',      'm', &
+               &    nsnow, snowlev, snowax_id)
+
+          !-
+          !- SECHIBA_HISTLEVEL = 1
+          !-
+          CALL histdef(hist_id, 'evap', 'Evaporation', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
+          CALL histdef(hist_id, 'coastalflow', 'Diffuse coastal flow', 'm^3/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'riverflow', 'River flow to the oceans', 'm^3/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw) 
+          CALL histdef(hist_id, 'temp_sol', 'Surface Temperature', 'C', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avecels(1), dt,dw)
+          CALL histdef(hist_id, 'rain', 'Rainfall', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
+          CALL histdef(hist_id, 'snowf', 'Snowfall', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
+          CALL histdef(hist_id, 'netrad', 'Net radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'lai', 'Leaf Area Index', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(1), dt,dw)
+          !
+          IF (  hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'reinf_slope', 'Slope index for each grid box', '1', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1),  dt,dw)
+             CALL histdef(hist_id, 'soilindex', 'Soil index', '1', &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, once(1),  dt,dw)
+          ENDIF
+          !
+          IF ( river_routing ) THEN
+             CALL histdef(hist_id, 'basinmap', 'Aproximate map of the river basins', ' ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw) 
+             CALL histdef(hist_id, 'nbrivers', 'Number or rivers in the outflow grid box', ' ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)  
+          ENDIF
+          !-
+          !- SECHIBA_HISTLEVEL = 2
+          !-
+          CALL histdef(hist_id, 'subli', 'Sublimation', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+          CALL histdef(hist_id, 'evapnu', 'Bare soil evaporation', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+          CALL histdef(hist_id, 'runoff', 'Surface runoff', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+          CALL histdef(hist_id, 'drainage', 'Deep drainage', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+          IF ( river_routing ) THEN
+             CALL histdef(hist_id, 'riversret', 'Return from endorheic rivers', 'mm/d', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+             CALL histdef(hist_id, 'hydrographs', 'Hydrographs of gridbox outflow', 'm^3/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(2), dt,dw)
+          ENDIF
+          IF ( hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'evapnu_soil', 'Bare soil evap for soil type', 'mm/d', &
+                  & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
+             CALL histdef(hist_id, 'drainage_soil', 'Drainage for soil type', 'mm/d', &
+                  & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
+             CALL histdef(hist_id, 'transpir_soil', 'Transpir for soil type', 'mm/d', &
+                  & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
+             CALL histdef(hist_id, 'runoff_soil', 'Runoff for soil type', 'mm/d', &
+                  & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
+          ENDIF
+          !
+          CALL histdef(hist_id, 'tair', 'Air Temperature', 'K',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'qair', 'Air humidity', 'g/g',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'q2m', '2m Air humidity', 'g/g',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 't2m', '2m Air Temperature', 'K',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'alb_vis', 'Albedo visible', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'alb_nir', 'Albedo near infrared', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'soilalb_vis', 'Soil Albedo visible', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'soilalb_nir', 'Soil Albedo near infrared', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'vegalb_vis', 'Vegetation Albedo visible', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'vegalb_nir', 'Vegetation Albedo near infrared', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'z0', 'Surface roughness', 'm',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'roughheight', 'Effective roughness height', 'm',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'transpir', 'Transpiration', 'mm/d', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(2), dt,dw)
+          CALL histdef(hist_id, 'inter', 'Interception loss', 'mm/d', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(2), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 3
+          !-
+          CALL histdef(hist_id, 'tsol_max', 'Maximum Surface Temperature',&
+               & 'C', iim,jjm, hori_id, 1,1,1, -99, 32, tmaxcels(3), dt,dw)
+          CALL histdef(hist_id, 'tsol_min', 'Minimum Surface Temperature',&
+               & 'C', iim,jjm, hori_id, 1,1,1, -99, 32, tmincels(3), dt,dw)
+          CALL histdef(hist_id, 'fluxsens', 'Sensible Heat Flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(3), dt,dw)
+          CALL histdef(hist_id, 'fluxlat', 'Latent Heat Flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(3), dt,dw)
+          CALL histdef(hist_id, 'snow', 'Snow mass', 'kg/m^2', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'snowage', 'Snow age', '?', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'snownobio', 'Snow on other surfaces', 'kg/m^2', &
+               & iim,jjm, hori_id, nnobio,1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'snownobioage', 'Snow age on other surfaces', 'd', &
+               & iim,jjm, hori_id, nnobio,1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'vegetfrac', 'Fraction of vegetation', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'tot_bare_soil', "Total Bare Soil Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'nobiofrac', 'Fraction of other surface types', '1', &
+               & iim,jjm, hori_id, nnobio, 1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
+          IF ( do_floodplains ) THEN
+             CALL histdef(hist_id, 'flood_frac', 'Flooded fraction', '1', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
+             CALL histdef(hist_id, 'reinfiltration', 'Reinfiltration from floodplains', 'mm/d', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(3), dt,dw)
+          ENDIF
+          IF ( hydrol_cwrr ) THEN
+             DO jst=1,nstm
+             
+                ! var_name= "mc_1" ... "mc_3"
+                WRITE (var_name,"('moistc_',i1)") jst
+                CALL histdef(hist_id, var_name, 'Soil Moisture profile for soil type', 'm3/m3', &
+                     & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(3),  dt,dw)
+                
+                ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+                WRITE (var_name,"('vegetsoil_',i1)") jst
+                CALL histdef(hist_id, var_name, 'Fraction of vegetation on soil types', '%', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3),  dt,dw)
+                
+                ! var_name= "kfact_root_1" ... "kfact_root_3"
+                WRITE (var_name,"('kfactroot_',i1)") jst
+                CALL histdef(hist_id, var_name, 'Root fraction profile for soil type', '%', &
+                     & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(3), dt,dw)
+                
+             ENDDO
+
+             IF (ok_freeze_cwrr) THEN
+                CALL histdef(hist_id, 'profil_froz_hydro', 'Frozen fraction for each hydrological soil layer', '-', &
+                     & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1),  dt,dw)
+                DO jst=1,nstm
+                   WRITE (var_name,"('profil_froz_hydro_',i1)") jst
+                   CALL histdef(hist_id, trim(var_name), 'Frozen fraction for each hydrological soil layer and soiltile', '-', &
+                        & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1),  dt,dw)
+                ENDDO
+                CALL histdef(hist_id, 'temp_hydro', 'Soil temperature interpolated on hydrological layers', 'K', &
+                     & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1), dt,dw)
+                CALL histdef(hist_id, 'kk_moy', 'Mean hydrological conductivity', 'mm/d', &
+                     & iim,jjm,hori_id, nslm,1,nslm, solayax_id, 32, avescatter(1),  dt,dw)
+             END IF
+             
+             CALL histdef(hist_id, 'ptn_beg', 'Soil temperature from previous time step', 'K', &
+                  & iim,jjm,hori_id, ngrnd,1,ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+
+             IF ( ok_freeze_thermix ) THEN
+                CALL histdef(hist_id, 'pcappa_supp', 'Additional heat capacity due to soil freezing for each soil layer', 'J/K', &
+                     iim,jjm,hori_id, ngrnd,1,ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+             END IF
+
+             CALL histdef(hist_id, 'shum_ngrnd_perma', 'Saturation degree on the thermal axes', '-', &
+                  & iim,jjm,hori_id,ngrnd,1,ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+             CALL histdef(hist_id, 'shumdiag_perma', 'Saturation degree of the soil', '-', &
+                  & iim,jjm,hori_id,nbdl,1,nbdl, soildiagax_id, 32, avescatter(1),  dt,dw)
+             CALL histdef(hist_id, 'humtot_pro', "Water content in soil layer", "kg m-2 ", &
+                  & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(3), dt,dw)
+          ENDIF
+          !
+          CALL histdef(hist_id, 'frac_bare', 'Bare soil fraction for each tile', '-', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'soiltile', 'Fraction of soil tiles', '%', &
+               & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, once(3),  dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 4
+          !-
+          IF ( .NOT. hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'dss', 'Up-reservoir Height', 'm',  &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
+             CALL histdef(hist_id, 'gqsb', 'Upper Soil Moisture', 'Kg/m^2',  &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
+             CALL histdef(hist_id, 'bqsb', 'Lower Soil Moisture', 'Kg/m^2',  &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
+          ELSE
+             CALL histdef(hist_id, 'humtot', 'Total Soil Moisture', 'Kg/m^2', &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
+             CALL histdef(hist_id, 'humtot_soil', 'Soil Moisture for soil type', 'Kg/m^2', &
+                  & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, avescatter(4), dt,dw)
+             CALL histdef(hist_id, 'SWI', 'Soil wetness index','-',  &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
+             CALL histdef(hist_id, 'njsc', 'Soil class used for hydrology', '-', &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, once(4), dt,dw)
+          ENDIF
+          CALL histdef(hist_id, 'qsintveg', 'Water on canopy', 'Kg/m^2', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
+          CALL histdef(hist_id, 'rstruct', 'Structural resistance', 's/m', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
+          IF ( ok_co2 ) THEN
+             CALL histdef(hist_id, 'gpp', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+          ENDIF
+          IF ( ok_stomate ) THEN
+             CALL histdef(hist_id, 'nee', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt, dw)
+          ENDIF
+          CALL histdef(hist_id, 'precisol', 'Throughfall', 'mm/d',  &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(4), dt,dw)
+          CALL histdef(hist_id, 'drysoil_frac', 'Fraction of visibly dry soil', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(4), dt,dw)
+          CALL histdef(hist_id, 'evapot', 'Potential evaporation', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(4), dt,dw)
+          CALL histdef(hist_id, 'evapot_corr', 'Potential evaporation', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(4), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 5
+          !-
+          CALL histdef(hist_id, 'swnet', 'Net solar radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(5), dt,dw)
+          CALL histdef(hist_id, 'swdown', 'Incident solar radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(5), dt,dw)
+          CALL histdef(hist_id, 'lwdown', 'Absorbed downward longwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
+          CALL histdef(hist_id, 'lwnet', 'Net surface longwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 6
+          !-
+          CALL histdef(hist_id, 'ptn', 'Deep ground temperature', 'K', &
+               & iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(6),  dt,dw)
+          CALL histdef(hist_id, 'snowmelt', 'snow melt', 'kg/m2', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(6), dt,dw)
+          CALL histdef(hist_id, 'frac_snow_veg', 'snow fraction on vegeted area','-', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(6), dt,dw)
+          CALL histdef(hist_id, 'frac_snow_nobio', 'snow fraction on non-vegeted area', '-', &
+               & iim,jjm, hori_id, nnobio, 1,nnobio, nobioax_id, 32, avescatter(6), dt,dw)
+          CALL histdef(hist_id, 'pgflux', 'extra energy used for melting top snow layer', '-', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(6), dt,dw)
+
+          IF (ok_explicitsnow) THEN
+             CALL histdef(hist_id, 'grndflux', 'ground heat flux', 'W/m2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(6), dt,dw)
+             CALL histdef(hist_id, 'sfcfrz', 'surface frozen fraction', '-', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(6), dt,dw)
+             CALL histdef(hist_id, 'snowrho', 'Snow density profile', 'kg/m3', & 
+                  & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6), dt,dw)
+             CALL histdef(hist_id, 'snowtemp','Snow temperature profile','K', &
+                  & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6),dt,dw)
+             CALL histdef(hist_id, 'snowdz','Snow depth profile','m', &
+                  & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6),dt,dw)
+             CALL histdef(hist_id, 'snowliq','Snow liquid content profile','m', &
+                  & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6),dt,dw)
+             CALL histdef(hist_id, 'snowgrain','Snow grain profile','m', &
+                  & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6),dt,dw)
+             CALL histdef(hist_id, 'snowheat','Snow Heat profile','J/m2', &
+                  & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6),dt,dw)
+             CALL histdef(hist_id, 'radsink','Solar Radiation profile','W/m2', &
+                  & iim,jjm, hori_id, nsnow, 1, nsnow, snowax_id, 32,avescatter(6),dt,dw)
+          END IF
+          CALL histdef(hist_id, 'Qg', 'Ground heat flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+
+          IF (hydrol_cwrr) THEN
+             IF (ok_freeze_thermix) THEN
+                CALL histdef(hist_id, 'profil_froz', 'Frozen fraction of the soil', '-', &
+                     & iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(6),  dt,dw)
+             END IF
+             CALL histdef(hist_id, 'pkappa', 'Soil thermal conductivity', 'W/m/K', &
+                  & iim,jjm,hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+             CALL histdef(hist_id, 'pcapa', 'Apparent heat capacity', 'J/m3/K', &
+                  & iim,jjm,hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+          END IF
+
+          !-
+          !- SECHIBA_HISTLEVEL = 7
+          !-
+          IF ( river_routing ) THEN
+             CALL histdef(hist_id, 'fastr', 'Fast flow reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
+             CALL histdef(hist_id, 'slowr', 'Slow flow reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
+             CALL histdef(hist_id, 'streamr', 'Stream flow reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
+             CALL histdef(hist_id, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
+             
+             !-
+             !- SECHIBA_HISTLEVEL = 8
+             !-
+             CALL histdef(hist_id, 'pondr', 'Ponds reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+             CALL histdef(hist_id, 'swampmap', 'Map of swamps', 'm^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(8), dt,dw)
+             !
+             IF ( do_irrigation ) THEN
+                CALL histdef(hist_id, 'irrigation', 'Net irrigation', 'mm/d', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(8), dt,dw)
+                CALL histdef(hist_id, 'netirrig', 'Net irrigation requirement', 'mm/d', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(8), dt,dw)
+                CALL histdef(hist_id, 'irrigmap', 'Map of irrigated surfaces', 'm^2', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, once(8), dt,dw)
+             ENDIF
+             IF ( do_floodplains ) THEN
+                CALL histdef(hist_id, 'floodmap', 'Map of floodplains', 'm^2', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, once(8), dt,dw)
+                CALL histdef(hist_id, 'floodh', 'Floodplains height', 'mm', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+                CALL histdef(hist_id, 'floodr', 'Floodplains reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+                CALL histdef(hist_id, 'floodout', 'Flow out of floodplains', 'mm/d', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(8), dt,dw)
+                CALL histdef(hist_id, 'evapflo', 'Floodplains evaporation', 'mm/d', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(8), dt,dw)
+             ENDIF
+             !
+          ENDIF
+
+          IF ( hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'k_litt', 'Litter cond', 'mm/d', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          ENDIF
+          CALL histdef(hist_id, 'beta', 'Beta Function', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'raero', 'Aerodynamic resistance', 's/m',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'cdrag', 'Drag coefficient for LE and SH', '?',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'Wind', 'Wind speed', 'm/s',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'qsatt' , 'Surface saturated humidity', 'g/g', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'vbeta1', 'Beta for sublimation', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'vbeta4', 'Beta for bare soil', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'vbeta5', 'Beta for floodplains', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          IF ( ok_co2 ) THEN
+             CALL histdef(hist_id, 'gsmean', 'mean stomatal conductance', 'umol/m2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(8), dt,dw)
+          ENDIF
+          CALL histdef(hist_id, 'humrel', 'Soil moisture stress', '-',  &
+               & iim,jjm, hori_id, nvm,1,nvm, vegax_id, 32, avescatter(8), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 9
+          !-
+          !-
+          !- SECHIBA_HISTLEVEL = 10
+          !-
+          IF ( ok_co2 ) THEN
+             CALL histdef(hist_id, 'cimean', 'Stomatal CO2 concentation', 'mmole/m2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+             CALL histdef(hist_id, 'cim', 'cim', 'ppm', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          ENDIF
+          CALL histdef(hist_id, 'vbeta3', 'Beta for Transpiration', 'mm/d', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'rveget', 'Canopy resistance', 's/m', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          IF ( .NOT. hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'rsol', 'Soil resistance', 's/m',  &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(10), dt,dw)
+          ENDIF
+          CALL histdef(hist_id,'vbeta2','Beta for Interception loss','mm/d', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'qsintmax', 'Maximum Interception capacity', 'Kg/m^2', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+
+          !- SECHIBA_HISTLEVEL = 11
+          !-
+
+          CALL histdef(hist_id, 'mrsos', "Moisture in Upper 0.1 m of Soil Column", "kg m-2", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'mrso', "Total Soil Moisture Content", "kg m-2", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'mrros', "Surface Runoff", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+          
+          CALL histdef(hist_id, 'mrro', "Total Runoff", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+
+          CALL histdef(hist_id, 'prveg', "Precipitation onto Canopy", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+
+
+          CALL histdef(hist_id, 'evspsblveg', "Evaporation from Canopy", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+          
+          CALL histdef(hist_id, 'evspsblsoi', "Water Evaporation from Soil", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+          
+          CALL histdef(hist_id, 'tran', "Transpiration", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+          
+          CALL histdef(hist_id, 'treeFrac', "Tree Cover Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'grassFrac', "Natural Grass Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'cropFrac', "Crop Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'baresoilFrac', "Bare Soil Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'residualFrac', &
+               & "Fraction of Grid Cell that is Land but Neither Vegetation-Covered nor Bare Soil", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          IF ( ok_bvoc ) THEN
+             CALL histdef(hist_id, 'PAR', 'PAR', 'umol phot/m^2/s',  &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+             IF ( ok_radcanopy ) THEN
+                CALL histdef(hist_id, 'PARsun', 'Sunlit Leaf PAR', 'umol phot/m^2/s', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'PARsh', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'laisun', 'Sunlit Leaf Area Index', '1', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'laish', 'Shaded Leaf Area Index', '1', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'Fdf', 'Fdf', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                IF ( ok_multilayer ) then 
+                   CALL histdef(hist_id, 'PARsuntab', 'Sunlit Leaf PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(11), dt,dw)
+                   CALL histdef(hist_id, 'PARshtab', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(11), dt,dw)
+                ENDIF
+                CALL histdef(hist_id, 'coszang', 'coszang', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'PARdf', 'PARdf', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'PARdr', 'PARdr', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'Trans', 'Trans', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+             END IF
+             
+             CALL histdef(hist_id, 'flx_fertil_no', 'flx_fertil_no', 'ngN/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'CRF', 'CRF', '1', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_co2_bbg_year', 'flx_co2_bbg_year', 'kgC/m^2/yr ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(11), dt,dw)  
+             CALL histdef(hist_id, 'N_qt_WRICE_year', 'N_qt_WRICE_year', 'kgN/yr ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(11), dt,dw)  
+             CALL histdef(hist_id, 'N_qt_OTHER_year', 'N_qt_OTHER_year', 'kgN/yr ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(11), dt,dw)  
+             CALL histdef(hist_id, 'flx_iso', 'flx_iso', 'kgC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_mono', 'flx_mono', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_apinen', 'flx_apinen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_bpinen', 'flx_bpinen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_limonen', 'flx_limonen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_myrcen', 'flx_myrcen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_sabinen', 'flx_sabinen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_camphen', 'flx_camphen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_3caren', 'flx_3caren', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_tbocimen', 'flx_tbocimen', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_othermono', 'flx_othermono', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_sesquiter', 'flx_sesquiter', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_ORVOC', 'flx_ORVOC', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_MBO', 'flx_MBO', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_methanol', 'flx_methanol', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_acetone', 'flx_acetone', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_acetal', 'flx_acetal', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_formal', 'flx_formal', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_acetic', 'flx_acetic', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_formic', 'flx_formic', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_no_soil', 'flx_no_soil', 'ngN/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_no', 'flx_no', 'ngN/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'fco2', 'fco2', '-', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          ENDIF
+
+       ELSE 
+          !-
+          !- This is the ALMA convention output now
+          !-
+          !- 
+          IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+             CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id,orch_domain_id)
+#else
+             CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id)
+#endif
+          ELSE
+#ifdef CPP_PARA
+             CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id,domain_id=orch_domain_id)
+#else
+             CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id)
+#endif
+          ENDIF
+          !-
+          CALL histvert(hist_id, 'veget', 'Vegetation types', '1', &
+               &    nvm,   veg, vegax_id)
+          CALL histvert(hist_id, 'solth', 'Soil levels',      'm', &
+               &    ngrnd, sol, solax_id)
+          CALL histvert(hist_id, 'soiltyp', 'Soil types',      '1', &
+               &    nstm, soltyp, soltax_id)
+          CALL histvert(hist_id, 'nobio', 'Other surface types',      '1', &
+               &    nnobio, nobiotyp, nobioax_id)
+          IF (  hydrol_cwrr ) THEN
+             CALL histvert(hist_id, 'solay', 'Hydrol soil levels',      'm', &
+                  &    nslm, diaglev(1:nslm), solayax_id)
+          ENDIF
+          !-
+          !-  Vegetation
+          !-
+          CALL histdef(hist_id, 'vegetfrac', 'Fraction of vegetation', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'nobiofrac', 'Fraction of other surface types', '1', &
+               & iim,jjm, hori_id, nnobio, 1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
+          !- 
+          !-  General energy balance
+          !-
+          CALL histdef(hist_id, 'Tair', 'Near surface air temperature at forcing level', 'K',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'Qair', 'Near surface specific humidity at forcing level', 'g/g',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'SWnet', 'Net shortwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
+          CALL histdef(hist_id, 'LWnet', 'Net longwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'Qh', 'Sensible heat flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
+          CALL histdef(hist_id, 'Qle', 'Latent heat flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
+          CALL histdef(hist_id, 'Qg', 'Ground heat flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'Qf', 'Energy of fusion', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'Qv', 'Energy of sublimation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelSurfHeat', 'Change in surface layer heat', 'J/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, sumscatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelColdCont', 'Change in snow surface layer cold content', 'J/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, sumscatter(1), dt,dw)
+          !-
+          !- General water balance
+          !-
+          CALL histdef(hist_id, 'Snowf', 'Snowfall rate', 'kg/m^2/s',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'Rainf', 'Rainfall rate', 'kg/m^2/s',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'Evap', 'Total Evapotranspiration', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'Qs', 'Surface runoff', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'Qsb', 'Sub-surface runoff', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'Qsm', 'Snowmelt', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'DelSoilMoist', 'Change in soil moisture', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelSurfStor', 'Change in Surface Water Storage','kg/m^2',&
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelIntercept', 'Change in interception storage', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelSWE', 'Change in Snow Water Equivalent', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
+          IF ( do_irrigation ) THEN
+             CALL histdef(hist_id, 'Qirrig', 'Irrigation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'Qirrig_req', 'Irrigation requirement', 'kg/m^2/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          ENDIF
+          !-
+          !- Surface state
+          !-
+          CALL histdef(hist_id, 'AvgSurfT', 'Average surface temperature', 'K', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
+          CALL histdef(hist_id, 'PotSurfT', 'Potential (Unstressed) surface temperature', 'K', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
+          CALL histdef(hist_id, 'RadT', 'Surface radiative temperature', 'K', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
+          CALL histdef(hist_id, 'Albedo', 'Albedo', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SWI', 'Soil wetness index','1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SurfStor', 'Surface Water Storage','kg/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SWE', 'Snow Water Equivalent', 'kg/m^2', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          !!-
+          !-  Sub-surface state
+          !- 
+          IF ( .NOT. hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2',  &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
+          ELSE
+             CALL histdef(hist_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2',  &
+                  & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1), dt,dw)
+
+             IF (ok_freeze_cwrr) THEN
+                CALL histdef(hist_id, 'profil_froz_hydro', 'Frozen fraction for each hydrological soil layer', '-', &
+                     & iim,jjm, hori_id, nslm, 1, nslm,solayax_id, 32, avescatter(1),  dt,dw)
+                DO jst=1,nstm
+                   WRITE (var_name,"('profil_froz_hydro_',i1)") jst
+                   CALL histdef(hist_id, trim(var_name), 'Frozen fraction for each hydrological soil layer and soiltile', '-', &
+                        & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1),  dt,dw)
+                ENDDO
+
+                CALL histdef(hist_id, 'temp_hydro', 'Soil temperature interpolated on hydrological layers', 'K', &
+                     & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1), dt,dw)
+                CALL histdef(hist_id, 'kk_moy', 'Mean hydrological conductivity', 'mm/d', &
+                     & iim,jjm,hori_id, nslm,1,nslm, solayax_id, 32, avescatter(1),  dt,dw)
+             ENDIF
+          END IF
+          CALL histdef(hist_id, 'SoilWet', 'Total soil wetness', '-',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SoilTemp', 'Soil temperature profile', 'K', &
+               & iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+          !- 
+          !-  Evaporation components
+          !-
+          CALL histdef(hist_id, 'PotEvap', 'Potential evapotranspiration', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'PotEvapOld', 'Potential evapotranspiration old method', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'ECanop', 'Interception evaporation', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'TVeg', 'Transpiration', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'ESoil', 'Bare soil evaporation', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'EWater', 'Open water evaporation', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'RootMoist','Root zone soil water', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SubSnow','Snow sublimation','kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'ACond', 'Aerodynamic conductance', 'm/s',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          IF ( do_floodplains ) THEN
+             CALL histdef(hist_id, 'Qflood', 'Floodplain Evaporation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          ENDIF
+          !-
+          !- Surface turbulence
+          !-
+          CALL histdef(hist_id, 'Z0', 'Roughness height', 'm',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'EffectHeight', 'Effective displacement height (h-d)', 'm',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          !-
+          !-
+          !-  Cold Season Processes
+          !-
+          CALL histdef(hist_id, 'SnowFrac', 'Snow cover fraction', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SAlbedo', 'Snow albedo', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SnowDepth', '3D snow depth', 'm', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          !-
+          !- Hydrologic variables
+          !-
+          CALL histdef(hist_id, 'SwampMap', 'Map of swamp areas', 'm^2', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
+          CALL histdef(hist_id, 'Dis', 'Simulated River Discharge', 'm^3/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(2), dt,dw)
+          IF ( do_irrigation ) THEN
+             CALL histdef(hist_id, 'IrrigationMap', 'Map of irrigated areas', 'm^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
+          ENDIF
+          IF ( do_floodplains ) THEN
+             CALL histdef(hist_id, 'FloodplainsMap', 'Map of flooded areas', 'm^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
+             CALL histdef(hist_id, 'FloodFrac', 'Floodplain Fraction', '-', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          ENDIF
+          CALL histdef(hist_id, 'humrel', 'Soil moisture stress', '-',  &
+               & iim,jjm, hori_id, nvm,1,nvm, vegax_id, 32, avescatter(8), dt,dw)
+          !-
+          !-  The carbon budget
+          !-
+          IF ( ok_co2 ) THEN
+             CALL histdef(hist_id, 'GPP', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+          ENDIF
+          IF ( ok_stomate ) THEN
+             CALL histdef(hist_id, 'NEE', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+          ENDIF
+          !
+      ENDIF
+       !-
+       !- Forcing and grid information
+       !-
+       CALL histdef(hist_id, 'LandPoints', 'Land Points', '1', &
+            & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)  
+       CALL histdef(hist_id, 'Areas', 'Mesh areas', 'm2', &
+            & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt, dw)
+       CALL histdef(hist_id, 'Contfrac', 'Continental fraction', '1', &
+            & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt, dw)
+       !-
+       ! Write the names of the pfts in the history files
+       global_attribute="PFT_name"
+       DO i=1,nvm
+          WRITE(global_attribute(9:10),"(I2.2)") i
+          CALL histglobal_attr(hist_id, global_attribute, PFT_name(i))
+       ENDDO
+       !-
+       CALL histend(hist_id)
+    ENDIF ! IF (is_omp_root)
+ 
+    END IF !IF ( dw == 0 )
+    !
+    !
+    ! Second SECHIBA hist file
+    !
+    !-
+    !Config Key   = SECHIBA_HISTFILE2
+    !Config Desc  = Flag to switch on histfile 2 for SECHIBA (hi-frequency ?)
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = This Flag switch on the second SECHIBA writing for hi (or low) 
+    !Config         frequency writing. This second output is optional and not written
+    !Config         by default.
+    !Config Units = [FLAG]
+    !-
+    ok_histfile2=.FALSE.
+    CALL getin_p('SECHIBA_HISTFILE2', ok_histfile2)
+    WRITE(numout,*) 'SECHIBA_HISTFILE2 ', ok_histfile2
+    !
+    !-
+    !Config Key   = WRITE_STEP2
+    !Config Desc  = Frequency in seconds at which to WRITE output
+    !Config If    = SECHIBA_HISTFILE2
+    !Config Def   = 1800.0
+    !Config Help  = This variables gives the frequency the output 2 of
+    !Config         the model should be written into the netCDF file.
+    !Config         It does not affect the frequency at which the
+    !Config         operations such as averaging are done.
+    !Config         That is IF the coding of the calls to histdef
+    !Config         are correct !
+    !Config Units = [seconds]
+    !-
+    dw2 = 1800.0
+    CALL getin_p('WRITE_STEP2', dw2)
+    
+    ! Deactivate sechiba_histfile2 if the frequency is set to zero
+    IF ( dw2 == 0 ) THEN
+       ok_histfile2=.FALSE.
+       WRITE(numout,*) 'WRITE_STEP2 was set to zero and therfore SECHIBA_HISTFILE2 is deactivated.'
+    ELSE IF ( hist_id < 0 ) THEN
+       ! Deactivate all history files if sechiba_history file is deactivated
+       ok_histfile2=.FALSE.
+       WRITE(numout,*) 'SECHIBA_HISTFILE2 will not be created because sechiba_history file is deactivated.'
+    END IF
+
+    hist2_id = -1
+    !
+    IF (ok_histfile2) THEN
+       !-
+       !Config Key   = SECHIBA_OUTPUT_FILE2
+       !Config Desc  = Name of file in which the output number 2 is going to be written
+       !Config If    = SECHIBA_HISTFILE2
+       !Config Def   = sechiba_out_2.nc
+       !Config Help  = This file is going to be created by the model
+       !Config         and will contain the output 2 from the model.
+       !Config Units = [FILE]
+       !-
+       histname2='sechiba_out_2.nc'
+       CALL getin_p('SECHIBA_OUTPUT_FILE2', histname2)
+       WRITE(numout,*) 'SECHIBA_OUTPUT_FILE2 ', histname2
+       !-
+       !Config Key   = SECHIBA_HISTLEVEL2
+       !Config Desc  = SECHIBA history 2 output level (0..10)
+       !Config If    = SECHIBA_HISTFILE2
+       !Config Def   = 1
+       !Config Help  = Chooses the list of variables in the history file. 
+       !Config         Values between 0: nothing is written; 10: everything is 
+       !Config         written are available More details can be found on the web under documentation.
+       !Config         web under documentation.
+       !Config         First level contains all ORCHIDEE outputs.
+       !Config Units = [-] 
+       !-
+       hist2_level = 1
+       CALL getin_p('SECHIBA_HISTLEVEL2', hist2_level)
+       !-
+       WRITE(numout,*) 'SECHIBA history level 2 : ',hist2_level
+       IF ( (hist2_level > max_hist_level).OR.(hist2_level < 0) ) THEN
+          STOP 'This history level 2 is not allowed'
+       ENDIF
+       !
+       !-
+       !- define operations as a function of history level.
+       !- Above hist2_level, operation='never'
+       !-
+       ave2(1:max_hist_level) = 'ave(scatter(X))'
+       IF (hist2_level < max_hist_level) THEN
+          ave2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       sumscatter2(1:max_hist_level) = 't_sum(scatter(X))'
+       IF (hist2_level < max_hist_level) THEN
+          sumscatter2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       avecels2(1:max_hist_level) = 'ave(cels(scatter(X)))'
+       IF (hist2_level < max_hist_level) THEN
+          avecels2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       avescatter2(1:max_hist_level) = 'ave(scatter(X))'
+       IF (hist2_level < max_hist_level) THEN
+          avescatter2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       tmincels2(1:max_hist_level) = 't_min(cels(scatter(X)))'
+       IF (hist2_level < max_hist_level) THEN
+          tmincels2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       tmaxcels2(1:max_hist_level) = 't_max(cels(scatter(X)))'
+       IF (hist2_level < max_hist_level) THEN
+          tmaxcels2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       fluxop2(1:max_hist_level) = flux_op
+       IF (hist2_level < max_hist_level) THEN
+          fluxop2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       fluxop_scinsec2(1:max_hist_level) = flux_scinsec
+       IF (hist2_level < max_hist_level) THEN
+          fluxop_scinsec2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       once2(1:max_hist_level) = 'once(scatter(X))'
+       IF (hist2_level < max_hist_level) THEN
+          once2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       ! 
+       IF (is_omp_root) THEN
+          IF ( .NOT. almaoutput ) THEN
+             !- 
+             IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+                CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id,orch_domain_id)
+#else
+                CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id)
+#endif
+                WRITE(numout,*)  'HISTBEG2 --->',istp_old,date0,dt,dw2,hist2_id
+             ELSE
+#ifdef CPP_PARA
+                CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id,domain_id=orch_domain_id)
+#else
+                CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id)
+#endif
+             ENDIF
+             !-
+             CALL histvert(hist2_id, 'veget', 'Vegetation types', '1', &
+                  &    nvm,   veg, vegax_id2)
+             CALL histvert(hist2_id, 'laiax', 'Nb LAI', '1', &
+                  &    nlai+1,   lai, laiax_id2)
+             CALL histvert(hist2_id, 'solth', 'Soil levels',      'm', &
+                  &    ngrnd, sol, solax_id2)
+             CALL histvert(hist2_id, 'soiltyp', 'Soil types',      '1', &
+                  &    nstm, soltyp, soltax_id2)
+             CALL histvert(hist2_id, 'nobio', 'Other surface types',      '1', &
+                  &    nnobio, nobiotyp, nobioax_id2)
+             CALL histvert(hist2_id, 'albtyp', 'Albedo Types',     '1', &
+                  &    2, albtyp, albax_id2)
+             IF (  hydrol_cwrr ) THEN
+                CALL histvert(hist2_id, 'solay', 'Hydrol soil levels',      'm', &
+                     &    nslm, solay, solayax_id2)
+             ENDIF
+             !-
+             !- SECHIBA_HISTLEVEL2 = 1
+             !-
+             CALL histdef(hist2_id, 'ptn', 'Deep ground temperature', 'K', &
+                  & iim,jjm, hori_id2, ngrnd, 1, ngrnd, solax_id2, 32, avescatter2(2),  dt, dw2)  
+
+             CALL histdef(hist2_id, 'mrsos', "Moisture in Upper 0.1 m of Soil Column", "kg m-2", &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(2), dt,dw2)            
+
+             CALL histdef(hist2_id, 'mrso', "Total Soil Moisture Content", "kg m-2", &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(11), dt,dw2)
+             
+             CALL histdef(hist2_id, 'mrros', "Surface Runoff", "kg m-2 s-1", &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(11), dt,dw2)
+
+             CALL histdef(hist2_id, 'mrro', "Total Runoff", "kg m-2 s-1", &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(2), dt,dw2)      
+
+             !-
+             !- SECHIBA_HISTLEVEL2 = 2
+             !-
+             CALL histdef(hist2_id, 'cdrag', 'Drag coefficient for LE and SH', '?',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt, dw2)
+             CALL histdef(hist2_id, 'soilalb_vis', 'Soil Albedo visible', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+             CALL histdef(hist2_id, 'soilalb_nir', 'Soil Albedo near infrared', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+             CALL histdef(hist2_id, 'vegalb_vis', 'Vegetation Albedo visible', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+             CALL histdef(hist2_id, 'vegalb_nir', 'Vegetation Albedo near infrared', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+             CALL histdef(hist2_id, 'z0', 'Surface roughness', 'm',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt, dw2)
+             CALL histdef(hist2_id, 'coastalflow', 'Diffuse coastal flow', 'm^3/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), dt, dw2)
+             CALL histdef(hist2_id, 'riverflow', 'River flow to the oceans', 'm^3/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), dt, dw2) 
+             CALL histdef(hist2_id, 'tsol_rad', 'Radiative surface temperature', 'C', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avecels2(2), dt, dw2)
+             IF ( do_floodplains ) THEN
+                CALL histdef(hist2_id, 'floodout', 'Flow out of floodplains', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt,dw2)
+                CALL histdef(hist2_id, 'vevapflo', 'Floodplains evaporation', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt, dw2)
+                CALL histdef(hist2_id, 'flood_frac', 'Flooded fraction', '1', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+                CALL histdef(hist2_id, 'reinfiltration', 'Reinfiltration from floodplains', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt,dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'vevapnu', 'Bare soil evaporation', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt, dw2)
+             CALL histdef(hist2_id, 'temp_sol', 'New Surface Temperature', 'C', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avecels2(2), dt, dw2)
+             CALL histdef(hist2_id, 'qsurf', 'Near surface specific humidity', 'g/g',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
+             CALL histdef(hist2_id, 'albedo', 'Albedo', '1', &
+                  & iim,jjm, hori_id2, 2,1,2, albax_id2, 32, avescatter2(2), dt, dw2)
+             CALL histdef(hist2_id, 'fluxsens', 'Sensible Heat Flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
+             CALL histdef(hist2_id, 'fluxlat', 'Latent Heat Flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
+             CALL histdef(hist2_id, 'emis', 'Surface emissivity', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 3
+             !-
+             CALL histdef(hist2_id, 'evap', 'Evaporation', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
+             CALL histdef(hist2_id, 'rain', 'Rainfall', 'mm/d',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
+             CALL histdef(hist2_id, 'snowf', 'Snowfall', 'mm/d',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
+             CALL histdef(hist2_id, 'netrad', 'Net radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(3), dt, dw2)
+             CALL histdef(hist2_id, 'lai', 'Leaf Area Index', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
+             IF ( river_routing ) THEN
+                CALL histdef(hist2_id, 'basinmap', 'Aproximate map of the river basins', ' ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(3), dt, dw2) 
+                CALL histdef(hist2_id, 'nbrivers', 'Number or rivers in the outflow grid box', ' ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(3), dt, dw2)  
+             ENDIF
+             IF (check_waterbal) THEN
+                CALL histdef(hist2_id, 'TotWater', 'Total amount of water at end of time step', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(3), dt, dw2)
+                CALL histdef(hist2_id, 'TotWaterFlux', 'Total water flux', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
+             ENDIF
+
+             IF (  hydrol_cwrr ) THEN
+                 CALL histdef(hist2_id, 'humtot_pro', "Water content in soil layer", "kg m-2 ", &
+                  & iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(3), dt,dw2)
+             ENDIF
+             !-
+             !- SECHIBA_HISTLEVEL2 = 4
+             !-
+             CALL histdef(hist2_id, 'subli', 'Sublimation', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
+             CALL histdef(hist2_id, 'runoff', 'Surface runoff', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
+             CALL histdef(hist2_id, 'drainage', 'Deep drainage', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
+             IF ( river_routing ) THEN
+                CALL histdef(hist2_id, 'riversret', 'Return from endorheic rivers', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
+                CALL histdef(hist2_id, 'hydrographs', 'Hydrographs of gridbox outflow', 'm^3/s', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(4), dt, dw2)
+             ENDIF
+             IF ( hydrol_cwrr ) THEN
+                CALL histdef(hist2_id, 'evapnu_soil', 'Bare soil evap for soil type', 'mm/d', &
+                     & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
+                CALL histdef(hist2_id, 'drainage_soil', 'Drainage for soil type', 'mm/d', &
+                     & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
+                CALL histdef(hist2_id, 'transpir_soil', 'Transpir for soil type', 'mm/d', &
+                     & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
+                CALL histdef(hist2_id, 'runoff_soil', 'Runoff for soil type', 'mm/d', &
+                     & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
+             ENDIF
+             !
+             CALL histdef(hist2_id, 'tair', 'Air Temperature', 'K',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 'qair', 'Air humidity', 'g/g',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 'q2m', '2m Air humidity', 'g/g',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 't2m', '2m Air Temperature', 'K',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+            CALL histdef(hist2_id, 'alb_vis', 'Albedo visible', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 'alb_nir', 'Albedo near infrared', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 'roughheight', 'Effective roughness height', 'm',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(4), dt, dw2)
+             CALL histdef(hist2_id, 'transpir', 'Transpiration', 'mm/d', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(4), dt, dw2)
+             CALL histdef(hist2_id, 'inter', 'Interception loss', 'mm/d', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(4), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 5
+             !-
+             CALL histdef(hist2_id, 'tsol_max', 'Maximum Surface Temperature',&
+                  & 'C', iim,jjm, hori_id2, 1,1,1, -99, 32, tmaxcels2(5), dt, dw2)
+             CALL histdef(hist2_id, 'tsol_min', 'Minimum Surface Temperature',&
+                  & 'C', iim,jjm, hori_id2, 1,1,1, -99, 32, tmincels2(5), dt, dw2)
+             CALL histdef(hist2_id, 'snow', 'Snow mass', 'kg/m^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'snowage', 'Snow age', '?', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'snownobio', 'Snow on other surfaces', 'kg/m^2', &
+                  & iim,jjm, hori_id2, nnobio,1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'snownobioage', 'Snow age on other surfaces', 'd', &
+                  & iim,jjm, hori_id2, nnobio,1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'vegetfrac', 'Fraction of vegetation', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'nobiofrac', 'Fraction of other surface types', '1', &
+                  & iim,jjm, hori_id2, nnobio, 1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
+             IF ( hydrol_cwrr ) THEN
+                DO jst=1,nstm
+                   
+                   ! var_name= "mc_1" ... "mc_3"
+                   WRITE (var_name,"('moistc_',i1)") jst
+                   CALL histdef(hist2_id, var_name, 'Soil Moisture profile for soil type', 'm3/m3', &
+                        & iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(5), dt, dw2)
+                   
+                   ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+                   WRITE (var_name,"('vegetsoil_',i1)") jst
+                   CALL histdef(hist2_id, var_name, 'Fraction of vegetation on soil types', '%', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
+                   
+                   ! var_name= "kfact_root_1" ... "kfact_root_3"
+                   WRITE (var_name,"('kfactroot_',i1)") jst
+                   CALL histdef(hist2_id, var_name, 'Root fraction profile for soil type', '%', &
+                        & iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(5), dt,dw2)
+                ENDDO
+
+             ENDIF
+             !-
+             !- SECHIBA_HISTLEVEL2 = 6
+             !-
+             IF ( .NOT. hydrol_cwrr ) THEN
+                CALL histdef(hist2_id, 'dss', 'Up-reservoir Height', 'm',  &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id, 32, avescatter2(6), dt,dw2)
+                CALL histdef(hist2_id, 'gqsb', 'Upper Soil Moisture', 'Kg/m^2',  &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
+                CALL histdef(hist2_id, 'bqsb', 'Lower Soil Moisture', 'Kg/m^2',  &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
+             ELSE
+                CALL histdef(hist2_id, 'humtot', 'Total Soil Moisture', 'Kg/m^2', &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
+                CALL histdef(hist2_id, 'humtot_soil', 'Soil Moisture for soil type', 'Kg/m^2', &
+                     & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, avescatter2(6), dt, dw2)
+                CALL histdef(hist2_id, 'SWI', 'Soil wetness index','-',  &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt,dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'qsintveg', 'Water on canopy', 'Kg/m^2', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(6), dt, dw2)
+             CALL histdef(hist2_id, 'rstruct', 'Structural resistance', 's/m', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(6), dt, dw2)
+             IF ( ok_co2 ) THEN
+                CALL histdef(hist2_id, 'gpp', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
+             ENDIF
+             IF ( ok_stomate ) THEN
+                CALL histdef(hist2_id, 'nee', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
+                CALL histdef(hist2_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
+                CALL histdef(hist2_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
+                CALL histdef(hist2_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt, dw2)
+                CALL histdef(hist2_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt, dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'precisol', 'Throughfall', 'mm/d',  &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(6), dt, dw2)
+             CALL histdef(hist2_id, 'drysoil_frac', 'Fraction of visibly dry soil', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(6), dt, dw2)
+             CALL histdef(hist2_id, 'evapot', 'Potential evaporation', 'mm/d',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(6), dt, dw2)
+             CALL histdef(hist2_id, 'evapot_corr', 'Potential evaporation', 'mm/d',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(6), dt, dw2)
+             CALL histdef(hist2_id, 'snowmelt', 'snow melt', 'kg/m2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(6), dt, dw2)
+
+             !-
+             !- SECHIBA_HISTLEVEL2 = 7
+             !-
+             CALL histdef(hist2_id, 'swnet', 'Net solar radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(7), dt, dw2)
+             CALL histdef(hist2_id, 'swdown', 'Incident solar radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(7), dt, dw2)
+             CALL histdef(hist2_id, 'lwdown', 'Absorbed downward longwave radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'lwnet', 'Net surface longwave radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 8
+             !-
+             IF ( river_routing ) THEN
+                CALL histdef(hist2_id, 'fastr', 'Fast flow reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+                CALL histdef(hist2_id, 'slowr', 'Slow flow reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+                CALL histdef(hist2_id, 'streamr', 'Stream flow reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+                CALL histdef(hist2_id, 'floodr', 'Floodplains reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt,dw2)
+                CALL histdef(hist2_id, 'floodh', 'Floodplains height', 'mm', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt,dw2)
+                CALL histdef(hist2_id, 'pondr', 'Ponds reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt,dw2)
+                CALL histdef(hist2_id, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+                IF ( do_irrigation ) THEN
+                   CALL histdef(hist2_id, 'irrigation', 'Net irrigation', 'mm/d', &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(8), dt, dw2)
+                   CALL histdef(hist2_id, 'netirrig', 'Net irrigation requirement', 'mm/d', &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(8), dt, dw2)
+                   CALL histdef(hist2_id, 'irrigmap', 'Map of irrigated areas', 'm^2', &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(8), dt, dw2)
+                ENDIF
+                CALL histdef(hist2_id, 'floodmap', 'Map of floodplains', 'm^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(8), dt,dw2)
+                CALL histdef(hist2_id, 'swampmap', 'Map of swamps', 'm^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(8), dt,dw2)
+             ENDIF
+             !-
+             !- SECHIBA_HISTLEVEL2 = 9
+             !-
+             CALL histdef(hist2_id, 'beta', 'Beta Function', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'raero', 'Aerodynamic resistance', 's/m',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'Wind', 'Wind speed', 'm/s',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'qsatt' , 'Surface saturated humidity', 'g/g', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'vbeta1', 'Beta for sublimation', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'vbeta4', 'Beta for bare soil', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             IF ( ok_co2 ) THEN
+                CALL histdef(hist2_id, 'gsmean', 'mean stomatal conductance', 'umol/m2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'vbeta5', 'Beta for floodplains', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             IF (  hydrol_cwrr ) THEN
+                CALL histdef(hist2_id, 'reinf_slope', 'Slope index for each grid box', '1', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(9),  dt,dw2)
+                CALL histdef(hist2_id, 'soilindex', 'Soil index', '1', &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, once2(9),  dt,dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'humrel', 'Soil moisture stress', '-',  &
+                  & iim,jjm, hori_id2, nvm,1,nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 10
+             !-
+             IF ( ok_co2 ) THEN
+                CALL histdef(hist2_id, 'cimean', 'Stomatal CO2 concentation', 'mmole/m2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'vbeta3', 'Beta for Transpiration', 'mm/d', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
+             CALL histdef(hist2_id, 'rveget', 'Canopy resistance', 's/m', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
+             IF ( .NOT. hydrol_cwrr ) THEN
+                CALL histdef(hist2_id, 'rsol', 'Soil resistance', 's/m',  &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt, dw2)
+             ENDIF
+             CALL histdef(hist2_id,'vbeta2','Beta for Interception loss','mm/d', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
+             CALL histdef(hist2_id, 'qsintmax', 'Maximum Interception capacity', 'Kg/m^2', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
+             
+             IF ( ok_bvoc ) THEN
+                CALL histdef(hist2_id, 'PAR', 'PAR', 'umol phot/m^2/s',  &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                IF ( ok_radcanopy ) THEN
+                   CALL histdef(hist2_id, 'PARsun', 'Sunlit Leaf PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'PARsh', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'laisun', 'Sunlit Leaf Area Index', '1', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'laish', 'Shaded Leaf Area Index', '1', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'Fdf', 'Fdf', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   IF ( ok_multilayer ) then 
+                      CALL histdef(hist2_id, 'PARsuntab', 'Sunlit Leaf PAR', 'umol phot/m^2/s', &
+                           & iim,jjm, hori_id2, nlai+1, 1, nlai+1, laiax_id2, 32, avescatter2(10), dt,dw2)
+                      CALL histdef(hist2_id, 'PARshtab', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                           & iim,jjm, hori_id2, nlai+1, 1, nlai+1, laiax_id2, 32, avescatter2(10), dt,dw2)
+                   ENDIF
+                   CALL histdef(hist2_id, 'coszang', 'coszang', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'PARdf', 'PARdf', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'PARdr', 'PARdr', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'Trans', 'Trans', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                END IF
+                
+                CALL histdef(hist2_id, 'flx_fertil_no', 'flx_fertil_no', 'ngN/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'CRF', 'CRF', '1', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_co2_bbg_year', 'flx_co2_bbg_year', 'kgC/m^2/yr ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt,dw2)  
+                CALL histdef(hist2_id, 'N_qt_WRICE_year', 'N_qt_WRICE_year', 'kgN/yr ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt,dw2)  
+                CALL histdef(hist2_id, 'N_qt_OTHER_year', 'N_qt_OTHER_year', 'kgN/yr ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt,dw2)  
+                CALL histdef(hist2_id, 'flx_iso', 'flx_iso', 'kgC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_mono', 'flx_mono', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_apinen', 'flx_apinen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_bpinen', 'flx_bpinen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_limonen', 'flx_limonen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_myrcen', 'flx_myrcen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_sabinen', 'flx_sabinen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_camphen', 'flx_camphen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_3caren', 'flx_3caren', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_tbocimen', 'flx_tbocimen', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_othermono', 'flx_othermono', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_sesquiter', 'flx_sesquiter', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_ORVOC', 'flx_ORVOC', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_MBO', 'flx_MBO', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_methanol', 'flx_methanol', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_acetone', 'flx_acetone', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(1), dt,dw2)   !! LDF TEST modificato a 1... !!
+                CALL histdef(hist2_id, 'flx_acetal', 'flx_acetal', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(1), dt,dw2)   !! LDF TEST modificato a 1... !!
+                CALL histdef(hist2_id, 'flx_formal', 'flx_formal', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_acetic', 'flx_acetic', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_formic', 'flx_formic', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_no_soil', 'flx_no_soil', 'ngN/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_no', 'flx_no', 'ngN/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+             ENDIF
+         ELSE 
+             !-
+             !- This is the ALMA convention output now
+             !-
+             !- 
+             IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+                CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id,orch_domain_id)
+#else
+                CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id)
+#endif
+                WRITE(numout,*)  'HISTBEG2 --->',istp_old,date0,dt,dw2,hist2_id
+             ELSE
+#ifdef CPP_PARA
+                CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id,domain_id=orch_domain_id)
+#else
+                CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id)
+#endif 
+             ENDIF
+             !-
+             CALL histvert(hist2_id, 'veget', 'Vegetation types', '1', &
+                  &    nvm,   veg, vegax_id2)
+             CALL histvert(hist2_id, 'solth', 'Soil levels',      'm', &
+                  &    ngrnd, sol, solax_id2)
+             CALL histvert(hist2_id, 'soiltyp', 'Soil types',      '1', &
+                  &    nstm, soltyp, soltax_id2)
+             CALL histvert(hist2_id, 'nobio', 'Other surface types',      '1', &
+                  &    nnobio, nobiotyp, nobioax_id2)
+             IF (  hydrol_cwrr ) THEN
+                CALL histvert(hist2_id, 'solay', 'Hydrol soil levels',      'm', &
+                     &    nslm, diaglev(1:nslm), solayax_id2)
+             ENDIF
+             !-
+             !-  Vegetation
+             !-
+             CALL histdef(hist2_id, 'vegetfrac', 'Fraction of vegetation', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
+             CALL histdef(hist2_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
+             CALL histdef(hist2_id, 'nobiofrac', 'Fraction of other surface types', '1', &
+                  & iim,jjm, hori_id2, nnobio, 1, nnobio, nobioax_id2, 32, avescatter2(3), dt, dw2)
+             !- 
+             !-  General energy balance
+             !-
+             CALL histdef(hist2_id, 'SWnet', 'Net shortwave radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
+             CALL histdef(hist2_id, 'LWnet', 'Net longwave radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qh', 'Sensible heat flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qle', 'Latent heat flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qg', 'Ground heat flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qf', 'Energy of fusion', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(5), dt, dw2)
+             CALL histdef(hist2_id, 'Qv', 'Energy of sublimation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'DelSurfHeat', 'Change in surface layer heat', 'J/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, sumscatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'DelColdCont', 'Change in snow surface layer cold content', 'J/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, sumscatter2(7), dt, dw2)
+             !-
+             !- General water balance
+             !-
+             CALL histdef(hist2_id, 'Snowf', 'Snowfall rate', 'kg/m^2/s',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Rainf', 'Rainfall rate', 'kg/m^2/s',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Evap', 'Total Evapotranspiration', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qs', 'Surface runoff', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qsb', 'Sub-surface runoff', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qsm', 'Snowmelt', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'DelSoilMoist', 'Change in soil moisture', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'DelSurfStor', 'Change in Surface Water Storage','kg/m^2',&
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(7), dt,dw2)
+             CALL histdef(hist2_id, 'DelIntercept', 'Change in interception storage', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'DelSWE', 'Change in interception storage Snow Water Equivalent', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(7), dt, dw2)
+             !-
+             !- Surface state
+             !-
+             CALL histdef(hist2_id, 'AvgSurfT', 'Average surface temperature', 'K', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
+             CALL histdef(hist2_id, 'RadT', 'Surface radiative temperature', 'K', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(5), dt, dw2)
+             CALL histdef(hist2_id, 'Albedo', 'Albedo', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'SWI', 'Soil wetness index','1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'SurfStor', 'Surface Water Storage','kg/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'SWE', 'Snow Water Equivalent', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter2(1), dt,dw2)
+             !!-
+             !-  Sub-surface state
+             !- 
+             IF ( .NOT. hydrol_cwrr ) THEN
+                CALL histdef(hist2_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2',  &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(7), dt, dw2)
+             ELSE
+                CALL histdef(hist2_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2',  &
+                     & iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(7), dt, dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'SoilWet', 'Total soil wetness', '-',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'SoilTemp', 'Soil temperature profile', 'K', &
+                  & iim,jjm, hori_id2, ngrnd, 1, ngrnd, solax_id2, 32, avescatter2(7), dt, dw2)
+             !- 
+             !-  Evaporation components
+             !-
+             CALL histdef(hist2_id, 'PotEvap', 'Potential evapotranspiration', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'ECanop', 'Interception evaporation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(5), dt, dw2)
+             CALL histdef(hist2_id, 'TVeg', 'Transpiration', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(5), dt, dw2)
+             CALL histdef(hist2_id, 'ESoil', 'Bare soil evaporation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(5), dt, dw2)
+             CALL histdef(hist2_id, 'EWater', 'Open water evaporation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(5), dt, dw2)
+             CALL histdef(hist2_id, 'RootMoist','Root zone soil water', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'SubSnow','Snow sublimation','kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'ACond', 'Aerodynamic conductance', 'm/s',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             !-
+             !-
+             !-  Cold Season Processes
+             !-
+             CALL histdef(hist2_id, 'SnowFrac', 'Snow cover fraction', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'SAlbedo', 'Snow albedo', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'SnowDepth', '3D snow depth', 'm', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             !-
+             !- Hydrologic variables
+             !-
+             CALL histdef(hist2_id, 'IrrigationMap', 'Map of irrigated areas', 'm^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
+             CALL histdef(hist2_id, 'FloodplainsMap', 'Map of flooded areas', 'm^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt,dw2)
+             CALL histdef(hist2_id, 'SwampMap', 'Map of swamp areas', 'm^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt,dw2)
+             CALL histdef(hist2_id, 'Dis', 'Simulated River Discharge', 'm^3/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt,dw2)
+             CALL histdef(hist2_id, 'humrel', 'Soil moisture stress', '-',  &
+                  & iim,jjm, hori_id2, nvm,1,nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
+             !-
+             !-  The carbon budget
+             !-
+             IF ( ok_co2 ) THEN
+                CALL histdef(hist2_id, 'GPP', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
+             ENDIF
+             IF ( ok_stomate ) THEN
+                CALL histdef(hist2_id, 'NEE', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
+                CALL histdef(hist2_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
+                CALL histdef(hist2_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
+                CALL histdef(hist2_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
+                CALL histdef(hist2_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
+             ENDIF
+             !
+          ENDIF
+          !-
+          CALL histdef(hist2_id, 'LandPoints', 'Land Points', '1', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)  
+          CALL histdef(hist2_id, 'Areas', 'Mesh areas', 'm2', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
+          CALL histdef(hist2_id, 'Contfrac', 'Continental fraction', '1', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
+          !-
+          ! Write the names of the pfts in the high frequency sechiba history files
+          global_attribute="PFT_name"
+          DO i=1,nvm
+             WRITE(global_attribute(9:10),"(I2.2)") i
+             CALL histglobal_attr(hist2_id, global_attribute, PFT_name(i))
+          ENDDO
+          !-
+          CALL histend(hist2_id)
+      ENDIF
+  ENDIF
+
+    !-
+    !=====================================================================
+    !- 3.2 STOMATE's history file
+    !=====================================================================
+    IF ( ok_stomate ) THEN
+       !-
+       ! STOMATE IS ACTIVATED
+       !-
+       !Config Key   = STOMATE_OUTPUT_FILE
+       !Config Desc  = Name of file in which STOMATE's output is going to be written
+       !Config If    = OK_STOMATE
+       !Config Def   = stomate_history.nc
+       !Config Help  = This file is going to be created by the model
+       !Config         and will contain the output from the model.
+       !Config         This file is a truly COADS compliant netCDF file.
+       !Config         It will be generated by the hist software from
+       !Config         the IOIPSL package.
+       !Config Units = [FILE]
+       !-
+       stom_histname='stomate_history.nc'
+       CALL getin_p('STOMATE_OUTPUT_FILE', stom_histname)       
+       WRITE(numout,*) 'STOMATE_OUTPUT_FILE', TRIM(stom_histname)
+       !-
+       !Config Key   = STOMATE_HIST_DT
+       !Config Desc  = STOMATE history time step
+       !Config If    = OK_STOMATE
+       !Config Def   = 10.
+       !Config Help  = Time step of the STOMATE history file
+       !Config Units = [days]
+       !-
+       hist_days_stom = 10.
+       CALL getin_p('STOMATE_HIST_DT', hist_days_stom)       
+
+       IF ( hist_id < 0 ) THEN
+          ! Deactivate all history files if sechiba_history file is deactivated
+          hist_dt_stom=0
+          WRITE(numout,*) 'STOMATE history file will not be created because sechiba_history file is deactivated.'
+       ELSE IF ( hist_days_stom == moins_un ) THEN
+          hist_dt_stom = moins_un
+          WRITE(numout,*) 'output frequency for STOMATE history file (d): one month.'
+       ELSE IF ( hist_days_stom == 0 ) THEN
+          ! Deactivate this file
+          hist_dt_stom=0
+          WRITE(numout,*) 'STOMATE history file will not be created'
+       ELSE
+          hist_dt_stom = NINT( hist_days_stom ) * one_day
+          WRITE(numout,*) 'output frequency for STOMATE history file (d): ', &
+               hist_dt_stom/one_day
+       ENDIF
+
+       ! test consistency between STOMATE_HIST_DT and DT_STOMATE parameters
+       dt_stomate_loc = one_day
+       CALL getin_p('DT_STOMATE', dt_stomate_loc)
+       IF ( hist_days_stom /= moins_un .AND. hist_dt_stom/=0) THEN
+          IF (dt_stomate_loc > hist_dt_stom) THEN
+             WRITE(numout,*) "DT_STOMATE = ",dt_stomate_loc,"  , STOMATE_HIST_DT = ",hist_dt_stom
+             CALL ipslerr_p (3,'ioipslctrl_history', &
+                  &          'Problem with DT_STOMATE > STOMATE_HIST_DT','', &
+                  &          '(must be less or equal)')
+          ENDIF
+       ENDIF
+       !-
+       !- Initialize stomate_history file
+       IF ( hist_dt_stom == 0 ) THEN
+          ! Case hist_dt_stom=0 : No creation of stomate_history.nc file
+          ! Nothing will be done.
+          hist_id_stom=-1
+       ELSE
+          ! Initialise stomate_history file
+       IF (is_omp_root) THEN
+          IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+             CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id_stom,domain_id=orch_domain_id)
+#else
+             CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id_stom)
+#endif
+          ELSE
+#ifdef CPP_PARA
+             CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id_stom,domain_id=orch_domain_id)
+#else
+             CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id_stom)
+#endif
+          ENDIF
+          CALL histvert (hist_id_stom, 'Depth', 'Soil levels', &
+               & 'm', nslm, -diaglev(1:nslm), hist_solax_id)
+          !- define PFT axis
+          hist_PFTaxis = (/ ( REAL(i,r_std), i=1,nvm ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'PFT', 'Plant functional type', &
+               & '1', nvm, hist_PFTaxis, hist_PFTaxis_id)
+          ! deforestation
+          !- define Pool_10 axis
+          hist_pool_10axis = (/ ( REAL(i,r_std), i=1,10 ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P10', 'Pool 10 years', &
+               & '1', 10, hist_pool_10axis, hist_pool_10axis_id)
+          
+          !- define Pool_100 axis
+          hist_pool_100axis = (/ ( REAL(i,r_std), i=1,100 ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P100', 'Pool 100 years', &
+               & '1', 100, hist_pool_100axis, hist_pool_100axis_id)
+          
+          !- define Pool_11 axis
+          hist_pool_11axis = (/ ( REAL(i,r_std), i=1,11 ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P11', 'Pool 10 years + 1', &
+               & '1', 11, hist_pool_11axis, hist_pool_11axis_id)
+          
+          !- define Pool_101 axis
+          hist_pool_101axis = (/ ( REAL(i,r_std), i=1,101 ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P101', 'Pool 100 years + 1', &
+               & '1', 101, hist_pool_101axis, hist_pool_101axis_id)
+       ENDIF
+       !- define STOMATE history file
+       CALL ioipslctrl_histstom (hist_id_stom, nvm, iim, jjm, &
+            & dt, hist_dt_stom, hori_id, hist_PFTaxis_id, &
+            & hist_pool_10axis_id, hist_pool_100axis_id, &
+            & hist_pool_11axis_id, hist_pool_101axis_id, &
+            & hist_solax_id)
+       
+       !- Write the names of the pfts in the stomate history files 
+       IF (is_omp_root) THEN
+          global_attribute="PFT_name"
+          DO i=1,nvm
+             WRITE(global_attribute(9:10),"(I2.2)") i
+             CALL histglobal_attr(hist_id_stom, global_attribute, PFT_name(i))
+          ENDDO
+
+       !- end definition
+          CALL histend(hist_id_stom)
+       ENDIF
+    END IF ! IF ( hist_dt_stom == 0 )
+
+       !-
+       !-
+       !-
+       ! STOMATE IPCC OUTPUTS IS ACTIVATED
+       !-
+       !Config Key   = STOMATE_IPCC_OUTPUT_FILE
+       !Config Desc  = Name of file in which STOMATE's output is going to be written
+       !Config If    = OK_STOMATE
+       !Config Def   = stomate_ipcc_history.nc
+       !Config Help  = This file is going to be created by the model
+       !Config         and will contain the output from the model.
+       !Config         This file is a truly COADS compliant netCDF file.
+       !Config         It will be generated by the hist software from
+       !Config         the IOIPSL package.
+       !Config Units = [FILE]
+       !-
+       stom_ipcc_histname='stomate_ipcc_history.nc'
+       CALL getin_p('STOMATE_IPCC_OUTPUT_FILE', stom_ipcc_histname)       
+       WRITE(numout,*) 'STOMATE_IPCC_OUTPUT_FILE', TRIM(stom_ipcc_histname)
+       !-
+       !Config Key   = STOMATE_IPCC_HIST_DT
+       !Config Desc  = STOMATE IPCC history time step
+       !Config If    = OK_STOMATE
+       !Config Def   = 0.
+       !Config Help  = Time step of the STOMATE IPCC history file
+       !Config Units = [days]
+       !-
+       hist_days_stom_ipcc = zero
+       CALL getin_p('STOMATE_IPCC_HIST_DT', hist_days_stom_ipcc)       
+       IF ( hist_days_stom_ipcc == moins_un ) THEN
+          hist_dt_stom_ipcc = moins_un
+          WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): one month.'
+       ELSE
+          hist_dt_stom_ipcc = NINT( hist_days_stom_ipcc ) * one_day
+          WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): ', &
+            hist_dt_stom_ipcc/one_day
+       ENDIF
+       
+       IF ( hist_dt_stom_ipcc /= 0 .AND. hist_id < 0 ) THEN
+          ! sechiba_history file is not created therefore STOMATE IPCC history file will be deactivated
+          hist_dt_stom_ipcc=0
+          hist_days_stom_ipcc=0
+          WRITE(numout,*) 'STOMATE IPCC history file is not created.'
+       END IF
+
+       ! test consistency between STOMATE_IPCC_HIST_DT and DT_STOMATE parameters
+       dt_stomate_loc = one_day
+       CALL getin_p('DT_STOMATE', dt_stomate_loc)
+       IF ( hist_days_stom_ipcc > zero ) THEN
+          IF (dt_stomate_loc > hist_dt_stom_ipcc) THEN
+             WRITE(numout,*) "DT_STOMATE = ",dt_stomate_loc,"  , STOMATE_IPCC_HIST_DT = ",hist_dt_stom_ipcc
+             CALL ipslerr_p (3,'ioipslctrl_history', &
+                  &          'Problem with DT_STOMATE > STOMATE_IPCC_HIST_DT','', &
+                  &          '(must be less or equal)')
+          ENDIF
+       ENDIF
+
+       !Config Key   = OK_HISTSYNC
+       !Config Desc  = Syncronize and write IOIPSL output files at each time step
+       !Config If    = 
+       !Config Def   = FALSE
+       !Config Help  = Setting this flag to true might affect run performance. Only use it for debug perpose.
+       !Config Units = [FLAG]
+       ok_histsync=.FALSE.
+       CALL getin_p('OK_HISTSYNC', ok_histsync)       
+
+
+
+       IF ( hist_dt_stom_ipcc == 0 ) THEN
+          hist_id_stom_ipcc = -1
+       ELSE
+          !-
+          !- initialize
+          IF (is_omp_root) THEN
+             IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+                CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
+#else
+                CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id, hist_id_stom_ipcc)
+#endif
+             ELSE
+#ifdef CPP_PARA
+                CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
+#else
+                CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id, hist_id_stom_ipcc)
+#endif
+             ENDIF
+             !- declare this axis
+             CALL histvert (hist_id_stom_IPCC, 'PFT', 'Plant functional type', &
+                  & '1', nvm, hist_PFTaxis, hist_IPCC_PFTaxis_id)
+             
+             !- define STOMATE history file
+             CALL ioipslctrl_histstomipcc (hist_id_stom_IPCC, nvm, iim, jjm, &
+                  & dt, hist_dt_stom_ipcc, hori_id, hist_IPCC_PFTaxis_id)
+             
+             !- Write the names of the pfts in the stomate history files 
+             global_attribute="PFT_name"
+             DO i=1,nvm
+                WRITE(global_attribute(9:10),"(I2.2)") i
+                CALL histglobal_attr(hist_id_stom_IPCC, global_attribute, PFT_name(i))
+             ENDDO
+
+             !- end definition
+             CALL histend(hist_id_stom_IPCC)
+          ENDIF
+      ENDIF
+   ENDIF
+
+
+  END SUBROUTINE ioipslctrl_history
+
+!! ================================================================================================================================
+!! SUBROUTINE    : ioipslctrl_histstom
+!!
+!>\BRIEF	 This subroutine initialize the IOIPSL stomate output file
+!! 
+!! DESCRIPTION   : This subroutine initialize the IOIPSL output file stomate_history.nc(default name).
+!!                 This subroutine was previously named stom_define_history and where located in module intersurf.
+!! RECENT CHANGE(S): None
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE ioipslctrl_histstom( &
+       hist_id_stom, nvm, iim, jjm, dt, &
+       hist_dt, hist_hori_id, hist_PFTaxis_id, &
+       hist_pool_10axis_id, hist_pool_100axis_id, &
+       hist_pool_11axis_id, hist_pool_101axis_id,&
+       hist_solax_id)
+    ! deforestation axis added as arguments
+
+    !---------------------------------------------------------------------
+    !- Tell ioipsl which variables are to be written
+    !- and on which grid they are defined
+    !---------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    !- Input
+    !-
+    !- File id
+    INTEGER(i_std),INTENT(in) :: hist_id_stom
+    !- number of PFTs
+    INTEGER(i_std),INTENT(in) :: nvm
+    !- Domain size
+    INTEGER(i_std),INTENT(in) :: iim, jjm
+    !- Time step of STOMATE (seconds)
+    REAL(r_std),INTENT(in)    :: dt
+    !- Time step of history file (s)
+    REAL(r_std),INTENT(in)    :: hist_dt
+    !- id horizontal grid
+    INTEGER(i_std),INTENT(in) :: hist_hori_id
+    !- id of PFT axis
+    INTEGER(i_std),INTENT(in) :: hist_PFTaxis_id
+    !) id soil carbon layers
+    INTEGER(i_std),INTENT(in) :: hist_solax_id
+    !- id of Deforestation axis
+    INTEGER(i_std),INTENT(in) :: hist_pool_10axis_id,hist_pool_100axis_id
+    INTEGER(i_std),INTENT(in) :: hist_pool_11axis_id,hist_pool_101axis_id
+    !-
+    !- 1 local
+    !-
+    !- maximum history level
+    INTEGER(i_std), PARAMETER  :: max_hist_level = 10
+    !- output level (between 0 and 10)
+    !-  ( 0:nothing is written, 10:everything is written)
+    INTEGER(i_std)             :: hist_level
+    !- Character strings to define operations for histdef
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: ave
+
+    !---------------------------------------------------------------------
+    !=====================================================================
+    !- 1 history level
+    !=====================================================================
+    !- 1.1 define history levelx
+    !=====================================================================
+    !Config Key   = STOMATE_HISTLEVEL
+    !Config Desc  = STOMATE history output level (0..10)
+    !Config If    = OK_STOMATE
+    !Config Def   = 10
+    !Config Help  = 0: nothing is written; 10: everything is written
+    !Config Units = [-]
+    !-
+    hist_level = 10
+    CALL getin_p('STOMATE_HISTLEVEL', hist_level)
+    !-
+    WRITE(numout,*) 'STOMATE history level: ',hist_level
+    IF ( (hist_level > max_hist_level).OR.(hist_level < 0) ) THEN
+       STOP 'This history level is not allowed'
+    ENDIF
+    !=====================================================================
+    !- 1.2 define operations according to output level
+    !=====================================================================
+    ave(1:hist_level) =  'ave(scatter(X))'
+    ave(hist_level+1:max_hist_level) =  'never          '
+    !=====================================================================
+    !- 2 surface fields (2d)
+    !- 3 PFT: 3rd dimension
+    !=====================================================================
+
+
+    ! structural litter above ground
+    IF (is_omp_root) THEN
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_STR_AB       "), &
+            &               TRIM("structural litter above ground                    "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! metabolic litter above ground                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_MET_AB       "), &
+            &               TRIM("metabolic litter above ground                     "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+
+       ! structural litter below ground               
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_STR_BE       "), &
+            &               TRIM("structural litter below ground per m3 of soil     "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+
+       ! metabolic litter below ground                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_MET_BE       "), &
+            &               TRIM("metabolic litter below ground per m3 of soil      "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+       
+       ! fraction of soil covered by dead leaves           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("DEADLEAF_COVER      "), &
+            &               TRIM("fraction of soil covered by dead leaves           "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+       ! total soil and litter carbon
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_SOIL_CARB     "), &
+            &               TRIM("total soil and belowground litter C per m3 of soil"), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+       ! total soil and litter carbon 14
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_SOIL_CARB14     "), &
+            &               TRIM("total soil and belowground litter 14C per m3 of soil"), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+
+       ! active soil carbon in ground                 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CARBON_ACTIVE       "), &
+            &               TRIM("active soil carbon in ground per m3 of soil        "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+       ! active soil carbon 14 in ground                 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CARBON14_ACTIVE       "), &
+            &               TRIM("active soil carbon 14 in ground per m3 of soil        "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+
+       ! slow soil carbon in ground                   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CARBON_SLOW         "), &
+            &               TRIM("slow soil carbon in ground per m3 of soil          "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+       ! slow soil carbon 14 in ground                   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CARBON14_SLOW         "), &
+            &               TRIM("slow soil carbon 14 in ground per m3 of soil          "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+
+       ! passive soil carbon in ground                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CARBON_PASSIVE      "), &
+            &               TRIM("passive soil carbon in ground per m3 of soil       "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+      ! passive soil carbon 14 in ground                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CARBON14_PASSIVE      "), &
+            &               TRIM("passive soil carbon 14 in ground per m3 of soil       "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+
+       ! free dissolved organic carbon in soil                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FREE_DOC           "), &
+            &               TRIM("free dissolved organic C in soil per m3 of soil     "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+       ! free dissolved organic carbon 14 in soil                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FREE_DOC14           "), &
+            &               TRIM("free dissolved organic 14C in soil per m3 of soil     "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+       ! adsorbed dissolved organic carbon in soil                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ADSORBED_DOC        "), &
+            &               TRIM("adsorbed dissolved org. C in soil per m3 of soil    "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+       ! adsorbed dissolved organic carbon 14 in soil                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ADSORBED_DOC14        "), &
+            &               TRIM("adsorbed dissolved org. 14C in soil per m3 of soil    "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+       ! exported dissolved organic carbon                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("EXPORTED_DOC_RUNOFF "), &
+            &               TRIM("exported DOC from runoff "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("EXPORTED_DOC_DRAIN  "), &
+            &               TRIM("exported DOC from drainage "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("EXPORTED_DOC_FLOOD  "), &
+            &               TRIM("exported DOC from  flood "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+              
+       ! Long term 2 m temperature                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("T2M_LONGTERM        "), &
+            &               TRIM("Longterm 2 m temperature                          "), &
+            &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(9), dt, hist_dt)
+       
+       ! Monthly 2 m temperature                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("T2M_MONTH           "), &
+            &               TRIM("Monthly 2 m temperature                           "), &
+            &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+       ! Weekly 2 m temperature                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("T2M_WEEK            "), &
+            &               TRIM("Weekly 2 m temperature                            "), &
+            &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+       ! heterotr. resp. from ground                  
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HET_RESP            "), &
+            &               TRIM("heterotr. resp. from ground                       "), &
+            &               TRIM("gC/m^2 tot/pft/day  "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+       
+       ! Fire fraction on ground
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FIREFRAC            "), &
+            &               TRIM("Fire fraction on ground                           "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Fire index on ground                      
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FIREINDEX           "), &
+            &               TRIM("Fire index on ground                              "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+       
+       ! Litter humidity                                   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTERHUM           "), &
+            &               TRIM("Litter humidity                                   "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+       
+       ! CO2 flux                                  
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CO2FLUX             "), &
+            &               TRIM("CO2 flux                                          "), &
+            &               TRIM("gC/m^2/pft/mth      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Output CO2 flux from fire                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CO2_FIRE            "), &
+            &               TRIM("Output CO2 flux from fire                         "), &
+            &               TRIM("gC/day/m^2/pft      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+       
+       ! CO2 taken from atmosphere for initiate growth     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CO2_TAKEN           "), &
+            &               TRIM("CO2 taken from atmosphere for initiate growth     "), &
+            &               TRIM("gC/day/m^2/pft      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       IF (ok_dgvm) THEN
+          ! total co2 flux (sum over 13 PFTs). when DGVM is activated, the previous
+          ! SUM(CO2FLUX*veget_max) is wrong. We should look at this variable.
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCO2FLUX            "), &
+               &               TRIM("total CO2flux of 13 PFTs (after adjustment)       "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+          
+          ! should be the same with tCO2FLUX
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCO2FLUX_OLD        "), &
+               &               TRIM("total CO2flux of 13 PFTs(multiply by veget_max_old"), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(10), dt, hist_dt)
+          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tGPP                 "), &
+               &               TRIM("total GPP of 13 PFTs (after adjustment)           "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tRESP_GROWTH         "), &
+               &               TRIM("total resp growth of 13 PFTs (after adjustment)   "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tRESP_MAINT          "), &
+               &               TRIM("total resp maint  of 13 PFTs (after adjustment)   "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tRESP_HETERO         "), &
+               &               TRIM("total resp hetero of 13 PFTs (after adjustment)   "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCARBON              "), &
+               &               TRIM("total carbon of 13 PFTs (after adjustment)        "), &
+               &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tBIOMASS             "), &
+               &               TRIM("total biomass of 13 PFTs (after adjustment)       "), &
+               &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tLITTER              "), &
+               &               TRIM("total litter of 13 PFTs (after adjustment)        "), &
+               &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tSOILC               "), &
+               &               TRIM("total soil carbon of 13 PFTs (after adjustment)   "), &
+               &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCO2_TAKEN           "), &
+               &               TRIM("total co2_to_bm 13 PFTs (after adjustment)        "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(10), dt, hist_dt)
+          
+          CALL histdef (hist_id_stom, &
+               &               TRIM("tCO2_FIRE            "), &
+               &               TRIM("total co2_fire 13 PFTs (after adjustment)         "), &
+               &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+               &               1,1,1, -99,32, ave(10), dt, hist_dt)
+       END IF
+       
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FPC_MAX             "), &
+            &               TRIM("foliage projective cover                          "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MAXFPC_LASTYEAR     "), &
+            &               TRIM("foliage projective cover of last year             "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+
+       ! "seasonal" 2 m temperature                           
+       CALL histdef (hist_id_stom, &
+         &               TRIM("TSEASON             "), &
+         &               TRIM("Seasonal 2 m temperature                             "), &
+         &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(10), dt, hist_dt)
+
+       ! how many days after onset                           
+       CALL histdef (hist_id_stom, &
+         &               TRIM("TMIN_SPRING_TIME    "), &
+         &               TRIM("how many days after onset                            "), &
+         &               TRIM("days                "), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+
+       !                           
+       CALL histdef (hist_id_stom, &
+         &               TRIM("ONSET_DATE          "), &
+         &               TRIM("onset date                                           "), &
+         &               TRIM("day                 "), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+
+       ! Leaf Area Index                                   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LAI                 "), &
+            &               TRIM("Leaf Area Index                                   "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+       
+       ! Maximum vegetation fraction (LAI -> infinity)     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("VEGET_MAX           "), &
+            &               TRIM("Maximum vegetation fraction (LAI -> infinity)     "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+       
+       ! Net primary productivity                          
+       CALL histdef (hist_id_stom, &
+            &               TRIM("NPP                 "), &
+            &               TRIM("Net primary productivity                          "), &
+            &               TRIM("gC/day/(m^2 tot)    "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Gross primary productivity                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GPP                 "), &
+            &               TRIM("Gross primary productivity                        "), &
+            &               TRIM("gC/day/m^2          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Density of individuals                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("IND                 "), &
+            &               TRIM("Density of individuals                            "), &
+            &               TRIM("1/ m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! Adaptation to climate
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ADAPTATION          "), &
+            &               TRIM("Adaptation to climate (DGVM)                      "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+    
+       ! Probability from regenerative
+       CALL histdef (hist_id_stom, &
+            &               TRIM("REGENERATION        "), &
+            &               TRIM("Probability from regenerative (DGVM)               "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+       
+       ! crown area of individuals (m**2)
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CN_IND              "), &
+            &               TRIM("crown area of individuals                         "), &
+            &               TRIM("m^2                 "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! woodmass of individuals (gC)
+       CALL histdef (hist_id_stom, &
+            &               TRIM("WOODMASS_IND        "), &
+            &               TRIM("Woodmass of individuals                           "), &
+            &               TRIM("gC/pft              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! total living biomass
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_M             "), &
+            &               TRIM("Total living biomass                              "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+       
+       ! Leaf mass                                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LEAF_M              "), &
+            &               TRIM("Leaf mass                                         "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! Sap mass above ground                             
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_M_AB            "), &
+            &               TRIM("Sap mass above ground                             "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Sap mass below ground                             
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_M_BE            "), &
+            &               TRIM("Sap mass below ground                             "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! Heartwood mass above ground                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEART_M_AB          "), &
+            &               TRIM("Heartwood mass above ground                       "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Heartwood mass below ground                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEART_M_BE          "), &
+            &               TRIM("Heartwood mass below ground                       "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Root mass                                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ROOT_M              "), &
+            &               TRIM("Root mass                                         "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! Fruit mass                                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FRUIT_M             "), &
+            &               TRIM("Fruit mass                                        "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! Carbohydrate reserve mass                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("RESERVE_M           "), &
+            &               TRIM("Carbohydrate reserve mass                         "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! total turnover rate
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_TURN          "), &
+            &               TRIM("total turnover rate                               "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Leaf turnover                                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LEAF_TURN           "), &
+            &               TRIM("Leaf turnover                                     "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Sap turnover above                                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_AB_TURN         "), &
+            &               TRIM("Sap turnover above                                "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Root turnover                                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ROOT_TURN           "), &
+            &               TRIM("Root turnover                                     "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Fruit turnover                                    
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FRUIT_TURN          "), &
+            &               TRIM("Fruit turnover                                    "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! total conversion of biomass to litter 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_BM_LITTER     "), &
+            &               TRIM("total conversion of biomass to litter             "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Leaf death                                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LEAF_BM_LITTER      "), &
+            &               TRIM("Leaf death                                        "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+       
+       ! Sap death above ground                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_AB_BM_LITTER    "), &
+            &               TRIM("Sap death above ground                            "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Sap death below ground                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_BE_BM_LITTER    "), &
+            &               TRIM("Sap death below ground                            "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Heartwood death above ground                      
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEART_AB_BM_LITTER  "), &
+            &               TRIM("Heartwood death above ground                      "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Heartwood death below ground                      
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEART_BE_BM_LITTER  "), &
+            &               TRIM("Heartwood death below ground                      "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Root death                                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ROOT_BM_LITTER      "), &
+            &               TRIM("Root death                                        "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+       
+       ! Fruit death                                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FRUIT_BM_LITTER     "), &
+            &               TRIM("Fruit death                                       "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Carbohydrate reserve death                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("RESERVE_BM_LITTER   "), &
+            &               TRIM("Carbohydrate reserve death                        "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Maintenance respiration                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MAINT_RESP          "), &
+            &               TRIM("Maintenance respiration                           "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Growth respiration                                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GROWTH_RESP         "), &
+            &               TRIM("Growth respiration                                "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! age                                               
+       CALL histdef (hist_id_stom, &
+            &               TRIM("AGE                 "), &
+            &               TRIM("age                                               "), &
+            &               TRIM("years               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(7), dt, hist_dt)
+       
+       ! height                                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEIGHT              "), &
+            &               TRIM("height                                            "), &
+            &               TRIM("m                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(7), dt, hist_dt)
+
+       ! weekly moisture stress                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MOISTRESS           "), &
+            &               TRIM("weekly moisture stress                            "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! Maximum rate of carboxylation                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("VCMAX               "), &
+            &               TRIM("Maximum rate of carboxylation                     "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! leaf age                                          
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LEAF_AGE            "), &
+            &               TRIM("leaf age                                          "), &
+            &               TRIM("days                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+       
+       ! Fraction of trees that dies (gap)                 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MORTALITY           "), &
+            &               TRIM("Fraction of trees that dies (gap)                 "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! Fraction of plants killed by fire                 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FIREDEATH           "), &
+            &               TRIM("Fraction of plants killed by fire                 "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! Density of newly established saplings             
+       CALL histdef (hist_id_stom, &
+            &               TRIM("IND_ESTAB           "), &
+            &               TRIM("Density of newly established saplings             "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! Establish tree
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ESTABTREE           "), &
+            &               TRIM("Rate of tree establishement                       "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(6), dt, hist_dt)
+
+       ! Establish grass
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ESTABGRASS          "), &
+            &               TRIM("Rate of grass establishement                      "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(6), dt, hist_dt)
+
+       ! Fraction of plants that dies (light competition)  
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LIGHT_DEATH         "), &
+            &               TRIM("Fraction of plants that dies (light competition)  "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! biomass allocated to leaves                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_LEAF       "), &
+            &               TRIM("biomass allocated to leaves                       "), &
+            &               TRIM("gC/m**2/pft/dt      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to sapwood above ground         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_SAP_AB     "), &
+            &               TRIM("biomass allocated to sapwood above ground         "), &
+            &               TRIM("gC/m**2/pft/dt      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to sapwood below ground         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_SAP_BE     "), &
+            &               TRIM("biomass allocated to sapwood below ground         "), &
+            &               TRIM("gC/m**2/pft/dt      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to roots                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_ROOT       "), &
+            &               TRIM("biomass allocated to roots                        "), &
+            &               TRIM("gC/m**2/pft/dt          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to fruits                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_FRUIT      "), &
+            &               TRIM("biomass allocated to fruits                       "), &
+            &               TRIM("gC/m**2/pft/dt          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to carbohydrate reserve         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_RES        "), &
+            &               TRIM("biomass allocated to carbohydrate reserve         "), &
+            &               TRIM("gC/m**2/pft/dt          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! time constant of herbivore activity               
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HERBIVORES          "), &
+            &               TRIM("time constant of herbivore activity               "), &
+            &               TRIM("days                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! turnover time for grass leaves                    
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TURNOVER_TIME       "), &
+            &               TRIM("turnover time for grass leaves                    "), &
+            &               TRIM("days                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! 10 year wood product pool                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PROD10              "), &
+            &               TRIM("10 year wood product pool                         "), &
+            &               TRIM("gC/m**2             "), iim,jjm, hist_hori_id, &
+            &               11,1,11, hist_pool_11axis_id,32, ave(5), dt, hist_dt)
+       
+       ! annual flux for each 10 year wood product pool    
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FLUX10              "), &
+            &               TRIM("annual flux for each 10 year wood product pool    "), &
+            &               TRIM("gC/m**2/yr          "), iim,jjm, hist_hori_id, &
+            &               10,1,10, hist_pool_10axis_id,32, ave(5), dt, hist_dt)
+       
+       ! 100 year wood product pool                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PROD100             "), &
+            &               TRIM("100 year wood product pool                        "), &
+            &               TRIM("gC/m**2             "), iim,jjm, hist_hori_id, &
+            &               101,1,101, hist_pool_101axis_id,32, ave(5), dt, hist_dt)
+
+       ! annual flux for each 100 year wood product pool   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FLUX100             "), &
+            &               TRIM("annual flux for each 100 year wood product pool   "), &
+            &               TRIM("gC/m**2/yr          "), iim,jjm, hist_hori_id, &
+            &               100,1,100, hist_pool_100axis_id,32, ave(5), dt, hist_dt)
+
+       ! annual release right after deforestation          
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CONVFLUX            "), &
+            &               TRIM("annual release right after deforestation          "), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+
+       ! annual release from all 10 year wood product pools 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CFLUX_PROD10        "), &
+            &               TRIM("annual release from all 10 year wood product pools"), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+
+       ! annual release from all 100year wood product pools
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CFLUX_PROD100       "), &
+            &               TRIM("annual release from all 100year wood product pools"), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+       ! agriculure product
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HARVEST_ABOVE       "), &
+            &               TRIM("annual release product after harvest              "), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+
+
+       CALL histdef(hist_id_stom, 'RESOLUTION_X', 'E-W resolution', 'm', &
+            & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+       CALL histdef(hist_id_stom, 'RESOLUTION_Y', 'N-S resolution', 'm', &
+            & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+       CALL histdef(hist_id_stom, 'CONTFRAC', 'Continental fraction', '1', &
+            & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+       CALL histdef(hist_id_stom, 'Areas', 'Mesh areas', 'm2', &
+            & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+       
+       !  Special outputs for phenology
+       CALL histdef (hist_id_stom, &
+            &               TRIM("WHEN_GROWTHINIT     "), &
+            &               TRIM("Time elapsed from season beginning                "), &
+            &               TRIM("d                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PFTPRESENT          "), &
+            &               TRIM("PFT exists                                        "), &
+            &               TRIM("d                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GDD_MIDWINTER       "), &
+            &               TRIM("Growing degree days, since midwinter              "), &
+            &               TRIM("degK                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GDD_M5_DORMANCE     "), &
+            &               TRIM("Growing degree days, since dormance               "), &
+            &               TRIM("degK                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("NCD_DORMANCE        "), &
+            &               TRIM("Number of chilling days, since leaves were lost   "), &
+            &               TRIM("d                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ALLOW_INITPHENO     "), &
+            &               TRIM("Allow to declare beginning of the growing season  "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BEGIN_LEAVES        "), &
+            &               TRIM("Signal to start putting leaves on                 "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+    ENDIF
+
+  END SUBROUTINE ioipslctrl_histstom
+
+!! ================================================================================================================================
+!! SUBROUTINE    : ioipslctrl_histstomipcc
+!!
+!>\BRIEF	 This subroutine initialize the IOIPSL stomate second output file (ipcc file)
+!! 
+!! DESCRIPTION   : This subroutine initialize the IOIPSL stomate second output file named stomate_ipcc_history.nc(default name).
+!!                 This subroutine was previously called stom_IPCC_define_history and located in module intersurf.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE ioipslctrl_histstomipcc( &
+       hist_id_stom_IPCC, nvm, iim, jjm, dt, &
+       hist_dt, hist_hori_id, hist_PFTaxis_id)
+    ! deforestation axis added as arguments
+
+    !---------------------------------------------------------------------
+    !- Tell ioipsl which variables are to be written
+    !- and on which grid they are defined
+    !---------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    !- Input
+    !-
+    !- File id
+    INTEGER(i_std),INTENT(in) :: hist_id_stom_IPCC
+    !- number of PFTs
+    INTEGER(i_std),INTENT(in) :: nvm
+    !- Domain size
+    INTEGER(i_std),INTENT(in) :: iim, jjm
+    !- Time step of STOMATE (seconds)
+    REAL(r_std),INTENT(in)    :: dt
+    !- Time step of history file (s)
+    REAL(r_std),INTENT(in)    :: hist_dt
+    !- id horizontal grid
+    INTEGER(i_std),INTENT(in) :: hist_hori_id
+    !- id of PFT axis
+    INTEGER(i_std),INTENT(in) :: hist_PFTaxis_id
+    !-
+    !- 1 local
+    !-
+    !- Character strings to define operations for histdef
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: ave
+
+    !=====================================================================
+    !- 1 define operations
+    !=====================================================================
+    ave(1) =  'ave(scatter(X))'
+    !=====================================================================
+    !- 2 surface fields (2d)
+    !=====================================================================
+    ! Carbon in Vegetation
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cVeg"), &
+         &               TRIM("Carbon in Vegetation"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Litter Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLitter"), &
+         &               TRIM("Carbon in Litter Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoil"), &
+         &               TRIM("Carbon in Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Products of Land Use Change
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cProduct"), &
+         &               TRIM("Carbon in Products of Land Use Change"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon Mass Variation
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cMassVariation"), &
+         &               TRIM("Terrestrial Carbon Mass Variation"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Leaf Area Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("lai"), &
+         &               TRIM("Leaf Area Fraction"), &
+         &               TRIM("1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Gross Primary Production
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("gpp"), &
+         &               TRIM("Gross Primary Production"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Autotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("ra"), &
+         &               TRIM("Autotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Net Primary Production
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("npp"), &
+         &               TRIM("Net Primary Production"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Heterotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("rh"), &
+         &               TRIM("Heterotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Emission from Fire
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fFire"), &
+         &               TRIM("CO2 Emission from Fire"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! CO2 Flux to Atmosphere from Crop Harvesting
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fHarvest"), &
+         &               TRIM("CO2 Flux to Atmosphere from Crop Harvesting"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux to Atmosphere from Land Use Change
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fLuc"), &
+         &               TRIM("CO2 Flux to Atmosphere from Land Use Change"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Net Biospheric Production
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nbp"), &
+         &               TRIM("Net Biospheric Production"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Total Carbon Flux from Vegetation to Litter
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fVegLitter"), &
+         &               TRIM("Total Carbon Flux from Vegetation to Litter"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Total Carbon Flux from Litter to Soil
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fLitterSoil"), &
+         &               TRIM("Total Carbon Flux from Litter to Soil"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! Carbon in Leaves
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLeaf"), &
+         &               TRIM("Carbon in Leaves"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Wood
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cWood"), &
+         &               TRIM("Carbon in Wood"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Roots
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cRoot"), &
+         &               TRIM("Carbon in Roots"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Other Living Compartments
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cMisc"), &
+         &               TRIM("Carbon in Other Living Compartments"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! Carbon in Above-Ground Litter
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLitterAbove"), &
+         &               TRIM("Carbon in Above-Ground Litter"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Below-Ground Litter
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLitterBelow"), &
+         &               TRIM("Carbon in Below-Ground Litter"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Fast Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoilFast"), &
+         &               TRIM("Carbon in Fast Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Medium Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoilMedium"), &
+         &               TRIM("Carbon in Medium Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Slow Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoilSlow"), &
+         &               TRIM("Carbon in Slow Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    !- 3 PFT: 3rd dimension
+    ! Fractional Land Cover of PFT
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("landCoverFrac"), &
+         &               TRIM("Fractional Land Cover of PFT"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+
+    ! Total Primary Deciduous Tree Cover Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("treeFracPrimDec"), &
+         &               TRIM("Total Primary Deciduous Tree Cover Fraction"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! Total Primary Evergreen Tree Cover Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("treeFracPrimEver"), &
+         &               TRIM("Total Primary Evergreen Tree Cover Fraction"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! Total C3 PFT Cover Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("c3PftFrac"), &
+         &               TRIM("Total C3 PFT Cover Fraction"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Total C4 PFT Cover Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("c4PftFrac"), &
+         &               TRIM("Total C4 PFT Cover Fraction"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Growth Autotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("rGrowth"), &
+         &               TRIM("Growth Autotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Maintenance Autotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("rMaint"), &
+         &               TRIM("Maintenance Autotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux from Atmosphere due to NPP Allocation to Leaf
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nppLeaf"), &
+         &               TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Leaf"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux from Atmosphere due to NPP Allocation to Wood
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nppWood"), &
+         &               TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Wood"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux from Atmosphere due to NPP Allocation to Root
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nppRoot"), &
+         &               TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Root"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity on Land.
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nep"), &
+         &               TRIM("Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity."), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    CALL histdef(hist_id_stom_IPCC, 'RESOLUTION_X', 'E-W resolution', 'm', &
+         & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+    CALL histdef(hist_id_stom_IPCC, 'RESOLUTION_Y', 'N-S resolution', 'm', &
+         & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+    CALL histdef(hist_id_stom_IPCC, 'CONTFRAC', 'Continental fraction', '1', &
+         & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+    CALL histdef(hist_id_stom_IPCC, 'Areas', 'Mesh areas', 'm2', &
+         & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+
+  END SUBROUTINE ioipslctrl_histstomipcc
+
+!! ================================================================================================================================
+!! SUBROUTINE    : ioipslctrl_restini
+!!
+!>\BRIEF	 This subroutine initialize the restart files in ORCHDIEE. 
+!! 
+!! DESCRIPTION   : This subroutine initialize restart files in ORCHIDEE. IOIPSL is used for manipulating the restart files. 
+!!                 This subroutine was previously called intsurf_restart and located in module intersurf.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE ioipslctrl_restini(istp, date0, dt, rest_id, rest_id_stom, itau_offset, date0_shifted)
+
+    USE mod_orchidee_para
+    !
+    !  This subroutine initialized the restart file for the land-surface scheme
+    !
+    IMPLICIT NONE
+    !
+    INTEGER(i_std), INTENT(in)                  :: istp      !! Time step of the restart file
+    REAL(r_std)                                 :: date0     !! The date at which itau = 0
+    REAL(r_std)                                 :: dt        !! Time step
+    INTEGER(i_std), INTENT(out)                 :: rest_id, rest_id_stom   !! ID of the restart file
+    INTEGER(i_std), INTENT(out)                 :: itau_offset
+    REAL(r_std), INTENT(out)                    :: date0_shifted
+
+
+    !  LOCAL
+    !
+    REAL(r_std)                 :: dt_rest, date0_rest
+    INTEGER(i_std)              :: itau_dep
+    INTEGER(i_std),PARAMETER    :: llm=1
+    REAL(r_std), DIMENSION(llm) :: lev
+    LOGICAL, PARAMETER          :: overwrite_time=.TRUE. !! Always override the date from the restart files for SECHIBA and STOMATE. 
+                                                         !! The date is taken from the gcm or from the driver restart file. 
+    REAL(r_std)                 :: in_julian, rest_julian
+    INTEGER(i_std)              :: yy, mm, dd
+    REAL(r_std)                 :: ss
+    !
+    !Config Key   = SECHIBA_restart_in
+    !Config Desc  = Name of restart to READ for initial conditions
+    !Config If    = OK_SECHIBA 
+    !Config Def   = NONE
+    !Config Help  = This is the name of the file which will be opened
+    !Config         to extract the initial values of all prognostic
+    !Config         values of the model. This has to be a netCDF file.
+    !Config         Not truly COADS compliant. NONE will mean that
+    !Config         no restart file is to be expected.
+    !Config Units = [FILE]
+!-
+    CALL getin_p('SECHIBA_restart_in',restname_in)
+    WRITE(numout,*) 'INPUT RESTART_FILE', restname_in
+    !-
+    !Config Key   = SECHIBA_rest_out
+    !Config Desc  = Name of restart files to be created by SECHIBA
+    !Config If    = OK_SECHIBA
+    !Config Def   = sechiba_rest_out.nc
+    !Config Help  = This variable give the name for
+    !Config         the restart files. The restart software within
+    !Config         IOIPSL will add .nc if needed.
+    !Config Units = [FILE]
+    !
+    CALL getin_p('SECHIBA_rest_out', restname_out)
+ 
+    lev(:) = zero
+    itau_dep = istp
+    in_julian = itau2date(istp, date0, dt)
+    date0_rest = date0
+    dt_rest = dt
+    !
+    IF (is_root_prc) THEN
+      CALL restini( restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
+         &  restname_out, itau_dep, date0_rest, dt_rest, rest_id, overwrite_time)
+    ELSE
+       rest_id=0
+    ENDIF
+    CALL bcast (itau_dep)
+    CALL bcast (date0_rest)
+    CALL bcast (dt_rest)
+    !
+    !  itau_dep of SECHIBA is phased with the GCM if needed
+    !
+    rest_julian = itau2date(itau_dep, date0_rest, dt_rest)
+    !
+    IF ( ABS( in_julian - rest_julian) .GT. dt/one_day .AND. .NOT. OFF_LINE_MODE ) THEN
+       WRITE(numout,*) 'The SECHIBA restart is not for the same timestep as the GCM,'
+       WRITE(numout,*) 'the two are synchronized. The land-surface conditions can not impose'
+       WRITE(numout,*) 'the chronology of the simulation.'
+       WRITE(numout,*) 'Time step of the GCM :', istp, 'Julian day : ', in_julian
+       CALL ju2ymds(in_julian, yy, mm, dd, ss)
+       WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
+       WRITE(numout,*) 'Time step of SECHIBA :', itau_dep, 'Julian day : ', rest_julian
+       CALL ju2ymds(rest_julian, yy, mm, dd, ss)
+       WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
+       
+       itau_offset = itau_dep - istp
+       date0_shifted = date0 - itau_offset*dt/one_day
+       
+       WRITE(numout,*) 'The new starting date is :', date0_shifted
+       CALL ju2ymds(date0_shifted, yy, mm, dd, ss)
+       WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
+    ELSE
+       itau_offset = 0
+       date0_shifted = date0
+    ENDIF
+    !
+!!!    CALL ioconf_startdate(date0_shifted)
+    !
+    !=====================================================================
+    !- 1.5 Restart file for STOMATE
+    !=====================================================================
+    IF ( ok_stomate ) THEN 
+       !-
+       ! STOMATE IS ACTIVATED
+       !-
+       !Config Key   = STOMATE_RESTART_FILEIN
+       !Config Desc  = Name of restart to READ for initial conditions of STOMATE
+       !Config If    = STOMATE_OK_STOMATE
+       !Config Def   = NONE
+       !Config Help  = This is the name of the file which will be opened
+       !Config         to extract the initial values of all prognostic
+       !Config         values of STOMATE.
+       !Config Units = [FILE]
+       !-
+       CALL getin_p('STOMATE_RESTART_FILEIN',stom_restname_in)
+       WRITE(numout,*) 'STOMATE INPUT RESTART_FILE', stom_restname_in
+       !-
+       !Config Key   = STOMATE_RESTART_FILEOUT
+       !Config Desc  = Name of restart files to be created by STOMATE
+       !Config If    = STOMATE_OK_STOMATE
+       !Config Def   = stomate_rest_out.nc
+       !Config Help  = This is the name of the file which will be opened
+       !Config         to write the final values of all prognostic values
+       !Config         of STOMATE.
+       !Config Units = [FILE]
+       !-
+       CALL getin_p('STOMATE_RESTART_FILEOUT', stom_restname_out)
+       WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE', stom_restname_out
+       !-
+       IF (is_root_prc) THEN
+         CALL restini (stom_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
+            &  stom_restname_out, itau_dep, date0_rest, dt_rest, rest_id_stom, overwrite_time)
+       ELSE
+         rest_id_stom=0
+       ENDIF
+       CALL bcast (itau_dep)
+       CALL bcast (date0_rest)
+       CALL bcast (dt_rest)
+       !-
+    ENDIF
+  END SUBROUTINE ioipslctrl_restini
+
+END MODULE ioipslctrl
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/qsat_moisture.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/qsat_moisture.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/qsat_moisture.f90	(revision 5166)
@@ -0,0 +1,1198 @@
+! =================================================================================================================================
+! MODULE 	: qsat_moisture
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "qsat_moisture" module contains public tools functions like qsat, dev_qsat.   
+!!
+!!\n DESCRIPTION: This module is the result of the splitting of constantes_veg.\n
+!!                As the subroutines qsatcalc, dev_qsatcalc are used only by enerbil and diffuco, they are part of SECHIBA 
+!!                component. 
+!!
+!! REFERENCE(S)	: 
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE qsat_moisture
+
+  USE defprec
+  USE constantes
+  USE IOIPSL
+  USE constantes_soil 
+!-
+  IMPLICIT NONE
+!-
+
+  LOGICAL,SAVE :: l_qsat_first=.TRUE.                !! First call to qsat subroutines and functions (true/false)
+!$OMP THREADPRIVATE(l_qsat_first)
+
+
+  INTEGER(i_std),PARAMETER :: max_temp=370           !! Maximum temperature for saturated humidity (K) and also used as 
+                                                     !! the size of local array to keep saturated humidity (unitless)
+
+  INTEGER(i_std),PARAMETER :: min_temp=100           !! Minimum temperature for saturated humidity (K)
+
+  REAL(r_std),DIMENSION(max_temp),SAVE :: qsfrict    !! Array to keep water vapor pressure at saturation for each temperature level 
+                                                     !! (hPa)
+!$OMP THREADPRIVATE(qsfrict)
+
+  CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: qsatcalc
+!! 
+!>\BRIEF          This routine calculates the saturated humidity using the pressure
+!!                and the temperature for all pixels. 
+!!
+!! DESCRIPTION : This routine interpolates qsat between temperatures by the following formula :
+!!               \latexonly
+!!               \input{qsatcalc.tex}
+!!               \endlatexonly
+!!               \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S) : qsat_out
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+    SUBROUTINE qsatcalc (kjpindex,temp_in,pres_in,qsat_out)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration
+      
+      !! 0.1 Input variables
+      
+      INTEGER(i_std),INTENT(in) :: kjpindex                   !! Domain size (unitless)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: temp_in  !! Temperature in degre Kelvin (K)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: pres_in  !! Pressure (hPa)
+      
+      !! 0.2 Output variables 
+      
+      REAL(r_std),DIMENSION(kjpindex),INTENT(out) :: qsat_out !! Saturated humidity at the surface (kg of water/kg of air)
+      
+      !! 0.4 Local variables
+      
+      INTEGER(i_std), DIMENSION(kjpindex) :: jt               !! Temporary array stocking the truncated temperatures in Kelvin 
+                                                              !!(converted into integers)
+      INTEGER(i_std)                      :: ji               !! indices (unitless)
+      REAL(r_std),DIMENSION(kjpindex)     :: zz_a, zz_b, zz_f !! Temporary variables
+      INTEGER(i_std)                      :: nbad             !! Number of points where the temperature is too high or too low
+      INTEGER(i_std),DIMENSION(1)         :: lo               !! Temporary vector to mark the position of the highest temperature
+                                                              !! or the lowest temperature over all the pixels in jt (unitless)
+!_ ================================================================================================================================
+
+      !-
+      !! 1.Initialize qsfrict array if needed
+      !-
+      IF (l_qsat_first) THEN
+         !-
+         CALL qsfrict_init
+         l_qsat_first = .FALSE.
+         !-
+      ENDIF !(l_qsat_first)
+      
+      !-
+      !! 2. Computes qsat interpolation into two successive temperature
+      !-
+      jt = INT(temp_in(:))
+       
+      !! 2.1 Diagnostic pixels where the temperature is too high 
+      nbad = COUNT(jt(:) >= max_temp-1)
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) ' qsatcalc: temperature too high at ', &
+              &    nbad, ' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(2,'qsatcalc','diffuco', '', &
+                 &                     'temperature incorect.') ! Warning message
+         ELSE
+            lo = MAXLOC(temp_in(:))
+            WRITE(numout,*) &
+                 &     'Maximum temperature ( ',MAXVAL(temp_in),') found at ',lo(1)
+            WHERE (jt(:) >= max_temp-1)   jt(:) = max_temp-1
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF ! (nbad > 0)
+ 
+      
+      !! 2.2 Diagnostic pixels where the temperature is too low
+      nbad = COUNT(jt(:) <= min_temp)
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) ' qsatcalc: temperature too low at ', &
+              &    nbad, ' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(2,'qsatcalc','diffuco', '', &
+                 &                   'temperature incorect.') ! Warning message
+         ELSE
+            lo = MINLOC(temp_in(:))
+            WRITE(numout,*) &
+                 &     'Minimum temperature ( ',MINVAL(temp_in),') found at ',lo(1)
+            WHERE (jt(:) <= min_temp)   jt(:) = min_temp
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF! (nbad > 0)
+ 
+      !! 2.3 Temporary variables needed for interpolation
+      DO ji = 1, kjpindex ! Loop over # pixels
+         
+         zz_f(ji) = temp_in(ji)-FLOAT(jt(ji))
+         zz_a(ji) = qsfrict(jt(ji))
+         zz_b(ji) = qsfrict(jt(ji)+1)
+         
+      ENDDO ! Loop over # pixels
+      
+      !-
+      !! 3. Interpolation between these two values
+      !-
+      DO ji = 1, kjpindex ! Loop over # pixels
+         
+         qsat_out(ji) = ((zz_b(ji)-zz_a(ji))*zz_f(ji)+zz_a(ji))/pres_in(ji)
+         
+      ENDDO  ! Loop over # pixels
+
+
+    END SUBROUTINE qsatcalc
+ 
+!! ================================================================================================================================
+!! FUNCTION 	: [DISPENSABLE] qsat
+!!
+!>\BRIEF         This function computes deviation the saturated humidity with the pressure
+!! and the temperature for a scalar. 
+!!
+!! DESCRIPTION : This routine is obsolete : replaced by the subroutine qsatcalc. \n
+!!               qsat is interpolated by : \n
+!!               \latexonly
+!!               \input{qsat.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): None\n
+!!
+!! RETURN VALUE : qsat_result
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================    
+
+    FUNCTION qsat (temp_in,pres_in) RESULT (qsat_result)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration
+
+      !! 0.1 Input variables
+
+      REAL(r_std),INTENT(in) :: temp_in   !! Temperature (K)
+      REAL(r_std),INTENT(in) :: pres_in   !! Pressure    (hPa)
+
+      !! 0.2 Result
+      
+      REAL(r_std) :: qsat_result          !! Saturated humidity calculated at the surface (kg/kg)
+      
+      !! 0.4 Local variables
+      
+      INTEGER(i_std)   :: jt              !! Temporary scalar stocking the truncated temperature in Kelvin 
+                                          !! (converted into integer)
+      REAL(r_std)      :: zz_a,zz_b,zz_f  !! Temporary scalar variables      
+ 
+!_ ================================================================================================================================
+
+      !-
+      !! 1.Initialize qsfrict array if needed
+      !-
+      IF (l_qsat_first) THEN
+         !-
+         CALL qsfrict_init
+         l_qsat_first = .FALSE.
+         !-
+      ENDIF
+
+      !-
+      !! 2. Computes qsat interpolation into two successive temperatures
+      !-
+      jt = INT(temp_in)
+
+      !! 2.1 Is the temperature too high ?
+      IF (jt >= max_temp-1) THEN
+         WRITE(numout,*) &
+              &   ' We stop. temperature too BIG : ',temp_in, &
+              &   ' approximation for : ',jt
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(2,'qsat','', '',&
+                 &                   'temperature incorect.') ! Warning message
+         ELSE
+            qsat_result = 999999.
+            RETURN
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(jt >= max_temp-1)
+
+      !! 2.2 Is the temperature too low ?
+      IF (jt <= min_temp ) THEN
+         WRITE(numout,*) &
+              &   ' We stop. temperature too SMALL : ',temp_in, &
+              &   ' approximation for : ',jt
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(2,'qsat','', '',&
+                 &                   'temperature incorect.')
+         ELSE
+            qsat_result = -999999.
+            RETURN
+         ENDIF!(.NOT.diag_qsat)
+         !-
+      ENDIF !(jt <= min_temp )
+
+      !! 2.3 Temporary variables needed for interpolation
+      zz_f = temp_in-FLOAT(jt)
+      zz_a = qsfrict(jt)
+      zz_b = qsfrict(jt+1)
+
+      !! 3. Interpolates between these two values
+
+      qsat_result = ((zz_b-zz_a)*zz_f+zz_a)/pres_in
+
+
+    END FUNCTION qsat
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: dev_qsatcalc
+!!
+!>\BRIEF         This routine calculates the deviation of the saturated humidity qsat.
+!!
+!! DESCRIPTION : The deviation of qsat is calculated by :
+!!               \latexonly
+!!               \input{dev_qsatcalc.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S) : dev_qsat_out
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!!
+!! FLOWCHART    :
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_moigdd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================ 
+
+    SUBROUTINE dev_qsatcalc (kjpindex,temp_in,pres_in,dev_qsat_out)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration
+      
+      !! 0.1 Input variables
+
+      INTEGER(i_std),INTENT(in)                   :: kjpindex       !! Domain size (unitless)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: temp_in        !! Temperature (K)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: pres_in        !! Pressure (hPa)
+
+
+      !! 0.2 Output variables 
+      
+      REAL(r_std),DIMENSION(kjpindex),INTENT(out) :: dev_qsat_out   !! Result (??units??) 
+
+      
+      !! 0.4 Local variables
+      
+      INTEGER(i_std),DIMENSION(kjpindex) :: jt                      !! Temporary array stocking the truncated temperatures
+                                                                    !! in Kelvin (converted into integers) 
+      INTEGER(i_std)                     :: ji                      !! Indice (unitless)
+      REAL(r_std),DIMENSION(kjpindex)    :: zz_a, zz_b, zz_c, zz_f  !! Temporary vector variables
+      INTEGER(i_std)                     :: nbad                    !! Number of points where the temperature is too high or too low
+
+!_ ================================================================================================================================
+
+      !-
+      !! 1.Initialize qsfrict array if needed
+      !-
+      IF (l_qsat_first) THEN
+         !-
+         CALL qsfrict_init
+         l_qsat_first = .FALSE.
+         !-
+      ENDIF
+
+      !-
+      !! 2. Compute qsat interpolation into two successive temperature
+      !-
+      jt = INT(temp_in(:)+undemi)
+      
+      !! 2.1 Pixels where the temperature is too high 
+      nbad = COUNT( jt(:) >= max_temp-1 )
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) &
+              &   ' dev_qsatcalc: temperature too high at ',nbad,' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'dev_qsatcalc','', '', &
+                 &                   'temperature incorect.') ! Fatal error
+         ELSE
+            WHERE (jt(:) >= max_temp-1)   jt(:) = max_temp-1
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(nbad > 0)
+      
+      !! 2.2 Pixels where the temperature is too low
+      nbad = COUNT( jt(:) <= min_temp )
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) &
+              &   ' dev_qsatcalc: temperature too low at ',nbad,' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'dev_qsatcalc', '', '',&
+                 &                   'temperature incorect.') ! Fatal error
+         ELSE
+            WHERE (jt(:) <= min_temp)   jt(:) = min_temp
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(nbad > 0)
+
+      !! 2.3 Temporary variables needed for interpolation
+      DO ji=1,kjpindex  ! Loop over # pixels
+         
+         zz_f(ji) = temp_in(ji)+undemi-FLOAT(jt(ji))
+         zz_a(ji) = qsfrict(jt(ji)-1)
+         zz_b(ji) = qsfrict(jt(ji))
+         zz_c(ji) = qsfrict(jt(ji)+1)
+         
+      ENDDO ! Loop over # pixels
+      
+      !-
+      !! 3. Interpolates between these two values
+      !-
+      DO ji = 1, kjpindex ! Loop over # pixels
+         
+         dev_qsat_out(ji) = &
+              &   ((zz_c(ji)-deux*zz_b(ji)+zz_a(ji))*(zz_f(ji)-un) + &
+              &                         zz_c(ji)-zz_b(ji))/pres_in(ji)
+         
+      ENDDO ! Loop over # pixels
+
+
+    END SUBROUTINE dev_qsatcalc
+
+!! ================================================================================================================================
+!! FUNCTION 	: [DISPENSABLE] dev_qsat
+!!
+!>\BRIEF         This function computes deviation of qsat. 
+!!
+!! DESCRIPTION : The deviation of qsat is calculated by :
+!!               \latexonly
+!!               \input{dev_qsat.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : dev_qsat_result
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+    FUNCTION dev_qsat (temp_in,pres_in) RESULT (dev_qsat_result)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration 
+   
+      !! 0.1 Input variables
+
+      REAL(r_std),INTENT(in)  :: pres_in          !! Pressure (hPa)
+      REAL(r_std),INTENT(in)  :: temp_in          !! Temperture (K)
+      
+      !! 0.2 Result
+
+      REAL(r_std) :: dev_qsat_result              !! (??units??) !!
+      
+      !! 0.4 Local variables
+
+      INTEGER(i_std)  :: jt                       !! Index (unitless)
+      REAL(r_std)     :: zz_a, zz_b, zz_c, zz_f   !! Temporary scalars   
+
+!_ ================================================================================================================================
+ 
+      !-
+      !! 1.Initialize qsfrict array if needed
+      !-
+      IF (l_qsat_first) THEN
+         !-
+         CALL qsfrict_init
+         l_qsat_first = .FALSE.
+         !-
+      ENDIF
+
+      !-
+      !! 2. computes qsat deviation interpolation
+      !!    into two successive temperature
+      !-
+      jt = INT(temp_in+undemi)
+
+      !! 2.1 Is the temperature too high ?
+      IF (jt >= max_temp-1) THEN
+         !-
+         WRITE(numout,*) &
+              &   ' We stop. temperature too HIGH : ',temp_in, &
+              &   ' approximation for : ',jt
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'dev_qsat','', '',&
+                 &                   'temperature incorect.') ! Fatal error
+         ELSE
+            dev_qsat_result = 999999.
+            RETURN
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(jt >= max_temp-1)
+      !-
+      !! 2.2 Is the temperature too low ?
+      IF (jt <= min_temp ) THEN
+         WRITE(numout,*) &
+              &   ' We stop. temperature too LOW : ',temp_in, &
+              &   ' approximation for : ',jt
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'dev_qsat','', '',&
+                 &                    'temperature incorect.')
+         ELSE
+            dev_qsat_result = -999999.
+            RETURN
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(jt <= min_temp )
+
+      !! 2.3  Temporary variables for interpolation
+      zz_f = temp_in+undemi-FLOAT(jt)
+      zz_a = qsfrict(jt-1)
+      zz_b = qsfrict(jt)
+      zz_c = qsfrict(jt+1)
+
+      !-
+      !! 3. Interpolate
+      !-
+      dev_qsat_result=((zz_c-deux*zz_b+zz_a)*(zz_f-un)+zz_c-zz_b)/pres_in
+
+    END FUNCTION dev_qsat
+ 
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: qsfrict_init
+!!
+!>\BRIEF         The qsfrict_init routine initialises qsfrict array to store 
+!!               precalculated values for qsat by using Goff-Gratch equations.  
+!!
+!! DESCRIPTION : This routine calculates the specific humidity qsat as a function of temperature in 
+!!               Kelvin by using the modified Goff-Gratch equations(1946): \n
+!!               \latexonly
+!!               \input{goff_gratch.tex}
+!!               \endlatexonly
+!!               qsfrict is initialized by the following formulas : \n
+!!               \latexonly
+!!               \input{qsfrict_init.tex}
+!!               \endlatexonly
+!!               These values are used by the subroutines qsatcalc, dev_qsat. \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::qsfrict
+!!
+!! REFERENCE(S)	:
+!! - Algorithme d'un ensemble de paramÃ©trisation physique (1998), 
+!! Note de Laurent Li dÃ©crivant les paramÃ©trisations physiques incluses dans le modÃšle (pdf),
+!! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques 
+!! - Goff, J. A., and S. Gratch (1946) Low-pressure properties of water from â160 to 212 Â°F, in Transactions of the
+!! American Society of Heating and Ventilating Engineers, pp 95â122, presented at the 52nd annual meeting of the
+!! American Society of Heating and Ventilating Engineers, New York, 1946.
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+    SUBROUTINE qsfrict_init
+      
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration
+      
+      !! 0.4 Local variables
+
+      INTEGER(i_std) :: ji                             !! Indice(unitless)
+      REAL(r_std)    :: zrapp,zcorr,ztemperature,zqsat !! Temporary vector variables      
+
+!_ ================================================================================================================================
+
+      !! 1. Initialisation
+      zrapp = msmlr_h2o/msmlr_air
+      zcorr = 0.00320991_r_std
+      
+      !! 2. Computes saturated humidity one time and store in qsfrict local array
+      DO ji=100,max_temp ! Loop over size(qsfrict) : each position of qsfrict matches a temperature 
+         
+         ztemperature = FLOAT(ji)
+         !-
+         IF (ztemperature < 273._r_std) THEN 
+           zqsat = zrapp*10.0_r_std**(2.07023_r_std-zcorr*ztemperature &
+                 &             -2484.896/ztemperature+3.56654*LOG10(ztemperature)) ! Equilibrium water vapor - solid
+         ELSE 
+            zqsat = zrapp*10.0**(23.8319-2948.964/ztemperature & 
+                 &              -5.028*LOG10(ztemperature) &
+                 &              -29810.16*EXP(-0.0699382*ztemperature) &
+                 &              +25.21935*EXP(-2999.924/ztemperature)) ! Equilibrium water vapor - liquid
+         ENDIF !(ztemperature < 273._r_std)
+         !-
+         qsfrict (ji) = zqsat
+         
+      ENDDO ! Loop over size(qsfrict) 
+
+      !! 3. Set to zero the non-computed values
+      qsfrict(1:100) = zero 
+      !-
+      IF (printlev>=3) WRITE (numout,*) ' qsfrict_init done'
+
+
+    END SUBROUTINE qsfrict_init
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lhold_2d
+!!
+!>\BRIEF         Calculate the maximum liquid water holding capacity of
+!!               snow layer(s)
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: PWHOLDMAX
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+    
+  FUNCTION snow3lhold_2d(PSNOWRHO,PSNOWDZ) RESULT(PWHOLDMAX)
+    
+    !! 0.1 Input variables
+    REAL(r_std), DIMENSION(:,:), INTENT(IN)                   :: PSNOWDZ    !! Snow depth
+    REAL(r_std), DIMENSION(:,:), INTENT(IN)                   :: PSNOWRHO   !! Snow density 
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PWHOLDMAX  !! Maximum Water holding capacity
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZHOLDMAXR, ZSNOWRHO
+
+
+    ! Evaluate capacity using upper density limit:
+    ZSNOWRHO(:,:) = MIN(xrhosmax, PSNOWRHO(:,:))
+
+    ! Maximum ratio of liquid to SWE:
+    ZHOLDMAXR(:,:) = xwsnowholdmax1 + (xwsnowholdmax2-xwsnowholdmax1)*                  &
+         MAX(0.,xsnowrhohold-ZSNOWRHO(:,:))/xsnowrhohold
+
+    ! Maximum liquid water holding capacity of the snow (m):
+    PWHOLDMAX(:,:) = ZHOLDMAXR(:,:)*PSNOWDZ(:,:)*ZSNOWRHO(:,:)/ph2o
+    WHERE(ZSNOWRHO(:,:) .GE. xrhosmax) PWHOLDMAX(:,:) = 0.0
+
+  END FUNCTION snow3lhold_2d
+
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lhold_1d
+!!
+!>\BRIEF         Calculate the maximum liquid water holding capacity of
+!!               snow layer(s)
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  
+  FUNCTION snow3lhold_1d(PSNOWRHO,PSNOWDZ) RESULT(PWHOLDMAX)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:), INTENT(IN)                     :: PSNOWDZ        !! Snow depth
+    REAL, DIMENSION(:), INTENT(IN)                     :: PSNOWRHO       !! Snow density
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                    :: PWHOLDMAX      !! Maximum Water holding capacity
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                    :: ZHOLDMAXR, ZSNOWRHO
+
+
+    ! Evaluate capacity using upper density limit:
+    ZSNOWRHO(:) = MIN(xrhosmax, PSNOWRHO(:))
+
+    ! Maximum ratio of liquid to SWE:
+    ZHOLDMAXR(:) = xwsnowholdmax1 + (xwsnowholdmax2-xwsnowholdmax1)*                  &
+         MAX(0.,xsnowrhohold-ZSNOWRHO(:))/xsnowrhohold
+
+    ! Maximum liquid water holding capacity of the snow (m):
+    PWHOLDMAX(:) = ZHOLDMAXR(:)*PSNOWDZ(:)*ZSNOWRHO(:)/ph2o
+
+    WHERE(ZSNOWRHO(:) .GE. xrhosmax) PWHOLDMAX(:)=0.0
+
+  END FUNCTION snow3lhold_1d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lhold_0d
+!!
+!>\BRIEF         Calculate the maximum liquid water holding capacity of
+!!               snow layer(s)
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  
+  FUNCTION snow3lhold_0d(PSNOWRHO,PSNOWDZ) RESULT(PWHOLDMAX)
+
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(IN)                     :: PSNOWRHO   !!
+    !!  Snow density
+    REAL(r_std), INTENT(IN)                     :: PSNOWDZ    !!
+    !!  Snow depth
+
+    !! 0.2 Output variables
+    REAL(r_std)                                 :: PWHOLDMAX  !!
+    !!  Maximum water holding capacity
+
+    !! 0.3 Modified variables 
+
+    !! 0.4 Local variables
+    REAL(r_std)                    :: ZHOLDMAXR, ZSNOWRHO
+
+
+    ! Evaluate capacity using upper density limit:
+    ZSNOWRHO = MIN(xrhosmax, PSNOWRHO)
+
+    ! Maximum ratio of liquid to SWE:
+    ZHOLDMAXR = xwsnowholdmax1 + (xwsnowholdmax2-xwsnowholdmax1)*&
+         & MAX(0.,xsnowrhohold-ZSNOWRHO)/xsnowrhohold
+
+    ! Maximum liquid water holding capacity of the snow (m):
+    PWHOLDMAX = ZHOLDMAXR*PSNOWDZ*ZSNOWRHO/ph2o
+
+    IF (ZSNOWRHO .GE. xrhosmax) PWHOLDMAX = 0.0
+
+  END FUNCTION snow3lhold_0d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lheat_2d
+!!
+!>\BRIEF         Compute snow heat content (J m-2) from snow mass and liquid
+!!               water content and temperature.
+!!               snow layer(s)
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  
+  FUNCTION snow3lheat_2d(PSNOWLIQ,PSNOWRHO,PSNOWDZ,PSNOWTEMP) RESULT(PSNOWHEAT)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWRHO  !! layer density           (kg m-3)
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWDZ   !! layer thickness         (m)
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWLIQ  !! liquid water content    (m)
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWTEMP !! layer temperature       (K)
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PSNOWHEAT !! heat content (enthalpy) (J m-2)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSCAP     !! snow heat capacity (J K-1 m-3)
+
+    ZSCAP(:,:)     = snow3lscap_2d(PSNOWRHO)
+
+    ! snow heat content (heat required to melt the snowpack) or enthalpy (J m-2)
+    PSNOWHEAT(:,:) = PSNOWDZ(:,:)*( ZSCAP(:,:)*(PSNOWTEMP(:,:)-tp_00)        &
+         - chalfu0*PSNOWRHO(:,:) ) + chalfu0*ph2o*PSNOWLIQ(:,:)
+
+  END FUNCTION snow3lheat_2d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lheat_1d
+!!
+!>\BRIEF         Compute snow heat content (J m-2) from snow mass and liquid
+!!               water content and temperature.
+!!               snow layer(s)
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  
+  FUNCTION snow3lheat_1d(PSNOWLIQ,PSNOWRHO,PSNOWDZ,PSNOWTEMP) RESULT(PSNOWHEAT)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWRHO  !! layer density           (kg m-3)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWDZ   !! layer thickness         (m)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWLIQ  !! liquid water content    (m)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWTEMP !! layer temperature       (K)
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: PSNOWHEAT !! heat content (enthalpy) (J m-2)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: ZSCAP     !! snow heat capacity (J K-1 m-3)
+
+
+    ZSCAP(:)     = snow3lscap_1d(PSNOWRHO)
+
+    ! snow heat content (heat required to melt the snowpack) or enthalpy (J m-2)
+    PSNOWHEAT(:) = PSNOWDZ(:)*( ZSCAP(:)*(PSNOWTEMP(:)-tp_00)                 &
+         -chalfu0*PSNOWRHO(:) ) + chalfu0*ph2o*PSNOWLIQ(:)
+
+  END FUNCTION snow3lheat_1d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lscap_2d
+!!
+!>\BRIEF         Calculate the heat capacity of a snow layer.
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : The method of Verseghy (1991), Int. J. Climat., 11, 111-133.
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lscap_2d(PSNOWRHO) RESULT(PSCAP)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWRHO    !! Snow density
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PSCAP       !! Heat capacity (J K-1 m-3)
+
+    PSCAP(:,:) = PSNOWRHO(:,:)*xci    
+
+  END FUNCTION snow3lscap_2d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lscap_1d
+!!
+!>\BRIEF         Calculate the heat capacity of a snow layer.
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : The method of Verseghy (1991), Int. J. Climat., 11, 111-133.
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lscap_1d(PSNOWRHO) RESULT(PSCAP)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWRHO    !! Snow density
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: PSCAP       !! Heat capacity (J K-1 m-3)
+
+    PSCAP(:) = PSNOWRHO(:)*xci     
+
+  END FUNCTION snow3lscap_1d
+
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3ltemp_2d
+!!
+!>\BRIEF         Diagnose snow temperature (K) from heat content (J m-2)
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3ltemp_2d(PSNOWHEAT,PSNOWRHO,PSNOWDZ) RESULT(PSNOWTEMP)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWRHO  !! layer density     (kg m-3)
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWDZ   !! layer thickness   (m)
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWHEAT !! heat content      (J m-2)
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PSNOWTEMP !! layer temperature (K)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSCAP     !! snow heat capacity (J K-1 m-3)
+
+    ZSCAP(:,:)     = snow3lscap_2d(PSNOWRHO)
+
+    PSNOWTEMP(:,:) = tp_00 + ( ((PSNOWHEAT(:,:)/PSNOWDZ(:,:))                   &
+         + chalfu0*PSNOWRHO(:,:))/ZSCAP(:,:) )
+
+    PSNOWTEMP(:,:) = MIN(tp_00, PSNOWTEMP(:,:))
+
+  END FUNCTION snow3ltemp_2d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3ltemp_1d
+!!
+!>\BRIEF         Diagnose snow temperature (K) from heat content (J m-2)
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3ltemp_1d(PSNOWHEAT,PSNOWRHO,PSNOWDZ) RESULT(PSNOWTEMP)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWRHO  !! layer density     (kg m-3)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWDZ   !! layer thickness   (m)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWHEAT !! heat content      (J m-2)
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: PSNOWTEMP !! layer temperature (K)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: ZSCAP     !! snow heat capacity (J K-1 m-3)
+
+    ZSCAP(:)     = snow3lscap_1d(PSNOWRHO)
+
+    PSNOWTEMP(:) = tp_00 + ( ((PSNOWHEAT(:)/PSNOWDZ(:))                   &
+         + chalfu0*PSNOWRHO(:))/ZSCAP(:) )
+
+    PSNOWTEMP(:) = MIN(tp_00, PSNOWTEMP(:))
+    WHERE(PSNOWTEMP(:) .LE. 100) PSNOWTEMP(:) = tp_00
+
+  END FUNCTION snow3ltemp_1d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lgrain_2d
+!!
+!>\BRIEF         Calculate the grain size (m) for initialization
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : Loth and Graf 1993 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lgrain_2d(PSNOWRHO) RESULT(PDSGRAIN)
+
+    !! 0.1 Input variables
+    REAL(r_std), DIMENSION(:,:), INTENT(IN)                   :: PSNOWRHO                   !! Snow density
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PDSGRAIN                   !! Snow grain size
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), PARAMETER                                    :: ZSNOWRAD_AGRAIN = 1.6e-4   !! (m)
+    REAL(r_std), PARAMETER                                    :: ZSNOWRAD_BGRAIN = 1.1e-13  !! (m13/kg4)
+    REAL(r_std), PARAMETER                                    :: ZDSGRAIN_MAX    = 2.796e-3 !! (m)
+
+    ! grain size in m:
+
+    PDSGRAIN(:,:) = ZSNOWRAD_AGRAIN + ZSNOWRAD_BGRAIN*(PSNOWRHO(:,:)**4)
+    PDSGRAIN(:,:) = MIN(ZDSGRAIN_MAX, PDSGRAIN(:,:))
+
+  END FUNCTION snow3lgrain_2d
+
+!!
+!================================================================================================================================
+!! FUNCTION   : snow3lgrain_1d
+!!
+!>\BRIEF         Calculate the grain size (m) for initialization
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : Loth and Graf 1993 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lgrain_1d(PSNOWRHO) RESULT(PDSGRAIN)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:), INTENT(IN)  :: PSNOWRHO                        !! Snow density
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO)) :: PDSGRAIN                        !! Snow grain size
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, PARAMETER                       :: ZSNOWRAD_AGRAIN = 1.6e-4  !! (m)
+    REAL, PARAMETER                       :: ZSNOWRAD_BGRAIN = 1.1e-13 !! (m13/kg4)
+    REAL, PARAMETER                       :: ZDSGRAIN_MAX    = 2.796e-3!! (m)
+
+    ! grain size in m:
+
+    PDSGRAIN(:) = ZSNOWRAD_AGRAIN + ZSNOWRAD_BGRAIN*(PSNOWRHO(:)**4)
+    PDSGRAIN(:) = MIN(ZDSGRAIN_MAX, PDSGRAIN(:))
+
+  END FUNCTION snow3lgrain_1d
+
+!================================================================================================================================
+!! FUNCTION   : snow3lgrain_0d
+!!
+!>\BRIEF         Calculate the grain size (m) for initialization
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : Loth and Graf 1993 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lgrain_0d(PSNOWRHO) RESULT(PDSGRAIN)
+
+    !! 0.1 Input variables
+    REAL(r_std), INTENT(IN)               :: PSNOWRHO                  !! Snow density
+
+    !! 0.2 Output variables
+    REAL(r_std)                           :: PDSGRAIN                  !! Snow grain size
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, PARAMETER                       :: ZSNOWRAD_AGRAIN = 1.6e-4  !! (m)
+    REAL, PARAMETER                       :: ZSNOWRAD_BGRAIN = 1.1e-13 !! (m13/kg4)
+    REAL, PARAMETER                       :: ZDSGRAIN_MAX    = 2.796e-3!! (m)
+
+    ! grain size in m:
+
+    PDSGRAIN = ZSNOWRAD_AGRAIN + ZSNOWRAD_BGRAIN*(PSNOWRHO**4)
+    PDSGRAIN = MIN(ZDSGRAIN_MAX, PDSGRAIN)
+
+  END FUNCTION snow3lgrain_0d
+
+!================================================================================================================================
+!! FUNCTION   : snow3lliq_2d
+!!
+!>\BRIEF         Diagnose snow liquid water content from temperature (K) and
+!!               heat content  (J m-2)
+!!
+!! DESCRIPTION : Diagnose snow liquid water content from temperature (K)
+!!               and heat content (J m-2). Note, need to evaluate SNOWTEMP from
+!!               SNOW3LTEMP before calling this function (i.e. using same
+!!               heat content, mass and diagnosed temperature). 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lliq_2d(PSNOWHEAT,PSNOWRHO,PSNOWDZ,PSNOWTEMP)&
+       & RESULT(PSNOWLIQ)
+
+    !! 0.1 Input variables
+    REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWRHO &
+         & !! layer density        (kg m-3)
+         REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWDZ  &
+         & !! layer thickness      (m)
+         REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWHEAT&
+         & !! heat content         (J m-2)
+         REAL, DIMENSION(:,:), INTENT(IN)                   :: PSNOWTEMP&
+         & !! layer temperature    (K)
+         
+                                !! 0.2 Output variables
+         REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: PSNOWLIQ &
+         & ! liquid water content (m)
+         
+                                !! 0.3 Modified variables
+         
+                                !! 0.4 Local variables
+         REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: ZSCAP    &
+         & !! snow heat capacity (J K-1 m-3)
+         
+         ZSCAP(:,:)     = snow3lscap_2d(PSNOWRHO)
+
+    ! The result of the full heat balance equation: if the sum
+    !  equals zero,
+    ! then no liquid. If an imbalance occurs, this represents
+    !  liquid water content.
+
+    PSNOWLIQ(:,:)  = ( ((tp_00-PSNOWTEMP(:,:))*ZSCAP(:,:) + chalfu0&
+         &*PSNOWRHO(:,:))*PSNOWDZ(:,:) + PSNOWHEAT(:,:) ) /(chalfu0&
+         &*ph2o)
+
+    ! just a numerical check:
+
+    PSNOWLIQ(:,:)  = MAX(0.0, PSNOWLIQ(:,:))
+
+  END FUNCTION snow3lliq_2d
+
+!================================================================================================================================
+!! FUNCTION   : snow3lliq_1d
+!!
+!>\BRIEF         Diagnose snow liquid water content from temperature (K) and
+!!               heat content  (J m-2)
+!!
+!! DESCRIPTION : Diagnose snow liquid water content from temperature (K)
+!!               and heat content (J m-2). Note, need to evaluate SNOWTEMP from
+!!               SNOW3LTEMP before calling this function (i.e. using same
+!!               heat content, mass and diagnosed temperature). 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+  FUNCTION snow3lliq_1d(PSNOWHEAT,PSNOWRHO,PSNOWDZ,PSNOWTEMP) RESULT(PSNOWLIQ)
+    
+    !! 0.1 Input variables
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWRHO  !! layer density        (kg m-3)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWDZ   !! layer thickness      (m)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWHEAT !! heat content         (J m-2)
+    REAL, DIMENSION(:), INTENT(IN)                   :: PSNOWTEMP !! layer temperature    (K)
+
+    !! 0.2 Output variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: PSNOWLIQ  !! liquid water content (m)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL, DIMENSION(SIZE(PSNOWRHO))                  :: ZSCAP     !! snow heat capacity (J K-1 m-3)
+
+    ZSCAP(:)     = snow3lscap_1d(PSNOWRHO)
+
+    ! The result of the full heat balance equation: if the sum equals zero,
+    ! then no liquid. If an imbalance occurs, this represents liquid water content.
+    !
+    PSNOWLIQ(:)  = ( ((tp_00-PSNOWTEMP(:))*ZSCAP(:) +                      &
+         chalfu0*PSNOWRHO(:))*PSNOWDZ(:) + PSNOWHEAT(:) )    &
+         /(chalfu0*ph2o)
+
+    ! just a numerical check:
+
+    PSNOWLIQ(:)  = MAX(0.0, PSNOWLIQ(:))
+
+  END FUNCTION snow3lliq_1d
+  
+END MODULE qsat_moisture
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/routing.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/routing.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/routing.f90	(revision 5166)
@@ -0,0 +1,9201 @@
+!w =================================================================================================================================
+
+! MODULE       : routing
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module routes the water over the continents into the oceans and computes the water
+!!             stored in floodplains or taken for irrigation.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) :
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+! 
+!
+! Histoire Salee
+!---------------
+! La douce riviere
+! Sortant de son lit
+! S'est jetee ma chere
+! dans les bras mais oui
+! du beau fleuve
+!
+! L'eau coule sous les ponts
+! Et puis les flots s'emeuvent
+! - N'etes vous pas au courant ?
+! Il parait que la riviere 
+! Va devenir mer
+!                       Roland Bacri
+!
+
+
+MODULE routing
+
+  USE ioipsl   
+  USE xios_orchidee
+  USE ioipsl_para 
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE sechiba_io
+  USE interpol_help
+  USE grid
+  USE mod_orchidee_para
+
+
+  IMPLICIT NONE
+  PRIVATE
+  PUBLIC :: routing_main, routing_initialize, routing_finalize, routing_clear
+
+  LOGICAL, SAVE                                              :: l_first_routing=.TRUE.      !! Logical to initialize the routine.
+!$OMP THREADPRIVATE(l_first_routing)
+!! PARAMETERS
+  INTEGER(i_std), PARAMETER                                  :: nbasmax=5                   !! The maximum number of basins we wish to have per grid box (truncation of the model) (unitless)
+  INTEGER(i_std), SAVE                                       :: nbvmax                      !! The maximum number of basins we can handle at any time during the generation of the maps (unitless)
+!$OMP THREADPRIVATE(nbvmax)
+  REAL(r_std), PARAMETER                                     :: slow_tcst_cwrr = 25.0        !! Property of the slow reservoir, when CWRR hydrology is activated (day/m)
+  REAL(r_std), PARAMETER                                     :: fast_tcst_cwrr = 3.0        !! Property of the fast reservoir, when CWRR hydrology is activated (day/m)
+  REAL(r_std), PARAMETER                                     :: stream_tcst_cwrr = 0.24     !! Property of the stream reservoir, when CWRR hydrology is activated (day/m)
+  REAL(r_std), PARAMETER                                     :: flood_tcst_cwrr = 4.0       !! Property of the floodplains reservoir, when CWRR hydrology is activated (day/m)
+  REAL(r_std), PARAMETER                                     :: swamp_cst_cwrr = 0.2        !! Fraction of the river transport that flows to the swamps, when CWRR hydrology is activated (unitless;0-1)
+  !
+  REAL(r_std), PARAMETER                                     :: slow_tcst_chois = 25.0      !! Property of the slow reservoir, when Choisnel hydrology is activated (day/m)
+  REAL(r_std), PARAMETER                                     :: fast_tcst_chois = 3.0       !! Property of the fast reservoir, when Choisnel hydrology is activated (day/m)
+  REAL(r_std), PARAMETER                                     :: stream_tcst_chois = 0.24    !! Property of the stream reservoir, when Choisnel hydrology is activated (day/m)
+  REAL(r_std), PARAMETER                                     :: flood_tcst_chois = 4.0      !! Property of the floodplains reservoir, when Choisnel hydrology is activated (day/m)
+  REAL(r_std), PARAMETER                                     :: swamp_cst_chois = 0.2       !! Fraction of the river transport that flows to the swamps, when Choisnel hydrology is activated (unitless;0-1)
+  !
+  REAL(r_std), SAVE                                          :: fast_tcst                   !! Property of the fast reservoir, (day/m)
+!$OMP THREADPRIVATE(fast_tcst)
+  REAL(r_std), SAVE                                          :: slow_tcst                   !! Property of the slow reservoir, (day/m)
+!$OMP THREADPRIVATE(slow_tcst)
+  REAL(r_std), SAVE                                          :: stream_tcst                 !! Property of the stream reservoir, (day/m)
+!$OMP THREADPRIVATE(stream_tcst)
+  REAL(r_std), SAVE                                          :: flood_tcst                  !! Property of the floodplains reservoir, (day/m)
+!$OMP THREADPRIVATE(flood_tcst)
+  REAL(r_std), SAVE                                          :: swamp_cst                   !! Fraction of the river transport that flows to the swamps (unitless;0-1)
+!$OMP THREADPRIVATE(swamp_cst)
+  !
+  !  Relation between volume and fraction of floodplains
+  
+  REAL(r_std), PARAMETER                                     :: beta = 2.0                  !! Parameter to fix the shape of the 
+                                                                                            !! floodplain (>1 for convex edges, 
+                                                                                            !! <1 for concave edges) (unitless)
+  REAL(r_std), PARAMETER                                     :: betap = 0.5                 !! Ratio of the basin surface 
+                                                                                            !! intercepted by ponds and the maximum 
+                                                                                            !! surface of ponds (unitless;0-1)
+  REAL(r_std), PARAMETER                                     :: floodcri = 2000.0           !! Potential height for which all the 
+                                                                                            !! basin is flooded (mm)
+  
+  !  Relation between maximum surface of ponds and basin surface, and drainage (mm/j) to the slow_res
+  
+  REAL(r_std), PARAMETER                                     :: pond_bas = 50.0             !! [DISPENSABLE] - not used
+  REAL(r_std), PARAMETER                                     :: pondcri = 2000.0            !! Potential height for which all the 
+                                                                                            !! basin is a pond (mm)
+  REAL(r_std), PARAMETER                                     :: maxevap_lake = 7.5/86400.   !! Maximum evaporation rate from lakes
+                                                                                            !! @tex $(kg m^{-2} s^{-1})$ @endtex
+  REAL(r_std), PARAMETER                                     :: min_reservoir = 1.E-6_r_std !! A minimum amount of water in the 
+                                                                                            !! reservoir is set so that we do not 
+                                                                                            !! loose when correcting for rounding 
+                                                                                            !! errors (kg)
+  
+  REAL(r_std), PARAMETER                                     :: crop_coef = 1.0             !! Empirical crop coefficient dependent 
+                                                                                            !! on vegetation characteristics
+                                                                                            !! according to Kassel irrigation 
+                                                                                            !! parametrization.
+                                                                                            !! When potential transpiration is used 
+                                                                                            !! this coefficient has another 
+                                                                                            !! interpretation (unitless)
+  
+  INTEGER(i_std), SAVE                                       :: diagunit = 87               !! Diagnostic file unit (unitless)
+!$OMP THREADPRIVATE(diagunit)
+  !
+  REAL(r_std),SAVE                                           :: dt_routing                  !! Routing time step (s)
+!$OMP THREADPRIVATE(dt_routing)
+  !
+  !
+  ! Logicals to control model configuration
+  !
+  LOGICAL, SAVE                                              :: dofloodinfilt = .FALSE.     !! Logical to choose if floodplains infiltration is activated or not (true/false)
+!$OMP THREADPRIVATE(dofloodinfilt)
+  LOGICAL, SAVE                                              :: doswamps = .FALSE.          !! Logical to choose if swamps are activated or not (true/false)
+!$OMP THREADPRIVATE(doswamps)
+  LOGICAL, SAVE                                              :: doponds = .FALSE.           !! Logical to choose if ponds are activated or not (true/false)
+!$OMP THREADPRIVATE(doponds)
+  ! Decomposition rates for dissolved organic carbon
+  REAL(r_std), SAVE                                          :: T_water = 25                !! Water temperature (Â°C)
+                                                                                            !! Maybe better in Kelvin?
+                                                                                            !! Maybe we need different water
+                                                                                            !! for different reservoirs 
+  REAL(r_std), SAVE                                          :: fast_dec = 0.05             !! Preliminary test rate (unitless)
+  REAL(r_std), SAVE                                          :: slow_dec = 0.05             !! Preliminary test rate (unitless)  
+  REAL(r_std), SAVE                                          :: stream_dec = 0.05           !! Preliminary test rate (unitless)
+  REAL(r_std), SAVE                                          :: flood_dec = 0.05            !! Preliminary test rate (unitless)
+  REAL(r_std), SAVE                                          :: pond_dec = 0.05             !! Preliminary test rate (unitless)
+  REAL(r_std), SAVE                                          :: CO2_conc1 = 12.0E-6         !! Test concentrations for C (unitless)
+  REAL(r_std), SAVE                                          :: CO2_conc2 = 12.0E-7         !! Test concentrations for C (unitless)
+  REAL(r_std), SAVE                                          :: CO2_conc3 = 15.0E-8         !! Test concentrations for C (unitless) 
+  REAL(r_std), SAVE                                          :: doc_conc1 = 1.0E-6          !! Test concentrations for C (unitless)
+  REAL(r_std), SAVE                                          :: doc_conc2 = 1.0E-5          !! Test concentrations for C (unitless)  
+  REAL(r_std), SAVE                                          :: doc_conc3 = 2.0E-6          !! Test concentrations for C (unitless)
+  REAL(r_std), SAVE                                          :: k_headw = 3.0               !! Gas_exchange velocity in head waters
+                                                                                            !! @tex $(m day^{-1})$ @endtex
+  REAL(r_std), SAVE                                          :: k_stream = 3.0              !! Gas_exchange velocity in streams
+                                                                                            !! @tex $(m day^{-1})$ @endtex
+                                                                                            !! k_headw and k_stream later from 
+                                                                                            !! forcing file (also in floodplains)
+  REAL(r_std), SAVE                                          :: k_flood = 3.0               !! Gas_exchange velocity in head waters
+                                                                                            !! @tex $(m day^{-1})$ @endtex
+  REAL(r_std), SAVE                                          :: k_pond = 3.0                !! Gas_exchange velocity in head waters
+                                                                                            !! @tex $(m day^{-1})$ @endtex
+  REAL(r_std), SAVE                                          :: pCO2_atm = 350.0            !! Atmospheric pCO2 (atm)
+  INTEGER(i_std), SAVE                                       :: nstep_FCO2 = 240            !! Segmentation steps per day used
+                                                                                            !! used in calculation of CO2 evasion
+                                                                                            !! from water surfaces
+
+  ! Logicals to control model configuration  
+  LOGICAL, SAVE                                              :: doirrigation = .FALSE.      !! Logical to choose if irrigation is
+                                                                                            !! activated or not (true/false)
+!$OMP THREADPRIVATE(doirrigation)
+  LOGICAL, SAVE                                              :: dofloodplains = .FALSE.     !! Logical to choose if floodplains are
+                                                                                            !! activated or not (true/false)
+!$OMP THREADPRIVATE(dofloodplains)
+  LOGICAL, SAVE                                              :: ok_doc = .TRUE.             !! Logical to choose if C is activated
+                                                                                            !! or not (true/false)
+!$OMP THREADPRIVATE(ok_doc)
+  !
+  ! The variables describing the basins and their routing, need to be in the restart file.
+  !
+  INTEGER(i_std), SAVE                                       :: num_largest                 !! Number of largest river basins which should be treated as independently as rivers
+                                                                                            !! (not flow into ocean as diffusion coastal flow) (unitless)
+!$OMP THREADPRIVATE(num_largest)
+  REAL(r_std), SAVE                                          :: time_counter                !! Time counter (s)
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: routing_area_loc            !! Surface of basin 
+                                                                                            !! @tex $(m^2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: topo_resid_loc              !! Topographic index of the retention 
+                                                                                            !! time (m)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_togrid_loc            !! Grid into which the basin flows 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_tobasin_loc           !! Basin in to which the water goes 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_nbintobas_loc         !! Number of basin into current one 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: global_basinid_loc          !! ID of basin (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:,:):: hydrodiag_loc               !! Variable to diagnose the hydrographs
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:)       :: hydroupbasin_loc            !! The area upstream of the gauging 
+                                                                                            !! station @tex $(m^2})$ @endtex
+  
+  ! parallelism
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: routing_area_glo            !! Surface of basin 
+                                                                                            !! @tex $(m^2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: topo_resid_glo              !! Topographic index of the retention
+                                                                                            !! time (m)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_togrid_glo            !! Grid into which the basin flows 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_tobasin_glo           !! Basin in to which the water goes 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_nbintobas_glo         !! Number of basin into current one 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: global_basinid_glo          !! ID of basin (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:,:):: hydrodiag_glo               !! Variable to diagnose the hydrographs
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:)       :: hydroupbasin_glo            !! The area upstream of the gauging 
+                                                                                            !! station @tex $(m^2})$ @endtex
+  
+  REAL(r_std), SAVE, POINTER, DIMENSION(:,:)                 :: routing_area                !! Surface of basin 
+                                                                                            !! @tex $(m^2})$ @endtex
+  REAL(r_std), SAVE, POINTER, DIMENSION(:,:)                 :: topo_resid                  !! Topographic index of the retention 
+                                                                                            !! time (m)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: route_togrid                !! Grid into which the basin flows 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: route_tobasin               !! Basin in to which the water goes 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: route_nbintobas             !! Number of basin into current one 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: global_basinid              !! ID of basin (unitless)
+!$OMP THREADPRIVATE(global_basinid)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:,:)            :: hydrodiag                   !! Variable to diagnose the hydrographs
+!$OMP THREADPRIVATE(hydrodiag)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: slowflow_diag               !! Diagnostic slow flow hydrographs (kg/dt)
+!$OMP THREADPRIVATE(slowflow_diag)  
+  REAL(r_std), SAVE, POINTER, DIMENSION(:)                   :: hydroupbasin                !! The area upstream of the gauging station (m^2)
+!$OMP THREADPRIVATE(hydroupbasin)
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: irrigated                   !! Area equipped for irrigation in each grid box (m^2)
+!$OMP THREADPRIVATE(irrigated)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: floodplains                 !! Maximal surface which can be inundated in each grid box (m^2)
+!$OMP THREADPRIVATE(floodplains)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: swamp                       !! Maximal surface of swamps in each grid box (m^2)
+!$OMP THREADPRIVATE(swamp)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: headw_area                  !! Head water surface area in each 
+                                                                                            !! grid box @tex $(m^2})$ @endtex  
+!$OMP THREADPRIVATE(headw_area)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: stream_area                 !! Stream/river surface area in each 
+                                                                                            !! grid box @tex $(m^2})$@endtex   
+!$OMP THREADPRIVATE(stream_area)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: upstream_area               !! Upstream lying, contributing 
+                                                                                            !! area (=catchment area)  
+                                                                                            !! @tex $(m^2})$ @endtex 
+!$OMP THREADPRIVATE(upstream_area)
+  !
+  ! The reservoirs, also to be put into the restart file.
+  
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:)           :: fast_reservoir              !! Water or matter amount in the  
+                                                                                            !! fast reservoir (kg)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:)           :: slow_reservoir              !! Water or matter amount in the 
+                                                                                            !! slow reservoir (kg)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:)           :: stream_reservoir            !! Water or matter amount in the 
+                                                                                            !! stream reservoir (kg)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:)           :: flood_reservoir             !! Water or matter amount in the 
+                                                                                            !! floodplains reservoir (kg)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: lake_reservoir              !! Water or matter amount in the 
+                                                                                            !! lake reservoir (kg)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: pond_reservoir              !! Water or matter amount in the 
+                                                                                            !! pond reservoir (kg)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: flood_frac_bas              !! Flooded fraction per basin 
+                                                                                            !! (unitless;0-1)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: pond_frac                   !! Pond fraction per grid box 
+                                                                                            !! (unitless;0-1)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: flood_height                !! Floodplain height (mm)
+  
+  ! The accumulated fluxes.
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: floodout_mean               !! Accumulated flow out of floodplains
+                                                                                            !! Evaporation-Precipitation 
+                                                                                            !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: runoff_mean                 !! Accumulated runoff 
+                                                                                            !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: drainage_mean               !! Accumulated drainage 
+                                                                                            !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: transpot_mean               !! Mean potential transpiration from 
+                                                                                            !! the plants 
+                                                                                            !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: precip_mean                 !! Accumulated precipitation 
+                                                                                            !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: humrel_mean                 !! Mean soil moisture stress, mean root 
+                                                                                            !! extraction potential (unitless)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: totnobio_mean               !! Mean last total fraction of no bio 
+                                                                                            !! (unitless;0-1)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: vegtot_mean                 !! Mean potentially vegetated fraction 
+                                                                                            !! (unitless;0-1)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: k_litt_mean                 !! Mean averaged conductivity for 
+                                                                                            !! saturated infiltration in the 
+                                                                                            !! 'litter' layer 
+                                                                                            !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  
+  ! The averaged outflow fluxes.
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: lakeinflow_mean              !! Mean lake inflow 
+                                                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: returnflow_mean              !! Mean water and matter flow from 
+                                                                                             !! lakes and swamps which returns to 
+                                                                                             !! the grid box.
+                                                                                             !! This water and dissolved matter 
+                                                                                             !! will go back into the hydrol or 
+                                                                                             !! hydrolc module to allow 
+                                                                                             !! re-evaporation 
+                                                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: reinfiltration_mean          !! Mean water and matter flow which 
+                                                                                             !! returns to the grid box 
+                                                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: irrigation_mean              !! Mean irrigation flux.
+                                                                                             !! This is the water taken from the 
+                                                                                             !! reservoirs and beeing put into the
+                                                                                             !! upper layers of the soil 
+                                                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: riverflow_mean               !! Mean Outflow of the major rivers.
+                                                                                             !! The flux will be located on the 
+                                                                                             !! continental grid but this should be
+                                                                                             !! a coastal point 
+                                                                                             !! @tex $(kg dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: coastalflow_mean             !! Mean outflow on coastal points by 
+                                                                                             !! small basins.
+                                                                                             !! It flows in a disperse way into 
+                                                                                             !! the ocean 
+                                                                                             !! @tex $(kg dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: floodtemp                    !! Temperature to decide if 
+                                                                                             !! floodplains work (K)
+  INTEGER(i_std), SAVE                                       :: floodtemp_lev                !! Temperature level to decide if 
+                                                                                             !! floodplains work (K)
+  
+  ! Diagnostic variables ... well sort of !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: irrig_netereq                !! Irrigation requirement (water 
+                                                                                             !! requirements by the crop for its 
+                                                                                             !! optimal growth 
+                                                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: hydrographs                  !! Hydrographs at the outflow of the 
+                                                                                             !! grid box for major basins 
+                                                                                             !! @tex $(kg dt^{-1})$ @endtex
+                                                                                             !! sofar no dimension for matterfluxes
+                                                                                             !! were added
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: FCO2_aq                      !! CO2 evasion from water surface
+                                                                                             !! @tex $(kg C dt^{-1})$ @endtex  
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: pCO2_aq                      !! CO2 evasion from water surface
+                                                                                             !! @tex $(kg C dt^{-1})$ @endtex   
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: DOC_inp                      !! Input DOC
+  ! Diagnostics for the various reservoirs we use @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: fast_diag                    !! Diagnostic for the fast reservoir 
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: slow_diag                    !! Diagnostic for the slow reservoir 
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: stream_diag                  !! Diagnostic for the stream reservoir
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: flood_diag                   !! Diagnostic for the floodplain 
+                                                                                             !! reservoir 
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: pond_diag                    !! Diagnostic for the pond reservoir 
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: lake_diag                    !! Diagnostic for the lake reservoir 
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: delsurfstor                  !! Diagnostic of the change in surface 
+                                                                                             !! water storage (flood, pond and lake
+                                                                                             !! reservoirs) 
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  
+
+CONTAINS
+  !!  =============================================================================================================================
+  !! SUBROUTINE:         routing_initialize
+  !!
+  !>\BRIEF	         Initialize the routing module
+  !!
+  !! DESCRIPTION:        Initialize the routing module. Read from restart file or read the routing.nc file to initialize the
+  !!                     routing scheme. 
+  !!
+  !! RECENT CHANGE(S)
+  !!
+  !! REFERENCE(S)
+  !! 
+  !! FLOWCHART   
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE routing_initialize( kjit,       nbpt,           index,                 &
+                                rest_id,     hist_id,        hist2_id,   lalo,      &
+                                neighbours,  resolution,     contfrac,   stempdiag, &
+                                returnflow,  reinfiltration, irrigation, riverflow, &
+                                coastalflow, flood_frac,     flood_res )
+       
+    IMPLICIT NONE
+    
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)     :: kjit                 !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)     :: nbpt                 !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)     :: index(nbpt)          !! Indices of the points on the map (unitless)
+    INTEGER(i_std),INTENT(in)      :: rest_id              !! Restart file identifier (unitless)
+    INTEGER(i_std),INTENT(in)      :: hist_id              !! Access to history file (unitless)
+    INTEGER(i_std),INTENT(in)      :: hist2_id             !! Access to history file 2 (unitless)
+    REAL(r_std), INTENT(in)        :: lalo(nbpt,2)         !! Vector of latitude and longitudes (beware of the order !)
+
+    INTEGER(i_std), INTENT(in)     :: neighbours(nbpt,8)   !! Vector of neighbours for each grid point 
+                                                           !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) (unitless)
+    REAL(r_std), INTENT(in)        :: resolution(nbpt,2)   !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)        :: contfrac(nbpt)       !! Fraction of land in each grid box (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: stempdiag(nbpt,nbdl) !! Diagnostic soil temperature profile
+
+    !! 0.2 Output variables
+    REAL(r_std), INTENT(out)       :: returnflow(nbpt)     !! The water flow from lakes and swamps which returns to the grid box.
+                                                           !! This water will go back into the hydrol or hydrolc module to allow re-evaporation (kg/m^2/dt)
+    REAL(r_std), INTENT(out)       :: reinfiltration(nbpt) !! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt)
+    REAL(r_std), INTENT(out)       :: irrigation(nbpt)     !! Irrigation flux. This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt)
+    REAL(r_std), INTENT(out)       :: riverflow(nbpt)      !! Outflow of the major rivers. The flux will be located on the continental grid but this should be a coastal point (kg/dt)
+
+    REAL(r_std), INTENT(out)       :: coastalflow(nbpt)    !! Outflow on coastal points by small basins. This is the water which flows in a disperse way into the ocean (kg/dt)
+    REAL(r_std), INTENT(out)       :: flood_frac(nbpt)     !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), INTENT(out)       :: flood_res(nbpt)      !! Diagnostic of water amount in the floodplains reservoir (kg)
+    
+    !! 0.3 Local variables
+    LOGICAL                        :: init_irrig           !! Logical to initialize the irrigation (true/false)
+    LOGICAL                        :: init_flood           !! Logical to initialize the floodplains (true/false)
+    LOGICAL                        :: init_swamp           !! Logical to initialize the swamps (true/false)
+    LOGICAL                        :: init_streamsurf=.FALSE. !! Logical to initialize the stream surface (true/false)
+!_ ================================================================================================================================
+
+    !
+    ! do initialisation
+    !
+    nbvmax = 440
+    ! Here we will allocate the memory and get the fixed fields from the restart file.
+    ! If the info is not found then we will compute the routing map.
+    !
+    CALL routing_init (kjit, nbpt, index, returnflow, reinfiltration, irrigation, &
+         riverflow, coastalflow, flood_frac, flood_res, stempdiag, rest_id)
+
+    routing_area => routing_area_loc  
+    topo_resid => topo_resid_loc
+    route_togrid => route_togrid_loc
+    route_tobasin => route_tobasin_loc
+    global_basinid => global_basinid_loc
+    hydrodiag => hydrodiag_loc
+    
+    ! This routine computes the routing map if the route_togrid_glo is undefined. This means that the
+    ! map has not been initialized during the restart process..
+    !
+    !! Reads in the map of the basins and flow directions to construct the catchments of each grid box
+    !
+    IF ( COUNT(route_togrid_glo .GE. undef_int) .GT. 0 ) THEN
+       CALL routing_basins_p(nbpt, lalo, neighbours, resolution, contfrac)
+    ENDIF
+    !
+    ! Do we have what we need if we want to do irrigation
+    !! Initialisation of flags for irrigated land, flood plains and swamps
+    !
+    init_irrig = .FALSE.
+    IF ( do_irrigation ) THEN 
+       IF (COUNT(irrigated .GE. undef_sechiba-1) > 0) init_irrig = .TRUE.
+    END IF
+    
+    init_flood = .FALSE.
+    IF ( do_floodplains ) THEN
+       IF (COUNT(floodplains .GE. undef_sechiba-1) > 0) init_flood = .TRUE.
+    END IF
+    
+    init_swamp = .FALSE.
+    IF ( doswamps ) THEN
+       IF (COUNT(swamp .GE. undef_sechiba-1) > 0 ) init_swamp = .TRUE.
+    END IF
+       
+          IF ( ok_doc ) THEN
+             IF (COUNT((headw_area+stream_area) .GE. undef_sechiba-1) > 0) THEN
+                init_streamsurf = .TRUE.
+             ENDIF
+          ENDIF
+
+          !! If we have irrigated land, flood plains or swamps then we need to interpolate the 
+          !! 0.5 degree base data set to the resolution of the model.
+
+          IF ( init_irrig .OR. init_flood .OR. init_swamp .OR. init_streamsurf ) THEN
+             CALL routing_irrigmap (nbpt, index, lalo, neighbours, resolution, contfrac, &
+       &                     init_irrig, irrigated, init_flood, floodplains, init_swamp, &
+       &                     swamp, init_streamsurf, headw_area, stream_area, hist_id, hist2_id)
+          ENDIF
+    
+    IF ( do_irrigation ) THEN 
+       CALL xios_orchidee_send_field("irrigmap",irrigated)
+       
+       WRITE(numout,*) 'Verification : range of irrigated : ', MINVAL(irrigated), MAXVAL(irrigated) 
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist_id, 'irrigmap', 1, irrigated, nbpt, index)
+       ELSE
+          CALL histwrite_p(hist_id, 'IrrigationMap', 1, irrigated, nbpt, index)
+       ENDIF
+       IF ( hist2_id > 0 ) THEN
+          IF ( .NOT. almaoutput ) THEN
+             CALL histwrite_p(hist2_id, 'irrigmap', 1, irrigated, nbpt, index)
+          ELSE
+             CALL histwrite_p(hist2_id, 'IrrigationMap', 1, irrigated, nbpt, index)
+          ENDIF
+       ENDIF
+    ENDIF
+    
+    IF ( do_floodplains ) THEN
+       CALL xios_orchidee_send_field("floodmap",floodplains)
+       
+       WRITE(numout,*) 'Verification : range of floodplains : ', MINVAL(floodplains), MAXVAL(floodplains) 
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist_id, 'floodmap', 1, floodplains, nbpt, index)
+       ELSE
+          CALL histwrite_p(hist_id, 'FloodplainsMap', 1, floodplains, nbpt, index)
+       ENDIF
+       IF ( hist2_id > 0 ) THEN
+          IF ( .NOT. almaoutput ) THEN
+             CALL histwrite_p(hist2_id, 'floodmap', 1, floodplains, nbpt, index)
+          ELSE
+             CALL histwrite_p(hist2_id, 'FloodplainsMap', 1, floodplains, nbpt, index)
+          ENDIF
+       ENDIF
+    ENDIF
+    
+    IF ( doswamps ) THEN
+       CALL xios_orchidee_send_field("swampmap",swamp)
+       
+       WRITE(numout,*) 'Verification : range of swamp : ', MINVAL(swamp), MAXVAL(swamp) 
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist_id, 'swampmap', 1, swamp, nbpt, index)
+       ELSE
+          CALL histwrite_p(hist_id, 'SwampMap', 1, swamp, nbpt, index)
+       ENDIF
+       IF ( hist2_id > 0 ) THEN
+          IF ( .NOT. almaoutput ) THEN
+             CALL histwrite_p(hist2_id, 'swampmap', 1, swamp, nbpt, index)
+          ELSE
+             CALL histwrite_p(hist2_id, 'SwampMap', 1, swamp, nbpt, index)
+          ENDIF
+          IF ( doirrigation ) THEN 
+             WRITE(numout,*) 'Verification : range of irrigated : ', MINVAL(irrigated), MAXVAL(irrigated) 
+             IF ( .NOT. almaoutput ) THEN
+                CALL histwrite_p(hist_id, 'irrigmap', 1, irrigated, nbpt, index)
+             ELSE
+                CALL histwrite_p(hist_id, 'IrrigationMap', 1, irrigated, nbpt, index)
+             ENDIF
+             IF ( hist2_id > 0 ) THEN
+                IF ( .NOT. almaoutput ) THEN
+                   CALL histwrite_p(hist2_id, 'irrigmap', 1, irrigated, nbpt, index)
+                ELSE
+                   CALL histwrite_p(hist2_id, 'IrrigationMap', 1, irrigated, nbpt, index)
+                ENDIF
+             ENDIF
+          ENDIF
+          !
+          IF ( dofloodplains ) THEN
+             WRITE(numout,*) 'Verification : range of floodplains : ', MINVAL(floodplains), MAXVAL(floodplains) 
+             IF ( .NOT. almaoutput ) THEN
+                CALL histwrite_p(hist_id, 'floodmap', 1, floodplains, nbpt, index)
+             ELSE
+                CALL histwrite_p(hist_id, 'FloodplainsMap', 1, floodplains, nbpt, index)
+             ENDIF
+             IF ( hist2_id > 0 ) THEN
+                IF ( .NOT. almaoutput ) THEN
+                   CALL histwrite_p(hist2_id, 'floodmap', 1, floodplains, nbpt, index)
+                ELSE
+                   CALL histwrite_p(hist2_id, 'FloodplainsMap', 1, floodplains, nbpt, index)
+                ENDIF
+             ENDIF
+          ENDIF
+          !
+          IF ( doswamps ) THEN
+             WRITE(numout,*) 'Verification : range of swamp : ', MINVAL(swamp), MAXVAL(swamp) 
+             IF ( .NOT. almaoutput ) THEN
+                CALL histwrite_p(hist_id, 'swampmap', 1, swamp, nbpt, index)
+             ELSE
+                CALL histwrite_p(hist_id, 'SwampMap', 1, swamp, nbpt, index)
+             ENDIF
+             IF ( hist2_id > 0 ) THEN
+                IF ( .NOT. almaoutput ) THEN
+                   CALL histwrite_p(hist2_id, 'swampmap', 1, swamp, nbpt, index)
+                ELSE
+                   CALL histwrite_p(hist2_id, 'SwampMap', 1, swamp, nbpt, index)
+                ENDIF
+             ENDIF
+          ENDIF
+
+       ENDIF
+    ENDIF
+    
+    !! This routine gives a diagnostic of the basins used.
+    CALL routing_diagnostic_p(nbpt, index, lalo, resolution, contfrac, hist_id, hist2_id)
+    
+    l_first_routing = .FALSE.
+    
+  END SUBROUTINE routing_initialize
+
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_main 
+!!
+!>\BRIEF          This module routes the water over the continents (runoff and
+!!                drainage produced by the hydrolc or hydrol module) into the oceans. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags):
+!! The routing scheme (Polcher, 2003) carries the water from the runoff and drainage simulated by SECHIBA
+!! to the ocean through reservoirs, with some delay. The routing scheme is based on
+!! a parametrization of the water flow on a global scale (Miller et al., 1994; Hagemann
+!! and Dumenil, 1998). Given the global map of the main watersheds (Oki et al., 1999;
+!! Fekete et al., 1999; Vorosmarty et al., 2000) which delineates the boundaries of subbasins
+!! and gives the eight possible directions of water flow within the pixel, the surface
+!! runoff and the deep drainage are routed to the ocean. The time-step of the routing is one day.
+!! The scheme also diagnoses how much water is retained in the foodplains and thus return to soil
+!! moisture or is taken out of the rivers for irrigation. \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!! The result of the routing are 3 fluxes :
+!! - riverflow   : The water which flows out from the major rivers. The flux will be located
+!!                 on the continental grid but this should be a coastal point.
+!! - coastalflow : This is the water which flows in a disperse way into the ocean. Essentially these
+!!                 are the outflows from all of the small rivers.
+!! - returnflow  : This is the water which flows into a land-point - typically rivers which end in
+!!                 the desert. This water will go back into the hydrol module to allow re-evaporation.
+!! - irrigation  : This is water taken from the reservoir and is being put into the upper 
+!!                 layers of the soil.
+!! The two first fluxes are in kg/dt and the last two fluxes are in kg/(m^2dt).\n
+!!
+!! REFERENCE(S) :
+!! - Miller JR, Russell GL, Caliri G (1994)
+!!   Continental-scale river flow in climate models.
+!!   J. Clim., 7:914-928
+!! - Hagemann S and Dumenil L. (1998)
+!!   A parametrization of the lateral waterflow for the global scale.
+!!   Clim. Dyn., 14:17-31
+!! - Oki, T., T. Nishimura, and P. Dirmeyer (1999)
+!!   Assessment of annual runoff from land surface models using total runoff integrating pathways (TRIP)
+!!   J. Meteorol. Soc. Jpn., 77, 235-255
+!! - Fekete BM, Charles V, Grabs W (2000)
+!!   Global, composite runoff fields based on observed river discharge and simulated water balances.
+!!   Technical report, UNH/GRDC, Global Runoff Data Centre, Koblenz
+!! - Vorosmarty, C., B. Fekete, B. Meybeck, and R. Lammers (2000)
+!!   Global system of rivers: Its role in organizing continental land mass and defining land-to-ocean linkages
+!!   Global Biogeochem. Cycles, 14, 599-621
+!! - Vivant, A-C. (?? 2002)
+!!   DÃ©veloppement du schÃ©ma de routage et des plaines d'inondation, MSc Thesis, Paris VI University
+!! - J. Polcher (2003)
+!!   Les processus de surface a l'echelle globale et leurs interactions avec l'atmosphere
+!!   Habilitation a diriger les recherches, Paris VI University, 67pp.
+!!
+!! FLOWCHART    :
+!! \latexonly 
+!! \includegraphics[scale=0.75]{routing_main_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_main(kjit, nbpt, index, &
+       & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, &
+       & drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, &
+       & stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, rest_id, &
+       & hist_id, hist2_id, DOC_EXP_agg_d)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)     :: kjit                 !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)     :: nbpt                 !! Domain size (unitless)
+    INTEGER(i_std),INTENT(in)      :: rest_id              !! Restart file identifier (unitless)
+    INTEGER(i_std),INTENT(in)      :: hist_id              !! Access to history file (unitless)
+    INTEGER(i_std),INTENT(in)      :: hist2_id             !! Access to history file 2 (unitless)
+    INTEGER(i_std), INTENT(in)     :: index(nbpt)          !! Indices of the points on the map (unitless)
+    REAL(r_std), INTENT(in)        :: lalo(nbpt,2)         !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)     :: neighbours(nbpt,8)   !! Vector of neighbours for each grid point 
+                                                           !! (unitless; 1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), INTENT(in)        :: resolution(nbpt,2)   !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)        :: contfrac(nbpt)       !! Fraction of land in each grid box (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: totfrac_nobio(nbpt)  !! Total fraction of no-vegetation (continental ice, lakes ...) 
+                                                           !! (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: veget_max(nbpt,nvm)  !! Maximal fraction of vegetation (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: floodout(nbpt)       !! Grid-point flow out of floodplains 
+                                                           !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)        :: runoff(nbpt)         !! Grid-point runoff @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)        :: drainage(nbpt)       !! Grid-point drainage @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)        :: transpot(nbpt,nvm)   !! Potential transpiration of the vegetation 
+                                                           !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)        :: precip_rain(nbpt)    !! Rainfall @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)        :: k_litt(nbpt)         !! Averaged conductivity for saturated infiltration in the 'litter' 
+                                                           !! layer @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)        :: humrel(nbpt,nvm)     !! Soil moisture stress, root extraction potential (unitless)
+    REAL(r_std), INTENT(in)        :: stempdiag(nbpt,nbdl) !! Diagnostic soil temperature profile
+    REAL(r_std), INTENT(in)        :: reinf_slope(nbpt)    !! Coefficient which determines the reinfiltration ratio in the grid box due to flat areas (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: DOC_EXP_agg_d(nbpt,nexp)   !! DOC exports, diffrenet paths (nexp), in  
+                                                                 !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex 
+
+    !! 0.2 Output variables
+    REAL(r_std), INTENT(out)       :: returnflow(nbpt,nflow)     !! The water flow from lakes and swamps which returns to the grid box.
+                                                                 !! This water will go back into the hydrol or hydrolc module to allow re-evaporation (kg/m^2/dt)
+    REAL(r_std), INTENT(out)       :: reinfiltration(nbpt,nflow) !! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt)
+    REAL(r_std), INTENT(out)       :: irrigation(nbpt,nflow)     !! Irrigation flux. This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt)
+    REAL(r_std), INTENT(out)       :: riverflow(nbpt,nflow)      !! Outflow of the major rivers. The flux will be located on the continental grid but this should be a coastal point (kg/dt)
+    REAL(r_std), INTENT(out)       :: coastalflow(nbpt,nflow)    !! Outflow on coastal points by small basins. This is the water which flows in a disperse way into the ocean (kg/dt)
+    REAL(r_std), INTENT(out)       :: flood_frac(nbpt)           !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), INTENT(out)       :: flood_res(nbpt)            !! Diagnostic of water amount in the floodplains reservoir (kg)
+
+    !! 0.3 Local variables
+    CHARACTER(LEN=30)                 :: var_name                !! To store variables names for I/O (unitless)
+    REAL(r_std), DIMENSION(1)         :: tmp_day                 !! 
+    REAL(r_std), DIMENSION(nbpt,nflow):: return_lakes            !! Water from lakes flowing back into soil moisture (kg/m^2/dt)
+    INTEGER(i_std)                    :: ig, jv                  !! Indices (unitless)
+    LOGICAL, SAVE                     :: init_irrig=.FALSE.      !! Logical to initialize the irrigation (true/false)
+    LOGICAL, SAVE                     :: init_flood=.FALSE.      !! Logical to initialize the floodplains (true/false)
+    LOGICAL, SAVE                     :: init_swamp=.FALSE.      !! Logical to initialize the swamps (true/false)
+    LOGICAL, SAVE                     :: init_streamsurf=.FALSE. !! Logical to initialize the stream surface (true/false)
+    REAL(r_std), DIMENSION(nbpt)      :: tot_vegfrac_nowoody  !! Total fraction occupied by grass (0-1,unitless)
+    INTEGER(i_std)                    :: iflow                   !! Index (unitless)
+
+!_ ================================================================================================================================
+
+    !
+    !! Computes the variables averaged between routing time steps and which will be used in subsequent calculations
+    !
+    
+    ! 'precip_rain', 'runoff', 'drainage'  are input parameters only for water. The parameters 
+    ! 'precip_mean', 'runoff_mean', 'drainage_mean', on the other hand, have a third dimension 
+    ! for different matter fluxes. The dimension iflow=2 (DOC) and iflow=3 (CO2) are at this 
+    ! preliminary stage computed with a test concentration  which is taken for both species. 
+    ! Next steps: The concentrations, or better the fluxes of CO2 and DOC in runoff and drainage 
+    ! will come from the soil carbon module. For precipitation, we will have to distinguish direct 
+    ! precipitation on e.g. water surface of flooded areas, which has likely negligible 
+    ! concnetrations of DOC, and throughfall. The CO2 conentrations in the precipitation could 
+    ! be assumed to be in equilibrium with the atmosphere. Similarly, 'floodout' is only calculated 
+    ! for water sofar, later, there needs to be a C balance for precipitation gains and evaporation 
+    ! losses.   
+    floodout_mean(:) = floodout_mean(:) + floodout(:)   
+    precip_mean(:,ih2o) =  precip_mean(:,ih2o) + precip_rain(:)
+    runoff_mean(:,ih2o) = runoff_mean(:,ih2o) + runoff(:)
+    drainage_mean(:,ih2o) = drainage_mean(:,ih2o) + drainage(:)
+
+    DOC_inp = DOC_EXP_agg_d
+    IF(ok_doc)THEN 
+       drainage_mean(:,idoc)   = DOC_EXP_agg_d(:,idrainage)*1e-3   
+       runoff_mean(:,idoc)     = DOC_EXP_agg_d(:,irunoff)*1e-3   
+       precip_mean(:,idoc)     = precip_mean(:,idoc) + precip_rain(:)*doc_conc3
+       drainage_mean(:,iCO2aq) = drainage_mean(:,iCO2aq) + drainage(:)*CO2_conc1    
+       runoff_mean(:,iCO2aq)   = runoff_mean(:,iCO2aq) + runoff(:)*CO2_conc2    
+       precip_mean(:,iCO2aq)   = precip_mean(:,iCO2aq) + precip_rain(:)*CO2_conc3    
+    ENDIF !ok_doc
+
+    !! Computes the total fraction occupied by the grasses and the crops for each grid cell
+    tot_vegfrac_nowoody(:) = zero
+    DO jv  = 1, nvm
+       IF ( (jv /= ibare_sechiba) .AND. .NOT.(is_tree(jv)) ) THEN  
+       !RL This was changed by Camille and FGU:  IF ( is_c3(jv) .OR. is_c4(jv) ) THEN
+          tot_vegfrac_nowoody(:) = tot_vegfrac_nowoody(:) + veget_max(:,jv) 
+       END IF
+    END DO
+
+    DO ig = 1, nbpt
+       IF ( tot_vegfrac_nowoody(ig) .GT. min_sechiba ) THEN
+          DO jv = 1,nvm
+             IF ( (jv /= ibare_sechiba) .AND. .NOT.(is_tree(jv)) ) THEN 
+             !RL This was changed by Camille and FGU:  IF ( is_c3(jv) .OR. is_c4(jv) ) THEN
+                transpot_mean(ig) = transpot_mean(ig) + transpot(ig,jv) &
+                               &  * veget_max(ig,jv)/tot_vegfrac_nowoody(ig)  
+             END IF
+          END DO
+       ELSE
+          IF (MAXVAL(veget_max(ig,2:nvm)) .GT. min_sechiba) THEN
+             DO jv = 2, nvm
+                transpot_mean(ig) = transpot_mean(ig) + transpot(ig,jv) &
+                              &   * veget_max(ig,jv)/ SUM(veget_max(ig,2:nvm))
+             ENDDO
+          ENDIF
+       ENDIF
+    ENDDO
+
+    !
+    ! Averaged variables (i.e. *dt_sechiba/dt_routing). This accounts for the difference between the shorter
+    ! timestep dt_sechiba of other parts of the model and the long dt_routing timestep (set to one day at present)
+    
+    totnobio_mean(:) = totnobio_mean(:) + totfrac_nobio(:)*dt_sechiba/dt_routing
+    k_litt_mean(:) = k_litt_mean(:) + k_litt(:)*dt_sechiba/dt_routing
+    !
+    ! Only potentially vegetated surfaces are taken into account. At the start of
+    ! the growing seasons we will give more weight to these areas.
+    
+    DO jv=2,nvm
+       DO ig=1,nbpt
+          humrel_mean(ig) = humrel_mean(ig) + humrel(ig,jv)*veget_max(ig,jv)*dt_sechiba/dt_routing
+          vegtot_mean(ig) = vegtot_mean(ig) + veget_max(ig,jv)*dt_sechiba/dt_routing
+       ENDDO
+    ENDDO
+    
+    time_counter = time_counter + dt_sechiba 
+    
+    !! 2 If the time has come we do the routing.
+    
+    IF ( NINT(time_counter) .GE. NINT(dt_routing) ) THEN 
+       
+       !! 2.1 Check the water balance if needed
+       
+       IF ( check_waterbal ) THEN
+          CALL routing_waterbal(nbpt, .TRUE., flood_frac, floodout_mean, precip_mean, runoff_mean,&
+          & drainage_mean, returnflow_mean, reinfiltration_mean, irrigation_mean, riverflow_mean, & 
+          & coastalflow_mean)
+       ENDIF
+       ! Make sure we do not flood north of 49N as there freezing processes start to play a 
+       ! role and they are not yet well treated in ORCHIDEE.
+       
+       DO ig=1,nbpt
+          IF ( lalo(ig,1) > 49.0 ) THEN
+             floodtemp(ig) = tp_00 - un
+          ENDIF
+       ENDDO
+      
+       !! 2.2 Computes the transport of water in the various reservoirs
+       
+       CALL routing_flow(nbpt, dt_routing, lalo, floodout_mean, runoff_mean, drainage_mean, &
+            & vegtot_mean, totnobio_mean, transpot_mean, precip_mean, humrel_mean, k_litt_mean, floodtemp, reinf_slope, &
+            & lakeinflow_mean, returnflow_mean, reinfiltration_mean, irrigation_mean, riverflow_mean, &
+            & coastalflow_mean, hydrographs, slowflow_diag, flood_frac, flood_res)
+       !
+       !! Responsible for storing the water in lakes
+       !
+       CALL routing_lake(nbpt, dt_routing, lakeinflow_mean, humrel_mean, return_lakes)
+
+       returnflow_mean(:,:) = returnflow_mean(:,:) + return_lakes(:,:)
+       
+       !! 2.4 Check the water balance in the routing scheme
+       
+       IF ( check_waterbal ) THEN
+          CALL routing_waterbal(nbpt, .FALSE., flood_frac, floodout_mean, precip_mean, &
+          & runoff_mean, drainage_mean, returnflow_mean, reinfiltration_mean, irrigation_mean, &
+          & riverflow_mean, coastalflow_mean)
+       ENDIF    
+       
+       !! 2.5 Reinitalize variables for averages
+       time_counter = zero
+       !
+       floodout_mean(:) = zero
+       runoff_mean(:,:) = zero
+       drainage_mean(:,:) = zero
+       transpot_mean(:) = zero
+       precip_mean(:,:) = zero
+       !
+       humrel_mean(:) = zero
+       totnobio_mean(:) = zero
+       k_litt_mean(:) = zero
+       vegtot_mean(:) = zero
+       !
+       ! Change the units of the routing fluxes from kg/dt_routing into kg/dt_sechiba
+       !                                    and from m^3/dt_routing into m^3/dt_sechiba
+       !
+       returnflow_mean(:,:) = returnflow_mean(:,:)/dt_routing*dt_sechiba
+       reinfiltration_mean(:,:) = reinfiltration_mean(:,:)/dt_routing*dt_sechiba
+       irrigation_mean(:,:) = irrigation_mean(:,:)/dt_routing*dt_sechiba
+       irrig_netereq(:) = irrig_netereq(:)/dt_routing*dt_sechiba
+       !
+       ! Change units as above but at the same time transform the kg/dt_sechiba to m^3/dt_sechiba
+       !
+       riverflow_mean(:,:) = riverflow_mean(:,:)/dt_routing*dt_sechiba/mille
+       coastalflow_mean(:,:) = coastalflow_mean(:,:)/dt_routing*dt_sechiba/mille
+       hydrographs(:,:) = hydrographs(:,:)/dt_routing*dt_sechiba/mille
+       slowflow_diag(:) = slowflow_diag(:)/dt_routing*dt_sechiba/mille
+    ENDIF
+
+    !
+    ! Return the fraction of routed water for this time step.
+    !
+    returnflow(:,:) = returnflow_mean(:,:)
+    reinfiltration(:,:) = reinfiltration_mean(:,:)
+    irrigation(:,:) = irrigation_mean(:,:)
+    riverflow(:,:) = riverflow_mean(:,:)
+    coastalflow(:,:) = coastalflow_mean(:,:)
+
+    !
+    ! Write diagnostics
+    !
+
+    CALL xios_orchidee_send_field("riversret",returnflow*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("hydrographs",hydrographs/dt_sechiba)
+    CALL xios_orchidee_send_field("Qb",slowflow_diag/dt_sechiba) ! Qb in m3/s
+    CALL xios_orchidee_send_field("reinfiltration",reinfiltration)
+    CALL xios_orchidee_send_field("fastr",fast_diag)
+    CALL xios_orchidee_send_field("slowr",slow_diag)
+    CALL xios_orchidee_send_field("streamr",stream_diag)
+    CALL xios_orchidee_send_field("lakevol",lake_diag)
+    CALL xios_orchidee_send_field("pondr",pond_diag)
+    CALL xios_orchidee_send_field("irrigation",irrigation*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("irrigation_alma",irrigation/dt_sechiba)
+    CALL xios_orchidee_send_field("netirrig",irrig_netereq*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("netirrig_alma",irrig_netereq/dt_sechiba)
+    CALL xios_orchidee_send_field("floodh",flood_height)
+    CALL xios_orchidee_send_field("floodr",flood_diag)
+    delsurfstor(:) = delsurfstor(:) + flood_diag(:,ih2o) + pond_diag(:,ih2o) &
+         &         + lake_diag(:,ih2o)
+    CALL xios_orchidee_send_field("DelSurfStor",delsurfstor)
+    CALL xios_orchidee_send_field("SurfStor",flood_diag+pond_diag+lake_diag)
+
+    IF ( .NOT. almaoutput ) THEN
+       ! first, only variables which are only for water
+       !
+       CALL histwrite_p(hist_id, 'riversret', kjit, returnflow, nbpt, index)
+       IF (do_floodplains .OR. doponds) THEN
+          CALL histwrite_p(hist_id, 'reinfiltration', kjit, reinfiltration, nbpt, index)
+       ENDIF
+       CALL histwrite_p(hist_id, 'hydrographs', kjit, hydrographs, nbpt, index)
+       !
+       CALL histwrite_p(hist_id, 'fastr', kjit, fast_diag, nbpt, index)
+       CALL histwrite_p(hist_id, 'slowr', kjit, slow_diag, nbpt, index)
+       CALL histwrite_p(hist_id, 'streamr', kjit, stream_diag, nbpt, index)
+       IF ( do_floodplains ) THEN
+          CALL histwrite(hist_id, 'floodh', kjit, flood_height, nbpt, index)
+       ENDIF
+       !
+       IF ( do_irrigation ) THEN
+          CALL histwrite(hist_id, 'netirrig', kjit, irrig_netereq, nbpt, index)
+       ENDIF
+       IF ( doswamps ) THEN
+          var_name = 'swamp'
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, swamp, 'scatter',  nbp_glo, index_g)
+       ENDIF
+       !
+       delsurfstor(:) = delsurfstor(:) + flood_diag(:,ih2o) + pond_diag(:,ih2o) + lake_diag(:,ih2o)
+       CALL histwrite(hist_id, 'DelSurfStor', kjit, delsurfstor, nbpt, index)
+       CALL histwrite(hist_id, 'SurfStor', kjit, flood_diag(:,ih2o)+pond_diag(:,ih2o) &
+            &        +lake_diag(:,ih2o), nbpt, index)
+       CALL histwrite(hist_id, 'Dis', kjit, hydrographs(:,ih2o), nbpt, index)
+       IF ( do_irrigation ) THEN
+          CALL histwrite(hist_id, 'Qirrig', kjit, irrigation(:,ih2o), nbpt, index)
+          CALL histwrite(hist_id, 'Qirrig_req', kjit, irrig_netereq, nbpt, index)
+       ENDIF
+       !
+    ENDIF !( .NOT. almaoutput )
+    
+    IF ( hist2_id > 0 ) THEN        !for hist2_id there is no addition of C fluxes
+       IF ( .NOT. almaoutput ) THEN
+          !
+          CALL histwrite(hist2_id, 'riversret', kjit, returnflow(:,ih2o), nbpt, index)
+          IF (do_floodplains .OR. doponds) THEN
+             CALL histwrite(hist2_id, 'reinfiltration', kjit, reinfiltration(:,ih2o), nbpt, index)
+          ENDIF
+          CALL histwrite(hist2_id, 'hydrographs', kjit, hydrographs(:,ih2o), nbpt, index)
+          !
+          CALL histwrite(hist2_id, 'fastr', kjit, fast_diag(:,ih2o), nbpt, index)
+          CALL histwrite(hist2_id, 'slowr', kjit, slow_diag(:,ih2o), nbpt, index)
+          IF ( do_floodplains ) THEN
+             CALL histwrite(hist2_id, 'floodr', kjit, flood_diag(:,ih2o), nbpt, index)
+             CALL histwrite(hist2_id, 'floodh', kjit, flood_height, nbpt, index)
+          ENDIF
+          CALL histwrite(hist2_id, 'pondr', kjit, pond_diag(:,ih2o), nbpt, index)
+          CALL histwrite(hist2_id, 'streamr', kjit, stream_diag(:,ih2o), nbpt, index)
+          CALL histwrite(hist2_id, 'lakevol', kjit, lake_diag(:,ih2o), nbpt, index)
+          !
+          IF ( do_irrigation ) THEN
+             CALL histwrite(hist2_id, 'irrigation', kjit, irrigation(:,ih2o), nbpt, index)
+             CALL histwrite(hist2_id, 'returnflow', kjit, returnflow(:,ih2o), nbpt, index)
+             CALL histwrite(hist2_id, 'netirrig', kjit, irrig_netereq, nbpt, index)
+          ENDIF
+          !
+       ELSE
+          !
+          delsurfstor(:) = delsurfstor(:) + flood_diag(:,ih2o) + pond_diag(:,ih2o) &
+               &         + lake_diag(:,ih2o)
+          CALL histwrite(hist2_id, 'DelSurfStor', kjit, delsurfstor, nbpt, index)
+          CALL histwrite(hist2_id, 'SurfStor', kjit, flood_diag(:,ih2o) + pond_diag(:,ih2o) &
+               &        + lake_diag(:,ih2o), nbpt, index)
+          CALL histwrite(hist2_id, 'Dis', kjit, hydrographs(:,ih2o), nbpt, index)
+          !
+       ENDIF
+    ENDIF
+    !
+    !
+  END SUBROUTINE routing_main
+  
+  !!  =============================================================================================================================
+  !! SUBROUTINE:         routing_finalize
+  !!
+  !>\BRIEF	         Write to restart file
+  !!
+  !! DESCRIPTION:        Write module variables to restart file
+  !!
+  !! RECENT CHANGE(S)
+  !!
+  !! REFERENCE(S)
+  !! 
+  !! FLOWCHART   
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE routing_finalize( kjit, nbpt, rest_id, flood_frac, flood_res )
+    
+    IMPLICIT NONE
+    
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)     :: kjit                 !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)     :: nbpt                 !! Domain size (unitless)
+    INTEGER(i_std),INTENT(in)      :: rest_id              !! Restart file identifier (unitless)
+    REAL(r_std), INTENT(in)        :: flood_frac(nbpt)     !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: flood_res(nbpt)      !! Diagnostic of water amount in the floodplains reservoir (kg)
+    
+    !! 0.2 Local variables
+    REAL(r_std), DIMENSION(1)      :: tmp_day              
+    INTEGER(i_std)                 :: iflow                !! Index (unitless)
+    CHARACTER(LEN=80)              :: var_name             !! To store variables names for I/O (unitless)
+    CHARACTER(LEN=10)              :: flow_suff            !! To assign a suffix to the variables name indicating the 
+                                                           !! transported specie
+!_ ================================================================================================================================
+    
+    !
+    ! Write restart variables
+    !
+    tmp_day(1) = time_counter
+    IF (is_root_prc) CALL restput (rest_id, 'routingcounter', 1, 1, 1, kjit, tmp_day)
+
+    CALL restput_p (rest_id, 'routingarea', nbp_glo, nbasmax, 1, kjit, routing_area, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'routetogrid', nbp_glo, nbasmax, 1, kjit, REAL(route_togrid,r_std), 'scatter', &
+         nbp_glo, index_g)
+    CALL restput_p (rest_id, 'routetobasin', nbp_glo, nbasmax, 1, kjit, REAL(route_tobasin,r_std), 'scatter', &
+         nbp_glo, index_g)
+    CALL restput_p (rest_id, 'basinid', nbp_glo, nbasmax, 1, kjit, REAL(global_basinid,r_std), 'scatter', &
+         nbp_glo, index_g)
+    CALL restput_p (rest_id, 'topoindex', nbp_glo, nbasmax, 1, kjit, topo_resid, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'floodh', nbp_glo, 1, 1, kjit, flood_height, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'flood_frac_bas', nbp_glo, nbasmax, 1, kjit, flood_frac_bas, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'pond_frac', nbp_glo, 1, 1, kjit, pond_frac, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'flood_frac', nbp_glo, 1, 1, kjit, flood_frac, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'flood_res', nbp_glo, 1, 1, kjit, flood_res, 'scatter', nbp_glo, index_g)
+
+
+    CALL restput_p (rest_id, 'slowflow_diag', nbp_glo, 1, 1, kjit, slowflow_diag, 'scatter',  nbp_glo, index_g)
+    !
+    ! Keep track of the accumulated variables
+    !
+    CALL restput_p (rest_id, 'floodout_route', nbp_glo, 1, 1, kjit, floodout_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'transpot_route', nbp_glo, 1, 1, kjit, transpot_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'humrel_route', nbp_glo, 1, 1, kjit, humrel_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'totnobio_route', nbp_glo, 1, 1, kjit, totnobio_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'k_litt_route', nbp_glo, 1, 1, kjit, k_litt_mean, 'scatter',  nbp_glo, index_g)
+    CALL restput_p (rest_id, 'vegtot_route', nbp_glo, 1, 1, kjit, vegtot_mean, 'scatter',  nbp_glo, index_g)
+
+    IF ( do_irrigation ) THEN
+       CALL restput_p (rest_id, 'irrigated', nbp_glo, 1, 1, kjit, irrigated, 'scatter',  nbp_glo, index_g)
+    ENDIF
+
+    IF ( do_floodplains ) THEN
+       CALL restput_p (rest_id, 'floodplains', nbp_glo, 1, 1, kjit, floodplains, 'scatter',  nbp_glo, index_g)
+    ENDIF
+    IF ( doswamps ) THEN
+       CALL restput_p (rest_id, 'swamp', nbp_glo, 1, 1, kjit, swamp, 'scatter',  nbp_glo, index_g)
+    ENDIF
+
+       DO iflow = 1, nflow
+          IF (iflow .EQ. 1) THEN
+             flow_suff = ''
+          ELSEIF (iflow .EQ. 2) THEN
+             flow_suff = '_doc'
+          ELSEIF (iflow .EQ. 3) THEN
+             flow_suff = '_CO2'
+          ELSEIF (iflow .EQ. 4) THEN
+             flow_suff = '_CO2ev'
+          ELSE
+             flow_suff = '_NoName'  !!ERROR - suffixes not specified
+          ENDIF !iflow=1...nflow
+          ! variables with two dimensions
+          var_name = 'fastres'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, &
+               &          fast_reservoir(:,:,iflow), 'scatter',  nbp_glo, index_g)
+          var_name = 'slowres'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit,  &
+               &          slow_reservoir(:,:,iflow), 'scatter',  nbp_glo, index_g)
+          var_name = 'streamres'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, &
+               &          stream_reservoir(:,:,iflow),'scatter',nbp_glo,index_g)
+          var_name = 'floodres'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, &
+               &          flood_reservoir(:,:,iflow), 'scatter',  nbp_glo, index_g)
+
+          !variables with one dimension
+
+          var_name = 'lakeres'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, lake_reservoir(:,iflow), &
+               &            'scatter', nbp_glo, index_g)
+          var_name = 'pondres'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, pond_reservoir(:,iflow), &
+               &            'scatter', nbp_glo, index_g)
+          var_name = 'lakeinflow'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, lakeinflow_mean(:,iflow), &
+               &            'scatter', nbp_glo, index_g)
+          var_name = 'returnflow'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, returnflow_mean(:,iflow), &
+               &            'scatter', nbp_glo, index_g)
+          var_name = 'reinfiltration'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, reinfiltration_mean(:,iflow), &
+               &            'scatter',  nbp_glo, index_g)
+          var_name = 'riverflow'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, riverflow_mean(:,iflow), &
+               &            'scatter',  nbp_glo, index_g)
+          var_name = 'coastalflow'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, coastalflow_mean(:,iflow), &
+               &            'scatter',  nbp_glo, index_g)
+          var_name = 'runoff_route'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, runoff_mean(:,iflow), &
+               &            'scatter', nbp_glo, index_g)
+          var_name = 'drainage_route'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, drainage_mean(:,iflow), &
+               &            'scatter', nbp_glo, index_g)
+          var_name = 'precip_route'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, precip_mean(:,iflow), &
+               &            'scatter', nbp_glo, index_g)
+          var_name = 'hydrographs'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, hydrographs(:,iflow), &
+               &         'scatter', nbp_glo, index_g)
+          IF ( doirrigation ) THEN
+             var_name = 'irrigation'//flow_suff
+             CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, irrigation_mean(:,iflow), &
+                     &            'scatter',  nbp_glo, index_g)
+          ENDIF !doirrigation
+       ENDDO !DO iflow = 1, nflow
+
+  
+  END SUBROUTINE routing_finalize
+
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_init
+!!
+!>\BRIEF         This subroutine allocates the memory and get the fixed fields from the restart file.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_init(kjit, nbpt, index, returnflow, reinfiltration, irrigation, &
+       &                  riverflow, coastalflow, flood_frac, flood_res, stempdiag, rest_id)
+    
+    IMPLICIT NONE
+    
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                   :: kjit           !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)                   :: nbpt           !! Domain size (unitless)
+    INTEGER(i_std), DIMENSION (nbpt), INTENT(in) :: index          !! Indices of the points on the map (unitless)
+    REAL(r_std), DIMENSION(nbpt,nbdl),INTENT(in) :: stempdiag      !! Temperature profile in soil
+    INTEGER(i_std), INTENT(in)                   :: rest_id        !! Restart file identifier (unitless)
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION (nbpt,nflow),INTENT(out)    :: returnflow     !! The water flow from lakes and swamps which returns 
+                                                                         !! into the grid box. This water will go back into the 
+                                                                         !! hydrol or hydrolc module to allow re-evaporation 
+                                                                         !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION (nbpt,nflow),INTENT(out)    :: reinfiltration !! Water flow from ponds and floodplains which returns 
+                                                                         !! to the grid box @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION (nbpt,nflow),INTENT(out)    :: irrigation     !! Irrigation flux. This is the water taken from the 
+                                                                         !! reservoirs and beeing put into the upper layers of 
+                                                                         !! the soil.@tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION (nbpt,nflow),INTENT(out)    :: riverflow      !! Outflow of the major rivers. The flux will be located 
+                                                                         !! on the continental grid but this should be a coastal 
+                                                                         !! point @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION (nbpt,nflow),INTENT(out)    :: coastalflow    !! Outflow on coastal points by small basins. This is the 
+                                                                         !! water which flows in a disperse way into the ocean 
+                                                                         !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)          :: flood_frac     !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)          :: flood_res      !! Diagnostic of water amount in the floodplains reservoir
+                                                                         !! (kg)
+    
+    !! 0.3 LOCAL VARIABLES
+    CHARACTER(LEN=80)                            :: var_name       !! To store variables names for I/O (unitless)
+    CHARACTER(LEN=10)                            :: flow_suff      !! To assign a suffix to the variables name indicating the 
+                                                                   !! transported specie
+    CHARACTER(LEN=80)                            :: var_long_name  !! To store variables long names for I/O (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: tmp_real_g     !! A temporary real array for the integers
+    REAL(r_std), DIMENSION(1)                    :: tmp_day        !!
+    REAL(r_std)                                  :: ratio          !! Diagnostic ratio to check that dt_routing is a multiple of dt_sechiba (unitless)
+    REAL(r_std)                                  :: totarea        !! Total area of basin (m^2)
+    INTEGER(i_std)                               :: iflow, ier, ig, ib, ipn(1) !! Indices (unitless)
+
+ !! 1. Get values for control variables 
+    !
+    ! These variables will require the configuration infrastructure
+    !
+    !Config Key   = DT_ROUTING 
+    !Config If    = RIVER_ROUTING
+    !Config Desc  = Time step of the routing scheme
+    !Config Def   = one_day
+    !Config Help  = This values gives the time step in seconds of the routing scheme. 
+    !Config         It should be multiple of the main time step of ORCHIDEE. One day
+    !Config         is a good value.
+    !Config Units = [seconds]
+    !
+    dt_routing = one_day
+    CALL getin_p('DT_ROUTING', dt_routing)
+    !
+    !Config Key   = ROUTING_RIVERS
+    !Config If    = RIVER_ROUTING
+    !Config Desc  = Number of rivers 
+    !Config Def   = 50
+    !Config Help  = This parameter chooses the number of largest river basins
+    !Config         which should be treated as independently as rivers and not
+    !Config         flow into the oceans as diffusion coastal flow.
+    !Config Units = [-]
+    num_largest = 50
+    CALL getin_p('ROUTING_RIVERS', num_largest)
+    !
+    !Config Key   = DO_FLOODINFILT
+    !Config Desc  = Should floodplains reinfiltrate into the soil 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the flood plains reinfiltration 
+    !Config         into the soil moisture. It then can go 
+    !Config         back to the slow and fast reservoirs
+    !Config Units = [FLAG]
+    !
+    dofloodinfilt = .FALSE.
+    CALL getin_p('DO_FLOODINFILT', dofloodinfilt)
+    !
+    !Config Key   = DO_SWAMPS
+    !Config Desc  = Should we include swamp parameterization 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the swamps and return 
+    !Config         the water into the bottom of the soil. It then can go 
+    !Config         back to the atmopshere. This tried to simulate 
+    !Config         internal deltas of rivers.
+    !Config Units = [FLAG]
+    !
+    doswamps = .FALSE.
+    CALL getin_p('DO_SWAMPS', doswamps)
+    !
+    !Config Key   = DO_PONDS
+    !Config Desc  = Should we include ponds 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the ponds and return 
+    !Config         the water into the soil moisture. It then can go 
+    !Config         back to the atmopshere. This tried to simulate 
+    !Config         little ponds especially in West Africa.
+    !Config Units = [FLAG]
+    !
+    doponds = .FALSE.
+    CALL getin_p('DO_PONDS', doponds)
+    !
+    ! Fix the time constants according to hydrol_cwrr flag
+    !
+    !
+    !Config Key   = SLOW_TCST
+    !Config Desc  = Time constant for the slow reservoir 
+    !Config If    = RIVER_ROUTING 
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         time constant (in days) of the slow reservoir
+    !Config         in order to get better river flows for 
+    !Config         particular regions.
+    !Config Units = [days]
+    !
+!> A value for property of each reservoir (in day/m) is given to compute a time constant (in day)
+!> for each reservoir (product of tcst and topo_resid).
+!> The value of tcst has been calibrated for the three reservoirs over the Senegal river basin only,
+!> during the 1 degree NCEP Corrected by Cru (NCC) resolution simulations (Ngo-Duc et al., 2005, Ngo-Duc et al., 2006) and
+!> generalized for all the basins of the world. The "slow reservoir" and the "fast reservoir"
+!> have the highest value in order to simulate the groundwater. 
+!> The "stream reservoir", which represents all the water of the stream, has the lowest value.
+!> Those figures are the same for all the basins of the world.
+!> The value of slow_tcst is equal to fast_tcst when CWRR is activated.
+!> This assumption should be re-discussed.
+    !
+    IF ( hydrol_cwrr ) THEN
+       slow_tcst = slow_tcst_cwrr
+    ELSE
+       slow_tcst = slow_tcst_chois
+    ENDIF
+    CALL getin_p('SLOW_TCST', slow_tcst)
+    !
+    !Config Key   = FAST_TCST
+    !Config Desc  = Time constant for the fast reservoir 
+    !Config If    = RIVER_ROUTING 
+    !Config Def   = fast_tcst_cwrr or fast_tcst_chois depending on flag HYDROL_CWRR
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         time constant (in days) of the fast reservoir
+    !Config         in order to get better river flows for 
+    !Config         particular regions.
+    !Config Units = [days]
+    !
+    IF ( hydrol_cwrr ) THEN
+       fast_tcst = fast_tcst_cwrr
+    ELSE
+       fast_tcst = fast_tcst_chois
+    ENDIF
+    CALL getin_p('FAST_TCST', fast_tcst)
+    !
+    !Config Key   = STREAM_TCST
+    !Config Desc  = Time constant for the stream reservoir 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = stream_tcst_cwrr or stream_tcst_chois depending on flag HYDROL_CWRR
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         time constant (in days) of the stream reservoir
+    !Config         in order to get better river flows for 
+    !Config         particular regions.
+    !Config Units = [days]
+    !
+    IF ( hydrol_cwrr ) THEN
+       stream_tcst = stream_tcst_cwrr
+    ELSE
+       stream_tcst = stream_tcst_chois
+    ENDIF
+    CALL getin_p('STREAM_TCST', stream_tcst)
+    !
+    !Config Key   = FLOOD_TCST
+    !Config Desc  = Time constant for the flood reservoir 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 4.0
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         time constant (in days) of the flood reservoir
+    !Config         in order to get better river flows for 
+    !Config         particular regions.
+    !Config Units = [days]
+    !
+    IF ( hydrol_cwrr ) THEN
+       flood_tcst = flood_tcst_cwrr
+    ELSE
+       flood_tcst = flood_tcst_chois
+    ENDIF
+    CALL getin_p('FLOOD_TCST', flood_tcst)
+    !
+    !Config Key   = SWAMP_CST
+    !Config Desc  = Fraction of the river that flows back to swamps 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 0.2
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         fraction of the river transport
+    !Config         that flows to swamps
+    !Config Units = [-]
+    !
+    IF ( hydrol_cwrr ) THEN
+       swamp_cst = swamp_cst_cwrr
+    ELSE
+       swamp_cst = swamp_cst_chois
+    ENDIF
+    CALL getin_p('SWAMP_CST', swamp_cst)
+    !
+    !Config Key   = FAST_DEC, SLOW_DEC, STREAM_DEC, FLOOD_DEC, POND_DEC
+    !Config Desc  = Oxidation rates of DOC in the diffrenet inland water types 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 0.05
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         the proportion of DOC composed per
+    !Config         one day time step
+    !Config Units = [-]    
+    CALL getin_p('FAST_DEC', fast_dec)    
+    CALL getin_p('SLOW_DEC', slow_dec)        
+    CALL getin_p('STREAM_DEC', stream_dec)        
+    CALL getin_p('FLOOD_DEC', flood_dec)      
+    CALL getin_p('POND_DEC', pond_dec)      
+    !
+    !Config Key   = K_HEADW, K_STREAM, K_FLOOD, K_POND
+    !Config Desc  = Gas exchange velocities for CO2 and differrnt types of inland waters
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 3.0
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         gas exchange velocity for CO2 an the different
+    !Config         types of inland waters
+    !Config Units = @tex $(m day^{-1})$ @endtex    
+    CALL getin_p('K_HEADW', k_headw)    
+    CALL getin_p('K_STREAM', k_stream)        
+    CALL getin_p('K_FLOOD', k_flood)      
+    CALL getin_p('K_POND', k_pond)      
+    !
+    !Config Key   = DRAINAGE_CO2
+    !Config Desc  = Fixed CO2 concentration of the drainage
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 12.0E-06
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         a CO2 concnetration for the drainage
+    !Config Units = @tex $(kg C kg^{-1})$ @endtex  
+    CALL getin_p('DRAINAGE_CO2', CO2_conc1)    
+    !
+    !Config Key   = RUNOFF_CO2
+    !Config Desc  = Fixed CO2 concentration of the runoff
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 12.0E-07
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         a CO2 concnetration for the runoff
+    !Config Units = @tex $(kg C kg^{-1})$ @endtex  
+    CALL getin_p('RUNOFF_CO2', CO2_conc2)     
+    !
+    !Config Key   = PRECIP_CO2
+    !Config Desc  = Fixed CO2 concentration of the precipitation
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 15.0E-08
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         a CO2 concnetration for the precipitation
+    !Config Units = @tex $(kg C kg^{-1})$ @endtex  
+    CALL getin_p('PRECIP_CO2', CO2_conc3) 
+    !
+    ! In order to simplify the time cascade check that dt_routing
+    ! is a multiple of dt_sechiba
+    !
+    ratio = dt_routing/dt_sechiba
+    IF ( ABS(NINT(ratio) - ratio) .GT. 10*EPSILON(ratio)) THEN
+       WRITE(numout,*) 'WARNING -- WARNING -- WARNING -- WARNING'
+       WRITE(numout,*) "The chosen time step for the routing is not a multiple of the"
+       WRITE(numout,*) "main time step of the model. We will change dt_routing so that"
+       WRITE(numout,*) "this condition os fulfilled"
+       dt_routing = NINT(ratio) * dt_sechiba
+       WRITE(numout,*) 'THE NEW DT_ROUTING IS : ', dt_routing
+    ENDIF
+    !
+    IF ( dt_routing .LT. dt_sechiba) THEN
+       WRITE(numout,*) 'WARNING -- WARNING -- WARNING -- WARNING'
+       WRITE(numout,*) 'The routing timestep can not be smaller than the one'
+       WRITE(numout,*) 'of the model. We reset its value to the model''s timestep.'
+       WRITE(numout,*) 'The old DT_ROUTING is : ', dt_routing
+       dt_routing = dt_sechiba
+       WRITE(numout,*) 'THE NEW DT_ROUTING IS : ', dt_routing
+    ENDIF
+    
+  !! 2. Allocate and initialize variables from the restart files
+    var_name ="routingcounter"
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt('UNITS', 's')
+       CALL ioconf_setatt('LONG_NAME','Time counter for the routing scheme')
+       CALL restget (rest_id, var_name, 1, 1, 1, kjit, .TRUE., tmp_day)
+       IF (tmp_day(1) == val_exp) THEN
+          time_counter = zero
+       ELSE
+          time_counter = tmp_day(1) 
+       ENDIF
+       CALL setvar (time_counter, val_exp, 'NO_KEYWORD', zero)
+    ENDIF
+    CALL bcast(time_counter)
+!$    CALL setvar_p (time_counter, val_exp, 'NO_KEYWORD', zero)
+
+    
+    ALLOCATE (routing_area_loc(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for routing_area_loc','','')
+
+    ALLOCATE (routing_area_glo(nbp_glo,nbasmax))
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for routing_area_glo','','')
+    var_name = 'routingarea'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Area of basin')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., routing_area_glo, &
+            &       "gather", nbp_glo, index_g)
+    ENDIF
+    CALL scatter(routing_area_glo,routing_area_loc)
+    routing_area=>routing_area_loc
+
+    ALLOCATE (tmp_real_g(nbp_glo,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for tmp_real_g','','')
+
+    ALLOCATE (route_togrid_loc(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for route_togrid_loc','','')
+    ALLOCATE (route_togrid_glo(nbp_glo,nbasmax), stat=ier)      ! used in global in routing_flow
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for route_togrid_glo','','')
+
+    IF (is_root_prc) THEN
+       var_name = 'routetogrid'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','Grid into which the basin flows')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., tmp_real_g, "gather", &
+            &       nbp_glo, index_g)
+       route_togrid_glo(:,:) = undef_int
+       WHERE ( tmp_real_g .LT. val_exp )
+          route_togrid_glo = NINT(tmp_real_g)
+    ENDWHERE
+    ENDIF
+    CALL bcast(route_togrid_glo)                      ! used in global in routing_flow
+    CALL scatter(route_togrid_glo,route_togrid_loc)
+    route_togrid=>route_togrid_loc
+    !
+    ALLOCATE (route_tobasin_loc(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for route_tobasin_loc','','')
+
+    ALLOCATE (route_tobasin_glo(nbp_glo,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for route_tobasin_glo','','')
+
+    IF (is_root_prc) THEN
+       var_name = 'routetobasin'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','Basin in to which the water goes')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., tmp_real_g, "gather", &
+            &       nbp_glo, index_g)
+       route_tobasin_glo = undef_int
+       WHERE ( tmp_real_g .LT. val_exp )
+         route_tobasin_glo = NINT(tmp_real_g)
+      ENDWHERE
+    ENDIF
+    CALL scatter(route_tobasin_glo,route_tobasin_loc)
+    route_tobasin=>route_tobasin_loc
+    !
+    ! nbintobasin
+    !
+    ALLOCATE (route_nbintobas_loc(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for route_nbintobas_loc','','')
+    ALLOCATE (route_nbintobas_glo(nbp_glo,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for route_nbintobas_glo','','')
+
+    IF (is_root_prc) THEN
+       var_name = 'routenbintobas'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','Number of basin into current one')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., tmp_real_g, "gather", &
+            &       nbp_glo, index_g)
+       route_nbintobas_glo = undef_int
+       WHERE ( tmp_real_g .LT. val_exp )
+         route_nbintobas_glo = NINT(tmp_real_g)
+      ENDWHERE
+    ENDIF
+    CALL scatter(route_nbintobas_glo,route_nbintobas_loc)
+    route_nbintobas=>route_nbintobas_loc
+    !
+    ALLOCATE (global_basinid_loc(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for global_basinid_loc','','')
+    ALLOCATE (global_basinid_glo(nbp_glo,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for global_basinid_glo','','')
+
+    IF (is_root_prc) THEN
+       var_name = 'basinid'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','ID of basin')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., tmp_real_g, "gather", &
+            &       nbp_glo, index_g)
+       global_basinid_glo = undef_int
+       WHERE ( tmp_real_g .LT. val_exp )
+          global_basinid_glo = NINT(tmp_real_g)
+       ENDWHERE
+    ENDIF
+    CALL scatter(global_basinid_glo,global_basinid_loc)
+    global_basinid=>global_basinid_loc
+    !
+    ALLOCATE (topo_resid_loc(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for topo_resid_loc','','')
+    ALLOCATE (topo_resid_glo(nbp_glo,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for topo_resid_glo','','')
+
+    IF (is_root_prc) THEN
+       var_name = 'topoindex'
+       CALL ioconf_setatt('UNITS', 'm')
+       CALL ioconf_setatt('LONG_NAME','Topographic index of the residence time')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., topo_resid_glo, &
+            &       "gather", nbp_glo, index_g)
+    ENDIF
+    CALL scatter(topo_resid_glo,topo_resid_loc)
+    topo_resid=>topo_resid_loc
+
+    ! Ininitialize variables with a dimension for differnet matter fluxes (iflow) 
+    ! The attribution of variable long names still needs to be optimized
+    ! Also the attribution of suffixes for the diffrenet matter fluxes could be maganed 
+    ! in a diffrenet way, maybe as a function
+    ALLOCATE (fast_reservoir(nbpt,nbasmax,nflow))
+    ALLOCATE (slow_reservoir(nbpt,nbasmax,nflow))
+    ALLOCATE (stream_reservoir(nbpt,nbasmax,nflow))
+    ALLOCATE (flood_reservoir(nbpt,nbasmax,nflow))
+    ALLOCATE (lake_reservoir(nbpt,nflow))
+    ALLOCATE (pond_reservoir(nbpt,nflow))
+    ALLOCATE (lakeinflow_mean(nbpt,nflow))
+    ALLOCATE (returnflow_mean(nbpt,nflow))
+    ALLOCATE (reinfiltration_mean(nbpt,nflow))
+    ALLOCATE (irrigation_mean(nbpt,nflow))
+    ALLOCATE (riverflow_mean(nbpt,nflow))
+    ALLOCATE (coastalflow_mean(nbpt,nflow))
+    DO iflow = 1, nflow
+       IF (iflow .EQ. 1) THEN
+       flow_suff = ''
+       ELSEIF (iflow .EQ. 2) THEN
+       flow_suff = '_doc'
+       ELSEIF (iflow .EQ. 3) THEN
+       flow_suff = '_CO2'
+       ELSEIF (iflow .EQ. 4) THEN
+       flow_suff = '_CO2ev'
+       ELSE
+       flow_suff = '_NoName'  !!ERROR - suffixes not specified
+       ENDIF !iflow=1...nflow
+
+       var_name = 'fastres'//flow_suff
+       var_long_name = 'Water in the fast reservoir'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., &
+            &         fast_reservoir(:,:,iflow), "gather", nbp_glo, index_g)
+
+       var_name = 'slowres'//flow_suff
+       var_long_name = 'Water in the slow reservoir'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., &
+            &         slow_reservoir(:,:,iflow), "gather", nbp_glo, index_g)
+
+       var_name = 'streamres'//flow_suff
+       var_long_name = 'Water in the stream reservoir'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., &
+            &         stream_reservoir(:,:,iflow), "gather", nbp_glo, index_g)
+
+       var_name = 'floodres'//flow_suff
+       var_long_name = 'Water in the flood reservoir'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., &
+            &         flood_reservoir(:,:,iflow), "gather", nbp_glo, index_g)
+
+       var_name = 'lakeres'//flow_suff
+       var_long_name = 'Water in the lake reservoir'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         lake_reservoir(:,iflow), "gather", nbp_glo, index_g)
+
+       var_name = 'pondres'//flow_suff
+       var_long_name =  'Water in the pond reservoir'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         pond_reservoir(:,iflow), "gather", nbp_glo, index_g)
+
+       var_name = 'lakeinflow'//flow_suff
+       var_long_name = 'Lake inflow'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg/dt')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         lakeinflow_mean(:,iflow), "gather", nbp_glo, index_g)
+
+       var_name = 'returnflow'//flow_suff
+       var_long_name ='Deep return flux'
+       CALL ioconf_setatt('UNITS', 'Kg/m^2/dt')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         returnflow_mean(:,iflow), "gather", nbp_glo, index_g)
+
+       var_name = 'reinfiltration'//flow_suff
+       var_long_name = 'Top return flux'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg/m^2/dt')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         reinfiltration_mean(:,iflow), "gather", nbp_glo, index_g)
+
+       IF ( doirrigation ) THEN
+       var_name = 'irrigation'//flow_suff
+       var_long_name = 'Artificial irrigation flux'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg/dt')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         irrigation_mean(:,iflow), "gather", nbp_glo, index_g)
+       ELSE
+          irrigation_mean(:,iflow) = zero
+       ENDIF
+
+       var_name = 'riverflow'//flow_suff
+       var_long_name = 'River flux into the sea'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg/dt')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         riverflow_mean(:,iflow), "gather", nbp_glo, index_g)
+
+       !
+       var_name = 'coastalflow'//flow_suff
+       var_long_name = 'Diffuse flux into the sea'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg/dt')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         coastalflow_mean(:,iflow), "gather", nbp_glo, index_g)
+    ENDDO !iflow=1...nflow
+    CALL setvar_p (fast_reservoir, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (slow_reservoir, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (stream_reservoir, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (flood_reservoir, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (lake_reservoir, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (pond_reservoir, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (lakeinflow_mean, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (returnflow_mean, val_exp, 'NO_KEYWORD', zero)
+    returnflow = returnflow_mean
+    CALL setvar_p (reinfiltration_mean, val_exp, 'NO_KEYWORD', zero)
+    reinfiltration = reinfiltration_mean
+    IF ( doirrigation ) THEN
+      CALL setvar_p (irrigation_mean, val_exp, 'NO_KEYWORD', zero)
+    ENDIF
+    irrigation = irrigation_mean
+    CALL setvar_p (riverflow_mean, val_exp, 'NO_KEYWORD', zero)
+    riverflow = riverflow_mean
+    CALL setvar_p (coastalflow_mean, val_exp, 'NO_KEYWORD', zero)
+    coastalflow = coastalflow_mean
+    ! end initializing variables with dimension for matter transport
+
+    ALLOCATE (flood_frac_bas(nbpt,nbasmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for flood_frac_bas','','')
+    var_name = 'flood_frac_bas'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Flooded fraction per basin')
+    CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., flood_frac_bas, &
+         &         "gather", nbp_glo, index_g)
+    CALL setvar_p (flood_frac_bas, val_exp, 'NO_KEYWORD', zero)
+
+    ALLOCATE (flood_height(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for flood_height','','')
+    var_name = 'floodh'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., flood_height, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (flood_height, val_exp, 'NO_KEYWORD', zero)
+    
+    ALLOCATE (pond_frac(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for pond_frac','','')
+    var_name = 'pond_frac'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Pond fraction per grid box')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., pond_frac, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (pond_frac, val_exp, 'NO_KEYWORD', zero)
+    
+    var_name = 'flood_frac'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Flooded fraction per grid box')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., flood_frac, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (flood_frac, val_exp, 'NO_KEYWORD', zero)
+    
+    var_name = 'flood_res'
+    CALL ioconf_setatt_p('UNITS','mm')
+    CALL ioconf_setatt_p('LONG_NAME','Flooded quantity (estimation)')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., flood_res, "gather", nbp_glo, index_g)
+    CALL setvar_p (flood_res, val_exp, 'NO_KEYWORD', zero)
+!    flood_res = zero
+    
+    ! Map of irrigated areas
+    
+    IF ( do_irrigation ) THEN
+       ALLOCATE (irrigated(nbpt), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for irrigated','','')
+       var_name = 'irrigated'
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Surface of irrigated area')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., irrigated, "gather", &
+            &         nbp_glo, index_g)
+       CALL setvar_p (irrigated, val_exp, 'NO_KEYWORD', undef_sechiba)
+    ENDIF
+    
+    IF ( do_floodplains ) THEN
+       ALLOCATE (floodplains(nbpt), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for floodplains','','')
+       var_name = 'floodplains'
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Surface which can be flooded')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., floodplains, "gather", &
+            &         nbp_glo, index_g)
+       CALL setvar_p (floodplains, val_exp, 'NO_KEYWORD', undef_sechiba)
+    ENDIF
+    IF ( doswamps ) THEN
+       ALLOCATE (swamp(nbpt), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for swamp','','')
+       var_name = 'swamp'
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Surface which can become swamp')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., swamp, "gather", nbp_glo, &
+            &         index_g)
+       CALL setvar_p (swamp, val_exp, 'NO_KEYWORD', undef_sechiba)
+    ENDIF
+    IF ( ok_doc ) THEN
+       ALLOCATE (headw_area(nbpt))
+       var_name = 'headw_area'
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Headwater surface area')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., headw_area, "gather", nbp_glo, &
+            &         index_g)
+       CALL setvar_p (headw_area, val_exp, 'NO_KEYWORD', undef_sechiba)
+       !
+       ALLOCATE (stream_area(nbpt))
+       var_name = 'stream_area'
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Stream/river surface area')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., stream_area, "gather", nbp_glo, &
+            &         index_g)
+       CALL setvar_p (stream_area, val_exp, 'NO_KEYWORD', undef_sechiba)      
+
+       ALLOCATE (upstream_area(nbpt,nbasmax))
+       var_name = 'upstream_area'
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Upstream area per basin')
+       CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., upstream_area, &
+           &         "gather", nbp_glo, index_g)
+       CALL setvar_p (upstream_area, val_exp, 'NO_KEYWORD', zero)    
+       
+    ENDIF !ok_doc
+    ! Put into the restart file the fluxes so that they can be regenerated at restart.
+    !
+    
+    ! Locate it at the 2m level
+    ipn = MINLOC(ABS(diaglev-2))
+    floodtemp_lev = ipn(1)
+    ALLOCATE (floodtemp(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for floodtemp','','')
+    floodtemp(:) = stempdiag(:,floodtemp_lev)
+    
+    ALLOCATE(hydrographs(nbpt,nflow))
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for hydrographs','','')
+    var_name = 'hydrographs'
+    CALL ioconf_setatt('UNITS', '1000 kg/dt')
+    CALL ioconf_setatt('LONG_NAME','Hydrograph at outlow of grid')
+    CALL restget_p (rest_id, var_name, nbp_glo, nflow, 1, kjit, .TRUE., hydrographs, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (hydrographs, val_exp, 'NO_KEYWORD', zero)
+
+    ALLOCATE(slowflow_diag(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for slowflow_diag','','')
+    var_name = 'slowflow_diag'
+    CALL ioconf_setatt_p('UNITS', 'm^3/dt')
+    CALL ioconf_setatt_p('LONG_NAME','Slowflow hydrograph at outlow of grid')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE.,slowflow_diag, "gather", nbp_glo, index_g)
+    CALL setvar_p (slowflow_diag, val_exp, 'NO_KEYWORD', zero)
+
+    !
+    ! The diagnostic variables, they are initialized from the above restart variables.
+
+    ALLOCATE(fast_diag(nbpt,nflow), slow_diag(nbpt,nflow), stream_diag(nbpt,nflow), &
+    & flood_diag(nbpt,nflow), pond_diag(nbpt,nflow), lake_diag(nbpt,nflow), delsurfstor(nbpt), &
+    & FCO2_aq(nbpt,naqsys), pCO2_aq(nbpt,naqsys), DOC_inp(nbpt,nexp), stat=ier)
+
+    fast_diag(:,:)   = zero
+    slow_diag(:,:)   = zero
+    stream_diag(:,:) = zero
+    flood_diag(:,:)  = zero
+    pond_diag(:,:)   = zero
+    lake_diag(:,:)   = zero
+    delsurfstor(:)   = zero
+    FCO2_aq(:,:)     = zero
+    pCO2_aq(:,:)     = zero
+    DOC_inp(:,:)     = zero
+
+    DO ig=1,nbpt
+       totarea = zero
+       DO ib=1,nbasmax
+          totarea = totarea + routing_area(ig,ib)
+       ENDDO !ib=1,nbasmax    
+
+       DO iflow=1,nflow
+          DO ib=1,nbasmax
+            fast_diag(ig,iflow) = fast_diag(ig,iflow) + fast_reservoir(ig,ib,iflow)
+            slow_diag(ig,iflow) = slow_diag(ig,iflow) + slow_reservoir(ig,ib,iflow)
+            stream_diag(ig,iflow) = stream_diag(ig,iflow) + stream_reservoir(ig,ib,iflow)
+            flood_diag(ig,iflow) = flood_diag(ig,iflow) + flood_reservoir(ig,ib,iflow)
+          ENDDO !ib=1,nbasmax
+          !
+          fast_diag(ig,iflow) = fast_diag(ig,iflow)/totarea
+          slow_diag(ig,iflow) = slow_diag(ig,iflow)/totarea
+          stream_diag(ig,iflow) = stream_diag(ig,iflow)/totarea
+          flood_diag(ig,iflow) = flood_diag(ig,iflow)/totarea
+          !
+          ! This is the volume of the lake scaled to the entire grid.
+          ! It would be better to scale it to the size of the lake
+          ! but this information is not yet available.
+          !
+          lake_diag(ig,iflow) = lake_reservoir(ig,iflow)/totarea
+       ENDDO !iflow=1,nflow
+    ENDDO !ig=1,nbpt
+
+    ! Get from the restart the fluxes we accumulated.
+    
+    ALLOCATE (floodout_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for floodout_mean','','')
+    var_name = 'floodout_route'
+    CALL ioconf_setatt('UNITS', 'Kg')
+    CALL ioconf_setatt('LONG_NAME','Accumulated flow out of floodplains for routing')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., floodout_mean, "gather",&
+         &         nbp_glo, index_g)
+    CALL setvar_p (floodout_mean, val_exp, 'NO_KEYWORD', zero)
+    
+    ! Runoff, drainage and precipitation are input fluxes which can contain dissolved or 
+    ! particulate matter. For these three input fluxes the are different dimensions, 
+    ! for the different species transported
+
+    ALLOCATE(runoff_mean(nbpt,nflow))
+    ALLOCATE(drainage_mean(nbpt,nflow))
+    ALLOCATE(precip_mean(nbpt,nflow))
+
+    DO iflow = 1, nflow
+       IF (iflow .EQ. 1) THEN
+       flow_suff = ''
+       ELSEIF (iflow .EQ. 2) THEN
+       flow_suff = '_doc'
+       ELSEIF (iflow .EQ. 3) THEN
+       flow_suff = '_CO2'
+       ELSEIF (iflow .EQ. 4) THEN
+       flow_suff = '_CO2ev'
+       ELSE
+       flow_suff = '_NoName'  !!ERROR - suffixes not specified
+       ENDIF !iflow=1...nflow
+       !
+       var_name = 'runoff_route'//flow_suff
+       var_long_name = 'Accumulated runoff for routing'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., runoff_mean(:,iflow), &
+            &         "gather", nbp_glo, index_g)
+
+       var_name = 'drainage_route'//flow_suff
+       var_long_name = 'Accumulated drainage for routing'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., drainage_mean(:,iflow), &
+            &         "gather", nbp_glo, index_g)
+
+       var_name = 'precip_route'//flow_suff
+       var_long_name = 'Accumulated rain precipitation for irrigation'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg/m^2')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., precip_mean(:,iflow), &
+            &         "gather", nbp_glo, index_g)
+    ENDDO !iflow=1...nflow
+    CALL setvar_p (runoff_mean, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (drainage_mean, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (precip_mean, val_exp, 'NO_KEYWORD', zero)
+
+    ! Now again variables which do not have diffrenet dimensions for different species
+    
+    ALLOCATE(transpot_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for transpot_mean','','')
+    var_name = 'transpot_route'
+    CALL ioconf_setatt_p('UNITS', 'Kg/m^2')
+    CALL ioconf_setatt_p('LONG_NAME','Accumulated potential transpiration for routing/irrigation')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., transpot_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (transpot_mean, val_exp, 'NO_KEYWORD', zero)
+
+    ALLOCATE(humrel_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for humrel_mean','','')
+    var_name = 'humrel_route'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Mean humrel for irrigation')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., humrel_mean, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (humrel_mean, val_exp, 'NO_KEYWORD', un)
+    
+    ALLOCATE(k_litt_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for k_litt_mean','','')
+    var_name = 'k_litt_route'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Mean cond. for litter')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., k_litt_mean, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (k_litt_mean, val_exp, 'NO_KEYWORD', zero)
+    
+    ALLOCATE(totnobio_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for totnobio_mean','','')
+    var_name = 'totnobio_route'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Last Total fraction of no bio for irrigation')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., totnobio_mean, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (totnobio_mean, val_exp, 'NO_KEYWORD', zero)
+    
+    ALLOCATE(vegtot_mean(nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for vegtot_mean','','')
+    var_name = 'vegtot_route'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Last Total fraction of vegetation')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., vegtot_mean, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (vegtot_mean, val_exp, 'NO_KEYWORD', un)
+    
+    DEALLOCATE(tmp_real_g)
+    
+    ! Allocate diagnostic variables
+    
+    ALLOCATE(hydrodiag_loc(nbpt,nbasmax,nflow),hydrodiag_glo(nbp_glo,nbasmax,nflow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for hydrodiag_glo','','')
+    hydrodiag=>hydrodiag_loc
+
+    ALLOCATE(hydroupbasin_loc(nbpt),hydroupbasin_glo(nbp_glo), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_init','Pb in allocate for hydroupbasin_glo','','')
+    hydroupbasin=>hydroupbasin_loc
+
+    !
+  END SUBROUTINE routing_init
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_clear
+!!
+!>\BRIEF        : This subroutine deallocates the block memory previously allocated.
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_clear()
+    !
+    l_first_routing=.TRUE.
+    !
+    IF (ALLOCATED(routing_area_loc)) DEALLOCATE(routing_area_loc)
+    IF (ALLOCATED(route_togrid_loc)) DEALLOCATE(route_togrid_loc)
+    IF (ALLOCATED(route_tobasin_loc)) DEALLOCATE(route_tobasin_loc)
+    IF (ALLOCATED(route_nbintobas_loc)) DEALLOCATE(route_nbintobas_loc)
+    IF (ALLOCATED(global_basinid_loc)) DEALLOCATE(global_basinid_loc)
+    IF (ALLOCATED(topo_resid_loc)) DEALLOCATE(topo_resid_loc)
+    IF (ALLOCATED(routing_area_glo)) DEALLOCATE(routing_area_glo)
+    IF (ALLOCATED(route_togrid_glo)) DEALLOCATE(route_togrid_glo)
+    IF (ALLOCATED(route_tobasin_glo)) DEALLOCATE(route_tobasin_glo)
+    IF (ALLOCATED(route_nbintobas_glo)) DEALLOCATE(route_nbintobas_glo)
+    IF (ALLOCATED(global_basinid_glo)) DEALLOCATE(global_basinid_glo)
+    IF (ALLOCATED(topo_resid_glo)) DEALLOCATE(topo_resid_glo)
+    IF (ALLOCATED(fast_reservoir)) DEALLOCATE(fast_reservoir)
+    IF (ALLOCATED(slow_reservoir)) DEALLOCATE(slow_reservoir)
+    IF (ALLOCATED(stream_reservoir)) DEALLOCATE(stream_reservoir)
+    IF (ALLOCATED(flood_reservoir)) DEALLOCATE(flood_reservoir)
+    IF (ALLOCATED(flood_frac_bas)) DEALLOCATE(flood_frac_bas)
+    IF (ALLOCATED(flood_height)) DEALLOCATE(flood_height)
+    IF (ALLOCATED(pond_frac)) DEALLOCATE(pond_frac)
+    IF (ALLOCATED(lake_reservoir)) DEALLOCATE(lake_reservoir)
+    IF (ALLOCATED(pond_reservoir)) DEALLOCATE(pond_reservoir)
+    IF (ALLOCATED(returnflow_mean)) DEALLOCATE(returnflow_mean)
+    IF (ALLOCATED(reinfiltration_mean)) DEALLOCATE(reinfiltration_mean)
+    IF (ALLOCATED(riverflow_mean)) DEALLOCATE(riverflow_mean)
+    IF (ALLOCATED(coastalflow_mean)) DEALLOCATE(coastalflow_mean)
+    IF (ALLOCATED(lakeinflow_mean)) DEALLOCATE(lakeinflow_mean)
+    IF (ALLOCATED(runoff_mean)) DEALLOCATE(runoff_mean)
+    IF (ALLOCATED(floodout_mean)) DEALLOCATE(floodout_mean)
+    IF (ALLOCATED(drainage_mean)) DEALLOCATE(drainage_mean)
+    IF (ALLOCATED(transpot_mean)) DEALLOCATE(transpot_mean)
+    IF (ALLOCATED(precip_mean)) DEALLOCATE(precip_mean)
+    IF (ALLOCATED(humrel_mean)) DEALLOCATE(humrel_mean)
+    IF (ALLOCATED(k_litt_mean)) DEALLOCATE(k_litt_mean)
+    IF (ALLOCATED(totnobio_mean)) DEALLOCATE(totnobio_mean)
+    IF (ALLOCATED(vegtot_mean)) DEALLOCATE(vegtot_mean)
+    IF (ALLOCATED(floodtemp)) DEALLOCATE(floodtemp)
+    IF (ALLOCATED(hydrodiag_loc)) DEALLOCATE(hydrodiag_loc)
+    IF (ALLOCATED(hydrodiag_glo)) DEALLOCATE(hydrodiag_glo)
+    IF (ALLOCATED(hydroupbasin_loc)) DEALLOCATE(hydroupbasin_loc)    
+    IF (ALLOCATED(hydroupbasin_glo)) DEALLOCATE(hydroupbasin_glo)
+    IF (ALLOCATED(hydrographs)) DEALLOCATE(hydrographs)
+    IF (ALLOCATED(slowflow_diag)) DEALLOCATE(slowflow_diag)
+    IF (ALLOCATED(irrigation_mean)) DEALLOCATE(irrigation_mean)
+    IF (ALLOCATED(irrigated)) DEALLOCATE(irrigated)
+    IF (ALLOCATED(floodplains)) DEALLOCATE(floodplains)
+    IF (ALLOCATED(swamp)) DEALLOCATE(swamp)
+    IF (ALLOCATED(headw_area)) DEALLOCATE(headw_area)    
+    IF (ALLOCATED(stream_area)) DEALLOCATE(stream_area)  
+    IF (ALLOCATED(upstream_area)) DEALLOCATE(upstream_area)        
+    IF (ALLOCATED(fast_diag)) DEALLOCATE(fast_diag)
+    IF (ALLOCATED(slow_diag)) DEALLOCATE(slow_diag)
+    IF (ALLOCATED(stream_diag)) DEALLOCATE(stream_diag)
+    IF (ALLOCATED(flood_diag)) DEALLOCATE(flood_diag)
+    IF (ALLOCATED(pond_diag)) DEALLOCATE(pond_diag)
+    IF (ALLOCATED(lake_diag)) DEALLOCATE(lake_diag)
+    IF (ALLOCATED(delsurfstor)) DEALLOCATE(delsurfstor)
+    IF (ALLOCATED(FCO2_aq)) DEALLOCATE(FCO2_aq)  
+    IF (ALLOCATED(pCO2_aq)) DEALLOCATE(pCO2_aq) 
+    IF (ALLOCATED(DOC_inp)) DEALLOCATE(DOC_inp)     
+    !
+  END SUBROUTINE routing_clear
+  !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_flow
+!!
+!>\BRIEF         This subroutine computes the transport of water in the various reservoirs
+!!                (including ponds and floodplains) and the water withdrawals from the reservoirs for irrigation.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!! This will first compute the amount of water which flows out of each of the 3 reservoirs using the assumption of an 
+!! exponential decrease of water in the reservoir (see Hagemann S and Dumenil L. (1998)). Then we compute the fluxes 
+!! for floodplains and ponds. All this will then be used in order to update each of the basins : taking water out of 
+!! the up-stream basin and adding it to the down-stream one.
+!! As this step happens globaly we have to stop the parallel processing in order to exchange the information. Once 
+!! all reservoirs are updated we deal with irrigation. The final step is to compute diagnostic fluxes. Among them
+!! the hydrographs of the largest rivers we have chosen to monitor.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): lakeinflow, returnflow, reinfiltration, irrigation, riverflow, coastalflow, hydrographs, flood_frac, 
+!!                          flood_res
+!!
+!! REFERENCES   :
+!! - Ngo-Duc, T., K. Laval, G. Ramillien, J. Polcher, and A. Cazenave (2007)
+!!   Validation of the land water storage simulated by Organising Carbon and Hydrology in Dynamic Ecosystems (ORCHIDEE) with 
+!!   Gravity Recovery and Climate Experiment (GRACE) data.
+!!   Water Resour. Res., 43, W04427, doi:10.1029/2006WR004941.
+!! * Irrigation:
+!! - de Rosnay, P., J. Polcher, K. Laval, and M. Sabre (2003)
+!!   Integrated parameterization of irrigation in the land surface model ORCHIDEE. Validation over Indian Peninsula.
+!!   Geophys. Res. Lett., 30(19), 1986, doi:10.1029/2003GL018024.
+!! - A.C. Vivant (2003)
+!!   Les plaines d'inondations et l'irrigation dans ORCHIDEE, impacts de leur prise en compte.
+!!   , , 51pp.
+!! - N. Culson (2004)
+!!   Impact de l'irrigation sur le cycle de l'eau
+!!   Master thesis, Paris VI University, 55pp.
+!! - X.-T. Nguyen-Vinh (2005)
+!!   Analyse de l'impact de l'irrigation en Amerique du Nord - plaine du Mississippi - sur la climatologie regionale
+!!   Master thesis, Paris VI University, 33pp.
+!! - M. Guimberteau (2006)
+!!   Analyse et modifications proposees de la modelisation de l'irrigation dans un modele de surface.
+!!   Master thesis, Paris VI University, 46pp.
+!! - Guimberteau M. (2010)
+!!   Modelisation de l'hydrologie continentale et influences de l'irrigation sur le cycle de l'eau.
+!!   Ph.D. thesis, Paris VI University, 195pp.
+!! - Guimberteau M., Laval K., Perrier A. and Polcher J. (2011).
+!!   Global effect of irrigation and its impact on the onset of the Indian summer monsoon.
+!!   In press, Climate Dynamics, doi: 10.1007/s00382-011-1252-5.
+!! * Floodplains:
+!! - A.C. Vivant (2002)
+!!   L'ecoulement lateral de l'eau sur les surfaces continentales. Prise en compte des plaines d'inondations dans ORCHIDEE.
+!!   Master thesis, Paris VI University, 46pp.
+!! - A.C. Vivant (2003)
+!!   Les plaines d'inondations et l'irrigation dans ORCHIDEE, impacts de leur prise en compte.
+!!   , , 51pp.
+!! - T. d'Orgeval (2006)
+!!   Impact du changement climatique sur le cycle de l'eau en Afrique de l'Ouest: modelisation et incertitudes.
+!!   Ph.D. thesis, Paris VI University, 188pp.
+!! - T. d'Orgeval, J. Polcher, and P. de Rosnay (2008)
+!!   Sensitivity of the West African hydrological cycle in ORCHIDEE to infiltration processes.
+!!   Hydrol. Earth Syst. Sci., 12, 1387-1401
+!! - M. Guimberteau, G. Drapeau, J. Ronchail, B. Sultan, J. Polcher, J.-M. Martinez, C. Prigent, J.-L. Guyot, G. Cochonneau,
+!!   J. C. Espinoza, N. Filizola, P. Fraizy, W. Lavado, E. De Oliveira, R. Pombosa, L. Noriega, and P. Vauchel (2011)
+!!   Discharge simulation in the sub-basins of the Amazon using ORCHIDEE forced by new datasets.
+!!   Hydrol. Earth Syst. Sci. Discuss., 8, 11171-11232, doi:10.5194/hessd-8-11171-2011
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_flow(nbpt, dt_routing, lalo, floodout, runoff, drainage, &
+       &                  vegtot, totnobio, transpot_mean, precip, humrel, k_litt, floodtemp, reinf_slope, &
+       &                  lakeinflow, returnflow, reinfiltration, irrigation, riverflow, &
+       &                  coastalflow, hydrographs, slowflow_diag, flood_frac, flood_res)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                   :: nbpt                      !! Domain size (unitless)
+    REAL(r_std), INTENT (in)                     :: dt_routing                !! Routing time step (s)
+    REAL(r_std), INTENT(in)                      :: lalo(nbpt,2)              !! Vector of latitude and longitudes
+    REAL(r_std), INTENT(in)                      :: runoff(nbpt,nflow)        !! Grid-point runoff (kg/m^2/dt)
+    REAL(r_std), INTENT(in)                      :: floodout(nbpt)            !! Grid-point flow out of floodplains (kg/m^2/dt)
+    REAL(r_std), INTENT(in)                      :: drainage(nbpt,nflow)      !! Grid-point drainage (kg/m^2/dt)
+    REAL(r_std), INTENT(in)                      :: vegtot(nbpt)              !! Potentially vegetated fraction (unitless;0-1)
+    REAL(r_std), INTENT(in)                      :: totnobio(nbpt)            !! Other areas which can not have vegetation
+    REAL(r_std), INTENT(in)                      :: transpot_mean(nbpt)       !! Mean potential transpiration of the vegetation (kg/m^2/dt)
+    REAL(r_std), INTENT(in)                      :: precip(nbpt,nflow)        !! Rainfall (kg/m^2/dt)
+    REAL(r_std), INTENT(in)                      :: humrel(nbpt)              !! Soil moisture stress, root extraction potential (unitless)
+    REAL(r_std), INTENT(in)                      :: k_litt(nbpt)              !! Averaged conductivity for saturated infiltration in the 'litter' layer (kg/m^2/dt)
+    REAL(r_std), INTENT(in)                      :: floodtemp(nbpt)           !! Temperature to decide if floodplains work (K)
+    REAL(r_std), INTENT(in)                      :: reinf_slope(nbpt)         !! Coefficient which determines the reinfiltration ratio in the grid box due to flat areas (unitless;0-1)
+    REAL(r_std), INTENT(out)                     :: lakeinflow(nbpt,nflow)    !! Water inflow to the lakes (kg/dt)
+    !
+!! OUTPUT VARIABLES
+    REAL(r_std), INTENT(out)                     :: returnflow(nbpt,nflow)    !! The water flow from lakes and swamps which returns into the grid box.
+                                                                              !! This water will go back into the hydrol or hydrolc module to allow re-evaporation (kg/m^2/dt)
+    REAL(r_std), INTENT(out)                     :: reinfiltration(nbpt,nflow)!! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt)
+    REAL(r_std), INTENT(out)                     :: irrigation(nbpt,nflow)    !! Irrigation flux. This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt)
+    REAL(r_std), INTENT(out)                     :: riverflow(nbpt,nflow)     !! Outflow of the major rivers. The flux will be located on the continental grid but this should be a coastal point (kg/dt)
+    REAL(r_std), INTENT(out)                     :: coastalflow(nbpt,nflow)   !! Outflow on coastal points by small basins. This is the water which flows in a disperse way into the ocean (kg/dt)
+    REAL(r_std), INTENT(out)                     :: hydrographs(nbpt,nflow)   !! Hydrographs at the outflow of the grid box for major basins (kg/dt)
+    REAL(r_std), INTENT(out)                     :: slowflow_diag(nbpt)       !! Hydrographs of slow_flow = routed slow_flow for major basins (kg/dt)
+    REAL(r_std), INTENT(out)                     :: flood_frac(nbpt)          !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), INTENT(out)                     :: flood_res(nbpt)           !! Diagnostic of water amount in the floodplains reservoir (kg)
+    !
+!! LOCAL VARIABLES
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: fast_flow       !! Outflow from the fast reservoir 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: slow_flow       !! Outflow from the slow reservoir 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: stream_flow     !! Outflow from the stream reservoir 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: flood_flow      !! Outflow from the floodplain reservoir 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: pond_inflow     !! Inflow to the pond reservoir 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: pond_drainage   !! Drainage from pond 
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: flood_drainage  !! Drainage from floodplains 
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: return_swamp    !! Inflow to the swamp 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+
+    ! Variables used in calculating CO2 evasion
+    REAL(r_std)                                        :: K_CO2           !! Henry constant for CO2 @tex $(mol atm^{-1})$ @endtex
+    REAL(r_std)                                        :: pCO2_wa         !! pCO2 in water (atm)    
+    REAL(r_std), DIMENSION(nbpt)                       :: tot_upstream    !! Value used for partioning stream area among basins   
+                                                                          !! @tex $(m)$ @endtex 
+    REAL(r_std), DIMENSION(nbpt, nbasmax)              :: headw_area_bas  !! Area of headwaters per basin
+                                                                          !! @tex $(m^2)$ @endtex 
+    REAL(r_std), DIMENSION(nbpt, nbasmax)              :: stream_area_bas !! Area of streams and rivers per basin
+                                                                          !! @tex $(m^2)$ @endtex          
+
+    REAL(r_std)                                        :: FCO2, FCO2_ac   !! CO2 evasion from water surface
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex   
+    REAL(r_std)                                        :: store_CO2       !! CO2 storage in water column
+                                                                          !! @tex $(kg)$ @endtex   
+    REAL(r_std)                                        :: store_doc       !! DOC storage in water column
+                                                                          !! @tex $(kg)$ @endtex                        
+    REAL(r_std)                                        :: decompos        !! decomposition rate per sub time-step 
+                                                                          !! (nstep_FCO2 per day)
+    REAL(r_std), DIMENSION(nbpt, nbasmax, naqsys)      :: pCO2_aq_bas     !! avg pCO2 per basin and aq. system
+                                                                          !! @tex $(m^2)$ @endtex 
+    REAL(r_std)                                        :: pCO2_avg        !! used to calculate average pCO2 over the  
+                                                                          !! nstep_FCO2 time-steps per day)
+    REAL(r_std)                                        :: pCO2_aggr       !! used to aggreagte pco2 par grid cell
+                                                                          !! weighted by the water storage of
+                                                                          !! each basin
+                                                                          !! @tex $(atm kg H2O)$ @endtex               
+
+    ! Variables used to preserve the preceding values of the reservoirs for follwoing calculations 
+
+    real(r_std), DIMENSION(nflow)                      :: slow_reservoir_prec       !! Temporary storage retaining preceding value
+                                                                                    !! for slow reservoir for aother calculation.
+                                                                                    !! @tex $(kg dt^{-1})$ @endtex                                                                                  
+    real(r_std), DIMENSION(nflow)                      :: fast_reservoir_prec       !! Temporary storage retaining preceding value
+                                                                                    !! for fast reservoir for aother calculation. 
+                                                                                    !! @tex $(kg dt^{-1})$ @endtex                                                                                  
+    real(r_std), DIMENSION(nflow)                      :: stream_reservoir_prec     !! Temporary storage retaining preceding value
+                                                                                    !! for stream reservoir for aother calculation. 
+                                                                                    !! @tex $(kg dt^{-1})$ @endtex
+    !
+    ! Irrigation per basin
+    !
+    REAL(r_std), DIMENSION(nbpt, nbasmax)              :: irrig_needs               !! Total irrigation requirement (water requirements by the crop for its optimal growth) (kg)
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: irrig_actual              !! Possible irrigation according to the water availability in the reservoirs (kg)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)              :: irrig_deficit             !! Amount of water missing for irrigation (kg)
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: irrig_adduct        !! Amount of water carried over from other basins for 
+                                                                              !! irrigation (kg)
+    REAL(r_std), DIMENSION(nbpt, 0:nbasmax+3,nflow)    :: transport           !! Water transport between basins 
+                                                                              !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbp_glo, 0:nbasmax+3,nflow) :: transport_glo       !! Water transport between basins 
+                                                                              !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: floods              !! Water flow in to the floodplains 
+                                                                              !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: potflood            !! Potential inflow to the swamps 
+                                                                              !! @tex $(kg dt^{-1})$ @endtex
+
+    REAL(r_std), DIMENSION(nbpt)                 :: tobeflooded               !! Maximal surface which can be inundated in each grid box (m^2)
+    REAL(r_std), DIMENSION(nbpt)                 :: totarea                   !! Total area of basin (m^2)
+    REAL(r_std), DIMENSION(nbpt,nflow)           :: totflood                  !! Total amount of water in the floodplains reservoir
+                                                                              !! (kg)
+    REAL(r_std), DIMENSION(nbasmax,nflow)        :: pond_excessflow           !! 
+    REAL(r_std)                                  :: flow                      !! Outflow computation for the reservoirs (kg/dt)
+    REAL(r_std)                                  :: floodindex                !! Fraction of grid box area inundated (unitless;0-1)
+    REAL(r_std)                                  :: pondex                    !! 
+    REAL(r_std)                                  :: flood_frac_pot            !! Total fraction of the grid box which is flooded at optimum repartition (unitless;0-1)
+    REAL(r_std)                                  :: total_area                !! Sum of all the surfaces of the basins 
+                                                                              !! @tex $(m^2})$ @endtex
+    REAL(r_std)                                  :: stream_tot                !! Total water amount in the stream reservoirs (kg)
+    REAL(r_std), DIMENSION(nflow)                :: adduction                 !! Importation of water from a stream reservoir of a neighboring grid box (kg)
+    REAL(r_std), DIMENSION(8,nbasmax)            :: streams_around            !! Stream reservoirs of the neighboring grid boxes (kg)
+    INTEGER(i_std), DIMENSION(8)                 :: igrd                      !! 
+    INTEGER(i_std), DIMENSION(2)                 :: ff                        !! 
+    INTEGER(i_std), DIMENSION(1)                 :: fi                        !! 
+    INTEGER(i_std)                               :: ig, ib, ib2, ig2          !! Indices (unitless)
+    INTEGER(i_std)                               :: rtg, rtb, in              !! Indices (unitless)
+    INTEGER(i_std)                               :: ier                       !! Error handling 
+    INTEGER(i_std)                               :: iflow, istep_FCO2         !! Indices (unitless) 
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: fast_flow_g               !! Outflow from the fast reservoir 
+                                                                              !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: slow_flow_g               !! Outflow from the slow reservoir 
+                                                                              !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: stream_flow_g             !! Outflow from the stream reservoir 
+                                                                              !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: irrig_deficit_glo         !! Amount of water missing for irrigation (kg)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: stream_reservoir_glo      !! Water amount in the stream reservoir (kg)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: irrig_adduct_glo          !! Amount of water carried over from other 
+                                                                              !! basins for irrigation (kg)
+
+    LOGICAL                                      :: error_reservoir           !! Logical to check if there is a negative 
+                                                                              !! amount of water in the slow reservoir 
+                                                                              !! (true/false)
+    !! PARAMETERS
+    LOGICAL, PARAMETER                           :: check_reservoir = .FALSE. !! Logical to choose if we write informations when a negative amount of water is occurring in a reservoir (true/false)
+
+
+ !! 1. Calculation of fluxes
+    ! The main variables related to reservoirs of water storage and fluxes from and to the 
+    ! reservoirs have a dimension specifying the stored/transported species. These species 
+    ! comprise sofar water (ih2o=1), dissolved organic carbon (idoc=1), and dissolved CO2 
+    ! (iCO2aq=2). For all outflows of a reservoir, i.e. a lateral outflow or infiltration 
+    ! into the soil, the concnetration in dissolved matter is assumed to be that in the reservoir.
+    
+    !! 1.1 Initializing variables
+    transport(:,:,:) = zero
+    transport_glo(:,:,:) = zero
+    irrig_netereq(:) = zero
+    irrig_needs(:,:) = zero
+    irrig_actual(:,:,:) = zero
+    irrig_deficit(:,:) = zero
+    irrig_adduct(:,:,:) = zero
+    totarea(:) = zero
+    totflood(:,:) = zero
+    
+    !! 1.2 Aggreating area and flood reservoirs per grid box
+    
+    DO ib=1,nbasmax
+       DO ig=1,nbpt
+          !
+          totarea(ig) = totarea(ig) + routing_area(ig,ib)
+          totflood(ig,:) = totflood(ig,:) + flood_reservoir(ig,ib,:)
+       ENDDO
+    ENDDO
+    
+    !! 1.3 Calculating outflows from fast, slow, stream reservoirs
+    
+    !> The outflow fluxes from the three reservoirs are computed. 
+    !> The outflow of volume of water Vi into the reservoir i is assumed to be linearly related 
+    !> to its volume. The water travel simulated by the routing scheme is dependent on the water 
+    !> retention index topo_resid given by a 0.5 degree resolution map for each pixel performed 
+    !> from a simplification of Manning's formula(Dingman, 1994; Ducharne et al., 2003).
+    !> The resulting product of tcst (in day/m) and topo_resid (in m) represents the time constant 
+    !> (day) which is an e-folding time, the time necessary for the water amount
+    !> in the stream reservoir to decrease by a factor e. Hence, it gives an order of
+    !> magnitude of the travel time through this reservoir between
+    !> the sub-basin considered and its downstream neighbor.
+
+    !! 1.3.1 Calculation of water outflows
+    DO ib=1,nbasmax     
+       DO ig=1,nbpt
+          IF ( route_tobasin(ig,ib) .GT. 0 ) THEN
+             !
+             ! Each of the fluxes is limited by the water in the reservoir and a small margin 
+             ! (min_reservoir) to avoid rounding errors.
+             ! Because the minimum content of the reservoirs is only defined for water,
+             ! the water fluxes are calculated first. The matter fluxes are calculated later
+             ! based on the water fluxes (1.3.2)
+             !
+             flow = MIN(fast_reservoir(ig,ib,ih2o)&
+                  & /((topo_resid(ig,ib)/1000.)*fast_tcst*one_day/dt_routing),&
+                  & fast_reservoir(ig,ib,ih2o)-min_reservoir)
+             fast_flow(ig,ib,ih2o) = MAX(flow, zero)
+             !
+             flow = MIN(slow_reservoir(ig,ib,ih2o)&
+                  & /((topo_resid(ig,ib)/1000.)*slow_tcst*one_day/dt_routing),&
+                  & slow_reservoir(ig,ib,ih2o)-min_reservoir)
+             slow_flow(ig,ib,ih2o) = MAX(flow, zero)
+             !
+             flow = MIN(stream_reservoir(ig,ib,ih2o)/((topo_resid(ig,ib)/1000.)*stream_tcst* & 
+                  & MAX(un-SQRT(flood_frac_bas(ig,ib)),min_sechiba)*one_day/dt_routing),&
+                  & stream_reservoir(ig,ib,ih2o)-min_reservoir)
+             stream_flow(ig,ib,ih2o) = MAX(flow, zero)
+             !
+          ELSE !route_tobasin(ig,ib)
+             fast_flow(ig,ib,ih2o) = zero
+             slow_flow(ig,ib,ih2o) = zero
+             stream_flow(ig,ib,ih2o) = zero
+          ENDIF !route_tobasin(ig,ib)
+       ENDDO !nbpt
+    ENDDO    !nbsmax
+    
+    !! 1.3.2 Calculation of dissolved matter outflows
+    ! Based on the water fluxes from the reservoirs, the matter fluxes are calculated
+    ! The outflows are assumed to have the same concentrations as the reservoirs
+    
+    DO iflow=ih2o+1,nflow
+       DO ib=1,nbasmax
+          DO ig=1,nbpt        
+             IF (fast_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                fast_flow(ig,ib,iflow)= fast_flow(ig,ib,ih2o) &
+                    &                 * (fast_reservoir(ig,ib,iflow) / fast_reservoir(ig,ib,ih2o))
+             ELSE  
+                fast_flow(ig,ib,iflow)=zero
+             ENDIF
+             !
+             IF (slow_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                slow_flow(ig,ib,iflow)= slow_flow(ig,ib,ih2o) &
+                    &                 * (slow_reservoir(ig,ib,iflow) / slow_reservoir(ig,ib,ih2o))
+             ELSE  
+                slow_flow(ig,ib,iflow)=zero
+             ENDIF
+             !  
+             IF (stream_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN 
+                stream_flow(ig,ib,iflow)= stream_flow(ig,ib,ih2o) &
+                      &                 * (stream_reservoir(ig,ib,iflow) &
+                      &                 / stream_reservoir(ig,ib,ih2o))
+             ELSE  
+                stream_flow(ig,ib,iflow)=zero
+             ENDIF
+             !            
+          ENDDO !ig=1,nbpt      
+       ENDDO !  ib=1,nbasmax
+    ENDDO !iflow=ih2o+1,nflow
+ 
+    
+    !! 1.4 Compute the fluxes from the floodplains and ponds if they exist.
+    !! 1.4.1 Compute vertical fluxes with precipitation and potential evaporation
+    ! Note that the variable 'floodout' represents the balance evaporation - precipitation 
+    ! on the floodes area. 'Floodout' is calculated in the hydrol module.
+    IF (do_floodplains .OR. doponds) THEN
+       DO ig=1,nbpt
+          IF (flood_frac(ig) .GT. min_sechiba) THEN
+             
+             flow = MIN(floodout(ig)*totarea(ig)*pond_frac(ig)/flood_frac(ig), &
+               &    pond_reservoir(ig,ih2o)+totflood(ig,ih2o))
+             pondex = MAX(flow - pond_reservoir(ig,ih2o), zero)
+             pond_reservoir(ig,ih2o) = pond_reservoir(ig,ih2o) - (flow - pondex) 
+             
+             ! If demand was over reservoir size, we will take it out from floodplains
+             
+             pond_excessflow(:,:) = zero
+
+             DO ib=1,nbasmax
+                pond_excessflow(ib,ih2o) = MIN(pondex*flood_frac_bas(ig,ib)&
+                     &                     /(flood_frac(ig)-pond_frac(ig)),&
+                     &                     flood_reservoir(ig,ib,ih2o))
+                pondex = pondex - pond_excessflow(ib,ih2o)
+             ENDDO !ib=1,nbasmax
+             
+             IF ( pondex .GT. min_sechiba) THEN
+                WRITE(numout,*) "Unable to redistribute the excess pond outflow over the water &
+                     &          available in the floodplain."
+                WRITE(numout,*) "Pondex = ", pondex
+                WRITE(numout,*) "pond_excessflow(:,ih2o) = ", pond_excessflow(:,ih2o)
+             ENDIF
+             
+                         
+             DO ib=1,nbasmax
+                
+                flow = floodout(ig)*routing_area(ig,ib)*flood_frac_bas(ig,ib)/flood_frac(ig) &
+                  &  + pond_excessflow(ib,ih2o)
+                flood_reservoir(ig,ib,ih2o) = flood_reservoir(ig,ib,ih2o) - flow
+                
+                IF (flood_reservoir(ig,ib,ih2o) .LT. min_sechiba) flood_reservoir(ig,ib,ih2o) =zero
+             ENDDO ! ib=1,nbasmax
+             
+             !! Now update of the other elementatl flows
+             !! We assume that now dissolved matter is lost due to evaporation, which
+             !! means an upconcetration if evaporation exceeds precipitation. Thus, for the
+             !! storage changes in dissolved matter, only inputs from precipitation are considered
+             !! This simplifies the calculations as compared to above, because there can only be
+             !! a gain of dissolved matter. To be consistent with the equations above, however,
+             !! the gains are here represented by negative numbers (floodout is the net-evaporation
+             !! per day). Note that floodout refers to net-evaporation from floodplains only but  
+             !! was normalized to the whole grid cell. Thus, in the equations above one has to  
+             !! devide by flood_frac(ig). 'precip(ig,iflow)' gives the precipitation per area and  
+             !! time, which is valid for the whole grid box. But here, we are only interseted in 
+             !! the amount of precipitation (and the associated wet deposition) on water surfaces.
+
+
+             DO iflow=ih2o+1, nflow
+                flow = -precip(ig,iflow)*totarea(ig)*pond_frac(ig)
+                pond_reservoir(ig,iflow) = pond_reservoir(ig,iflow) - flow     
+                          
+                DO ib=1,nbasmax
+                
+                   flow = -precip(ig,iflow) * routing_area(ig,ib) * flood_frac_bas(ig,ib) 
+                   flood_reservoir(ig,ib,iflow) = flood_reservoir(ig,ib,iflow) - flow
+                
+                   IF (flood_reservoir(ig,ib,ih2o) .LT. min_sechiba) &
+                              &     flood_reservoir(ig,ib,iflow) =zero
+                ENDDO ! ib=1,nbasmax    
+             ENDDO !iflow=ih2o+1, nflow
+             
+             !! If ponds fall dry, storage of dissolved matter is set to zero
+             IF (pond_reservoir(ig,ih2o) .LT. min_sechiba) pond_reservoir(ig,:) = zero             
+          ENDIF !(flood_frac(ig) .GT. min_sechiba)
+       ENDDO ! ig=1,nbpt
+    ENDIF !(flood_frac(ig) .GT. min_sechiba)
+    
+    !! 1.4.2 Computing the drainage from floodplains and update reservoirs
+    !> Drainage from floodplains is depending on a averaged conductivity (k_litt) 
+    !> for saturated infiltration in the 'litter' layer. Flood_drainage will be
+    !> a component of the total reinfiltration that leaves the routing scheme.
+    !-
+    IF (do_floodplains) THEN
+       IF (dofloodinfilt) THEN
+          !! 1.4.2.1 Drainage of water
+          DO ib=1,nbasmax
+             DO ig=1,nbpt
+                flood_drainage(ig,ib,ih2o) = MAX(zero, MIN(flood_reservoir(ig,ib,ih2o), &
+                     & flood_frac(ig)*routing_area(ig,ib)*k_litt(ig)*dt_routing/one_day))
+             ENDDO !ig=1,nbpt   
+          ENDDO !ib=1,nbasmax   
+          
+          !! 1.4.2.2 Drainage of dissolved matter
+          ! The matter fluxes with the drainage are computed based on the assumption that the  
+          ! drainage has the same concentrations as the water in the reservoirs. This assumption
+          ! is used to directly scale the fluxes of dissolved matter with that of water.
+          ! This will not work for particualte matter fluxes.
+          
+          DO iflow=ih2o+1,nflow
+             DO ib=1,nbasmax
+                DO ig=1,nbpt 
+                   IF (flood_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                      flood_drainage(ig,ib,iflow) = flood_drainage(ig,ib,ih2o) &
+                         &  * (flood_reservoir(ig,ib,iflow) / flood_reservoir(ig,ib,ih2o))
+                   ELSE
+                      flood_drainage(ig,ib,iflow) = zero
+                   ENDIF
+                ENDDO !ig=1,nbpt    
+             ENDDO !ib=1,nbasmax                
+          ENDDO !iflow=ih2o+1,nflow
+          
+          !! 1.4.2.3 Update flood reservoir with drainage losses 
+          DO iflow=1,nflow
+             DO ib=1,nbasmax
+                DO ig=1,nbpt                      
+                   flood_reservoir(ig,ib,iflow) = flood_reservoir(ig,ib,iflow) &
+                                    &           - flood_drainage(ig,ib,iflow)
+                ENDDO !ig=1,nbpt
+             ENDDO !ib=1,nbasmax
+          ENDDO !iflow=1,nflow      
+          
+          !! 1.4.2.4 If floddinfiltration not activated, drainage is zero         
+       ELSE !dofloodinfilt
+          flood_drainage(:,:,:) = zero 
+       ENDIF
+
+       !! 1.4.3 Compute the lateral outflows from the floodplains
+       !> Outflow from floodplains is computed depending a delay. This delay is characterized by a
+       !> time constant function of the surface of the floodplains and the product of topo_resid 
+       !> and flood_tcst. flood_tcst has been calibrated through observations in the Niger Inner 
+       !> Delta (D'Orgeval, 2006).
+       
+       DO iflow=1,nflow 
+          DO ib=1,nbasmax
+             DO ig=1,nbpt
+                IF ( route_tobasin(ig,ib) .GT. 0 ) THEN
+                   IF (flood_frac_bas(ig,ib) .GT. min_sechiba) THEN
+                      flow = MIN(flood_reservoir(ig,ib,iflow)  &
+                           & /((topo_resid(ig,ib)/1000.)*flood_tcst* &
+                           & flood_frac_bas(ig,ib)*one_day/dt_routing),&
+                           & flood_reservoir(ig,ib,iflow))
+                   ELSE
+                      flow = zero
+                   ENDIF
+                   flood_flow(ig,ib,iflow) = flow
+                ELSE
+                   flood_flow(ig,ib,iflow) = zero
+                ENDIF
+             ENDDO !ig=1,nbpt
+          ENDDO !ib=1,nbasmax
+       ENDDO !iflow=1,nflow        
+    ELSE! floodplains
+    ! The followin nested loops are not necessary, this can simply be optimized!
+      flood_drainage(:,:,:)  = zero
+      flood_flow(:,:,:)      = zero
+      flood_reservoir(:,:,:) = zero
+    ENDIF
+
+    !! 1.4.4 Drainage and inflow for ponds
+    !- Computing drainage and inflow for ponds
+    !> Drainage from ponds is computed in the same way as for floodplains.
+    !> Reinfiltrated fraction from the runoff (i.e. the outflow from the fast reservoir)
+    !> is the inflow of the pond reservoir.
+    !-
+    IF (doponds) THEN
+       ! If used, the slope coef is not used in hydrol for water2infilt
+       
+       ! As k_litt refers to water infiltration, pond_drainage is first only calculated for water
+       ! in a second step, the dissolved matter fluxes associated to infiltration are calcutaed 
+       ! based on the infiltration of water, assuming the same concentrations in the drainage as 
+       ! in the water stored in the reservoir.
+       
+       !! 1.4.4.1 Drainage of water in ponds       
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             pond_drainage(ig,ib,ih2o) = MIN(pond_reservoir(ig,ih2o) &
+                  &                    * routing_area(ig,ib)/totarea(ig), &
+                  &                      pond_frac(ig) * routing_area(ig,ib) * k_litt(ig) &
+                  &                    * dt_routing/one_day)
+          ENDDO !ig=1,nbpt
+       ENDDO !ib=1,nbasmax
+       
+       !! 1.4.4.2 Flows of dissolved matter with drainage
+       
+       DO iflow=ih2o+1,nflow
+          DO ib=1,nbasmax
+             DO ig=1,nbpt      
+                IF (pond_reservoir(ig,ih2o) .GT. min_sechiba) THEN
+                   pond_drainage(ig,ib,iflow) = pond_drainage(ig,ib,ih2o) &
+                                 &            * (pond_reservoir(ig,iflow) &
+                                 &            / pond_reservoir(ig,ih2o))
+                ELSE
+                   pond_drainage(ig,ib,iflow) = zero
+                ENDIF
+             ENDDO !ig=1,nbpt           
+          ENDDO !ib=1,nbasmax        
+       ENDDO !iflow=ih2o+1,nflow
+       
+       !! 1.4.4.3 Inflows of water and dissolved matter to ponds
+       ! Calculation of pond inflow using water and dissolved matter from the fast flow
+       ! Then, update of fast flow
+       
+       DO iflow=1,nflow
+          DO ib=1,nbasmax
+             DO ig=1,nbpt
+                pond_inflow(ig,ib,iflow) = fast_flow(ig,ib,iflow) * reinf_slope(ig)               
+                fast_flow(ig,ib,iflow) = fast_flow(ig,ib,iflow) - pond_inflow(ig,ib,iflow) 
+             ENDDO !ig=1,nbpt
+          ENDDO !ib=1,nbasmax
+       ENDDO !iflow=1,nflow 
+    ELSE
+       pond_inflow(:,:,:) = zero
+       pond_drainage(:,:,:) = zero
+       pond_reservoir(:,:) = zero   
+    ENDIF 
+
+    !! 1.5 Compute the transport from one basin to another
+
+    IF (is_root_prc)  THEN
+       ALLOCATE( fast_flow_g(nbp_glo, nbasmax, nflow), slow_flow_g(nbp_glo, nbasmax, nflow), &
+            stream_flow_g(nbp_glo, nbasmax, nflow))
+    ELSE
+       ALLOCATE( fast_flow_g(1,1,1), slow_flow_g(1,1,1), &
+            stream_flow_g(1,1,1) )
+    ENDIF
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_flow','Pb in allocate for fast_flow_g','','')
+       
+    CALL gather(fast_flow,fast_flow_g)
+    CALL gather(slow_flow,slow_flow_g)
+    CALL gather(stream_flow,stream_flow_g)
+
+    IF (is_root_prc) THEN
+       ! routing is done for all matter fluxes at the same time 
+       DO ib=1,nbasmax
+          DO ig=1,nbp_glo
+             !
+             rtg = route_togrid_glo(ig,ib)
+             rtb = route_tobasin_glo(ig,ib)
+             transport_glo(rtg,rtb,:) = transport_glo(rtg,rtb,:) + fast_flow_g(ig,ib,:) &
+                                    & + slow_flow_g(ig,ib,:) + stream_flow_g(ig,ib,:)
+             !
+          ENDDO !ig=1,nbp_glo
+       ENDDO !ib=1,nbasmax
+    ENDIF !is_root_prc
+
+    DEALLOCATE( fast_flow_g, slow_flow_g, stream_flow_g )
+   
+    CALL scatter(transport_glo,transport)
+
+    !! 1.6 Do the floodings 
+    !! 1.6.1 Initialize
+    return_swamp(:,:,:)=zero
+    floods(:,:,:)=zero
+    
+    !! 1.6.2 Swamps: Calculating returnflow taking water from river
+    !> Over swamp areas, a fraction of water (return_swamp) is withdrawn from the river depending
+    !> on the parameter swamp_cst.
+    !> It will be transferred into soil moisture and thus does not return directly to the river.
+
+    IF ( doswamps ) THEN
+       tobeflooded(:) = swamp(:)
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             potflood(ig,ib,:) = transport(ig,ib,:) 
+             
+             IF ( tobeflooded(ig) > 0. .AND. potflood(ig,ib,ih2o) > 0. &
+             &  .AND. floodtemp(ig) > tp_00 ) THEN
+                
+                IF (routing_area(ig,ib) > tobeflooded(ig)) THEN
+                   floodindex = tobeflooded(ig) / routing_area(ig,ib)
+                ELSE
+                   floodindex = 1.0
+                ENDIF
+                return_swamp(ig,ib,:) = swamp_cst * potflood(ig,ib,:) * floodindex
+                
+                tobeflooded(ig) = tobeflooded(ig) - routing_area(ig,ib) 
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+
+    !! 1.6.3 Floodplains: Update amount of water/matter which enters the floodplains
+ 
+    IF ( do_floodplains ) THEN
+       DO ig=1,nbpt
+          IF (floodplains(ig) .GT. min_sechiba .AND. floodtemp(ig) .GT. tp_00) THEN
+             DO ib=1,nbasmax
+                floods(ig,ib,:) = transport(ig,ib,:) - return_swamp(ig,ib,:) 
+             ENDDO !ib=1,nbasmax
+          ENDIF
+       ENDDO !ig=1,nbpt
+    ENDIF
+    
+    !! 2. Update all reservoirs
+    !> The slow and deep reservoir (slow_reservoir) collect the deep drainage whereas the
+    !> fast_reservoir collects the computed surface runoff. Both discharge into a third reservoir
+    !> (stream_reservoir) of the next sub-basin downstream.
+    !> Water from the floodplains reservoir (flood_reservoir) flows also into the stream_reservoir 
+    !> of the next sub-basin downstream. Water that flows into the pond_reservoir is withdrawn 
+    !> from the fast_reservoir.
+    
+    error_reservoir=.FALSE.
+    loopresnbpt : DO ig=1,nbpt
+       DO ib=1,nbasmax
+          !! 2.1 Update all reservoirs based on in and out flows 
+          ! No loop for iflow, reservoirs are update for all species at once
+          fast_reservoir(ig,ib,:)   = fast_reservoir(ig,ib,:) + runoff(ig,:)*routing_area(ig,ib) &
+               &                    - fast_flow(ig,ib,:) - pond_inflow(ig,ib,:)
+          
+          slow_reservoir(ig,ib,:)   = slow_reservoir(ig,ib,:) + drainage(ig,:)*routing_area(ig,ib) &
+               &                    - slow_flow(ig,ib,:)
+          
+          stream_reservoir(ig,ib,:) = stream_reservoir(ig,ib,:) + flood_flow(ig,ib,:) &
+               &                    + transport(ig,ib,:) - stream_flow(ig,ib,:) &
+               &                    - return_swamp(ig,ib,:) - floods(ig,ib,:)
+          
+          flood_reservoir(ig,ib,:)  = flood_reservoir(ig,ib,:) + floods(ig,ib,:) &
+               &                    - flood_flow(ig,ib,:) 
+          
+          pond_reservoir(ig,:)      = pond_reservoir(ig,:) + pond_inflow(ig,ib,:) &
+               &                    - pond_drainage(ig,ib,:)
+          
+ 
+          !! 2.2 Check reservoirs for negative values
+          ! If the floodplain reservoir is assigned a negative water storage, the floodplain
+          ! reservoir is reset to 0 kg, and the missing water is taken from the stream reservoir. 
+          ! If the stream reservoir is negative, then water is taken from the fast reservoir. 
+          ! And if the fast reservoir is negative, the missing water is finally taken from the 
+          ! slow reservoir. In case of negative values in the slow reservoir, then routing stops 
+          ! with an error message. When water fluxes are corrected, this correction is done
+          ! for the dissolved matter at the same time.
+          
+          IF ( flood_reservoir(ig,ib,ih2o) .LT. zero ) THEN 
+             IF ( check_reservoir ) THEN
+                WRITE(numout,*) "WARNING : negative flood reservoir at :", ig, ib, &
+                       &        ". Problem is being corrected."
+                WRITE(numout,*) "flood_reservoir, floods, flood_flow : ", &
+                       &        flood_reservoir(ig,ib,ih2o), floods(ig,ib,ih2o), &
+                       &        flood_flow(ig,ib,ih2o) 
+             ENDIF
+             stream_reservoir(ig,ib,:) = stream_reservoir(ig,ib,:) + flood_reservoir(ig,ib,:)
+             flood_reservoir(ig,ib,:) = zero
+          ENDIF
+          
+          IF ( stream_reservoir(ig,ib,ih2o) .LT. zero ) THEN
+             IF ( check_reservoir ) THEN
+                WRITE(numout,*) "WARNING : negative stream reservoir at :", ig, ib, &
+                       &        ". Problem is being corrected."
+                WRITE(numout,*) "stream_reservoir, flood_flow, transport : ", &
+                       &        stream_reservoir(ig,ib,ih2o), flood_flow(ig,ib,ih2o), &
+                       &        transport(ig,ib,ih2o)
+                WRITE(numout,*) "stream_flow, return_swamp, floods :", stream_flow(ig,ib,ih2o), &
+                       &        return_swamp(ig,ib,ih2o), floods(ig,ib,ih2o)
+             ENDIF
+             fast_reservoir(ig,ib,:) =  fast_reservoir(ig,ib,:) + stream_reservoir(ig,ib,:)
+             stream_reservoir(ig,ib,:) = zero        
+          ENDIF
+          
+          IF ( fast_reservoir(ig,ib,ih2o) .LT. zero ) THEN
+             IF ( check_reservoir ) THEN
+                WRITE(numout,*) "WARNING : negative fast reservoir at :", ig, ib, &
+                       &        ". Problem is being corrected."
+                WRITE(numout,*) "fast_reservoir, runoff, fast_flow, ponf_inflow  : ", &
+                       &        fast_reservoir(ig,ib,ih2o), runoff(ig,ih2o), &
+                       &        fast_flow(ig,ib,ih2o), pond_inflow(ig,ib,ih2o)
+             ENDIF
+             slow_reservoir(ig,ib,:) =  slow_reservoir(ig,ib,:) + fast_reservoir(ig,ib,:)
+             fast_reservoir(ig,ib,:) = zero
+          ENDIF
+
+          IF ( slow_reservoir(ig,ib,ih2o) .LT. - min_sechiba ) THEN
+             WRITE(numout,*) 'WARNING : There is a negative reservoir at :', ig, ib,lalo(ig,:)
+             WRITE(numout,*) 'WARNING : slowr, slow_flow, drainage', &
+                  & slow_reservoir(ig,ib,ih2o), slow_flow(ig,ib,ih2o), drainage(ig,ih2o)
+             WRITE(numout,*) 'WARNING : pondr, pond_inflow, pond_drainage', &
+                  & pond_reservoir(ig,ih2o), pond_inflow(ig,ib,ih2o), pond_drainage(ig,ib,ih2o)
+             CALL ipslerr_p(2, 'routing_flow', 'WARNING negative slow_reservoir.','','')
+             EXIT loopresnbpt
+          ENDIF
+
+       ENDDO !ib=1,nbasmax
+       ! DOC decomposition in ponds is calculated after the loop for the basins, as the pond 
+       ! reservoir has no dimension for different basins and always relates to the entire grid box.
+       IF (ok_doc) THEN
+          pond_reservoir(ig,ico2aq) = pond_reservoir(ig,ico2aq) - pond_dec*pond_reservoir(ig,idoc)
+          pond_reservoir(ig,idoc)   = (1 - pond_dec) * pond_reservoir(ig,idoc)
+       ENDIF 
+    ENDDO loopresnbpt
+
+    
+       ! All resservoirs were sofar checked for water content and eventually corrected where water
+       ! content was negative(see above). For dissolved matter transport, there might however 
+       ! still be very small negative or positive values due to rounding errors.
+           
+      
+    !! 2.3 Aggreagte the flood reservoirs per grid box   
+    totflood(:,:) = zero
+    DO ig=1,nbpt
+       DO ib=1,nbasmax
+          totflood(ig,:) = totflood(ig,:) + flood_reservoir(ig,ib,:)
+       ENDDO
+    ENDDO
+
+
+    !! 3 Computes the fraction of floodplains and ponds according to their volume
+
+    IF (do_floodplains .OR. doponds) THEN
+       flood_frac(:) = zero
+       flood_height(:) = zero
+       flood_frac_bas(:,:) = zero
+       DO ig=1, nbpt
+          IF (totflood(ig,ih2o) .GT. min_sechiba) THEN
+             ! We first compute the total fraction of the grid box which is flooded at 
+             ! optimum repartition
+             flood_frac_pot = (totflood(ig,ih2o) / (totarea(ig)*floodcri/(beta+un))) & 
+                  &         **(beta/(beta+un))
+             flood_frac(ig) = MIN(floodplains(ig) / totarea(ig), flood_frac_pot)
+             ! Then we diagnose the fraction for each basin with the size of its flood_reservoir 
+             ! (flood_frac_bas may be > 1)
+             DO ib=1,nbasmax
+                IF (routing_area(ig,ib) .GT. min_sechiba) THEN
+                   flood_frac_bas(ig,ib) = flood_frac(ig) &
+                        &                * (flood_reservoir(ig,ib,ih2o) / totflood(ig,ih2o)) &
+                        &                / (routing_area(ig,ib) / totarea(ig))
+                ENDIF
+             ENDDO
+             ! We diagnose the maximum height of floodplain
+             flood_height(ig) = (beta/(beta+1))*floodcri*(flood_frac(ig))**(un/beta) &
+                        &     + totflood(ig,ih2o)/(totarea(ig)*flood_frac(ig)) 
+             ! And finally add the pond surface
+             pond_frac(ig) = MIN(un-flood_frac(ig), &
+                        &    ((betap+1)*pond_reservoir(ig,ih2o) / (pondcri*totarea(ig))) &
+                        &  **(betap/(betap+1)) ) 
+             flood_frac(ig) = flood_frac(ig) + pond_frac(ig)
+             
+          ENDIF
+       ENDDO
+    ELSE
+       flood_frac(:) = zero
+       flood_height(:) = zero
+       flood_frac_bas(:,:) = zero
+    ENDIF
+
+    !!
+    !! 4 Compute CO2 evasion from all five reservoirs
+    IF (ok_doc) THEN   
+       !! 4.1 Partioning the headwater and stream areas among the basins of each cell 
+       !! Aggreagte squares of stream and fast (head water) reservoirs to partition areas between 
+       !! basins. Square root was chosen as it corresponds more or less to the typical exponent in 
+       !! reported discharge stream width relationships. 
+       !! THe headwaters would here be represented by fast resrvoir
+       !! Headwaters represent lotic wtare bodies below grid scale, which are nethertheless important
+       !! for the biogeochemical budget
+       !! 4.1.1 Initialize
+       tot_upstream(:) = zero
+       !! 4.1.2 Aggregate squares of water reservoirs
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             !
+             tot_upstream(ig)  = tot_upstream(ig) + upstream_area(ig,ib)**undemi
+          ENDDO !ig=1,nbpt
+       ENDDO !ib=1,nbasmax   
+       !! 4.2 Calculate stream and headwater per basin
+       DO ig=1,nbpt
+          total_area = sum(routing_area(ig,:))
+          DO ib=1,nbasmax
+             !   
+             IF (tot_upstream(ig) .GT. min_sechiba) THEN
+                stream_area_bas(ig,ib) = stream_area(ig) * (upstream_area(ig,ib)**undemi) &
+                     &                 / tot_upstream(ig)
+             ELSE 
+                stream_area_bas(ig,ib) = zero
+             ENDIF !(tot_upstream(ig) .GT. min_sechiba)
+             !
+             IF (total_area .GT. min_sechiba) THEN
+                headw_area_bas(ig,ib)  = headw_area(ig) * routing_area(ig,ib) / total_area
+             ELSE 
+                headw_area_bas(ig,ib)  = zero    
+             ENDIF !(total_area(ig) .GT. min_sechiba)         
+          ENDDO !ib=1,nbasmax
+       ENDDO  !ig=1,nbpt           
+       !! 4.3 Calculate DOC decomposition and CO2 evasion
+       !! 4.3.0 Calculation of Henry constant
+       !! This is just the preliminary position, once we figured out how to best estimate water
+       !! temperature, this will be within the loops on gridboxes (and basins???)
+       K_CO2 = 10.0**( - (-2.22E-06 * (T_water**trois) - 1.91E-05 * (T_water**deux) &
+         &   + 1.63E-02 * T_water + 1.11))
+       !! This is an equation from Telmer and Veizer (1999),GCA, which was derived from data
+       !! listed in the text book by Stumm and Morgan
+       !! 4.3.1 Intilaize FCO2_aq and pCO2_aq
+       FCO2_aq(:,:) = zero
+       pCO2_aq(:,:) = zero       
+       !! 4.3.2 Calculation
+         !! First, the decomposition of DOC and subsequent CO2 production are calculated 
+         !! (at present state with fixed decomposition rates per day).
+         !! The decomposition is not calculated for the whole day at once but over
+         !! a certain number of time segments over the day (nstep_FCO2, for the moment
+         !! nstep_FCO2=240). For each of these time segments, the CO2 evasion (FCO2)
+         !! is calculated as well. This segmentation was necessary as the storage of 
+         !! dissolved CO2, and thus the implied concentrations of dissolved CO2, are the
+         !! initial values for each time step. As the CO2 concentation decreases during
+         !! the outgassing, at a given gas exchange rate, the flux rates would decrease
+         !! in proportion to the decreasing pCO2 gradient between water and air.
+         !! Using the initial concentrations (and thus initial partial pressures) for  
+         !! each 1 day time step to calculate the FCO2 over the whole day would lead 
+         !! to systematically too high numbers. The number of time segments can be changed in
+         !! the main declaration part.
+         !! For the calculation of CO2 evasion from the different reservoirs (FCO2), first,
+         !! the pCO2 of the water column is claculated (pCO2_wa). Then FCO2 is calcluated
+         !! based on the diffrence between pCO2 of water and in the atmosphere, the Henry
+         !! constant (K_CO2), the gas exchange velocity k, and the water surface area.
+         !! mmslr_C is the atmoic weight of C in mol/kg, defined in constantes_var.f90.
+         !! As the gas exchanges velocity k in m/d can be larger then required to
+         !! equilibrate the water column with the atmosphere, which happens if the water
+         !! column has an average depth in m (not directly given here, but implied by the
+         !! relationship of water storage in the reservoir and water surface area) that
+         !! is lower then the water column depth therotical equilibrate per day (=k),
+         !! the maximum outgassing is defined by the amount of dissolved CO2 in the
+         !! reservoir which is in excess to the theoretical equilibrium state with the 
+         !! atmosphere (By having a large number of time segments, this risk is lowered,
+         !! but not entriely ruled out). 
+         !! As the pCO2_wa calculated from the concentration of dissolved
+         !! CO2 (iCO2aq) is further depending on the water temperature, changes in water 
+         !! temperature can cause the water column to be undersaturated with respect
+         !! to atmospheric pCO2, particulary if water imputs and stored water from the
+         !! preceding time step were at or close to the equilibrium with the atmosphere. 
+         !! In that case, FCO2 is set to zero. Negative values for FCO2, that is CO2
+         !! uptake from the atmosphere are not represented in this model.  
+
+         
+       DO ig=1,nbpt
+          DO ib=1,nbasmax 
+             !! 4.3.2.1 Floodplains
+             IF (flood_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                ! Initializing
+                FCO2_ac = zero
+                pCO2_avg = zero
+                store_CO2 = flood_reservoir(ig,ib,iCO2aq)
+                store_doc = flood_reservoir(ig,ib,idoc) 
+                decompos  = flood_dec*flood_reservoir(ig,ib,idoc)/nstep_FCO2                  
+                ! Outgassing over nstep_FCO2 time segments per day
+                DO istep_FCO2 = 1, nstep_FCO2
+                   pCO2_wa = ((store_CO2 / flood_reservoir(ig,ib,ih2o)) &
+                      &    / msmlr_C) / K_CO2
+                   FCO2    = min((K_CO2 * (pCO2_wa-1.0E-06*pCO2_atm) * msmlr_C * k_flood &
+                        &  * flood_frac_bas(ig,ib) * routing_area(ig,ib) * mille/ nstep_FCO2), &
+                        &    max((K_CO2 * (pCO2_wa-1.0E-06*pCO2_atm) * msmlr_C &
+                        &  * flood_reservoir(ig,ib,ih2o)), zero))  
+                   FCO2_ac = FCO2_ac + FCO2
+                   pCO2_avg = pCO2_avg + pCO2_wa
+                   store_CO2 = store_CO2 - FCO2 + decompos
+                   store_doc = store_doc - decompos
+                ENDDO !istep_FCO2 = 1, nstep_FCO2
+                flood_reservoir(ig,ib,idoc)= store_doc                
+                flood_reservoir(ig,ib,iCO2ev) = flood_reservoir(ig,ib,iCO2ev) + FCO2_ac
+                flood_reservoir(ig,ib,iCO2aq) = store_CO2
+                FCO2_aq(ig,ifloodr) = FCO2_aq(ig,ifloodr) + FCO2_ac 
+                pCO2_aq_bas(ig,ib,ifloodr) = pCO2_avg / nstep_FCO2
+             ELSE 
+                flood_reservoir(ig,ib,:) = zero
+             ENDIF !(flood_reservoir(ig,ib,ih2o) .GT. min_sechiba)
+             !
+             !! 4.3.2.2 Streams and rivers
+             IF (stream_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                ! Initializing
+                FCO2_ac = zero
+                pCO2_avg = zero                
+                store_CO2 = stream_reservoir(ig,ib,iCO2aq)
+                store_doc = stream_reservoir(ig,ib,idoc) 
+                decompos  = stream_dec*stream_reservoir(ig,ib,idoc)/nstep_FCO2                    
+                ! Outgassing over nstep_FCO2 time segments per day
+                DO istep_FCO2 = 1, nstep_FCO2
+                   pCO2_wa = ((store_CO2 / stream_reservoir(ig,ib,ih2o)) &
+                      &    / msmlr_C) / K_CO2
+                   FCO2    = min((K_CO2 * (pCO2_wa-1.0E-06*pCO2_atm) * msmlr_C * k_stream &
+                      &    * stream_area_bas(ig,ib) * mille / nstep_FCO2), &
+                      &      max((K_CO2 * (pCO2_wa-1.0E-06*pCO2_atm) * msmlr_C &
+                      &    * stream_reservoir(ig,ib,ih2o)), zero))  
+                   FCO2_ac = FCO2_ac + FCO2
+                   pCO2_avg = pCO2_avg + pCO2_wa
+                   store_CO2 = store_CO2 - FCO2 + decompos
+                   store_doc = store_doc - decompos
+                ENDDO !istep_FCO2 = 1, nstep_FCO2  
+                stream_reservoir(ig,ib,idoc)= store_doc                
+                stream_reservoir(ig,ib,iCO2ev) = stream_reservoir(ig,ib,iCO2ev) + FCO2_ac
+                stream_reservoir(ig,ib,iCO2aq) = store_CO2               
+                FCO2_aq(ig,istreamr) = FCO2_aq(ig,istreamr) + FCO2_ac 
+                pCO2_aq_bas(ig,ib,istreamr) = pCO2_avg / nstep_FCO2                
+             ELSE 
+                stream_reservoir(ig,ib,:) = zero
+             ENDIF !(stream_reservoir(ig,ib,ih2o) .GT. min_sechiba)
+             !
+             !! 4.3.2.3 Fast reservoir
+             ! Here we calculate the CO2 evasion from the headwaters, which are represented by fast
+             ! reservoir (runoff). First, we calculate the oxidation of DOC, and thus production of 
+             ! CO2. Then, we calculate the CO2 evasion assumin that all dissolved CO2 in excess to 
+             ! the atmospheric partial pressure of pCO2 is evading. 
+             IF (fast_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                ! Initializing
+                FCO2_ac = zero  
+                pCO2_avg = zero                 
+                decompos  = fast_dec*fast_reservoir(ig,ib,idoc)  
+                store_CO2 = fast_reservoir(ig,ib,iCO2aq) + decompos               
+                store_doc = fast_reservoir(ig,ib,idoc) - decompos
+                
+                pCO2_wa = ((store_CO2 / fast_reservoir(ig,ib,ih2o)) &
+                   &    / msmlr_C) / K_CO2
+                FCO2    = max((K_CO2 * (pCO2_wa-1.0E-06*pCO2_atm) * msmlr_C &
+                   &    * fast_reservoir(ig,ib,ih2o)), zero)  
+                  
+                store_CO2 = store_CO2 - FCO2
+
+                fast_reservoir(ig,ib,idoc)= store_doc                
+                fast_reservoir(ig,ib,iCO2ev) = fast_reservoir(ig,ib,iCO2ev) + FCO2
+                fast_reservoir(ig,ib,iCO2aq) = store_CO2               
+                FCO2_aq(ig,ifastr) = FCO2_aq(ig,ifastr) + FCO2   
+                pCO2_aq_bas(ig,ib,ifastr) = pCO2_wa                 
+             ELSE 
+                fast_reservoir(ig,ib,:) = zero
+             ENDIF !(fast_reservoir(ig,ib,ih2o) .GT. min_sechiba)
+             
+             !! 4.3.2.4 Groundwater (slow reservoir)
+             ! For the slow reservoir, which we assume to present the groundwater reservoir,
+             ! we assume CO2 evasion to be zero. The only process here is the decomposition
+             ! DOC, which fuels the dissolved CO2 storage.
+             IF (slow_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                ! Initializing             
+                decompos  = slow_dec*slow_reservoir(ig,ib,idoc)                    
+                slow_reservoir(ig,ib,idoc)= slow_reservoir(ig,ib,idoc) - decompos                
+                slow_reservoir(ig,ib,iCO2aq) = slow_reservoir(ig,ib,iCO2aq) + decompos   
+                pCO2_aq_bas(ig,ib,islowr) = ((slow_reservoir(ig,ib,iCO2aq) &
+                      &                   / slow_reservoir(ig,ib,ih2o)) &
+                      &                   / msmlr_C) / K_CO2               
+             ELSE 
+                slow_reservoir(ig,ib,:) = zero
+             ENDIF !(slow_reservoir(ig,ib,ih2o) .GT. min_sechiba)                  
+          ENDDO !ib=1,nbasmax 
+          !! 4.3.2.5 Ponds
+          IF (pond_reservoir(ig,ih2o) .GT. min_sechiba) THEN
+             ! Initializing
+             FCO2_ac = zero
+             pCO2_avg = zero               
+             store_CO2 = pond_reservoir(ig,iCO2aq) 
+             store_doc = pond_reservoir(ig,idoc) 
+             decompos  = pond_dec * pond_reservoir(ig,idoc) / nstep_FCO2              
+             ! Outgassing over nstep_FCO2 time segments per day
+             DO istep_FCO2 = 1, nstep_FCO2       
+                pCO2_wa = ((store_CO2 / pond_reservoir(ig,ih2o)) &
+                   &    / msmlr_C) / K_CO2
+                FCO2    = min((K_CO2 * (pCO2_wa - 1.0E-06*pCO2_atm) * msmlr_C*k_pond*totarea(ig) &
+                   &    * pond_frac(ig) * mille/nstep_FCO2), max((K_CO2*(pCO2_wa-1.0E-06*pCO2_atm)&
+                   &    * msmlr_C * pond_reservoir(ig,ih2o)), zero))  
+                FCO2_ac = FCO2_ac + FCO2
+                pCO2_avg = pCO2_avg + pCO2_wa                  
+                store_CO2 = store_CO2 - FCO2 + decompos
+                store_doc = store_doc - decompos    
+             ENDDO !istep_FCO2 = 1, nstep_FCO2  
+             pond_reservoir(ig,idoc)   = store_doc            
+             pond_reservoir(ig,iCO2ev) = pond_reservoir(ig,iCO2ev) + FCO2_ac
+             pond_reservoir(ig,iCO2aq) = store_CO2         
+             FCO2_aq(ig,ipondr)         = FCO2_ac 
+             pCO2_aq(ig,ipondr)         = pCO2_avg / nstep_FCO2              
+          ELSE
+             pond_reservoir(ig,:) = zero
+          ENDIF !(pond_reservoir(ig,ib,ih2o) .GT. min_sechiba)
+       ENDDO !ig=1,nbpt
+       
+       !! 4.4 Aggreagte pCO2 values for flood, stream, fast and slow reservoirs
+       !! per grid box. This is done using the water storage per reservoir and basin as weight.
+       DO ig=1,nbpt
+       
+          pCO2_aggr = zero
+          IF (sum(flood_reservoir(ig,:,ih2o)) .GT. min_sechiba) THEN
+             DO ib=1,nbasmax 
+                !! 4.4.1 Floodplains
+                pCO2_aggr = pCO2_aggr + pCO2_aq_bas(ig,ib,ifloodr)*flood_reservoir(ig,ib,ih2o)
+             ENDDO
+             pCO2_aq(ig,ifloodr) = pCO2_aggr / sum(flood_reservoir(ig,:,ih2o))
+          ELSE
+             ! Do nothing, would be zero from initialization
+          ENDIF !   sum(flood_reservoir(ig,:,ih2o)) .GT. min_sechiba
+          
+          pCO2_aggr = zero
+          IF (sum(stream_reservoir(ig,:,ih2o)) .GT. min_sechiba) THEN
+             DO ib=1,nbasmax 
+                !! 4.4.2 Streams
+                pCO2_aggr = pCO2_aggr + pCO2_aq_bas(ig,ib,istreamr)*stream_reservoir(ig,ib,ih2o)
+             ENDDO
+             pCO2_aq(ig,istreamr) = pCO2_aggr / sum(stream_reservoir(ig,:,ih2o))
+          ELSE
+             ! Do nothing, would be zero from initialization
+          ENDIF !   sum(stream_reservoir(ig,:,ih2o)) .GT. min_sechiba       
+
+          pCO2_aggr = zero
+          IF (sum(fast_reservoir(ig,:,ih2o)) .GT. min_sechiba) THEN
+             DO ib=1,nbasmax 
+                !! 4.4.3 fast reservoir
+                pCO2_aggr = pCO2_aggr + pCO2_aq_bas(ig,ib,ifastr)*fast_reservoir(ig,ib,ih2o)
+             ENDDO
+             pCO2_aq(ig,ifastr) = pCO2_aggr / sum(fast_reservoir(ig,:,ih2o))
+          ELSE
+             ! Do nothing, would be zero from initialization
+          ENDIF !   sum(fast_reservoir(ig,:,ih2o)) .GT. min_sechiba      
+
+          pCO2_aggr = zero
+          IF (sum(slow_reservoir(ig,:,ih2o)) .GT. min_sechiba) THEN
+             DO ib=1,nbasmax 
+                !! 4.4.4 slow reservoir
+                pCO2_aggr = pCO2_aggr + pCO2_aq_bas(ig,ib,islowr)*slow_reservoir(ig,ib,ih2o)
+             ENDDO
+             pCO2_aq(ig,islowr) = pCO2_aggr / sum(slow_reservoir(ig,:,ih2o))
+          ELSE
+             ! Do nothing, would be zero from initialization
+          ENDIF !   sum(slow_reservoir(ig,:,ih2o)) .GT. min_sechiba    
+
+          !! 4.4.5 Pond reservoir
+          !! does not need to be aggreagted, was already calculated per whole grid cell
+       ENDDO !ig=1,nbpt
+       
+       !! 4.5 Recalculate pCO2 from atm to uatm
+       pCO2_aq = pCO2_aq * 1.0E06
+                      
+    ENDIF !ok_doc)   
+    
+    !! 5. Compute the total reinfiltration and returnflow to the grid box
+    !> A term of returnflow is computed including the water from the swamps that does not return 
+    !> directly to the river but will be put into soil moisture (see hydrol module).
+    !> A term of reinfiltration is computed including the water that reinfiltrated from the ponds 
+    !> and floodplains areas. It will be put into soil moisture (see hydrol module).
+    !-
+    IF (do_floodplains .OR. doswamps .OR. doponds) THEN
+       returnflow(:,:) = zero
+       reinfiltration(:,:) = zero
+       
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             ! No loop for species transported, all calculated at the same time
+             ! This will work for dissolved species, as long as similar concentrations in
+             ! infiltrating water and reservoirs are assumed
+             returnflow(ig,:)     = returnflow(ig,:) + return_swamp(ig,ib,:)
+             reinfiltration(ig,:) = reinfiltration(ig,:) + pond_drainage(ig,ib,:) &
+                   &              + flood_drainage(ig,ib,:) 
+          ENDDO !ig=1,nbpt
+       ENDDO !ib=1,nbasmax
+       
+       DO ig=1,nbpt ! This loop is maybe redundant if index 'ig' is replaced by ':'
+          returnflow(ig,:) = returnflow(ig,:)/totarea(ig)
+          reinfiltration(ig,:) = reinfiltration(ig,:)/totarea(ig)
+       ENDDO !ig=1,nbpt
+    ELSE
+       returnflow(:,:) = zero
+       reinfiltration(:,:) = zero
+    ENDIF
+
+    !! 6. Compute the net irrigation requirement from Univ of Kassel
+
+    ! This is a very low priority process and thus only applies if
+    ! there is some water left in the reservoirs after all other things.
+
+!> The computation of the irrigation is performed here.
+!> * First step
+!> In a first time, the water requirements (irrig_netereq) by the crops for their optimal growth 
+!> are calculated over each irrigated fraction (irrigated(ig)/totarea(ig)). It is the difference
+!> between the maximal water loss by the crops (transpot_mean) and the net water amount kept by the 
+!> soil (precipitation and reinfiltration). Transpot_mean is computed in the routines enerbil and 
+!> diffuco. It is derived from the effective transpiration parametrization under stress-free 
+!> conditions, called potential transpiration. Crop_coef was used by a previous parametrization of
+!> irrigation in the code. Here, its value is equal to one. The crop coefficient was constant in 
+!> space and time to represent a mean resistance of the vegetation to the potential evaporation. 
+!> Now, the term crop_coef*Epot is substituted by transpot_mean (see Guimberteau et al., 2011).
+!> * Second step
+!> We compute irrigation needs in order to supply Irrig_netereq. Water for irrigation 
+!> (irrig_actual) is withdrawn from the reservoirs. The amount of water is withdrawn in priority
+!> from the stream reservoir. If the irrigation requirement is higher than the water availability
+!> of the reservoir, water is withdrawn from the fast reservoir or, in the extreme case, from the 
+!> slow reservoir.
+!> * Third step
+!> We compute a deficit in water for irrigation. If it is positive, irrigation (depending on water
+!> availibility in the reservoirs) has not supplied the crops requirements.
+!
+    IF ( do_irrigation ) THEN
+       DO ig=1,nbpt
+          !! 6.1 Compute irrigation requirements
+          IF ((vegtot(ig) .GT. min_sechiba) .AND. (humrel(ig) .LT. un-min_sechiba) .AND. &
+               & (runoff(ig,ih2o) .LT. min_sechiba) ) THEN
+             
+             irrig_netereq(ig) = (irrigated(ig) / totarea(ig) )  & 
+                  &            * MAX(zero, crop_coef * transpot_mean(ig)  & 
+                  &            - (precip(ig,ih2o)+reinfiltration(ig,ih2o)) )
+             
+          ENDIF
+          !! 6.2 Compute irrigation adduction within each basin
+          DO ib=1,nbasmax
+             IF ( routing_area(ig,ib) .GT. 0 ) THEN
+                !! 6.2.1 Water fluxes related to irrigation        
+                irrig_needs(ig,ib) = irrig_netereq(ig) * routing_area(ig,ib)
+                
+                irrig_actual(ig,ib,ih2o) = MIN(irrig_needs(ig,ib),&
+                     &                         stream_reservoir(ig,ib,ih2o) &
+                     &                         + fast_reservoir(ig,ib,ih2o) &
+                     &                         + slow_reservoir(ig,ib,ih2o))
+                
+                IF (ok_doc) THEN
+                    slow_reservoir_prec(:) = slow_reservoir(ig,ib,:) 
+                    fast_reservoir_prec(:) = fast_reservoir(ig,ib,:) 
+                    stream_reservoir_prec(:) = stream_reservoir(ig,ib,:)
+                ENDIF !(ok_doc)
+
+                
+                slow_reservoir(ig,ib,ih2o)   = MAX(zero, slow_reservoir(ig,ib,ih2o) &
+                                         &        + MIN(zero, fast_reservoir(ig,ib,ih2o) &
+                                         &             + MIN(zero, stream_reservoir(ig,ib,ih2o) &
+                                         &                  - irrig_actual(ig,ib,ih2o))))
+
+                fast_reservoir(ig,ib,ih2o)   = MAX(zero, fast_reservoir(ig,ib,ih2o) &
+                                       &          + MIN(zero, stream_reservoir(ig,ib,ih2o) &
+                                       &               - irrig_actual(ig,ib,ih2o)))
+
+                stream_reservoir(ig,ib,ih2o) = MAX(zero, stream_reservoir(ig,ib,ih2o) &
+                                       &          - irrig_actual(ig,ib,ih2o) )
+                
+                !! 6.2.2 Dissolved matter fluxes related to irrigation
+                IF (ok_doc) THEN
+                    IF (slow_reservoir_prec(ih2o) .GT. zero) THEN
+                       slow_reservoir(ig,ib,ih2o+1:nflow) = slow_reservoir(ig,ib,ih2o) &
+                                                        & * slow_reservoir(ig,ib,ih2o+1:nflow) &
+                                                        & / slow_reservoir_prec(ih2o)
+                    ELSE !(slow_reservoir_prec(ih2o) .GT. 0.0)
+                       slow_reservoir(ig,ib,ih2o+1:nflow) = zero
+                    ENDIF !(slow_reservoir_prec(ih2o) .GT. 0.0)
+                    
+                    IF (fast_reservoir_prec(ih2o) .GT. zero) THEN
+                       fast_reservoir(ig,ib,ih2o+1:nflow) = fast_reservoir(ig,ib,ih2o) &
+                                                        & * fast_reservoir(ig,ib,ih2o+1:nflow) &
+                                                        & / fast_reservoir_prec(ih2o)
+                    ELSE !(fast_reservoir_prec(ih2o).GT. 0.0)
+                       fast_reservoir(ig,ib,ih2o+1:nflow) = zero
+                    ENDIF !(fast_reservoir_prec(ih2o).GT. 0.0)                  
+                    
+                    IF (stream_reservoir_prec(ih2o) .GT. zero) THEN
+                       stream_reservoir(ig,ib,ih2o+1:nflow) = stream_reservoir(ig,ib,ih2o) &
+                                                          & * stream_reservoir(ig,ib,ih2o+1:nflow)&
+                                                          & / stream_reservoir_prec(ih2o)
+                    ELSE !(stream_reservoir_prec(ih2o) .GT. 0.0)
+                       stream_reservoir(ig,ib,ih2o+1:nflow) = zero
+                    ENDIF !(stream_reservoir_prec(ih2o) .GT. 0.0)                       
+                    
+                    irrig_actual(ig,ib,ih2o+1:nflow) = (slow_reservoir_prec(ih2o+1:nflow) &
+                                    &                - slow_reservoir(ig,ib,ih2o+1:nflow)) &
+                                    &                + (fast_reservoir_prec(ih2o+1:nflow) &
+                                    &                - fast_reservoir(ig,ib,ih2o+1:nflow)) &
+                                    &                + (stream_reservoir_prec(ih2o+1:nflow) &
+                                    &                - stream_reservoir(ig,ib,ih2o+1:nflow))
+                ENDIF !(ok_doc)
+                !! 6.2.3 Update of irrigation deficit 
+                irrig_deficit(ig,ib) = irrig_needs(ig,ib)-irrig_actual(ig,ib,ih2o)
+             ENDIF !( routing_area(ig,ib) .GT. 0 )
+          ENDDO!ib=1,nbasmax, we are still in the loop for grid boxes
+          
+          !! 6.3 Irrigation between basins within gridbox
+          ! Check if we cannot find the missing water in another basin of the same grid 
+          ! (stream reservoir only). If we find that then we create some adduction from 
+          ! that subbasin to the one where we need it for irrigation.
+          
+          !> If crops water requirements have not been supplied (irrig_deficit>0), we check 
+          !> if we cannot find the missing water in another basin of the same grid. If there 
+          !> is water in the stream reservoir of this subbasin, we create some adduction
+          !> from that subbasin to the one where we need it for irrigation.
+
+          DO ib=1,nbasmax
+
+             stream_tot = SUM(stream_reservoir(ig,:,ih2o))
+
+             DO WHILE ( irrig_deficit(ig,ib) > min_sechiba .AND. stream_tot > min_sechiba)
+                
+                fi = MAXLOC(stream_reservoir(ig,:,ih2o))
+                ib2 = fi(1)
+                !! 6.3.1 Water transfer
+                irrig_adduct(ig,ib,ih2o) = MIN(irrig_deficit(ig,ib), stream_reservoir(ig,ib2,ih2o))
+                IF (ok_doc) THEN
+                    stream_reservoir_prec(:) = stream_reservoir(ig,ib2,:)
+                ENDIF ! (ok_doc)
+                ! the updated stream reservoir has to be calculated firts for water
+                ! from the updated stream water reservoir, the matter transfer with the adduction 
+                ! flux will be calculated
+                stream_reservoir(ig,ib2,ih2o) = stream_reservoir(ig,ib2,ih2o) &
+                                   &          - irrig_adduct(ig,ib,ih2o)
+                
+                !! 6.3.2 Transfer of dissolved matter
+                IF (ok_doc) THEN
+                    IF (stream_reservoir_prec(ih2o) .GT. zero) THEN
+                    irrig_adduct(ig,ib,ih2o+1:nflow) = stream_reservoir(ig,ib2,ih2o+1:nflow) &
+                                                &    * (1-(stream_reservoir(ig,ib2,ih2o) &
+                                                &    / stream_reservoir_prec(ih2o)))
+                    stream_reservoir(ig,ib2,ih2o+1:nflow) = stream_reservoir(ig,ib2,ih2o+1:nflow) &
+                                       &                  - irrig_adduct(ig,ib,ih2o+1:nflow)
+                    ! that means the reservoir is reduced linearly to the reduction in the water 
+                    ! reservoir, the concentration remains the same
+                    ELSE !(stream_reservoir_prec(ih2o) .GT. zero)
+                    stream_reservoir(ig,ib2,ih2o+1:nflow) = zero
+                    irrig_adduct(ig,ib,ih2o+1:nflow) =zero
+                    ENDIF !(stream_reservoir_prec(ih2o) .GT. zero)
+                ENDIF ! OK_DOC
+                !! 6.3.3 Update of irrigation deficit
+                irrig_deficit(ig,ib) = irrig_deficit(ig,ib)-irrig_adduct(ig,ib,ih2o)
+             
+                stream_tot = SUM(stream_reservoir(ig,:,ih2o))
+                
+             ENDDO !WHILE ( irrig_deficit(ig,ib) > min_sechiba .AND. stream_tot > min_sechiba)
+             
+          ENDDO !basins
+          !
+       ENDDO !grid boxes
+       
+       !! 6.4 Irrigation with water from neighbouring grid boxes
+       ! If we are at higher resolution we might need to look at neighboring grid boxes to find 
+       ! the streams which can feed irrigation
+
+       !> At higher resolution (grid box smaller than 100x100km), we can import water from 
+       !> neighboring grid boxes to the one where we need it for irrigation.
+       
+       IF (is_root_prc) THEN
+          ALLOCATE(irrig_deficit_glo(nbp_glo, nbasmax), stream_reservoir_glo(nbp_glo, nbasmax,nflow), &
+               &        irrig_adduct_glo(nbp_glo, nbasmax,nflow), stat=ier)
+       ELSE
+          ALLOCATE(irrig_deficit_glo(0, 0), stream_reservoir_glo(0, 0, 0), &
+               &        irrig_adduct_glo(0, 0, 0), stat=ier)
+       ENDIF
+       IF (ier /= 0) CALL ipslerr_p(3,'routing_flow','Pb in allocate for irrig_deficit_glo, stream_reservoir_glo,...','','')
+
+       CALL gather(irrig_deficit, irrig_deficit_glo)
+       CALL gather(stream_reservoir, stream_reservoir_glo)
+       CALL gather(irrig_adduct, irrig_adduct_glo)
+
+
+       IF (is_root_prc) THEN
+          !
+          DO ig=1,nbp_glo
+             ! Only work if the grid box is smaller than 100x100km. Else the piplines we build
+             ! here would be too long to be reasonable.
+             IF ( resolution_g(ig,1) < 100000. .AND. resolution_g(ig,2) < 100000. ) THEN
+                DO ib=1,nbasmax
+                   !
+                   IF ( irrig_deficit_glo(ig,ib)  > min_sechiba ) THEN
+                      !
+                      DO in=1,8
+                         ig2 = neighbours_g(ig,in)
+                         streams_around(in,:) = stream_reservoir_glo(ig2,:,ih2o)
+                         igrd(in) = ig2
+                      ENDDO
+                      !
+                      ff=MAXLOC(streams_around)
+                      ig2=igrd(ff(1))
+                      ib2=ff(2)
+                      !
+                      IF ( routing_area_glo(ig2,ib2) .GT. zero &
+                         &  .AND. stream_reservoir_glo(ig2,ib2,ih2o) .GT. zero ) THEN
+                         adduction(ih2o) = MIN(irrig_deficit_glo(ig,ib), &
+                              &            stream_reservoir_glo(ig2,ib2,ih2o))
+                         IF (ok_doc) THEN
+                            IF (stream_reservoir_glo(ig2,ib2,ih2o) .GT. zero) THEN
+                            adduction(ih2o+1:nflow) = adduction(ih2o) &
+                                      &             * (stream_reservoir_glo(ig2,ib2,ih2o+1:nflow) &      
+                                      &             / stream_reservoir_glo(ig2,ib2,ih2o))
+                            ELSE !(stream_reservoir_glo(ig2,ib2,ih2o) .GT. zero)
+                            adduction(ih2o+1:nflow) = zero
+                            ENDIF !(stream_reservoir_glo(ig2,ib2,ih2o) .GT. zero)
+                         ENDIF !ok_doc
+                         stream_reservoir_glo(ig2,ib2,:) = stream_reservoir_glo(ig2,ib2,:) &
+                                      &                  - adduction(:)
+
+                         irrig_deficit_glo(ig,ib) = irrig_deficit_glo(ig,ib) - adduction(ih2o)
+                         irrig_adduct_glo(ig,ib,:) = irrig_adduct_glo(ig,ib,:) + adduction(:)
+                      ENDIF !( routing_area_glo(ig2,ib2) .GT. 0 
+                            ! .AND. stream_reservoir_glo(ig2,ib2,ih2o) .GT. zero )
+                      
+                   ENDIF !( irrig_deficit_glo(ig,ib)  > min_sechiba )
+                   
+                ENDDO !ib=1,nbasmax
+             ENDIF !( resolution_g(ig,1) < 100000. .AND. resolution_g(ig,2) < 100000. )
+          ENDDO !ig=1,nbp_glo
+          
+       ENDIF !(is_root_prc)
+
+       CALL scatter(irrig_deficit_glo, irrig_deficit)
+       CALL scatter(stream_reservoir_glo,  stream_reservoir)
+       CALL scatter(irrig_adduct_glo, irrig_adduct)
+
+       DEALLOCATE(irrig_deficit_glo, stream_reservoir_glo, irrig_adduct_glo)
+
+    ENDIF !doirrigation
+
+    !! 7. Compute the fluxes which leave the routing scheme
+    
+    ! Lakeinflow is in Kg/dt
+    ! returnflow is in Kg/m^2/dt
+    !
+    delsurfstor(:)   = -flood_diag(:,ih2o)-pond_diag(:,ih2o)-lake_diag(:,ih2o)
+    hydrographs(:,:) = zero
+    slowflow_diag(:) = zero
+    fast_diag(:,:)   = zero
+    slow_diag(:,:)   = zero
+    stream_diag(:,:) = zero
+    flood_diag(:,:)  =  zero
+    pond_diag(:,:)   =  zero
+    irrigation(:,:)  = zero
+    !
+    !
+    DO ib=1,nbasmax
+       DO ig=1,nbpt
+          IF (hydrodiag(ig,ib,ih2o) > 0 ) THEN
+             hydrographs(ig,:) = hydrographs(ig,:) + fast_flow(ig,ib,:) + slow_flow(ig,ib,:) &
+                           & + stream_flow(ig,ib,:)
+            slowflow_diag(ig) = slowflow_diag(ig) + slow_flow(ig,ib,ih2o)
+          ENDIF ! Maybe something similar for fluvial matter fluxes?
+          fast_diag(ig,:) = fast_diag(ig,:) + fast_reservoir(ig,ib,:)
+          slow_diag(ig,:) = slow_diag(ig,:) + slow_reservoir(ig,ib,:)
+          stream_diag(ig,:) = stream_diag(ig,:) + stream_reservoir(ig,ib,:)
+          flood_diag(ig,:) = flood_diag(ig,:) + flood_reservoir(ig,ib,:)
+          irrigation (ig,:) = irrigation (ig,:) + irrig_actual(ig,ib,:) + irrig_adduct(ig,ib,:)
+       ENDDO !ig=1,nbpt
+    ENDDO !ib=1,nbasmax
+    !
+    DO ig=1,nbpt
+       fast_diag(ig,:) = fast_diag(ig,:)/totarea(ig)
+       slow_diag(ig,:) = slow_diag(ig,:)/totarea(ig)
+       stream_diag(ig,:) = stream_diag(ig,:)/totarea(ig)
+       flood_diag(ig,:) = flood_diag(ig,:)/totarea(ig)
+       pond_diag(ig,:) = pond_reservoir(ig,:)/totarea(ig)
+       
+       irrigation(ig,:) = irrigation(ig,:)/totarea(ig)
+    
+    !! 7.4 Calculate lateral outflows from the river network
+       ! The three output types for the routing : endoheric basins, rivers and 
+       ! diffuse coastal flow.
+       
+       lakeinflow(ig,:) = transport(ig,nbasmax+1,:)
+       coastalflow(ig,:) = transport(ig,nbasmax+2,:)
+       riverflow(ig,:) = transport(ig,nbasmax+3,:)
+    ENDDO !ig=1,nbpt
+    !! 7.5 Sum up water storages in pond and floodplains as input for hydrol module
+    flood_res(:) = flood_diag(:,ih2o) + pond_diag(:,ih2o)
+    
+  END SUBROUTINE routing_flow
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_lake
+!!
+!>\BRIEF        : This subroutine stores water in lakes so that it does not cycle through the runoff.
+!!                For the moment it only works for endoheric lakes but I can be extended in the future.
+!!
+!! DESCRIPTION (definitions, functional, design, flags): The return flow to the soil moisture reservoir
+!! is based on a maximum lake evaporation rate (maxevap_lake). \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_lake(nbpt, dt_routing, lakeinflow, humrel, return_lakes)
+    !
+    IMPLICIT NONE
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                      :: nbpt         !! Domain size (unitless)
+    REAL(r_std), INTENT (in)                        :: dt_routing   !! Routing time step (s)
+    REAL(r_std), INTENT(in), DIMENSION(nbpt,nflow)  :: lakeinflow   !! Water inflow to the lakes 
+                                                                    !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in), DIMENSION(nbpt)        :: humrel       !! Soil moisture stress, root extraction potential (unitless)
+
+    !! 0.2 Output variables 
+    REAL(r_std), INTENT(out), DIMENSION(nbpt,nflow) :: return_lakes !! Water from lakes flowing back into soil moisture 
+                                                                    !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+
+    !! 0.3 Local variables  
+    INTEGER(i_std)                                  :: ig, iflow    !! Indices (unitless)
+    REAL(r_std)                                     :: refill       !! Potential amount of water infiltrating into the lake soil 
+                                                                    !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std)                                     :: total_area   !! Sum of all the surfaces of the basins @tex $(m^2})$ @endtex
+
+ !! 1. Calculate infiltration and update lake reservoir
+    DO ig=1,nbpt
+       
+       total_area = SUM(routing_area(ig,:))
+       !! 1.1 Update lake reservoir with inflows
+       lake_reservoir(ig,:) = lake_reservoir(ig,:) + lakeinflow(ig,:)
+       
+       !! 1.2 Calculate inflitration in lakes (returnflow to soil column)
+       !! 1.2.1 Infiltration of water
+       refill = MAX(zero, maxevap_lake * (un - humrel(ig)) * dt_routing * total_area)
+       return_lakes(ig,ih2o) = MIN(refill, lake_reservoir(ig,ih2o))
+       !! 1.2.2 Infiltration of dissolved matter
+       IF (ok_doc) THEN
+           IF (lake_reservoir(ig,ih2o).GT.0.0) THEN
+                 return_lakes(ig,ih2o+1:nflow)=return_lakes(ig,ih2o) & 
+                                           &  * lake_reservoir(ig,ih2o+1:nflow) &
+                                           &  / lake_reservoir(ig,ih2o)     
+           ELSE !  (lake_reservoir(ig,ih2o).GT.0.0)
+                 return_lakes(ig,ih2o+1:nflow)=zero
+           ENDIF ! (lake_reservoir(ig,ih2o).GT.0.0)
+       ENDIF ! (ok_doc) 
+       !! 1.3 Update of lake reservoir with returnflow
+       lake_reservoir(ig,:) = lake_reservoir(ig,:) - return_lakes(ig,:) 
+       
+       !! 1.4 Scaling returnflow to grid box
+       IF ( doswamps ) THEN
+          return_lakes(ig,:) = return_lakes(ig,:)/total_area
+       ELSE
+          return_lakes(ig,:) = zero
+       ENDIF
+       !! 1.5 Scaling lake reservoir to grid box
+       ! This is the volume of the lake scaled to the entire grid.
+       ! It would be batter to scale it to the size of the lake
+       ! but this information is not yet available.
+       lake_diag(ig,:) = lake_reservoir(ig,:)/total_area
+    
+    ENDDO !ig=1,nbpt
+  END SUBROUTINE routing_lake
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_diagnostic_p
+!!
+!>\BRIEF         This parallelized subroutine gives a diagnostic of the basins used
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_diagnostic_p(nbpt, index, lalo, resolution, contfrac, hist_id, hist2_id)
+    !
+    IMPLICIT NONE
+    
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)      :: nbpt               !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)      :: index(nbpt)        !! Indices of the points on the map (unitless)
+    REAL(r_std), INTENT(in)         :: lalo(nbpt,2)       !! Vector of latitude and longitudes (beware of the order !)
+    REAL(r_std), INTENT(in)         :: resolution(nbpt,2) !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)         :: contfrac(nbpt)     !! Fraction of land in each grid box (unitless;0-1)
+    INTEGER(i_std),INTENT (in)      :: hist_id            !! Access to history file (unitless)
+    INTEGER(i_std),INTENT (in)      :: hist2_id           !! Access to history file 2 (unitless)
+    !
+!! LOCAL VARIABLES
+    REAL(r_std), DIMENSION(nbpt)    :: nbrivers           !! Number of rivers in the grid (unitless)
+    REAL(r_std), DIMENSION(nbpt)    :: basinmap           !! Map of basins (unitless)
+    REAL(r_std), DIMENSION(nbp_glo) :: nbrivers_g         !! Number of rivers in the grid (unitless)
+    REAL(r_std), DIMENSION(nbp_glo) :: basinmap_g         !! Map of basins (unitless)
+
+    routing_area => routing_area_glo  
+    topo_resid => topo_resid_glo
+    route_togrid => route_togrid_glo
+    route_tobasin => route_tobasin_glo
+    route_nbintobas => route_nbintobas_glo
+    global_basinid => global_basinid_glo
+    hydrodiag=>hydrodiag_glo
+    hydroupbasin=>hydroupbasin_glo
+    
+    IF (is_root_prc) CALL routing_diagnostic(nbp_glo, index_g, lalo_g, resolution_g, contfrac_g, nbrivers_g,basinmap_g)
+
+    routing_area => routing_area_loc  
+    topo_resid => topo_resid_loc
+    route_togrid => route_togrid_loc
+    route_tobasin => route_tobasin_loc
+    route_nbintobas => route_nbintobas_loc
+    global_basinid => global_basinid_loc
+    hydrodiag=>hydrodiag_loc
+    hydroupbasin=>hydroupbasin_loc
+    
+    CALL scatter(nbrivers_g,nbrivers)
+    CALL scatter(basinmap_g,basinmap)
+    CALL scatter(hydrodiag_glo,hydrodiag_loc)
+    CALL scatter(hydroupbasin_glo,hydroupbasin_loc)
+       
+    CALL xios_orchidee_send_field("basinmap",basinmap)
+    CALL xios_orchidee_send_field("nbrivers",nbrivers)
+
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite(hist_id, 'basinmap', 1, basinmap, nbpt, index)
+       CALL histwrite(hist_id, 'nbrivers', 1, nbrivers, nbpt, index)
+    ELSE
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite(hist2_id, 'basinmap', 1, basinmap, nbpt, index)
+          CALL histwrite(hist2_id, 'nbrivers', 1, nbrivers, nbpt, index)
+       ELSE
+       ENDIF
+    ENDIF
+    
+        
+  END SUBROUTINE routing_diagnostic_p
+
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_diagnostic
+!!
+!>\BRIEF         This non-parallelized subroutine gives a diagnostic of the basins used. This produces some information 
+!!               on the rivers which are being diagnosed.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : As not all rivers can be monitored in the model, we will only
+!! archive num_largest rivers. In this routine we will diagnose the num_largest largest rivers and print to the standard
+!! output the names of these basins and their area. The list of names of these largest rivers are taken from a list coded in the 
+!! routine routing_names. As this standard output is not sufficient, we will also write it to a netCDF file with the routine 
+!! routing_diagncfile. It is important to keep for diagnostic the fraction of the largest basins in each grid box and keep information
+!! how they are linked one to the other.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): No output variables.
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_diagnostic(nbpt, l_index, lalo, resolution, contfrac, nbrivers, basinmap)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                   :: nbpt                !! Domain size  (unitless)
+    INTEGER(i_std), INTENT(in)                   :: l_index(nbpt)       !! Indices of the points on the map (unitless)
+    REAL(r_std), INTENT(in)                      :: lalo(nbpt,2)        !! Vector of latitude and longitudes (beware of the order !) 
+    REAL(r_std), INTENT(in)                      :: resolution(nbpt,2)  !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)                      :: contfrac(nbpt)      !! Fraction of land in each grid box (unitless;0-1)
+    !
+!! OUTPUT VARIABLES
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)    :: nbrivers            !! Number of rivers in the grid (unitless)
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)    :: basinmap            !! Map of basins (unitless)
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std), DIMENSION(nbpt,nbasmax)      :: outids              !! IDs of river to which this basin contributes (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: pts                 !! List the points belonging to the basin (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: ptbas               !! List the basin number for this point (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: outpt               !! Outflow point for each basin (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)    :: nb_pts              !! Number of points in the basin (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: totarea             !! Total area of basin @tex $(m^2})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: tmparea             !! 
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)    :: topids              !! The IDs of the first num_largest basins (unitless)
+    CHARACTER(LEN=25), ALLOCATABLE, DIMENSION(:) :: basin_names         !! Names of the rivers (unitless)
+    CHARACTER(LEN=25)                            :: name_str            !!
+    !
+    LOGICAL                                      :: river_file          !! Choose to write a description of the rivers (true/false)
+    CHARACTER(LEN=80)                            :: river_file_name     !! Filename in which we write the description of the rivers (unitless)
+    !
+    CHARACTER(LEN=25), ALLOCATABLE, DIMENSION(:)  :: sorted_names       !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: streams_nb         !! Number of streams in basin (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: streams_avehops    !! Average number of hops in streams (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: streams_minhops    !! Minimum number of hops in streams (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: streams_maxhops    !! Minimum number of hops in streams (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)        :: streams_resid      !! Average residence time
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lbasin_area        !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lbasin_uparea      !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: lrivercode         !!
+    !
+    INTEGER(i_std)                                :: ig, ib, og, ob, ign, ibn, ff(1), ic, icc, nb_small, idbas, slen, ii !! Indices (unitless)
+    INTEGER(i_std)                                :: ier                !! Error handling
+    CHARACTER(LEN=1)                              :: nn                 !!
+    INTEGER(i_std)                                :: name_found         !!
+    !
+    REAL(r_std)                                   :: averesid           !!
+    REAL(r_std), DIMENSION(nbasmax)               :: tmpbas             !!
+    REAL(r_std), DIMENSION(nbpt,nbasmax)          :: areaupbasin        !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: sortedrivs         !!
+    !
+    ! Variables for the river coding
+    !
+    INTEGER(i_std)                               :: longest_river       !!
+    INTEGER(i_std)                               :: nbmax               !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: allstreams          !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: upstreamchange      !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)    :: tstreams, tslen, tpts, tptbas, tcode !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: tuparea             !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: tupstreamchange     !!
+    !
+    LOGICAL                                      :: err_nbpt_grid_basin !! (true/false)
+    LOGICAL                                      :: err_basin_number    !! (true/false)
+    !
+    !
+    ALLOCATE(sortedrivs(num_largest))
+    ALLOCATE(sorted_names(num_largest))
+    ALLOCATE(streams_nb(num_largest), streams_avehops(num_largest), streams_minhops(num_largest))
+    ALLOCATE(streams_maxhops(num_largest))
+    ALLOCATE(streams_resid(num_largest))
+    !
+    ALLOCATE(pts(num_largest, nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for pts','','')
+
+    ALLOCATE(ptbas(num_largest, nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for ptbas','','')
+
+    ALLOCATE(outpt(num_largest, 2), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for outpt','','')
+
+    ALLOCATE(nb_pts(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for nb_pts','','')
+
+    ALLOCATE(totarea(num_largest), tmparea(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for totarea','','')
+
+    ALLOCATE(topids(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for topids','','')
+
+    ALLOCATE(sortedrivs(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for sortedrivs','','')
+
+    ALLOCATE(sorted_names(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for sorted_names','','')
+
+    ALLOCATE(streams_nb(num_largest), streams_avehops(num_largest), streams_minhops(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for streams_nb','','')
+
+    ALLOCATE(streams_maxhops(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for streams_maxhops','','')
+
+    ALLOCATE(streams_resid(num_largest), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for streams_resid','','')
+    
+    ALLOCATE(lbasin_area(num_largest,nbpt), lbasin_uparea(num_largest,nbpt), lrivercode(num_largest,nbpt), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for lbasin_area','','')
+    
+    IF ( .NOT. is_root_prc) THEN
+       WRITE(numout,*) "routing_diagnostic is not suitable for running in parallel"
+       WRITE(numout,*) "We are here on a non root processor. is_root_prc = ", is_root_prc
+       WRITE(numout,*) "STOP from routing_diagnostic"
+       CALL ipslerr_p(3,'routing_diagnostic','This routine is not suitable for running in parallel','','')
+    ENDIF
+    
+    
+    !Config Key   = RIVER_DESC
+    !Config Desc  = Writes out a description of the rivers
+    !Config If    = RIVER_ROUTING
+    !Config Def   = n
+    !Config Help  = This flag allows to write out a file containing the list of 
+    !Config         rivers which are beeing simulated. It provides location of outflow
+    !Config         drainage area, name and ID.
+    !Config Units = [FLAG]
+    !
+    river_file=.FALSE.
+    CALL getin('RIVER_DESC', river_file)
+    !
+    !Config Key   = RIVER_DESC_FILE
+    !Config Desc  = Filename in which we write the description of the rivers. If suffix is ".nc" a netCDF file is created
+    !Config If    = RIVER_DESC
+    !Config Def   = river_desc.nc
+    !Config Help  = File name where we will write the information. If the suffix is ".nc" a netCDF file is generated. Else
+    !Config         a simple text file will contain some information. The netCDF file is valuable for post-processing the
+    !               data as it will contain the fraction of the large basins in each grid box.
+    !Config Units = [FILE]
+    !
+    river_file_name="river_desc.nc"
+    CALL getin('RIVER_DESC_FILE', river_file_name)
+    !
+    !
+    ! First we get the list of all river outflow points
+    ! We work under the assumption that we only have num_largest basins finishing with
+    ! nbasmax+3. This is checked in routing_truncate.
+    !
+    nb_small = 1
+    outpt(:,:) = -1
+    ic = 0
+    DO ig=1,nbpt
+       DO ib=1,nbasmax
+          ign = route_togrid(ig, ib)
+          ibn = route_tobasin(ig, ib)
+          IF ( ibn .EQ. nbasmax+3) THEN
+             ic = ic + 1
+             outpt(ic,1) = ig
+             outpt(ic,2) = ib
+             !
+             ! Get the largest id of the basins we call a river. This is
+             ! to extract the names of all rivers.
+             !
+             IF ( global_basinid(ig,ib) > nb_small ) THEN
+                nb_small = global_basinid(ig,ib)
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    
+    nb_small = MIN(nb_small, 349)
+    
+    ALLOCATE(basin_names(nb_small), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for basins_names','','')
+
+    CALL routing_names(nb_small, basin_names)
+    !
+    ! Go through all points and basins to see if they outflow as a river and store the
+    ! information needed in the various arrays.
+    !
+    nb_pts(:) = 0
+    totarea(:) = zero
+    hydrodiag(:,:,:) = 0
+    areaupbasin(:,:) = zero
+    outids(:,:) = -1
+    ob = -1
+    og = -1
+    lbasin_area(:,:) = zero
+    lbasin_uparea(:,:) = zero
+    longest_river = 0
+    !
+    err_nbpt_grid_basin = .FALSE.
+    loopgridbasin : DO ig=1,nbpt
+       !
+       DO ib=1,nbasmax
+          IF ( routing_area(ig,ib) .GT. zero ) THEN
+             ic = 0
+             ign = ig
+             ibn = ib
+             ! Locate outflow point
+             DO WHILE (ibn .GT. 0 .AND. ibn .LE. nbasmax .AND. ic .LT. nbasmax*nbpt)
+                ic = ic + 1
+                og = ign
+                ob = ibn
+                ign = route_togrid(og, ob)
+                ibn = route_tobasin(og, ob)
+                areaupbasin(og, ob) = areaupbasin(og, ob) + routing_area(ig,ib)
+             ENDDO
+             !
+             longest_river = MAX(longest_river, ic)
+             !
+             ! Now that we have an outflow check if it is one of the num_largest rivers. 
+             ! In this case we keeps the location so we diagnose it.
+             !
+             IF ( ibn .EQ. nbasmax + 3) THEN
+                DO icc = 1,num_largest
+                   IF ( outpt(icc,1) .EQ. og .AND. outpt(icc,2) .EQ. ob ) THEN
+                      !
+                      ! We only keep this point for our map if it is large enough.
+                      !
+                      nb_pts(icc) = nb_pts(icc) + 1
+                      !
+                      !
+                      IF ( nb_pts(icc) > nbpt ) THEN
+                         err_nbpt_grid_basin = .TRUE.
+                         EXIT loopgridbasin
+                      ENDIF
+                      !
+                      pts(icc, nb_pts(icc)) = ig
+                      ptbas(icc, nb_pts(icc)) = ib
+                      totarea(icc) = totarea(icc) + routing_area(ig,ib)
+                      !
+                      lbasin_area(icc,nb_pts(icc)) = routing_area(ig,ib)
+                      !
+                      ! ID of the river is taken from the last point before the outflow.
+                      topids(icc) = global_basinid(og,ob)
+                      outids(ig,ib) = global_basinid(og,ob)
+                      !
+                      ! On this gridbox and basin we will diagnose the hydrograph
+                      !
+                      hydrodiag(ig, ib, :) = 1
+                      !
+                   ENDIF
+                ENDDO
+             ENDIF
+          ENDIF
+          !
+       ENDDO
+       !
+    ENDDO loopgridbasin
+    !
+    IF ( err_nbpt_grid_basin ) THEN
+       WRITE(numout, *) "routing_diagnostic : The number of grid points in basin ", icc
+       WRITE(numout, *) "routing_diagnostic : is larger than anticiped. "
+       CALL ipslerr(3, 'routing_diagnostic', 'We are heading for a out of bounds in arrays pts, ptsbas and lbasin_area.',&
+                     & 'Increase the last dimension of these arrays.','')
+    ENDIF
+    !
+    ! Now we decide which points we will keep from the largest basins
+    !
+    ! Temporary fix
+    route_nbintobas(:,:) = 0
+    !
+    basinmap(:) = zero
+    DO ig=1,nbpt
+       !
+       ! Look for the dominant basin in this grid. This information only affects some
+       ! diagnostics : hydrographs and saved area upstream.
+       !
+       icc = 0
+       idbas = -1
+       !
+       DO ib=1,nbasmax
+          IF ( outids(ig,ib) > 0 ) THEN
+             IF ( COUNT(outids(ig,:) == outids(ig,ib)) > icc ) THEN
+                icc = COUNT(outids(ig,:) == outids(ig,ib))
+                idbas = outids(ig,ib)
+             ENDIF
+          ENDIF
+       ENDDO
+       !
+       ! If we have found a point from the large basins and decided which one
+       ! takes over this grid then we note it on the map.
+       ! Clean-up a little the hydrodiag array
+       !
+       IF ( idbas > 0 ) THEN
+          basinmap(ig) = REAL(idbas, r_std)
+       ENDIF
+       !
+       ! Now place the hydrograph diagnostic on the point closest to the
+       ! ocean.
+       !
+       tmpbas(:) = zero
+       DO ib=1,nbasmax
+          IF ( outids(ig,ib) .EQ. idbas) THEN
+             tmpbas(ib) = areaupbasin(ig,ib)
+          ENDIF
+       ENDDO
+       hydrodiag(ig,:,:) = 0
+       ff=MAXLOC(tmpbas)
+       hydrodiag(ig,ff(1),:) = 1
+       hydroupbasin(ig) = areaupbasin(ig,ff(1))
+       !
+    ENDDO
+    !
+    !
+    !
+    tmparea(:) = totarea(:)
+    DO icc = 1, num_largest
+       ff = MAXLOC(tmparea)
+       sortedrivs(icc) = ff(1)
+       tmparea(ff(1)) = 0.0
+    ENDDO
+    !
+    ! Diagnose the complexity of the basins obtained and determine their code in the Pfafstetter system
+    !
+    nbmax=MAXVAL(nb_pts)
+    ALLOCATE(allstreams(nbmax, longest_river), upstreamchange(nbmax, longest_river), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for allstreams','','')
+
+    ALLOCATE(tstreams(longest_river), tupstreamchange(longest_river), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for tstreams','','')
+
+    ALLOCATE(tslen(nbmax), tpts(nbmax), tptbas(nbmax), tuparea(nbmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for tslen','','')
+
+    ALLOCATE(tcode(nbmax), stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'routing_diagnostic','Pb in allocate for tcode','','')
+
+    DO icc = 1, num_largest
+       !
+       ! Work through the largest basins
+       !
+       idbas = sortedrivs(icc)
+       !
+       streams_nb(idbas) = 0
+       streams_avehops(idbas) = 0
+       streams_minhops(idbas) = undef_int
+       streams_maxhops(idbas) = 0
+       streams_resid(idbas) = zero
+       tslen(:) = 0
+       !
+       allstreams(:,:) = 0
+       upstreamchange(:,:) = zero
+       !
+       DO ii=1,nb_pts(idbas)
+          !
+          ig = pts(idbas, ii)
+          ib = ptbas(idbas, ii)
+          !
+          lbasin_uparea(idbas,ii) = areaupbasin(ig,ib)
+          !
+          slen = 0
+          ign = ig
+          ibn = ib
+          og = ig
+          ob = ib
+          !
+          averesid = zero
+          tupstreamchange(:) = zero
+          ! go to outflow point to count the number of hops
+          DO WHILE (ibn .GT. 0 .AND. ibn .LE. nbasmax)
+             ! Store data
+             slen = slen + 1
+             tstreams(slen) = ign
+             tupstreamchange(slen) = areaupbasin(ign,ibn)-areaupbasin(og,ob)
+             ! Move to next point
+             og = ign
+             ob = ibn
+             ign = route_togrid(og, ob)
+             ibn = route_tobasin(og, ob)
+             averesid = averesid + topo_resid(og, ob)**2
+          ENDDO
+          !
+          allstreams(ii,1:slen) = tstreams(slen:1:-1)
+          upstreamchange(ii,1:slen) = tupstreamchange(slen:1:-1)
+          tslen(ii) = slen
+          !
+          ! Save diagnostics
+          !
+          streams_nb(idbas) = streams_nb(idbas) + 1
+          streams_avehops(idbas) = streams_avehops(idbas) + slen
+          streams_resid(idbas) = streams_resid(idbas) + SQRT(averesid)
+          IF ( slen < streams_minhops(idbas) ) THEN
+             streams_minhops(idbas) = slen
+          ENDIF
+          IF ( slen > streams_maxhops(idbas) ) THEN
+             streams_maxhops(idbas) = slen
+          ENDIF
+          !
+       ENDDO
+       ! build the average
+       IF ( streams_nb(idbas) > 0 ) THEN
+          streams_avehops(idbas) = streams_avehops(idbas)/streams_nb(idbas)
+          streams_resid(idbas) = streams_resid(idbas)/REAL(streams_nb(idbas), r_std)
+       ELSE
+          ! River without streams ... very rare but happens
+          streams_avehops(idbas) = zero
+          streams_resid(idbas) = zero
+          streams_maxhops(idbas) = zero
+          streams_minhops(idbas) = zero
+       ENDIF
+       !
+       !
+       ii=nb_pts(idbas)
+       tpts(:) = 0
+       tpts(1:ii) = pts(idbas,1:ii)
+       tptbas(:) = 0
+       tptbas(1:ii) = ptbas(idbas,1:ii)
+       tuparea(:) = 0
+       tuparea(1:ii) = lbasin_uparea(idbas,1:ii)
+       !
+       CALL routing_diagcode(ii, tpts, tptbas, tuparea, tslen, MAXVAL(tslen), allstreams, upstreamchange, tcode)  
+       !
+       lrivercode(idbas,:) = 0
+       lrivercode(idbas,1:ii) = tcode(1:ii)
+       !
+    ENDDO
+    !
+    ! Create the sorted list of names
+    !
+    err_basin_number = .FALSE.
+    DO icc = 1, num_largest
+       !
+       ib=sortedrivs(icc)
+       !
+       IF ( topids(ib) .GT. nb_small ) THEN
+          IF (topids(ib) <= 99 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I2.2)') topids(ib)
+          ELSE IF (topids(ib) <= 999 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I3.3)') topids(ib)
+          ELSE IF (topids(ib) <= 9999 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I4.4)') topids(ib)
+          ELSE IF (topids(ib) <= 99999 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I5.5)') topids(ib)
+          ELSE IF (topids(ib) <= 999999 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I6.6)') topids(ib)
+          ELSE
+             err_basin_number = .TRUE.
+             EXIT
+          ENDIF
+
+       ELSE
+          sorted_names(icc) = basin_names(topids(ib))
+       ENDIF
+       !
+    ENDDO
+    !
+    IF ( err_basin_number ) THEN
+       CALL ipslerr(3, 'routing_diagnostic', 'We found a basin number larger than 999999.',&
+            & 'This is impossible. Please verify your configuration.','')
+    ENDIF
+    !
+    ! Check for doubles and rename if needed
+    !
+    DO icc = 1, num_largest
+       name_found=0
+       DO ic=1, num_largest
+          IF ( TRIM(sorted_names(icc)) == TRIM(sorted_names(ic)) ) THEN
+             name_found = name_found + 1
+          ENDIF
+       ENDDO
+       !
+       IF ( name_found > 1 ) THEN
+          DO ic=num_largest,1,-1
+             IF ( TRIM(sorted_names(icc)) == TRIM(sorted_names(ic)) ) THEN
+                IF ( name_found > 1 ) THEN
+                   WRITE(nn,'(I2)')  name_found
+                   IF (name_found < 10) nn(1:1) = '0'
+                   sorted_names(ic) = TRIM(sorted_names(ic))//nn
+                   name_found = name_found - 1
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDIF
+       !
+    ENDDO
+    !
+    ! Print to stdout on ROOT_PROC the diagnostics for the largest basins we have found.
+    !
+    DO icc = 1, num_largest
+       !
+       IF ( nb_pts(sortedrivs(icc)) .GT. 2 ) THEN
+          name_str = sorted_names(icc)
+          WRITE(numout,'("Basin ID ", I5," ", A15, " Area [km^2] : ", F13.4, " Nb points : ", I4)')&
+               & topids(sortedrivs(icc)), name_str(1:15), totarea(sortedrivs(icc))/1.e6,  nb_pts(sortedrivs(icc))
+          ENDIF
+          !
+    ENDDO
+    !
+    ! Save some of the basin information into files.
+    !
+    IF ( river_file ) THEN
+
+       IF ( INDEX(river_file_name,".nc") > 1 ) THEN
+
+          CALL routing_diagncfile(river_file_name, nbpt, lalo, nb_pts, topids, sorted_names, sortedrivs, &
+               &                  pts, lbasin_area, lbasin_uparea, lrivercode, outpt, streams_nb, streams_avehops, &
+               &                  streams_minhops, streams_maxhops, streams_resid)
+
+       ELSE
+
+          OPEN(diagunit, FILE=river_file_name)
+          WRITE(diagunit,'(A)') "Basin ID, Area [km^2], Nb points, Lon and Lat of outflow"
+          WRITE(diagunit,'(A)') "Nb streams, total number of hops, min, ave and max number of hops per stream"
+          !
+          DO icc = 1, num_largest
+             !
+             IF ( nb_pts(sortedrivs(icc)) .GT. 2 ) THEN
+                !
+                name_str = sorted_names(icc)
+                !
+                WRITE(diagunit,'(I5,A25,F14.5,I5,2F9.2)') topids(sortedrivs(icc)), name_str(1:15), totarea(sortedrivs(icc))/1.e6, &
+                     &    nb_pts(sortedrivs(icc)), lalo(outpt(sortedrivs(icc),1),2), lalo(outpt(sortedrivs(icc),1),1)
+                WRITE(diagunit,'(5I9,F16.4)') streams_nb(sortedrivs(icc)), &
+                     & streams_avehops(sortedrivs(icc))*streams_nb(sortedrivs(icc)), &
+                     & streams_minhops(sortedrivs(icc)), &
+                     & streams_avehops(sortedrivs(icc)), &
+                     & streams_maxhops(sortedrivs(icc)), streams_resid(sortedrivs(icc))
+                !
+             ENDIF
+             !
+          ENDDO
+          !
+          CLOSE(diagunit)
+          !
+       ENDIF
+       !
+    ENDIF
+    !
+    !
+    nbrivers(:) = zero
+    DO ig=1,nbpt
+       nbrivers(ig) = COUNT(route_tobasin(ig,1:nbasmax) == nbasmax+3)
+    ENDDO
+    DO ig=1,nbpt
+       IF ( nbrivers(ig) > 1 ) THEN
+          WRITE(numout,*) 'Grid box ', ig, ' has ', NINT(nbrivers(ig)), ' outflow points.'
+          WRITE(numout,*) 'The rivers which flow into the ocean at this point are :'
+          DO icc=1,nbasmax
+             IF ( route_tobasin(ig,icc) == nbasmax+3) THEN
+                IF ( global_basinid(ig,icc) <= nb_small ) THEN
+                   WRITE(numout,*) 'ID = ',global_basinid(ig,icc), ' Name = ', basin_names(global_basinid(ig,icc))
+                ELSE
+                   WRITE(numout,*) 'ID = ',global_basinid(ig,icc), ' Problem ===== ID is larger than possible'
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDIF
+    ENDDO
+    !
+    WRITE(numout,*) 'Maximum topographic index :', MAXVAL(topo_resid)
+    ic = COUNT(topo_resid .GT. 0.)
+    WRITE(numout,*) 'Mean topographic index :', SUM(topo_resid, MASK=topo_resid .GT. zero)/ic
+    WRITE(numout,*) 'Minimum topographic index :', MINVAL(topo_resid, MASK=topo_resid .GT. zero)
+    !
+    DEALLOCATE(pts)
+    DEALLOCATE(outpt)
+    DEALLOCATE(nb_pts)
+    DEALLOCATE(totarea, tmparea)
+    DEALLOCATE(streams_nb, streams_avehops, streams_minhops, streams_maxhops)
+    !
+    DEALLOCATE(lbasin_area, lbasin_uparea, lrivercode)
+    !
+    DEALLOCATE(allstreams)
+    DEALLOCATE(tstreams)
+    DEALLOCATE(tslen, tpts, tptbas, tuparea)
+    DEALLOCATE(tcode)
+    !
+    WRITE(numout,*) 'Maximum topographic index :', MAXVAL(topo_resid)
+    ic = COUNT(topo_resid .GT. 0.)
+    WRITE(numout,*) 'Mean topographic index :', SUM(topo_resid, MASK=topo_resid .GT. 0.)/ic
+    WRITE(numout,*) 'Minimum topographic index :', MINVAL(topo_resid, MASK=topo_resid .GT. 0.)
+    !
+    !
+  END SUBROUTINE routing_diagnostic
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_diagcode
+!!
+!>\BRIEF       This subroutine determines the code in the Pfafstetter system for all points
+!!              within the given catchment.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): streamcode
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_diagcode(ip, tpts, tpbas, tuparea, tslen, ls, allstreams, upstreamchange, streamcode)  
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                   :: ip             !!
+    INTEGER(i_std), INTENT(in)                   :: ls             !!
+    INTEGER(i_std), DIMENSION(ip), INTENT(in)    :: tpts           !!
+    INTEGER(i_std), DIMENSION(ip), INTENT(in)    :: tpbas          !!
+    REAL(r_std), DIMENSION(ip), INTENT(in)       :: tuparea        !!
+    INTEGER(i_std), DIMENSION(ip), INTENT(in)    :: tslen          !!
+    INTEGER(i_std), DIMENSION(ip,ls), INTENT(in) :: allstreams     !!
+    REAL(r_std), DIMENSION(ip,ls), INTENT(in)    :: upstreamchange !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), DIMENSION(ip), INTENT(out)   :: streamcode     !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                               :: ilev, cntsubbas, ib, ic, i, it, ilevmax, imaxlen, nbzero !!
+    INTEGER(i_std)                               :: tstreamcode(ip)!!
+    INTEGER(i_std)                               :: indsubbas(ip)  !!
+    INTEGER(i_std)                               :: iw(ip)         !!
+    INTEGER(i_std)                               :: tdiff(ip)      !!
+    INTEGER(i_std)                               :: tmpjunc(4)     !!
+    INTEGER(i_std)                               :: junction(4)    !!
+    INTEGER(i_std)                               :: ff(1)          !!
+    INTEGER(i_std)                               :: ll             !!
+    REAL(r_std)                                  :: chguparea(ip)  !!
+    REAL(r_std)                                  :: largest        !!
+    !
+    streamcode(:) = 0
+    !
+    ! If we accept 4 grid boxes per coded basin then per level we need at least
+    ! 4*9=36 boxes.
+    !
+    ilevmax = 0
+    it = ip
+    DO WHILE (it >= 36)
+       ilevmax = ilevmax+1
+       it = it/9
+    ENDDO
+    !
+    DO ilev=1,ilevmax
+       !
+       ! Count number of sub-basins we already have
+       !
+       cntsubbas=0
+       tstreamcode(:) = streamcode(:)
+       DO WHILE ( COUNT(tstreamcode(:) >= 0) > 0 )
+         cntsubbas=cntsubbas+1
+         indsubbas(cntsubbas) = MAXVAL(tstreamcode(:))
+         WHERE ( tstreamcode(:) == indsubbas(cntsubbas) ) tstreamcode = -1
+       ENDDO
+       !
+       ! Go through all these basins in order to find the next Pfafstetter numbers
+       !
+       DO ib=1,cntsubbas
+          !
+          ! Get all the streams which have the current Pfadstetter number
+          !
+          it=0
+          DO ic=1,ip
+             IF ( streamcode(ic) == indsubbas(ib) ) THEN
+                it =it+1
+                iw(it)=ic 
+             ENDIF
+          ENDDO
+          !
+          ! Which is the longest stream in this basin ?
+          !
+          ff=MAXLOC(tslen(iw(1:it)))
+          imaxlen=iw(ff(1))
+          chguparea(:) = zero
+          chguparea(1:tslen(imaxlen)) = upstreamchange(imaxlen, 1:tslen(imaxlen))
+          !
+          IF ( COUNT(chguparea(1:tslen(imaxlen)) > 0) < 4 ) THEN
+             !
+             ! If this subbasin is too small we just set all points to zero
+             !
+             DO i=1,it
+                streamcode(iw(i)) = streamcode(iw(i))*10
+             ENDDO
+          ELSE
+             ! 
+             ! Else do the Pfafstetter numbering
+             ! 
+             !
+             ! Where do we have the 4 largest change in upstream area on this stream.
+             ! This must be the confluence of 2 rivers and thus a junction point.
+             !
+             largest=pi*R_Earth*R_Earth
+             DO i=1,4
+                ff = MAXLOC(chguparea(1:tslen(imaxlen)), MASK = chguparea(1:tslen(imaxlen)) < largest)
+                tmpjunc(i) = ff(1)
+                largest=chguparea(tmpjunc(i))
+             ENDDO
+             ! sort junctions to go from the outflow up-stream
+             ff(1)=0
+             DO i=1,4
+                junction(i) = MINVAL(tmpjunc, MASK=tmpjunc > ff(1))
+                ff(1) = junction(i)
+             ENDDO
+             !
+             ! Find all streams which are identical up to that junction and increase their code accordingly 
+             !
+             DO i=1,it
+                ll=MIN(tslen(imaxlen),tslen(iw(i)))
+                tdiff(1:ll) = allstreams(imaxlen,1:ll)-allstreams(iw(i),1:ll)
+                nbzero = COUNT(tdiff(1:ll) == 0)
+                IF (nbzero < junction(1) ) THEN
+                   ! Before first of the 4 largest basins
+                   streamcode(iw(i)) = streamcode(iw(i))*10+1
+                ELSE IF (nbzero == junction(1) ) THEN
+                   ! Stream part of the first largest basin
+                   streamcode(iw(i)) = streamcode(iw(i))*10+2
+                ELSE IF (nbzero < junction(2) ) THEN
+                   ! Between first and second stream
+                   streamcode(iw(i)) = streamcode(iw(i))*10+3
+                ELSE IF (nbzero == junction(2) ) THEN
+                   ! Stream part of the second basin
+                   streamcode(iw(i)) = streamcode(iw(i))*10+4
+                ELSE IF (nbzero < junction(3) ) THEN
+                   ! In between stream 2 and 3
+                   streamcode(iw(i)) = streamcode(iw(i))*10+5
+                ELSE IF (nbzero == junction(3) ) THEN
+                   ! Part of 3rd basin
+                   streamcode(iw(i)) = streamcode(iw(i))*10+6
+                ELSE IF (nbzero < junction(4) ) THEN
+                   ! In between 3 and 4th basins
+                   streamcode(iw(i)) = streamcode(iw(i))*10+7
+                ELSE IF (nbzero == junction(4) ) THEN
+                   ! Final of the 4 largest basins
+                   streamcode(iw(i)) = streamcode(iw(i))*10+8
+                ELSE
+                   ! The rest of the points and also the basin of the longest stream
+                   streamcode(iw(i)) = streamcode(iw(i))*10+9
+                ENDIF
+             ENDDO
+          ENDIF
+       ENDDO
+       !
+    ENDDO
+    !
+    !
+  END SUBROUTINE routing_diagcode
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_diagncfile
+!!
+!>\BRIEF         This subroutine creates a netCDF file containing all the informations
+!!                on the largest rivers which can be used for a refined analysis. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_diagncfile(river_file_name, nbpt, lalo, nb_pts, topids, sorted_names, sortedrivs, &
+       &       lbasin_index, lbasin_area, lbasin_uparea, lrivercode, outpt, streams_nb, streams_avehops, &
+       &       streams_minhops, streams_maxhops, streams_resid)
+    !
+    USE netcdf
+    !
+    IMPLICIT NONE
+    !
+    !
+!! INPUT VARIABLES
+    REAL(r_std), INTENT(in)                     :: lalo(nbpt,2)             !! Vector of latitude and longitudes (beware of the order !)
+
+!! LOCAL VARIABLES
+    CHARACTER(LEN=80)                           :: river_file_name          !! Filename in which we write the description of the rivers (1)
+    INTEGER(i_std)                              :: nbpt                     !! Domain size  (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: nb_pts                   !! Number of points in the basin (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: topids                   !! The IDs of the first num_largest basins (unitless)
+    CHARACTER(LEN=25), DIMENSION(num_largest)   :: sorted_names             !! Names of the basins to be put into the file (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: sortedrivs               !!
+    INTEGER(i_std), DIMENSION(num_largest,nbpt) :: lbasin_index             !!
+    REAL(r_std), DIMENSION(num_largest,nbpt)    :: lbasin_area              !!
+    REAL(r_std), DIMENSION(num_largest,nbpt)    :: lbasin_uparea            !!
+    INTEGER(i_std), DIMENSION(num_largest,nbpt) :: lrivercode               !!
+    !
+    INTEGER(i_std), DIMENSION(num_largest,2)    :: outpt                    !! Outflow point for each basin (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: streams_nb               !! Number of streams in basin (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: streams_avehops          !! Average number of hops in streams (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: streams_minhops          !! Minimum number of hops in streams (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: streams_maxhops          !! Minimum number of hops in streams (unitless)
+    REAL(r_std), DIMENSION(num_largest)         :: streams_resid            !! Average residence time
+    !
+    INTEGER(i_std)                              :: icc, fid, iret, ierr_tot, ib, ij, ik, i, j, lcc !! Indices (unitless)
+    INTEGER(i_std)                              :: nlonid, nlatid, varid, varid2, varid3
+    INTEGER(i_std)                              :: dims(2)                  !!
+    REAL(r_std)                                 :: lon_min, lon_max, lat_min, lat_max
+    CHARACTER(LEN=80)                           :: lon_name, lat_name, var_name, long_name, nc_name, att_str
+    CHARACTER(LEN=15)                           :: gridtype                 !!
+    !
+    REAL(r_std)                                 :: basinfrac(iim_g,jjm_g)   !!
+    REAL(r_std)                                 :: basinuparea(iim_g,jjm_g) !!
+    INTEGER(i_std)                              :: basincode(iim_g,jjm_g)   !!
+    !
+    LOGICAL                                     :: check=.FALSE.            !! (true/false)
+    !
+!! PARAMETERS
+    INTEGER(i_std),PARAMETER                    :: kind_r_diag=NF90_REAL8   !!
+    INTEGER(i_std),PARAMETER                    :: kind_i_diag=NF90_INT     !!
+    !
+    !
+    ! 1.0 Create the NETCDF file and store the coordinates.
+    !
+    ! This variable should be defined and computed in the module grid.f90.
+    ! Jan
+    gridtype="regular"
+    !
+    iret = NF90_CREATE(TRIM(river_file_name), NF90_CLOBBER, fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not create file :', &
+            & TRIM(river_file_name), '(Problem with disk place or filename ?)')
+    ENDIF
+    !
+    ! 1.1 Define dimensions
+    !
+    IF ( INDEX(gridtype, "regular") == 1 ) THEN
+       !
+       ! 1.1.1 regular grid
+       !
+       iret = NF90_DEF_DIM(fid, 'lon', iim_g, dims(1))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Dimension "x" can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       iret = NF90_DEF_DIM(fid, 'lat', jjm_g, dims(2))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Dimension "y" can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+    ELSE
+       !
+       ! 1.1.2 irregular grid
+       !
+       iret = NF90_DEF_DIM(fid, 'x', iim_g, dims(1))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Dimension "x" can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       
+       iret = NF90_DEF_DIM(fid, 'y', jjm_g, dims(2))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Dimension "y" can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+    ENDIF
+    !
+    !
+    ! 1.2 Define variables and attributes
+    !
+    IF ( INDEX(gridtype, "regular") == 1 ) THEN
+       !
+       ! 1.2.1 regular grid
+       !
+       lon_name = 'lon'
+       !
+       iret = NF90_DEF_VAR(fid, lon_name, kind_r_diag, dims(1), nlonid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Variable '//lon_name//' can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+       lat_name = 'lat'
+       iret = NF90_DEF_VAR(fid, lat_name, kind_r_diag, dims(2), nlatid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Variable '//lat_name//' can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+    ELSE
+       !
+       ! 1.2.2 irregular grid
+       !
+       lon_name = 'nav_lon'
+       !
+       iret = NF90_DEF_VAR(fid, lon_name, kind_r_diag, dims, nlonid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Variable '//lon_name//' can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+       lat_name = 'nav_lat'
+       iret = NF90_DEF_VAR(fid, lat_name, kind_r_diag, dims, nlatid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Variable '//lat_name//' can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+    ENDIF
+    !
+    ! 1.3 Add attributes to the coordinate variables
+    !
+    iret = NF90_PUT_ATT(fid, nlonid, 'units', "degrees_east") 
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lon_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    lon_min = -180.
+    lon_max = 180.
+    !
+    iret = NF90_PUT_ATT(fid, nlonid, 'valid_min', lon_min)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lon_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_ATT(fid, nlonid, 'valid_max', lon_max)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lon_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    iret = NF90_PUT_ATT(fid, nlonid, 'long_name', "Longitude")
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lon_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_ATT(fid, nlatid, 'units', "degrees_north")
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lat_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    lat_max = 90.
+    lat_min = -90.
+    !
+    iret = NF90_PUT_ATT(fid, nlatid, 'valid_min', lat_min)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lat_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_ATT(fid, nlatid, 'valid_max', lat_max)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lat_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_ATT(fid, nlatid, 'long_name', "Latitude")
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lat_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    iret = NF90_ENDDEF(fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not end definitions in the file : ', &
+ &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    !  1.4 Write coordinates
+    !
+    IF ( INDEX(gridtype, "regular") == 1 ) THEN
+       !
+       ! 1.4.1 regular grid
+       !
+       iret = NF90_PUT_VAR(fid, nlonid, lon_g(1:iim_g,1))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Could not put variable nav_lon  in the file : ', &
+               &          TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+       iret = NF90_PUT_VAR(fid, nlatid, lat_g(1,1:jjm_g))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Could not put variable nav_lat  in the file : ', &
+               &          TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+    ELSE
+       !
+       ! 1.4.2 irregular grid
+       !
+       iret = NF90_PUT_VAR(fid, nlonid, lon_g)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Could not put variable nav_lon  in the file : ', &
+               &          TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+       iret = NF90_PUT_VAR(fid, nlatid, lat_g)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Could not put variable nav_lat  in the file : ', &
+               &          TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+    ENDIF
+    !
+    ! 2.0 Go through all basins and wirte the information into the netCDF file.
+    !
+    DO icc = 1, num_largest
+       !
+       ! 2.1 Compute the fields to be saved in the file
+       !
+       ib=sortedrivs(icc)
+       !
+       !
+       IF ( nb_pts(ib) > 2 ) THEN
+          !
+          basinfrac(:,:) = zero
+          basinuparea(:,:) = zero
+          basincode(:,:) = zero
+          !
+          DO ij=1, nb_pts(ib)
+
+             ik=lbasin_index(ib,ij)
+
+             j = ((index_g(ik)-1)/iim_g) + 1
+             i = (index_g(ik)-(j-1)*iim_g)
+
+             basinfrac(i,j) = basinfrac(i,j) + lbasin_area(ib,ij)/(resolution_g(ik,1)*resolution_g(ik,2))
+             basinuparea(i,j) = MAX(basinuparea(i,j), lbasin_uparea(ib,ij))
+             basincode(i,j) = lrivercode(ib,ij)
+
+          ENDDO
+          !
+          DO i=1,iim_g
+             DO j=1,jjm_g
+                IF ( basinfrac(i,j) <= EPSILON(zero) ) THEN
+                   basinfrac(i,j) = undef_sechiba
+                   basinuparea(i,j)  = undef_sechiba
+                   basincode(i,j)  = undef_int
+                ELSE
+                   basinfrac(i,j) = MAX(basinfrac(i,j), un)
+                ENDIF 
+             ENDDO
+          ENDDO
+          !
+          ! 
+          ! 2.2 Define the variables in the netCDF file
+          !
+          iret = NF90_REDEF(fid)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', &
+                  &          'Could not restart definitions in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! Create a name more suitable for a variable in a netCDF file
+          !
+          nc_name =  TRIM(sorted_names(icc))
+          ! Take out all character which could cause problems
+          lcc=LEN_TRIM(nc_name)
+          DO ij=1,lcc
+             IF ( nc_name(ij:ij) == " " ) nc_name(ij:ij) = "_"
+             IF ( nc_name(ij:ij) == "(" ) nc_name(ij:ij) = "_"
+             IF ( nc_name(ij:ij) == ")" ) nc_name(ij:ij) = "_"
+          ENDDO
+          ! reduce redundant "__"
+          DO ij=1,lcc
+             IF ( nc_name(ij:ij+1) == "__" ) nc_name(ij+1:)=nc_name(ij+2:lcc)
+          ENDDO
+          lcc=LEN_TRIM(nc_name)
+          IF ( nc_name(lcc:lcc) == "_" ) nc_name(lcc:lcc) = " "
+          !
+          !
+          ! 2.3 Fraction variable
+          !
+          IF (check) WRITE(*,*) "Define Fraction variable and add attributes"
+          !
+          var_name =  TRIM(nc_name)//"_frac"
+          !
+          iret = NF90_DEF_VAR(fid, TRIM(var_name), kind_r_diag, dims, varid)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Variable '//TRIM(var_name)//' can not be defined for the file : ', &
+                  &         TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ierr_tot = 0
+          ! Units
+          iret = NF90_PUT_ATT(fid, varid, 'units', "-")
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Units',  iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          ! Long name
+          long_name = "Fraction of basin "//TRIM(sorted_names(icc))//" per grid box"
+          iret = NF90_PUT_ATT(fid, varid, 'long_name', long_name)
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Long_Name', long_name, iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          ! Missing value
+          iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Missing value', undef_sechiba, iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ib=sortedrivs(icc)
+          IF ( check ) WRITE(*,*) "Doing basin ", icc," corrsdponding to index = ", ib, "num_largest : ", num_largest
+          !
+          ! Nb of grid points in basin
+          att_str='Nb_of_grid_points_in_basin'
+          iret = NF90_PUT_ATT(fid, varid, att_str, nb_pts(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Nb of grid points in basin', nb_pts(ib), iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Longitude of outflow point 
+          att_str='Longitude_of_outflow_point'
+          iret = NF90_PUT_ATT(fid, varid, att_str, lalo(outpt(ib,1),2))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Longitude of outflow point', lalo(outpt(ib,1),2), iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Latitide of outflow point
+          att_str='Latitude_of_outflow_point'
+          iret = NF90_PUT_ATT(fid, varid, att_str, lalo(outpt(ib,1),1))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Latitude of outflow point',  lalo(outpt(ib,1),1), iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Number of streams
+          att_str= 'Number_of_streams'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_nb(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Number of streams', streams_nb(ib), iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Total number of hops to go to the oceans
+          att_str='Total_number_of_hops_to_ocean'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_avehops(ib)*streams_nb(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Total number of hops to go to the oceans ', streams_avehops(ib)*streams_nb(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Minimum number of hops to go to the ocean for any stream
+          att_str='Minimum_number_of_hops_to_ocean_for_any_stream'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_minhops(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Minimum number of hops to go tp the ocean for any stream', streams_minhops(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Average number of hops to go to the ocean for any stream 
+          att_str='Average_number_of_hops_to_ocean_for_any_stream'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_avehops(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Average number of hops to go tp the ocean for any stream', streams_avehops(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Maximum number of hops to go to the ocean for any stream 
+          att_str='Maximum_number_of_hops_to_ocean_for_any_stream'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_maxhops(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Maximum number of hops to go tp the ocean for any stream', streams_maxhops(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Average residence time in the basin
+          att_str='Average_residence_time_in_basin'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_resid(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Average residence time in the basin', streams_resid(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          IF (ierr_tot > 0 ) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Could not add some attributes to variable '//var_name//' for the file :', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! 2.4 Upstream area variable variable
+          !
+          IF (check) WRITE(*,*) "Define Upstream variable and add attributes"
+          !
+          ! Create a name more suitable for a variable in a netCDF file
+          !
+          var_name =  TRIM(nc_name)//"_upstream"
+          DO ij=1,LEN_TRIM(var_name)
+             IF ( var_name(ij:ij) == " " ) var_name(ij:ij) = "_"
+          ENDDO
+          !
+          iret = NF90_DEF_VAR(fid, TRIM(var_name), kind_r_diag, dims, varid2)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Variable '//TRIM(var_name)//' can not be defined for the file : ', &
+                  &         TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ierr_tot = 0
+          ! Units
+          iret = NF90_PUT_ATT(fid, varid2, 'units', "m^2")
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          ! Long name
+          long_name = "Upstream area of basin "//TRIM(sorted_names(icc))//" in the grid box"
+          iret = NF90_PUT_ATT(fid, varid2, 'long_name', long_name)
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          ! Missing value
+          iret = NF90_PUT_ATT(fid, varid2, 'missing_value', undef_sechiba)
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          !
+          IF (ierr_tot > 0 ) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Could not add some attributes to variable '//var_name//' for the file :', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! 2.5 Pfafstetter codes for basins
+          !
+          IF (check) WRITE(*,*) "Define Pfafstetter codes variable and add attributes"
+          !
+          var_name =  TRIM(nc_name)//"_coding"
+          DO ij=1,LEN_TRIM(var_name)
+             IF ( var_name(ij:ij) == " " ) var_name(ij:ij) = "_"
+          ENDDO
+          !
+          iret = NF90_DEF_VAR(fid, TRIM(var_name), kind_i_diag, dims, varid3)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Variable '//TRIM(var_name)//' can not be defined for the file : ', &
+                  &         TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ierr_tot = 0
+          ! Units
+          iret = NF90_PUT_ATT(fid, varid3, 'units', "-")
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          ! Long name
+          long_name = "Pfafstetter codes of grid boxes in basin "//TRIM(sorted_names(icc))
+          iret = NF90_PUT_ATT(fid, varid3, 'long_name', long_name)
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          ! Missing value
+          iret = NF90_PUT_ATT(fid, varid3, 'missing_value', undef_int)
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          !
+          IF (ierr_tot > 0 ) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Could not add some attributes to variable '//var_name//' for the file :', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! 2.6 ENDDEF of netCDF file
+          !
+          IF (check) WRITE(*,*) "END define"
+          !
+          iret = NF90_ENDDEF(fid)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', &
+                  &          'Could not end definitions in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! 2.7 Write the data to the file
+          !
+          IF (check) WRITE(*,*) "Put basinfrac"
+          iret = NF90_PUT_VAR(fid, varid, basinfrac)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Could not put variable basinfrac in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+
+          IF (check) WRITE(*,*) "Put basinuparea"
+          iret = NF90_PUT_VAR(fid, varid2, basinuparea)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Could not put variable basinuparea in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+
+          IF (check) WRITE(*,*) "Put basincode"
+          iret = NF90_PUT_VAR(fid, varid3, basincode)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagfile', 'Could not put variable basincode in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+       ENDIF
+       !
+    ENDDO
+    !
+    IF (check) WRITE(*,*) "Close file"
+    !
+    ! Close netCDF file and do some memory management.
+    !
+    iret = NF90_CLOSE(fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', &
+            &          'Could not end definitions in the file : ', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    !
+  END SUBROUTINE routing_diagncfile
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_basins_p
+!!
+!>\BRIEF        This parallelized subroutine computes the routing map if needed. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_basins_p(nbpt, lalo, neighbours, resolution, contfrac)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in) :: nbpt                          !! Domain size (unitless)
+    REAL(r_std), INTENT(in)    :: lalo(nbpt,2)                  !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in) :: neighbours(nbpt,8)            !! Vector of neighbours for each grid point 
+                                                                !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) (unitless)
+    REAL(r_std), INTENT(in)    :: resolution(nbpt,2)            !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)    :: contfrac(nbpt)                !! Fraction of land in each grid box (unitless;0-1)   
+
+!    INTEGER(i_std)    :: neighbours_tmp(nbpt,8)
+!    INTEGER(i_std) :: i,j
+    
+!    DO i=1,nbp_loc
+!      DO j=1,8
+!   IF (neighbours(i,j)==-1) THEN
+!     neighbours_tmp(i,j)=neighbours(i,j)
+!   ELSE
+!     neighbours_tmp(i,j)=neighbours(i,j)+nbp_para_begin(mpi_rank)-1
+!   ENDIF  
+!      ENDDO
+!    ENDDO
+
+    routing_area => routing_area_glo  
+    topo_resid => topo_resid_glo
+    route_togrid => route_togrid_glo
+    route_tobasin => route_tobasin_glo
+    route_nbintobas => route_nbintobas_glo
+    global_basinid => global_basinid_glo
+ 
+    IF (is_root_prc) CALL routing_basins(nbp_glo,lalo_g, neighbours_g, resolution_g, contfrac_g)
+
+    routing_area => routing_area_loc  
+    topo_resid => topo_resid_loc
+    route_togrid => route_togrid_loc
+    route_tobasin => route_tobasin_loc
+    route_nbintobas => route_nbintobas_loc
+    global_basinid => global_basinid_loc
+
+    CALL scatter(routing_area_glo,routing_area_loc)
+    CALL scatter(topo_resid_glo,topo_resid_loc)
+    CALL scatter(route_togrid_glo,route_togrid_loc)
+    CALL scatter(route_tobasin_glo,route_tobasin_loc)
+    CALL scatter(route_nbintobas_glo,route_nbintobas_loc)
+    CALL scatter(global_basinid_glo,global_basinid_loc)
+    
+  END SUBROUTINE routing_basins_p
+  ! 
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_basins
+!!
+!>\BRIEF        This non-parallelized subroutine reads in the map of basins and flow direction to construct
+!!              the catchments of each grid box. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!! The work is done in a number of steps which are performed locally on the 
+!! GCM grid:
+!!  1) First we find the grid-points of the high resolution routing grid which are
+!!     within the coarser grid of the GCM.
+!!  2) When we have these grid points we decompose them into basins in the routine
+!!     routing_findbasins. A number of simplifications are done if needed.
+!!  3) In the routine routing_globalize we put the basin information of this grid
+!!     into the global fields.
+!! Then we work on the global grid to perform the following tasks :
+!!  1) We link up the basins of the various grid points and check the global consistency.
+!!  2) The area of each outflow point is computed.
+!!  3) The final step is to reduce the number of basins in order to fit into the truncation.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None, as the routine puts information into the global variables of the module.
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_basins(nbpt, lalo, neighbours, resolution, contfrac)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                    :: nbpt                  !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                       :: lalo(nbpt,2)          !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)                    :: neighbours(nbpt,8)    !! Vector of neighbours for each grid point (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) (unitless)
+    REAL(r_std), INTENT(in)                       :: resolution(nbpt,2)    !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)                       :: contfrac(nbpt)        !! Fraction of land in each grid box (unitless;0-1)
+!! LOCAL VARIABLES
+    CHARACTER(LEN=80)                             :: filename              !! Name of the netcdf file (unitless)
+    INTEGER(i_std)                                :: iml, jml, lml, tml, fid, ib, ip, jp, fopt !! Indices (unitless)
+    REAL(r_std)                                   :: lev(1), date, dt, coslat
+    INTEGER(i_std)                                :: itau(1)               !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: trip                  !! The trip field (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: basins                !! The basin field (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: topoindex             !! Topographic index of the residence time (m)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: hierarchy             !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lat_rel               !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lon_rel               !!
+    !
+    INTEGER(i_std)                                :: nbi, nbj              !! Number of point in x and y within the grid (unitless)
+    REAL(r_std)                                   :: min_topoind           !! The current minimum of topographic index (m)
+    REAL(r_std)                                   :: max_basins            !!
+    REAL(r_std)                                   :: invented_basins       !!
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: area_bx               !! Area of each small box in the grid box @tex $(m^2})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: hierarchy_bx          !! Level in the basin of the point
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lon_bx                !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lat_bx                !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: topoind_bx            !! Topographic index of the residence time for each of the smaller boxes (m)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: trip_bx               !! The trip field for each of the smaller boxes (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: basin_bx              !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: coast_pts             !! The coastal flow points (unitless)
+    !
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_count           !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: basin_id              !!
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: basin_area            !!
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: basin_hierarchy       !!
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: basin_topoind         !! Topographic index of the residence time for a basin (m)
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: fetch_basin           !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: basin_flowdir         !! Water flow directions in the basin (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: outflow_grid          !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: outflow_basin         !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: inflow_number         !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: inflow_basin          !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: inflow_grid           !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: nbcoastal             !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: coastal_basin         !!
+    !
+    ! Interpolation help variables
+    !
+    INTEGER(i_std)                                :: nix, njx              !!
+    CHARACTER(LEN=30)                             :: callsign              !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)    :: resol_lu              !! Resolution
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: mask                  !! Mask to exclude some points (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: sub_area              !! Area on the fine grid @tex $(m^2})$ @endtex
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sub_index             !! Indices of the points we need on the fine grid (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: sub_pts               !! Number of high resolution points on this grid (unitless)
+    INTEGER                                       :: ALLOC_ERR             !!
+    LOGICAL                                       :: ok_interpol = .FALSE. !! Flag for interpolation (true/false)
+    !
+    INTEGER(i_std)                                :: nb_basin              !! Number of sub-basins (unitless)
+    INTEGER(i_std)                                :: nwbas                 !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_inbxid          !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_sz              !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_bxout           !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: basin_pts             !!
+    CHARACTER(LEN=7)                              :: fmt                   !!
+    LOGICAL                                       :: debug = .FALSE.       !! (true/false)
+    !
+    INTEGER(i_std), DIMENSION(2)                  :: diagbox = (/ 1, 2 /)  !!
+    !
+    !
+    IF ( .NOT. is_root_prc) THEN
+       WRITE(numout,*) "is_root_prc = ", is_root_prc
+       CALL ipslerr (3,'routing_basins', &
+            &          'routing_basins is not suitable for running in parallel', &
+            &          'We are here on a non root processor. ','(STOP from routing_basins)')
+    ENDIF
+    !
+    ! Test on diagbox and nbpt
+    !
+    IF (debug) THEN
+       IF (ANY(diagbox .GT. nbpt)) THEN 
+          WRITE(numout,*) "Debug diganostics : nbpt, diagbox", nbpt, diagbox
+          call ipslerr(3,'routing_basin', &
+               &      'Problem with diagbox in debug mode.', & 
+               &      'diagbox values can''t be greater than land points number.', &
+               &      '(decrease diagbox wrong value)')
+       ENDIF
+    ENDIF
+    !
+    !
+    !  Needs to be a configurable variable
+    !
+    !
+    !Config Key   = ROUTING_FILE
+    !Config Desc  = Name of file which contains the routing information
+    !Config If    = RIVER_ROUTING
+    !Config Def   = routing.nc
+    !Config Help  = The file provided here should alow the routing module to
+    !Config         read the high resolution grid of basins and the flow direction 
+    !Config         from one mesh to the other.
+    !Config Units = [FILE]
+    !
+    filename = 'routing.nc'
+    CALL getin('ROUTING_FILE',filename)
+    !
+    CALL flininfo(filename,iml, jml, lml, tml, fid)
+    CALL flinclo(fid)
+    !
+    ! soils_param.nc file is 1Â° soit texture file.
+    !
+    ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for lat_rel','','')
+    ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for lon_rel','','')
+
+    ALLOCATE (trip(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for trip','','')
+
+    ALLOCATE (basins(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basins','','')
+
+    ALLOCATE (topoindex(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for topoindex','','')
+
+    ALLOCATE (hierarchy(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for hierarchy','','')
+
+    !
+    CALL flinopen(filename, .FALSE., iml, jml, lml, lon_rel, lat_rel, lev, tml, itau, date, dt, fid)
+    !!
+    !! From the basin description data we will read the following variables :
+    !!
+    !! Trip : Provides the flow direction following the convention :
+    !! trip = 1 : flow = N
+    !! trip = 2 : flow = NE
+    !! trip = 3 : flow = E
+    !! trip = 4 : flow = SE
+    !! trip = 5 : flow = S
+    !! trip = 6 : flow = SW
+    !! trip = 7 : flow = W
+    !! trip = 8 : flow = NW
+    !! trip = 97 : return flow into the ground
+    !! trip = 98 : coastal flow (diffuse flow into the oceans)
+    !! trip = 99 : river flow into the oceans
+    !!
+    !! Basins : Provides a uniqe ID for each basin. These IDs are also used to get
+    !! the name of the basin from the table in routine routing_names.
+    !! 
+    !! Topoind :  is the topographic index for the retention time of the water in the
+    !! grid box. It has been computed with the following formula : 1000 x sqrt(d^3/Dz) 
+    !! where d is the distance of the river from the current grid box to the next one
+    !! as indicated by the variable trip.
+    !! Dz the hight difference between between the two grid boxes.
+    !! All these variables are in meters.
+    !! Furthermore  we have to limit the height difference to 5m in order to avoid any unpleasant
+    !! surprises. If dz < 5m then dz=5.
+    !!
+    !
+    CALL flinget(fid, 'trip', iml, jml, lml, tml, 1, 1, trip)
+    !
+    CALL flinget(fid, 'basins', iml, jml, lml, tml, 1, 1, basins)
+    !
+    CALL flinget(fid, 'topoind', iml, jml, lml, tml, 1, 1, topoindex)
+    !
+    CALL flinclo(fid)
+    !
+    min_topoind = MINVAL(topoindex, MASK=topoindex .LT. undef_sechiba-un)
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          IF ( trip(ip,jp) < 1.e10 .AND. topoindex(ip,jp) > 1.e10) THEN
+             WRITE(numout,*) 'trip exists but not topoind :'
+             WRITE(numout,*) 'ip, jp :', ip, jp
+             WRITE(numout,*) 'trip, topoind : ', trip(ip,jp), topoindex(ip,jp)
+             CALL ipslerr_p(3,'routing_basins','trip exists but not topoind','','')
+          ENDIF
+       ENDDO
+    ENDDO
+
+    ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for resol_lu','','')
+
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for mask','','')
+    !
+    ! Consider all points a priori
+    !
+    mask(:,:) = 0
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          ! Determine the land mask of the basin map read from the file ROUTING_FILE
+          !
+          IF ( trip(ip,jp) < 1.e10 ) THEN
+             mask(ip,jp) = 1
+          ENDIF
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )     
+          IF ( ip .EQ. 1 ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip,jp) ) * pi/180. * R_Earth * coslat
+          ELSEIF ( ip .EQ. iml ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip,jp) - lon_rel(ip-1,jp) ) * pi/180. * R_Earth * coslat
+          ELSE
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp) - lat_rel(ip,jp+1) ) * pi/180. * R_Earth
+          ELSEIF ( jp .EQ. jml ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp) ) * pi/180. * R_Earth
+          ELSE
+             resol_lu(ip,jp,2) =  ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp+1) )/2. * pi/180. * R_Earth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! The maximum number of points of the source map (basin description here) which can fit into
+    ! any grid point of the ORCHIDEE grid is stimated here.
+    ! Some margin is taken.
+    !
+    callsign = "routing_basins"
+    ok_interpol = .FALSE.
+    !  
+    nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+    njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+    nbvmax = nix*njx*2
+    !
+    ! We are on the root processor here as this routine is not in parallel. So no need to broadcast.
+    !
+    WRITE(numout,*) "Projection arrays for ",callsign," : "
+    WRITE(numout,*) "Routing : nbvmax = ", nbvmax
+
+
+    ALLOCATE (sub_area(nbpt,nbvmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for sub_area','','')
+    sub_area(:,:)=zero
+
+    ALLOCATE (sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for sub_index','','')
+    sub_index(:,:,:)=0
+
+    ALLOCATE (sub_pts(nbpt), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for sub_pts','','')
+    sub_pts(:)=0
+    !
+    ! routine aggregate will for each point of the ORCHIDEE grid determine which points
+    ! of the source grid (basin definitions here) fit in there and which fraction of
+    ! of the ORCHIDEE grid it represents.
+    !
+    CALL aggregate(nbpt, lalo, neighbours, resolution, contfrac, &
+         &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+         &                nbvmax, sub_index, sub_area, ok_interpol)
+    !
+    WHERE (sub_area < 0) sub_area=zero
+    !
+    ! Some verifications
+    !
+    DO ib=1,nbpt
+       sub_pts(ib) = COUNT(sub_area(ib,:) > zero)
+       DO fopt=1,sub_pts(ib)
+          IF (sub_area(ib, fopt) == 0 ) THEN
+             WRITE(numout,*) "Zero Area - Sub_area > 0 : ", ib, fopt
+             WRITE(numout,*) "Zero Area - lon : ",lalo(ib,2)
+             WRITE(numout,*) "Zero Area - lon_rel : ", lon_rel(sub_index(ib, fopt, 1),sub_index(ib, fopt, 2))
+             WRITE(numout,*) "Zero Area - lat : ",lalo(ib,1)
+             WRITE(numout,*) "Zero Area - lat_rel : ", lat_rel(sub_index(ib, fopt, 1),sub_index(ib, fopt, 2))
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Do some memory management.
+    !
+    nwbas = MAXVAL(sub_pts)
+    !
+    ALLOCATE (area_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for area_bx','','')
+    ALLOCATE (hierarchy_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for hierarchy_bx','','')
+    ALLOCATE (lon_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for lon_bx','','')
+    ALLOCATE (lat_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for lat_bx','','')
+    ALLOCATE (topoind_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for topoind_bx','','')
+    ALLOCATE (trip_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for trip_bx','','')
+    ALLOCATE (basin_bx(nbvmax,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_bx','','')
+    ALLOCATE (coast_pts(nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for coast_pts','','')
+    ALLOCATE (basin_inbxid(nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_inbxid','','')
+    ALLOCATE (basin_sz(nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_sz','','')
+    ALLOCATE (basin_pts(nbvmax,nbvmax,2), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_pts','','')
+    ALLOCATE (basin_bxout(nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_bxout','','')
+    ALLOCATE (basin_count(nbpt), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_count','','')
+    ALLOCATE (basin_area(nbpt,nwbas), basin_hierarchy(nbpt,nwbas), basin_topoind(nbpt,nwbas), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_area','','')
+    ALLOCATE (fetch_basin(nbpt,nwbas), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for fetch_basin','','')
+    ALLOCATE (basin_id(nbpt,nwbas),  basin_flowdir(nbpt,nwbas), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for basin_id','','')
+    ALLOCATE (outflow_grid(nbpt,nwbas),outflow_basin(nbpt,nwbas), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for outflow_grid','','')
+    ALLOCATE (inflow_number(nbpt,nwbas), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for inflow_number','','')
+    ALLOCATE (inflow_basin(nbpt,nwbas,nbvmax), inflow_grid(nbpt,nwbas,nbvmax), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for inflow_basin','','')
+    ALLOCATE (nbcoastal(nbpt), coastal_basin(nbpt,nwbas), stat=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_basins','Pb in allocate for nbcoastal','','')
+    
+    !    Order all sub points in each grid_box and find the sub basins
+    !
+    !    before we start we set the maps to empty
+    !
+    basin_id(:,:) = undef_int
+    basin_count(:) = 0
+    hierarchy(:,:) = undef_sechiba
+    max_basins = MAXVAL(basins, MASK=basins .LT. 1.e10)
+    invented_basins = max_basins
+    nbcoastal(:) = 0
+    !
+    !! Finds,in each grid box, the distance to the outflow point ... this defines the order in which
+    !! the water will go through the sub-basins and grid boxes.
+    !
+    CALL routing_hierarchy(iml, jml, trip, topoindex, hierarchy)
+    !
+    !
+    DO ib =1, nbpt
+       !
+       !
+       !  extract the information for this grid box
+       !
+       !! Extracts from the global high resolution fields the data for the current grid box.
+       !
+       CALL routing_getgrid(nbpt, iml, jml, ib, sub_pts, sub_index, sub_area, max_basins, min_topoind, &
+            & lon_rel, lat_rel, lalo, resolution, contfrac, trip, basins, topoindex, hierarchy, &
+            & nbi, nbj, area_bx, trip_bx, basin_bx, topoind_bx, hierarchy_bx, lon_bx, lat_bx)
+       !
+       !! Finds the basins: returns the list of all points which are within the same basin of the grid box.
+       !
+       CALL routing_findbasins(nbi, nbj, trip_bx, basin_bx, hierarchy_bx, topoind_bx,&
+            & nb_basin, basin_inbxid, basin_sz, basin_bxout, basin_pts, coast_pts)
+       !
+       !  Deal with the case where nb_basin=0 for this grid box. In this case all goes into coastal flow.
+       !
+       IF ( debug .AND. (COUNT(diagbox .EQ. ib) .GT. 0) ) THEN
+          WRITE(numout,*) '===================== IB = :', ib
+          WRITE(numout,*) "sub_pts(ib) :", sub_pts(ib), "sub_area(ib,:) :",sub_area(ib,1:2)
+          WRITE(numout,*) 'LON LAT of GCM :', lalo(ib,2), lalo(ib,1)
+          WRITE(numout,*) 'Neighbor options :',  neighbours(ib,1:8)
+          WRITE(numout,*) 'Resolution :', resolution(ib,1:2)
+          WRITE(fmt,"('(',I3,'I6)')") nbi
+          WRITE(numout,*) '-------------> trip ', trip_bx(1,1)
+          DO jp=1,nbj
+             WRITE(numout,fmt) trip_bx(1:nbi,jp)
+          ENDDO
+          WRITE(numout,*) '-------------> basin ',basin_bx(1,1)
+          DO jp=1,nbj
+             WRITE(numout,fmt) basin_bx(1:nbi,jp)
+          ENDDO
+          WRITE(numout,*) '-------------> hierarchy ',hierarchy_bx(1,1)
+          DO jp=1,nbj
+             WRITE(numout,fmt) INT(hierarchy_bx(1:nbi,jp)/1000.)
+          ENDDO
+          WRITE(numout,*) '-------------> topoindex ',topoind_bx(1,1)
+          DO jp=1,nbj
+             WRITE(numout,fmt) INT(topoind_bx(1:nbi,jp)/1000.)
+          ENDDO
+          !
+          WRITE(numout,*) '------------> The basins we retain'
+          DO jp=1,nb_basin
+             WRITE(numout,*) 'index, size, bxout, coast :', basin_inbxid(jp), basin_sz(jp),&
+                  & basin_bxout(jp), coast_pts(jp)
+          ENDDO
+          !
+       ENDIF
+       !
+       !! Puts the basins found for the current grid box in the context of the global map.
+       !
+       CALL routing_globalize(nbpt, ib, neighbours, area_bx, trip_bx, hierarchy_bx, topoind_bx, min_topoind,&
+            & nb_basin, basin_inbxid, basin_sz, basin_pts, basin_bxout, coast_pts, nwbas, basin_count,&
+            & basin_area, basin_hierarchy, basin_topoind, basin_id, basin_flowdir, outflow_grid,&
+            & nbcoastal, coastal_basin) 
+       !
+       !
+       IF ( debug .AND. (COUNT(diagbox .EQ. ib) .GT. 0) ) THEN
+          WRITE(numout,*) 'GLOBAL information after routing_globalize for grid ', ib
+          DO jp=1,basin_count(ib)
+             WRITE(numout,*) 'Basin ID : ', basin_id(ib, jp)
+             WRITE(numout,*) 'Basin flowdir :', basin_flowdir(ib, jp)
+             WRITE(numout,*) 'Basin hierarchy :', basin_hierarchy(ib, jp)
+             WRITE(numout,*) 'Basin topoindex :', basin_topoind(ib, jp)
+             WRITE(numout,*) 'Basin outflow grid :', outflow_grid(ib,jp)
+          ENDDO
+       ENDIF
+       !
+    ENDDO
+    !
+    !! Makes the connections between the bains and ensures global coherence.
+    !
+    CALL routing_linkup(nbpt, neighbours, nwbas, basin_count, basin_area, basin_id, basin_flowdir, &
+         & basin_hierarchy, outflow_grid, outflow_basin, inflow_number, inflow_grid, inflow_basin, &
+         & nbcoastal, coastal_basin, invented_basins)
+    ! 
+    !
+    WRITE(numout,*) 'The maximum number of basins in any grid :', MAXVAL(basin_count)
+    !
+    IF ( debug ) THEN
+       DO ib=1,SIZE(diagbox)
+          IF ( diagbox(ib) .GT. 0 ) THEN
+             WRITE(numout,*) 'After routing_linkup information for grid ', diagbox(ib)
+             DO jp=1,basin_count(diagbox(ib))
+                WRITE(numout,*) 'Basin ID : ', basin_id(diagbox(ib), jp)
+                WRITE(numout,*) 'Basin outflow_grid :', outflow_grid(diagbox(ib), jp)
+                WRITE(numout,*) 'Basin outflow_basin:', outflow_basin(diagbox(ib), jp)
+                WRITE(numout,*) 'Basin hierarchy :', basin_hierarchy(diagbox(ib), jp)
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDIF
+    !
+    !! Computes the fetch of each basin, upstream area in known.
+    !
+    CALL routing_fetch(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_id, outflow_grid, &
+         & outflow_basin, fetch_basin)
+    !
+    !
+    WRITE(numout,*) "Start reducing the number of basins per grid to meet the required truncation."
+    !
+    !! Reduces the number of basins per grid to the value chosen by the user.
+    !
+    CALL routing_truncate(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_topoind,&
+         & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+         & inflow_grid, inflow_basin)
+    !
+    !! Calculate the fetch again and store the upstream areas which are here used as output variable     
+    CALL routing_fetch(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_id, outflow_grid, &
+         & outflow_basin, fetch_basin)         
+    upstream_area = fetch_basin     
+    
+
+    !
+    DEALLOCATE (lat_rel)
+    DEALLOCATE (lon_rel)
+    !
+    DEALLOCATE (trip)
+    DEALLOCATE (basins)
+    DEALLOCATE (topoindex)
+    DEALLOCATE (hierarchy)
+    !
+    DEALLOCATE (sub_area)
+    DEALLOCATE (sub_index)
+    DEALLOCATE (sub_pts)
+    !
+    DEALLOCATE (mask)
+    DEALLOCATE (resol_lu)
+    !
+    DEALLOCATE (basin_count)
+    DEALLOCATE (basin_area, basin_hierarchy, basin_topoind, fetch_basin)
+    DEALLOCATE (basin_id,  basin_flowdir)
+    DEALLOCATE (outflow_grid,outflow_basin)
+    DEALLOCATE (inflow_number)
+    DEALLOCATE (inflow_basin, inflow_grid)
+    DEALLOCATE (nbcoastal, coastal_basin)
+
+  END SUBROUTINE routing_basins
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_getgrid
+!!
+!>\BRIEF         This subroutine extracts from the global high resolution fields
+!!               the data for the current grid box we are dealing with.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!! Convention for trip on the input :
+!! The trip field follows the following convention for the flow of the water :
+!! trip = 1 : flow = N
+!! trip = 2 : flow = NE
+!! trip = 3 : flow = E
+!! trip = 4 : flow = SE
+!! trip = 5 : flow = S
+!! trip = 6 : flow = SW
+!! trip = 7 : flow = W
+!! trip = 8 : flow = NW
+!! trip = 97 : return flow into the ground
+!! trip = 98 : coastal flow (diffuse flow into the oceans) These values are created here
+!! trip = 99 : river flow into the oceans
+!!
+!! On output, the grid boxes of the basin map which flow out of the GCM grid are identified
+!! by numbers larger than 100 :
+!! trip = 101 : flow = N out of the coarse grid
+!! trip = 102 : flow = NE out of the coarse grid
+!! trip = 103 : flow = E out of the coarse grid
+!! trip = 104 : flow = SE out of the coarse grid
+!! trip = 105 : flow = S out of the coarse grid
+!! trip = 106 : flow = SW out of the coarse grid
+!! trip = 107 : flow = W out of the coarse grid
+!! trip = 108 : flow = NW out of the coarse grid
+!! Inside the grid the convention remains the same as above (ie between 1 and 99).:\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_getgrid(nbpt, iml, jml, ib, sub_pts, sub_index, sub_area, max_basins, min_topoind, &
+       & lon_rel, lat_rel, lalo, resolution, contfrac, trip, basins, topoindex, hierarchy, &
+       & nbi, nbj, area_bx, trip_bx, basin_bx, topoind_bx, hierarchy_bx, lon_bx, lat_bx)
+    !
+    IMPLICIT NONE
+    !
+!!  INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)  :: nbpt                        !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)  :: iml                         !! X resolution of the high resolution grid
+    INTEGER(i_std), INTENT(in)  :: jml                         !! Y resolution of the high resolution grid
+    INTEGER(i_std), INTENT(in)  :: ib                          !! Current basin (unitless)
+    INTEGER(i_std), INTENT(in)  :: sub_pts(nbpt)               !! Number of high resolution points on this grid (unitless)
+    INTEGER(i_std), INTENT(in)  :: sub_index(nbpt,nbvmax,2)    !! Indices of the points we need on the fine grid (unitless)
+    REAL(r_std), INTENT(inout)  :: max_basins                  !! The current maximum of basins
+    REAL(r_std), INTENT(in)     :: min_topoind                 !! The current minimum of topographic index (m)
+    REAL(r_std), INTENT(in)     :: sub_area(nbpt,nbvmax)       !! Area on the fine grid @tex $(m^2})$ @endtex
+    REAL(r_std), INTENT(in)     :: lon_rel(iml,jml)            !!
+    REAL(r_std), INTENT(in)     :: lat_rel(iml,jml)            !! coordinates of the fine grid
+    REAL(r_std), INTENT(in)     :: lalo(nbpt,2)                !! Vector of latitude and longitudes (beware of the order !)
+    REAL(r_std), INTENT(in)     :: resolution(nbpt,2)          !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)     :: contfrac(nbpt)              !! Fraction of land in each grid box (unitless;0-1)
+    REAL(r_std), INTENT(inout)  :: trip(iml,jml)               !! The trip field (unitless)
+    REAL(r_std), INTENT(inout)  :: basins(iml,jml)             !! data on the fine grid
+    REAL(r_std), INTENT(inout)  :: topoindex(iml,jml)          !! Topographic index of the residence time (m)
+    REAL(r_std), INTENT(inout)  :: hierarchy(iml, jml)         !! data on the fine grid
+    !
+!!  OUTPUT VARIABLES
+    INTEGER(i_std), INTENT(out) :: nbi, nbj                    !! Number of point in x and y within the grid (unitless)
+    REAL(r_std), INTENT(out)    :: area_bx(nbvmax,nbvmax)      !! Area of each small box in the grid box @tex $(m^2})$ @endtex
+    REAL(r_std), INTENT(out)    :: hierarchy_bx(nbvmax,nbvmax) !! Level in the basin of the point
+    REAL(r_std), INTENT(out)    :: lon_bx(nbvmax,nbvmax)       !!
+    REAL(r_std), INTENT(out)    :: lat_bx(nbvmax,nbvmax)       !!
+    REAL(r_std), INTENT(out)    :: topoind_bx(nbvmax,nbvmax)   !! Topographic index of the residence time for each of the smaller boxes (m)
+    INTEGER(i_std), INTENT(out) :: trip_bx(nbvmax,nbvmax)      !! The trip field for each of the smaller boxes (unitless)
+    INTEGER(i_std), INTENT(out) :: basin_bx(nbvmax,nbvmax)     !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)              :: ip, jp, ll(1), iloc, jloc   !! Indices (unitless)
+    REAL(r_std)                 :: lonstr(nbvmax*nbvmax)       !!
+    REAL(r_std)                 :: latstr(nbvmax*nbvmax)       !!
+
+!_ ================================================================================================================================
+
+    !
+    ! Set everything to undef to locate easily empty points
+    !
+    trip_bx(:,:) = undef_int
+    basin_bx(:,:) = undef_int
+    topoind_bx(:,:) = undef_sechiba
+    area_bx(:,:) = undef_sechiba
+    hierarchy_bx(:,:) = undef_sechiba
+    !
+    IF ( sub_pts(ib) > 0 ) THEN
+       !
+       DO ip=1,sub_pts(ib)
+          lonstr(ip) = lon_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+          latstr(ip) = lat_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+       ENDDO
+       !
+       !  Get the size of the area and order the coordinates to go from North to South and West to East
+       !
+       CALL routing_sortcoord(sub_pts(ib), lonstr, 'WE', nbi)
+       CALL routing_sortcoord(sub_pts(ib), latstr, 'NS', nbj)
+       !
+       ! Transfer the data in such a way that (1,1) is the North Western corner and
+       ! (nbi, nbj) the South Eastern.
+       !
+       DO ip=1,sub_pts(ib)
+          ll = MINLOC(ABS(lonstr(1:nbi) - lon_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))))
+          iloc = ll(1)
+          ll = MINLOC(ABS(latstr(1:nbj) - lat_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))))
+          jloc = ll(1)
+          trip_bx(iloc, jloc) = NINT(trip(sub_index(ib, ip, 1), sub_index(ib, ip, 2)))
+          basin_bx(iloc, jloc) = NINT(basins(sub_index(ib, ip, 1), sub_index(ib, ip, 2)))
+          area_bx(iloc, jloc) = sub_area(ib, ip)
+          topoind_bx(iloc, jloc) = topoindex(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+          hierarchy_bx(iloc, jloc) = hierarchy(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+          lon_bx(iloc, jloc) = lon_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+          lat_bx(iloc, jloc) = lat_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+       ENDDO
+    ELSE
+       !
+       ! This is the case where the model invented a continental point
+       !
+       nbi = 1
+       nbj = 1
+       iloc = 1
+       jloc = 1
+       trip_bx(iloc, jloc) = 98
+       basin_bx(iloc, jloc) = NINT(max_basins + 1)
+       max_basins = max_basins + 1
+       area_bx(iloc, jloc) = resolution(ib,1)*resolution(ib,2)*contfrac(ib)
+       topoind_bx(iloc, jloc) = min_topoind
+       hierarchy_bx(iloc, jloc) =  min_topoind
+       lon_bx(iloc, jloc) = lalo(ib,2)
+       lat_bx(iloc, jloc) = lalo(ib,1)
+       !
+    ENDIF
+    !
+    ! Tag in trip all the outflow conditions. The table is thus :
+    ! trip = 100+n : Outflow into another grid box
+    ! trip = 99    : River outflow into the ocean
+    ! trip = 98    : This will be coastal flow (not organized as a basin)
+    ! trip = 97    : return flow into the soil (local)
+    !
+    DO jp=1,nbj
+       IF ( trip_bx(1,jp) .EQ. 8 .OR. trip_bx(1,jp) .EQ. 7 .OR. trip_bx(1,jp) .EQ. 6) THEN
+          trip_bx(1,jp) = trip_bx(1,jp) + 100
+       ENDIF
+       IF ( trip_bx(nbi,jp) .EQ. 2 .OR. trip_bx(nbi,jp) .EQ. 3 .OR. trip_bx(nbi,jp) .EQ. 4) THEN
+          trip_bx(nbi,jp) = trip_bx(nbi,jp) + 100
+       ENDIF
+    ENDDO
+    DO ip=1,nbi
+       IF ( trip_bx(ip,1) .EQ. 8 .OR. trip_bx(ip,1) .EQ. 1 .OR. trip_bx(ip,1) .EQ. 2) THEN
+          trip_bx(ip,1) = trip_bx(ip,1) + 100
+       ENDIF
+       IF ( trip_bx(ip,nbj) .EQ. 6 .OR. trip_bx(ip,nbj) .EQ. 5 .OR. trip_bx(ip,nbj) .EQ. 4) THEN
+          trip_bx(ip,nbj) = trip_bx(ip,nbj) + 100
+       ENDIF
+    ENDDO
+    !
+    !
+    !  We simplify the outflow. We only need the direction normal to the
+    !     box boundary and the 4 corners.
+    ! 
+    ! Northern border
+    IF ( trip_bx(1,1) .EQ. 102 ) trip_bx(1,1) = 101
+    IF ( trip_bx(nbi,1) .EQ. 108 ) trip_bx(nbi,1) = 101
+    DO ip=2,nbi-1
+       IF ( trip_bx(ip,1) .EQ. 108 .OR. trip_bx(ip,1) .EQ. 102 ) trip_bx(ip,1) = 101
+    ENDDO
+    ! Southern border
+    IF ( trip_bx(1,nbj) .EQ. 104 ) trip_bx(1,nbj) = 105
+    IF ( trip_bx(nbi,nbj) .EQ. 106 ) trip_bx(nbi,nbj) = 105
+    DO ip=2,nbi-1
+       IF ( trip_bx(ip,nbj) .EQ. 104 .OR. trip_bx(ip,nbj) .EQ. 106 ) trip_bx(ip,nbj) = 105
+    ENDDO
+    ! Eastern border
+    IF ( trip_bx(nbi,1) .EQ. 104) trip_bx(nbi,1) = 103
+    IF ( trip_bx(nbi,nbj) .EQ. 102) trip_bx(nbi,nbj) = 103
+    DO jp=2,nbj-1
+       IF ( trip_bx(nbi,jp) .EQ. 104 .OR. trip_bx(nbi,jp) .EQ. 102 ) trip_bx(nbi,jp) = 103
+    ENDDO
+    ! Western border
+    IF ( trip_bx(1,1) .EQ. 106) trip_bx(1,1) = 107
+    IF ( trip_bx(1,nbj) .EQ. 108) trip_bx(1,nbj) = 107
+    DO jp=2,nbj-1
+       IF ( trip_bx(1,jp) .EQ. 106 .OR. trip_bx(1,jp) .EQ. 108 ) trip_bx(1,jp) = 107
+    ENDDO       
+    !
+    !
+  END SUBROUTINE routing_getgrid
+!
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_sortcoord
+!!
+!>\BRIEF         This subroutines orders the coordinates to go from North to South and West to East.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_sortcoord(nb_in, coords, direction, nb_out)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)   :: nb_in             !!
+    REAL(r_std), INTENT(inout)   :: coords(nb_in)     !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), INTENT(out)  :: nb_out            !!
+    !
+!! LOCAL VARIABLES
+    CHARACTER(LEN=2)             :: direction         !!
+    INTEGER(i_std)               :: ipos              !!
+    REAL(r_std)                  :: coords_tmp(nb_in) !!
+    INTEGER(i_std), DIMENSION(1) :: ll                !!
+    INTEGER(i_std)               :: ind(nb_in)        !!
+    !
+    ipos = 1
+    nb_out = nb_in
+    !
+    ! Compress the coordinates array
+    !
+    DO WHILE ( ipos < nb_in )
+       IF ( coords(ipos+1) /= undef_sechiba) THEN
+         IF ( COUNT(coords(ipos:nb_out) == coords(ipos)) > 1 ) THEN
+            coords(ipos:nb_out-1) = coords(ipos+1:nb_out) 
+            coords(nb_out:nb_in) = undef_sechiba
+            nb_out = nb_out - 1
+         ELSE
+            ipos = ipos + 1
+         ENDIF
+      ELSE
+         EXIT
+      ENDIF
+    ENDDO
+    !
+    ! Sort it now
+    !
+    ! First we get ready and adjust for the periodicity in longitude
+    !
+    coords_tmp(:) = undef_sechiba
+    IF ( INDEX(direction, 'WE') == 1 .OR.  INDEX(direction, 'EW') == 1) THEN
+       IF ( MAXVAL(ABS(coords(1:nb_out))) .GT. 160 ) THEN
+          coords_tmp(1:nb_out) = MOD(coords(1:nb_out) + 360.0, 360.0)
+       ELSE
+          coords_tmp(1:nb_out) = coords(1:nb_out)
+       ENDIF
+    ELSE IF ( INDEX(direction, 'NS') == 1 .OR.  INDEX(direction, 'SN') == 1) THEN
+       coords_tmp(1:nb_out) = coords(1:nb_out)
+    ELSE
+       WRITE(numout,*) 'The chosen direction (', direction,') is not recognized'
+       CALL ipslerr_p(3,'routing_sortcoord','The chosen direction is not recognized','First section','')
+    ENDIF
+    !
+    ! Get it sorted out now
+    !
+    ipos = 1
+    !
+    IF ( INDEX(direction, 'WE') == 1 .OR. INDEX(direction, 'SN') == 1) THEN
+       DO WHILE (COUNT(ABS(coords_tmp(:)-undef_sechiba) > EPSILON(undef_sechiba)*10.) >= 1)
+          ll = MINLOC(coords_tmp(:), coords_tmp /= undef_sechiba)
+          ind(ipos) = ll(1) 
+          coords_tmp(ll(1)) = undef_sechiba
+          ipos = ipos + 1
+       ENDDO
+    ELSE IF ( INDEX(direction, 'EW') == 1 .OR. INDEX(direction, 'NS') == 1) THEN
+       DO WHILE (COUNT(ABS(coords_tmp(:)-undef_sechiba) > EPSILON(undef_sechiba)*10.) >= 1)
+          ll = MAXLOC(coords_tmp(:), coords_tmp /= undef_sechiba)
+          ind(ipos) = ll(1) 
+          coords_tmp(ll(1)) = undef_sechiba
+          ipos = ipos + 1
+       ENDDO
+    ELSE
+       WRITE(numout,*) 'The chosen direction (', direction,') is not recognized (second)'
+       CALL ipslerr_p(3,'routing_sortcoord','The chosen direction is not recognized','Second section','')
+    ENDIF
+    !
+    coords(1:nb_out) = coords(ind(1:nb_out))
+    IF (nb_out < nb_in) THEN
+       coords(nb_out+1:nb_in) = zero
+    ENDIF
+    !
+  END SUBROUTINE routing_sortcoord
+  !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_findbasins
+!!
+!>\BRIEF         This subroutine finds the basins and does some clean up.
+!!               The aim is to return the list off all points which are within the
+!!               same basin of the grid box.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!!  We will also collect all points which directly flow into the ocean in one basin
+!!  Make sure that we do not have a basin with two outflows and other exceptions.
+!!  At this stage no effort is made to come down to the truncation of the model.
+!!
+!! Convention for trip    \n
+!! -------------------    \n
+!! Inside of the box :    \n
+!! trip = 1 : flow = N    \n
+!! trip = 2 : flow = NE    \n
+!! trip = 3 : flow = E    \n
+!! trip = 4 : flow = SE    \n
+!! trip = 5 : flow = S    \n
+!! trip = 6 : flow = SW    \n
+!! trip = 7 : flow = W    \n
+!! trip = 8 : flow = NW    \n
+!! trip = 97 : return flow into the ground    \n
+!! trip = 98 : coastal flow (diffuse flow into the oceans) These values are created here    \n
+!! trip = 99 : river flow into the oceans    \n
+!!
+!! Out flow from the grid :    \n
+!! trip = 101 : flow = N out of the coarse grid    \n
+!! trip = 102 : flow = NE out of the coarse grid    \n
+!! trip = 103 : flow = E out of the coarse grid    \n
+!! trip = 104 : flow = SE out of the coarse grid    \n
+!! trip = 105 : flow = S out of the coarse grid    \n
+!! trip = 106 : flow = SW out of the coarse grid    \n
+!! trip = 107 : flow = W out of the coarse grid    \n
+!! trip = 108 : flow = NW out of the coarse grid!    \n
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_findbasins(nbi, nbj, trip, basin, hierarchy, topoind, nb_basin, basin_inbxid, basin_sz,&
+       & basin_bxout, basin_pts, coast_pts)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)    :: nbi                          !! Number of point in x within the grid (unitless)
+    INTEGER(i_std), INTENT(in)    :: nbj                          !! Number of point in y within the grid (unitless)
+    REAL(r_std), INTENT(in)       :: hierarchy(:,:)               !!
+    REAL(r_std), INTENT(in)       :: topoind(:,:)                 !! Topographic index of the residence time (m)
+    !
+    !  Modified
+    INTEGER(i_std), INTENT(inout) :: trip(:,:)                    !! The trip field (unitless)
+    INTEGER(i_std), INTENT(inout) :: basin(:,:)                   !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), INTENT(out)   :: nb_basin                     !! Number of sub-basins (unitless)
+    INTEGER(i_std), INTENT(out)   :: basin_inbxid(nbvmax)         !!
+    INTEGER(i_std), INTENT(out)   :: basin_sz(nbvmax)             !!
+    INTEGER(i_std), INTENT(out)   :: basin_bxout(nbvmax)          !!
+    INTEGER(i_std), INTENT(out)   :: basin_pts(nbvmax, nbvmax, 2) !!
+    INTEGER(i_std), INTENT(out)   :: coast_pts(nbvmax)            !! The coastal flow points (unitless)
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                :: ibas, ilf, nbb, nb_in        !!
+    INTEGER(i_std)                :: bname(nbvmax)                !!
+    INTEGER(i_std)                :: sz(nbvmax)                   !!
+    INTEGER(i_std)                :: pts(nbvmax,nbvmax,2)         !!
+    INTEGER(i_std)                :: nbout(nbvmax)                !!
+    INTEGER(i_std)                :: new_nb                       !!
+    INTEGER(i_std)                :: new_bname(nbvmax)            !!
+    INTEGER(i_std)                :: new_sz(nbvmax)               !!
+    INTEGER(i_std)                :: new_pts(nbvmax,nbvmax,2)     !!
+    INTEGER(i_std)                :: itrans                       !!
+    INTEGER(i_std)                :: trans(nbvmax)                !!
+    INTEGER(i_std)                :: outdir(nbvmax)               !!
+    INTEGER(i_std)                :: tmpsz(nbvmax)                !!
+    INTEGER(i_std)                :: ip, jp, jpp(1), ipb          !!
+    INTEGER(i_std)                :: sortind(nbvmax)              !!
+    CHARACTER(LEN=7)              :: fmt                          !!
+    !
+    nbb = 0
+    ibas = -1
+    bname(:) = undef_int
+    sz(:) = 0
+    nbout(:) = 0
+    new_pts(:,:,:) = 0
+    !
+    ! 1.0 Find all basins within this grid box
+    !     Sort the variables per basin so that we can more easily
+    !     access data from the same basin (The variables are :
+    !     bname, sz, pts, nbout)
+    !
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( basin(ip,jp) .LT. undef_int) THEN
+             IF ( COUNT(basin(ip,jp) .EQ. bname(:)) .EQ. 0 ) THEN
+                nbb = nbb + 1
+                IF ( nbb .GT. nbvmax ) CALL ipslerr_p(3,'routing_findbasins','nbvmax too small','first section','')
+                bname(nbb) = basin(ip,jp)
+                sz(nbb) = 0
+             ENDIF
+             !
+             DO ilf=1,nbb
+                IF ( basin(ip,jp) .EQ. bname(ilf) ) THEN
+                   ibas = ilf
+                ENDIF
+             ENDDO
+             !
+             sz(ibas) = sz(ibas) + 1
+             IF ( sz(ibas) .GT. nbvmax ) CALL ipslerr_p(3,'routing_findbasins','nbvmax too small','second section','')
+             pts(ibas, sz(ibas), 1) = ip
+             pts(ibas, sz(ibas), 2) = jp
+             ! We deal only with outflow and leave flow back into the grid box for later.
+             IF ( trip(ip,jp) .GE. 97 ) THEN
+                nbout(ibas) = nbout(ibas) + 1
+             ENDIF
+             !
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! 2.0 All basins which have size 1 and flow to the ocean are put together.
+    !
+    itrans = 0
+    coast_pts(:) = undef_int
+    ! Get all the points we can collect
+    DO ip=1,nbb
+       IF ( sz(ip) .EQ. 1 .AND. trip(pts(ip,1,1),pts(ip,1,2)) .EQ. 99) THEN
+          itrans = itrans + 1
+          trans(itrans) = ip
+          trip(pts(ip,1,1),pts(ip,1,2)) = 98
+       ENDIF
+    ENDDO
+    ! put everything in the first basin
+    IF ( itrans .GT. 1) THEN
+       ipb = trans(1)
+       coast_pts(sz(ipb)) = bname(ipb)
+       bname(ipb) = -1
+       DO ip=2,itrans
+          sz(ipb) = sz(ipb) + 1
+          coast_pts(sz(ipb)) = bname(trans(ip))
+          sz(trans(ip)) = 0
+          pts(ipb, sz(ipb), 1) = pts(trans(ip), 1, 1) 
+          pts(ipb, sz(ipb), 2) = pts(trans(ip), 1, 2) 
+       ENDDO
+    ENDIF
+    !
+    ! 3.0 Make sure that we have only one outflow point in each basin
+    !
+    ! nbb is the number of basins on this grid box.
+    new_nb = 0
+    DO ip=1,nbb
+       ! We only do this for grid-points which have more than one outflow
+       IF ( sz(ip) .GT. 1 .AND. nbout(ip) .GT. 1) THEN
+          !
+          ! Pick up all points needed and store them in trans
+          !
+          itrans = 0
+          DO jp=1,sz(ip)
+             IF ( trip(pts(ip,jp,1),pts(ip,jp,2)) .GE. 97) THEN
+                itrans = itrans + 1
+                trans(itrans) = trip(pts(ip,jp,1),pts(ip,jp,2))
+             ENDIF
+          ENDDO
+          !
+          ! First issue : We have more than one point of the basin which flows into
+          ! the ocean. In this case we put everything into coastal flow. It will go into
+          ! a separate basin in the routing_globalize routine.
+          !
+          IF ( (COUNT(trans(1:itrans) .EQ. 99) + COUNT(trans(1:itrans) .EQ. 98)) .GT. 1) THEN
+             DO jp=1,sz(ip)
+                IF ( trip(pts(ip,jp,1),pts(ip,jp,2)) .EQ. 99 ) THEN
+                   trip(pts(ip,jp,1),pts(ip,jp,2)) = 98
+                   trans(itrans) = trip(pts(ip,jp,1),pts(ip,jp,2))
+                ENDIF
+             ENDDO
+          ENDIF
+          !
+          ! Second issue : We have redundant outflows at the boundaries. That is two small grid
+          ! boxes flowing into the same GCM grid box.
+          !
+          IF ( COUNT(trans(1:itrans) .GT. 100) .GE. 1) THEN
+             CALL routing_simplify(nbi, nbj, trip, basin, hierarchy, bname(ip))
+             itrans = 0
+             DO jp=1,sz(ip)
+                IF ( trip(pts(ip,jp,1),pts(ip,jp,2)) .GE. 9) THEN
+                   itrans = itrans + 1
+                   trans(itrans) = trip(pts(ip,jp,1),pts(ip,jp,2))
+                ENDIF
+             ENDDO
+          ENDIF
+          !
+          ! Third issue : we have more than one outflow from the boxes. This could be 
+          !             - flow into 2 or more neighboring GCM grids
+          !             - flow into a neighboring GCM grids and into the ocean or be a return flow (=97. =98, =99)
+          !             - flow into a neighboring GCM grids or ocean and back into the same GCM grid box
+          ! The only solution is to cut the basin up in as many parts.
+          !
+          IF ( COUNT(trans(1:itrans) .GE. 97) .GT. 1) THEN
+             !
+             nb_in =  new_nb
+             CALL routing_cutbasin(nbi, nbj, nbb, trip, basin, bname(ip), new_nb, new_bname, new_sz, new_pts)
+             !
+             ! If we have split the basin then we need to cancel the old one
+             !
+             IF ( nb_in .NE. new_nb) THEN
+                sz(ip) = 0
+             ENDIF
+             !
+          ENDIF
+          !
+       ENDIF
+    ENDDO
+    !
+    !  Add the new basins to the end of the list
+    !
+    If ( nbb+new_nb .LE. nbvmax) THEN
+       DO ip=1,new_nb
+          bname(nbb+ip) = new_bname(ip)
+          sz(nbb+ip) = new_sz(ip)
+          pts(nbb+ip,:,:) = new_pts(ip,:,:)
+       ENDDO
+       nbb = nbb+new_nb
+    ELSE
+       WRITE(numout,*) 'Increase nbvmax. It is too small to contain all the basins (routing_findbasins)'
+       CALL ipslerr_p(3,'routing_findbasins','Increase nbvmax.','It is too small to contain all the basins','')
+    ENDIF
+    !
+    ! Keep the output direction
+    !
+    DO ip=1,nbb
+       IF ( sz(ip) .GT. 0 ) THEN
+          trans(:) = 0
+          DO jp=1,sz(ip)
+             trans(jp) = trip(pts(ip,jp,1),pts(ip,jp,2))
+          ENDDO
+          outdir(ip) = MAXVAL(trans(1:sz(ip)))
+          IF ( outdir(ip) .GE. 97 ) THEN
+             outdir(ip) = outdir(ip) - 100
+          ELSE
+             WRITE(numout,*) 'Why are we here and can not find a trip larger than 96'
+             WRITE(numout,*) 'Does this mean that the basin does not have any outflow ', ip, bname(ip)
+             WRITE(fmt,"('(',I3,'I9)')") nbi
+             WRITE(numout,*) '-----------------------> trip'
+             DO jp=1,nbj
+                WRITE(numout,fmt) trip(1:nbi,jp)
+             ENDDO
+             WRITE(numout,*) '-----------------------> basin'
+             DO jp=1,nbj
+                WRITE(numout,fmt) basin(1:nbi,jp)
+             ENDDO
+             CALL ipslerr_p(3,'routing_findbasins','Probleme finding trip','','')
+          ENDIF
+       ENDIF
+    ENDDO
+    !
+    !
+    ! Sort the output by size of the various basins. 
+    !
+    nb_basin = COUNT(sz(1:nbb) .GT. 0)
+    tmpsz(:) = -1
+    tmpsz(1:nbb) = sz(1:nbb)
+    DO ip=1,nbb
+       jpp = MAXLOC(tmpsz(:))
+       IF ( sz(jpp(1)) .GT. 0) THEN
+          sortind(ip) = jpp(1)
+          tmpsz(jpp(1)) = -1
+       ENDIF
+    ENDDO
+    basin_inbxid(1:nb_basin) = bname(sortind(1:nb_basin))
+    basin_sz(1:nb_basin) = sz(sortind(1:nb_basin))
+    basin_pts(1:nb_basin,:,:) = pts(sortind(1:nb_basin),:,:)
+    basin_bxout(1:nb_basin) = outdir(sortind(1:nb_basin))
+    !
+    ! We can only check if we have at least as many outflows as basins
+    !
+    ip = COUNT(trip(1:nbi,1:nbj) .GE. 97 .AND. trip(1:nbi,1:nbj) .LT. undef_int)
+!!    ip = ip + COUNT(trip(1:nbi,1:nbj) .EQ. 97)
+!!    IF ( COUNT(trip(1:nbi,1:nbj) .EQ. 98) .GT. 0) ip = ip + 1
+    IF ( ip .LT. nb_basin ) THEN
+       WRITE(numout,*) 'We have less outflow points than basins :', ip
+       WRITE(fmt,"('(',I3,'I9)')") nbi
+       WRITE(numout,*) '-----------------------> trip'
+       DO jp=1,nbj
+          WRITE(numout,fmt) trip(1:nbi,jp)
+       ENDDO
+       WRITE(numout,*) '-----------------------> basin'
+       DO jp=1,nbj
+          WRITE(numout,fmt) basin(1:nbi,jp)
+       ENDDO
+       WRITE(numout,*) 'nb_basin :', nb_basin
+       WRITE(numout,*) 'Basin sized :', basin_sz(1:nb_basin)
+       CALL ipslerr_p(3,'routing_findbasins','Probleme less outflow points than basins','','')
+    ENDIF
+    
+  END SUBROUTINE routing_findbasins
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_simplify
+!!
+!>\BRIEF         This subroutine symplifies the routing out of each basin by taking 
+!!               out redundancies at the borders of the GCM box.
+!!               The aim is to have only one outflow point per basin and grid box.
+!!               But here we will not change the direction of the outflow.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_simplify(nbi, nbj, trip, basin, hierarchy, basin_inbxid)
+    !
+    IMPLICIT NONE
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                             :: nbi                        !! Number of point in x within the grid (unitless)
+    INTEGER(i_std)                             :: nbj                        !! Number of point in y within the grid (unitless)
+    INTEGER(i_std)                             :: trip(:,:)                  !! The trip field (unitless)
+    INTEGER(i_std)                             :: basin(:,:)                 !!
+    REAL(r_std)                                :: hierarchy(:,:)             !!
+    INTEGER(i_std)                             :: basin_inbxid               !!
+    !
+    INTEGER(i_std)                             :: ip, jp, nbout, basin_sz, iborder !!
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)   :: trip_tmp                   !! Temporary trip field which only contains the values for the basin on which we currently work (1)
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2) :: trip_flow                  !!
+    INTEGER(i_std), DIMENSION(nbvmax,2)        :: outflow                    !!
+    INTEGER(i_std), DIMENSION(nbvmax)          :: outsz                      !!
+    CHARACTER(LEN=7)                           :: fmt                        !!
+    !
+    INTEGER(i_std), DIMENSION(8,2)             :: inc                        !!
+    INTEGER(i_std)                             :: itodo, ill(1), icc, ismall, ibas, iip, jjp, ib, id !! Indices (unitless)
+    INTEGER(i_std), DIMENSION(nbvmax)          :: todopt                     !!
+!$, todosz
+    REAL(r_std), DIMENSION(nbvmax)             :: todohi                     !!
+    LOGICAL                                    :: not_found, debug = .FALSE. !! (true/false)
+    !
+    !
+    !  The routing code (i=1, j=2)
+    !
+    inc(1,1) = 0
+    inc(1,2) = -1
+    inc(2,1) = 1
+    inc(2,2) = -1
+    inc(3,1) = 1
+    inc(3,2) = 0
+    inc(4,1) = 1
+    inc(4,2) = 1
+    inc(5,1) = 0
+    inc(5,2) = 1
+    inc(6,1) = -1
+    inc(6,2) = 1
+    inc(7,1) = -1
+    inc(7,2) = 0
+    inc(8,1) = -1
+    inc(8,2) = -1
+    !
+    !
+    !  Symplify the outflow conditions first. We are only interested in the
+    !  outflows which go to different GCM grid boxes.
+    !
+    IF ( debug ) THEN
+       WRITE(numout,*) '+++++++++++++++++++ BEFORE ANYTHING ++++++++++++++++++++'
+       WRITE(fmt,"('(',I3,'I6)')") nbi
+       DO jp=1,nbj
+          WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+       ENDDO
+    ENDIF
+    !
+    !  transfer the trips into an array which only contains the basin we are interested in
+    !
+    trip_tmp(:,:) = -1
+    basin_sz = 0
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( basin(ip,jp) .EQ. basin_inbxid) THEN
+             trip_tmp(ip,jp) = trip(ip,jp)
+             basin_sz = basin_sz + 1
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Determine for each point where it flows to
+    !
+    CALL routing_findrout(nbi, nbj, trip_tmp, basin_sz, basin_inbxid, nbout, outflow, trip_flow, outsz)
+    !
+    !
+    !
+    !
+    ! Over the width of a GCM grid box we can have many outflows but we are interested
+    ! in only one for each basin. Thus we wish to collect them all to form only one outflow
+    ! to the neighboring grid box.
+    !
+    DO iborder = 101,107,2
+       !
+       ! If we have more than one of these outflows then we need to merge the sub-basins
+       !
+       icc = COUNT(trip_tmp .EQ. iborder)-1
+       DO WHILE ( icc .GT. 0)
+          ! Pick out all the points we will have to do
+          itodo = 0
+          DO ip=1,nbout
+             IF (trip_tmp(outflow(ip,1),outflow(ip,2)) .EQ. iborder) THEN
+                itodo = itodo + 1
+                todopt(itodo) = ip
+!$                todosz(itodo) = outsz(ip)
+                ! We take the hierarchy of the outflow point as we will try to
+                ! minimize if for the outflow of the entire basin.
+                todohi(itodo) = hierarchy(outflow(ip,1),outflow(ip,2))
+             ENDIF
+          ENDDO
+          !
+          ! We change the direction of the smallest basin.
+          !
+          ill=MAXLOC(todohi(1:itodo))
+          ismall = todopt(ill(1))
+          !
+          DO ip=1,nbi
+             DO jp=1,nbj
+                IF ( trip_flow(ip,jp,1) .EQ. outflow(ismall,1) .AND.&
+                     & trip_flow(ip,jp,2) .EQ. outflow(ismall,2) ) THEN
+                   ! Now that we have found a point of the smallest sub-basin we 
+                   ! look around for another sub-basin
+                   ib = 1
+                   not_found = .TRUE.
+                   DO WHILE ( not_found .AND. ib .LE. itodo ) 
+                      IF ( ib .NE. ill(1) ) THEN
+                         ibas = todopt(ib)
+                         DO id=1,8
+                            iip = ip + inc(id,1)
+                            jjp = jp + inc(id,2)
+                            ! Can we look at this points or is there any need to ?
+                            IF ( iip .GE. 1 .AND. iip .LE. nbi .AND. &
+                                 & jjp .GE. 1 .AND. jjp .LE. nbj .AND. not_found) THEN
+                               ! Is this point the one we look for ?
+                               IF ( trip_flow(iip,jjp,1) .EQ. outflow(ibas,1) .AND. &
+                                    & trip_flow(iip,jjp,2) .EQ. outflow(ibas,2)) THEN
+                                  trip_flow(ip,jp,1) = outflow(ibas,1)
+                                  trip_flow(ip,jp,2) = outflow(ibas,2)
+                                  trip_tmp(ip,jp) = id
+                                  ! This last line ensures that we do not come back to this point
+                                  ! and that in the end the outer while will stop
+                                  not_found = .FALSE.
+                               ENDIF
+                            ENDIF
+                         ENDDO
+                      ENDIF
+                      ib = ib + 1
+                   ENDDO
+                ENDIF
+             ENDDO
+          ENDDO
+          !
+          icc = icc - 1
+       ENDDO
+       !
+       !
+    ENDDO
+    !
+    IF ( debug ) THEN
+       WRITE(numout,*) '+++++++++++++++++++ AFTER +++++++++++++++++++++++++++++'
+       WRITE(fmt,"('(',I3,'I6)')") nbi
+       DO jp=1,nbj
+          WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+       ENDDO
+    ENDIF
+    !
+    !  Put trip_tmp back into trip
+    !
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( trip_tmp(ip,jp) .GT. 0) THEN
+             trip(ip,jp) = trip_tmp(ip,jp)
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE routing_simplify
+!
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_cutbasin
+!!
+!>\BRIEF        This subroutine cuts the original basin which has more than one outflow
+!!              into as many subbasins as outflow directions.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_cutbasin (nbi, nbj, nbbasins, trip, basin, basin_inbxid, nb, bname, sz, pts)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                 :: nbi, nbj             !! Number of point in x and y within the grid (unitless)
+    INTEGER(i_std), INTENT(in)                 :: nbbasins             !!
+    INTEGER(i_std), INTENT(in)                 :: basin_inbxid         !!
+    !
+    !  Modified
+    INTEGER(i_std), INTENT(inout)              :: trip(:,:)            !! The trip field (unitless)
+    INTEGER(i_std), INTENT(inout)              :: basin(:,:)           !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), INTENT(out)                :: nb                   !!
+    INTEGER(i_std), INTENT(out)                :: bname(nbvmax)        !!
+    INTEGER(i_std), INTENT(out)                :: sz(nbvmax)           !!
+    INTEGER(i_std), INTENT(out)                :: pts(nbvmax,nbvmax,2) !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                             :: ip, jp, iip, jjp, ib, ibb, id, nbout !! Indices (unitless)
+    INTEGER(i_std)                             :: basin_sz             !!
+    INTEGER(i_std)                             :: nb_in                !!
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)   :: trip_tmp             !! Temporary trip field which only contains the values for the basin on which we currently work (unitless)
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2) :: trip_flow            !!
+    INTEGER(i_std), DIMENSION(nbvmax,2)        :: outflow              !!
+    INTEGER(i_std), DIMENSION(nbvmax)          :: outsz                !!
+    CHARACTER(LEN=7)                           :: fmt                  !!
+    LOGICAL                                    :: not_found            !! (true/false)
+    LOGICAL                                    :: debug=.FALSE.        !! (true/false)
+    !
+    INTEGER(i_std), DIMENSION(8,2)             :: inc                  !!
+    !
+    !
+    !  The routing code (i=1, j=2)
+    !
+    inc(1,1) = 0
+    inc(1,2) = -1
+    inc(2,1) = 1
+    inc(2,2) = -1
+    inc(3,1) = 1
+    inc(3,2) = 0
+    inc(4,1) = 1
+    inc(4,2) = 1
+    inc(5,1) = 0
+    inc(5,2) = 1
+    inc(6,1) = -1
+    inc(6,2) = 1
+    inc(7,1) = -1
+    inc(7,2) = 0
+    inc(8,1) = -1
+    inc(8,2) = -1
+    !
+    ! Set up a temporary trip field which only contains the values
+    ! for the basin on which we currently work.
+    !
+    trip_tmp(:,:) = -1
+    basin_sz = 0
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( basin(ip,jp) .EQ. basin_inbxid) THEN
+             trip_tmp(ip,jp) = trip(ip,jp)
+             basin_sz = basin_sz + 1
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    CALL routing_findrout(nbi, nbj, trip_tmp, basin_sz, basin_inbxid, nbout, outflow, trip_flow, outsz)
+    ! 
+!    IF ( debug ) THEN
+!       DO ib = nb_in+1,nb
+!          DO ip=1,sz(ib)
+!             trip_tmp(pts(ib, ip, 1),pts(ib, ip, 2)) = ib*(-1)-900
+!          ENDDO
+!       ENDDO
+!       WRITE(fmt,"('(',I3,'I6)')") nbi
+!       WRITE(numout,*)  'BEFORE ------------> New basins '
+!       WRITE(numout,*) nb, ' sz :', sz(1:nb)
+!       DO jp=1,nbj
+!          WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+!       ENDDO
+!    ENDIF
+    !
+    !  Take out the small sub-basins. That is those which have only one grid box
+    !  This is only done if we need to save space in the number of basins. Else we
+    !  can take it easy and keep diverging sub-basins for the moment. 
+    !
+    IF ( nbbasins .GE. nbasmax ) THEN
+       DO ib=1,nbout
+          ! If the sub-basin is of size one and its larger neighbor is flowing into another
+          ! direction then we put them together.
+          IF ( outsz(ib) .EQ. 1 .AND. trip(outflow(ib,1), outflow(ib,2)) .GT. 99 ) THEN
+             !
+             not_found = .TRUE.
+             DO id=1,8
+                ip = outflow(ib,1)
+                jp = outflow(ib,2)
+                iip = ip + inc(id,1)
+                jjp = jp + inc(id,2)
+                ! Can we look at this points ?
+                IF ( iip .GE. 1 .AND. iip .LE. nbi .AND. &
+                     & jjp .GE. 1 .AND. jjp .LE. nbj .AND. not_found) THEN
+                   ! Did we find a direct neighbor which is an outflow point ?
+                   IF ( trip_tmp(iip,jjp) .GT. 100 ) THEN
+                      ! IF so direct the flow towards it and update the tables.
+                      not_found = .FALSE.
+                      trip(ip,jp) = id
+                      trip_tmp(ip,jp) = id
+                      outsz(ib) = 0
+                      ! update the table of this basin
+                      DO ibb=1,nbout
+                         IF ( iip .EQ. outflow(ibb,1) .AND. jjp .EQ. outflow(ibb,2) ) THEN
+                            outsz(ibb) = outsz(ibb)+1 
+                            trip_flow(ip,jp,1) = outflow(ibb,1)
+                            trip_flow(ip,jp,2) = outflow(ibb,2)
+                         ENDIF
+                      ENDDO
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDIF
+    !
+    !
+    !  Cut the basin if we have more than 1 left.
+    !
+    !
+    IF ( COUNT(outsz(1:nbout) .GT. 0) .GT. 1 ) THEN
+       !
+       nb_in = nb
+       !
+       DO ib = 1,nbout
+          IF ( outsz(ib) .GT. 0) THEN
+             nb = nb+1
+             IF ( nb .GT. nbvmax) THEN
+                WRITE(numout,*) 'nbvmax too small, increase it (routing_cutbasin)'
+             ENDIF
+             bname(nb) = basin_inbxid
+             sz(nb) = 0
+             DO ip=1,nbi
+                DO jp=1,nbj
+                   IF ( (trip_flow(ip,jp,1) + trip_flow(ip,jp,1)) .GT. 0 .AND. &
+                      & trip_flow(ip,jp,1) .EQ. outflow(ib,1) .AND. &
+                      & trip_flow(ip,jp,2) .EQ. outflow(ib,2) ) THEN
+                      sz(nb) = sz(nb) + 1
+                      pts(nb, sz(nb), 1) = ip
+                      pts(nb, sz(nb), 2) = jp
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDIF
+       ENDDO
+       ! A short verification 
+       IF ( SUM(sz(nb_in+1:nb)) .NE. basin_sz) THEN
+          WRITE(numout,*) 'Lost some points while spliting the basin'
+          WRITE(numout,*) 'nbout :', nbout
+          DO ib = nb_in+1,nb
+             WRITE(numout,*) 'ib, SZ :', ib, sz(ib)
+          ENDDO
+          WRITE(fmt,"('(',I3,'I6)')") nbi
+          WRITE(numout,*)  '-------------> trip '
+          DO jp=1,nbj
+             WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+          ENDDO
+          CALL ipslerr_p(3,'routing_cutbasin','Lost some points while spliting the basin','','')
+       ENDIF
+       
+       IF ( debug ) THEN
+          DO ib = nb_in+1,nb
+             DO ip=1,sz(ib)
+                trip_tmp(pts(ib, ip, 1),pts(ib, ip, 2)) = ib*(-1)-900
+             ENDDO
+          ENDDO
+          WRITE(fmt,"('(',I3,'I6)')") nbi
+          WRITE(numout,*)  'AFTER-------------> New basins '
+          WRITE(numout,*) nb, ' sz :', sz(1:nb)
+          DO jp=1,nbj
+             WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+          ENDDO
+          IF ( MAXVAl(trip_tmp(1:nbi,1:nbj)) .GT. 0) THEN
+             CALL ipslerr_p(3,'routing_cutbasin','Error in debug checking','','')
+          ENDIF
+       ENDIF
+    ENDIF
+    !
+  END SUBROUTINE routing_cutbasin
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_hierarchy
+!!
+!>\BRIEF        This subroutine finds, for each point, the distance to the outflow
+!!               point along the flowlines of the basin. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_hierarchy(iml, jml, trip, topoindex, hierarchy)
+    !
+    IMPLICIT NONE
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                  :: iml          !! X resolution of the high resolution grid
+    INTEGER(i_std)                  :: jml          !! Y resolution of the high resolution grid
+    REAL(r_std), DIMENSION(iml,jml) :: trip         !! The trip field (unitless)
+    REAL(r_std), DIMENSION(iml,jml) :: hierarchy    !!
+    REAL(r_std), DIMENSION(iml,jml) :: topoindex    !! Topographic index of the residence time (m)
+    !
+    INTEGER(i_std), DIMENSION(8,2)  :: inc          !!
+    INTEGER(i_std)                  :: ip, jp, ib, ntripi, ntripj, cnt, trp !!
+    REAL(r_std)                     :: topohier     !! The new value of topographically weighted hierarchy (m)
+    REAL(r_std)                     :: topohier_old !! The old value of topographically weighted hierarchy (m)
+    CHARACTER(LEN=7)                :: fmt          !!
+    !
+    !  The routing code (i=1, j=2)
+    !
+    inc(1,1) = 0
+    inc(1,2) = -1
+    inc(2,1) = 1
+    inc(2,2) = -1
+    inc(3,1) = 1
+    inc(3,2) = 0
+    inc(4,1) = 1
+    inc(4,2) = 1
+    inc(5,1) = 0
+    inc(5,2) = 1
+    inc(6,1) = -1
+    inc(6,2) = 1
+    inc(7,1) = -1
+    inc(7,2) = 0
+    inc(8,1) = -1
+    inc(8,2) = -1
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          IF ( trip(ip,jp) .LT. undef_sechiba ) THEN
+             ntripi = ip
+             ntripj = jp
+             trp = NINT(trip(ip,jp))
+             cnt = 1
+             ! Warn for extreme numbers
+             IF (  topoindex(ip,jp) .GT. 1.e10 ) THEN
+                WRITE(numout,*) 'We have a very large topographic index for point ', ip, jp
+                WRITE(numout,*) 'This can not be right :', topoindex(ip,jp)
+                CALL ipslerr_p(3,'routing_hierarchy','Too large topographic index','','')
+             ELSE
+                topohier = topoindex(ip,jp)
+             ENDIF
+             !
+             DO WHILE ( trp .GT. 0 .AND. trp .LT. 9 .AND. cnt .LT. iml*jml) 
+                cnt = cnt + 1
+                ntripi = ntripi + inc(trp,1)
+                IF ( ntripi .LT. 1) ntripi = iml
+                IF ( ntripi .GT. iml) ntripi = 1
+                ntripj = ntripj + inc(trp,2)
+                topohier_old = topohier
+                topohier = topohier + topoindex(ntripi, ntripj)
+                IF ( topohier_old .GT. topohier) THEN
+                   WRITE(numout,*) 'Big Problem, how comes we climb up a hill ?'
+                   WRITE(numout,*) 'The old value of topographicaly weighted hierarchy was : ', topohier_old
+                   WRITE(numout,*) 'The new one is :', topohier
+                   CALL ipslerr_p(3,'routing_hierarchy','Big Problem, how comes we climb up a hill ?','','')
+                ENDIF
+                trp = NINT(trip(ntripi, ntripj))
+             ENDDO
+             
+             IF ( cnt .EQ. iml*jml) THEN
+                WRITE(numout,*) 'We could not route point (routing_findrout) :', ip, jp
+                WRITE(numout,*) '-------------> trip '
+                WRITE(fmt,"('(',I3,'I6)')") iml
+                DO ib=1,jml
+                   WRITE(numout,fmt) trip(1:iml,ib)
+                ENDDO
+                CALL ipslerr_p(3,'routing_hierarchy','We could not route point','','')
+             ENDIF
+             
+             hierarchy(ip,jp) = topohier
+             
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    !
+  END SUBROUTINE routing_hierarchy
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_findrout
+!!
+!>\BRIEF        This subroutine simply computes the route to each outflow point
+!!              and returns the outflow point for each point in the basin.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_findrout(nbi, nbj, trip, basin_sz, basinid, nbout, outflow, trip_flow, outsz)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std)                                          :: nbi       !! Number of point in x within the grid (unitless)
+    INTEGER(i_std)                                          :: nbj       !! Number of point in y within the grid (unitless)
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)                :: trip      !! The trip field (unitless)
+    INTEGER(i_std)                                          :: basin_sz  !!
+    INTEGER(i_std)                                          :: basinid   !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), DIMENSION(nbvmax,2), INTENT(out)        :: outflow   !!
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2), INTENT(out) :: trip_flow !!
+    INTEGER(i_std), INTENT(out)                             :: nbout     !! 
+    INTEGER(i_std), DIMENSION(nbvmax), INTENT(out)          :: outsz     !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std), DIMENSION(8,2)                          :: inc       !!
+    INTEGER(i_std)                                          :: ip, jp, ib, cnt, trp, totsz !! Indices (unitless)
+    CHARACTER(LEN=7)                                        :: fmt       !!
+    !
+    !
+    !  The routing code (i=1, j=2)
+    !
+    inc(1,1) = 0
+    inc(1,2) = -1
+    inc(2,1) = 1
+    inc(2,2) = -1
+    inc(3,1) = 1
+    inc(3,2) = 0
+    inc(4,1) = 1
+    inc(4,2) = 1
+    inc(5,1) = 0
+    inc(5,2) = 1
+    inc(6,1) = -1
+    inc(6,2) = 1
+    inc(7,1) = -1
+    inc(7,2) = 0
+    inc(8,1) = -1
+    inc(8,2) = -1
+    !
+    !
+    !  Get the outflows and determine for each point to which outflow point it belong 
+    !
+    nbout = 0
+    trip_flow(:,:,:) = 0
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( trip(ip,jp) .GT. 9) THEN
+             nbout = nbout + 1
+             outflow(nbout,1) = ip
+             outflow(nbout,2) = jp
+          ENDIF 
+          IF ( trip(ip,jp) .GT. 0) THEN
+             trip_flow(ip,jp,1) = ip
+             trip_flow(ip,jp,2) = jp
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Follow the flow of the water
+    !
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( (trip_flow(ip,jp,1) + trip_flow(ip,jp,2)) .GT. 0) THEN
+             trp = trip(trip_flow(ip,jp,1), trip_flow(ip,jp,2))
+             cnt = 0
+             DO WHILE ( trp .GT. 0 .AND. trp .LT. 9 .AND. cnt .LT. nbi*nbj) 
+                cnt = cnt + 1
+                trip_flow(ip,jp,1) = trip_flow(ip,jp,1) + inc(trp,1)
+                trip_flow(ip,jp,2) = trip_flow(ip,jp,2) + inc(trp,2)
+                trp = trip(trip_flow(ip,jp,1), trip_flow(ip,jp,2))
+             ENDDO
+             IF ( cnt .EQ. nbi*nbj) THEN
+                WRITE(numout,*) 'We could not route point (routing_findrout) :', ip, jp
+                WRITE(numout,*) '-------------> trip '
+                WRITE(fmt,"('(',I3,'I6)')") nbi
+                DO ib=1,nbj
+                   WRITE(numout,fmt) trip(1:nbi,ib)
+                ENDDO
+                CALL ipslerr_p(3,'routing_findrout','We could not route point','','')
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    !  What is the size of the region behind each outflow point ?
+    !
+    totsz = 0
+    DO ip=1,nbout
+       outsz(ip) = COUNT(trip_flow(:,:,1) .EQ. outflow(ip,1) .AND. trip_flow(:,:,2) .EQ. outflow(ip,2))
+       totsz = totsz + outsz(ip)
+    ENDDO
+    IF ( basin_sz .NE. totsz) THEN
+       WRITE(numout,*) 'Water got lost while I tried to follow it '
+       WRITE(numout,*) basin_sz, totsz
+       WRITE(numout,*) 'Basin id :', basinid
+       DO ip=1,nbout
+          WRITE(numout,*) 'ip :', ip, ' outsz :', outsz(ip), ' outflow :', outflow(ip,1), outflow(ip,2)
+       ENDDO
+       WRITE(numout,*) '-------------> trip '
+       WRITE(fmt,"('(',I3,'I6)')") nbi
+       DO jp=1,nbj
+          WRITE(numout,fmt) trip(1:nbi,jp)
+       ENDDO
+       CALL ipslerr_p(3,'routing_findrout','Water got lost while I tried to follow it','','')
+    ENDIF
+    !
+  END SUBROUTINE routing_findrout
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_globalize
+!!
+!>\BRIEF        This subroutine puts the basins found for grid box in the global map.
+!!               Connection can only be made later when all information is together. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!! One of the outputs is basin_flowdir. Its convention is 1-8 for the directions from North to North
+!! West going through South. The negative values will be -3 for return flow, -2 for coastal flow
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_globalize(nbpt, ib, neighbours, area_bx, trip_bx, hierarchy_bx, topoind_bx, min_topoind,&
+       & nb_basin, basin_inbxid, basin_sz, basin_pts, basin_bxout, coast_pts, nwbas, basin_count,&
+       & basin_area, basin_hierarchy, basin_topoind, basin_id, basin_flowdir, outflow_grid,&
+       & nbcoastal, coastal_basin)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT (in)                :: nbpt                   !! Domain size (unitless)
+    INTEGER(i_std), INTENT (in)                :: ib                     !! Current basin (unitless)
+    INTEGER(i_std), INTENT(in)                 :: neighbours(nbpt,8)     !! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    !
+!! LOCAL VARIABLES 
+    REAL(r_std), DIMENSION(nbvmax,nbvmax)      :: area_bx                !! Area of each small box in the grid box @tex $(m^2})$ @endtex
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)   :: trip_bx                !! The trip field for each of the smaller boxes (unitless)
+    REAL(r_std), DIMENSION(nbvmax,nbvmax)      :: hierarchy_bx           !! Level in the basin of the point
+    REAL(r_std), DIMENSION(nbvmax,nbvmax)      :: topoind_bx             !! Topographic index of the residence time for each of the smaller boxes (m)
+    REAL(r_std)                                :: min_topoind            !! The current minimum of topographic index (m)
+    INTEGER(i_std)                             :: nb_basin               !! Number of sub-basins (unitless)
+    INTEGER(i_std), DIMENSION(nbvmax)          :: basin_inbxid, basin_sz !! ID of basin, number of points in the basin
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2) :: basin_pts              !! Points in each basin
+    INTEGER(i_std), DIMENSION(nbvmax)          :: basin_bxout            !! outflow direction
+    INTEGER(i_std)                             :: coast_pts(nbvmax)      !! The coastal flow points (unitless)
+    ! global maps
+    INTEGER(i_std)                             :: nwbas                  !!
+    INTEGER(i_std), DIMENSION(nbpt)            :: basin_count            !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)      :: basin_id               !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)      :: basin_flowdir          !! Water flow directions in the basin (unitless)
+    REAL(r_std), DIMENSION(nbpt,nwbas)         :: basin_area             !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)         :: basin_hierarchy        !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)         :: basin_topoind          !! Topographic index of the residence time for a basin (m)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)      :: outflow_grid           !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt)            :: nbcoastal              !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)      :: coastal_basin          !!
+    !
+    INTEGER(i_std)                             :: ij, iz                 !! Indices (unitless)
+    CHARACTER(LEN=4)                           :: hierar_method = 'OUTP' !!
+    !
+    !
+    DO ij=1, nb_basin
+       !
+       ! Count the basins and keep their ID
+       !
+       basin_count(ib) = basin_count(ib)+1
+       if (basin_count(ib) > nwbas) then 
+          WRITE(numout,*) 'ib=',ib
+          call ipslerr(3,'routing_globalize', &
+               &      'Problem with basin_count : ', & 
+               &      'It is greater than number of allocated basin nwbas.', &
+               &      '(stop to count basins)')
+       endif 
+       basin_id(ib,basin_count(ib)) = basin_inbxid(ij)
+       !
+       ! Transfer the list of basins which flow into the ocean as coastal flow.
+       !
+       IF ( basin_id(ib,basin_count(ib)) .LT. 0) THEN
+          nbcoastal(ib) = basin_sz(ij)
+          coastal_basin(ib,1:nbcoastal(ib)) = coast_pts(1:nbcoastal(ib))
+       ENDIF
+       !
+       !
+       ! Compute the area of the basin
+       !
+       basin_area(ib,ij) = zero
+       basin_hierarchy(ib,ij) = zero
+       !
+       SELECT CASE (hierar_method)
+          !
+          CASE("MINI")
+             basin_hierarchy(ib,ij) = undef_sechiba
+          !
+       END SELECT
+       basin_topoind(ib,ij) = zero
+       !
+       DO iz=1,basin_sz(ij)
+          !
+          basin_area(ib,ij) = basin_area(ib,ij) + area_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+          basin_topoind(ib,ij) = basin_topoind(ib,ij) + topoind_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+          !
+          ! There are a number of ways to determine the hierarchy of the entire basin.
+          ! We allow for three here :
+          !     - Take the mean value
+          !     - Take the minimum value within the basin
+          !     - Take the value at the outflow point
+          ! Probably taking the value of the outflow point is the best solution.
+          !
+          SELECT CASE (hierar_method)
+             !
+             CASE("MEAN")
+                ! Mean hierarchy of the basin
+                basin_hierarchy(ib,ij) = basin_hierarchy(ib,ij) + &
+                     & hierarchy_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+             CASE("MINI")
+                ! The smallest value of the basin
+                IF ( hierarchy_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2)) .LT. basin_hierarchy(ib,ij)) THEN
+                   basin_hierarchy(ib,ij) = hierarchy_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+                ENDIF
+             CASE("OUTP")
+                ! Value at the outflow point
+                IF ( trip_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2)) .GT. 100 ) THEN
+                   basin_hierarchy(ib,ij) = hierarchy_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+                ENDIF
+             CASE DEFAULT
+                WRITE(numout,*) 'Unknown method for computing the hierarchy of the basin'
+                CALL ipslerr_p(3,'routing_globalize','Unknown method for computing the hierarchy of the basin','','')
+          END SELECT
+          !
+       ENDDO
+       !
+       basin_topoind(ib,ij) = basin_topoind(ib,ij)/REAL(basin_sz(ij),r_std)
+       !
+       SELECT CASE (hierar_method)
+          !
+          CASE("MEAN")
+             basin_hierarchy(ib,ij) = basin_hierarchy(ib,ij)/REAL(basin_sz(ij),r_std)
+          !
+       END SELECT
+       !
+       ! To make sure that it has the lowest number if this is an outflow point we reset  basin_hierarchy
+       !
+       IF (basin_bxout(ij) .LT. 0) THEN
+          basin_hierarchy(ib,ij) = min_topoind
+          basin_topoind(ib,ij) = min_topoind
+       ENDIF
+       !
+       !
+       ! Keep the outflow boxes and basin
+       !
+       basin_flowdir(ib,ij) = basin_bxout(ij)
+       IF (basin_bxout(ij) .GT. 0) THEN
+          outflow_grid(ib,ij) = neighbours(ib,basin_bxout(ij))
+       ELSE
+          outflow_grid(ib,ij) = basin_bxout(ij)
+       ENDIF
+       !
+       !
+    ENDDO
+    !
+
+    !
+  END SUBROUTINE routing_globalize
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_linkup
+!!
+!>\BRIEF         This subroutine makes the connections between the basins and ensure global coherence. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!! The convention for outflow_grid is :
+!! outflow_grid = -1 : River flow
+!! outflow_grid = -2 : Coastal flow
+!! outflow_grid = -3 : Return flow\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_linkup(nbpt, neighbours, nwbas, basin_count, basin_area, basin_id, basin_flowdir, &
+       & basin_hierarchy, outflow_grid, outflow_basin, inflow_number, inflow_grid, inflow_basin, nbcoastal,&
+       & coastal_basin, invented_basins)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT (in)                    :: nbpt                  !! Domain size  (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,8), INTENT (in) :: neighbours            !!
+    REAL(r_std), INTENT(in)                        :: invented_basins       !!
+    !
+    INTEGER(i_std)                                 :: nwbas                 !!
+    INTEGER(i_std), DIMENSION(nbpt)                :: basin_count           !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: basin_id              !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: basin_flowdir         !! Water flow directions in the basin (unitless)
+    REAL(r_std), DIMENSION(nbpt,nwbas)             :: basin_area            !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)             :: basin_hierarchy       !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: outflow_grid          !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: outflow_basin         !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: inflow_number         !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nbvmax)   :: inflow_basin          !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nbvmax)   :: inflow_grid           !!
+    INTEGER(i_std), DIMENSION(nbpt)                :: nbcoastal             !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: coastal_basin         !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                                 :: sp, sb, sbl, inp, bid, outdm1, outdp1 !! Indices (unitless)
+    INTEGER(i_std)                                 :: dp1, dm1, dm1i, dp1i, bp1, bm1 !! Indices (unitless)
+    INTEGER(i_std)                                 :: dop, bop              !!
+    INTEGER(i_std)                                 :: fbas(nwbas), nbfbas   !!
+    REAL(r_std)                                    :: fbas_hierarchy(nwbas) !!
+    INTEGER(i_std)                                 :: ff(1)                 !!
+    !
+    ! ERRORS 
+    LOGICAL                                        :: error1, error2, error3, error4, error5 !! (true/false)
+    !
+!! PARAMETERS
+    LOGICAL, PARAMETER                             :: check = .FALSE.       !! (true/false)
+    
+    error1=.FALSE.
+    error2=.FALSE.
+    error3=.FALSE.
+    error4=.FALSE.
+    error5=.FALSE.
+
+    outflow_basin(:,:) = undef_int
+    inflow_number(:,:) = 0
+    !
+    DO sp=1,nbpt
+       DO sb=1,basin_count(sp)
+          !
+          inp = outflow_grid(sp,sb)
+          bid = basin_id(sp,sb)
+          !
+          ! We only work on this point if it does not flow into the ocean
+          ! At this point any of the outflows is designated by a negative values in
+          ! outflow_grid
+          !
+          IF ( inp .GT. 0 ) THEN
+             !
+             ! Now find the basin in the onflow point (inp)
+             !
+             nbfbas = 0
+             !
+             !
+             DO sbl=1,basin_count(inp)
+                !
+                ! Either it is a standard basin or one aggregated from ocean flow points.
+                ! If we flow into a another grid box we have to make sure that its hierarchy in the
+                ! basin is lower.
+                !
+                !
+                IF ( basin_id(inp,sbl) .GT. 0 ) THEN
+                   IF ( basin_id(inp,sbl) .EQ. bid .OR. basin_id(inp,sbl) .GT. invented_basins) THEN
+                      nbfbas =nbfbas + 1
+                      fbas(nbfbas) = sbl
+                      fbas_hierarchy(nbfbas) = basin_hierarchy(inp,sbl)
+                   ENDIF
+                ELSE
+                   IF ( COUNT(coastal_basin(inp,1:nbcoastal(inp)) .EQ. bid) .GT. 0 ) THEN
+                      nbfbas =nbfbas + 1
+                      fbas(nbfbas) = sbl
+                      fbas_hierarchy(nbfbas) = basin_hierarchy(inp,sbl)
+                   ENDIF
+                ENDIF
+                !
+             ENDDO
+             ! 
+             !  If we have more than one basin we will take the one which is lowest
+             !  in the hierarchy.
+             !
+             IF (nbfbas .GE. 1) THEN
+                ff = MINLOC(fbas_hierarchy(1:nbfbas))
+                sbl = fbas(ff(1))
+                !
+                bop = undef_int
+                IF ( basin_hierarchy(inp,sbl) .LE. basin_hierarchy(sp,sb) ) THEN
+                   IF ( basin_hierarchy(inp,sbl) .LE. basin_hierarchy(sp,sb) ) THEN
+                      bop = sbl
+                   ELSE
+                      ! The same hierarchy is allowed if both grids flow in about 
+                      ! the same direction :
+                      IF ( ( MOD(basin_flowdir(inp,sbl)+1-1, 8)+1 .EQ. basin_flowdir(sp,sb)).OR. &
+                           & ( basin_flowdir(inp,sbl) .EQ. basin_flowdir(sp,sb)).OR. &
+                           & ( MOD(basin_flowdir(inp,sbl)+7-1, 8)+1 .EQ. basin_flowdir(sp,sb)) ) THEN
+                         bop = sbl
+                      ENDIF
+                   ENDIF
+                ENDIF
+                !
+                ! If the basin is suitable (bop < undef_int) then take it
+                !
+                IF ( bop .LT. undef_int ) THEN
+                   outflow_basin(sp,sb) = bop
+                   inflow_number(inp,bop) =  inflow_number(inp,bop) + 1
+                   IF ( inflow_number(inp,bop) .LE. nbvmax ) THEN
+                      inflow_grid(inp, bop, inflow_number(inp,bop)) = sp
+                      inflow_basin(inp, bop, inflow_number(inp,bop)) = sb
+                   ELSE
+                      error1=.TRUE.
+                      EXIT
+                   ENDIF
+                ENDIF
+             ENDIF
+             !
+             !
+          ENDIF
+          !
+          !
+          !
+          ! Did we find it ?
+          !
+          ! In case the outflow point was ocean or we did not find the correct basin we start to look
+          ! around. We find two options for the outflow direction (dp1 & dm1) and the corresponding 
+          ! basin index (bp1 & bm1).
+          !
+          !
+          IF ( outflow_basin(sp,sb) .EQ. undef_int &
+               & .AND. basin_flowdir(sp,sb) .GT. 0) THEN
+             !
+             dp1i = MOD(basin_flowdir(sp,sb)+1-1, 8)+1
+             dp1 = neighbours(sp,dp1i)
+             dm1i = MOD(basin_flowdir(sp,sb)+7-1, 8)+1
+             IF ( dm1i .LT. 1 ) dm1i = 8
+             dm1 = neighbours(sp,dm1i)
+             !
+             !
+             bp1 = -1
+             IF ( dp1 .GT. 0 ) THEN
+                DO sbl=1,basin_count(dp1)
+                   IF (basin_id(dp1,sbl) .EQ. bid .AND.&
+                        & basin_hierarchy(sp,sb) .GE. basin_hierarchy(dp1,sbl) .AND. &
+                        & bp1 .LT. 0) THEN
+                      IF ( basin_hierarchy(sp,sb) .GT. basin_hierarchy(dp1,sbl) ) THEN
+                         bp1 = sbl
+                      ELSE
+                         ! The same hierarchy is allowed if both grids flow in about 
+                         ! the same direction :
+                         IF ( ( MOD(basin_flowdir(dp1,sbl)+1-1, 8)+1 .EQ. basin_flowdir(sp,sb)).OR. &
+                            & ( basin_flowdir(dp1,sbl) .EQ. basin_flowdir(sp,sb)).OR. &
+                            & ( MOD(basin_flowdir(dp1,sbl)+7-1, 8)+1 .EQ. basin_flowdir(sp,sb)) ) THEN
+                            bp1 = sbl
+                         ENDIF
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDIF
+             !
+             bm1 = -1
+             IF ( dm1 .GT. 0 ) THEN
+                DO sbl=1,basin_count(dm1)
+                   IF (basin_id(dm1,sbl) .EQ. bid .AND.&
+                        & basin_hierarchy(sp,sb) .GE. basin_hierarchy(dm1,sbl) .AND. &
+                        & bm1 .LT. 0) THEN
+                      IF ( basin_hierarchy(sp,sb) .GT. basin_hierarchy(dm1,sbl) ) THEN
+                         bm1 = sbl
+                      ELSE                         
+                         ! The same hierarchy is allowed if both grids flow in about 
+                         ! the same direction :
+                         IF ( ( MOD(basin_flowdir(dm1,sbl)+1-1, 8)+1 .EQ. basin_flowdir(sp,sb)) .OR. &
+                            & ( basin_flowdir(dm1,sbl) .EQ. basin_flowdir(sp,sb)) .OR. &
+                            & ( MOD(basin_flowdir(dm1,sbl)+7-1, 8)+1 .EQ. basin_flowdir(sp,sb)) ) THEN
+                            bm1 = sbl
+                         ENDIF
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDIF
+             !
+             !
+             ! First deal with the case on land.
+             !
+             ! For that we need to check if the water will be able to flow out of the grid dp1 or dm1 
+             ! and not return to our current grid. If it is the current grid
+             ! then we can not do anything with that neighbour. Thus we set the
+             ! value of outdm1 and outdp1 back to -1
+             !
+             outdp1 = undef_int
+             IF ( dp1 .GT. 0 .AND. bp1 .GT. 0 ) THEN
+                ! if the outflow is into the ocean then we put something less than undef_int in outdp1!
+                IF (basin_flowdir(dp1,bp1) .GT. 0) THEN
+                   outdp1 = neighbours(dp1,basin_flowdir(dp1,bp1))
+                   IF ( outdp1 .EQ. sp ) outdp1 = undef_int 
+                ELSE
+                   outdp1 = nbpt + 1
+                ENDIF
+             ENDIF
+             outdm1 = undef_int
+             IF ( dm1 .GT. 0 .AND. bm1 .GT. 0 ) THEN
+                IF (basin_flowdir(dm1,bm1) .GT. 0) THEN
+                   outdm1 = neighbours(dm1,basin_flowdir(dm1,bm1))
+                   IF ( outdm1 .EQ. sp )  outdm1 = undef_int
+                ELSE
+                   outdm1 = nbpt + 1
+                ENDIF
+             ENDIF
+             !
+             ! Now that we know our options we need go through them.
+             !
+             dop = undef_int
+             bop = undef_int
+             IF ( outdp1 .LT. undef_int .AND. outdm1 .LT. undef_int) THEN
+                ! 
+                ! In this case we let the current basin flow into the smaller one
+                !
+                IF ( basin_area(dp1,bp1) .LT.  basin_area(dm1,bm1) ) THEN
+                   dop = dp1
+                   bop = bp1
+                ELSE
+                   dop = dm1
+                   bop = bm1
+                ENDIF
+                !
+                !
+             ELSE IF (  outdp1 .LT. undef_int ) THEN
+                ! If only the first one is possible
+                dop = dp1
+                bop = bp1
+             ELSE IF ( outdm1 .LT. undef_int ) THEN
+                ! If only the second one is possible
+                dop = dm1
+                bop = bm1
+             ELSE
+                !
+                ! Now we are at the point where none of the neighboring points is suitable 
+                ! or we have a coastal point.
+                !
+                ! If there is an option to put the water into the ocean go for it.
+                !
+                IF ( outflow_grid(sp,sb) .LT. 0 .OR. dm1 .LT. 0 .OR. dp1 .LT. 0 ) THEN
+                   dop = -1
+                ELSE
+                   !
+                   ! If we are on a land point with only land neighbors but no one suitable to let the 
+                   ! water flow into we have to look for a solution in the current grid box.
+                   ! 
+                   !
+                   IF ( bp1 .LT. 0 .AND. bm1 .LT. 0 ) THEN
+                      !
+                      ! Do we have more than one basin with the same ID ?
+                      !
+                      IF ( COUNT(basin_id(sp,1:basin_count(sp)) .EQ. bid) .GE. 2) THEN
+                         !
+                         ! Now we can try the option of flowing into the basin of the same grid box.
+                         !
+                         DO sbl=1,basin_count(sp)
+                            IF (sbl .NE. sb .AND. basin_id(sp,sbl) .EQ. bid) THEN
+                               ! In case this basin has a lower hierarchy or flows into a totaly
+                               ! different direction we go for it.
+                               IF ( (basin_hierarchy(sp,sb) .GE. basin_hierarchy(sp,sbl)) .OR. &
+                                    & (basin_flowdir(sp,sbl) .LT. dm1i .AND.&
+                                    & basin_flowdir(sp,sbl) .GT. dp1i) ) THEN
+                                  dop = sp
+                                  bop = sbl
+                                  IF (check) THEN
+                                     IF (basin_hierarchy(sp,sb) .LT. basin_hierarchy(sp,sbl)) THEN
+                                        WRITE(numout,*) '>>>>>>> POINT CORRECTED against hierarchy :',&
+                                             & sp, sb, 'into', sbl
+                                     ENDIF
+                                  ENDIF
+                               ENDIF
+                               !
+                            ENDIF
+                         ENDDO
+                         !
+                      ENDIF
+                   ENDIF
+                ENDIF
+                !
+                IF ( dop .EQ. undef_int .AND. bop .EQ. undef_int ) THEN
+                   IF (check) THEN
+                      WRITE(numout,*) 'Why are we here with point ', sp, sb
+                      WRITE(numout,*) 'Coordinates : (lon,lat) = ', lalo(sp,2), lalo(sp,1)
+                      WRITE(numout,*) 'Contfrac : = ', contfrac(sp)
+                      WRITE(numout,*) 'Local Basin ID :', basin_id(sp,1:basin_count(sp))
+                      WRITE(numout,*) 'Local hierarchies :', basin_hierarchy(sp,1:basin_count(sp))
+                      WRITE(numout,*) 'Local basin_flowdir :', basin_flowdir(sp,1:basin_count(sp))
+                      WRITE(numout,*) 'Local outflowgrid :', outflow_grid(sp,1:basin_count(sp))
+                      WRITE(numout,*) 'outflow_grid :', inp
+                      WRITE(numout,*) 'Coodinates outflow : (lon,lat) = ', lalo(inp,2), lalo(inp,1)
+                      WRITE(numout,*) 'Contfrac : = ', contfrac(inp)
+                      WRITE(numout,*) 'Outflow Basin ID :', basin_id(inp,1:basin_count(inp))
+                      WRITE(numout,*) 'Outflow hierarchies :', basin_hierarchy(inp,1:basin_count(inp))
+                      WRITE(numout,*) 'Outflow basin_flowdir :', basin_flowdir(inp,1:basin_count(inp))
+                      WRITE(numout,*) 'Explored options +1 :', dp1, bp1, outdp1
+                      WRITE(numout,*) 'Explored +1 Basin ID :', basin_id(dp1,1:basin_count(dp1))
+                      WRITE(numout,*) 'Explored +1 hierarchies :', basin_hierarchy(dp1,1:basin_count(dp1))
+                      WRITE(numout,*) 'Explored +1 basin_flowdir :', basin_flowdir(dp1,1:basin_count(dp1))
+                      WRITE(numout,*) 'Explored options -1 :', dm1, bm1, outdm1
+                      WRITE(numout,*) 'Explored -1 Basin ID :', basin_id(dm1,1:basin_count(dm1))
+                      WRITE(numout,*) 'Explored -1 hierarchies :', basin_hierarchy(dm1,1:basin_count(dm1))
+                      WRITE(numout,*) 'Explored -1 basin_flowdir :', basin_flowdir(dm1,1:basin_count(dm1))
+                      WRITE(numout,*) '****************************'
+                   ENDIF
+                   IF ( contfrac(sp) > 0.01 ) THEN
+                      error2=.TRUE.
+                      EXIT
+                   ENDIF
+                ENDIF
+                !
+             ENDIF
+             !
+             ! Now that we know where we want the water to flow to we write the
+             ! the information in the right fields.
+             !
+             IF ( dop .GT. 0 .AND. dop .NE. undef_int ) THEN
+                outflow_grid(sp,sb) = dop
+                outflow_basin(sp,sb) = bop
+                inflow_number(dop,bop) =  inflow_number(dop,bop) + 1
+                IF ( inflow_number(dop,bop) .LE. nbvmax ) THEN
+                   inflow_grid(dop, bop, inflow_number(dop,bop)) = sp
+                   inflow_basin(dop, bop, inflow_number(dop,bop)) = sb
+                ELSE
+                   error3=.TRUE.
+                   EXIT
+                ENDIF
+                !
+             ELSE
+                outflow_grid(sp,sb) = -2
+                outflow_basin(sp,sb) = undef_int
+             ENDIF
+             !
+          ENDIF
+          !
+          !
+          ! If we still have not found anything then we have to check that there is not a basin
+          ! within the same grid box which has a lower hierarchy.
+          !
+          !
+          IF ( outflow_grid(sp,sb) .GT. 0 .AND. outflow_basin(sp,sb) .EQ. undef_int &
+               & .AND. basin_flowdir(sp,sb) .GT. 0) THEN
+             !
+             
+             IF (check) &
+                  WRITE(numout,*) 'There is no reason to here, this part of the code should be dead :', sp,sb
+             !
+             DO sbl=1,basin_count(sp)
+                !
+                ! Three conditions are needed to let the water flow into another basin of the
+                ! same grid :
+                ! - another basin than the current one
+                ! - same ID
+                ! - of lower hierarchy.
+                !
+                IF ( (sbl .NE. sb) .AND. (basin_id(sp,sbl) .EQ. bid)&
+                     & .AND. (basin_hierarchy(sp,sb) .GT. basin_hierarchy(sp,sbl)) ) THEN
+                   outflow_basin(sp,sb) = sbl
+                   inflow_number(sp,sbl) =  inflow_number(sp,sbl) + 1
+                   IF ( inflow_number(sp,sbl) .LE. nbvmax ) THEN
+                      IF ( sp .EQ. 42 .AND. sbl .EQ. 1) THEN
+                         IF (check) &
+                              WRITE(numout,*) 'ADD INFLOW (3):', sp, sb
+                      ENDIF
+                      inflow_grid(sp, sbl, inflow_number(sp,sbl)) = sp
+                      inflow_basin(sp, sbl, inflow_number(sp,sbl)) = sb
+                   ELSE
+                      error4=.TRUE.
+                      EXIT
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDIF
+          !
+          ! Ok that is it, we give up :-)
+          !
+          IF ( outflow_grid(sp,sb) .GT. 0 .AND. outflow_basin(sp,sb) .EQ. undef_int &
+               & .AND. basin_flowdir(sp,sb) .GT. 0) THEN
+             !
+             error5=.TRUE.
+             EXIT
+          ENDIF
+       ENDDO
+       !
+    ENDDO
+    IF (error1) THEN
+       WRITE(numout,*) " routing_linkup : bop .LT. undef_int",bop
+       CALL ipslerr(3,'routing_linkup', &
+            "bop .LT. undef_int",'Increase nbvmax','stop routing_linkup')
+    ENDIF
+    IF (error2) THEN
+       CALL ipslerr(3,'routing_linkup', &
+            &      'In the routine which make connections between the basins and ensure global coherence,', & 
+            &      'there is a problem with outflow linkup without any valid direction. Try with check=.TRUE.', &
+            &      '(Perhaps there is a problem with the grid.)')
+    ENDIF
+    IF (error3) THEN
+       WRITE(numout,*) " routing_linkup : dop .GT. 0 .AND. dop .NE. undef_int",dop
+       CALL ipslerr(3,'routing_linkup', &
+            "dop .GT. 0 .AND. dop .NE. undef_int",'Increase nbvmax. Try with check=.TRUE.','stop routing_linkup')
+    ENDIF
+    IF (error4) THEN
+       WRITE(numout,*) " routing_linkup : (sbl .NE. sb) .AND. (basin_id(sp,sbl) .EQ. bid) ", & 
+            &  " .AND. (basin_hierarchy(sp,sb) .GT. basin_hierarchy(sp,sbl))",sbl,sb,basin_id(sp,sbl),bid, & 
+            &  basin_hierarchy(sp,sb),basin_hierarchy(sp,sbl)
+       CALL ipslerr(3,'routing_linkup', &
+            "(sbl .NE. sb) .AND. (basin_id(sp,sbl) .EQ. bid) .AND. (basin_hierarchy(sp,sb) .GT. basin_hierarchy(sp,sbl))" &
+            ,'Increase nbvmax. Try with check=.TRUE.','stop routing_linkup')
+    ENDIF
+    IF (error5) THEN
+       WRITE(numout,*) 'We could not find the basin into which we need to flow'
+       WRITE(numout,*) 'Grid point ', sp, ' and basin ', sb
+       WRITE(numout,*) 'Explored neighbours :', dm1, dp1 
+       WRITE(numout,*) 'Outflow direction :', basin_flowdir(sp,sb)
+       WRITE(numout,*) 'Outlfow grid :', outflow_grid(sp,sb)
+       WRITE(numout,*) 'Outlfow basin :',outflow_basin(sp,sb)
+       WRITE(numout,*) 'basin ID:',basin_id(sp,sb)
+       WRITE(numout,*) 'Hierarchy :', basin_hierarchy(sp,sb)
+       CALL ipslerr(3,'routing_linkup', &
+            "We could not find the basin into which we need to flow",'Try with check=.TRUE.','stop routing_linkup')
+    ENDIF
+    !
+    ! Check for each outflow basin that it exists
+    !
+    DO sp=1,nbpt
+       DO sb=1,basin_count(sp)
+          !
+          inp = outflow_grid(sp,sb)
+          sbl = outflow_basin(sp,sb)
+          IF ( inp .GE. 0 ) THEN
+             IF ( basin_count(inp) .LT. sbl ) THEN
+                WRITE(numout,*) 'point :', sp, ' basin :', sb
+                WRITE(numout,*) 'Flows into point :', inp, ' basin :', sbl
+                WRITE(numout,*) 'But it flows into now here as basin count = ', basin_count(inp)
+                CALL ipslerr_p(3,'routing_linkup','Problem with outflow','','')
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE routing_linkup
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_fetch
+!!
+!>\BRIEF        This subroutine computes the fetch of each basin. This means that for each basin we
+!!               will know how much area is upstream. It will help decide how to procede with the
+!!               the truncation later and allow to set correctly in outflow_grid the distinction
+!!               between coastal and river flow. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_fetch(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_id,&
+       & outflow_grid, outflow_basin, fetch_basin)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                           :: nbpt          !! Domain size  (unitless)
+    !
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in)           :: resolution    !! The size of each grid box in X and Y (m)
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)             :: contfrac      !! Fraction of land in each grid box (unitless;0-1)
+    !
+    INTEGER(i_std)                                       :: nwbas         !!
+    INTEGER(i_std), DIMENSION(nbpt), INTENT(in)          :: basin_count   !!
+    REAL(r_std), DIMENSION(nbpt,nwbas), INTENT(inout)    :: basin_area    !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas), INTENT(in)    :: basin_id      !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas), INTENT(inout) :: outflow_grid  !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas), INTENT(in)    :: outflow_basin !!
+!
+!! OUTPUT VARIABLES
+    REAL(r_std), DIMENSION(nbpt,nwbas), INTENT(out)      :: fetch_basin   !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                                        :: ib, ij, ff(1), it, itt, igrif, ibasf, nboutflow !! Indices (unitless)
+    REAL(r_std)                                           :: contarea     !!
+    REAL(r_std)                                           :: totbasins    !!
+    REAL(r_std), DIMENSION(nbpt*nbvmax)                   :: tmp_area     !!
+    INTEGER(i_std), DIMENSION(nbpt*nbvmax,2)              :: tmpindex     !!
+    !
+    !
+    ! Normalize the area of all basins
+    !
+    DO ib=1,nbpt
+       !
+       totbasins = SUM(basin_area(ib,1:basin_count(ib)))
+       contarea = resolution(ib,1)*resolution(ib,2)*contfrac(ib)
+       !
+       DO ij=1,basin_count(ib)
+          basin_area(ib,ij) = basin_area(ib,ij)/totbasins*contarea
+       ENDDO
+       !
+    ENDDO
+    WRITE(numout,*) 'Normalization done'
+    !
+    ! Compute the area upstream of each basin
+    !
+    fetch_basin(:,:) = zero
+    !
+    !
+    DO ib=1,nbpt
+       !
+       DO ij=1,basin_count(ib)
+          !
+          fetch_basin(ib, ij) = fetch_basin(ib, ij) + basin_area(ib,ij)
+          !
+          igrif = outflow_grid(ib,ij)
+          ibasf = outflow_basin(ib,ij)
+          !
+          itt = 0
+          DO WHILE (igrif .GT. 0)
+             fetch_basin(igrif,ibasf) =  fetch_basin(igrif,ibasf) + basin_area(ib, ij)
+             it = outflow_grid(igrif, ibasf)
+             ibasf = outflow_basin(igrif, ibasf)
+             igrif = it
+             itt = itt + 1
+             IF ( itt .GT. 500) THEN
+                WRITE(numout,&
+                     "('Grid ',I5, ' and basin ',I5, 'did not converge after iteration ',I5)") ib, ij, itt
+                WRITE(numout,*) 'Basin ID :', basin_id(igrif,ibasf)
+                WRITE(numout,&
+                     "('We are stuck with the flow into grid ',I5,' and basin ',I5)") igrif, ibasf
+                IF ( itt .GT. 510) THEN
+                   CALL ipslerr_p(3,'routing_fetch','Problem...','','')
+                ENDIF
+             ENDIF
+          ENDDO
+          !
+       ENDDO
+       !
+    ENDDO
+    !
+    WRITE(numout,*) 'The smallest FETCH :', MINVAL(fetch_basin)
+    WRITE(numout,*) 'The largest FETCH :', MAXVAL(fetch_basin)
+    !
+    ! Now we set for the 'num_largest' largest basins the outflow condition as stream flow 
+    ! (i.e. outflow_grid = -1) and all other outflow basins are set to coastal flow 
+    ! (i.e. outflow_grid = -2). The return flow is not touched.
+    !
+    nboutflow = 0
+    !
+    DO ib=1,nbpt
+       !
+       DO ij=1,basin_count(ib)
+          !
+          ! We do not need any more the river flow flag as we are going to reset it.
+          !
+          IF ( outflow_grid(ib,ij) .EQ. -1) THEN
+             outflow_grid(ib,ij) = -2
+          ENDIF
+          !
+          IF ( outflow_grid(ib,ij) .EQ. -2) THEN
+             !
+             nboutflow = nboutflow + 1
+             tmp_area(nboutflow) = fetch_basin(ib,ij)
+             tmpindex(nboutflow,1) = ib
+             tmpindex(nboutflow,2) = ij
+             !
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    DO ib=1, num_largest
+       ff = MAXLOC(tmp_area(1:nboutflow))
+       outflow_grid(tmpindex(ff(1),1), tmpindex(ff(1),2)) = -1
+       tmp_area(ff(1)) = zero
+    ENDDO
+    !
+  END SUBROUTINE routing_fetch
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_truncate
+!!
+!>\BRIEF         This subroutine reduces the number of basins per grid to the value chosen by the user.
+!!               It also computes the final field which will be used to route the water at the
+!!               requested truncation.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : 
+!! Truncate if needed and find the path closest to the high resolution data.
+!!
+!! The algorithm :
+!! 
+!! We only go through this procedure only as many times as there are basins to take out at most.
+!! This is important as it allows the simplifications to spread from one grid to the other.
+!! The for each step of the iteration and at each grid point we check the following options for 
+!! simplifying the pathways of water :
+!! 1) If the basin of a grid flows into another basin of the same grid. Kill the one which only
+!!    served as a transition
+!! 2) If in one grid box we have a number of basins which flow into the ocean as coastal flow. 
+!!    We kill the smallest one and put into the largest basin. There is no need to manage many 
+!!    basins going into the ocean as coastal flows. 
+!! 3) If we have streams run in parallel from one gird box to the others (that is these are 
+!!    different basins) we will put the smaller one in the larger one. This may hapen at any
+!!    level of the flow but in theory it should propagate downstream.
+!! 4) If we have two basins with the same ID but flow into different grid boxes we sacrifice
+!!    the smallest one and route it through the largest. 
+!!
+!! Obviously if any of the options find something then we skip the rest and take out the basin.:\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_truncate(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_topoind,&
+       & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+       & inflow_grid, inflow_basin)
+    !
+    IMPLICIT NONE
+    !
+!! PARAMETERS
+    INTEGER(i_std), PARAMETER                       :: pickmax = 200  !!
+
+!! INPUT VARIABLES
+    INTEGER(i_std)                                  :: nbpt           !! Domain size  (unitless)
+    !
+    REAL(r_std), DIMENSION(nbpt,2)                  :: resolution     !! The size of each grid box in X and Y (m)
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)        :: contfrac       !! Fraction of land in each grid box (unitless;0-1)
+    !
+    INTEGER(i_std)                                  :: nwbas          !!
+    INTEGER(i_std), DIMENSION(nbpt)                 :: basin_count    !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: basin_id       !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: basin_flowdir  !! Water flow directions in the basin (unitless)
+    REAL(r_std), DIMENSION(nbpt,nwbas)              :: basin_area     !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)              :: basin_topoind  !! Topographic index of the residence time for a basin (m)
+    REAL(r_std), DIMENSION(nbpt,nwbas)              :: fetch_basin    !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: outflow_grid   !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: outflow_basin  !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: inflow_number  !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nwbas)     :: inflow_basin   !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nwbas)     :: inflow_grid    !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                                  :: ib, ij, ibf, ijf, igrif, ibasf, cnt, pold, bold, ff(2) !! Indices (unitless)
+    INTEGER(i_std)                                  :: ii, kbas, sbas, ik, iter, ibt, obj !! Indices (unitless)
+    REAL(r_std), DIMENSION(nbpt,nbasmax)            :: floflo         !!
+    REAL(r_std), DIMENSION(nbpt)                    :: gridarea       !!
+    REAL(r_std), DIMENSION(nbpt)                    :: gridbasinarea  !!
+    REAL(r_std)                                     :: ratio          !!
+    INTEGER(i_std), DIMENSION(pickmax,2)            :: largest_basins !!
+    INTEGER(i_std), DIMENSION(pickmax)              :: tmp_ids        !!
+    INTEGER(i_std)                                  :: multbas        !!
+    INTEGER(i_std)                                  :: iml(1)         !! X resolution of the high resolution grid
+    INTEGER(i_std), DIMENSION(pickmax)              :: multbas_sz     !!
+    REAL(r_std), DIMENSION(pickmax)                 :: tmp_area       !!
+    INTEGER(i_std), DIMENSION(pickmax,pickmax)      :: multbas_list   !!
+    !
+    INTEGER(i_std)                                  :: nbtruncate     !!
+    INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:) :: indextrunc     !!
+    !
+    !
+    IF ( .NOT. ALLOCATED(indextrunc)) THEN
+       ALLOCATE(indextrunc(nbpt))
+    ENDIF
+    !
+    ! We have to go through the grid as least as often as we have to reduce the number of basins
+    ! For good measure we add 3 more passages.
+    !
+    !
+    DO iter = 1, MAXVAL(basin_count) - nbasmax +3
+       !
+       ! Get the points over which we wish to truncate
+       !
+       nbtruncate = 0
+       DO ib = 1, nbpt
+          IF ( basin_count(ib) .GT. nbasmax ) THEN
+             nbtruncate = nbtruncate + 1
+             indextrunc(nbtruncate) = ib
+          ENDIF
+       ENDDO
+       !
+       ! Go through the basins which need to be truncated.       
+       !
+       DO ibt=1,nbtruncate
+          !
+          ib = indextrunc(ibt)
+          !
+          ! Check if we have basin which flows into a basin in the same grid
+          ! kbas = basin we will have to kill
+          ! sbas = basin which takes over kbas
+          !
+          kbas = 0
+          sbas = 0
+          !
+          ! 1) Can we find a basin which flows into a basin of the same grid ?
+          !
+          DO ij=1,basin_count(ib)
+             DO ii=1,basin_count(ib)
+                IF ( outflow_grid(ib,ii) .EQ. ib .AND. outflow_basin(ib, ii) .EQ. ij .AND. kbas*sbas .NE. 0) THEN
+                   kbas = ii
+                   sbas = ij
+                ENDIF
+             ENDDO
+          ENDDO
+          !
+          ! 2) Merge two basins which flow into the ocean as coastal or return flow 
+          ! (outflow_grid = -2 or -3). Well obviously only if we have more than 1 and 
+          ! have not found anything yet!
+          !
+          IF ( (COUNT(outflow_grid(ib,1:basin_count(ib)) .EQ. -2) .GT. 1 .OR.&
+               & COUNT(outflow_grid(ib,1:basin_count(ib)) .EQ. -3) .GT. 1) .AND.&
+               & kbas*sbas .EQ. 0) THEN
+             !
+             multbas = 0
+             multbas_sz(:) = 0
+             !
+             IF ( COUNT(outflow_grid(ib,1:basin_count(ib)) .EQ. -2) .GT. 1 ) THEN
+                obj = -2
+             ELSE
+                obj = -3
+             ENDIF
+             !
+             ! First we get the list of all basins which go out as coastal or return flow (obj)
+             !
+             DO ij=1,basin_count(ib)
+                IF ( outflow_grid(ib,ij) .EQ. obj ) THEN
+                   multbas = multbas + 1
+                   multbas_sz(multbas) = ij
+                   tmp_area(multbas) = fetch_basin(ib,ij)
+                ENDIF
+             ENDDO
+             !
+             ! Now the take the smallest to be transfered to the largest
+             !
+             iml = MAXLOC(tmp_area(1:multbas), MASK = tmp_area(1:multbas) .GT. zero)
+             sbas = multbas_sz(iml(1))
+             iml = MINLOC(tmp_area(1:multbas), MASK = tmp_area(1:multbas) .GT. zero)
+             kbas = multbas_sz(iml(1))
+             !
+          ENDIF
+          !
+          !   3) If we have basins flowing into the same grid but different basins then we put them 
+          !   together. Obviously we first work with the grid which has most streams running into it
+          !   and putting the smallest in the largests catchments.
+          !
+          IF ( kbas*sbas .EQ. 0) THEN
+             !
+             tmp_ids(1:basin_count(ib)) = outflow_grid(ib,1:basin_count(ib))
+             multbas = 0
+             multbas_sz(:) = 0
+             !
+             ! First obtain the list of basins which flow into the same basin
+             !
+             DO ij=1,basin_count(ib)
+                IF ( outflow_grid(ib,ij) .GT. 0 .AND.&
+                     & COUNT(tmp_ids(1:basin_count(ib)) .EQ. outflow_grid(ib,ij)) .GT. 1) THEN
+                   multbas = multbas + 1
+                   DO ii=1,basin_count(ib)
+                      IF ( tmp_ids(ii) .EQ. outflow_grid(ib,ij)) THEN
+                         multbas_sz(multbas) = multbas_sz(multbas) + 1
+                         multbas_list(multbas,multbas_sz(multbas)) = ii
+                         tmp_ids(ii) = -99
+                      ENDIF
+                   ENDDO
+                ELSE
+                   tmp_ids(ij) = -99
+                ENDIF
+             ENDDO
+             !
+             ! Did we come up with any basins to deal with this way ?
+             !
+             IF ( multbas .GT. 0 ) THEN
+                !
+                iml = MAXLOC(multbas_sz(1:multbas))
+                ik = iml(1)
+                !
+                ! Take the smallest and largest of these basins !
+                !
+                DO ii=1,multbas_sz(ik)
+                   tmp_area(ii) = fetch_basin(ib, multbas_list(ik,ii))
+                ENDDO
+                !
+                iml = MAXLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                sbas = multbas_list(ik,iml(1))
+                iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                kbas = multbas_list(ik,iml(1))
+                !
+             ENDIF
+             !
+          ENDIF
+          !
+          !   4) If we have twice the same basin we put them together even if they flow into different
+          !   directions. If one of them goes to the ocean it takes the advantage.
+          !
+          IF ( kbas*sbas .EQ. 0) THEN
+             !
+             tmp_ids(1:basin_count(ib)) = basin_id(ib,1:basin_count(ib))
+             multbas = 0
+             multbas_sz(:) = 0
+             !
+             ! First obtain the list of basins which have sub-basins in this grid box.
+             ! (these are identified by their IDs)
+             !
+             DO ij=1,basin_count(ib)
+                IF ( COUNT(tmp_ids(1:basin_count(ib)) .EQ. basin_id(ib,ij)) .GT. 1) THEN
+                   multbas = multbas + 1
+                   DO ii=1,basin_count(ib)
+                      IF ( tmp_ids(ii) .EQ. basin_id(ib,ij)) THEN
+                         multbas_sz(multbas) = multbas_sz(multbas) + 1
+                         multbas_list(multbas,multbas_sz(multbas)) = ii
+                         tmp_ids(ii) = -99
+                      ENDIF
+                   ENDDO
+                ELSE
+                   tmp_ids(ij) = -99
+                ENDIF
+             ENDDO
+             !
+             ! We are going to work on the basin with the largest number of sub-basins.
+             ! (IF we have a basin which has subbasins !)
+             !
+             IF ( multbas .GT. 0 ) THEN
+                !
+                iml = MAXLOC(multbas_sz(1:multbas))
+                ik = iml(1)
+                !
+                ! If one of the basins goes to the ocean then it is going to have the priority
+                !
+                tmp_area(:) = zero
+                IF ( COUNT(outflow_grid(ib,multbas_list(ik,1:multbas_sz(ik))) .LT. 0) .GT. 0) THEN
+                   DO ii=1,multbas_sz(ik)
+                      IF ( outflow_grid(ib,multbas_list(ik,ii)) .LT. 0 .AND. sbas .EQ. 0 ) THEN
+                         sbas = multbas_list(ik,ii)
+                      ELSE
+                         tmp_area(ii) = fetch_basin(ib, multbas_list(ik,ii))
+                      ENDIF
+                   ENDDO
+                   ! take the smallest of the subbasins
+                   iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                   kbas = multbas_list(ik,iml(1))
+                ELSE
+                   !
+                   ! Else we take simply the largest and smallest
+                   !
+                   DO ii=1,multbas_sz(ik)
+                      tmp_area(ii) = fetch_basin(ib, multbas_list(ik,ii))
+                   ENDDO
+                   iml = MAXLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                   sbas = multbas_list(ik,iml(1))
+                   iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                   kbas = multbas_list(ik,iml(1))
+                   !
+                ENDIF
+                !
+                !
+             ENDIF
+          ENDIF
+          !
+          !
+          !
+          ! Then we call routing_killbas to clean up the basins in this grid
+          !
+          IF ( kbas .GT. 0 .AND. sbas .GT. 0 ) THEN
+             CALL routing_killbas(nbpt, ib, kbas, sbas, nwbas, basin_count, basin_area, basin_topoind,&
+                  & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+                  & inflow_grid, inflow_basin)
+          ENDIF
+          !
+       ENDDO
+       !
+       !      
+    ENDDO
+    !
+    ! If there are any grids left with too many basins we need to take out the big hammer !
+    ! We will only do it if this represents less than 5% of all points.
+    !
+    IF ( COUNT(basin_count .GT. nbasmax) .GT. 0 ) THEN
+       !
+       !
+       IF ( COUNT(basin_count .GT. nbasmax)/nbpt*100 .GT. 5 ) THEN
+          WRITE(numout,*) 'We have ', COUNT(basin_count .GT. nbasmax)/nbpt*100, '% of all points which do not yet'
+          WRITE(numout,*) 'have the right trunctaction. That is too much to apply a brutal method'
+          DO ib = 1, nbpt
+             IF ( basin_count(ib) .GT. nbasmax ) THEN
+                !
+                WRITE(numout,*) 'We did not find a basin which could be supressed. We will'
+                WRITE(numout,*) 'not be able to reduce the truncation in grid ', ib
+                DO ij=1,basin_count(ib)
+                   WRITE(numout,*) 'grid, basin nb and id :', ib, ij, basin_id(ib,ij)
+                   WRITE(numout,*) 'Outflow grid and basin ->', outflow_grid(ib,ij), outflow_basin(ib, ij)
+                ENDDO
+             ENDIF
+          ENDDO
+          CALL ipslerr_p(3,'routing_truncate','No basin found which could be supressed.','','')
+       ELSE
+          !
+          !
+          DO ib = 1,nbpt
+             DO WHILE ( basin_count(ib) .GT. nbasmax )
+                !
+                WRITE(numout,*) 'HAMMER, ib, basin_count :', ib, basin_count(ib)
+                !
+                ! Here we simply put the smallest basins into the largest ones. It is really a brute force
+                ! method but it will only be applied if everything has failed.
+                !
+                DO ii = 1,basin_count(ib)
+                   tmp_area(ii) = fetch_basin(ib, ii)
+                ENDDO
+                !
+                iml = MAXLOC(tmp_area(1:basin_count(ib)), MASK = tmp_area(1:basin_count(ib)) .GT. 0.)
+                sbas =iml(1)
+                iml = MINLOC(tmp_area(1:basin_count(ib)), MASK = tmp_area(1:basin_count(ib)) .GT. 0.)
+                kbas = iml(1)
+                !
+                IF ( kbas .GT. 0 .AND. sbas .GT. 0 ) THEN
+                   CALL routing_killbas(nbpt, ib, kbas, sbas, nwbas, basin_count, basin_area, basin_topoind,&
+                        & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+                        & inflow_grid, inflow_basin)
+                ENDIF
+             ENDDO
+          ENDDO
+          !
+       ENDIF
+       !
+       !
+    ENDIF
+    !
+    ! Now that we have reached the right truncation (resolution) we will start
+    ! to produce the variables we will use to route the water.
+    !
+    DO ib=1,nbpt
+       !
+       ! For non existing basins the route_tobasin variable is put to zero. This will allow us
+       ! to pick up the number of basin afterwards.
+       !
+       route_togrid(ib,:) = ib
+       route_tobasin(ib,:) = 0
+       routing_area(ib,:) = zero
+       !
+    ENDDO
+    !
+    ! Transfer the info into the definitive variables
+    !
+    DO ib=1,nbpt
+       DO ij=1,basin_count(ib)
+          routing_area(ib,ij) = basin_area(ib,ij)
+          topo_resid(ib,ij) = basin_topoind(ib,ij)
+          global_basinid(ib,ij) = basin_id(ib,ij)
+          route_togrid(ib,ij) = outflow_grid(ib,ij)
+          route_tobasin(ib,ij) = outflow_basin(ib,ij)
+       ENDDO
+    ENDDO
+    !
+    !
+    ! Set the new convention for the outflow conditions
+    ! Now it is based in the outflow basin and the outflow grid will
+    ! be the same as the current.
+    ! returnflow to the grid : nbasmax + 1
+    ! coastal flow           : nbasmax + 2
+    ! river outflow          : nbasmax + 3
+    !
+    ! Here we put everything here in coastal flow. It is later where we will
+    ! put the largest basins into river outflow.
+    !
+    DO ib=1,nbpt
+       DO ij=1,basin_count(ib)
+          ! River flows
+          IF ( route_togrid(ib,ij) .EQ. -1 ) THEN
+             route_tobasin(ib,ij) = nbasmax + 2
+             route_togrid(ib,ij) = ib
+          ! Coastal flows
+          ELSE IF ( route_togrid(ib,ij) .EQ. -2 ) THEN
+             route_tobasin(ib,ij) = nbasmax + 2
+             route_togrid(ib,ij) = ib
+          ! Return flow
+          ELSE IF ( route_togrid(ib,ij) .EQ. -3 ) THEN
+             route_tobasin(ib,ij) = nbasmax + 1
+             route_togrid(ib,ij) = ib
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! A second check on the data. Just make sure that each basin flows somewhere.
+    !
+    DO ib=1,nbpt
+       DO ij=1,basin_count(ib)
+          ibf = route_togrid(ib,ij)
+          ijf = route_tobasin(ib,ij)
+          IF ( ijf .GT. basin_count(ibf) .AND.  ijf .LE. nbasmax) THEN
+             WRITE(numout,*) 'Second check'
+             WRITE(numout,*) 'point :', ib, ' basin :', ij
+             WRITE(numout,*) 'Flows into point :', ibf, ' basin :', ijf
+             WRITE(numout,*) 'But it flows into now here as basin count = ', basin_count(ibf)
+             CALL ipslerr_p(3,'routing_truncate','Problem with routing..','','')
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Verify areas of the continents
+    !
+    floflo(:,:) = zero
+    gridarea(:) = contfrac(:)*resolution(:,1)*resolution(:,2)
+    DO ib=1,nbpt
+       gridbasinarea(ib) = SUM(routing_area(ib,:))
+    ENDDO
+    !
+    DO ib=1,nbpt
+       DO ij=1,basin_count(ib)
+          cnt = 0
+          igrif = ib
+          ibasf = ij
+          DO WHILE (ibasf .LE. nbasmax .AND. cnt .LT. nbasmax*nbpt)
+             cnt = cnt + 1
+             pold = igrif
+             bold = ibasf
+             igrif = route_togrid(pold, bold)
+             ibasf = route_tobasin(pold, bold)
+             IF ( ibasf .GT. basin_count(igrif)  .AND.  ibasf .LE. nbasmax) THEN
+                WRITE(numout,*) 'We should not be here as the basin flows into the pampa'
+                WRITE(numout,*) 'Last correct point :', pold, bold
+                WRITE(numout,*) 'It pointed to in the new variables :', route_togrid(pold, bold),route_tobasin(pold, bold) 
+                WRITE(numout,*) 'The old variables gave :', outflow_grid(pold, bold), outflow_basin(pold, bold) 
+                WRITE(numout,*) 'Where we ended up :', igrif,ibasf
+                CALL ipslerr_p(3,'routing_truncate','Problem with routing..','','')
+             ENDIF
+          ENDDO
+          !
+          IF ( ibasf .GT. nbasmax ) THEN
+             floflo(igrif,bold) = floflo(igrif,bold) + routing_area(ib,ij)
+          ELSE
+             WRITE(numout,*) 'The flow did not end up in the ocean or in the grid cell.'
+             WRITE(numout,*) 'For grid ', ib, ' and basin ', ij
+             WRITE(numout,*) 'The last grid was ', igrif, ' and basin ', ibasf
+             CALL ipslerr_p(3,'routing_truncate','Problem with routing..','','')
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    DO ib=1,nbpt
+       IF ( gridbasinarea(ib) > zero ) THEN
+          ratio = gridarea(ib)/gridbasinarea(ib)
+          routing_area(ib,:) = routing_area(ib,:)*ratio
+       ELSE
+          WRITE(numout,*) 'gridbasinarea(ib) <= zero. We should stop here :', ib
+       ENDIF
+    ENDDO
+    !
+    WRITE(numout,*) 'Sum of area of all outflow areas :',SUM(routing_area)
+    WRITE(numout,*) 'Surface of all continents :', SUM(gridarea)
+    !
+    ! Redo the the distinction between river outflow and coastal flow. We can not
+    ! take into account the return flow points.
+    !
+    ibf = 0
+    DO ib=1, pickmax
+       ff = MAXLOC(floflo)
+       ! tdo - To take into account rivers that do not flow to the oceans 
+       IF ( route_tobasin(ff(1), ff(2)) .GT. nbasmax ) THEN
+!       IF ( route_tobasin(ff(1), ff(2)) .EQ. nbasmax + 2) THEN
+          ibf = ibf + 1
+          largest_basins(ibf,:) = ff(:)
+       ENDIF
+       floflo(ff(1), ff(2)) = zero
+    ENDDO
+    !
+    ! Put the largest basins into river flows.
+    !
+    IF ( ibf .LT.  num_largest) THEN
+       WRITE(numout,*) 'Not enough basins to choose the ',  num_largest, 'largest'
+       CALL ipslerr_p(3,'routing_truncate','Not enough basins','','')
+    ENDIF
+    !
+    !
+    !
+    DO ib=1, num_largest
+       route_tobasin(largest_basins(ib,1),largest_basins(ib,2)) = nbasmax + 3
+    ENDDO
+    !
+    WRITE(numout,*) 'NUMBER OF RIVERS :', COUNT(route_tobasin .GE. nbasmax + 3)
+    !
+  END SUBROUTINE  routing_truncate
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_killbas
+!!
+!>\BRIEF        The aim of this subroutine is to kill a basin (that is put into another larger one).
+!!              When we do this we need to be careful and change all associated variables.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_killbas(nbpt, ib, tokill, totakeover, nwbas, basin_count, basin_area, basin_topoind,&
+       & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+       & inflow_grid, inflow_basin)
+    !
+    !
+    IMPLICIT NONE
+    !
+    INTEGER(i_std)                              :: tokill        !!
+    INTEGER(i_std)                              :: totakeover    !!
+    INTEGER(i_std)                              :: nbpt          !! Domain size  (unitless)
+    INTEGER(i_std)                              :: ib            !! Current basin (unitless)
+    !
+    INTEGER(i_std)                              :: nwbas         !!
+    INTEGER(i_std), DIMENSION(nbpt)             :: basin_count   !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: basin_id      !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: basin_flowdir !! Water flow directions in the basin (unitless)
+    REAL(r_std), DIMENSION(nbpt,nwbas)          :: basin_area    !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)          :: basin_topoind !! Topographic index of the residence time for a basin (m)
+    REAL(r_std), DIMENSION(nbpt,nwbas)          :: fetch_basin   !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: outflow_grid  !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: outflow_basin !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: inflow_number !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nwbas) :: inflow_basin  !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nwbas) :: inflow_grid   !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                              :: inf, ibs, ing, inb, ibasf, igrif, it !! Indices (unitless)
+    LOGICAL                                     :: doshift       !! (true/false)
+    !
+    ! Update the information needed in the basin "totakeover"
+    ! For the moment only area
+    !
+    WRITE(numout,*) 'KILL BASIN :', ib, tokill, totakeover, basin_id(ib,tokill), basin_id(ib,totakeover)
+    !
+    !
+    basin_area(ib, totakeover) = basin_area(ib, totakeover) +  basin_area(ib, tokill)
+    basin_topoind(ib, totakeover) = (basin_topoind(ib, totakeover) + basin_topoind(ib, tokill))/2.0
+    !
+    ! Add the fetch of the basin will kill to the one which gets the water
+    !
+    fetch_basin(ib, totakeover) = fetch_basin(ib, totakeover) + fetch_basin(ib, tokill)
+    igrif = outflow_grid(ib,totakeover)
+    ibasf = outflow_basin(ib,totakeover)
+    !
+    inf = 0
+    DO WHILE (igrif .GT. 0)
+       fetch_basin(igrif,ibasf) =  fetch_basin(igrif,ibasf) + fetch_basin(ib, tokill) 
+       it = outflow_grid(igrif, ibasf)
+       ibasf = outflow_basin(igrif, ibasf)
+       igrif = it
+       inf = inf + 1
+    ENDDO
+    !
+    ! Take out the basin we have just rerouted from the fetch of the basins in which it used to flow.
+    !
+    igrif = outflow_grid(ib,tokill)
+    ibasf = outflow_basin(ib,tokill)
+    !
+    DO WHILE (igrif .GT. 0)
+       fetch_basin(igrif,ibasf) =  fetch_basin(igrif,ibasf) - fetch_basin(ib, tokill)
+       it = outflow_grid(igrif, ibasf)
+       ibasf = outflow_basin(igrif, ibasf)
+       igrif = it
+    ENDDO   
+    !
+    !  Redirect the flows which went into the basin to be killed before we change everything
+    !
+    DO inf = 1, inflow_number(ib, tokill)
+       outflow_basin(inflow_grid(ib, tokill, inf), inflow_basin(ib, tokill, inf)) = totakeover
+       inflow_number(ib, totakeover) = inflow_number(ib, totakeover) + 1
+       inflow_grid(ib, totakeover,  inflow_number(ib, totakeover)) = inflow_grid(ib, tokill, inf)
+       inflow_basin(ib, totakeover,  inflow_number(ib, totakeover)) = inflow_basin(ib, tokill, inf)
+    ENDDO
+    !
+    ! Take out the basin to be killed from the list of inflow basins of the downstream basin
+    ! (In case the basin does not flow into an ocean or lake)
+    !
+    IF ( outflow_grid(ib,tokill) .GT. 0) THEN
+       !
+       ing = outflow_grid(ib, tokill)
+       inb = outflow_basin(ib, tokill)
+       doshift = .FALSE.
+       !
+       DO inf = 1, inflow_number(ing, inb)
+          IF ( doshift ) THEN
+             inflow_grid(ing, inb, inf-1) = inflow_grid(ing, inb, inf)
+             inflow_basin(ing, inb, inf-1) = inflow_basin(ing, inb, inf)
+          ENDIF
+          IF ( inflow_grid(ing, inb, inf) .EQ. ib .AND. inflow_basin(ing, inb, inf) .EQ. tokill) THEN
+             doshift = .TRUE.
+          ENDIF
+       ENDDO
+       !
+       ! This is only to allow for the last check
+       !
+       inf = inflow_number(ing, inb)
+       IF ( inflow_grid(ing, inb, inf) .EQ. ib .AND. inflow_basin(ing, inb, inf) .EQ. tokill) THEN
+          doshift = .TRUE.
+       ENDIF
+       !
+       IF ( .NOT. doshift ) THEN
+          WRITE(numout,*) 'Strange we did not find the basin to kill in the downstream basin'
+          CALL ipslerr_p(3,'routing_killbas','Basin not found','','')
+       ENDIF
+       inflow_number(ing, inb) = inflow_number(ing, inb) - 1
+       
+    ENDIF
+    !
+    ! Now remove from the arrays the information of basin "tokill"
+    !
+    basin_id(ib, tokill:basin_count(ib)-1) = basin_id(ib, tokill+1:basin_count(ib))
+    basin_flowdir(ib, tokill:basin_count(ib)-1) = basin_flowdir(ib, tokill+1:basin_count(ib))
+    basin_area(ib, tokill:basin_count(ib)-1) = basin_area(ib, tokill+1:basin_count(ib))
+    basin_area(ib, basin_count(ib):nwbas) = zero
+    basin_topoind(ib, tokill:basin_count(ib)-1) = basin_topoind(ib, tokill+1:basin_count(ib))
+    basin_topoind(ib, basin_count(ib):nwbas) = zero
+    fetch_basin(ib, tokill:basin_count(ib)-1) = fetch_basin(ib, tokill+1:basin_count(ib))
+    fetch_basin(ib, basin_count(ib):nwbas) = zero
+    !
+    ! Before we remove the information from the outflow fields we have to correct the corresponding inflow fields
+    ! of the grids into which the flow goes
+    !
+    DO ibs = tokill+1,basin_count(ib)
+       ing = outflow_grid(ib, ibs)
+       inb = outflow_basin(ib, ibs)
+       IF ( ing .GT. 0 ) THEN
+          DO inf = 1, inflow_number(ing, inb)
+             IF ( inflow_grid(ing,inb,inf) .EQ. ib .AND. inflow_basin(ing,inb,inf) .EQ. ibs) THEN
+                inflow_basin(ing,inb,inf) = ibs - 1
+             ENDIF
+          ENDDO
+       ENDIF
+    ENDDO
+    outflow_grid(ib, tokill:basin_count(ib)-1) = outflow_grid(ib, tokill+1:basin_count(ib))
+    outflow_basin(ib, tokill:basin_count(ib)-1) = outflow_basin(ib, tokill+1:basin_count(ib))
+    !
+    ! Basins which moved down also need to redirect their incoming flows.
+    !
+    DO ibs=tokill+1, basin_count(ib)
+       DO inf = 1, inflow_number(ib, ibs)
+          outflow_basin(inflow_grid(ib, ibs, inf), inflow_basin(ib, ibs, inf)) = ibs-1
+       ENDDO
+    ENDDO
+    !
+    ! Shift the inflow basins
+    !
+    DO it = tokill+1,basin_count(ib)
+       inflow_grid(ib, it-1, 1:inflow_number(ib,it)) =  inflow_grid(ib, it, 1:inflow_number(ib,it))
+       inflow_basin(ib, it-1, 1:inflow_number(ib,it)) =  inflow_basin(ib, it, 1:inflow_number(ib,it))
+       inflow_number(ib,it-1) = inflow_number(ib,it)
+    ENDDO
+    !
+    basin_count(ib) = basin_count(ib) - 1
+    !
+  END SUBROUTINE routing_killbas 
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_names
+!!
+!>\BRIEF         This subroutine lists the name of the largest basins which are explicitly listed in the basin
+!!               description file used by ORCHIDEE.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_names(numlar, basin_names)
+    !
+    IMPLICIT NONE
+    !
+    ! Arguments
+    !
+    INTEGER(i_std), INTENT(in)             :: numlar              !!
+    CHARACTER(LEN=*), INTENT(inout)        :: basin_names(numlar) !! Name of the basins (unitless)
+!! PARAMETERS
+    INTEGER(i_std), PARAMETER              :: listleng=349        !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                         :: lenstr, i           !!
+    CHARACTER(LEN=60), DIMENSION(listleng) :: list_names          !!
+    CHARACTER(LEN=60)                      :: tmp_str             !!
+    !
+
+    lenstr = LEN(basin_names(1))
+    !
+    list_names(1) = "Amazon"
+    list_names(2) = "Nile"
+    list_names(3) = "Zaire"
+    list_names(4) = "Mississippi"
+    list_names(5) = "Amur"
+    list_names(6) = "Parana"
+    list_names(7) = "Yenisei"
+    list_names(8) = "Ob"
+    list_names(9) = "Lena"
+    list_names(10) = "Niger"
+    list_names(11) = "Zambezi"
+    list_names(12) = "Erg Iguidi (Sahara)"
+    list_names(13) = "Chang Jiang (Yangtze)"
+    list_names(14) = "Mackenzie"
+    list_names(15) = "Ganges"
+    list_names(16) = "Chari"
+    list_names(17) = "Volga"
+    list_names(18) = "St. Lawrence"
+    list_names(19) = "Indus"
+    list_names(20) = "Syr-Darya"
+    list_names(21) = "Nelson"
+    list_names(22) = "Orinoco"
+    list_names(23) = "Murray"
+    list_names(24) = "Great Artesian Basin"
+    list_names(25) = "Shatt el Arab"
+    list_names(26) = "Orange"
+    list_names(27) = "Huang He"
+    list_names(28) = "Yukon"
+    list_names(29) = "Senegal"
+    list_names(30) = "Chott Jerid"
+    list_names(31) = "Jubba"
+    list_names(32) = "Colorado (Ari)"
+    list_names(33) = "Rio Grande (US)"
+    list_names(34) = "Danube"
+    list_names(35) = "Mekong"
+    list_names(36) = "Tocantins"
+    list_names(37) = "Wadi al Farigh"
+    list_names(38) = "Tarim"
+    list_names(39) = "Columbia"
+    list_names(40) = "Komadugu Yobe (Tchad)"
+    list_names(41) = "Kolyma"
+    list_names(42) = "Sao Francisco"
+    list_names(43) = "Amu-Darya"
+    list_names(44) = "GHAASBasin51"
+    list_names(45) = "Dnepr"
+    list_names(46) = "GHAASBasin61"
+    list_names(47) = "Don"
+    list_names(48) = "Colorado (Arg)"
+    list_names(49) = "Limpopo"
+    list_names(50) = "GHAASBasin50"
+    list_names(51) = "Zhujiang"
+    list_names(52) = "Irrawaddy"
+    list_names(53) = "Volta"
+    list_names(54) = "GHAASBasin54"
+    list_names(55) = "Farah"
+    list_names(56) = "Khatanga"
+    list_names(57) = "Dvina"
+    list_names(58) = "Urugay"
+    list_names(59) = "Qarqan"
+    list_names(60) = "GHAASBasin75"
+    list_names(61) = "Parnaiba"
+    list_names(62) = "GHAASBasin73"
+    list_names(63) = "Indigirka"
+    list_names(64) = "Churchill (Hud)"
+    list_names(65) = "Godavari"
+    list_names(66) = "Pur - Taz"
+    list_names(67) = "Pechora"
+    list_names(68) = "Baker"
+    list_names(69) = "Ural"
+    list_names(70) = "Neva"
+    list_names(71) = "Liao"
+    list_names(72) = "Salween"
+    list_names(73) = "GHAASBasin73"
+    list_names(74) = "Jordan"
+    list_names(75) = "GHAASBasin78"
+    list_names(76) = "Magdalena"
+    list_names(77) = "Krishna"
+    list_names(78) = "Salado"
+    list_names(79) = "Fraser"
+    list_names(80) = "Hai Ho"
+    list_names(81) = "Huai"
+    list_names(82) = "Yana"
+    list_names(83) = "GHAASBasin95"
+    list_names(84) = "GHAASBasin105"
+    list_names(85) = "Kura"
+    list_names(86) = "Olenek"
+    list_names(87) = "Ogooue"
+    list_names(88) = "Taymyr"
+    list_names(89) = "Negro Arg"
+    list_names(90) = "Chubut"
+    list_names(91) = "GHAASBasin91"
+    list_names(92) = "GHAASBasin122"
+    list_names(93) = "GHAASBasin120"
+    list_names(94) = "Sacramento"
+    list_names(95) = "Fitzroy West"
+    list_names(96) = "Grande de Santiago"
+    list_names(97) = "Rufiji"
+    list_names(98) = "Wisla"
+    list_names(99) = "GHAASBasin47"
+    list_names(100) = "GHAASBasin127"
+    list_names(101) = "Hong"
+    list_names(102) = "GHAASBasin97"
+    list_names(103) = "Swan-Avon"
+    list_names(104) = "Rhine"
+    list_names(105) = "Cuanza"
+    list_names(106) = "GHAASBasin106"
+    list_names(107) = "GHAASBasin142"
+    list_names(108) = "Roviuna"
+    list_names(109) = "Essequibo"
+    list_names(110) = "Elbe"
+    list_names(111) = "Koksoak"
+    list_names(112) = "Chao Phraya"
+    list_names(113) = "Brahmani"
+    list_names(114) = "GHAASBasin165"
+    list_names(115) = "Pyasina"
+    list_names(116) = "Fitzroy East"
+    list_names(117) = "GHAASBasin173"
+    list_names(118) = "Albany"
+    list_names(119) = "Sanaga"
+    list_names(120) = "GHAASBasin120"
+    list_names(121) = "GHAASBasin178"
+    list_names(122) = "GHAASBasin148"
+    list_names(123) = "Brazos (Tex)"
+    list_names(124) = "GHAASBasin124"
+    list_names(125) = "Alabama"
+    list_names(126) = "GHAASBasin174"
+    list_names(127) = "GHAASBasin179"
+    list_names(128) = "Balsas"
+    list_names(129) = "GHAASBasin172"
+    list_names(130) = "Burdekin"
+    list_names(131) = "Colorado (Texas)"
+    list_names(132) = "GHAASBasin150"
+    list_names(133) = "Odra"
+    list_names(134) = "Loire"
+    list_names(135) = "GHAASBasin98"
+    list_names(136) = "Galana"
+    list_names(137) = "Kuskowin"
+    list_names(138) = "Moose"
+    list_names(139) = "Narmada"
+    list_names(140) = "GHAASBasin140"
+    list_names(141) = "GHAASBasin141"
+    list_names(142) = "Flinders"
+    list_names(143) = "Kizil Irmak"
+    list_names(144) = "GHAASBasin144"
+    list_names(145) = "Save"
+    list_names(146) = "Roper"
+    list_names(147) = "Churchill (Atlantic)"
+    list_names(148) = "GHAASBasin148"
+    list_names(149) = "Victoria"
+    list_names(150) = "Back"
+    list_names(151) = "Bandama"
+    list_names(152) = "Severn (Can)"
+    list_names(153) = "Po"
+    list_names(154) = "GHAASBasin154"
+    list_names(155) = "GHAASBasin155"
+    list_names(156) = "GHAASBasin156"
+    list_names(157) = "Rhone"
+    list_names(158) = "Tana (Ken)"
+    list_names(159) = "La Grande"
+    list_names(160) = "GHAASBasin160"
+    list_names(161) = "Cunene"
+    list_names(162) = "Douro"
+    list_names(163) = "GHAASBasin163"
+    list_names(164) = "Nemanus"
+    list_names(165) = "GHAASBasin165"
+    list_names(166) = "Anabar"
+    list_names(167) = "Hayes"
+    list_names(168) = "Mearim"
+    list_names(169) = "GHAASBasin169"
+    list_names(170) = "Panuco"
+    list_names(171) = "GHAASBasin171"
+    list_names(172) = "Doce"
+    list_names(173) = "Gasgoyne"
+    list_names(174) = "GHAASBasin174"
+    list_names(175) = "GHAASBasin175"
+    list_names(176) = "Ashburton"
+    list_names(177) = "GHAASBasin177"
+    list_names(178) = "Peel"
+    list_names(179) = "Daugava"
+    list_names(180) = "GHAASBasin180"
+    list_names(181) = "Ebro"
+    list_names(182) = "Comoe"
+    list_names(183) = "Jacui"
+    list_names(184) = "GHAASBasin184"
+    list_names(185) = "Kapuas"
+    list_names(186) = "GHAASBasin186"
+    list_names(187) = "Penzhina"
+    list_names(188) = "Cauweri"
+    list_names(189) = "GHAASBasin189"
+    list_names(190) = "Mamberamo"
+    list_names(191) = "Sepik"
+    list_names(192) = "GHAASBasin192"
+    list_names(193) = "Sassandra"
+    list_names(194) = "GHAASBasin194"
+    list_names(195) = "GHAASBasin195"
+    list_names(196) = "Nottaway"
+    list_names(197) = "Barito"
+    list_names(198) = "GHAASBasin198"
+    list_names(199) = "Seine"
+    list_names(200) = "Tejo"
+    list_names(201) = "GHAASBasin201"
+    list_names(202) = "Gambia"
+    list_names(203) = "Susquehanna"
+    list_names(204) = "Dnestr"
+    list_names(205) = "Murchinson"
+    list_names(206) = "Deseado"
+    list_names(207) = "Mitchell"
+    list_names(208) = "Mahakam"
+    list_names(209) = "GHAASBasin209"
+    list_names(210) = "Pangani"
+    list_names(211) = "GHAASBasin211"
+    list_names(212) = "GHAASBasin212"
+    list_names(213) = "GHAASBasin213"
+    list_names(214) = "GHAASBasin214"
+    list_names(215) = "GHAASBasin215"
+    list_names(216) = "Bug"
+    list_names(217) = "GHAASBasin217"
+    list_names(218) = "Usumacinta"
+    list_names(219) = "Jequitinhonha"
+    list_names(220) = "GHAASBasin220"
+    list_names(221) = "Corantijn"
+    list_names(222) = "Fuchun Jiang"
+    list_names(223) = "Copper"
+    list_names(224) = "Tapti"
+    list_names(225) = "Menjiang"
+    list_names(226) = "Karun"
+    list_names(227) = "Mezen"
+    list_names(228) = "Guadiana"
+    list_names(229) = "Maroni"
+    list_names(230) = "GHAASBasin230"
+    list_names(231) = "Uda"
+    list_names(232) = "GHAASBasin232"
+    list_names(233) = "Kuban"
+    list_names(234) = "Colville"
+    list_names(235) = "Thaane"
+    list_names(236) = "Alazeya"
+    list_names(237) = "Paraiba do Sul"
+    list_names(238) = "GHAASBasin238"
+    list_names(239) = "Fortesque"
+    list_names(240) = "GHAASBasin240"
+    list_names(241) = "GHAASBasin241"
+    list_names(242) = "Winisk"
+    list_names(243) = "GHAASBasin243"
+    list_names(244) = "GHAASBasin244"
+    list_names(245) = "Ikopa"
+    list_names(246) = "Gilbert"
+    list_names(247) = "Kouilou"
+    list_names(248) = "Fly"
+    list_names(249) = "GHAASBasin249"
+    list_names(250) = "GHAASBasin250"
+    list_names(251) = "GHAASBasin251"
+    list_names(252) = "Mangoky"
+    list_names(253) = "Damodar"
+    list_names(254) = "Onega"
+    list_names(255) = "Moulouya"
+    list_names(256) = "GHAASBasin256"
+    list_names(257) = "Ord"
+    list_names(258) = "GHAASBasin258"
+    list_names(259) = "GHAASBasin259"
+    list_names(260) = "GHAASBasin260"
+    list_names(261) = "GHAASBasin261"
+    list_names(262) = "Narva"
+    list_names(263) = "GHAASBasin263"
+    list_names(264) = "Seal"
+    list_names(265) = "Cheliff"
+    list_names(266) = "Garonne"
+    list_names(267) = "Rupert"
+    list_names(268) = "GHAASBasin268"
+    list_names(269) = "Brahmani"
+    list_names(270) = "Sakarya"
+    list_names(271) = "Gourits"
+    list_names(272) = "Sittang"
+    list_names(273) = "Rajang"
+    list_names(274) = "Evros"
+    list_names(275) = "Appalachicola"
+    list_names(276) = "Attawapiskat"
+    list_names(277) = "Lurio"
+    list_names(278) = "Daly"
+    list_names(279) = "Penner"
+    list_names(280) = "GHAASBasin280"
+    list_names(281) = "GHAASBasin281"
+    list_names(282) = "Guadalquivir"
+    list_names(283) = "Nadym"
+    list_names(284) = "GHAASBasin284"
+    list_names(285) = "Saint John"
+    list_names(286) = "GHAASBasin286"
+    list_names(287) = "Cross"
+    list_names(288) = "Omoloy"
+    list_names(289) = "Oueme"
+    list_names(290) = "GHAASBasin290"
+    list_names(291) = "Gota"
+    list_names(292) = "Nueces"
+    list_names(293) = "Stikine"
+    list_names(294) = "Yalu"
+    list_names(295) = "Arnaud"
+    list_names(296) = "GHAASBasin296"
+    list_names(297) = "Jequitinhonha"
+    list_names(298) = "Kamchatka"
+    list_names(299) = "GHAASBasin299"
+    list_names(300) = "Grijalva"
+    list_names(301) = "GHAASBasin301"
+    list_names(302) = "Kemijoki"
+    list_names(303) = "Olifants"
+    list_names(304) = "GHAASBasin304"
+    list_names(305) = "Tsiribihina"
+    list_names(306) = "Coppermine"
+    list_names(307) = "GHAASBasin307"
+    list_names(308) = "GHAASBasin308"
+    list_names(309) = "Kovda"
+    list_names(310) = "Trinity"
+    list_names(311) = "Glama"
+    list_names(312) = "GHAASBasin312"
+    list_names(313) = "Luan"
+    list_names(314) = "Leichhardt"
+    list_names(315) = "GHAASBasin315"
+    list_names(316) = "Gurupi"
+    list_names(317) = "GR Baleine"
+    list_names(318) = "Aux Feuilles"
+    list_names(319) = "GHAASBasin319"
+    list_names(320) = "Weser"
+    list_names(321) = "GHAASBasin321"
+    list_names(322) = "GHAASBasin322"
+    list_names(323) = "Yesil"
+    list_names(324) = "Incomati"
+    list_names(325) = "GHAASBasin325"
+    list_names(326) = "GHAASBasin326"
+    list_names(327) = "Pungoe"
+    list_names(328) = "GHAASBasin328"
+    list_names(329) = "Meuse"
+    list_names(330) = "Eastmain"
+    list_names(331) = "Araguari"
+    list_names(332) = "Hudson"
+    list_names(333) = "GHAASBasin333"
+    list_names(334) = "GHAASBasin334"
+    list_names(335) = "GHAASBasin335"
+    list_names(336) = "GHAASBasin336"
+    list_names(337) = "Kobuk"
+    list_names(338) = "Altamaha"
+    list_names(339) = "GHAASBasin339"
+    list_names(340) = "Mand"
+    list_names(341) = "Santee"
+    list_names(342) = "GHAASBasin342"
+    list_names(343) = "GHAASBasin343"
+    list_names(344) = "GHAASBasin344"
+    list_names(345) = "Hari"
+    list_names(346) = "GHAASBasin346"
+    list_names(347) = "Wami"
+    list_names(348) = "GHAASBasin348"
+    list_names(349) = "GHAASBasin349"
+    !
+    basin_names(:) = '    '
+    !
+    DO i=1,numlar
+       tmp_str = list_names(i)
+       basin_names(i) = tmp_str(1:MIN(lenstr,LEN_TRIM(tmp_str)))
+    ENDDO
+    !
+  END SUBROUTINE routing_names
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_irrigmap
+!!
+!>\BRIEF         This  subroutine interpolates the 0.5x0.5 degree based map of irrigated areas to the resolution of the model.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_irrigmap (nbpt, index, lalo, neighbours, resolution, contfrac, &
+       &                     init_irrig, irrigated, init_flood, floodplains, init_swamp, &
+       &                     swamp, init_streamsurf, headw_area, stream_area, hist_id, hist2_id)   
+       
+    !
+    IMPLICIT NONE
+    !
+!! PARAMETERS
+    INTEGER(i_std), PARAMETER                      :: ilake = 1             !! Number of type of lakes area (unitless)
+    INTEGER(i_std), PARAMETER                      :: idam = 2              !! Number of type of dams area (unitless)
+    INTEGER(i_std), PARAMETER                      :: iflood = 3            !! Number of type of floodplains area (unitless)
+    INTEGER(i_std), PARAMETER                      :: iswamp = 4            !! Number of type of swamps area (unitless)
+    INTEGER(i_std), PARAMETER                      :: isal = 5              !! Number of type of salines area (unitless)
+    INTEGER(i_std), PARAMETER                      :: ipond = 6             !! Number of type of ponds area (unitless)
+    INTEGER(i_std), PARAMETER                      :: ntype = 6             !! Number of types of flooded surfaces (unitless)
+!!RL This is something that should have been defined in constantes_var
+    
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                     :: nbpt                  !! Domain size  (unitless)
+    INTEGER(i_std), INTENT(in)                     :: index(nbpt)           !! Index on the global map.
+    REAL(r_std), INTENT(in)                        :: lalo(nbpt,2)          !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)                     :: neighbours(nbpt,8)    !! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std), INTENT(in)                        :: resolution(nbpt,2)    !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)                        :: contfrac(nbpt)        !! Fraction of land in each grid box (unitless;0-1)
+    INTEGER(i_std), INTENT(in)                     :: hist_id               !! Access to history file (unitless)
+    INTEGER(i_std), INTENT(in)                     :: hist2_id              !! Access to history file 2 (unitless)
+    LOGICAL, INTENT(in)                            :: init_irrig            !! Logical to initialize the irrigation (true/false)
+    LOGICAL, INTENT(in)                            :: init_flood            !! Logical to initialize the floodplains (true/false)
+    LOGICAL, INTENT(in)                            :: init_swamp            !! Logical to initialize the swamps (true/false)
+    LOGICAL, INTENT(in)                            :: init_streamsurf       !! Logical to initialize the stream surface (true/false)
+    !
+!! OUTPUT VARIABLES
+    REAL(r_std), INTENT(out)                       :: irrigated(:)          !! Irrigated surface in each grid box @tex $(m^2})$ @endtex
+    REAL(r_std), INTENT(out)                       :: floodplains(:)        !! Surface which can be inundated in each grid box @tex $(m^2})$ @endtex
+    REAL(r_std), INTENT(out)                       :: swamp(:)              !! Surface which can be swamp in each grid box @tex $(m^2})$ @endtex
+    REAL(r_std), INTENT(out)                       :: headw_area(:)         !! Surface of head waters in each grid box @tex $(m^2})$ @endtex  
+    REAL(r_std), INTENT(out)                       :: stream_area(:)        !! Surface of rivers in each grid box @tex $(m^2})$ @endtex     
+    !
+!! LOCAL VARIABLES
+    ! Interpolation variables
+    ! 
+    INTEGER(i_std)                                 :: nbpmax, nix, njx, fopt!! Idices, (unitless)
+    CHARACTER(LEN=30)                              :: callsign              !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)     :: resol_lu              !! Resolution read on the map
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)    :: mask                  !! Mask to exclude some points (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: irrsub_area           !! Area on the fine grid (m^2)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: irrsub_index          !! Indices of the points we need on the fine grid (unitless)
+    INTEGER                                        :: ALLOC_ERR             !!
+    LOGICAL                                        :: ok_interpol = .FALSE. !! Flag for interpolation (true/false)
+    !
+    CHARACTER(LEN=80)                              :: filename              !! Name of the netcdf file (unitless)
+    INTEGER(i_std)                                 :: iml, jml, lml, tml, fid, ib, ip, jp, itype !! Indices (unitless)
+    REAL(r_std)                                    :: lev(1), date, dt, coslat !!
+    INTEGER(i_std)                                 :: itau(1)               !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: latrel                !! Latitude
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: lonrel                !! Longitude
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: irrigated_frac        !! Irrigated fraction of the grid box (unitless;0-1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)     :: flood_fracmax         !! Maximal flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: stream_frac           !! Sream fraction of the grid box (unitless;0-1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: headw_frac            !! Head water fraction of the grid box (unitless;0-1)   
+    REAL(r_std)                                    :: area_irrig            !! Irrigated surface in the grid box @tex $(m^2})$ @endtex
+    REAL(r_std)                                    :: area_flood(ntype)     !! Flooded surface in the grid box @tex $(m^2})$ @endtex
+    REAL(r_std)                                    :: area_stream           !! River surface in the grid box @tex $(m^2})$ @endtex
+    REAL(r_std)                                    :: area_headw            !! Head water surface in the grid box @tex $(m^2})$ @endtex    
+!$    REAL(r_std)                                :: irrigmap(nbpt)
+!$    REAL(r_std)                                :: floodmap(nbpt)
+!$    REAL(r_std)                                :: swampmap(nbpt)
+
+!_ ================================================================================================================================
+
+    !
+    !Config Key   = IRRIGATION_FILE
+    !Config Desc  = Name of file which contains the map of irrigated areas
+    !Config Def   = floodplains.nc
+    !Config If    = DO_IRRIGATION OR DO_FLOODPLAINS OR ok_doc
+    !Config Help  = The name of the file to be opened to read the field
+    !Config         with the area in m^2 of the area irrigated within each
+    !Config         0.5 0.5 deg grid box. The map currently used is the one
+    !Config         developed by the Center for Environmental Systems Research 
+    !Config         in Kassel (1995).
+    !Config Units = [FILE]
+    !
+    filename = 'floodplains.nc' !
+    CALL getin_p('IRRIGATION_FILE',filename)  
+    !
+    IF (is_root_prc) THEN
+       CALL flininfo(filename,iml, jml, lml, tml, fid)
+       CALL flinclo(fid)
+    ENDIF
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    !
+    !
+    ALLOCATE (latrel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for latrel','','')
+
+    ALLOCATE (lonrel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for lonrel','','')
+
+    ALLOCATE (irrigated_frac(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for irrigated_frac','','')
+
+    ALLOCATE (flood_fracmax(iml,jml,ntype), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for flood_fracmax','','')
+
+    IF (is_root_prc) CALL flinopen(filename, .FALSE., iml, jml, lml, lonrel, latrel, lev, tml, itau, date, dt, fid)
+    CALL bcast(lonrel)
+    CALL bcast(latrel)
+    
+ 
+    IF (is_root_prc) CALL flinget(fid, 'irrig', iml, jml, lml, tml, 1, 1, irrigated_frac)
+    CALL bcast(irrigated_frac)
+    IF (is_root_prc) CALL flinget(fid, 'lake', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,ilake))
+    IF (is_root_prc) CALL flinget(fid, 'dam', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,idam))
+    IF (is_root_prc) CALL flinget(fid, 'flood', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,iflood))
+    IF (is_root_prc) CALL flinget(fid, 'swamp', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,iswamp))
+    IF (is_root_prc) CALL flinget(fid, 'saline', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,isal))
+    CALL bcast(flood_fracmax)
+    IF (is_root_prc) CALL flinget(fid, 'headw', iml, jml, lml, tml, 1, 1, headw_frac)
+    CALL bcast(headw_frac)    
+    IF (is_root_prc) CALL flinget(fid, 'stream', iml, jml, lml, tml, 1, 1, stream_frac)
+    CALL bcast(stream_frac)    
+    !
+    IF (is_root_prc) CALL flinclo(fid)
+    !
+    ! Set to zero all fraction which are less than 0.5%
+    ! For head water and stream surface area a lower min threshold was chosen. 
+    ! Should we keep the 0.5% for floodplains, or better decrease the min_number?
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          IF ( irrigated_frac(ip,jp) .LT. undef_sechiba-un) THEN
+             irrigated_frac(ip,jp) = irrigated_frac(ip,jp)/100.
+             IF ( irrigated_frac(ip,jp) < 0.005 ) irrigated_frac(ip,jp) = zero
+          ENDIF
+          !
+          DO itype=1,ntype
+             IF ( flood_fracmax(ip,jp,itype) .LT. undef_sechiba-1.) THEN
+                flood_fracmax(ip,jp,itype) = flood_fracmax(ip,jp,itype)/100
+                IF ( flood_fracmax(ip,jp,itype) < 0.005 )  flood_fracmax(ip,jp,itype) = zero
+             ENDIF
+          ENDDO
+          !
+          IF ( headw_frac(ip,jp) .LT. undef_sechiba-un) THEN
+             headw_frac(ip,jp) = headw_frac(ip,jp)/100.
+             IF ( headw_frac(ip,jp) < 0.0001 ) headw_frac(ip,jp) = zero
+          ENDIF
+          !         
+          IF ( stream_frac(ip,jp) .LT. undef_sechiba-un) THEN
+             stream_frac(ip,jp) = stream_frac(ip,jp)/100.
+             IF ( stream_frac(ip,jp) < 0.0001 ) stream_frac(ip,jp) = zero
+          ENDIF
+          !           
+       ENDDO
+    ENDDO
+    !
+    WRITE(numout,*) 'lonrel : ', MAXVAL(lonrel), MINVAL(lonrel)
+    WRITE(numout,*) 'latrel : ', MAXVAL(latrel), MINVAL(latrel)
+    WRITE(numout,*) 'irrigated_frac : ', MINVAL(irrigated_frac, MASK=irrigated_frac .GT. 0), &
+         &                          MAXVAL(irrigated_frac, MASK=irrigated_frac .LT. undef_sechiba)
+    WRITE(numout,*) 'flood_fracmax : ', MINVAL(flood_fracmax, MASK=flood_fracmax .GT. 0), &
+         &                      MAXVAL(flood_fracmax, MASK=flood_fracmax .LT. undef_sechiba)
+    WRITE(numout,*) 'headw_frac : ', MINVAL(headw_frac, MASK=headw_frac .GT. 0), &
+         &                          MAXVAL(headw_frac, MASK=headw_frac .LT. undef_sechiba)          
+    WRITE(numout,*) 'stream_frac : ', MINVAL(stream_frac, MASK=stream_frac .GT. 0), &
+         &                          MAXVAL(stream_frac, MASK=stream_frac .LT. undef_sechiba)         
+    !
+    ! Consider all points a priori
+    !
+    ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for resol_lu','','')
+
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for mask','','')
+    mask(:,:) = 0
+
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          ! Exclude the points where we are close to the missing value.
+          !
+!MG This condition cannot be applied in floodplains/swamps configuration because
+!   the same mask would be used for the interpolation of irrigation, floodplains and swamps maps.
+!          IF ( irrigated_frac(ip,jp) < undef_sechiba ) THEN
+             mask(ip,jp) = 1
+!          ENDIF
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( latrel(ip,jp) * pi/180. ), mincos )     
+          IF ( ip .EQ. 1 ) THEN
+             resol_lu(ip,jp,1) = ABS( lonrel(ip+1,jp) - lonrel(ip,jp) ) * pi/180. * R_Earth * coslat
+          ELSEIF ( ip .EQ. iml ) THEN
+             resol_lu(ip,jp,1) = ABS( lonrel(ip,jp) - lonrel(ip-1,jp) ) * pi/180. * R_Earth * coslat
+          ELSE
+             resol_lu(ip,jp,1) = ABS( lonrel(ip+1,jp) - lonrel(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resol_lu(ip,jp,2) = ABS( latrel(ip,jp) - latrel(ip,jp+1) ) * pi/180. * R_Earth
+          ELSEIF ( jp .EQ. jml ) THEN
+             resol_lu(ip,jp,2) = ABS( latrel(ip,jp-1) - latrel(ip,jp) ) * pi/180. * R_Earth
+          ELSE
+             resol_lu(ip,jp,2) =  ABS( latrel(ip,jp-1) - latrel(ip,jp+1) )/2. * pi/180. * R_Earth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    callsign = 'Irrigation map'
+    ok_interpol = .FALSE.
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+       njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+       nbpmax = nix*njx*2
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+       WRITE(numout,*) "nbpmax = ",nbpmax, nix, njx
+    ENDIF
+    CALL bcast(nbpmax)
+
+    ALLOCATE(irrsub_index(nbpt, nbpmax, 2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for irrsub_index','','')
+    irrsub_index(:,:,:)=0
+
+    ALLOCATE(irrsub_area(nbpt, nbpmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'routing_irrigmap','Pb in allocate for irrsub_area','','')
+    irrsub_area(:,:)=zero
+
+    CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+         &                iml, jml, lonrel, latrel, mask, callsign, &
+         &                nbpmax, irrsub_index, irrsub_area, ok_interpol)
+    !
+    !
+    WHERE (irrsub_area < 0) irrsub_area=zero
+    !  
+    ! Test here if not all sub_area are larger than 0 if so, then we need to increase nbpmax
+    !
+    DO ib=1,nbpt
+       !
+       area_irrig  = 0.0
+       area_flood  = 0.0
+       area_stream = 0.0
+       area_headw  = 0.0
+       !
+       DO fopt=1,COUNT(irrsub_area(ib,:) > zero)
+          !
+          ip = irrsub_index(ib, fopt, 1)
+          jp = irrsub_index(ib, fopt, 2)
+          !
+          IF (irrigated_frac(ip,jp) .LT. undef_sechiba-1.) THEN
+             area_irrig = area_irrig + irrsub_area(ib,fopt)*irrigated_frac(ip,jp)
+          ENDIF
+          !
+          DO itype=1,ntype
+             IF (flood_fracmax(ip,jp,itype) .LT. undef_sechiba-1.) THEN
+                area_flood(itype) = area_flood(itype) + irrsub_area(ib,fopt)*flood_fracmax(ip,jp,itype)
+             ENDIF
+          ENDDO
+       ENDDO
+       !
+       ! Put the total irrigated and flooded areas in the output variables
+       !
+       IF ( init_irrig ) THEN
+          irrigated(ib) = MIN(area_irrig, resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( irrigated(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', irrigated(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_irrig
+             CALL ipslerr_p(3,'routing_irrigmap','Problem with irrigated...','','')
+          ENDIF
+!$          ! Compute a diagnostic of the map.
+!$          IF(contfrac(ib).GT.zero) THEN
+!$             irrigmap (ib) = irrigated(ib) / ( resolution(ib,1)*resolution(ib,2)*contfrac(ib) )
+!$          ELSE
+!$             irrigmap (ib) = zero
+!$          ENDIF
+          !
+       ENDIF
+       !
+       IF ( init_flood ) THEN
+          floodplains(ib) = MIN(area_flood(iflood)+area_flood(idam)+area_flood(isal), &
+               & resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( floodplains(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', floodplains(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_flood
+             CALL ipslerr_p(3,'routing_irrigmap','Problem with floodplains..','','')
+          ENDIF
+!$          ! Compute a diagnostic of the map.
+!$          IF(contfrac(ib).GT.zero) THEN
+!$             floodmap(ib) = floodplains(ib) / ( resolution(ib,1)*resolution(ib,2)*contfrac(ib) )
+!$          ELSE
+!$             floodmap(ib) = 0.0
+!$          ENDIF
+       ENDIF
+       !
+       IF ( init_swamp ) THEN
+          swamp(ib) = MIN(area_flood(iswamp), resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( swamp(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', swamp(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_flood
+             CALL ipslerr_p(3,'routing_irrigmap','Problem with swamp...','','')
+          ENDIF
+!$          ! Compute a diagnostic of the map.
+!$          IF(contfrac(ib).GT.zero) THEN
+!$             swampmap(ib) = swamp(ib) / ( resolution(ib,1)*resolution(ib,2)*contfrac(ib) )
+!$          ELSE
+!$             swampmap(ib) = zero
+!$          ENDIF
+       ENDIF
+       !
+       IF ( init_streamsurf ) THEN
+          headw_area(ib) = MIN(area_headw, resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( headw_area(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', headw_area(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_headw
+             STOP
+          ENDIF
+          
+          stream_area(ib) = MIN(area_stream, resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( stream_area(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', stream_area(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_stream
+             STOP
+          ENDIF
+          !
+       ENDIF
+       !
+       !
+       !
+    ENDDO
+    !
+    !
+    IF ( init_irrig ) WRITE(numout,*) "Diagnostics irrigated :", MINVAL(irrigated), MAXVAL(irrigated)
+    IF ( init_flood ) WRITE(numout,*) "Diagnostics floodplains :", MINVAL(floodplains), MAXVAL(floodplains)
+    IF ( init_swamp ) WRITE(numout,*) "Diagnostics swamp :", MINVAL(swamp), MAXVAL(swamp)
+    IF ( init_streamsurf ) WRITE(numout,*) "Diagnostics head waters :", MINVAL(headw_area), MAXVAL(headw_area)  
+    IF ( init_streamsurf ) WRITE(numout,*) "Diagnostics rivers :", MINVAL(stream_area), MAXVAL(stream_area)    
+!
+! No compensation is done for overlapping floodplains, swamp and irrig. At least overlapping will not
+! happen between floodplains and swamp alone
+!    IF ( init_irrig .AND. init_flood ) THEN
+!       DO ib = 1, nbpt
+!          surp = (floodplains(ib)+swamp(ib)+irrigated(ib)) / (resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+!          IF ( surp .GT. un ) THEN
+!             floodplains(ib) = floodplains(ib) / surp
+!             swamp(ib) = swamp(ib) / surp
+!             irrigated(ib) = irrigated(ib) / surp
+!          ENDIF
+!       ENDDO
+!    ENDIF
+    !
+    DEALLOCATE (irrsub_area)
+    DEALLOCATE (irrsub_index)
+    !
+    DEALLOCATE (mask)
+    DEALLOCATE (resol_lu)
+    !
+    DEALLOCATE (lonrel)
+    DEALLOCATE (latrel)
+    !
+  END SUBROUTINE routing_irrigmap
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_waterbal
+!!
+!>\BRIEF         This subroutine checks the water balance in the routing module.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_waterbal(nbpt, reinit, flood_frac, floodout, precipitation, runoff, drainage,  &
+               & returnflow, reinfiltration, irrigation, riverflow, coastalflow)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in) :: nbpt                       !! Domain size  (unitless)
+    LOGICAL, INTENT(in)        :: reinit                     !! Controls behaviour (true/false)
+    REAL(r_std), INTENT(in)    :: flood_frac(nbpt)           !! Grid-point fraction of floodplains 
+    REAL(r_std), INTENT(in)    :: floodout(nbpt)             !! Grid-point flow out of floodplains 
+                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: precipitation(nbpt,nflow)  !! Grid-point precipitation @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: runoff(nbpt,nflow)         !! Grid-point runoff @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: drainage(nbpt,nflow)       !! Grid-point drainage @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: returnflow(nbpt,nflow)     !! The water flow from lakes and swamps which returns to the grid box.
+                                                             !! This water will go back into the hydrol or hydrolc module to allow 
+                                                             !! re-evaporation @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: reinfiltration(nbpt,nflow) !! Water flow from ponds and floodplains which returns to the grid box 
+                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: irrigation(nbpt,nflow)     !! Irrigation flux. This is the water taken from the reservoirs and 
+                                                             !! beeing put into the upper layers of the soil 
+                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: riverflow(nbpt,nflow)      !! Outflow of the major rivers. The flux will be located on the 
+                                                             !! continental grid but this should be a coastal point 
+                                                             !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: coastalflow(nbpt,nflow)    !! Outflow on coastal points by small basins. This is the water which 
+                                                             !! flows in a disperse way into the ocean @tex $(kg dt^{-1})$ @endtex
+    !
+    ! We sum-up all the water we have in the warious reservoirs
+    !! 0.2 Local variables    
+    REAL(r_std), SAVE          :: totw_flood           !! Sum of all the water amount in the floodplains reservoirs (kg)
+    REAL(r_std), SAVE          :: totw_stream          !! Sum of all the water amount in the stream reservoirs (kg)
+    REAL(r_std), SAVE          :: totw_fast            !! Sum of all the water amount in the fast reservoirs (kg)
+    REAL(r_std), SAVE          :: totw_slow            !! Sum of all the water amount in the slow reservoirs (kg)
+    REAL(r_std), SAVE          :: totw_lake            !! Sum of all the water amount in the lake reservoirs (kg)
+    REAL(r_std), SAVE          :: totw_pond            !! Sum of all the water amount in the pond reservoirs (kg)
+    REAL(r_std), SAVE          :: totw_in              !! Sum of the water flow in to the routing scheme
+    REAL(r_std), SAVE          :: totw_out             !! Sum of the water flow out to the routing scheme
+    REAL(r_std), SAVE          :: totw_return          !! 
+    REAL(r_std), SAVE          :: totw_irrig           !! 
+    REAL(r_std), SAVE          :: totw_river           !! 
+    REAL(r_std), SAVE          :: totw_coastal         !! 
+    REAL(r_std), SAVE          :: totc_flood           !! Sum of all the carbon amount in the floodplains reservoirs (kg)
+    REAL(r_std), SAVE          :: totc_stream          !! Sum of all the carbon amount in the stream reservoirs (kg)
+    REAL(r_std), SAVE          :: totc_fast            !! Sum of all the carbon amount in the fast reservoirs (kg)
+    REAL(r_std), SAVE          :: totc_slow            !! Sum of all the carbon amount in the slow reservoirs (kg)
+    REAL(r_std), SAVE          :: totc_lake            !! Sum of all the carbon amount in the lake reservoirs (kg)
+    REAL(r_std), SAVE          :: totc_pond            !! Sum of all the carbon amount in the pond reservoirs (kg)
+    REAL(r_std), SAVE          :: totc_in              !! Sum of the carbon flow in to the routing scheme
+    REAL(r_std), SAVE          :: totc_out             !! Sum of the carbon flow out to the routing scheme
+    REAL(r_std), SAVE          :: totc_return          !! 
+    REAL(r_std), SAVE          :: totc_irrig           !! 
+    REAL(r_std), SAVE          :: totc_river           !! 
+    REAL(r_std), SAVE          :: totc_coastal         !!
+    REAL(r_std), SAVE          :: totc_FCO2         !!    
+    REAL(r_std)                :: totarea              !! Total area of basin @tex $(m^2})$ @endtex
+    REAL(r_std)                :: area                 !! Total area of routing @tex $(m^2})$ @endtex
+    INTEGER(i_std)             :: ig                   !! 
+    
+    ! Just to make sure we do not get too large numbers !
+    
+    !! PARAMETERS
+    REAL(r_std), PARAMETER     :: scaling = 1.0E+6     !!
+    REAL(r_std), PARAMETER     :: allowed_err = 50.    !!
+  !! 1. Calculate water balance
+    IF ( reinit ) THEN
+       !
+       totw_flood = zero
+       totw_stream = zero
+       totw_fast = zero
+       totw_slow = zero
+       totw_lake = zero
+       totw_pond = zero 
+       totw_in = zero
+       !
+       DO ig=1,nbpt
+          !
+          totarea = SUM(routing_area(ig,:))
+          !
+          totw_flood = totw_flood + SUM(flood_reservoir(ig,:,ih2o)/scaling)
+          totw_stream = totw_stream + SUM(stream_reservoir(ig,:,ih2o)/scaling)
+          totw_fast = totw_fast + SUM(fast_reservoir(ig,:,ih2o)/scaling)
+          totw_slow = totw_slow + SUM(slow_reservoir(ig,:,ih2o)/scaling)
+          totw_lake = totw_lake + lake_reservoir(ig,ih2o)/scaling
+          totw_pond = totw_pond + pond_reservoir(ig,ih2o)/scaling
+          !
+          totw_in = totw_in + (runoff(ig,ih2o) + drainage(ig,ih2o) - floodout(ig))&
+          &       * totarea / scaling
+          !
+       ENDDO
+       !
+    ELSE
+       !
+       totw_out = zero
+       totw_return = zero
+       totw_irrig = zero
+       totw_river = zero
+       totw_coastal = zero
+       area = zero
+       !
+       DO ig=1,nbpt
+          !
+          totarea = SUM(routing_area(ig,:))
+          !
+          totw_flood = totw_flood - SUM(flood_reservoir(ig,:,ih2o)/scaling)
+          totw_stream = totw_stream - SUM(stream_reservoir(ig,:,ih2o)/scaling)
+          totw_fast = totw_fast - SUM(fast_reservoir(ig,:,ih2o)/scaling)
+          totw_slow = totw_slow - SUM(slow_reservoir(ig,:,ih2o)/scaling)
+          totw_lake = totw_lake - lake_reservoir(ig,ih2o)/scaling
+          totw_pond = totw_pond - pond_reservoir(ig,ih2o)/scaling
+          !
+          totw_return = totw_return + (reinfiltration(ig,ih2o)+returnflow(ig,ih2o))*totarea/scaling
+          totw_irrig = totw_irrig + irrigation(ig,ih2o)*totarea/scaling
+          totw_river = totw_river + riverflow(ig,ih2o)/scaling
+          totw_coastal = totw_coastal + coastalflow(ig,ih2o)/scaling
+          !
+          area = area + totarea
+          !
+       ENDDO
+       totw_out = totw_return + totw_irrig + totw_river + totw_coastal
+       !
+       ! Now we have all the information to balance our water
+       !
+       IF ( ABS((totw_flood + totw_stream + totw_fast + totw_slow + totw_lake + totw_pond) - &
+            & (totw_out - totw_in)) > allowed_err ) THEN
+          WRITE(numout,*) 'WARNING : Water not conserved in routing. Limit at ', allowed_err, ' 10^6 kg'
+          WRITE(numout,*) '--Water-- change : flood stream fast ', totw_flood, totw_stream, totw_fast
+          WRITE(numout,*) '--Water-- change : slow, lake ', totw_slow, totw_lake
+          WRITE(numout,*) '--Water>>> change in the routing res. : ', totw_flood + totw_stream + totw_fast + totw_slow + totw_lake
+          WRITE(numout,*) '--Water input : ', totw_in
+          WRITE(numout,*) '--Water output : ', totw_out
+          WRITE(numout,*) '--Water output : return, irrig ', totw_return, totw_irrig
+          WRITE(numout,*) '--Water output : river, coastal ',totw_river, totw_coastal
+          WRITE(numout,*) '--Water>>> change by fluxes : ', totw_out - totw_in, ' Diff [mm/dt]: ',   &
+               & ((totw_flood + totw_stream + totw_fast + totw_slow + totw_lake) - (totw_out - totw_in))/area
+
+          ! Stop the model
+          CALL ipslerr_p(3, 'routing_waterbal', 'Water is not conserved in routing.','','')
+       ENDIF
+       !       !
+    ENDIF
+    !! 2 Calculate C fluxes
+    IF ( reinit ) THEN
+       !
+       totc_flood = zero
+       totc_stream = zero
+       totc_fast = zero
+       totc_slow = zero
+       totc_lake = zero
+       totc_pond = zero 
+       totc_in = zero
+       !
+       DO ig=1,nbpt
+          !
+          totarea = SUM(routing_area(ig,:))
+          !
+          totc_flood  = totc_flood + SUM(flood_reservoir(ig,:,idoc)) &
+          &           + SUM(flood_reservoir(ig,:,iCO2aq))
+          totc_stream = totc_stream + SUM(stream_reservoir(ig,:,idoc)) &
+          &           + SUM(stream_reservoir(ig,:,iCO2aq))
+          totc_fast = totc_fast + SUM(fast_reservoir(ig,:,idoc)) + SUM(fast_reservoir(ig,:,iCO2aq))
+          totc_slow = totc_slow + SUM(slow_reservoir(ig,:,idoc)) + SUM(slow_reservoir(ig,:,iCO2aq))
+          totc_lake = totc_lake + lake_reservoir(ig,idoc) + lake_reservoir(ig,iCO2aq)
+          totc_pond = totc_pond + pond_reservoir(ig,idoc) + pond_reservoir(ig,iCO2aq)
+          !
+          totc_in = totc_in + totarea &
+          & * ((precipitation(ig,idoc) + precipitation(ig,iCO2aq)) * flood_frac(ig) &
+          & + runoff(ig,idoc) + runoff(ig,iCO2aq) + drainage(ig,idoc) + drainage(ig,iCO2aq))            
+          !
+       ENDDO
+       !
+    ELSE
+       !
+       totc_out = zero
+       totc_return = zero
+       totc_irrig = zero
+       totc_river = zero
+       totc_coastal = zero
+       totc_FCO2 = zero
+       area = zero
+       !
+       DO ig=1,nbpt
+          !
+          totarea = SUM(routing_area(ig,:))
+          !
+          totc_flood  = totc_flood - SUM(flood_reservoir(ig,:,idoc)) &
+          &           - SUM(flood_reservoir(ig,:,iCO2aq))
+          totc_stream = totc_stream - SUM(stream_reservoir(ig,:,idoc)) &
+          &           - SUM(stream_reservoir(ig,:,iCO2aq))
+          totc_fast = totc_fast - SUM(fast_reservoir(ig,:,idoc)) - SUM(fast_reservoir(ig,:,iCO2aq))
+          totc_slow = totc_slow - SUM(slow_reservoir(ig,:,idoc)) - SUM(slow_reservoir(ig,:,iCO2aq))
+          totc_lake = totc_lake - lake_reservoir(ig,idoc) - lake_reservoir(ig,iCO2aq)
+          totc_pond = totc_pond - pond_reservoir(ig,idoc) - pond_reservoir(ig,iCO2aq)
+          !
+          totc_return = totc_return + (reinfiltration(ig,idoc) + returnflow(ig,idoc) &
+          &           + reinfiltration(ig,iCO2aq) + returnflow(ig,iCO2aq) )*totarea
+          totc_irrig = totc_irrig + (irrigation(ig,idoc)+irrigation(ig,iCO2aq)) * totarea
+          totc_river = totc_river + riverflow(ig,idoc) + riverflow(ig,iCO2aq)
+          totc_coastal = totc_coastal + coastalflow(ig,idoc) + coastalflow(ig,iCO2aq)
+          totc_FCO2    = totc_FCO2 + SUM(FCO2_aq(ig,:))
+          !
+          area = area + totarea
+          !
+       ENDDO
+       totc_out = totc_return + totc_irrig + totc_river + totc_coastal + totc_FCO2
+       !
+       ! Now we have all the information to balance our carbon
+       !
+       IF ( ABS((totc_flood + totc_stream + totc_fast + totc_slow + totc_lake + totc_pond) - &
+            & (totc_out - totc_in)) > allowed_err ) THEN
+          WRITE(numout,*) 'WARNING : carbon not conserved in routing. Limit at ', allowed_err, ' 10^6 kg'
+          WRITE(numout,*) '--carbon-- change : flood stream fast ', totc_flood, totc_stream, totc_fast
+          WRITE(numout,*) '--carbon-- change : slow, lake ', totc_slow, totc_lake
+          WRITE(numout,*) '--carbon>>> change in the routing res. : ', totc_flood + totc_stream &
+          &               + totc_fast + totc_slow + totc_lake
+          WRITE(numout,*) '--carbon input : ', totc_in
+          WRITE(numout,*) '--carbon output : ', totc_out
+          WRITE(numout,*) '--carbon output : return, irrig ', totc_return, totc_irrig
+          WRITE(numout,*) '--carbon output : river, coastal ',totc_river, totc_coastal
+          WRITE(numout,*) '--carbon>>> change by fluxes : ', totc_out - totc_in, ' Diff [mm/dt]: ',   &
+          & ((totc_flood + totc_stream + totc_fast + totc_slow + totc_lake) - (totc_out - totc_in))/area
+       ENDIF
+       !       !
+    ENDIF    
+    !
+  END SUBROUTINE routing_waterbal
+  
+  
+END MODULE routing
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/sechiba.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/sechiba.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/sechiba.f90	(revision 5166)
@@ -0,0 +1,2032 @@
+!  ==============================================================================================================================\n
+!  MODULE 	: sechiba
+! 
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Structures the calculation of atmospheric and hydrological 
+!! variables by calling diffuco_main, enerbil_main, hydrolc_main (or hydrol_main),
+!! enerbil_fusion, condveg_main and thermosoil_main. Note that sechiba_main
+!! calls slowproc_main and thus indirectly calculates the biogeochemical
+!! processes as well.
+!!
+!!\n DESCRIPTION  : :: shumdiag, :: litterhumdiag and :: stempdiag are not 
+!! saved in the restart file because at the first time step because they 
+!! are recalculated. However, they must be saved as they are in slowproc 
+!! which is called before the modules which calculate them.
+!! 
+!! RECENT CHANGE(S): None 
+!! 
+!! REFERENCE(S) : None
+!!   
+!! SVN     :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+ 
+MODULE sechiba
+ 
+  USE ioipsl
+  USE xios_orchidee
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE diffuco
+  USE condveg
+  USE enerbil
+  USE hydrol                                                                     !! 
+  USE hydrolc
+  USE thermosoil
+  USE thermosoilc
+  USE sechiba_io
+  USE slowproc
+  USE routing
+  use ioipsl_para
+
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC sechiba_main, sechiba_initialize, sechiba_clear
+
+  INTEGER(i_std), SAVE                             :: printlev_loc   !! local printlev for this module
+!$OMP THREADPRIVATE(printlev_loc)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexveg       !! indexing array for the 3D fields of vegetation
+!$OMP THREADPRIVATE(indexveg)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexlai       !! indexing array for the 3D fields of vegetation
+!$OMP THREADPRIVATE(indexlai)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexnobio     !! indexing array for the 3D fields of other surfaces (ice,
+                                                                     !! lakes, ...)
+!$OMP THREADPRIVATE(indexnobio)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexsoil      !! indexing array for the 3D fields of soil types (kjpindex*nstm)
+!$OMP THREADPRIVATE(indexsoil)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexgrnd      !! indexing array for the 3D ground heat profiles (kjpindex*ngrnd)
+!$OMP THREADPRIVATE(indexgrnd)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexlayer     !! indexing array for the 3D fields of soil layers in CWRR (kjpindex*nslm)
+!$OMP THREADPRIVATE(indexlayer)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexnbdl      !! indexing array for the 3D fields of diagnostic soil layers (kjpindex*nbdl)
+!$OMP THREADPRIVATE(indexnbdl)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexalb       !! indexing array for the 2 fields of albedo
+!$OMP THREADPRIVATE(indexalb)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexsnow      !! indexing array for the 3D fields snow layers
+!$OMP THREADPRIVATE(indexsnow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: veget          !! Fraction of vegetation type (unitless, 0-1)       
+!$OMP THREADPRIVATE(veget)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: veget_max      !! Max. fraction of vegetation type (LAI -> infty, unitless)
+!$OMP THREADPRIVATE(veget_max)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: tot_bare_soil  !! Total evaporating bare soil fraction 
+!$OMP THREADPRIVATE(tot_bare_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: height         !! Vegetation Height (m)
+!$OMP THREADPRIVATE(height)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: totfrac_nobio  !! Total fraction of continental ice+lakes+cities+...
+                                                                     !! (unitless, 0-1)
+!$OMP THREADPRIVATE(totfrac_nobio)
+  REAL(r_std),ALLOCATABLE, SAVE,  DIMENSION (:,:)  :: wat_flux0      !! Water flux in the first soil layers exported for soil C calculations
+!$OMP THREADPRIVATE(wat_flux0)
+  REAL(r_std),ALLOCATABLE, SAVE,  DIMENSION (:,:,:) :: wat_flux       !! Water flux in the soil layers exported for soil C calculations
+!$OMP THREADPRIVATE(wat_flux)
+  REAL(r_std),ALLOCATABLE, SAVE,  DIMENSION (:,:)  :: drainage_per_soil !! Drainage per soil type exported for soil C calculations
+!$OMP THREADPRIVATE(drainage_per_soil)
+  REAL(r_std),ALLOCATABLE, SAVE,  DIMENSION (:,:)  :: runoff_per_soil !! Runoff per soil type exported for soil C calculations
+!$OMP THREADPRIVATE(runoff_per_soil)
+  REAL, ALLOCATABLE, DIMENSION(:,:,:) :: soil_mc
+!$OMP THREADPRIVATE(soil_mc)
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: litter_mc
+!$OMP THREADPRIVATE(litter_mc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: floodout       !! Flow out of floodplains from hydrol
+!$OMP THREADPRIVATE(floodout)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: runoff         !! Surface runoff calculated by hydrol or hydrolc 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: DOC_EXP_agg_d  !! DOC exports, diffrenet paths (nexp), in  
+                                                                     !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex 
+!$OMP THREADPRIVATE(runoff)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: drainage       !! Deep drainage calculatedd by hydrol or hydrolc 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(drainage)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: returnflow     !! Water flow from lakes and swamps which returns to 
+                                                                     !! the grid box @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(returnflow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: reinfiltration !! Routed water which returns into the soil
+!$OMP THREADPRIVATE(reinfiltration)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: irrigation     !! Irrigation flux taken from the routing reservoirs and 
+                                                                     !! being put into the upper layers of the soil 
+                                                                     !! @tex $(kg m^{-2})$ @endtex                                           
+!$OMP THREADPRIVATE(irrigation)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: DOC_to_topsoil !! Sum of DOC fluxes from irrirgation and reinfiltration 
+                                                                     !! @tex $(g m^{-2})$ @endtex                                           
+!$OMP THREADPRIVATE(DOC_to_topsoil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: DOC_to_subsoil !! DOC fluxes from returnflow in lakes and swamps 
+                                                                     !! @tex $(g m^{-2})$ @endtex                                           
+!$OMP THREADPRIVATE(DOC_to_subsoil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: emis           !! Surface emissivity (unitless)
+!$OMP THREADPRIVATE(emis)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: z0             !! Surface roughness (m)
+!$OMP THREADPRIVATE(z0)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: roughheight    !! Effective height for roughness (m)
+!$OMP THREADPRIVATE(roughheight)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: reinf_slope    !! slope coefficient (reinfiltration) 
+!$OMP THREADPRIVATE(reinf_slope)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: shumdiag       !! Mean relative soil moisture in the different levels used 
+                                                                     !! by thermosoil.f90 (unitless, 0-1)
+!$OMP THREADPRIVATE(shumdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: shumdiag_perma !! Saturation degree of the soil 
+!$OMP THREADPRIVATE(shumdiag_perma)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: k_litt         !! litter cond.
+!$OMP THREADPRIVATE(k_litt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: litterhumdiag  !! Litter dryness factor (unitless, 0-1)
+!$OMP THREADPRIVATE(litterhumdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: stempdiag      !! Temperature which controls canopy evolution (K)
+!$OMP THREADPRIVATE(stempdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: qsintveg       !! Water on vegetation due to interception 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(qsintveg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta2         !! Interception resistance (unitless,0-1)
+!$OMP THREADPRIVATE(vbeta2)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta3         !! Vegetation resistance (unitless,0-1)
+!$OMP THREADPRIVATE(vbeta3)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta3pot      !! Potential vegetation resistance
+!$OMP THREADPRIVATE(vbeta3pot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: gsmean         !! Mean stomatal conductance for CO2 (umol m-2 s-1) 
+!$OMP THREADPRIVATE(gsmean) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: cimean         !! STOMATE: mean intercellular CO2 concentration (ppm)
+!$OMP THREADPRIVATE(cimean)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vevapwet       !! Interception loss over each PFT 
+                                                                     !! @tex $(kg m^{-2} days^{-1})$ @endtex
+!$OMP THREADPRIVATE(vevapwet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: transpir       !! Transpiration @tex $(kg m^{-2} days^{-1})$ @endtex
+!$OMP THREADPRIVATE(transpir)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: transpot       !! Potential Transpiration (needed for irrigation)
+!$OMP THREADPRIVATE(transpot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: qsintmax       !! Maximum amount of water in the canopy interception 
+                                                                     !! reservoir @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(qsintmax)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: rveget         !! Surface resistance for the vegetation 
+                                                                     !! @tex $(s m^{-1})$ @endtex
+!$OMP THREADPRIVATE(rveget)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: rstruct        !! Vegetation structural resistance
+!$OMP THREADPRIVATE(rstruct)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: snow_nobio     !! Snow mass of non-vegetative surfaces 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(snow_nobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: snow_nobio_age !! Snow age on non-vegetative surfaces (days)
+!$OMP THREADPRIVATE(snow_nobio_age)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: frac_nobio     !! Fraction of non-vegetative surfaces (continental ice, 
+                                                                     !! lakes, ...) (unitless, 0-1)
+!$OMP THREADPRIVATE(frac_nobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: albedo         !! Surface albedo for visible and near-infrared 
+                                                                     !! (unitless, 0-1)
+!$OMP THREADPRIVATE(albedo)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:):: assim_param    !! min+max+opt temps, vcmax, vjmax for photosynthesis
+!$OMP THREADPRIVATE(assim_param)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lai            !! Surface foliaire
+!$OMP THREADPRIVATE(lai)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: gpp            !! STOMATE: GPP. gC/m**2 of total area
+!$OMP THREADPRIVATE(gpp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)     :: temp_growth       !! Growth temperature (ÃÂ°C) - Is equal to t2m_month 
+!$OMP THREADPRIVATE(temp_growth) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: humrel         !! Relative humidity
+!$OMP THREADPRIVATE(humrel)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vegstress      !! Vegetation moisture stress (only for vegetation growth)
+!$OMP THREADPRIVATE(vegstress)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:):: frac_age       !! Age efficacity from STOMATE for isoprene 
+!$OMP THREADPRIVATE(frac_age)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: soiltile       !! Fraction of each soil tile (0-1, unitless)
+!$OMP THREADPRIVATE(soiltile)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+!$OMP THREADPRIVATE(njsc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta1         !! Snow resistance 
+!$OMP THREADPRIVATE(vbeta1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta4         !! Bare soil resistance
+!$OMP THREADPRIVATE(vbeta4)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta5         !! Floodplains resistance
+!$OMP THREADPRIVATE(vbeta5)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: soilcap        !!
+!$OMP THREADPRIVATE(soilcap)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: soilflx        !!
+!$OMP THREADPRIVATE(soilflx)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: temp_sol       !! Soil temperature
+!$OMP THREADPRIVATE(temp_sol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: qsurf          !! near soil air moisture
+!$OMP THREADPRIVATE(qsurf)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: flood_res      !! flood reservoir estimate
+!$OMP THREADPRIVATE(flood_res)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: flood_frac     !! flooded fraction
+!$OMP THREADPRIVATE(flood_frac)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: snow           !! Snow mass [Kg/m^2]
+!$OMP THREADPRIVATE(snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: snow_age       !! Snow age
+!$OMP THREADPRIVATE(snow_age)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: drysoil_frac   !! Fraction of visibly (albedo) Dry soil (Between 0 and 1)
+!$OMP THREADPRIVATE(drysoil_frac)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: rsol           !! resistance to bare soil evaporation
+!$OMP THREADPRIVATE(rsol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: evap_bare_lim  !! Bare soil stress
+!$OMP THREADPRIVATE(evap_bare_lim)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: co2_flux       !! CO2 flux (gC/m**2 of average ground/s)
+!$OMP THREADPRIVATE(co2_flux)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: evapot         !! Soil Potential Evaporation
+!$OMP THREADPRIVATE(evapot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: evapot_corr    !! Soil Potential Evaporation Correction (Milly 1992)
+!$OMP THREADPRIVATE(evapot_corr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vevapflo       !! Floodplains evaporation
+!$OMP THREADPRIVATE(vevapflo)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vevapsno       !! Snow evaporation
+!$OMP THREADPRIVATE(vevapsno)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vevapnu        !! Bare soil evaporation
+!$OMP THREADPRIVATE(vevapnu)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: t2mdiag        !! 2 meter temperature
+!$OMP THREADPRIVATE(t2mdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: tot_melt       !! Total melt
+!$OMP THREADPRIVATE(tot_melt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta          !! Resistance coefficient
+!$OMP THREADPRIVATE(vbeta)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: valpha         !! Resistance coefficient
+!$OMP THREADPRIVATE(valpha)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: fusion         !!
+!$OMP THREADPRIVATE(fusion)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: rau            !! Density
+!$OMP THREADPRIVATE(rau)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: deadleaf_cover !! Fraction of soil covered by dead leaves
+!$OMP THREADPRIVATE(deadleaf_cover)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: ptnlev1        !! 1st level Different levels soil temperature
+!$OMP THREADPRIVATE(ptnlev1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: mc_layh        !! Volumetric soil moisture for each layer in hydrol(liquid + ice) (m3/m3)
+!$OMP THREADPRIVATE(mc_layh)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: mcl_layh       !! Volumetric soil moisture for each layer in hydrol(liquid) (m3/m3)
+!$OMP THREADPRIVATE(mcl_layh)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: tmc_layh       !! Total soil moisture content for each layer in hydrol(liquid + ice) (mm)
+!$OMP THREADPRIVATE(tmc_layh)
+
+  LOGICAL, SAVE                                    :: l_first_sechiba = .TRUE. !! Flag controlling the intialisation (true/false)
+!$OMP THREADPRIVATE(l_first_sechiba)
+
+  ! Variables related to snow processes calculations  
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: snowrho      !! snow density for each layer
+!$OMP THREADPRIVATE(snowrho)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: snowheat     !! snow heat content for each layer (J/m2)
+!$OMP THREADPRIVATE(snowheat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: snowgrain    !! snow grain size (m)
+!$OMP THREADPRIVATE(snowgrain)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: snowtemp     !! snow temperature profile (K)
+!$OMP THREADPRIVATE(snowtemp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: snowdz       !! snow layer thickness (m)
+!$OMP THREADPRIVATE(snowdz)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: gtemp        !! soil surface temperature
+!$OMP THREADPRIVATE(gtemp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: pgflux       !! net energy into snow pack
+!$OMP THREADPRIVATE(pgflux)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: cgrnd_snow   !! Integration coefficient for snow numerical scheme
+!$OMP THREADPRIVATE(cgrnd_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)  :: dgrnd_snow   !! Integration coefficient for snow numerical scheme
+!$OMP THREADPRIVATE(dgrnd_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: lambda_snow  !! Coefficient of the linear extrapolation of surface temperature 
+                                                                  !! from the first and second snow layers
+!$OMP THREADPRIVATE(lambda_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)    :: temp_sol_add !! Additional energy to melt snow for snow ablation case (K)
+!$OMP THREADPRIVATE(temp_sol_add)
+
+  LOGICAL, SAVE                                   :: ok_doc= .TRUE.
+!$OMP THREADPRIVATE(ok_doc)   
+  CHARACTER(LEN=80)    :: var_name       !! To store variables names for I/O (unitless)
+  CHARACTER(LEN=10)    :: flow_suff      !! To assign a suffix to the variables name indicating the transported specie
+  CHARACTER(LEN=80)    :: var_long_name  !! To store variables long names for I/O (unitless) 
+CONTAINS
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    sechiba_initialize
+!!
+!>\BRIEF	  Initialize all prinicipal modules by calling their "_initialize" subroutines
+!!
+!! DESCRIPTION:	  Initialize all prinicipal modules by calling their "_initialize" subroutines
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE sechiba_initialize( &
+       kjit,         kjpij,        kjpindex,     index,      date0,       &
+       lalo,         contfrac,     neighbours,   resolution, zlev,        &
+       u,            v,            qair,         t2m,        temp_air,    &
+       petAcoef,     peqAcoef,     petBcoef,     peqBcoef,                &
+       precip_rain,  precip_snow,  lwdown,       swnet,      swdown,      &
+       pb,           rest_id,      hist_id,      hist2_id,                &
+       rest_id_stom, hist_id_stom, hist_id_stom_IPCC,                     &
+       coastalflow,  riverflow,    tsol_rad,     vevapp,       qsurf_out, &
+       z0_out,       albedo_out,   fluxsens,     fluxlat,      emis_out,  &
+       netco2flux,   fco2_lu,      temp_sol_new, tq_cdrag)
+
+!! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                               :: kjit              !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)                               :: kjpij             !! Total size of the un-compressed grid 
+                                                                                  !! (unitless)
+    INTEGER(i_std), INTENT(in)                               :: kjpindex          !! Domain size - terrestrial pixels only 
+                                                                                  !! (unitless)
+    INTEGER(i_std),INTENT (in)                               :: rest_id           !! _Restart_ file identifier (unitless)
+    INTEGER(i_std),INTENT (in)                               :: hist_id           !! _History_ file identifier (unitless)
+    INTEGER(i_std),INTENT (in)                               :: hist2_id          !! _History_ file 2 identifier (unitless)
+    INTEGER(i_std),INTENT (in)                               :: rest_id_stom      !! STOMATE's _Restart_ file identifier 
+                                                                                  !! (unitless)
+    INTEGER(i_std),INTENT (in)                               :: hist_id_stom      !! STOMATE's _History_ file identifier 
+                                                                                  !! (unitless)
+    INTEGER(i_std),INTENT(in)                                :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file file 
+                                                                                  !! identifier (unitless)
+    REAL(r_std), INTENT (in)                                 :: date0             !! Initial date (??unit??)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)          :: lalo              !! Geographic coordinates (latitude,longitude)
+                                                                                  !! for grid cells (degrees)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: contfrac          !! Fraction of continent in the grid 
+                                                                                  !! (unitless, 0-1)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: index             !! Indices of the pixels on the map. 
+                                                                                  !! Sechiba uses a reduced grid excluding oceans
+                                                                                  !! ::index contains the indices of the 
+                                                                                  !! terrestrial pixels only! (unitless)
+    INTEGER(i_std), DIMENSION (kjpindex,8), INTENT(in)       :: neighbours        !! Neighboring grid points if land!(unitless)
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)          :: resolution        !! Size in x and y of the grid (m)
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u                 !! Lowest level wind speed in direction u 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v                 !! Lowest level wind speed in direction v 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: zlev              !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair              !! Lowest level specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: t2m               !! 2m air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_rain       !! Rain precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_snow       !! Snow precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown            !! Down-welling long-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet             !! Net surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swdown            !! Down-welling surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_air          !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef          !! Coefficients A for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef          !! Coefficients A for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef          !! Coefficients B for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef          !! Coefficients B for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb                !! Surface pressure (hPa)
+
+
+!! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: coastalflow       !! Outflow on coastal points by small basins.
+                                                                                  !! This is the water which flows in a disperse 
+                                                                                  !! way into the ocean
+                                                                                  !! @tex $(kg dt_routing^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: riverflow         !! Outflow of the major rivers.
+                                                                                  !! The flux will be located on the continental 
+                                                                                  !! grid but this should be a coastal point  
+                                                                                  !! @tex $(kg dt_routing^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: tsol_rad          !! Radiative surface temperature 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: vevapp            !! Total of evaporation 
+                                                                                  !! @tex $(kg m^{-2} days^{-1})$ @endtex
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qsurf_out         !! Surface specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: z0_out            !! Surface roughness (output diagnostic, m)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out)         :: albedo_out        !! VIS and NIR albedo (output diagnostic, 
+                                                                                  !! unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxsens          !! Sensible heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxlat           !! Latent heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: emis_out          !! Emissivity (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: netco2flux        !! Sum CO2 flux over PFTs 
+                                                                                  !! ??(gC m^{-2} s^{-1})??
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fco2_lu           !! Land Cover Change CO2 flux 
+                                                                                  !! ??(gC m^{-2} s^{-1})??
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: temp_sol_new      !! New ground temperature (K)
+
+!! 0.3 Modified
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: tq_cdrag          !! Surface drag coefficient 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex 
+
+!! 0.4 Local variables
+    INTEGER(i_std)                                           :: ji, jv		  !! Index (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: histvar           !! Computations for history files (unitless)
+    CHARACTER(LEN=80)                                        :: var_name          !! To store variables names for I/O (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: frac_snow_veg     !! Snow cover fraction on vegetation, 
+                                                                                  !! only for diagnostics (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nnobio)                  :: frac_snow_nobio   !! Snow cover fraction on continental ice, lakes, etc
+                                                                                  !! only for diagnostics (unitless)
+
+     
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) ' sechiba kjpindex =',kjpindex
+
+    !! 1. Initialize variables on first call
+
+    !! 1.1 Initialize most of sechiba's variables
+    CALL sechiba_init (kjit, kjpij, kjpindex, index, rest_id, lalo)
+    
+    !! 1.3 Initialize stomate's variables
+
+    CALL slowproc_initialize (kjit,          kjpij,        kjpindex,      date0,              &
+                              rest_id,       rest_id_stom, hist_id_stom,   hist_id_stom_IPCC, &
+                              index,         indexveg,     lalo,           neighbours,        &
+                              resolution,    contfrac,     t2m,                               &
+                              soiltile,      reinf_slope,  deadleaf_cover, assim_param,       &
+                              lai,           frac_age,     height,         veget,             &
+                              frac_nobio,    njsc,         veget_max,      tot_bare_soil,     &
+                              totfrac_nobio, qsintmax,     co2_flux,       fco2_lu, temp_growth)
+
+
+    netco2flux(:) = zero
+    DO jv = 2,nvm
+       netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv)
+    ENDDO
+    
+    !! 1.4 Initialize diffusion coefficients
+    CALL diffuco_initialize (kjit,    kjpindex, index,                  &
+                             rest_id, lalo,     neighbours, resolution, &
+                             rstruct, tq_cdrag)
+    
+    !! 1.5 Initialize remaining variables of energy budget
+    CALL enerbil_initialize (kjit,     kjpindex,     index,    rest_id,  &
+                             temp_air, qair,                             &
+                             temp_sol, temp_sol_new, tsol_rad, t2mdiag,  &
+                             evapot,   evapot_corr,  qsurf,    fluxsens, &
+                             fluxlat,  vevapp )
+    
+    
+    !! 1.7 Initialize remaining hydrological variables
+    IF ( .NOT. hydrol_cwrr ) THEN
+       ! 1.7.1 Initialize remaining hydrological variables from Choisnel module (2 soil layers)
+       CALL hydrolc_initialize( kjit,      kjpindex,     index,          rest_id, &
+                                veget,     veget_max,    tot_bare_soil,           &
+                                rsol,      drysoil_frac, snow,                    &
+                                snow_age,  snow_nobio,   snow_nobio_age, humrel,  &
+                                vegstress, qsintveg,     shumdiag,       snowrho, &
+                                snowtemp,  snowgrain,    snowdz,         snowheat)
+     
+       evap_bare_lim(:) = -un
+       k_litt(:) = huit
+       
+       ! No specific calculation for shumdiag_perma. We assume it to shumdiag.
+       shumdiag_perma(:,:)=shumdiag(:,:)
+    ELSE
+       !! 1.7.2 Initialize remaining hydrological variables from CWRR module (11 soil layers)
+       CALL hydrol_initialize ( kjit,           kjpindex,  index,         rest_id,          &
+            njsc,           soiltile,  veget,         veget_max,        &
+            humrel,         vegstress, drysoil_frac,                    &
+            shumdiag_perma, k_litt,    qsintveg,                        &
+            evap_bare_lim,  snow,      snow_age,      snow_nobio,       &
+            snow_nobio_age, snowrho,   snowtemp,      snowgrain,        &
+            snowdz,         snowheat,  &
+            mc_layh,    mcl_layh,  tmc_layh)
+
+    ENDIF
+    
+    !! 1.9 Initialize surface parameters (emissivity, albedo and roughness)
+    CALL condveg_initialize (kjit, kjpindex, index, rest_id, &
+         lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, &
+         zlev, snow, snow_age, snow_nobio, snow_nobio_age, &
+         drysoil_frac, height, snowdz,snowrho, tot_bare_soil, &
+         emis, albedo, z0, roughheight, &
+         frac_snow_veg,frac_snow_nobio)
+    
+    !! 1.10 Initialization of soil thermodynamics
+    
+    IF (hydrol_cwrr) THEN
+       CALL thermosoil_initialize (kjit, kjpindex, rest_id,  &
+            temp_sol_new, snow,       shumdiag_perma,        &
+            soilcap,      soilflx,    stempdiag,             &
+            gtemp,               &
+            mc_layh,  mcl_layh,   tmc_layh,       njsc ,     &
+            frac_snow_veg,frac_snow_nobio,totfrac_nobio,     &
+            snowdz, snowrho, snowtemp, lambda_snow, cgrnd_snow, dgrnd_snow, pb)
+    ELSE
+       CALL thermosoilc_initialize (kjit, kjpindex, rest_id,  &
+            temp_sol_new, snow,       shumdiag_perma,        &
+            soilcap,      soilflx,    stempdiag,             &
+            gtemp, &
+            frac_snow_veg,frac_snow_nobio,totfrac_nobio,     &
+            snowdz, snowrho, snowtemp, lambda_snow, cgrnd_snow, dgrnd_snow, pb)
+
+    END IF
+
+    !! 1.12 Initialize river routing
+    IF ( river_routing .AND. nbp_glo .GT. 1) THEN
+       !! 1.12.1 Initialize river routing
+       CALL routing_initialize( kjit,        kjpindex,       index,                 &
+            rest_id,     hist_id,        hist2_id,   lalo,      &
+            neighbours,  resolution,     contfrac,   stempdiag, &
+            returnflow,  reinfiltration, irrigation, riverflow, &
+            coastalflow, flood_frac,     flood_res )
+    ELSE
+       !! 1.12.2 No routing, set variables to zero
+       riverflow(:) = zero
+       coastalflow(:) = zero
+       returnflow(:,:) = zero
+       reinfiltration(:,:) = zero
+       irrigation(:,:) = zero
+       flood_frac(:) = zero
+       flood_res(:) = zero
+    ENDIF
+    
+    !! 1.13 Write internal variables to output fields
+    z0_out(:) = z0(:)
+    emis_out(:) = emis(:)
+    albedo_out(:,:) = albedo(:,:) 
+    qsurf_out(:) = qsurf(:)
+    
+  END SUBROUTINE sechiba_initialize
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_main
+!!
+!>\BRIEF        Main routine for the sechiba module performing three functions:
+!! calculating temporal evolution of all variables and preparation of output and 
+!! restart files (during the last call only)
+!!
+!!\n DESCRIPTION : Main routine for the sechiba module. 
+!! One time step evolution consists of:
+!! - call sechiba_var_init to do some initialization,
+!! - call slowproc_main to do some daily calculations
+!! - call diffuco_main for diffusion coefficient calculation,
+!! - call enerbil_main for energy budget calculation,
+!! - call hydrolc_main (or hydrol_main) for hydrologic processes calculation,
+!! - call enerbil_fusion : last part with fusion,
+!! - call condveg_main for surface conditions such as roughness, albedo, and emmisivity,
+!! - call thermosoil_main(for cwrr) or thermosoilc_main(for choisnel) for soil thermodynamic calculation,
+!! - call sechiba_end to swap previous to new fields.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): Hydrological variables (:: coastalflow and :: riverflow),
+!! components of the energy budget (:: tsol_rad, :: vevapp, :: fluxsens, 
+!! :: temp_sol_new and :: fluxlat), surface characteristics (:: z0_out, :: emis_out, 
+!! :: tq_cdrag and :: albedo_out) and land use related CO2 fluxes (:: netco2flux and 
+!! :: fco2_lu)            
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!! \includegraphics[scale = 0.5]{sechibamainflow.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE sechiba_main (kjit, kjpij, kjpindex, index, date0, &
+       & ldrestart_read, ldrestart_write, &
+       & lalo, contfrac, neighbours, resolution,&
+       & zlev, u, v, qair, q2m, t2m, temp_air, epot_air, ccanopy, &
+       & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+       & precip_rain, precip_snow, lwdown, swnet, swdown, coszang, pb, &
+       & vevapp, fluxsens, fluxlat, coastalflow, riverflow, netco2flux, fco2_lu, &
+       & tsol_rad, temp_sol_new, qsurf_out, albedo_out, emis_out, z0_out, &
+       & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC)
+!       & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, &
+!       hist_id_stom_IPCC,soil_mc,litter_mc)
+!! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                               :: kjit              !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)                               :: kjpij             !! Total size of the un-compressed grid 
+                                                                                  !! (unitless)
+    INTEGER(i_std), INTENT(in)                               :: kjpindex          !! Domain size - terrestrial pixels only 
+                                                                                  !! (unitless)
+    INTEGER(i_std),INTENT (in)                               :: rest_id           !! _Restart_ file identifier (unitless)
+    INTEGER(i_std),INTENT (in)                               :: hist_id           !! _History_ file identifier (unitless)
+    INTEGER(i_std),INTENT (in)                               :: hist2_id          !! _History_ file 2 identifier (unitless)
+    INTEGER(i_std),INTENT (in)                               :: rest_id_stom      !! STOMATE's _Restart_ file identifier 
+                                                                                  !! (unitless)
+    INTEGER(i_std),INTENT (in)                               :: hist_id_stom      !! STOMATE's _History_ file identifier 
+                                                                                  !! (unitless)
+    INTEGER(i_std),INTENT(in)                                :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file file 
+                                                                                  !! identifier (unitless)
+    REAL(r_std), INTENT (in)                                 :: date0             !! Initial date (??unit??)
+    LOGICAL, INTENT(in)                                      :: ldrestart_read    !! Logical for _restart_ file to read 
+                                                                                  !! (true/false)
+    LOGICAL, INTENT(in)                                      :: ldrestart_write   !! Logical for _restart_ file to write 
+                                                                                  !! (true/false)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)          :: lalo              !! Geographic coordinates (latitude,longitude)
+                                                                                  !! for grid cells (degrees)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: contfrac          !! Fraction of continent in the grid 
+                                                                                  !! (unitless, 0-1)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: index             !! Indices of the pixels on the map. 
+                                                                                  !! Sechiba uses a reduced grid excluding oceans
+                                                                                  !! ::index contains the indices of the 
+                                                                                  !! terrestrial pixels only! (unitless)
+    INTEGER(i_std), DIMENSION (kjpindex,8), INTENT(in)       :: neighbours        !! Neighboring grid points if land!(unitless)
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)          :: resolution        !! Size in x and y of the grid (m)
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u                 !! Lowest level wind speed in direction u 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v                 !! Lowest level wind speed in direction v 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: zlev              !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair              !! Lowest level specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q2m               !! 2m specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: t2m               !! 2m air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_rain       !! Rain precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_snow       !! Snow precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown            !! Down-welling long-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: coszang           !! Cosine of the solar zenith angle (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet             !! Net surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swdown            !! Down-welling surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_air          !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air          !! Air potential energy (??J)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: ccanopy           !! CO2 concentration in the canopy (ppm)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef          !! Coefficients A for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef          !! Coefficients A for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef          !! Coefficients B for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef          !! Coefficients B for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb                !! Surface pressure (hPa)
+
+
+!! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,nflow), INTENT (out)     :: coastalflow       !! Outflow on coastal points by small basins.
+                                                                                  !! This is the water which flows in a disperse 
+                                                                                  !! way into the ocean
+                                                                                  !! @tex $(kg dt_routing^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex,nflow), INTENT (out)     :: riverflow         !! Outflow of the major rivers.
+                                                                                  !! The flux will be located on the continental 
+                                                                                  !! grid but this should be a coastal point  
+                                                                                  !! @tex $(kg dt_routing^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: tsol_rad          !! Radiative surface temperature 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: vevapp            !! Total of evaporation 
+                                                                                  !! @tex $(kg m^{-2} days^{-1})$ @endtex
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qsurf_out         !! Surface specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: z0_out            !! Surface roughness (output diagnostic, m)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out)         :: albedo_out        !! VIS and NIR albedo (output diagnostic, 
+                                                                                  !! unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxsens          !! Sensible heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxlat           !! Latent heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: emis_out          !! Emissivity (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: netco2flux        !! Sum CO2 flux over PFTs 
+                                                                                  !! ??(gC m^{-2} s^{-1})??
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fco2_lu           !! Land Cover Change CO2 flux 
+                                                                                  !! ??(gC m^{-2} s^{-1})??
+
+!! 0.3 Modified
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: tq_cdrag          !! Surface drag coefficient 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: temp_sol_new      !! New ground temperature (K)
+!    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(inout):: soil_mc           !! soil moisture content \f($m^3 \times m^3$)\f
+!    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(inout)     :: litter_mc         !! litter moisture content \f($m^3 \times m^3$)\f
+
+!! 0.4 local variables
+
+    INTEGER(i_std)                                           :: ji, jv		  !! Index (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: histvar           !! Computations for history files (unitless)
+    CHARACTER(LEN=80)                                        :: var_name          !! To store variables names for I/O (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_treefrac      !! Total fraction occupied by trees (0-1, uniless) 
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_grassfrac     !! Total fraction occupied by grasses (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_cropfrac      !! Total fraction occcupied by crops (0-1, unitess)
+    REAL(r_std), DIMENSION(kjpindex)                         :: grndflux          !! Net energy into soil (W/m2)
+    REAL(r_std), DIMENSION(kjpindex,nsnow)                   :: snowliq           !! Liquid water content (m)
+    REAL(r_std), DIMENSION(kjpindex)                         :: frac_snow_veg     !! Snow cover fraction on vegetation, 
+                                                                                  !! only for diagnostics (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nnobio)                  :: frac_snow_nobio   !! Snow cover fraction on continental ice, lakes, etc
+                                                                                  !! only for diagnostics (unitless)
+
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) ' sechiba kjpindex =',kjpindex
+
+    !! 1. Initialize variables at each time step
+    CALL sechiba_var_init (kjpindex, rau, pb, temp_air) 
+
+    !! 2. Compute diffusion coefficients
+    CALL diffuco_main (kjit, kjpindex, index, indexveg, indexlai, u, v, &
+         & zlev, z0, roughheight, temp_sol, temp_air, temp_growth, rau, tq_cdrag, qsurf, qair, q2m, t2m, pb ,  &
+         & rsol, evap_bare_lim, evapot, evapot_corr, snow, flood_frac, flood_res, frac_nobio, snow_nobio, totfrac_nobio, &
+         & swnet, swdown, coszang, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, &
+         & vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, gsmean, rveget, rstruct, cimean, gpp, &
+         & lalo, neighbours, resolution, ptnlev1, precip_rain, frac_age, tot_bare_soil, &
+         & hist_id, hist2_id)
+   
+    !! 3. Compute energy balance
+    CALL enerbil_main (kjit, kjpindex, &
+         & index, indexveg, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef, &
+         & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, &
+         & emis, soilflx, soilcap, tq_cdrag, humrel, fluxsens, fluxlat, &
+         & vevapp, transpir, transpot, vevapnu, vevapwet, vevapsno, vevapflo, t2mdiag, temp_sol, tsol_rad, &
+         & temp_sol_new, qsurf, evapot, evapot_corr, rest_id, hist_id, hist2_id, &
+         & precip_rain,  pgflux, snowdz, snowrho, temp_sol_add)
+
+ 
+    !! 4. Compute hydrology
+    IF ( .NOT. hydrol_cwrr ) THEN
+       ! 4.1 Water balance from Choisnel module (2 soil layers)
+       CALL hydrolc_main (kjit, kjpindex, index, indexveg, &
+            & temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+            & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age, tot_melt, transpir, &
+            & precip_rain, precip_snow, returnflow, reinfiltration, irrigation, humrel, vegstress, rsol, drysoil_frac, &
+            & evapot, evapot_corr, flood_frac, flood_res, shumdiag, litterhumdiag, soilcap, rest_id, hist_id, hist2_id, &
+            & temp_air, pb, u, v, swnet, pgflux, &
+            & snowrho,snowtemp,snowgrain,snowdz,snowheat,snowliq, &
+            & grndflux,gtemp,tot_bare_soil, &
+            & lambda_snow,cgrnd_snow,dgrnd_snow,temp_sol_add)
+
+       evap_bare_lim(:) = -un
+       k_litt(:) = huit
+       
+       ! No specific calculation for shumdiag_perma. We assume it to shumdiag.
+       shumdiag_perma(:,:)=shumdiag(:,:)
+    ELSE
+       !! 4.1 Water balance from CWRR module (11 soil layers)
+       CALL hydrol_main (kjit, kjpindex, &
+            & index, indexveg, indexsoil, indexlayer, indexnbdl, &
+            & temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max, njsc, &
+            & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age,  &
+            & tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, &
+            & humrel, vegstress, drysoil_frac, evapot, evapot_corr, evap_bare_lim, flood_frac, flood_res, &
+            & shumdiag,shumdiag_perma, k_litt, litterhumdiag, soilcap, soiltile, reinf_slope,&
+            & rest_id, hist_id, hist2_id,&
+            & stempdiag, &
+            & temp_air, pb, u, v, swnet, pgflux, &
+            & snowrho,snowtemp,snowgrain,snowdz,snowheat,snowliq, &
+            & grndflux,gtemp,tot_bare_soil, &
+            & lambda_snow,cgrnd_snow,dgrnd_snow,temp_sol_add, &
+            & mc_layh, mcl_layh, tmc_layh, runoff_per_soil, drainage_per_soil, soil_mc, &
+            & litter_mc, wat_flux0, wat_flux) 
+
+       rsol(:) = -un
+
+    ENDIF
+         
+    !! 5. Compute remaining components of the energy balance
+    IF ( .NOT. ok_explicitsnow ) THEN
+       CALL enerbil_fusion (kjpindex, tot_melt, soilcap, snowdz, &
+            temp_sol_new, fusion)
+    END IF
+
+    !! 6. Compute surface variables (emissivity, albedo and roughness)
+    CALL condveg_main (kjit, kjpindex, index, rest_id, hist_id, hist2_id, &
+         lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, &
+         zlev, snow, snow_age, snow_nobio, snow_nobio_age, &
+         drysoil_frac, height, snowdz, snowrho, tot_bare_soil, &
+         emis, albedo, z0, roughheight, &
+         frac_snow_veg, frac_snow_nobio)
+
+    !! 7. Compute soil thermodynamics
+    IF (hydrol_cwrr) THEN
+       CALL thermosoil_main (kjit, kjpindex, &
+            index, indexgrnd, &
+            temp_sol_new, snow, soilcap, soilflx, &
+            shumdiag_perma, stempdiag, ptnlev1, rest_id, hist_id, hist2_id, &
+            snowdz,snowrho,snowtemp,gtemp,pb,&
+            mc_layh, mcl_layh, tmc_layh, njsc,frac_snow_veg,frac_snow_nobio,totfrac_nobio,temp_sol_add, &
+	    lambda_snow, cgrnd_snow, dgrnd_snow)
+    ELSE
+       CALL thermosoilc_main (kjit, kjpindex, &
+            index, indexgrnd, indexnbdl, &
+            temp_sol_new, snow, soilcap, soilflx, &
+            shumdiag_perma, stempdiag, ptnlev1, rest_id, hist_id, hist2_id, &
+            snowdz,snowrho,snowtemp,gtemp,pb,&
+            frac_snow_veg,frac_snow_nobio,totfrac_nobio,temp_sol_add, &
+	    lambda_snow, cgrnd_snow, dgrnd_snow)
+    END IF
+
+
+    !! 8. Compute river routing 
+    IF ( river_routing .AND. nbp_glo .GT. 1) THEN
+       !! 8.1 River routing
+       CALL routing_main (kjit, kjpindex, index, &
+            & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, &
+            & drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, &
+            & stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, &
+            & rest_id, hist_id, hist2_id, DOC_EXP_agg_d)
+    ELSE
+       !! 8.2 No routing, set variables to zero
+       riverflow(:,:) = zero
+       coastalflow(:,:) = zero
+       returnflow(:,:) = zero
+       reinfiltration(:,:) = zero
+       irrigation(:,:) = zero
+       flood_frac(:) = zero
+       flood_res(:) = zero
+    ENDIF
+    
+    ! Calculate DOC inputs to soil column from stomate_soilcarbon.f90, to be exported via slowprocesses
+    DOC_to_topsoil(:,icarbon) = (reinfiltration(:,idoc)+irrigation(:,idoc))*mille
+    DOC_to_subsoil(:,icarbon) = returnflow(:,idoc)*mille
+
+    DOC_to_topsoil(:,icarbon14) = DOC_to_topsoil(:,icarbon)
+    DOC_to_subsoil(:,icarbon14) = DOC_to_subsoil(:,icarbon)  
+         
+       
+    !! 9. Compute slow processes (i.e. 'daily' and annual time step)
+    ! ::ok_co2 and ::ok_stomate are flags that determine whether the
+    ! forcing files are written.
+    CALL slowproc_main (kjit, kjpij, kjpindex, date0, &
+         index, indexveg, lalo, neighbours, resolution, contfrac, soiltile, &
+         t2mdiag, t2mdiag, temp_sol, stempdiag, &
+         vegstress, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+         deadleaf_cover, &
+         assim_param, &
+         lai, frac_age, height, veget, frac_nobio, njsc, veget_max, totfrac_nobio, qsintmax, &
+         rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+         co2_flux, fco2_lu, temp_growth, tot_bare_soil, &
+         soil_mc, litter_mc, floodout, runoff, drainage, wat_flux0, wat_flux, &
+         drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, DOC_to_topsoil, DOC_to_subsoil)
+
+    !! 9.2 Compute global CO2 flux
+    netco2flux(:) = zero
+    DO jv = 2,nvm
+       netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv)
+    ENDDO
+ 
+    !! 10. Update the temperature (temp_sol) with newly computed values
+    CALL sechiba_end (kjpindex, temp_sol_new, temp_sol)
+
+   
+    !! 11. Write internal variables to output fields
+    z0_out(:) = z0(:)
+    emis_out(:) = emis(:)
+    albedo_out(:,:) = albedo(:,:) 
+    qsurf_out(:) = qsurf(:)
+ 
+    !! 12. Write global variables to history files
+    sum_treefrac(:) = zero
+    sum_grassfrac(:) = zero
+    sum_cropfrac(:) = zero
+    DO jv = 2, nvm 
+       IF (is_tree(jv) .AND. natural(jv)) THEN
+          sum_treefrac(:) = sum_treefrac(:) + veget_max(:,jv)
+       ELSE IF ((.NOT. is_tree(jv))  .AND. natural(jv)) THEN
+          sum_grassfrac(:) = sum_grassfrac(:) + veget_max(:,jv)
+       ELSE 
+          sum_cropfrac = sum_cropfrac(:) + veget_max(:,jv)
+       ENDIF
+    ENDDO          
+
+    CALL xios_orchidee_send_field("evapnu",vevapnu*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("snow",snow)
+    CALL xios_orchidee_send_field("snowage",snow_age)
+    CALL xios_orchidee_send_field("snownobio",snow_nobio)
+    CALL xios_orchidee_send_field("snownobioage",snow_nobio_age)
+    CALL xios_orchidee_send_field("reinf_slope",reinf_slope)
+    CALL xios_orchidee_send_field("soilindex",REAL(njsc, r_std))
+    CALL xios_orchidee_send_field("vegetfrac",veget)
+    CALL xios_orchidee_send_field("maxvegetfrac",veget_max)
+    CALL xios_orchidee_send_field("nobiofrac",frac_nobio)
+    CALL xios_orchidee_send_field("soiltile",soiltile)
+    CALL xios_orchidee_send_field("rstruct",rstruct)
+    IF (ok_co2) CALL xios_orchidee_send_field("gpp",gpp/dt_sechiba)
+    CALL xios_orchidee_send_field("nee",co2_flux/dt_sechiba)
+    CALL xios_orchidee_send_field("drysoil_frac",drysoil_frac)
+    CALL xios_orchidee_send_field("evapflo",vevapflo*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("evapflo_alma",vevapflo/dt_sechiba)
+    CALL xios_orchidee_send_field("k_litt",k_litt)
+    CALL xios_orchidee_send_field("beta",vbeta)
+    CALL xios_orchidee_send_field("vbeta1",vbeta1)
+    CALL xios_orchidee_send_field("vbeta2",vbeta2)
+    CALL xios_orchidee_send_field("vbeta3",vbeta3)
+    CALL xios_orchidee_send_field("vbeta4",vbeta4)
+    CALL xios_orchidee_send_field("vbeta5",vbeta5)
+    CALL xios_orchidee_send_field("gsmean",gsmean)
+    CALL xios_orchidee_send_field("cimean",cimean)
+    CALL xios_orchidee_send_field("rveget",rveget)
+    CALL xios_orchidee_send_field("rsol",rsol)
+ 
+    histvar(:)=SUM(vevapwet(:,:),dim=2)
+    CALL xios_orchidee_send_field("evspsblveg",histvar/dt_sechiba)
+    histvar(:)= vevapnu(:)+vevapsno(:)
+    CALL xios_orchidee_send_field("evspsblsoi",histvar/dt_sechiba)
+    histvar(:)=SUM(transpir(:,:),dim=2)
+    CALL xios_orchidee_send_field("tran",histvar/dt_sechiba)
+    histvar(:)= sum_treefrac(:)*100*contfrac(:)
+    CALL xios_orchidee_send_field("treeFrac",histvar)
+    histvar(:)= sum_grassfrac(:)*100*contfrac(:)
+    CALL xios_orchidee_send_field("grassFrac",histvar)
+    histvar(:)= sum_cropfrac(:)*100*contfrac(:)
+    CALL xios_orchidee_send_field("cropFrac",histvar)
+    histvar(:)=veget_max(:,1)*100*contfrac(:)
+    CALL xios_orchidee_send_field("baresoilFrac",histvar)
+    histvar(:)=SUM(frac_nobio(:,1:nnobio),dim=2)*100*contfrac(:)
+    CALL xios_orchidee_send_field("residualFrac",histvar)
+
+    CALL xios_orchidee_send_field("tsol_rad",tsol_rad-273.15)
+    CALL xios_orchidee_send_field("qsurf",qsurf)
+    CALL xios_orchidee_send_field("albedo",albedo)
+    CALL xios_orchidee_send_field("emis",emis)
+    CALL xios_orchidee_send_field("z0",z0)
+    CALL xios_orchidee_send_field("roughheight",roughheight)
+    CALL xios_orchidee_send_field("lai",lai)
+    histvar(:)=zero   
+    DO ji = 1, kjpindex
+       IF (SUM(veget_max(ji,:)) > zero) THEN
+         DO jv=2,nvm
+            histvar(ji) = histvar(ji) + veget_max(ji,jv)*lai(ji,jv)/SUM(veget_max(ji,:))
+         END DO
+       END IF
+    END DO
+
+    CALL xios_orchidee_send_field("LAImean",histvar)
+    CALL xios_orchidee_send_field("subli",vevapsno*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("vevapnu",vevapnu*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("vevapnu_alma",vevapnu/dt_sechiba)
+    CALL xios_orchidee_send_field("transpir",transpir*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("inter",vevapwet*one_day/dt_sechiba)
+    CALL xios_orchidee_send_field("Qf",fusion)
+    histvar(:)=zero
+    DO jv=1,nvm
+      histvar(:) = histvar(:) + vevapwet(:,jv)
+    ENDDO
+    CALL xios_orchidee_send_field("ECanop",histvar/dt_sechiba)
+    histvar(:)=zero
+    DO jv=1,nvm
+      histvar(:) = histvar(:) + transpir(:,jv)
+    ENDDO
+    CALL xios_orchidee_send_field("TVeg",histvar/dt_sechiba)
+    CALL xios_orchidee_send_field("ACond",tq_cdrag)
+
+    IF ( .NOT. almaoutput ) THEN
+       ! Write history file in IPSL-format
+       CALL histwrite_p(hist_id, 'beta', kjit, vbeta, kjpindex, index)
+       CALL histwrite_p(hist_id, 'z0', kjit, z0, kjpindex, index)
+       CALL histwrite_p(hist_id, 'roughheight', kjit, roughheight, kjpindex, index)
+       CALL histwrite_p(hist_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+       CALL histwrite_p(hist_id, 'lai', kjit, lai, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'subli', kjit, vevapsno, kjpindex, index)
+       CALL histwrite_p(hist_id, 'evapnu', kjit, vevapnu, kjpindex, index)
+       CALL histwrite_p(hist_id, 'transpir', kjit, transpir, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'inter', kjit, vevapwet, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'vbeta1', kjit, vbeta1, kjpindex, index)
+       CALL histwrite_p(hist_id, 'vbeta2', kjit, vbeta2, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'vbeta3', kjit, vbeta3, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'vbeta4', kjit, vbeta4, kjpindex, index)    
+       CALL histwrite_p(hist_id, 'vbeta5', kjit, vbeta5, kjpindex, index)    
+       CALL histwrite_p(hist_id, 'drysoil_frac', kjit, drysoil_frac, kjpindex, index)
+       CALL histwrite_p(hist_id, 'rveget', kjit, rveget, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'rstruct', kjit, rstruct, kjpindex*nvm, indexveg)
+
+       IF ( .NOT. hydrol_cwrr ) THEN
+          CALL histwrite_p(hist_id, 'rsol', kjit, rsol, kjpindex, index)
+       ENDIF
+       CALL histwrite_p(hist_id, 'snow', kjit, snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'snowage', kjit, snow_age, kjpindex, index)
+       CALL histwrite_p(hist_id, 'snownobio', kjit, snow_nobio, kjpindex*nnobio, indexnobio)
+       CALL histwrite_p(hist_id, 'snownobioage', kjit, snow_nobio_age, kjpindex*nnobio, indexnobio)
+
+       IF (ok_explicitsnow) THEN
+          CALL histwrite_p(hist_id, 'grndflux', kjit, grndflux, kjpindex,index)
+          CALL histwrite_p(hist_id, 'snowtemp',kjit,snowtemp,kjpindex*nsnow,indexsnow)
+          CALL histwrite_p(hist_id, 'snowliq', kjit,snowliq,kjpindex*nsnow,indexsnow)
+          CALL histwrite_p(hist_id, 'snowdz', kjit,snowdz,kjpindex*nsnow,indexsnow)
+          CALL histwrite_p(hist_id, 'snowrho', kjit,snowrho,kjpindex*nsnow,indexsnow)
+          CALL histwrite_p(hist_id, 'snowgrain',kjit,snowgrain,kjpindex*nsnow,indexsnow)
+          CALL histwrite_p(hist_id, 'snowheat',kjit,snowheat,kjpindex*nsnow,indexsnow)
+       END IF
+
+       CALL histwrite_p(hist_id,'frac_snow_veg',kjit,frac_snow_veg,kjpindex,index)
+       CALL histwrite_p(hist_id, 'frac_snow_nobio', kjit,frac_snow_nobio,kjpindex*nnobio, indexnobio)
+       CALL histwrite_p(hist_id, 'pgflux',kjit,pgflux,kjpindex,index)
+       CALL histwrite_p(hist_id, 'soiltile',  kjit, soiltile, kjpindex*nstm, indexsoil)
+       !
+       IF ( hydrol_cwrr ) THEN
+          CALL histwrite_p(hist_id, 'soilindex',  kjit, REAL(njsc, r_std), kjpindex, index)
+          CALL histwrite_p(hist_id, 'reinf_slope',  kjit, reinf_slope, kjpindex, index)
+          CALL histwrite_p(hist_id, 'k_litt', kjit, k_litt, kjpindex, index)
+       ENDIF
+       IF ( do_floodplains ) THEN
+          CALL histwrite_p(hist_id, 'evapflo', kjit, vevapflo, kjpindex, index)
+          CALL histwrite_p(hist_id, 'flood_frac', kjit, flood_frac, kjpindex, index)
+       ENDIF
+       IF ( ok_co2 ) THEN
+          CALL histwrite_p(hist_id, 'gsmean', kjit, gsmean, kjpindex*nvm, indexveg)    
+          CALL histwrite_p(hist_id, 'gpp', kjit, gpp, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'cimean', kjit, cimean, kjpindex*nvm, indexveg)    
+       ENDIF
+       IF ( ok_stomate ) THEN
+          CALL histwrite_p(hist_id, 'nee', kjit, co2_flux, kjpindex*nvm, indexveg)    
+       ENDIF
+
+       histvar(:)=SUM(vevapwet(:,:),dim=2)
+       CALL histwrite_p(hist_id, 'evspsblveg', kjit, histvar, kjpindex, index)
+
+       histvar(:)= vevapnu(:)+vevapsno(:)
+       CALL histwrite_p(hist_id, 'evspsblsoi', kjit, histvar, kjpindex, index)
+
+       histvar(:)=SUM(transpir(:,:),dim=2)
+       CALL histwrite_p(hist_id, 'tran', kjit, histvar, kjpindex, index)
+
+       histvar(:)= sum_treefrac(:)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'treeFrac', kjit, histvar, kjpindex, index) 
+
+       histvar(:)= sum_grassfrac(:)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'grassFrac', kjit, histvar, kjpindex, index) 
+
+       histvar(:)= sum_cropfrac(:)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'cropFrac', kjit, histvar, kjpindex, index)
+
+       histvar(:)=veget_max(:,1)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'baresoilFrac', kjit, histvar, kjpindex, index)
+
+       histvar(:)=SUM(frac_nobio(:,1:nnobio),dim=2)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'residualFrac', kjit, histvar, kjpindex, index)
+    ELSE
+       ! Write history file in ALMA format 
+       CALL histwrite_p(hist_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+       CALL histwrite_p(hist_id, 'Qf', kjit, fusion, kjpindex, index)
+       CALL histwrite_p(hist_id, 'ESoil', kjit, vevapnu, kjpindex, index)
+       CALL histwrite_p(hist_id, 'EWater', kjit, vevapflo, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SWE', kjit, snow, kjpindex, index)
+       histvar(:)=zero
+       DO jv=1,nvm
+          histvar(:) = histvar(:) + transpir(:,jv)
+       ENDDO
+       CALL histwrite_p(hist_id, 'TVeg', kjit, histvar, kjpindex, index)
+       histvar(:)=zero
+       DO jv=1,nvm
+          histvar(:) = histvar(:) + vevapwet(:,jv)
+       ENDDO
+       CALL histwrite_p(hist_id, 'ECanop', kjit, histvar, kjpindex, index)
+       CALL histwrite_p(hist_id, 'ACond', kjit, tq_cdrag, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SnowFrac', kjit, vbeta1, kjpindex, index)
+       !
+       CALL histwrite_p(hist_id, 'Z0', kjit, z0, kjpindex, index)
+       CALL histwrite_p(hist_id, 'EffectHeight', kjit, roughheight, kjpindex, index)
+       !
+       IF ( do_floodplains ) THEN
+          CALL histwrite_p(hist_id, 'Qflood', kjit, vevapflo, kjpindex, index)
+          CALL histwrite_p(hist_id, 'FloodFrac', kjit, flood_frac, kjpindex, index)
+       ENDIF
+       !
+       IF ( ok_co2 ) THEN
+          CALL histwrite_p(hist_id, 'GPP', kjit, gpp, kjpindex*nvm, indexveg)
+       ENDIF
+       IF ( ok_stomate ) THEN
+             CALL histwrite_p(hist_id, 'NEE', kjit, co2_flux, kjpindex*nvm, indexveg)    
+       ENDIF
+    ENDIF ! almaoutput
+    
+    !! 13. Write additional output file with higher frequency
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          ! Write history file in IPSL-format
+          CALL histwrite_p(hist2_id, 'tsol_rad', kjit, tsol_rad, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'qsurf', kjit, qsurf, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'albedo', kjit, albedo, kjpindex*2, indexalb)
+          CALL histwrite_p(hist2_id, 'emis', kjit, emis, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'beta', kjit, vbeta, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'z0', kjit, z0, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'roughheight', kjit, roughheight, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+          CALL histwrite_p(hist2_id, 'lai', kjit, lai, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'subli', kjit, vevapsno, kjpindex, index)
+          IF ( do_floodplains ) THEN
+             CALL histwrite_p(hist2_id, 'vevapflo', kjit, vevapflo, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'flood_frac', kjit, flood_frac, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'vevapnu', kjit, vevapnu, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'transpir', kjit, transpir, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'inter', kjit, vevapwet, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'vbeta1', kjit, vbeta1, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'vbeta2', kjit, vbeta2, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'vbeta3', kjit, vbeta3, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'vbeta4', kjit, vbeta4, kjpindex, index)    
+          CALL histwrite_p(hist2_id, 'vbeta5', kjit, vbeta5, kjpindex, index)    
+          CALL histwrite_p(hist2_id, 'drysoil_frac', kjit, drysoil_frac, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'rveget', kjit, rveget, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'rstruct', kjit, rstruct, kjpindex*nvm, indexveg)
+          IF ( .NOT. hydrol_cwrr ) THEN
+             CALL histwrite_p(hist2_id, 'rsol', kjit, rsol, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'snow', kjit, snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snowage', kjit, snow_age, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snownobio', kjit, snow_nobio, kjpindex*nnobio, indexnobio)
+          CALL histwrite_p(hist2_id, 'snownobioage', kjit, snow_nobio_age, kjpindex*nnobio, indexnobio)
+          !
+          IF (  hydrol_cwrr ) THEN
+             CALL histwrite_p(hist2_id, 'soilindex',  kjit, REAL(njsc, r_std), kjpindex, index)
+             CALL histwrite_p(hist2_id, 'reinf_slope',  kjit, reinf_slope, kjpindex, index)
+          ENDIF
+          !
+          IF ( ok_co2 ) THEN
+             CALL histwrite_p(hist2_id, 'gsmean', kjit, gsmean, kjpindex*nvm, indexveg)    
+             CALL histwrite_p(hist2_id, 'gpp', kjit, gpp, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'cimean', kjit, cimean, kjpindex*nvm, indexveg)    
+          ENDIF
+          IF ( ok_stomate ) THEN
+             CALL histwrite_p(hist2_id, 'nee', kjit, co2_flux, kjpindex*nvm, indexveg)    
+          ENDIF
+       ELSE
+          ! Write history file in ALMA format
+          CALL histwrite_p(hist2_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+          CALL histwrite_p(hist2_id, 'Qf', kjit, fusion, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'ESoil', kjit, vevapnu, kjpindex, index)
+          IF ( do_floodplains ) THEN
+             CALL histwrite_p(hist2_id, 'EWater', kjit, vevapflo, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'FloodFrac', kjit, flood_frac, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'SWE', kjit, snow, kjpindex, index)
+          histvar(:)=zero
+          DO jv=1,nvm
+             histvar(:) = histvar(:) + transpir(:,jv)
+          ENDDO
+          CALL histwrite_p(hist2_id, 'TVeg', kjit, histvar, kjpindex, index)
+          histvar(:)=zero
+          DO jv=1,nvm
+             histvar(:) = histvar(:) + vevapwet(:,jv)
+          ENDDO
+          CALL histwrite_p(hist2_id, 'ECanop', kjit, histvar, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'ACond', kjit, tq_cdrag, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SnowFrac', kjit, vbeta1, kjpindex, index)
+          IF ( ok_co2 ) THEN
+             CALL histwrite_p(hist2_id, 'GPP', kjit, gpp, kjpindex*nvm, indexveg)
+          ENDIF
+          IF ( ok_stomate ) THEN
+             CALL histwrite_p(hist2_id, 'NEE', kjit, co2_flux, kjpindex*nvm, indexveg)    
+          ENDIF
+       ENDIF ! almaoutput
+    ENDIF ! hist2_id
+
+
+    !! Change the vegetation fractions if a new map was read in slowproc. This is done 
+    !! after lcchange has been done in stomatelpj
+    IF (done_stomate_lcchange) THEN
+       CALL slowproc_change_frac(kjpindex, lai, &
+                                 veget_max, veget, frac_nobio, totfrac_nobio, tot_bare_soil, soiltile)
+       done_stomate_lcchange=.FALSE.
+    END IF
+
+    !! 14. If it is the last time step, write restart files
+    IF (ldrestart_write) THEN
+       CALL sechiba_finalize( &
+            kjit,     kjpij,  kjpindex, index,   rest_id, &
+            tq_cdrag, vevapp, fluxsens, fluxlat, tsol_rad)
+    END IF
+
+  END SUBROUTINE sechiba_main
+
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    sechiba_finalize
+!!
+!>\BRIEF	  Finalize all modules by calling their "_finalize" subroutines.
+!!
+!! DESCRIPTION:	  Finalize all modules by calling their "_finalize" subroutines. These subroutines will write variables to 
+!!                restart file. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE sechiba_finalize( &
+       kjit,     kjpij,  kjpindex, index,   rest_id, &
+       tq_cdrag, vevapp, fluxsens, fluxlat, tsol_rad)
+
+!! 0.1 Input variables    
+    INTEGER(i_std), INTENT(in)                               :: kjit              !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)                               :: kjpij             !! Total size of the un-compressed grid 
+                                                                                  !! (unitless)
+    INTEGER(i_std), INTENT(in)                               :: kjpindex          !! Domain size - terrestrial pixels only 
+                                                                                  !! (unitless)
+    INTEGER(i_std),INTENT (in)                               :: rest_id           !! _Restart_ file identifier (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: index             !! Indices of the pixels on the map. 
+                                                                                  !! Sechiba uses a reduced grid excluding oceans
+                                                                                  !! ::index contains the indices of the 
+                                                                                  !! terrestrial pixels only! (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: tsol_rad           !! Radiative surface temperature 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: vevapp             !! Total of evaporation 
+                                                                                  !! @tex $(kg m^{-2} days^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: fluxsens           !! Sensible heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: fluxlat            !! Latent heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: tq_cdrag           !! Surface drag coefficient 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex 
+
+!! 0.2 Local variables
+    INTEGER(i_std)                                          :: ji, jv		  !! Index (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                        :: histvar            !! Computations for history files (unitless)
+    CHARACTER(LEN=80)                                       :: var_name           !! To store variables names for I/O (unitless)
+
+
+    !! Write restart file for the next simulation from SECHIBA and other modules
+
+    IF (printlev>=3) WRITE (numout,*) 'Write restart file'
+
+    !! 1. Call diffuco_finalize to write restart files
+    CALL diffuco_finalize (kjit, kjpindex, rest_id, rstruct )
+    
+    !! 2. Call energy budget to write restart files
+    CALL enerbil_finalize (kjit,   kjpindex,    rest_id,            &
+                           evapot, evapot_corr, temp_sol, tsol_rad, &
+                           qsurf,  fluxsens,    fluxlat,  vevapp )
+    
+    !! 3. Call hydrology to write restart files
+    IF ( .NOT. hydrol_cwrr ) THEN
+       !! 3.1 Call water balance from Choisnel module (2 soil layers) to write restart file
+       CALL hydrolc_finalize( kjit,      kjpindex,   rest_id,        snow,       &
+                              snow_age,  snow_nobio, snow_nobio_age, humrel,     &
+                              vegstress, qsintveg,   snowrho,        snowtemp,   &
+                              snowdz,    snowheat,   snowgrain,       &
+                              drysoil_frac, rsol, shumdiag)
+
+       evap_bare_lim(:) = -un
+       k_litt(:) = huit
+       shumdiag_perma(:,:)=shumdiag(:,:)
+    ELSE
+       !! 3.2 Call water balance from CWRR module (11 soil layers) to write restart file
+       CALL hydrol_finalize( kjit,           kjpindex, rest_id,  vegstress,  &
+                             qsintveg,       humrel,   snow,     snow_age, snow_nobio, &
+                             snow_nobio_age, snowrho,  snowtemp, snowdz,     &
+                             snowheat,       snowgrain,    &
+                             drysoil_frac, evap_bare_lim)
+    ENDIF
+    
+    !! 4. Call condveg to write surface variables to restart files
+    CALL condveg_finalize (kjit, kjpindex, rest_id, z0, roughheight)
+    
+    !! 5. Call soil thermodynamic to write restart files
+    IF (hydrol_cwrr) THEN
+       CALL thermosoil_finalize (kjit,    kjpindex, rest_id,   gtemp, &
+            soilcap, soilflx, lambda_snow, cgrnd_snow, dgrnd_snow)
+    ELSE
+       CALL thermosoilc_finalize (kjit,    kjpindex, rest_id,   gtemp, &
+            soilcap, soilflx, lambda_snow, cgrnd_snow, dgrnd_snow)
+    
+    END IF ! ldrestart_write 
+
+    !! 6. Add river routing to restart files  
+    IF ( river_routing .AND. nbp_glo .GT. 1) THEN
+       !! 6.1 Call river routing to write restart files 
+       CALL routing_finalize( kjit, kjpindex, rest_id, flood_frac, flood_res )
+    ELSE
+       !! 6.2 No routing, set variables to zero
+       reinfiltration(:,:) = zero
+       returnflow(:,:) = zero
+       irrigation(:,:) = zero
+       flood_frac(:) = zero
+       flood_res(:) = zero
+    ENDIF
+    
+    !! 7. Call slowproc_main to add 'daily' and annual variables to restart file
+    CALL slowproc_finalize (kjit,       kjpindex,  rest_id,  index,      &
+                            njsc,       lai,       height,   veget,      &
+                            frac_nobio, veget_max, reinf_slope,          &
+                            assim_param, frac_age, soiltile)
+    
+    IF (printlev>=3) WRITE (numout,*) 'sechiba_finalize done'
+    
+  END SUBROUTINE sechiba_finalize
+
+  
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_init
+!!
+!>\BRIEF        Dynamic allocation of the variables, the dimensions of the 
+!! variables are determined by user-specified settings. 
+!! 
+!! DESCRIPTION  : The domain size (:: kjpindex) is used to allocate the correct
+!! dimensions to all variables in sechiba. Depending on the variable, its 
+!! dimensions are also determined by the number of PFT's (::nvm), number of 
+!! soil types (::nstm), number of non-vegetative surface types (::nnobio),
+!! number of soil levels (::ngrnd), number of soil layers in the hydrological 
+!! model (i.e. cwrr) (::nslm). Values for these variables are set in
+!! constantes_soil.f90 and constantes_veg.f90.\n
+!!
+!! Memory is allocated for all Sechiba variables and new indexing tables
+!! are build making use of both (::kjpij) and (::kjpindex). New indexing tables 
+!! are needed because a single pixel can contain several PFTs, soil types, etc.
+!! The new indexing tables have separate indices for the different
+!! PFTs, soil types, etc.\n
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output 
+!! variables. However, the routine allocates memory and builds new indexing 
+!! variables for later use.
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================ 
+
+  SUBROUTINE sechiba_init (kjit, kjpij, kjpindex, index, rest_id, lalo)
+
+!! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT (in)                         :: kjit               !! Time step number (unitless)
+    INTEGER(i_std), INTENT (in)                         :: kjpij              !! Total size of the un-compressed grid (unitless)
+    INTEGER(i_std), INTENT (in)                         :: kjpindex           !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std), INTENT (in)                         :: rest_id            !! _Restart_ file identifier (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index              !! Indeces of the points on the map (unitless)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)     :: lalo               !! Geographical coordinates (latitude,longitude) 
+                                                                              !! for pixels (degrees)
+!! 0.2 Output variables
+
+!! 0.3 Modified variables
+
+!! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ier                !! Check errors in memory allocation (unitless)
+    INTEGER(i_std)                                      :: ji, jv             !! Indeces (unitless)
+!_ ==============================================================================================================================
+
+!! 1. Initialize variables 
+    
+    ! Dynamic allocation with user-specified dimensions on first call
+    IF (l_first_sechiba) THEN 
+       l_first_sechiba=.FALSE.
+    ELSE 
+       CALL ipslerr_p(3,'sechiba_init',' l_first_sechiba false . we stop ','','')
+    ENDIF
+
+    !! Initialize local printlev
+    printlev_loc=get_printlev('sechiba')
+    
+
+    !! 1.1 Initialize 3D vegetation indexation table
+    ALLOCATE (indexveg(kjpindex*nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexveg','','')
+
+    ALLOCATE (indexlai(kjpindex*(nlai+1)),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexlai','','')
+
+    ALLOCATE (indexsoil(kjpindex*nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexsoil','','')
+
+    ALLOCATE (indexnobio(kjpindex*nnobio),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexnobio','','')
+
+    ALLOCATE (indexgrnd(kjpindex*ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexgrnd','','')
+
+    ALLOCATE (indexsnow(kjpindex*nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexsnow','','')
+
+    ALLOCATE (indexlayer(kjpindex*nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexlayer','','')
+
+    ALLOCATE (indexnbdl(kjpindex*nbdl),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexnbdl','','')
+
+    ALLOCATE (indexalb(kjpindex*2),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for indexalb','','')
+
+    !! 1.2  Initialize 1D array allocation with restartable value
+    ALLOCATE (flood_res(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for flood_res','','')
+    flood_res(:) = undef_sechiba
+
+    ALLOCATE (flood_frac(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for kjpindex','','')
+    flood_frac(:) = undef_sechiba
+
+    ALLOCATE (snow(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snow','','')
+    snow(:) = undef_sechiba
+
+    ALLOCATE (snow_age(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snow_age','','')
+    snow_age(:) = undef_sechiba
+
+    ALLOCATE (drysoil_frac(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for drysoil_frac','','')
+
+    ALLOCATE (rsol(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for rsol','','')
+
+    ALLOCATE (evap_bare_lim(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for evap_bare_lim','','')
+
+    ALLOCATE (evapot(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for evapot','','')
+    evapot(:) = undef_sechiba
+
+    ALLOCATE (evapot_corr(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for evapot_corr','','')
+
+    ALLOCATE (humrel(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for humrel','','')
+    humrel(:,:) = undef_sechiba
+
+    ALLOCATE (vegstress(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vegstress','','')
+    vegstress(:,:) = undef_sechiba
+
+    ALLOCATE (njsc(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for njsc','','')
+    njsc(:)= undef_int
+
+    ALLOCATE (soiltile(kjpindex,nstm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for soiltile','','')
+
+    ALLOCATE (reinf_slope(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for reinf_slope','','')
+
+    ALLOCATE (vbeta1(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta1','','')
+
+    ALLOCATE (vbeta4(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta4','','')
+
+    ALLOCATE (vbeta5(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta5','','')
+
+    ALLOCATE (soilcap(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for soilcap','','')
+
+    ALLOCATE (soilflx(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for soilflx','','')
+
+    ALLOCATE (temp_sol(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for temp_sol','','')
+    temp_sol(:) = undef_sechiba
+
+    ALLOCATE (qsurf(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for qsurf','','')
+    qsurf(:) = undef_sechiba
+
+    !! 1.3 Initialize 2D array allocation with restartable value
+    ALLOCATE (qsintveg(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for qsintveg','','')
+    qsintveg(:,:) = undef_sechiba
+
+    ALLOCATE (vbeta2(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta2','','')
+
+    ALLOCATE (vbeta3(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta3','','')
+
+    ALLOCATE (vbeta3pot(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta3pot','','')
+
+    ALLOCATE (gsmean(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for gsmean','','')
+
+    ALLOCATE (cimean(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for cimean','','')
+
+    ALLOCATE (gpp(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for gpp','','')
+    gpp(:,:) = undef_sechiba
+
+ 
+    ALLOCATE (temp_growth(kjpindex),stat=ier) 
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for temp_growth','','')
+    temp_growth(:) = undef_sechiba 
+
+    ALLOCATE (veget(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for veget','','')
+    veget(:,:)=undef_sechiba
+
+    ALLOCATE (veget_max(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for veget_max','','')
+
+    ALLOCATE (tot_bare_soil(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for tot_bare_soil','','')
+
+    ALLOCATE (lai(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for lai','','')
+    lai(:,:)=undef_sechiba
+
+    ALLOCATE (frac_age(kjpindex,nvm,nleafages),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for frac_age','','')
+    frac_age(:,:,:)=undef_sechiba
+
+    ALLOCATE (height(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for height','','')
+    height(:,:)=undef_sechiba
+
+    ALLOCATE (frac_nobio(kjpindex,nnobio),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for frac_nobio','','')
+    frac_nobio(:,:) = undef_sechiba
+
+    ALLOCATE (albedo(kjpindex,2),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for albedo','','')
+
+    ALLOCATE (snow_nobio(kjpindex,nnobio),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snow_nobio','','')
+    snow_nobio(:,:) = undef_sechiba
+
+    ALLOCATE (snow_nobio_age(kjpindex,nnobio),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snow_nobio_age','','')
+    snow_nobio_age(:,:) = undef_sechiba
+
+    ALLOCATE (assim_param(kjpindex,nvm,npco2),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for assim_param','','')
+
+    !! 1.4 Initialize 1D array allocation 
+    ALLOCATE (vevapflo(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vevapflo','','')
+    vevapflo(:)=zero
+
+    ALLOCATE (vevapsno(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vevapsno','','')
+
+    ALLOCATE (vevapnu(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vevapnu','','')
+
+    ALLOCATE (t2mdiag(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for t2mdiag','','')
+
+    ALLOCATE (totfrac_nobio(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for totfrac_nobio','','')
+
+    ALLOCATE (floodout(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for floodout','','')
+
+    ALLOCATE (runoff(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for runoff','','')
+
+   ALLOCATE (wat_flux0(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in wat_flux0 allocation. We stop. We need kjpindex*nstm words = ',kjpindex*nstm
+       STOP 'sechiba_init'
+    END IF
+ 
+    ALLOCATE (wat_flux(kjpindex,nslm, nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in wat_flux allocation. We stop. We need kjpindex*nslm*nstm words = ',kjpindex*nslm*nstm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (drainage_per_soil(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in drainage_per_soil allocation. We stop. We need kjpindex*nstm words = ',kjpindex*nstm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (runoff_per_soil(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in runoff_per_soil allocation. We stop. We need kjpindex*nstm words = ',kjpindex*nstm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (litter_mc(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in litter_mc allocation. We stop. We need kjpindex*nstm words = ',kjpindex*nstm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (soil_mc(kjpindex,nbdl,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in soil_mc allocation. We stop. We need kjpindex*nbdl*nstm words = ',kjpindex*nbdl*nstm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (drainage(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for drainage','','')
+
+    ALLOCATE (returnflow(kjpindex,nflow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for returnflow','','')
+    returnflow(:,:) = zero
+    
+    ALLOCATE (DOC_EXP_agg_d(kjpindex,nflow),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in DOC_EXP_agg_d allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    DOC_EXP_agg_d(:,:) = zero    
+
+    ALLOCATE (reinfiltration(kjpindex,nflow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for reinfiltration','','')
+    reinfiltration(:,:) = zero
+
+    ALLOCATE (irrigation(kjpindex,nflow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for irrigation','','')
+    irrigation(:,:) = zero
+    
+    ALLOCATE (DOC_to_topsoil(kjpindex,nelements),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in DOC_to_topsoil allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    DOC_to_topsoil(:,:) = zero    
+    
+    ALLOCATE (DOC_to_subsoil(kjpindex,nelements),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in DOC_to_subsoil allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    DOC_to_subsoil(:,:) = zero       
+    
+    ALLOCATE (z0(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for z0','','')
+
+    ALLOCATE (roughheight(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for roughheight','','')
+
+    ALLOCATE (emis(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for emis','','')
+
+    ALLOCATE (tot_melt(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for tot_melt','','')
+
+    ALLOCATE (valpha(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for valpha','','')
+
+    ALLOCATE (vbeta(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vbeta','','')
+
+    ALLOCATE (fusion(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for fusion','','')
+
+    ALLOCATE (rau(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for rau','','')
+
+    ALLOCATE (deadleaf_cover(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for deadleaf_cover','','')
+
+    ALLOCATE (stempdiag(kjpindex, nbdl),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for stempdiag','','')
+
+
+    ALLOCATE (co2_flux(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for co2_flux','','')
+    co2_flux(:,:)=zero
+
+    ALLOCATE (shumdiag(kjpindex,nbdl),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for shumdiag','','')
+    
+    ALLOCATE (shumdiag_perma(kjpindex,nbdl),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for shumdiag_perma','','')
+
+    ALLOCATE (litterhumdiag(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for litterhumdiag','','')
+
+    ALLOCATE (ptnlev1(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for ptnlev1','','')
+
+    ALLOCATE (k_litt(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for k_litt','','')
+
+    !! 1.5 Initialize 2D array allocation
+    ALLOCATE (vevapwet(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for vevapwet','','')
+    vevapwet(:,:)=undef_sechiba
+
+    ALLOCATE (transpir(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for transpir','','')
+
+    ALLOCATE (transpot(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for transpot','','')
+
+    ALLOCATE (qsintmax(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for qsintmax','','')
+
+    ALLOCATE (rveget(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for rveget','','')
+
+    ALLOCATE (rstruct(kjpindex,nvm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for rstruct','','')
+
+    ALLOCATE (pgflux(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for pgflux','','')
+    pgflux(:)= 0.0
+
+    ALLOCATE (cgrnd_snow(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for cgrnd_snow','','')
+    cgrnd_snow(:,:) = 0
+
+    ALLOCATE (dgrnd_snow(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for dgrnd_snow','','')
+    dgrnd_snow(:,:) = 0
+
+    ALLOCATE (lambda_snow(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for lambda_snow','','')
+    lambda_snow(:) = 0
+
+    ALLOCATE (temp_sol_add(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for temp_sol_add','','')
+
+    ALLOCATE (gtemp(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for gtemp','','')
+
+    ALLOCATE (snowrho(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snowrho','','')
+
+    ALLOCATE (snowheat(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snowheat','','')
+
+    ALLOCATE (snowgrain(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snowgrain','','')
+
+    ALLOCATE (snowtemp(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snowtemp','','')
+
+    ALLOCATE (snowdz(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for snowdz','','')
+
+    ALLOCATE (mc_layh(kjpindex, nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for mc_layh','','')
+
+    ALLOCATE (mcl_layh(kjpindex, nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for mcl_layh','','')
+
+    ALLOCATE (tmc_layh(kjpindex, nslm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'sechiba_init','Pb in alloc for tmc_layh','','')
+
+    !! 1.6 Initialize indexing table for the vegetation fields. 
+    ! In SECHIBA we work on reduced grids but to store in the full 3D filed vegetation variable 
+    ! we need another index table : indexveg, indexsoil, indexnobio and indexgrnd
+    DO ji = 1, kjpindex
+       !
+       DO jv = 1, nlai+1
+          indexlai((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, nvm
+          indexveg((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !      
+       DO jv = 1, nstm
+          indexsoil((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !      
+       DO jv = 1, nnobio
+          indexnobio((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, ngrnd
+          indexgrnd((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, nsnow
+          indexsnow((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij
+       ENDDO
+
+       DO jv = 1, nbdl
+          indexnbdl((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij
+       ENDDO
+
+       DO jv = 1, nslm
+          indexlayer((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, 2
+          indexalb((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+    ENDDO
+
+!! 2. Read the default value that will be put into variable which are not in the restart file
+    CALL ioget_expval(val_exp)
+    
+    IF (printlev>=3) WRITE (numout,*) ' sechiba_init done '
+
+  END SUBROUTINE sechiba_init
+  
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_clear
+!!
+!>\BRIEF        Deallocate memory of sechiba's variables
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================ 
+
+  SUBROUTINE sechiba_clear (forcing_name,cforcing_name)
+
+    CHARACTER(LEN=100), INTENT(in)           :: forcing_name       !! Name of forcing file (unitless)
+    CHARACTER(LEN=100), INTENT(in)           :: cforcing_name      !! Name of forcing file with carbon related variables (unitless)
+!_ ================================================================================================================================
+    
+!! 1. Initialize first run
+
+    l_first_sechiba=.TRUE.
+
+!! 2. Deallocate dynamic variables of sechiba
+
+    IF ( ALLOCATED (indexveg)) DEALLOCATE (indexveg)
+    IF ( ALLOCATED (indexlai)) DEALLOCATE (indexlai)
+    IF ( ALLOCATED (indexsoil)) DEALLOCATE (indexsoil)
+    IF ( ALLOCATED (indexnobio)) DEALLOCATE (indexnobio)
+    IF ( ALLOCATED (indexsnow)) DEALLOCATE (indexsnow)
+    IF ( ALLOCATED (indexgrnd)) DEALLOCATE (indexgrnd)
+    IF ( ALLOCATED (indexlayer)) DEALLOCATE (indexlayer)
+    IF ( ALLOCATED (indexnbdl)) DEALLOCATE (indexnbdl)
+    IF ( ALLOCATED (indexalb)) DEALLOCATE (indexalb)
+    IF ( ALLOCATED (flood_res)) DEALLOCATE (flood_res)
+    IF ( ALLOCATED (flood_frac)) DEALLOCATE (flood_frac)
+    IF ( ALLOCATED (snow)) DEALLOCATE (snow)
+    IF ( ALLOCATED (snow_age)) DEALLOCATE (snow_age)
+    IF ( ALLOCATED (drysoil_frac)) DEALLOCATE (drysoil_frac)
+    IF ( ALLOCATED (rsol)) DEALLOCATE (rsol)
+    IF ( ALLOCATED (evap_bare_lim)) DEALLOCATE (evap_bare_lim)
+    IF ( ALLOCATED (evapot)) DEALLOCATE (evapot)
+    IF ( ALLOCATED (evapot_corr)) DEALLOCATE (evapot_corr)
+    IF ( ALLOCATED (humrel)) DEALLOCATE (humrel)
+    IF ( ALLOCATED (vegstress)) DEALLOCATE (vegstress)
+    IF ( ALLOCATED (soiltile)) DEALLOCATE (soiltile)
+    IF ( ALLOCATED (njsc)) DEALLOCATE (njsc)
+    IF ( ALLOCATED (reinf_slope)) DEALLOCATE (reinf_slope)
+    IF ( ALLOCATED (vbeta1)) DEALLOCATE (vbeta1)
+    IF ( ALLOCATED (vbeta4)) DEALLOCATE (vbeta4)
+    IF ( ALLOCATED (vbeta5)) DEALLOCATE (vbeta5)
+    IF ( ALLOCATED (soilcap)) DEALLOCATE (soilcap)
+    IF ( ALLOCATED (soilflx)) DEALLOCATE (soilflx)
+    IF ( ALLOCATED (temp_sol)) DEALLOCATE (temp_sol)
+    IF ( ALLOCATED (qsurf)) DEALLOCATE (qsurf)
+    IF ( ALLOCATED (qsintveg)) DEALLOCATE (qsintveg)
+    IF ( ALLOCATED (vbeta2))  DEALLOCATE (vbeta2)
+    IF ( ALLOCATED (vbeta3)) DEALLOCATE (vbeta3)
+    IF ( ALLOCATED (vbeta3pot)) DEALLOCATE (vbeta3pot)
+    IF ( ALLOCATED (gsmean)) DEALLOCATE (gsmean)
+    IF ( ALLOCATED (cimean)) DEALLOCATE (cimean)
+    IF ( ALLOCATED (gpp)) DEALLOCATE (gpp)
+    IF ( ALLOCATED (temp_growth)) DEALLOCATE (temp_growth) 
+    IF ( ALLOCATED (veget)) DEALLOCATE (veget)
+    IF ( ALLOCATED (veget_max)) DEALLOCATE (veget_max)
+    IF ( ALLOCATED (tot_bare_soil)) DEALLOCATE (tot_bare_soil)
+    IF ( ALLOCATED (lai)) DEALLOCATE (lai)
+    IF ( ALLOCATED (frac_age)) DEALLOCATE (frac_age)
+    IF ( ALLOCATED (height)) DEALLOCATE (height)
+    IF ( ALLOCATED (roughheight)) DEALLOCATE (roughheight)
+    IF ( ALLOCATED (frac_nobio)) DEALLOCATE (frac_nobio)
+    IF ( ALLOCATED (snow_nobio)) DEALLOCATE (snow_nobio)
+    IF ( ALLOCATED (snow_nobio_age)) DEALLOCATE (snow_nobio_age)
+    IF ( ALLOCATED (assim_param)) DEALLOCATE (assim_param)
+    IF ( ALLOCATED (vevapflo)) DEALLOCATE (vevapflo)
+    IF ( ALLOCATED (vevapsno)) DEALLOCATE (vevapsno)
+    IF ( ALLOCATED (vevapnu)) DEALLOCATE (vevapnu)
+    IF ( ALLOCATED (t2mdiag)) DEALLOCATE (t2mdiag)
+    IF ( ALLOCATED (totfrac_nobio)) DEALLOCATE (totfrac_nobio)
+    IF ( ALLOCATED (floodout)) DEALLOCATE (floodout)
+    IF ( ALLOCATED (runoff)) DEALLOCATE (runoff)
+    IF ( ALLOCATED (drainage)) DEALLOCATE (drainage)
+    IF ( ALLOCATED (reinfiltration)) DEALLOCATE (reinfiltration)
+    IF ( ALLOCATED (DOC_EXP_agg_d)) DEALLOCATE (DOC_EXP_agg_d) 
+    IF ( ALLOCATED (DOC_to_topsoil)) DEALLOCATE (DOC_to_topsoil) 
+    IF ( ALLOCATED (DOC_to_subsoil)) DEALLOCATE (DOC_to_subsoil)     
+    IF ( ALLOCATED (irrigation)) DEALLOCATE (irrigation)
+    IF ( ALLOCATED (tot_melt)) DEALLOCATE (tot_melt)
+    IF ( ALLOCATED (valpha)) DEALLOCATE (valpha)
+    IF ( ALLOCATED (vbeta)) DEALLOCATE (vbeta)
+    IF ( ALLOCATED (fusion)) DEALLOCATE (fusion)
+    IF ( ALLOCATED (rau)) DEALLOCATE (rau)
+    IF ( ALLOCATED (deadleaf_cover)) DEALLOCATE (deadleaf_cover)
+    IF ( ALLOCATED (stempdiag)) DEALLOCATE (stempdiag)
+    IF ( ALLOCATED (co2_flux)) DEALLOCATE (co2_flux)
+    IF ( ALLOCATED (shumdiag)) DEALLOCATE (shumdiag)
+    IF ( ALLOCATED (shumdiag_perma)) DEALLOCATE (shumdiag_perma)
+    IF ( ALLOCATED (litterhumdiag)) DEALLOCATE (litterhumdiag)
+    IF ( ALLOCATED (ptnlev1)) DEALLOCATE (ptnlev1)
+    IF ( ALLOCATED (k_litt)) DEALLOCATE (k_litt)
+    IF ( ALLOCATED (vevapwet)) DEALLOCATE (vevapwet)
+    IF ( ALLOCATED (transpir)) DEALLOCATE (transpir)
+    IF ( ALLOCATED (transpot)) DEALLOCATE (transpot)
+    IF ( ALLOCATED (qsintmax)) DEALLOCATE (qsintmax)
+    IF ( ALLOCATED (rveget)) DEALLOCATE (rveget)
+    IF ( ALLOCATED (rstruct)) DEALLOCATE (rstruct)
+    IF ( ALLOCATED (snowrho)) DEALLOCATE (snowrho)
+    IF ( ALLOCATED (snowgrain)) DEALLOCATE (snowgrain)
+    IF ( ALLOCATED (snowtemp)) DEALLOCATE (snowtemp)
+    IF ( ALLOCATED (snowdz)) DEALLOCATE (snowdz)
+    IF ( ALLOCATED (snowheat)) DEALLOCATE (snowheat)
+    IF ( ALLOCATED (cgrnd_snow)) DEALLOCATE (cgrnd_snow)
+    IF ( ALLOCATED (dgrnd_snow)) DEALLOCATE (dgrnd_snow)
+    IF ( ALLOCATED (lambda_snow)) DEALLOCATE(lambda_snow) 
+    IF ( ALLOCATED (gtemp)) DEALLOCATE (gtemp)
+    IF ( ALLOCATED (pgflux)) DEALLOCATE (pgflux)
+    IF ( ALLOCATED (mc_layh)) DEALLOCATE (mc_layh)
+    IF ( ALLOCATED (mcl_layh)) DEALLOCATE (mcl_layh)
+    IF ( ALLOCATED (tmc_layh)) DEALLOCATE (tmc_layh)
+
+!! 3. Clear all allocated memory
+
+    CALL pft_parameters_clear
+    CALL slowproc_clear 
+    CALL diffuco_clear 
+    CALL enerbil_clear  
+    IF ( hydrol_cwrr ) THEN
+       CALL hydrol_clear 
+       CALL thermosoil_clear
+    ELSE
+       CALL hydrolc_clear  
+       CALL thermosoilc_clear
+    ENDIF
+    CALL condveg_clear 
+    CALL routing_clear
+
+  END SUBROUTINE sechiba_clear
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_var_init
+!!
+!>\BRIEF        Calculate air density as a function of air temperature and 
+!! pressure for each terrestrial pixel.
+!! 
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S): air density (::rau, kg m^{-3}).
+!! 
+!! REFERENCE(S)	: None
+!! 
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE sechiba_var_init (kjpindex, rau, pb, temp_air) 
+
+!! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                    :: kjpindex        !! Domain size - terrestrial pixels only (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: pb              !! Surface pressure (hPa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: temp_air        !! Air temperature (K)
+    
+!! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: rau             !! Air density @tex $(kg m^{-3})$ @endtex
+
+!! 0.3 Modified variables
+
+!! 0.4 Local variables
+
+    INTEGER(i_std)                                 :: ji              !! Indices (unitless)
+!_ ================================================================================================================================
+    
+!! 1. Calculate intial air density (::rau)
+   
+    DO ji = 1,kjpindex
+       rau(ji) = pa_par_hpa * pb(ji) / (cte_molr*temp_air(ji))
+    END DO
+
+    IF (printlev>=3) WRITE (numout,*) ' sechiba_var_init done '
+
+  END SUBROUTINE sechiba_var_init
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_end
+!!
+!>\BRIEF        Swap old for newly calculated soil temperature.
+!! 
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S): soil temperature (::temp_sol; K)
+!! 
+!! REFERENCE(S)	: None
+!! 
+!! FLOWCHART    : None
+!! \n
+!! ================================================================================================================================ 
+
+  SUBROUTINE sechiba_end (kjpindex, temp_sol_new, temp_sol)
+                         
+
+!! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                       :: kjpindex           !! Domain size - terrestrial pixels only (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: temp_sol_new       !! New soil temperature (K)
+    
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)    :: temp_sol           !! Soil temperature (K)
+
+!_ ================================================================================================================================
+    
+!! 1. Swap temperature
+
+    temp_sol(:) = temp_sol_new(:)
+    
+    IF (printlev>=3) WRITE (numout,*) ' sechiba_end done '
+
+  END SUBROUTINE sechiba_end
+
+END MODULE sechiba
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/sechiba_io.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/sechiba_io.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/sechiba_io.f90	(revision 5166)
@@ -0,0 +1,467 @@
+!! This subroutines initialize a variable or an array
+!! with a variable or an array of smaller rank
+!! - i is for integer interface - r for real interface
+!! - 0 is for a scalar - 1 for a 1D array - 2 for a 2D array
+!! Thee right routines is automatically called depending type of input variable
+!! This initialisation is done only if the value of input field is egal to val_exp
+!!
+!! If a key word is provided which is not equal to "NO_KEYWORD" or "NOKEYWORD" then
+!! we try to find the value to fill in in the configuration file.
+!!
+!! @author Marie-Alice Foujols and Jan Polcher
+!! @Version : $Revision$, $Date$
+!! 
+!< $HeadURL$
+!< $Date$
+!< $Author$
+!< $Revision$
+!! IPSL (2006)
+!!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!!
+MODULE sechiba_io
+
+  USE defprec
+  USE constantes
+  USE ioipsl
+  USE sechiba_io_p
+
+  IMPLICIT NONE
+
+  INTERFACE setvar
+    MODULE PROCEDURE i0setvar, i10setvar, i20setvar, i11setvar, i21setvar, i22setvar
+    MODULE PROCEDURE r0setvar, r10setvar, r20setvar, r11setvar, r21setvar, r22setvar, r30setvar
+  END INTERFACE
+
+!
+! mettre la l'interface des routines utilisees:
+!
+! restget/put/ini histbeg/def flinopen/close
+!
+
+LOGICAL, SAVE                  :: long_print_setvar=.FALSE.  !! change to true to have more information
+!$OMP THREADPRIVATE(long_print_setvar)
+
+CONTAINS 
+
+
+!! Interface for integer scalar to scalar.
+SUBROUTINE i0setvar (var, val_exp, key_wd, val_put)
+
+  INTEGER(i_std), INTENT(inout)                   :: var                  !! Integer scalar to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Initial value to stored
+
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar) WRITE(numout,*) "i0setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( var == val_exp ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var = val_tmp
+  END IF
+  
+END SUBROUTINE i0setvar
+
+
+!! Interface for initialising an 1D integer array with a scalar integer.
+SUBROUTINE i10setvar (var, val_exp, key_wd, val_put)
+
+  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+  
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar) WRITE(numout,*) "i10setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var(:) = val_tmp
+  END IF
+  
+END SUBROUTINE i10setvar
+
+
+!! Interface for initialising an 1D array integer with an other 1D array integer.
+SUBROUTINE i11setvar (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
+
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar) WRITE(numout,*) "i11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var(:) = val_tmp (:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i11setvar
+
+
+!! Interface for initialising an 2D array integer with a scalar integer.
+SUBROUTINE i20setvar (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  !
+  ! this subroutine set val_put value to var if var is constant
+  ! 
+  !
+  IF (long_print_setvar) WRITE(numout,*) "i20setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var(:,:) = val_tmp
+  END IF
+  
+END SUBROUTINE i20setvar
+
+
+!! Interface for initialising an 2D array integer with an 1D array integer.
+!! Row or column depending size of 1D array to stored.
+!!
+!! example: 1D 1,2,3     2D is 1, 2, 3,
+!!                             1, 2, 3
+!!
+!!
+!! example: 1D 1,2,3     2D is 1, 1,
+!!                             2, 2,
+!!                             3, 3
+!!
+SUBROUTINE i21setvar (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D integer array to stored
+  
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  ! test if the 1D array dimension is compatible with first or second 
+  ! dimension of the 2D array
+
+  IF (long_print_setvar) WRITE(numout,*) "i21setvar :", key_wd, val_exp, val_put
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF (SIZE(val_put)==SIZE(var,1)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+      !                                1., 2., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
+      END IF
+  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 1.,
+      !                                2., 2.,
+      !                                3., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
+      END IF
+  ELSE 
+      WRITE(numout,*) ' incompatible dimension var and val_put'
+      WRITE(numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
+      WRITE(numout,*) ' val_put ', SIZE(val_put)
+      STOP 'setvar'
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i21setvar
+
+!! Interface for initialising an 2D array integer with an other 2D array integer.
+SUBROUTINE i22setvar (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd              !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
+
+  INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar) WRITE(numout,*) "i21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
+
+  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
+  val_tmp(:,:) = val_put(:,:)
+
+  IF ( ALL(var(:,:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:,:) = val_tmp(:,:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i22setvar
+
+
+!! Interface for scalar to scalar real
+SUBROUTINE r0setvar (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), INTENT(inout)                   :: var                  !! Real scalar to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Initial value to stored
+  
+  REAL(r_std)                                  :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar) WRITE(numout,*) "r0setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( var==val_exp ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var = val_tmp
+  END IF
+  
+END SUBROUTINE r0setvar
+
+
+!! Interface for initialising an 1D real array with a scalar real.
+SUBROUTINE r10setvar (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+   
+  REAL(r_std)                                  :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+ 
+  IF (long_print_setvar) WRITE(numout,*) "r10setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:) = val_tmp
+  END IF
+  
+END SUBROUTINE r10setvar
+
+
+!! Interface for initialising an 1D array real with an other 1D array real.
+SUBROUTINE r11setvar (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd              !! The Key word we will look for
+  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
+
+  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+   
+  IF (long_print_setvar) WRITE(numout,*) "r11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:) = val_tmp (:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r11setvar
+
+
+!! Interface for initialising an 2D array real with a scalar real.
+SUBROUTINE r20setvar (var, val_exp, key_wd, val_put)
+  
+  ! interface for scalar to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd                  !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+ 
+  REAL(r_std)                                  :: val_tmp  
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+ 
+  IF (long_print_setvar) WRITE(numout,*) "r20setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var(:,:) = val_tmp
+  END IF
+  
+END SUBROUTINE r20setvar
+
+
+!! Interface for initialising an 2D array real with an 1D array real.
+!! Row or column depending size of 1D array to stored.
+!!
+!! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+!!                                1., 2., 3.
+!!
+!!
+!! example: 1D 1.,2.,3.     2D is 1., 1.,
+!!                                2., 2.,
+!!                                3., 3.
+!!
+SUBROUTINE r21setvar (var, val_exp, key_wd, val_put)
+  
+  ! interface for 1D array to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D real array to stored
+
+  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  ! test if the 1D array dimension is compatible with first or second 
+  ! dimension of the 2D array
+
+  IF (long_print_setvar) WRITE(numout,*) "r21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF (SIZE(val_put)==SIZE(var,1)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+      !                                1., 2., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
+      END IF
+  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 1.,
+      !                                2., 2.,
+      !                                3., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
+      END IF
+  ELSE 
+      WRITE(numout,*) ' incompatible dimension var and val_put'
+      WRITE(numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
+      WRITE(numout,*) ' val_put ', SIZE(val_put)
+      STOP 'setvar'
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r21setvar
+
+
+!! Interface for initialising an 2D array real with an other 2D array real. 
+SUBROUTINE r22setvar (var, val_exp, key_wd, val_put)
+  
+  ! interface for 2D array to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd              !! The Key word we will look for
+  REAL(r_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
+
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar) WRITE(numout,*) "r22setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
+
+  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
+  val_tmp(:,:) = val_put(:,:)
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:,:) = val_tmp(:,:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r22setvar
+
+!! Interface for initialising an 3D array real with a scalar real.
+SUBROUTINE r30setvar (var, val_exp, key_wd, val_put)
+
+  ! interface for scalar to 3D array real
+
+  REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: var                  !! 3D integer array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+
+  REAL(r_std)                                  :: val_tmp 
+  INTEGER(i_std)                              :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar) WRITE(numout,*) 'r30setvar',val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:,:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:,:,:) = val_tmp
+  END IF
+
+END SUBROUTINE r30setvar
+
+END MODULE sechiba_io
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/sechiba_io_p.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/sechiba_io_p.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/sechiba_io_p.f90	(revision 5166)
@@ -0,0 +1,522 @@
+!! This subroutines initialize a variable or an array
+!! with a variable or an array of smaller rank
+!! - i is for integer interface - r for real interface
+!! - 0 is for a scalar - 1 for a 1D array - 2 for a 2D array
+!! Thee right routines is automatically called depending type of input variable
+!! This initialisation is done only if the value of input field is egal to val_exp
+!!
+!! If a key word is provided which is not equal to "NO_KEYWORD" or "NOKEYWORD" then
+!! we try to find the value to fill in in the configuration file.
+!!
+!! @author Marie-Alice Foujols and Jan Polcher
+!! @Version : $Revision$, $Date$
+!! 
+!< $HeadURL$
+!< $Date$
+!< $Author$
+!< $Revision$
+!! IPSL (2006)
+!!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!!
+MODULE sechiba_io_p
+
+  USE defprec
+  USE constantes
+  USE ioipsl
+  USE ioipsl_para
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  INTERFACE setvar_p
+    MODULE PROCEDURE i0setvar_p, i10setvar_p, i20setvar_p, i11setvar_p, i21setvar_p, i22setvar_p
+    MODULE PROCEDURE r0setvar_p, r10setvar_p, r20setvar_p, r11setvar_p, r21setvar_p, r22setvar_p, r30setvar_p
+  END INTERFACE
+
+!
+! mettre la l'interface des routines utilisees:
+!
+! restget/put/ini histbeg/def flinopen/close
+!
+
+LOGICAL, SAVE                  :: long_print_setvar_p=.FALSE.  !! change to true to have more information
+!$OMP THREADPRIVATE(long_print_setvar_p)
+
+CONTAINS 
+
+!! Interface for integer scalar to scalar.
+SUBROUTINE i0setvar_p (var, val_exp, key_wd, val_put)
+
+  INTEGER(i_std), INTENT(inout)                   :: var                  !! Integer scalar to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Initial value to stored
+
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar_p) WRITE (numout,*) "i0setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( var == val_exp ) THEN 
+     IF ( is_key <= 0 ) THEN
+        CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var = val_tmp
+  END IF
+  
+END SUBROUTINE i0setvar_p
+
+
+!! Interface for initialising an 1D integer array with a scalar integer.
+SUBROUTINE i10setvar_p (var, val_exp, key_wd, val_put)
+
+  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+  
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar_p) WRITE (numout,*) "i10setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:) = val_tmp
+  END IF
+  
+END SUBROUTINE i10setvar_p
+
+
+!! Interface for initialising an 1D array integer with an other 1D array integer.
+SUBROUTINE i11setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
+  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable 
+
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp_g
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar_p) WRITE (numout,*) "i11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+        IF (PRESENT(is_grid) ) THEN
+           IF (is_root_prc) THEN
+              ALLOCATE( val_tmp_g(nbp_glo) )
+           ELSE
+              ALLOCATE( val_tmp_g(1) )
+           ENDIF
+           CALL gather( val_tmp,val_tmp_g )
+           IF (is_root_prc) &
+              CALL getin(key_wd,  val_tmp_g)
+           CALL scatter( val_tmp,val_tmp_g )
+           DEALLOCATE( val_tmp_g )
+        ELSE
+           CALL getin_p(key_wd,  val_tmp)
+        ENDIF
+     ENDIF
+     var(:) = val_tmp (:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i11setvar_p
+
+
+!! Interface for initialising an 2D array integer with a scalar integer.
+SUBROUTINE i20setvar_p (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  !
+  ! this subroutine set val_put value to var if var is constant
+  ! 
+  !
+  IF (long_print_setvar_p) WRITE (numout,*) "i20setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:,:) = val_tmp
+  END IF
+  
+END SUBROUTINE i20setvar_p
+
+
+!! Interface for initialising an 2D array integer with an 1D array integer.
+!! Row or column depending size of 1D array to stored.
+!!
+!! example: 1D 1,2,3     2D is 1, 2, 3,
+!!                             1, 2, 3
+!!
+!!
+!! example: 1D 1,2,3     2D is 1, 1,
+!!                             2, 2,
+!!                             3, 3
+!!
+SUBROUTINE i21setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D integer array to stored
+  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable 
+  
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  ! test if the 1D array dimension is compatible with first or second 
+  ! dimension of the 2D array
+
+  IF (long_print_setvar_p) WRITE (numout,*) "i21setvar :", key_wd, val_exp, val_put
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF (SIZE(val_put)==SIZE(var,1)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+      !                                1., 2., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) THEN
+           CALL getin_p(key_wd,  val_tmp)
+         ENDIF
+         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
+      END IF
+  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 1.,
+      !                                2., 2.,
+      !                                3., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) THEN
+           CALL getin_p(key_wd,  val_tmp)
+         ENDIF
+         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
+      END IF
+  ELSE 
+      WRITE (numout,*) ' incompatible dimension var and val_put'
+      WRITE (numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
+      WRITE (numout,*) ' val_put ', SIZE(val_put)
+      STOP 'setvar'
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i21setvar_p
+
+!! Interface for initialising an 2D array integer with an other 2D array integer.
+SUBROUTINE i22setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd              !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
+  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable 
+
+  INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar_p) WRITE (numout,*) "i21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
+
+  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
+  val_tmp(:,:) = val_put(:,:)
+
+  IF ( ALL(var(:,:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:,:) = val_tmp(:,:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i22setvar_p
+
+
+!! Interface for scalar to scalar real
+SUBROUTINE r0setvar_p (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), INTENT(inout)                   :: var                  !! Real scalar to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Initial value to stored
+  
+  REAL(r_std)                                  :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar_p) WRITE (numout,*) "r0setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( var==val_exp ) THEN 
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var = val_tmp
+  END IF
+  
+END SUBROUTINE r0setvar_p
+
+
+!! Interface for initialising an 1D real array with a scalar real.
+SUBROUTINE r10setvar_p (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+   
+  REAL(r_std)                                  :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+ 
+  IF (long_print_setvar_p) WRITE (numout,*) "r10setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:) = val_tmp
+  END IF
+  
+END SUBROUTINE r10setvar_p
+
+
+!! Interface for initialising an 1D array real with an other 1D array real.
+SUBROUTINE r11setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd              !! The Key word we will look for
+  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
+  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable 
+
+  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+   
+  IF (long_print_setvar_p) WRITE (numout,*) "r11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:) = val_tmp (:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r11setvar_p
+
+
+!! Interface for initialising an 2D array real with a scalar real.
+SUBROUTINE r20setvar_p (var, val_exp, key_wd, val_put)
+  
+  ! interface for scalar to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd                  !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+ 
+  REAL(r_std)                                  :: val_tmp  
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+ 
+  IF (long_print_setvar_p) WRITE (numout,*) "r20setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:,:) = val_tmp
+  END IF
+  
+END SUBROUTINE r20setvar_p
+
+
+!! Interface for initialising an 2D array real with an 1D array real.
+!! Row or column depending size of 1D array to stored.
+!!
+!! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+!!                                1., 2., 3.
+!!
+!!
+!! example: 1D 1.,2.,3.     2D is 1., 1.,
+!!                                2., 2.,
+!!                                3., 3.
+!!
+SUBROUTINE r21setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  ! interface for 1D array to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D real array to stored
+  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable 
+
+  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  ! test if the 1D array dimension is compatible with first or second 
+  ! dimension of the 2D array
+
+  IF (long_print_setvar_p) WRITE (numout,*) "r21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF (SIZE(val_put)==SIZE(var,1)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+      !                                1., 2., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) THEN
+           CALL getin_p(key_wd,  val_tmp)
+         ENDIF
+         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
+      END IF
+  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 1.,
+      !                                2., 2.,
+      !                                3., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) THEN
+           CALL getin_p(key_wd,  val_tmp)
+         ENDIF
+         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
+      END IF
+  ELSE 
+      WRITE (numout,*) ' incompatible dimension var and val_put'
+      WRITE (numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
+      WRITE (numout,*) ' val_put ', SIZE(val_put)
+      STOP 'setvar'
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r21setvar_p
+
+
+!! Interface for initialising a real 2D array with a scalar parameter from run.def or an other 2D array in argument
+SUBROUTINE r22setvar_p (var, val_exp, key_wd, val_put)
+  
+  ! interface for 2D array to 2D array real
+  ! If a key_wd is set, it is supposed to be a scalar parameter will be read from run.def
+  ! It is not possible to read a 2D variable from run.def
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                 :: key_wd              !! The Key word we will look for
+  REAL(r_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
+  REAL(r_std)                                  :: val_scal            !! Temporary variable to read a scalar value from run.def
+  INTEGER(i_std)                               :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar_p) WRITE (numout,*) "r22setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
+
+  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
+  val_tmp(:,:) = val_put(:,:)
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+        ! This case only read a scalar value with getin
+        val_scal=val_exp
+        CALL getin_p(key_wd, val_scal)
+        ! If a value was found in run.def, then set val_tmp to this value.
+        IF (val_scal/=val_exp) val_tmp(:,:)=val_scal 
+     ENDIF
+     var(:,:) = val_tmp(:,:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r22setvar_p
+
+!! Interface for initialising an 3D array real with a scalar real.
+SUBROUTINE r30setvar_p (var, val_exp, key_wd, val_put)
+
+  ! interface for scalar to 3D array real
+
+  REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: var                  !! 3D integer array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+
+  REAL(r_std)                                  :: val_tmp 
+  INTEGER(i_std)                              :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar_p) WRITE(numout,*) 'r30setvar',val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:,:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:,:,:) = val_tmp
+  END IF
+
+END SUBROUTINE r30setvar_p
+
+END MODULE sechiba_io_p
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/slowproc.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/slowproc.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/slowproc.f90	(revision 5166)
@@ -0,0 +1,4502 @@
+! =================================================================================================================================
+! MODULE       : slowproc
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Groups the subroutines that: (1) initialize all variables used in 
+!! slowproc_main, (2) prepare the restart file for the next simulation, (3) Update the 
+!! vegetation cover if needed, and (4) handle all slow processes if the carbon
+!! cycle is activated (call STOMATE) or update the vegetation properties (LAI and 
+!! fractional cover) in the case of a run with only SECHIBA.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): Allowed reading of USDA map, Nov 2014, ADucharne
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE slowproc
+
+  USE defprec
+  USE constantes 
+  USE constantes_soil
+  USE pft_parameters
+  USE ioipsl
+  USE xios_orchidee
+  USE ioipsl_para
+  USE sechiba_io
+  USE interpol_help
+  USE stomate
+  USE stomate_data
+  USE grid
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PRIVATE
+  PUBLIC slowproc_main, slowproc_clear, slowproc_initialize, slowproc_finalize, slowproc_change_frac
+
+  !
+  ! variables used inside slowproc module : declaration and initialisation
+  !
+  REAL(r_std), SAVE                                  :: slope_default = 0.1
+!$OMP THREADPRIVATE(slope_default)
+  INTEGER(i_std) , SAVE                              :: veget_update        !! update frequency in years for landuse (nb of years)
+!$OMP THREADPRIVATE(veget_update)
+  INTEGER, SAVE                                      :: printlev_loc        !! Local printlev in slowproc module
+!$OMP THREADPRIVATE(printlev_loc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: clayfraction        !! Clayfraction (0-1, unitless)
+!$OMP THREADPRIVATE(clayfraction)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: bulk_density        !! bulk_density (kg m-3)
+!$OMP THREADPRIVATE(bulk_density)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: soil_ph             !! soil_ph (0-14, pH units)
+!$OMP THREADPRIVATE(soil_ph)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: laimap              !! LAI map when the LAI is prescribed and not calculated by STOMATE
+!$OMP THREADPRIVATE(laimap)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: soilclass_default
+!$OMP THREADPRIVATE(soilclass_default)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: veget_max_new       !! New year fraction of vegetation type (0-1, unitless)
+!$OMP THREADPRIVATE(veget_max_new)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_nobio_new      !! New year fraction of ice+lakes+cities+... (0-1, unitless)
+!$OMP THREADPRIVATE(frac_nobio_new)
+  INTEGER(i_std), SAVE                               :: lcanop              !! canopy levels used for LAI
+!$OMP THREADPRIVATE(lcanop)
+  INTEGER(i_std) , SAVE                              :: veget_year          !! year for vegetation update
+!$OMP THREADPRIVATE(veget_year)
+
+  ! Update vegetation and bare soil fraction
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_bare        !! Fraction (of veget_max) of bare soil in each vegetation type           
+!$OMP THREADPRIVATE(frac_bare)
+  PUBLIC frac_bare
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: slowproc_initialize
+!!
+!>\BRIEF         Initialize slowproc module and call initialization of stomate module
+!!
+!! DESCRIPTION : Allocate module variables, read from restart file or initialize with default values
+!!               Call initialization of stomate module.
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_initialize (kjit,          kjpij,        kjpindex,       date0,             &
+                                  rest_id,       rest_id_stom, hist_id_stom,   hist_id_stom_IPCC, &
+                                  IndexLand,     indexveg,     lalo,           neighbours,        &
+                                  resolution,    contfrac,     t2m,                               &
+                                  soiltile,      reinf_slope,  deadleaf_cover, assim_param,       &
+                                  lai,           frac_age,     height,         veget,             &
+                                  frac_nobio,    njsc,         veget_max,      tot_bare_soil,     &
+                                  totfrac_nobio, qsintmax,     co2_flux,       fco2_lu,  temp_growth)
+
+!! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                          :: kjit                !! Time step number
+    INTEGER(i_std), INTENT(in)                          :: kjpij               !! Total size of the un-compressed grid
+    INTEGER(i_std),INTENT(in)                           :: kjpindex            !! Domain size - terrestrial pixels only
+    REAL(r_std),INTENT (in)                             :: date0               !! Initial date of what ???
+    INTEGER(i_std),INTENT (in)                          :: rest_id             !! Restart file identifier
+    INTEGER(i_std),INTENT (in)                          :: rest_id_stom        !! STOMATE's _Restart_ file identifier
+    INTEGER(i_std),INTENT (in)                          :: hist_id_stom        !! STOMATE's _history_ file identifier
+    INTEGER(i_std),INTENT(in)                           :: hist_id_stom_IPCC   !! STOMATE's IPCC _history_ file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: IndexLand           !! Indices of the points on the land map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in):: indexveg            !! Indices of the points on the vegetation (3D map ???) 
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)     :: lalo                !! Geogr. coordinates (latitude,longitude) (degrees)
+    INTEGER(i_std), DIMENSION (kjpindex,8), INTENT(in)  :: neighbours          !! neighoring grid points if land.
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)     :: resolution          !! size in x an y of the grid (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: contfrac            !! Fraction of continent in the grid (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: t2m                 !! 2 m air temperature (K)
+    
+!! 0.2 Output variables 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)     :: co2_flux       !! CO2 flux per average ground area (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: fco2_lu        !! CO2 flux from land-use (without forest management) (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: temp_growth    !! Growth temperature (°C) - Is equal to t2m_month 
+    INTEGER(i_std), DIMENSION(kjpindex), INTENT(out)       :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: lai            !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: height         !! height of vegetation (m)
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT(out):: frac_age   !! Age efficacity from STOMATE for isoprene
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: veget          !! Fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out)  :: frac_nobio     !! Fraction of ice, lakes, cities etc. in the mesh
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: veget_max      !! Maximum fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: tot_bare_soil  !! Total evaporating bare soil fraction 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: totfrac_nobio  !! Total fraction of ice+lakes+cities etc. in the mesh
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)    :: soiltile       !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)          :: reinf_slope    !! slope coef for reinfiltration
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2),INTENT (out):: assim_param    !! min+max+opt temperatures & vmax for photosynthesis (K, \mumol m^{-2} s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: deadleaf_cover !! Fraction of soil covered by dead leaves (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)     :: qsintmax       !! Maximum water storage on vegetation from interception (mm)
+
+!! 0.4 Local variables
+    INTEGER(i_std)                                     :: j, jv                !! indices 
+    REAL(r_std)                                        :: tmp_day(1)           !! temporary variable for I/O
+    CHARACTER(LEN=80)                                  :: var_name             !! To store variables names for I/O
+    REAL(r_std), DIMENSION(kjpindex,nvm)               :: npp                  !! Net Ecosystem Exchange (gC/(m**2 of total ground)/time step)
+
+!_ ================================================================================================================================
+
+    !! 1. Perform the allocation of all variables, define some files and some flags. 
+    !     Restart file read for Sechiba.
+    CALL slowproc_init (kjit, date0, kjpindex, IndexLand, lalo, neighbours, resolution, contfrac, &
+         rest_id, lai, frac_age, veget, frac_nobio, totfrac_nobio, soiltile, reinf_slope, &
+         veget_max, tot_bare_soil, njsc, &
+         height, lcanop, veget_update, veget_year)
+    
+
+    !! 2. Define Time step in days for stomate
+    dt_days = dt_stomate / one_day
+    
+
+    !! 3. check time step coherence between slow processes and fast processes
+    IF ( dt_stomate .LT. dt_sechiba ) THEN
+       WRITE(numout,*) 'slow_processes: time step smaller than forcing time step.'
+       CALL ipslerr_p(3,'slowproc_initialize','Coherence problem between dt_stomate and dt_sechiba',&
+            'Time step smaller than forcing time step','')
+    ENDIF
+    
+    !! 4. Call stomate to initialize all variables manadged in stomate,
+    IF ( ok_stomate ) THEN
+
+       CALL stomate_initialize &
+            (kjit,           kjpij,                  kjpindex,                        &
+             rest_id_stom,   hist_id_stom,           hist_id_stom_IPCC,               &
+             indexLand,      lalo,                   neighbours,   resolution,        &
+             contfrac,       totfrac_nobio,          clayfraction, bulk_density,      &
+             soil_ph,        t2m,               &
+             lai,            veget,                  veget_max,                       &
+             co2_flux,       fco2_lu,                deadleaf_cover, assim_param, temp_growth )
+    ENDIF
+    
+    !! 5. Specific run without the carbon cycle (STOMATE not called): 
+    !!     Need to initialize some variables that will be used in SECHIBA:
+    !!     height, deadleaf_cover, assim_param, qsintmax.
+    IF (.NOT. ok_stomate ) THEN
+       CALL slowproc_derivvar (kjpindex, veget, lai, &
+            qsintmax, deadleaf_cover, assim_param, height, temp_growth)
+    ELSE
+       qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
+       qsintmax(:,1) = zero
+    ENDIF
+    
+  END SUBROUTINE slowproc_initialize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_main
+!!
+!>\BRIEF         Main routine that manage variable initialisation (slowproc_init), 
+!! prepare the restart file with the slowproc variables, update the time variables 
+!! for slow processes, and possibly update the vegetation cover, before calling 
+!! STOMATE in the case of the carbon cycle activated or just update LAI (and possibly
+!! the vegetation cover) for simulation with only SECHIBA   
+!!
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): The subroutine manages 
+!! diverses tasks:
+!! (1) Initializing all variables of slowproc (first call)
+!! (2) Preparation of the restart file for the next simulation with all prognostic variables
+!! (3) Compute and update time variable for slow processes
+!! (4) Update the vegetation cover if there is some land use change (only every years)
+!! (5) Call STOMATE for the runs with the carbone cycle activated (ok_stomate) and compute the respiration
+!!     and the net primary production
+!! (6) Compute the LAI and possibly update the vegetation cover for run without STOMATE 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):  ::co2_flux, ::fco2_lu, ::lai, ::height, ::veget, ::frac_nobio,  
+!! ::veget_max, ::totfrac_nobio, ::soiltype, ::assim_param, ::deadleaf_cover, ::qsintmax,
+!! and resp_maint, resp_hetero, resp_growth, npp that are calculated and stored
+!! in stomate is activated.  
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : 
+! \latexonly 
+! \includegraphics(scale=0.5){SlowprocMainFlow.eps} !PP to be finalize!!)
+! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_main (kjit, kjpij, kjpindex, date0, &
+       IndexLand, indexveg, lalo, neighbours, resolution, contfrac, soiltile, &
+       t2m, t2m_min, temp_sol, stempdiag, &
+       humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+       deadleaf_cover, &
+       assim_param, &
+       lai, frac_age, height, veget, frac_nobio, njsc, veget_max, totfrac_nobio, qsintmax, &
+       rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+       co2_flux, fco2_lu, temp_growth, tot_bare_soil, &
+       soil_mc, litter_mc,floodout, runoff, drainage, wat_flux0, wat_flux,&
+       drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, DOC_to_topsoil, DOC_to_subsoil)
+  
+!! INTERFACE DESCRIPTION
+
+!! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjit                !! Time step number
+    INTEGER(i_std), INTENT(in)                          :: kjpij               !! Total size of the un-compressed grid
+    INTEGER(i_std),INTENT(in)                           :: kjpindex            !! Domain size - terrestrial pixels only
+    REAL(r_std),INTENT (in)                             :: date0               !! Initial date of what ???
+    INTEGER(i_std),INTENT (in)                          :: rest_id,hist_id     !! _Restart_ file and _history_ file identifier
+    INTEGER(i_std),INTENT (in)                          :: hist2_id            !! _history_ file 2 identifier
+    INTEGER(i_std),INTENT (in)                          :: rest_id_stom        !! STOMATE's _Restart_ file identifier
+    INTEGER(i_std),INTENT (in)                          :: hist_id_stom        !! STOMATE's _history_ file identifier
+    INTEGER(i_std),INTENT(in)                           :: hist_id_stom_IPCC   !! STOMATE's IPCC _history_ file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: IndexLand           !! Indices of the points on the land map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in):: indexveg            !! Indices of the points on the vegetation (3D map ???) 
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)     :: lalo                !! Geogr. coordinates (latitude,longitude) (degrees)
+    INTEGER(i_std), DIMENSION (kjpindex,8), INTENT(in)  :: neighbours          !! neighoring grid points if land. In what ??? indices or geographical coordinates (lat/lon) ??? 
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)     :: resolution          !! size in x an y of the grid (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: contfrac            !! Fraction of continent in the grid (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)  :: humrel              !! Relative humidity ("moisture stress") (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: t2m                 !! 2 m air temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: t2m_min             !! min. 2 m air temp. during forcing time step (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: temp_sol            !! Surface temperature (K)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)  :: stempdiag           !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)  :: shumdiag            !! Relative soil moisture (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(in)  :: soil_mc         !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in)   :: litter_mc           !! litter moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: litterhumdiag       !! Litter humidity  (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: precip_rain         !! Rain precipitation (mm dt_stomate^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: precip_snow         !! Snow precipitation (mm dt_stomate^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: gpp                 !! GPP of total ground area (gC m^{-2} time step^{-1}). 
+                                                                               !! Calculated in sechiba, account for vegetation cover and 
+                                                                               !! effective time step to obtain gpp_d   
+   REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: floodout             !! flux out of floodplains
+   REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: runoff               !! Complete runoff
+   REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: drainage             !! Drainage
+   REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in)   :: wat_flux0            !! Water flux in the first soil layers exported for soil C calculations
+   REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(in)   :: wat_flux        !! Water flux in the soil layers exported for soil C calculations
+   REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in)   :: drainage_per_soil    !! Drainage per soil type exported for soil C calculations 
+   REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in)   :: runoff_per_soil      !! Runoff per soil type exported for soil C calculations 
+   REAL(r_std),DIMENSION (kjpindex,nelements), INTENT(in)   :: DOC_to_topsoil  !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                               !! floodplains and from irrigation
+                                                                               !! @tex $(gC m^{-2} day{-1})$ @endtex
+   REAL(r_std),DIMENSION (kjpindex,nelements), INTENT(in)   :: DOC_to_subsoil  !! DOC inputs to bottom of the soil column, from returnflow
+                                                                               !! in swamps and lakes
+                                                                               !! @tex $(gC m^{-2} day{-1})$ @endtex
+!! 0.2 Output variables 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)  :: co2_flux            !! CO2 flux per average ground area (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: fco2_lu             !! CO2 flux from land-use (without forest management) (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: temp_growth         !! Growth temperature (°C) - Is equal to t2m_month 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: tot_bare_soil       !! Total evaporating bare soil fraction 
+    REAL(r_std),DIMENSION(kjpindex, nexp), INTENT (out) :: DOC_EXP_agg_d       !! DOC exports, diffrenet paths (nexp), in  
+                                                                               !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex      
+!! 0.3 Modified variables
+    INTEGER(i_std), DIMENSION(kjpindex), INTENT(inout)       :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: lai            !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: height         !! height of vegetation (m)
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT(inout):: frac_age   !! Age efficacity from STOMATE for isoprene
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: veget          !! Fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout)  :: frac_nobio     !! Fraction of ice, lakes, cities etc. in the mesh
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: veget_max      !! Maximum fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: totfrac_nobio  !! Total fraction of ice+lakes+cities etc. in the mesh
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout)    :: soiltile       !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2),INTENT (inout):: assim_param    !! min+max+opt temperatures & vmax for photosynthesis (K, \mumol m^{-2} s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: deadleaf_cover !! Fraction of soil covered by dead leaves (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: qsintmax       !! Maximum water storage on vegetation from interception (mm)
+
+!! 0.4 Local variables
+    INTEGER(i_std)                                     :: j, jv, ji            !! indices 
+    REAL(r_std)                                        :: tmp_day(1)           !! temporary variable for I/O
+    CHARACTER(LEN=80)                                  :: var_name             !! To store variables names for I/O
+    REAL(r_std), DIMENSION(kjpindex,nvm)               :: resp_maint           !! Maitanance component of autotrophic respiration in (gC m^{-2} dt_stomate^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm,nelements)     :: resp_hetero          !! heterotrophic resp. (gC/(m**2 of total ground)/time step)
+    REAL(r_std), DIMENSION(kjpindex,nvm)               :: resp_growth          !! Growth component of autotrophic respiration in gC m^{-2} dt_stomate^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm)               :: npp                  !! Net Ecosystem Exchange (gC/(m**2 of total ground)/time step)
+    REAL(r_std),DIMENSION (kjpindex)                   :: totfrac_nobio_new    !! Total fraction for the next year
+    LOGICAL                                            :: FirstTsYear          !! Flag set to true for the first sechiba time step on the year.
+    LOGICAL                                            :: LastTsDay            !! Flag set to true for the last sechiba time step of the day. 
+!_ ================================================================================================================================
+
+    !! 1. Compute and update all variables linked to the date and time
+    IF (printlev_loc>=5) WRITE(numout,*) 'Entering slowproc_main, month, day, sec=',month,day,sec
+    
+    IF ( sec == dt_sechiba .AND. month==1 .AND. day==1 ) THEN
+       ! The current time step is the first sechiba timestep of a new year
+       IF (printlev_loc>=4) WRITE(numout,*) "This is a new day and a new year: month, day, sec=", month, day, sec
+       FirstTsYear=.TRUE.
+    ELSE
+       FirstTsYear=.FALSE.
+    END IF
+    
+    IF ( sec == 0 ) THEN
+       ! The current time step is the last sechiba time step on a day
+       LastTsDay=.TRUE.
+       
+       IF ( month == 1 .AND. day == 1 ) THEN
+          ! The current time step is the last sechiba time step on a year
+          ! JG : note that month=1, day=1, sec=O is the last day of the year. 
+          !      This is due to a problem before the first call to slowproc. 
+          !      slowproc_main enters the first time on the 2nd time step (1800s)
+          EndOfYear = .TRUE.
+          IF (printlev_loc>=4) WRITE(numout,*) "This is the last sechiba time step of a year, EndOfYear is activated"
+       ELSE
+          EndOfYear = .FALSE.
+       END IF
+    ELSE
+       LastTsDay = .FALSE.
+       EndOfYear = .FALSE.
+    END IF
+
+    !! 2. Activate slow processes if it is the end of the day
+    IF ( LastTsDay ) THEN
+       ! 3.2.2 Activate slow processes in the end of the day
+       do_slow = .TRUE.
+    
+    ! 3.3 We are not a new day so that slow processes in STOMATE will
+    ! not be done (but why end of year set to false ???)
+       ! 3.2.3 Count the number of days 
+       date = date + nint(dt_days)
+       IF (printlev_loc>=4) WRITE(numout,*) "New date : ",date, 'year_length ',year_length,kjit
+    ELSE
+       do_slow = .FALSE.
+    ENDIF
+    
+    !! 3. Update the vegetation if it is time to do so.
+    !!    This is done at the first sechiba time step on a new year and only every "veget_update" years. 
+    !!    veget_update correspond to a number of years between each vegetation updates.
+    !!    Nothing is done if veget_update=0.
+    !!    Update of the vegetation map can not be done if map_pft_format=false.
+    IF ( map_pft_format .AND. (veget_update > 0) .AND. FirstTsYear ) THEN
+       veget_year = veget_year + 1
+
+       ! Update of the vegetation cover with Land Use only if 
+       ! the current year match the requested condition (a multiple of "veget_update")
+       IF ( MOD(veget_year - veget_year_orig, veget_update) == 0 ) THEN
+          IF (printlev_loc>=1) WRITE(numout,*)  'We are updating the vegetation map for year =' , veget_year
+          
+          ! Read the new the vegetation from file. Output is veget_max_new and frac_nobio_new
+          CALL slowproc_readvegetmax(kjpindex, lalo, neighbours, resolution, contfrac, &
+               veget_max, veget_max_new, frac_nobio_new, veget_year, .FALSE.)
+          
+          ! Set the flag do_now_stomate_lcchange to activate stomate_lcchange.
+          ! This flag will be kept to true until stomate_lcchange has been done. 
+          ! The variable totfrac_nobio_new will only be used in stomate when this flag is activated
+          do_now_stomate_lcchange=.TRUE.
+          IF ( .NOT. ok_stomate ) THEN
+             ! Special case if stomate is not activated : set the variable done_stomate_lcchange=true 
+             ! so that the subroutine slowproc_change_frac will be called in the end of sechiba_main.
+             done_stomate_lcchange=.TRUE.
+          END IF
+       ENDIF
+    ENDIF
+
+    !! 4. Main call to STOMATE
+    IF ( ok_stomate ) THEN
+       
+       ! Caluclate totfrac_nobio_new only for the case when the land use map has been read previously
+       IF (do_now_stomate_lcchange) THEN
+          totfrac_nobio_new(:) = zero
+          DO jv = 1, nnobio
+             totfrac_nobio_new(:) = totfrac_nobio_new(:) + frac_nobio_new(:,jv)
+          ENDDO
+       ELSE
+          totfrac_nobio_new(:) = zero
+       END IF
+          
+       !! 4.1 Call stomate main routine that will call all c-cycle routines       !
+       CALL stomate_main (kjit, kjpij, kjpindex, &
+            IndexLand, lalo, neighbours, resolution, contfrac, totfrac_nobio, clayfraction, &
+            t2m, t2m_min, temp_sol, stempdiag, &
+            humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+            deadleaf_cover, &
+            assim_param, &
+            lai, frac_age, height, veget, veget_max, &
+            veget_max_new, totfrac_nobio_new, &
+            hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+            co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth,temp_growth, &
+            soil_mc,soiltile,&
+            litter_mc,floodout, runoff, drainage,wat_flux0, wat_flux, &
+            bulk_density, soil_ph, drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, &
+            DOC_to_topsoil, DOC_to_subsoil)
+
+       !! 4.2 Output the respiration terms and the net primary
+       !!     production (NPP) that are calculated in STOMATE
+
+       ! 4.2.1 Output the 3 respiration terms
+       CALL xios_orchidee_send_field("maint_resp",resp_maint/dt_sechiba)
+       CALL xios_orchidee_send_field("hetero_resp",resp_hetero(:,:,icarbon)/dt_sechiba)
+       CALL xios_orchidee_send_field("growth_resp",resp_growth/dt_sechiba)
+       
+       CALL histwrite_p(hist_id, 'maint_resp', kjit, resp_maint, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'hetero_resp', kjit, resp_hetero(:,:,icarbon), kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'growth_resp', kjit, resp_growth, kjpindex*nvm, indexveg)
+       
+       ! 4.2.2 Compute the net primary production as the diff from
+       ! Gross primary productin and the growth and maintenance
+       ! respirations
+       npp(:,1)=zero
+       DO j = 2,nvm
+          npp(:,j) = gpp(:,j) - resp_growth(:,j) - resp_maint(:,j)
+       ENDDO
+       
+       CALL xios_orchidee_send_field("npp",npp/dt_sechiba)
+       
+       CALL histwrite_p(hist_id, 'npp', kjit, npp, kjpindex*nvm, indexveg)
+       
+
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'maint_resp', kjit, resp_maint, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'hetero_resp', kjit, resp_hetero(:,:,icarbon), kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'growth_resp', kjit, resp_growth, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'npp', kjit, npp, kjpindex*nvm, indexveg)
+       ENDIF
+     
+    ELSE
+       !! ok_stomate is not activated
+       !! Define the CO2 flux from the grid point to zero (no carbone cycle)
+       co2_flux(:,:) = zero
+    ENDIF
+
+ 
+    !! 5. Do daily processes if necessary
+    !!
+    IF ( do_slow ) THEN
+
+       !!  5.1 Calculate the LAI if STOMATE is not activated
+       IF ( .NOT. ok_stomate ) THEN
+          CALL slowproc_lai (kjpindex, lcanop,stempdiag, &
+               lalo,resolution,lai,month,day,laimap)
+          
+          frac_age(:,:,1) = un
+          frac_age(:,:,2) = zero
+          frac_age(:,:,3) = zero
+          frac_age(:,:,4) = zero
+       ENDIF
+
+       !! 5.2 Update veget
+       CALL slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile)
+
+       !! 5.3 updates qsintmax and other derived variables
+       IF ( .NOT. ok_stomate ) THEN
+          CALL slowproc_derivvar (kjpindex, veget, lai, &
+               qsintmax, deadleaf_cover, assim_param, height, temp_growth)
+       ELSE
+          qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
+          qsintmax(:,1) = zero
+       ENDIF
+    END IF
+
+    !! 6. Calculate tot_bare_soil needed in hydrol, diffuco and condveg
+    tot_bare_soil(:) = veget_max(:,1)
+    DO jv = 2, nvm
+       DO ji =1, kjpindex
+          tot_bare_soil(ji) = tot_bare_soil(ji) + (veget_max(ji,jv) - veget(ji,jv))
+       ENDDO
+    END DO
+    
+
+    !! 7. Do some basic tests on the surface fractions updated above, only if
+    !!    slowproc_veget has been done (do_slow). No change of the variables. 
+    IF (do_slow) THEN
+        CALL slowproc_checkveget(kjpindex, frac_nobio, veget_max, veget, tot_bare_soil, soiltile)
+    END IF  
+
+    !! 8. Write output fields
+    CALL xios_orchidee_send_field("tot_bare_soil",tot_bare_soil)
+    
+    IF ( .NOT. almaoutput) THEN
+       CALL histwrite_p(hist_id, 'tot_bare_soil', kjit, tot_bare_soil, kjpindex, IndexLand)
+    END IF
+
+
+    IF (printlev_loc>=3) WRITE (numout,*) ' slowproc_main done '
+
+  END SUBROUTINE slowproc_main
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: slowproc_finalize
+!!
+!>\BRIEF         Write to restart file variables for slowproc module and call finalization of stomate module
+!!
+!! DESCRIPTION : 
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_finalize (kjit,       kjpindex,  rest_id,  IndexLand,  &
+                                njsc,       lai,       height,   veget,      &
+                                frac_nobio, veget_max, reinf_slope,          &
+                                assim_param, frac_age, soiltile )
+
+!! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                           :: kjit           !! Time step number
+    INTEGER(i_std),INTENT(in)                            :: kjpindex       !! Domain size - terrestrial pixels only
+    INTEGER(i_std),INTENT (in)                           :: rest_id        !! Restart file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: IndexLand      !! Indices of the points on the land map
+    INTEGER(i_std), DIMENSION(kjpindex), INTENT(in)      :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: lai            !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: height         !! height of vegetation (m)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget          !! Fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio     !! Fraction of ice, lakes, cities etc. in the mesh
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget_max      !! Maximum fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)         :: reinf_slope    !! slope coef for reinfiltration
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2),INTENT (in):: assim_param   !! min+max+opt temperatures & vmax for photosynthesis (K, \mumol m^{-2} s^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT(in):: frac_age  !! Age efficacity from STOMATE for isoprene
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in)    :: soiltile       !! Fraction of soil tiles in the gridbox (unitless)
+!! 0.4 Local variables
+    REAL(r_std)                                          :: tmp_day(1)     !! temporary variable for I/O
+    INTEGER                                              :: jf,ier         !! Indice
+    CHARACTER(LEN=4)                                     :: laistring      !! Temporary character string
+    CHARACTER(LEN=80)                                    :: var_name       !! To store variables names for I/O
+!_ ================================================================================================================================
+
+    IF (printlev_loc>=3) WRITE (numout,*) 'Write restart file with SLOWPROC variables '
+
+    ! 2.1 Write a series of variables controled by slowproc: day
+    ! counter, vegetation fraction, max vegetation fraction, LAI
+    ! variable from stomate, fraction of bare soil, soiltype
+    ! fraction, clay fraction, height of vegetation, map of LAI
+    
+    CALL restput_p (rest_id, 'veget', nbp_glo, nvm, 1, kjit, veget, 'scatter',  nbp_glo, index_g)
+
+    CALL restput_p (rest_id, 'veget_max', nbp_glo, nvm, 1, kjit, veget_max, 'scatter',  nbp_glo, index_g)
+
+    CALL restput_p (rest_id, 'lai', nbp_glo, nvm, 1, kjit, lai, 'scatter',  nbp_glo, index_g)
+
+    CALL restput_p (rest_id, 'frac_nobio', nbp_glo, nnobio, 1, kjit, frac_nobio, 'scatter',  nbp_glo, index_g)
+
+
+    DO jf = 1, nleafages
+       ! variable name is somewhat complicated as ioipsl does not allow 3d variables for the moment...
+       WRITE(laistring,'(i4)') jf
+       laistring=ADJUSTL(laistring)
+       var_name='frac_age_'//laistring(1:LEN_TRIM(laistring))
+       CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, frac_age(:,:,jf), 'scatter',  nbp_glo, index_g)
+    ENDDO
+
+
+    CALL restput_p (rest_id, 'njsc', nbp_glo, 1, 1, kjit, REAL(njsc, r_std), 'scatter',  nbp_glo, index_g)
+    
+    IF ( hydrol_cwrr ) THEN
+       CALL restput_p (rest_id, 'reinf_slope', nbp_glo, 1, 1, kjit, reinf_slope, 'scatter',  nbp_glo, index_g)
+    END IF
+       
+    CALL restput_p (rest_id, 'clay_frac', nbp_glo, 1, 1, kjit, clayfraction, 'scatter',  nbp_glo, index_g)
+
+    CALL restput_p (rest_id, 'soil_ph', nbp_glo, 1, 1, kjit, soil_ph, 'scatter',  nbp_glo, index_g)
+
+    CALL restput_p (rest_id, 'bulk_dens', nbp_glo, 1, 1, kjit, bulk_density, 'scatter',  nbp_glo, index_g)
+    !
+    ! The height of the vegetation could in principle be recalculated at the beginning of the run.
+    ! However, this is very tedious, as many special cases have to be taken into account. This variable
+    ! is therefore saved in the restart file.
+    CALL restput_p (rest_id, 'height', nbp_glo, nvm, 1, kjit, height, 'scatter',  nbp_glo, index_g)
+
+    ! Allocation of next year vegetation fraction in case of land use change
+    ! Specific case where the LAI is read and not calculated by STOMATE: need to be saved
+    IF (read_lai) THEN     
+       CALL restput_p (rest_id, 'laimap', nbp_glo, nvm, 12, kjit, laimap)
+    ENDIF
+
+    ! Allocation of the fraction of non biospheric areas 
+    ! If there is some land use change, write the year for the land use ??? 
+    IF (map_pft_format) THEN
+       tmp_day(1) = REAL(veget_year,r_std)
+       IF (is_root_prc) CALL restput (rest_id, 'veget_year', 1 , 1  , 1, kjit, tmp_day)
+    ENDIF
+    
+    ! 2.2 Write restart variables managed by STOMATE
+    IF ( ok_stomate ) THEN
+       CALL stomate_finalize (kjit, kjpindex, indexLand, clayfraction, soil_ph, bulk_density, &
+                              soiltile, veget_max, assim_param) 
+    ENDIF
+    
+    ALLOCATE (frac_bare(kjpindex,nvm),STAT=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in frac_bare allocation. We stop. We need kjpindex*nvm words = ',kjpindex*nvm
+       STOP
+    END IF
+  END SUBROUTINE slowproc_finalize
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_init
+!!
+!>\BRIEF         Initialisation of all variables linked to SLOWPROC
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): The subroutine manages 
+!! diverses tasks:
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lcanop, ::veget_update, ::veget_year,
+!! ::lai, ::veget, ::frac_nobio, ::totfrac_nobio, ::veget_max, ::height, ::soiltype
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_init (kjit, date0, kjpindex, IndexLand, lalo, neighbours, resolution, contfrac, &
+       rest_id, lai, frac_age, veget, frac_nobio, totfrac_nobio, soiltile, reinf_slope, &
+       veget_max, tot_bare_soil, njsc, &
+       height, lcanop, veget_update, veget_year)
+    
+    !! INTERFACE DESCRIPTION
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT (in)                           :: kjit           !! Time step number
+    REAL(r_std), INTENT (in)                              :: date0          !! intial date of the simulation ???
+    INTEGER(i_std), INTENT (in)                           :: kjpindex       !! Domain size - Terrestrial pixels only 
+    INTEGER(i_std), INTENT (in)                           :: rest_id        !! Restart file identifier
+    
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: IndexLand      !! Indices of the land points on the map
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)       :: lalo           !! Geogr. coordinates (latitude,longitude) (degrees)
+    INTEGER(i_std), DIMENSION (kjpindex,8), INTENT(in)    :: neighbours     !! Vector of neighbours for each grid point 1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) 
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)       :: resolution     !! size in x and y of the grid (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: contfrac       !! Fraction of continent in the grid (unitless)
+    
+    !! 0.2 Output variables
+    INTEGER(i_std), INTENT(out)                           :: lcanop         !! Number of Canopy level used to compute LAI
+    INTEGER(i_std), INTENT(out)                           :: veget_update   !! update frequency in timesteps (years) for landuse
+    INTEGER(i_std), INTENT(out)                           :: veget_year     !! first year for landuse   (year or index ???)
+    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: lai            !! Leaf Area index (m^2 / m^2)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: veget          !! Fraction of vegetation type (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: frac_nobio     !! Fraction of ice,lakes,cities, ... (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: totfrac_nobio  !! Total fraction of ice+lakes+cities+... (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: veget_max      !! Max fraction of vegetation type (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: tot_bare_soil  !! Total evaporating bare soil fraction 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: height         !! Height of vegetation or surface in genral ??? (m)
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT (out):: frac_age !! Age efficacity from STOMATE for isoprene
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)   :: soiltile       !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)        :: reinf_slope    !! slope coef for reinfiltration
+    INTEGER(i_std), DIMENSION(kjpindex), INTENT(out)      :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    
+    !! 0.3 Local variables 
+    REAL(r_std)                                           :: tmp_day(1)        !! temporary variable 
+    REAL(r_std)                                           :: tmp_veget_year(1) !! temporary variable
+    REAL(r_std)                                           :: zcanop            !! ???? soil depth taken for canopy
+    INTEGER(i_std)                                        :: vtmp(1)           !! temporary variable
+    REAL(r_std), DIMENSION(nbdl)                          :: zsoil             !! soil depths at diagnostic levels
+    CHARACTER(LEN=4)                                      :: laistring         !! Temporary character string
+    INTEGER(i_std)                                        :: j,l, jf           !! Indices
+    CHARACTER(LEN=80)                                     :: var_name          !! To store variables names for I/O
+    INTEGER(i_std)                                        :: ji, jv, ier,jst   !! Indices 
+    LOGICAL                                               :: get_slope
+    REAL(r_std)                                           :: frac_nobio1       !! temporary variable for frac_nobio(see above)
+    REAL(r_std), DIMENSION(kjpindex)                      :: tmp_real
+    REAL(r_std), DIMENSION(kjpindex,nbdl)                 :: stempdiag2_bid    !! matrix to store stempdiag_bid
+    REAL(r_std), DIMENSION (kjpindex,nscm)                :: soilclass         !! Fractions of each soil textural class in the grid cell (0-1, unitless)
+    CHARACTER(LEN=4)                                      :: vegsoil_dist      !! Flag to choose the soil/vegetation distribution
+    CHARACTER(LEN=30), SAVE                               :: veget_str         !! update frequency for landuse
+    !$OMP THREADPRIVATE(veget_str)
+    REAL(r_std), DIMENSION(kjpindex)                      :: frac_crop_tot     !! Total fraction occupied by crops (0-1, unitless)
+    LOGICAL                                               :: found_restart     !! found_restart=true if all 3 variables veget_max, veget and 
+                                                                               !! frac_nobio are read from restart file
+    !_ ================================================================================================================================
+  
+    !! 0. Initialize local printlev
+    printlev_loc=get_printlev('slowproc')
+    IF (printlev_loc>=3) WRITE (numout,*) "In slowproc_init"
+    
+    
+    !! 1. Allocation 
+
+    ALLOCATE (clayfraction(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable clayfraction','','')
+    clayfraction(:)=undef_sechiba
+
+    ALLOCATE (bulk_density(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable bulk_density','','')
+    bulk_density(:)=undef_sechiba
+
+    ALLOCATE (soil_ph(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable soil_ph','','')
+    soil_ph(:)=undef_sechiba
+
+    ! Initialisation of the fraction of the different vegetation: Start with 100% of bare soil
+    ALLOCATE (soilclass_default(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable soilclass_default','','')
+    soilclass_default(:)=undef_sechiba
+
+    ! Allocation of last year vegetation fraction in case of land use change
+    ALLOCATE(veget_max_new(kjpindex, nvm), STAT=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable veget_max_new','','')
+
+    ! Allocation of the fraction of non biospheric areas 
+    ALLOCATE(frac_nobio_new(kjpindex, nnobio), STAT=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable frac_nobio_new','','')
+    
+    ! Allocate laimap
+    IF (read_lai)THEN
+       ALLOCATE (laimap(kjpindex,nvm,12),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable laimap','','')
+    ELSE
+       ALLOCATE (laimap(1,1,1), stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable laimap(1,1,1)','','')
+    ENDIF
+
+    !! 2. Read variables from restart file
+
+    found_restart=.TRUE.
+    var_name= 'veget'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Vegetation fraction')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., veget, "gather", nbp_glo, index_g)
+    IF ( ALL( veget(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
+
+    var_name= 'veget_max'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Maximum vegetation fraction')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., veget_max, "gather", nbp_glo, index_g)
+    IF ( ALL( veget_max(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
+
+    var_name= 'frac_nobio'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Special soil type fraction')
+    CALL restget_p (rest_id, var_name, nbp_glo, nnobio, 1, kjit, .TRUE., frac_nobio, "gather", nbp_glo, index_g)
+    IF ( ALL( frac_nobio(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
+
+    IF (map_pft_format) THEN
+       var_name= 'veget_year'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Last year get in Land Use file.')
+       IF (is_root_prc) THEN
+          CALL restget (rest_id, var_name, 1       , 1  , 1, kjit, .TRUE., tmp_veget_year)
+          !
+          IF (tmp_veget_year(1) == val_exp) THEN
+             veget_year=veget_year_orig
+          ELSE
+             IF (veget_reinit) THEN
+                veget_year=veget_year_orig
+             ELSE
+                veget_year=INT(tmp_veget_year(1))
+             ENDIF
+          ENDIF
+       ENDIF
+       CALL bcast(veget_year)
+
+       !
+       !Config Key   = VEGET_UPDATE
+       !Config Desc  = Update vegetation frequency
+       !Config If    = MAP_PFT_FORMAT
+       !Config Def   = 0Y
+       !Config Help  = The veget datas will be update each this time step.
+       !Config Units = [years]
+       !
+       veget_update=0
+       WRITE(veget_str,'(a)') '0Y'
+     !?? danger : VEGET_UPDATE now called VEGET_LENGTH in Thomas L. run.def ??!!  
+       CALL getin_p('VEGET_UPDATE', veget_str)
+       l=INDEX(TRIM(veget_str),'Y')
+       READ(veget_str(1:(l-1)),"(I2.2)") veget_update
+       WRITE(numout,*) "Update frequency for land use in years :",veget_update
+
+       ! Coherence test
+       IF (veget_update > 0 .AND. ok_dgvm .AND. .NOT. agriculture) THEN
+          CALL ipslerr_p(3,'slowproc_init',&
+               'The combination DGVM=TRUE, AGRICULTURE=FALSE and VEGET_UPDATE>0 is not possible', &
+               'Set VEGET_UPDATE=0Y in run.def','')
+       END IF
+    ELSE
+       ! map_pft_format=FALSE: there can not be any land use change. Set veget_update to 0.
+       veget_update=0
+    ENDIF
+
+    IF ( hydrol_cwrr ) THEN
+       var_name= 'reinf_slope'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Slope coef for reinfiltration')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., reinf_slope, "gather", nbp_glo, index_g)
+    END IF
+    
+    ! Below we define the soil texture of the grid-cells
+    var_name= 'njsc'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Index of soil type')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tmp_real, "gather", nbp_glo, index_g)
+    IF ( ALL( tmp_real(:) .EQ. val_exp) ) THEN
+       njsc (:) = undef_int
+    ELSE
+       njsc = NINT(tmp_real)
+    END IF
+    
+    var_name= 'clay_frac'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Fraction of clay in each mesh')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., clayfraction, "gather", nbp_glo, index_g)
+
+    var_name= 'bulk_dens'
+    CALL ioconf_setatt_p('UNITS', 'kg m-3')
+    CALL ioconf_setatt_p('LONG_NAME','soil bulk density in each mesh')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., bulk_density, "gather", nbp_glo, index_g)
+    !
+    var_name= 'soil_ph'
+    CALL ioconf_setatt_p('UNITS', 'pH units')
+    CALL ioconf_setatt_p('LONG_NAME','soil pH in each mesh')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., soil_ph, "gather", nbp_glo, index_g)
+    !
+    var_name= 'lai'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Leaf area index')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., lai, "gather", nbp_glo, index_g)
+
+    ! The height of the vegetation could in principle be recalculated at the beginning of the run.
+    ! However, this is very tedious, as many special cases have to be taken into account. This variable
+    ! is therefore saved in the restart file.
+    var_name= 'height'
+    CALL ioconf_setatt_p('UNITS', 'm')
+    CALL ioconf_setatt_p('LONG_NAME','Height of vegetation')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., height, "gather", nbp_glo, index_g)
+ 
+    IF (read_lai)THEN
+       var_name= 'laimap'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Leaf area index read')
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 12, kjit, .TRUE., laimap)
+    ENDIF
+
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Fraction of leaves in leaf age class ')
+    DO jf = 1, nleafages
+       ! variable name is somewhat complicated as ioipsl does not allow 3d variables for the moment...
+       WRITE(laistring,'(i4)') jf
+       laistring=ADJUSTL(laistring)
+       var_name='frac_age_'//laistring(1:LEN_TRIM(laistring))
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE.,frac_age(:,:,jf), "gather", nbp_glo, index_g)
+    ENDDO
+
+    !! 3. Some other initializations
+
+    !Config Key   = SECHIBA_ZCANOP
+    !Config Desc  = Soil level used for canopy development (if STOMATE disactivated)
+    !Config If    = OK_SECHIBA and .NOT. OK_STOMATE  
+    !Config Def   = 0.5
+    !Config Help  = The temperature at this soil depth is used to determine the LAI when
+    !Config         STOMATE is not activated.
+    !Config Units = [m]
+    zcanop = 0.5_r_std
+    CALL setvar_p (zcanop, val_exp, 'SECHIBA_ZCANOP', 0.5_r_std)
+
+    ! depth at center of the levels
+    zsoil(1) = diaglev(1) / 2.
+    DO l = 2, nbdl
+       zsoil(l) = ( diaglev(l) + diaglev(l-1) ) / 2.
+    ENDDO
+
+    ! index of this level
+    vtmp = MINLOC ( ABS ( zcanop - zsoil(:) ) )
+    lcanop = vtmp(1)
+
+    !
+    !  Interception reservoir coefficient
+    !
+    !Config Key   = SECHIBA_QSINT 
+    !Config Desc  = Interception reservoir coefficient
+    !Config If    = OK_SECHIBA 
+    !Config Def   = 0.1
+    !Config Help  = Transforms leaf area index into size of interception reservoir
+    !Config         for slowproc_derivvar or stomate
+    !Config Units = [m]
+    CALL getin_p('SECHIBA_QSINT', qsintcst)
+    WRITE(numout, *)' SECHIBA_QSINT, qsintcst = ', qsintcst
+
+    !
+    ! Time step of STOMATE and LAI update
+    !
+    !Config Key   = DT_STOMATE
+    !Config Desc  = Time step of STOMATE and other slow processes
+    !Config If    = OK_STOMATE
+    !Config Def   = one_day
+    !Config Help  = Time step (s) of regular update of vegetation
+    !Config         cover, LAI etc. This is also the time step
+    !Config         of STOMATE.
+    !Config Units = [seconds]
+
+    dt_stomate = one_day
+    CALL getin_p('DT_STOMATE', dt_stomate)
+
+
+
+    !! 4. Initialization of variables not found in restart file
+
+    IF ( impveg ) THEN
+
+       !! 4.1.a Case impveg=true: Initialization of variables by reading run.def
+       !!       The routine setvar_p will only initialize the variable if it was not found in restart file. 
+       !!       We are on a point and thus we can read the information from the run.def
+       
+       !Config Key   = SECHIBA_VEGMAX
+       !Config Desc  = Maximum vegetation distribution within the mesh (0-dim mode)
+       !Config If    = IMPOSE_VEG
+       !Config Def   = 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0
+       !Config Help  = The fraction of vegetation is read from the restart file. If
+       !Config         it is not found there we will use the values provided here.
+       !Config Units = [-]
+       CALL setvar_p (veget_max, val_exp, 'SECHIBA_VEGMAX', veget_ori_fixed_test_1)
+       IF (SUM(veget_ori_fixed_test_1) > un) THEN
+          CALL ipslerr_p (2,'slowproc_init', &
+             &     'The sum of the fractions of the array SECHIBA_VEGMAX is greater than 1.', &
+             &     'The sum should be equal to 1.', &
+             &     'Check your configuration file.')
+       ENDIF
+
+       !Config Key   = SECHIBA_FRAC_NOBIO
+       !Config Desc  = Fraction of other surface types within the mesh (0-dim mode)
+       !Config If    = IMPOSE_VEG
+       !Config Def   = 0.0
+       !Config Help  = The fraction of ice, lakes, etc. is read from the restart file. If
+       !Config         it is not found there we will use the values provided here.
+       !Config         For the moment, there is only ice.
+       !Config Units = [-]
+       frac_nobio1 = frac_nobio(1,1)
+       CALL setvar_p (frac_nobio1, val_exp, 'SECHIBA_FRAC_NOBIO', frac_nobio_fixed_test_1)
+       frac_nobio(:,:) = frac_nobio1
+
+       IF (.NOT. found_restart) THEN
+          ! Call slowproc_veget to correct veget_max and to calculate veget and soiltiles
+          CALL slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile)
+       END IF
+       
+       !Config Key   = SECHIBA_LAI
+       !Config Desc  = LAI for all vegetation types (0-dim mode)
+       !Config Def   = 0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2.
+       !Config If    = IMPOSE_VEG
+       !Config Help  = The maximum LAI used in the 0dim mode. The values should be found
+       !Config         in the restart file. The new values of LAI will be computed anyway
+       !Config         at the end of the current day. The need for this variable is caused
+       !Config         by the fact that the model may stop during a day and thus we have not
+       !Config         yet been through the routines which compute the new surface conditions.
+       !Config Units = [-]
+       CALL setvar_p (lai, val_exp, 'SECHIBA_LAI', llaimax)
+
+       IF (impsoilt) THEN
+
+          ! If njsc is not in restart file, then initialize soilclass from values 
+          ! from run.def file and recalculate njsc
+          IF ( ALL(njsc(:) .EQ. undef_int )) THEN
+             !Config Key   = SOIL_FRACTIONS
+             !Config Desc  = Fraction of the 3 soil types (0-dim mode)
+             !Config Def   = undef_sechiba
+             !Config If    = IMPOSE_VEG and IMPOSE_SOILT
+             !Config Help  = Determines the fraction for the 3 soil types
+             !Config         in the mesh in the following order : sand loam and clay.
+             !Config Units = [-]
+          
+             soilclass(1,:) = soilclass_default(:)
+             CALL getin_p('SOIL_FRACTIONS',soilclass(1,:))
+             ! Assign for each grid-cell the % of the different textural classes (up to 12 if 'usda')
+             DO ji=2,kjpindex
+                ! here we read, for the prescribed grid-cell, the % occupied by each of the soil texture classes 
+                soilclass(ji,:) = soilclass(1,:)
+             ENDDO
+
+             ! Simplify an heterogeneous grid-cell into an homogeneous one with the dominant texture
+             njsc(:) = 0
+             DO ji = 1, kjpindex
+                ! here we reduce to the dominant texture class
+                njsc(ji) = MAXLOC(soilclass(ji,:),1)
+             ENDDO
+          END IF
+
+          !Config Key   = CLAY_FRACTION
+          !Config Desc  = Fraction of the clay fraction (0-dim mode)
+          !Config Def   = 0.2
+          !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+          !Config Help  = Determines the fraction of clay in the grid box.
+          !Config Units = [-] 
+          
+          ! If clayfraction was not in restart file it will be read fro run.def file instead of deduced 
+          ! based on fractions of each textural class
+          CALL setvar_p (clayfraction, val_exp, 'CLAY_FRACTION', clayfraction_default)
+
+
+          !Config Key   = SOIL_PH
+          !Config Desc  = pH of the soil (0-dim mode)
+          !Config Def   = 7.0
+          !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+          !Config Help  = Determines the soil pH in the grid box.
+          !Config Units = [pH units] 
+          !
+          CALL setvar_p (soil_ph, val_exp, 'soil_ph', soil_ph_default)
+
+          !
+          !Config Key   = BULK_DENSITY
+          !Config Desc  = value of the soil bulk density 
+          !Config if    = IMPOSE_VEG and IMPOSE_SOIL
+          !Config Def   = 1.65
+          !Config Help  =
+          CALL setvar_p (bulk_density, val_exp, 'BULK_DENSITY', bulk_density_default)
+
+       ELSE
+
+          IF ( MINVAL(clayfraction) .EQ. MAXVAL(clayfraction) .AND. MAXVAL(clayfraction) .EQ. val_exp .OR. &
+               MINVAL(soil_ph) .EQ. MAXVAL(soil_ph) .AND. MAXVAL(soil_ph) .EQ. val_exp .OR. &
+               MINVAL(njsc) .EQ. MAXVAL(njsc) .AND. MAXVAL(njsc) .EQ. undef_int ) THEN
+             
+             CALL slowproc_soilt(kjpindex, lalo, neighbours, resolution, contfrac, soilclass, clayfraction, bulk_density, soil_ph)
+             njsc(:) = 0
+             DO ji = 1, kjpindex
+                njsc(ji) = MAXLOC(soilclass(ji,:),1)
+             ENDDO
+          ENDIF
+       ENDIF
+
+       !Config Key   = REINF_SLOPE
+       !Config Desc  = Slope coef for reinfiltration 
+       !Config Def   = 0.1
+       !Config If    = IMPOSE_VEG
+       !Config Help  = Determines the reinfiltration ratio in the grid box due to flat areas
+       !Config Units = [-]
+       !
+       slope_default=0.1
+       CALL setvar_p (reinf_slope, val_exp, 'SLOPE', slope_default)
+
+       !Config Key   = SLOWPROC_HEIGHT
+       !Config Desc  = Height for all vegetation types 
+       !Config Def   = 0., 30., 30., 20., 20., 20., 15., 15., 15., .5, .6, 1.0, 1.0
+       !Config If    = OK_SECHIBA
+       !Config Help  = The height used in the 0dim mode. The values should be found
+       !Config         in the restart file. The new values of height will be computed anyway
+       !Config         at the end of the current day. The need for this variable is caused
+       !Config         by the fact that the model may stop during a day and thus we have not
+       !Config         yet been through the routines which compute the new surface conditions.
+       !Config Units = [m]
+       CALL setvar_p (height, val_exp, 'SLOWPROC_HEIGHT', height_presc)
+
+
+    ELSE IF ( .NOT. found_restart ) THEN
+
+       !! 4.1.b Case impveg=false and no restart files: Initialization by reading vegetation map
+       
+       ! Initialize veget_max and frac_nobio
+       IF ( map_pft_format ) THEN
+          ! Case without restart file and map_pft_format=true
+          IF (printlev_loc>=3) WRITE(numout,*) 'Before call slowproc_readvegetmax in initialization phase without restart files'
+          IF (printlev_loc>=3) WRITE(numout,*) 'veget_year=', veget_year
+          
+          ! Call the routine to read the vegetation from file (output is veget_max_new)
+          CALL slowproc_readvegetmax(kjpindex, lalo, neighbours, resolution, contfrac, &
+               veget_max, veget_max_new, frac_nobio_new, veget_year, .TRUE.)
+          IF (printlev_loc>=4) WRITE (numout,*) 'After slowproc_readvegetmax in initialization phase'
+          
+          ! Update vegetation with values read from the file
+          veget_max           = veget_max_new
+          frac_nobio          = frac_nobio_new          
+       ELSE
+          ! map_pft_format=FALSE: Read and interpolate Olson type map
+          CALL slowproc_interpol(kjpindex, lalo, neighbours, resolution, contfrac, veget_max, frac_nobio)
+       END IF
+       
+       !! Reset totaly or partialy veget_max if using DGVM
+       IF ( ok_dgvm  ) THEN
+          ! If we are dealing with dynamic vegetation then all natural PFTs should be set to veget_max = 0
+          ! In case no agriculture is desired, agriculture PFTS should be set to 0 as well
+          IF (agriculture) THEN
+             DO jv = 2, nvm
+                IF (natural(jv)) THEN 
+                   veget_max(:,jv)=zero
+                ENDIF
+             ENDDO
+             
+             ! Calculate the fraction of crop for each point.
+             ! Sum only on the indexes corresponding to the non_natural pfts
+             frac_crop_tot(:) = zero
+             DO jv = 2, nvm
+                IF(.NOT. natural(jv)) THEN
+                   DO ji = 1, kjpindex
+                      frac_crop_tot(ji) = frac_crop_tot(ji) + veget_max(ji,jv)
+                   ENDDO
+                ENDIF
+             END DO
+             
+             ! Calculate the fraction of bare soil
+             DO ji = 1, kjpindex
+                veget_max(ji,1) = un - frac_crop_tot(ji) - SUM(frac_nobio(ji,:))   
+             ENDDO
+          ELSE
+             veget_max(:,:) = zero
+             DO ji = 1, kjpindex
+                veget_max(ji,1) = un  - SUM(frac_nobio(ji,:))
+             ENDDO
+          END IF
+       END IF   ! end ok_dgvm
+       
+
+       ! Call slowproc_veget to correct veget_max and to calculate veget and soiltiles
+       CALL slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile)
+       
+    END IF ! end impveg
+
+    !! 4.2 Continue initializing variables not found in restart file. Case for both impveg=true and false.
+
+    ! Initialize laimap for the case read_lai if not found in restart file
+    IF (read_lai) THEN
+       IF ( ALL( laimap(:,:,:) .EQ. val_exp) ) THEN
+          ! Interpolation of LAI
+          CALL slowproc_interlai (kjpindex, lalo, resolution,  neighbours, contfrac, laimap)
+       ENDIF
+    ENDIF
+    
+    ! Initialize lai if not found in restart file and not already initialized using impveg
+    IF ( MINVAL(lai) .EQ. MAXVAL(lai) .AND. MAXVAL(lai) .EQ. val_exp) THEN
+       IF (read_lai) THEN
+          stempdiag2_bid(1:kjpindex,1:nbdl) = stempdiag_bid
+          CALL slowproc_lai (kjpindex, lcanop, stempdiag2_bid, &
+               lalo,resolution,lai,month,day,laimap)
+       ELSE
+          ! If we start from scratch, we set lai to zero for consistency with stomate
+          lai(:,:) = zero
+       ENDIF
+       
+       frac_age(:,:,1) = un
+       frac_age(:,:,2) = zero
+       frac_age(:,:,3) = zero
+       frac_age(:,:,4) = zero
+    ENDIF
+    
+    ! Initialize heigth if not found in restart file and not already initialized using impveg
+    IF ( MINVAL(height) .EQ. MAXVAL(height) .AND. MAXVAL(height) .EQ. val_exp) THEN
+       ! Impose height
+       DO jv = 1, nvm
+          height(:,jv) = height_presc(jv)
+       ENDDO
+    ENDIF
+    
+    ! Initialize clayfraction and njsc if not found in restart file and not already initialized using impveg
+    IF ( MINVAL(clayfraction) .EQ. MAXVAL(clayfraction) .AND. MAXVAL(clayfraction) .EQ. val_exp .OR. &
+         MINVAL(bulk_density) .EQ. MAXVAL(bulk_density) .AND. MAXVAL(bulk_density) .EQ. val_exp .OR. &
+         MINVAL(soil_ph) .EQ. MAXVAL(soil_ph) .AND. MAXVAL(soil_ph) .EQ. val_exp .OR. &
+         MINVAL(njsc) .EQ. MAXVAL(njsc) .AND. MAXVAL(njsc) .EQ. undef_int ) THEN
+       
+       IF (printlev_loc>=4) WRITE (numout,*) 'clayfraction or njcs were not in restart file, call slowproc_soilt'
+       CALL slowproc_soilt(kjpindex, lalo, neighbours, resolution, contfrac, soilclass, clayfraction, bulk_density, soil_ph)
+       IF (printlev_loc>=4) WRITE (numout,*) 'After slowproc_soilt'
+       
+       njsc(:) = 0
+       DO ji = 1, kjpindex
+          njsc(ji) = MAXLOC(soilclass(ji,:),1)
+       ENDDO
+    ENDIF
+
+    !Config Key   = GET_SLOPE
+    !Config Desc  = Read slopes from file and do the interpolation
+    !Config Def   = n
+    !Config If    =
+    !Config Help  = Needed for reading the slopesfile and doing the interpolation. This will be
+    !               used by the re-infiltration parametrization
+    !Config Units = [FLAG]
+    get_slope = .FALSE.
+    CALL getin_p('GET_SLOPE',get_slope)
+    
+    IF ( hydrol_cwrr ) THEN
+       IF ( MINVAL(reinf_slope) .EQ. MAXVAL(reinf_slope) .AND. MAXVAL(reinf_slope) .EQ. val_exp .OR. get_slope) THEN
+          IF (printlev_loc>=4) WRITE (numout,*) 'reinf_slope was not in restart file. Now call slowproc_slope'
+          
+          CALL slowproc_slope(kjpindex, lalo, neighbours, resolution, contfrac, reinf_slope)
+          IF (printlev_loc>=4) WRITE (numout,*) 'After slowproc_slope'
+          
+       ENDIF
+    END IF
+
+    
+    !! 5. Some calculations always done, with and without restart files
+       
+    ! The variables veget, veget_max and frac_nobio were all read from restart file or initialized above.
+    ! Calculate now totfrac_nobio and soiltiles using these variables.
+    
+    ! Calculate totfrac_nobio
+    totfrac_nobio(:) = zero
+    DO jv = 1, nnobio
+       totfrac_nobio(:) = totfrac_nobio(:) + frac_nobio(:,jv)
+    ENDDO
+    
+    ! Calculate soiltile. This variable do not need to be in the restart file.
+    soiltile(:,:) = zero
+    soiltile(:,1) = totfrac_nobio(:)
+    DO jv = 1, nvm
+       jst = pref_soil_veg(jv)
+       DO ji = 1, kjpindex
+          soiltile(ji,jst) = soiltile(ji,jst) + veget_max(ji,jv)
+       ENDDO
+    ENDDO
+    
+    ! Always calculate tot_bare_soil
+    tot_bare_soil(:) = veget_max(:,1)
+    DO jv = 2, nvm
+       DO ji =1, kjpindex
+          tot_bare_soil(ji) = tot_bare_soil(ji) + (veget_max(ji,jv) - veget(ji,jv))
+       ENDDO
+    END DO
+    
+    IF (printlev_loc>=3) WRITE (numout,*) ' slowproc_init done '
+    
+  END SUBROUTINE slowproc_init
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_clear
+!!
+!>\BRIEF          Clear all variables related to slowproc and stomate modules  
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_clear 
+
+  ! 1 clear all the variables defined as common for the routines in slowproc 
+
+    
+    IF (ALLOCATED (clayfraction)) DEALLOCATE (clayfraction)
+    IF (ALLOCATED (bulk_density)) DEALLOCATE (bulk_density)
+    IF (ALLOCATED (soil_ph)) DEALLOCATE (soil_ph)
+    IF (ALLOCATED (laimap)) DEALLOCATE (laimap)
+    IF (ALLOCATED (veget_max_new)) DEALLOCATE (veget_max_new)
+    IF (ALLOCATED (frac_nobio_new)) DEALLOCATE (frac_nobio_new)
+    IF ( ALLOCATED (soilclass_default)) DEALLOCATE (soilclass_default)
+
+ ! 2. Clear all the variables in stomate 
+
+    IF ( ALLOCATED (soilclass_default)) DEALLOCATE (soilclass_default)
+    IF (ALLOCATED  (frac_bare)) DEALLOCATE (frac_bare)
+    !
+
+ ! 2. Clear all the variables in stomate 
+
+    CALL stomate_clear 
+    !
+  END SUBROUTINE slowproc_clear
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_derivvar
+!!
+!>\BRIEF         Initializes variables related to the
+!! parameters to be assimilated, the maximum water on vegetation, the vegetation height, 
+!! and the fraction of soil covered by dead leaves and the vegetation height 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags):
+!! (1) Initialization of the variables relevant for the assimilation parameters  
+!! (2) Intialization of the fraction of soil covered by dead leaves
+!! (3) Initialization of the Vegetation height per PFT
+!! (3) Initialization the maximum water on vegetation for interception with a particular treatement of the PFT no.1
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::qsintmax, ::deadleaf_cover, ::assim_param, ::height  
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_derivvar (kjpindex, veget, lai, &
+       qsintmax, deadleaf_cover, assim_param, height, temp_growth)
+
+    !! INTERFACE DESCRIPTION
+
+    !! 0.1 Input scalar and fields 
+    INTEGER(i_std), INTENT (in)                                :: kjpindex       !! Domain size - terrestrial pixels only
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)          :: veget          !! Fraction of pixel covered by PFT. Fraction accounts for none-biological land covers (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)          :: lai            !! PFT leaf area index (m^{2} m^{-2})
+
+    !! 0.2. Output scalar and fields 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)          :: qsintmax       !! Maximum water on vegetation for interception(mm)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)              :: deadleaf_cover !! fraction of soil covered by dead leaves (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm,npco2), INTENT (out)   :: assim_param    !! min+max+opt temperatures & vmax for photosynthesis (K, \mumol m^{-2} s^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)          :: height         !! height of the vegetation or surface in general ??? (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)              :: temp_growth    !! growth temperature (°C)  
+    !
+    !! 0.3 Local declaration
+    INTEGER(i_std)                                              :: ji, jv         !! Local indices
+!_ ================================================================================================================================
+
+    !
+    ! 1. Initialize (why here ??) the variables revelant for the assimilation parameters
+    !
+    DO jv = 1, nvm
+       assim_param(:,jv,ivcmax) = vcmax_fix(jv)
+    ENDDO
+
+    !
+    ! 2. Intialize the fraction of soil covered by dead leaves 
+    !
+    deadleaf_cover(:) = zero
+
+    !
+    ! 3. Initialize the Vegetation height per PFT
+    !
+    DO jv = 1, nvm
+       height(:,jv) = height_presc(jv)
+    ENDDO
+    !
+    ! 4. Initialize the maximum water on vegetation for interception
+    !
+    qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
+
+    ! Added by Nathalie - July 2006
+    !  Initialize the case of the PFT no.1 to zero 
+    qsintmax(:,1) = zero
+
+    temp_growth(:)=25.
+
+  END SUBROUTINE slowproc_derivvar
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_mean
+!!
+!>\BRIEF          Accumulates field_in over a period of dt_tot.
+!! Has to be called at every time step (dt). 
+!! Mean value is calculated if ldmean=.TRUE.
+!! field_mean must be initialized outside of this routine! 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!! (1) AcumAcuumlm 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::field_main
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_mean (npts, n_dim2, dt_tot, dt, ldmean, field_in, field_mean)
+
+    !
+    !! 0 declarations
+
+    !! 0.1 input scalar and variables 
+    INTEGER(i_std), INTENT(in)                           :: npts     !! Domain size- terrestrial pixels only 
+    INTEGER(i_std), INTENT(in)                           :: n_dim2   !! Number of PFTs 
+    REAL(r_std), INTENT(in)                              :: dt_tot   !! Time step of stomate (in days). The period over which the accumulation or the mean is computed 
+    REAL(r_std), INTENT(in)                              :: dt       !! Time step in days 
+    LOGICAL, INTENT(in)                                  :: ldmean   !! Flag to calculate the mean after the accumulation ???
+    REAL(r_std), DIMENSION(npts,n_dim2), INTENT(in)      :: field_in !! Daily field 
+
+    !! 0.3 Modified field; The computed sum or mean field over dt_tot time period depending on the flag ldmean 
+    REAL(r_std), DIMENSION(npts,n_dim2), INTENT(inout)   :: field_mean !! Accumulated field at dt_tot time period or mean field over dt_tot 
+ 
+
+!_ ================================================================================================================================
+
+    !
+    ! 1. Accumulation the field over dt_tot period 
+    !
+    field_mean(:,:) = field_mean(:,:) + field_in(:,:) * dt
+
+    !
+    ! 2. If the flag ldmean set, the mean field is computed over dt_tot period  
+    !
+    IF (ldmean) THEN
+       field_mean(:,:) = field_mean(:,:) / dt_tot
+    ENDIF
+
+  END SUBROUTINE slowproc_mean
+
+
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_long
+!!
+!>\BRIEF        Calculates a temporally smoothed field (field_long) from
+!! instantaneous input fields.Time constant tau determines the strength of the smoothing.
+!! For tau -> infinity??, field_long becomes the true mean value of field_inst
+!! (but  the spinup becomes infinietly long, too).
+!! field_long must be initialized outside of this routine! 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!! (1) Testing the time coherence betwen the time step dt and the time tau over which
+!! the rescaled of the mean is performed   
+!!  (2) Computing the rescaled mean over tau period 
+!! MAIN OUTPUT VARIABLE(S): field_long  
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::field_long
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_long (npts, n_dim2, dt, tau, field_inst, field_long)
+
+    !
+    ! 0 declarations
+    !
+
+    ! 0.1 input scalar and fields 
+
+    INTEGER(i_std), INTENT(in)                                 :: npts        !! Domain size- terrestrial pixels only
+    INTEGER(i_std), INTENT(in)                                 :: n_dim2      !! Second dimension of the fields, which represents the number of PFTs
+    REAL(r_std), INTENT(in)                                    :: dt          !! Time step in days   
+    REAL(r_std), INTENT(in)                                    :: tau         !! Integration time constant (has to have same unit as dt!)  
+    REAL(r_std), DIMENSION(npts,n_dim2), INTENT(in)            :: field_inst  !! Instantaneous field 
+
+
+    ! 0.2 modified field
+
+    ! Long-term field
+    REAL(r_std), DIMENSION(npts,n_dim2), INTENT(inout)         :: field_long  !! Mean value of the instantaneous field rescaled at tau time period 
+
+!_ ================================================================================================================================
+
+    !
+    ! 1 test coherence of the time 
+
+    IF ( ( tau .LT. dt ) .OR. ( dt .LE. zero ) .OR. ( tau .LE. zero ) ) THEN
+       WRITE(numout,*) 'slowproc_long: Problem with time steps'
+       WRITE(numout,*) 'dt=',dt
+       WRITE(numout,*) 'tau=',tau
+    ENDIF
+
+    !
+    ! 2 integration of the field over tau 
+
+    field_long(:,:) = ( field_inst(:,:)*dt + field_long(:,:)*(tau-dt) ) / tau
+
+  END SUBROUTINE slowproc_long
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_veget
+!!
+!>\BRIEF        Set small fractions to zero and normalize to keep the sum equal 1. Calucate veget and soiltile.
+!!
+!! DESCRIPTION  : Set small fractions to zero and normalize to keep the sum equal 1. Calucate veget and soiltile.
+!! (1) Set veget_max and frac_nobio for fraction smaller than min_vegfrac.
+!! (2) Reset some variables in stomate for small fractions
+!! (3) Calculate veget
+!! (5) Calculate totfrac_nobio
+!! (6) Calculate soiltile
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: frac_nobio, totfrac_nobio, veget_max, veget, soiltile
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile)
+    !
+    ! 0. Declarations
+    !
+    ! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                             :: kjpindex    !! Domain size - terrestrial pixels only
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)       :: lai         !! PFT leaf area index (m^{2} m^{-2})
+
+    ! 0.2 Modified variables 
+    REAL(r_std), DIMENSION(kjpindex,nnobio), INTENT(inout) :: frac_nobio  !! Fraction of the mesh which is covered by ice, lakes, ...
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout)    :: veget_max   !! Maximum fraction of vegetation type including none biological fraction (unitless)
+
+    ! 0.3 Output variables 
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)      :: veget       !! Fraction of pixel covered by PFT. Fraction accounts for none-biological land covers (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)         :: totfrac_nobio
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)    :: soiltile     !! Fraction of each soil tile (0-1, unitless)
+
+    ! 0.4 Local scalar and varaiables 
+    INTEGER(i_std)                                         :: ji, jv, jst !! indices 
+    REAL(r_std)                                            :: SUMveg      
+
+!_ ================================================================================================================================
+    IF (printlev_loc > 8) WRITE(numout,*) 'Entering slowproc_veget'
+
+    !! 1. Set to zero fractions of frac_nobio and veget_max smaller than min_vegfrac
+    !!    Normalize to have the sum equal 1.
+    DO ji = 1, kjpindex
+       IF ( SUM(frac_nobio(ji,:)) .LT. min_vegfrac ) THEN
+          frac_nobio(ji,:) = zero
+       ENDIF
+    
+       IF (.NOT. ok_dgvm) THEN
+          DO jv = 1, nvm
+             IF ( veget_max(ji,jv) .LT. min_vegfrac ) THEN
+                veget_max(ji,jv) = zero
+             ENDIF
+          ENDDO
+       END IF
+ 
+       !! Normalize to keep the sum equal 1.
+       SUMveg = SUM(frac_nobio(ji,:))+SUM(veget_max(ji,:))
+       frac_nobio(ji,:) = frac_nobio(ji,:)/SUMveg
+       veget_max(ji,:) = veget_max(ji,:)/SUMveg
+    ENDDO
+
+
+    !! 2. Calculate veget
+    !!    If lai of a vegetation type (jv > 1) is small, increase soil part
+    !!    stomate-like calculation
+    DO ji = 1, kjpindex
+       veget(ji,1)=veget_max(ji,1)
+       DO jv = 2, nvm
+          veget(ji,jv) = veget_max(ji,jv) * ( un - exp( - lai(ji,jv) * ext_coeff(jv) ) )
+       ENDDO
+    ENDDO
+
+
+    !! 3. Calculate totfrac_nobio
+    totfrac_nobio(:) = zero
+    DO jv = 1, nnobio
+       totfrac_nobio(:) = totfrac_nobio(:) + frac_nobio(:,jv)
+    ENDDO
+    
+
+    !! 4. Calculate soiltiles
+    !! Soiltiles are only used in hydrol, but we fix them in here because some time it might depend
+    !! on a changing vegetation (but then some adaptation should be made to hydrol) and be also used
+    !! in the other modules to perform separated energy balances
+    soiltile(:,:) = zero
+    soiltile(:,1) = totfrac_nobio(:)
+    DO jv = 1, nvm
+       jst = pref_soil_veg(jv)
+       DO ji = 1, kjpindex
+          soiltile(ji,jst) = soiltile(ji,jst) + veget_max(ji,jv)
+       ENDDO
+    ENDDO
+    
+  END SUBROUTINE slowproc_veget
+ 
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_lai
+!!
+!>\BRIEF        Do the interpolation of lai for the PFTs in case the laimap is not read   
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!! (1) Interplation by using the mean value of laimin and laimax for the PFTs    
+!! (2) Interpolation between laimax and laimin values by using the temporal
+!!  variations 
+!! (3) If problem occurs during the interpolation, the routine stops 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lai
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_lai (kjpindex,lcanop,stempdiag,lalo,resolution,lai,mm,dd,laimap)
+    !
+    ! 0. Declarations
+    !
+    !! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                          :: kjpindex   !! Domain size - terrestrial pixels only
+    INTEGER(i_std), INTENT(in)                          :: lcanop     !! soil level used for LAI
+    INTEGER(i_std), INTENT(in)                          :: mm, dd     !! Number of the month in the year and number of day of the month 
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)  :: stempdiag  !! Soil temperature (K) ???
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)     :: lalo       !! Geogr. coordinates (latitude,longitude) (degrees)
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)     :: resolution !! Size in x an y of the grid (m) - surface area of the gridbox
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: laimap     !! map of lai read 
+
+    !! 0.2 Output
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)   :: lai        !! PFT leaf area index (m^{2} m^{-2})LAI
+
+    !! 0.4 Local
+    INTEGER(i_std)                                      :: ji,jv      !! Local indices 
+!_ ================================================================================================================================
+
+    !
+    IF  ( .NOT. read_lai ) THEN
+    
+       lai(: ,1) = zero
+       ! On boucle sur 2,nvm au lieu de 1,nvm
+       DO jv = 2,nvm
+          SELECT CASE (type_of_lai(jv))
+             
+          CASE ("mean ")
+             !
+             ! 1. do the interpolation between laimax and laimin
+             !
+             lai(:,jv) = undemi * (llaimax(jv) + llaimin(jv))
+             !
+          CASE ("inter")
+             !
+             ! 2. do the interpolation between laimax and laimin
+             !
+             DO ji = 1,kjpindex
+                lai(ji,jv) = llaimin(jv) + tempfunc(stempdiag(ji,lcanop)) * (llaimax(jv) - llaimin(jv))
+             ENDDO
+             !
+          CASE default
+             !
+             ! 3. Problem
+             !
+             WRITE (numout,*) 'This kind of lai choice is not possible. '// &
+                  ' We stop with type_of_lai ',jv,' = ', type_of_lai(jv) 
+             CALL ipslerr_p(3,'slowproc_lai','Bad value for type_of_lai','read_lai=false','')
+          END SELECT
+          
+       ENDDO
+       !
+    ELSE
+       lai(: ,1) = zero
+       ! On boucle sur 2,nvm au lieu de 1,nvm
+       DO jv = 2,nvm
+
+          SELECT CASE (type_of_lai(jv))
+             
+          CASE ("mean ")
+             !
+             ! 1. force MAXVAL of laimap on lai on this PFT
+             !
+             DO ji = 1,kjpindex
+                lai(ji,jv) = MAXVAL(laimap(ji,jv,:))
+             ENDDO
+             !
+          CASE ("inter")
+             !
+             ! 2. do the interpolation between laimax and laimin
+             !
+             !
+             ! If January
+             !
+             IF (mm .EQ. 1 ) THEN
+                IF (dd .LE. 15) THEN
+                   lai(:,jv) = laimap(:,jv,12)*(1-(dd+15)/30.) + laimap(:,jv,1)*((dd+15)/30.)
+                ELSE
+                   lai(:,jv) = laimap(:,jv,1)*(1-(dd-15)/30.) + laimap(:,jv,2)*((dd-15)/30.)
+                ENDIF
+                !
+                ! If December
+                !
+             ELSE IF (mm .EQ. 12) THEN
+                IF (dd .LE. 15) THEN
+                   lai(:,jv) = laimap(:,jv,11)*(1-(dd+15)/30.) + laimap(:,jv,12)*((dd+15)/30.)
+                ELSE
+                   lai(:,jv) = laimap(:,jv,12)*(1-(dd-15)/30.) + laimap(:,jv,1)*((dd-15)/30.)
+                ENDIF
+          !
+          ! ELSE
+          !
+             ELSE
+                IF (dd .LE. 15) THEN
+                   lai(:,jv) = laimap(:,jv,mm-1)*(1-(dd+15)/30.) + laimap(:,jv,mm)*((dd+15)/30.)
+                ELSE
+                   lai(:,jv) = laimap(:,jv,mm)*(1-(dd-15)/30.) + laimap(:,jv,mm+1)*((dd-15)/30.)
+                ENDIF
+             ENDIF
+             !
+          CASE default
+             !
+             ! 3. Problem
+             !
+             WRITE (numout,*) 'This kind of lai choice is not possible. '// &
+                  ' We stop with type_of_lai ',jv,' = ', type_of_lai(jv) 
+             CALL ipslerr_p(3,'slowproc_lai','Bad value for type_of_lai','read_lai=true','')
+          END SELECT
+          
+       ENDDO
+    ENDIF
+
+  END SUBROUTINE slowproc_lai
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_interlai
+!!
+!>\BRIEF         Interpolate the LAI map to the grid of the model 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::laimap
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_interlai(nbpt, lalo,  resolution, neighbours, contfrac, laimap)
+    !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)          :: nbpt                  !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)             :: lalo(nbpt,2)          !! Vector of latitude and longitudes 
+                                                                 !! (beware of the order = 1 : latitude, 2 : longitude)
+    REAL(r_std), INTENT(in)             :: resolution(nbpt,2)    !! The size in km of each grid-box in X and Y
+    !
+    INTEGER(i_std), INTENT(in)         :: neighbours(nbpt,8)     !! Vector of neighbours for each grid point 1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) 
+                            
+    REAL(r_std), INTENT(in)             :: contfrac(nbpt)        !! Fraction of land in each grid box.
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)    ::  laimap(nbpt,nvm,12)          !! lai read variable and re-dimensioned
+    !
+    !  0.3 LOCAL
+    !
+    !
+    CHARACTER(LEN=80) :: filename                               !! name of the LAI map read
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lat_lu, lon_lu    !! latitude and
+                                                                !! longitude, extract from LAI map
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat, lon        !! en 2D ???
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area     !! the area of the fine grid in the model grid ???
+                                                                !! cf src_global/interpol_help.f90, line 377, called "areaoverlap"
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index !! the indexes from the grid boxes from the data that go into the 
+                                                                !! model's boxes  
+                                                                !! cf src_global/interpol_help.f90,line 300, called "ip"
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: laimap_lu   !! value in LAIMAP
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: resol_lu
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    !
+    REAL(r_std) :: coslat, lmax, lmin, ldelta
+    INTEGER(i_std) :: nix, njx
+    REAL(r_std) :: totarea
+    INTEGER(i_std) :: idi, nbvmax                               !! nbvmax : number of maximum vegetation map
+                                                                !! points in the GCM grid ; idi : its counter
+    CHARACTER(LEN=30) :: callsign                               !! Allows to specify which variable is beeing treated
+    !
+    LOGICAL ::           renormelize_lai  ! flag to force LAI renormelization
+    LOGICAL ::           ok_interpol                            !! optionnal return of aggregate_2d
+    !
+    INTEGER                  :: ALLOC_ERR 
+!_ ================================================================================================================================
+    !
+    !Config Key   = LAI_FILE
+    !Config Desc  = Name of file from which the vegetation map is to be read
+    !Config If    = LAI_MAP
+    !Config Def   = lai2D.nc
+    !Config Help  = The name of the file to be opened to read the LAI
+    !Config         map is to be given here. Usualy SECHIBA runs with a 5kmx5km
+    !Config         map which is derived from a Nicolas VIOVY one. 
+    !Config Units = [FILE]
+    !
+    filename = 'lai2D.nc'
+    CALL getin_p('LAI_FILE',filename)
+    !
+    !
+    !Config Key   = RENORM_LAI
+    !Config Desc  = flag to force LAI renormelization
+    !Config If    = LAI_MAP
+    !Config Def   = n
+    !Config Help  = If true, the laimap will be renormalize between llaimin and llaimax parameters.
+    !Config Units = [FLAG]
+    !
+    renormelize_lai = .FALSE.
+    CALL getin_p('RENORM_LAI',renormelize_lai)
+
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+
+    ALLOCATE(lon_lu(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable lon_lu','','')
+
+    ALLOCATE(lat_lu(jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable lat_lu','','')
+
+    ALLOCATE(laimap_lu(iml,jml,nvm,tml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable laimap_lu','','')
+
+    ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable resol_lu','','')
+
+    IF (is_root_prc) THEN
+       CALL flinget(fid, 'longitude', iml, 0, 0, 0, 1, 1, lon_lu)
+       CALL flinget(fid, 'latitude', jml, 0, 0, 0, 1, 1, lat_lu)
+       CALL flinget(fid, 'LAI', iml, jml, nvm, tml, 1, 12, laimap_lu)
+       !
+       WHERE (laimap_lu(:,:,:,:) < zero )
+          laimap_lu(:,:,:,:) = zero
+       ENDWHERE
+       !
+       CALL flinclo(fid)
+    ENDIF
+    CALL bcast(lon_lu)
+    CALL bcast(lat_lu)
+    CALL bcast(laimap_lu)
+
+    ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable lon','','')
+
+    ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable lat','','')
+
+    DO ip=1,iml
+       lat(ip,:) = lat_lu(:)
+    ENDDO
+    DO jp=1,jml
+       lon(:,jp) = lon_lu(:)
+    ENDDO
+
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable mask','','')
+    
+    ! Consider all points a priori
+    !
+    mask(:,:) = 0
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          ! Exclude the points where there is never a LAI value. It is probably 
+          ! an ocean point.
+          !
+          IF ( ANY(laimap_lu(ip,jp,:,:) < 20.) ) THEN
+             mask(ip,jp) = 1
+          ENDIF
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( lat(ip,jp) * pi/180. ), mincos )     
+          IF ( ip .EQ. 1 ) THEN
+             resol_lu(ip,jp,1) = ABS( lon(ip+1,jp) - lon(ip,jp) ) * pi/180. * R_Earth * coslat
+          ELSEIF ( ip .EQ. iml ) THEN
+             resol_lu(ip,jp,1) = ABS( lon(ip,jp) - lon(ip-1,jp) ) * pi/180. * R_Earth * coslat
+          ELSE
+             resol_lu(ip,jp,1) = ABS( lon(ip+1,jp) - lon(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resol_lu(ip,jp,2) = ABS( lat(ip,jp) - lat(ip,jp+1) ) * pi/180. * R_Earth
+          ELSEIF ( jp .EQ. jml ) THEN
+             resol_lu(ip,jp,2) = ABS( lat(ip,jp-1) - lat(ip,jp) ) * pi/180. * R_Earth
+          ELSE
+             resol_lu(ip,jp,2) =  ABS( lat(ip,jp-1) - lat(ip,jp+1) )/2. * pi/180. * R_Earth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+       njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+       nbvmax = nix*njx
+    ENDIF
+    CALL bcast(nbvmax)
+    !
+    callsign = 'LAI map'
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+       !WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+       ALLOCATE(sub_index(nbpt, nbvmax, 2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:,:)=0
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon, lat, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       !
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+       
+    ENDDO
+    !
+    laimap(:,:,:) = zero
+    !
+    DO ib=1,nbpt
+       idi = COUNT(sub_area(ib,:) > zero)
+       IF ( idi > 0 ) THEN
+          totarea = zero
+          DO jj=1,idi
+             ip = sub_index(ib,jj,1)
+             jp = sub_index(ib,jj,2)
+             DO jv=1,nvm
+                DO it=1,12
+                   laimap(ib,jv,it) = laimap(ib,jv,it) + laimap_lu(ip,jp,jv,it)*sub_area(ib,jj)
+                ENDDO
+             ENDDO
+             totarea = totarea + sub_area(ib,jj)
+          ENDDO
+          !
+          ! Normalize
+          !
+          laimap(ib,:,:) = laimap(ib,:,:)/totarea
+          !
+       ELSE
+          WRITE(numout,*) 'On point ', ib, ' no points where found for interpolating the LAI map.'
+          WRITE(numout,*) 'Location : ', lalo(ib,2), lalo(ib,1)
+          DO jv=1,nvm
+             laimap(ib,jv,:) = (llaimax(jv)+llaimin(jv))/deux
+          ENDDO
+          WRITE(numout,*) 'Solved by putting the average LAI for the PFT all year long'
+       ENDIF
+    ENDDO
+    !
+    ! Normelize the read LAI by the values SECHIBA is used to
+    !
+    IF ( renormelize_lai ) THEN
+       DO ib=1,nbpt
+          DO jv=1,nvm
+             lmax = MAXVAL(laimap(ib,jv,:))
+             lmin = MINVAL(laimap(ib,jv,:))
+             ldelta = lmax-lmin
+             IF ( ldelta < min_sechiba) THEN
+                ! LAI constante ... keep it constant
+                laimap(ib,jv,:) = (laimap(ib,jv,:)-lmin)+(llaimax(jv)+llaimin(jv))/deux
+             ELSE
+                laimap(ib,jv,:) = (laimap(ib,jv,:)-lmin)/(lmax-lmin)*(llaimax(jv)-llaimin(jv))+llaimin(jv)
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+    !
+    WRITE(numout,*) 'slowproc_interlai : Interpolation Done'
+    !
+    !  
+    !
+    DEALLOCATE(lat_lu)
+    DEALLOCATE(lon_lu)
+    DEALLOCATE(lon)
+    DEALLOCATE(lat)
+    DEALLOCATE(laimap_lu)
+    DEALLOCATE(mask)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(sub_index)
+    DEALLOCATE (resol_lu)
+
+  END SUBROUTINE slowproc_interlai
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_readvegetmax
+!!
+!>\BRIEF          Read and interpolate a vegetation map (by pft)
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): The subroutine was previously called slowproc_update.
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_readvegetmax(nbpt, lalo, neighbours,  resolution, contfrac, & 
+       veget_last, & 
+       veget_next, frac_nobio_next, veget_year, init)
+    !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)                             :: nbpt            !! Number of points for which the data needs 
+                                                                              !! to be interpolated
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in)             :: lalo            !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), DIMENSION(nbpt,8), INTENT(in)         :: neighbours       !! Vector of neighbours for each grid point 
+                                                                              !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in)             :: resolution      !! The size in km of each grid-box in X and Y
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)               :: contfrac        !! Fraction of continent in the grid
+    !
+    REAL(r_std), DIMENSION(nbpt,nvm), INTENT(in)           :: veget_last      !! old max vegetfrac
+    INTEGER(i_std), INTENT(in)         :: veget_year            !! first year for landuse (0 == NO TIME AXIS)
+    LOGICAL, INTENT(in)                :: init                  !! initialisation : in case of dgvm, it forces update of all PFTs
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), DIMENSION(nbpt,nvm), INTENT(out)          :: veget_next       !! new max vegetfrac
+    REAL(r_std), DIMENSION(nbpt,nnobio), INTENT(out)       :: frac_nobio_next  !! new fraction of the mesh which is 
+                                                                               !! covered by ice, lakes, ...
+    !
+    !  0.3 LOCAL
+    !
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, inobio, jv
+    INTEGER(i_std) :: nb_coord,nb_var, nb_gat,nb_dim
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)  :: itau
+    REAL(r_std), DIMENSION(1)  :: time_counter
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lat_lu, lon_lu
+    INTEGER,DIMENSION(flio_max_var_dims) :: l_d_w, i_d_w
+    LOGICAL :: exv, l_ex
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: vegmap            ! last coord is time with only one value = 1
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: vegmap_1            ! last coord is time with only one value = 1  (IF VEGET_YEAR == 0 , NO TIME AXIS)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_ful, lon_ful
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    !
+    REAL(r_std) :: sumf, err, norm
+    REAL(r_std) :: totarea
+    INTEGER(i_std) :: idi, nbvmax
+    CHARACTER(LEN=30) :: callsign
+    !
+    LOGICAL ::           ok_interpol ! optionnal return of aggregate_2d
+    !
+    ! for DGVM case :
+    REAL(r_std)                 :: sum_veg                     ! sum of vegets
+    REAL(r_std)                 :: sum_nobio                   ! sum of nobios
+    REAL(r_std)                 :: sumvAnthro_old, sumvAnthro  ! last an new sum of antrhopic vegets
+    REAL(r_std)                 :: rapport                     ! (S-B) / (S-A)
+    LOGICAL                     :: partial_update              ! if TRUE, partialy update PFT (only anthropic ones) 
+                                                               ! e.g. in case of DGVM and not init (optional parameter)
+    INTEGER                  :: ALLOC_ERR
+
+!_ ================================================================================================================================
+    !
+    !Config Key   = VEGETATION_FILE
+    !Config Desc  = Name of file from which the vegetation map is to be read
+    !Config If    = MAP_PFT_FORMAT
+    !Config Def   = PFTmap.nc
+    !Config Help  = The name of the file to be opened to read a vegetation
+    !Config         map (in pft) is to be given here. 
+    !Config Units = [FILE]
+    !
+    filename = 'PFTmap.nc'
+    CALL getin_p('VEGETATION_FILE',filename)
+    !
+    IF (is_root_prc) THEN
+       IF (printlev_loc >=5) THEN
+          WRITE(numout,*) "Entering slowproc_readvegetmax. Debug mode."
+          WRITE (*,'(/," --> fliodmpf")')
+          CALL fliodmpf (TRIM(filename))
+          WRITE (*,'(/," --> flioopfd")')
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev_loc >=5) THEN
+          WRITE (*,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (*,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (*,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+    CALL bcast(nb_coord)
+    CALL bcast(nb_var)
+    CALL bcast(nb_gat)
+    IF ( veget_year > 0 ) THEN
+WRITE(numout,*) "is_root_prc", is_root_prc
+       IF (is_root_prc) THEN
+          CALL flioinqv (fid,v_n="time_counter",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) 
+          IF (.NOT. l_ex ) THEN 
+             CALL ipslerr_p (3,'slowproc_readvegetmax', & 
+                  'Error reading time_counter from ', TRIM(filename), & 
+                  'Check file attribute, dimension, file, ... for time_counter' ) 
+          END IF
+       END IF
+       CALL bcast(l_d_w)
+       tml=l_d_w(1)
+    ELSE
+       tml=0
+    END IF
+    WRITE(numout,*) "slowproc_readvegetmax: tml =",tml
+
+    IF (is_root_prc) THEN
+       CALL flioinqv (fid,v_n="lon",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) 
+         IF (.NOT. l_ex ) THEN 
+            CALL ipslerr_p (3,'slowproc_readvegetmax', & 
+                 'Error reading lon from ', TRIM(filename), & 
+                 'Check file attribute, dimension, file, ... for lon' ) 
+         END IF
+    END IF
+    CALL bcast(l_d_w)
+    iml=l_d_w(1)
+    WRITE(numout,*) "slowproc_readvegetmax: iml =",iml
+    
+    IF (is_root_prc) THEN
+       CALL flioinqv (fid,v_n="lat",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) 
+         IF (.NOT. l_ex ) THEN 
+            CALL ipslerr_p (3,'slowproc_readvegetmax', & 
+                 'Error reading lat from ', TRIM(filename), & 
+                 'Check file attribute, dimension, file, ... for lat' ) 
+         END IF
+    END IF
+    CALL bcast(l_d_w)
+    jml=l_d_w(1)
+    WRITE(numout,*) "slowproc_readvegetmax: jml =",jml
+    
+    IF (is_root_prc) THEN
+       CALL flioinqv (fid,v_n="veget",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) 
+        IF (.NOT. l_ex ) THEN 
+           CALL ipslerr_p (3,'slowproc_readvegetmax', & 
+                'Error reading veget from ', TRIM(filename), & 
+                'Check file attribute, dimension, file, ... for veget' ) 
+        END IF
+    END IF
+    CALL bcast(l_d_w)
+    lml=l_d_w(1)
+    WRITE(numout,*) "lml =",lml
+
+    IF (lml /= nvm) &
+         CALL ipslerr_p (3,'slowproc_readvegetmax', &
+               &          'Problem with vegetation file for Land Use','lml /= nvm', &
+               &          '(number of pft must be equal)')
+    
+    ALLOCATE(lat_lu(jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_readvegetmax','Error in allocation for lat_lu','','')
+
+    ALLOCATE(lon_lu(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_readvegetmax','Error in allocation for lon_lu','','')
+
+    IF ( veget_year > 0 ) THEN
+       IF (tml > 0) THEN
+          ALLOCATE(itau(tml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_readvegetmax','Error in allocation for itau','','')
+       ENDIF
+    END IF
+       
+    IF (is_root_prc) THEN
+       IF (tml > 0) THEN
+          CALL fliogstc (fid, t_axis=itau,x_axis=lon_lu,y_axis=lat_lu)
+          IF (veget_year <= tml) THEN
+             CALL fliogetv (fid,"time_counter",time_counter, start=(/ veget_year /), count=(/ 1 /))
+             WRITE(numout,*) "slowproc_readvegetmax LAND USE : the date read for vegetmax is ",time_counter
+          ELSE
+             CALL fliogetv (fid,"time_counter",time_counter, start=(/ tml /), count=(/ 1 /))
+             WRITE(numout,*) "slowproc_readvegetmax LAND USE : You try to update vegetmax with a the date greater than in the file."
+             WRITE(numout,*) "                           We will keep the last one :",time_counter
+          ENDIF
+       ELSE
+          CALL fliogstc (fid, x_axis=lon_lu,y_axis=lat_lu)
+       ENDIF
+    ENDIF
+    
+    IF (tml > 0) THEN
+       CALL bcast(itau)
+    ENDIF
+    CALL bcast(lon_lu)
+    CALL bcast(lat_lu)
+
+    ALLOCATE(lat_ful(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_readvegetmax','Error in allocation for lat_ful','','')
+
+    ALLOCATE(lon_ful(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_readvegetmax','Error in allocation for lon_ful','','')
+
+    DO ip=1,iml
+       lon_ful(ip,:)=lon_lu(ip)
+    ENDDO
+    DO jp=1,jml
+       lat_ful(:,jp)=lat_lu(jp)
+    ENDDO
+    
+    WRITE(numout,*) 'Reading the LAND USE vegetation file'
+    
+    ALLOCATE(vegmap(iml,jml,nvm,1), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_readvegetmax','Error in allocation for vegmap','','')
+
+    IF ( veget_year == 0 ) THEN
+       IF (is_root_prc) THEN
+          ALLOCATE(vegmap_1(iml,jml,nvm), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_readvegetmax','Error in allocation for vegmap_1','','')
+       ENDIF
+    ENDIF
+    !
+!!!$    CALL flinopen &
+!!!$       &  (filename, .FALSE., iml, jml, lml, lon_ful, lat_ful, &
+!!!$       &   lev_ful, tml, itau, date, dt, fid)
+!!!=> FATAL ERROR FROM ROUTINE flinopen
+!!! --> No time axis found
+ !!
+!!!MM modif TAG 1.4 : 
+!!!    CALL flinget(fid, 'lon', iml, 0, 0, 0, 1, 1, lon_lu)
+!!!    CALL flinget(fid, 'lat', jml, 0, 0, 0, 1, 1, lat_lu)
+!!!    CALL flinget(fid, 'maxvegetfrac', iml, jml, nvm, tml, 1, 293, vegmap_lu)
+!!!FATAL ERROR FROM ROUTINE flinopen
+!!! --> No variable lon
+!!!   We get only the right year
+!!!$    CALL flinget(fid, 'maxvegetfrac', iml, jml, nvm, tml, veget_year, veget_year, vegmap)
+!!!$    !
+!!!$    CALL flinclo(fid)
+
+    IF (is_root_prc) THEN
+       CALL flioinqv (fid,"maxvegetfrac",exv,nb_dims=nb_dim,len_dims=l_d_w,id_dims=i_d_w)
+         IF (.NOT. exv ) THEN 
+            CALL ipslerr_p (3,'slowproc_readvegetmax', & 
+                 'Error reading maxvegetfrac from ', TRIM(filename), & 
+                 'Check file Attribute, dimension, file, ... for maxvegetfrac' ) 
+         END IF
+    END IF
+
+    CALL bcast(nb_dim)
+    CALL bcast(l_d_w)
+    CALL bcast(i_d_w)
+
+    IF (printlev_loc >=5) THEN
+       WRITE (numout,'(" Number of dimensions : ",I2)') nb_dim
+       WRITE (numout,'(" Dimensions :",/,5(1X,I7,:))') l_d_w(1:nb_dim)
+       WRITE (numout,'(" Identifiers :",/,5(1X,I7,:))') i_d_w(1:nb_dim)
+    ENDIF
+    
+    IF ( veget_year > 0 ) THEN
+       IF (is_root_prc) THEN
+          IF (veget_year <= tml) THEN
+             CALL fliogetv (fid,"maxvegetfrac", vegmap, start=(/ 1, 1, 1, veget_year /), count=(/ iml, jml, nvm, 1 /))
+          ELSE
+             CALL fliogetv (fid,"maxvegetfrac", vegmap, start=(/ 1, 1, 1, tml /), count=(/ iml, jml, nvm, 1 /))
+          ENDIF
+       ENDIF
+    ELSE
+       IF (is_root_prc) THEN
+          CALL fliogetv (fid,"maxvegetfrac", vegmap_1, start=(/ 1, 1, 1 /), count=(/ iml, jml, nvm /))
+          vegmap(:,:,:,1)=vegmap_1(:,:,:)
+          DEALLOCATE(vegmap_1)
+       ENDIF
+    ENDIF
+    CALL bcast(vegmap)
+    IF (is_root_prc) CALL flioclo (fid)
+
+    !
+    ! Mask of permitted variables.
+    !
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_readvegetmax','Error in allocation for mask','','')
+
+    mask(:,:) = 0
+    DO ip=1,iml
+       DO jp=1,jml
+          sum_veg=SUM(vegmap(ip,jp,:,1))
+          IF ( sum_veg .GE. min_sechiba .AND. sum_veg .LE. 1.-1.e-7) THEN
+             mask(ip,jp) = 1
+             IF (printlev_loc >=5) THEN
+                WRITE(numout,*) "update : SUM(vegmap(",ip,jp,")) = ",sum_veg
+             ENDIF
+          ELSEIF ( sum_veg .GT. 1.-1.e-7 .AND. sum_veg .LE. 2.) THEN
+             ! normalization
+             vegmap(ip,jp,:,1) = vegmap(ip,jp,:,1) / sum_veg
+             mask(ip,jp) = 1
+             IF (printlev_loc >=5) THEN
+                WRITE(numout,*) "update : SUM(vegmap(",ip,jp,"))_c = ",SUM(vegmap(ip,jp,:,1))
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    !
+    ! The number of maximum vegetation map points in the GCM grid should
+    ! also be computed and not imposed here.
+    !
+    nbvmax = 200
+    !
+    callsign="Land Use Vegetation map"
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+       !WRITE(numout,*) "nbvmax = ",nbvmax
+
+       ALLOCATE(sub_index(nbpt, nbvmax,2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_readvegetmax','Error in allocation for sub_index','','')
+
+       sub_index(:,:,:)=0
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_readvegetmax','Error in allocation for sub_area','','')
+       sub_area(:,:)=zero
+
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon_ful, lat_ful, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       !
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+       
+    ENDDO
+    !
+    ! Compute the logical for partial (only anthropic) PTFs update
+    IF (ok_dgvm .AND. .NOT. init) THEN
+       partial_update= .TRUE.
+    ELSE
+       partial_update=.FALSE.
+    END IF
+
+    IF ( .NOT. partial_update ) THEN
+       veget_next(:,:)=zero
+       
+       DO ib = 1, nbpt
+          sumf=zero
+          DO idi=1, nbvmax
+             ! Leave the do loop if all sub areas are treated, sub_area <= 0
+             IF ( sub_area(ib,idi) <= zero ) EXIT
+             ip = sub_index(ib,idi,1)
+             jp = sub_index(ib,idi,2)
+             veget_next(ib,:) = veget_next(ib,:) + vegmap(ip,jp,:,1)*sub_area(ib,idi)
+             sumf=sumf + sub_area(ib,idi)
+          ENDDO
+!!!$          !
+!!!$          !  Limit the smalest vegetation fraction to 0.5%
+!!!$          !
+!!!$          DO jv = 1, nvm
+!!!$             IF ( veget_next(ib,jv) .LT. min_vegfrac ) THEN
+!!!$                veget_next(ib,jv) = zero
+!!!$             ENDIF
+!!!$          ENDDO
+          !
+          ! Normalize
+          !
+          IF (sumf > min_sechiba) THEN
+             veget_next(ib,:) = veget_next(ib,:) / sumf
+          ELSE
+             WRITE(numout,*) "slowproc_readvegetmax : No land point in the map for point ",&
+                  ib,",(",lalo(ib,1),",",lalo(ib,2),")" 
+             CALL ipslerr_p (2,'slowproc_readvegetmax', &
+                  &          'Problem with vegetation file for Land Use.', &
+                  &          "No land point in the map for point", &
+                  &          'Keep old values. (verify your land use file.)')
+!!$             CALL slowproc_nearest (iml, lon_ful, lat_ful, &
+!!$                  lalo(ib,2), lalo(ib,1), inear)
+             IF (init) THEN
+                veget_next(ib,1) = un
+                veget_next(ib,2:nvm) = zero
+             ELSE
+                veget_next(ib,:) = veget_last(ib,:)
+             ENDIF
+             
+          ENDIF
+          !
+          IF (printlev_loc >=5) THEN
+             WRITE(numout,*) "SUM(veget_next(",ib,")) = ",SUM(veget_next(ib,:))
+          ENDIF
+       ENDDO
+    ELSE
+       DO ib = 1, nbpt
+          ! last veget for this point
+          sum_veg=SUM(veget_last(ib,:))
+          IF (printlev_loc >=5) THEN
+             WRITE(numout,*) "SUM(veget_last(",ib,")) = ",sum_veg
+          ENDIF
+          !
+          ! If the DGVM is activated, only anthropiques PFT are utpdated,
+          ! other are copied 
+          veget_next(ib,:) = veget_last(ib,:)
+          !
+          ! natural ones are initialized to zero.
+          DO jv = 2, nvm
+             ! If the DGVM is activated, only anthropiques PFT are utpdated 
+             IF ( .NOT. natural(jv) ) THEN
+                veget_next(ib,jv) = zero
+             ENDIF
+          ENDDO
+          !
+          sumf=zero
+          DO idi=1, nbvmax
+             ! Leave the do loop if all sub areas are treated, sub_area <= 0
+             IF ( sub_area(ib,idi) <= zero ) EXIT
+             ip = sub_index(ib,idi,1)
+             jp = sub_index(ib,idi,2)
+             ! If the DGVM is activated, only anthropic PFTs are utpdated 
+             DO jv = 2, nvm
+                IF ( .NOT. natural(jv) ) THEN       
+                   veget_next(ib,jv) = veget_next(ib,jv) + vegmap(ip,jp,jv,1)*sub_area(ib,idi)
+                ENDIF
+             ENDDO
+             sumf=sumf + sub_area(ib,idi)
+          ENDDO
+!!!$          !
+!!!$          !  Limit the smalest vegetation fraction to 0.5%
+!!!$          !
+!!!$          DO jv = 2, nvm
+!!!$             ! On anthropic and natural PFTs ? 
+!!!$             IF ( veget_next(ib,jv) .LT. min_vegfrac ) THEN
+!!!$                veget_next(ib,jv) = zero
+!!!$             ENDIF
+!!!$          ENDDO
+          !
+          ! Normalize
+          !
+          ! Proposition de Pierre :
+          ! apres modification de la surface des PFTs anthropiques,
+          ! on doit conserver la proportion des PFTs naturels.
+          ! ie la somme des vegets est conservee
+          !    et PFT naturel / (somme des vegets - somme des vegets anthropiques)
+          !       est conservee.
+          ! Modification de Nathalie : 
+          ! Si les PFTs anthropique diminue, on les remplace plutôt par du sol nu.
+          ! Le DGVM est chargé de ré-introduire les PFTs naturels.
+          IF (sumf > min_sechiba) THEN
+             sumvAnthro_old = zero
+             sumvAnthro     = zero
+             DO jv = 2, nvm
+                IF ( .NOT. natural(jv) ) THEN
+                   veget_next(ib,jv) = veget_next(ib,jv) / sumf
+                   sumvAnthro = sumvAnthro + veget_next(ib,jv)
+                   sumvAnthro_old = sumvAnthro_old + veget_last(ib,jv)
+                ENDIF
+             ENDDO
+
+             IF ( sumvAnthro_old < sumvAnthro ) THEN
+                ! Reforestation
+                ! conservation :
+                rapport = ( sum_veg - sumvAnthro ) / ( sum_veg - sumvAnthro_old )
+                DO jv = 1, nvm
+                   IF ( natural(jv) ) THEN
+                      veget_next(ib,jv) = veget_last(ib,jv) * rapport
+                   ENDIF
+                ENDDO
+             ELSE
+                ! Deforestation
+                DO jv = 1, nvm
+                   IF ( natural(jv) ) THEN
+                      veget_next(ib,jv) = veget_last(ib,jv)
+                   ENDIF
+                ENDDO
+                veget_next(ib,1) = veget_next(ib,1) + sumvAnthro_old - sumvAnthro
+             ENDIF
+
+             ! test
+             IF ( ABS( SUM(veget_next(ib,:)) - sum_veg ) > 10*EPSILON(un) ) THEN
+                WRITE(numout,*) "No conservation of sum of veget for point ",ib,",(",lalo(ib,1),",",lalo(ib,2),")" 
+                WRITE(numout,*) "last sum of veget ",sum_veg," new sum of veget ",SUM(veget_next(ib,:))," error : ",&
+                     &                         SUM(veget_next(ib,:)) - sum_veg
+                WRITE(numout,*) "Anthropic modifications : last ",sumvAnthro_old," new ",sumvAnthro     
+                CALL ipslerr_p (3,'slowproc_readvegetmax', &
+                     &          'No conservation of sum of veget_next', &
+                     &          "The sum of veget_next is different after reading Land Use map.", &
+                     &          '(verify the dgvm case model.)')
+             ENDIF
+          ELSE
+             WRITE(numout,*) "No land point in the map for point ",ib,",(",lalo(ib,1),",",lalo(ib,2),")" 
+             CALL ipslerr_p (2,'slowproc_readvegetmax', &
+                  &          'Problem with vegetation file for Land Use.', &
+                  &          "No land point in the map for point", &
+                  &          '(verify your land use file.)')
+             veget_next(ib,:) = veget_last(ib,:)
+          ENDIF
+          
+       ENDDO       
+    ENDIF
+    !
+    frac_nobio_next (:,:) = un
+    !
+!MM
+    ! Work only for one nnobio !! (ie ice)
+    DO inobio=1,nnobio
+       DO jv=1,nvm
+          DO ib = 1, nbpt
+             frac_nobio_next(ib,inobio) = frac_nobio_next(ib,inobio) - veget_next(ib,jv)
+          ENDDO
+       ENDDO
+    ENDDO
+
+    DO ib = 1, nbpt
+       sum_veg = SUM(veget_next(ib,:))
+       sum_nobio = SUM(frac_nobio_next(ib,:))
+       IF (sum_nobio < 0.) THEN
+          frac_nobio_next(ib,:) = zero
+          veget_next(ib,1) = veget_next(ib,1) + sum_nobio
+          sum_veg = SUM(veget_next(ib,:))
+       ENDIF
+       sumf = sum_veg + sum_nobio
+       IF (sumf > min_sechiba) THEN
+          veget_next(ib,:) = veget_next(ib,:) / sumf
+          frac_nobio_next(ib,:) = frac_nobio_next(ib,:) / sumf
+          norm=SUM(veget_next(ib,:))+SUM(frac_nobio_next(ib,:))
+          err=norm-un
+          IF (printlev_loc >=5) &
+             WRITE(numout,*) "ib ",ib," SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-un, sumf",err,sumf
+          IF (abs(err) > -EPSILON(un)) THEN
+             IF ( SUM(frac_nobio_next(ib,:)) > min_sechiba ) THEN
+                frac_nobio_next(ib,1) = frac_nobio_next(ib,1) - err
+             ELSE
+                veget_next(ib,1) = veget_next(ib,1) - err
+             ENDIF
+             norm=SUM(veget_next(ib,:))+SUM(frac_nobio_next(ib,:))
+             err=norm-un
+             IF (printlev_loc >=5) &
+                  WRITE(numout,*) "ib ",ib," SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-un",err
+             IF (abs(err) > EPSILON(un)) THEN
+                WRITE(numout,*) "update : Problem with point ",ib,",(",lalo(ib,1),",",lalo(ib,2),")" 
+                WRITE(numout,*) "         err(sum-1.) = ",abs(err)
+                CALL ipslerr_p (2,'slowproc_readvegetmax', &
+                     &          'Problem with sum vegetation + sum fracnobio for Land Use.', &
+                     &          "sum not equal to 1.", &
+                     &          '(verify your land use file.)')
+             ENDIF
+          ENDIF
+       ELSE
+          WRITE(numout,*) "No vegetation nor frac_nobio for point ",ib,",(",lalo(ib,1),",",lalo(ib,2),")" 
+          WRITE(numout,*)"Replaced by bare_soil !! "
+          veget_next(ib,1) = un
+          veget_next(ib,2:nvm) = zero
+          frac_nobio_next(ib,:) = zero
+!!!$          CALL ipslerr_p (3,'slowproc_readvegetmax', &
+!!!$               &          'Problem with vegetation file for Land Use.', &
+!!!$               &          "No vegetation nor frac_nobio for point ", &
+!!!$               &          '(verify your land use file.)')
+       ENDIF
+    ENDDO
+    
+    WRITE(numout,*) 'slowproc_readvegetmax : Interpolation Done'
+    
+    DEALLOCATE(vegmap)
+    DEALLOCATE(lat_lu,lon_lu)
+    DEALLOCATE(lat_ful,lon_ful)
+    DEALLOCATE(mask)
+    DEALLOCATE(sub_index,sub_area)
+
+  END SUBROUTINE slowproc_readvegetmax
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_interpol
+!!
+!>\BRIEF         Interpolate the IGBP vegetation map to the grid of the model
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_interpol(nbpt, lalo, neighbours, resolution, contfrac, veget, frac_nobio )
+    !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)          :: nbpt                  !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)              :: lalo(nbpt,2)         !! Vector of latitude and longitudes (beware of the order!)
+    INTEGER(i_std), INTENT(in)          :: neighbours(nbpt,8)    !! Vector of neighbours for each grid point 
+                                                                 !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), INTENT(in)              :: resolution(nbpt,2)   !! The size in km of each grid-box in X and Y
+    REAL(r_std),DIMENSION (nbpt), INTENT (in) :: contfrac        !! Fraction of continent in the grid
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)    ::  veget(nbpt,nvm)              !! Vegetation fractions
+    REAL(r_std), INTENT(out)    ::  frac_nobio(nbpt,nnobio)      !! Fraction of the mesh which is covered by ice, lakes, ...
+    !
+    LOGICAL ::           ok_interpol                             !! optionnal return of aggregate_vec
+    !
+    !  0.3 LOCAL
+    !
+    INTEGER(i_std), PARAMETER  :: nolson = 94                    !! Number of Olson classes
+    !
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, vid
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lat_ful, lon_ful, vegmap
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: sub_area
+    INTEGER(i_std),ALLOCATABLE, DIMENSION(:,:) :: sub_index
+    REAL(r_std), DIMENSION(nbpt,nolson) :: n_origveg
+    REAL(r_std), DIMENSION(nbpt) :: n_found
+    REAL(r_std), DIMENSION(nbpt,nolson) :: frac_origveg
+    REAL(r_std) :: vegcorr(nolson,nvm)
+    REAL(r_std) :: nobiocorr(nolson,nnobio)
+    CHARACTER(LEN=40) :: callsign
+    REAL(r_std) :: sumf, resol_lon, resol_lat
+    INTEGER(i_std) :: idi, jv, inear, nbvmax, nix, njx
+    !
+    INTEGER                  :: ALLOC_ERR
+
+!_ ================================================================================================================================
+    !
+    n_origveg(:,:) = zero
+    n_found(:) = zero
+    !
+    CALL get_vegcorr (nolson,vegcorr,nobiocorr)
+    !
+    !Config Key   = VEGETATION_FILE
+    !Config Desc  = Name of file from which the vegetation map is to be read
+    !Config If    = NOT(IMPOSE_VEG) and NOT(MAP_PFT_FORMAT)
+    !Config Def   = carteveg5km.nc
+    !Config Help  = The name of the file to be opened to read the vegetation
+    !Config         map is to be given here. Usualy SECHIBA runs with a 5kmx5km
+    !Config         map which is derived from the IGBP one. We assume that we have
+    !Config         a classification in 87 types. This is Olson modified by Viovy.
+    !Config Units = [FILE]
+    !
+    filename = 'carteveg5km.nc'
+    CALL getin_p('VEGETATION_FILE',filename)
+
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+
+    ALLOCATE(lat_ful(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_interpol','Error in allocation for lat_ful','','')
+
+    ALLOCATE(lon_ful(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_interpol','Error in allocation for lon_ful','','')
+
+    ALLOCATE(vegmap(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_interpol','Error in allocation for vegmap','','')
+
+    WRITE(numout,*) 'Reading the OLSON type vegetation file'
+    IF (is_root_prc) THEN
+       CALL flinget(fid, 'longitude', iml, jml, lml, tml, 1, 1, lon_ful)
+       CALL flinget(fid, 'latitude', iml, jml, lml, tml, 1, 1, lat_ful)
+       CALL flinget(fid, 'vegetation_map', iml, jml, lml, tml, 1, 1, vegmap)
+
+       CALL flinclo(fid)
+    ENDIF
+    
+    CALL bcast(lon_ful)
+    CALL bcast(lat_ful)
+    CALL bcast(vegmap)
+    
+    
+    IF (MAXVAL(vegmap) .LT. nolson) THEN
+       WRITE(numout,*) 'WARNING -- WARNING'
+       WRITE(numout,*) 'The vegetation map has to few vegetation types.'
+       WRITE(numout,*) 'If you are lucky it will work but please check'
+    ELSE IF ( MAXVAL(vegmap) .GT. nolson) THEN
+       WRITE(numout,*) 'More vegetation types in file than the code can'
+       WRITE(numout,*) 'deal with.: ',  MAXVAL(vegmap),  nolson
+       CALL ipslerr_p(3,'slowproc_interpol','Error in number of vegetation types','','')
+    ENDIF
+    !
+    ! Some assumptions on the vegetation file. This information should be
+    ! be computed or read from the file. 
+    ! It is the reolution in meters of the grid of the vegetation file.
+    !
+    resol_lon = 5000.
+    resol_lat = 5000.
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution_g(:,1))*2/resol_lon)+2
+       njx=INT(MAXVAL(resolution_g(:,2))*2/resol_lon)+2
+       nbvmax = nix*njx
+    ENDIF
+    CALL bcast(nbvmax)
+    
+    callsign="Vegetation map"
+    
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev_loc>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev_loc>=3) WRITE(numout,*) "nbvmax = ",nbvmax
+       
+       ALLOCATE(sub_index(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_interpol','Error in allocation for sub_index','','')
+       sub_index(:,:)=0
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_interpol','Error in allocation for sub_area','','')
+       sub_area(:,:)=zero
+
+       IF (printlev_loc>=3) WRITE(numout,*) 'Carteveg range LON:', MINVAL(lon_ful), MAXVAL(lon_ful)
+       IF (printlev_loc>=3) WRITE(numout,*) 'Carteveg range LAT:', MINVAL(lat_ful), MAXVAL(lat_ful)
+    
+    WRITE(numout,*) 'Carteveg range LON:', MINVAL(lon_ful), MAXVAL(lon_ful)
+    WRITE(numout,*) 'Carteveg range LAT:', MINVAL(lat_ful), MAXVAL(lat_ful)
+    !
+       CALL aggregate_p (nbpt, lalo, neighbours, resolution, contfrac, &
+            iml, lon_ful, lat_ful, resol_lon, resol_lat, callsign, &
+            nbvmax, sub_index, sub_area, ok_interpol)
+       
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ELSE
+          DO ib = 1, nbpt
+             DO idi=1, nbvmax
+                ! Leave the do loop if all sub areas are treated, sub_area <= 0
+                IF ( sub_area(ib,idi) <= zero ) EXIT 
+                ip = sub_index(ib,idi)
+                n_origveg(ib,NINT(vegmap(ip))) = n_origveg(ib,NINT(vegmap(ip))) + sub_area(ib,idi)
+                n_found(ib) =  n_found(ib) + sub_area(ib,idi)
+             ENDDO
+          ENDDO
+       ENDIF
+    ENDDO
+    !
+    ! Now we know how many points of which Olson type from the fine grid fall
+    ! into each box of the (coarse) model grid: n_origveg(nbpt,nolson)
+    !
+    !
+    ! determine fraction of Olson vegetation type in each box of the coarse grid
+    !
+    DO vid = 1, nolson
+       WHERE ( n_found(:) .GT. 0 ) 
+          frac_origveg(:,vid) = n_origveg(:,vid) / n_found(:)
+       ELSEWHERE
+          frac_origveg(:,vid) = zero
+       ENDWHERE
+    ENDDO
+    !
+    ! now finally calculate coarse vegetation map
+    ! Find which model vegetation corresponds to each Olson type 
+    !
+    veget(:,:) = zero
+    frac_nobio(:,:) = zero
+    
+    DO vid = 1, nolson
+       DO jv = 1, nvm
+          veget(:,jv) = veget(:,jv) + frac_origveg(:,vid) * vegcorr(vid,jv)
+       ENDDO
+    
+       DO jv = 1, nnobio
+          frac_nobio(:,jv) = frac_nobio(:,jv) + frac_origveg(:,vid) * nobiocorr(vid,jv)
+       ENDDO
+    ENDDO
+ 
+    IF (printlev_loc>=3) WRITE (numout,*) 'slowproc_interpol : Interpolation Done'
+    !
+    !   Clean up the point of the map
+    !
+    DO ib = 1, nbpt
+       !
+       !  Let us see if all points found something in the 5km map !
+       !
+       IF ( n_found(ib) .EQ. 0 ) THEN
+          !
+          ! Now we need to handle some exceptions
+          !
+          IF ( lalo(ib,1) .LT. -56.0) THEN
+             ! Antartica
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+          ELSE IF ( lalo(ib,1) .GT. 70.0) THEN
+             ! Artica
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+          ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN
+             ! Greenland
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+          ELSE
+             WRITE(numout,*) 'PROBLEM, no point in the 5km map found for this grid box',ib
+             WRITE(numout,*) 'Longitude range : ', lalo(ib,2)
+             WRITE(numout,*) 'Latitude range : ', lalo(ib,1)
+             
+             WRITE(numout,*) 'Looking for nearest point on the 5 km map'
+             CALL slowproc_nearest (iml, lon_ful, lat_ful, &
+                  lalo(ib,2), lalo(ib,1), inear)
+             WRITE(numout,*) 'Coordinates of the nearest point:', &
+                  lon_ful(inear),lat_ful(inear)
+             
+             DO jv = 1, nvm
+                veget(ib,jv) = vegcorr(NINT(vegmap(inear)),jv)
+             ENDDO
+             
+             DO jv = 1, nnobio
+                frac_nobio(ib,jv) = nobiocorr(NINT(vegmap(inear)),jv)
+             ENDDO
+          ENDIF
+       ENDIF
+       !
+       !
+       !  Limit the smallest vegetation fraction to 0.5%
+       !
+       DO vid = 1, nvm
+          IF ( veget(ib,vid) .LT. min_vegfrac ) THEN
+             veget(ib,vid) = zero
+          ENDIF
+       ENDDO
+  
+       sumf = SUM(frac_nobio(ib,:))+SUM(veget(ib,:))
+       frac_nobio(ib,:) = frac_nobio(ib,:)/sumf
+       veget(ib,:) = veget(ib,:)/sumf
+    ENDDO
+    
+    DEALLOCATE(vegmap)
+    DEALLOCATE(lat_ful, lon_ful)
+    DEALLOCATE(sub_index)
+    DEALLOCATE(sub_area)
+
+  END SUBROUTINE slowproc_interpol
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_nearest
+!!
+!>\BRIEF         looks for nearest grid point on the fine map
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::inear
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_nearest(iml, lon5, lat5, lonmod, latmod, inear)
+
+    !! INTERFACE DESCRIPTION
+    
+    !! 0.1 input variables
+
+    INTEGER(i_std), INTENT(in)                   :: iml             !! size of the vector
+    REAL(r_std), DIMENSION(iml), INTENT(in)      :: lon5, lat5      !! longitude and latitude vector, for the 5km vegmap
+    REAL(r_std), INTENT(in)                      :: lonmod, latmod  !! longitude  and latitude modelled
+
+    !! 0.2 output variables
+    
+    INTEGER(i_std), INTENT(out)                  :: inear           !! location of the grid point from the 5km vegmap grid
+                                                                    !! closest from the modelled grid point
+
+    !! 0.4 Local variables
+
+    REAL(r_std)                                  :: pa, p
+    REAL(r_std)                                  :: coscolat, sincolat
+    REAL(r_std)                                  :: cospa, sinpa
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: cosang
+    INTEGER(i_std)                               :: i
+    INTEGER(i_std), DIMENSION(1)                 :: ineartab
+    INTEGER                                      :: ALLOC_ERR
+
+!_ ================================================================================================================================
+
+    ALLOCATE(cosang(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_nearest','Error in allocation for cosang','','')
+
+    pa = pi/2.0 - latmod*pi/180.0 ! dist. between north pole and the point a 
+                                                      !! COLATITUDE, in radian
+    cospa = COS(pa)
+    sinpa = SIN(pa)
+
+    DO i = 1, iml
+
+       sincolat = SIN( pi/2.0 - lat5(i)*pi/180.0 ) !! sinus of the colatitude
+       coscolat = COS( pi/2.0 - lat5(i)*pi/180.0 ) !! cosinus of the colatitude
+
+       p = (lonmod-lon5(i))*pi/180.0 !! angle between a & b (between their meridian)in radians
+
+       !! dist(i) = ACOS( cospa*coscolat + sinpa*sincolat*COS(p))
+       cosang(i) = cospa*coscolat + sinpa*sincolat*COS(p) !! TL : cosang is maximum when angle is at minimal value  
+!! orthodromic distance between 2 points : cosang = cosinus (arc(AB)/R), with
+!R = Earth radius, then max(cosang) = max(cos(arc(AB)/R)), reached when arc(AB)/R is minimal, when
+! arc(AB) is minimal, thus when point B (corresponding grid point from LAI MAP) is the nearest from
+! modelled A point
+    ENDDO
+
+    ineartab = MAXLOC( cosang(:) )
+    inear = ineartab(1)
+
+    DEALLOCATE(cosang)
+  END SUBROUTINE slowproc_nearest
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_soilt
+!!
+!>\BRIEF         Interpolate the Zobler or Reynolds/USDA soil type map
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): Nov 2014, ADucharne
+!!
+!! MAIN OUTPUT VARIABLE(S): ::soiltype, ::clayfraction, bulk_density, soil_ph
+!!
+!! REFERENCE(S) : Reynold, Jackson, and Rawls (2000). Estimating soil water-holding capacities 
+!! by linking the Food and Agriculture Organization soil map of the world with global pedon
+!! databases and continuous pedotransfer functions, WRR, 36, 3653-3662
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_soilt(nbpt, lalo, neighbours, resolution, contfrac, soilclass, clayfraction, bulk_density, soil_ph)
+    !
+    !
+    !   This subroutine should read the Zobler/Reynolds map and interpolate to the model grid. 
+    !   The method is to get fraction of the three/12 main soiltypes for each grid box.
+    !   For the Zobler case, also called FAO in the code, the soil fraction are going to be put 
+    !   into the array soiltype in the following order : coarse, medium and fine.
+    !   For the Reynolds/USDA case, the soiltype array follows the order defined in constantes_soil_var.f90
+    !
+    !
+    !!  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)    :: nbpt                   !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)       :: lalo(nbpt,2)           !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)    :: neighbours(nbpt,8)     !! Vector of neighbours for each grid point 
+                                                            !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), INTENT(in)       :: resolution(nbpt,2)     !! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)         !! Fraction of land in each grid box.
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)      :: soilclass(nbpt, nscm)  !! Soil type map to be created from the Zobler map
+                                                            !! or a map defining the 12 USDA classes (e.g. Reynolds)
+                                                            !! Holds the area of each texture class in the ORCHIDEE grid cells
+                                                            !! Final unit = fraction of ORCHIDEE grid-cell (unitless)
+    REAL(r_std), INTENT(out)      :: clayfraction(nbpt)     !! The fraction of clay as used by STOMATE
+    REAL(r_std), INTENT(out)      :: bulk_density(nbpt)     !! The soil bulk density
+    REAL(r_std), INTENT(out)      :: soil_ph(nbpt)          !! The soil pH
+    !
+    !
+    !  0.3 LOCAL
+    !
+    INTEGER(i_std)               :: nbvmax
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, ilf, nbexp
+    INTEGER(i_std) :: fopt                                  !! Nb of pts from the texture map within one ORCHIDEE grid-cell
+    REAL(r_std) :: lev(1), datetmp, dttmp
+    INTEGER(i_std) :: itautmp(1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_rel, lon_rel
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: soiltext, soilbd, soilph    !! Input soil map (from netcdf file) (unitless)
+                                                            !! (with values from 0 to 7 if Zobler, from 1 to 12 if USDA)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: soiltext2   !! Auxiliary map read from netcdf, but not used
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)  :: sub_area   !! Areas of intersections between soil texture and ORCHIDEE's grid
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index !! to associate the coordinates of the texture 
+                                                                !! grid cells and the ORCHIDEE grid-cell covering them
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: resol_lu
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: solt       !! Texture the different points from the input texture map 
+                                                            !! in one ORCHIDEE grid cell (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: solt2      !! Unused
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: solbd, solph
+    REAL(r_std) ::  sgn, coslat
+    CHARACTER(LEN=30) :: callsign
+    INTEGER(i_std) :: nix, njx
+    !
+    ! Number of texture classes in Zobler
+    !
+    INTEGER(i_std), PARAMETER :: nzobler = 7                !! Nb of texture classes according in the Zobler map
+    REAL(r_std),ALLOCATABLE   :: textfrac_table(:,:)        !! conversion table between the texture index
+                                                            !! and the granulometric composition
+    !   
+    LOGICAL                  :: ok_interpol  ! optionnal return of aggregate_2d
+    !   
+    INTEGER                  :: ALLOC_ERR
+
+!_ ================================================================================================================================
+    !
+    IF (printlev_loc>=3) WRITE (numout,*) 'Entering slowproc_soilt'
+    !
+    !  Needs to be a configurable variable
+    !
+    !
+    !Config Key   = SOILCLASS_FILE
+    !Config Desc  = Name of file from which soil types are read
+    !Config Def   = soils_param.nc
+    !Config If    = NOT(IMPOSE_VEG)
+    !Config Help  = The name of the file to be opened to read the soil types. 
+    !Config         The data from this file is then interpolated to the grid of
+    !Config         of the model. The aim is to get fractions for sand loam and
+    !Config         clay in each grid box. This information is used for soil hydrology
+    !Config         and respiration.
+    !Config Units = [FILE]
+    !
+    ! soils_param.nc file is 1deg soil texture file (Zobler)
+    ! The USDA map from Reynolds is soils_param_usda.nc (1/12deg resolution)
+
+    filename = 'soils_param.nc'
+    CALL getin_p('SOILCLASS_FILE',filename)
+    !
+    IF (is_root_prc) THEN
+       CALL flininfo(filename,iml, jml, lml, tml, fid)
+       CALL flinclo(fid)
+    ENDIF
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    !
+    ! soils_param.nc file is 1° soit texture file.
+    !
+    ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for lat_rel','','')
+
+    ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for lon_rel','','')
+
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for mask','','')
+
+    ALLOCATE(soiltext(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for soiltext','','')
+
+    ALLOCATE(soilbd(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of soilbd : ",ALLOC_ERR
+      STOP
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(soilph(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of soilph : ",ALLOC_ERR
+      STOP
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(soiltext2(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for soiltext2','','')
+
+    ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for resol_lu','','')
+
+
+    IF (is_root_prc) CALL flinopen(filename, .FALSE., iml, jml, lml, lon_rel, lat_rel, lev, tml, itautmp, datetmp, dttmp, fid)
+    CALL bcast(lon_rel)
+    CALL bcast(lat_rel)
+    
+    !
+    IF (is_root_prc) CALL flinget(fid, 'soiltext', iml, jml, lml, tml, 1, 1, soiltext)
+    CALL bcast(soiltext)
+
+    IF (.NOT. impsoilt) THEN
+    IF (is_root_prc) CALL flinget(fid, 'soil_ph', iml, jml, lml, tml, 1, 1, soilph)
+    CALL bcast(soilph)
+    !
+    IF (is_root_prc) CALL flinget(fid, 'soilbd', iml, jml, lml, tml, 1, 1, soilbd)
+    CALL bcast(soilbd)
+    ENDIF
+    !
+    IF (is_root_prc) CALL flinclo(fid)
+    !
+    nbexp = 0
+    !
+    !
+    ! Mask of permitted variables.
+    !
+    mask(:,:) = zero
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          IF (soiltext(ip,jp) .GT. min_sechiba) THEN
+             mask(ip,jp) = un
+          ENDIF
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )     
+          IF ( ip .EQ. 1 ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip,jp) ) * pi/180. * R_Earth * coslat
+          ELSEIF ( ip .EQ. iml ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip,jp) - lon_rel(ip-1,jp) ) * pi/180. * R_Earth * coslat
+          ELSE
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp) - lat_rel(ip,jp+1) ) * pi/180. * R_Earth
+          ELSEIF ( jp .EQ. jml ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp) ) * pi/180. * R_Earth
+          ELSE
+             resol_lu(ip,jp,2) =  ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp+1) )/2. * pi/180. * R_Earth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some margin is taken.
+    !
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+       njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+       nbvmax = nix*njx
+    ENDIF
+    CALL bcast(nbvmax)
+    !
+    callsign = "Soil types"
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+    !WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+       ALLOCATE(solt(nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for solt','','')
+
+    !   ALLOCATE(solt2(nbvmax), STAT=ALLOC_ERR)
+    !   IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for solt2','','')
+
+    ALLOCATE(solt2(nbvmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of solt2 : ",ALLOC_ERR
+       STOP 
+    ENDIF
+       ALLOC_ERR=-1
+    ALLOCATE(solbd(nbvmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of solbd : ",ALLOC_ERR
+       STOP
+    ENDIF
+       ALLOC_ERR=-1
+    ALLOCATE(solph(nbvmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of solph : ",ALLOC_ERR
+       STOP
+    ENDIF
+
+    ALLOC_ERR=-1
+       ALLOCATE(sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for sub_index','','')
+       sub_index(:,:,:)=0
+
+       ALLOCATE(sub_area(nbpt,nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for sub_area','','')
+       sub_area(:,:)=zero
+       
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          DEALLOCATE(solt)
+          DEALLOCATE(solt2)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+    !
+    IF (printlev_loc>=4) WRITE (numout,*) 'slowproc_soilt: read/allocate OK'
+    !
+    SELECTCASE(soil_classif)
+    CASE('none')
+       ALLOCATE(textfrac_table(nscm,ntext), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for textfrac_table','','')
+       DO ib=1, nbpt
+          soilclass(ib,:) = soilclass_default_fao
+          clayfraction(ib) = clayfraction_default
+          bulk_density(ib) = bulk_density_default
+          soil_ph(ib) = soil_ph_default
+       ENDDO
+    CASE('zobler')
+       !
+       soilclass_default=soilclass_default_fao ! FAO means here 3 final texture classes
+       !
+       WRITE(numout,*) "Using a soilclass map with Zobler classification"
+       !
+       ALLOCATE(textfrac_table(nzobler,ntext), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for textfrac_table','','')
+       CALL get_soilcorr_zobler (nzobler, textfrac_table)
+       !
+       !
+       DO ib =1, nbpt
+          !
+          ! GO through the point we have found
+          !
+          !
+          fopt = COUNT(sub_area(ib,:) > zero)
+          !
+          !    Check that we found some points
+          !
+          soilclass(ib,:) = zero
+          clayfraction(ib) = zero
+          bulk_density(ib) = zero 
+          soil_ph(ib) = zero
+          !
+          IF ( fopt .EQ. 0) THEN
+             ! No points were found for current grid box, use default values
+             nbexp = nbexp + 1
+             soilclass(ib,:) = soilclass_default(:)
+             clayfraction(ib) = clayfraction_default
+             bulk_density(ib) = bulk_density_default
+             soil_ph(ib) = soil_ph_default
+          ELSE
+             !
+             DO ilf = 1,fopt
+                solt(ilf) = soiltext(sub_index(ib,ilf,1),sub_index(ib,ilf,2)) ! soiltext=classe zobler entre 1 et 7
+                solbd(ilf) = soilbd(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+                solph(ilf) = soilph(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+             ENDDO
+             !
+             sgn = zero
+             !
+             !   Compute the fraction of each textural class
+             !
+             DO ilf = 1,fopt
+                !
+                ! Here we make the correspondance between the 7 zobler textures and the 3 textures in ORCHIDEE
+                ! and soilclass correspond to surfaces covered by the 3 textures of ORCHIDEE (coase,medium,fine)
+                ! We have to take care of two exceptions here : type 6 = glacier and type 0 = ocean
+                !
+                IF ( (solt(ilf) .LE. nzobler) .AND. (solt(ilf) .GT. 0) .AND.&
+                     & (solt(ilf) .NE. 6)) THEN
+                   SELECTCASE(solt(ilf))
+                   CASE(1)
+                      soilclass(ib,1) = soilclass(ib,1) + sub_area(ib,ilf)
+                   CASE(2)
+                      soilclass(ib,2) = soilclass(ib,2) + sub_area(ib,ilf)
+                   CASE(3)
+                      soilclass(ib,2) = soilclass(ib,2) + sub_area(ib,ilf)
+                   CASE(4)
+                      soilclass(ib,2) = soilclass(ib,2) + sub_area(ib,ilf)
+                   CASE(5)
+                      soilclass(ib,3) = soilclass(ib,3) + sub_area(ib,ilf)
+                   CASE(7)
+                      soilclass(ib,2) = soilclass(ib,2) + sub_area(ib,ilf)
+                   CASE DEFAULT
+                      WRITE(numout,*) 'We should not be here, an impossible case appeared'
+                      CALL ipslerr_p(3,'slowproc_soilt','Bad value for solt','','')
+                   END SELECT
+                   ! clayfraction is the sum of the % of clay (as a mineral of small granulometry, and not as a texture)
+                   ! over the zobler pixels composing the ORCHIDEE grid-cell
+                   clayfraction(ib) = clayfraction(ib) + &
+                        & textfrac_table(solt(ilf),3) * sub_area(ib,ilf)
+                   bulk_density(ib) = bulk_density(ib) + solbd(ilf) * sub_area(ib,ilf) 
+                   soil_ph(ib) = soil_ph(ib) + solph(ilf)  * sub_area(ib,ilf)
+                   sgn = sgn + sub_area(ib,ilf)
+                ELSE
+                   IF (solt(ilf) .GT. nzobler) THEN
+                      WRITE(numout,*) 'The file contains a soil color class which is incompatible with this program'
+                      CALL ipslerr_p(3,'slowproc_soilt','Problem soil color class incompatible','','')
+                   ENDIF
+                ENDIF
+                !
+             ENDDO
+             !
+             ! Normalize the surface => from areas to fractions 
+             !
+             IF ( sgn .LT. min_sechiba) THEN
+                nbexp = nbexp + 1
+                soilclass(ib,:) = soilclass_default(:)
+                clayfraction(ib) = clayfraction_default
+                bulk_density(ib) = bulk_density_default
+                soil_ph(ib) = soil_ph_default
+             ELSE
+                soilclass(ib,:) = soilclass(ib,:)/sgn
+                clayfraction(ib) = clayfraction(ib)/sgn
+                bulk_density(ib) = bulk_density(ib)/sgn
+                soil_ph(ib) = soil_ph(ib)/sgn
+             ENDIF
+             !
+          ENDIF
+       ENDDO
+   
+    ! The "USDA" case reads a map of the 12 USDA texture classes, 
+    ! such as to assign the corresponding soil properties
+    CASE("usda")
+       !
+       IF (printlev_loc>=4) WRITE (numout,*) 'slowproc_soilt: start case usda'
+
+       soilclass_default=soilclass_default_usda
+       !
+       WRITE(numout,*) "Using a soilclass map with usda classification"
+       !
+       ALLOCATE(textfrac_table(nscm,ntext), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for textfrac_table','','')
+
+       CALL get_soilcorr_usda (nscm, textfrac_table)
+
+       IF (printlev_loc>=4) WRITE (numout,*) 'slowproc_soilt: After get_soilcorr_usda'
+       !
+       DO ib =1, nbpt
+          !
+          ! GO through the point we have found
+          !
+          !
+          fopt = COUNT(sub_area(ib,:) > zero)
+          !
+          !    Check that we found some points
+          !
+          soilclass(ib,:) = 0.0
+          clayfraction(ib) = 0.0
+          bulk_density(ib) = 0.0
+          soil_ph(ib) = 0.0
+          !
+          IF ( fopt .EQ. 0) THEN
+             nbexp = nbexp + 1
+             soilclass(ib,:) = soilclass_default
+             clayfraction(ib) = clayfraction_default
+             bulk_density(ib) = bulk_density_default
+             soil_ph(ib) = soil_ph_default
+          ELSE
+             !
+             DO ilf = 1,fopt
+                solt(ilf) = soiltext(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+                solbd(ilf) = soilbd(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+                solph(ilf) = soilph(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+             ENDDO
+
+             !
+             !
+             !   Compute the fraction of each textural class  
+             !
+             sgn = zero
+             !
+             DO ilf = 1,fopt
+                !
+                ! 
+                !
+                IF ( (solt(ilf) .LE. nscm) .AND. (solt(ilf) .GT. 0) ) THEN
+                   soilclass(ib,solt(ilf)) = soilclass(ib,solt(ilf)) + sub_area(ib,ilf)
+                   clayfraction(ib) = clayfraction(ib) + textfrac_table(solt(ilf),3) * sub_area(ib,ilf)
+                   bulk_density(ib) = bulk_density(ib) + solbd(ilf) * sub_area(ib,ilf)
+                   soil_ph(ib) = soil_ph(ib) + solph(ilf)  * sub_area(ib,ilf)
+
+                   sgn = sgn + sub_area(ib,ilf)
+                ELSE
+                   IF (solt(ilf) .GT. nscm) THEN
+                      WRITE(*,*) 'The file contains a soil color class which is incompatible with this program'
+                      CALL ipslerr_p(3,'slowproc_soilt','Problem soil color class incompatible 2','','')
+                   ENDIF
+                ENDIF
+                !
+             ENDDO
+             !
+             ! Normalize the surface
+             !
+             IF ( sgn .LT. min_sechiba) THEN
+                nbexp = nbexp + 1
+                soilclass(ib,:) = soilclass_default(:)
+                clayfraction(ib) = clayfraction_default
+                bulk_density(ib) = bulk_density_default
+                soil_ph(ib) = soil_ph_default
+             ELSE
+                soilclass(ib,:) = soilclass(ib,:)/sgn
+                clayfraction(ib) = clayfraction(ib)/sgn
+                bulk_density(ib) = bulk_density(ib)/sgn
+                soil_ph(ib) = soil_ph(ib)/sgn
+             ENDIF
+             !
+          ENDIF
+          !
+       ENDDO
+       
+       IF (printlev_loc>=4) WRITE (numout,*) 'slowproc_soilt: End case usda'
+       !
+    CASE DEFAULT
+       WRITE(*,*) 'A non supported soil type classification has been chosen'
+       CALL ipslerr_p(3,'slowproc_soilt','non supported soil type classification','','')
+    ENDSELECT
+    !
+    WRITE(numout,*) 'Interpolation Done'
+       !
+    IF ( nbexp .GT. 0 ) THEN
+       WRITE(numout,*) 'slowproc_soilt : The interpolation of the bare soil albedo had ', nbexp
+       WRITE(numout,*) 'slowproc_soilt : points without data. This are either coastal points or'
+       WRITE(numout,*) 'slowproc_soilt : ice covered land.'
+       WRITE(numout,*) 'slowproc_soilt : The problem was solved by using the default soil types.'
+    ENDIF
+    !
+    DEALLOCATE (lat_rel)
+    DEALLOCATE (lon_rel)
+    DEALLOCATE (mask)
+    DEALLOCATE (sub_area)
+    DEALLOCATE (sub_index)
+    DEALLOCATE (soiltext)
+    DEALLOCATE (soilbd)
+    DEALLOCATE (soilph)
+    DEALLOCATE (solt)
+    DEALLOCATE (soiltext2)
+    DEALLOCATE (solt2)
+    DEALLOCATE (textfrac_table)
+    DEALLOCATE (resol_lu)
+
+  END SUBROUTINE slowproc_soilt
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_slope
+!!
+!>\BRIEF         Calculate mean slope coef in each  model grid box from the slope map
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::reinf_slope
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_slope(nbpt, lalo, neighbours, resolution, contfrac, reinf_slope)
+    !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)          :: nbpt                  ! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)              :: lalo(nbpt,2)          ! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)          :: neighbours(nbpt,8)    ! Vector of neighbours for each grid point 
+    ! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), INTENT(in)              :: resolution(nbpt,2)    ! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT (in)             :: contfrac(nbpt)         !! Fraction of continent in the grid
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)    ::  reinf_slope(nbpt)                   ! slope coef 
+    !
+    !  0.3 LOCAL
+    !
+    !
+    REAL(r_std)  :: slope_noreinf                 ! Slope above which runoff is maximum
+    CHARACTER(LEN=80) :: filename
+    CHARACTER(LEN=30) :: callsign
+    INTEGER(i_std)    :: iml, jml, lml, tml, fid, ib, ip, jp, vid
+    INTEGER(i_std)    :: idi, idi_last, nbvmax
+    REAL(r_std)        :: slopecoef, coslat
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sub_index
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: lat_rel, lon_rel, slopemap
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)      :: lat_lu, lon_lu
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: resol_lu
+    INTEGER(i_std) :: nix, njx
+    !
+    LOGICAL ::           ok_interpol = .FALSE. ! optionnal return of aggregate_2d
+    !
+    INTEGER                  :: ALLOC_ERR
+!_ ================================================================================================================================
+
+    !
+    !Config Key   = SLOPE_NOREINF
+    !Config Desc  = See slope_noreinf above
+    !Config If    = 
+    !Config Def   = 0.5
+    !Config Help  = The slope above which there is no reinfiltration
+    !Config Units = [-]
+    !
+    slope_noreinf = 0.5
+    !
+    CALL getin_p('SLOPE_NOREINF',slope_noreinf)
+    !
+    !Config Key   = TOPOGRAPHY_FILE
+    !Config Desc  = Name of file from which the topography map is to be read
+    !Config If    = 
+    !Config Def   = cartepente2d_15min.nc
+    !Config Help  = The name of the file to be opened to read the orography
+    !Config         map is to be given here. Usualy SECHIBA runs with a 2'
+    !Config         map which is derived from the NGDC one. 
+    !Config Units = [FILE]
+    !
+    filename = 'cartepente2d_15min.nc'
+    CALL getin_p('TOPOGRAPHY_FILE',filename)
+    !
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    
+    ALLOCATE(lat_lu(jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable lat_lu','','')
+
+    ALLOCATE(lon_lu(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable lon_lu','','')
+
+    ALLOCATE(slopemap(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable slopemap','','')
+
+    ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable resol_lu','','')
+
+    WRITE(numout,*) 'Reading the topography file'
+
+    IF (is_root_prc) THEN
+       CALL flinget(fid, 'longitude', iml, 0, 0, 0, 1, 1, lon_lu)
+       CALL flinget(fid, 'latitude', jml, 0, 0, 0, 1, 1, lat_lu)
+       CALL flinget(fid, 'pente', iml, jml, 0, 0, 1, 1, slopemap)
+       !
+       CALL flinclo(fid)
+    ENDIF
+    CALL bcast(lon_lu)
+    CALL bcast(lat_lu)
+    CALL bcast(slopemap)
+    
+    ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable lon_rel','','')
+
+    ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable lat_rel','','')
+
+    DO ip=1,iml
+       lat_rel(ip,:) = lat_lu(:)
+    ENDDO
+    DO jp=1,jml
+       lon_rel(:,jp) = lon_lu(:)
+    ENDDO
+    !
+    !
+    ! Mask of permitted variables.
+    !
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable mask','','')
+
+    mask(:,:) = zero
+    DO ip=1,iml
+       DO jp=1,jml
+          IF (slopemap(ip,jp) .GT. min_sechiba) THEN
+             mask(ip,jp) = un
+          ENDIF
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )     
+          IF ( ip .EQ. 1 ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip,jp) ) * pi/180. * R_Earth * coslat
+          ELSEIF ( ip .EQ. iml ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip,jp) - lon_rel(ip-1,jp) ) * pi/180. * R_Earth * coslat
+          ELSE
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp) - lat_rel(ip,jp+1) ) * pi/180. * R_Earth
+          ELSEIF ( jp .EQ. jml ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp) ) * pi/180. * R_Earth
+          ELSE
+             resol_lu(ip,jp,2) =  ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp+1) )/2. * pi/180. * R_Earth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+       njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+       nbvmax = nix*njx
+    ENDIF
+    CALL bcast(nbvmax)
+    !
+    callsign="Slope map"
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       !
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+       WRITE(numout,*) "nbvmax = ",nbvmax
+
+       ALLOCATE(sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable sub_index','','')
+       sub_index(:,:,:)=0
+
+       ALLOCATE(sub_area(nbpt,nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable sub_area','','')
+       sub_area(:,:)=zero
+
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       IF (.NOT. ok_interpol ) THEN
+          IF (printlev_loc>=3) WRITE(numout,*) 'nbvmax will be increased from ',nbvmax,' to ', nbvmax*2
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       END IF
+    END DO
+    !
+    !
+    DO ib = 1, nbpt
+      !-
+      !- Reinfiltration coefficient due to the slope: Calculation with parameteres maxlope_ro 
+      !-
+      slopecoef = zero
+
+      ! Initialize last index to the highest possible 
+      idi_last=nbvmax
+      DO idi=1, nbvmax
+         ! Leave the do loop if all sub areas are treated, sub_area <= 0
+         IF ( sub_area(ib,idi) <= zero ) THEN
+            ! Set last index to the last one used
+            idi_last=idi-1
+            ! Exit do loop
+            EXIT
+         END IF
+
+         ip = sub_index(ib,idi,1)
+         jp = sub_index(ib,idi,2)
+
+         slopecoef = slopecoef + MIN(slopemap(ip,jp)/slope_noreinf, un) * sub_area(ib,idi)
+      ENDDO
+
+      IF ( idi_last >= 1 ) THEN
+         reinf_slope(ib) = un - slopecoef / SUM(sub_area(ib,1:idi_last)) 
+      ELSE
+         reinf_slope(ib) = slope_default
+      ENDIF
+    ENDDO
+    !
+    !
+    WRITE(numout,*) 'Interpolation Done'
+    !
+    !
+    DEALLOCATE(slopemap)
+    DEALLOCATE(sub_index)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(mask)
+    DEALLOCATE(lon_lu)
+    DEALLOCATE(lat_lu)
+    DEALLOCATE(lon_rel)
+    DEALLOCATE(lat_rel)
+
+  END SUBROUTINE slowproc_slope
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: get_vegcorr
+!!
+!>\BRIEF         The "get_vegcorr" routine defines the table of correspondence
+!!               between the 94 Olson vegetation types and the 13 Plant Functional Types known 
+!!               by SECHIBA and STOMATE. Used by slowproc for the old interpolation.
+!!
+!!\DESCRIPTION : get_vegcorr is needed if you use the old_map carteveg5km.nc. \n
+!!               Usually SECHIBA can run with a 5kmx5km map which is derived from the IGBP one. \n
+!!               We assume that we have a classification in 94 types. This is Olson one modified by Nicolas Viovy.\n
+!!               ORCHIDEE has to convert the Olson vegetation types into PFTs for the run (interpolation step).\n
+!!               Each Olson matches to a combination of fractions of one or several PFTs.\n
+!!               This routine uses the same process for the non-biospheric map (not used).\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vegcorr, ::nobiocorr.
+!!
+!! REFERENCE(S)	: 
+!! - Olson, J.S., J.A. Watts, and L.J. Allison., 1983. 
+!! "Carbon in Live Vegetation of Major World Ecosystems." 
+!! Report ORNL-5862. Oak Ridge National Laboratory, Oak Ridge, Tennessee. 
+!! - Olson, J.S., J.A. Watts, and L.J. Allison., 1985. 
+!! "Major World Ecosystem Complexes Ranked by Carbon in Live Vegetation: A Database." 
+!! NDP-017. Carbon Dioxide Information Center, Oak Ridge National Laboratory, Oak Ridge, Tennessee.
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE get_vegcorr (nolson,vegcorr,nobiocorr)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+    
+    INTEGER(i_std),PARAMETER :: nolson94 = 94                       !! Number of Olson vegetation types (unitless)
+    INTEGER(i_std),PARAMETER :: nvm13 = 13                          !! Number of PFTS of ORCHIDEE (unitless) 
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in) :: nolson                             !! Number of Olson vegetation types (unitless)
+    
+    !! 0.2 Output variables 
+
+    REAL(r_std),DIMENSION(nolson,nvm),INTENT(out) :: vegcorr        !! Correspondence array between Olson types and PFTS 
+                                                                    !! (0-1, unitless)
+    REAL(r_std),DIMENSION(nolson,nnobio),INTENT(out) :: nobiocorr   !! Correspondence array between non-vegetation types and nobio 
+                                                                    !! types (lake,etc..) (0-1, unitless)
+
+    !! 0.4 Local variable
+    
+    INTEGER(i_std) :: ib                                            !! Indice (unitless)
+    
+ !_ ================================================================================================================================
+
+    !-
+    ! 0. Check consistency
+    !-
+    IF (nolson /= nolson94) THEN
+       WRITE(numout,*) nolson,nolson94
+       CALL ipslerr_p(3,'get_vegcorr', '', '',&
+            &                 'wrong number of OLSON vegetation types.') ! Fatal error
+    ENDIF !(nolson /= nolson94)
+    
+    IF (nvm /= nvm13) THEN
+       WRITE(numout,*) nvm,nvm13
+       CALL ipslerr_p(3,'get_vegcorr', '', '',&
+            &                 'wrong number of SECHIBA vegetation types.') ! Fatal error
+    ENDIF !(nvm /= nvm13)
+
+    ! The carteveg5km cannot be used if the PFTs are not in the standard order
+    DO ib = 1,nvm
+       IF (pft_to_mtc(ib) /= ib ) THEN
+          CALL ipslerr_p(3,'get_vegcorr','You have redefined the order of the 13 PFTS', & 
+               &          'You can not use carteveg5km', 'Use the standard configuration of PFTS' )
+       ENDIF
+    ENDDO
+
+    !-
+    ! 1 set the indices of non-biospheric surface types to 0.
+    !-
+    nobiocorr(:,:) = zero
+    !-
+    ! 2 Here we construct the correspondance table
+    !   between Olson and the following SECHIBA Classes.
+    !   vegcorr(i,:)+nobiocorr(i,:) = 1.  for all i.
+    !-
+    ! The modified OLSON types found in file carteveg5km.nc
+    ! created by Nicolas Viovy :
+    !  1 Urban
+    vegcorr( 1,:) = &
+         & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    !  2 Cool low sparse grassland
+    vegcorr( 2,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    !  3 Cold conifer forest
+    vegcorr( 3,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    !  4 Cold deciduous conifer forest
+    vegcorr( 4,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0/)
+    !  5 Cool Deciduous broadleaf forest
+    vegcorr( 5,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    !  6 Cool evergreen broadleaf forests
+    vegcorr( 6,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    !  7 Cool tall grasses and shrubs
+    vegcorr( 7,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    !  8 Warm C3 tall grasses and shrubs
+    vegcorr( 8,:) = &
+         & (/0.1, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    !  9 Warm C4 tall grases and shrubs
+    vegcorr( 9,:) = &
+         & (/0.1, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0/)
+    ! 10 Bare desert
+    vegcorr(10,:) = &
+         & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 11 Cold upland tundra
+    vegcorr(11,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    ! 12 Cool irrigated grassland
+    vegcorr(12,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.0/)
+    ! 13 Semi desert
+    vegcorr(13,:) = &
+         & (/0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
+    ! 14 Glacier ice
+    vegcorr(14,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    nobiocorr(14,iice) = 1.
+    ! 15 Warm wooded wet swamp
+    vegcorr(15,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0/)
+    ! 16 Inland water
+    vegcorr(16,:) = &
+         & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 17 sea water
+    vegcorr(17,:) = &
+         & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 18 cool shrub evergreen
+    vegcorr(18,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 19 cold shrub deciduous
+    vegcorr(19,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 20 Cold evergreen forest and fields
+    vegcorr(20,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0/)
+    ! 21 cool rain forest
+    vegcorr(21,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 22 cold conifer boreal forest
+    vegcorr(22,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 23 cool conifer forest
+    vegcorr(23,:) = &
+         & (/0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 24 warm mixed forest
+    vegcorr(24,:) = &
+         & (/0.0, 0.4, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0/)
+    ! 25 cool mixed forest
+    vegcorr(25,:) = &
+         & (/0.0, 0.0, 0.0, 0.4, 0.0, 0.4, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 26 cool broadleaf forest
+    vegcorr(26,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0/)
+    ! 27 cool deciduous broadleaf forest
+    vegcorr(27,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.3, 0.5, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 28 warm montane tropical forest
+    vegcorr(28,:) = &
+         & (/0.0, 0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0/)
+    ! 29 warm seasonal tropical forest
+    vegcorr(29,:) = &
+         & (/0.0, 0.5, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0/)
+    ! 30 cool crops and towns
+    vegcorr(30,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0/)
+    ! 31 warm crops and towns
+    vegcorr(31,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8/)
+    ! 32 cool crops and towns
+    vegcorr(32,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0/)
+    ! 33 warm dry tropical woods
+    vegcorr(33,:) = &
+         & (/0.2, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
+    ! 34 warm tropical rain forest
+    vegcorr(34,:) = &
+         & (/0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 35 warm tropical degraded forest
+    vegcorr(35,:) = &
+         & (/0.1, 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0/)
+    ! 36 warm corn and beans cropland
+    vegcorr(36,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0/)
+    ! 37 cool corn and bean cropland
+    vegcorr(37,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/)
+    ! 38 warm rice paddy and field
+    vegcorr(38,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0/)
+    ! 39 hot irrigated cropland
+    vegcorr(39,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0/)
+    ! 40 cool irrigated cropland
+    vegcorr(40,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/)
+    ! 41 cold irrigated cropland
+    vegcorr(41,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/)
+    ! 42 cool grasses and shrubs
+    vegcorr(42,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0/)
+    ! 43 hot and mild grasses and shrubs
+    vegcorr(43,:) = &
+         & (/0.2, 0.0, 0.1, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0/)
+    ! 44 cold grassland
+    vegcorr(44,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.0/)
+    ! 45 Savanna (woods) C3
+    vegcorr(45,:) = &
+         & (/0.1, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0/)
+    ! 46 Savanna woods C4
+    vegcorr(46,:) = &
+         & (/0.1, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0/)
+    ! 47 Mire, bog, fen
+    vegcorr(47,:) = &
+         & (/0.1, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0/)
+    ! 48 Warm marsh wetland
+    vegcorr(48,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    ! 49 cold marsh wetland
+    vegcorr(49,:) = &
+         & (/0.0, 0.0, 0.0, 0.1, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    ! 50 mediteraean scrub
+    vegcorr(50,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    ! 51 Cool dry woody scrub
+    vegcorr(51,:) = &
+         & (/0.3, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 52 Warm dry evergreen woods
+    vegcorr(52,:) = &
+         & (/0.1, 0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 53 Volcanic rocks
+    vegcorr(53,:) = &
+         & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 54 sand desert
+    vegcorr(54,:) = &
+         & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 55 warm semi desert shrubs
+    vegcorr(55,:) = &
+         & (/0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
+    ! 56 cool semi desert shrubs
+    vegcorr(56,:) = &
+         & (/0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0/)
+    ! 57 semi desert sage
+    vegcorr(57,:) = &
+         & (/0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 58 Barren tundra
+    vegcorr(58,:) = &
+         & (/0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0/)
+    ! 59 cool southern hemisphere mixed forest
+    vegcorr(59,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.3, 0.3, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
+    ! 60 cool fields and woods
+    vegcorr(60,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
+    ! 61 warm forest and filed
+    vegcorr(61,:) = &
+         & (/0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6/)
+    ! 62 cool forest and field
+    vegcorr(62,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
+    ! 63 warm C3 fields and woody savanna
+    vegcorr(63,:) = &
+         & (/0.1, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
+    ! 64 warm C4 fields and woody savanna
+    vegcorr(64,:) = &
+         & (/0.1, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6/)
+    ! 65 cool fields and woody savanna
+    vegcorr(65,:) = &
+         & (/0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
+    ! 66 warm succulent and thorn scrub
+    vegcorr(66,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    ! 67 cold small leaf mixed woods
+    vegcorr(67,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.3, 0.0, 0.5, 0.0, 0.0, 0.0/)
+    ! 68 cold deciduous and mixed boreal fores
+    vegcorr(68,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
+    ! 69 cold narrow conifers
+    vegcorr(69,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0/)
+    ! 70 cold wooded tundra
+    vegcorr(70,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.7, 0.0, 0.0, 0.0/)
+    ! 71 cold heath scrub
+    vegcorr(71,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.7, 0.0, 0.0, 0.0/)
+    ! 72 Polar and alpine desert
+    vegcorr(72,:) = &
+         & (/0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0/)
+    ! 73 warm Mangrove
+    vegcorr(73,:) = &
+         & (/0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 74 cool crop and water mixtures
+    vegcorr(74,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
+    ! 75 cool southern hemisphere mixed forest
+    vegcorr(75,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.4, 0.4, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 76 cool moist eucalyptus
+    vegcorr(76,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 77 warm rain green tropical forest
+    vegcorr(77,:) = &
+         & (/0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 78 warm C3 woody savanna
+    vegcorr(78,:) = &
+         & (/0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 79 warm C4 woody savanna
+    vegcorr(79,:) = &
+         & (/0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0/)
+    ! 80 cool woody savanna
+    vegcorr(80,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 81 cold woody savanna
+    vegcorr(81,:) = &
+         & (/0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 82 warm broadleaf crops
+    vegcorr(82,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0/)
+    ! 83 warm C3 grass crops
+    vegcorr(83,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0/)
+    ! 84 warm C4 grass crops
+    vegcorr(84,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9/)
+    ! 85 cool grass crops
+    vegcorr(85,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/)
+    ! 86 warm C3 crops grass,shrubs
+    vegcorr(86,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0/)
+    ! 87 cool crops,grass,shrubs
+    vegcorr(87,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.5, 0.0/)
+    ! 88 warm evergreen tree crop
+    vegcorr(88,:) = &
+         & (/0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2/)
+    ! 89 cool evergreen tree crop
+    vegcorr(89,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0/)
+    ! 90 cold evergreen tree crop
+    vegcorr(90,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0/)
+    ! 91 warm deciduous tree crop
+    vegcorr(91,:) = &
+         & (/0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2/)
+    ! 92 cool deciduous tree crop
+    vegcorr(92,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0/)
+    ! 93 cold deciduous tree crop
+    vegcorr(93,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.2, 0.0/)
+    ! 94 wet sclerophylic forest
+    vegcorr(94,:) = &
+         & (/0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    !-
+    ! 3 Check the mapping for the Olson types which are going into the
+    !   the veget and nobio array.
+    !-
+    DO ib=1,nolson
+       !
+       IF ( ABS(SUM(vegcorr(ib,:))+SUM(nobiocorr(ib,:))-1.0) &
+            &       > EPSILON(1.0)) THEN
+          WRITE(numout,*) 'Wrong correspondance for Olson type :', ib
+          CALL ipslerr_p(3,'get_vegcorr', '', '',&
+               &                 'Wrong correspondance for Olson type.') ! Fatal error
+       ENDIF
+       !
+    ENDDO ! Loop over the # Olson type
+
+
+  END SUBROUTINE get_vegcorr
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: get_soilcorr_zobler
+!!
+!>\BRIEF         The "get_soilcorr" routine defines the table of correspondence
+!!               between the Zobler types and the three texture types known by SECHIBA and STOMATE :
+!!               silt, sand and clay. 
+!!
+!! DESCRIPTION : get_soilcorr is needed if you use soils_param.nc .\n
+!!               The data from this file is then interpolated to the grid of the model. \n
+!!               The aim is to get fractions for sand loam and clay in each grid box.\n
+!!               This information is used for soil hydrology and respiration.
+!!
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::texfrac_table
+!!
+!! REFERENCE(S)	: 
+!! - Zobler L., 1986, A World Soil File for global climate modelling. NASA Technical memorandum 87802. NASA 
+!!   Goddard Institute for Space Studies, New York, U.S.A.
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE get_soilcorr_zobler (nzobler,textfrac_table)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+    
+    INTEGER(i_std),PARAMETER :: nbtypes_zobler = 7                    !! Number of Zobler types (unitless)
+
+    !! 0.1  Input variables
+    
+    INTEGER(i_std),INTENT(in) :: nzobler                              !! Size of the array (unitless)
+    
+    !! 0.2 Output variables 
+    
+    REAL(r_std),DIMENSION(nzobler,ntext),INTENT(out) :: textfrac_table !! Table of correspondence between soil texture class
+                                                                       !! and granulometric composition (0-1, unitless)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std) :: ib                                              !! Indice (unitless)
+    
+!_ ================================================================================================================================
+
+    !-
+    ! 0. Check consistency
+    !-  
+    IF (nzobler /= nbtypes_zobler) THEN 
+       CALL ipslerr_p(3,'get_soilcorr', 'nzobler /= nbtypes_zobler',&
+          &   'We do not have the correct number of classes', &
+          &                 ' in the code for the file.')  ! Fatal error
+    ENDIF
+
+    !-
+    ! 1. Textural fraction for : silt        sand         clay
+    !-
+    textfrac_table(1,:) = (/ 0.12, 0.82, 0.06 /)
+    textfrac_table(2,:) = (/ 0.32, 0.58, 0.10 /)
+    textfrac_table(3,:) = (/ 0.39, 0.43, 0.18 /)
+    textfrac_table(4,:) = (/ 0.15, 0.58, 0.27 /)
+    textfrac_table(5,:) = (/ 0.34, 0.32, 0.34 /)
+    textfrac_table(6,:) = (/ 0.00, 1.00, 0.00 /)
+    textfrac_table(7,:) = (/ 0.39, 0.43, 0.18 /)
+
+
+    !-
+    ! 2. Check the mapping for the Zobler types which are going into the ORCHIDEE textures classes 
+    !-
+    DO ib=1,nzobler ! Loop over # classes soil
+       
+       IF (ABS(SUM(textfrac_table(ib,:))-1.0) > EPSILON(1.0)) THEN ! The sum of the textural fractions should not exceed 1 !
+          WRITE(numout,*) &
+               &     'Error in the correspondence table', &
+               &     ' sum is not equal to 1 in', ib
+          WRITE(numout,*) textfrac_table(ib,:)
+          CALL ipslerr_p(3,'get_soilcorr', 'SUM(textfrac_table(ib,:)) /= 1.0',&
+               &                 '', 'Error in the correspondence table') ! Fatal error
+       ENDIF
+       
+    ENDDO ! Loop over # classes soil
+
+    
+  END SUBROUTINE get_soilcorr_zobler
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: get_soilcorr_usda
+!!
+!>\BRIEF         The "get_soilcorr_usda" routine defines the table of correspondence
+!!               between the 12 USDA textural classes and their granulometric composition, 
+!!               as % of silt, sand and clay. This is used to further defien clayfraction.
+!!
+!! DESCRIPTION : get_soilcorr is needed if you use soils_param.nc .\n
+!!               The data from this file is then interpolated to the grid of the model. \n
+!!               The aim is to get fractions for sand loam and clay in each grid box.\n
+!!               This information is used for soil hydrology and respiration.
+!!               The default map in this case is derived from Reynolds et al 2000, \n
+!!               at the 1/12deg resolution, with indices that are consistent with the \n
+!!               textures tabulated below
+!!
+!! RECENT CHANGE(S): Created by A. Ducharne on July 02, 2014
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::texfrac_table
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE get_soilcorr_usda (nusda,textfrac_table)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+    
+    !! 0.1  Input variables
+    
+    INTEGER(i_std),INTENT(in) :: nusda                               !! Size of the array (unitless)
+    
+    !! 0.2 Output variables 
+    
+    REAL(r_std),DIMENSION(nusda,ntext),INTENT(out) :: textfrac_table !! Table of correspondence between soil texture class
+                                                                     !! and granulometric composition (0-1, unitless)
+    
+    !! 0.4 Local variables
+
+    INTEGER(i_std),PARAMETER :: nbtypes_usda = 12                    !! Number of USDA texture classes (unitless)
+    INTEGER(i_std) :: n                                              !! Index (unitless)
+    
+!_ ================================================================================================================================
+
+    !-
+    ! 0. Check consistency
+    !-  
+    IF (nusda /= nbtypes_usda) THEN 
+       CALL ipslerr_p(3,'get_soilcorr', 'nusda /= nbtypes_usda',&
+          &   'We do not have the correct number of classes', &
+          &                 ' in the code for the file.')  ! Fatal error
+    ENDIF
+
+    !! Parameters for soil type distribution :
+    !! Sand, Loamy Sand, Sandy Loam, Silt Loam, Silt, Loam, Sandy Clay Loam, Silty Clay Loam, Clay Loam, Sandy Clay, Silty Clay, Clay
+    ! The order comes from constantes_soil.f90
+    ! The corresponding granulometric composition comes from Carsel & Parrish, 1988
+
+    !-
+    ! 1. Textural fractions for : sand, clay
+    !-
+    textfrac_table(1,2:3)  = (/ 0.93, 0.03 /) ! Sand
+    textfrac_table(2,2:3)  = (/ 0.81, 0.06 /) ! Loamy Sand
+    textfrac_table(3,2:3)  = (/ 0.63, 0.11 /) ! Sandy Loam
+    textfrac_table(4,2:3)  = (/ 0.17, 0.19 /) ! Silt Loam
+    textfrac_table(5,2:3)  = (/ 0.06, 0.10 /) ! Silt
+    textfrac_table(6,2:3)  = (/ 0.40, 0.20 /) ! Loam
+    textfrac_table(7,2:3)  = (/ 0.54, 0.27 /) ! Sandy Clay Loam
+    textfrac_table(8,2:3)  = (/ 0.08, 0.33 /) ! Silty Clay Loam
+    textfrac_table(9,2:3)  = (/ 0.30, 0.33 /) ! Clay Loam
+    textfrac_table(10,2:3) = (/ 0.48, 0.41 /) ! Sandy Clay
+    textfrac_table(11,2:3) = (/ 0.06, 0.46 /) ! Silty Clay
+    textfrac_table(12,2:3) = (/ 0.15, 0.55 /) ! Clay
+
+    ! Fraction of silt
+
+    DO n=1,nusda
+       textfrac_table(n,1) = 1. - textfrac_table(n,2) - textfrac_table(n,3)
+    END DO
+       
+  END SUBROUTINE get_soilcorr_usda
+
+!! ================================================================================================================================
+!! FUNCTION 	: tempfunc
+!!
+!>\BRIEF        ! This function interpolates value between ztempmin and ztempmax
+!! used for lai detection. 
+!!
+!! DESCRIPTION   : This subroutine calculates a scalar between 0 and 1 with the following equation :\n
+!!                 \latexonly
+!!                 \input{constantes_veg_tempfunc.tex}
+!!                 \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : tempfunc_result
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION tempfunc (temp_in) RESULT (tempfunc_result)
+
+
+    !! 0. Variables and parameters declaration
+
+    REAL(r_std),PARAMETER    :: ztempmin=273._r_std   !! Temperature for laimin (K)
+    REAL(r_std),PARAMETER    :: ztempmax=293._r_std   !! Temperature for laimax (K)
+    REAL(r_std)              :: zfacteur              !! Interpolation factor   (K^{-2})
+
+    !! 0.1 Input variables
+
+    REAL(r_std),INTENT(in)   :: temp_in               !! Temperature (K)
+
+    !! 0.2 Result
+
+    REAL(r_std)              :: tempfunc_result       !! (unitless)
+    
+!_ ================================================================================================================================
+
+    !! 1. Define a coefficient
+    zfacteur = un/(ztempmax-ztempmin)**2
+    
+    !! 2. Computes tempfunc
+    IF     (temp_in > ztempmax) THEN
+       tempfunc_result = un
+    ELSEIF (temp_in < ztempmin) THEN
+       tempfunc_result = zero
+    ELSE
+       tempfunc_result = un-zfacteur*(ztempmax-temp_in)**2
+    ENDIF !(temp_in > ztempmax)
+
+
+  END FUNCTION tempfunc
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_checkveget
+!!
+!>\BRIEF         To verify the consistency of the various fractions defined within the grid box after having been
+!!               been updated by STOMATE or the standard procedures.
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: none
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!
+  SUBROUTINE slowproc_checkveget(nbpt, frac_nobio, veget_max, veget, tot_bare_soil, soiltile)
+
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)                      :: nbpt       ! Number of points for which the data needs to be interpolated
+    REAL(r_std),DIMENSION (nbpt,nnobio), INTENT(in) :: frac_nobio ! Fraction of ice,lakes,cities, ... (unitless)
+    REAL(r_std),DIMENSION (nbpt,nvm), INTENT(in)    :: veget_max  ! Maximum fraction of vegetation type including none biological fraction (unitless) 
+    REAL(r_std),DIMENSION (nbpt,nvm), INTENT(in)    :: veget      ! Vegetation fractions
+    REAL(r_std),DIMENSION (nbpt), INTENT(in)        :: tot_bare_soil ! Total evaporating bare soil fraction 
+    REAL(r_std),DIMENSION (nbpt,nstm), INTENT(in)   :: soiltile   ! Fraction of soil tiles in the gridbox (unitless)
+
+    !  0.3 LOCAL
+    !
+    INTEGER(i_std) :: ji, jn, jv, js
+    REAL(r_std)  :: epsilocal  !! A very small value
+    REAL(r_std)  :: totfrac
+    CHARACTER(len=80) :: str1, str2
+    
+!_ ================================================================================================================================
+    
+    !
+    ! There is some margin added as the computing errors might bring us above EPSILON(un)
+    !
+    epsilocal = EPSILON(un)*1000.
+    
+    !! 1.0 Verify that none of the fractions are smaller than min_vegfrac, without beeing zero.
+    !!
+    DO ji=1,nbpt
+       DO jn=1,nnobio
+          IF ( frac_nobio(ji,jn) > epsilocal .AND. frac_nobio(ji,jn) < min_vegfrac ) THEN
+             WRITE(str1,'("Occurs on grid box", I8," and nobio type ",I3 )') ji, jn
+             WRITE(str2,'("The small value obtained is ", E14.4)') frac_nobio(ji,jn)
+             CALL ipslerr_p (3,'slowproc_checkveget', &
+                  "frac_nobio is larger than zero but smaller than min_vegfrac.", str1, str2)
+          ENDIF
+       ENDDO
+    END DO
+    
+    IF (.NOT. ok_dgvm) THEN       
+       DO ji=1,nbpt
+          DO jv=1,nvm
+             IF ( veget_max(ji,jv) > epsilocal .AND. veget_max(ji,jv) < min_vegfrac ) THEN
+                WRITE(str1,'("Occurs on grid box", I8," and nobio type ",I3 )') ji, jn
+                WRITE(str2,'("The small value obtained is ", E14.4)') veget_max(ji,jv)
+                CALL ipslerr_p (3,'slowproc_checkveget', &
+                     "veget_max is larger than zero but smaller than min_vegfrac.", str1, str2)
+             ENDIF
+          ENDDO
+       ENDDO
+    END IF
+    
+    !! 2.0 verify that with all the fractions we cover the entire grid box  
+    !!
+    DO ji=1,nbpt
+       totfrac = zero
+       DO jn=1,nnobio
+          totfrac = totfrac + frac_nobio(ji,jn)
+       ENDDO
+       DO jv=1,nvm
+          totfrac = totfrac + veget_max(ji,jv)
+       ENDDO
+       IF ( ABS(totfrac - un) > epsilocal) THEN
+             WRITE(str1,'("This occurs on grid box", I8)') ji
+             WRITE(str2,'("The sum over all fraction and error are ", E14.4, E14.4)') totfrac, ABS(totfrac - un)
+             CALL ipslerr_p (3,'slowproc_checkveget', &
+                   "veget_max + frac_nobio is not equal to 1.", str1, str2)
+             WRITE(*,*) "EPSILON =", epsilocal 
+       ENDIF
+    ENDDO
+    
+    !! 3.0 Verify that veget is smaller or equal to veget_max
+    !!
+    DO ji=1,nbpt
+       DO jv=1,nvm
+          IF ( jv == ibare_sechiba ) THEN
+             IF ( ABS(veget(ji,jv) - veget_max(ji,jv)) > epsilocal ) THEN
+                WRITE(str1,'("This occurs on grid box", I8)') ji
+                WRITE(str2,'("The difference is ", E14.4)') veget(ji,jv) - veget_max(ji,jv)
+                CALL ipslerr_p (3,'slowproc_checkveget', &
+                     "veget is not equal to veget_max on bare soil.", str1, str2)
+             ENDIF
+          ELSE
+             IF ( veget(ji,jv) > veget_max(ji,jv) ) THEN
+                WRITE(str1,'("This occurs on grid box", I8)') ji
+                WRITE(str2,'("The values for veget and veget_max :", F8.4, F8.4)') veget(ji,jv), veget_max(ji,jv)
+                CALL ipslerr_p (3,'slowproc_checkveget', &
+                     "veget is greater than veget_max.", str1, str2)
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    
+    !! 4.0 Test tot_bare_soil in relation to the other variables
+    !!
+    DO ji=1,nbpt
+       totfrac = zero
+       DO jv=1,nvm
+          totfrac = totfrac + (veget_max(ji,jv) - veget(ji,jv))
+       ENDDO
+       ! add the bare soil fraction to totfrac
+       totfrac = totfrac + veget(ji,ibare_sechiba)
+       ! do the test
+       IF ( ABS(totfrac - tot_bare_soil(ji)) > epsilocal ) THEN
+          WRITE(str1,'("This occurs on grid box", I8)') ji
+          WRITE(str2,'("The values for tot_bare_soil, tot frac and error :", F8.4, F8.4, E14.4)') &
+               &  tot_bare_soil(ji), totfrac, ABS(totfrac - tot_bare_soil(ji))
+          CALL ipslerr_p (3,'slowproc_checkveget', &
+               "tot_bare_soil does not correspond to the total bare soil fraction.", str1, str2)
+       ENDIF
+    ENDDO
+    
+    !! 5.0 Test that soiltile has the right sum
+    !!
+    DO ji=1,nbpt
+       totfrac = zero
+       DO js=1,nstm
+          totfrac = totfrac + soiltile(ji,js)
+       ENDDO
+       IF ( ABS(totfrac - un) > epsilocal ) THEN
+          WRITE(str1,'("This occurs on grid box", I8)') ji
+          WRITE(str2,'("The sum of soiltile and error are :", F8.4, E14.4)') soiltile, ABS(totfrac - un)
+          CALL ipslerr_p (3,'slowproc_checkveget', &
+               "soiltile does not sum-up to one.", str1, str2)
+       ENDIF
+    ENDDO
+    
+  END SUBROUTINE slowproc_checkveget
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_change_frac
+!!
+!>\BRIEF        Update the vegetation fractions
+!!
+!! DESCRIPTION  : Update the vegetation fractions. This subroutine is called in the same time step as lcchange in stomatelpj has
+!!                has been done. This subroutine is called after the diagnostics have been written in sechiba_main.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: veget_max, veget, frac_nobio, totfrac_nobio, tot_bare_soil, soiltile
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_change_frac(kjpindex, lai, &
+                                  veget_max, veget, frac_nobio, totfrac_nobio, tot_bare_soil, soiltile)
+    !
+    ! 0. Declarations
+    !
+    ! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                           :: kjpindex      !! Domain size - terrestrial pixels only
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)     :: lai           !! Leaf area index (m^2 m^{-2})    
+
+    ! 0.2 Output variables 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out)    :: veget_max      !! Maximum fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out)    :: veget          !! Fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(out) :: frac_nobio     !! Fraction of ice, lakes, cities etc. in the mesh
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)        :: totfrac_nobio  !! Total fraction of ice+lakes+cities etc. in the mesh
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)       :: tot_bare_soil  !! Total evaporating bare soil fraction 
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)  :: soiltile       !! Fraction of each soil tile (0-1, unitless)
+
+    ! 0.3 Local variables
+    INTEGER(i_std)                                       :: ji, jv         !! Loop index
+
+    
+    !! Update vegetation fractions with the values coming from the vegetation file read in slowproc_readvegetmax.
+    !! Partial update has been taken into account for the case with DGVM and AGRICULTURE in slowproc_readvegetmax. 
+    veget_max  = veget_max_new
+    frac_nobio = frac_nobio_new
+    
+
+    !! Verification and correction on veget_max, calculation of veget and soiltile.
+    CALL slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile)
+
+    !! Calculate tot_bare_soil needed in hydrol, diffuco and condveg
+    tot_bare_soil(:) = veget_max(:,1)
+    DO jv = 2, nvm
+       DO ji =1, kjpindex
+          tot_bare_soil(ji) = tot_bare_soil(ji) + (veget_max(ji,jv) - veget(ji,jv))
+       ENDDO
+    END DO
+    
+    !! Do some basic tests on the surface fractions updated above
+    CALL slowproc_checkveget(kjpindex, frac_nobio, veget_max, veget, tot_bare_soil, soiltile)
+
+  END SUBROUTINE slowproc_change_frac
+
+END MODULE slowproc
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/thermosoil.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/thermosoil.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/thermosoil.f90	(revision 5166)
@@ -0,0 +1,1948 @@
+! =================================================================================================================================
+! MODULE       : thermosoil
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Calculates the soil temperatures by solving the heat
+!! diffusion equation within the soil. This module is only used with CWRR hydrology.
+!!
+!!\n DESCRIPTION : General important informations about the numerical scheme and
+!!                 the soil vertical discretization:\n
+!!               - the soil is zmaxt deep (by default 10m) and divided into "ngrnd" layers. 
+!!                 From 0-zmaxh(default 2m), the discretization is the same as for hydrology. 
+!!                 From zmaxh(2m) and below, the depth increase linearly (by default) or geometrically. \n
+!!               - "jg" is usually used as the index going from 1 to ngrnd to describe the
+!!                  layers, from top (jg=1) to bottom (jg=ngrnd)\n
+!!               - the thermal numerical scheme is implicit finite differences.\n
+!!                 -- When it is resolved in thermosoil_profile at the present timestep t, the
+!!                 dependancy from the previous timestep (t-1) is hidden in the
+!!                 integration coefficients cgrnd and dgrnd, which are therefore
+!!                 calculated at the very end of thermosoil_main (call to
+!!                 thermosoil_coef) for use in the next timestep.\n
+!!                 -- At timestep t, the system becomes :\n 
+!!
+!!                              T(k+1)=cgrnd(k)+dgrnd(k)*T(k) \n
+!!                                      -- EQ1 -- \n
+!!
+!!                 (the bottom boundary condition has been used to obtained this equation).\n
+!!                 To solve it, the uppermost soil temperature T(1) is required.
+!!                 It is obtained from the surface temperature Ts, which is
+!!                 considered a linear extrapolation of T(1) and T(2)\n
+!!
+!!                           Ts=(1+lambda)*T(1) -lambda*T(2) \n 
+!!                                      -- EQ2--\n
+!!
+!!                 -- caveat 1 : Ts is called 'temp_soil_new' in this routine,
+!!                 don' t act.\n
+!!                 -- caveat 2 : actually, the surface temperature at time t Ts
+!!                 depends on the soil temperature at time t through the
+!!                 ground heat flux. This is again implicitly solved, with Ts(t)
+!!                 expressed as :\n
+!!
+!!                 soilcap*(Ts(t)-Ts(t-1))/dt=soilflx+otherfluxes(Ts(t))\n 
+!!                                      -- EQ3 --\n
+!!
+!!                 and the dependency from the previous timestep is hidden in
+!!                 soilcap and soilflx (apparent surface heat capacity and heat
+!!                 flux respectively). Soilcap and soilflx are therefore
+!!                 calculated at the previous timestep, at the very end of thermosoil
+!!                 (final call to thermosoil_coef) and stored to be used at the next time step.
+!!                 At timestep t, EQ3 is solved for Ts in enerbil, and Ts
+!!                 is used in thermosoil to get T(1) and solve EQ1.\n
+!!
+!! - lambda is the @tex $\mu$ @endtex of F. Hourdin' s PhD thesis, equation (A28); ie the
+!! coefficient of the linear extrapolation of Ts (surface temperature) from T1 and T2 (ptn(jg=1) and ptn(jg=2)), so that:\n
+!! Ts= (1+lambda)*T(1)-lambda*T(2) --EQ2-- \n
+!! lambda = (zlt(1))/((zlt(2)-zlt(1))) \n
+!!
+!! RECENT CHANGE(S) : - Change soil thermal properties to consider also soil texture, rev 2922.
+!!                    - Change vertical discretization, rev 2917. Note: In the revised thermosoil, 
+!!                    cstgrnd and lskin are not needed any more. The depth znt, zlt and dlt
+!!                    are computed in vertical_soil and are in meter
+!!
+!! REFERENCE(S) : None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE thermosoil
+
+  ! modules used :
+  USE ioipsl
+  USE ioipsl_para
+  USE xios_orchidee
+  USE constantes
+  USE constantes_soil
+  USE sechiba_io
+  USE grid
+
+  IMPLICIT NONE
+
+  !private and public routines :
+  PRIVATE
+  PUBLIC :: thermosoil_main, thermosoil_clear,  thermosoil_initialize, thermosoil_finalize
+
+  REAL(r_std), SAVE                               :: lambda                   !! See Module description
+!$OMP THREADPRIVATE(lambda)
+  REAL(r_std), SAVE                               :: fz1, zalph               !! usefull constants for diverse use
+!$OMP THREADPRIVATE(fz1, zalph)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ptn                      !! vertically discretized 
+                                                                              !! soil temperatures @tex ($K$) @endtex. 
+!$OMP THREADPRIVATE(ptn)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: dz1                      !! numerical constant used in the thermal numerical
+                                                                              !! scheme  @tex ($m^{-1}$) @endtex. ; it corresponds
+                                                                              !! to the coefficient  @tex $d_k$ @endtex of equation
+                                                                              !! (A.12) in F. Hourdin PhD thesis.
+!$OMP THREADPRIVATE(dz1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: cgrnd                    !! integration coefficient for the numerical scheme,
+                                                                              !! see eq.1
+!$OMP THREADPRIVATE(cgrnd)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dgrnd                    !! integration coefficient for the numerical scheme,
+                                                                              !! see eq.1
+!$OMP THREADPRIVATE(dgrnd)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcapa                    !! volumetric vertically discretized soil heat 
+                                                                              !! capacity  @tex ($J K^{-1} m^{-3}$) @endtex. 
+                                                                              !! It depends on the soil
+                                                                              !! moisture content (shum_ngrnd_perma) and is calculated at 
+                                                                              !! each time step in thermosoil_coef.
+!$OMP THREADPRIVATE(pcapa)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pkappa                   !! vertically discretized soil thermal conductivity 
+                                                                              !!  @tex ($W K^{-1} m^{-1}$) @endtex. Same as pcapa.
+!$OMP THREADPRIVATE(pkappa)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcapa_snow               !! volumetric vertically discretized snow heat 
+                                                                              !! capacity @tex ($J K^{-1} m^{-3}$) @endtex. 
+!$OMP THREADPRIVATE(pcapa_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pkappa_snow              !! vertically discretized snow thermal conductivity 
+                                                                              !! @tex ($W K^{-1} m^{-1}$) @endtex.
+!$OMP THREADPRIVATE(pkappa_snow)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcapa_en                 !! heat capacity used for surfheat_incr and 
+                                                                              !! coldcont_incr 
+!$OMP THREADPRIVATE(pcapa_en)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ptn_beg                  !! vertically discretized temperature at the 
+                                                                              !! beginning of the time step  @tex ($K$) @endtex; 
+                                                                              !! is used in 
+                                                                              !! thermosoil_energy for energy-related diagnostic of
+                                                                              !! the routine.
+!$OMP THREADPRIVATE(ptn_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: temp_sol_beg             !! Surface temperature at the beginning of the 
+                                                                              !! timestep  @tex ($K$) @endtex
+!$OMP THREADPRIVATE(temp_sol_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: surfheat_incr            !! Change in soil heat content during the timestep 
+                                                                              !!  @tex ($J$) @endtex.
+!$OMP THREADPRIVATE(surfheat_incr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: coldcont_incr            !! Change in snow heat content  @tex ($J$) @endtex.
+!$OMP THREADPRIVATE(coldcont_incr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: shum_ngrnd_perma         !! Saturation degree on the thermal axes (0-1, dimensionless)
+!$OMP THREADPRIVATE(shum_ngrnd_perma)
+
+  !  Variables related to soil freezing
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: profil_froz              !! Frozen fraction of the soil on hydrological levels (-)
+!$OMP THREADPRIVATE(profil_froz)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION (:) :: e_soil_lat                  !! Accumulated latent heat for the whole soil (J)
+!$OMP THREADPRIVATE(e_soil_lat)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcappa_supp               !! Additional heat capacity due to soil freezing for each soil layer (J/K)
+!$OMP THREADPRIVATE(pcappa_supp)    
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: dz5                      !! Used for numerical calculation [-]
+!$OMP THREADPRIVATE(dz5)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcs                      !! Saturation humidity [m3/m3]
+!$OMP THREADPRIVATE(mcs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: SMCMAX                   !! Soil porosity [m3/m3]
+!$OMP THREADPRIVATE(SMCMAX)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: QZ                       !! quartz content [-]
+!$OMP THREADPRIVATE(QZ)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: so_capa_dry_ns           !! Dry soil Heat capacity of soils,J.m^{-3}.K^{-1} 
+!$OMP THREADPRIVATE(so_capa_dry_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mc_layt                  !! Volumetric soil moisture (liquid+ice) (m3/m3) on the thermodynamical levels at interface
+!$OMP THREADPRIVATE(mc_layt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mcl_layt                 !! Volumetric soil moisture (liquid) (m3/m3) on the thermodynamical levels at interface
+!$OMP THREADPRIVATE(mcl_layt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_layt                 !! Total soil moisture content for each layer (liquid+ice) (mm) on the thermodynamical levels
+!$OMP THREADPRIVATE(tmc_layt)
+  INTEGER(i_std), SAVE                            :: brk_flag = 0             !! Flag to consider bedrock: 0.no; 1.yes
+!$OMP THREADPRIVATE(brk_flag)
+
+
+CONTAINS
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : thermosoil_initialize
+  !!
+  !>\BRIEF			            Allocate module variables, read from restart file or initialize with default values
+  !!
+  !! DESCRIPTION			    : Allocate module variables, read from restart file or initialize with default values.
+  !!                                          Call thermosoil_var_init to calculate physical constants. 
+  !!                                          Call thermosoil_coef to calculate thermal soil properties.
+  !!
+  !! RECENT CHANGE(S)			    : None
+  !!
+  !! REFERENCE(S)			    : None
+  !! 
+  !! FLOWCHART                              : None
+  !! \n
+  !_ ==============================================================================================================================
+  SUBROUTINE thermosoil_initialize (kjit,          kjpindex,   rest_id,                   &
+                                    temp_sol_new,  snow,       shumdiag_perma,            &
+                                    soilcap,       soilflx,    stempdiag,                 &
+                                    gtemp,                   &
+                                    mc_layh,       mcl_layh,   tmc_layh,        njsc,     &
+                                    frac_snow_veg,frac_snow_nobio,totfrac_nobio, &
+                                    snowdz, snowrho, snowtemp, lambda_snow, cgrnd_snow, dgrnd_snow, pb)
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                            :: kjit             !! Time step number (unitless) 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex         !! Domain size (unitless)
+    INTEGER(i_std),INTENT (in)                            :: rest_id          !! Restart file identifier (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: temp_sol_new     !! Surface temperature at the present time-step,
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: snow             !! Snow mass (kg)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: shumdiag_perma   !! Soil saturation degree (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: mc_layh          !! Volumetric soil moisture content (liquid+ice) for hydrological layers, at node (m3/m3)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: mcl_layh         !! Volumetric soil moisture content (liquid) for hydrological layers, at node (m3/m3)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: tmc_layh         !! Total soil moisture content(liquid+ice) for hydrological layers (mm)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: frac_snow_veg    !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)   :: frac_snow_nobio  !! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: totfrac_nobio    !! Total fraction of continental ice+lakes+cities+...
+                                                                              !! (unitless,0-1)
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT (in)    :: snowdz           !! Snow depth
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)   :: snowrho          !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)   :: snowtemp         !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)        :: pb               !! Surface presure (hPa)
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: soilcap          !! apparent surface heat capacity considering snow and soil surface (J m-2 K-1)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: soilflx          !! apparent soil heat flux considering snow and soil surface (W m-2)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out)   :: stempdiag        !! temperature profile on the levels in hydrol(K)
+    REAL(r_std),DIMENSION (kjpindex),INTENT(out)          :: gtemp            !! First soil layer temperature
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)       :: lambda_snow     !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: cgrnd_snow      !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: dgrnd_snow      !! Integration coefficient for snow numerical scheme
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                        :: ier, i, jg
+    LOGICAL                                               :: calculate_coef   !! Local flag to initialize variables by call to thermosoil_coef   
+!_ ================================================================================================================================
+    
+
+    !
+    !  !! Flag to consider bedrock at deeper layers
+    !  !! It affects heat capacity and thermal conductivity (energy balance). 
+    !
+    !Config Key  = BEDROCK_FLAG
+    !Config Desc = Flag to consider bedrock at deeper layers.
+    !Config If   = 
+    !Config Def  = 0
+    !Config Help = 0, no, 1, yes. 
+    !Config Units = [FLAG]
+    brk_flag = 0
+    CALL getin_p('BEDROCK_FLAG', brk_flag)
+
+    IF (printlev >= 3) WRITE (numout,*) 'Start thermosoil_initialize '
+
+    !! 1. Allocate soil temperatures variables
+    ALLOCATE (ptn(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of ptn','','')
+
+    ALLOCATE (dz1(ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of dz1','','')
+
+    ALLOCATE (cgrnd(kjpindex,ngrnd-1),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of cgrnd','','')
+
+    ALLOCATE (dgrnd(kjpindex,ngrnd-1),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of dgrnd','','')
+
+    ALLOCATE (pcapa(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of pcapa','','')
+
+    ALLOCATE (pkappa(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of pkappa','','')
+
+    ALLOCATE (pcapa_snow(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of pcapa_snow','','')
+
+    ALLOCATE (pkappa_snow(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of pkappa_snow','','')
+
+    ALLOCATE (surfheat_incr(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of surfheat_incr','','')
+
+    ALLOCATE (coldcont_incr(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of coldcont_incr','','')
+
+    ALLOCATE (pcapa_en(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of pcapa_en','','')
+
+    ALLOCATE (ptn_beg(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of ptn_beg','','')
+
+    ALLOCATE (temp_sol_beg(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of temp_sol_beg','','')
+
+    ALLOCATE (shum_ngrnd_perma(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of shum_ngrnd_perma','','')
+
+    ALLOCATE (profil_froz(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of profil_froz','','')
+
+    IF (ok_freeze_thermix) THEN
+       ALLOCATE (pcappa_supp(kjpindex,ngrnd),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of ok_freeze_termix','','')
+    END IF
+    IF (ok_Ecorr) THEN
+       ALLOCATE (e_soil_lat(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of e_soil_lat','','')
+    END IF
+
+    ALLOCATE (dz5(ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of dz5','','')
+
+    ALLOCATE (mc_layt(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of mc_layt','','')
+
+    ALLOCATE (mcl_layt(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of mcl_layt','','')
+
+    ALLOCATE (tmc_layt(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of tmc_layt','','')
+
+    ALLOCATE (mcs(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of mcs','','')
+
+    ALLOCATE (SMCMAX(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of SMCMAX','','')
+
+    ALLOCATE (QZ(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of QZ','','')
+
+    ALLOCATE (so_capa_dry_ns(nscm),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoil_initialize', 'Error in allocation of so_capa_dry_ns','','')
+
+
+!! Soil texture choose
+    SELECTCASE (nscm)
+    CASE (3)
+       SMCMAX(:) = SMCMAX_fao(:)
+       QZ(:) = QZ_fao(:)
+       so_capa_dry_ns(:) = so_capa_dry_ns_fao(:)
+       mcs(:) = mcs_fao(:)
+    CASE (12)
+       SMCMAX(:) = SMCMAX_usda(:)
+      QZ(:) = QZ_usda(:)
+       so_capa_dry_ns(:) = so_capa_dry_ns_usda(:)
+       mcs(:) = mcs_usda(:)
+    CASE DEFAULT
+       WRITE (numout,*) 'Unsupported soil type classification. Choose between zobler, fao and usda according to the map'
+       STOP 'thermosoil_initialize'
+    ENDSELECT
+
+    
+    !! 2. Initialize variable from restart file or with default values 
+    
+    !! Reads restart files for soil temperatures only. If no restart file is
+    !! found,  the initial soil temperature is by default set to 280K at all depths. The user
+    !! can decide to initialize soil temperatures at an other value, in which case he should set the flag THERMOSOIL_TPRO
+    !! to this specific value in the run.def.
+    IF (printlev>=3) WRITE (numout,*) 'Read restart file for THERMOSOIL variables'
+
+    CALL ioconf_setatt_p('UNITS', 'K')
+    CALL ioconf_setatt_p('LONG_NAME','Soil Temperature profile')
+    CALL restget_p (rest_id, 'ptn', nbp_glo, ngrnd, 1, kjit, .TRUE., ptn, "gather", nbp_glo, index_g)
+
+    ! Initialize ptn if it was not found in restart file
+    IF (ALL(ptn(:,:)==val_exp)) THEN 
+       ! ptn was not found in restart file
+
+       IF (read_reftemp) THEN
+          ! Read variable ptn from file
+          CALL read_reftempfile(kjpindex,lalo,ptn)
+       ELSE
+          ! Initialize ptn with a constant value which can be set in run.def
+
+          !Config Key   = THERMOSOIL_TPRO
+          !Config Desc  = Initial soil temperature profile if not found in restart
+          !Config Def   = 280.
+          !Config If    = OK_SECHIBA
+          !Config Help  = The initial value of the temperature profile in the soil if 
+          !Config         its value is not found in the restart file. Here
+          !Config         we only require one value as we will assume a constant 
+          !Config         throughout the column.
+          !Config Units = Kelvin [K]
+          CALL setvar_p (ptn, val_exp,'THERMOSOIL_TPRO',280._r_std)
+       END IF
+    END IF
+    
+    ! Initialize ptn_beg (variable needed in thermosoil_coef before calucation in thermosoil_energy)
+    ptn_beg(:,:) = ptn(:,:)
+    
+    ! Initialize temp_sol_beg with values from previous time-step
+    temp_sol_beg(:) = temp_sol_new(:) 
+    
+    ! Read e_soil_lat from restart file or initialize
+    IF (ok_Ecorr) THEN
+       CALL restget_p (rest_id, 'e_soil_lat', nbp_glo, 1, 1, kjit, .TRUE., &
+            e_soil_lat, "gather", nbp_glo, index_g)
+       CALL setvar_p (e_soil_lat, val_exp,'NO_KEYWORD',zero)
+    END IF
+
+    ! Read gtemp from restart file
+    CALL restget_p (rest_id, 'gtemp', nbp_glo, 1, 1, kjit, .TRUE., &
+         gtemp, "gather", nbp_glo, index_g)
+    CALL setvar_p (gtemp, val_exp,'NO_KEYWORD',zero)
+    
+
+    ! Read variables calculated in thermosoil_coef from restart file
+    ! If the variables were not found in the restart file, the logical 
+    ! calculate_coef will be true and thermosoil_coef will be called further below.
+    ! These variables need to be in the restart file to avoid a time shift that
+    ! would be done using thermosoil_coef at this stage.
+    calculate_coef=.FALSE.
+    CALL ioconf_setatt_p('UNITS', 'J m-2 K-1')
+    CALL ioconf_setatt_p('LONG_NAME','Apparent surface heat capacity')
+    CALL restget_p (rest_id, 'soilcap', nbp_glo, 1, 1, kjit, .TRUE., &
+         soilcap, "gather", nbp_glo, index_g)
+    IF (ALL(soilcap(:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', 'W m-2')
+    CALL ioconf_setatt_p('LONG_NAME','Apparent soil heat flux')
+    CALL restget_p (rest_id, 'soilflx', nbp_glo, 1, 1, kjit, .TRUE., &
+         soilflx, "gather", nbp_glo, index_g)
+    IF (ALL(soilflx(:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Integration coefficient for the numerical scheme')
+    CALL restget_p (rest_id, 'cgrnd', nbp_glo, ngrnd-1, 1, kjit, .TRUE., &
+         cgrnd, "gather", nbp_glo, index_g)
+    IF (ALL(cgrnd(:,:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Integration coefficient for the numerical scheme')
+    CALL restget_p (rest_id, 'dgrnd', nbp_glo, ngrnd-1, 1, kjit, .TRUE., &
+         dgrnd, "gather", nbp_glo, index_g)
+    IF (ALL(dgrnd(:,:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Integration coefficient for the numerical scheme')
+    CALL restget_p (rest_id, 'cgrnd_snow', nbp_glo, nsnow, 1, kjit, .TRUE., &
+         cgrnd_snow, "gather", nbp_glo, index_g)
+    IF (ALL(cgrnd_snow(:,:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Integration coefficient for the numerical scheme')
+    CALL restget_p (rest_id, 'dgrnd_snow', nbp_glo, nsnow, 1, kjit, .TRUE., &
+         dgrnd_snow, "gather", nbp_glo, index_g)
+    IF (ALL(dgrnd_snow(:,:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Coefficient of the linear extrapolation of surface temperature')
+    CALL restget_p (rest_id, 'lambda_snow', nbp_glo, 1, 1, kjit, .TRUE., &
+         lambda_snow, "gather", nbp_glo, index_g)
+    IF (ALL(lambda_snow(:)==val_exp)) calculate_coef=.TRUE.
+
+    !! 2.2 Computes some physical constants and arrays depending on the soil vertical discretization 
+
+    ! Calculate so_capa_ice
+    so_capa_ice = so_capa_dry + poros*capa_ice*rho_ice
+    WRITE(numout,*) 'Calculation of so_capa_ice=', so_capa_ice,' using poros=',poros,' and capa_ice=',capa_ice
+    
+    ! Computing some usefull constants for the numerical scheme
+    ! Use znt(depth of nodes) and zlt(depth of deeper layer interface) from vertical_soil module.  
+    DO jg=1,ngrnd-1
+      dz1(jg)  = un / (znt(jg+1) - znt(jg))
+      dz5(jg) = (zlt(jg) - znt(jg)) * dz1(jg)
+    ENDDO
+    dz5(ngrnd) = 0.0
+    lambda = znt(1) * dz1(1)
+
+    ! Send out the temperature profile on the first nslm levels(the levels treated in hydrol)
+    stempdiag(:,:) = ptn(:,1:nslm)
+    
+
+    !! 2.3. Computes cgrnd, dgrnd, soilflx and soilcap coefficients only if they were not found in restart file.
+    IF (calculate_coef) THEN
+       ! Interpolate variables needed by thermosoil_coef to the thermal levels
+       CALL thermosoil_humlev(kjpindex, shumdiag_perma, mc_layh, mcl_layh, tmc_layh)
+
+       IF (printlev>=3) WRITE (numout,*) 'thermosoil_coef will be called in the intialization phase'
+       CALL thermosoil_coef (&
+            kjpindex,      temp_sol_new,    snow,           njsc, &
+            frac_snow_veg, frac_snow_nobio, totfrac_nobio,        &
+            snowdz,        snowrho,         snowtemp,       pb,   &
+            ptn,                                                  &
+            soilcap,       soilflx,         cgrnd,          dgrnd,&
+	    lambda_snow,   cgrnd_snow,      dgrnd_snow)
+    END IF
+
+  END SUBROUTINE thermosoil_initialize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_main
+!!
+!>\BRIEF        Thermosoil_main computes the soil thermal properties and dynamics, ie solves
+!! the heat diffusion equation within the soil. 
+!!
+!! DESCRIPTION : The resolution of the soil heat diffusion equation 
+!! relies on a numerical finite-difference implicit scheme
+!! fully described in the reference and in the header of the thermosoil module.
+!! - The dependency of the previous timestep hidden in the 
+!! integration coefficients cgrnd and dgrnd (EQ1), calculated in thermosoil_coef, and 
+!! called at the end of the routine to prepare for the next timestep.
+!! - The effective computation of the new soil temperatures is performed in thermosoil_profile. 
+!!
+!! - thermosoil_coef calculates the coefficients for the numerical scheme for the very first iteration of thermosoil;
+!! after that, thermosoil_coef is called only at the end of the module to calculate the coefficients for the next timestep.
+!! - thermosoil_profile solves the numerical scheme.\n
+!!
+!! - Flags : one unique flag : THERMOSOIL_TPRO (to be set to the desired initial soil in-depth temperature in K; by default 280K)
+!!
+!! RECENT CHANGE(S) : Change vertical discretization (consistent with hydrology layers) and soil thermal properties (taking into account soil texture effects).
+!!
+!! MAIN OUTPUT VARIABLE(S): vertically discretized soil temperatures ptn, soil
+!! thermal properties (pcapa, pkappa), apparent surface heat capacity (soilcap)
+!! and heat flux (soilflx) to be used in enerbil at the next timestep to solve
+!! the surface energy balance.
+!!
+!! REFERENCE(S) : 
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of planetary atmospheres,
+!!  Ph.D. thesis, Paris VII University. Remark: the part of F. Hourdin' s PhD thesis relative to the thermal
+!!  integration scheme has been scanned and is provided along with the documentation, with name : 
+!!  Hourdin_1992_PhD_thermal_scheme.pdf
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{thermosoil_flowchart.png}
+!! \endlatexonly
+!! 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_main (kjit, kjpindex, &
+       index, indexgrnd, &
+       temp_sol_new, snow, soilcap, soilflx, &
+       shumdiag_perma, stempdiag, ptnlev1, rest_id, hist_id, hist2_id, &
+       snowdz,snowrho,snowtemp,gtemp,pb,&
+       mc_layh, mcl_layh, tmc_layh, njsc, frac_snow_veg,frac_snow_nobio,totfrac_nobio,temp_sol_add, &
+       lambda_snow, cgrnd_snow, dgrnd_snow)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                            :: kjit             !! Time step number (unitless) 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex         !! Domain size (unitless)
+    INTEGER(i_std),INTENT (in)                            :: rest_id,hist_id  !! Restart_ file and history file identifier 
+                                                                              !! (unitless)
+    INTEGER(i_std),INTENT (in)                            :: hist2_id         !! history file 2 identifier (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: index            !! Indeces of the points on the map (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex*ngrnd), INTENT (in):: indexgrnd        !! Indeces of the points on the 3D map (vertical 
+                                                                              !! dimension towards the ground) (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: temp_sol_new     !! Surface temperature at the present time-step,
+                                                                              !! temp_sol_new is only modified for the case ok_explicitsnow
+                                                                              !! Ts @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: snow             !! Snow mass @tex ($kg$) @endtex.
+                                                                              !! Caveat: when there is snow on the
+                                                                              !! ground, the snow is integrated into the soil for
+                                                                              !! the calculation of the thermal dynamics. It means
+                                                                              !! that the uppermost soil layers can completely or 
+                                                                              !! partially consist in snow. In the second case, zx1
+                                                                              !! and zx2 are the fraction of the soil layer 
+                                                                              !! consisting in snow and 'normal' soil, respectively
+                                                                              !! This is calculated in thermosoil_coef.
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: shumdiag_perma   !! Soil saturation degree (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT (in)    :: snowdz           !! Snow depth
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT (in)    :: snowrho          !! Snow density
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT (inout) :: snowtemp         !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: pb              !! Surface presure (hPa)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: mc_layh          !! Volumetric soil moisture content for each layer in hydrol at nodes(liquid + ice) (m3/m3)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: mcl_layh         !! Volumetric soil moisture content for each layer in hydrol at nodes(liquid) (m3/m3)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: tmc_layh         !! Total soil moisture content for each layer in hydrol(liquid + ice) (mm)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: frac_snow_veg    !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)   :: frac_snow_nobio  !! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: totfrac_nobio    !! Total fraction of continental ice+lakes+cities+...
+                                                                              !!(unitless,0-1)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: temp_sol_add     !! additional surface temperature due to the melt of first layer
+                                                                              !! at the present time-step @tex ($K$) @endtex
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: ptnlev1          !! 1st level soil temperature   
+    REAL(r_std),DIMENSION (kjpindex),INTENT(out)          :: gtemp            !! First soil layer temperature
+
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: soilcap          !! apparent surface heat capacity considering snow and soil surface
+                                                                              !! @tex ($J m^{-2} K^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: soilflx          !! apparent soil heat flux  considering snow and soil surface
+                                                                              !! @tex ($W m^{-2}$) @endtex
+                                                                              !! , positive 
+                                                                              !! towards the soil, writen as Qg (ground heat flux) 
+                                                                              !! in the history files, and computed at the end of 
+                                                                              !! thermosoil for the calculation of Ts in enerbil, 
+                                                                              !! see EQ3.
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out)   :: stempdiag        !! temperature profile @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT(inout)       :: lambda_snow      !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (inout):: cgrnd_snow       !! Integration coefficient for snow numerical scheme
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (inout):: dgrnd_snow       !! Integration coefficient for snow numerical scheme
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                        :: jv,ji,ii
+
+!_ ================================================================================================================================
+    
+  !! 3. Put the soil wetness diagnostic on the levels of the soil temperature
+
+    !!?? this could logically be put just before the last call to
+    !!thermosoil_coef, as the results are used there...
+    CALL thermosoil_humlev(kjpindex, shumdiag_perma, mc_layh, mcl_layh, tmc_layh)
+
+    
+  !! 4. Effective computation of the soil temperatures profile, using the cgrnd and dgrnd coefficients from previous tstep.
+    
+    CALL thermosoil_profile (kjpindex,      temp_sol_new,                   &
+                             frac_snow_veg, frac_snow_nobio, totfrac_nobio, &
+                             ptn,           stempdiag,       snowtemp,      &
+                             cgrnd_snow,    dgrnd_snow)
+
+  !! 5. Call to thermosoil_energy, still to be clarified..
+
+    CALL thermosoil_energy (kjpindex, temp_sol_new, soilcap)
+
+  !! 6. Writing the history files according to the ALMA standards (or not..)
+
+    !in only one file (hist2_id <=0) or in 2 different files (hist2_id >0).
+    CALL xios_orchidee_send_field("ptn",ptn)
+    CALL xios_orchidee_send_field("Qg",soilflx)
+    CALL xios_orchidee_send_field("DelSurfHeat",surfheat_incr)
+    CALL xios_orchidee_send_field("DelColdCont",coldcont_incr)
+
+    IF ( .NOT. almaoutput ) THEN
+      CALL histwrite_p(hist_id, 'ptn', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+      CALL histwrite_p(hist_id, 'Qg', kjit, soilflx, kjpindex, index)
+
+      IF ( hydrol_cwrr ) THEN
+         CALL histwrite_p(hist_id, 'ptn_beg', kjit, ptn_beg, kjpindex*ngrnd, indexgrnd)
+         CALL histwrite_p(hist_id, 'pkappa', kjit, pkappa, kjpindex*ngrnd, indexgrnd)
+         CALL histwrite_p(hist_id, 'pcapa', kjit, pcapa, kjpindex*ngrnd, indexgrnd)
+
+         IF (ok_freeze_thermix) THEN
+            CALL histwrite_p(hist_id, 'profil_froz', kjit, profil_froz, kjpindex*ngrnd, indexgrnd)
+            CALL histwrite_p(hist_id, 'pcappa_supp', kjit, pcappa_supp, kjpindex*ngrnd, indexgrnd)
+         END IF
+         CALL histwrite_p(hist_id, 'shum_ngrnd_perma', kjit, shum_ngrnd_perma(:,:), kjpindex*ngrnd, indexgrnd)
+      END IF
+
+    ELSE
+      CALL histwrite_p(hist_id, 'SoilTemp', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+      CALL histwrite_p(hist_id, 'Qg', kjit, soilflx, kjpindex, index)
+      CALL histwrite_p(hist_id, 'DelSurfHeat', kjit, surfheat_incr, kjpindex, index)
+      CALL histwrite_p(hist_id, 'DelColdCont', kjit, coldcont_incr, kjpindex, index)
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist2_id, 'ptn', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+       ELSE
+          CALL histwrite_p(hist2_id, 'SoilTemp', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+          CALL histwrite_p(hist2_id, 'Qg', kjit, soilflx, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSurfHeat', kjit, surfheat_incr, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelColdCont', kjit, coldcont_incr, kjpindex, index)
+       ENDIF
+    ENDIF
+    
+  !! 7. A last final call to thermosoil_coef
+ 
+    !! A last final call to thermosoil_coef, which calculates the different
+    !!coefficients (cgrnd, dgrnd, soilcap, soilflx) from this time step to be
+    !!used at the next time step, either in the surface temperature calculation
+    !!(soilcap, soilflx) or in the soil thermal numerical scheme.
+    CALL thermosoil_coef (&
+         kjpindex,      temp_sol_new,    snow,         njsc, &
+         frac_snow_veg, frac_snow_nobio, totfrac_nobio,      &
+         snowdz,        snowrho,         snowtemp,     pb,   &
+         ptn,                                                &
+         soilcap,       soilflx,         cgrnd,        dgrnd,&
+         lambda_snow,   cgrnd_snow,      dgrnd_snow)
+         
+
+    ! Save variables for explicit snow model
+    gtemp(:) = ptn(:,1)
+
+    !! Initialize output arguments to be used in sechiba
+    ptnlev1(:) = ptn(:,1)
+
+    !! Surface temperature is forced to zero celcius if its value is larger than melting point, only for explicit snow scheme
+    IF  (ok_explicitsnow) THEN
+       DO ji=1,kjpindex
+          IF  (SUM(snowdz(ji,:)) .GT. 0.0) THEN
+             IF (temp_sol_new(ji) .GE. tp_00) THEN
+                temp_sol_new(ji) = tp_00
+             ENDIF
+          END IF
+       END DO
+    ENDIF
+
+    IF (printlev>=3) WRITE (numout,*) ' thermosoil_main done '
+
+  END SUBROUTINE thermosoil_main
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : thermosoil_finalize
+  !!
+  !>\BRIEF                                    Write to restart file
+  !!
+  !! DESCRIPTION			    : This subroutine writes the module variables and variables calculated in thermosoil
+  !!                                          to restart file
+  !! \n
+  !_ ==============================================================================================================================
+  SUBROUTINE thermosoil_finalize (kjit,    kjpindex, rest_id,   gtemp, &
+                                  soilcap, soilflx, lambda_snow, cgrnd_snow, dgrnd_snow)
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                            :: kjit             !! Time step number (unitless) 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex         !! Domain size (unitless)
+    INTEGER(i_std),INTENT (in)                            :: rest_id          !! Restart file identifier(unitless)
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: gtemp            !! First soil layer temperature
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: soilcap
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: soilflx
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)         :: lambda_snow      !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (in)  :: cgrnd_snow       !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (in)  :: dgrnd_snow       !! Integration coefficient for snow numerical scheme
+
+!_ ================================================================================================================================
+    
+    !! 1. Write variables to restart file to be used for the next simulation
+    IF (printlev>=3) WRITE (numout,*) 'Write restart file with THERMOSOIL variables'
+    
+    CALL restput_p(rest_id, 'ptn', nbp_glo, ngrnd, 1, kjit, ptn, 'scatter', nbp_glo, index_g)
+    
+    IF (ok_Ecorr) THEN
+       CALL restput_p(rest_id, 'e_soil_lat', nbp_glo, 1 , 1, kjit, e_soil_lat, 'scatter', nbp_glo, index_g)
+    END IF
+    
+    CALL restput_p(rest_id, 'gtemp', nbp_glo, 1, 1, kjit, gtemp, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'soilcap', nbp_glo, 1, 1, kjit, soilcap, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'soilflx', nbp_glo, 1, 1, kjit, soilflx, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'cgrnd', nbp_glo, ngrnd-1, 1, kjit, cgrnd, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'dgrnd', nbp_glo, ngrnd-1, 1, kjit, dgrnd, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'cgrnd_snow', nbp_glo, nsnow, 1, kjit, cgrnd_snow, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'dgrnd_snow', nbp_glo, nsnow, 1, kjit, dgrnd_snow, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'lambda_snow', nbp_glo, 1, 1, kjit, lambda_snow, 'scatter', nbp_glo, index_g)
+    
+  END SUBROUTINE thermosoil_finalize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_clear
+!!
+!>\BRIEF        Deallocates the allocated arrays.
+!! The call of thermosoil_clear originates from sechiba_clear but the calling sequence and 
+!! its purpose require further investigation.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE thermosoil_clear()
+
+        IF ( ALLOCATED (ptn)) DEALLOCATE (ptn)
+        IF ( ALLOCATED (cgrnd)) DEALLOCATE (cgrnd) 
+        IF ( ALLOCATED (dgrnd)) DEALLOCATE (dgrnd) 
+        IF ( ALLOCATED (pcapa)) DEALLOCATE (pcapa)
+        IF ( ALLOCATED (pkappa))  DEALLOCATE (pkappa)
+        IF ( ALLOCATED (pcapa_snow)) DEALLOCATE (pcapa_snow)
+        IF ( ALLOCATED (pkappa_snow))  DEALLOCATE (pkappa_snow)
+        IF ( ALLOCATED (pcapa_en)) DEALLOCATE (pcapa_en)
+        IF ( ALLOCATED (ptn_beg)) DEALLOCATE (ptn_beg)
+        IF ( ALLOCATED (temp_sol_beg)) DEALLOCATE (temp_sol_beg)
+        IF ( ALLOCATED (surfheat_incr)) DEALLOCATE (surfheat_incr)
+        IF ( ALLOCATED (coldcont_incr)) DEALLOCATE (coldcont_incr)
+        IF ( ALLOCATED (shum_ngrnd_perma)) DEALLOCATE (shum_ngrnd_perma)
+        IF ( ALLOCATED (profil_froz)) DEALLOCATE (profil_froz)
+        IF ( ALLOCATED (mc_layt)) DEALLOCATE (mc_layt)
+        IF ( ALLOCATED (mcl_layt)) DEALLOCATE (mcl_layt)
+        IF ( ALLOCATED (tmc_layt)) DEALLOCATE (tmc_layt)
+  END SUBROUTINE thermosoil_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_coef
+!!
+!>\BRIEF        Calculate soil thermal properties, integration coefficients, apparent heat flux,
+!! surface heat capacity,  
+!!
+!! DESCRIPTION	: This routine computes : \n
+!!		1. the soil thermal properties. \n 
+!!		2. the integration coefficients of the thermal numerical scheme, cgrnd and dgrnd,
+!!              which depend on the vertical grid and on soil properties, and are used at the next 
+!!              timestep.\n
+!!              3. the soil apparent heat flux and surface heat capacity (soilflx
+!!              and soilcap), used by enerbil to compute the surface temperature at the next
+!!              timestep.\n
+!!             -  The soil thermal properties depend on water content (shum_ngrnd_perma, shumdiag_perma, 
+!!              mc_layt, mcl_layt, tmc_layt), dominant soil texture(njsc), and on the presence 
+!!              of snow : snow is integrated into the soil for the thermal calculations, ie if there 
+!!              is snow on the ground, the first thermal layer(s) consist in snow, depending on the 
+!!              snow-depth. If a layer consists out of snow and soil, wheighed soil properties are 
+!!              calculated\n
+!!             - The coefficients cgrnd and dgrnd are the integration
+!!              coefficients for the thermal scheme \n
+!!                              T(k+1)=cgrnd(k)+dgrnd(k)*T(k) \n
+!!                                      -- EQ1 -- \n
+!!              They correspond respectively to $\beta$ and $\alpha$ from F. Hourdin\'s thesis and 
+!!              their expression can be found in this document (eq A19 and A20)
+!!             - soilcap and soilflx are the apparent surface heat capacity and flux
+!!               used in enerbil at the next timestep to solve the surface
+!!               balance for Ts (EQ3); they correspond to $C_s$ and $F_s$ in F.
+!!               Hourdin\'s PhD thesis and are expressed in eq. A30 and A31. \n
+!!                 soilcap*(Ts(t)-Ts(t-1))/dt=soilflx+otherfluxes(Ts(t)) \n
+!!                                      -- EQ3 --\n
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): cgrnd, dgrnd, pcapa, pkappa, soilcap, soilflx
+!!
+!! REFERENCE(S) :
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of planetary atmospheres,
+!! Ph.D. thesis, Paris VII University. Remark: the part of F. Hourdin's PhD thesis relative to the thermal
+!! integration scheme has been scanned and is provided along with the documentation, with name : 
+!! Hourdin_1992_PhD_thermal_scheme.pdf
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_coef (kjpindex,      temp_sol_new,    snow,           njsc, &
+                              frac_snow_veg, frac_snow_nobio, totfrac_nobio,        &
+                              snowdz,        snowrho,         snowtemp,       pb,   &
+                              ptn,                                                  &
+                              soilcap,       soilflx,         cgrnd,          dgrnd,&
+			      lambda_snow,   cgrnd_snow,      dgrnd_snow)
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                             :: kjpindex     !! Domain size (unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: temp_sol_new !! soil surface temperature @tex ($K$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: snow         !! snow mass @tex ($Kg$) @endtex
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)       :: njsc         !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: frac_snow_veg   !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)    :: frac_snow_nobio !! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)            :: totfrac_nobio   !! Total fraction of continental ice+lakes+cities+...
+                                                                              !!(unitless,0-1)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)    :: snowdz        !!Snow depth
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)    :: snowrho        !!Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)    :: snowtemp       !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: pb         !! Surface presure (hPa)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)        :: soilcap      !! surface heat capacity considering snow and soil surface
+                                                                           !! @tex ($J m^{-2} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)        :: soilflx      !! surface heat flux considering snow and soil surface @tex ($W m^{-2}$) @endtex,
+                                                                           !! positive towards the 
+                                                                           !! soil, writen as Qg (ground heat flux) in the history 
+                                                                           !! files.
+    REAL(r_std), DIMENSION (kjpindex,ngrnd-1), INTENT(out) :: cgrnd        !! matrix coefficient for the computation of soil 
+                                                                           !! temperatures (beta in F. Hourdin thesis)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd-1), INTENT(out) :: dgrnd        !! matrix coefficient for the computation of soil 
+                                                                           !! temperatures (alpha in F. Hourdin thesis)
+
+
+    !! 0.3 Modified variable
+
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT (inout):: ptn          !! vertically discretized soil temperatures. ptn is only modified if ok_Ecorr.
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)       :: lambda_snow  !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: cgrnd_snow   !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: dgrnd_snow   !! Integration coefficient for snow numerical scheme
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                         :: ji, jg
+    REAL(r_std), DIMENSION (kjpindex,ngrnd-1)              :: zdz1         !! numerical (buffer) constant 
+                                                                           !! @tex ($W m^{-1} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                :: zdz2         !! numerical (buffer) constant  
+                                                                           !! @tex ($W m^{-1} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex)                      :: z1           !! numerical constant @tex ($W m^{-1} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex)                      :: soilcap_nosnow      !! surface heat capacity
+                                                                                  !! @tex ($J m^{-2} K^{-1}$)
+                                                                                  !! @endtex
+    REAL(r_std), DIMENSION (kjpindex)                      :: soilflx_nosnow      !! surface heat flux @tex ($W m^{-2}$) @endtex,
+                                                                                  !! positive towards the soil, written as Qg
+                                                                                  !!(ground heat flux in the history files).
+    REAL(r_std), DIMENSION (kjpindex)                      :: snowcap             !! apparent snow heat capacity @tex ($J m^{-2} K^{-1}$)
+    REAL(r_std), DIMENSION (kjpindex)                      :: snowflx             !! apparent snow-atmosphere heat flux @tex ($W m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: dz1_snow
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: ZSNOWDZM
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: dz2_snow
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: zdz1_snow
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: zdz2_snow
+    REAL(r_std), DIMENSION (kjpindex)                      :: z1_snow
+
+!_ ================================================================================================================================
+
+  !! 1. Computation of the soil thermal properties
+   
+    ! Computation of the soil thermal properties; snow properties are also accounted for
+    IF (ok_freeze_thermix) THEN
+       CALL thermosoil_getdiff( kjpindex, snow, ptn, njsc, snowrho, snowtemp, pb )
+    ELSE IF (ok_explicitsnow) THEN
+       ! Special case with explicit snow model without soil freezing
+       CALL thermosoil_getdiff_old_thermix_without_snow( kjpindex, njsc, snowrho, snowtemp, pb )
+    ELSE
+       ! Special case with old snow without soil freezing
+       CALL thermosoil_getdiff_old_thermix_with_snow( kjpindex, snow, njsc )
+    ENDIF
+
+    ! Energy conservation : Correction to make sure that the same latent heat is released and 
+    ! consumed during freezing and thawing
+    IF (ok_Ecorr) THEN
+       CALL thermosoil_readjust(kjpindex, ptn)
+    ENDIF
+    
+
+    !! 2. Computation of the coefficients of the numerical integration scheme for the soil layers
+
+    !! 2.1 Calculate numerical coefficients zdz1 and zdz2
+    DO jg=1,ngrnd
+      DO ji=1,kjpindex
+        zdz2(ji,jg)=pcapa(ji,jg) * dlt(jg)/dt_sechiba
+      ENDDO
+    ENDDO
+    
+    DO jg=1,ngrnd-1
+      DO ji=1,kjpindex
+        zdz1(ji,jg) = dz1(jg) * pkappa(ji,jg)
+      ENDDO
+    ENDDO
+    
+    !! 2.2 Calculate coefficients cgrnd and dgrnd for soil
+    DO ji = 1,kjpindex
+      z1(ji) = zdz2(ji,ngrnd) + zdz1(ji,ngrnd-1)
+      cgrnd(ji,ngrnd-1) = zdz2(ji,ngrnd) * ptn(ji,ngrnd) / z1(ji)
+      dgrnd(ji,ngrnd-1) = zdz1(ji,ngrnd-1) / z1(ji)
+    ENDDO
+
+    DO jg = ngrnd-1,2,-1
+      DO ji = 1,kjpindex
+        z1(ji) = un / (zdz2(ji,jg) + zdz1(ji,jg-1) + zdz1(ji,jg) * (un - dgrnd(ji,jg)))
+        cgrnd(ji,jg-1) = (ptn(ji,jg) * zdz2(ji,jg) + zdz1(ji,jg) * cgrnd(ji,jg)) * z1(ji)
+        dgrnd(ji,jg-1) = zdz1(ji,jg-1) * z1(ji)
+      ENDDO
+    ENDDO
+
+
+    !! 3. Computation of the coefficients of the numerical integration scheme for the snow layers
+
+    !! 3.1 Calculate numerical coefficients zdz1_snow, zdz2_snow and lambda_snow
+    DO ji = 1, kjpindex
+
+       IF ( ok_explicitsnow ) THEN
+
+          ! Calculate internal values
+          DO jg = 1, nsnow
+             ZSNOWDZM(ji,jg) = MAX(snowdz(ji,jg),psnowdzmin)
+          ENDDO
+          dz2_snow(ji,:)=ZSNOWDZM(ji,:)
+
+          DO jg = 1, nsnow-1
+             dz1_snow(ji,jg)  = 2.0 / (dz2_snow(ji,jg+1)+dz2_snow(ji,jg))
+          ENDDO
+
+          lambda_snow(ji) = dz2_snow(ji,1)/2.0 * dz1_snow(ji,1)
+
+          DO jg=1,nsnow
+             zdz2_snow(ji,jg)=pcapa_snow(ji,jg) * dz2_snow(ji,jg)/dt_sechiba
+          ENDDO
+
+          DO jg=1,nsnow-1
+             zdz1_snow(ji,jg) = dz1_snow(ji,jg) * pkappa_snow(ji,jg)
+          ENDDO
+
+          ! the bottom snow
+          zdz1_snow(ji,nsnow) = pkappa_snow(ji,nsnow) / ( zlt(1) + dz2_snow(ji,nsnow)/2 )
+
+       ELSE
+          ! Without explict snow
+          lambda_snow(ji) = lambda
+       ENDIF
+
+    ENDDO
+
+    !! 3.2 Calculate coefficients cgrnd_snow and dgrnd_snow for snow
+    DO ji = 1,kjpindex
+       IF ( ok_explicitsnow ) THEN
+          ! bottom level
+          z1_snow(ji) = zdz2(ji,1)+(un-dgrnd(ji,1))*zdz1(ji,1)+zdz1_snow(ji,nsnow)
+          cgrnd_snow(ji,nsnow) = (zdz2(ji,1) * ptn(ji,1) + zdz1(ji,1) * cgrnd(ji,1) ) / z1_snow(ji)
+          dgrnd_snow(ji,nsnow) = zdz1_snow(ji,nsnow) / z1_snow(ji)
+
+          ! next-to-bottom level
+          z1_snow(ji) = zdz2_snow(ji,nsnow)+(un-dgrnd_snow(ji,nsnow))*zdz1_snow(ji,nsnow)+zdz1_snow(ji,nsnow-1)
+          cgrnd_snow(ji,nsnow-1) = (zdz2_snow(ji,nsnow)*snowtemp(ji,nsnow)+&
+               zdz1_snow(ji,nsnow)*cgrnd_snow(ji,nsnow))/z1_snow(ji)
+          dgrnd_snow(ji,nsnow-1) = zdz1_snow(ji,nsnow-1) / z1_snow(ji)
+
+          DO jg = nsnow-1,2,-1
+             z1_snow(ji) = un / (zdz2_snow(ji,jg) + zdz1_snow(ji,jg-1) + zdz1_snow(ji,jg) * (un - dgrnd_snow(ji,jg)))
+             cgrnd_snow(ji,jg-1) = (snowtemp(ji,jg) * zdz2_snow(ji,jg) + zdz1_snow(ji,jg) * cgrnd_snow(ji,jg)) * z1_snow(ji)
+             dgrnd_snow(ji,jg-1) = zdz1_snow(ji,jg-1) * z1_snow(ji)
+          ENDDO
+       ELSE
+          ! Without explict snow
+          cgrnd_snow(ji,:) = cgrnd(ji,1)
+          dgrnd_snow(ji,:) = dgrnd(ji,1)
+       ENDIF
+    ENDDO
+
+
+
+  !! 4. Computation of the apparent ground heat flux 
+    !! Computation of apparent snow-atmosphere flux  
+    DO ji = 1,kjpindex
+       IF ( ok_explicitsnow ) THEN
+          snowflx(ji) = zdz1_snow(ji,1) * (cgrnd_snow(ji,1) + (dgrnd_snow(ji,1)-1.) * snowtemp(ji,1))
+          snowcap(ji) = (zdz2_snow(ji,1) * dt_sechiba + dt_sechiba * (un - dgrnd_snow(ji,1)) * zdz1_snow(ji,1))
+          z1_snow(ji) = lambda_snow(ji) * (un - dgrnd_snow(ji,1)) + un 
+          snowcap(ji) = snowcap(ji) / z1_snow(ji)
+          snowflx(ji) = snowflx(ji) + &
+               & snowcap(ji) * (snowtemp(ji,1) * z1_snow(ji) - lambda_snow(ji) * cgrnd_snow(ji,1) - temp_sol_new(ji)) / dt_sechiba
+       ELSE
+          snowflx(ji) = zero
+          snowcap(ji) = zero
+       ENDIF
+    ENDDO
+
+ 
+    !! Computation of the apparent ground heat flux (> towards the soil) and
+    !! apparent surface heat capacity, used at the next timestep by enerbil to
+    !! compute the surface temperature.
+    DO ji = 1,kjpindex
+      soilflx_nosnow(ji) = zdz1(ji,1) * (cgrnd(ji,1) + (dgrnd(ji,1)-1.) * ptn(ji,1))
+      soilcap_nosnow(ji) = (zdz2(ji,1) * dt_sechiba + dt_sechiba * (un - dgrnd(ji,1)) * zdz1(ji,1))
+      z1(ji) = lambda * (un - dgrnd(ji,1)) + un
+      soilcap_nosnow(ji) = soilcap_nosnow(ji) / z1(ji)
+      soilflx_nosnow(ji) = soilflx_nosnow(ji) + &
+         & soilcap_nosnow(ji) * (ptn(ji,1) * z1(ji) - lambda * cgrnd(ji,1) - temp_sol_new(ji)) / dt_sechiba 
+    ENDDO
+
+    !! Add snow fraction
+    IF ( ok_explicitsnow ) THEN
+       ! Using an effective heat capacity and heat flux by a simple pondering of snow and soil fraction
+       DO ji = 1, kjpindex
+          soilcap(ji) = snowcap(ji)*frac_snow_veg(ji)*(1-totfrac_nobio(ji))+    & ! weights related to snow cover fraction on vegetation  
+               soilcap_nosnow(ji)*SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji)+ & ! weights related to SCF on nobio
+               soilcap_nosnow(ji)*(1-(frac_snow_veg(ji)*(1-totfrac_nobio(ji))-SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji))) ! weights related to non snow fraction
+          soilflx(ji) = snowflx(ji)*frac_snow_veg(ji)*(1-totfrac_nobio(ji))+    & ! weights related to snow cover fraction on vegetation  
+               soilflx_nosnow(ji)*SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji)+ & ! weights related to SCF on nobio
+               soilflx_nosnow(ji)*(1-(frac_snow_veg(ji)*(1-totfrac_nobio(ji))-SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji))) ! weights related to non snow fraction
+       ENDDO
+    ELSE
+       ! Do not consider snow fraction
+       soilcap(:)=soilcap_nosnow(:)
+       soilflx(:)=soilflx_nosnow(:)
+    END IF
+
+    IF (printlev>=3) WRITE (numout,*) ' thermosoil_coef done '
+
+  END SUBROUTINE thermosoil_coef
+ 
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_profile
+!!
+!>\BRIEF        In this routine solves the numerical soil thermal scheme, ie calculates the new soil temperature profile; 
+!! 
+!!
+!! DESCRIPTION	: The calculation of the new soil temperature profile is based on
+!! the cgrnd and dgrnd values from the previous timestep and the surface temperature Ts aka temp_sol_new. (see detailed
+!! explanation in the header of the thermosoil module or in the reference).\n
+!!                              T(k+1)=cgrnd(k)+dgrnd(k)*T(k)\n
+!!                                      -- EQ1 --\n
+!!                           Ts=(1+lambda)*T(1) -lambda*T(2)\n 
+!!                                      -- EQ2--\n
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): ptn (soil temperature profile on the thermal axis), 
+!!                          stempdiag (soil temperature profile on the diagnostic axis)
+!!
+!! REFERENCE(S) :
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of planetary atmospheres,
+!! Ph.D. thesis, Paris VII University. Remark: the part of F. Hourdin's PhD thesis relative to the thermal
+!! integration scheme has been scanned and is provided along with the documentation, with name : 
+!! Hourdin_1992_PhD_thermal_scheme.pdf
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+ SUBROUTINE thermosoil_profile (kjpindex,      temp_sol_new,                   &
+                                frac_snow_veg, frac_snow_nobio, totfrac_nobio, &
+                                ptn,           stempdiag,       snowtemp,      &
+                                cgrnd_snow,    dgrnd_snow)
+
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex       !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol_new   !! Surface temperature at the present time-step 
+                                                                               !! @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)             :: frac_snow_veg  !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)      :: frac_snow_nobio!! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)              :: totfrac_nobio  !! Total fraction of continental ice+lakes+cities+...
+                                                                               !! (unitless,0-1)
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(in)       :: snowtemp       !! Snow temperature
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(in)       :: cgrnd_snow     !! Integration coefficient for snow numerical scheme
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(in)       :: dgrnd_snow     !! Integration coefficient for snow numerical scheme
+ 
+    !! 0.3 Modified variables
+
+ 
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex,ngrnd), INTENT (out)     :: ptn            !! vertically discretized soil temperatures 
+                                                                               !! @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out)      :: stempdiag      !! diagnostic temperature profile 
+                                                                               !! @tex ($K$) @endtex
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jg
+    REAL(r_std)                                              :: temp_sol_eff   !! effective surface temperature including snow and soil
+     
+!_ ================================================================================================================================
+
+  !! 1. Computes the soil temperatures ptn.
+
+    !! 1.1. ptn(jg=1) using EQ1 and EQ2
+    DO ji = 1,kjpindex
+
+       IF ( ok_explicitsnow ) THEN
+          ! Using an effective surface temperature by a simple pondering 
+          temp_sol_eff=snowtemp(ji,nsnow)*frac_snow_veg(ji)*(1-totfrac_nobio(ji))+ &      ! weights related to snow cover fraction on vegetation  
+               temp_sol_new(ji)*SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji)+ &           ! weights related to SCF on nobio
+               temp_sol_new(ji)*(1-(frac_snow_veg(ji)*(1-totfrac_nobio(ji))-SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji))) ! weights related to non snow fraction
+          ! Soil temperature calculation with explicit snow if there is snow on the ground
+          ptn(ji,1) = cgrnd_snow(ji,nsnow) + dgrnd_snow(ji,nsnow) * temp_sol_eff
+       ELSE
+          ! Standard soil temperature calculation
+          ptn(ji,1) = (lambda * cgrnd(ji,1) + temp_sol_new(ji)) / (lambda *(un - dgrnd(ji,1)) + un)
+       ENDIF
+    ENDDO
+
+    !! 1.2. ptn(jg=2:ngrnd) using EQ1.
+    DO jg = 1,ngrnd-1
+      DO ji = 1,kjpindex
+        ptn(ji,jg+1) = cgrnd(ji,jg) + dgrnd(ji,jg) * ptn(ji,jg)
+      ENDDO
+    ENDDO
+
+    !! 2. Assigne the soil temperature to the output variable. It is already on the right axis. 
+    stempdiag(:,:) = ptn(:,1:nslm)
+
+    IF (printlev>=3) WRITE (numout,*) ' thermosoil_profile done '
+
+  END SUBROUTINE thermosoil_profile
+
+!================================================================================================================================
+!! SUBROUTINE   : thermosoil_cond
+!!
+!>\BRIEF          Calculate soil thermal conductivity.  
+!!
+!! DESCRIPTION  : This routine computes soil thermal conductivity
+!!                Code introduced from NOAH LSM. 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): cnd
+!!
+!! REFERENCE(S) :
+!!    Farouki, O.T.,1986: Thermal Properties of Soils. Series on Rock
+!!            and Soil Mechanics, Vol. 11, Trans Tech, 136 PP.
+!!    Johansen, O., 1975: Thermal Conductivity of Soils. Ph.D. Thesis,
+!!            University of Trondheim,
+!!    Peters-Lidard, C. D., Blackburn, E., Liang, X., & Wood, E. F.,
+!!            1998: The effect of soil thermal conductivity 
+!!            Parameterization on Surface Energy fluxes
+!!            and Temperatures. J. of The Atmospheric Sciences,
+!!            Vol. 55, pp. 1209-1224.
+!! Modify histroy:
+!!
+!! FLOWCHART    : None
+!! \n
+!_
+!================================================================================================================================
+
+  SUBROUTINE thermosoil_cond (kjpindex, njsc, smc, qz, smcmax, sh2o, cnd)
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex      !! Domain size (unitless)
+    INTEGER(i_std), DIMENSION (kjpindex), INTENT (in)          :: njsc          !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(IN)        :: smc           !! Volumetric Soil Moisture Content (m3/m3)
+    REAL(r_std), DIMENSION (nscm), INTENT(IN)                  :: qz            !! Quartz Content (Soil Type Dependent) (0-1)               
+    REAL(r_std), DIMENSION (nscm), INTENT(IN)                  :: smcmax        !! Soil Porosity (0-1)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(IN)        :: sh2o          !! Unfrozen Soil Moisture Content; Frozen Soil Moisture = smc - sh2o
+    
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(OUT)       :: cnd           !! Soil Thermal Conductivity (W/m/k)
+    
+    !! 0.3 Modified variables
+    
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                    :: ake           !! Kerston Number (unitless)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                    :: thksat        !! Saturated Thermal Conductivity (W/m/k)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                    :: satratio      !! Degree of Saturation (0-1)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                    :: xu            !! Unfrozen Volume For Saturation (0-1)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                    :: xunfroz       !! Unfrozon Volume Fraction (0-1)
+    REAL(r_std)                                                :: thko          !! Thermal Conductivity for Other Ssoil Components (W/m/k)
+    REAL(r_std)                                                :: gammd         !! Dry Dendity (kg/m3)
+    REAL(r_std)                                                :: thkdry        !! Dry Thermal Conductivity (W/m/k)
+    REAL(r_std)                                                :: thks          !! Thermal Conductivity for the Solids Combined (Quartz + Other) (W/m/k)
+    REAL(r_std), PARAMETER                                     :: THKICE = 2.2  !! Ice Thermal Conductivity (W/m/k)
+    REAL(r_std), PARAMETER                                     :: THKQTZ = 7.7  !! Thermal Conductivity for Quartz (W/m/k)
+    REAL(r_std), PARAMETER                                     :: THKW = 0.57   !! Water Thermal Conductivity (W/m/k)
+    INTEGER(i_std)                                             :: ji, jg, jst
+    
+!_================================================================================================================================
+    
+    !! 1. Dry and Saturated Thermal Conductivity.
+   
+    DO ji = 1,kjpindex
+      jst = njsc(ji)
+
+      !! 1.1. Dry density (Kg/m3) and Dry thermal conductivity (W.M-1.K-1)
+      gammd = (1. - smcmax(jst))*2700.
+      thkdry = (0.135* gammd+ 64.7)/ (2700. - 0.947* gammd)
+
+      !! 1.2. thermal conductivity of "other" soil components
+      IF (qz(jst) > 0.2) THEN
+         thko = 2.0
+      ELSEIF (qz(jst) <= 0.2) THEN
+         thko = 3.0
+      ENDIF
+
+      !! 1.3. Thermal conductivity of solids
+      thks = (THKQTZ ** qz(jst))* (thko ** (1. - qz(jst)))
+
+      DO jg = 1,ngrnd      
+        !! 1.4. saturation ratio
+        satratio(ji,jg) = smc(ji,jg) / smcmax(jst)
+    
+        !! 1.5. Saturated Thermal Conductivity (thksat)
+        xunfroz(ji,jg) = sh2o(ji,jg) / smc(ji,jg)   ! Unfrozen Fraction (From i.e., 100%Liquid, to 0. (100% Frozen))
+        xu(ji,jg) = xunfroz(ji,jg) * smcmax(jst)  ! Unfrozen volume for saturation (porosity*xunfroz)
+        thksat(ji,jg) = thks ** (1. - smcmax(jst))* THKICE ** (smcmax(jst) - xu(ji,jg))* THKW ** (xu(ji,jg))
+      END DO ! DO jg = 1,ngrnd
+
+      !! 2. Kerston Number (ake)
+      DO jg = 1,ngrnd
+        IF ( (sh2o(ji,jg) + 0.0005) <  smc(ji,jg) ) THEN
+          ! Frozen
+          ake(ji,jg) = satratio(ji,jg)
+        ELSE
+          ! Unfrozen
+          IF ( satratio(ji,jg) >  0.1 ) THEN
+            ake(ji,jg) = LOG10 (satratio(ji,jg)) + 1.0
+          ELSEIF ( satratio(ji,jg) >  0.05 .AND. satratio(ji,jg) <=  0.1 ) THEN
+            ake(ji,jg) = 0.7 * LOG10 (satratio(ji,jg)) + 1.0
+          ELSE
+            ake(ji,jg) = 0.0  ! use k = kdry
+          END IF
+        END IF
+      END DO ! DO jg = 1,ngrnd
+
+      !! 3. Thermal conductivity (cnd)
+      DO jg = 1,ngrnd
+        cnd(ji,jg) = ake(ji,jg) * (thksat(ji,jg) - thkdry) + thkdry
+      END DO ! DO jg = 1,ngrnd
+
+    END DO !DO ji = 1,kjpindex
+    
+  END SUBROUTINE thermosoil_cond
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_humlev
+!!
+!>\BRIEF           Interpolate variables from the hydrology layers to the thermodynamic layers
+!!
+!! DESCRIPTION  :  Interpolate the volumetric soil moisture content from the node to the interface of the layer. 
+!!                 The values for the deep layers in thermosoil where hydrology is not existing are constant. 
+!!                 No interpolation is needed for the total soil moisture content and for the soil saturation degree.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): mc_layt, mcl_layt, tmc_layt, shum_ngrnd_perma
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+  SUBROUTINE thermosoil_humlev(kjpindex, shumdiag_perma, mc_layh, mcl_layh, tmc_layh)
+  
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex       !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: shumdiag_perma !! Soil saturation degree on the diagnostic axis (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: mc_layh        !! Volumetric soil moisture content for each layer in hydrol at nodes(liquid+ice) [m/s]
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: mcl_layh       !! Volumetric soil moisture content for each layer in hydrol at nodes(liquid) [m/s]
+    REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in)    :: tmc_layh       !! Total soil moisture content for each layer in hydrol(liquid+ice) [mm]
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                       :: ji, jd
+
+!_ ================================================================================================================================
+
+    IF (printlev >= 4) WRITE(numout,*) 'Start thermosoil_humlev' 
+
+    ! The values for the deep layers in thermosoil where hydrology is not existing are constant. 
+    ! For exemple if thermosoil uses 8m, and hydrol uses 2m vertical discretization,
+    ! the values between 2m and 8m are constant.
+    DO ji=1,kjpindex
+       DO jd = 1, nslm
+          IF(jd == 1) THEN
+             mc_layt(ji,jd) = mc_layh(ji,jd)
+             mcl_layt(ji,jd) = mcl_layh(ji,jd)
+          ELSEIF(jd == 2) THEN
+             mc_layt(ji, jd) = mc_layh(ji,jd-1)*(znt(jd)-zlt(jd-1))/(znt(jd)-0.0) + &
+                  mc_layh(ji, jd)*(zlt(jd-1)-0.0)/(znt(jd)-0.0)
+             mcl_layt(ji, jd) = mcl_layh(ji,jd-1)*(znt(jd)-zlt(jd-1))/(znt(jd)-0.0) + &
+                  mcl_layh(ji, jd)*(zlt(jd-1)-0.0)/(znt(jd)-0.0)
+          ELSEIF(jd == nslm) THEN
+             mc_layt(ji, jd) = mc_layh(ji,jd-1)*(zlt(jd)-zlt(jd-1))/(zlt(jd)-znt(jd-1))  + &
+                  mc_layh(ji,jd)*(zlt(jd-1)-znt(jd-1))/(zlt(jd)-znt(jd-1))
+             mcl_layt(ji, jd) = mcl_layh(ji,jd-1)*(zlt(jd)-zlt(jd-1))/(zlt(jd)-znt(jd-1))  + &
+                  mcl_layh(ji,jd)*(zlt(jd-1)-znt(jd-1))/(zlt(jd)-znt(jd-1))
+          ELSE
+             mc_layt(ji, jd) = mc_layh(ji, jd-1)*(1-dz5(jd-1)) + mc_layh(ji,jd)*dz5(jd-1)
+             mcl_layt(ji, jd) = mcl_layh(ji, jd-1)*(1-dz5(jd-1)) + mcl_layh(ji,jd)*dz5(jd-1)
+          ENDIF
+
+          shum_ngrnd_perma(ji,jd) = shumdiag_perma(ji,jd)
+          tmc_layt(ji,jd) = tmc_layh(ji,jd)
+       ENDDO
+       
+       ! The deep layers in thermosoil where hydro is not existing
+       DO jd = nslm+1, ngrnd
+          shum_ngrnd_perma(ji,jd) = shumdiag_perma(ji,nslm)
+          mc_layt(ji,jd) = mc_layh(ji,nslm)
+          mcl_layt(ji,jd) = mcl_layh(ji,nslm)
+          tmc_layt(ji,jd) = tmc_layh(ji,nslm)
+       ENDDO
+    ENDDO
+
+    IF (printlev >= 4) WRITE(numout,*) 'thermosoil_humlev done' 
+
+  END SUBROUTINE thermosoil_humlev
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_energy
+!!
+!>\BRIEF         Energy check-up.
+!!
+!! DESCRIPTION  : I didn\'t comment this routine since at do not understand its use, please
+!! ask initial designers (Jan ? Nathalie ?).
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ??
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_energy(kjpindex, temp_sol_new, soilcap)
+  
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                     :: kjpindex     !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: temp_sol_new !! Surface temperature at the present time-step, Ts 
+                                                                   !! @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: soilcap      !! Apparent surface heat capacity 
+                                                                   !! @tex ($J m^{-2} K^{-1}$) @endtex, 
+                                                                   !! see eq. A29 of F. Hourdin\'s PhD thesis.
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                 :: ji, jg
+!_ ================================================================================================================================
+   
+
+     DO ji = 1, kjpindex
+      surfheat_incr(ji) = zero
+      coldcont_incr(ji) = zero
+     ENDDO
+    
+    !  Sum up the energy content of all layers in the soil.
+    DO ji = 1, kjpindex
+   
+       IF (pcapa_en(ji,1) .LE. sn_capa) THEN
+          
+          ! Verify the energy conservation in the surface layer
+          coldcont_incr(ji) = soilcap(ji) * (temp_sol_new(ji) - temp_sol_beg(ji))
+          surfheat_incr(ji) = zero
+       ELSE
+          
+          ! Verify the energy conservation in the surface layer
+          surfheat_incr(ji) = soilcap(ji) * (temp_sol_new(ji) - temp_sol_beg(ji))
+          coldcont_incr(ji) = zero
+       ENDIF
+    ENDDO
+    
+    ptn_beg(:,:)      = ptn(:,:)
+    temp_sol_beg(:)   = temp_sol_new(:)
+
+  END SUBROUTINE thermosoil_energy
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_readjust
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION	: Energy conservation : Correction to make sure that the same latent heat is released and 
+!!                consumed during freezing and thawing  
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): ptn (soil temperature profile on the thermal axis), 
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_readjust(kjpindex, ptn)
+
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                             :: kjpindex
+    
+    !! 0.2 Modified variables
+    REAL(r_std),DIMENSION(kjpindex,ngrnd),INTENT(inout)    :: ptn
+
+    !! 0.3 Local variables
+    INTEGER(i_std)  :: ji, jg
+    INTEGER(i_std)  :: lev3m  !! Closest interface level to 3m
+    REAL(r_std) :: ptn_tmp
+
+    ! The energy is spread over the layers down to approximatly 3m
+    ! Find the closest level to 3m. It can be below or above 3m.
+    lev3m=MINLOC(ABS(zlt(:)-3.0),dim=1)
+    IF (printlev >= 3) WRITE(numout,*) 'In thermosoil_adjust: lev3m=',lev3m, ' zlt(lev3m)=', zlt(lev3m)
+    
+    DO jg=1, ngrnd
+       DO ji=1, kjpindex
+          ! All soil latent energy is put into e_soil_lat(ji)
+          ! because the variable soil layers make it difficult to keep track of all
+          ! layers in this version
+          ! NOTE : pcapa has unit J/K/m3 and pcappa_supp has J/K
+          e_soil_lat(ji)=e_soil_lat(ji)+pcappa_supp(ji,jg)*(ptn(ji,jg)-ptn_beg(ji,jg))
+       END DO
+    END DO
+
+   DO ji=1, kjpindex
+      IF (e_soil_lat(ji).GT.min_sechiba.AND.MINVAL(ptn(ji,:)).GT.ZeroCelsius+fr_dT/2.) THEN
+         ! The soil is thawed: we spread the excess of energy over the uppermost lev3m levels
+         ! Here we increase the temperatures
+         DO jg=1, lev3m
+            ptn_tmp=ptn(ji,jg)
+            
+            ptn(ji,jg)=ptn(ji,jg)+MIN(e_soil_lat(ji)/pcapa(ji,jg)/zlt(lev3m), 0.5)
+            e_soil_lat(ji)=e_soil_lat(ji)-(ptn(ji,jg)-ptn_tmp)*pcapa(ji,jg)*dlt(jg)
+         ENDDO
+      ELSE IF (e_soil_lat(ji).LT.-min_sechiba.AND.MINVAL(ptn(ji,:)).GT.ZeroCelsius+fr_dT/2.) THEN
+         ! The soil is thawed
+         ! Here we decrease the temperatures
+         DO jg=1, lev3m
+            ptn_tmp=ptn(ji,jg)
+            ptn(ji,jg)=MAX(ZeroCelsius+fr_dT/2., ptn_tmp+e_soil_lat(ji)/pcapa(ji,jg)/zlt(lev3m))
+            e_soil_lat(ji)=e_soil_lat(ji)+(ptn_tmp-ptn(ji,jg))*pcapa(ji,jg)*dlt(jg)
+         END DO
+      END IF
+   END DO
+
+  END SUBROUTINE thermosoil_readjust
+   
+!-------------------------------------------------------------------
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_getdiff
+!!
+!>\BRIEF          Computes soil and snow heat capacity and conductivity    
+!!
+!! DESCRIPTION	: Computation of the soil thermal properties; snow properties are also accounted for
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): 
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_getdiff( kjpindex, snow, ptn, njsc, snowrho, snowtemp, pb )
+
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)				:: kjpindex
+    REAL(r_std),DIMENSION(kjpindex),INTENT (in)	        :: snow       !! Snow mass
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: njsc       !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowrho        !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowtemp       !! Snow temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: pb         !! Surface presure (hPa)
+    REAL(r_std),DIMENSION(kjpindex,ngrnd),INTENT(in)	:: ptn        !! Soil temperature profile
+
+    !! 0.3 Local variables
+    REAL						:: xx         !! Unfrozen fraction of the soil
+    REAL(r_std), DIMENSION(kjpindex)             	:: snow_h
+    REAL(r_std), DIMENSION(kjpindex,ngrnd) 		:: zx1, zx2    
+    REAL			   			:: cap_iw     !! Heat capacity of ice/water mixture 
+    INTEGER						:: ji,jg
+    INTEGER                                             :: jst
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)             :: pcapa_tmp  !! soil heat capacity (J/m3/K) 
+
+    pcapa_tmp(:,:) = 0.0
+
+    !! Computes soil heat capacity and conductivity
+    DO ji = 1,kjpindex
+       IF (.NOT. ok_explicitsnow) THEN      
+          ! 1. Determine the fractions of snow and soil
+          snow_h(ji) = snow(ji) / sn_dens
+      
+          !
+          !  1.1. The first level
+          !
+          IF ( snow_h(ji) .GT. zlt(1) ) THEN
+             ! the 1st level is in the snow => the 1st layer is entirely snow
+             zx1(ji,1) = 1.
+             zx2(ji,1) = 0.
+          ELSE IF ( snow_h(ji) .GT. zero ) THEN      
+             ! the 1st level is beyond the snow and the snow is present
+             zx1(ji,1) = snow_h(ji) / zlt(1)
+             zx2(ji,1) = ( zlt(1) - snow_h(ji)) / zlt(1)	
+          ELSE
+             ! there is no snow at all, quoi ;-)
+             zx1(ji,1) = 0.
+             zx2(ji,1) = 1.       
+          ENDIF
+      
+          !
+          !  1.2. The other levels
+          !
+          DO jg = 2, ngrnd
+             IF ( snow_h(ji) .GT. zlt(jg) ) THEN
+                ! the current level is in the snow => the current layer is entirely snow
+                zx1(ji,jg) = 1.
+                zx2(ji,jg) = 0.
+             ELSE IF ( snow_h(ji) .GT. zlt(jg-1) ) THEN
+                ! the current layer is partially snow
+                zx1(ji,jg) = (snow_h(ji) - zlt(jg-1)) / (zlt(jg) - zlt(jg-1))
+                zx2(ji,jg) = ( zlt(jg) - snow_h(ji)) / (zlt(jg) - zlt(jg-1))
+             ELSE
+                ! both levels are out of snow => the current layer is entirely soil	  
+                zx1(ji,jg) = 0.
+                zx2(ji,jg) = 1.       
+             ENDIF
+          ENDDO
+       ELSE
+          zx1(ji,:) = 0.
+          zx2(ji,:) = 1.
+       END IF
+
+      DO jg = 1, ngrnd
+         jst = njsc(ji)
+         pcapa_tmp(ji, jg) = so_capa_dry_ns(jst) + water_capa * tmc_layt(ji,jg)/mille/dlt(jg)
+         !
+         ! 2. Calculate heat capacity with allowance for permafrost
+         ! 2.1. soil heat capacity depending on temperature and humidity
+	 
+         IF (ptn(ji,jg) .LT. ZeroCelsius-fr_dT/2.) THEN
+	    ! frozen soil
+	    profil_froz(ji,jg) = 1.
+ 	    pcappa_supp(ji,jg)= 0.
+            pcapa(ji, jg) = so_capa_dry_ns(jst) + so_capa_ice * tmc_layt(ji,jg) / mille / dlt(jg)
+
+     	 ELSEIF (ptn(ji,jg) .GT. ZeroCelsius+fr_dT/2.) THEN
+	    ! unfrozen soil	 
+            pcapa(ji, jg) = pcapa_tmp(ji, jg)
+	    profil_froz(ji,jg) = 0.
+ 	    pcappa_supp(ji,jg)= 0.
+     	 ELSE
+     	   ! xx is the unfrozen fraction of soil water	   	   
+     	   xx = (ptn(ji,jg)-(ZeroCelsius-fr_dT/2.)) / fr_dT
+           profil_froz(ji,jg) = (1. - xx)
+
+	   ! net heat capacity of the ice/water mixture
+     	   cap_iw = xx * so_capa_wet + (1.-xx) * so_capa_ice
+           pcapa(ji, jg) = so_capa_dry_ns(jst) + &
+                water_capa * tmc_layt(ji,jg)/mille / dlt(jg) * xx + &
+                so_capa_ice * tmc_layt(ji,jg) / mille/dlt(jg) * (1.-xx)
+ 	   pcappa_supp(ji,jg)= shum_ngrnd_perma(ji,jg)*poros*lhf*rho_water/fr_dT*zx2(ji,jg)*dlt(jg)
+
+         ENDIF
+
+         !
+	 ! 2.2. Take into account the snow and soil fractions in the layer
+	 !
+         pcapa(ji,jg) = zx1(ji,jg) * sn_capa + zx2(ji,jg) * pcapa(ji,jg)
+
+	 !
+	 ! 2.3. Calculate the heat capacity for energy conservation check 
+	 IF ( zx1(ji,jg).GT.0. ) THEN
+            pcapa_en(ji,jg) = sn_capa
+	 ELSE
+            pcapa_en(ji,jg) = pcapa(ji,jg)
+	 ENDIF
+
+      END DO            
+    ENDDO   
+
+    !
+    ! 3. Calculate the heat conductivity with allowance for permafrost
+    !
+    CALL thermosoil_cond (kjpindex, njsc, mc_layt, QZ, SMCMAX, mcl_layt, pkappa)
+
+    !! Computes snow heat capacity and conductivity    
+    DO ji = 1,kjpindex
+       pcapa_snow(ji,:) = snowrho(ji,:) * xci
+       pkappa_snow(ji,:) = (ZSNOWTHRMCOND1 + ZSNOWTHRMCOND2*snowrho(ji,:)*snowrho(ji,:)) +      &
+            MAX(0.0,(ZSNOWTHRMCOND_AVAP+(ZSNOWTHRMCOND_BVAP/(snowtemp(ji,:)+ &
+            ZSNOWTHRMCOND_CVAP)))*(XP00/(pb(ji)*100.)))
+    END DO
+   
+   END SUBROUTINE thermosoil_getdiff
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_getdiff_old_thermix_with_snow
+!!
+!>\BRIEF          Computes soil heat capacity and conductivity    
+!!
+!! DESCRIPTION	: Computes soil heat capacity and conductivity
+!!                Special case with old snow without soil freezing
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S):
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+
+   SUBROUTINE thermosoil_getdiff_old_thermix_with_snow( kjpindex, snow, njsc )
+
+
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in) :: kjpindex
+    REAL(r_std),DIMENSION(kjpindex),INTENT (in)         :: snow
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+
+
+    !! 0.2 Local variables
+    INTEGER					:: ji,jg
+    REAL(r_std)                                 :: snow_h       !! snow_h is the snow height @tex ($m$) @endtex 
+    REAL(r_std)                                 :: zx1, zx2     !! zx1 and zx2 are the layer fraction consisting in snow and soil respectively.
+    INTEGER                                             :: jst
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)             :: pkappa_tmp   !! soil thermal conductivity (W/m/K)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)             :: pcapa_tmp    !! soil heat capacity (J/m3/K) 
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)             :: pkappa_wet   !! wet soil thermal conductivity (W/m/K)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)             :: pcapa_wet    !! wet soil heat capacity (J/m3/K)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)             :: mcs_tmp          !! Saturated soil moisture (liquid+ice) (m3/m3)
+      
+    ! Computation of the soil thermal properties; snow properties are also accounted for
+
+   pkappa_tmp(:,:) = 0.0
+   pcapa_tmp(:,:) = 0.0
+   pkappa_wet(:,:) = 0.0
+   pcapa_wet(:,:) = 0.0
+   DO ji = 1, kjpindex
+      jst = njsc(ji)
+      mcs_tmp(ji,:) = mcs(jst)
+      DO jg = 1, ngrnd
+          pcapa_tmp(ji, jg) = so_capa_dry_ns(jst) + water_capa * tmc_layt(ji,jg)/mille/dlt(jg)
+          pcapa_wet(ji, jg) = so_capa_dry_ns(jst) + water_capa * mcs(jst)
+      ENDDO
+    ENDDO
+
+    CALL thermosoil_cond(kjpindex, njsc, mc_layt, QZ, SMCMAX, mcl_layt, pkappa_tmp)
+    CALL thermosoil_cond(kjpindex, njsc, mcs_tmp, QZ, SMCMAX, mcs_tmp, pkappa_wet)
+
+    DO ji = 1,kjpindex
+      snow_h = snow(ji) / sn_dens
+
+      ! First layer
+      IF ( snow_h .GT. zlt(1) ) THEN
+          pcapa(ji,1) = sn_capa
+          pcapa_en(ji,1) = sn_capa
+          pkappa(ji,1) = sn_cond
+      ELSE IF ( snow_h .GT. zero ) THEN
+          pcapa_en(ji,1) = sn_capa
+          zx1 = snow_h / zlt(1)
+          zx2 = ( zlt(1) - snow_h) / zlt(1)
+          pcapa(ji, 1) = zx1 * sn_capa + zx2 * pcapa_wet(ji,1)
+          pkappa(ji,1) = un / ( zx1 / sn_cond + zx2 / (pkappa_wet(ji,1)) )
+      ELSE
+          pkappa(ji,1) = pkappa_tmp(ji,1)
+          pcapa(ji, 1) = pcapa_tmp(ji, 1)
+          pcapa_en(ji, 1) = pcapa_tmp(ji, 1)
+      ENDIF
+
+      ! Mid layers
+      DO jg = 2, ngrnd - 2
+        IF ( snow_h .GT. zlt(jg) ) THEN
+            pcapa(ji,jg) = sn_capa
+            pkappa(ji,jg) = sn_cond
+            pcapa_en(ji,jg) = sn_capa
+        ELSE IF ( snow_h .GT. zlt(jg-1) ) THEN
+            zx1 = (snow_h - zlt(jg-1)) / (zlt(jg) - zlt(jg-1))
+            zx2 = ( zlt(jg) - snow_h) / (zlt(jg) - zlt(jg-1))
+            pcapa_en(ji,jg) = sn_capa
+            pcapa(ji, jg) = zx1 * sn_capa + zx2 * pcapa_wet(ji,jg)
+            pkappa(ji,jg) = un / ( zx1 / sn_cond + zx2 / (pkappa_wet(ji,jg)))
+        ELSE
+            pcapa(ji, jg) = pcapa_tmp(ji, jg)
+            pkappa(ji,jg) = pkappa_tmp(ji,jg)
+            pcapa_en(ji, jg) = pcapa_tmp(ji, jg)
+        ENDIF
+      ENDDO
+
+      ! Last two layers: These layers can not be filled with snow
+      DO jg = ngrnd - 1, ngrnd
+         pcapa(ji,jg) = so_capa_dry
+         pkappa(ji,jg) = so_cond_dry
+         pcapa_en(ji,jg) = so_capa_dry
+      END DO
+      
+      IF (brk_flag == 1) THEN
+        ! Bedrock flag is activated
+        DO jg = ngrnd-1,ngrnd
+           pcapa(ji,jg) = brk_capa
+           pcapa_en(ji,jg) = brk_capa
+           pkappa(ji,jg) = brk_cond
+        ENDDO
+      ENDIF
+
+    ENDDO ! DO ji = 1,kjpindex
+
+
+    END SUBROUTINE thermosoil_getdiff_old_thermix_with_snow
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_getdiff_old_thermix_without_snow
+!!
+!>\BRIEF          Computes soil and snow heat capacity and conductivity    
+!!
+!! DESCRIPTION	: Calculations of soil and snow thermal properties without effect of freezing. This subroutine is only
+!!                call for the case with explictsnow activated.
+!!                
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S):
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+    SUBROUTINE thermosoil_getdiff_old_thermix_without_snow( kjpindex, njsc, snowrho, snowtemp, pb )
+
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+      INTEGER(i_std), INTENT(in) :: kjpindex
+      INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: njsc     !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+      REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowrho  !! Snow density
+      REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowtemp !! Snow temperature
+      REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: pb       !! Surface presure (hPa)
+
+
+    !! 0.1 Local variables
+      INTEGER(i_std)    				  :: ji,jg, jst     !! Index
+      REAL(r_std), DIMENSION (kjpindex,ngrnd)             :: pcapa_tmp      !! Soil heat capacity (J/m3/K) 
+
+      !! Computes soil heat capacity and conductivity
+      DO jg = 1,ngrnd
+         DO ji = 1,kjpindex
+            jst = njsc(ji)
+            pcapa_tmp(ji, jg) = so_capa_dry_ns(jst) + water_capa * tmc_layt(ji,jg)/mille/dlt(jg)
+            pcapa(ji,jg) = pcapa_tmp(ji, jg)
+            pcapa_en(ji,jg) = pcapa_tmp(ji, jg)
+         ENDDO
+      ENDDO
+
+      CALL thermosoil_cond (kjpindex, njsc, mc_layt, QZ, SMCMAX, mcl_layt, pkappa)
+
+      IF (brk_flag == 1) THEN
+        ! Bedrock flag is activated
+        DO jg = ngrnd-1,ngrnd
+          DO ji = 1,kjpindex
+             pcapa(ji,jg) = brk_capa
+             pcapa_en(ji,jg) = brk_capa 
+             pkappa(ji,jg) = brk_cond
+          ENDDO
+        ENDDO
+      ENDIF
+
+    !! Computes snow heat capacity and conductivity
+    DO ji = 1,kjpindex
+        pcapa_snow(ji,:) = snowrho(ji,:) * xci
+        pkappa_snow(ji,:) = (ZSNOWTHRMCOND1 + ZSNOWTHRMCOND2*snowrho(ji,:)*snowrho(ji,:)) +      &
+              MAX(0.0,(ZSNOWTHRMCOND_AVAP+(ZSNOWTHRMCOND_BVAP/(snowtemp(ji,:)+ &
+              ZSNOWTHRMCOND_CVAP)))*(XP00/(pb(ji)*100.)))
+    END DO
+
+  END SUBROUTINE thermosoil_getdiff_old_thermix_without_snow
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : read_reftempfile
+!!
+!>\BRIEF          
+!!
+!! DESCRIPTION	: Read file with longterm soil temperature
+!!                
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): reftemp : Reference temerature
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+    
+  SUBROUTINE read_reftempfile(kjpindex,lalo,reftemp)
+    
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in) :: kjpindex
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT(in) :: lalo
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(kjpindex, ngrnd), INTENT(out) :: reftemp
+
+    !! 0.3 Local variables
+    INTEGER(i_std) :: il, ils, ip, ix, iy, imin, jmin, ier
+    REAL(r_std) :: dlon, dlonmin, dlat, dlatmin
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: xx,yy
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: reftemp_file
+    REAL(r_std),ALLOCATABLE,DIMENSION(:) :: x,y
+    REAL(r_std) :: lev(1), date, dt
+    INTEGER(i_std) :: itau(1)
+    
+
+    !Config Key   = SOIL_REFTEMP_FILE
+    !Config Desc  = File with climatological soil temperature
+    !Config If    = READ_REFTEMP
+    !Config Def   = reftemp.nc
+    !Config Help  = 
+    !Config Units = [FILE]
+    filename = 'reftemp.nc'
+    CALL getin('SOIL_REFTEMP_FILE',filename)
+
+    CALL flininfo(filename,iml, jml, lml, tml, fid)
+    ALLOCATE (yy(iml,jml), stat=ier)
+    ALLOCATE (xx(iml,jml), stat=ier)
+    ALLOCATE (x(iml),y(jml), stat=ier)
+    ALLOCATE (reftemp_file(iml,jml), stat=ier)
+    
+    CALL flinopen (filename, .FALSE., iml, jml, lml, &
+         xx, yy, lev, tml, itau, date, dt, fid)
+    CALL flinget (fid, 'temperature', iml, jml, lml, tml, &
+         1, 1, reftemp_file)
+    CALL flinclo (fid)
+
+    ! We suppose that the file is regular. If this is not the case the temperatures will be wrong.
+    x(:) = xx(:,1)
+    y(:) = yy(1,:)
+    ! Take the closest value
+    DO ip = 1, kjpindex
+       dlonmin = HUGE(1.)
+       DO ix = 1,iml
+          dlon = MIN( ABS(lalo(ip,2)-x(ix)), ABS(lalo(ip,2)+360.-x(ix)), ABS(lalo(ip,2)-360.-x(ix)) )
+          IF ( dlon .LT. dlonmin ) THEN
+             imin = ix
+             dlonmin = dlon
+          ENDIF
+       ENDDO
+       dlatmin = HUGE(1.)
+       DO iy = 1,jml
+          dlat = ABS(lalo(ip,1)-y(iy))
+          IF ( dlat .LT. dlatmin ) THEN
+             jmin = iy
+             dlatmin = dlat
+          ENDIF
+       ENDDO
+       reftemp(ip, :) = reftemp_file(imin,jmin)+273.15
+    ENDDO
+    DEALLOCATE (yy)
+    DEALLOCATE (xx)
+    DEALLOCATE (x)
+    DEALLOCATE (reftemp_file)
+    
+  END SUBROUTINE read_reftempfile
+
+
+END MODULE thermosoil
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/thermosoilc.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/thermosoilc.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_sechiba/thermosoilc.f90	(revision 5166)
@@ -0,0 +1,2107 @@
+! =================================================================================================================================
+! MODULE       : thermosoilc
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Calculates the soil temperatures by solving the heat
+!! diffusion equation within the soil. This module is only used with Choisnel hydrology.
+!!
+!!\n DESCRIPTION : General important informations about the numerical scheme and
+!!                 the soil vertical discretization:\n
+!!               - the soil is divided into "ngrnd" (=7 by default) layers, reaching to as
+!!                 deep as 5.5m down within the soil, with thiscknesses
+!!                 following a geometric series of ration 2.\n
+!!               - "jg" is usually used as the index going from 1 to ngrnd to describe the
+!!                  layers, from top (jg=1) to bottom (jg=ngrnd)\n
+!!               - the thermal numerical scheme is implicit finite differences.\n
+!!                 -- When it is resolved in thermosoil_profile at the present timestep t, the
+!!                 dependancy from the previous timestep (t-1) is hidden in the
+!!                 integration coefficients cgrnd and dgrnd, which are therefore
+!!                 calculated at the very end of thermosoil_main (call to
+!!                 thermosoil_coef) for use in the next timestep.\n
+!!                 -- At timestep t, the system becomes :\n 
+!!
+!!                              T(k+1)=cgrnd(k)+dgrnd(k)*T(k) \n
+!!                                      -- EQ1 -- \n
+!!
+!!                 (the bottom boundary condition has been used to obtained this equation).\n
+!!                 To solve it, the uppermost soil temperature T(1) is required.
+!!                 It is obtained from the surface temperature Ts, which is
+!!                 considered a linear extrapolation of T(1) and T(2)\n
+!!
+!!                           Ts=(1-lambda)*T(1) -lambda*T(2) \n 
+!!                                      -- EQ2--\n
+!!
+!!                 -- caveat 1 : Ts is called 'temp_soil_new' in this routine,
+!!                 don' t act.\n
+!!                 -- caveat 2 : actually, the surface temperature at time t Ts
+!!                 depends on the soil temperature at time t through the
+!!                 ground heat flux. This is again implicitly solved, with Ts(t)
+!!                 expressed as :\n
+!!
+!!                 soilcap*(Ts(t)-Ts(t-1))/dt=soilflux+otherfluxes(Ts(t))\n 
+!!                                      -- EQ3 --\n
+!!
+!!                 and the dependency from the previous timestep is hidden in
+!!                 soilcap and soilflux (apparent surface heat capacity and heat
+!!                 flux respectively). Soilcap and soilflux are therefore
+!!                 calculated at the previsou timestep, at the very end of thermosoil
+!!                 (final call to thermosoil_coef) and stored to be used at the next time step.
+!!                 At timestep t, EQ3 is solved for Ts in enerbil, and Ts
+!!                 is used in thermosoil to get T(1) and solve EQ1.\n
+!!
+!! - lambda is the @tex $\mu$ @endtex of F. Hourdin' s PhD thesis, equation (A28); ie the
+!! coefficient of the linear extrapolation of Ts (surface temperature) from T1 and T2 (ptn(jg=1) and ptn(jg=2)), so that:\n
+!! Ts= (1+lambda)*T(1)-lambda*T(2) --EQ2-- \n
+!! lambda = (zz_coeff(1))/((zz_coef(2)-zz_coef(1))) \n
+!!
+!! - cstgrnd is the attenuation depth of the diurnal temperature signal
+!! (period : one_day) as a result of the heat conduction equation
+!! with no coefficients :
+!!\latexonly
+!!\input{thermosoil_var_init0.tex}
+!!\endlatexonly
+!!  -- EQ4 --\n
+!! This equation results from the change of variables :
+!! z' =z*sqrt(Cp/K) where z' is the new depth (homogeneous
+!! to sqrt(time) ), z the real depth (in m), Cp and K the soil heat
+!! capacity and conductivity respectively.\n
+!!
+!! the attenuation depth of a diurnal thermal signal for EQ4 is therefore homogeneous to sqrt(time) and
+!! equals : \n
+!! cstgrnd = sqrt(oneday/Pi)
+!!
+!! - lskin is the attenuation depth of the diurnal temperature signal
+!! (period : one_day) within the soil for the complete heat conduction equation
+!! (ie : with coefficients)
+!!\latexonly
+!!\input{thermosoil_var_init00.tex}
+!!\endlatexonly
+!! -- EQ5 --  \n
+!! it can be retrieved from cstgrnd using the change of variable  z' =z*sqrt(Cp/K):\n
+!! lskin = sqrt(K/Cp)*cstgrnd =  sqrt(K/Cp)*sqrt(oneday//Pi)\n
+!! 
+!! In thermosoil, the ratio lskin/cstgrnd is frequently used as the
+!! multiplicative factor to go from
+!!'adimensional' depths (like z' ) to real depths (z). z' is not really
+!! adimensional but is reffered to like this in the code.
+!!
+!!
+!! RECENT CHANGE(S) : thermosoilc module is a copy of thermosoil before the vertical discretization was changed.
+!!                    This module is used only for the Choisnel hydrology. 
+!!
+!! REFERENCE(S) : None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE thermosoilc
+
+  ! modules used :
+  USE ioipsl
+  USE ioipsl_para
+  USE xios_orchidee
+  USE constantes
+  USE constantes_soil
+  USE sechiba_io
+  USE grid
+
+
+  IMPLICIT NONE
+
+  !private and public routines :
+  PRIVATE
+  PUBLIC :: thermosoilc_main, thermosoilc_clear, thermosoilc_levels, thermosoilc_initialize, thermosoilc_finalize
+
+  REAL(r_std), SAVE                               :: lambda, cstgrnd, lskin   !! See Module description
+!$OMP THREADPRIVATE(lambda, cstgrnd, lskin)
+
+  REAL(r_std), SAVE                               :: fz1, zalph               !! usefull constants for diverse use
+!$OMP THREADPRIVATE(fz1, zalph)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ptn                      !! vertically discretized 
+                                                                              !! soil temperatures @tex ($K$) @endtex. 
+!$OMP THREADPRIVATE(ptn)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: zz                       !! depths of the soil thermal numerical nodes. 
+                                                                              !! Caveats: they are not exactly the centers of the
+                                                                              !! thermal layers, see the calculation in 
+                                                                              !! ::thermosoilc_var_init  @tex ($m$) @endtex.
+!$OMP THREADPRIVATE(zz)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: zz_coef		      !! depths of the boundaries of the thermal layers,
+                                                                              !! see the calculation in 
+                                                                              !! thermosoilc_var_init  @tex ($m$) @endtex.
+!$OMP THREADPRIVATE(zz_coef)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: dz1                      !! numerical constant used in the thermal numerical
+                                                                              !! scheme  @tex ($m^{-1}$) @endtex. ; it corresponds
+                                                                              !! to the coefficient  @tex $d_k$ @endtex of equation
+                                                                              !! (A.12) in F. Hourdin PhD thesis.
+!$OMP THREADPRIVATE(dz1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: dz2                      !! thicknesses of the thermal layers  @tex ($m$)
+                                                                              !! @endtex; typically: 
+                                                                              !! dz2(jg)=zz_coef(jg+1)-zz_coef(jg); calculated once 
+                                                                              !! and for all in thermosoilc_var_init
+!$OMP THREADPRIVATE(dz2)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: cgrnd                    !! integration coefficient for the numerical scheme,
+                                                                              !! see eq.1
+!$OMP THREADPRIVATE(cgrnd)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dgrnd                    !! integration coefficient for the numerical scheme,
+                                                                              !! see eq.1
+!$OMP THREADPRIVATE(dgrnd)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcapa                    !! volumetric vertically discretized soil heat 
+                                                                              !! capacity  @tex ($J K^{-1} m^{-3}$) @endtex. 
+                                                                              !! It depends on the soil
+                                                                              !! moisture content (shum_ngrnd_perma) and is calculated at 
+                                                                              !! each time step in thermosoilc_coef.
+!$OMP THREADPRIVATE(pcapa)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pkappa                   !! vertically discretized soil thermal conductivity 
+                                                                              !!  @tex ($W K^{-1} m^{-1}$) @endtex. Same as pcapa.
+!$OMP THREADPRIVATE(pkappa)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcapa_snow               !! volumetric vertically discretized snow heat 
+                                                                              !! capacity @tex ($J K^{-1} m^{-3}$) @endtex.
+!$OMP THREADPRIVATE(pcapa_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pkappa_snow              !! vertically discretized snow thermal conductivity 
+                                                                              !! @tex ($W K^{-1} m^{-1}$) @endtex.
+!$OMP THREADPRIVATE(pkappa_snow)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcapa_en                 !! heat capacity used for surfheat_incr and 
+                                                                              !! coldcont_incr 
+!$OMP THREADPRIVATE(pcapa_en)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ptn_beg                  !! vertically discretized temperature at the 
+                                                                              !! beginning of the time step  @tex ($K$) @endtex; 
+                                                                              !! is used in 
+                                                                              !! thermosoilc_energy for energy-related diagnostic of
+                                                                              !! the routine.
+!$OMP THREADPRIVATE(ptn_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: temp_sol_beg             !! Surface temperature at the beginning of the 
+                                                                              !! timestep  @tex ($K$) @endtex
+!$OMP THREADPRIVATE(temp_sol_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: surfheat_incr            !! Change in soil heat content during the timestep 
+                                                                              !!  @tex ($J$) @endtex.
+!$OMP THREADPRIVATE(surfheat_incr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: coldcont_incr            !! Change in snow heat content  @tex ($J$) @endtex.
+!$OMP THREADPRIVATE(coldcont_incr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: shum_ngrnd_perma         !! Saturation degree on the thermal axes (0-1, dimensionless)
+!$OMP THREADPRIVATE(shum_ngrnd_perma)
+
+  !  Variables related to soil freezing
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: profil_froz              !! Frozen fraction of the soil on hydrological levels (-)
+!$OMP THREADPRIVATE(profil_froz)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION (:) :: e_soil_lat                  !! Accumulated latent heat for the whole soil (J)
+!$OMP THREADPRIVATE(e_soil_lat)
+  REAL(r_std),ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcappa_supp               !! Additional heat capacity due to soil freezing for each soil layer (J/K)
+!$OMP THREADPRIVATE(pcappa_supp)    
+
+
+CONTAINS
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : thermosoilc_initialize
+  !!
+  !>\BRIEF			            Allocate module variables, read from restart file or initialize with default values
+  !!
+  !! DESCRIPTION			    : Allocate module variables, read from restart file or initialize with default values.
+  !!                                          Call thermosoilc_var_init to calculate physical constants. 
+  !!                                          Call thermosoilc_coef to calculate thermal soil properties.
+  !!
+  !! RECENT CHANGE(S)			    : None
+  !!
+  !! REFERENCE(S)			    : None
+  !! 
+  !! FLOWCHART                              : None
+  !! \n
+  !_ ==============================================================================================================================
+  SUBROUTINE thermosoilc_initialize (kjit,          kjpindex,   rest_id,                   &
+                                    temp_sol_new,  snow,       shumdiag_perma,            &
+                                    soilcap,       soilflx,    stempdiag,                 &
+                                    gtemp, &
+                                    frac_snow_veg,frac_snow_nobio,totfrac_nobio, &
+                                    snowdz, snowrho, snowtemp, lambda_snow, cgrnd_snow, dgrnd_snow, pb)
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                            :: kjit             !! Time step number (unitless) 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex         !! Domain size (unitless)
+    INTEGER(i_std),INTENT (in)                            :: rest_id          !! Restart file identifier (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: temp_sol_new     !! Surface temperature at the present time-step,
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: snow             !! Snow mass (kg)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)    :: shumdiag_perma   !! Soil saturation degree on the diagnostic axis (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: frac_snow_veg    !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)   :: frac_snow_nobio  !! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: totfrac_nobio    !! Total fraction of continental ice+lakes+cities+...
+                                                                              !! (unitless,0-1)
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT (in)    :: snowdz           !! Snow depth
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)    :: snowrho         !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowtemp        !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: pb              !! Surface presure (hPa)
+
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: soilcap          !! apparent surface heat capacity (J m-2 K-1)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: soilflx          !! apparent soil heat flux (W m-2)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)   :: stempdiag        !! diagnostic temperature profile (K)
+    REAL(r_std),DIMENSION (kjpindex),INTENT(out)          :: gtemp            !! First soil layer temperature
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)       :: lambda_snow     !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: cgrnd_snow      !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: dgrnd_snow      !! Integration coefficient for snow numerical scheme
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                        :: ier, i
+    LOGICAL                                               :: calculate_coef   !! Local flag to initialize variables by call to thermosoilc_coef   
+!_ ================================================================================================================================
+    
+    IF (printlev >= 3) WRITE (numout,*) 'Start thermosoilc_initialize '
+
+    !! 1. Allocate soil temperatures variables
+    ALLOCATE (ptn(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of ptn','','')
+
+    ALLOCATE (zz(ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of zz','','')
+
+    ALLOCATE (zz_coef(ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of zz_coef','','')
+
+    ALLOCATE (dz1(ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of dz1','','')
+
+    ALLOCATE (dz2(ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of dz2','','')
+
+    ALLOCATE (cgrnd(kjpindex,ngrnd-1),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of cgrnd','','')
+
+    ALLOCATE (dgrnd(kjpindex,ngrnd-1),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of dgrnd','','')
+
+    ALLOCATE (pkappa_snow(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of pkappa_snow','','')
+
+    ALLOCATE (pcapa_snow(kjpindex,nsnow),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of pcapa_snow','','')
+
+    ALLOCATE (pcapa(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of pcapa','','')
+
+    ALLOCATE (pkappa(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of pkappa','','')
+
+    ALLOCATE (surfheat_incr(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of surfheat_incr','','')
+
+    ALLOCATE (coldcont_incr(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of coldcont_incr','','')
+
+    ALLOCATE (pcapa_en(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of pcapa_en','','')
+
+    ALLOCATE (ptn_beg(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of ptn_beg','','')
+
+    ALLOCATE (temp_sol_beg(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of temp_sol_beg','','')
+
+    ALLOCATE (shum_ngrnd_perma(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of shum_ngrnd_perma','','')
+
+    ALLOCATE (profil_froz(kjpindex,ngrnd),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of profil_froz','','')
+
+    IF (ok_freeze_thermix) THEN
+       ALLOCATE (pcappa_supp(kjpindex,ngrnd),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of ok_freeze_termix','','')
+    END IF
+    IF (ok_Ecorr) THEN
+       ALLOCATE (e_soil_lat(kjpindex),stat=ier)
+       IF (ier /= 0) CALL ipslerr_p(3,'thermosoilc_initialize', 'Error in allocation of e_soil_lat','','')
+    END IF
+
+    !! 2. Initialize variable from restart file or with default values 
+    
+    !! Reads restart files for soil temperatures only. If no restart file is
+    !! found,  the initial soil temperature is by default set to 280K at all depths. The user
+    !! can decide to initialize soil temperatures at an other value, in which case he should set the flag THERMOSOIL_TPRO
+    !! to this specific value in the run.def.
+    IF (printlev>=3) WRITE (numout,*) 'Read restart file for THERMOSOIL variables'
+
+    CALL ioconf_setatt_p('UNITS', 'K')
+    CALL ioconf_setatt_p('LONG_NAME','Soil Temperature profile')
+    CALL restget_p (rest_id, 'ptn', nbp_glo, ngrnd, 1, kjit, .TRUE., ptn, "gather", nbp_glo, index_g)
+
+    ! Initialize ptn if it was not found in restart file
+    IF (ALL(ptn(:,:)==val_exp)) THEN 
+       ! ptn was not found in restart file
+
+       IF (read_reftemp) THEN
+          ! Read variable ptn from file
+          CALL read_reftempfile(kjpindex,lalo,ptn)
+       ELSE
+          ! Initialize ptn with a constant value which can be set in run.def
+          
+          !Config Key   = THERMOSOIL_TPRO
+          !Config Desc  = Initial soil temperature profile if not found in restart
+          !Config Def   = 280.
+          !Config If    = OK_SECHIBA
+          !Config Help  = The initial value of the temperature profile in the soil if 
+          !Config         its value is not found in the restart file. Here
+          !Config         we only require one value as we will assume a constant 
+          !Config         throughout the column.
+          !Config Units = Kelvin [K]
+          CALL setvar_p (ptn, val_exp,'THERMOSOIL_TPRO',280._r_std)
+       END IF
+    END IF
+    
+    ! Initialize ptn_beg (variable needed in thermosoilc_coef before calucation in thermosoilc_energy)
+    ptn_beg(:,:) = ptn(:,:)
+    
+    ! Initialize temp_sol_beg with values from previous time-step
+    temp_sol_beg(:) = temp_sol_new(:) 
+    
+    ! Read e_soil_lat from restart file or initialize
+    IF (ok_Ecorr) THEN
+       CALL restget_p (rest_id, 'e_soil_lat', nbp_glo, 1, 1, kjit, .TRUE., &
+            e_soil_lat, "gather", nbp_glo, index_g)
+       CALL setvar_p (e_soil_lat, val_exp,'NO_KEYWORD',zero)
+    END IF
+
+    ! Read gtemp from restart file
+    CALL restget_p (rest_id, 'gtemp', nbp_glo, 1, 1, kjit, .TRUE., &
+         gtemp, "gather", nbp_glo, index_g)
+    CALL setvar_p (gtemp, val_exp,'NO_KEYWORD',zero)
+    
+    ! Read variables calculated in thermosoilc_coef from restart file
+    ! If the variables were not found in the restart file, the logical 
+    ! calculate_coef will be true and thermosoilc_coef will be called further below.
+    ! These variables need to be in the restart file to avoid a time shift that
+    ! would be done using thermosoilc_coef at this stage.
+    calculate_coef=.FALSE.
+    CALL ioconf_setatt_p('UNITS', 'J m-2 K-1')
+    CALL ioconf_setatt_p('LONG_NAME','Apparent surface heat capacity')
+    CALL restget_p (rest_id, 'soilcap', nbp_glo, 1, 1, kjit, .TRUE., &
+         soilcap, "gather", nbp_glo, index_g)
+    IF (ALL(soilcap(:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', 'W m-2')
+    CALL ioconf_setatt_p('LONG_NAME','Apparent soil heat flux')
+    CALL restget_p (rest_id, 'soilflx', nbp_glo, 1, 1, kjit, .TRUE., &
+         soilflx, "gather", nbp_glo, index_g)
+    IF (ALL(soilflx(:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Integration coefficient for the numerical scheme')
+    CALL restget_p (rest_id, 'cgrnd', nbp_glo, ngrnd-1, 1, kjit, .TRUE., &
+         cgrnd, "gather", nbp_glo, index_g)
+    IF (ALL(cgrnd(:,:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Integration coefficient for the numerical scheme')
+    CALL restget_p (rest_id, 'dgrnd', nbp_glo, ngrnd-1, 1, kjit, .TRUE., &
+         dgrnd, "gather", nbp_glo, index_g)
+    IF (ALL(dgrnd(:,:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Integration coefficient for the numerical scheme')
+    CALL restget_p (rest_id, 'cgrnd_snow', nbp_glo, nsnow, 1, kjit, .TRUE., &
+         cgrnd_snow, "gather", nbp_glo, index_g)
+    IF (ALL(cgrnd_snow(:,:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Integration coefficient for the numerical scheme')
+    CALL restget_p (rest_id, 'dgrnd_snow', nbp_glo, nsnow, 1, kjit, .TRUE., &
+         dgrnd_snow, "gather", nbp_glo, index_g)
+    IF (ALL(dgrnd_snow(:,:)==val_exp)) calculate_coef=.TRUE.
+
+    CALL ioconf_setatt_p('UNITS', '')
+    CALL ioconf_setatt_p('LONG_NAME','Coefficient of the linear extrapolation of surface temperature')
+    CALL restget_p (rest_id, 'lambda_snow', nbp_glo, 1, 1, kjit, .TRUE., &
+         lambda_snow, "gather", nbp_glo, index_g)
+    IF (ALL(lambda_snow(:)==val_exp)) calculate_coef=.TRUE.
+
+
+    !! 2.2.Computes physical constants and arrays; initializes soil thermal properties; produces the first stempdiag
+    !!  Computes some physical constants and arrays depending on the soil vertical discretization 
+    !! (lskin, cstgrnd, zz, zz_coef, dz1, dz2); get the vertical humidity onto the thermal levels
+    CALL thermosoilc_var_init (kjpindex, shumdiag_perma, snow, &
+         zz, zz_coef, dz1, dz2, stempdiag)
+    
+    !! 2.3. Computes cgrd, dgrd, soilflx and soilcap coefficients from restart values or initialisation values.
+    !!      This is done only if they were not found in restart file.
+    IF (calculate_coef) THEN
+       IF (printlev>=3) WRITE (numout,*) 'thermosoilc_coef will be called in the intialization phase'
+       CALL thermosoilc_coef (&
+            kjpindex, temp_sol_new, snow, &
+            ptn,      soilcap, soilflx,      zz, &
+            dz1,      dz2,           &
+            cgrnd,    dgrnd, &
+            frac_snow_veg,frac_snow_nobio,totfrac_nobio, &
+            snowdz,snowrho,  snowtemp,     pb,         &
+	    lambda_snow,    cgrnd_snow,    dgrnd_snow)
+    END IF
+
+  END SUBROUTINE thermosoilc_initialize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoilc_main
+!!
+!>\BRIEF        Thermosoilc_main computes the soil thermal properties and dynamics, ie solves
+!! the heat diffusion equation within the soil. The soil temperature profile is
+!! then interpolated onto the diagnostic axis.
+!!
+!! DESCRIPTION : The resolution of the soil heat diffusion equation 
+!! relies on a numerical finite-difference implicit scheme
+!! fully described in the reference and in the header of the thermosoilc module.
+!! - The dependency of the previous timestep hidden in the 
+!! integration coefficients cgrnd and dgrnd (EQ1), calculated in thermosoilc_coef, and 
+!! called at the end of the routine to prepare for the next timestep.
+!! - The effective computation of the new soil temperatures is performed in thermosoilc_profile. 
+!!
+!! - thermosoilc_coef calculates the coefficients for the numerical scheme for the very first iteration of thermosoilc;
+!! after that, thermosoilc_coef is called only at the end of the module to calculate the coefficients for the next timestep.
+!! - thermosoilc_profile solves the numerical scheme.\n
+!!
+!! - Flags : one unique flag : THERMOSOIL_TPRO (to be set to the desired initial soil in-depth temperature in K; by default 280K)
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): vertically discretized soil temperatures ptn, soil
+!! thermal properties (pcapa, pkappa), apparent surface heat capacity (soilcap)
+!! and heat flux (soilflux) to be used in enerbil at the next timestep to solve
+!! the surface energy balance.
+!!
+!! REFERENCE(S) : 
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of planetary atmospheres,
+!!  Ph.D. thesis, Paris VII University. Remark: the part of F. Hourdin' s PhD thesis relative to the thermal
+!!  integration scheme has been scanned and is provided along with the documentation, with name : 
+!!  Hourdin_1992_PhD_thermal_scheme.pdf
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{thermosoil_flowchart.png}
+!! \endlatexonly
+!! 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoilc_main (kjit, kjpindex, &
+       index, indexgrnd, &
+       indexnbdl, &
+       temp_sol_new, snow, soilcap, soilflx, &
+       shumdiag_perma, stempdiag, ptnlev1, rest_id, hist_id, hist2_id, &
+       snowdz,snowrho,snowtemp,gtemp,pb,&
+       frac_snow_veg,frac_snow_nobio,totfrac_nobio,temp_sol_add, &
+       lambda_snow, cgrnd_snow, dgrnd_snow)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                            :: kjit             !! Time step number (unitless) 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex         !! Domain size (unitless)
+    INTEGER(i_std),INTENT (in)                            :: rest_id,hist_id  !! Restart_ file and history file identifier 
+                                                                              !! (unitless)
+    INTEGER(i_std),INTENT (in)                            :: hist2_id         !! history file 2 identifier (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: index            !! Indeces of the points on the map (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex*ngrnd), INTENT (in):: indexgrnd        !! Indeces of the points on the 3D map (vertical 
+                                                                              !! dimension towards the ground) (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: temp_sol_new     !! Surface temperature at the present time-step,
+                                                                              !! temp_sol_new is only modified for the case ok_explicitsnow
+                                                                              !! Ts @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: snow             !! Snow mass @tex ($kg$) @endtex.
+                                                                              !! Caveat: when there is snow on the
+                                                                              !! ground, the snow is integrated into the soil for
+                                                                              !! the calculation of the thermal dynamics. It means
+                                                                              !! that the uppermost soil layers can completely or 
+                                                                              !! partially consist in snow. In the second case, zx1
+                                                                              !! and zx2 are the fraction of the soil layer 
+                                                                              !! consisting in snow and 'normal' soil, respectively
+                                                                              !! This is calculated in thermosoilc_coef.
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)    :: shumdiag_perma   !! Soil saturation degree on the diagnostic axis (0-1, unitless)
+    INTEGER(i_std),DIMENSION (kjpindex*nbdl), INTENT (in) :: indexnbdl        !! Indeces of the points on the 3D map
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT (in)    :: snowdz           !! Snow depth
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT (in)    :: snowrho          !! Snow density
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)        :: pb               !! Surface presure (hPa)
+
+    REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT (inout) :: snowtemp         !! Snow temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: frac_snow_veg    !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)   :: frac_snow_nobio  !! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: totfrac_nobio    !! Total fraction of continental ice+lakes+cities+...
+                                                                              !!(unitless,0-1)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: temp_sol_add     !! additional surface temperature due to the melt of first layer
+                                                                              !!at the present time-step @tex ($K$) @endtex
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: ptnlev1          !! 1st level soil temperature   
+    REAL(r_std),DIMENSION (kjpindex),INTENT(out)          :: gtemp            !! First soil layer temperature
+
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: soilcap          !! apparent surface heat capacity
+                                                                              !! @tex ($J m^{-2} K^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: soilflx          !! apparent soil heat flux @tex ($W m^{-2}$) @endtex
+                                                                              !! , positive 
+                                                                              !! towards the soil, writen as Qg (ground heat flux) 
+                                                                              !! in the history files, and computed at the end of 
+                                                                              !! thermosoilc for the calculation of Ts in enerbil, 
+                                                                              !! see EQ3.
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (inout) :: stempdiag        !! diagnostic temperature profile @tex ($K$) @endtex
+                                                                              !! , eg on the 
+                                                                              !! diagnostic axis (levels:1:nbdl). The soil 
+                                                                              !! temperature is put on this diagnostic axis to be
+                                                                              !! used by other modules (slowproc.f90; routing.f90;
+                                                                              !! hydrol or hydrolc when a frozen soil 
+                                                                              !! parametrization is used..)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)       :: lambda_snow     !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: cgrnd_snow      !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: dgrnd_snow      !! Integration coefficient for snow numerical scheme
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                        :: jv,ji,ii
+
+!_ ================================================================================================================================
+    
+  !! 3. Put the soil wetness diagnostic on the levels of the soil temperature
+
+    !!?? this could logically be put just before the last call to
+    !!thermosoil_coef, as the results are used there...
+    CALL thermosoilc_humlev(kjpindex, shumdiag_perma, snow)
+
+    
+  !! 4. Effective computation of the soil temperatures profile, using the cgrd and dgrd coefficients from previsou tstep.
+    
+    CALL thermosoilc_profile (kjpindex, temp_sol_new, ptn,  &
+         stempdiag,snowtemp, frac_snow_veg, frac_snow_nobio,totfrac_nobio, &
+         cgrnd_snow, dgrnd_snow)
+
+  !! 5. Call to thermosoilc_energy, still to be clarified..
+
+    CALL thermosoilc_energy (kjpindex, temp_sol_new, soilcap)
+
+  !! 6. Writing the history files according to the ALMA standards (or not..)
+
+    !in only one file (hist2_id <=0) or in 2 different files (hist2_id >0).
+    CALL xios_orchidee_send_field("ptn",ptn)
+    CALL xios_orchidee_send_field("Qg",soilflx)
+    CALL xios_orchidee_send_field("DelSurfHeat",surfheat_incr)
+    CALL xios_orchidee_send_field("DelColdCont",coldcont_incr)
+
+    IF ( .NOT. almaoutput ) THEN
+      CALL histwrite_p(hist_id, 'ptn', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+      CALL histwrite_p(hist_id, 'Qg', kjit, soilflx, kjpindex, index)
+    ELSE
+      CALL histwrite_p(hist_id, 'SoilTemp', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+      CALL histwrite_p(hist_id, 'Qg', kjit, soilflx, kjpindex, index)
+      CALL histwrite_p(hist_id, 'DelSurfHeat', kjit, surfheat_incr, kjpindex, index)
+      CALL histwrite_p(hist_id, 'DelColdCont', kjit, coldcont_incr, kjpindex, index)
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist2_id, 'ptn', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+       ELSE
+          CALL histwrite_p(hist2_id, 'SoilTemp', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+          CALL histwrite_p(hist2_id, 'Qg', kjit, soilflx, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSurfHeat', kjit, surfheat_incr, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelColdCont', kjit, coldcont_incr, kjpindex, index)
+       ENDIF
+    ENDIF
+    
+  !! 7. A last final call to thermosoilc_coef
+ 
+    !! A last final call to thermosoilc_coef, which calculates the different
+    !!coefficients (cgrnd, dgrnd, dz1, soilcap, soilflx) from this time step to be
+    !!used at the next time step, either in the surface temperature calculation
+    !!(soilcap, soilflx) or in the soil thermal numerical scheme.
+    CALL thermosoilc_coef (&
+         kjpindex, temp_sol_new, snow, &
+         ptn,      soilcap, soilflx,      zz,   &
+         dz1,      dz2,                     &
+         cgrnd,   dgrnd, &
+         frac_snow_veg,frac_snow_nobio,totfrac_nobio,&
+         snowdz,snowrho,  snowtemp,     pb, &
+	 lambda_snow,    cgrnd_snow,    dgrnd_snow)
+
+    ! Save variables for explicit snow model
+    gtemp(:) = ptn(:,1)
+
+    !! Initialize output arguments to be used in sechiba
+    ptnlev1(:) = ptn(:,1)
+
+
+    !! Surface temperature is forced to zero celcius if its value is larger than melting point, only for explicit snow scheme
+    IF  (ok_explicitsnow) THEN
+       DO ji=1,kjpindex
+          IF  (SUM(snowdz(ji,:)) .GT. 0.0) THEN
+             IF (temp_sol_new(ji) .GE. tp_00) THEN
+                temp_sol_new(ji) = tp_00
+             ENDIF
+          END IF
+       END DO
+    ENDIF
+
+
+    IF (printlev>=3) WRITE (numout,*) ' thermosoilc_main done '
+
+  END SUBROUTINE thermosoilc_main
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : thermosoilc_finalize
+  !!
+  !>\BRIEF                                    Write to restart file
+  !!
+  !! DESCRIPTION			    : This subroutine writes the module variables and variables calculated in thermosoilc
+  !!                                          to restart file
+  !! \n
+  !_ ==============================================================================================================================
+  SUBROUTINE thermosoilc_finalize (kjit,    kjpindex, rest_id,   gtemp,     &
+                                  soilcap, soilflx, lambda_snow, cgrnd_snow, dgrnd_snow)
+
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                            :: kjit             !! Time step number (unitless) 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex         !! Domain size (unitless)
+    INTEGER(i_std),INTENT (in)                            :: rest_id          !! Restart file identifier(unitless)
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: gtemp            !! First soil layer temperature
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: soilcap
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)           :: soilflx
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)         :: lambda_snow      !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (in)  :: cgrnd_snow       !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (in)  :: dgrnd_snow       !! Integration coefficient for snow numerical scheme
+
+!_ ================================================================================================================================
+    
+    !! 1. Write variables to restart file to be used for the next simulation
+    IF (printlev>=3) WRITE (numout,*) 'Write restart file with THERMOSOIL variables'
+    
+    CALL restput_p(rest_id, 'ptn', nbp_glo, ngrnd, 1, kjit, ptn, 'scatter', nbp_glo, index_g)
+    
+    IF (ok_Ecorr) THEN
+       CALL restput_p(rest_id, 'e_soil_lat', nbp_glo, 1 , 1, kjit, e_soil_lat, 'scatter', nbp_glo, index_g)
+    END IF
+    
+    CALL restput_p(rest_id, 'gtemp', nbp_glo, 1, 1, kjit, gtemp, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'soilcap', nbp_glo, 1, 1, kjit, soilcap, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'soilflx', nbp_glo, 1, 1, kjit, soilflx, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'cgrnd', nbp_glo, ngrnd-1, 1, kjit, cgrnd, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'dgrnd', nbp_glo, ngrnd-1, 1, kjit, dgrnd, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'cgrnd_snow', nbp_glo, nsnow, 1, kjit, cgrnd_snow, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'dgrnd_snow', nbp_glo, nsnow, 1, kjit, dgrnd_snow, 'scatter', nbp_glo, index_g)
+    CALL restput_p(rest_id, 'lambda_snow', nbp_glo, 1, 1, kjit, lambda_snow, 'scatter', nbp_glo, index_g)
+
+  END SUBROUTINE thermosoilc_finalize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoilc_clear
+!!
+!>\BRIEF        Desallocates the allocated arrays.
+!! The call of thermosoilc_clear originates from sechiba_clear but the calling sequence and 
+!! its purpose require further investigation.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE thermosoilc_clear()
+
+        IF ( ALLOCATED (ptn)) DEALLOCATE (ptn)
+        IF ( ALLOCATED (cgrnd)) DEALLOCATE (cgrnd) 
+        IF ( ALLOCATED (dgrnd)) DEALLOCATE (dgrnd) 
+        IF ( ALLOCATED (pcapa)) DEALLOCATE (pcapa)
+        IF ( ALLOCATED (pkappa))  DEALLOCATE (pkappa)
+        IF ( ALLOCATED (pcapa_en)) DEALLOCATE (pcapa_en)
+        IF ( ALLOCATED (ptn_beg)) DEALLOCATE (ptn_beg)
+        IF ( ALLOCATED (temp_sol_beg)) DEALLOCATE (temp_sol_beg)
+        IF ( ALLOCATED (surfheat_incr)) DEALLOCATE (surfheat_incr)
+        IF ( ALLOCATED (coldcont_incr)) DEALLOCATE (coldcont_incr)
+        IF ( ALLOCATED (shum_ngrnd_perma)) DEALLOCATE (shum_ngrnd_perma)
+        IF ( ALLOCATED (profil_froz)) DEALLOCATE (profil_froz)
+
+  END SUBROUTINE thermosoilc_clear
+
+
+!! ================================================================================================================================
+!! FUNCTION     : fz
+!!
+!>\BRIEF        fz(rk), the function's result, is the "rk"th element of a geometric series 
+!! with first element fz1 and ration zalph.
+!!
+!! DESCRIPTION  : This function is used to calculate the depths of the boudaries of the thermal layers (zz_coef) and 
+!! of the numerical nodes (zz) of the thermal scheme. Formulae to get the adimensional depths are followings :
+!!      zz(jg)      = fz(REAL(jg,r_std) - undemi); \n
+!!      zz_coef(jg) = fz(REAL(jg,r_std))
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! RETURN VALUE : fz(rk)
+!!
+!! REFERENCE(S) : None 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION fz(rk) RESULT (fz_result)
+
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    REAL(r_std), INTENT(in)                        :: rk
+    
+    !! 0.2 Output variables
+
+    REAL(r_std)                                    :: fz_result
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+!_ ================================================================================================================================
+
+    fz_result = fz1 * (zalph ** rk - un) / (zalph - un)
+
+  END FUNCTION fz
+
+
+!! ================================================================================================================================
+!! FUNCTION     : thermosoilc_levels
+!!
+!>\BRIEF          Depth of nodes for the thermal layers in meters. 
+!!
+!! DESCRIPTION  : Calculate and return the depth in meters of the nodes of the soil layers. This calculation is the same 
+!!                as done in thermosoilc_var_init for zz. See thermosoilc_var_init for more details. 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! RETURN VALUE : Vector of soil depth for the nodes in meters
+!!
+!! REFERENCE(S) : None 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION thermosoilc_levels() RESULT (zz_out)
+    
+    !! 0.1 Return variable
+    
+    REAL(r_std), DIMENSION (ngrnd)  :: zz_out      !! Depth of soil layers in meters
+    
+    !! 0.2 Local variables
+    INTEGER(i_std)                  :: jg
+    REAL(r_std)                     :: so_capa
+    REAL(r_std)                     :: so_cond
+    
+!_ ================================================================================================================================
+
+    !! 1. Define some parameters
+    so_capa = (so_capa_dry + so_capa_wet)/deux
+    so_cond = (so_cond_dry + so_cond_wet)/deux
+    
+    cstgrnd=SQRT(one_day / pi)
+    lskin = SQRT(so_cond / so_capa * one_day / pi)
+
+    !! Parameters needed by fz function
+    fz1 = 0.3_r_std * cstgrnd
+    zalph = deux
+
+    !!  2. Get adimentional depth of the numerical nodes
+    DO jg=1,ngrnd
+       zz_out(jg) = fz(REAL(jg,r_std) - undemi)
+    ENDDO
+    
+    !! 3. Convert to meters
+    DO jg=1,ngrnd
+       zz_out(jg) = zz_out(jg) /  cstgrnd * lskin
+    END DO
+
+  END FUNCTION thermosoilc_levels
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoilc_var_init
+!!
+!>\BRIEF        Define and initializes the soil thermal parameters
+!!		  
+!! DESCRIPTION	: This routine\n
+!! 1. Defines the parameters ruling the vertical grid of the thermal scheme (fz1, zalpha).\n
+!! 2. Defines the scaling coefficients for adimensional depths (lskin, cstgrnd, see explanation in the 
+!!    variables description of thermosoilc_main). \n
+!! 3. Calculates the vertical discretization of the soil (zz, zz_coef, dz2) and the constants used
+!!    in the numerical scheme and which depend only on the discretization (dz1, lambda).\n
+!! 4. Initializes the soil thermal parameters (capacity, conductivity) based on initial soil moisture content.\n
+!! 5. Produces a first temperature diagnostic based on temperature initialization.\n
+!!
+!! The scheme comprizes ngrnd=7 layers by default.
+!! The layer' s boundaries depths (zz_coef) follow a geometric series of ratio zalph=2 and first term fz1.\n
+!! zz_coef(jg)=fz1.(1-zalph^jg)/(1-zalph) \n
+!! The layers' boudaries depths are first calculated 'adimensionally', ie with a
+!! discretization adapted to EQ5. This discretization is chosen for its ability at
+!! reproducing a thermal signal with periods ranging from days to centuries. (see
+!! Hourdin, 1992). Typically, fz1 is chosen as : fz1=0.3*cstgrnd (with cstgrnd the
+!! adimensional attenuation depth). \n
+!! The factor lskin/cstgrnd is then used to go from adimensional depths to
+!! depths in m.\n
+!! zz(real)=lskin/cstgrnd*zz(adimensional)\n
+!! Similarly, the depths of the numerical nodes are first calculated
+!! adimensionally, then the conversion factor is applied.\n
+!! the numerical nodes (zz) are not exactly the layers' centers : their depths are calculated as follows:\n
+!! zz(jg)=fz1.(1-zalph^(jg-1/2))/(1-zalph)\n
+!! The values of zz and zz_coef used in the default thermal discretization are in the following table.
+!! \latexonly
+!! \includegraphics{thermosoilc_var_init1.jpg}
+!! \endlatexonly\n
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : None
+!!
+!! REFERENCE(S)	:
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of 
+!! planetary atmospheres, Ph.D. thesis, Paris VII University.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoilc_var_init(kjpindex, shumdiag_perma, snow, &
+                                 zz, zz_coef, dz1, dz2, stempdiag)
+
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex          !! Domain size (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nbdl), INTENT (in)      :: shumdiag_perma    !! Relative soil humidity on the diagnostic axis 
+                                                                                  !! (unitless), [0,1]. (see description of the 
+                                                                                  !! variables of thermosoilc_main for more 
+                                                                                  !! explanations) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)     	     :: snow              !! Snow quantity   
+   
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (ngrnd), INTENT(out)              :: zz                !! depths of the layers'numerical nodes 
+                                                                                  !! @tex ($m$)@endtex 
+    REAL(r_std), DIMENSION (ngrnd), INTENT(out)              :: zz_coef		  !! depths of the layers'boundaries 
+                                                                                  !! @tex ($m$)@endtex 
+    REAL(r_std), DIMENSION (ngrnd), INTENT(out)              :: dz1               !! numerical constant depending on the vertical
+                                                                                  !! thermal grid only @tex  ($m^{-1}$) @endtex. 
+                                                                                  !! (see description
+                                                                                  !! of the variables of thermosoilc_main for more
+                                                                                  !! explanations)
+    REAL(r_std), DIMENSION (ngrnd), INTENT(out)              :: dz2               !! thicknesses of the soil thermal layers 
+                                                                                  !! @tex ($m$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nbdl), INTENT (out)     :: stempdiag         !! Diagnostic temperature profile @tex ($K$)
+                                                                                  !! @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ier, ji, jg       !! Index (unitless)
+    REAL(r_std)                                              :: sum               !! Temporary variable
+    REAL(r_std)                                              :: so_capa           !! Average Thermal Conductivity of soils 
+                                                                                  !! @tex $(W.m^{-2}.K^{-1})$ @endtex
+    REAL(r_std)                                              :: so_cond           !! Average Thermal Conductivity of soils 
+                                                                                  !! @tex $(W.m^{-2}.K^{-1})$ @endtex
+
+!_ ================================================================================================================================
+
+  !! 1. Initialization of the parameters of the vertical discretization and of the attenuation depths
+    
+    !! so_capa and so_cond are temporary variables which contain the average values of soil conductivity 
+    !! and soil conductivity and are only needed in thermosoilc_var_init to set the vertical layering. 
+    so_capa = (so_capa_dry + so_capa_wet)/deux
+    so_cond = (so_cond_dry + so_cond_wet)/deux
+
+    cstgrnd=SQRT(one_day / pi)
+    lskin = SQRT(so_cond / so_capa * one_day / pi)
+    fz1 = 0.3_r_std * cstgrnd
+    zalph = deux
+
+    !! Calculate so_capa_ice
+    so_capa_ice = so_capa_dry + poros*capa_ice*rho_ice
+    WRITE(numout,*) 'Calculation of so_capa_ice=', so_capa_ice,' using poros=',poros,' and capa_ice=',capa_ice
+    
+  !! 2.  Computing the depth of the thermal levels (numerical nodes) and the layers boundaries
+   
+    !! Computing the depth of the thermal levels (numerical nodes) and 
+    !! the layers boundariesusing the so-called
+    !! adimentional variable z' = z/lskin*cstgrnd (with z in m)
+    
+    !! 2.1 adimensional thicknesses of the layers
+    DO jg=1,ngrnd
+
+    !!?? code simplification hopefully possible here with up-to-date compilers !
+    !!! This needs to be solved soon. Either we allow CPP options in SECHIBA or the VPP
+    !!! fixes its compiler 
+    !!!#ifdef VPP5000
+      dz2(jg) = fz(REAL(jg,r_std)-undemi+undemi) - fz(REAL(jg-1,r_std)-undemi+undemi)
+    !!!#else
+    !!!      dz2(jg) = fz(REAL(jg,r_std)) - fz(REAL(jg-1,r_std))
+    !!!#endif
+    ENDDO
+    
+    !! 2.2 adimentional depth of the numerical nodes and layers' boudaries
+    DO jg=1,ngrnd
+      zz(jg)      = fz(REAL(jg,r_std) - undemi)
+      zz_coef(jg) = fz(REAL(jg,r_std)-undemi+undemi)
+    ENDDO
+
+    !! 2.3 Converting to meters
+    DO jg=1,ngrnd
+      zz(jg)      = zz(jg) /  cstgrnd * lskin
+      zz_coef(jg) = zz_coef(jg) / cstgrnd * lskin 
+      dz2(jg)     = dz2(jg) /  cstgrnd * lskin
+    ENDDO
+
+    !! 2.4 Computing some usefull constants for the numerical scheme
+    DO jg=1,ngrnd-1
+      dz1(jg)  = un / (zz(jg+1) - zz(jg))
+    ENDDO
+    lambda = zz(1) * dz1(1)
+
+    !! 2.5 Get the wetness profile on the thermal vertical grid from the diagnostic axis
+    CALL thermosoilc_humlev(kjpindex, shumdiag_perma, snow)
+
+  !! 3. Diagnostics : consistency checks on the vertical grid.
+
+    WRITE (numout,*) 'diagnostic des niveaux dans le sol' !!?? to be changed,
+    WRITE (numout,*) 'niveaux intermediaires et pleins'
+    sum = zero
+    DO jg=1,ngrnd
+      sum = sum + dz2(jg)
+      WRITE (numout,*) zz(jg),sum
+    ENDDO
+
+    
+  !! 4. Compute a first diagnostic temperature profile
+    
+    CALL thermosoilc_diaglev(kjpindex, stempdiag)
+
+    IF (printlev>=3) WRITE (numout,*) ' thermosoilc_var_init done '
+
+  END SUBROUTINE thermosoilc_var_init
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoilc_coef
+!!
+!>\BRIEF        Calculate soil thermal properties, integration coefficients, apparent heat flux,
+!! surface heat capacity,  
+!!
+!! DESCRIPTION	: This routine computes : \n
+!!		1. the soil thermal properties. \n 
+!!		2. the integration coefficients of the thermal numerical scheme, cgrnd and dgrnd,
+!!              which depend on the vertical grid and on soil properties, and are used at the next 
+!!              timestep.\n
+!!              3. the soil apparent heat flux and surface heat capacity soilflux
+!!              and soilcap, used by enerbil to compute the surface temperature at the next
+!!              timestep.\n
+!!             -  The soil thermal properties depend on water content (shum_ngrnd_perma, shumdiag_perma) and on the presence 
+!!              of snow : snow is integrated into the soil for the thermal calculations, ie if there 
+!!              is snow on the ground, the first thermal layer(s) consist in snow, depending on the 
+!!              snow-depth. If a layer consists out of snow and soil, wheighed soil properties are 
+!!              calculated\n
+!!             - The coefficients cgrnd and dgrnd are the integration
+!!              coefficients for the thermal scheme \n
+!!                              T(k+1)=cgrnd(k)+dgrnd(k)*T(k) \n
+!!                                      -- EQ1 -- \n
+!!              They correspond respectively to $\beta$ and $\alpha$ from F. Hourdin\'s thesis and 
+!!              their expression can be found in this document (eq A19 and A20)
+!!             - soilcap and soilflux are the apparent surface heat capacity and flux
+!!               used in enerbil at the next timestep to solve the surface
+!!               balance for Ts (EQ3); they correspond to $C_s$ and $F_s$ in F.
+!!               Hourdin\'s PhD thesis and are expressed in eq. A30 and A31. \n
+!!                 soilcap*(Ts(t)-Ts(t-1))/dt=soilflux+otherfluxes(Ts(t)) \n
+!!                                      -- EQ3 --\n
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): cgrnd, dgrnd, pcapa, pkappa, soilcap, soilflx
+!!
+!! REFERENCE(S) :
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of planetary atmospheres,
+!! Ph.D. thesis, Paris VII University. Remark: the part of F. Hourdin's PhD thesis relative to the thermal
+!! integration scheme has been scanned and is provided along with the documentation, with name : 
+!! Hourdin_1992_PhD_thermal_scheme.pdf
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoilc_coef (kjpindex, temp_sol_new, snow,            &
+                              ptn,      soilcap, soilflx,      zz,     &
+                              dz1,      dz2,                           &
+                              cgrnd,    dgrnd,                         &
+                              frac_snow_veg,frac_snow_nobio,totfrac_nobio, &
+                              snowdz,snowrho,  snowtemp,     pb,         &
+			      lambda_snow,    cgrnd_snow,    dgrnd_snow)
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                             :: kjpindex     !! Domain size (unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: temp_sol_new !! soil surface temperature @tex ($K$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: snow         !! snow mass @tex ($Kg$) @endtex
+    REAL(r_std), DIMENSION (ngrnd), INTENT(in)             :: zz           !! depths of the soil thermal numerical nodes 
+                                                                           !! @tex ($m$) @endtex 
+    REAL(r_std), DIMENSION (ngrnd), INTENT(in)             :: dz1          !! numerical constant depending on the vertical 
+                                                                           !! thermal grid only @tex ($m^{-1}$) @endtex 
+    REAL(r_std), DIMENSION (ngrnd), INTENT(in)             :: dz2          !! thicknesses of the soil thermal layers
+                                                                           !! @tex ($m$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)           :: frac_snow_veg   !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)    :: frac_snow_nobio !! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)            :: totfrac_nobio   !! Total fraction of continental ice+lakes+cities+...
+                                                                              !!(unitless,0-1)
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)    :: snowdz          !! Snow depth
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)    :: snowrho         !! Snow density
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in)    :: snowtemp        !! Snow temperature
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: pb              !! Surface presure (hPa)
+    
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)        :: soilcap      !! surface heat capacity
+                                                                           !! @tex ($J m^{-2} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)        :: soilflx      !! surface heat flux @tex ($W m^{-2}$) @endtex,
+                                                                           !! positive towards the 
+                                                                           !! soil, writen as Qg (ground heat flux) in the history 
+                                                                           !! files.
+    REAL(r_std), DIMENSION (kjpindex,ngrnd-1), INTENT(out) :: cgrnd        !! matrix coefficient for the computation of soil 
+                                                                           !! temperatures (beta in F. Hourdin thesis)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd-1), INTENT(out) :: dgrnd        !! matrix coefficient for the computation of soil 
+                                                                           !! temperatures (alpha in F. Hourdin thesis)
+
+
+    !! 0.3 Modified variable
+
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT (inout):: ptn          !! vertically discretized soil temperatures
+                                                                           !! @tex ($K$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)       :: lambda_snow  !! Coefficient of the linear extrapolation of surface temperature 
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: cgrnd_snow   !! Integration coefficient for snow numerical scheme
+    REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT (inout):: dgrnd_snow   !! Integration coefficient for snow numerical scheme
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                         :: ji, jg
+    REAL(r_std), DIMENSION (kjpindex,ngrnd-1)              :: zdz1         !! numerical (buffer) constant 
+                                                                           !! @tex ($W m^{-1} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,ngrnd)                :: zdz2         !! numerical (buffer) constant  
+                                                                           !! @tex ($W m^{-1} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex)                      :: z1           !! numerical constant @tex ($W m^{-1} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex)                      :: soilcap_nosnow !! surface heat capacity
+                                                                             !! @tex ($J m^{-2} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex)                      :: soilflx_nosnow !! surface heat flux @tex ($W m^{-2}$) @endtex,
+                                                                             !! positive towards the soil, written as Qg (ground heat flux in the history files).
+    REAL(r_std), DIMENSION (kjpindex)                      :: snowcap        !! apparent snow heat capacity @tex ($J m^{-2} K^{-1}$)
+    REAL(r_std), DIMENSION (kjpindex)                      :: snowflx        !! apparent snow-atmosphere heat flux @tex ($W m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: dz1_snow
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: ZSNOWDZM
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: dz2_snow
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: zdz1_snow
+    REAL(r_std), DIMENSION (kjpindex,nsnow)                :: zdz2_snow
+    REAL(r_std), DIMENSION (kjpindex)                      :: z1_snow
+
+!_ ================================================================================================================================
+
+  !! 1. Computation of the soil thermal properties
+   
+    ! Computation of the soil thermal properties; snow properties are also accounted for
+    IF (ok_freeze_thermix) THEN
+       CALL thermosoilc_getdiff( kjpindex, snow, ptn, snowrho, snowtemp, pb )
+    ELSE IF (ok_explicitsnow) THEN
+       ! Special case with explicit snow model without soil freezing
+       CALL thermosoilc_getdiff_old_thermix_without_snow( kjpindex, snowrho, snowtemp, pb )
+    ELSE
+       ! Special case with old snow without soil freezing
+       CALL thermosoilc_getdiff_old_thermix_with_snow( kjpindex, snow )
+    ENDIF
+
+    ! Energy conservation : Correction to make sure that the same latent heat is released and 
+    ! consumed during freezing and thawing
+    IF (ok_Ecorr) THEN
+       CALL thermosoilc_readjust(kjpindex, ptn)
+    ENDIF
+    
+
+    !! 2. Computation of the coefficients of the numerical integration scheme for the soil layers
+
+    !! 2.1 Calculate numerical coefficients zdz1 and zdz2
+    DO jg=1,ngrnd
+      DO ji=1,kjpindex
+        zdz2(ji,jg)=pcapa(ji,jg) * dz2(jg)/dt_sechiba
+      ENDDO
+    ENDDO
+    
+    DO jg=1,ngrnd-1
+      DO ji=1,kjpindex
+        zdz1(ji,jg) = dz1(jg) * pkappa(ji,jg)
+      ENDDO
+    ENDDO
+    
+    !! 2.2 Calculate coefficients cgrnd and dgrnd for soil
+    DO ji = 1,kjpindex
+      z1(ji) = zdz2(ji,ngrnd) + zdz1(ji,ngrnd-1)
+      cgrnd(ji,ngrnd-1) = zdz2(ji,ngrnd) * ptn(ji,ngrnd) / z1(ji)
+      dgrnd(ji,ngrnd-1) = zdz1(ji,ngrnd-1) / z1(ji)
+    ENDDO
+
+    DO jg = ngrnd-1,2,-1
+      DO ji = 1,kjpindex
+        z1(ji) = un / (zdz2(ji,jg) + zdz1(ji,jg-1) + zdz1(ji,jg) * (un - dgrnd(ji,jg)))
+        cgrnd(ji,jg-1) = (ptn(ji,jg) * zdz2(ji,jg) + zdz1(ji,jg) * cgrnd(ji,jg)) * z1(ji)
+        dgrnd(ji,jg-1) = zdz1(ji,jg-1) * z1(ji)
+      ENDDO
+    ENDDO
+
+
+    !! 3. Computation of the coefficients of the numerical integration scheme for the snow layers
+
+    !! 3.1 Calculate numerical coefficients zdz1_snow, zdz2_snow and lambda_snow
+    DO ji = 1, kjpindex
+
+       dz2_snow(ji,:) = 0
+
+       IF ( ok_explicitsnow ) THEN
+
+          ! Calculate internal values
+          DO jg = 1, nsnow
+             ZSNOWDZM(ji,jg) = MAX(snowdz(ji,jg),psnowdzmin)
+          ENDDO
+          dz2_snow(ji,:)=ZSNOWDZM(ji,:)
+
+          DO jg = 1, nsnow-1
+             dz1_snow(ji,jg)  = 2.0 / (dz2_snow(ji,jg+1)+dz2_snow(ji,jg))
+          ENDDO
+
+          lambda_snow(ji) = dz2_snow(ji,1)/2.0 * dz1_snow(ji,1)
+
+          DO jg=1,nsnow
+             zdz2_snow(ji,jg)=pcapa_snow(ji,jg) * dz2_snow(ji,jg)/dt_sechiba
+          ENDDO
+
+          DO jg=1,nsnow-1
+             zdz1_snow(ji,jg) = dz1_snow(ji,jg) * pkappa_snow(ji,jg)
+          ENDDO
+
+          ! the bottom snow
+          zdz1_snow(ji,nsnow) = pkappa_snow(ji,nsnow) / ( zz_coef(1) + dz2_snow(ji,nsnow)/2 )
+
+       ELSE
+          ! There is no snow, these values will never be used
+          lambda_snow(ji) = lambda
+       ENDIF
+
+    ENDDO
+
+    !! 3.2 Calculate coefficients cgrnd_snow and dgrnd_snow for snow
+    DO ji = 1,kjpindex
+       IF ( ok_explicitsnow ) THEN
+          ! bottom level
+          z1_snow(ji) = zdz2(ji,1)+(un-dgrnd(ji,1))*zdz1(ji,1)+zdz1_snow(ji,nsnow)
+          cgrnd_snow(ji,nsnow) = (zdz2(ji,1) * ptn(ji,1) + zdz1(ji,1) * cgrnd(ji,1) ) / z1_snow(ji)
+          dgrnd_snow(ji,nsnow) = zdz1_snow(ji,nsnow) / z1_snow(ji)
+
+          ! next-to-bottom level
+          z1_snow(ji) = zdz2_snow(ji,nsnow)+(un-dgrnd_snow(ji,nsnow))*zdz1_snow(ji,nsnow)+zdz1_snow(ji,nsnow-1)
+          cgrnd_snow(ji,nsnow-1) = (zdz2_snow(ji,nsnow)*snowtemp(ji,nsnow)+&
+               zdz1_snow(ji,nsnow)*cgrnd_snow(ji,nsnow))/z1_snow(ji)
+          dgrnd_snow(ji,nsnow-1) = zdz1_snow(ji,nsnow-1) / z1_snow(ji)
+
+          DO jg = nsnow-1,2,-1
+             z1_snow(ji) = un / (zdz2_snow(ji,jg) + zdz1_snow(ji,jg-1) + zdz1_snow(ji,jg) * (un - dgrnd_snow(ji,jg)))
+             cgrnd_snow(ji,jg-1) = (snowtemp(ji,jg) * zdz2_snow(ji,jg) + zdz1_snow(ji,jg) * cgrnd_snow(ji,jg)) * z1_snow(ji)
+             dgrnd_snow(ji,jg-1) = zdz1_snow(ji,jg-1) * z1_snow(ji)
+          ENDDO
+       ELSE
+          ! There is no snow, these values will never be used
+          cgrnd_snow(ji,:) = cgrnd(ji,1)
+          dgrnd_snow(ji,:) = dgrnd(ji,1)
+       ENDIF
+    ENDDO
+
+
+    !! 4. Computation of the apparent ground heat flux 
+    !! Computation of apparent snow-atmosphere flux  
+    DO ji = 1,kjpindex
+       IF ( ok_explicitsnow ) THEN
+          snowflx(ji) = zdz1_snow(ji,1) * (cgrnd_snow(ji,1) + (dgrnd_snow(ji,1)-1.) * snowtemp(ji,1))
+          snowcap(ji) = (zdz2_snow(ji,1) * dt_sechiba + dt_sechiba * (un - dgrnd_snow(ji,1)) * zdz1_snow(ji,1))
+          z1_snow(ji) = lambda_snow(ji) * (un - dgrnd_snow(ji,1)) + un 
+          snowcap(ji) = snowcap(ji) / z1_snow(ji)
+          snowflx(ji) = snowflx(ji) + &
+               & snowcap(ji) * (snowtemp(ji,1) * z1_snow(ji) - lambda_snow(ji) * cgrnd_snow(ji,1) - temp_sol_new(ji)) / dt_sechiba
+       ELSE
+          snowflx(ji) = zero
+          snowcap(ji) = zero
+       ENDIF
+    ENDDO
+
+
+    !! Computation of the apparent ground heat flux (> towards the soil) and
+    !! apparent surface heat capacity, used at the next timestep by enerbil to
+    !! compute the surface temperature.
+    DO ji = 1,kjpindex
+      soilflx_nosnow(ji) = zdz1(ji,1) * (cgrnd(ji,1) + (dgrnd(ji,1)-1.) * ptn(ji,1))
+      soilcap_nosnow(ji) = (zdz2(ji,1) * dt_sechiba + dt_sechiba * (un - dgrnd(ji,1)) * zdz1(ji,1))
+      z1(ji) = lambda * (un - dgrnd(ji,1)) + un
+      soilcap_nosnow(ji) = soilcap_nosnow(ji) / z1(ji)
+      soilflx_nosnow(ji) = soilflx_nosnow(ji) + &
+         & soilcap_nosnow(ji) * (ptn(ji,1) * z1(ji) - lambda * cgrnd(ji,1) - temp_sol_new(ji)) / dt_sechiba
+    ENDDO
+
+    !! Add snow fraction
+    IF ( ok_explicitsnow ) THEN
+       ! Using an effective heat capacity and heat flux by a simple pondering of snow and soil fraction
+       DO ji = 1, kjpindex
+          soilcap(ji) = snowcap(ji)*frac_snow_veg(ji)*(1-totfrac_nobio(ji))+    & ! weights related to snow cover fraction on vegetation  
+               soilcap_nosnow(ji)*SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji)+ & ! weights related to SCF on nobio
+               soilcap_nosnow(ji)*(1-(frac_snow_veg(ji)*(1-totfrac_nobio(ji))-SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji))) ! weights related to non snow fraction
+          soilflx(ji) = snowflx(ji)*frac_snow_veg(ji)*(1-totfrac_nobio(ji))+    & ! weights related to snow cover fraction on vegetation  
+               soilflx_nosnow(ji)*SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji)+ & ! weights related to SCF on nobio
+               soilflx_nosnow(ji)*(1-(frac_snow_veg(ji)*(1-totfrac_nobio(ji))-SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji))) ! weights related to non snow fraction
+       ENDDO
+    ELSE
+       ! Do not consider snow fraction
+       soilcap(:)=soilcap_nosnow(:)
+       soilflx(:)=soilflx_nosnow(:)
+    END IF
+
+    IF (printlev>=3) WRITE (numout,*) ' thermosoilc_coef done '
+
+  END SUBROUTINE thermosoilc_coef
+ 
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoilc_profile
+!!
+!>\BRIEF        In this routine solves the numerical soil thermal scheme, ie calculates the new soil temperature profile; 
+!! This profile is then exported onto the diagnostic axis (call thermosoilc_diaglev)
+!!
+!! DESCRIPTION	: The calculation of the new soil temperature profile is based on
+!! the cgrnd and dgrnd values from the previous timestep and the surface temperature Ts aka temp_sol_new. (see detailed
+!! explanation in the header of the thermosoilc module or in the reference).\n
+!!                              T(k+1)=cgrnd(k)+dgrnd(k)*T(k)\n
+!!                                      -- EQ1 --\n
+!!                           Ts=(1-lambda)*T(1) -lambda*T(2)\n 
+!!                                      -- EQ2--\n
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): ptn (soil temperature profile on the thermal axis), 
+!!                          stempdiag (soil temperature profile on the diagnostic axis)
+!!
+!! REFERENCE(S) :
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of planetary atmospheres,
+!! Ph.D. thesis, Paris VII University. Remark: the part of F. Hourdin's PhD thesis relative to the thermal
+!! integration scheme has been scanned and is provided along with the documentation, with name : 
+!! Hourdin_1992_PhD_thermal_scheme.pdf
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+ SUBROUTINE thermosoilc_profile (kjpindex, temp_sol_new, ptn, stempdiag, &
+                                 snowtemp, frac_snow_veg,frac_snow_nobio,totfrac_nobio, &
+                                 cgrnd_snow,dgrnd_snow)
+
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex       !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol_new   !! Surface temperature at the present time-step 
+                                                                               !! @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)             :: frac_snow_veg  !! Snow cover fraction on vegeted area
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in)      :: frac_snow_nobio!! Snow cover fraction on non-vegeted area
+    REAL(r_std),DIMENSION (kjpindex),INTENT(in)              :: totfrac_nobio  !! Total fraction of continental ice+lakes+cities+...(unitless,0-1)
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(in)       :: snowtemp       !! Snow temperature
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(in)       :: cgrnd_snow     !! Integration coefficient for snow numerical scheme
+    REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT(in)       :: dgrnd_snow     !! Integration coefficient for snow numerical scheme
+
+   
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)      :: stempdiag      !! diagnostic temperature profile 
+                                                                               !! @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,ngrnd), INTENT (out)     :: ptn            !! vertically discretized soil temperatures 
+                                                                               !! @tex ($K$) @endtex
+
+    !! 0.3 Modified variables
+
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jg
+    REAL(r_std)                                              :: temp_sol_eff
+     
+!_ ================================================================================================================================
+    
+  !! 1. Computes the soil temperatures ptn.
+
+    !! 1.1. ptn(jg=1) using EQ1 and EQ2
+    DO ji = 1,kjpindex
+
+       IF ( ok_explicitsnow ) THEN
+          ! Soil temperature calculation with explicit snow if there is snow on the ground
+          ! using an effective surface temperature by a simple pondering 
+          temp_sol_eff=snowtemp(ji,nsnow)*frac_snow_veg(ji)*(1-totfrac_nobio(ji))+ & ! weights related to snow cover fraction on vegetation  
+               temp_sol_new(ji)*SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji)+ & ! weights related to SCF on nobio
+               temp_sol_new(ji)*(1-(frac_snow_veg(ji)*(1-totfrac_nobio(ji))-SUM(frac_snow_nobio(ji,:))*totfrac_nobio(ji))) ! weights related to non snow fraction
+          ! Soil temperature calculation with explicit snow if there is snow on the ground
+          ptn(ji,1) = cgrnd_snow(ji,nsnow) + dgrnd_snow(ji,nsnow) * temp_sol_eff
+       ELSE
+          ! Standard soil temperature calculation
+          ptn(ji,1) = (lambda * cgrnd(ji,1) + temp_sol_new(ji)) / (lambda *(un - dgrnd(ji,1)) + un)
+       ENDIF
+    ENDDO
+
+    !! 1.2. ptn(jg=2:ngrnd) using EQ1.
+    DO jg = 1,ngrnd-1
+      DO ji = 1,kjpindex
+        ptn(ji,jg+1) = cgrnd(ji,jg) + dgrnd(ji,jg) * ptn(ji,jg)
+      ENDDO
+    ENDDO
+
+  !! 2. Put the soil temperatures onto the diagnostic axis 
+  
+    !! Put the soil temperatures onto the diagnostic axis for convenient
+    !! use in other routines (stomate..)
+    CALL thermosoilc_diaglev(kjpindex, stempdiag)
+
+    IF (printlev>=3) WRITE (numout,*) ' thermosoilc_profile done '
+
+  END SUBROUTINE thermosoilc_profile
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoilc_diaglev
+!!
+!>\BRIEF        Interpolation of the soil in-depth temperatures onto the diagnostic profile.
+!!
+!! DESCRIPTION  : This is a very easy linear interpolation, with intfact(jd, jg) the fraction
+!! the thermal layer jg comprised within the diagnostic layer jd. The depths of
+!! the diagnostic levels are diaglev(1:nbdl), computed in slowproc.f90.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): stempdiag (soil temperature profile on the diagnostic axis)
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoilc_diaglev(kjpindex, stempdiag)
+    
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT(in)                          :: kjpindex       !! Domain size (unitless)
+   
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out) :: stempdiag      !! Diagnostoc soil temperature profile @tex ($K$) @endtex
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jd, jg
+    REAL(r_std)                                         :: lev_diag, prev_diag, lev_prog, prev_prog
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)      :: intfact
+!$OMP THREADPRIVATE(intfact)
+    LOGICAL, PARAMETER                                  :: check=.FALSE.
+!_ ================================================================================================================================
+    
+  !! 1. Computes intfact(jd, jg)
+
+    !! Computes intfact(jd, jg), the fraction
+    !! the thermal layer jg comprised within the diagnostic layer jd.
+    IF ( .NOT. ALLOCATED(intfact)) THEN
+        
+        ALLOCATE(intfact(nbdl, ngrnd))
+        
+        prev_diag = zero
+        DO jd = 1, nbdl
+          lev_diag = diaglev(jd)
+          prev_prog = zero
+          DO jg = 1, ngrnd
+             IF ( jg == ngrnd .AND. (prev_prog + dz2(jg)) < lev_diag ) THEN
+                lev_prog = lev_diag
+             ELSE
+                lev_prog = prev_prog + dz2(jg)
+             ENDIF
+            intfact(jd,jg) = MAX(MIN(lev_diag,lev_prog)-MAX(prev_diag, prev_prog), zero)/(lev_diag-prev_diag)
+            prev_prog = lev_prog
+          ENDDO
+           prev_diag = lev_diag
+        ENDDO
+        
+        IF ( check ) THEN
+           WRITE(numout,*) 'thermosoilc_diagev -- thermosoilc_diaglev -- thermosoilc_diaglev --' 
+           DO jd = 1, nbdl
+              WRITE(numout,*) jd, '-', intfact(jd,1:ngrnd)
+           ENDDO
+           WRITE(numout,*) "SUM -- SUM -- SUM SUM -- SUM -- SUM"
+           DO jd = 1, nbdl
+              WRITE(numout,*) jd, '-', SUM(intfact(jd,1:ngrnd))
+           ENDDO
+           WRITE(numout,*) 'thermosoilc_diaglev -- thermosoilc_diaglev -- thermosoilc_diaglev --' 
+        ENDIF
+        
+    ENDIF
+
+ !! 2. does the interpolation
+
+    stempdiag(:,:) = zero
+    DO jg = 1, ngrnd
+      DO jd = 1, nbdl
+        DO ji = 1, kjpindex
+          stempdiag(ji,jd) = stempdiag(ji,jd) + ptn(ji,jg)*intfact(jd,jg)
+        ENDDO
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE thermosoilc_diaglev
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoilc_humlev
+!!
+!>\BRIEF        Interpolates the diagnostic soil humidity profile shumdiag_perma(nbdl, diagnostic axis) onto 
+!!              the thermal axis, which gives shum_ngrnd_perma(ngrnd, thermal axis).
+!!
+!! DESCRIPTION  : Same as in thermosoilc_diaglev : This is a very easy linear interpolation, with intfactw(jd, jg) the fraction
+!! the thermal layer jd comprised within the diagnostic layer jg. 
+!! 
+!! The depths of the diagnostic levels are diaglev(1:nbdl), computed in slowproc.f90.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): shum_ngrnd_perma (soil saturation degree on the thermal axis)
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+  SUBROUTINE thermosoilc_humlev(kjpindex, shumdiag_perma, snow)
+  
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex    !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)    :: shumdiag_perma  
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: snow 
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                       :: ji, jd, jg
+    REAL(r_std)                                          :: lev_diag, prev_diag, lev_prog, prev_prog
+    REAL(r_std), DIMENSION(ngrnd,nbdl)                   :: intfactw     !! fraction of each diagnostic layer (jd) comprized within
+                                                                         !! a given thermal layer (jg)(0-1, unitless) 
+    REAL(r_std), DIMENSION(kjpindex)               :: snow_h
+    LOGICAL, PARAMETER :: check=.FALSE.
+
+!_ ================================================================================================================================
+    
+  !! 1. computes intfactw(jd,jg), the fraction of each diagnostic layer (jg) comprized within a given thermal layer (jd)
+    IF ( check ) &
+         WRITE(numout,*) 'thermosoilc_humlev --' 
+
+    ! Snow height
+    snow_h(:)=snow(:)/sn_dens
+    !
+    shum_ngrnd_perma(:,:) = zero
+    DO ji=1,kjpindex
+       prev_diag = zero
+       DO jd = 1, ngrnd
+          lev_diag = prev_diag + dz2(jd)
+          prev_prog = snow_h(ji)
+          DO jg = 1, nbdl
+             IF ( jg == nbdl .AND. diaglev(jg)+snow_h(ji) < lev_diag ) THEN
+                lev_prog = lev_diag+snow_h(ji)
+             ELSE
+                lev_prog = diaglev(jg)+snow_h(ji)
+             ENDIF
+             intfactw(jd,jg) = MAX(MIN(lev_diag,lev_prog)-MAX(prev_diag, prev_prog), zero)/(lev_diag-prev_diag)
+             prev_prog = lev_prog
+          ENDDO
+          prev_diag = lev_diag
+       ENDDO
+
+       DO jg = 1, nbdl
+          DO jd = 1, ngrnd
+             shum_ngrnd_perma(ji,jd) = shum_ngrnd_perma(ji,jd) + shumdiag_perma(ji,jg)*intfactw(jd,jg)
+          ENDDO
+       ENDDO
+       !
+       IF ( check ) THEN
+          DO jd = 1, ngrnd
+             WRITE(numout,*) ji,jd, '-', intfactw(jd,1:nbdl),'-sum-', SUM(intfactw(jd,1:nbdl))
+          ENDDO
+       ENDIF
+    ENDDO
+
+    IF ( check ) &
+         WRITE(numout,*) 'thermosoilc_humlev --' 
+
+  END SUBROUTINE thermosoilc_humlev
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoilc_energy
+!!
+!>\BRIEF         Energy check-up.
+!!
+!! DESCRIPTION  : I didn\'t comment this routine since at do not understand its use, please
+!! ask initial designers (Jan ? Nathalie ?).
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ??
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoilc_energy(kjpindex, temp_sol_new, soilcap)
+  
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                     :: kjpindex     !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: temp_sol_new !! Surface temperature at the present time-step, Ts 
+                                                                   !! @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: soilcap      !! Apparent surface heat capacity 
+                                                                   !! @tex ($J m^{-2} K^{-1}$) @endtex, 
+                                                                   !! see eq. A29 of F. Hourdin\'s PhD thesis.
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                 :: ji, jg
+!_ ================================================================================================================================
+   
+
+     DO ji = 1, kjpindex
+      surfheat_incr(ji) = zero
+      coldcont_incr(ji) = zero
+     ENDDO
+    
+    !  Sum up the energy content of all layers in the soil.
+    DO ji = 1, kjpindex
+   
+       IF (pcapa_en(ji,1) .LE. sn_capa) THEN
+          
+          ! Verify the energy conservation in the surface layer
+          coldcont_incr(ji) = soilcap(ji) * (temp_sol_new(ji) - temp_sol_beg(ji))
+          surfheat_incr(ji) = zero
+       ELSE
+          
+          ! Verify the energy conservation in the surface layer
+          surfheat_incr(ji) = soilcap(ji) * (temp_sol_new(ji) - temp_sol_beg(ji))
+          coldcont_incr(ji) = zero
+       ENDIF
+    ENDDO
+    
+    ptn_beg(:,:)      = ptn(:,:)
+    temp_sol_beg(:)   = temp_sol_new(:)
+
+  END SUBROUTINE thermosoilc_energy
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoilc_readjust
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION	: Energy conservation : Correction to make sure that the same latent heat is released and 
+!!                consumed during freezing and thawing  
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): ptn (soil temperature profile on the thermal axis), 
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoilc_readjust(kjpindex, ptn)
+
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                             :: kjpindex
+
+    !! 0.2 Modified variables
+    REAL(r_std),DIMENSION(kjpindex,ngrnd),INTENT(inout)    :: ptn
+
+    !! 0.3 Local variables
+    INTEGER(i_std)  :: ji, jg
+    REAL(r_std) :: ptn_tmp
+
+    DO jg=1, ngrnd
+       DO ji=1, kjpindex
+          ! All soil latent energy is put into e_soil_lat(ji)
+          ! because the variable soil layers make it difficult to keep track of all
+          ! layers in this version
+          ! NOTE : pcapa has unit J/K/m3 and pcappa_supp has J/K
+          e_soil_lat(ji)=e_soil_lat(ji)+pcappa_supp(ji,jg)*(ptn(ji,jg)-ptn_beg(ji,jg))
+       END DO
+   END DO
+
+   DO ji=1, kjpindex
+      IF (e_soil_lat(ji).GT.min_sechiba.AND.MINVAL(ptn(ji,:)).GT.ZeroCelsius+fr_dT/2.) THEN
+         ! The soil is thawed: we spread the excess of energy over the uppermost 6 levels e.g. 2.7m
+         ! Here we increase the temperatures
+         DO jg=1,6
+            ptn_tmp=ptn(ji,jg)
+            
+            ptn(ji,jg)=ptn(ji,jg)+MIN(e_soil_lat(ji)/pcapa(ji,jg)/zz_coef(6), 0.5)
+            e_soil_lat(ji)=e_soil_lat(ji)-(ptn(ji,jg)-ptn_tmp)*pcapa(ji,jg)*dz2(jg)
+         ENDDO
+      ELSE IF (e_soil_lat(ji).LT.-min_sechiba.AND.MINVAL(ptn(ji,:)).GT.ZeroCelsius+fr_dT/2.) THEN
+         ! The soil is thawed
+         ! Here we decrease the temperatures
+         DO jg=1,6
+            ptn_tmp=ptn(ji,jg)
+            ptn(ji,jg)=MAX(ZeroCelsius+fr_dT/2., ptn_tmp+e_soil_lat(ji)/pcapa(ji,jg)/zz_coef(6))
+            e_soil_lat(ji)=e_soil_lat(ji)+(ptn_tmp-ptn(ji,jg))*pcapa(ji,jg)*dz2(jg)
+         END DO
+      END IF
+   END DO
+
+  END SUBROUTINE thermosoilc_readjust
+   
+!-------------------------------------------------------------------
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoilc_getdiff
+!!
+!>\BRIEF          Computes soil and snow heat capacity and conductivity    
+!!
+!! DESCRIPTION	: Computation of the soil and snow thermal properties; snow properties are also accounted for
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): 
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoilc_getdiff( kjpindex, snow, ptn, snowrho, snowtemp, pb )
+
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)				:: kjpindex
+    REAL(r_std),DIMENSION(kjpindex),INTENT (in)	        :: snow       !! Snow mass
+    REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)    :: snowrho    !! Snow density
+    REAL(r_std),DIMENSION(kjpindex,nsnow),INTENT(in)    :: snowtemp   !! Snow temperature
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)          :: pb         !! Surface pressure
+    REAL(r_std),DIMENSION(kjpindex,ngrnd),INTENT(in)	:: ptn        !! Soil temperature profile
+
+    !! 0.3 Local variables
+    REAL						:: xx         !! Unfrozen fraction of the soil
+    REAL(r_std), DIMENSION(kjpindex)             	:: snow_h
+    REAL(r_std), DIMENSION(kjpindex,ngrnd) 		:: zx1, zx2    
+    REAL			   			:: cap_iw     !! Heat capacity of ice/water mixture 
+    REAL						:: csat       !! Thermal conductivity for saturated soil
+    INTEGER						:: ji,jg
+
+
+    DO ji = 1,kjpindex
+       IF (.NOT. ok_explicitsnow) THEN      
+          ! 1. Determine the fractions of snow and soil
+          snow_h(ji) = snow(ji) / sn_dens
+      
+          !
+          !  1.1. The first level
+          !
+          IF ( snow_h(ji) .GT. zz_coef(1) ) THEN
+             ! the 1st level is in the snow => the 1st layer is entirely snow
+             zx1(ji,1) = 1.
+             zx2(ji,1) = 0.
+          ELSE IF ( snow_h(ji) .GT. zero ) THEN      
+             ! the 1st level is beyond the snow and the snow is present
+             zx1(ji,1) = snow_h(ji) / zz_coef(1)
+             zx2(ji,1) = ( zz_coef(1) - snow_h(ji)) / zz_coef(1)	
+          ELSE
+             ! there is no snow at all, quoi ;-)
+             zx1(ji,1) = 0.
+             zx2(ji,1) = 1.       
+          ENDIF
+      
+          !
+          !  1.2. The other levels
+          !
+          DO jg = 2, ngrnd
+             IF ( snow_h(ji) .GT. zz_coef(jg) ) THEN
+                ! the current level is in the snow => the current layer is entirely snow
+                zx1(ji,jg) = 1.
+                zx2(ji,jg) = 0.
+             ELSE IF ( snow_h(ji) .GT. zz_coef(jg-1) ) THEN
+                ! the current layer is partially snow
+                zx1(ji,jg) = (snow_h(ji) - zz_coef(jg-1)) / (zz_coef(jg) - zz_coef(jg-1))
+                zx2(ji,jg) = ( zz_coef(jg) - snow_h(ji)) / (zz_coef(jg) - zz_coef(jg-1))
+             ELSE
+                ! both levels are out of snow => the current layer is entirely soil	  
+                zx1(ji,jg) = 0.
+                zx2(ji,jg) = 1.       
+             ENDIF
+          ENDDO
+       ELSE
+          zx1(ji,:) = 0.
+          zx2(ji,:) = 1.
+       END IF
+
+      DO jg = 1, ngrnd
+         !
+         ! 2. Calculate heat capacity with allowance for permafrost
+         ! 2.1. soil heat capacity depending on temperature and humidity
+	 
+         IF (ptn(ji,jg) .LT. ZeroCelsius-fr_dT/2.) THEN
+	    ! frozen soil
+            pcapa(ji,jg) = so_capa_dry + shum_ngrnd_perma(ji,jg)*(so_capa_ice - so_capa_dry)!Isa : old version, proved to be correct
+	    profil_froz(ji,jg) = 1.
+ 	    pcappa_supp(ji,jg)= 0.
+
+     	 ELSEIF (ptn(ji,jg) .GT. ZeroCelsius+fr_dT/2.) THEN
+	    ! unfrozen soil	 
+     	    pcapa(ji,jg) =  so_capa_dry + shum_ngrnd_perma(ji,jg)*(so_capa_wet - so_capa_dry)!Isa : old version, proved to be correct
+	    profil_froz(ji,jg) = 0.
+ 	    pcappa_supp(ji,jg)= 0.
+     	 ELSE
+     	   ! xx is the unfrozen fraction of soil water	   	   
+     	   xx = (ptn(ji,jg)-(ZeroCelsius-fr_dT/2.)) / fr_dT
+           profil_froz(ji,jg) = (1. - xx)
+
+	   ! net heat capacity of the ice/water mixture
+     	   cap_iw = xx * so_capa_wet + (1.-xx) * so_capa_ice
+	   pcapa(ji,jg) = so_capa_dry + shum_ngrnd_perma(ji,jg)*(cap_iw-so_capa_dry) + shum_ngrnd_perma(ji,jg)*poros*lhf*rho_water/fr_dT
+ 	   pcappa_supp(ji,jg)= shum_ngrnd_perma(ji,jg)*poros*lhf*rho_water/fr_dT*zx2(ji,jg)*dz2(jg)
+
+         ENDIF
+
+         !
+	 ! 2.2. Take into account the snow and soil fractions in the layer
+	 !
+         pcapa(ji,jg) = zx1(ji,jg) * sn_capa + zx2(ji,jg) * pcapa(ji,jg)
+
+	 !
+	 ! 2.3. Calculate the heat capacity for energy conservation check 
+	 IF ( zx1(ji,jg).GT.0. ) THEN
+            pcapa_en(ji,jg) = sn_capa
+	 ELSE
+            pcapa_en(ji,jg) = pcapa(ji,jg)
+	 ENDIF
+ 
+         !
+         ! 3. Calculate the heat conductivity with allowance for permafrost (Farouki, 1981, Cold Reg. Sci. Technol.)
+         !
+	 ! 3.1. unfrozen fraction
+         xx = (ptn(ji,jg)-(ZeroCelsius-fr_dT/2.)) / fr_dT * poros
+         xx = MIN( poros, MAX( 0., xx ) )
+
+         ! 3.2. saturated conductivity
+      	 csat = cond_solid**(1.-poros) * cond_ice**(poros-xx) * cond_water**xx
+     	
+       	 ! 3.3. unsaturated conductivity
+     	 pkappa(ji,jg) =(csat - so_cond_dry)*shum_ngrnd_perma(ji,jg) + so_cond_dry
+
+         !
+	 ! 3.4. Take into account the snow and soil fractions in the layer
+         pkappa(ji,jg) = un / ( zx1(ji,jg) / sn_cond + zx2(ji,jg) / pkappa(ji,jg) )
+      END DO            
+    ENDDO   
+
+    ! 4. Calculate snow heat capacity and conductivity
+     DO ji = 1,kjpindex
+         pcapa_snow(ji,:) = snowrho(ji,:) * xci
+         pkappa_snow(ji,:) = (ZSNOWTHRMCOND1 + ZSNOWTHRMCOND2*snowrho(ji,:)*snowrho(ji,:)) +      &
+               MAX(0.0,(ZSNOWTHRMCOND_AVAP+(ZSNOWTHRMCOND_BVAP/(snowtemp(ji,:)+ &
+                ZSNOWTHRMCOND_CVAP)))*(XP00/(pb(ji)*100.)))
+    END DO
+
+
+   
+   END SUBROUTINE thermosoilc_getdiff
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoilc_getdiff_old_thermix_with_snow
+!!
+!>\BRIEF          Computes soil heat capacity and conductivity    
+!!
+!! DESCRIPTION	: Computes soil heat capacity and conductivity
+!!                Special case with old snow without soil freezing
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S):
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+
+   SUBROUTINE thermosoilc_getdiff_old_thermix_with_snow( kjpindex, snow )
+
+
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in) :: kjpindex
+    REAL(r_std),DIMENSION(kjpindex),INTENT (in) :: snow
+
+    !! 0.2 Local variables
+    INTEGER					:: ji,jg
+    REAL(r_std)                                 :: snow_h       !! snow_h is the snow height @tex ($m$) @endtex 
+    REAL(r_std)                                 :: zx1, zx2     !! zx1 and zx2 are the layer fraction consisting in snow and soil respectively.
+
+     
+    ! Computation of the soil thermal properties; snow properties are also accounted for
+    DO ji = 1,kjpindex
+      snow_h = snow(ji) / sn_dens
+
+      ! First layer
+      IF ( snow_h .GT. zz_coef(1) ) THEN
+          pcapa(ji,1) = sn_capa
+          pcapa_en(ji,1) = sn_capa
+          pkappa(ji,1) = sn_cond
+      ELSE IF ( snow_h .GT. zero ) THEN
+          pcapa_en(ji,1) = sn_capa
+          zx1 = snow_h / zz_coef(1)
+          zx2 = ( zz_coef(1) - snow_h) / zz_coef(1)
+          pcapa(ji,1) = zx1 * sn_capa + zx2 * so_capa_wet
+          pkappa(ji,1) = un / ( zx1 / sn_cond + zx2 / so_cond_wet )
+      ELSE
+          pcapa(ji,1) = so_capa_dry + shum_ngrnd_perma(ji,1)*(so_capa_wet - so_capa_dry)
+          pkappa(ji,1) = so_cond_dry + shum_ngrnd_perma(ji,1)*(so_cond_wet - so_cond_dry)
+          pcapa_en(ji,1) = so_capa_dry + shum_ngrnd_perma(ji,1)*(so_capa_wet - so_capa_dry)
+      ENDIF
+
+      ! Mid layers
+      DO jg = 2, ngrnd - 2
+        IF ( snow_h .GT. zz_coef(jg) ) THEN
+            pcapa(ji,jg) = sn_capa
+            pkappa(ji,jg) = sn_cond
+            pcapa_en(ji,jg) = sn_capa
+        ELSE IF ( snow_h .GT. zz_coef(jg-1) ) THEN
+            zx1 = (snow_h - zz_coef(jg-1)) / (zz_coef(jg) - zz_coef(jg-1))
+            zx2 = ( zz_coef(jg) - snow_h) / (zz_coef(jg) - zz_coef(jg-1))
+            pcapa(ji,jg) = zx1 * sn_capa + zx2 * so_capa_wet
+            pkappa(ji,jg) = un / ( zx1 / sn_cond + zx2 / so_cond_wet )
+            pcapa_en(ji,jg) = sn_capa
+        ELSE
+            pcapa(ji,jg) = so_capa_dry + shum_ngrnd_perma(ji,jg)*(so_capa_wet - so_capa_dry)
+            pkappa(ji,jg) = so_cond_dry + shum_ngrnd_perma(ji,jg)*(so_cond_wet - so_cond_dry)
+            pcapa_en(ji,jg) = so_capa_dry + shum_ngrnd_perma(ji,jg)*(so_capa_wet - so_capa_dry)
+        ENDIF
+      ENDDO
+
+      ! Last two layers: These layers can not be filled with snow
+      DO jg = ngrnd - 1, ngrnd
+         pcapa(ji,jg) = so_capa_dry
+         pkappa(ji,jg) = so_cond_dry
+         pcapa_en(ji,jg) = so_capa_dry
+      END DO
+      
+    ENDDO ! DO ji = 1,kjpindex
+
+
+    END SUBROUTINE thermosoilc_getdiff_old_thermix_with_snow
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoilc_getdiff_old_thermix_without_snow
+!!
+!>\BRIEF          Computes soil and snow heat capacity and conductivity    
+!!
+!! DESCRIPTION	: Calculations of soil and snow thermal properties without effect of freezing. This subroutine is only called
+!!                when explicitsnow is activated.
+!!                
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S):
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+    SUBROUTINE thermosoilc_getdiff_old_thermix_without_snow( kjpindex,snowrho, snowtemp, pb )
+
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+      INTEGER(i_std), INTENT(in) :: kjpindex
+      REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowrho  !! Snow density
+      REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowtemp !! Snow temperature
+      REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: pb       !! Surface presure (hPa)
+
+
+    !! 0.1 Local variables
+      INTEGER						  :: ji,jg
+
+     ! soil
+      DO jg = 1,ngrnd
+         DO ji = 1,kjpindex
+            pkappa(ji,jg) = so_cond_dry + shum_ngrnd_perma(ji,jg)*(so_cond_wet - so_cond_dry)
+            pcapa(ji,jg) = so_capa_dry + shum_ngrnd_perma(ji,jg)*(so_capa_wet - so_capa_dry)
+            pcapa_en(ji,jg) = so_capa_dry + shum_ngrnd_perma(ji,jg)*(so_capa_wet - so_capa_dry)
+         ENDDO
+      ENDDO
+
+     ! snow 
+     DO ji = 1,kjpindex
+         pcapa_snow(ji,:) = snowrho(ji,:) * xci
+         pkappa_snow(ji,:) = (ZSNOWTHRMCOND1 + ZSNOWTHRMCOND2*snowrho(ji,:)*snowrho(ji,:)) +      & 
+              MAX(0.0,(ZSNOWTHRMCOND_AVAP+(ZSNOWTHRMCOND_BVAP/(snowtemp(ji,:)+ &
+               ZSNOWTHRMCOND_CVAP)))*(XP00/(pb(ji)*100.)))
+     END DO
+
+
+   END SUBROUTINE thermosoilc_getdiff_old_thermix_without_snow
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : read_reftempfile
+!!
+!>\BRIEF          
+!!
+!! DESCRIPTION	: Read file with longterm temperature
+!!                
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): reftemp : Reference temerature
+!!                          
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE read_reftempfile(kjpindex,lalo,reftemp)
+     
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in) :: kjpindex
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT(in) :: lalo
+    
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(kjpindex, ngrnd), INTENT(out) :: reftemp
+
+    !! 0.3 Local variables
+    INTEGER(i_std) :: il, ils, ip, ix, iy, imin, jmin, ier
+    REAL(r_std) :: dlon, dlonmin, dlat, dlatmin
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: xx,yy
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: reftemp_file
+    REAL(r_std),ALLOCATABLE,DIMENSION(:) :: x,y
+    REAL(r_std) :: lev(1), date, dt
+    INTEGER(i_std) :: itau(1)
+    
+
+    
+    !Config Key   = SOIL_REFTEMP_FILE
+    !Config Desc  = File with climatological soil temperature
+    !Config If    = READ_REFTEMP
+    !Config Def   = reftemp.nc
+    !Config Help  = 
+    !Config Units = [FILE]
+    filename = 'reftemp.nc'
+    CALL getin('SOIL_REFTEMP_FILE',filename)
+
+    CALL flininfo(filename,iml, jml, lml, tml, fid)
+    ALLOCATE (yy(iml,jml), stat=ier)
+    ALLOCATE (xx(iml,jml), stat=ier)
+    ALLOCATE (x(iml),y(jml), stat=ier)
+    ALLOCATE (reftemp_file(iml,jml), stat=ier)
+    
+    CALL flinopen (filename, .FALSE., iml, jml, lml, &
+         xx, yy, lev, tml, itau, date, dt, fid)
+    CALL flinget (fid, 'temperature', iml, jml, lml, tml, &
+         1, 1, reftemp_file)
+    CALL flinclo (fid)
+
+    ! We suppose that the file is regular. If this is not the case the temperatures will be wrong.
+    x(:) = xx(:,1)
+    y(:) = yy(1,:)
+    ! Take the closest value
+    DO ip = 1, kjpindex
+       dlonmin = HUGE(1.)
+       DO ix = 1,iml
+          dlon = MIN( ABS(lalo(ip,2)-x(ix)), ABS(lalo(ip,2)+360.-x(ix)), ABS(lalo(ip,2)-360.-x(ix)) )
+          IF ( dlon .LT. dlonmin ) THEN
+             imin = ix
+             dlonmin = dlon
+          ENDIF
+       ENDDO
+       dlatmin = HUGE(1.)
+       DO iy = 1,jml
+          dlat = ABS(lalo(ip,1)-y(iy))
+          IF ( dlat .LT. dlatmin ) THEN
+             jmin = iy
+             dlatmin = dlat
+          ENDIF
+       ENDDO
+       reftemp(ip, :) = reftemp_file(imin,jmin)+273.15
+    ENDDO
+    DEALLOCATE (yy)
+    DEALLOCATE (xx)
+    DEALLOCATE (x)
+    DEALLOCATE (reftemp_file)
+    
+       
+  END SUBROUTINE read_reftempfile
+  
+
+END MODULE thermosoilc
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/AA_make	(revision 5166)
@@ -0,0 +1,215 @@
+#-
+#- $Id$
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec  SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec  SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+ORGLOB_LIB = $(LIBDIR)/liborglob.a
+SXORGLOB_LIB = $(ORGLOB_LIB)
+#-Q- sxnec  SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- eshpux SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-
+MODS1 = stomate_data.f90      \
+        lpj_constraints.f90        \
+        lpj_cover.f90              \
+        lpj_crown.f90              \
+        lpj_establish.f90          \
+        lpj_fire.f90               \
+        lpj_gap.f90                \
+        lpj_kill.f90               \
+        lpj_light.f90              \
+        lpj_pftinout.f90           \
+        stomate_alloc.f90          \
+        stomate_data.f90           \
+        stomate_io.f90             \
+        stomate_litter.f90         \
+        stomate_npp.f90            \
+        stomate_phenology.f90      \
+        stomate_prescribe.f90      \
+        stomate_season.f90         \
+        stomate_soilcarbon.f90     \
+        stomate_turnover.f90       \
+        stomate_vmax.f90           \
+        stomate_lcchange.f90       \
+        stomate_lpj.f90            \
+        stomate_resp.f90           \
+        stomate.f90
+
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libparallel
+	$(M_K) libparameters
+	$(M_K) liborglob
+	$(M_K) m_all
+	@echo stomate is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+#-Q- intel m_all: WORK_MOD $(MODEL_LIB)($(OBJSMODS1))
+
+memory:
+#-Q- sxnec 	@echo maximum memory must be defined on Rhodes 
+#-Q- sxnec 	@echo in sh or ksh : ulimit -v unlimited 
+#-Q- sxnec 	@echo in csh or tcsh : limit vmemoryuse unlimited 
+#-Q- sxnec 	-/sbin/ulimit -v unlimited
+#-Q- sxnec 	-limit vmemoryuse unlimited
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+libparameters:
+	(cd ../src_parameters; $(M_K) -f Makefile)
+
+liborglob:
+	(cd ../src_global; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o): %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+#-Q- intel
+#-Q- intel WORK_MOD:
+#-Q- intel 	$(RM) work.pcl
+#-Q- intel 	@echo "work.pc" > work.pcl
+#-Q- intel 	@echo "../src_parameters/work.pc" >> work.pcl
+#-Q- intel 	@echo "../../IOIPSL/src/work.pc" >> work.pcl
+
+config: 
+	$(BINDIR)/Fparser -name STOMATE $(MODS1)
+	echo 'Configuration of STOMATE done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(stomate.o):          \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(stomate_io.o)      \
+  $(MODEL_LIB)(stomate_lpj.o)
+
+$(MODEL_LIB)(stomate_data.o): \
+  $(PARAM_LIB)(pft_parameters.o)	\
+  $(PARAM_LIB)(constantes.o)  
+
+$(MODEL_LIB)(lpj_constraints.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_cover.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_crown.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_establish.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_fire.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_gap.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_kill.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_light.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_pftinout.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_alloc.o): \
+  $(PARAM_LIB)(pft_parameters.o)	\
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_io.o): \
+  $(MODEL_LIB)(stomate_data.o) \
+  $(PARALLEL_LIB)(mod_orchidee_para.o)
+
+
+$(MODEL_LIB)(stomate_litter.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_npp.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_phenology.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_prescribe.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_resp.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_season.o): \
+  $(PARAM_LIB)(pft_parameters.o)	\
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_soilcarbon.o): \
+  $(MODEL_LIB)(stomate_data.o) \
+  $(ORGLOB_LIB)(grid.o)\
+  $(ORGLOB_LIB)(solar.o)
+
+$(MODEL_LIB)(stomate_turnover.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_vmax.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_lcchange.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_lpj.o):            \
+  $(MODEL_LIB)(lpj_constraints.o)       \
+  $(MODEL_LIB)(lpj_cover.o)             \
+  $(MODEL_LIB)(lpj_crown.o)             \
+  $(MODEL_LIB)(lpj_establish.o)         \
+  $(MODEL_LIB)(lpj_fire.o)              \
+  $(MODEL_LIB)(lpj_gap.o)               \
+  $(MODEL_LIB)(lpj_kill.o)              \
+  $(MODEL_LIB)(lpj_light.o)             \
+  $(MODEL_LIB)(lpj_pftinout.o)          \
+  $(MODEL_LIB)(stomate_alloc.o)         \
+  $(MODEL_LIB)(stomate_data.o)          \
+  $(MODEL_LIB)(stomate_litter.o)        \
+  $(MODEL_LIB)(stomate_npp.o)           \
+  $(MODEL_LIB)(stomate_phenology.o)     \
+  $(MODEL_LIB)(stomate_prescribe.o)     \
+  $(MODEL_LIB)(stomate_season.o)        \
+  $(MODEL_LIB)(stomate_soilcarbon.o)    \
+  $(MODEL_LIB)(stomate_turnover.o)      \
+  $(MODEL_LIB)(stomate_vmax.o)          \
+  $(MODEL_LIB)(stomate_resp.o)          \
+  $(MODEL_LIB)(stomate_lcchange.o)
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/AA_make.ldef	(revision 5166)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a STOMATE
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/libstomate.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxstomate.a
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_constraints.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_constraints.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_constraints.f90	(revision 5166)
@@ -0,0 +1,246 @@
+! =================================================================================================================================
+! MODULE       : lpj_constraints
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!              This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Groups the subroutines that: (1) initialize all variables in 
+!! lpj_constraints and (2) check the temperature threshold to decide for each PFT 
+!! if it can adapt to and regenerate under prevailing climate conditions**1
+!! 
+!!\n RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) :
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!   plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!   global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!   dynamics in the modelling of terrestrial ecosystems: comparing two
+!!   contrasting approaches within European climate space,
+!!   Global Ecology and Biogeography, 10, 621-637.\n
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_constraints
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC constraints,constraints_clear
+
+  REAL(r_std), PARAMETER          :: grow_limit = 7+ZeroCelsius          !! Growing-season temperature limit to tree extension (K)
+  LOGICAL, SAVE                   :: firstcall_constraints = .TRUE.      !! first call
+!$OMP THREADPRIVATE(firstcall_constraints)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : constraints_clear
+!!
+!>\BRIEF        Set the flag ::firstcall_constraints to .TRUE. and as such activate section 
+!!              1.1 of the subroutine constraints (see subroutine constraints).
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE constraints_clear
+    firstcall_constraints = .TRUE. 
+  END SUBROUTINE constraints_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : constraints
+!!
+!>\BRIEF        Determine whether each PFT can adapt to and regenerate under the prevailing climate
+!! conditions. Climate conditions are characterised by different threshold values for air temperature.
+!!
+!! DESCRIPTION : PFTs are adapted to the climate conditions if the daily air temperature does not drop below 
+!! the treshold values ::tcm_crit. Some PFT's do not have a ::tcm_crit treshold. Seasonal trees die if leafage 
+!! does not show a clear seasonality. (i.e. if the start of the growing season is never detected)
+!! 
+!! If the monthly temperature is below ::tcm_crit i.e. the critical temperature of the coldest month, the 
+!! PFT will be able to regenerate. If minimum temperatures do not drop below ::tcm_crit, its regenerative 
+!! capacity decreases with time. Hence, plants that need vernalization die after a few years if they don't
+!! vernalize (even if they would not loose their leaves).
+!!
+!! The treshold values ::t_min_crit, the critical temperature of the coldest month is defined in 
+!! stomate_constants.f90'. However, ::regenerate_min, the critical temperature to support regeneration is 
+!! calculated in this routine from parameters of which none depenent on the PFT. The value for 
+!! ::large_value is defined as 1.E33 in stomata_constraints
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::adapted (0-1, unitless) and ::regenerate (0-1, unitless)
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : 
+!! \latexonly 
+!!     \includegraphics[scale=0.3]{lpj_constraints_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+  
+    SUBROUTINE constraints (npts, dt, &
+       t2m_month, t2m_min_daily, when_growthinit, Tseason, &
+       adapted, regenerate)
+    
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variable
+
+    INTEGER(i_std), INTENT(in)                      :: npts            !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                         :: dt              !! Time step   (days)
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: t2m_month       !! "Monthly" 2-meter temperature by defualt 
+                                                                       !! monthly spans 20 days a (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: Tseason         !! "seasonal" 2-meter temperature (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: t2m_min_daily   !! Daily minimum 2-meter temperature (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)    :: when_growthinit !! Days since beginning of growing season (days)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: adapted         !! Winter too cold? (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: regenerate      !! Winter sufficiently cold? (0 to 1, unitless)
+
+    !! 0.4 Local variables
+
+    REAL(r_std)                                     :: tau_adapt       !! Memory length for adaption (days)
+    REAL(r_std)                                     :: tau_regenerate  !! Memory length for regeneration (days)
+    REAL(r_std)                                     :: regenerate_min  !! Critical value of "regenerate" below which plant 
+                                                                       !! dies (unitless)
+    INTEGER(i_std)                                  :: j               !! Index
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering constraints' ! diagnostic level in implimentation
+
+  !! 1. Initializations
+
+    tau_adapt = one_year
+    tau_regenerate = one_year
+
+    !! 1.1 Print parameter settings
+    IF ( firstcall_constraints ) THEN
+
+       WRITE(numout,*) 'constraints:'
+       
+       WRITE(numout,*) '   > Memory length for adaption (d): ',tau_adapt
+       WRITE(numout,*) '   > Memory length for regeneration (d): ',tau_regenerate
+       WRITE(numout,*) '   > Longest sustainable time without vernalization (y):', too_long
+       WRITE(numout,*) '   > For trees, longest sustainable time without growth init (y):', too_long
+       
+       firstcall_constraints = .FALSE.
+       
+    ENDIF
+
+    !! 1.2 Calculate critical value for "regenerate"
+    !      Critical value for "regenerate", below this value, the last vernalization
+    !      happened too far in the past, The PFT is can not regenerate under the 
+    !      prevailing climate conditions.
+    regenerate_min = exp ( - too_long * one_year / tau_regenerate )
+
+  !! 2. Calculate ::adapted and ::regenerate
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! 2.1 PFT mask for natural or agriculture vegetations
+       IF ( natural(j) .OR. agriculture ) THEN
+
+          !! 2.1.1 Climate criteria
+          !! There is no critical temperature for the PFT 
+          !  Frost restistant PFT do not have a critical temperature for growth
+          IF ( tmin_crit(j) .EQ. undef ) THEN
+             adapted(:,j) = un 
+          ENDIF
+
+          !! 2.1.2 Seasonal trees die if leafage does not show a clear seasonality.
+          !        Seasonal trees die if leafage does not show a clear seasonality
+          !        (i.e. if the start of the growing season is never detected).
+          IF ( is_tree(j) .AND. ( pheno_model(j) .NE. 'none' ) ) THEN
+
+             WHERE ( when_growthinit(:,j) .GT. too_long*one_year .AND. when_growthinit(:,j).LT. large_value)
+                adapted(:,j) = zero
+             ENDWHERE
+
+          ENDIF
+
+          ! "seasonal" temperature Tseason must exceed 7 degree (grow_limit) for trees to be declared adapted.
+          IF ( is_tree(j) ) THEN
+             WHERE ( Tseason(:) .LT. grow_limit )
+                adapted(:,j)=zero
+             ENDWHERE
+          ENDIF
+
+          adapted(:,j) = un - ( un - adapted(:,j) ) * (tau_adapt- dt)/tau_adapt 
+
+          !! 2.1.3 Test if PFT is regenerative
+
+          !! 2.1.3.1 Check PFT vernalization. 
+          !          If sufficiently cold, PFT will be able to regenerate for some time.
+          !          Several PFTs (ex: evergreen) don't need vernalization 
+          IF ( tcm_crit(j) .EQ. undef ) THEN
+
+             regenerate(:,j) = un
+
+          !! 2.1.3.2 PFT needs vernalization
+          ELSE
+
+             WHERE ( t2m_month(:) .LE. tcm_crit(j) )
+                regenerate(:,j) = un
+             ENDWHERE
+
+             ! Limited memory: after some time, the winter is forgotten and the PFT can no longer
+             ! produce seeds, hence, with time ::regenerate approaches 0
+             regenerate(:,j) = regenerate(:,j) * (tau_regenerate-dt)/tau_regenerate
+
+          ENDIF
+
+          !! 2.1.4 Plants that need vernalization die
+          !        Plants that need vernalization die after a few years if they don't
+          !        vernalize (even if they would not loose their leaves).
+          WHERE ( regenerate(:,j) .LE. regenerate_min )
+             adapted(:,j) = zero
+          ENDWHERE
+
+       !! 2.1 PFT except natual and agriculture vegetation
+       !      Should be developed if needed 
+       ELSE
+
+          adapted(:,j) = zero
+
+          regenerate(:,j) = zero
+
+       ENDIF ! PFT of natural or agriculture
+
+    ENDDO ! Loop over # PFTs
+
+  !! 3. Write history files
+    CALL xios_orchidee_send_field("ADAPTATION",adapted)
+    CALL xios_orchidee_send_field("REGENERATION",regenerate)
+
+    CALL histwrite_p (hist_id_stomate, 'ADAPTATION', itime, &
+         adapted, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'REGENERATION', itime, &
+         regenerate, npts*nvm, horipft_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving constraints'
+
+  END SUBROUTINE constraints
+
+END MODULE lpj_constraints
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_cover.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_cover.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_cover.f90	(revision 5166)
@@ -0,0 +1,341 @@
+! =================================================================================================================================
+! MODULE       : lpj_cover
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Recalculate vegetation cover and LAI
+!!
+!!\n DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) : 
+!!        Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!        plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!        global vegetation model, Global Change Biology, 9, 161-185.\n
+!!        Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!        dynamics in the modelling of terrestrial ecosystems: comparing two
+!!        contrasting approaches within European climate space,
+!!        Global Ecology and Biogeography, 10, 621-637.\n
+!!
+!! SVN :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_cover
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes_soil
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC cover
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE     : lpj_cover
+!!
+!>\BRIEF          Recalculate vegetation cover and LAI
+!!
+!!\n DESCRIPTION : Veget_max is first renewed here according to newly calculated foliage biomass in this calculation step 
+!! Then, litter, soil carbon, and biomass are also recalcuted with taking into account the changes in Veget_max (i.e. delta_veg)
+!! Grid-scale fpc (foliage projected coverage) is calculated to obtain the shadede ground area by leaf's light capture
+!! Finally, grid-scale fpc is adjusted not to exceed 1.0
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::lai (leaf area index, @tex $(m^2 m^{-2})$ @endtex), 
+!! :: veget (fractional vegetation cover, unitless)
+!!
+!! REFERENCE(S)   : None
+!! 
+!! FLOWCHART :
+!! \latexonly 
+!!     \includegraphics[scale=0.5]{lpj_cover_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE cover (npts, cn_ind, ind, biomass, &
+       veget_max, veget_max_old, lai, litter_above, litter_below, carbon, DOC, turnover_daily, bm_to_litter, &
+       co2_to_bm, co2_fire, resp_hetero, resp_maint, resp_growth, gpp_daily, moist_soil)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                  :: npts             !! Domain size (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                :: cn_ind           !! Crown area 
+                                                                                    !! @tex $(m^2)$ @endtex per individual
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                :: ind              !! Number of individuals 
+                                                                                    !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                :: veget_max_old    !! "Maximal" coverage fraction of a PFT (LAI-> 
+                                                                                    !! infinity) on ground at beginning of time 
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)               :: moist_soil       !! moisture in soil for one pixel (m3/m3)
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)             :: lai                 !! Leaf area index OF AN INDIVIDUAL PLANT 
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements), INTENT(inout) :: litter_above    !! Metabolic and structural litter, above
+                                                                                       !! ground @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements), INTENT(inout) :: litter_below !! Metabolic and structural litter, below ground 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl,nelements), INTENT(inout) :: carbon     !! Carbon pool: active, slow, or passive 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements), INTENT(inout) :: DOC   !! Dissolved Organic Carbon in soil
+                                                                                       !! The unit is given by m^3 of water
+                                                                                       !! @tex $(gC m{-3} of water) $ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! Biomass @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: veget_max      !! "Maximal" coverage fraction of a PFT (LAI->
+                                                                                       !! infinity) on ground (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: turnover_daily !! Turnover rates (gC m^{-2} day^{-1})
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter   !! Conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: co2_to_bm      !! biomass up take for establishment           
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: co2_fire       !! Carbon emitted to the atmosphere by fire(living
+                                                                                       !! and dead biomass)
+    REAL(r_std), DIMENSION(npts,nvm,nelements), INTENT(inout)        :: resp_hetero    !! Heterotrophic respiration
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: resp_maint     !! Maintenance respiration 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: resp_growth    !! Growth respiration
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: gpp_daily      !! Daily gross primary productivity
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                              :: i,j,k,m             !! Index (unitless)
+    REAL(r_std), DIMENSION(npts,nlitt,nelements)                :: dilu_lit_above      !! Above ground litter dilution @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nbdl,nelements)           :: dilu_lit_below      !! Below ground litter dilution @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,ncarb,nbdl)                     :: dilu_soil_carbon    !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts,nparts,nelements)               :: dilu_bio            !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_TCarbon        !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts,nparts,nelements)               :: dilu_turnover_daily !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts,nparts,nelements)               :: dilu_bm_to_litter   !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_co2flux_new    !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_gpp_daily      !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_resp_growth    !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_resp_maint     !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_resp_hetero    !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_co2_to_bm      !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts)                                :: dilu_co2_fire       !! Dilution for carbon variables
+    REAL(r_std), DIMENSION(npts,nvm)                            :: TCarbon             !! Total carbon
+    REAL(r_std), DIMENSION(npts,nvm)                            :: co2flux_new         !! NBP after re-calculation in order to conserve carbon 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: co2flux_old         !! NBP before re-calculation 
+    REAL(r_std), DIMENSION(nvm)                                 :: delta_veg           !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(nvm)                                 :: reduct              !! Conversion factors (unitless)
+    REAL(r_std)                                                 :: delta_veg_sum       !! Conversion factors (unitless)
+    REAL(r_std)                                                 :: diff                !! Conversion factors (unitless)
+    REAL(r_std)                                                 :: sr                  !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: frac_nat            !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: sum_vegettree       !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: sum_vegetgrass      !! Conversion factors (unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: sum_veget_natveg    !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: vartmp              !! Temporary variable used to add history
+    REAL(r_std), DIMENSION(0:nbdl)                              :: z_soil              !! Variable to store depth of the different
+                                                                                       !! soil layers (m)
+!_ ================================================================================================================================
+
+ !! 1. If the vegetation is dynamic, calculate new maximum vegetation cover for natural plants
+  
+    IF ( ok_dgvm ) THEN
+
+       !! 1.1  Calculate initial values of vegetation cover
+       frac_nat(:) = un
+       sum_veget_natveg(:) = zero
+       veget_max(:,ibare_sechiba) = un
+
+       DO j = 2,nvm ! loop over PFTs
+
+          IF ( natural(j) ) THEN
+	     
+             ! Summation of individual tree crown area to get total foliar projected coverage
+             veget_max(:,j) = ind(:,j) * cn_ind(:,j)
+             sum_veget_natveg(:) = sum_veget_natveg(:) + veget_max(:,j)
+
+          ELSE
+             
+             !fraction occupied by agriculture needs to be substracted for the DGVM
+             !this is used below to constrain veget for natural vegetation, see below
+             frac_nat(:) = frac_nat(:) - veget_max(:,j)
+
+          ENDIF
+
+       ENDDO ! loop over PFTs
+
+       DO i = 1, npts ! loop over grid points
+	  
+          ! Recalculation of vegetation projected coverage when ::frac_nat was below ::sum_veget_natveg
+          ! It means that non-natural vegetation will recover ::veget_max as natural vegetation
+          IF (sum_veget_natveg(i) .GT. frac_nat(i) .AND. frac_nat(i) .GT. min_stomate) THEN
+
+             DO j = 2,nvm ! loop over PFTs
+                IF( natural(j) ) THEN
+                   veget_max(i,j) =  veget_max(i,j) * frac_nat(i) / sum_veget_natveg(i)
+                ENDIF
+             ENDDO ! loop over PFTs
+
+          ENDIF
+       ENDDO ! loop over grid points
+	
+       ! Renew veget_max of bare soil as 0 to difference of veget_max (ibare_sechiba) 
+       ! to current veget_max
+       DO j = 2,nvm ! loop over PFTs
+          veget_max(:,ibare_sechiba) = veget_max(:,ibare_sechiba) - veget_max(:,j)
+       ENDDO ! loop over PFTs
+
+       veget_max(:,ibare_sechiba) = MAX( veget_max(:,ibare_sechiba), zero )
+       !! 1.1.1 Copy the depth of the different soil layers (number of layers=nbdl) 
+       !        previously calculated as variable diaglev in routines
+       !        sechiba.f90 and slowproc.f90  
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+       !! 1.2 Calculate carbon fluxes between PFTs to maintain mass balance
+       !! Assure carbon closure when veget_max changes(delta_veg): if veget_max of some PFTs decrease, we use "dilu" to 
+       !! record the corresponding lost in carbon (biomass, litter, soil carbon, gpp, respiration etc.) for 
+       !! these PFTs, and re-allocate "dilu" to those PFTs with increasing veget_max.
+       DO i = 1, npts ! loop over grid points
+          
+          ! Calculate the change in veget_max between previous time step and current time step
+          delta_veg(:) = veget_max(i,:)-veget_max_old(i,:)
+          delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.zero)
+
+          dilu_lit_above(i,:,:) = zero
+          dilu_lit_below(i,:,:,:) = zero
+          dilu_soil_carbon(i,:,:) = zero
+
+          dilu_bio(i,:,:) = zero
+          dilu_TCarbon(i)=zero
+          dilu_turnover_daily(i,:,:)=zero
+          dilu_bm_to_litter(i,:,:)=zero
+          dilu_co2flux_new(i)=zero
+          dilu_gpp_daily(i)=zero
+          dilu_resp_growth(i)=zero
+          dilu_resp_maint(i)=zero
+          dilu_resp_hetero(i)=zero
+          dilu_co2_to_bm(i)=zero
+          dilu_co2_fire(i)=zero
+
+          ! Calculate TCarbon: total carbon including biomass, litter and soil carbon, as well as "today's" turnover and 
+          ! bm_to_litter due to mortality, because today's turnover and bm_to_litter are not yet added into "litter" until tomorrow. 
+          DO j=1, nvm
+                TCarbon(i,j)=SUM(biomass(i,j,:,icarbon))+SUM(carbon(i,:,j,:,icarbon))+SUM(litter_above(i,:,j,icarbon))+ SUM(litter_below(i,:,j,:,icarbon))+&
+                     SUM(turnover_daily(i,j,:,icarbon))+SUM(bm_to_litter(i,j,:,icarbon))
+                co2flux_old(i,j)=resp_maint(i,j)+resp_growth(i,j)+resp_hetero(i,j,icarbon)+co2_fire(i,j)-co2_to_bm(i,j)-gpp_daily(i,j)
+                co2flux_new(i,j)=resp_maint(i,j)+resp_growth(i,j)+resp_hetero(i,j,icarbon)+co2_fire(i,j)-co2_to_bm(i,j)-gpp_daily(i,j)
+          ENDDO
+
+          DO j=1, nvm ! loop over PFTs
+             DO k=2,nbdl
+             IF ( delta_veg(j) < -min_stomate ) THEN 
+                dilu_lit_above(i,:,icarbon) =  dilu_lit_above(i,:,icarbon) + delta_veg(j) * litter_above(i,:,j,icarbon) / delta_veg_sum
+		dilu_lit_above(i,:,icarbon14) =  dilu_lit_above(i,:,icarbon14) + delta_veg(j) * litter_above(i,:,j,icarbon14) / delta_veg_sum
+                dilu_lit_below(i,:,:,icarbon) =  dilu_lit_below(i,:,:,icarbon) + delta_veg(j) * litter_below(i,:,j,:,icarbon) / delta_veg_sum
+		dilu_lit_below(i,:,:,icarbon14) =  dilu_lit_below(i,:,:,icarbon14) + delta_veg(j) * litter_below(i,:,j,:,icarbon14) / delta_veg_sum 
+              DO m = 1,npool
+                dilu_soil_carbon(i,:,k) =  dilu_soil_carbon(i,:,k) + delta_veg(j) * (carbon(i,:,j,k,icarbon)+ &
+                                        (DOC(:,j,k,ifree,m,icarbon) + DOC(:,j,k,iadsorbed,m,icarbon))* moist_soil(:,k) * (z_soil(k)-z_soil(k-1))) / delta_veg_sum
+              ENDDO
+                dilu_TCarbon(i)= dilu_TCarbon(i) + delta_veg(j) * TCarbon(i,j) / delta_veg_sum
+                dilu_turnover_daily(i,:,icarbon)=dilu_turnover_daily(i,:,icarbon)+delta_veg(j)*turnover_daily(i,j,:,icarbon)/delta_veg_sum
+                dilu_bm_to_litter(i,:,icarbon)=dilu_bm_to_litter(i,:,icarbon)+delta_veg(j)*bm_to_litter(i,j,:,icarbon)/delta_veg_sum
+		dilu_bm_to_litter(i,:,icarbon14)=dilu_bm_to_litter(i,:,icarbon14)+delta_veg(j)*bm_to_litter(i,j,:,icarbon14)/delta_veg_sum
+                dilu_co2flux_new(i)=dilu_co2flux_new(i)+delta_veg(j)*co2flux_old(i,j)/delta_veg_sum
+                dilu_gpp_daily(i)=dilu_gpp_daily(i)+delta_veg(j)*gpp_daily(i,j)/delta_veg_sum
+                dilu_resp_growth(i)=dilu_resp_growth(i)+delta_veg(j)*resp_growth(i,j)/delta_veg_sum
+                dilu_resp_maint(i)=dilu_resp_maint(i)+delta_veg(j)*resp_maint(i,j)/delta_veg_sum
+                dilu_resp_hetero(i)=dilu_resp_hetero(i)+delta_veg(j)*resp_hetero(i,j,icarbon)/delta_veg_sum
+                dilu_co2_to_bm(i)=dilu_co2_to_bm(i)+delta_veg(j)*co2_to_bm(i,j)/delta_veg_sum
+                dilu_co2_fire(i)=dilu_co2_fire(i)+delta_veg(j)*co2_fire(i,j)/delta_veg_sum
+             ENDIF
+             ENDDO
+              DO m =1,npool
+                dilu_soil_carbon(i,:,1) =  dilu_soil_carbon(i,:,1) + delta_veg(j) * (carbon(i,:,j,1,icarbon)+ &
+                                        (DOC(:,j,1,ifree,m,icarbon) + DOC(:,j,1,iadsorbed,m,icarbon))* moist_soil(:,1) * (z_soil(1))) / delta_veg_sum
+              ENDDO
+          ENDDO ! loop over PFTs
+
+          DO j=1, nvm ! loop over PFTs
+             IF ( delta_veg(j) > min_stomate) THEN
+
+                ! Dilution of reservoirs
+                ! Recalculate the litter and soil carbon with taking into accout the change in 
+                ! veget_max (delta_veg)
+                ! Litter
+        litter_above(i,:,j,icarbon)=(litter_above(i,:,j,icarbon) * veget_max_old(i,j) + dilu_lit_above(i,:,icarbon) * delta_veg(j)) / veget_max(i,j)
+	litter_above(i,:,j,icarbon14)= ratio * litter_above(i,:,j,icarbon)
+        litter_below(i,:,j,:,icarbon)=(litter_below(i,:,j,:,icarbon) * veget_max_old(i,j) + dilu_lit_below(i,:,:,icarbon) * delta_veg(j)) / veget_max(i,j)
+	litter_below(i,:,j,:,icarbon14)= ratio * litter_below(i,:,j,:,icarbon)
+                ! Soil carbon
+                carbon(i,:,j,:,icarbon)=(carbon(i,:,j,:,icarbon) * veget_max_old(i,j) + dilu_soil_carbon(i,:,:) * delta_veg(j)) / veget_max(i,j)
+		carbon(i,:,j,:,icarbon14)=(carbon(i,:,j,:,icarbon14) * veget_max_old(i,j) + dilu_soil_carbon(i,:,:) * delta_veg(j)) / veget_max(i,j)
+                TCarbon(i,j)=(TCarbon(i,j) * veget_max_old(i,j) + dilu_TCarbon(i) * delta_veg(j)) / veget_max(i,j)
+                turnover_daily(i,j,:,icarbon)=(turnover_daily(i,j,:,icarbon)*veget_max_old(i,j)+&
+                     dilu_turnover_daily(i,:,icarbon)*delta_veg(j))/veget_max(i,j)
+                bm_to_litter(i,j,:,icarbon)=(bm_to_litter(i,j,:,icarbon)*veget_max_old(i,j)+&
+                     dilu_bm_to_litter(i,:,icarbon)*delta_veg(j))/veget_max(i,j)
+                co2flux_new(i,j)=(co2flux_old(i,j)*veget_max_old(i,j)+dilu_co2flux_new(i)*delta_veg(j))/veget_max(i,j)
+                gpp_daily(i,j)=(gpp_daily(i,j)*veget_max_old(i,j)+dilu_gpp_daily(i)*delta_veg(j))/veget_max(i,j)
+                resp_growth(i,j)=(resp_growth(i,j)*veget_max_old(i,j)+dilu_resp_growth(i)*delta_veg(j))/veget_max(i,j)
+                resp_maint(i,j)=(resp_maint(i,j)*veget_max_old(i,j)+dilu_resp_maint(i)*delta_veg(j))/veget_max(i,j)
+                resp_hetero(i,j,icarbon)=(resp_hetero(i,j,icarbon)*veget_max_old(i,j)+dilu_resp_hetero(i)*delta_veg(j))/veget_max(i,j)
+		resp_hetero(i,j,icarbon14)=(resp_hetero(i,j,icarbon14)*veget_max_old(i,j)+dilu_resp_hetero(i)*delta_veg(j))/veget_max(i,j)
+                co2_to_bm(i,j)=(co2_to_bm(i,j)*veget_max_old(i,j)+dilu_co2_to_bm(i)*delta_veg(j))/veget_max(i,j)
+                co2_fire(i,j)=(co2_fire(i,j)*veget_max_old(i,j)+dilu_co2_fire(i)*delta_veg(j))/veget_max(i,j)
+             ENDIF
+
+             IF(veget_max(i,j).GT.min_stomate) THEN
+
+                ! Correct biomass densities to conserve mass
+                ! since it's defined on veget_max
+                biomass(i,j,:,icarbon) = biomass(i,j,:,icarbon) * veget_max_old(i,j) / veget_max(i,j)
+		biomass(i,j,:,icarbon14) = biomass(i,j,:,icarbon14) * veget_max_old(i,j) / veget_max(i,j)
+
+             ENDIF
+
+          ENDDO ! loop over PFTs
+       ENDDO ! loop over grid points
+
+       vartmp(:)=SUM(gpp_daily*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tGPP", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_growth*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tRESP_GROWTH", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_maint*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tRESP_MAINT", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_hetero(:,:,icarbon)*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tRESP_HETERO", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2_to_bm*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCO2_TAKEN", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2_fire*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCO2_FIRE", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2flux_new*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCO2FLUX", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2flux_old*veget_max_old,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCO2FLUX_OLD", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(TCarbon*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tCARBON", itime, vartmp, npts, hori_index)
+       vartmp(:)=SUM(SUM(biomass(:,:,:,icarbon),dim=3)*veget_max,dim=2)
+       CALL histwrite_p (hist_id_stomate, "tBIOMASS", itime, vartmp, npts, hori_index)
+!       vartmp(:)=SUM(SUM(SUM(litter(:,:,:,:,icarbon),dim=4),dim=2)*veget_max,dim=2)
+!       CALL histwrite_p (hist_id_stomate, "tLITTER", itime, vartmp, npts, hori_index)
+!       vartmp(:)=SUM(SUM(carbon,dim=2)*veget_max,dim=2)
+!       CALL histwrite_p (hist_id_stomate, "tSOILC", itime, vartmp, npts, hori_index)
+    ENDIF
+
+  END SUBROUTINE cover
+
+END MODULE lpj_cover
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_crown.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_crown.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_crown.f90	(revision 5166)
@@ -0,0 +1,203 @@
+! =================================================================================================================================
+! MODULE       : lpj_crown
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Calculate individual crown area from stem mass
+!!
+!! \n DESCRIPTION : Calculating crown area of individual tree by diameter and tree height
+!!
+!! REFERENCE(S) :
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!  dynamics in the modelling of terrestrial ecosystems: comparing two
+!!  contrasting approaches within European climate space,
+!!  Global Ecology and Biogeography, 10, 621-637.
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_crown
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+  
+  IMPLICIT NONE
+  
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC crown
+  
+CONTAINS
+  
+  
+!! ================================================================================================================================
+!! SUBROUTINE    : lpj_crown
+!!
+!>\BRIEF         Calculate individual crown area from stem mass
+!!
+!! DESCRIPTION   : Calculating crown area of individual tree by diameter and tree height
+!! which are also calculated internally within this program from stem mass and allometory.
+!! Calculations for diameter, height and crown area originate from eqns 1, 2, and 3 in 
+!! Appendix B, Smith et al. (2001) following Huang et al. 1992 and Zeide 1993.
+!! \latexonly
+!!  \input{lpj_crown1.tex}
+!!  \input{lpj_crown2.tex}
+!!  \input{lpj_crown3.tex}
+!! \endlatexonly
+!! \n
+!! where \f$k_{allom1}(=100.)\f$, \f$k_{allom2}(=40.)\f$, \f$k_{allom3}(=0.85)\f$ and \f$k_{rp}(=1.6)\f$ are 
+!! constants, \f$WD\f$ is wood density (\f$=2 \times 10^5\f$ gC m\f$^3\f$) and \f$CA_{max}\f$ is maximum 
+!! crown area (\f$=27.3\f$ m\f$^2\f$).
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::cn_ind (crown area per individual, @tex $m^2 $ @endtex) and ::height (m)
+!!
+!! REFERENCE(S)   :
+!! - Huang, S., Titus, S.J. and Wiens, D.P. (1992) Comparison of nonlinear heightâdiameter functions for major 
+!! Alberta tree species. Canadian Journal of Forest Research, 22, 1297â1304.\n
+!! - Zeide, B. (1993) Primary unit of the tree crown. Ecology, 74, 1598â1602.\n
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation dynamics in the modelling of 
+!! terrestrial ecosystems: comparing two contrasting approaches within European climate space,
+!! Global Ecology and Biogeography, 10, 621-637.\n
+!! 
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE crown &
+       &  (npts, PFTpresent, ind, biomass, woodmass_ind, veget_max, cn_ind, height)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                         :: npts              !! Domain size (unitless) 
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in)            :: PFTpresent        !! Is pft there (unitless)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)        :: ind               !! [DISPENSABLE] Density of individuals 
+                                                                           !! @tex $(m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: biomass !! [DISPENSABLE] Biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)        :: woodmass_ind      !! Woodmass of the individual, needed to calculate 
+                                                                           !! crownarea in lpj_crown (gC)
+
+    !! 0.2 Output variables
+  
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out)       :: cn_ind            !! Crown area per individual @tex $(m^{2})$ @endtex    
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(inout)     :: veget_max        !! [DISPENSABLE] "Maximal" coverage fraction of a PFT 
+                                                                          !! infinity) on ground (unitless)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(inout)     :: height           !! Height of vegetation (m)           
+
+    !! 0.4 Local variables
+	
+!   REAL(r_std),DIMENSION(npts)                       :: woodmass        !! Wood mass of an individual (gC)
+    INTEGER(i_std)                                    :: j               !! Index
+    REAL(r_std),DIMENSION(npts)                       :: dia             !! Stem diameter (m)
+    REAL(r_std),DIMENSION(nvm)                        :: height_presc_12 !! [DISPENSABLE] Prescribed height of each pfts (m)
+
+!_ ================================================================================================================================
+    
+  !! 1. Initializations
+    
+    !! 1.1 Check if DGVM is activated
+    IF (.NOT.ok_dgvm .AND. lpj_gap_const_mort) THEN
+       CALL ipslerr_p(3,'crown','Coherence error','crown cannot be called with static vegetation.','')
+    ENDIF
+    
+    !! 1.2 Initialize output to zero
+    cn_ind(:,:) = zero
+
+    !! 1.3 Copy prescribed height to new variable**3 !![DISPENSABLE]
+    height_presc_12(1:nvm) = height_presc(1:nvm)     !![DISPENSABLE]
+    
+  !! 2. Calculate (or prescribe) crown area
+    
+    DO j = 2,nvm ! loop over PFTs
+       IF (is_tree(j)) THEN
+          
+          !! 2.1 Trees
+          IF (natural(j)) THEN
+
+             !! 2.1.1 Natural trees
+             !WHERE (PFTpresent(:,j) .AND.ind(:,j).GT.min_stomate)
+             WHERE (PFTpresent(:,j) .AND.woodmass_ind(:,j).GT.min_stomate)
+
+                !! 2.1.1.1 Calculate individual wood mass**2
+
+                !! S. Zaehle note that woodmass_ind needs to be defined on the individual, hence
+                !! biomass*veget_max/ind, not as stated here, correction MERGE 
+                !!         woodmass(:) = &
+                !! &         (biomass(:,j,isapabove,icarbon) + biomass(:,j,isapbelow,icarbon) &
+                !! &         +biomass(:,j,iheartabove,icarbon) + biomass(:,j,iheartbelow,icarbon))/ind(:,j)
+          
+                !! 2.1.1.2 Stem diameter from pipe model
+                !          Stem diameter (pipe model) is calculated by allometory (eqn 1, Appdx B, Smith et al. (2001))
+                !!!$          dia(:) = (woodmass(:)/(pipe_density*pi/4.*pipe_tune2)) &
+                dia(:) = (woodmass_ind(:,j)/(pipe_density*pi/4.*pipe_tune2)) &
+                 &       **(1./(2.+pipe_tune3))
+
+                !! 2.1.1.3 Individual tree height from pipe model
+                !          Individual tree height (eqn 2, Appdx B, Smith et al. (2001))
+                height(:,j) = pipe_tune2*(dia(:)**pipe_tune3)
+
+                !!!$S. Zaehle : The constraint on height has nothing to do with LPJ (for that purpose there's dia_max
+                !!!$ cannot see why this is necessary - it also blurrs the output, hence I leave it commented
+                !!!$ WHERE (height(:,j) > height_presc_12(j))
+                !!!$    dia(:) = (height_presc_12(j)/pipe_tune2)**(1./pipe_tune3)
+                !!!$    height(:,j) = height_presc_12(j)
+                !!!$ ENDWHERE
+
+                !! 2.1.1.4 Crown area of individual tree  
+                !          Calculate crown area, truncate crown area for trunks with large diameters 
+                ! crown area cannot exceed a certain value, prescribed through maxdia 
+                ! (eqn 3, Appdx B, Smith et al. (2001))
+                cn_ind(:,j) = pipe_tune1*MIN(dia(:),maxdia(j))**pipe_tune_exp_coeff
+
+             ENDWHERE
+          ELSE
+
+             !! 2.1.2 Agricultural tree
+             !        To be developped if needed
+             CALL ipslerr_p(3,'crown','Cannot treat agricultural trees.','','')
+          ENDIF
+       ELSE
+          
+       !! 2.2 Grasses
+          
+          WHERE (PFTpresent(:,j))
+
+             !! 2.2.1 Crown area of grass
+             !        An "individual" is 1 m^2 of grass
+             cn_ind(:,j) = un
+          ENDWHERE
+       ENDIF
+       
+       !! 2.3 Recalculate vegetation cover 
+       
+       !!!$S. Zaehle : since now all state variables are defined on veget_max it is very
+       !!!$ dangerous to change this several times in stomate_lpj, as then GPP, turnover and allocated 
+       !!!$ biomass are not defined on the same space! Hence, veget_max is now kept constant
+       !!!$ and updated at the end of stomate_lpj in lpj_cover.f90
+       !!!$ Eventually, this routine should only be called once at the beginning and the end of stomate_lpj
+       !!!$ or prefereably cn_ind made a saved state variable!
+       !!!$ IF (natural(j).AND.ok_dgvm) THEN
+       !!!$   veget_max(:,j) = ind(:,j) * cn_ind(:,j)
+       !!!$ ENDIF
+
+    ENDDO ! loop over PFTs
+
+  END SUBROUTINE crown
+
+END MODULE lpj_crown
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_establish.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_establish.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_establish.f90	(revision 5166)
@@ -0,0 +1,801 @@
+! =================================================================================================================================
+! MODULE       : lpj_establish
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Establish pft's
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: 
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!        plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!        global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Haxeltine, A. and I. C. Prentice (1996), BIOME3: An equilibrium
+!!        terrestrial biosphere model based on ecophysiological constraints, 
+!!        resource availability, and competition among plant functional types,
+!!        Global Biogeochemical Cycles, 10(4), 693-709.\n
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!        dynamics in the modelling of terrestrial ecosystems: comparing two
+!!        contrasting approaches within European climate space,
+!!        Global Ecology and Biogeography, 10, 621-637.\n
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_establish
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+  PRIVATE
+  PUBLIC establish,establish_clear
+
+  LOGICAL, SAVE                          :: firstcall_establish = .TRUE.           !! first call
+!$OMP THREADPRIVATE(firstcall_establish)
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : fire_clear 
+!!
+!>\BRIEF       Set the firstcall_establish flag to .TRUE. and activate initialization
+!_ ================================================================================================================================
+
+  SUBROUTINE establish_clear
+    firstcall_establish = .TRUE.
+  END SUBROUTINE establish_clear
+
+
+! =================================================================================================================================
+! SUBROUTINE   : establish 
+!
+!>\BRIEF       Calculate sstablishment of new woody PFT and herbaceous PFTs
+!!
+!! DESCRIPTION : Establishments of new woody and herbaceous PFT are simulated. 
+!! Maximum establishment rate (0.12) declines due to competition for light (space).
+!! There are two establishment estimates: one for the for DGVM and one for the 
+!! static cases.\n
+!! In the case of DGVM, competitive process of establishment for the area of 
+!! available space is represented using more detailed description compared with static 
+!! one. Biomass and distribution of plant age are updated on the basis of changes 
+!! in number of individuals. Finally excess sapwood of is converted to heartwood.
+!!
+!! \latexonly
+!! \input{equation_lpj_establish.tex}
+!! \endlatexonly
+!! \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)    :
+!! Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!    dynamics in the modelling of terrestrial ecosystems: comparing two
+!!    contrasting approaches within European climate space,
+!!    Global Ecology and Biogeography, 10, 621-637.
+!!
+!! FLOWCHART       : 
+!! \latexonly
+!! \includegraphics[scale = 0.7]{establish.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE establish (npts, dt, PFTpresent, regenerate, &
+       neighbours, resolution, need_adjacent, herbivores, &
+       precip_annual, gdd0, lm_lastyearmax, &
+       cn_ind, lai, avail_tree, avail_grass,  npp_longterm, &
+       leaf_age, leaf_frac, &
+       ind, biomass, age, everywhere, co2_to_bm,veget_max, woodmass_ind, &
+       mortality, bm_to_litter)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size - number of pixels (dimensionless)    
+    REAL(r_std), INTENT(in)                                   :: dt              !! Time step of vegetation dynamics for stomate 
+                                                                                 !! (days)            
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                  :: PFTpresent      !! Is pft there (unitless)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: regenerate      !! Winter sufficiently cold (unitless)   
+    INTEGER(i_std), DIMENSION(npts,8), INTENT(in)             :: neighbours      !! indices of the 8 neighbours of each grid point 
+                                                                                 !! (unitless);  
+                                                                                 !! [1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW]  
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)                :: resolution      !! resolution at each grid point (m); 1=E-W, 2=N-S     
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                  :: need_adjacent   !! in order for this PFT to be introduced, does it
+                                                                                 !! have to be present in an adjacent grid box?  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: herbivores      !! time constant of probability of a leaf to 
+                                                                                 !! be eaten by a herbivore (days)     
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: precip_annual   !! annual precipitation (mm year^{-1}) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: gdd0            !! growing degree days (degree C)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lm_lastyearmax  !! last year's maximum leaf mass for each PFT 
+                                                                                 !! (gC m^{-2 })
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: cn_ind          !! crown area of individuals (m^2)        
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lai             !! leaf area index OF an individual plant 
+                                                                                 !! (m^2 m^{-2})           
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: avail_tree      !! space availability for trees (unitless)     
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: avail_grass     !! space availability for grasses (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: npp_longterm    !! longterm NPP, for each PFT (gC m^{-2})   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: veget_max       !! "maximal" coverage fraction of a PFT 
+                                                                                 !! (LAI -> infinity) on ground (unitless)
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(in)               :: mortality       !! Fraction of individual dying this time 
+                                                                                 !! step (0 to 1, unitless) 
+
+    !! 0.2 Output variables
+    
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age        !! leaf age (days)     
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! fraction of leaves in leaf age class (unitless)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! Number of individuals (individuals m^{-2})          
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass   !! biomass (gC m^{-2 })     
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age             !! mean age (years)       
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! is the PFT everywhere in the grid box or very 
+                                                                                 !! localized (unitless)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm       !! biomass up take for establishment i.e. 
+                                                                                 !! pseudo-photosynthesis (gC m^{-2} day^{-1}) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: woodmass_ind    !! woodmass of the individual, needed to calculate
+                                                                                 !! crownarea in lpj_crownarea (gC m^{-2 })  
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !!Biomass transfer to litter
+
+    !! 0.4 Local variables
+
+    REAL(r_std)                                               :: tau_eatup       !! time during which a sapling can be entirely 
+                                                                                 !! eaten by herbivores (days) 
+    REAL(r_std), DIMENSION(npts,nvm)                          :: fpc_nat         !! new fpc, foliage projective cover: fractional
+                                                                                 !! coverage (unitless)       
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_climate_tree  !! maximum tree establishment rate, 
+                                                                                              !! based on climate only (unitless)  
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_climate_grass !! maximum grass establishment rate,
+                                                                                              !! based on climate only (unitless)
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_tree          !! maximum tree establishment rate, 
+                                                                                              !! based on climate and fpc 
+                                                                                              !! (unitless) 
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_grass         !! maximum grass establishment rate,
+                                                                                              !! based on climate and fpc 
+                                                                                              !! (unitless) 
+    REAL(r_std), DIMENSION(npts)                              :: sumfpc          !! total natural fpc (unitless)
+    REAL(r_std), DIMENSION(npts)                              :: fracnat         !! total fraction occupied by natural 
+                                                                                 !! vegetation (unitless)  
+    REAL(r_std), DIMENSION(npts)                              :: sumfpc_wood     !! total woody fpc (unitless)    
+    REAL(r_std), DIMENSION(npts)                              :: spacefight_grass!! for grasses, measures the total concurrence 
+                                                                                 !! for available space (unitless)
+    REAL(r_std), DIMENSION(npts,nvm)                          :: d_ind           !! change in number of individuals per time step 
+                                                                                 !! (individuals m^{-2} day{-1})         
+    REAL(r_std), DIMENSION(npts)                              :: bm_new          !! biomass increase (gC m^{-2 })        
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements)         :: biomass_old     !! Save the original biomass passed into the subroutine 
+    REAL(r_std), DIMENSION(npts)                              :: bm_non          !! Non-effective establishment: the "virtual" saplings that die instantly
+    REAL(r_std), DIMENSION(npts)                              :: bm_eff          !! Effective (or real) establishment  
+    REAL(r_std), DIMENSION(npts)                              :: dia             !! stem diameter (m)    
+    REAL(r_std), DIMENSION(npts)                              :: b1              !! temporary variable           
+    REAL(r_std), DIMENSION(npts)                              :: woodmass        !! woodmass of an individual (gC m^{-2})  
+    REAL(r_std), DIMENSION(npts)                              :: leaf_mass_young !! carbon mass in youngest leaf age class 
+                                                                                 !! (gC m^{-2})
+    REAL(r_std), DIMENSION(npts)                              :: factor          !! reduction factor for establishment if many 
+                                                                                 !! trees or grasses are present (unitless)  
+    REAL(r_std), DIMENSION(npts)                              :: total_bm_c      !! Total carbon mass for all pools (gC m^{-2})    
+    REAL(r_std), DIMENSION(npts,nelements)                    :: total_bm_sapl   !! Total sappling biomass for all pools 
+                                                                                 !! (gC m^{-2})  
+    REAL(r_std), DIMENSION(npts,nelements)                    :: total_bm_sapl_non !! total non-effective sapling biomass 
+
+    INTEGER(i_std)                                            :: nfrontx         !! from how many sides is the grid box invaded
+                                                                                 !! (unitless?)   
+    INTEGER(i_std)                                            :: nfronty         !! from how many sides is the grid box invaded
+                                                                                 !! (unitless?)   
+    REAL(r_std), DIMENSION(npts)                              :: vn              !! flow due to new individuals veget_max after 
+                                                                                 !! establishment, to get a proper estimate of 
+                                                                                 !! carbon and nitrogen 
+    REAL(r_std), DIMENSION(npts)                              :: lai_ind         !! lai on each PFT surface (m^2 m^{-2})   
+    REAL(r_std), DIMENSION(npts)                              :: veget_max_tree  !! Sum of veget_max for the pft's which are trees
+    INTEGER(i_std)                                            :: nbtree          !! Number of PFT's which are trees
+    INTEGER(i_std)                                            :: i,j,k,m         !! indices (unitless)       
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering establish'
+
+  !! 1. messages and initialization
+
+    ! Assumption: time durasion that sapling is completely eaten by hervioures is a half year?   
+    ! No reference
+    tau_eatup = one_year/2.
+    
+    ! Calculate the sum of the vegetation over the tree pft's and the number of pft's which are trees
+    veget_max_tree(:) = 0.0
+    nbtree=0
+    DO j = 1, nvm 
+       IF (is_tree(j)) THEN
+          veget_max_tree(:) = veget_max_tree(:) + veget_max(:,j)
+          nbtree = nbtree + 1
+       END IF
+    END DO
+    ! Set nbtree=1 to avoid zero division later if there are no tree PFT's.
+    ! For that case veget_max_tree=0 so there will not be any impact.
+    IF (nbtree == 0) nbtree=1
+
+    !! 1.1 First call only
+    IF ( firstcall_establish ) THEN
+
+       WRITE(numout,*) 'establish:'
+
+       WRITE(numout,*) '   > time during which a sapling can be entirely eaten by herbivores (d): ', &
+            tau_eatup
+
+       firstcall_establish = .FALSE.
+
+    ENDIF
+
+  !! 2. recalculate fpc
+
+    IF (ok_dgvm) THEN
+       fracnat(:) = un
+
+       !! 2.1 Only natural part of the grid cell
+       do j = 2,nvm ! Loop over # PFTs
+          
+          IF ( .NOT. natural(j) ) THEN
+             fracnat(:) = fracnat(:) - veget_max(:,j)
+          ENDIF
+       ENDDO ! Loop over # PFTs
+       
+       sumfpc(:) = zero
+
+       !! 2.2 Total natural fpc on grid
+       !      The overall fractional coverage of a PFT in a grid is calculated here.
+       !      FPC is related to mean individual leaf area index by the Lambert-Beer law.
+       !      See Eq. (1) in tex file.\n
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( natural(j) ) THEN
+             WHERE(fracnat(:).GT.min_stomate)
+                WHERE (lai(:,j) == val_exp) 
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                ELSEWHERE
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) & 
+                        * ( un - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
+                ENDWHERE
+             ENDWHERE
+
+             WHERE ( PFTpresent(:,j) )
+                sumfpc(:) = sumfpc(:) + fpc_nat(:,j)
+             ENDWHERE
+          ELSE
+
+             fpc_nat(:,j) = zero
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+       
+       !! 2.3 Total woody fpc on grid and number of regenerative tree pfts
+       !      Total woody FPC increases by adding new FPC.
+       !      Under the condition that temperature in last winter is higher than a threshold, 
+       !      woody plants is exposed in higher competitive environment.
+       sumfpc_wood(:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( is_tree(j) .AND. natural(j) ) THEN
+
+             ! total woody fpc
+             WHERE ( PFTpresent(:,j) )
+                sumfpc_wood(:) = sumfpc_wood(:) + fpc_nat(:,j)
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+
+       !! 2.4 Total number of natural grasses on grid\n
+       !     Grass increment equals 'everywhere'\n
+       spacefight_grass(:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( .NOT. is_tree(j) .AND. natural(j) ) THEN
+
+             ! Count a PFT fully only if it is present on a grid.
+             WHERE ( PFTpresent(:,j) )
+                spacefight_grass(:) = spacefight_grass(:) + everywhere(:,j)
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+
+       !! 2.5 Maximum establishment rate, based on climate only\n
+       WHERE ( ( precip_annual(:) .GE. precip_crit ) .AND. ( gdd0(:) .GE. gdd_crit_estab ) )
+
+          estab_rate_max_climate_tree(:) = estab_max_tree ! 'estab_max_*'; see 'stomate_constants.f90'
+          estab_rate_max_climate_grass(:) = estab_max_grass
+
+       ELSEWHERE
+
+          estab_rate_max_climate_tree(:) = zero
+          estab_rate_max_climate_grass(:) = zero
+
+       ENDWHERE
+
+       !! 2.6 Reduce maximum tree establishment rate if many trees are present.
+       !      In the original DGVM, this is done using a step function which yields a
+       !      reduction by factor 4 if sumfpc_wood(i) .GT.  fpc_crit - 0.05.
+       !      This can lead to small oscillations (without consequences however).
+       !      Here, a steady linear transition is used between fpc_crit-0.075 and
+       !      fpc_crit-0.025.
+       !      factor(:) = 1. - 15. * ( sumfpc_wood(:) - (fpc_crit-.075))
+       !      factor(:) = MAX( 0.25_r_std, MIN( 1._r_std, factor(:)))
+       !      S. Zaehle modified according to Smith et al. 2001
+       !      See Eq. (2) in header
+       factor(:)=(un - exp(- establish_scal_fact * (un - sumfpc_wood(:))))*(un - sumfpc_wood(:))
+       estab_rate_max_tree(:) = estab_rate_max_climate_tree(:) * factor(:)
+
+       !! 2.7 Modulate grass establishment rate.
+       !      If canopy is not closed (fpc < fpc_crit-0.05), normal establishment.
+       !      If canopy is closed, establishment is reduced by a factor 4.
+       !      Factor is linear between these two bounds.
+       !      This is different from the original DGVM where a step function is
+       !      used at fpc_crit-0.05 (This can lead to small oscillations,
+       !      without consequences however).
+       !      factor(:) = 1. - 15. * ( sumfpc(:) - (fpc_crit-.05))
+       !      factor(:) = MAX( 0.25_r_std, MIN( 1._r_std, factor(:)))
+       !      estab_rate_max_grass(:) = estab_rate_max_climate_grass(:) * factor(:)
+       !      S. Zaehle modified to true LPJ formulation, grasses are only allowed in the
+       !      fpc fraction not occupied by trees..., 080806
+       !      estab_rate_max_grass(:)=MAX(0.98-sumfpc(:),zero)
+       !      See Eq. (3) in header
+       estab_rate_max_grass(:) = MAX(MIN(estab_rate_max_climate_grass(:), max_tree_coverage - sumfpc(:)),zero)
+
+       !! 2.8 Longterm grass NPP for competition between C4 and C3 grasses
+       !      to avoid equal veget_max, the idea is that more reestablishment
+       !      is possible for the more productive PFT
+       factor(:) = min_stomate
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( natural(j) .AND. .NOT.is_tree(j)) & 
+               factor(:) = factor(:) + npp_longterm(:,j) * &
+               lm_lastyearmax(:,j) * sla(j)
+       ENDDO ! Loop over # PFTs
+
+       !! 2.9 Establish natural PFTs
+       d_ind(:,:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( natural(j) ) THEN ! only for natural PFTs
+
+             !! 2.9.1 PFT expansion across the grid box. Not to be confused with areal coverage.
+             IF ( treat_expansion ) THEN
+
+                ! only treat plants that are regenerative and present and still can expand
+                DO i = 1, npts ! Loop over # pixels - domain size
+
+                   IF ( PFTpresent(i,j) .AND. &
+                        ( everywhere(i,j) .LT. un ) .AND. &
+                        ( regenerate(i,j) .GT. regenerate_crit ) ) THEN
+
+                      ! from how many sides is the grid box invaded (separate x and y directions
+                      ! because resolution may be strongly anisotropic)
+                      ! For the moment we only look into 4 direction but that can be expanded (JP) 
+                      nfrontx = 0
+                      IF ( neighbours(i,3) .GT. 0 ) THEN
+                         IF ( everywhere(neighbours(i,3),j) .GT. 1.-min_stomate ) nfrontx = nfrontx+1
+                      ENDIF
+                      IF ( neighbours(i,7) .GT. 0 ) THEN
+                         IF ( everywhere(neighbours(i,7),j) .GT. 1.-min_stomate ) nfrontx = nfrontx+1
+                      ENDIF
+
+                      nfronty = 0
+                      IF ( neighbours(i,1) .GT. 0 ) THEN
+                         IF ( everywhere(neighbours(i,1),j) .GT. 1.-min_stomate ) nfronty = nfronty+1
+                      ENDIF
+                      IF ( neighbours(i,5) .GT. 0 ) THEN
+                         IF ( everywhere(neighbours(i,5),j) .GT. 1.-min_stomate ) nfronty = nfronty+1
+                      ENDIF
+                      
+                      everywhere(i,j) = &
+                           everywhere(i,j) + migrate(j) * dt/one_year * &
+                           ( nfrontx / resolution(i,1) + nfronty / resolution(i,2) )
+                      
+                      IF ( .NOT. need_adjacent(i,j) ) THEN
+                         
+                         ! in that case, we also assume that the PFT expands from places within
+                         ! the grid box (e.g., oasis).
+                         ! What is this equation? No reference.
+                         everywhere(i,j) = &
+                              everywhere(i,j) + migrate(j) * dt/one_year * &
+                              2. * SQRT( pi*everywhere(i,j)/(resolution(i,1)*resolution(i,2)) )
+
+                      ENDIF
+
+                      everywhere(i,j) = MIN( everywhere(i,j), un )
+
+                   ENDIF
+
+                ENDDO ! Loop over # pixels - domain size
+
+             ENDIF ! treat expansion?
+
+             !! 2.9.2 Establishment rate
+             !      - Is lower if the PFT is only present in a small part of the grid box
+             !        (after its introduction), therefore multiplied by "everywhere".
+             !      - Is divided by the number of PFTs that compete ("spacefight").
+             !      - Is modulated by space availability (avail_tree, avail_grass).
+
+             !! 2.9.2.1 present and regenerative trees
+             IF ( is_tree(j) ) THEN
+
+                WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit ) )
+                   d_ind(:,j) = estab_rate_max_tree(:)*everywhere(:,j) * &
+                        avail_tree(:) * dt/one_year
+                ENDWHERE
+
+             !! 2.9.2.2 present and regenerative grasses
+             ELSE
+
+                WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit )  & 
+                     .AND.factor(:).GT.min_stomate .AND. spacefight_grass(:).GT. min_stomate) 
+                   
+                   d_ind(:,j) = estab_rate_max_grass(:)*everywhere(:,j)/spacefight_grass(:) * &
+                        MAX(min_stomate,npp_longterm(:,j)*lm_lastyearmax(:,j)*sla(j)/factor(:)) * fracnat(:) * dt/one_year
+                ENDWHERE
+                
+             ENDIF  ! tree/grass
+             
+          ENDIF ! if natural
+       ENDDO  ! Loop over # PFTs
+       
+  !! 3. Lpj establishment in static case 
+
+    !     Lpj establishment in static case, S. Zaehle 080806, account for real LPJ dynamics in
+    !     prescribed vegetation, i.e. population dynamics within a given area of the grid cell.
+    ELSE 
+
+       d_ind(:,:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          WHERE(ind(:,j)*cn_ind(:,j).GT.min_stomate)
+             lai_ind(:) = sla(j) * lm_lastyearmax(:,j)/(ind(:,j)*cn_ind(:,j))
+          ELSEWHERE
+             lai_ind(:) = zero
+          ENDWHERE
+
+          !! 3.1 For natural woody PFTs
+          IF ( natural(j) .AND. is_tree(j)) THEN 
+
+             ! See Eq. (4) in tex file.            
+             fpc_nat(:,j) =  MIN(un, cn_ind(:,j) * ind(:,j) * & 
+                  MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover ) )
+
+
+             WHERE (veget_max(:,j).GT.min_stomate.AND.ind(:,j).LE.2.)
+
+                !! 3.1.1 Only establish into growing stands 
+                !        Only establish into growing stands, ind can become very
+                !        large in the static mode because LAI is very low in poor 
+                !        growing conditions, favouring continuous establishment. 
+                !        To avoid this a maximum IND is set. BLARPP: This should be
+                !        replaced by a better stand density criteria.
+                factor(:)=(un - exp(-establish_scal_fact * (un - fpc_nat(:,j))))*(un - fpc_nat(:,j))
+
+                estab_rate_max_tree(:) = estab_max_tree * factor(:) 
+
+                !! 3.1.2 do establishment for natural PFTs\n
+                d_ind(:,j) = MAX( zero, estab_rate_max_tree(:) * dt/one_year)
+
+             ENDWHERE
+
+             !S. Zaehle: quickfix: to simulate even aged stand, uncomment the following lines...
+             !where (ind(:,j) .LE. min_stomate)
+             !d_ind(:,j) = 0.1 !MAX( 0.0, estab_rate_max_tree(:) * dt/one_year)
+             WHERE (veget_max(:,j).GT.min_stomate .AND. ind(:,j).EQ.zero)
+                d_ind(:,j) = ind_0_estab
+             ENDWHERE
+
+          !! 3.2 For natural grass PFTs
+          ELSEIF ( natural(j) .AND. .NOT.is_tree(j)) THEN 
+
+             WHERE (veget_max(:,j).GT.min_stomate)
+
+                fpc_nat(:,j) =  cn_ind(:,j) * ind(:,j) * & 
+                     MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
+
+                d_ind(:,j) = MAX(zero , (un - fpc_nat(:,j)) * dt/one_year )
+
+             ENDWHERE
+
+             WHERE (veget_max(:,j).GT.min_stomate .AND. ind(:,j).EQ. zero)
+                d_ind(:,j) = ind_0_estab 
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+
+    ENDIF ! DGVM OR NOT
+
+  !! 4. Biomass calculation
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN ! only for natural PFTs
+
+          !! 4.1 Herbivores reduce establishment rate
+          !      We suppose that saplings are vulnerable during a given time after establishment.
+          !      This is taken into account by preventively reducing the establishment rate.
+          IF ( ok_herbivores ) THEN
+
+             d_ind(:,j) = d_ind(:,j) * EXP( - tau_eatup/herbivores(:,j) )
+
+          ENDIF
+
+          !! 4.2 Total biomass.
+          !      Add biomass only if d_ind, over one year, is of the order of ind.
+          !      save old leaf mass to calculate leaf age
+          leaf_mass_young(:) = leaf_frac(:,j,1) * biomass(:,j,ileaf,icarbon)
+
+          ! total biomass of existing PFT to limit biomass added from establishment
+          total_bm_c(:) = zero
+
+          DO k = 1, nparts
+             total_bm_c(:) = total_bm_c(:) + biomass(:,j,k,icarbon)
+          ENDDO
+          IF(ok_dgvm) THEN
+             vn(:) = veget_max(:,j)
+          ELSE
+             vn(:) = un
+          ENDIF
+
+          !! 4.3 Woodmass calculation
+
+          !! 4.3.1 with DGVM
+          IF(ok_dgvm) THEN
+
+             ! S. Zaehle calculate new woodmass_ind and veget_max after establishment (needed for correct scaling!)
+             ! essential correction for MERGE!
+             IF(is_tree(j))THEN
+                DO i=1,npts ! Loop over # pixels - domain size
+                   IF((d_ind(i,j)+ind(i,j)).GT.min_stomate) THEN
+
+                      IF((total_bm_c(i).LE.min_stomate) .OR. (veget_max(i,j) .LE. min_stomate)) THEN
+
+                         ! new wood mass of PFT
+                         woodmass_ind(i,j) = &
+                              (((biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                              + biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon))*veget_max(i,j)) &
+                              + (bm_sapl(j,isapabove,icarbon) + bm_sapl(j,isapbelow,icarbon) &
+                              + bm_sapl(j,iheartabove,icarbon) + bm_sapl(j,iheartbelow,icarbon))*d_ind(i,j))/(ind(i,j) + d_ind(i,j))
+
+                      ELSE
+ 
+                         ! new biomass is added to the labile pool, hence there is no change 
+                         ! in CA associated with establishment
+                         woodmass_ind(i,j) = &
+                              & (biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                              & +biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon))*veget_max(i,j) &
+                              & /(ind(i,j) + d_ind(i,j))
+
+                      ENDIF
+
+                      ! new diameter of PFT
+                      dia(i) = (woodmass_ind(i,j)/(pipe_density*pi/4.*pipe_tune2)) &
+                           &                **(1./(2.+pipe_tune3))
+                      vn(i) = (ind(i,j) + d_ind(i,j))*pipe_tune1*MIN(dia(i),maxdia(j))**pipe_tune_exp_coeff
+
+                   ENDIF
+                ENDDO ! Loop over # pixels - domain size
+             ELSE ! for grasses, cnd=1, so the above calculation cancels
+                vn(:) = ind(:,j) + d_ind(:,j)
+             ENDIF
+
+          !! 4.3.2 without DGVM (static)\n
+          ELSE 
+             DO i=1,npts ! Loop over # pixels - domain size
+                IF(is_tree(j).AND.(d_ind(i,j)+ind(i,j)).GT.min_stomate) THEN
+                   IF(total_bm_c(i).LE.min_stomate) THEN
+
+                      ! new wood mass of PFT
+                      woodmass_ind(i,j) = &
+                           & (((biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                           & + biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon))) &
+                           & + (bm_sapl(j,isapabove,icarbon) + bm_sapl(j,isapbelow,icarbon) &
+                           & + bm_sapl(j,iheartabove,icarbon) + bm_sapl(j,iheartbelow,icarbon))*d_ind(i,j))/(ind(i,j)+d_ind(i,j))
+
+                   ELSE
+ 
+                      ! new biomass is added to the labile pool, hence there is no change 
+                      ! in CA associated with establishment
+                      woodmass_ind(i,j) = &
+                           & (biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                           & + biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon)) &
+                           & /(ind(i,j) + d_ind(i,j))
+
+                   ENDIF
+                ENDIF
+             ENDDO ! Loop over # pixels - domain size
+
+             vn(:) = un ! cannot change in static!, and veget_max implicit in d_ind
+
+          ENDIF
+
+          !! 4.4 total biomass of PFT added by establishment defined over veget_max ...
+
+          total_bm_sapl(:,:) = zero
+          total_bm_sapl_non(:,:) = zero
+          biomass_old(:,j,:,icarbon)=biomass(:,j,:,icarbon)
+	  biomass_old(:,j,:,icarbon14)= biomass_old(:,j,:,icarbon)
+          DO k = 1, nparts ! Loop over # litter tissues (nparts=8); see 'stomate_constants.f90'
+             WHERE(d_ind(:,j).GT.min_stomate.AND.total_bm_c(:).GT.min_stomate.AND.vn(:).GT.min_stomate)
+
+                total_bm_sapl(:,icarbon) = total_bm_sapl(:,icarbon) + bm_sapl(j,k,icarbon) * d_ind(:,j) / vn(:)
+
+                ! non-effective establishment
+                total_bm_sapl_non(:,icarbon) = total_bm_sapl_non(:,icarbon) + &
+                     bm_sapl(j,k,icarbon) * (ind(:,j)+d_ind(:,j))*mortality(:,j) / vn(:)
+
+             ENDWHERE
+          ENDDO ! Loop over # litter tissues
+
+!Dan Zhu modification: there is a problem here, if DGVM is activated, co2_to_bm will never reach
+!0 due to establishment, where d_ind is still large at equilibrium (=ind*mortality). So we
+!need to subtract it from litter (not biomass, because the
+!corresponding biomass has been lost in lpj_gap).
+
+          !! 4.5 Update biomass at each component
+          DO k = 1, nparts ! Loop over # litter tissues
+
+             bm_new(:) = zero
+             bm_non(:) = zero
+             bm_eff(:) = zero
+
+             ! first ever establishment, C flows
+             WHERE( d_ind(:,j).GT.min_stomate .AND. &
+                  total_bm_c(:).LE.min_stomate .AND. &
+                  vn(:).GT.min_stomate)
+
+                bm_new(:) = d_ind(:,j) * bm_sapl(j,k,icarbon) / vn(:)
+                biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) + bm_new(:)
+		biomass(:,j,k,icarbon14) = biomass(:,j,k,icarbon)
+
+                ! bm_to_litter minus the 'non-effective' establishment (mortality), but cannot be less than 0
+                WHERE((veget_max_tree(:) .GT. 0.1) .AND. (veget_max(:,j) .LT. veget_max_tree(:)/nbtree) )
+
+                   bm_non(:) = MIN( biomass(:,j,k,icarbon)+bm_to_litter(:,j,k,icarbon), &
+                        (ind(:,j)+d_ind(:,j))*mortality(:,j) * bm_sapl(j,k,icarbon)/vn(:) )
+                   bm_eff(:) = MIN( npp_longterm(:,j)/one_year, bm_new(:)-bm_non(:) )
+                   bm_non(:) = MIN( biomass(:,j,k,icarbon)+bm_to_litter(:,j,k,icarbon), bm_new(:)-bm_eff(:) )
+
+                   co2_to_bm(:,j)=co2_to_bm(:,j) + bm_new(:) - bm_non(:)
+                   WHERE( bm_to_litter(:,j,k,icarbon) .LT. bm_non(:) )
+                      biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) - ( bm_non(:) - bm_to_litter(:,j,k,icarbon) )
+		      biomass(:,j,k,icarbon14) = biomass(:,j,k,icarbon)
+                   ENDWHERE
+                   bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) - MIN(bm_to_litter(:,j,k,icarbon), bm_non(:) )
+
+                ELSEWHERE
+
+                   bm_non(:) = MIN( bm_to_litter(:,j,k,icarbon), (ind(:,j)+d_ind(:,j))*mortality(:,j) * bm_sapl(j,k,icarbon)/vn(:) )
+                   co2_to_bm(:,j)=co2_to_bm(:,j) + bm_new(:)/dt - bm_non(:)/dt
+                   bm_to_litter(:,j,k,icarbon)=bm_to_litter(:,j,k,icarbon)- bm_non(:)
+                ENDWHERE
+
+             ENDWHERE
+
+             ! establishment into existing population, C flows
+             WHERE(d_ind(:,j).GT.min_stomate.AND.total_bm_c(:).GT.min_stomate)
+
+                bm_new(:) = total_bm_sapl(:,icarbon) * biomass_old(:,j,k,icarbon) / total_bm_c(:)
+                biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) + bm_new(:)
+		biomass(:,j,k,icarbon14) = biomass(:,j,k,icarbon)
+
+                WHERE((veget_max_tree(:) .GT. 0.1) .AND. (veget_max(:,j) .LT. veget_max_tree(:)/nbtree) )
+                   bm_non(:) = MIN( biomass(:,j,k,icarbon)+bm_to_litter(:,j,k,icarbon), &
+                        total_bm_sapl_non(:,icarbon) *biomass_old(:,j,k,icarbon)/total_bm_c(:) )
+                   bm_eff(:) = MIN( npp_longterm(:,j)/one_year, bm_new(:)-bm_non(:) )
+                   bm_non(:) = MAX( zero, MIN( biomass(:,j,k,icarbon)+bm_to_litter(:,j,k,icarbon)-min_stomate, &
+                        bm_new(:)-bm_eff(:) ) )
+
+                   co2_to_bm(:,j)=co2_to_bm(:,j) + bm_new(:) - bm_non(:)
+                   WHERE( bm_to_litter(:,j,k,icarbon) .LT. bm_non(:) )
+                      biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) - ( bm_non(:) - bm_to_litter(:,j,k,icarbon) )
+		      biomass(:,j,k,icarbon14) = biomass(:,j,k,icarbon)
+                   ENDWHERE
+                   bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) - MIN(bm_to_litter(:,j,k,icarbon), bm_non(:) )
+
+                ELSEWHERE
+
+                   bm_non(:) = MIN( bm_to_litter(:,j,k,icarbon), &
+                        total_bm_sapl_non(:,icarbon) *biomass_old(:,j,k,icarbon)/total_bm_c(:) )
+                   co2_to_bm(:,j) = co2_to_bm(:,j) + bm_new(:)/dt - bm_non(:)/dt
+                   bm_to_litter(:,j,k,icarbon)=bm_to_litter(:,j,k,icarbon)- bm_non(:)
+                ENDWHERE
+
+             ENDWHERE
+
+          ENDDO ! Loop over # litter tissues
+
+          IF (ANY( bm_to_litter(:,j,:,icarbon) .LT. 0.0 ) .OR. ANY( biomass(:,j,:,icarbon) .LT. 0.0 ) ) THEN
+             CALL ipslerr_p(3,'establish','something wrong in establish/gap.','','')
+          ENDIF 
+
+          !! 4.6 Decrease leaf age in youngest class if new leaf biomass is higher than old one.
+          WHERE ( d_ind(:,j) * bm_sapl(j,ileaf,icarbon) .GT. min_stomate )
+ 
+             ! reset leaf ages. Should do a real calculation like in the npp routine, 
+             ! but this case is rare and not worth messing around.
+             ! S. Zaehle 080806, added real calculation now, because otherwise leaf_age/leaf_frac
+             ! are not initialised for the calculation of vmax, and hence no growth at all.
+             ! logic follows that of stomate_npp.f90, just that it's been adjusted for the code here
+             leaf_age(:,j,1) = leaf_age(:,j,1) * leaf_mass_young(:) / &
+                  ( leaf_mass_young(:) + d_ind(:,j) * bm_sapl(j,ileaf,icarbon) )
+
+          ENDWHERE
+
+          leaf_mass_young(:) = leaf_mass_young(:) + d_ind(:,j) * bm_sapl(j,ileaf,icarbon)   
+
+          !! 4.7 Youngest class: new mass in youngest class divided by total new mass
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+             ! new age class fractions (fraction in youngest class increases)
+             leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf,icarbon)
+
+          ENDWHERE
+
+          !! 4.8 Other classes: old mass in leaf age class divided by new mass
+          DO m = 2, nleafages
+
+             WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+                leaf_frac(:,j,m) = leaf_frac(:,j,m) * & 
+                     ( biomass(:,j,ileaf,icarbon) + d_ind(:,j) * bm_sapl(j,ileaf,icarbon) ) /  biomass(:,j,ileaf,icarbon)
+
+             ENDWHERE
+
+          ENDDO
+
+          !! 4.9 Update age and number of individuals
+          WHERE ( d_ind(:,j) .GT. min_stomate )
+
+             age(:,j) = age(:,j) * ind(:,j) / ( ind(:,j) + d_ind(:,j) )
+
+             ind(:,j) = ind(:,j) + d_ind(:,j)
+
+          ENDWHERE
+
+          !! 4.10 Convert excess sapwood to heartwood
+          !!      No longer done : supressed by S. Zaehle given that the LPJ logic of carbon allocation was 
+          !!      contradictory to SLAVE allocation. See CVS tag 1_5 for initial formulation. 
+
+
+       ENDIF ! natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 5. history
+
+    d_ind = d_ind / dt
+
+    CALL xios_orchidee_send_field("IND_ESTAB",d_ind)
+    CALL xios_orchidee_send_field("ESTABTREE",estab_rate_max_tree)
+    CALL xios_orchidee_send_field("ESTABGRASS",estab_rate_max_grass)
+
+    CALL histwrite_p (hist_id_stomate, 'IND_ESTAB', itime, d_ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ESTABTREE', itime, estab_rate_max_tree, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'ESTABGRASS', itime, estab_rate_max_grass, npts, hori_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving establish'
+
+  END SUBROUTINE establish
+
+END MODULE lpj_establish
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_fire.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_fire.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_fire.f90	(revision 5166)
@@ -0,0 +1,563 @@
+! =================================================================================================================================
+! MODULE        : lpj_fire
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Calculates the probability of fire and its effects on the carbon cycle
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN           :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_fire
+
+  ! modules used:
+  USE xios_orchidee
+  USE stomate_data
+  USE ioipsl_para 
+  USE pft_parameters
+  USE constantes
+  USE constantes_soil
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC fire,fire_clear
+
+  LOGICAL, SAVE                   :: firstcall_fire = .TRUE.        !! first call 
+!$OMP THREADPRIVATE(firstcall_fire)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : fire_clear 
+!!
+!>\BRIEF        Set the firstcall_fire flag to .TRUE. and activate initialization
+!! 
+!_ ================================================================================================================================
+
+  SUBROUTINE fire_clear
+    firstcall_fire = .TRUE.
+  END SUBROUTINE fire_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE     : fire 
+!!
+!>\BRIEF          Calculate fire index and fraction of area burned by comparing 
+!! daily litter moisture with prescribed moisture of fire inhibition. If daily 
+!! moisture is below the precribed threshold, allow fire disturbance and 
+!! calculate CO_2 emissions from fire. The main algorithm follows Thonicke et al. 
+!! (2001)
+!!
+!! DESCRIPTION	: Fire occurs when the three basic prerequisites are met: 
+!! sufficient fuel on the ground, relatively dry fuel (fuel moisture lower than 
+!! the moisture of extinction), and presence of ignition sources.  The flag 
+!! ::disable_fire is used to use this fire module or not. While here in the module the 
+!! ignition source is not explicitely represented. It's assumed 
+!! that the ignition source is always available, i.e., if a sufficient amount 
+!! of dead fuel exists with a moisture content below the moisture of fire 
+!! inhibition, then both live and dead fuel will start to burn.\n
+!!
+!! The module completes the following tasks:
+!! 1. Calculates daily fire index, long term fire index and available ground 
+!! litter for burning.\n
+!! \latexonly
+!! \input{lpj_fire_1.tex}  
+!! \endlatexonly
+!! Where, m is the daily litter moisture, m_e is the moisture of extinction, p(m) 
+!! is probability of fire (i.e. the daily fire index).\n
+!! 
+!! \latexonly
+!! \input{lpj_fire_2.tex}  
+!! \endlatexonly
+!! Where, s is the long term fire index and A(s) is the annual fire fraction.\n
+!! 2. Calculates annual fire fraction, then transform to daily fraction in the 
+!! same time step of stomate.\n
+!! 3. Ground litter and grass live biomass (in growing season and except root and carbon 
+!! reserve pool) are  burned at full fire fraction.\n
+!! 4. Fire fraction for tree PFT are compromised by prescribed fire resistence.
+!! Tree live biomass are consumed using this compromised fire fraction and consumption
+!! fraction for different biomass parts. In the case of activation of dynamic 
+!! vegetation, tree individual density is updated after fire. \n 
+!! 5. For all types of fuel (either ground litter or live biomass) that are 
+!! burned, there is a certain fraction of âresidueâ that are not completely 
+!! burned. The remaining part is transferred to (in case of biomass) or
+!! remains (in case of ground litter) as litter.\n
+!! 6. Update the biomass, litter or dead leaves pool after burning.
+!! 
+!! RECENT CHANGE(S): April 2015: Black carbon calculations is removed. The black carbon was not conserved.
+!!
+!! MAIN OUTPUT VARIABLE(S): ::co2_fire or the carbon emitted into the atmosphere 
+!! by fire, including both living and dead biomass (gC m^{-2} dtslow^{-1})$ @endtex
+!!
+!! REFERENCES    :
+!! - Thonicke K., Venevsky S., Sitch S., and Cramer W. (2001) The role of fire 
+!! disturbance for global vegetation dynamics: coupling fire into a Dynamic 
+!! Global Vegetation Model, Global Ecology & Biogeography, 10, 661-677.
+!! - Kuhlbusch et al. JGR 101, 23651-23665, 1996
+!! - Kuhlbusch & Crutzen, GBC 9, 491-501, 1995
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART     : None
+!! \n 
+!_ ================================================================================================================================
+  
+  SUBROUTINE fire (npts, dt, litterpart, &
+       litterhum_daily, t2m_daily, lignin_struc_above,veget_max, &
+       fireindex, firelitter, biomass, ind, &
+       litter_above, dead_leaves, bm_to_litter, &
+       co2_fire)
+
+  !! 0. Variable and parameter declarations
+
+    !! 0.1 Input variables
+   
+    INTEGER(i_std), INTENT(in)                                   :: npts                !! Domain size - number of pixels 
+                                                                                        !! (unitless)   
+    REAL(r_std), INTENT(in)                                      :: dt                  !! Time step of the simulations for stomate 
+                                                                                        !! (days)   
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)           :: litterpart          !! [DISPENSABLE] Fraction of litter above 
+                                                                                        !! the ground belonging to different PFTs 
+                                                                                        !! ?? this variable is used but might be 
+                                                                                        !! redundant (with value of always 1) ?? 
+                                                                                        !! To check but probably litterpart to be 
+                                                                                        !! removed. Probably a residual from 
+                                                                                        !! nat/agri before merge   
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: litterhum_daily     !! Daily litter moisture (unitless, 0-1)   
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: t2m_daily           !! Daily 2 meter temperature (K)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                 :: lignin_struc_above        !! Ratio Lignin/Carbon in structural above 
+                                                                                        !! and below ground litter 
+                                                                                        !! @tex $(gC gC^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                 :: veget_max           !! Maximum fraction of vegetation type including 
+                                                                                        !! non-biological fraction (0-1, unitless) 
+
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                :: co2_fire            !! Carbon emitted into the atmosphere by 
+                                                                                        !! fire, including both living and dead 
+                                                                                        !! biomass 
+                                                                                        !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    !! 0.3 Modified variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)              :: fireindex           !! Probability of fire; in the code means 
+                                                                                        !! long term fire index (unitless, 0-1)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)              :: firelitter          !! Total natural litter 
+                                                                                        !! available for burning above the ground 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)  :: biomass        !! Biomass @tex $(gC m^{-2})$ @endtex
+    REAl(r_std), DIMENSION(npts,nvm), INTENT(inout)                   :: ind            !! Density of individuals 
+                                                                                        !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements), INTENT(inout) :: litter_above     !! Metabolic and structural litter, above
+                                                                                        !! and below ground 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)        :: dead_leaves         !! Dead leaves on ground, per PFT, 
+                                                                                        !! metabolic and structural 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: bm_to_litter     !! Biomass entering the litter pool 
+                                                                                        !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+   
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                                  :: fire_disturb       !! Actual fire disturbance fraction 
+                                                                                        !! after consideration of inherent fire 
+                                                                                        !! resistance of different PFTs 
+                                                                                        !! (unitless, 0-1)  
+    REAL(r_std), DIMENSION(npts,nvm)                              :: firedeath          !! In case of activation of dynamic 
+                                                                                        !! vegetation, the daily fraction of 
+                                                                                        !! burned individuals (unitless, 0-1)  
+    REAL(r_std), DIMENSION(npts)                                  :: moistlimit         !! Moisture for fire inhibition per PFT                                                                                         !! 
+                                                                                        !! (unitless, 0-1) ; temporary variable 
+                                                                                        !! for each PFT in the loop over #PFT ? 
+                                                                                        !! it's not fire inhibition, it's 
+                                                                                        !! "moisture of extinction" by the original
+                                                                                        !! reference paper, and a more "fire 
+                                                                                        !! professional name" it's better to change
+                                                                                        !! the name of moistlimit 
+    REAL(r_std), DIMENSION(npts)                                  :: litter             !! Total aboveground litter per PFT                                                                                         !! 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                              :: fireindex_daily    !! Daily fire index (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts, nvm)                             :: firefrac           !! Daily fire burning fraction on ground 
+                                                                                        !! (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts)                                  :: struc_residual     !! Fraction of structural litter not burned
+                                                                                        !! (thus residual), depending on strutural 
+                                                                                        !! litter lignin content  (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts)                                  :: residue            !! Fuel (either biomass or litter) not 
+                                                                                        !! burned  @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                                  :: x                  !! Intermediate variable
+    REAL(r_std), DIMENSION(npts)                                  :: aff                !! Annual fire fraction (unitless, 0-1) 
+    INTEGER(i_std)                                                :: j,k,m,l            !! Indeces
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering fire'
+
+ !! 1. Initialization
+
+    IF ( firstcall_fire ) THEN
+
+       !! 1.1 Fraction to CO_2
+       !      What fraction of the plant biomass compartment, if burned, is transformed 
+       !      into CO_2 released to the atmosphere?
+       !??! the fraction for heartabove seems too big, it's not clear if this value is correct. 
+
+       !! 1.2 print control messages
+       WRITE(numout,*) 'fire:'
+
+       WRITE(numout,*) '   > temporal inertia of fire probability (d): ',tau_fire
+
+       WRITE(numout,*) '   > fraction of burned biomass that becomes CO2:'
+       WRITE(numout,*) '     leaves: ', co2frac(ileaf)
+       WRITE(numout,*) '     sap above ground: ', co2frac(isapabove)
+       WRITE(numout,*) '     sap below ground: ', co2frac(isapbelow)
+       WRITE(numout,*) '     heartwood above ground: ', co2frac(iheartabove)
+       WRITE(numout,*) '     heartwood below ground: ', co2frac(iheartbelow)
+       WRITE(numout,*) '     roots: ', co2frac(iroot)
+       WRITE(numout,*) '     fruits: ', co2frac(ifruit)
+       WRITE(numout,*) '     carbohydrate reserve: ', co2frac(icarbres)
+
+       WRITE(numout,*) '   > critical litter quantity (gC/m**2): ',litter_crit
+       WRITE(numout,*) '   > We calculate a fire probability on agricultural ground, but'
+       WRITE(numout,*) '       the effective fire fraction is zero.'
+
+       firstcall_fire = .FALSE.
+
+    ENDIF
+
+    !! 1.4 Initialize output
+    co2_fire(:,:) = zero
+    firedeath(:,:) = zero
+    fireindex_daily(:,:) = zero
+    firefrac(:,:) = zero
+
+ !! 2. Determine fire probability
+ 
+    ! Calculate probability that crops are not burned for the moment
+    ! Calculate long-term aboveground litter
+ 
+    ! a long loop over PFT
+    DO j = 2,nvm !loop over #PFT
+
+       !! 2.1 Total above ground litter
+       !      Total litter above the ground for the PFT under consideration
+       litter(:) = litter_above(:,imetabolic,j,icarbon) + &
+            litter_above(:,istructural,j,icarbon)
+
+       !! 2.2 Calculate the PFT litter amount weighted by moisture 
+       ! If litter moisture is higher than moisture of extinction, fire is not possible.
+       moistlimit(:) = zero
+       WHERE ( (t2m_daily(:) .GT. ZeroCelsius) .AND. (litter(:) .GT. min_stomate) )
+       !?? the calculation here is redundant? as the part before flam(j) is 1?
+       !?? see first comment.. litterpart to be removed ?
+          moistlimit(:) = moistlimit(:) + &
+               ( litterpart(:,j,imetabolic)*litter_above(:,imetabolic,j,icarbon) + &
+               litterpart(:,j,istructural)*litter_above(:,istructural,j,icarbon)  ) / &
+               litter(:) * flam(j)
+
+       ENDWHERE
+       !! 2.3 Calculate daily fire index 
+       !      Calculate daily fire index
+       !      \latexonly
+       !        \input{lpj_fire_1.tex}  
+       !      \endlatexonly
+       !      Where, m is the daily litter moisture, m_e is the moisture of extinction, p(m) 
+       !      is probability of fire (i.e. the daily fire index).\n
+       WHERE ( moistlimit(:) .GT. min_stomate )
+          x(:) = litterhum_daily(:)/moistlimit(:)
+          fireindex_daily(:,j) = EXP( - pi * x(:) * x(:) )
+       ELSEWHERE
+          fireindex_daily(:,j) = zero
+       ENDWHERE
+
+       !! 2.4 Calculate long-term fire index 
+       !      Calculate long-term fire index which is the mean probability of fire
+       fireindex(:,j) = ((tau_fire - dt) * fireindex(:,j) + (dt) * fireindex_daily(:,j)) / tau_fire
+
+       !! 2.5 Calculate long term aboveground litter that are available for burning
+       firelitter(:,j) = &
+            ( ( tau_fire-dt ) * firelitter(:,j) + dt * litter(:) ) / tau_fire
+
+  !! 3. Calculate fire fraction from litter and fireindex
+
+       !! 3.1 Fire fraction from long term fire index for natural PFTs
+       !  Transform the annual fire fraction to daily fraction. This is done by assuming that
+       !  each day the fire fraction is the same. 
+       aff(:) = firefrac_func (npts, fireindex(:,j))
+
+       ! annual_fire_fraction = 1. - ( 1. - daily_fire_fraction )**365
+       ! Thus, daily_fire_fraction = 1. - ( 1. - annual_fire_fraction )**(1/365)
+       ! If annual firefrac<<1, then firefrac_daily = firefrac * dt/one_year
+       ! This approximation avoids numerical problems.
+       ! the variable 'un' is 1
+       IF(.NOT.disable_fire.AND.natural(j))THEN
+          WHERE ( aff(:) .GT. 0.1 )
+             firefrac(:,j) = un - ( un - aff(:) ) ** (dt/one_year)
+          ELSEWHERE
+             firefrac(:,j) = aff(:) * dt/one_year
+          ENDWHERE
+       ELSE
+          firefrac(:,j) = zero
+       ENDIF
+
+       ! No fire if litter is below critical value
+       WHERE ( firelitter(:,j) .LT. litter_crit )
+          firefrac(:,j) = zero
+       ENDWHERE
+
+       ! However, there is a minimum fire extent
+       firefrac(:,j) = MAX( 0.001_r_std * dt/one_year, firefrac(:,j) )
+
+       ! if FIRE_DISABLE flag is set no fire
+       IF (disable_fire) firefrac = zero
+       
+       !! 3.2 For agricultural ground, no fire is burned for the moment
+       IF ( .NOT. natural(j)) firefrac(:,j) = zero
+       
+  !! 4. Determine fire impact
+
+       ! Calculate fire disturbance fraction for each PFT, and fire emissions due 
+       ! to grasses.
+   
+       !! 4.1 Tree and grass live biomass 
+       ! Tree live biomass is not burned in fire. 
+       ! However, in the dynamic vegetation module, tree individual density 
+       ! will be updated after fire. The fraction of tree individuals that are 
+       ! supposed to die in fire is the fire fraction multiplied by the tree PFT fire 
+       ! resistance which reflect survivorship of different tree PFTs during fire.  
+       IF ( is_tree(j) ) THEN
+
+          !! 4.1.1 Disturban,ce factor for trees 
+          !        Trees are disturbed over the whole year. A resistance factor is  
+          !        used to reflect survivorship of different tree PFTs during fire. 
+          fire_disturb(:) = ( un - resist(j) ) * firefrac(:,j)
+
+       ELSE
+
+          !! 4.1.2 Disturbance factor for grasses 
+          !        Grass is not disturbed outside the growing season thus grass biomass 
+          !        is only burned during the growing season.
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+             fire_disturb(:) = ( un - resist(j) ) * firefrac(:,j)
+
+          ELSEWHERE
+
+             fire_disturb(:) = zero
+
+          ENDWHERE
+
+       ENDIF
+
+       !! 4.2 Burn live biomass
+       !      The burned part goes to either the atmposhere or litter
+       DO k = 1, nparts
+
+          ! for tree PFT, all biomass compartments are burned.
+          ! for grass biomass compartments, all are burned except root and carbon reserve
+          ! IF concerning PFT is tree; OR (the PFT is grass, but not root or carbon reserve biomass); then it's burned.
+          IF ( .NOT. ( ( .NOT. is_tree(j) ) .AND. ( ( k.EQ.iroot ) .OR. ( k.EQ.icarbres ) ) ) ) THEN
+
+             !! 4.2.1 Fraction to the atmosphere.
+             co2_fire(:,j) =  co2_fire(:,j)+ biomass(:,j,k,icarbon) * fire_disturb(:) * co2frac(k) / dt
+
+             !! 4.2.2 Determine the residue
+             !        Residual is expressed in gC/m^2
+             residue(:) = biomass(:,j,k,icarbon) * fire_disturb(:) * ( un - co2frac(k) )
+
+             !! 4.2.2.3 The rest (largest part) of the residue becomes litter.
+             bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) + residue(:)
+          ENDIF
+
+       ENDDO
+
+      
+       !! 4.3 Update biomass pool after burning
+       
+       !! 4.3.1 Decrease biomass amount except for grass roots and carbon reserve.
+     !  DO m = 1, nelements ! Loop over # elements
+          
+          DO k = 1, nparts
+
+             ! **2
+             IF ( .NOT. ( ( .NOT. is_tree(j) ) .AND. ( ( k.EQ.iroot ) .OR. ( k.EQ.icarbres) ) ) ) THEN
+                
+                biomass(:,j,k,icarbon) = ( un - fire_disturb(:) ) * biomass(:,j,k,icarbon)
+		biomass(:,j,k,icarbon14) = biomass(:,j,k,icarbon)
+                
+             ENDIF
+
+          ENDDO
+          
+     !  END DO ! End Loop over # elements
+
+
+       !! 4.3.2 If vegetation is dynamic, then decrease the density of tree individuals.
+       IF ( (ok_dgvm .OR. .NOT.lpj_gap_const_mort) .AND. is_tree(j) ) THEN
+
+          firedeath(:,j) = fire_disturb(:) / dt
+
+          ind(:,j) = ( un - fire_disturb(:) ) * ind(:,j)
+
+       ENDIF
+
+    ENDDO      ! loop over #PFT
+
+  !! 5. Burn litter
+
+    !   All litter (either forest or grass) is burned throughout the whole year
+    !   Metabolic litter is totally burned. Burning fraction of structural litter is related 
+    !   with its lignin content. The burned part either goes to the atmosphere
+    !   or remains in litter as unburned residue.
+    DO j = 2,nvm  !loop over #PFT
+
+       !! 5.1 Burn exposed metabolic litter
+       !      Exposed metabolic litter burns completely and goes directly into the atmosphere as CO2.
+
+       !! 5.1.1 CO2 flux from litter burning
+       !        Flux expressed in gC m^{-2}dtslow^{-1}
+       co2_fire(:,j) = co2_fire(:,j) + litter_above(:,imetabolic,j,icarbon) * &
+            firefrac(:,j) / dt
+       !! 5.1.2 Decrease metabolic litter
+       !  DO m = 1,nelements
+            litter_above(:,imetabolic,j,icarbon) = litter_above(:,imetabolic,j,icarbon) * &
+                 ( un - firefrac(:,j) )
+
+	    litter_above(:,imetabolic,j,icarbon14) = ratio * litter_above(:,imetabolic,j,icarbon)
+        ! ENDDO
+       !! 5.2 Burning exposed structural litter 
+       !      The fraction that goes to the atmosphere is related to its lignin content. The remaining unburned 
+       !      residues remain as litter.
+
+       !! 5.2.1 Incomplete burning of exposed structural litter  
+       !        Fraction of structural litter that does not burn completly. This fraction depends on lignin 
+       !        content (lignin_struc).
+       struc_residual(:) = fire_resist_struct * lignin_struc_above(:,j) 
+
+       !! 5.2.2 CO2 flux from litter burning 
+       !  Flux expressed in gC m^{-2}dtslow^{-1}
+       co2_fire(:,j) = co2_fire(:,j) + &
+            litter_above(:,istructural,j,icarbon) * firefrac(:,j) * &
+            ( un - struc_residual(:) )/ dt
+       !! 5.2.3 Determine residue 
+       !        The residue is litter that undergoes fire, but is not transformed into CO2
+       residue(:) = litter_above(:,istructural,j,icarbon) * firefrac(:,j) * &
+            struc_residual(:)
+
+       !! 5.2.6 TResidue remaining litter
+       !        The rest (largest part) of the residue remains litter. Remaining 
+       !        litter is the sum of this and of the litter which has not undergone a fire.
+       WHERE (veget_max(:,j) .GT. min_stomate)
+       litter_above(:,istructural,j,icarbon) = &
+            litter_above(:,istructural,j,icarbon) * ( un - firefrac(:,j) ) + &
+            residue(:)
+
+       litter_above(:,istructural,j,icarbon14) = &
+           ratio * litter_above(:,istructural,j,icarbon) 
+
+       ENDWHERE
+
+    ENDDO  !  loop over #PFT
+!WRITE (numout,*) "litter_above_#2_fire_PFT6=",litter_above(:,:,6,:)
+!WRITE (numout,*) "litter_above_#2_fire_PFT10=",litter_above(:,:,10,:)
+   
+   !! 5.3 Update exposed dead leaves (leaf litter) on the ground
+   !      Dead leaves are supposed to burn completely in fire even their structural part.
+    DO j = 2,nvm
+
+       DO k = 1, nlitt
+          dead_leaves(:,j,k) = dead_leaves(:,j,k) * ( un - firefrac(:,j) )
+       ENDDO
+
+    ENDDO
+
+  !! 6. write out history variables
+
+    ! output in 1/dtslow
+    firefrac(:,:) = firefrac(:,:) / dt
+
+    CALL xios_orchidee_send_field("FIREFRAC",firefrac(:,:))
+    CALL xios_orchidee_send_field("FIREDEATH",firedeath(:,:))
+
+    CALL histwrite_p (hist_id_stomate, 'FIREFRAC', itime, &
+         firefrac(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FIREDEATH', itime, &
+         firedeath(:,:), npts*nvm, horipft_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving fire'
+
+  END SUBROUTINE fire
+
+
+!! ================================================================================================================================
+!! FUNCTION     : firefrac_func
+!!
+!>\BRIEF        Calculate the annual fire fraction using long term fire index
+!! 
+!! DESCRIPTION	: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : annual fire fraction (::firefrac_result)
+!!
+!! REFERENCES   :
+!! - Thonicke K., Venevsky S., Sitch S., and Cramer W. (2001) The role of fire 
+!! disturbance for global vegetation dynamics: coupling fire into a Dynamic 
+!! Global Vegetation Model, Global Ecology & Biogeography, 10, 661-677.\n
+!!
+!! FLOWCHART    : None
+!! \n 
+!_ ================================================================================================================================
+   
+  FUNCTION firefrac_func (npts, x) RESULT (firefrac_result)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                 :: npts             !! Domain size (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)   :: x                !! fire index (unitless, 0-1)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts)               :: firefrac_result  !! fire fraction (unitless, 0-1)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts)               :: xm1              !! intermediate variable
+!_ ================================================================================================================================
+
+!! 1. Function
+
+    xm1(:) = x(:) - 1.
+
+    ! this equation is from Thonicke et al. (2001) equation (9), it use the fire index as input to calculate annual fire fraction.
+    ! but with different parameters with the source literature.
+    !! \latexonly
+    !! \input{lpj_fire_2.tex}  
+    !! \endlatexonly
+    !! Where, s is the long term fire index and A(s) is the annual fire fraction.\n
+    !??! here we use a different parameter with K. Thonicke et al. (2001)
+    !??! it's not clear if these parameters are correct.
+    firefrac_result(:) = &
+         &     x(:) * EXP( xm1(:) / ( -firefrac_coeff(4)*xm1(:)*xm1(:)*xm1(:) + &
+         &     firefrac_coeff(3)*xm1(:)*xm1(:) + &
+         &     firefrac_coeff(2)*xm1(:) +  &      
+         &     firefrac_coeff(1) ) )
+
+  END FUNCTION firefrac_func
+
+END MODULE lpj_fire
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_gap.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_gap.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_gap.f90	(revision 5166)
@@ -0,0 +1,349 @@
+! =================================================================================================================================
+! MODULE       : lpj_gap
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Simulate mortality of individuals and update biomass, litter and 
+!! stand density of the PFT
+!!
+!!\n DESCRIPTION : Simulate mortality of individuals and update biomass, litter and 
+!! stand density of the PFT. This module differs from lpj_kill.f90 in that this 
+!! module kills individuals within a PFT and lpj_kill.f90 removes a PFT from a 
+!! gridbox
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) : 
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!         plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!         global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Waring, R. H. (1983). "Estimating forest growth and efficiency in relation 
+!!         to canopy leaf area." Advances in Ecological Research 13: 327-354.\n
+!! 
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_gap
+
+  ! modules used:
+  USE xios_orchidee
+  USE stomate_data
+  USE pft_parameters
+  USE ioipsl_para 
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC gap,gap_clear
+  
+  ! Variable declaration 
+
+  LOGICAL, SAVE             :: firstcall_gap = .TRUE.                  !! first call flag
+!$OMP THREADPRIVATE(firstcall_gap)
+  REAL(r_std), PARAMETER    :: frost_damage_limit = -3 + ZeroCelsius   !! Spring frost-damage limitation (K)
+  REAL(r_std), PARAMETER    :: coldness_mort = 0.04                    !! Daily mortality induced by extreme coldness in winter
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gap_clear
+!!
+!>\BRIEF        Set the firstcall_gap flag back to .TRUE. to prepare for the next simulation.
+!_ ================================================================================================================================
+  
+  SUBROUTINE gap_clear
+    firstcall_gap = .TRUE.
+  END SUBROUTINE gap_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gap
+!!
+!>\BRIEF        Simulate tree and grass mortality, transfer dead biomass to litter and update stand density
+!!
+!! DESCRIPTION  : Calculate mortality of trees and grasses, transfer the dead biomass to litter pool,
+!! and update biomass pool and number of individuals. To get tree mortality, it's possible to choose either a 
+!! constant mortality rate; or to calculate the tree mortality rate based on it's growth efficiency, which is 
+!! defined as this year's net biomass increment per leaf area.\n
+!!
+!! When using growth efficiency mortality, first calculate the net biomass increment for the last year, then 
+!! calculate the growth efficiency and finally calculate the growth efficiency mortality.\n
+!!
+!! Eqation to calculate growth efficiency:
+!! \latexonly 
+!!     \input{gap1.tex}
+!! \endlatexonly
+!! Where $greff$ is growth efficiency, $\Delta$ is net biomass increment, 
+!! $C_{leaf} is last year's leaf biomass, and $SLA$ the specific leaf area. 
+!! 
+!!
+!! Eqation to calculate growth efficiency mortality:
+!! \latexonly 
+!!     \input{gap2.tex}
+!! \endlatexonly
+!! Where $mort_{greff}$ is the growth efficiency mortality, $greff$ is growth  
+!! efficiency, $k_{mort1}$ is asymptotic maximum mortality rate.
+!! 
+!! The name for variable ::availability is not well chosen. Actually the meaning of the variable is mortailty 
+!! rate derived from growth efficiency related mortality. ?? Suggestion: change the name "availability" to 
+!! "mortgref", which means "mortality caused by ".\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::biomass; biomass, ::ind density of individuals, ::bm_to_litter biomass transfer 
+!! to litter and ::mortality mortality (fraction of trees that is dying per time step)
+!!
+!! REFERENCE(S)   :
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!         plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!         global vegetation model, Global Change Biology, 9, 161-185.
+!! - Waring, R. H. (1983). "Estimating forest growth and efficiency in relation 
+!!         to canopy leaf area." Advances in Ecological Research 13: 327-354.
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+  
+  SUBROUTINE gap (npts, dt, &
+       npp_longterm, turnover_longterm, lm_lastyearmax, &
+       PFTpresent, t2m_min_daily, Tmin_spring_time, &
+       biomass, ind, bm_to_litter, mortality )
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                              :: npts                    !! Domain size (-)
+    REAL(r_std), INTENT(in)                                 :: dt                      !! Time step (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: npp_longterm            !! "Long term" (default 3-year) net primary
+                                                                                       !! productivity  
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover_longterm       !! "Long term" (default 3-year) turnover  
+                                                                                       !! rate @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: lm_lastyearmax          !! Last year's maximum leaf mass, for each 
+                                                                                       !! PFT @tex $(gC m^{-2})$ @endtex
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                :: PFTpresent              !! Is the pft present in the pixel
+    REAL(r_std), DIMENSION(npts), INTENT(in)                :: t2m_min_daily           !! Daily minimum 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: Tmin_spring_time        !! Number of days after begin_leaves (leaf onset) 
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(out)            :: mortality               !! Mortality (fraction of trees that is 
+                                                                                       !! dying per time step)
+
+    !! 0.3 Modified variables   
+    
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)  :: biomass       !! Biomass @tex $(gC m^{-2}) $@endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                   :: ind           !! Number of individuals 
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)  :: bm_to_litter  !! Biomass transfer to litter 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex  
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                            :: delta_biomass           !! Net biomass increase for the previous 
+                                                                                       !! year @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts)                            :: dmortality              !! Dead biomass caused by mortality 
+                                                                                       !! @tex $(gC m^{-2}) $@endtex
+    REAL(r_std), DIMENSION(npts)                            :: vigour                  !! Growth efficiency, an indicator of tree 
+                                                                                       !! vitality, used to calculate mortality
+    REAL(r_std), DIMENSION(npts)                            :: availability            !! Mortality rate derived by growth 
+                                                                                       !! efficiency @tex $(year^{-1})$ @endtex 
+    INTEGER(i_std)                                          :: i, j,k,m                !! Indices
+
+!_ ================================================================================================================================
+
+    IF ( firstcall_gap ) THEN
+
+       firstcall_gap = .FALSE.
+
+    ENDIF
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering gap',lpj_gap_const_mort
+
+    mortality(:,:) = zero
+
+    ! loop over #PFT
+    DO j = 2,nvm
+
+ !! 1. Tree mortality
+
+       IF ( is_tree(j) ) THEN 
+
+          !! 1.1 Use growth efficiency or constant mortality?
+          IF ( .NOT.  lpj_gap_const_mort  ) THEN
+
+             !! 1.1.1 Estimate net biomass increment
+             !        To calculate growth efficiency mortality, first estimate net biomass increment by 
+             !        subtracting turnover from last year's NPP.
+             WHERE ( PFTpresent(:,j) .AND. ( lm_lastyearmax(:,j) .GT. min_stomate ) )
+
+            !??! the following should be removed
+            ! note that npp_longterm is now actually longterm growth efficiency (NPP/LAI)
+            ! to be fair to deciduous trees
+            ! calculate net biomass increment
+             delta_biomass(:) = MAX( npp_longterm(:,j) - ( turnover_longterm(:,j,ileaf,icarbon) + &
+                  turnover_longterm(:,j,iroot,icarbon) + turnover_longterm(:,j,ifruit,icarbon) + & 
+                  turnover_longterm(:,j,isapabove,icarbon) + turnover_longterm(:,j,isapbelow,icarbon) ) ,zero)
+
+            !! 1.1.2 Calculate growth efficiency 
+            !        Calculate growth efficiency by dividing net biomass increment by last year's 
+            !        maximum LAI. (corresponding actually to the maximum LAI of the previous year)
+             vigour(:) = delta_biomass(:) / (lm_lastyearmax(:,j)*sla(j))
+
+             ELSEWHERE
+
+                vigour(:) = zero
+
+             ENDWHERE
+
+             !! 1.1.3 Calculate growth efficiency mortality rate
+             WHERE ( PFTpresent(:,j) )
+                
+                availability(:) = availability_fact(j) / ( un + ref_greff * vigour(:) )
+                ! Scale mortality by timesteps per year
+                mortality(:,j) = MAX(min_avail,availability(:))  * dt/one_year  
+
+             ENDWHERE
+
+          ELSE  ! .NOT. lpj_gap_const_mort
+
+             !! 1.2 Use constant mortality accounting for the residence time of each tree PFT
+             WHERE ( PFTpresent(:,j) )
+
+                mortality(:,j) = dt/(residence_time(j)*one_year)
+
+             ENDWHERE
+
+          ENDIF ! .NOT.  lpj_gap_const_mort
+
+          !! 1.3 Mortality in DGVM
+          !      If the long term NPP is zero, all trees are killed
+          !??! This is this only applied in the DGVM maybe in order to make the DGVM respond faster and thus make the vegetation dynamics more dynamic?
+          !??! the link here with lpj_kill.f90 is still not clear and so would leave to who especially working on this. 
+          IF ( ok_dgvm ) THEN
+
+             WHERE ( PFTpresent(:,j) .AND. ( npp_longterm(:,j) .LE. min_stomate ) )
+
+                mortality(:,j) = un
+
+             ENDWHERE
+
+          ENDIF
+
+          IF ( ok_dgvm .AND. (tmin_crit(j) .NE. undef) ) THEN
+             ! frost-sensitive PFTs
+             WHERE ( t2m_min_daily(:) .LT. tmin_crit(j) )
+                mortality(:,j) = MIN(un,(coldness_mort*(tmin_crit(j)-t2m_min_daily(:))+mortality(:,j) ) )
+             ENDWHERE
+          ENDIF
+
+          IF ( ok_dgvm .AND. leaf_tab(j)==1 .AND. pheno_type(j)==2) THEN
+             ! Treat the spring frost for broadleaf and summergreen vegetations
+             ! leaf_tab=broadleaf and pheno_typ=summergreen
+             DO i=1,npts
+                IF ( (Tmin_spring_time(i,j)>0) .AND. (Tmin_spring_time(i,j)<spring_days_max+1) ) THEN
+                   IF ( t2m_min_daily(i) .LT. frost_damage_limit ) THEN
+                      mortality(i,j) = MIN(un,(0.01*(frost_damage_limit-t2m_min_daily(i))* &
+                           Tmin_spring_time(i,j)/spring_days_max+mortality(i,j) ) )
+                   END IF
+                END IF
+             END DO
+          END IF
+       
+
+          !! 1.4 Update biomass and litter pools 
+          !    Update biomass and litter pool after dying and transfer recently died biomass to litter
+          
+          !DO m = 1,nelements
+             DO k = 1, nparts
+                
+                WHERE ( PFTpresent(:,j) )
+                   
+                   dmortality(:) =  mortality(:,j) * biomass(:,j,k,icarbon)
+                   bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) + dmortality(:)
+                   biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) - dmortality(:)
+		   bm_to_litter(:,j,k,icarbon14) = bm_to_litter(:,j,k,icarbon) 
+                   biomass(:,j,k,icarbon14) = biomass(:,j,k,icarbon) 
+
+                ENDWHERE
+
+             ENDDO
+          !END DO
+
+          !! 1.5 In case of dynamic vegetation, update tree individual density
+          IF ( ok_dgvm ) THEN
+
+             WHERE ( PFTpresent(:,j) )
+
+                ind(:,j) = ind(:,j) * ( un - mortality(:,j) )
+
+             ENDWHERE
+
+          ENDIF
+       ELSE 
+
+ !! 2. Grasses mortality
+
+          ! For grasses, if last year's NPP is very small (less than 10 gCm^{-2}year{-1})
+          ! the grasses completely die
+          IF ( .NOT.ok_dgvm .AND. .NOT.lpj_gap_const_mort) THEN
+
+             WHERE ( PFTpresent(:,j) .AND. ( npp_longterm(:,j) .LE. npp_longterm_init ) )
+
+                mortality(:,j) = un
+
+             ENDWHERE
+
+             ! Update biomass and litter pools
+             !DO m = 1,nelements
+                DO k = 1, nparts
+
+                   WHERE ( PFTpresent(:,j) )
+                      
+                      dmortality(:) =  mortality(:,j) * biomass(:,j,k,icarbon)
+                      
+                      bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) + dmortality(:)
+                      
+                      biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) - dmortality(:)
+		      
+		      bm_to_litter(:,j,k,icarbon14) = bm_to_litter(:,j,k,icarbon) 
+                      
+                      biomass(:,j,k,icarbon14) = biomass(:,j,k,icarbon) 
+                      
+                   ENDWHERE
+
+                ENDDO
+             !END DO
+             
+          ENDIF
+
+       ENDIF   !IF ( is_tree(j) )
+
+    ENDDO      !loop over pfts
+
+ !! 3. Write to history files
+
+    ! output in fraction of trees that dies/day.
+    mortality(:,:) = mortality(:,:) / dt
+
+    CALL xios_orchidee_send_field("MORTALITY",mortality)
+
+    CALL histwrite_p (hist_id_stomate, 'MORTALITY', itime, &
+         mortality, npts*nvm, horipft_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving gap'
+
+  END SUBROUTINE gap
+
+END MODULE lpj_gap
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_kill.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_kill.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_kill.f90	(revision 5166)
@@ -0,0 +1,282 @@
+! =================================================================================================================================
+! MODULE       : lpj_kill
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Kills natural PFTs with low biomass and low number of individuals. 
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE lpj_kill
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC kill
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE  : kill
+!!
+!>\BRIEF       Kills natural pfts that have low biomass or low number of individuals, 
+!! returns biomass to litter pools,  and resets biomass to zero.  
+!!
+!! DESCRIPTION : Kills natural PFTS. The PFT vegetation characteristics are
+!! reinitialized. Kill is either done in DGVM mode or in non-DGVM mode
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): senescence, PFTpresent, cn_ind, ind, RIP_time, age, when_growthinit, 
+!! everywhere,beget, veget_max, npp_longterm, biomass, bm_to_litter, leaf_age, leaf_frac
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE kill (npts, whichroutine, lm_lastyearmax, &
+       ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+       lai, age, leaf_age, leaf_frac, npp_longterm, &
+       when_growthinit, everywhere, veget_max, bm_to_litter)
+
+ !! 0. Variable and parameter description
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size (unitless)
+    CHARACTER(LEN=10), INTENT(in)                             :: whichroutine    !! Message (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lai             !! [DISPENSABLE] leaf area index OF AN INDIVIDUAL PLANT 
+                                                                                 !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lm_lastyearmax  !! Last year's maximum leaf mass, for each PFT 
+                                                                                 !! @tex $(gC.m^{-2})$ @endtex
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: senescence      !! Is the plant senescent? (only for deciduous 
+                                                                                 !! trees - carbohydrate reserve) (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent      !! Is pft there (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: cn_ind          !! Crown area of individuals 
+                                                                                 !! @tex $(m^2)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! Number of individuals 
+                                                                                 !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: RIP_time        !! How much time ago was the PFT eliminated for
+                                                                                 !! the last time (y)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age             !! Mean age (years)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit !! How many days ago was the beginning of the 
+                                                                                 !! growing season (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! Is the PFT everywhere in the grid box or very
+                                                                                 !! localized (after its introduction)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget_max       !! "Maximal" coverage fraction of a PFT (LAI -> 
+                                                                                 !! infinity) on ground (unitless;0-1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm    !! "Long term" (default = 3-year) net primary 
+                                                                                 !! productivity 
+                                                                                 !! @tex $(gC.m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age        !! Leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! Fraction of leaves in leaf age class 
+                                                                                 !! (unitless;0-1)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass       !! Biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter  !! Conversion of biomass to litter 
+                                                                                      !! @tex $(gC.m^{-2} day^{-1})$ @endtex
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                            :: j,m             !! Indices       (unitless)
+    LOGICAL, DIMENSION(npts)                                  :: was_killed      !! Bookkeeping   (true/false)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering kill'
+
+ !! 1. Kill PFTs
+
+    ! Kill plants if number of individuals or last year's leaf mass is close to zero.
+    ! the "was_killed" business is necessary for a more efficient code on the VPP processor
+    DO j = 2,nvm ! loop plant functional types
+
+       was_killed(:) = .FALSE.
+
+       IF ( natural(j) ) THEN
+
+          !! 1.1 Kill natural PFTs when DGVM is activated
+          IF ( ok_dgvm ) THEN
+             WHERE ( PFTpresent(:,j) .AND. &
+                  ( ( ind(:,j) .LT. min_stomate ) .OR. &
+                  ( lm_lastyearmax(:,j) .LT. min_stomate ) ) )
+             
+                was_killed(:) = .TRUE.
+             
+             ENDWHERE
+          
+          ELSE
+
+             !! 1.2 Kill natural PFTs when running STOMATE without DGVM
+
+             !! 1.2.1 Kill PFTs
+             WHERE ( PFTpresent(:,j) .AND. & 
+                  (biomass(:,j,icarbres,icarbon) .LE.zero .OR. & 
+                  biomass(:,j,iroot,icarbon).LT.-min_stomate .OR. biomass(:,j,ileaf,icarbon).LT.-min_stomate ).AND. & 
+                  ind(:,j).GT. zero)
+
+                was_killed(:) = .TRUE.
+
+             ENDWHERE
+
+             !! 1.2.2 Overwrite long-term NPP for grasses
+             IF(.NOT.is_tree(j).AND..NOT.lpj_gap_const_mort)THEN
+                WHERE ( was_killed(:) )
+
+                   npp_longterm(:,j) = 500.
+
+                ENDWHERE
+             ENDIF
+
+          ENDIF ! ok_dgvm
+
+          !! 1.3 Bookkeeping for PFTs that were killed
+          !      For PFTs that were killed, return biomass pools to litter 
+          !      and update biomass pools to zero
+          IF ( ANY( was_killed(:) ) ) THEN
+          
+            ! DO m = 1,nelements
+
+                WHERE ( was_killed(:) )
+
+                   bm_to_litter(:,j,ileaf,icarbon) = bm_to_litter(:,j,ileaf,icarbon) + biomass(:,j,ileaf,icarbon)
+                   bm_to_litter(:,j,isapabove,icarbon) = bm_to_litter(:,j,isapabove,icarbon) + biomass(:,j,isapabove,icarbon)
+                   bm_to_litter(:,j,isapbelow,icarbon) = bm_to_litter(:,j,isapbelow,icarbon) + biomass(:,j,isapbelow,icarbon)
+                   bm_to_litter(:,j,iheartabove,icarbon) = bm_to_litter(:,j,iheartabove,icarbon) + &
+                                                     biomass(:,j,iheartabove,icarbon)
+                   bm_to_litter(:,j,iheartbelow,icarbon) = bm_to_litter(:,j,iheartbelow,icarbon) + &
+                                                     biomass(:,j,iheartbelow,icarbon)
+                   bm_to_litter(:,j,iroot,icarbon) = bm_to_litter(:,j,iroot,icarbon) + biomass(:,j,iroot,icarbon)
+                   bm_to_litter(:,j,ifruit,icarbon) = bm_to_litter(:,j,ifruit,icarbon) + biomass(:,j,ifruit,icarbon)
+                   bm_to_litter(:,j,icarbres,icarbon) = bm_to_litter(:,j,icarbres,icarbon) + biomass(:,j,icarbres,icarbon)
+                   
+                   bm_to_litter(:,j,ileaf,icarbon14) = bm_to_litter(:,j,ileaf,icarbon) 
+                   bm_to_litter(:,j,isapabove,icarbon14) = bm_to_litter(:,j,isapabove,icarbon) 
+                   bm_to_litter(:,j,isapbelow,icarbon14) = bm_to_litter(:,j,isapbelow,icarbon) 
+                   bm_to_litter(:,j,iheartabove,icarbon14) = bm_to_litter(:,j,iheartabove,icarbon) 
+                   bm_to_litter(:,j,iheartbelow,icarbon14) = bm_to_litter(:,j,iheartbelow,icarbon) 
+                   bm_to_litter(:,j,iroot,icarbon14) = bm_to_litter(:,j,iroot,icarbon) 
+                   bm_to_litter(:,j,ifruit,icarbon14) = bm_to_litter(:,j,ifruit,icarbon) 
+                   bm_to_litter(:,j,icarbres,icarbon14) = bm_to_litter(:,j,icarbres,icarbon)
+
+                   biomass(:,j,ileaf,icarbon) = zero
+                   biomass(:,j,isapabove,icarbon) = zero
+                   biomass(:,j,isapbelow,icarbon) = zero
+                   biomass(:,j,iheartabove,icarbon) = zero
+                   biomass(:,j,iheartbelow,icarbon) = zero
+                   biomass(:,j,iroot,icarbon) = zero
+                   biomass(:,j,ifruit,icarbon) = zero
+                   biomass(:,j,icarbres,icarbon) = zero
+
+		   biomass(:,j,ileaf,icarbon14) = zero
+                   biomass(:,j,isapabove,icarbon14) = zero
+                   biomass(:,j,isapbelow,icarbon14) = zero
+                   biomass(:,j,iheartabove,icarbon14) = zero
+                   biomass(:,j,iheartbelow,icarbon14) = zero
+                   biomass(:,j,iroot,icarbon14) = zero
+                   biomass(:,j,ifruit,icarbon14) = zero
+                   biomass(:,j,icarbres,icarbon14) = zero
+
+                ENDWHERE   ! was_killed
+
+            ! END DO
+
+            !! 1.4 Update veget_max in DGVM
+            !      Update veget_max in DGVM for killed PFTs and reset RIP_time
+            IF (ok_dgvm) THEN
+
+                WHERE ( was_killed(:) )
+                   PFTpresent(:,j) = .FALSE.
+
+                   veget_max(:,j) = zero
+                   
+                   RIP_time(:,j) = zero
+
+                ENDWHERE  ! was_killed
+
+            ENDIF ! ok_dgvm
+
+            !! 1.5 Reinitialize vegetation characteristics in DGVM and STOMATE
+            !      Reinitialize number of individuals, crown area and age
+            WHERE ( was_killed(:) )
+
+                ind(:,j) = zero
+
+                cn_ind(:,j) = zero
+
+                senescence(:,j) = .FALSE.
+
+                age(:,j) = zero
+
+                when_growthinit(:,j) = large_value 
+
+                everywhere(:,j) = zero
+
+!                veget(:,j) = zero
+!MM Ã  imposer ?!
+!                lai(:,j) = zero
+
+             ENDWHERE   ! was_killed
+
+             !! 1.6 Update leaf ages
+             DO m = 1, nleafages
+
+                WHERE ( was_killed(:) )
+
+                   leaf_age(:,j,m) = zero 
+                   leaf_frac(:,j,m) = zero 
+
+                ENDWHERE ! was_killed
+
+             ENDDO
+
+             !! 1.7 Print sub routine messages
+             IF ( printlev>=2 ) THEN
+
+                WRITE(numout,*) 'kill: eliminated ',PFT_name(j)
+                WRITE(numout,*) '  at ',COUNT( was_killed(:) ),' points after '//whichroutine
+
+             ENDIF
+
+          ENDIF     ! PFT must be killed at at least one place
+
+       ENDIF       ! PFT is natural
+
+    ENDDO         ! loop over PFTs
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving kill'
+
+  END SUBROUTINE kill
+
+END MODULE lpj_kill
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_light.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_light.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_light.f90	(revision 5166)
@@ -0,0 +1,641 @@
+! =================================================================================================================================
+! MODULE       : lpj_light
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Light competition within a PFT
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_light
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE constantes
+  USE stomate_data
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC light, light_clear
+
+  LOGICAL, SAVE                                            :: firstcall_light = .TRUE.             !! first call
+!$OMP THREADPRIVATE(firstcall_light)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : light_clear
+!!
+!>\BRIEF          Activation
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE light_clear
+    firstcall_light=.TRUE.
+  END SUBROUTINE light_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: light
+!!
+!>\BRIEF         Light competition within a PFT
+!!
+!! DESCRIPTION  : This module kills PFTs based on light competition
+!! 
+!! Here, fpc ("foilage projected cover") takes into account the minimum fraction
+!! of space covered by trees through branches etc. This is done to prevent strong relative
+!! changes of FPC from one day to another for deciduous trees at the beginning of their
+!! growing season, which would yield too strong cutbacks.\n
+!!
+!! fpc is now always calculated from lm_lastyearmax*sla, since the aim of this DGVM is 
+!! to represent community ecology effects; seasonal variations in establishment related to phenology
+!! may be relevant, but beyond the scope of a 1st generation DGVM.\n
+!!
+!! If agriculture is present, fpc can never reach 1.0 since natural veget_max < 1.0. To
+!! correct for this, ::ind must be recalculated to correspond to the natural density.
+!! since ::ind is expressed in m^{-2} grid cell, this can be achieved by dividing individual 
+!! density by the agricultural fraction.\n
+!!
+!! The flow in the routine is different for ::ok_dgvm. When ::ok_dgvm is true
+!! the following processes are considered:
+!!
+!! No competition between woody pfts (height of individuals is not considered).
+!! Exception: when one woody pft is overwhelming (i.e. fpc > fpc_crit). In that
+!! case, eliminate all other woody pfts and reduce dominant pft to fpc_crit.
+!! Age of individuals is not considered. In reality, light competition would more
+!! easily kill young individuals, thus increasing the mean age of the stand.
+!! Exclude agricultural pfts from competition.\n
+!!
+!! When ::ok_dgvm is false then light competition is calculated for the static case if the mortality is not 
+!! assumed to be constant. The following processes are considered: XXX
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ind, biomass, veget_lastlight, bm_to_litter, mortality
+!!
+!! REFERENCES   : 
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!! plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!! global vegetation model, Global Change Biology, 9, 161-185.\n
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE light (npts, dt, &
+       veget_max, fpc_max, PFTpresent, cn_ind, lai, maxfpc_lastyear, &
+       lm_lastyearmax, ind, biomass, veget_lastlight, bm_to_litter, mortality)
+
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                             :: npts                     !! Domain size (unitless)      
+    REAL(r_std), INTENT(in)                                :: dt                       !! Time step (days)      
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: PFTpresent               !! TRUE if pft is present (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: cn_ind                   !! Crown area of individuals 
+                                                                                       !! @tex $(m^2)$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: lai                      !! Leaf area index OF AN INDIVIDUAL PLANT 
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: maxfpc_lastyear          !! Last year's maximum fpc for each natural 
+                                                                                       !! PFT(unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: lm_lastyearmax           !! Last year's maximum leafmass for each 
+                                                                                       !! natural PFT 
+                                                                                       !! @tex $(gC m^2 s^{-1})$ @endtex   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget_max                !! Last year's maximum fpc for each natural 
+                                                                                       !! PFT (unitless;0-1)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: fpc_max                  !! Last year's maximum fpc for each natural 
+                                                                                       !! PFT (unitless)    
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: ind                      !! Number of individuals 
+                                                                                       !! @tex $(m^{-2})$ @endtex    
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! Biomass @tex $(gCm^{-2})$ @endtex    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: veget_lastlight          !! Vegetation cover after last light 
+                                                                                       !! competition (unitless;0-1)     
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter   !! Biomass transfer to litter per timestep
+                                                                                       !! @tex $(gCm^{-2})$ @endtex    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: mortality                !! Fraction of individuals that died this 
+                                                                                       !! time step per dt (unitless;0-1)   
+
+    !! 0.4 Local variables
+
+    LOGICAL, PARAMETER                                     :: annual_increase = .TRUE. !! For diagnosis of fpc increase, compare 
+                                                                                       !! today's fpc to last year's  Maximum (T)
+                                                                                       !! or to fpc of last time step (F) 
+    INTEGER(i_std)                                         :: i,j,k,m                  !! Index (unitless)    
+    REAL(r_std), DIMENSION(npts)                           :: sumfpc                   !! Total natural fpc, sum of all the PFTs
+                                                                                       !! (unitless)   
+    REAL(r_std), DIMENSION(npts)                           :: fracnat                  !! Fraction of natural vegetation within a 
+                                                                                       !! grid cell (unitless;0-1)   
+    REAL(r_std)                                            :: sumfpc_wood              !! Total natural woody fpc (unitless)   
+    REAL(r_std)                                            :: sumdelta_fpc_wood        !! Change in total woody fpc (unitless)   
+    REAL(r_std)                                            :: maxfpc_wood              !! Maximum wood fpc (unitless)   
+    INTEGER(i_std)                                         :: optpft_wood              !! Which woody pft is maximum (unitless)   
+    REAL(r_std)                                            :: sumfpc_grass             !! Total natural grass fpc (unitless)   
+    REAL(r_std), DIMENSION(npts,nvm)                       :: fpc_nat                  !! This year's foliage projected cover on 
+                                                                                       !! natural part of the grid cell 
+                                                                                       !! @tex $(m^2)$ @endtex
+    REAL(r_std), DIMENSION(nvm)                            :: deltafpc                 !! fpc change within last year (unitless)    
+    REAL(r_std)                                            :: reduct                   !! Relative change of number of individuals
+                                                                                       !! for trees (ind)    
+    REAL(r_std), DIMENSION(nvm)                            :: survive                  !! Fraction of plants that survive 
+                                                                                       !! (unitless;0-1)     
+    REAL(r_std), DIMENSION(npts)                           :: fpc_real                 !! FPC for static mode (unitless)     
+    REAL(r_std), DIMENSION(npts)                           :: lai_ind                  !! FPC mortality for static mode     
+    REAL(r_std)                                            :: sumfpc_grass2            !! New total grass fpc     
+    REAL(r_std), DIMENSION(npts,nvm)                       :: light_death              !! Fraction of plants that dies each day 
+                                                                                       !! @tex $(day^{-1})$ @endtex     
+    REAL(r_std)                                            :: fpc_dec                  !! Relative change of number of individuals 
+                                                                                       !! for trees
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering light'
+
+    
+ !! 1. Write diagnostics to out_orchidee files
+  
+    IF ( firstcall_light ) THEN
+
+       WRITE(numout,*) 'light:'
+
+       WRITE(numout,*) '   > For trees, minimum fraction of crown area covered'
+       WRITE(numout,*) '       (due to its branches etc.)', min_cover
+
+       WRITE(numout,*) '   > for diagnosis of fpc increase, compare today''s fpc'
+       IF ( annual_increase ) THEN
+          WRITE(numout,*) '     to last year''s maximum.'
+       ELSE
+          WRITE(numout,*) '     to fpc of the last time step.'
+       ENDIF
+
+       firstcall_light = .FALSE.
+
+    ENDIF
+
+!! 2. Light competition in DGVM
+
+    IF (ok_dgvm) THEN
+             
+       !! 2.1 Calculate natural part of the grid cell
+       fracnat(:) = un
+       DO j = 2,nvm
+          IF ( .NOT. natural(j) ) THEN
+             fracnat(:) = fracnat(:) - veget_max(:,j)
+          ENDIF
+       ENDDO
+       
+       !! 2.2 Calculate fpc on natural part of grid cell
+       fpc_nat(:,:) = zero
+       fpc_nat(:,ibare_sechiba) = un
+
+       DO j = 2, nvm ! loop over #PFTs
+
+
+          !! 2.2.1 Natural PFTs
+          IF ( natural(j) ) THEN
+   
+             !!?? it seems that the treatment below for trees and grasses are the same? so there is no necessity to use IF...ELSE...ENDIF structure?
+	     !!?? CODE SHOULD BE CLEANED UP BELOW
+
+             !! 2.2.1.1 Trees
+             IF ( is_tree(j) ) THEN
+
+                ! !! 2.1.1.1 trees: minimum cover due to stems, branches etc.
+                !          DO i = 1, npts
+                !             IF (lai(i,j) == val_exp) THEN
+                !                fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
+                !             ELSE
+                !                fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
+                !                     MAX( ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
+                !             ENDIF
+                !          ENDDO
+                !NV : modif from S. Zaehle version : fpc is based on veget_max, not veget.
+
+                WHERE(fracnat(:).GE.min_stomate)
+
+                   !            WHERE(LAI(:,j) == val_exp)
+                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                   !            ELSEWHERE
+                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * &
+                   !                    MAX( ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ), min_cover )
+                   !            ENDWHERE
+
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                ENDWHERE
+
+             ELSE
+
+                !NV : modif from S. Zaehle version : fpc is based on veget_max, not veget.
+		!!?? DO GRASSES HAVE CROWNS?
+                
+                !! 2.2.1.1 Grasses
+                WHERE(fracnat(:).GE.min_stomate)
+
+                   !            WHERE(LAI(:,j) == val_exp)
+                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                   !            ELSEWHERE
+                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * &
+                   !                    ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
+                   !            ENDWHERE
+
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                ENDWHERE
+
+!!!$                ! 2.1.1.2 bare ground 
+!!!$                IF (j == ibare_sechiba) THEN
+!!!$                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) 
+!!!$
+!!!$                   ! 2.1.1.3 grasses
+!!!$                ELSE
+!!!$                   DO i = 1, npts
+!!!$                      IF (lai(i,j) == val_exp) THEN
+!!!$                         fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
+!!!$                      ELSE
+!!!$                         fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
+!!!$                              ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) )
+!!!$                      ENDIF
+!!!$                   ENDDO
+!!!$                ENDIF
+
+             ENDIF  ! tree/grass
+
+          ELSE
+
+             !! 2.2.2 Agricultural PFTs
+             !        Agriculural PFTs are not present on natural part
+             fpc_nat(:,j) = zero
+
+          ENDIF    ! natural/agricultural
+
+       ENDDO
+
+       
+       !! 2.3 Total fpc for grid point
+       sumfpc(:) = zero
+       DO j = 2,nvm
+
+          !S. Zaehle bug correction MERGE: need to subtract agricultural area!
+          sumfpc(:) = sumfpc(:) + fpc_nat(:,j)
+       ENDDO
+
+       
+       !! 2.4 Light competition
+
+       light_death(:,:) = zero
+
+       DO i = 1, npts ! S. Zaehle why this loop and not a vector statement ?
+
+          !! 2.4.1 Dense canopy 
+          IF ( sumfpc(i) .GT. fpc_crit ) THEN
+
+             ! 2.4.1.1 fpc change for each pft
+             ! There are two possibilities: either we compare today's fpc with the fpc after the last
+             ! time step, or we compare it to last year's maximum fpc of that PFT. In the first case,
+             ! the fpc increase will be strong for seasonal PFTs at the beginning of the growing season.
+             ! As for trees, the cutback is proportional to this increase, this means that seasonal trees
+             ! will be disadvantaged compared to evergreen trees. In the original LPJ model, with its 
+             ! annual time step, the second method was used (this corresponds to annual_increase=.TRUE.)
+
+             IF ( annual_increase ) THEN
+                deltafpc(:) = MAX( (fpc_nat(i,:)-maxfpc_lastyear(i,:)),  zero )
+             ELSE
+                deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)),  zero )
+             ENDIF
+
+             !! 2.4.1.2 Default survival
+             survive(:) = un
+
+             
+             !! 2.4.1.3 Determine some characteristics of the fpc distribution
+             sumfpc_wood = zero
+             sumdelta_fpc_wood = zero
+             maxfpc_wood = zero
+             optpft_wood = 0
+             sumfpc_grass = zero
+
+             DO j = 2,nvm ! loop over #PFTs
+
+                !! 2.4.1.3.1 Natural pfts
+                IF ( natural(j) ) THEN
+
+                   !! 2.4.1.3.1.1 Trees
+                   IF ( is_tree(j) ) THEN
+
+                      ! total woody fpc
+                      sumfpc_wood = sumfpc_wood + fpc_nat(i,j)
+
+                      ! how much did the woody fpc increase
+                      sumdelta_fpc_wood = sumdelta_fpc_wood + deltafpc(j)
+
+                      ! which woody pft is preponderant
+                      IF ( fpc_nat(i,j) .GT. maxfpc_wood ) THEN
+
+                         optpft_wood = j
+
+                         maxfpc_wood = fpc_nat(i,j)
+
+                      ENDIF
+
+                   ELSE
+
+                      !! 2.4.1.3.1.2 Grasses
+                      ! total (natural) grass fpc
+                      sumfpc_grass = sumfpc_grass + fpc_nat(i,j)
+
+                   ENDIF   ! tree or grass
+
+                ENDIF   ! natural
+
+             ENDDO  ! loop over pfts
+
+             !! 2.4.1.4 Wood outcompetes grass
+             !          Light competition where wood outcompetes grasses
+             
+             !S. Zaehle           IF (sumfpc_wood .GE. fpc_crit ) THEN
+             !
+             !! 3.2.1 all allowed natural space is covered by wood:
+             !!       cut back trees to fpc_crit.
+             !!       Original DGVM: kill grasses. Modified: we let a very
+             !!       small fraction of grasses survive.
+             !
+
+             DO j = 2,nvm ! Loop over #PFTs
+
+                ! only present and natural pfts compete
+                IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
+
+                   !! 2.4.1.4.1 Trees
+                   IF ( is_tree(j) ) THEN
+
+                      ! no single woody pft is overwhelming
+                      ! (original DGVM: tree_mercy = 0.0 )
+                      ! The reduction rate is proportional to the ratio deltafpc/fpc.
+                      IF (sumfpc_wood .GE. fpc_crit .AND. fpc_nat(i,j) .GT. min_stomate .AND. & 
+                           sumdelta_fpc_wood .GT. min_stomate) THEN
+
+                         ! reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * &
+                         !     (sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), &
+                         !     ( 1._r_std - 0.01 ) ) ! (0.01 = tree_mercy previously)
+
+                         !!? difficult to fully understand but doesn't look so simple
+                         reduct = un - MIN((fpc_nat(i,j)-(sumfpc_wood-fpc_crit) & 
+                              * deltafpc(j)/sumdelta_fpc_wood)/fpc_nat(i,j), un )
+
+                      ELSE
+
+                         ! tree fpc didn't icrease or it started from nothing
+                         reduct = zero
+
+                      ENDIF
+                   ELSE
+
+                      !! 2.4.1.4.2 Grasses 
+                      !            Let a very small fraction survive (the sum of all
+                      !            grass individuals may make up a maximum cover of
+                      !            grass_mercy [for lai -> infinity]).
+                      !            In the original DGVM, grasses were killed in that case,
+                      !            corresponding to grass_mercy = 0.
+                      !
+
+                      IF(sumfpc_grass .GE. un-MIN(fpc_crit,sumfpc_wood).AND. & 
+                           sumfpc_grass.GE.min_stomate) THEN
+
+                         fpc_dec = (sumfpc_grass - un + MIN(fpc_crit,sumfpc_wood))*fpc_nat(i,j)/sumfpc_grass
+
+                         reduct = fpc_dec
+                      ELSE 
+                         reduct = zero
+                      ENDIF
+                   ENDIF   ! tree or grass
+
+                   survive(j) = un - reduct
+                ENDIF     ! pft there and natural
+
+             ENDDO       ! loop over pfts
+
+             !S. Zaehle
+!!!$          ELSE
+!!!$
+!!!$             !
+!!!$             ! 3.2.2 not too much wood so that grasses can subsist
+!!!$             !
+!!!$
+!!!$             ! new total grass fpc
+!!!$             sumfpc_grass2 = fpc_crit - sumfpc_wood
+!!!$
+!!!$             DO j = 2,nvm
+!!!$
+!!!$                ! only present and natural PFTs compete
+!!!$
+!!!$                IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
+!!!$
+!!!$                   IF ( is_tree(j) ) THEN
+!!!$
+!!!$                      ! no change for trees
+!!!$
+!!!$                      survive(j) = 1.0
+!!!$
+!!!$                   ELSE
+!!!$
+!!!$                      ! grass: fractional loss is the same for all grasses
+!!!$
+!!!$                      IF ( sumfpc_grass .GT. min_stomate ) THEN
+!!!$                         survive(j) = sumfpc_grass2 / sumfpc_grass
+!!!$                      ELSE
+!!!$                         survive(j)=  zero
+!!!$                      ENDIF
+!!!$
+!!!$                   ENDIF
+!!!$
+!!!$                ENDIF    ! pft there and natural
+!!!$
+!!!$             ENDDO       ! loop over pfts
+!!!$
+!!!$          ENDIF    ! sumfpc_wood > fpc_crit
+
+             
+             !! 2.4.1.5 Update biomass and litter pools
+             
+             DO j = 2,nvm ! Loop over #PFTs
+
+                ! Natural PFTs
+                IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
+
+                   bm_to_litter(i,j,:,icarbon) = bm_to_litter(i,j,:,icarbon) + &
+                        biomass(i,j,:,icarbon) * ( un - survive(j) )
+
+ 		   bm_to_litter(i,j,:,icarbon14) = bm_to_litter(i,j,:,icarbon) 
+
+                   biomass(i,j,:,icarbon) = biomass(i,j,:,icarbon) * survive(j)
+		   biomass(i,j,:,icarbon14) = biomass(i,j,:,icarbon) 
+
+
+                   !? We are in a section where ok_dgvm is already at TRUE: No need to test it again
+                   IF ( ok_dgvm ) THEN
+                      ind(i,j) = ind(i,j) * survive(j)
+                   ENDIF
+
+                   ! fraction of plants that dies each day. 
+                   ! exact formulation: light_death(i,j) = un - survive(j) / dt
+                   light_death(i,j) = ( un - survive(j) ) / dt
+
+                ENDIF      ! pft there and natural
+
+             ENDDO        ! loop over pfts
+
+          ENDIF      ! sumfpc > fpc_crit
+
+       ENDDO        ! loop over grid points
+
+       
+       !! 2.5 Recalculate fpc for natural PFTs
+       !      Recalculate fpc on natural part of the grid cell for next light competition
+       DO j = 2,nvm ! loop over #PFT
+
+          !! 2.5.1 Natural PFTs
+          IF ( natural(j) ) THEN
+ 
+             !! 2.5.1.1 Trees
+             IF ( is_tree(j) ) THEN
+
+                DO i = 1, npts
+
+                   !NVMODIF         
+                   !    IF (lai(i,j) == val_exp) THEN
+                   !                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+                   !             ELSE
+                   !                veget_lastlight(i,j) = &
+                   !                     cn_ind(i,j) * ind(i,j) * &
+                   !                     MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
+                   !             ENDIF
+                   !!                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
+ 
+                   IF (lai(i,j) == val_exp) THEN
+                      veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+                   ELSE
+                      veget_lastlight(i,j) = &
+                           cn_ind(i,j) * ind(i,j) * &
+                           MAX( ( un - EXP( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) ), min_cover )
+                   ENDIF
+                ENDDO
+
+             ELSE
+
+                !! 2.5.1.2 Grasses
+                DO i = 1, npts
+
+                   !NVMODIF         
+                   !            IF (lai(i,j) == val_exp) THEN
+                   !                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+                   !             ELSE
+                   !                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
+                   !                     ( un - exp( -lai(i,j) * ext_coeff(j) ) )
+                   !             ENDIF
+                   !!veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+
+                   IF (lai(i,j) == val_exp) THEN
+                      veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+                   ELSE
+                      veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
+                           ( un - exp( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) )
+                   ENDIF
+                ENDDO
+             ENDIF    ! tree/grass
+
+          ELSE
+
+             !! 2.5.2 Agricultural PFTs
+             !        Agricultural PFTs are not present on the natural part of the grid point
+             veget_lastlight(:,j) = zero
+
+          ENDIF  ! natural/agricultural
+
+       ENDDO ! # PFTs
+
+    ELSE ! ok_dgvm
+
+ !! 3. Light competition in stomate (without DGVM)
+
+       light_death(:,:) = zero
+
+       DO j = 2, nvm 
+
+          IF ( natural(j) ) THEN
+
+	     !! NUMBERING BELOW SHOULD BE 5.0 or 4.3
+             !! 2.1.1 natural PFTs, in the one PFT only case there needs to be no special case for grasses,
+             !! neither a redistribution of mortality (delta fpc)
+             
+             !! 3.1 XXX
+             WHERE( ind(:,j)*cn_ind(:,j) .GT. min_stomate ) 
+                lai_ind(:) = sla(j) * lm_lastyearmax(:,j) / ( ind(:,j) * cn_ind(:,j) )
+             ELSEWHERE
+                lai_ind(:) = zero
+             ENDWHERE
+
+             fpc_nat(:,j) =  cn_ind(:,j) * ind(:,j) * & 
+                  MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
+
+             WHERE(fpc_nat(:,j).GT.fpc_max(:,j))
+
+                light_death(:,j) = MIN(un, un - fpc_max(:,j)/fpc_nat(:,j)) 
+
+             ENDWHERE
+
+             !! 3.2 Update biomass and litter pools
+           !  DO m = 1,nelements
+                DO k=1,nparts
+                   
+                   bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) + light_death(:,j)*biomass(:,j,k,icarbon)
+		   bm_to_litter(:,j,k,icarbon14) = bm_to_litter(:,j,k,icarbon)
+                   biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) - light_death(:,j)*biomass(:,j,k,icarbon)
+		   biomass(:,j,k,icarbon14) = biomass(:,j,k,icarbon)
+                   
+                ENDDO
+           !  END DO
+
+             !! 3.3 Update number of individuals
+             ind(:,j) = ind(:,j)-light_death(:,j)*ind(:,j)
+
+          ENDIF
+       ENDDO
+
+       light_death(:,:) = light_death(:,:)/dt
+
+    ENDIF ! ok_dgvm
+
+   
+ !! 4. Write history files
+    CALL xios_orchidee_send_field("LIGHT_DEATH",light_death)
+
+    CALL histwrite_p (hist_id_stomate, 'LIGHT_DEATH', itime, &
+         light_death, npts*nvm, horipft_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving light'
+
+  END SUBROUTINE light
+
+END MODULE lpj_light
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_pftinout.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_pftinout.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/lpj_pftinout.f90	(revision 5166)
@@ -0,0 +1,501 @@
+! =================================================================================================================================
+! MODULE       : lpj_pftinout
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Introduce and eliminate PFT's from pixel
+!!
+!! \n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! REFERENCE(S) :
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!        plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!        global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Thonicke, K., S. Venevsky, et al. (2001), The role of fire disturbance 
+!!        for global vegetation dynamics: coupling fire into a Dynamic Global
+!!        Vegetation Model, Global Ecology and Biogeography, 10, 661-677.\n
+!! - Haxeltine, A. and I. C. Prentice (1996), BIOME3: An equilibrium
+!!        terrestrial biosphere model based on ecophysiological constraints, 
+!!        resource availability, and competition among plant functional types,
+!!        Global Biogeochemical Cycles, 10(4), 693-709.\n
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!        dynamics in the modelling of terrestrial ecosystems: comparing two
+!!        contrasting approaches within European climate space,
+!!        Global Ecology and Biogeography, 10, 621-637.\n
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ==============================================================================================================================
+
+MODULE lpj_pftinout
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC pftinout,pftinout_clear
+
+  LOGICAL, SAVE                       :: firstcall_pftinout = .TRUE.                !! first call
+!$OMP THREADPRIVATE(firstcall_pftinout)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE  : pftinout_clear
+!!
+!>\BRIEF       Set flag ::firstcall_pftinout to true and initialize the variables
+!_ ================================================================================================================================
+
+  SUBROUTINE pftinout_clear
+    firstcall_pftinout = .TRUE.
+  END SUBROUTINE pftinout_clear
+
+!! ================================================================================================================================ 
+!! SUBROUTINE  : pftinout
+!! 
+!>\BRIEF       Introduce and eliminate PFT's from pixel
+!!
+!! DESCRIPTION**3 : Introduction and elimination of PFTs on the basis of climate condition.
+!! For natural and woody PFTs the foliage projected coverage is calculated as follows:
+!! \latexonly
+!!  \input{equation_lpj_pftinout.tex}
+!! \endlatexonly
+!! \n
+!! where FPC is foliage projective cover (::fpc_nat), CN crown area (::cn_ind, 
+!! @tex $ m^{2} $ @endtex), IND number of individuals (::ind, @tex $ m^{-2} $ @endtex,
+!! FRAC total fraction occupied by natural vegetation (::fracnat),
+!! @tex $ LM_{rm max} $ @endtex maximum leaf mass in last year
+!! (::lm_lastyearmax, @tex $ g C m^{-2} $ @endtex), SLA specific leaf area (sla,
+!! @tex $ m^{2} (g C)^{-1} $ @endtex), and coff coefficient (::ext_coeff). ::ext_coeff 
+!! describes a property of the canopy (i.e. law of Lambert-Beer) and is defined in **2
+!!
+!! The foliage projective cover feeds into the calculation of the space available for 
+!! expansion of existing and dispersion of new PFTs within a gridbox. In turn, available
+!! space is use to calculate the number of individuals with a PFT. 
+!!
+!! Saplings are introduced under the condition that winter temperature is 
+!! moderate, plant age is older than 1.25, (and for some PFTs at least one adjacent grid 
+!! box exists for expansion), new saplings are introduced for narural PFT. In the simulation of 
+!! agricultural grassland, if target PFT does not exist in the gridbox, it is introduced 
+!! regardless of climate condition. When a new PFT is introduced CO_2 is taken from the
+!! atmosphere to account for CO_2 present in the seed and required by the germinated seeds
+!! to establish a sapling. These initial phases in ontology are not accounted for. However,
+!! by taking this small amount of CO2 from the atmosphere, mass balance closure for C is
+!! preserved. 
+!!
+!! PFTs are eliminated under the condition that they are no longer adapted to the critical 
+!! temperatures in winter. When a PFT is eliminated its number of indiviuals is set to zero and
+!! the rest of the elimination process is taken care of in lpj_kill.f90.
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: avail_tree (space availability for trees, unitless),   
+!! :: avail_grass (space availability for grasses, unitless), :: biomass (biomass, \f$gC m^{-2}\f$) 
+!! and :: ind (density of individuals, \f$m^{-2}\f$)    
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    :
+!! \latexonly
+!!   \includegraphics[scale = 0.6]{pftinout.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+
+
+
+
+
+  SUBROUTINE pftinout (npts, dt, adapted, regenerate, &
+       neighbours, veget_max, &
+       biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, &
+       PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, &
+       co2_to_bm, &
+       avail_tree, avail_grass)
+    
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size - number of pixels (unitless)            
+    REAL(r_std), INTENT(in)                                   :: dt              !! Time step of vegetation dynamics for stomate
+                                                                                 !! (days)               
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: adapted         !! Winter not too cold (unitless)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: regenerate      !! Winter sufficiently cold (unitless)  
+    INTEGER(i_std), DIMENSION(npts,8), INTENT(in)             :: neighbours      !! Indices of the 8 neighbours of each grid point
+                                                                                 !! (unitless); 1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 
+                                                                                 !! 7=W, 8=NW       
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget_max       !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                                 !! infinity) on ground (unitless)        
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: avail_tree      !! Space availability for trees (unitless)   
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: avail_grass     !! Space availability for grasses (unitless)      
+
+
+    !! 0.3 Modified variables   
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass  !! Biomass (gC m^{-2})      
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! Density of individuals (m^{-2})
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: cn_ind          !! Crown area of individuals (m^2)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age             !! Mean age (years)            
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! Fraction of leaves in leaf age class (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm    !! "long term" net primary productivity 
+                                                                                 !! (gC m^{-2} year^{-1})   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: lm_lastyearmax  !! Last year's maximum leaf mass, for each PFT 
+                                                                                 !! (gC m^{-2})  
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: senescence      !! Plant senescent for deciduous trees; .FALSE. 
+                                                                                 !! if PFT is introduced or killed      
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent      !! PFT exists    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! is the PFT everywhere in the grid box or very 
+                                                                                 !! localized (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit !! how many days ago was the beginning of the 
+                                                                                 !! growing season (days) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: need_adjacent   !! in order for this PFT to be introduced, does it
+                                                                                 !! have to be present in an adjacent grid box?   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: RIP_time        !! How much time ago was the PFT eliminated for 
+                                                                                 !! the last time (years)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm       !! biomass uptaken (gC m^{-2} day^{-1})        
+ 
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                              :: avail           !! availability           
+    INTEGER(i_std)                                            :: i,j,m           !! indices      
+    REAL(r_std), DIMENSION(npts)                              :: sumfrac_wood    !! total woody vegetation cover     
+    INTEGER(i_std), DIMENSION(npts)                           :: n_present       !! number of adjacent grid cells where PFT is 
+                                                                                 !! ubiquitous        
+    LOGICAL, DIMENSION(npts)                                  :: can_introduce   !! we can introduce this PFT    
+    REAL(r_std), DIMENSION(npts)                              :: fracnat         !! no real need for dimension(ntps) except for 
+                                                                                 !! vectorisation          
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering pftinout'
+
+  !! 1. Messages    
+
+    IF ( firstcall_pftinout ) THEN
+
+       WRITE(numout,*) 'pftinout: Minimum space availability: ', min_avail
+
+       firstcall_pftinout = .FALSE.
+
+    ENDIF
+
+  !! 2. Total woody fpc and space avaibility on grid
+
+    ! Only natural part of the grid cell\n
+    ! S. Zaehle bug correction MERGE: need to subtract agricultural area!
+    ! fraction of agricultural surface
+
+    !! 2.1 only natural PFT
+    fracnat(:) = un
+    DO j = 2,nvm ! Loop over # PFTs
+       IF ( .NOT. natural(j) ) THEN
+          fracnat(:) = fracnat(:) - veget_max(:,j)
+       ENDIF
+    ENDDO ! Loop over # PFTs
+
+    !! 2.2 Total woody fractional plant cover
+    sumfrac_wood(:) = zero
+    DO j = 2,nvm ! Loop over # PFTs
+       
+       ! S. Zaehle problem here: agriculture, not convinced that this representation of LPJ is correct
+       ! if agriculture is present, ind must be recalculated to correspond to the natural density...
+       ! since ind is per grid cell, can be achived by discounting for agricultura fraction
+       IF ( natural(j).AND.is_tree(j) ) THEN
+          WHERE(fracnat(:).GT.min_stomate) 
+                sumfrac_wood(:) = sumfrac_wood(:) + cn_ind(:,j) * ind(:,j) / fracnat(:) & 
+                     * ( un - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
+                !lai changed to lm_last
+          ENDWHERE
+       ENDIF
+    ENDDO ! Loop over # PFTs
+
+    !! 2.3 Space availability
+    avail_grass(:) = MAX( ( un - sumfrac_wood(:) ), min_avail )
+    avail_tree(:) = MAX( ( fpc_crit - sumfrac_wood(:) ), min_avail )
+
+  !! 3. Time since last elimination (y)
+
+    RIP_time = RIP_time + dt / one_year
+
+  !! 4. Agicultural PFTs
+
+    ! Agricultural PFTs are only present if they are prescribed
+    DO j = 2,nvm ! Loop over # PFTs
+       
+       IF ( .NOT. natural(j) ) THEN
+          
+          IF (printlev>=4) WRITE(numout,*) 'pftinout: Agricultural PFTs'
+          
+          !! 4.1 Agricultural trees
+          !      Agricultural trees are not treated for the moment
+          IF ( is_tree(j) ) THEN
+
+             CALL ipslerr_p(3,'pftinout','Agricultural trees not treated.','','')
+
+          !! 4.2 Initialization of agricultural grass lands
+          !      Initialize parameter values of prescribed agricultural PFTs
+          ELSE
+
+             DO i = 1, npts ! Loop over # pixels - domain size
+
+                IF ( ( veget_max(i,j) .GT. min_stomate ) .AND. ( .NOT. PFTpresent(i,j) ) ) THEN
+
+                   ! prescribed, but not yet there.
+                   ind(i,j) = veget_max(i,j)
+                   biomass(i,j,:,icarbon) = bm_sapl(j,:,icarbon) * ind(i,j) /veget_max(i,j)
+		   biomass(i,j,:,icarbon14) = biomass(i,j,:,icarbon)
+                   co2_to_bm(i,j) =  co2_to_bm(i,j) +SUM( biomass(i,j,:,icarbon) ) / dt
+                   PFTpresent(i,j) = .TRUE.
+                   everywhere(i,j) = un
+                   senescence(i,j) = .FALSE.
+                   age(i,j) = zero
+
+                ENDIF  ! prescribed, but PFT not yet present
+
+             ENDDO ! Loop over # pixels - domain size
+
+          ENDIF
+
+       ENDIF ! not natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 5 Eliminate PFTs
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       ! only for natural PFTs
+       IF ( natural(j) ) THEN
+
+          ! Number of individuals are set to zero in the condition of cold winter   
+          ! 'adapted_crit' critical value for being adapted = 1.-(1./euler); see 'stomate_constants.f90'
+          WHERE (  PFTpresent(:,j) .AND. ( adapted(:,j) .LT. adapted_crit ) )
+
+             ! PFT there, but not adapted any more (ex: winter too cold): kill
+             ! set number of individuals to zero - rest will be done in lpj_kill
+             ind(:,j) = zero
+
+          ENDWHERE
+
+       ENDIF ! natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 6. Introduce PFTs
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN
+
+          ! space availability for this PFT
+          IF ( is_tree(j) ) THEN
+             avail(:) = avail_tree(:)
+          ELSE
+             avail(:) = avail_grass(:)
+          ENDIF
+          
+          !! 6.1 Check if PFT not present but (adapted and regenerative)     
+          can_introduce(:) = .FALSE.
+          
+          DO i = 1, npts ! Loop over # pixels - domain size
+
+             IF ( .NOT. PFTpresent(i,j) .AND. &
+                  ( adapted(i,j) .GT. adapted_crit ) .AND. &
+                  ( regenerate(i,j) .GT. regenerate_crit )  ) THEN
+
+                ! Seed are available nearby
+                IF ( need_adjacent(i,j) ) THEN
+
+                   !! 6.1.1 Climate allows introduction of the PFT but dispersion requires the 
+                   !        presence of seeds. Seed are considered available if at least one
+                   !        neighbouring pixel is entirely invaded by the PFT. If that condition is
+                   !        satisfied, the PFT can establish in the new pixel.
+                   ! Count number of totally invaded neighbours.
+                   ! no loop so that it can vectorize
+                   n_present(i) = 0
+                   IF ( neighbours(i,1) .GT. 0 ) THEN
+                      IF ( everywhere(neighbours(i,1),j) .GE. un-min_stomate ) THEN
+                         n_present(i) = n_present(i)+1
+                      ENDIF
+                   ENDIF
+                   IF ( neighbours(i,3) .GT. 0 ) THEN
+                      IF ( everywhere(neighbours(i,3),j) .GE. un-min_stomate ) THEN
+                         n_present(i) = n_present(i)+1
+                      ENDIF
+                   ENDIF
+                   IF ( neighbours(i,5) .GT. 0 ) THEN
+                      IF ( everywhere(neighbours(i,5),j) .GE. un-min_stomate ) THEN
+                         n_present(i) = n_present(i)+1
+                      ENDIF
+                   ENDIF
+                   IF ( neighbours(i,7) .GT. 0 ) THEN
+                      IF ( everywhere(neighbours(i,7),j) .GE. un-min_stomate ) THEN
+                         n_present(i) = n_present(i)+1
+                      ENDIF
+                   ENDIF
+
+                   IF ( n_present(i) .GT. 0 ) THEN
+
+                      ! PFT is ubiquitous in at least one adjacent grid box
+                      can_introduce(i) = .TRUE.
+
+                   ENDIF
+
+                ELSE
+
+                   !! 6.1.2 No seed (trees) required for dispersion
+                   !        The PFT can establish without the presence of seed trees in 
+                   !        neighbouring pixels.
+                   can_introduce(i) = .TRUE.
+
+                ENDIF ! do we have to look at the neighbours?
+
+             ENDIF ! we'd like to introduce the PFT
+
+          ENDDO ! Loop over # pixels - domain size 
+
+          !! 6.2 Has the PFT been eliminated lately?
+          !      Additional test whether the PFT has been eliminated lately, i.e.
+          !      less than 1.25 years ago. Do not only take full years as success of
+          !      introduction, as introduction might depend on season.
+          WHERE ( RIP_time(:,j) .LT. RIP_time_min )
+
+             ! PFT was eliminated lately - cannot reintroduce
+             can_introduce(:) = .FALSE.
+
+          ENDWHERE
+
+          !! 6.3 Introduce that PFT where possible
+          !      "can_introduce" means that it either exists in neighbouring grid boxes 
+          !      or that we do not look at neighbours, that it has not been eliminated 
+          !      lately, and, of course, that the climate is good for that PFT.
+          WHERE ( can_introduce(:) )
+             
+             PFTpresent(:,j) = .TRUE.
+             
+             senescence(:,j) = .FALSE.
+             
+             ! introduce at least a few saplings, even if canopy is closed
+             ! initial density of individuals (ind_0) = 0.02, see 'stomate_constant.f90'
+             ind(:,j) = ind_0 * (dt/one_year) * avail(:)
+             
+             WHERE(veget_max(:,j) .GT. min_stomate)
+                biomass(:,j,ileaf,icarbon) = bm_sapl(j,ileaf,icarbon) * ind(:,j) /veget_max(:,j)
+                biomass(:,j,isapabove,icarbon) = bm_sapl(j,isapabove,icarbon) * ind(:,j) /veget_max(:,j)
+                biomass(:,j,isapbelow,icarbon) = bm_sapl(j,isapbelow,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iheartabove,icarbon) = bm_sapl(j,iheartabove,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iheartbelow,icarbon) = bm_sapl(j,iheartbelow,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iroot,icarbon) = bm_sapl(j,iroot,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,ifruit,icarbon) = bm_sapl(j,ifruit,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(:,j)/veget_max(:,j)
+
+ 		biomass(:,j,ileaf,icarbon14) = biomass(:,j,ileaf,icarbon)
+                biomass(:,j,isapabove,icarbon14) = biomass(:,j,isapabove,icarbon)
+                biomass(:,j,isapbelow,icarbon14) = biomass(:,j,isapbelow,icarbon)
+                biomass(:,j,iheartabove,icarbon14) = biomass(:,j,iheartabove,icarbon)
+                biomass(:,j,iheartbelow,icarbon14) = biomass(:,j,iheartbelow,icarbon)
+                biomass(:,j,iroot,icarbon14) = biomass(:,j,iroot,icarbon)
+                biomass(:,j,ifruit,icarbon14) = biomass(:,j,ifruit,icarbon)
+                biomass(:,j,icarbres,icarbon14) = biomass(:,j,icarbres,icarbon)
+             ELSEWHERE              
+                biomass(:,j,ileaf,icarbon) = bm_sapl(j,ileaf,icarbon) * ind(:,j)
+                biomass(:,j,isapabove,icarbon) = bm_sapl(j,isapabove,icarbon) * ind(:,j)
+                biomass(:,j,isapbelow,icarbon) = bm_sapl(j,isapbelow,icarbon) * ind(:,j)
+                biomass(:,j,iheartabove,icarbon) = bm_sapl(j,iheartabove,icarbon) * ind(:,j)
+                biomass(:,j,iheartbelow,icarbon) = bm_sapl(j,iheartbelow,icarbon) * ind(:,j)
+                biomass(:,j,iroot,icarbon) = bm_sapl(j,iroot,icarbon) * ind(:,j)
+                biomass(:,j,ifruit,icarbon) = bm_sapl(j,ifruit,icarbon) * ind(:,j)
+                biomass(:,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(:,j)
+
+		biomass(:,j,ileaf,icarbon14) = biomass(:,j,ileaf,icarbon)
+                biomass(:,j,isapabove,icarbon14) = biomass(:,j,isapabove,icarbon)
+                biomass(:,j,isapbelow,icarbon14) = biomass(:,j,isapbelow,icarbon)
+                biomass(:,j,iheartabove,icarbon14) = biomass(:,j,iheartabove,icarbon)
+                biomass(:,j,iheartbelow,icarbon14) =  biomass(:,j,iheartbelow,icarbon) 
+                biomass(:,j,iroot,icarbon14) = biomass(:,j,iroot,icarbon)
+                biomass(:,j,ifruit,icarbon14) = biomass(:,j,ifruit,icarbon)
+                biomass(:,j,icarbres,icarbon14) = biomass(:,j,icarbres,icarbon)
+             END WHERE
+            
+             co2_to_bm(:,j) = &
+                  co2_to_bm(:,j) +  &
+                  ( biomass(:,j,ileaf,icarbon) + biomass(:,j,isapabove,icarbon) + &
+                  biomass(:,j,isapbelow,icarbon) + biomass(:,j,iheartabove,icarbon) + &
+                  biomass(:,j,iheartbelow,icarbon) + biomass(:,j,iroot,icarbon) + &
+                  biomass(:,j,ifruit,icarbon) + biomass(:,j,icarbres,icarbon) )/dt
+
+             when_growthinit(:,j) = large_value
+
+             age(:,j) = zero
+
+             ! all leaves are young
+             leaf_frac(:,j,1) = un
+
+             ! non-zero "long term" npp and last year's leaf mass for saplings -
+             ! so they won't be killed off by gap or kill
+             npp_longterm(:,j) = npp_longterm_init
+
+             lm_lastyearmax(:,j) = bm_sapl(j,ileaf,icarbon) * ind(:,j)
+
+          ENDWHERE    ! we can introduce the PFT
+
+          !! 6.4 Expansion of the PFT within the grid box 
+          !      PFT expansion/dispersion to a new grid box should not be confused with 
+          !      expansion in areal coverage
+          IF ( treat_expansion ) THEN
+
+             WHERE ( can_introduce(:) )
+
+                ! low value at the beginning
+                everywhere(:,j) = everywhere_init
+             ENDWHERE
+
+          ELSE
+
+             ! expansion is not treated
+             WHERE ( can_introduce(:) )
+                everywhere(:,j) = un
+             ENDWHERE
+
+          ENDIF ! treat expansion
+
+       ENDIF ! only natural PFTs
+
+    ENDDO ! Loop over # PFTs
+
+  !! 7. If a PFT has been present once in a grid box, we suppose that it will survive
+
+    !   If a PFT has been present once in a grid box, we suppose that it will survive
+    !   in isolated places (e.g., an oasis) within that grid box, even if it gets
+    !   officially eliminated from it later. That means that if climate becomes favorable
+    !   again, it will not need to get seeds from adjacent grid cells.
+    WHERE ( PFTpresent )
+       need_adjacent = .FALSE.
+    ENDWHERE
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving pftinout'
+
+  END SUBROUTINE pftinout
+
+END MODULE lpj_pftinout
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate.f90	(revision 5166)
@@ -0,0 +1,5051 @@
+! =================================================================================================================================
+! MODULE       : stomate
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Groups the subroutines that: (1) initialize all variables in 
+!! stomate, (2) read and write forcing files of stomate and the soil component,
+!! (3) aggregates and convert variables to handle the different time steps 
+!! between sechiba and stomate, (4) call subroutines that govern major stomate
+!! processes (litter, soil, and vegetation dynamics) and (5) structures these tasks 
+!! in stomate_main
+!!
+!!\n DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate
+
+  ! Modules used:
+  USE netcdf
+  USE defprec
+  USE grid
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE stomate_io
+  USE stomate_data
+  USE stomate_season
+  USE stomate_lpj
+  USE stomate_litter
+  USE stomate_vmax
+  USE stomate_soilcarbon
+  USE stomate_resp
+  USE mod_orchidee_para 
+  USE ioipsl_para 
+  USE xios_orchidee
+
+!  USE matrix_resolution
+  
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PRIVATE
+  PUBLIC stomate_main,stomate_clear,init_forcing, stomate_forcing_read, stomate_initialize, stomate_finalize
+
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: biomass              !! Biomass per ground area @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(biomass)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: veget_cov_max        !! Maximal fractional coverage: maximum share of a pixel
+                                                                         !! taken by a PFT 
+!$OMP THREADPRIVATE(veget_cov_max)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: ind                  !! Vegetation density, number of individuals per unit 
+                                                                         !! ground area @tex $(m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(ind)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: age                  !! Age of PFT it normalized by biomass - can increase and
+                                                                         !! decrease - (years)
+!$OMP THREADPRIVATE(age)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: adapted              !! Winter too cold for PFT to survive (0-1, unitless)
+!$OMP THREADPRIVATE(adapted)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: regenerate           !! Winter sufficiently cold to produce viable seeds 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(regenerate)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: everywhere           !! Is the PFT everywhere in the grid box or very localized 
+                                                                         !! (after its intoduction)
+!$OMP THREADPRIVATE(everywhere)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: fireindex            !! Probability of fire (unitless)
+!$OMP THREADPRIVATE(fireindex)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: veget_lastlight      !! Vegetation fractions (on ground) after last light 
+                                                                         !! competition (unitless) 
+!$OMP THREADPRIVATE(veget_lastlight)
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:)   :: fpc_max              !! "maximal" coverage fraction of a grid box (LAI -> 
+                                                                         !! infinity) on ground. [??CHECK??] It's set to zero here, 
+                                                                         !! and then is used once in lpj_light.f90 to test if 
+                                                                         !! fpc_nat is greater than it. Something seems missing
+!$OMP THREADPRIVATE(fpc_max)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: PFTpresent           !! PFT exists (equivalent to veget > 0 for natural PFTs)
+!$OMP THREADPRIVATE(PFTpresent)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: senescence           !! The PFT is senescent
+!$OMP THREADPRIVATE(senescence)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: begin_leaves         !! Signal to start putting leaves on (true/false)
+!$OMP THREADPRIVATE(begin_leaves)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: need_adjacent        !! This PFT needs to be in present in an adjacent gridbox 
+                                                                         !! if it is to be introduced in a new gridbox
+!$OMP THREADPRIVATE(need_adjacent)
+!--
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_daily         !! Daily plant available water -root profile weighted 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(humrel_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_week          !! "Weekly" plant available water -root profile weighted
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(humrel_week)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_month         !! "Monthly" plant available water -root profile weighted
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(humrel_month)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxhumrel_lastyear   !! Last year's max plant available water -root profile 
+                                                                         !! weighted (0-1, unitless)
+!$OMP THREADPRIVATE(maxhumrel_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxhumrel_thisyear   !! This year's max plant available water -root profile 
+                                                                         !! weighted (0-1, unitless) 
+!$OMP THREADPRIVATE(maxhumrel_thisyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: minhumrel_lastyear   !! Last year's min plant available water -root profile 
+                                                                         !! weighted (0-1, unitless)  
+!$OMP THREADPRIVATE(minhumrel_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: minhumrel_thisyear   !! This year's minimum plant available water -root profile
+                                                                         !! weighted (0-1, unitless)
+!$OMP THREADPRIVATE(minhumrel_thisyear)
+!---  
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_daily            !! Daily air temperature at 2 meter (K)
+!$OMP THREADPRIVATE(t2m_daily)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: Tseason              !! "seasonal" 2 meter temperatures (K)
+!$OMP THREADPRIVATE(Tseason)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: Tseason_length       !! temporary variable to calculate Tseason
+!$OMP THREADPRIVATE(Tseason_length)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: Tseason_tmp          !! temporary variable to calculate Tseason
+!$OMP THREADPRIVATE(Tseason_tmp)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: Tmin_spring_time     !! Number of days after begin_leaves (leaf onset) 
+!$OMP THREADPRIVATE(Tmin_spring_time)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: onset_date           !! Date in the year at when the leaves started to grow(begin_leaves), only for diagnostics.
+!$OMP THREADPRIVATE(onset_date)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_week             !! Mean "weekly" (default 7 days) air temperature at 2 
+                                                                         !! meter (K)  
+!$OMP THREADPRIVATE(t2m_week)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_month            !! Mean "monthly" (default 20 days) air temperature at 2 
+                                                                         !! meter (K)
+!$OMP THREADPRIVATE(t2m_month)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_longterm         !! Mean "Long term" (default 3 years) air temperature at 
+                                                                         !! 2 meter (K) 
+!$OMP THREADPRIVATE(t2m_longterm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_min_daily        !! Daily minimum air temperature at 2 meter (K)
+!$OMP THREADPRIVATE(t2m_min_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: tsurf_daily          !! Daily surface temperatures (K)
+!$OMP THREADPRIVATE(tsurf_daily)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_daily         !! Daily precipitations sum @tex $(mm day^{-1})$ @endtex
+!$OMP THREADPRIVATE(precip_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_lastyear      !! Last year's annual precipitation sum 
+                                                                         !! @tex $??(mm year^{-1})$ @endtex
+!$OMP THREADPRIVATE(precip_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_thisyear      !! This year's annual precipitation sum 
+                                                                         !! @tex $??(mm year^{-1})$ @endtex 
+!$OMP THREADPRIVATE(precip_thisyear)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: soilhum_daily        !! Daily soil humidity (0-1, unitless)
+!$OMP THREADPRIVATE(soilhum_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: soilhum_month        !! Soil humidity - integrated over a month (0-1, unitless) 
+!$OMP THREADPRIVATE(soilhum_month)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: tsoil_daily          !! Daily soil temperatures (K)
+!$OMP THREADPRIVATE(tsoil_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: tsoil_month          !! Soil temperatures at each soil layer integrated over a
+                                                                         !! month (K) 
+!$OMP THREADPRIVATE(tsoil_month)
+!--- 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: litterhum_daily      !! Daily litter humidity (0-1, unitless)
+!$OMP THREADPRIVATE(litterhum_daily)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_moist_above  !! Moisture control of heterotrophic respiration  
+                                                                         !! (0-1, unitless) 
+!$OMP THREADPRIVATE(control_moist_above)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: control_moist_soil  !! Moisture control of heterotrophic respiration 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(control_moist_soil)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: moist_soil           !! Soil moiture (m3 H20 m-3 Soil) 
+!$OMP THREADPRIVATE(moist_soil)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: soil_mc_Cforcing    !! Soil moiture per soil type (m3 H20 m-3 Soil) 
+!$OMP THREADPRIVATE(soil_mc_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: floodout_Cforcing       !! flux out of floodplains
+!$OMP THREADPRIVATE(floodout_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: wat_flux0_Cforcing    !! Water flux in the first soil layers exported for soil C calculations
+!$OMP THREADPRIVATE(wat_flux0_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: wat_flux_Cforcing    !! Water flux in the soil layers exported for soil C calculations
+!$OMP THREADPRIVATE(wat_flux_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::runoff_per_soil_Cforcing   !! Runoff per soil type [mm]
+!$OMP THREADPRIVATE(runoff_per_soil_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::drainage_per_soil_Cforcing  !! Drainage per soil type [mm]
+!$OMP THREADPRIVATE(drainage_per_soil_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_topsoil_Cforcing    !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                              !! floodplains and from irrigation
+                                                                              !! @tex $(gC m^{-2} day{-1})$ @endtex
+!$OMP THREADPRIVATE(DOC_to_topsoil_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_subsoil_Cforcing    !! DOC inputs to bottom of the soil column, from returnflow
+                                                                              !! in swamps and lakes
+                                                                              !! @tex $(gC m^{-2} day{-1})$ @endtex
+!$OMP THREADPRIVATE(DOC_to_subsoil_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_temp_above   !! Temperature control of heterotrophic respiration at the 
+                                                                         !! different soil levels (0-1, unitless) 
+!$OMP THREADPRIVATE(control_temp_above)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:)  :: control_temp_soil   !! Temperature control of heterotrophic respiration at the
+                                                                         !! different soil levels (0-1,unitless)
+!$OMP THREADPRIVATE(control_temp_soil)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: control_moist_above_daily  !! Moisture control of heterotrophic respiration daily  
+                                                                             !! (0-1, unitless) 
+!$OMP THREADPRIVATE(control_moist_above_daily) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: control_temp_above_daily   !!Temperature control of heterotrophic respiration, above 
+                                                                           !! and below daily (0-1,unitless) 
+!$OMP THREADPRIVATE(control_temp_above_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_moist_soil_daily  !! Moisture control of heterotrophic respiration daily 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(control_moist_soil_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: moist_soil_daily     !! Soil moiture daily (m3 H20 m-3 Soil) 
+!$OMP THREADPRIVATE(moist_soil_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: soil_mc_Cforcing_daily   !! Soil moiture per soil type daily (m3 H20 m-3 Soil) 
+!$OMP THREADPRIVATE(soil_mc_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: floodout_Cforcing_daily       !! flux out of floodplains
+!$OMP THREADPRIVATE(floodout_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: wat_flux0_Cforcing_daily    !! Water flux in the first soil layers exported for soil C calculations
+!$OMP THREADPRIVATE(wat_flux0_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:):: wat_flux_Cforcing_daily    !! Water flux in the soil layers exported for soil C calculations
+!$OMP THREADPRIVATE(wat_flux_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) ::runoff_per_soil_Cforcing_daily   !! Runoff per soil type [mm]
+!$OMP THREADPRIVATE(runoff_per_soil_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) ::drainage_per_soil_Cforcing_daily  !! Drainage per soil type [mm]
+!$OMP THREADPRIVATE(drainage_per_soil_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: DOC_to_topsoil_Cforcing_daily    !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                                  !! floodplains and from irrigation
+                                                                                  !! @tex $(gC m^{-2} day{-1})$ @endtex
+!$OMP THREADPRIVATE(DOC_to_topsoil_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: DOC_to_subsoil_Cforcing_daily    !! DOC inputs to bottom of the soil column, from returnflow
+                                                                                  !! in swamps and lakes
+                                                                                  !! @tex $(gC m^{-2} day{-1})$ @endtex
+!$OMP THREADPRIVATE(DOC_to_subsoil_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_temp_soil_daily   !! Temperature control of heterotrophic respiration, above
+                                                                         !! and below daily (0-1, unitless)
+!$OMP THREADPRIVATE(control_temp_soil_daily)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_init_date        !! inital date for gdd count 
+!$OMP THREADPRIVATE(gdd_init_date)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_from_growthinit  !! gdd from beginning of season (C)
+!$OMP THREADPRIVATE(gdd_from_growthinit)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: gdd0_lastyear        !! Last year's annual Growing Degree Days,
+                                                                         !! threshold 0 deg C (K) 
+!$OMP THREADPRIVATE(gdd0_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: gdd0_thisyear        !! This year's annual Growing Degree Days,
+                                                                         !! threshold 0 deg C (K)
+!$OMP THREADPRIVATE(gdd0_thisyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_m5_dormance      !! Growing degree days for onset of growing season, 
+                                                                         !! threshold -5 deg C (K)
+!$OMP THREADPRIVATE(gdd_m5_dormance)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_midwinter        !! Growing degree days for onset of growing season, 
+                                                                         !! since midwinter (K)
+!$OMP THREADPRIVATE(gdd_midwinter)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: ncd_dormance         !! Number of chilling days since leaves were lost (days) 
+!$OMP THREADPRIVATE(ncd_dormance)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: ngd_minus5           !! Number of growing days, threshold -5 deg C (days)
+!$OMP THREADPRIVATE(ngd_minus5)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: hum_min_dormance     !! Minimum moisture during dormance (0-1, unitless) 
+!$OMP THREADPRIVATE(hum_min_dormance)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gpp_daily            !! Daily gross primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(gpp_daily) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gpp_week             !! Mean "weekly" (default 7 days) GPP  
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(gpp_week)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxgppweek_lastyear  !! Last year's maximum "weekly" GPP  
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex 
+!$OMP THREADPRIVATE(maxgppweek_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxgppweek_thisyear  !! This year's maximum "weekly" GPP  
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex  
+!$OMP THREADPRIVATE(maxgppweek_thisyear)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: npp_daily            !! Daily net primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex 
+!$OMP THREADPRIVATE(npp_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: npp_longterm         !! "Long term" (default 3 years) net primary productivity 
+                                                                         !! per ground area  
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex   
+!$OMP THREADPRIVATE(npp_longterm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: npp_equil            !! Equilibrium NPP written to forcesoil 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(npp_equil)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: npp_tot              !! Total NPP written to forcesoil 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+!$OMP THREADPRIVATE(npp_tot)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: resp_maint_part_radia!! Maintenance respiration of different plant parts per 
+                                                                         !! total ground area at Sechiba time step  
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_maint_part_radia)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: resp_maint_part      !! Maintenance respiration of different plant parts per
+                                                                         !! total ground area at Stomate time step 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_maint_part)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_maint_radia     !! Maintenance respiration per ground area at Sechiba time
+                                                                         !! step   
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_maint_radia)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_maint_d         !! Maintenance respiration per ground area at Stomate time 
+                                                                         !! step  
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_maint_d)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_growth_d        !! Growth respiration per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_growth_d)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)   :: resp_hetero_d        !! Heterotrophic respiration per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_hetero_d)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)   :: resp_hetero_radia    !! Heterothrophic respiration per ground area at Sechiba
+                                                                         !! time step 
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex 
+!$OMP THREADPRIVATE(resp_hetero_radia)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)     :: turnover_time       !! Turnover time of grasses 
+                                                                         !! @tex $(dt_stomate^{-1})$ @endtex 
+!$OMP THREADPRIVATE(turnover_time)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: turnover_daily      !! Senescence-driven turnover (better: mortality) of 
+                                                                         !! leaves and roots  
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(turnover_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: turnover_littercalc !! Senescence-driven turnover (better: mortality) of 
+                                                                         !! leaves and roots at Sechiba time step 
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex 
+!$OMP THREADPRIVATE(turnover_littercalc)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: turnover_longterm   !! "Long term" (default 3 years) senescence-driven 
+                                                                         !! turnover (better: mortality) of leaves and roots 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(turnover_longterm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: bm_to_litter        !! Background (not senescence-driven) mortality of biomass
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(bm_to_litter)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: bm_to_littercalc    !! conversion of biomass to litter per ground area at 
+                                                                         !! Sechiba time step 
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex 
+!$OMP THREADPRIVATE(bm_to_littercalc)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: dead_leaves          !! Metabolic and structural pools of dead leaves on ground
+                                                                         !! per PFT @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(dead_leaves)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: litter_above        !! Above ground metabolic and structural litter 
+                                                                         !! per ground area 
+                                                                         !! @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(litter_above)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:):: litter_below       !! Below ground metabolic and structural litter 
+                                                                         !! per ground area 
+                                                                         !! @tex $(gC m^{-2})$ @endtex 
+!!$OMP THREADPRIVATE(litter_below))
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:) :: litter_above_Cforcing        !! Above ground metabolic and structural litter 
+                                                                         !! per ground area 
+                                                                         !! @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(litter_above_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:,:):: litter_below_Cforcing       !! Below ground metabolic and structural litter 
+                                                                         !! per ground area 
+                                                                         !! @tex $(gC m^{-2})$ @endtex 
+!!$OMP THREADPRIVATE(litter_below_Cforcing))
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: litterpart           !! Fraction of litter above the ground belonging to 
+                                                                         !! different litter pools (unitless)
+!$OMP THREADPRIVATE(litterpart)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: firelitter           !! Total litter above the ground that could potentially 
+                                                                         !! burn @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(firelitter)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:,:) :: soilcarbon_input     !! Quantity of carbon going into DOC pools from litter
+                                                                         !! decomposition per ground area  at Sechiba time step 
+                                                                         !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex 
+!$OMP THREADPRIVATE(soilcarbon_input)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:)  :: soilcarbon_input_daily !! Daily quantity of carbon going into DOC pools from
+                                                                           !! litter decomposition per ground area 
+                                                                           !! @tex $(gC m^{-2} day^{-1})$ @endtex 
+!$OMP THREADPRIVATE(soilcarbon_input_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:)  :: carbon             !! Soil carbon pools per ground area: active, slow, or 
+                                                                         !! passive, @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(carbon)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:,:)   :: DOC           !! Soil dissolved organic carbon free or adsorbed
+                                                                         !! detailled for each pools @tex $(gC m^{-2} of ground)$ @endtex
+!$OMP THREADPRIVATE(DOC)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: DOC_EXP_d             !! Soil dissolved organic carbon exported by drainage or runoff
+                                                                         !! @tex $(gCm^{-2} of ground)$ @endtex
+!$OMP THREADPRIVATE(DOC_EXP_d)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: lignin_struc_above   !! Ratio Lignine/Carbon in structural litter for above
+                                                                         !! ground compartments (unitless)
+!$OMP THREADPRIVATE(lignin_struc_above)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: lignin_struc_below   !! Ratio Lignine/Carbon in structural litter for below
+                                                                         !! ground compartments (unitless)
+!$OMP THREADPRIVATE(lignin_struc_below)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)    :: lignin_struc_above_Cforcing   !! Ratio Lignine/Carbon in structural litter for above
+                                                                         !! ground compartments (unitless)
+!$OMP THREADPRIVATE(lignin_struc_above_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:)  :: lignin_struc_below_Cforcing   !! Ratio Lignine/Carbon in structural litter for below
+                                                                         !! ground compartments (unitless)
+!$OMP THREADPRIVATE(lignin_struc_below_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: lm_lastyearmax       !! Last year's maximum leaf mass per ground area for each
+                                                                         !! PFT @tex $(gC m^{-2})$ @endtex  
+!$OMP THREADPRIVATE(lm_lastyearmax)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: lm_thisyearmax       !! This year's maximum leaf mass per ground area for each
+                                                                         !! PFT @tex $(gC m^{-2})$ @endtex  
+!$OMP THREADPRIVATE(lm_thisyearmax)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxfpc_lastyear      !! Last year's maximum fpc for each natural PFT, on ground
+                                                                         !! [??CHECK] fpc but this ones look ok (computed in 
+                                                                         !! season, used in light)?? 
+!$OMP THREADPRIVATE(maxfpc_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxfpc_thisyear      !! This year's maximum fpc for each PFT, on ground (see 
+                                                                         !! stomate_season), [??CHECK] fpc but this ones look ok 
+                                                                         !! (computed in season, used in light)??
+!$OMP THREADPRIVATE(maxfpc_thisyear)
+!---
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: leaf_age             !! Age of different leaf classes (days)
+!$OMP THREADPRIVATE(leaf_age)
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: leaf_frac            !! PFT fraction of leaf mass in leaf age class (0-1, 
+                                                                         !! unitless) 
+!$OMP THREADPRIVATE(leaf_frac)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: when_growthinit      !! Days since beginning of growing season (days)
+!$OMP THREADPRIVATE(when_growthinit)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: herbivores           !! Time constant of probability of a leaf to be eaten by a
+                                                                         !! herbivore (days)
+!$OMP THREADPRIVATE(herbivores)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: RIP_time             !! How much time ago was the PFT eliminated for the last 
+                                                                         !! time (year)
+!$OMP THREADPRIVATE(RIP_time)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: time_hum_min         !! Time elapsed since strongest moisture limitation (days) 
+!$OMP THREADPRIVATE(time_hum_min)
+!---
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: clay_fm              !! Soil clay content (0-1, unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: clay_fm_g            !! Soil clay content (0-1, unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: soil_ph_fm              !! Soil pH (0-14, pHunit), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: soil_ph_fm_g            !! Soil pH (0-14, pH unit), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: bulk_dens_fm         !! Soil bulk density (g cm-3), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: bulk_dens_fm_g       !! Soil bulk density (g cm-3), parallel computing
+
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: precip_fm            !! Daily precipitations sum @tex $(mm day^{-1})$ @endtex,
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: precip_fm_g          !! Daily precipitations sum @tex $(mm day^{-1})$ @endtex,
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: litterhum_daily_fm   !! Daily relative humidity of litter (0-1, unitless), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: litterhum_daily_fm_g !! Daily relative humidity of litter (0-1, unitless), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: t2m_daily_fm         !! Daily air temperature at 2 meter (K), parallel 
+                                                                         !! computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: t2m_daily_fm_g       !! Daily air temperature at 2 meter (K), parallel 
+                                                                         !! computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: t2m_min_daily_fm     !! Daily minimum air temperature at 2 meter (K), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: t2m_min_daily_fm_g   !! Daily minimum air temperature at 2 meter (K), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: tsurf_daily_fm       !! Daily surface temperatures (K), parallel 
+                                                                         !! computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: tsurf_daily_fm_g     !! Daily surface temperatures (K), parallel 
+                                                                         !! computing 
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: tsoil_daily_fm       !! Daily soil temperatures (K), parallel computing 
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: tsoil_daily_fm_g     !! Daily soil temperatures (K), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: soilhum_daily_fm     !! Daily soil humidity (0-1, unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: soilhum_daily_fm_g   !! Daily soil humidity (0-1, unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: humrel_daily_fm      !! Daily relative humidity of atmosphere (0-1, unitless), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: humrel_daily_fm_g    !! Daily relative humidity of atmosphere (0-1, unitless), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: gpp_daily_fm         !! Daily gross primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex, 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: gpp_daily_fm_g       !! Daily gross primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} day^{-1})$ @endtex, 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: veget_fm             !! Vegetation coverage taking into account non-biological
+                                                                         !! coverage (unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: veget_fm_g           !! Vegetation coverage taking into account non-biological
+                                                                         !! coverage (unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: veget_max_fm         !! Maximum vegetation coverage taking into account 
+                                                                         !! non-biological coverage (unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: veget_max_fm_g       !! Maximum vegetation coverage taking into account none 
+                                                                         !! biological coverage (unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: lai_fm               !! Leaf area index @tex $@tex $(m^2 m^{-2})$ @endtex$ @endtex, 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: lai_fm_g             !! Leaf area index @tex $@tex $(m^2 m^{-2})$ @endtex$ @endtex, 
+                                                                         !! parallel computing
+!    REAL(r_std),DIMENSION(nbp_glo)                :: clay_g                   !! Clay fraction of soil (0-1, unitless), parallel 
+                                                                              !! computing 
+!    REAL(r_std),DIMENSION(nbp_glo)                :: bulk_dens_g              !! Soil bulk density (g cm-3),  parallel 
+                                                                              !!
+                                                                              !computing
+!    REAL(r_std),DIMENSION(nbp_glo)                :: soil_ph_g                !! pH of soil (0-14, pH unit), parallel 
+                                                                              !! computing 
+!    REAL(r_std),DIMENSION(nbp_glo,nstm)           :: soiltile_g              !! soil type, parallel computing
+!    REAL(r_std),DIMENSION(nbp_glo,nvm)            :: veget_max_g              !! Maximum fraction of vegetation type including 
+                                                                              !! non-biological fraction (unitless),paralelle computing 
+!
+!    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:,:,:)  :: soilcarbon_input_g     !! Quantity of carbon going into DOC pools from 
+                                                                              !! litter decomposition  
+                                                                              !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex, parallel 
+                                                                              !! computing 
+!    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: control_moist_above_g    !! Moisture control of heterotrophic respiration  
+!                                                                              !! (0-1, unitless), parallel computing 
+!    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: control_moist_soil_g     !! Moisture control of heterotrophic respiration 
+!                                                                              !! (0-1, unitless), parallel computing 
+!    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: moist_soil_g             !! Soil moiture (m3 H20 m-3 Soil) 
+!    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: soil_mc_Cforcing_g       !! Soil moiture per soil type (m3 H20 m-3 Soil) 
+!    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)   :: floodout_Cforcing_g      !! flux out of floodplains
+!    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: wat_flux0_Cforcing_g     !! Water flux in the first soil layers exported for soil C calculations
+!    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: wat_flux_Cforcing_g     !! Water flux in the soil layers exported for soil C calculations
+!    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::runoff_per_soil_Cforcing_g   !! Runoff per soil type [mm]
+!    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::drainage_per_soil_Cforcing_g !! Drainage per soil type [mm]
+!    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_topsoil_Cforcing_g           !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                              !! floodplains and from irrigation
+                                                                              !! @tex $(gC m^{-2} day{-1})$ @endtex
+!    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_subsoil_Cforcing_g           !! DOC inputs to bottom of the soil column, from returnflow
+                                                                              !! in swamps and lakes
+                                                                              !! @tex $(gC m^{-2} day{-1})$ @endtex
+!    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: control_temp_above_g     !! Temperature control of heterotrophic respiration
+                                                                              !! (0-1, unitless), parallel computing
+!    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: control_temp_soil_g      !! Temperature control of heterotrophic respiration 
+                                                                              !! (0-1, unitless), parallel computing
+!    REAL(r_std),ALLOCATABLE,DIMENSION(:,:)        :: npp_equil_g              !! Equilibrium NPP written to forcesoil 
+                                                                              !! @tex $(gC m^{-2} year^{-1})$ @endtex, parallel 
+                                                                              !! computing 
+!   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:) :: litter_above_g        !! Above ground metabolic and structural litter 
+                                                                              !! per ground area 
+                                                                              !! @tex $(gC m^{-2})$ @endtex, parallel 
+                                                                              !! computing 
+
+!   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:,:):: litter_below_g       !! Below ground metabolic and structural litter 
+                                                                              !! per ground area 
+                                                                              !! @tex $(gC m^{-2})$ @endtex, parallel 
+                                                                              !! computing 
+!  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)    :: lignin_struc_above_g    !! Ratio Lignine/Carbon in structural litter for above
+                                                                              !! ground compartments (unitless), parallel 
+                                                                              !! computing 
+!  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:)  :: lignin_struc_below_g    !! Ratio Lignine/Carbon in structural litter for below
+                                                                              !! ground compartments (unitless), parallel 
+                                                                              !! computing 
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: co2_fire             !! Carbon emitted to the atmosphere by burning living 
+                                                                         !! and dead biomass 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex 
+!$OMP THREADPRIVATE(co2_fire)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: co2_to_bm_dgvm       !! Psuedo-photosynthesis,C used to provide seedlings with
+                                                                         !! an initial biomass, arbitrarily removed from the 
+                                                                         !! atmosphere  
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex 
+!$OMP THREADPRIVATE(co2_to_bm_dgvm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: co2_flux_daily       !! Daily net CO2 flux between atmosphere and biosphere 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+                                                                         !! [??CHECK] sign convention?
+!$OMP THREADPRIVATE(co2_flux_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: co2_flux_monthly     !! Monthly net CO2 flux between atmosphere and biosphere 
+                                                                         !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex
+                                                                         !! [??CHECK] sign convention? 
+!$OMP THREADPRIVATE(co2_flux_monthly)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: prod10               !! Wood products remaining in the 10 year-turnover pool 
+                                                                         !! after the annual release for each compartment 
+                                                                         !! @tex $(gC m^{-2})$ @endtex    
+                                                                         !! (0:10 input from year of land cover change),
+                                                                         !! dimension(#pixels,0:10 years
+!$OMP THREADPRIVATE(prod10)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: prod100              !! Wood products remaining in the 100 year-turnover pool
+                                                                         !! after the annual release for each compartment
+                                                                         !! @tex $(gC m^{-2})$ @endtex  
+                                                                         !! (0:100 input from year of land cover change), 
+                                                                         !! dimension(#pixels,0:100 years)
+!$OMP THREADPRIVATE(prod100)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: flux10               !! Wood decomposition from the 10 year-turnover pool 
+                                                                         !! compartments 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+                                                                         !! dimension(#pixels,0:10)  
+!$OMP THREADPRIVATE(flux10)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: flux100              !! Wood decomposition from the 100 year-turnover pool 
+                                                                         !! compartments 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+                                                                         !! dimension(#pixels,0:100)
+!$OMP THREADPRIVATE(flux100)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: convflux             !! Release during first year following land cover change 
+                                                                         !! (paper, burned, etc...) 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex  
+!$OMP THREADPRIVATE(convflux)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: cflux_prod10         !! Total annual release from the 10 year-turnover pool
+                                                                         !! sum of flux10  
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(cflux_prod10)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: cflux_prod100        !! Total annual release from the 100 year-turnover pool 
+                                                                         !! sum of flux100 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(cflux_prod100)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: harvest_above        !! Harvest of above ground biomass for agriculture -not 
+                                                                         !! just from land use change 
+                                                                         !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex
+!$OMP THREADPRIVATE(harvest_above)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: carb_mass_total      !! Total on-site and off-site C pool 
+                                                                         !! @tex $(??gC m^{-2})$ @endtex                        
+!$OMP THREADPRIVATE(carb_mass_total)
+!---
+  REAL(r_std), SAVE                              :: tau_longterm
+!$OMP THREADPRIVATE(tau_longterm)
+  REAL(r_std),SAVE                               :: dt_days=zero         !! Time step of STOMATE (days) 
+!$OMP THREADPRIVATE(dt_days)
+  INTEGER(i_std),SAVE                            :: date=0               !! Date (days) 
+!$OMP THREADPRIVATE(date)
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)   :: nforce               !! Number of states calculated for the soil forcing 
+                                                                         !! variables (unitless), dimension(::nparan*::nbyear) both 
+                                                                         !! given in the run definition file    
+!$OMP THREADPRIVATE(nforce)
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)   :: isf                  !! Index for number of time steps that can be stored in 
+                                                                         !! memory (unitless), dimension (#nsfm)
+!$OMP THREADPRIVATE(isf)
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)   :: nf_cumul             !! Number of years over which the average is calculated in
+                                                                         !! forcesoil when cumul flag is set, dimension (#nsft)
+                                                                         !! [??CHECK] definition the dimension is number of 
+                                                                         !! timesteps in a year?
+!$OMP THREADPRIVATE(nf_cumul)
+  INTEGER(i_std), SAVE                           :: spinup_period        !! Period of years used to calculate the resolution of the system for spinup analytic. 
+                                                                         !! This period correspond in most cases to the period of years of forcing data used
+  INTEGER,PARAMETER                              :: r_typ = nf90_real4   !! Specify data format (server dependent)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:)          :: nf_written           !! Flag indicating whether the forcing data have been 
+                                                                         !! written
+!$OMP THREADPRIVATE(nf_written)
+!---
+  LOGICAL, SAVE                                  :: do_slow=.FALSE.      !! Flag that determines whether stomate_accu calculates
+                                                                         !! the sum(do_slow=.FALSE.) or the mean 
+                                                                         !! (do_slow=.TRUE.)
+!$OMP THREADPRIVATE(do_slow)
+  LOGICAL, SAVE                                  :: EndOfYear=.FALSE.    !! Update annual variables? This variable must be 
+                                                                         !! .TRUE. once a year
+!$OMP THREADPRIVATE(EndOfYear)
+  LOGICAL, SAVE                                  :: EndOfMonth=.FALSE.   !! Update monthly variables? This variable must be 
+                                                                         !!.TRUE. once a month 
+!$OMP THREADPRIVATE(EndOfMonth)
+  LOGICAL, SAVE                                  :: l_first_stomate = .TRUE.!! Is this the first call of stomate?
+!$OMP THREADPRIVATE(l_first_stomate)
+  LOGICAL, SAVE                                  :: cumul_forcing=.FALSE.!! flag for cumul of forcing if teststomate
+!$OMP THREADPRIVATE(cumul_forcing)
+  LOGICAL, SAVE                                  :: cumul_Cforcing=.FALSE.  !! Flag, if internal parameter cumul_Cforcing is 
+                                                                            !! TRUE then ::nbyear (defined in run definition 
+                                                                            !! file will be forced to 1 later in this module. If 
+                                                                            !! FALSE the mean over ::nbyear is written in forcesoil
+!$OMP THREADPRIVATE(cumul_Cforcing)
+!---   
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: harvest_above_monthly   !! [??CHECK] post-processing - should be removed?
+!$OMP THREADPRIVATE(harvest_above_monthly)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: cflux_prod_monthly      !! [??CHECK] post-processing - should be removed?
+!$OMP THREADPRIVATE(cflux_prod_monthly)
+!---
+  REAL(r_std),SAVE                                   :: dt_forcesoil        !! Time step of soil forcing file (days)
+!$OMP THREADPRIVATE(dt_forcesoil)
+  INTEGER(i_std),PARAMETER                           :: nparanmax=366       !! Maximum number of time steps per year for forcesoil
+  INTEGER(i_std),SAVE                                :: nparan              !! Number of time steps per year for forcesoil read from run definition (unitless) 
+!$OMP THREADPRIVATE(nparan)
+  INTEGER(i_std),SAVE                                :: nbyear=1            !! Number of years saved for forcesoil (unitless) 
+!$OMP THREADPRIVATE(nbyear)
+  INTEGER(i_std),SAVE                                :: iatt                !! Time step of forcing of soil processes (iatt = 1 to ::nparan*::nbyear) 
+!$OMP THREADPRIVATE(iatt)
+  INTEGER(i_std),SAVE                                :: iatt_old=1          !! Previous ::iatt
+!$OMP THREADPRIVATE(iatt_old)
+  INTEGER(i_std),SAVE                                :: nsfm                !! Number of time steps that can be stored in memory (unitless) 
+!$OMP THREADPRIVATE(nsfm)
+  INTEGER(i_std),SAVE                                :: nsft                !! Number of time steps in a year (unitless)
+!$OMP THREADPRIVATE(nsft)
+  INTEGER(i_std),SAVE                                :: iisf                !! Current pointer for teststomate (unitless)
+!$OMP THREADPRIVATE(iisf)
+  CHARACTER(LEN=100), SAVE                           :: forcing_name        !! Name of forcing file 1
+!$OMP THREADPRIVATE(forcing_name)
+  CHARACTER(LEN=100), SAVE                           :: Cforcing_name       !! Name of forcing file 2
+!$OMP THREADPRIVATE(Cforcing_name)
+  INTEGER(i_std),SAVE                                :: Cforcing_id         !! File identifer of file 2
+!$OMP THREADPRIVATE(Cforcing_id)    
+  INTEGER(i_std),PARAMETER                           :: ndm = 11            !! Maximum number of dimensions (unitless)
+
+ 
+PUBLIC clay_fm, soil_ph_fm,bulk_dens_fm,humrel_daily_fm, litterhum_daily_fm, t2m_daily_fm, &
+   & t2m_min_daily_fm, tsurf_daily_fm, tsoil_daily_fm, soilhum_daily_fm, &
+   & precip_fm, gpp_daily_fm, veget_fm, veget_max_fm, lai_fm
+PUBLIC  dt_days, date, do_slow, EndOfYear
+PUBLIC isf, nf_written
+
+CONTAINS
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_initialize
+!!
+!>\BRIEF        Initialization routine for stomate module. 
+!!
+!! DESCRIPTION  : Initialization routine for stomate module. Read options from parameter file, allocate variables, read variables 
+!!                from restart file and initialize variables if necessary. 
+!!                
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE stomate_initialize &
+        (kjit,           kjpij,             kjpindex,                        &
+         rest_id_stom,   hist_id_stom,      hist_id_stom_IPCC,               &
+         index,          lalo,              neighbours,   resolution,        &
+         contfrac,       totfrac_nobio,     clay,         bulk_dens,         &
+         t2m,            soil_ph,           lai,          veget,             &
+         veget_max,      co2_flux,          fco2_lu,      deadleaf_cover,    &
+         assim_param,    temp_growth )
+
+    IMPLICIT NONE
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)                       :: kjit              !! Time step number (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpij             !! Total size of the un-compressed grid (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpindex          !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std),INTENT(in)                       :: rest_id_stom      !! STOMATE's _Restart_ file identifier (unitless)
+    INTEGER(i_std),INTENT(in)                       :: hist_id_stom      !! STOMATE's _history_ file identifier (unitless)
+    INTEGER(i_std),INTENT(in)                       :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file identifier(unitless) 
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)   :: index             !! The indices of the terrestrial pixels only (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: lalo              !! Geographical coordinates (latitude,longitude) for pixels (degrees) 
+    INTEGER(i_std),DIMENSION(kjpindex,8),INTENT(in) :: neighbours        !! Neighoring grid points if land for the DGVM (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: resolution        !! Size in x an y of the grid (m) - surface area of the gridbox 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)   :: contfrac          !! Fraction of continent in the grid cell (unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: totfrac_nobio     !! Fraction of grid cell covered by lakes, land ice, cities, ... (unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: clay              !! Clay fraction of soil (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: bulk_dens         !! Soil bulk density (g cm-3)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: soil_ph           !! Soil pH (0-14, pH unit)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: t2m               !! 2 m air temperature (K)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: lai               !! Leaf area inex @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: veget             !! Fraction of vegetation type including 
+                                                                         !! non-biological fraction (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: veget_max         !! Maximum fraction of vegetation type including 
+                                                                         !! non-biological fraction (unitless) 
+
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: co2_flux          !! CO2 flux between atmosphere and biosphere
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)     :: fco2_lu           !! CO2 flux between atmosphere and biosphere from land-use (without forest management)  
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)     :: deadleaf_cover    !! Fraction of soil covered by dead leaves (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(out) :: assim_param !! min+max+opt temperatures (K) & vmax for photosynthesis  
+                                                                         !! @tex $(\mu mol m^{-2}s^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)     :: temp_growth       !! Growth temperature (ÃÂ°C)  
+                                                                         !! Is equal to t2m_month 
+    !! 0.3 Local variables
+    REAL(r_std)                                   :: dt_days_read             !! STOMATE time step read in restart file (days)
+    INTEGER(i_std)                                :: l,k,ji, jv, i, j, m      !! indices    
+    REAL(r_std),PARAMETER                         :: max_dt_days = 5.         !! Maximum STOMATE time step (days)
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: rprof                    !! Coefficient of the exponential functions that 
+                                                                              !! relates root density to soil depth (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_daily_x              !! "Daily" gpp for teststomate  
+                                                                              !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: veget_cov                !! Fractional coverage: actually share of the pixel 
+                                                                              !! covered by a PFT (fraction of ground area), 
+                                                                              !! taking into account LAI ??(= grid scale fpc)?? 
+    INTEGER(i_std)                                :: ier                      !! Check errors in netcdf call (unitless)
+
+    INTEGER(i_std)                                :: max_totsize              !! Memory management - maximum memory size (Mb)
+    INTEGER(i_std)                                :: totsize_1step            !! Memory management - memory required to store one 
+                                                                              !! time step on one processor (Mb) 
+    INTEGER(i_std)                                :: totsize_tmp              !! Memory management - memory required to store one 
+                                                                              !! time step on all processors(Mb) 
+    INTEGER(i_std)                                :: vid                      !! Variable identifer of netCDF (unitless)
+    INTEGER(i_std)                                :: nneigh                   !! Number of neighbouring pixels
+    INTEGER(i_std)                                :: direct                   !! 
+    INTEGER(i_std),DIMENSION(ndm)                 :: d_id                     !! 
+
+
+!_ ================================================================================================================================
+    
+    !! 1. Initialize variable
+    !! Update flag
+    l_first_stomate = .FALSE.
+    
+    !! 1.1 Store current time step in a common variable
+    itime = kjit
+    
+    !![DISPENSABLE] 1.2 Copy the depth of the different soil layers from diaglev specified in slow_proc
+    
+    !! 1.3 PFT rooting depth across pixels, humescte is pre-defined 
+    ! (constantes_veg.f90). It is defined as the coefficient of an exponential 
+    ! function relating root density to depth 
+    DO j=1,nvm
+       rprof(:,j) = 1./humcste(j)
+    ENDDO
+    
+    !Config Key   = SPINUP_PERIOD
+    !Config Desc  = Period to calulcate equilibrium during spinup analytic
+    !Config If    = SPINUP_ANALYTIC
+    !Config Def   = -1
+    !Config Help  = Period corresponds in most cases to the number of years of forcing data used in the spinup.
+    !Config Units = [years]   
+    spinup_period = -1
+    CALL getin_p('SPINUP_PERIOD',spinup_period)       
+    
+    ! Check spinup_period values. 
+    ! For periods uptil 6 years, to obtain equilibrium, a bigger period have to be used 
+    ! and therefore spinup_period is adjusted to 10 years. 
+    IF (spinup_analytic) THEN
+       IF (spinup_period <= 0) THEN
+          WRITE(numout,*) 'Error in parameter spinup_period. This parameter must be > 0 : spinup_period=',spinup_period
+          CALL ipslerr_p (3,'stomate_initialize', &
+               'Parameter spinup_period must be set to a positive integer.', &
+               'Set this parameter to the number of years of forcing data used for the spinup.', &
+               '')
+       ELSE IF (spinup_period <= 6) THEN
+          ! Adjust to bigger period. The period must be a multiple of the original period.
+          WRITE(numout,*) 'Initial spinup_period =',spinup_period,' will be adjusted.'
+          spinup_period = spinup_period*(INT(9/spinup_period)+1)
+       END IF
+    END IF
+    
+    !! 1.4.0 Initialization of PFT specific parameters 
+    ! Initialization of PFT specific parameters that have no value
+    ! for the bare soil PFT i.e. fire resistance, flamability, maximum lai,
+    ! settings for growing degree days (GDD), settings for senescence, 
+    ! respiration coefficients, photosynthesis, etc.
+    ! [DISPENSABLE]
+    
+    !! 1.4.1 Allocate memory for all variables in stomate
+    ! Allocate memory for all variables in stomate, build new index
+    ! tables accounting for the PFTs, read and check flags and set file
+    ! identifier for restart and history files.
+    CALL stomate_init (kjpij, kjpindex, index, lalo, &
+         rest_id_stom, hist_id_stom, hist_id_stom_IPCC)
+    
+    !! 1.4.2 Initialization of PFT specific parameters
+    ! Initialization of PFT specific parameters i.e. sla from leaf life, 
+    ! sapling characteristics (biomass), migration speed, critical diameter,
+    ! coldest tolerable temperature, critical values for phenology, maximum
+    ! life time of leaves, respiration coefficients and photosynthesis.
+    ! The subroutine also communicates settings read by stomate_constant_init.
+    CALL data (kjpindex, lalo)
+    
+    !! 1.4.3 Initial conditions
+    
+    !! 1.4.3.1 Read initial values for STOMATE's variables from the _restart_ file
+    ! ??Shouldn't this be included in stomate_init?? Looks like an initialization!
+    co2_flux(:,:) = zero
+    fco2_lu(:) = zero
+    
+    ! Get values from _restart_ file. Note that only ::kjpindex, ::index, ::lalo 
+    ! and ::resolution are input variables, all others are output variables.
+    CALL readstart &
+         (kjpindex, index, lalo, resolution, t2m, &
+         dt_days_read, date, &
+         ind, adapted, regenerate, &
+         humrel_daily, gdd_init_date, litterhum_daily, &
+         t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+         soilhum_daily, precip_daily, &
+         gpp_daily, npp_daily, turnover_daily, &
+         humrel_month, humrel_week, &
+         t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+         tsoil_month, soilhum_month, fireindex, firelitter, &
+         maxhumrel_lastyear, maxhumrel_thisyear, &
+         minhumrel_lastyear, minhumrel_thisyear, &
+         maxgppweek_lastyear, maxgppweek_thisyear, &
+         gdd0_lastyear, gdd0_thisyear, &
+         precip_lastyear, precip_thisyear, &
+         gdd_m5_dormance,  gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+         PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+         maxfpc_lastyear, maxfpc_thisyear, &
+         turnover_longterm, gpp_week, biomass, resp_maint_part, &
+         leaf_age, leaf_frac, &
+         senescence, when_growthinit, age, &
+         resp_hetero_d, resp_maint_d, resp_growth_d, co2_fire, co2_to_bm_dgvm, &
+         veget_lastlight, everywhere, need_adjacent, RIP_time, &
+         time_hum_min, hum_min_dormance, &
+         litterpart, litter_above, litter_below, dead_leaves, &
+         carbon, DOC, lignin_struc_above,lignin_struc_below,turnover_time,&
+         prod10,prod100,flux10, flux100, &
+         convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total, &
+         Tseason, Tseason_length, Tseason_tmp, &
+         Tmin_spring_time, begin_leaves, onset_date, &
+         assim_param)
+    
+    !! 1.4.5 Check time step
+       
+    !! 1.4.5.1 Allow STOMATE's time step to change although this is dangerous
+    IF (dt_days /= dt_days_read) THEN
+       WRITE(numout,*) 'slow_processes: STOMATE time step changes:', &
+            & dt_days_read,' -> ',dt_days
+    ENDIF
+    
+    !! 1.4.5.2 Time step has to be a multiple of a full day
+    IF ( ( dt_days-REAL(NINT(dt_days),r_std) ) > min_stomate ) THEN
+       WRITE(numout,*) 'slow_processes: STOMATE time step is not a mutiple of a full day:', &
+            & dt_days,' days.'
+       STOP
+    ENDIF
+    
+    !! 1.4.5.3 upper limit to STOMATE's time step
+    IF ( dt_days > max_dt_days ) THEN
+       WRITE(numout,*) 'slow_processes: STOMATE time step exceeds the maximum value:', &
+            & dt_days,' days > ', max_dt_days, ' days.'  
+       STOP
+    ENDIF
+    
+    !! 1.4.5.4 STOMATE time step must not be less than the forcing time step
+    IF ( dt_sechiba > dt_days*one_day ) THEN
+       WRITE(numout,*) &
+            & 'slow_processes: STOMATE time step ::dt_days smaller than forcing time step ::dt_sechiba'
+       STOP
+    ENDIF
+    
+    !! 1.4.5.6 Final message on time step
+    WRITE(numout,*) 'Slow_processes, STOMATE time step (days): ', dt_days
+    
+    !! 1.4.6 Write forcing file for teststomate
+    IF (ok_co2 .AND. allow_forcing_write) THEN
+       
+       !Config Key   = STOMATE_FORCING_NAME
+       !Config Desc  = Name of STOMATE's forcing file
+       !Config If    = OK_STOMATE
+       !Config Def   = NONE
+       !Config Help  = Name that will be given
+       !Config         to STOMATE's offline forcing file
+       !Config         Compatible with Nicolas Viovy's driver
+       !Config Units = [FILE]
+       forcing_name = stomate_forcing_name
+       CALL getin_p('STOMATE_FORCING_NAME',forcing_name)
+       
+       IF ( TRIM(forcing_name) /= 'NONE' ) THEN
+          
+          !! 1.4.6.1 Calculate steps that can be stored in memory
+          ! Action for the root processor only (parallel computing)  
+          IF (is_root_prc) CALL SYSTEM ('rm -f '//TRIM(forcing_name))
+          WRITE(numout,*) 'writing a forcing file for STOMATE.'
+          
+          !Config Key   = STOMATE_FORCING_MEMSIZE
+          !Config Desc  = Size of STOMATE forcing data in memory 
+          !Config If    = OK_STOMATE
+          !Config Def   = 50
+          !Config Help  = This variable determines how many
+          !Config         forcing states will be kept in memory.
+          !Config         Must be a compromise between memory
+          !Config         use and frequeny of disk access.
+          !Config Units = [MegaBytes]
+          max_totsize = 50
+          CALL getin_p('STOMATE_FORCING_MEMSIZE', max_totsize)      
+          max_totsize = max_totsize*1000000
+          
+          totsize_1step = &
+               SIZE(clay)*KIND(clay) &
+               + SIZE(soil_ph)*KIND(soil_ph) &
+               +SIZE(bulk_dens)*KIND(bulk_dens) &
+               +SIZE(humrel_daily)*KIND(humrel_daily) &
+               +SIZE(litterhum_daily)*KIND(litterhum_daily) &
+               +SIZE(t2m_daily)*KIND(t2m_daily) &
+               +SIZE(t2m_min_daily)*KIND(t2m_min_daily) &
+               +SIZE(tsurf_daily)*KIND(tsurf_daily) &
+               +SIZE(tsoil_daily)*KIND(tsoil_daily) &
+               +SIZE(soilhum_daily)*KIND(soilhum_daily) &
+               +SIZE(precip_daily)*KIND(precip_daily) &
+               +SIZE(gpp_daily_x)*KIND(gpp_daily_x) &
+               +SIZE(veget)*KIND(veget) &
+               +SIZE(veget_max)*KIND(veget_max) &
+               +SIZE(lai)*KIND(lai)
+          
+          ! Totsize_1step is the size on a single processor, sum
+          ! all processors and send to all processors
+          CALL reduce_sum(totsize_1step,totsize_tmp)
+          CALL bcast(totsize_tmp)
+          totsize_1step=totsize_tmp
+          
+          ! Total number of forcing steps
+          nsft = INT(one_year/(dt_stomate/one_day))
+          
+          ! Number of forcing steps in memory
+          nsfm = MIN(nsft, &
+               MAX(1,NINT( REAL(max_totsize,r_std) &
+               /REAL(totsize_1step,r_std))))
+            
+             
+          !! 1.6.4.2 Allocate memory for variables containing forcing data  
+          ! and initialize variables (set to zero).
+          CALL init_forcing (kjpindex,nsfm,nsft)
+          
+          ! Indexing for writing forcing file
+          isf(:) = (/ (i,i=1,nsfm) /)
+          nf_written(:) = .FALSE.
+          nf_cumul(:) = 0
+          iisf = 0
+          
+          !! 1.6.4.3 Create netcdf file
+          ! Create, define and populate a netcdf file containing the forcing data.
+          ! For the root processor only (parallel computing). NF90_ are functions
+          ! from and external library.  
+          IF (is_root_prc) THEN
+             
+             ! Create new netCDF dataset
+             ier = NF90_CREATE (TRIM(forcing_name),NF90_SHARE,forcing_id)
+             
+             ! Add variable attribute
+             ! Note ::iim_g and ::jjm_g are dimensions of the global field and 
+             ! ::nbp_glo is the number of global continental points
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL,'dt_sechiba',dt_sechiba)
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL,'dt_stomate',dt_stomate)
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, &
+                  'nsft',REAL(nsft,r_std))
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, &
+                  'kjpij',REAL(iim_g*jjm_g,r_std))
+             ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, &
+                  'kjpindex',REAL(nbp_glo,r_std))
+             
+             ! Add new dimension
+             ier = NF90_DEF_DIM (forcing_id,'points',nbp_glo,d_id(1))
+             ier = NF90_DEF_DIM (forcing_id,'layers',nbdl,d_id(2))
+             ier = NF90_DEF_DIM (forcing_id,'pft',nvm,d_id(3))
+             direct=2
+             ier = NF90_DEF_DIM (forcing_id,'direction',direct,d_id(4))
+             nneigh=8
+             ier = NF90_DEF_DIM (forcing_id,'nneigh',nneigh,d_id(5))
+             ier = NF90_DEF_DIM (forcing_id,'time',NF90_UNLIMITED,d_id(6))
+             ier = NF90_DEF_DIM (forcing_id,'nbparts',nparts,d_id(7))
+             
+             ! Add new variable
+             ier = NF90_DEF_VAR (forcing_id,'points',    r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (forcing_id,'layers',    r_typ,d_id(2),vid)
+             ier = NF90_DEF_VAR (forcing_id,'pft',       r_typ,d_id(3),vid)
+             ier = NF90_DEF_VAR (forcing_id,'direction', r_typ,d_id(4),vid)
+             ier = NF90_DEF_VAR (forcing_id,'nneigh',    r_typ,d_id(5),vid)
+             ier = NF90_DEF_VAR (forcing_id,'time',      r_typ,d_id(6),vid)
+             ier = NF90_DEF_VAR (forcing_id,'nbparts',   r_typ,d_id(7),vid)
+             ier = NF90_DEF_VAR (forcing_id,'index',     r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (forcing_id,'contfrac',  r_typ,d_id(1),vid) 
+             ier = NF90_DEF_VAR (forcing_id,'lalo', &
+                  r_typ,(/ d_id(1),d_id(4) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'neighbours', &
+                  r_typ,(/ d_id(1),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'resolution', &
+                  r_typ,(/ d_id(1),d_id(4) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'clay', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'bulk_dens', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'soil_ph', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'humrel', &
+                  r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'litterhum', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'t2m', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'t2m_min', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'tsurf', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'tsoil', &
+                  r_typ,(/ d_id(1),d_id(2),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'soilhum', &
+                  r_typ,(/ d_id(1),d_id(2),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'precip', &
+                  r_typ,(/ d_id(1),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'gpp', &
+                  r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'veget', &
+                  r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'veget_max', &
+                  r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+             ier = NF90_DEF_VAR (forcing_id,'lai', &
+                  r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+             ier = NF90_ENDDEF (forcing_id)
+             
+             ! Given the name of a varaible, nf90_inq_varid finds the variable 
+             ! ID (::vid). Put data value(s) into variable ::vid
+             ier = NF90_INQ_VARID (forcing_id,'points',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid, &
+                  (/(REAL(i,r_std),i=1,nbp_glo) /))
+             ier = NF90_INQ_VARID (forcing_id,'layers',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nbdl)/))
+             ier = NF90_INQ_VARID (forcing_id,'pft',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nvm)/))
+             ier = NF90_INQ_VARID (forcing_id,'direction',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,2)/))
+             ier = NF90_INQ_VARID (forcing_id,'nneigh',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,8)/))
+             ier = NF90_INQ_VARID (forcing_id,'time',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nsft)/))
+             ier = NF90_INQ_VARID (forcing_id,'nbparts',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nparts)/))
+             ier = NF90_INQ_VARID (forcing_id,'index',vid)  
+             ier = NF90_PUT_VAR (forcing_id,vid,REAL(index_g,r_std))
+             ier = NF90_INQ_VARID (forcing_id,'contfrac',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid,REAL(contfrac_g,r_std))
+             ier = NF90_INQ_VARID (forcing_id,'lalo',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid,lalo_g)
+             !ym attention a neighbours, a modifier plus tard      
+             ier = NF90_INQ_VARID (forcing_id,'neighbours',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid,REAL(neighbours_g,r_std))
+             ier = NF90_INQ_VARID (forcing_id,'resolution',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid,resolution_g)
+          ENDIF ! is_root_prc
+       ENDIF ! (forcing_name) /= 'NONE'
+    ENDIF ! ok_co2 =.TRUE.
+    
+    !! 1.4.7 write forcing file for forcesoil
+    !! 1.4.7.1 Initialize
+    !Config Key   = STOMATE_CFORCING_NAME
+    !Config Desc  = Name of STOMATE's carbon forcing file
+    !Config If    = OK_STOMATE
+    !Config Def   = NONE
+    !Config Help  = Name that will be given to STOMATE's carbon
+    !Config         offline forcing file
+    !Config         Compatible with Nicolas Viovy's driver
+    !Config Units = [FILE]
+    Cforcing_name = stomate_Cforcing_name
+    CALL getin_p('STOMATE_CFORCING_NAME',Cforcing_name)
+    
+    IF ( TRIM(Cforcing_name) /= 'NONE' ) THEN
+       
+       ! Time step of forcesoil
+       !Config Key   = FORCESOIL_STEP_PER_YEAR
+       !Config Desc  = Number of time steps per year for carbon spinup.
+       !Config If    = OK_STOMATE
+       !Config Def   = 365
+       !Config Help  = Number of time steps per year for carbon spinup.
+       !Config Units = [days, months, year]
+       nparan = 365
+       CALL getin_p('FORCESOIL_STEP_PER_YEAR', nparan)
+       
+       ! Correct if setting is out of bounds 
+       IF ( nparan < 1 ) nparan = 1
+       
+       !Config Key   = FORCESOIL_NB_YEAR
+       !Config Desc  = Number of years saved for carbon spinup.
+       !Config If    = OK_STOMATE
+       !Config Def   = 1
+       !Config Help  = Number of years saved for carbon spinup. If internal parameter cumul_Cforcing is TRUE in stomate.f90
+       !Config         Then this parameter is forced to one.
+       !Config Units = [years]
+       CALL getin_p('FORCESOIL_NB_YEAR', nbyear)
+       
+       ! Set ::nbyear to 1. if ::cumul_Cforcing=.TRUE.
+       IF ( cumul_Cforcing ) THEN
+          CALL ipslerr_p (1,'stomate', &
+               'Internal parameter cumul_Cforcing is TRUE in stomate.f90', &
+               'Parameter FORCESOIL_NB_YEAR is therefore forced to 1.', &
+               '::nbyear is thus set to 1.')
+          nbyear=1
+       ENDIF
+       
+       ! Make use of ::nparan to calculate ::dt_forcesoil
+       dt_forcesoil = zero
+       nparan = nparan+1
+       DO WHILE ( dt_forcesoil < dt_stomate/one_day )
+          nparan = nparan-1
+          IF ( nparan < 1 ) THEN
+             STOP 'Problem with number of soil forcing time steps ::nparan < 1.'
+          ENDIF
+          dt_forcesoil = one_year/REAL(nparan,r_std)
+       ENDDO
+       IF ( nparan > nparanmax ) THEN
+          STOP 'Problem with number of soil forcing time steps ::nparan > ::nparanmax'
+       ENDIF
+       WRITE(numout,*) 'Time step of soil forcing (d): ',dt_forcesoil
+       
+       ! Allocate memory for the forcing variables of soil dynamics
+       ALLOCATE( nforce(nparan*nbyear))
+       nforce(:) = 0
+             ALLOCATE(control_moist_above(kjpindex,nvm,nparan*nbyear))
+             ALLOCATE(control_moist_soil(kjpindex,nbdl,nvm,nparan*nbyear))
+             ALLOCATE(moist_soil(kjpindex,nbdl,nparan*nbyear))
+             ALLOCATE(soil_mc_Cforcing(kjpindex,nbdl,nstm,nparan*nbyear))
+             ALLOCATE(floodout_Cforcing(kjpindex,nparan*nbyear))
+             ALLOCATE(wat_flux0_Cforcing(kjpindex,nstm,nparan*nbyear))
+             ALLOCATE(wat_flux_Cforcing(kjpindex,nbdl,nstm,nparan*nbyear))
+             ALLOCATE(runoff_per_soil_Cforcing(kjpindex,nstm,nparan*nbyear))
+             ALLOCATE(drainage_per_soil_Cforcing(kjpindex,nstm,nparan*nbyear))
+             ALLOCATE(DOC_to_topsoil_Cforcing(kjpindex,nelements,nparan*nbyear))
+             ALLOCATE(DOC_to_subsoil_Cforcing(kjpindex,nelements,nparan*nbyear))
+             ALLOCATE(npp_equil(kjpindex,nparan*nbyear))
+             ALLOCATE(npp_tot(kjpindex))
+             ALLOCATE(control_temp_above(kjpindex,nlitt,nparan*nbyear))
+             ALLOCATE(control_temp_soil(kjpindex,nbdl,npool*2,nparan*nbyear))
+             ALLOCATE(soilcarbon_input(kjpindex,nvm,nbdl,npool,nelements,nparan*nbyear))
+             ALLOCATE(litter_above_Cforcing(kjpindex,nlitt,nvm,nelements,nparan*nbyear))
+             ALLOCATE(litter_below_Cforcing(kjpindex,nlitt,nvm,nbdl,nelements,nparan*nbyear))
+             ALLOCATE(lignin_struc_above_Cforcing(kjpindex,nvm,nparan*nbyear))
+             ALLOCATE(lignin_struc_below_Cforcing(kjpindex,nvm,nbdl,nparan*nbyear))       
+       ! Initialize variables, set to zero
+             control_moist_above(:,:,:) = zero
+             control_moist_soil(:,:,:,:) = zero
+             moist_soil(:,:,:) = zero
+             soil_mc_Cforcing(:,:,:,:) = zero
+             floodout_Cforcing(:,:) = zero
+             wat_flux0_Cforcing(:,:,:) = zero
+             wat_flux_Cforcing(:,:,:,:) = zero
+             runoff_per_soil_Cforcing(:,:,:) = zero
+             drainage_per_soil_Cforcing(:,:,:) = zero
+             DOC_to_topsoil_Cforcing(:,:,:) = zero
+             DOC_to_subsoil_Cforcing(:,:,:) = zero
+             npp_equil(:,:) = zero
+             npp_tot(:) = zero
+             control_temp_above(:,:,:) = zero
+             control_temp_soil(:,:,:,:) = zero
+             soilcarbon_input(:,:,:,:,:,:) = zero
+             litter_above_Cforcing(:,:,:,:,:) = zero
+             litter_below_Cforcing(:,:,:,:,:,:) = zero
+             lignin_struc_above_Cforcing(:,:,:) = zero
+             lignin_struc_below_Cforcing(:,:,:,:) = zero
+       
+    ENDIF ! Cforcing_name) /= 'NONE'
+    
+    !! 1.4.8 Calculate STOMATE's vegetation fractions from veget, veget_max
+    DO j=1,nvm
+       WHERE ((1.-totfrac_nobio(:)) > min_sechiba)       
+          ! Pixels with vegetation
+          veget_cov(:,j) = veget(:,j)/( 1.-totfrac_nobio(:) )
+          veget_cov_max(:,j) = veget_max(:,j)/( 1.-totfrac_nobio(:) )
+       ELSEWHERE
+          ! Pixels without vegetation
+          veget_cov(:,j) = zero
+          veget_cov_max(:,j) = zero
+       ENDWHERE
+    ENDDO ! Loop over PFTs
+
+    !! 1.4.9 Initialize non-zero variables
+    CALL stomate_var_init &
+         (kjpindex, veget_cov_max, leaf_age, leaf_frac, &
+         dead_leaves, &
+         veget, lai, deadleaf_cover, assim_param)
+    
+    ! Initialize land cover change variable
+    ! ??Should be integrated in the subroutine?? 
+    harvest_above(:) = zero
+    
+    ! Initialize temp_growth
+    temp_growth(:)=t2m_month(:)-tp_00 
+
+      
+  END SUBROUTINE stomate_initialize
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_main
+!!
+!>\BRIEF        Manages variable initialisation, reading and writing forcing 
+!! files, aggregating data at stomate's time step (dt_stomate), aggregating data
+!! at longer time scale (i.e. for phenology) and uses these forcing to calculate
+!! CO2 fluxes (NPP and respirations) and C-pools (litter, soil, biomass, ...)
+!!
+!! DESCRIPTION  : The subroutine manages 
+!! divers tasks:
+!! (1) Initializing all variables of stomate (first call)
+!! (2) Reading and writing forcing data (last call)
+!! (3) Adding CO2 fluxes to the IPCC history files
+!! (4) Converting the time steps of variables to maintain consistency between
+!! sechiba and stomate
+!! (5) Use these variables to call stomate_lpj, maint_respiration, littercalc,
+!! soilcarbon. The called subroutines handle: climate constraints 
+!! for PFTs, PFT dynamics, Phenology, Allocation, NPP (based on GPP and
+!! authothropic respiration), fire, mortality, vmax, assimilation temperatures,
+!! all turnover processes, light competition, sapling establishment, lai,  
+!! land cover change and litter and soil dynamics.
+!! (6) Use the spin-up method developed by Lardy (2011)(only if SPINUP_ANALYTIC 
+!! is set to TRUE).
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): deadleaf_cover, assim_param, lai, height, veget, 
+!! veget_max, resp_maint, 
+!! resp_hetero,resp_growth, co2_flux, fco2_lu.
+!!
+!! REFERENCES	: 
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!! \includegraphics[scale=0.5]{stomatemainflow.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+  
+SUBROUTINE stomate_main &
+       & (kjit, kjpij, kjpindex, &
+       &  index, lalo, neighbours, resolution, contfrac, totfrac_nobio, clay, &
+       &  t2m, t2m_min, temp_sol, stempdiag, &
+       &  humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, &
+       &  gpp, deadleaf_cover, assim_param, &
+       &  lai, frac_age, height, veget, veget_max, &
+       &  veget_max_new, totfrac_nobio_new, &
+       &  hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+       &  co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth,temp_growth,soil_mc, soiltile, &
+       &  litter_mc,floodout, runoff, drainage, wat_flux0, wat_flux,bulk_dens, soil_ph,&
+       &  drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, &
+       &  DOC_to_topsoil, DOC_to_subsoil)
+    
+    IMPLICIT NONE
+
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                       :: kjit              !! Time step number (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpindex          !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpij             !! Total size of the un-compressed grid (unitless)
+    INTEGER(i_std),INTENT(in)                       :: rest_id_stom      !! STOMATE's _Restart_ file identifier (unitless)
+    INTEGER(i_std),INTENT(in)                       :: hist_id_stom      !! STOMATE's _history_ file identifier (unitless)
+    INTEGER(i_std),INTENT(in)                       :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file identifier 
+                                                                         !! (unitless) 
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)   :: index             !! Indices of the pixels on the map. Stomate uses a 
+                                                                         !! reduced grid excluding oceans. ::index contains 
+                                                                         !! the indices of the terrestrial pixels only 
+                                                                         !! (unitless) 
+    INTEGER(i_std),DIMENSION(kjpindex,8),INTENT(in) :: neighbours        !! Neighoring grid points if land for the DGVM 
+                                                                         !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: lalo              !! Geographical coordinates (latitude,longitude) 
+                                                                         !! for pixels (degrees) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: resolution        !! Size in x an y of the grid (m) - surface area of 
+                                                                         !! the gridbox 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)   :: contfrac          !! Fraction of continent in the grid cell (unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: totfrac_nobio     !! Fraction of grid cell covered by lakes, land 
+                                                                         !! ice, cities, ... (unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: clay              !! Clay fraction of soil (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(inout)   :: bulk_dens         !! Soil bulk density (g cm-3)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: soil_ph           !! Soil pH (0-14, pH unit)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: humrel            !! Relative humidity ("moisture availability") 
+                                                                         !! (0-1, unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: t2m               !! 2 m air temperature (K)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: t2m_min           !! Minimum 2 m air temp. during forcing time step 
+                                                                         !! (K) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: temp_sol          !! Surface temperature (K)
+    REAL(r_std),DIMENSION(kjpindex,nbdl),INTENT(in) :: stempdiag         !! Soil temperature (K)
+    REAL(r_std),DIMENSION(kjpindex,nbdl),INTENT(in) :: shumdiag          !! Relative soil moisture (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: litterhumdiag     !! Litter humidity (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: precip_rain       !! Rain precipitation  
+                                                                         !! @tex $(mm dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: precip_snow       !! Snow precipitation  
+                                                                         !! @tex $(mm dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: gpp               !! GPP of total ground area  
+                                                                         !! @tex $(gC m^{-2} time step^{-1})$ @endtex 
+                                                                         !! Calculated in sechiba, account for vegetation 
+                                                                         !! cover and effective time step to obtain ::gpp_d 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: veget_max_new     !! New "maximal" coverage fraction of a PFT: only if 
+                                                                         !! vegetation is updated in slowproc
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: totfrac_nobio_new !! New fraction of nobio per gridcell
+    INTEGER(i_std),INTENT(in)                       :: hist_id           !! ?? [DISPENSABLE] SECHIBA's _history_ file 
+                                                                         !! identifier 
+    INTEGER(i_std),INTENT(in)                       :: hist2_id          !! ?? [DISPENSABLE] SECHIBA's _history_ file 2 
+                                                                         !! identifier 
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(in)  :: soil_mc   !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltile  !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in):: litter_mc        !! litter moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)   :: floodout          !! flux out of floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)   :: runoff            !! Complete runoff
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)   :: drainage          !! Drainage
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in)    :: wat_flux0           !! Water flux in the first soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(in)   :: wat_flux        !! Water flux in the soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)   :: runoff_per_soil     !! Runoff per soil type [mm]
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)   :: drainage_per_soil   !! Drainage per soil type [mm]
+    REAL(r_std),DIMENSION (kjpindex,nelements), INTENT(in)   :: DOC_to_topsoil  !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                                !! floodplains and from irrigation
+                                                                                !! @tex $(gC m^{-2} day{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex,nelements), INTENT(in)   :: DOC_to_subsoil  !! DOC inputs to bottom of the soil column, from returnflow
+                                                                                !! in swamps and lakes
+                                                                                !! @tex $(gC m^{-2} day{-1})$ @endtex
+    
+    !! 0.2 Output variables 
+
+    REAL(r_std),DIMENSION(kjpindex, nexp),INTENT(out) :: DOC_EXP_agg_d     !! DOC exports, diffrenet paths (nexp), in  
+                                                                           !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex  
+
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)   :: co2_flux          !! CO2 flux between atmosphere and biosphere per 
+                                                                           !! average ground area 
+                                                                           !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex  
+                                                                           !! [??CHECK] sign convention? 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)       :: fco2_lu           !! CO2 flux between atmosphere and biosphere from 
+                                                                           !! land-use (without forest management)  
+                                                                           !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex  
+                                                                           !! [??CHECK] sign convention? 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)   :: resp_maint        !! Maitenance component of autotrophic respiration in 
+                                                                           !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)   :: resp_growth       !! Growth component of autotrophic respiration in 
+                                                                           !! @tex ($gC m^{-2} dt_stomate^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm,nelements),INTENT(out) :: resp_hetero       !! Heterotrophic respiration in  
+                                                                           !! @tex $(gC m^{-2} dt_stomate^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)       :: temp_growth       !! Growth temperature (ÃÂ°C)  
+                                                                           !! Is equal to t2m_month 
+
+    !! 0.3 Modified
+   
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: lai            !! Leaf area inex @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)          :: veget          !! Fraction of vegetation type including 
+                                                                              !! non-biological fraction (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: veget_max      !! Maximum fraction of vegetation type including 
+                                                                              !! non-biological fraction (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: height         !! Height of vegetation (m)
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(inout) :: assim_param    !! min+max+opt temperatures (K) & vmax for 
+                                                                              !! photosynthesis  
+                                                                              !! @tex $(\mu mol m^{-2}s^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex),INTENT(inout)           :: deadleaf_cover !! Fraction of soil covered by dead leaves 
+                                                                              !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(inout):: frac_age    !! Age efficacity from STOMATE 
+
+    !! 0.4 local variables
+    
+    REAL(r_std)                                   :: dt_days_read             !! STOMATE time step read in restart file (days)
+    INTEGER(i_std)                                :: l,k,ji, jv, i, j, m      !! indices    
+    REAL(r_std),PARAMETER                         :: max_dt_days = 5.         !! Maximum STOMATE time step (days)
+    REAL(r_std)                                   :: hist_days                !! Writing frequency for history file (days)
+    REAL(r_std),DIMENSION(0:nbdl)                 :: z_soil                   !! Variable to store depth of the different soil 
+                                                                              !! layers (m) 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: rprof                    !! Coefficient of the exponential functions that 
+                                                                              !! relates root density to soil depth (unitless) 
+    REAL(r_std),DIMENSION(kjpindex)               :: cvegtot                  !! Total "vegetation" cover (unitless)
+    REAL(r_std),DIMENSION(kjpindex)               :: precip                   !! Total liquid and solid precipitation  
+                                                                              !! @tex $(??mm dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_d                    !! Gross primary productivity per ground area 
+                                                                              !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_daily_x              !! "Daily" gpp for teststomate  
+                                                                              !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nelements) :: resp_hetero_litter       !! Litter heterotrophic respiration per ground area 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex  
+                                                                              !! ??Same variable is also used to 
+                                                                              !! store heterotrophic respiration per ground area 
+                                                                              !! over ::dt_sechiba?? 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nelements)      :: resp_hetero_soil    !! soil heterotrophic respiration  
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nexp, nelements)    :: DOC_EXP        !! Exported DOC through runoff, drainage, flood,
+                                                                              !! The unit is give by m^2 of
+                                                                              !! water @tex $(fC m{-2} of ground)$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: veget_cov                !! Fractional coverage: actually share of the pixel 
+                                                                              !! covered by a PFT (fraction of ground area), 
+                                                                              !! taking into account LAI ??(= grid scale fpc)?? 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: veget_cov_max_new        !! New value for maximal fractional coverage (unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: vcmax                    !! Maximum rate of carboxylation
+                                                                              !! @tex $(\mumol m^{-2} s^{-1})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: control_moist_above_inst !! Moisture control of heterotrophic respiration  
+                                                                              !! (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex,nbdl,nvm)     :: control_moist_soil_inst  !! Moisture control of heterotrophic respiration 
+                                                                              !! (0-1,unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nbdl)          :: moist_soil_inst          !! Soil moiture daily (m3 H20 m-3 Soil)  
+    REAL(r_std),DIMENSION(kjpindex,nbdl,nstm)     :: soil_mc_Cforcing_inst    !! Soil moiture per soil type daily (m3 H20 m-3 Soil)
+    REAL(r_std),DIMENSION (kjpindex)              :: floodout_Cforcing_inst   !! flux out of floodplains
+    REAL(r_std),DIMENSION (kjpindex,nstm)         :: wat_flux0_Cforcing_inst  !! Water flux in the first soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm)    :: wat_flux_Cforcing_inst   !! Water flux in the soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (kjpindex,nstm)         :: runoff_per_soil_Cforcing_inst            !! Runoff per soil type [mm]
+    REAL(r_std),DIMENSION (kjpindex,nstm)         :: drainage_per_soil_Cforcing_inst          !! Drainage per soil type [mm]
+    REAL(r_std),DIMENSION (kjpindex,nelements)    :: DOC_to_topsoil_Cforcing_inst  !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                                   !! floodplains and from irrigation
+                                                                                   !! @tex $(gC m^{-2} day{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex,nelements)    :: DOC_to_subsoil_Cforcing_inst  !! DOC inputs to bottom of the soil column, from returnflow
+                                                                                   !! in swamps and lakes
+                                                                                   !! @tex $(gC m^{-2} day{-1})$ @endtex
+
+    REAL(r_std),DIMENSION(kjpindex,nlitt)               :: control_temp_above_inst  !! Temperature control of heterotrophic  
+                                                                              !! respiration, above (0-1, unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nbdl,npool*2)        :: control_temp_soil_inst   !! Temperature control of heterotrophic 
+                                                                              !! respiration, below (0-1, unitless) 
+
+    REAL(r_std),DIMENSION(kjpindex,nvm,nbdl,npool,nelements) :: soilcarbon_input_inst   !! Quantity of carbon going into DOC pools from 
+                                                                              !! litter decomposition 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nbdl,npool,nelements) :: DOC_input_inst !! Quantity of carbon going into dissolved organic carbon pools from 
+                                                                              !! litter decomposition 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nmbcomp,nelements)   :: check_intern  !! Contains the components of the internal
+                                                                              !! mass balance chech for this routine
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nelements) :: closure_intern          !! Check closure of internal mass balance
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nelements) :: pool_start              !! Start and end pool of this routine
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nelements) :: pool_end                !! Start and end pool of this routine
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex    
+    INTEGER(i_std)                                :: ier                      !! Check errors in netcdf call (unitless)
+    REAL(r_std)                                   :: sf_time                  !! Intermediate variable to calculate current time 
+                                                                              !! step 
+    INTEGER(i_std)                                :: max_totsize              !! Memory management - maximum memory size (Mb)
+    INTEGER(i_std)                                :: totsize_1step            !! Memory management - memory required to store one 
+                                                                              !! time step on one processor (Mb) 
+    INTEGER(i_std)                                :: totsize_tmp              !! Memory management - memory required to store one 
+                                                                              !! time step on all processors(Mb) 
+    REAL(r_std)                                   :: xn                       !! How many times have we treated in this forcing 
+    REAL(r_std), DIMENSION(kjpindex)              :: vartmp                   !! Temporary variable
+    INTEGER(i_std)                                :: vid                      !! Variable identifer of netCDF (unitless)
+    INTEGER(i_std)                                :: nneigh                   !! Number of neighbouring pixels
+    INTEGER(i_std)                                :: direct                   !! ??
+    INTEGER(i_std),DIMENSION(ndm)                 :: d_id                     !! ??
+    REAL(r_std)                                   :: net_co2_flux_monthly     !! ??[DISPENSABLE]
+    REAL(r_std)                                   :: net_co2_flux_monthly_sum !! ??[DISPENSABLE]
+
+    REAL(r_std)                                   :: net_cflux_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_cflux_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_harvest_above_monthly_sum !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_harvest_above_monthly_tot !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_biosp_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_biosp_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std), DIMENSION(kjpindex,nvm,nbpools)  :: carbon_stock                  !! Array containing the carbon stock for each pool
+                                                                                   !! used by ORCHIDEE
+
+!_ ================================================================================================================================
+    
+  !! 1. Initialize variables
+
+    !! 1.1 Store current time step in a common variable
+    itime = kjit
+    
+    !![DISPENSABLE] 1.2 Copy the depth of the different soil layers from diaglev specified in slow_proc
+															
+    !! 1.3 PFT rooting depth across pixels, humescte is pre-defined 
+    ! (constantes_veg.f90). It is defined as the coefficient of an exponential 
+    ! function relating root density to depth 
+    DO j=1,nvm
+       rprof(:,j) = 1./humcste(j)
+    ENDDO
+    
+    !! 1.4 Initialize first call
+    ! Set growth respiration to zero
+    resp_growth=zero
+
+    ! Check that initialization is done
+    IF (l_first_stomate) CALL ipslerr_p(3,'stomate_main','Initialization not yet done.','','')
+    
+    IF (printlev >= 4) THEN
+       WRITE(numout,*) 'stomate_main: date=',date,' ymds=', year, month, day, sec, ' itime=', itime, ' do_slow=',do_slow
+    ENDIF
+
+!! 3. Special treatment for some input arrays.
+    
+    !! 3.1 Sum of liquid and solid precipitation
+    precip(:) = ( precip_rain(:) + precip_snow(:) )*one_day/dt_sechiba
+    
+    !! 3.2 Calculate STOMATE's vegetation fractions from veget and veget_max
+    DO j=1,nvm 
+       WHERE ((1.-totfrac_nobio(:)) > min_sechiba)
+          ! Pixels with vegetation
+          veget_cov(:,j) = veget(:,j)/( 1.-totfrac_nobio(:) )
+          veget_cov_max(:,j) = veget_max(:,j)/( 1.-totfrac_nobio(:) )
+       ELSEWHERE
+          ! Pixels without vegetation
+          veget_cov(:,j) = zero
+          veget_cov_max(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    IF ( do_now_stomate_lcchange ) THEN
+       DO j=1,nvm
+          WHERE ((1.-totfrac_nobio_new(:)) > min_sechiba)
+             ! Pixels with vegetation
+             veget_cov_max_new(:,j) = veget_max_new(:,j)/( 1.-totfrac_nobio_new(:) )
+          ELSEWHERE
+             ! Pixels without vegetation
+             veget_cov_max_new(:,j) = zero
+          ENDWHERE
+       ENDDO
+    ENDIF
+
+    !! 3.3 Adjust time step of GPP 
+    ! No GPP for bare soil
+    gpp_d(:,1) = zero
+    ! GPP per PFT
+    DO j = 2,nvm   
+       WHERE (veget_cov_max(:,j) > min_stomate)
+          ! The PFT is available on the pixel
+          gpp_d(:,j) =  gpp(:,j)/ veget_cov_max(:,j)* one_day/dt_sechiba  
+       ELSEWHERE
+          ! The PFT is absent on the pixel
+          gpp_d(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !! 3.4 The first time step of the first day of the month  
+    ! implies that the month is over
+    IF ( day == 1 .AND. sec .LT. dt_sechiba ) THEN
+       EndOfMonth=.TRUE.
+    ELSE
+       EndOfMonth=.FALSE.
+    ENDIF
+    
+
+  !! 4. Calculate variables for dt_stomate (i.e. "daily")
+
+    ! Note: If dt_days /= 1, then variables 'xx_daily' (eg. half-daily or bi-daily) are by definition
+    ! not expressed on a daily basis. This is not a problem but could be
+    ! confusing
+
+    !! 4.1 Accumulate instantaneous variables (do_slow=.FALSE.) 
+    ! Accumulate instantaneous variables (do_slow=.FALSE.) and eventually 
+    ! calculate daily mean value (do_slow=.TRUE.) 
+    CALL stomate_accu (kjpindex, nvm,  do_slow, humrel,        humrel_daily)
+    CALL stomate_accu (kjpindex,    1, do_slow, litterhumdiag, litterhum_daily)
+    CALL stomate_accu (kjpindex,    1, do_slow, t2m,           t2m_daily)
+    CALL stomate_accu (kjpindex,    1, do_slow, temp_sol,      tsurf_daily)
+    CALL stomate_accu (kjpindex, nbdl, do_slow, stempdiag,     tsoil_daily)
+    CALL stomate_accu (kjpindex, nbdl, do_slow, shumdiag,      soilhum_daily)
+    CALL stomate_accu (kjpindex,    1, do_slow, precip,        precip_daily)
+    CALL stomate_accu (kjpindex, nvm,  do_slow, gpp_d,         gpp_daily)
+   
+    !! 4.2 Daily minimum temperature
+    t2m_min_daily(:) = MIN( t2m_min(:), t2m_min_daily(:) )
+
+    !! 4.3 Calculate maintenance respiration
+    ! Note: lai is passed as output argument to overcome previous problems with 
+    ! natural and agricultural vegetation types. 
+    CALL maint_respiration &
+         & (kjpindex,lai,t2m,t2m_longterm,stempdiag,height,veget_cov_max, &
+         & rprof,biomass,resp_maint_part_radia)
+    
+    ! Aggregate maintenance respiration across the different plant parts 
+    resp_maint_radia(:,:) = zero
+    DO j=2,nvm
+       DO k= 1, nparts
+          resp_maint_radia(:,j) = resp_maint_radia(:,j) &
+               & + resp_maint_part_radia(:,j,k)
+       ENDDO
+    ENDDO
+    
+    ! Maintenance respiration separated by plant parts
+    resp_maint_part(:,:,:) = resp_maint_part(:,:,:) &
+         & + resp_maint_part_radia(:,:,:)
+
+    !! 4.4 Litter dynamics and litter heterothropic respiration 
+    ! Including: litter update, lignin content, PFT parts, litter decay,
+    ! litter heterotrophic respiration, dead leaf soil cover.
+    turnover_littercalc(:,:,:,:) = turnover_daily(:,:,:,:) * dt_sechiba/one_day
+    bm_to_littercalc(:,:,:,:)    = bm_to_litter(:,:,:,:) * dt_sechiba/one_day       
+    CALL littercalc (kjpindex, dt_sechiba/one_day, &
+         turnover_littercalc, bm_to_littercalc, &
+         veget_cov_max, temp_sol, stempdiag, shumdiag, litterhumdiag, rprof, &
+         litterpart, litter_above, litter_below, dead_leaves, &
+         lignin_struc_above, lignin_struc_below, &
+         deadleaf_cover, resp_hetero_litter, &
+         control_temp_above_inst, control_temp_soil_inst, &
+         control_moist_above_inst, control_moist_soil_inst, &
+         litter_mc,soilcarbon_input_inst, soil_mc, soiltile, &
+         clay, bulk_dens, soil_ph, carbon)
+    
+    ! Heterothropic litter respiration during time step ::dt_sechiba @tex $(gC m^{-2})$ @endtex
+    resp_hetero_litter(:,:,icarbon) = resp_hetero_litter(:,:,icarbon) * dt_sechiba/one_day
+    resp_hetero_litter(:,:,icarbon14) = resp_hetero_litter(:,:,icarbon14) * dt_sechiba/one_day
+    
+    !! 4.5 Soil carbon dynamics and soil heterotrophic respiration
+    ! Note: there is no vertical discretisation in the soil for litter decay.
+    CALL soilcarbon (kjpindex, dt_sechiba/one_day, clay, &
+         soilcarbon_input_inst, control_temp_soil_inst, control_moist_soil_inst, &
+         carbon, resp_hetero_soil,litter_above,litter_below,&
+         shumdiag,DOC, moist_soil_inst,DOC_EXP, lignin_struc_above, &
+         lignin_struc_below, floodout, runoff_per_soil, drainage_per_soil, wat_flux0,&
+         wat_flux,bulk_dens,soil_ph, veget_cov_max, soil_mc, soiltile,&
+         DOC_to_topsoil, DOC_to_subsoil)
+    
+    ! Heterothropic soil respiration during time step ::dt_sechiba @tex $(gC m^{-2})$ @endtex 
+    resp_hetero_soil(:,:,icarbon) = resp_hetero_soil(:,:,icarbon) * dt_sechiba/one_day
+    resp_hetero_soil(:,:,icarbon14) = resp_hetero_soil(:,:,icarbon14) * dt_sechiba/one_day
+
+    ! Total heterothrophic respiration during time step ::dt_sechiba @tex $(gC m^{-2})$ @endtex
+    resp_hetero_radia(:,:,icarbon) = resp_hetero_litter(:,:,icarbon) + resp_hetero_soil(:,:,icarbon)
+    resp_hetero_d(:,:,icarbon) = resp_hetero_d(:,:,icarbon) + resp_hetero_radia(:,:,icarbon)
+    resp_hetero_radia(:,:,icarbon14) = resp_hetero_litter(:,:,icarbon14) + resp_hetero_soil(:,:,icarbon14)
+    resp_hetero_d(:,:,icarbon14) = resp_hetero_d(:,:,icarbon14) + resp_hetero_radia(:,:,icarbon14)
+    ! Export of DOC during the time step ::dt_sechiba @tex $(gC m^{-3})$ @endtex
+    DOC_EXP_d(:,:,:,:)=DOC_EXP_d(:,:,:,:)+DOC_EXP(:,:,:,:)* dt_sechiba/one_day
+    
+    ! Accumulate DOC export per pixel and hydrological pathway for use as output variable
+    ! Aggregate from DOC_EXP_d
+    DO k=1,kjpindex
+       DO l=1, nexp
+          DOC_EXP_agg_d(k,l) = zero
+          DO m=1,13
+             IF (.NOT. ISNAN(DOC_EXP_d(k,m,l,icarbon))) THEN
+                IF ((DOC_EXP_d(k,m,l,icarbon) .GT. zero).AND.(DOC_EXP_d(k,m,l,icarbon) .LT. 1e6)) THEN 
+                   DOC_EXP_agg_d(k,l) = DOC_EXP_agg_d(k,l) + DOC_EXP_d(k,m,l,icarbon)
+                ELSE 
+                ! Do nothing
+                ENDIF
+             ELSE
+                !Do nothing
+             ENDIF
+          ENDDO !m=1,13
+          IF(ISNAN(DOC_EXP_agg_d(k,l))) WRITE(*,*) 'NaN in DOC_EXP_agg_d at position ', k,' for path ',l 
+       ENDDO ! l=1, nexp
+    ENDDO !k=1,kjpindex
+    
+    !! 4.6 Accumulate instantaneous variables (do_slow=.FALSE.) 
+    ! Accumulate instantaneous variables (do_slow=.FALSE.) and eventually 
+    ! calculate daily mean value (do_slow=.TRUE.) 
+    DO i= 1,nvm
+       CALL stomate_accu (kjpindex, 1, &
+        & do_slow, control_moist_above_inst(:,i), &
+        & control_moist_above_daily(:,i))
+       CALL stomate_accu (kjpindex, nbdl, &
+        & do_slow, control_moist_soil_inst(:,:,i),&
+        & control_moist_soil_daily(:,:,i))
+    ENDDO
+
+    CALL stomate_accu (kjpindex, nbdl, &
+     & do_slow, moist_soil_inst,&
+     & moist_soil_daily)
+    DO i= 1,nstm
+       CALL stomate_accu (kjpindex, nbdl, &
+        & do_slow, soil_mc(:,:,i),&
+        & soil_mc_Cforcing_daily(:,:,i))
+    ENDDO
+    CALL stomate_accu (kjpindex, 1, &
+     & do_slow, floodout,&
+     & floodout_Cforcing_daily)
+    CALL stomate_accu (kjpindex, nstm, &
+     & do_slow, wat_flux0,&
+     & wat_flux0_Cforcing_daily)
+    DO i= 1,nstm
+       CALL stomate_accu (kjpindex, nbdl, &
+        & do_slow, wat_flux(:,:,i),&
+        & wat_flux_Cforcing_daily(:,:,i))
+    ENDDO
+    CALL stomate_accu (kjpindex, nstm, &
+     & do_slow, runoff_per_soil,&
+     & runoff_per_soil_Cforcing_daily)
+    CALL stomate_accu (kjpindex, nstm, &
+     & do_slow, drainage_per_soil,&
+     & drainage_per_soil_Cforcing_daily)
+    CALL stomate_accu (kjpindex, nelements, &
+     & do_slow, DOC_to_topsoil,&
+     & DOC_to_topsoil_Cforcing_daily)
+    CALL stomate_accu (kjpindex, nelements, &
+     & do_slow, DOC_to_subsoil,&
+     & DOC_to_subsoil_Cforcing_daily)
+    DO i = 1, nlitt
+       CALL stomate_accu (kjpindex, 1, & 
+        & do_slow, control_temp_above_inst(:,i),  & 
+        & control_temp_above_daily(:,i))
+    ENDDO
+    DO i = 1,2*npool
+       CALL stomate_accu (kjpindex, nbdl, &
+        & do_slow, control_temp_soil_inst(:,:,i),&
+        & control_temp_soil_daily(:,:,i))
+    ENDDO
+    DO j = 1,nbdl
+       DO i = 1,npool
+          DO k = 1, nelements
+          CALL stomate_accu (kjpindex, nvm, &
+               & do_slow, soilcarbon_input_inst(:,:,j,i,k), soilcarbon_input_daily(:,:,j,i,k))
+          ENDDO
+       ENDDO
+    ENDDO
+!! 5. Daily processes - performed at the end of the day
+    
+    IF (do_slow) THEN
+
+       !! 5.1 Update lai
+       ! Use lai from stomate
+       ! ?? check if this is the only time ok_pheno is used??
+       ! ?? Looks like it is the only time. But this variables probably is defined 
+       ! in stomate_constants or something, in which case, it is difficult to track.
+       IF (ok_pheno) THEN
+          !! 5.1.1 Update LAI 
+          ! Set lai of bare soil to zero
+          lai(:,ibare_sechiba) = zero
+          ! lai for all PFTs
+          DO j = 2, nvm
+             lai(:,j) = biomass(:,j,ileaf,icarbon)*sla(j)
+          ENDDO
+          frac_age(:,:,:) = leaf_frac(:,:,:)
+       ELSE 
+          ! 5.1.2 Use a prescribed lai
+          ! WARNING: code in setlai is identical to the lines above
+          ! Update subroutine if LAI has to be forced 
+          CALL  setlai(kjpindex,lai) 
+          frac_age(:,:,:) = zero
+       ENDIF
+
+       !! 5.2 Calculate long-term "meteorological" and biological parameters
+       ! mainly in support of calculating phenology. If ::EndOfYear=.TRUE.
+       ! annual values are update (i.e. xx_lastyear).
+       CALL season &
+            &          (kjpindex, dt_days, EndOfYear, &
+            &           veget_cov, veget_cov_max, &
+            &           humrel_daily, t2m_daily, tsoil_daily, soilhum_daily, lalo, &
+            &           precip_daily, npp_daily, biomass, &
+            &           turnover_daily, gpp_daily, when_growthinit, &
+            &           maxhumrel_lastyear, maxhumrel_thisyear, &
+            &           minhumrel_lastyear, minhumrel_thisyear, &
+            &           maxgppweek_lastyear, maxgppweek_thisyear, &
+            &           gdd0_lastyear, gdd0_thisyear, &
+            &           precip_lastyear, precip_thisyear, &
+            &           lm_lastyearmax, lm_thisyearmax, &
+            &           maxfpc_lastyear, maxfpc_thisyear, &
+            &           humrel_month, humrel_week, t2m_longterm, tau_longterm, &
+            &           t2m_month, t2m_week, tsoil_month, soilhum_month, &
+            &           npp_longterm, turnover_longterm, gpp_week, &
+            &           gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+            &           time_hum_min, hum_min_dormance, gdd_init_date, &
+            &           gdd_from_growthinit, herbivores, &
+            &           Tseason, Tseason_length, Tseason_tmp, &
+            &           Tmin_spring_time, t2m_min_daily, begin_leaves, onset_date)
+       
+       !! 5.3 Use all processes included in stomate
+
+       !! 5.3.1  Activate stomate processes 
+       ! Activate stomate processes (the complete list of processes depends 
+       ! on whether the DGVM is used or not). Processes include: climate constraints 
+       ! for PFTs, PFT dynamics, Phenology, Allocation, NPP (based on GPP and
+       ! authothropic respiration), fire, mortality, vmax, assimilation temperatures,
+       ! all turnover processes, light competition, sapling establishment, lai and 
+       ! land cover change.
+       CALL StomateLpj &
+            &            (kjpindex, dt_days, &
+            &             neighbours, resolution, &
+            &             clay, herbivores, &
+            &             tsurf_daily, tsoil_daily, t2m_daily, t2m_min_daily, &
+            &             litterhum_daily, soilhum_daily, &
+            &             maxhumrel_lastyear, minhumrel_lastyear, &
+            &             gdd0_lastyear, precip_lastyear, &
+            &             humrel_month, humrel_week, t2m_longterm, t2m_month, t2m_week, &
+            &             tsoil_month, soilhum_month, &
+            &             gdd_m5_dormance,  gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+            &             turnover_longterm, gpp_daily, &
+            &             time_hum_min, maxfpc_lastyear, resp_maint_part,&
+            &             PFTpresent, age, fireindex, firelitter, &
+            &             leaf_age, leaf_frac, biomass, ind, adapted, regenerate, &
+            &             senescence, when_growthinit, litterpart, litter_above, litter_below, &
+            &             dead_leaves, carbon, DOC, DOC_EXP_d, lignin_struc_above, &
+            &             veget_cov_max, veget_cov_max_new, npp_longterm, lm_lastyearmax, &
+            &             veget_lastlight, everywhere, need_adjacent, RIP_time, &
+            &             lai, rprof,npp_daily, turnover_daily, turnover_time,&
+            &             soilcarbon_input_inst, &
+            &             co2_to_bm_dgvm, co2_fire, &
+            &             resp_hetero_d, resp_maint_d, resp_growth_d, &
+            &             height, deadleaf_cover, vcmax, &
+            &             bm_to_litter,&
+            &             prod10, prod100, flux10, flux100, &
+            &             convflux, cflux_prod10, cflux_prod100, harvest_above, carb_mass_total, &
+            &             fpc_max, &
+            &             Tseason, Tmin_spring_time, begin_leaves, onset_date, moist_soil_daily)
+       
+       !! 5.3.2 Calculate the total CO2 flux from land use change
+       fco2_lu(:) = convflux(:) &
+            &             + cflux_prod10(:)  &
+            &             + cflux_prod100(:) &
+            &             + harvest_above(:)
+       
+       !! 5.4 Calculate veget and veget_max
+       veget_max(:,:) = zero 
+       DO j = 1, nvm
+          veget_max(:,j) = veget_max(:,j) + &
+               & veget_cov_max(:,j) * ( 1.-totfrac_nobio(:) )
+       ENDDO
+       
+       !! 5.5 Photosynthesis parameters
+       assim_param(:,:,ivcmax) = zero
+       DO j = 2,nvm
+          assim_param(:,j,ivcmax) = vcmax(:,j)
+       ENDDO
+       
+       !! 5.6 Update forcing variables for soil carbon
+       IF (TRIM(Cforcing_name) /= 'NONE') THEN
+          npp_tot(:) = 0
+          DO j=2,nvm
+             npp_tot(:) = npp_tot(:) + npp_daily(:,j)
+          ENDDO
+          ! ::nbyear Number of years saved for carbon spinup
+          sf_time = MODULO(REAL(date,r_std)-1,one_year*REAL(nbyear,r_std))
+          iatt=FLOOR(sf_time/dt_forcesoil) + 1
+          IF (iatt == 0) iatt = iatt_old + 1
+          IF ((iatt<iatt_old) .and. (.not. cumul_Cforcing)) THEN
+             nforce(:)=0
+                soilcarbon_input(:,:,:,:,:,:) = zero
+                control_moist_above(:,:,:) = zero
+                control_moist_soil(:,:,:,:) = zero
+                moist_soil(:,:,:) = zero
+                soil_mc_Cforcing(:,:,:,:) = zero
+                floodout_Cforcing(:,:) = zero
+                wat_flux0_Cforcing(:,:,:) = zero
+                wat_flux_Cforcing(:,:,:,:) = zero
+                runoff_per_soil_Cforcing(:,:,:) = zero
+                drainage_per_soil_Cforcing(:,:,:) = zero
+                DOC_to_topsoil_Cforcing(:,:,:) = zero
+                DOC_to_subsoil_Cforcing(:,:,:) = zero
+                control_temp_above(:,:,:) = zero
+                control_temp_soil(:,:,:,:) = zero
+                litter_above_Cforcing(:,:,:,:,:) = zero
+                litter_below_Cforcing(:,:,:,:,:,:) = zero
+                npp_equil(:,:) = zero
+                lignin_struc_above_Cforcing(:,:,:) = zero
+                lignin_struc_below_Cforcing(:,:,:,:) = zero
+             ENDIF
+             iatt_old = iatt
+             ! Update forcing
+             nforce(iatt) = nforce(iatt)+1
+             soilcarbon_input(:,:,:,:,:,iatt) = soilcarbon_input(:,:,:,:,:,iatt) + soilcarbon_input_daily(:,:,:,:,:)
+             litter_above_Cforcing(:,:,:,:,iatt) = litter_above_Cforcing(:,:,:,:,iatt) + litter_above(:,:,:,:)
+             litter_below_Cforcing(:,:,:,:,:,iatt) = litter_below_Cforcing(:,:,:,:,:,iatt) + litter_below(:,:,:,:,:)
+             control_moist_above(:,:,iatt) = control_moist_above(:,:,iatt) + control_moist_above_daily(:,:)
+             control_moist_soil(:,:,:,iatt) = control_moist_soil(:,:,:,iatt) + control_moist_soil_daily(:,:,:)
+             moist_soil(:,:,iatt) = moist_soil(:,:,iatt) + moist_soil_daily(:,:)
+             soil_mc_Cforcing(:,:,:,iatt) = soil_mc_Cforcing(:,:,:,iatt) + soil_mc_Cforcing_daily(:,:,:)
+             floodout_Cforcing(:,iatt) = floodout_Cforcing(:,iatt) + floodout_Cforcing_daily(:)
+             wat_flux0_Cforcing(:,:,iatt) = wat_flux0_Cforcing(:,:,iatt) + wat_flux0_Cforcing_daily(:,:)
+             wat_flux_Cforcing(:,:,:,iatt) = wat_flux_Cforcing(:,:,:,iatt) + wat_flux_Cforcing_daily(:,:,:)
+             runoff_per_soil_Cforcing(:,:,iatt) = runoff_per_soil_Cforcing(:,:,iatt) + runoff_per_soil_Cforcing_daily(:,:)
+             drainage_per_soil_Cforcing(:,:,iatt) = drainage_per_soil_Cforcing(:,:,iatt) + drainage_per_soil_Cforcing_daily(:,:)
+             DOC_to_topsoil_Cforcing(:,:,iatt) = DOC_to_topsoil_Cforcing(:,:,iatt) + DOC_to_topsoil_Cforcing_daily(:,:)
+             DOC_to_subsoil_Cforcing(:,:,iatt) = DOC_to_subsoil_Cforcing(:,:,iatt) + DOC_to_subsoil_Cforcing_daily(:,:)
+             control_temp_above(:,:,iatt) = control_temp_above(:,:,iatt) + control_temp_above_daily(:,:)
+             control_temp_soil(:,:,:,iatt) = control_temp_soil(:,:,:,iatt) + control_temp_soil_daily(:,:,:)
+             npp_equil(:,iatt) = npp_equil(:,iatt) + npp_tot(:)
+             lignin_struc_above_Cforcing(:,:,iatt) = lignin_struc_above_Cforcing(:,:,iatt) + lignin_struc_above(:,:)
+             lignin_struc_below_Cforcing(:,:,:,iatt) = lignin_struc_below_Cforcing(:,:,:,iatt) + lignin_struc_below(:,:,:)
+          ENDIF
+       
+       !! 5.8 Write forcing file if ::ok_co2=.TRUE.
+       ! Note: if STOMATE is run in coupled mode the forcing file is written
+       ! If run in stand-alone mode, the forcing file is read!
+       IF ( ok_co2 .AND. TRIM(forcing_name) /= 'NONE' ) THEN
+          
+          !! 5.8.1 Convert GPP to sechiba time steps
+          ! GPP is multiplied by coverage to obtain forcing @tex $(gC m^{-2} dt_stomate^{-1})$\f \end@tex $(m^2 m^{-2})$ @endtexonly
+          ! @tex$ m^{-2}$ @endtex remains in the units because ::veget_cov_max is a fraction, not a 
+          ! surface area. In sechiba values are ponderated by surface and frac_no_bio. 
+          ! At the beginning of stomate, the units are converted. 
+          ! When we use forcesoil we call sechiba_main and so we need the have the same units as in sechiba.
+          gpp_daily_x(:,:) = zero
+          DO j = 2, nvm             
+             gpp_daily_x(:,j) = gpp_daily_x(:,j) + &
+              & gpp_daily(:,j) * dt_stomate / one_day * veget_cov_max(:,j)
+          ENDDO
+          
+          ! Bare soil moisture availability has not been treated
+          ! in STOMATE, update it here
+          humrel_daily(:,ibare_sechiba) = humrel(:,ibare_sechiba)   
+
+          ! Update index to store the next forcing step in memory
+          iisf = iisf+1
+
+          ! How many times have we treated this forcing state
+          xn = REAL(nf_cumul(isf(iisf)),r_std)
+          
+          !! 5.8.2 Cumulate forcing variables
+          ! Cumulate forcing variables (calculate average)
+          ! Note: precipitation is multiplied by dt_stomate/one_day to be consistent with 
+          ! the units in sechiba
+          IF (cumul_forcing) THEN
+             clay_fm(:,iisf) = (xn*clay_fm(:,iisf)+clay(:))/(xn+1.)
+             soil_ph_fm(:,iisf) = (xn*soil_ph_fm(:,iisf)+soil_ph(:))/(xn+1.)
+             bulk_dens_fm(:,iisf) = (xn*bulk_dens_fm(:,iisf)+bulk_dens(:))/(xn+1.)
+             humrel_daily_fm(:,:,iisf) = &
+                  & (xn*humrel_daily_fm(:,:,iisf) + humrel_daily(:,:))/(xn+1.)
+             litterhum_daily_fm(:,iisf) = &
+                  & (xn*litterhum_daily_fm(:,iisf)+litterhum_daily(:))/(xn+1.)
+             t2m_daily_fm(:,iisf) = &
+                  & (xn*t2m_daily_fm(:,iisf)+t2m_daily(:))/(xn+1.)
+             t2m_min_daily_fm(:,iisf) = &
+                  & (xn*t2m_min_daily_fm(:,iisf)+t2m_min_daily(:))/(xn+1.)
+             tsurf_daily_fm(:,iisf) = &
+                  & (xn*tsurf_daily_fm(:,iisf)+tsurf_daily(:))/(xn+1.)
+             tsoil_daily_fm(:,:,iisf) = &
+                  & (xn*tsoil_daily_fm(:,:,iisf)+tsoil_daily(:,:))/(xn+1.)
+             soilhum_daily_fm(:,:,iisf) = &
+                  & (xn*soilhum_daily_fm(:,:,iisf)+soilhum_daily(:,:))/(xn+1.)
+             precip_fm(:,iisf) = &
+                  & (xn*precip_fm(:,iisf)+precip_daily(:)*dt_stomate/one_day)/(xn+1.)
+             gpp_daily_fm(:,:,iisf) = &
+                  & (xn*gpp_daily_fm(:,:,iisf) + gpp_daily_x(:,:))/(xn+1.)
+             veget_fm(:,:,iisf) = &
+                  & (xn*veget_fm(:,:,iisf) + veget(:,:) )/(xn+1.)
+             veget_max_fm(:,:,iisf) = &
+                  & (xn*veget_max_fm(:,:,iisf) + veget_max(:,:) )/(xn+1.)
+             lai_fm(:,:,iisf) = &
+                  & (xn*lai_fm(:,:,iisf) + lai(:,:) )/(xn+1.)
+          ELSE
+             ! Here we just calculate the values
+             clay_fm(:,iisf) = clay(:)
+             soil_ph_fm(:,iisf) = soil_ph(:)
+             bulk_dens_fm(:,iisf) = bulk_dens(:)
+             humrel_daily_fm(:,:,iisf) = humrel_daily(:,:)
+             litterhum_daily_fm(:,iisf) = litterhum_daily(:)
+             t2m_daily_fm(:,iisf) = t2m_daily(:)
+             t2m_min_daily_fm(:,iisf) =t2m_min_daily(:)
+             tsurf_daily_fm(:,iisf) = tsurf_daily(:)
+             tsoil_daily_fm(:,:,iisf) =tsoil_daily(:,:)
+             soilhum_daily_fm(:,:,iisf) =soilhum_daily(:,:)
+             precip_fm(:,iisf) = precip_daily(:)
+             gpp_daily_fm(:,:,iisf) =gpp_daily_x(:,:)
+             veget_fm(:,:,iisf) = veget(:,:)
+             veget_max_fm(:,:,iisf) =veget_max(:,:)
+             lai_fm(:,:,iisf) =lai(:,:)
+          ENDIF
+          nf_cumul(isf(iisf)) = nf_cumul(isf(iisf))+1
+
+          ! 5.8.3 Do we have to write the forcing states?
+          IF (iisf == nsfm) THEN
+
+             !! 5.8.3.1 Write these forcing states
+             CALL forcing_write(forcing_id,1,nsfm)
+             ! determine which forcing states must be read
+             isf(1) = isf(nsfm)+1
+             IF ( isf(1) > nsft ) isf(1) = 1
+             DO iisf = 2, nsfm
+                isf(iisf) = isf(iisf-1)+1
+                IF (isf(iisf) > nsft)  isf(iisf) = 1
+             ENDDO
+
+             ! Read forcing variables - for debug use only
+             ! CALL forcing_read(forcing_id,nsfm)
+             iisf = 0
+
+          ENDIF
+
+       ENDIF
+
+
+       !! 5.9 Compute daily CO2 flux (AR5 output - not essential)
+       ! CO2 flux in @tex $gC m^{-2} s^{-1}$ @endtex (positive towards the atmosphere) is sum of:
+       ! (1) heterotrophic respiration from ground + (2) maintenance respiration 
+       ! from the plants + (3) growth respiration from the plants + (4) co2 
+       ! emissions from fire - (5) co2 taken up in the DGVM to establish 
+       ! saplings - (6) co2 taken up by photosyntyhesis
+       co2_flux_daily(:,:)=   &
+            & resp_maint_d(:,:) + resp_growth_d(:,:) + resp_hetero_d(:,:,icarbon) + &
+            & co2_fire(:,:) - co2_to_bm_dgvm(:,:) - gpp_daily(:,:)
+     CALL xios_orchidee_send_field("nep",SUM(co2_flux_daily*veget_cov_max,dim=2)/1e3/one_day*contfrac)
+
+       IF ( hist_id_stom_IPCC > 0 ) THEN
+          vartmp(:) = SUM(co2_flux_daily*veget_cov_max,dim=2)/1e3/one_day*contfrac
+          CALL histwrite_p (hist_id_stom_IPCC, "nep", itime, &
+               vartmp, kjpindex, hori_index)
+       ENDIF
+
+       ! See 5.9 for details on NEP + fire. At the monthly time step also 
+       ! harvest and land use change are calculated
+       co2_flux_monthly(:,:) = co2_flux_monthly(:,:) + co2_flux_daily(:,:)
+       harvest_above_monthly(:) = harvest_above_monthly(:) + harvest_above(:)
+       cflux_prod_monthly(:) = cflux_prod_monthly(:) + convflux(:) + & 
+        & cflux_prod10(:) + cflux_prod100(:)
+      
+       !! 5.10 Compute monthly CO2 fluxes 
+       IF ( EndOfMonth ) THEN
+          !! 5.10.1 Write history file for monthly fluxes
+          CALL histwrite_p (hist_id_stomate, 'CO2FLUX', itime, &
+               co2_flux_monthly, kjpindex*nvm, horipft_index)
+          
+          !?? I (=VB) translated the French, but the whole stuff does not make sense to me.
+          ! If one deletes the montly cumulation,
+          ! one should not forget this change in resolution(:,1)*resolution(:,2)*contfrac(:)
+          ! Si on supprimer le cumul par mois, 
+          ! il ne faut pas oublier cette modif resolution(:,1)*resolution(:,2)*contfrac(:)
+          ! Should be supressed, this is post-processing 
+          DO j=2, nvm
+             co2_flux_monthly(:,j) = co2_flux_monthly(:,j)* &
+                  resolution(:,1)*resolution(:,2)*contfrac(:)
+          ENDDO
+
+          ! Should be supressed, this is post-processing
+          ! ?? How does it differ from co2_flux_monthly??
+          net_co2_flux_monthly = zero
+          DO ji=1,kjpindex
+             DO j=2,nvm
+                net_co2_flux_monthly = net_co2_flux_monthly + &
+                     &  co2_flux_monthly(ji,j)*veget_cov_max(ji,j)
+             ENDDO
+          ENDDO
+
+     
+          !! 5.10.2 Cumulative fluxes of land use cover change, harvest and net biosphere production
+          ! Parallel processing, gather the information from different processors. first argument is the lo
+          ! local variable, the second argument is the global variable. bcast send it to all processors.
+          net_cflux_prod_monthly_sum = &
+              &  SUM(cflux_prod_monthly(:)*resolution(:,1)*resolution(:,2)*contfrac(:))*1e-15
+          CALL reduce_sum(net_cflux_prod_monthly_sum,net_cflux_prod_monthly_tot)
+          CALL bcast(net_cflux_prod_monthly_tot)
+          net_harvest_above_monthly_sum = &
+             &   SUM(harvest_above_monthly(:)*resolution(:,1)*resolution(:,2)*contfrac(:))*1e-15
+          CALL reduce_sum(net_harvest_above_monthly_sum,net_harvest_above_monthly_tot)
+          CALL bcast(net_harvest_above_monthly_tot)
+          net_co2_flux_monthly = net_co2_flux_monthly*1e-15
+          CALL reduce_sum(net_co2_flux_monthly,net_co2_flux_monthly_sum)
+          CALL bcast(net_co2_flux_monthly_sum)
+          net_biosp_prod_monthly_tot =  &
+             & ( net_co2_flux_monthly_sum + net_cflux_prod_monthly_tot + &
+             & net_harvest_above_monthly_tot )
+          
+          WRITE(numout,9010) 'GLOBAL net_cflux_prod_monthly    (Peta gC/month)  = ',net_cflux_prod_monthly_tot
+          WRITE(numout,9010) 'GLOBAL net_harvest_above_monthly (Peta gC/month)  = ',net_harvest_above_monthly_tot
+          WRITE(numout,9010) 'GLOBAL net_co2_flux_monthly      (Peta gC/month)  = ',net_co2_flux_monthly_sum
+          WRITE(numout,9010) 'GLOBAL net_biosp_prod_monthly    (Peta gC/month)  = ',net_biosp_prod_monthly_tot
+
+9010  FORMAT(A52,F17.14)
+
+          ! Reset Monthly values
+          
+          ! Reset Monthly values
+          co2_flux_monthly(:,:) = zero
+          harvest_above_monthly(:) = zero
+          cflux_prod_monthly(:)    = zero
+
+       ENDIF ! Monthly processes - at the end of the month
+       
+       !! 5.11 Reset daily variables
+       humrel_daily(:,:) = zero
+       litterhum_daily(:) = zero
+       t2m_daily(:) = zero
+       t2m_min_daily(:) = large_value
+       tsurf_daily(:) = zero
+       tsoil_daily(:,:) = zero
+       soilhum_daily(:,:) = zero
+       precip_daily(:) = zero
+       gpp_daily(:,:) = zero
+       resp_maint_part(:,:,:)=zero
+       resp_hetero_d=zero
+       DOC_EXP_d(:,:,:,:) = zero
+       IF (printlev >= 3) THEN
+          WRITE(numout,*) 'stomate_main: daily processes done'
+       ENDIF
+
+    ENDIF  ! Daily processes - at the end of the day
+    
+  !! 6. Outputs from Stomate
+
+    ! co2_flux receives a value from STOMATE only if STOMATE is activated.
+    ! Otherwise, the calling hydrological module must do this itself.
+
+    !! 6.1 Respiration and fluxes
+    resp_maint(:,:) = resp_maint_radia(:,:)*veget_cov_max(:,:)
+    resp_maint(:,ibare_sechiba) = zero
+    resp_growth(:,:)= resp_growth_d(:,:)*veget_cov_max(:,:)*dt_sechiba/one_day
+    resp_hetero(:,:,icarbon) = resp_hetero_radia(:,:,icarbon)*veget_cov_max(:,:)
+    resp_hetero(:,:,icarbon14) = resp_hetero_radia(:,:,icarbon14)*veget_cov_max(:,:)
+    
+    !! 6.2 Derived CO2 fluxes
+    ! CO2 flux in gC m^{-2} s^{-1} (positive towards the atmosphere) is sum of:
+    ! (1) heterotrophic respiration from ground + (2) maintenance respiration 
+    ! from the plants + (3) growth respiration from the plants + (4) co2 
+    ! emissions from fire - (5) co2 taken up in the DGVM to establish 
+    ! saplings - (6) co2 taken up by photosyntyhesis
+    co2_flux(:,:) = resp_hetero(:,:,icarbon) + resp_maint(:,:) + resp_growth(:,:) &
+         & + (co2_fire(:,:)-co2_to_bm_dgvm(:,:))*veget_cov_max(:,:)/one_day &
+         & - gpp(:,:)
+    
+    temp_growth(:)=t2m_month(:)-tp_00 
+   
+   
+    IF (printlev >= 4) WRITE(numout,*) 'Leaving stomate_main'
+
+  END SUBROUTINE stomate_main
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_finalize
+!!
+!>\BRIEF        Write variables to restart file
+!!
+!! DESCRIPTION  : Write variables to restart file
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCES	: 
+!!
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE stomate_finalize (kjit, kjpindex, index, clay, soil_ph, bulk_dens, &
+                               soiltile, veget_max, assim_param) 
+    
+    IMPLICIT NONE
+    
+    !! 0. Variable and parameter declaration
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)                       :: kjit              !! Time step number (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpindex          !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)   :: index             !! Indices of the terrestrial pixels only (unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: clay              !! Clay fraction of soil (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(inout)   :: bulk_dens         !! Soil bulk density (g cm-3)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: soil_ph           !! Soil pH (0-14, pH unit)
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltile  !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(in) :: assim_param    !! min+max+opt temperatures (K) & vmax for 
+                                                                           !! photosynthesis  
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: veget_max     !! New "maximal" coverage fraction of a PFT (LAI -> 
+                                                                         !! infinity) on ground only if EndOfYear is 
+                                                                         !! activated (unitless)
+    !! 0.4 Local variables
+    REAL(r_std)                                   :: dt_days_read             !! STOMATE time step read in restart file (days)
+    INTEGER(i_std)                                :: l,k,ji, jv, i, j, m      !! indices    
+    REAL(r_std),PARAMETER                         :: max_dt_days = 5.         !! Maximum STOMATE time step (days)
+    REAL(r_std)                                   :: hist_days                !! Writing frequency for history file (days)
+    REAL(r_std),DIMENSION(0:nbdl)                 :: z_soil                   !! Variable to store depth of the different soil layers (m)
+    REAL(r_std),DIMENSION(kjpindex)               :: cvegtot                  !! Total "vegetation" cover (unitless)
+    REAL(r_std),DIMENSION(kjpindex)               :: precip                   !! Total liquid and solid precipitation  
+                                                                              !! @tex $(??mm dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_d                    !! Gross primary productivity per ground area 
+                                                                              !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_daily_x              !! "Daily" gpp for teststomate  
+                                                                              !! @tex $(??gC m^{-2} dt_stomate^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nelements) :: resp_hetero_litter       !! Litter heterotrophic respiration per ground area 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex  
+                                                                              !! ??Same variable is also used to 
+                                                                              !! store heterotrophic respiration per ground area 
+                                                                              !! over ::dt_sechiba?? 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nelements)   :: resp_hetero_soil       !! soil heterotrophic respiration  
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: veget_cov                !! Fractional coverage: actually share of the pixel 
+                                                                              !! covered by a PFT (fraction of ground area), 
+                                                                              !! taking into account LAI ??(= grid scale fpc)?? 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: vcmax                    !! Maximum rate of carboxylation
+                                                                              !! @tex $(\mumol m^{-2} s^{-1})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,ncarb,nvm)     :: soilcarbon_input_inst    !! Quantity of carbon going into carbon pools from 
+                                                                              !! litter decomposition 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex 
+    
+    INTEGER(i_std)                                :: ier                      !! Check errors in netcdf call (unitless)
+    REAL(r_std)                                   :: sf_time                  !! Intermediate variable to calculate current time 
+                                                                              !! step 
+    INTEGER(i_std)                                :: max_totsize              !! Memory management - maximum memory size (Mb)
+    INTEGER(i_std)                                :: totsize_1step            !! Memory management - memory required to store one 
+                                                                              !! time step on one processor (Mb) 
+    INTEGER(i_std)                                :: totsize_tmp              !! Memory management - memory required to store one 
+                                                                              !! time step on all processors(Mb) 
+    REAL(r_std)                                   :: xn                       !! How many times have we treated in this forcing 
+    REAL(r_std), DIMENSION(kjpindex)              :: vartmp                   !! Temporary variable
+    INTEGER(i_std)                                :: vid                      !! Variable identifer of netCDF (unitless)
+    INTEGER(i_std)                                :: nneigh                   !! Number of neighbouring pixels
+    INTEGER(i_std)                                :: direct                   !! ??
+    INTEGER(i_std),DIMENSION(ndm)                 :: d_id                     !! ??
+    REAL(r_std),DIMENSION(nbp_glo)                :: clay_g                   !! Clay fraction of soil (0-1, unitless), parallel 
+                                                                              !! computing 
+    REAL(r_std),DIMENSION(nbp_glo)                :: bulk_dens_g              !! Soil bulk density (g cm-3),  parallel 
+                                                                              !!
+                                                                              !computing
+    REAL(r_std),DIMENSION(nbp_glo)                :: soil_ph_g                !! pH of soil (0-14, pH unit), parallel 
+                                                                              !! computing 
+    REAL(r_std),DIMENSION(nbp_glo,nstm)           :: soiltile_g              !! soil type, parallel computing
+    REAL(r_std),DIMENSION(nbp_glo,nvm)            :: veget_max_g              !! Maximum fraction of vegetation type including 
+                                                                              !! non-biological fraction (unitless),paralelle computing 
+
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:,:,:):: soilcarbon_input_g     !! Quantity of carbon going into DOC pools from 
+                                                                              !! litter decomposition  
+                                                                              !! @tex $(gC m^{-2} dt_sechiba^{-1})$ @endtex, parallel 
+                                                                              !! computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: control_moist_above_g    !! Moisture control of heterotrophic respiration  
+                                                                              !! (0-1, unitless), parallel computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: control_moist_soil_g     !! Moisture control of heterotrophic respiration 
+                                                                              !! (0-1, unitless), parallel computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: moist_soil_g             !! Soil moiture (m3 H20 m-3 Soil) 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: soil_mc_Cforcing_g       !! Soil moiture per soil type (m3 H20 m-3 Soil) 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:)        :: floodout_Cforcing_g      !! flux out of floodplains
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: wat_flux0_Cforcing_g     !! Water flux in the first soil layers exported for soil C calculations
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: wat_flux_Cforcing_g     !! Water flux in the soil layers exported for soil C calculations
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      ::runoff_per_soil_Cforcing_g   !! Runoff per soil type [mm]
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      ::drainage_per_soil_Cforcing_g !! Drainage per soil type [mm]
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: DOC_to_topsoil_Cforcing_g           !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                              !! floodplains and from irrigation
+                                                                              !! @tex $(gC m^{-2} day{-1})$ @endtex
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: DOC_to_subsoil_Cforcing_g           !! DOC inputs to bottom of the soil column, from returnflow
+                                                                              !! in swamps and lakes
+                                                                              !! @tex $(gC m^{-2} day{-1})$ @endtex
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: control_temp_above_g     !! Temperature control of heterotrophic respiration
+                                                                              !! (0-1, unitless), parallel computing
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: control_temp_soil_g      !! Temperature control of heterotrophic respiration 
+                                                                              !! (0-1, unitless), parallel computing
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:)        :: npp_equil_g              !! Equilibrium NPP written to forcesoil 
+                                                                              !! @tex $(gC m^{-2} year^{-1})$ @endtex, parallel 
+                                                                              !! computing 
+   REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:,:) :: litter_above_g        !! Above ground metabolic and structural litter 
+                                                                              !! per ground area 
+                                                                              !! @tex $(gC m^{-2})$ @endtex, parallel 
+                                                                              !! computing 
+
+   REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:,:,:):: litter_below_g       !! Below ground metabolic and structural litter 
+                                                                              !! per ground area 
+                                                                              !! @tex $(gC m^{-2})$ @endtex, parallel 
+                                                                              !! computing 
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)    :: lignin_struc_above_g    !! Ratio Lignine/Carbon in structural litter for above
+                                                                              !! ground compartments (unitless), parallel 
+                                                                              !! computing 
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)  :: lignin_struc_below_g    !! Ratio Lignine/Carbon in structural litter for below
+                                                                              !! ground compartments (unitless), parallel 
+                                                                              !! computing 
+!---
+
+    REAL(r_std)                                   :: net_cflux_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_cflux_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_harvest_above_monthly_sum !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_harvest_above_monthly_tot !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_biosp_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_biosp_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std), DIMENSION(kjpindex,nvm,nbpools)  :: carbon_stock                  !! Array containing the carbon stock for each pool
+                                                                                   !! used by ORCHIDEE
+
+!_ ================================================================================================================================
+    
+    !! 1. Write restart file for stomate
+    IF (printlev>=3) WRITE (numout,*) 'Write restart file for STOMATE'
+       
+    CALL writerestart &
+         (kjpindex, index, &
+         dt_days, date, &
+         ind, adapted, regenerate, &
+         humrel_daily, gdd_init_date, litterhum_daily, &
+         t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+         soilhum_daily, precip_daily, &
+         gpp_daily, npp_daily, turnover_daily, &
+         humrel_month, humrel_week, &
+         t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+         tsoil_month, soilhum_month, fireindex, firelitter, &
+         maxhumrel_lastyear, maxhumrel_thisyear, &
+         minhumrel_lastyear, minhumrel_thisyear, &
+         maxgppweek_lastyear, maxgppweek_thisyear, &
+         gdd0_lastyear, gdd0_thisyear, &
+         precip_lastyear, precip_thisyear, &
+         gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+         PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+         maxfpc_lastyear, maxfpc_thisyear, &
+         turnover_longterm, gpp_week, biomass, resp_maint_part, &
+         leaf_age, leaf_frac, &
+         senescence, when_growthinit, age, &
+         resp_hetero_d, resp_maint_d, resp_growth_d, co2_fire, co2_to_bm_dgvm, &
+         veget_lastlight, everywhere, need_adjacent, &
+         RIP_time, &
+         time_hum_min, hum_min_dormance, &
+         litterpart, litter_above, litter_below, dead_leaves, &
+         carbon, DOC, lignin_struc_above, lignin_struc_below, turnover_time,&
+         prod10,prod100,flux10, flux100, &
+         convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total, &
+         Tseason, Tseason_length, Tseason_tmp, &
+         Tmin_spring_time, begin_leaves, onset_date, &
+         assim_param)
+    
+    !! 2. Write file with variables that force general processes in stomate
+    IF (ok_co2 .AND. allow_forcing_write ) THEN
+       IF ( TRIM(forcing_name) /= 'NONE' ) THEN  
+          CALL forcing_write(forcing_id,1,iisf)
+          ! Close forcing file
+          IF (is_root_prc) ier = NF90_CLOSE (forcing_id)
+          forcing_id=-1
+       END IF
+    END IF
+    
+    !! 3. Collect variables that force the soil processes in stomate
+    IF (TRIM(Cforcing_name) /= 'NONE' ) THEN 
+       
+       !! Collet variables 
+       WRITE(numout,*) &
+            &      'stomate: writing the forcing file for carbon spinup'
+       DO iatt = 1, nparan*nbyear
+             IF ( nforce(iatt) > 0 ) THEN
+                soilcarbon_input(:,:,:,:,:,iatt) = &
+                     & soilcarbon_input(:,:,:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                litter_above_Cforcing(:,:,:,:,iatt) = &
+                     & litter_above_Cforcing(:,:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                litter_below_Cforcing(:,:,:,:,:,iatt) = &
+                     & litter_below_Cforcing(:,:,:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                control_moist_above(:,:,iatt) = &
+                     & control_moist_above(:,:,iatt)/REAL(nforce(iatt),r_std)
+                control_moist_soil(:,:,:,iatt) = &
+                     & control_moist_soil(:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                moist_soil(:,:,iatt) = &
+                     & moist_soil(:,:,iatt)/REAL(nforce(iatt),r_std)
+                soil_mc_Cforcing(:,:,:,iatt) = &
+                     & soil_mc_Cforcing(:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                floodout_Cforcing(:,iatt) = &
+                     & floodout_Cforcing(:,iatt)/REAL(nforce(iatt),r_std)
+                wat_flux0_Cforcing(:,:,iatt) = &
+                     & wat_flux0_Cforcing(:,:,iatt)/REAL(nforce(iatt),r_std)
+                wat_flux_Cforcing(:,:,:,iatt) = &
+                     & wat_flux_Cforcing(:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                runoff_per_soil_Cforcing(:,:,iatt) = &
+                     & runoff_per_soil_Cforcing(:,:,iatt)/REAL(nforce(iatt),r_std)
+                drainage_per_soil_Cforcing(:,:,iatt) = &
+                     & drainage_per_soil_Cforcing(:,:,iatt)/REAL(nforce(iatt),r_std)
+                DOC_to_topsoil_Cforcing(:,:,iatt) = &
+                     & DOC_to_topsoil_Cforcing(:,:,iatt)/REAL(nforce(iatt),r_std)
+                DOC_to_subsoil_Cforcing(:,:,iatt) = &
+                     & DOC_to_subsoil_Cforcing(:,:,iatt)/REAL(nforce(iatt),r_std)
+                control_temp_above(:,:,iatt) = &
+                     & control_temp_above(:,:,iatt)/REAL(nforce(iatt),r_std)
+                control_temp_soil(:,:,:,iatt) = &
+                     & control_temp_soil(:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                npp_equil(:,iatt) = &
+                     & npp_equil(:,iatt)/REAL(nforce(iatt),r_std)
+                lignin_struc_above_Cforcing(:,:,iatt) = &
+                     & lignin_struc_above_Cforcing(:,:,iatt)/REAL(nforce(iatt),r_std)
+                lignin_struc_below_Cforcing(:,:,:,iatt) = &
+                     & lignin_struc_below_Cforcing(:,:,:,iatt)/REAL(nforce(iatt),r_std)
+             ELSE
+                WRITE(numout,*) &
+                     &         'We have no soil carbon forcing data for this time step:', &
+                     &         iatt
+                WRITE(numout,*) ' -> we set them to zero'
+                soilcarbon_input(:,:,:,:,:,iatt) = zero
+                litter_above_Cforcing(:,:,:,:,iatt) = zero
+                litter_below_Cforcing(:,:,:,:,:,iatt) = zero
+                control_moist_above(:,:,iatt) = zero
+                control_moist_soil(:,:,:,iatt) = zero
+                moist_soil(:,:,iatt) = zero
+                soil_mc_Cforcing(:,:,:,iatt) = zero
+                floodout_Cforcing(:,iatt) = zero
+                wat_flux0_Cforcing(:,:,iatt) = zero
+                wat_flux_Cforcing(:,:,:,iatt) = zero
+                runoff_per_soil_Cforcing(:,:,iatt) = zero
+                drainage_per_soil_Cforcing(:,:,iatt) = zero
+                DOC_to_topsoil_Cforcing(:,:,iatt) = zero
+                DOC_to_subsoil_Cforcing(:,:,iatt) = zero
+                control_temp_above(:,:,iatt) = zero
+                control_temp_soil(:,:,:,iatt) = zero
+                npp_equil(:,iatt) = zero
+                lignin_struc_above_Cforcing(:,:,iatt) = zero
+                lignin_struc_below_Cforcing(:,:,:,iatt) = zero
+               ENDIF
+       ENDDO
+       
+       ! Allocate memory for parallel computing
+       IF (is_root_prc) THEN
+             ALLOCATE(soilcarbon_input_g(nbp_glo,nvm,nbdl,npool,nelements,nparan*nbyear))
+             ALLOCATE(control_moist_above_g(nbp_glo,nvm,nparan*nbyear))
+             ALLOCATE(control_moist_soil_g(nbp_glo,nbdl,nvm,nparan*nbyear))
+             ALLOCATE(moist_soil_g(nbp_glo,nbdl,nparan*nbyear))
+             ALLOCATE(soil_mc_Cforcing_g(nbp_glo,nbdl,nstm,nparan*nbyear))
+             ALLOCATE(floodout_Cforcing_g(nbp_glo,nparan*nbyear))
+             ALLOCATE(wat_flux0_Cforcing_g(nbp_glo,nstm,nparan*nbyear))
+             ALLOCATE(wat_flux_Cforcing_g(nbp_glo,nbdl,nstm,nparan*nbyear))
+             ALLOCATE(runoff_per_soil_Cforcing_g(nbp_glo,nstm,nparan*nbyear))
+             ALLOCATE(drainage_per_soil_Cforcing_g(nbp_glo,nstm,nparan*nbyear))
+             ALLOCATE(DOC_to_topsoil_Cforcing_g(nbp_glo,nelements,nparan*nbyear))
+             ALLOCATE(DOC_to_subsoil_Cforcing_g(nbp_glo,nelements,nparan*nbyear))
+             ALLOCATE(control_temp_above_g(nbp_glo,nlitt,nparan*nbyear))
+             ALLOCATE(control_temp_soil_g(nbp_glo,nbdl,npool*2,nparan*nbyear))
+             ALLOCATE(npp_equil_g(nbp_glo,nparan*nbyear))
+             ALLOCATE(litter_above_g(nbp_glo,nlitt,nvm,nelements,nparan*nbyear))
+             ALLOCATE(litter_below_g(nbp_glo,nlitt,nvm,nbdl,nelements,nparan*nbyear))
+             ALLOCATE(lignin_struc_above_g(nbp_glo,nvm,nparan*nbyear))
+             ALLOCATE(lignin_struc_below_g(nbp_glo,nvm,nbdl,nparan*nbyear))
+       ENDIF
+       
+       ! Gather distributed variables
+          ! Gather distributed variables
+          CALL gather(clay,clay_g)
+          CALL gather(control_moist_above,control_moist_above_g)
+          CALL gather(soil_ph,soil_ph_g)
+          CALL gather(bulk_dens, bulk_dens_g)
+          CALL gather(soiltile,soiltile_g)
+          CALL gather(veget_max,veget_max_g)
+          DO k= 1,nvm
+             DO i =1,npool
+                DO j=1,nbdl
+          CALL gather(soilcarbon_input(:,k,j,i,:,:),soilcarbon_input_g(:,k,j,i,:,:))
+                ENDDO
+             ENDDO
+          ENDDO
+          DO i =1,nlitt
+             DO j=1,nvm
+          CALL gather(litter_above_Cforcing(:,i,j,:,:),litter_above_g(:,i,j,:,:))
+             ENDDO
+          ENDDO
+          DO i =1,nlitt
+             DO j=1,nvm
+                DO k = 1,nbdl
+          CALL gather(litter_below_Cforcing(:,i,j,k,:,:),litter_below_g(:,i,j,k,:,:))
+                ENDDO
+             ENDDO
+          ENDDO
+          CALL gather(control_moist_soil,control_moist_soil_g)
+          CALL gather(moist_soil,moist_soil_g)
+          CALL gather(soil_mc_Cforcing,soil_mc_Cforcing_g)
+          CALL gather(floodout_Cforcing,floodout_Cforcing_g)
+          CALL gather(wat_flux0_Cforcing,wat_flux0_Cforcing_g)
+          DO j= 1, nbdl
+             DO i = 1, nstm
+          CALL gather(wat_flux_Cforcing(:,j,i,:),wat_flux_Cforcing_g(:,j,i,:))
+             ENDDO
+          ENDDO
+          CALL gather(runoff_per_soil_Cforcing,runoff_per_soil_Cforcing_g)
+          CALL gather(drainage_per_soil_Cforcing,drainage_per_soil_Cforcing_g)
+          CALL gather(DOC_to_topsoil_Cforcing,DOC_to_topsoil_Cforcing_g)
+          CALL gather(DOC_to_subsoil_Cforcing,DOC_to_subsoil_Cforcing_g)
+          DO k = 1, nlitt
+             CALL gather(control_temp_above(:,k,:),control_temp_above_g(:,k,:))
+          ENDDO
+          DO k = 1,2*npool
+             CALL gather(control_temp_soil(:,:,k,:),control_temp_soil_g(:,:,k,:))
+          ENDDO
+          CALL gather(npp_equil,npp_equil_g)
+          DO j=1,nvm
+             DO k = 1,nbdl
+          CALL gather(lignin_struc_below_Cforcing(:,j,k,:),lignin_struc_below_g(:,j,k,:))
+             ENDDO
+          ENDDO
+          DO j=1,nvm
+          CALL gather(lignin_struc_above_Cforcing(:,j,:),lignin_struc_above_g(:,j,:))
+          ENDDO
+       
+       !! Create netcdf
+       ! Create, define and populate a netcdf file containing the forcing data.
+       ! For the root processor only (parallel computing). NF90_ are functions
+       ! from and external library.  
+       IF (is_root_prc) THEN
+          WRITE (numout,*) 'Create Cforcing file : ',TRIM(Cforcing_name)
+          ! Create new netCDF dataset
+          ier = NF90_CREATE (TRIM(Cforcing_name),NF90_64BIT_OFFSET ,Cforcing_id)
+          IF (ier /= NF90_NOERR) THEN
+             WRITE (numout,*) 'Error in creating Cforcing file : ',TRIM(Cforcing_name)
+             CALL ipslerr_p (3,'stomate_finalize', &
+                  &        'PROBLEM creating Cforcing file', &
+                  &        NF90_STRERROR(ier),'')
+          END IF
+
+             ! Add variable attribute
+             ! Note ::nbp_glo is the number of global continental points
+             ier = NF90_PUT_ATT (Cforcing_id,NF90_GLOBAL, &
+                  &                        'kjpindex',REAL(nbp_glo,r_std))
+             ier = NF90_PUT_ATT (Cforcing_id,NF90_GLOBAL, &
+                  &                        'nparan',REAL(nparan,r_std))
+             ier = NF90_PUT_ATT (Cforcing_id,NF90_GLOBAL, &
+                  &                        'nbyear',REAL(nbyear,r_std))
+          
+             ! Add new dimension
+             ier = NF90_DEF_DIM (Cforcing_id,'points',nbp_glo,d_id(1))
+             ier = NF90_DEF_DIM (Cforcing_id,'carbtype',ncarb,d_id(2))
+             ier = NF90_DEF_DIM (Cforcing_id,'vegtype',nvm,d_id(3))
+             ier = NF90_DEF_DIM (Cforcing_id,'level',nlevs,d_id(4))
+             ier = NF90_DEF_DIM (Cforcing_id,'time_step',NF90_UNLIMITED,d_id(5))
+             ier = NF90_DEF_DIM (Cforcing_id,'solay',nbdl,d_id(6))
+             ier = NF90_DEF_DIM (Cforcing_id,'elements',nelements,d_id(7))
+             ier = NF90_DEF_DIM (Cforcing_id,'littertype',nlitt,d_id(8))
+             ier = NF90_DEF_DIM (Cforcing_id,'soiltype',nstm,d_id(9))
+             ier = NF90_DEF_DIM (Cforcing_id,'pooltype',npool,d_id(10))
+             ier = NF90_DEF_DIM (Cforcing_id,'dblepooltype',2*npool,d_id(11))
+             ! Add new variable
+             ier = NF90_DEF_VAR (Cforcing_id,'points',    r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'carbtype',  r_typ,d_id(2),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'vegtype',   r_typ,d_id(3),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'level',     r_typ,d_id(4),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'time_step', r_typ,d_id(5),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'solay',     r_typ,d_id(6),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'elements',  r_typ,d_id(7),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'littertype',r_typ,d_id(8),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'soiltype',  r_typ,d_id(9),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'pooltype',  r_typ,d_id(10),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'dblepooltype',  r_typ,d_id(11),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'index',     r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'clay',      r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'bulk_dens', r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'soil_ph',   r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'soiltile', r_typ, &
+                  &                        (/d_id(1),d_id(9) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'veget_max', r_typ, &
+                  &                        (/d_id(1),d_id(3) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'soilcarbon_input',r_typ, &
+                  &                        (/ d_id(1),d_id(3),d_id(6),d_id(10),d_id(7), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'control_moist_above',r_typ, &
+                  &                        (/ d_id(1),d_id(3),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'control_moist_soil',r_typ, &
+                  &                        (/ d_id(1),d_id(6),d_id(3),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'moist_soil',r_typ, &
+                  &                        (/ d_id(1),d_id(6),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'soil_mc',r_typ, &
+                  &                        (/ d_id(1),d_id(6),d_id(9),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'floodout',r_typ, &
+                  &                        (/ d_id(1),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'wat_flux0',r_typ, &
+                  &                        (/ d_id(1),d_id(9), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'wat_flux',r_typ, &
+                  &                        (/ d_id(1),d_id(6),d_id(9), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'runoff_per_soil',r_typ, &
+                  &                        (/ d_id(1),d_id(9), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'drainage_per_soil',r_typ, &
+                  &                        (/ d_id(1),d_id(9), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'DOC_to_topsoil',r_typ, &
+                  &                        (/ d_id(1),d_id(7), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'DOC_to_subsoil',r_typ, &
+                  &                        (/ d_id(1),d_id(7), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'control_temp_above',r_typ, &
+                  &                        (/ d_id(1),d_id(8),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'control_temp_soil',r_typ, &
+                  &                        (/ d_id(1),d_id(6),d_id(11),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'npp_equil',r_typ, &
+                  &                        (/ d_id(1),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'litter_above',r_typ, &
+                  &                        (/ d_id(1),d_id(8),d_id(3),d_id(7), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'litter_below',r_typ, &
+                  &                        (/ d_id(1),d_id(8),d_id(3),d_id(6),d_id(7), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'lignin_struc_below',r_typ, &
+                  &                        (/ d_id(1),d_id(3),d_id(6), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'lignin_struc_above',r_typ, &
+                  &                        (/ d_id(1),d_id(3), d_id(5) /),vid)
+             ier = NF90_ENDDEF (Cforcing_id)
+             ! Given the name of a varaible, nf90_inq_varid finds the variable 
+             ier = NF90_INQ_VARID (Cforcing_id,'points',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nbp_glo)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'carbtype',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                        (/(REAL(i,r_std),i=1,ncarb)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'vegtype',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                            (/(REAL(i,r_std),i=1,nvm)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'level',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nlevs)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'time_step',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nparan*nbyear)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'solay',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nbdl)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'elements',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nelements)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'littertype',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nlitt)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'soiltype',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nstm)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'pooltype',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,npool)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'dblepooltype',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,2*npool)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'index',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, REAL(index_g,r_std) )
+             ier = NF90_INQ_VARID (Cforcing_id,'clay',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, clay_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'bulk_dens',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, bulk_dens_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'soil_ph',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, soil_ph_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'soiltile',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, soiltile_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'veget_max',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, veget_max_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'soilcarbon_input',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, soilcarbon_input_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'control_moist_above',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, control_moist_above_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'control_moist_soil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, control_moist_soil_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'moist_soil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, moist_soil_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'soil_mc',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, soil_mc_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'floodout',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, floodout_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'wat_flux0',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, wat_flux0_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'wat_flux',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, wat_flux_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'runoff_per_soil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, runoff_per_soil_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'drainage_per_soil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, drainage_per_soil_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'DOC_to_topsoil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, DOC_to_topsoil_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'DOC_to_subsoil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, DOC_to_subsoil_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'control_temp_above',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, control_temp_above_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'control_temp_soil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, control_temp_soil_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'npp_equil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, npp_equil_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'litter_above',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, litter_above_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'litter_below',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, litter_below_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'lignin_struc_above',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, lignin_struc_above_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'lignin_struc_below',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, lignin_struc_below_g)
+          
+          ! Close netCDF
+          ier = NF90_CLOSE (Cforcing_id)
+          IF (ier /= NF90_NOERR) THEN
+             CALL ipslerr_p (3,'stomate_finalize', &
+                  &        'PROBLEM in closing Cforcing file', &
+                  &        NF90_STRERROR(ier),'')
+          END IF
+          
+          Cforcing_id = -1
+       ENDIF
+
+       ! Clear memory
+       IF (is_root_prc) THEN
+             DEALLOCATE(soilcarbon_input_g)
+             DEALLOCATE(control_moist_above_g)
+             DEALLOCATE(control_moist_soil_g)
+             DEALLOCATE(moist_soil_g)
+             DEALLOCATE(soil_mc_Cforcing_g)
+             DEALLOCATE(floodout_Cforcing_g)
+             DEALLOCATE(wat_flux0_Cforcing_g)
+             DEALLOCATE(wat_flux_Cforcing_g)
+             DEALLOCATE(runoff_per_soil_Cforcing_g)
+             DEALLOCATE(drainage_per_soil_Cforcing_g)
+             DEALLOCATE(DOC_to_topsoil_Cforcing_g)
+             DEALLOCATE(DOC_to_subsoil_Cforcing_g)
+             DEALLOCATE(control_temp_above_g)
+             DEALLOCATE(control_temp_soil_g)
+             DEALLOCATE(npp_equil_g)
+             DEALLOCATE(litter_above_g)
+             DEALLOCATE(litter_below_g)
+             DEALLOCATE(lignin_struc_above_g)
+             DEALLOCATE(lignin_struc_below_g)
+       ENDIF
+       
+    ENDIF
+  
+  END SUBROUTINE stomate_finalize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_init
+!!
+!>\BRIEF        The routine is called only at the first simulation. At that 
+!! time settings and flags are read and checked for internal consistency and 
+!! memory is allocated for the variables in stomate.
+!!
+!! DESCRIPTION  : The routine reads the 
+!! following flags from the run definition file:
+!! -ipd (index of grid point for online diagnostics)\n
+!! -ok_herbivores (flag to activate herbivores)\n
+!! -treat_expansion (flag to activate PFT expansion across a pixel\n
+!! -harvest_agri (flag to harvest aboveground biomass from agricultural PFTs)\n
+!! \n
+!! Check for inconsistent setting between the following flags:
+!! -ok_stomate\n
+!! -ok_dgvm\n
+!! -ok_co2\n
+!! \n
+!! Memory is allocated for all the variables of stomate and new indexing tables 
+!! are build. New indexing tables are needed because a single pixel can conatin 
+!! several PFTs. The new indexing tables have separate indices for the different 
+!! PFTs. Similar index tables are build for land use cover change.\n
+!! \n
+!! Several global variables and land cover change variables are initialized to 
+!! zero.\n
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output 
+!! variables. However, the routine allocates memory and builds new indexing 
+!! variables for later use.\n 
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE stomate_init &
+       &  (kjpij, kjpindex, index, lalo, &
+       &   rest_id_stom, hist_id_stom, hist_id_stom_IPCC)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                    :: kjpij             !! Total size of the un-compressed grid, including 
+                                                                      !! oceans (unitless) 
+    INTEGER(i_std),INTENT(in)                    :: kjpindex          !! Domain size - number of terrestrial pixels 
+                                                                      !! (unitless) 
+    INTEGER(i_std),INTENT(in)                    :: rest_id_stom      !! STOMATE's _Restart_ file identifier
+    INTEGER(i_std),INTENT(in)                    :: hist_id_stom      !! STOMATE's _history_ file identifier
+    INTEGER(i_std),INTENT(in)                    :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file identifier 
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in):: index             !! Indices of the terrestrial pixels on the global 
+                                                                      !! map 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in) :: lalo              !! Geogr. coordinates (latitude,longitude) (degrees)
+   
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    LOGICAL                                      :: l_error           !! Check errors in netcdf call
+    INTEGER(i_std)                               :: ier               !! Check errors in netcdf call
+    INTEGER(i_std)                               :: ji,j,ipd,l        !! Indices
+!_ ================================================================================================================================
+    
+  !! 1. Online diagnostics
+
+    IF ( kjpindex > 0 ) THEN
+       !Config  Key  = STOMATE_DIAGPT
+       !Config  Desc = Index of grid point for online diagnostics
+       !Config If    = OK_STOMATE
+       !Config  Def  = 1
+       !Config  Help = This is the index of the grid point which
+       !               will be used for online diagnostics.
+       !Config Units = [-]
+       ! By default ::ipd is set to 1
+       ipd = 1
+       ! Get ::ipd from run definition file
+       CALL getin_p('STOMATE_DIAGPT',ipd)
+       ipd = MIN( ipd, kjpindex )
+       WRITE(numout,*) 'Stomate: '
+       WRITE(numout,*) '  Index of grid point for online diagnostics: ',ipd
+       WRITE(numout,*) '  Lon, lat:',lalo(ipd,2),lalo(ipd,1)
+       WRITE(numout,*) '  Index of this point on GCM grid: ',index(ipd)
+       !
+    ENDIF
+    
+  !! 2. Check consistency of flags
+
+    IF ( ( .NOT. ok_stomate ) .AND. ok_dgvm ) THEN
+       WRITE(numout,*) 'Cannot do dynamical vegetation without STOMATE.'
+       WRITE(numout,*) 'Inconsistency between ::ok_stomate and ::ok_dgvm'
+       WRITE(numout,*) 'Stop: fatal error'
+       STOP
+    ENDIF
+
+    IF ((.NOT.ok_co2).AND.ok_stomate) THEN
+       WRITE(numout,*) 'Cannot call STOMATE without GPP.'
+       WRITE(numout,*) 'Inconsistency between ::ok_stomate and ::ok_co2'
+       WRITE(numout,*) 'Stop: fatal error'
+       STOP
+    ENDIF
+
+  !! 3. Communicate settings
+    
+    WRITE(numout,*) 'stomate first call - overview of the activated flags:'
+    WRITE(numout,*) '  Photosynthesis: ', ok_co2
+    WRITE(numout,*) '  STOMATE: ', ok_stomate
+    WRITE(numout,*) '  LPJ: ', ok_dgvm
+    
+  !! 4. Allocate memory for STOMATE's variables
+
+    l_error = .FALSE.
+
+    ALLOCATE(veget_cov_max(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for veget_cov_max. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for veget_cov_max_new. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(ind(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ind. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(adapted(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for adapted. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(regenerate(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for regenerate. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(litterhum_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for litterhum_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_min_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_min_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tsurf_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for tsurf_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tsoil_daily(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for tsoil_daily. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(soilhum_daily(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soilhum_daily. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(precip_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for precip_daily. We stop. We need kjpindex words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gpp_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gpp_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(npp_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for npp_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_daily(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_daily. We stop. We need kjpindex*nvm*nparts*nelements words', &
+       &   kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_littercalc(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_littercalc. We stop. We need kjpindex*nvm*nparts*nelements words', & 
+        &  kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_month(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_month. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_week(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_week. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_longterm(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_longterm. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for tlong_ref. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_month(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_month. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(Tseason(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for Tseason. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(Tseason_length(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for Tseason_length. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(Tseason_tmp(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for Tseason_tmp. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(Tmin_spring_time(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for Tmin_spring_time. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(onset_date(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for onset_date. We stop. We need kjpindex*nvm*nparts words',kjpindex,nvm,2
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_week(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_week. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tsoil_month(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for tsoil_month. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(soilhum_month(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soilhum_month. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(fireindex(kjpindex,nvm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for fireindex. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(firelitter(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for firelitter. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxhumrel_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxhumrel_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxhumrel_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxhumrel_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(minhumrel_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for minhumrel_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(minhumrel_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for minhumrel_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxgppweek_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxgppweek_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxgppweek_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxgppweek_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd0_lastyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd0_lastyear. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd0_thisyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd0_thisyear. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_init_date(kjpindex,2),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_init_date. We stop. We need kjpindex*2 words',kjpindex,2
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_from_growthinit(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_from_growthinit. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(precip_lastyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for precip_lastyear. We stop. We need kjpindex*nvm words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(precip_thisyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for precip_thisyear. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_m5_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_m5_dormance. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_midwinter(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_midwinter. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(ncd_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ncd_dormance. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(ngd_minus5(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ngd_minus5. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(PFTpresent(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for PFTpresent. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(npp_longterm(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for npp_longterm. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lm_lastyearmax(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lm_lastyearmax. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lm_thisyearmax(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lm_thisyearmax. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxfpc_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxfpc_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxfpc_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxfpc_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_longterm(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_longterm. We stop. We need kjpindex*nvm*nparts*nelements words', & 
+       &    kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gpp_week(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gpp_week. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(biomass(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for biomass. We stop. We need kjpindex*nvm*nparts*nelements words', &
+       &    kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(senescence(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for senescence. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(begin_leaves(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for begin_leaves. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(when_growthinit(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for when_growthinit. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(age(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for age. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_hetero_d(kjpindex,nvm,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_hetero_d. We stop. We need kjpindex*nvm words',kjpindex,nvm,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_hetero_radia(kjpindex,nvm,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_hetero_radia. We stop. We need kjpindex*nvm words',kjpindex,nvm,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_d. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_growth_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_growth_d. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(co2_fire(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for co2_fire. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(co2_to_bm_dgvm(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for co2_to_bm_dgvm. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(veget_lastlight(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for veget_lastlight. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(everywhere(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for everywhere. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(need_adjacent(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for need_adjacent. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(leaf_age(kjpindex,nvm,nleafages),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for leaf_age. We stop. We need kjpindex*nvm*nleafages words', & 
+       &      kjpindex,nvm,nleafages
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(leaf_frac(kjpindex,nvm,nleafages),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for leaf_frac. We stop. We need kjpindex*nvm*nleafages words', & 
+       &      kjpindex,nvm,nleafages
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(RIP_time(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for RIP_time. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(time_hum_min(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for time_hum_min. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(hum_min_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for hum_min_dormance. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(litterpart(kjpindex,nvm,nlitt),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for litterpart. We stop. We need kjpindex*nvm*nlitt words',  &
+       &  kjpindex,nvm,nlitt
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(litter_above(kjpindex,nlitt,nvm,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for litter. We stop. We need kjpindex*nlitt*nvm*nelements words', & 
+       &    kjpindex,nlitt,nvm,nelements
+       STOP 'stomate_init'
+    ENDIF
+    ALLOCATE(litter_below(kjpindex,nlitt,nvm,nbdl,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for litter. We stop. We need kjpindex*nlitt*nvm*nbdl*nelements words', &
+       &    kjpindex,nlitt,nvm,nbdl,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(dead_leaves(kjpindex,nvm,nlitt),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for dead_leaves. We stop. We need kjpindex*nvm*nlitt words', & 
+       &   kjpindex,nvm,nlitt
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(carbon(kjpindex,ncarb,nvm,nbdl,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for carbon. We stop. We need kjpindex*ncarb*nvm*nbdl words',kjpindex,ncarb,nvm,nbdl,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for black_carbon. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lignin_struc_above(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lignin_struc_above. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lignin_struc_below(kjpindex,nvm,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lignin_struc_below. We stop. We need kjpindex*nvm*nlevs words',kjpindex,nvm,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+
+    ALLOCATE(turnover_time(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_time. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(co2_flux_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for co2_flux_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(co2_flux_monthly(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for co2_flux_monthly. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (cflux_prod_monthly(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for cflux_prod_monthly. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+ 
+    ALLOCATE (harvest_above_monthly(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for harvest_above_monthly. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(bm_to_litter(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for bm_to_litter. We stop. We need kjpindex*nvm*nparts*nelements words', & 
+       &    kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(bm_to_littercalc(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for bm_to_littercalc. We stop. We need kjpindex*nvm*nparts*nelements words', &
+       &   kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(herbivores(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for herbivores. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(hori_index(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for hori_index. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(horipft_index(kjpindex*nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horipft_index. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(horisoillayer_index(kjpindex*nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horisoillayer_index. We stop. We need kjpindex*nbdl words',kjpindex*nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_part_radia(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_part_radia. We stop. We need kjpindex*nvm*nparts words', &
+       &  kjpindex,nvm,nparts
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_radia(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_radia. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_part(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_part. We stop. We need kjpindex*nvm*nparts words', &
+       &    kjpindex,nvm,nparts
+       STOP 'stomate_init'
+    ENDIF
+    resp_maint_part(:,:,:) = zero
+
+    ALLOCATE (horip10_index(kjpindex*10), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip10_index. We stop. We need kjpindex*10 words',kjpindex,10
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (horip100_index(kjpindex*100), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip100_index. We stop. We need kjpindex*100 words',kjpindex,100
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (horip11_index(kjpindex*11), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip11_index. We stop. We need kjpindex*11 words',kjpindex,11
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (horip101_index(kjpindex*101), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip101_index. We stop. We need kjpindex*101 words',kjpindex,101
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (prod10(kjpindex,0:10), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for prod10. We stop. We need kjpindex*11 words',kjpindex,11
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (prod100(kjpindex,0:100), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for prod100. We stop. We need kjpindex*101 words',kjpindex,101
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (flux10(kjpindex,10), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux10. We stop. We need kjpindex*10 words',kjpindex,10
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (flux100(kjpindex,100), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux100. We stop. We need kjpindex*100 words',kjpindex,100
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (convflux(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for convflux. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (cflux_prod10(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for cflux_prod10. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (cflux_prod100(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for cflux_prod100. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (harvest_above(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for harvest_above. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (carb_mass_total(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for carb_mass_total. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (soilcarbon_input_daily(kjpindex,nvm,nbdl,npool,nelements), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soilcarbon_input_daily. We stop. We need kjpindex*ncarb*nvm words', & 
+       &    kjpindex,ncarb,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(DOC(kjpindex,nvm,nbdl,ndoc,npool,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for DOC. We stop. We need kjpindex*nvm*nbdl*ndoc*npool*nelements words',kjpindex,nvm,nbdl,ndoc,npool,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(DOC_EXP_d(kjpindex,nvm,nexp,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for DOC_EXP_d. We stop. We need kjpindex*nvm*nexp*nelements words',kjpindex,nvm,nexp,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (control_temp_above_daily(kjpindex,nlitt), stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) 'Memory allocation error for control_temp_above_daily. We stop. We need kjpindex*nlitt words',kjpindex,nlitt 
+       STOP 'stomate_init' 
+    ENDIF
+
+    ALLOCATE (control_temp_soil_daily(kjpindex,nbdl,npool*2), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for control_temp_soil_daily. We stop. We need kjpindex*nbdl*npool words',kjpindex,nbdl,npool
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (control_moist_soil_daily(kjpindex,nbdl,nvm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for control_moist_soil_daily. We stop. We need kjpindex*nbdl*nvm words',kjpindex,nbdl,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (moist_soil_daily(kjpindex,nbdl), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for moist_soil_daily. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (soil_mc_Cforcing_daily(kjpindex,nbdl,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soil_mc_Cforcing_daily. We stop. We need kjpindex*nbdl*nstm words',kjpindex,nbdl,nstm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (floodout_Cforcing_daily(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for floodout_Cforcing_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (wat_flux0_Cforcing_daily(kjpindex,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for wat_flux0_Cforcing_daily. We stop. We need kjpindex*nstm words',kjpindex,nstm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (wat_flux_Cforcing_daily(kjpindex,nbdl,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for wat_flux_Cforcing_daily. We stop. We need kjpindex*nbdl*nstm words',kjpindex,nbdl,nstm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (runoff_per_soil_Cforcing_daily(kjpindex,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for runoff_per_soil_Cforcing_daily. We stop. We need kjpindex*nstm words',kjpindex,nstm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (drainage_per_soil_Cforcing_daily(kjpindex,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for drainage_per_soil_Cforcing_daily. We stop. We need kjpindex*nstm words',kjpindex,nstm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (DOC_to_topsoil_Cforcing_daily(kjpindex,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for DOC_to_topsoil_Cforcing_daily. We stop. We need kjpindex*nelements words',kjpindex,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (DOC_to_subsoil_Cforcing_daily(kjpindex,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for DOC_to_subsoil_Cforcing_daily. We stop. We need kjpindex*nelements words',kjpindex,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (control_moist_above_daily(kjpindex,nvm), stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) 'Memory allocation error for control_moist_above_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm 
+       STOP 'stomate_init' 
+    ENDIF 
+
+    ALLOCATE (fpc_max(kjpindex,nvm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for fpc_max. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+  !! 5. File definitions
+
+    ! Store history and restart files in common variables
+    hist_id_stomate = hist_id_stom
+    hist_id_stomate_IPCC = hist_id_stom_IPCC
+    rest_id_stomate = rest_id_stom
+    
+    ! In STOMATE reduced grids are used containing only terrestrial pixels.
+    ! Build a new indexing table for the vegetation fields separating 
+    ! between the different PFTs. Note that ::index has dimension (kjpindex) 
+    ! wheras ::indexpft has dimension (kjpindex*nvm). 
+
+    hori_index(:) = index(:)
+
+    DO j = 1, nvm
+       DO ji = 1, kjpindex
+          horipft_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+    DO j = 1, nbdl
+       DO ji = 1, kjpindex
+          horisoillayer_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    ! Similar index tables are build for the land cover change variables
+    DO j = 1, 10
+       DO ji = 1, kjpindex
+          horip10_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, 100
+       DO ji = 1, kjpindex
+          horip100_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, 11
+       DO ji = 1, kjpindex
+          horip11_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, 101
+       DO ji = 1, kjpindex
+          horip101_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+  !! 6. Initialization of global and land cover change variables. 
+
+    ! All variables are cumulative variables. bm_to_litter is not and is therefore
+    ! excluded
+    !   bm_to_litter(:,:,:) = zero
+    turnover_daily(:,:,:,:) = zero
+    resp_hetero_d(:,:,:) = zero
+    co2_flux_daily(:,:) = zero
+    co2_flux_monthly(:,:) = zero
+    cflux_prod_monthly(:) = zero
+    harvest_above_monthly(:) = zero
+    control_moist_above_daily(:,:) = zero
+    control_moist_soil_daily(:,:,:) = zero
+    moist_soil_daily(:,:) = zero
+    soil_mc_Cforcing_daily(:,:,:) = zero
+    floodout_Cforcing_daily(:) = zero
+    wat_flux0_Cforcing_daily(:,:) = zero
+    wat_flux_Cforcing_daily(:,:,:) = zero
+    runoff_per_soil_Cforcing_daily(:,:) = zero
+    drainage_per_soil_Cforcing_daily(:,:) = zero
+    DOC_to_topsoil_Cforcing_daily(:,:) = zero
+    DOC_to_subsoil_Cforcing_daily(:,:) = zero
+    control_temp_above_daily(:,:) = zero
+    control_temp_soil_daily(:,:,:) = zero
+    soilcarbon_input_daily(:,:,:,:,:) = zero
+    DOC_EXP_d(:,:,:,:) = zero
+    ! Land cover change variables
+    prod10(:,:)  = zero
+    prod100(:,:) = zero
+    flux10(:,:)  = zero
+    flux100(:,:) = zero
+    convflux(:)  = zero
+    cflux_prod10(:) = zero
+    cflux_prod100(:) = zero
+    fpc_max(:,:)=zero
+    
+  END SUBROUTINE stomate_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_clear
+!!
+!>\BRIEF        Deallocate memory of the stomate variables.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_clear
+
+  !! 1. Deallocate all dynamics variables
+
+    IF (ALLOCATED(veget_cov_max)) DEALLOCATE(veget_cov_max)
+    IF (ALLOCATED(ind)) DEALLOCATE(ind)
+    IF (ALLOCATED(adapted)) DEALLOCATE(adapted)
+    IF (ALLOCATED(regenerate)) DEALLOCATE(regenerate)
+    IF (ALLOCATED(humrel_daily)) DEALLOCATE(humrel_daily)
+    IF (ALLOCATED(gdd_init_date)) DEALLOCATE(gdd_init_date)
+    IF (ALLOCATED(litterhum_daily)) DEALLOCATE(litterhum_daily)
+    IF (ALLOCATED(t2m_daily))  DEALLOCATE(t2m_daily)
+    IF (ALLOCATED(t2m_min_daily))  DEALLOCATE(t2m_min_daily)
+    IF (ALLOCATED(tsurf_daily))  DEALLOCATE(tsurf_daily)
+    IF (ALLOCATED(tsoil_daily)) DEALLOCATE(tsoil_daily)
+    IF (ALLOCATED(soilhum_daily)) DEALLOCATE(soilhum_daily)
+    IF (ALLOCATED(precip_daily)) DEALLOCATE(precip_daily)
+    IF (ALLOCATED(gpp_daily)) DEALLOCATE(gpp_daily)
+    IF (ALLOCATED(npp_daily)) DEALLOCATE(npp_daily)
+    IF (ALLOCATED(turnover_daily)) DEALLOCATE(turnover_daily)
+    IF (ALLOCATED(turnover_littercalc)) DEALLOCATE(turnover_littercalc)
+    IF (ALLOCATED(humrel_month)) DEALLOCATE(humrel_month)
+    IF (ALLOCATED(humrel_week)) DEALLOCATE(humrel_week)
+    IF (ALLOCATED(t2m_longterm)) DEALLOCATE(t2m_longterm)
+    IF (ALLOCATED(t2m_month)) DEALLOCATE(t2m_month)
+    IF (ALLOCATED(Tseason)) DEALLOCATE(Tseason)
+    IF (ALLOCATED(Tseason_length)) DEALLOCATE(Tseason_length)
+    IF (ALLOCATED(Tseason_tmp)) DEALLOCATE(Tseason_tmp)
+    IF (ALLOCATED(Tmin_spring_time)) DEALLOCATE(Tmin_spring_time)
+    IF (ALLOCATED(onset_date)) DEALLOCATE(onset_date)
+    IF (ALLOCATED(begin_leaves)) DEALLOCATE(begin_leaves)
+    IF (ALLOCATED(t2m_week)) DEALLOCATE(t2m_week)
+    IF (ALLOCATED(tsoil_month)) DEALLOCATE(tsoil_month)
+    IF (ALLOCATED(soilhum_month)) DEALLOCATE(soilhum_month)
+    IF (ALLOCATED(fireindex)) DEALLOCATE(fireindex)
+    IF (ALLOCATED(firelitter)) DEALLOCATE(firelitter)
+    IF (ALLOCATED(maxhumrel_lastyear)) DEALLOCATE(maxhumrel_lastyear)
+    IF (ALLOCATED(maxhumrel_thisyear)) DEALLOCATE(maxhumrel_thisyear)
+    IF (ALLOCATED(minhumrel_lastyear)) DEALLOCATE(minhumrel_lastyear)
+    IF (ALLOCATED(minhumrel_thisyear)) DEALLOCATE(minhumrel_thisyear)
+    IF (ALLOCATED(maxgppweek_lastyear)) DEALLOCATE(maxgppweek_lastyear)
+    IF (ALLOCATED(maxgppweek_thisyear)) DEALLOCATE(maxgppweek_thisyear)
+    IF (ALLOCATED(gdd0_lastyear)) DEALLOCATE(gdd0_lastyear)
+    IF (ALLOCATED(gdd0_thisyear)) DEALLOCATE(gdd0_thisyear)
+    IF (ALLOCATED(precip_lastyear)) DEALLOCATE(precip_lastyear)
+    IF (ALLOCATED(precip_thisyear)) DEALLOCATE(precip_thisyear)
+    IF (ALLOCATED(gdd_m5_dormance)) DEALLOCATE(gdd_m5_dormance)
+    IF (ALLOCATED(gdd_from_growthinit)) DEALLOCATE(gdd_from_growthinit)
+    IF (ALLOCATED(gdd_midwinter)) DEALLOCATE(gdd_midwinter)
+    IF (ALLOCATED(ncd_dormance)) DEALLOCATE(ncd_dormance)
+    IF (ALLOCATED(ngd_minus5))  DEALLOCATE(ngd_minus5)
+    IF (ALLOCATED(PFTpresent)) DEALLOCATE(PFTpresent)
+    IF (ALLOCATED(npp_longterm)) DEALLOCATE(npp_longterm)
+    IF (ALLOCATED(lm_lastyearmax)) DEALLOCATE(lm_lastyearmax)
+    IF (ALLOCATED(lm_thisyearmax)) DEALLOCATE(lm_thisyearmax)
+    IF (ALLOCATED(maxfpc_lastyear)) DEALLOCATE(maxfpc_lastyear)
+    IF (ALLOCATED(maxfpc_thisyear)) DEALLOCATE(maxfpc_thisyear)
+    IF (ALLOCATED(turnover_longterm)) DEALLOCATE(turnover_longterm)
+    IF (ALLOCATED(gpp_week)) DEALLOCATE(gpp_week)
+    IF (ALLOCATED(biomass)) DEALLOCATE(biomass)
+    IF (ALLOCATED(senescence)) DEALLOCATE(senescence)
+    IF (ALLOCATED(when_growthinit)) DEALLOCATE(when_growthinit)
+    IF (ALLOCATED(age))  DEALLOCATE(age)
+    IF (ALLOCATED(resp_hetero_d)) DEALLOCATE(resp_hetero_d)
+    IF (ALLOCATED(resp_hetero_radia)) DEALLOCATE(resp_hetero_radia)
+    IF (ALLOCATED(resp_maint_d)) DEALLOCATE(resp_maint_d)
+    IF (ALLOCATED(resp_growth_d)) DEALLOCATE(resp_growth_d)
+    IF (ALLOCATED(co2_fire)) DEALLOCATE(co2_fire)
+    IF (ALLOCATED(co2_to_bm_dgvm)) DEALLOCATE(co2_to_bm_dgvm)
+    IF (ALLOCATED(veget_lastlight)) DEALLOCATE(veget_lastlight)
+    IF (ALLOCATED(everywhere)) DEALLOCATE(everywhere)
+    IF (ALLOCATED(need_adjacent)) DEALLOCATE(need_adjacent)
+    IF (ALLOCATED(leaf_age)) DEALLOCATE(leaf_age)
+    IF (ALLOCATED(leaf_frac)) DEALLOCATE(leaf_frac)
+    IF (ALLOCATED(RIP_time)) DEALLOCATE(RIP_time)
+    IF (ALLOCATED(time_hum_min)) DEALLOCATE(time_hum_min)
+    IF (ALLOCATED(hum_min_dormance)) DEALLOCATE(hum_min_dormance)
+    IF (ALLOCATED(litterpart)) DEALLOCATE(litterpart)
+    IF (ALLOCATED(litter_above)) DEALLOCATE(litter_above)
+    IF (ALLOCATED(litter_below)) DEALLOCATE(litter_below)
+    IF (ALLOCATED(dead_leaves)) DEALLOCATE(dead_leaves)
+    IF (ALLOCATED(carbon)) DEALLOCATE(carbon)
+    IF (ALLOCATED(lignin_struc_above)) DEALLOCATE(lignin_struc_above)
+    IF (ALLOCATED(lignin_struc_below)) DEALLOCATE(lignin_struc_below)
+    IF (ALLOCATED(turnover_time)) DEALLOCATE(turnover_time)
+    IF (ALLOCATED(co2_flux_daily)) DEALLOCATE(co2_flux_daily)
+    IF (ALLOCATED(co2_flux_monthly)) DEALLOCATE(co2_flux_monthly)
+    IF (ALLOCATED(harvest_above_monthly)) DEALLOCATE (harvest_above_monthly)
+    IF (ALLOCATED(cflux_prod_monthly)) DEALLOCATE (cflux_prod_monthly)
+    IF (ALLOCATED(bm_to_litter)) DEALLOCATE(bm_to_litter)
+    IF (ALLOCATED(bm_to_littercalc)) DEALLOCATE(bm_to_littercalc)
+    IF (ALLOCATED(herbivores)) DEALLOCATE(herbivores)
+    IF (ALLOCATED(resp_maint_part_radia)) DEALLOCATE(resp_maint_part_radia)
+    IF (ALLOCATED(resp_maint_radia)) DEALLOCATE(resp_maint_radia)
+    IF (ALLOCATED(resp_maint_part)) DEALLOCATE(resp_maint_part)
+    IF (ALLOCATED(hori_index)) DEALLOCATE(hori_index)
+    IF (ALLOCATED(horipft_index)) DEALLOCATE(horipft_index)
+    IF (ALLOCATED(horisoillayer_index)) DEALLOCATE(horisoillayer_index)
+    IF (ALLOCATED(clay_fm)) DEALLOCATE(clay_fm)
+    IF (ALLOCATED(bulk_dens_fm)) DEALLOCATE(bulk_dens_fm)
+    IF (ALLOCATED(soil_ph_fm)) DEALLOCATE(soil_ph_fm)
+    IF (ALLOCATED(humrel_daily_fm)) DEALLOCATE(humrel_daily_fm)
+    IF (ALLOCATED(litterhum_daily_fm))  DEALLOCATE(litterhum_daily_fm)
+    IF (ALLOCATED(t2m_daily_fm))  DEALLOCATE(t2m_daily_fm)
+    IF (ALLOCATED(t2m_min_daily_fm))  DEALLOCATE(t2m_min_daily_fm)
+    IF (ALLOCATED(tsurf_daily_fm)) DEALLOCATE(tsurf_daily_fm)
+    IF (ALLOCATED(tsoil_daily_fm)) DEALLOCATE(tsoil_daily_fm)
+    IF (ALLOCATED(soilhum_daily_fm))  DEALLOCATE(soilhum_daily_fm)
+    IF (ALLOCATED(precip_fm)) DEALLOCATE(precip_fm)
+    IF (ALLOCATED(gpp_daily_fm))  DEALLOCATE(gpp_daily_fm)
+    IF (ALLOCATED(veget_fm)) DEALLOCATE(veget_fm)
+    IF (ALLOCATED(veget_max_fm)) DEALLOCATE(veget_max_fm)
+    IF (ALLOCATED(lai_fm))  DEALLOCATE(lai_fm)
+    !
+    IF (ALLOCATED(clay_fm_g)) DEALLOCATE(clay_fm_g)
+    IF (ALLOCATED(humrel_daily_fm_g)) DEALLOCATE(humrel_daily_fm_g)
+    IF (ALLOCATED(litterhum_daily_fm_g))  DEALLOCATE(litterhum_daily_fm_g)
+    IF (ALLOCATED(t2m_daily_fm_g))  DEALLOCATE(t2m_daily_fm_g)
+    IF (ALLOCATED(t2m_min_daily_fm_g))  DEALLOCATE(t2m_min_daily_fm_g)
+    IF (ALLOCATED(tsurf_daily_fm_g)) DEALLOCATE(tsurf_daily_fm_g)
+    IF (ALLOCATED(tsoil_daily_fm_g)) DEALLOCATE(tsoil_daily_fm_g)
+    IF (ALLOCATED(soilhum_daily_fm_g))  DEALLOCATE(soilhum_daily_fm_g)
+    IF (ALLOCATED(precip_fm_g)) DEALLOCATE(precip_fm_g)
+    IF (ALLOCATED(gpp_daily_fm_g))  DEALLOCATE(gpp_daily_fm_g)
+    IF (ALLOCATED(veget_fm_g)) DEALLOCATE(veget_fm_g)
+    IF (ALLOCATED(veget_max_fm_g)) DEALLOCATE(veget_max_fm_g)
+    IF (ALLOCATED(lai_fm_g))  DEALLOCATE(lai_fm_g)
+    
+    IF (ALLOCATED(isf)) DEALLOCATE(isf)
+    IF (ALLOCATED(nf_written)) DEALLOCATE(nf_written)
+    IF (ALLOCATED(nf_cumul)) DEALLOCATE(nf_cumul)
+    IF (ALLOCATED(nforce)) DEALLOCATE(nforce)
+    IF (ALLOCATED(control_moist_above)) DEALLOCATE(control_moist_above)
+    IF (ALLOCATED(control_moist_soil)) DEALLOCATE(control_moist_soil)
+    IF (ALLOCATED(moist_soil)) DEALLOCATE(moist_soil)
+    IF (ALLOCATED(soil_mc_Cforcing)) DEALLOCATE(soil_mc_Cforcing)
+    IF (ALLOCATED(floodout_Cforcing)) DEALLOCATE(floodout_Cforcing)
+    IF (ALLOCATED(wat_flux0_Cforcing)) DEALLOCATE(wat_flux0_Cforcing)
+    IF (ALLOCATED(wat_flux_Cforcing)) DEALLOCATE(wat_flux_Cforcing)
+    IF (ALLOCATED(runoff_per_soil_Cforcing)) DEALLOCATE(runoff_per_soil_Cforcing)
+    IF (ALLOCATED(drainage_per_soil_Cforcing)) DEALLOCATE(drainage_per_soil_Cforcing)
+    IF (ALLOCATED(DOC_to_topsoil_Cforcing)) DEALLOCATE(DOC_to_topsoil_Cforcing)
+    IF (ALLOCATED(DOC_to_subsoil_Cforcing)) DEALLOCATE(DOC_to_subsoil_Cforcing)
+    IF (ALLOCATED(control_temp_above)) DEALLOCATE(control_temp_above)
+    IF (ALLOCATED(control_temp_soil)) DEALLOCATE(control_temp_soil)
+    IF (ALLOCATED(soilcarbon_input)) DEALLOCATE(soilcarbon_input)
+    IF ( ALLOCATED (horip10_index)) DEALLOCATE (horip10_index)
+    IF ( ALLOCATED (horip100_index)) DEALLOCATE (horip100_index)
+    IF ( ALLOCATED (horip11_index)) DEALLOCATE (horip11_index)
+    IF ( ALLOCATED (horip101_index)) DEALLOCATE (horip101_index)
+    IF ( ALLOCATED (prod10)) DEALLOCATE (prod10)
+    IF ( ALLOCATED (prod100)) DEALLOCATE (prod100)
+    IF ( ALLOCATED (flux10)) DEALLOCATE (flux10)
+    IF ( ALLOCATED (flux100)) DEALLOCATE (flux100)
+    IF ( ALLOCATED (convflux)) DEALLOCATE (convflux)
+    IF ( ALLOCATED (cflux_prod10)) DEALLOCATE (cflux_prod10)
+    IF ( ALLOCATED (cflux_prod100)) DEALLOCATE (cflux_prod100)
+    IF ( ALLOCATED (harvest_above)) DEALLOCATE (harvest_above)
+    IF ( ALLOCATED (soilcarbon_input_daily)) DEALLOCATE (soilcarbon_input_daily)
+    IF ( ALLOCATED (control_temp_above_daily)) DEALLOCATE (control_temp_above_daily)
+    IF ( ALLOCATED (control_temp_soil_daily)) DEALLOCATE (control_temp_soil_daily)
+    IF ( ALLOCATED (control_moist_above_daily)) DEALLOCATE (control_moist_above_daily)
+    IF ( ALLOCATED (control_moist_soil_daily)) DEALLOCATE (control_moist_soil_daily)
+    IF ( ALLOCATED (moist_soil_daily)) DEALLOCATE (moist_soil_daily)
+    IF ( ALLOCATED (soil_mc_Cforcing_daily)) DEALLOCATE (soil_mc_Cforcing_daily)
+    IF (ALLOCATED(floodout_Cforcing_daily)) DEALLOCATE(floodout_Cforcing_daily)
+    IF (ALLOCATED(wat_flux0_Cforcing_daily)) DEALLOCATE(wat_flux0_Cforcing_daily)
+    IF (ALLOCATED(wat_flux_Cforcing_daily)) DEALLOCATE(wat_flux_Cforcing_daily)
+    IF (ALLOCATED(runoff_per_soil_Cforcing_daily)) DEALLOCATE(runoff_per_soil_Cforcing_daily)
+    IF (ALLOCATED(drainage_per_soil_Cforcing_daily)) DEALLOCATE(drainage_per_soil_Cforcing_daily)
+    IF (ALLOCATED(DOC_to_topsoil_Cforcing_daily)) DEALLOCATE(DOC_to_topsoil_Cforcing_daily)
+    IF (ALLOCATED(DOC_to_subsoil_Cforcing_daily)) DEALLOCATE(DOC_to_subsoil_Cforcing_daily)
+    IF ( ALLOCATED (fpc_max)) DEALLOCATE (fpc_max)
+    IF (ALLOCATED(litter_above_Cforcing)) DEALLOCATE(litter_above_Cforcing)
+    IF (ALLOCATED(litter_below_Cforcing)) DEALLOCATE(litter_below_Cforcing)
+    IF (ALLOCATED(lignin_struc_above_Cforcing)) DEALLOCATE(lignin_struc_above_Cforcing)
+    IF (ALLOCATED(lignin_struc_below_Cforcing)) DEALLOCATE(lignin_struc_below_Cforcing)
+    IF (ALLOCATED(DOC_EXP_d)) DEALLOCATE(DOC_EXP_d)
+
+ !! 2. reset l_first
+
+    l_first_stomate=.TRUE.
+
+ !! 3. call to clear functions
+
+    CALL season_clear
+    CALL stomatelpj_clear
+    CALL littercalc_clear
+    CALL vmax_clear
+ 
+  END SUBROUTINE stomate_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_var_init
+!!
+!>\BRIEF        Initialize variables of stomate with a none-zero initial value.
+!! Subroutine is called only if ::ok_stomate = .TRUE. STOMATE diagnoses some 
+!! variables for SECHIBA : assim_param, deadleaf_cover, etc. These variables can 
+!! be recalculated from STOMATE's prognostic variables. Note that height is
+!! saved in SECHIBA.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): leaf age (::leaf_age) and fraction of leaves in leaf 
+!! age class (::leaf_frac). The maximum water on vegetation available for 
+!! interception, fraction of soil covered by dead leaves
+!! (::deadleaf_cover) and assimilation parameters (:: assim_param).
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_var_init &
+       &  (kjpindex, veget_cov_max, leaf_age, leaf_frac, &
+       &   dead_leaves, &
+       &   veget, lai, deadleaf_cover, assim_param)
+
+
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)                             :: kjpindex        !! Domain size - terrestrial pixels only
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)        :: veget           !! Fraction of pixel covered by PFT. Fraction 
+                                                                             !! accounts for none-biological land covers 
+                                                                             !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)        :: veget_cov_max   !! Fractional coverage: maximum share of the pixel 
+                                                                             !! covered by a PFT (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nlitt),INTENT(in)  :: dead_leaves     !! Metabolic and structural fraction of dead leaves 
+                                                                             !! per ground area 
+                                                                             !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)        :: lai             !! Leaf area index 
+                                                                             !! @tex $(m^2 m{-2})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(in) :: leaf_age     !! Age of different leaf classes per PFT (days)
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(in) :: leaf_frac    !! Fraction of leaves in leaf age class per PFT 
+                                                                             !! (unitless; 1)     
+    !! 0.2 Modified variables
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(inout) :: assim_param   !! min+max+opt temperatures (K) & vmax for 
+                                                                             !! photosynthesis  
+    
+    !! 0.3 Output variables
+    REAL(r_std),DIMENSION(kjpindex), INTENT (out)         :: deadleaf_cover  !! Fraction of soil covered by dead leaves 
+                                                                             !! (unitless) 
+    ! 0.4 Local variables
+   
+    REAL(r_std),PARAMETER                                 :: dt_0 = zero     !! Dummy time step, must be zero
+    REAL(r_std),DIMENSION(kjpindex,nvm)                   :: vcmax           !! Dummy vcmax 
+                                                                             !! @tex $(\mu mol m^{-2} s^{-1})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages)         :: leaf_age_tmp    !! Temporary variable
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages)         :: leaf_frac_tmp   !! Temporary variable
+                                                                             !! (unitless; 1)     
+    INTEGER(i_std)                                        :: j               !! Index (untiless)
+    
+!_ ================================================================================================================================   
+    ! Calculate assim_param if it was not found in the restart file
+    IF (ALL(assim_param(:,:,:)==val_exp)) THEN
+       ! Use temporary leaf_age_tmp and leaf_frac_tmp to preserve the input variables from being modified by the subroutine vmax.
+       leaf_age_tmp(:,:,:)=leaf_age(:,:,:)
+       leaf_frac_tmp(:,:,:)=leaf_frac(:,:,:)
+       !! 1.1 Calculate a temporary vcmax (stomate_vmax.f90)
+       CALL vmax (kjpindex, dt_0, leaf_age_tmp, leaf_frac_tmp, vcmax )
+       !! 1.2 transform into nvm vegetation types
+       assim_param(:,:,ivcmax) = zero
+       DO j = 2, nvm
+          assim_param(:,j,ivcmax)=vcmax(:,j)
+       ENDDO
+    END IF
+  
+    !! 2. Dead leaf cover (stomate_litter.f90)
+    CALL deadleaf (kjpindex, veget_cov_max, dead_leaves, deadleaf_cover)     
+    
+  END SUBROUTINE stomate_var_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_accu
+!!
+!>\BRIEF        Accumulate a variable for the time period specified by 
+!! ::dt_sechiba or calculate the mean value over ::dt_sechiba.
+!! 
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): accumulated or mean variable ::field_out:: 
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_accu (npts, n_dim2, ldmean, field_in, field_out)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in)                        :: npts      !! Domain size (unitless)
+    INTEGER(i_std),INTENT(in)                        :: n_dim2    !! 2nd dimension (1 or nvm)
+    LOGICAL,INTENT(in)                               :: ldmean    !! Flag to calculate the mean over
+    REAL(r_std),DIMENSION(npts,n_dim2),INTENT(in)    :: field_in  !! Field that needs to be accumulated
+    
+    !! 0.2 Modified variables
+    REAL(r_std),DIMENSION(npts,n_dim2),INTENT(inout) :: field_out !! Accumulated or mean field
+
+!_ ================================================================================================================================
+
+  !! 1. Accumulate field
+
+    field_out(:,:) = field_out(:,:)+field_in(:,:)*dt_sechiba
+   
+  !! 2. Mean fields
+
+    IF (ldmean) THEN
+       field_out(:,:) = field_out(:,:)/dt_stomate
+    ENDIF
+
+  END SUBROUTINE stomate_accu
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: init_forcing
+!!
+!>\BRIEF        Allocate memory for the variables containing the forcing data.
+!! The maximum size of the allocated memory is specified in run definition file
+!! (::max_totsize) and needs to be a compromise between charging the memory and 
+!! accessing disks to get the forcing data.
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output 
+!! variables. However, the routine allocates memory for later use. 
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE init_forcing (kjpindex,nsfm,nsft_loc)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std),INTENT(in) :: kjpindex !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std),INTENT(in) :: nsfm     !! Number of time steps that can be stored in memory (unitless)
+    INTEGER(i_std),INTENT(in) :: nsft_loc !! Number of time steps in a year (unitless)
+
+   !! 0.2 Output variables
+
+   !! 0.3 Modified variables
+
+   !! 0.4 Local variables
+
+    LOGICAL                   :: l_error  !! Check errors in netcdf call
+    INTEGER(i_std)            :: ier      !! Check errors in netcdf call
+!_ ================================================================================================================================
+    
+  !! 1. Allocate memory
+
+    ! Note ::nvm is number of PFTs and ::nbdl is number of soil layers
+    l_error = .FALSE.
+    ALLOCATE(clay_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables clay_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(soil_ph_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables soil_ph_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    l_error = .FALSE.
+    ALLOCATE(bulk_dens_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables bulk_dens_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+
+    ALLOCATE(humrel_daily_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables humrel_daily_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(litterhum_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables litterhum_daily_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(t2m_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables t2m_daily_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(t2m_min_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables t2m_min_daily_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(tsurf_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables tsurf_daily_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(tsoil_daily_fm(kjpindex,nbdl,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables tsoil_daily_fm ',kjpindex,nbdl,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(soilhum_daily_fm(kjpindex,nbdl,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables soilhum_daily_fm ',kjpindex,nbdl,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(precip_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables precip_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(gpp_daily_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables gpp_daily_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(veget_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(veget_max_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_max_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(lai_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables lai_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(isf(nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables isf ',nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(nf_written(nsft_loc),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables nf_written ',nsft_loc
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(nf_cumul(nsft_loc),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables nf_cumul ',nsft_loc
+       STOP 'init_forcing'
+    ENDIF
+    
+  !! 2. Allocate memory for the root processor only (parallel computing)
+
+    ! Where, ::nbp_glo is the number of global continental points
+    IF (is_root_prc) THEN
+       ALLOCATE(clay_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables clay_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(soil_ph_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables soil_ph_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(bulk_dens_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables bulk_dens_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(humrel_daily_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables humrel_daily_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(litterhum_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables litterhum_daily_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(t2m_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables t2m_daily_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(t2m_min_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables t2m_min_daily_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(tsurf_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables tsurf_daily_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(tsoil_daily_fm_g(nbp_glo,nbdl,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables tsoil_daily_fm_g ',nbp_glo,nbdl,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(soilhum_daily_fm_g(nbp_glo,nbdl,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables soilhum_daily_fm_g ',nbp_glo,nbdl,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(precip_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables precip_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(gpp_daily_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables gpp_daily_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(veget_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(veget_max_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_max_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(lai_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables lai_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+    ELSE
+       ! Allocate memory for co-processors
+       ALLOCATE(clay_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(soil_ph_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(bulk_dens_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(humrel_daily_fm_g(0,nvm,nsfm),stat=ier)
+       ALLOCATE(litterhum_daily_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(t2m_daily_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(t2m_min_daily_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(tsurf_daily_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(tsoil_daily_fm_g(0,nbdl,nsfm),stat=ier)
+       ALLOCATE(soilhum_daily_fm_g(0,nbdl,nsfm),stat=ier)
+       ALLOCATE(precip_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(gpp_daily_fm_g(0,nvm,nsfm),stat=ier)
+       ALLOCATE(veget_fm_g(0,nvm,nsfm),stat=ier)
+       ALLOCATE(veget_max_fm_g(0,nvm,nsfm),stat=ier)
+       ALLOCATE(lai_fm_g(0,nvm,nsfm),stat=ier)
+    ENDIF ! is_root_proc
+    
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables'
+       STOP 'init_forcing'
+    ENDIF
+
+  !! 3. Initilaize variables
+
+    CALL forcing_zero
+    
+  END SUBROUTINE init_forcing
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: forcing_zero
+!!
+!>\BRIEF        Initialize variables containing the forcing data; variables are 
+!! set to zero.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE forcing_zero
+    
+    clay_fm(:,:) = zero
+    soil_ph_fm(:,:) = zero
+    bulk_dens_fm(:,:) = zero
+    humrel_daily_fm(:,:,:) = zero
+    litterhum_daily_fm(:,:) = zero
+    t2m_daily_fm(:,:) = zero
+    t2m_min_daily_fm(:,:) = zero
+    tsurf_daily_fm(:,:) = zero
+    tsoil_daily_fm(:,:,:) = zero
+    soilhum_daily_fm(:,:,:) = zero
+    precip_fm(:,:) = zero
+    gpp_daily_fm(:,:,:) = zero
+    veget_fm(:,:,:) = zero
+    veget_max_fm(:,:,:) = zero
+    lai_fm(:,:,:) = zero
+    
+  END SUBROUTINE forcing_zero
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: forcing_write
+!!
+!>\BRIEF        Appends data values to a netCDF file containing the forcing 
+!! variables of the general processes in stomate.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): netCDF file
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE forcing_write(forcing_id,ibeg,iend)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)      :: forcing_id  !! File identifer of forcing file, assigned when netcdf is created
+    INTEGER(i_std),INTENT(in)      :: ibeg, iend  !! First and last time step to be written
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                 :: ii          !! Index of isf where isf is the number of time steps that can be 
+                                                  !! stored in memory 
+    INTEGER(i_std)                 :: iblocks     !! Index of block that is written
+    INTEGER(i_std)                 :: nblocks     !! Number of blocks that needs to be written
+    INTEGER(i_std)                 :: ier         !! Check errors in netcdf call
+    INTEGER(i_std),DIMENSION(0:2)  :: ifirst      !! First block in memory - changes with iblocks
+    INTEGER(i_std),DIMENSION(0:2)  :: ilast       !! Last block in memory - changes with iblocks
+    INTEGER(i_std),PARAMETER       :: ndm = 11    !! Maximum number of dimensions
+    INTEGER(i_std),DIMENSION(ndm)  :: start       !! First block to write
+    INTEGER(i_std)                 :: ndim        !! Dimensions of forcing to be added to the netCDF
+    INTEGER(i_std),DIMENSION(ndm)  :: count_force !! Number of elements in each dimension  
+    INTEGER(i_std)                 :: vid         !! Variable identifer of netCDF
+!_ ================================================================================================================================
+    
+  !! 1. Determine number of blocks of forcing variables that are stored in memory
+
+    nblocks = 0
+    ifirst(:) = 1
+    ilast(:) = 1
+    DO ii = ibeg, iend
+       IF (     (nblocks /= 0) &
+            &      .AND.(isf(ii) == isf(ilast(nblocks))+1)) THEN
+          ! Last block found
+          ilast(nblocks) = ii
+       ELSE
+          ! First block found
+          nblocks = nblocks+1
+          IF (nblocks > 2)  STOP 'Problem in forcing_write'
+          ifirst(nblocks) = ii
+          ilast(nblocks) = ii
+       ENDIF
+    ENDDO
+
+  !! 2. Gather distributed variables (parallel computing)
+
+    CALL gather(clay_fm,clay_fm_g)
+    CALL gather(soil_ph_fm,soil_ph_fm_g)
+    CALL gather(bulk_dens_fm,bulk_dens_fm_g)
+    CALL gather(humrel_daily_fm,humrel_daily_fm_g)
+    CALL gather(litterhum_daily_fm,litterhum_daily_fm_g)
+    CALL gather(t2m_daily_fm,t2m_daily_fm_g)
+    CALL gather(t2m_min_daily_fm,t2m_min_daily_fm_g)
+    CALL gather(tsurf_daily_fm,tsurf_daily_fm_g)
+    CALL gather(tsoil_daily_fm,tsoil_daily_fm_g)
+    CALL gather(soilhum_daily_fm,soilhum_daily_fm_g)
+    CALL gather(precip_fm,precip_fm_g)
+    CALL gather(gpp_daily_fm,gpp_daily_fm_g)
+    CALL gather(veget_fm,veget_fm_g)
+    CALL gather(veget_max_fm,veget_max_fm_g)
+    CALL gather(lai_fm,lai_fm_g)
+ 
+ !! 3. Append data to netCDF file
+   
+    IF (is_root_prc) THEN
+       ! The netCDF file has been created earlier in this module, a file ID is available 
+       ! and variables and dimensions have already been defined
+       DO iblocks = 1, nblocks
+          IF (ifirst(iblocks) /= ilast(iblocks)) THEN
+             ndim = 2
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(clay_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'clay',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid, &
+                  &              clay_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(soil_ph_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'soil_ph',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid, &
+                  &              soil_ph_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(bulk_dens_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'bulk_dens',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid, &
+                  &              bulk_dens_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(humrel_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'humrel',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            humrel_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(litterhum_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'litterhum',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            litterhum_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(t2m_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'t2m',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            t2m_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(t2m_min_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'t2m_min',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            t2m_min_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(tsurf_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'tsurf',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            tsurf_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(tsoil_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'tsoil',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            tsoil_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(soilhum_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'soilhum',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            soilhum_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(precip_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'precip',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            precip_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(gpp_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'gpp',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            gpp_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(veget_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'veget',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            veget_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(veget_max_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'veget_max',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            veget_max_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(lai_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'lai',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            lai_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+          ENDIF
+       ENDDO
+    ENDIF
+    
+  !! 4. Adjust flag of forcing file
+    nf_written(isf(:)) = .TRUE.
+
+  END SUBROUTINE forcing_write
+
+  
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_forcing_read
+!!
+!>\BRIEF        Read forcing file.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_forcing_read(forcing_id,nsfm)
+   
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)  :: forcing_id           !! File identifer of forcing file, assigned when netcdf is created
+    INTEGER(i_std),INTENT(in)  :: nsfm                 !! Number of time steps stored in memory        
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                 :: ii                !! Index of isf where isf is the number of time steps that can be stored in 
+                                                        !! memory 
+    INTEGER(i_std)                 :: iblocks           !! Index of block that is written
+    INTEGER(i_std)                 :: nblocks           !! Number of blocks that needs to be written
+    INTEGER(i_std)                 :: ier               !! Check error of netcdf call
+    INTEGER(i_std),DIMENSION(0:2)  :: ifirst            !! First block in memory - changes with iblocks
+    INTEGER(i_std),DIMENSION(0:2)  :: ilast             !! Last block in memory - changes with iblocks
+    INTEGER(i_std),PARAMETER       :: ndm = 11          !! Maximum number of dimensions
+    INTEGER(i_std),DIMENSION(ndm)  :: start             !! First block to write
+    INTEGER(i_std)                 :: ndim              !! Dimensions of forcing to be added to the netCDF
+    INTEGER(i_std),DIMENSION(ndm)  :: count_force       !! Number of elements in each dimension
+    INTEGER(i_std)                 :: vid               !! Variable identifer of netCDF
+    LOGICAL, PARAMETER             :: check=.FALSE.     !! Flag for debugging 
+    LOGICAL                        :: a_er=.FALSE.      !! Error catching from netcdf file
+!_ ================================================================================================================================
+
+    IF (check) WRITE(numout,*) "stomate_forcing_read "
+    
+  !! 1. Set to zero if the corresponding forcing state
+
+    ! has not yet been written into the file  
+    DO ii = 1, nsfm
+       IF (.NOT.nf_written(isf(ii))) THEN
+          clay_fm(:,ii) = zero
+          humrel_daily_fm(:,:,ii) = zero
+          litterhum_daily_fm(:,ii) = zero
+          t2m_daily_fm(:,ii) = zero
+          t2m_min_daily_fm(:,ii) = zero
+          tsurf_daily_fm(:,ii) = zero
+          tsoil_daily_fm(:,:,ii) = zero
+          soilhum_daily_fm(:,:,ii) = zero
+          precip_fm(:,ii) = zero
+          gpp_daily_fm(:,:,ii) = zero
+          veget_fm(:,:,ii) = zero
+          veget_max_fm(:,:,ii) = zero
+          lai_fm(:,:,ii) = zero
+       ENDIF
+    ENDDO
+    
+  !! 2. determine blocks of forcing states that are contiguous in memory
+
+    nblocks = 0
+    ifirst(:) = 1
+    ilast(:) = 1
+    
+    DO ii = 1, nsfm
+       IF (nf_written(isf(ii))) THEN
+          IF (     (nblocks /= 0) &
+               &        .AND.(isf(ii) == isf(ilast(nblocks))+1)) THEN
+
+
+             ! element is contiguous with last element found
+             ilast(nblocks) = ii
+          ELSE
+
+             ! found first element of new block
+             nblocks = nblocks+1
+             IF (nblocks > 2)  STOP 'Problem in stomate_forcing_read'
+             
+             ifirst(nblocks) = ii
+             ilast(nblocks) = ii
+          ENDIF
+       ENDIF
+    ENDDO
+    IF (check) WRITE(numout,*) "stomate_forcing_read nblocks, ifirst, ilast",nblocks, ifirst, ilast
+    
+  !! 3. Read variable values
+
+    IF (is_root_prc) THEN
+       DO iblocks = 1, nblocks
+          IF (check) WRITE(numout,*) "stomate_forcing_read iblocks, ifirst(iblocks), ilast(iblocks)",iblocks, &
+               ifirst(iblocks), ilast(iblocks)
+          IF (ifirst(iblocks) /= ilast(iblocks)) THEN
+             a_er=.FALSE.
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(clay_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'clay',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            clay_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(soil_ph_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'soil_ph',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            soil_ph_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(bulk_dens_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'bulk_dens',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            bulk_dens_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(humrel_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'humrel',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            humrel_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(litterhum_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'litterhum',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              litterhum_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(t2m_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'t2m',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              t2m_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(t2m_min_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'t2m_min',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              t2m_min_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(tsurf_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'tsurf',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              tsurf_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(tsoil_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'tsoil',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              tsoil_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(soilhum_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'soilhum',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              soilhum_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(precip_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'precip',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              precip_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(gpp_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'gpp',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            gpp_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(veget_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'veget',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            veget_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(veget_max_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'veget_max',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            veget_max_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(lai_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'lai',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            lai_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+             IF (a_er) THEN
+                CALL ipslerr_p (3,'stomate_forcing_read', &
+                     &        'PROBLEM when read forcing file', &
+                     &        '','')
+             ENDIF
+
+          ENDIF ! (ifirst(iblocks) /= ilast(iblocks))
+       ENDDO ! iblocks
+    ENDIF ! is_root_prc
+
+  !! 4. Distribute the variable over several processors
+
+    CALL scatter(clay_fm_g,clay_fm)
+    CALL scatter(soil_ph_fm_g,soil_ph_fm)
+    CALL scatter(bulk_dens_fm_g,bulk_dens_fm)
+    CALL scatter(humrel_daily_fm_g,humrel_daily_fm)
+    CALL scatter(litterhum_daily_fm_g,litterhum_daily_fm)
+    CALL scatter(t2m_daily_fm_g,t2m_daily_fm)
+    CALL scatter(t2m_min_daily_fm_g,t2m_min_daily_fm)
+    CALL scatter(tsurf_daily_fm_g,tsurf_daily_fm)
+    CALL scatter(tsoil_daily_fm_g,tsoil_daily_fm)
+    CALL scatter(soilhum_daily_fm_g,soilhum_daily_fm)
+    CALL scatter(precip_fm_g,precip_fm)
+    CALL scatter(gpp_daily_fm_g,gpp_daily_fm)
+    CALL scatter(veget_fm_g,veget_fm)
+    CALL scatter(veget_max_fm_g,veget_max_fm)
+    CALL scatter(lai_fm_g,lai_fm)
+  
+  END SUBROUTINE stomate_forcing_read
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: setlai
+!!
+!>\BRIEF        Routine to force the lai in STOMATE. The code in this routine
+!! simply CALCULATES lai and is therefore not functional. The routine should be 
+!! rewritten if one wants to force lai.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lai
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE setlai(npts,lai)
+
+  !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                    :: npts !! Domain size - number of pixels (unitless)
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out)  :: lai  !! PFT leaf area index @tex $(m^{2} m^{-2})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                               :: j    !! index (unitless)
+!_ ================================================================================================================================
+    
+    !! 1. Set lai for bare soil to zero
+
+    lai(:,ibare_sechiba) = zero
+
+    !! 2. Multiply foliage biomass by sla to calculate lai for all PFTs and pixels
+
+    DO j=2,nvm
+       lai(:,j) = biomass(:,j,ileaf,icarbon)*sla(j)
+    ENDDO
+    
+  END SUBROUTINE setlai
+
+END MODULE stomate
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_alloc.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_alloc.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_alloc.f90	(revision 5166)
@@ -0,0 +1,708 @@
+! =================================================================================================================================
+! MODULE       : stomate_alloc
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Allocate net primary production to: carbon reserves, aboveground sapwood,
+!! belowground sapwood, root, fruits and leaves.      
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_alloc
+
+  ! Modules used:
+
+  USE ioipsl_para
+  USE pft_parameters
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PRIVATE
+  PUBLIC alloc,alloc_clear
+
+ ! Variables shared by all subroutines in this module
+
+  LOGICAL, SAVE                                             :: firstcall_alloc = .TRUE.  !! Is this the first call? (true/false) 
+!$OMP THREADPRIVATE(firstcall_alloc)
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : alloc_clear
+!!
+!>\BRIEF          Set the flag ::firstcall_alloc to .TRUE. and as such activate section 
+!! 1.1 of the subroutine alloc (see below).\n
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE alloc_clear
+    firstcall_alloc = .TRUE.
+  END SUBROUTINE alloc_clear
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: alloc
+!!
+!>\BRIEF         Allocate net primary production (= photosynthesis
+!! minus autothrophic respiration) to: carbon reserves, aboveground sapwood,
+!! belowground sapwood, root, fruits and leaves following Friedlingstein et al. (1999).
+!!
+!! DESCRIPTION (definitions, functional, design, flags):\n
+!! The philosophy underlying the scheme is that allocation patterns result from
+!! evolved responses that adjust carbon investments to facilitate capture of most
+!! limiting resources i.e. light, water and mineral nitrogen. The implemented scheme 
+!! calculates the limitation of light, water and nitrogen. However, nitrogen is not a 
+!! prognostic variable of the model and therefore soil temperature and soil moisture 
+!! are used as a proxy for soil nitrogen availability.\n
+!! Sharpe & Rykiel (1991) proposed a generic relationship between the allocation of 
+!! carbon to a given plant compartment and the availability of a particular resource:\n
+!! \latexonly 
+!!   \input{alloc1.tex}
+!! \endlatexonly
+!! \n
+!! where A is the allocation of biomass production (NPP) to a given compartment (either 
+!! leaves, stem, or roots). Xi and Yj are resource availabilities (e.g. light, water, 
+!! nutrient). For a given plant compartment, a resource can be of type X or Y. An increase 
+!! in a X-type resource will increase the allocation to compartment A. An increase in a 
+!! Y-type resource will, however, lead to a decrease in carbon allocation to that compartment. 
+!! In other words, Y-type resources are those for which uptake increases with increased 
+!! investment in the compartment in question. X-type resources, as a consequence of 
+!! trade-offs, are the opposite. For example, water is a Y-type resource for root allocation. 
+!! Water-limited conditions should promote carbon allocation to roots, which enhance water 
+!! uptake and hence minimize plant water stress. Negative relationships between investment 
+!! and uptake arise when increased investment in one compartment leads, as required for 
+!! conservation of mass, to decreased investment in a component involved in uptake of 
+!! that resource.\n
+!!
+!! The implemented scheme allocates carbon to the following components:\n
+!! - Carbon reserves;\n
+!! - Aboveground sapwood;\n
+!! - Belowground sapwood;\n
+!! - Roots;\n
+!! - Fruits/seeds and\n
+!! - Leaves.
+!! \n
+!!
+!! The allocation to fruits and seeds is simply a 10% "tax" of the total biomass 
+!! production.\n
+!! Following carbohydrate use to support budburst and initial growth, the 
+!! carbohydrate reserve is refilled. The daily amount of carbon allocated to the 
+!! reserve pool is proportional to leaf+root allocation (::LtoLSR and ::RtoLSR).\n
+!! Sapwood and root allocation (respectively ::StoLSR and ::RtoLSR) are proportional 
+!! to the estimated light and soil (water and nitrogen) stress (::Limit_L and 
+!! ::Limit_NtoW). Further, Sapwood allocation is separated in belowground sapwood 
+!! and aboveground sapwood making use of the parameter (:: alloc_sap_above_tree
+!! or ::alloc_sap_above_grass). For trees partitioning between above and 
+!! belowground compartments is a function of PFT age.\n 
+!! Leaf allocation (::LtoLSR) is calculated as the residual of root and sapwood 
+!! allocation (LtoLSR(:) = 1. - RtoLSR(:) - StoLSR(:).\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: f_alloc; fraction of NPP that is allocated to the 
+!! six different biomass compartments (leaves, roots, above and belowground wood, 
+!! carbohydrate reserves and fruits). DIMENSION(npts,nvm,nparts).
+!!
+!! REFERENCE(S)	:
+!! - Friedlingstein, P., G. Joel, C.B. Field, and Y. Fung (1999), Towards an allocation
+!! scheme for global terrestrial carbon models, Global Change Biology, 5, 755-770.\n
+!! - Sharpe, P.J.H., and Rykiel, E.J. (1991), Modelling integrated response of plants 
+!! to multiple stresses. In: Response of Plants to Multiple Stresses (eds Mooney, H.A., 
+!! Winner, W.E., Pell, E.J.), pp. 205-224, Academic Press, San Diego, CA.\n
+!! - Krinner G, Viovy N, de Noblet-Ducoudr N, Ogee J, Polcher J, Friedlingstein P,
+!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
+!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
+!! doi: 10.1029/2003GB002199.\n
+!! - Malhi, Y., Doughty, C., and Galbraith, D. (2011). The allocation of ecosystem net primary productivity in tropical forests, 
+!! Philosophical Transactions of the Royal Society B-Biological Sciences, 366, 3225-3245, DOI 10.1098/rstb.2011.0062.\n
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!!   \includegraphics[scale=0.5]{allocflow.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE alloc (npts, dt, &
+       lai, veget_max, senescence, when_growthinit, &
+       moiavail_week, tsoil_month, soilhum_month, &
+       biomass, age, leaf_age, leaf_frac, rprof, f_alloc)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                 :: npts			!! Domain size - number of grid cells 
+                                                                                        !! (unitless)
+    REAL(r_std), INTENT(in)                                    :: dt			!! Time step of the simulations for stomate
+                                                                                        !! (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: lai			!! PFT leaf area index 
+                                                                                        !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_max		!! PFT "Maximal" coverage fraction of a PFT 
+                                                                                        !! (= ind*cn_ind) 
+                                                                                        !! @tex $(m^2 m^{-2})$ @endtex
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                   :: senescence		!! Is the PFT senescent?  - only for 
+                                                                                        !! deciduous trees (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: when_growthinit	!! Days since beginning of growing season 
+                                                                                        !! (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_week		!! PFT moisture availability - integrated
+                                                                                        !! over a week (0-1, unitless) 
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: tsoil_month		!! PFT soil temperature - integrated over 
+                                                                                        !! a month (K) 
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: soilhum_month		!! PFT soil humidity - integrated over a 
+                                                                                        !! month (0-1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: age			!! PFT age (days)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass		!! PFT total biomass 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age		!! PFT age of different leaf classes 
+                                                                                        !! (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac		!! PFT fraction of leaves in leaf age class
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: rprof                 !! [DISPENSABLE] PFT rooting depth - not 
+                                                                                        !! calculated in the current version of 
+                                                                                        !! the model (m) 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out)       :: f_alloc		!! PFT fraction of NPP that is allocated to
+                                                                                        !! the different components (0-1, unitless)
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(nvm)                                :: lai_happy		!! Lai threshold below which carbohydrate 
+                                                                                        !! reserve may be used 
+                                                                                        !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                               :: limit_L		!! Lights stress (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_N		!! Total nitrogen stress (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_N_temp		!! Stress from soil temperature on nitrogen
+                                                                                        !! mineralisation (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_N_hum		!! Stress from soil humidity on nitrogen 
+                                                                                        !! mineralisation (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_W		!! Soil water stress (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_WorN		!! Most limiting factor in the soil: 
+                                                                                        !! nitrogen or water (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit			!! Most limiting factor: amongst limit_N, 
+                                                                                        !! limit_W and limit_L (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: t_nitrogen		!! Preliminairy soil temperature stress 
+                                                                                        !! used as a proxy for nitrogen stress (K)
+    REAL(r_std), DIMENSION(npts)                               :: h_nitrogen		!! Preliminairy soil humidity stress used 
+                                                                                        !! as a proxy for nitrogen stress 
+                                                                                        !! (unitless)  
+    REAL(r_std), DIMENSION(npts)                               :: rpc			!! Scaling factor for integrating vertical
+                                                                                        !!  soil profiles (unitless) 	
+    REAL(r_std), DIMENSION(npts)                               :: LtoLSR		!! Ratio between leaf-allocation and 
+                                                                                        !! (leaf+sapwood+root)-allocation 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: StoLSR		!! Ratio between sapwood-allocation and 
+                                                                                        !! (leaf+sapwood+root)-allocation 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: RtoLSR		!! Ratio between root-allocation and 
+                                                                                        !! (leaf+sapwood+root)-allocation 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: carb_rescale		!! Rescaling factor for allocation factors
+                                                                                        !! if carbon is allocated to carbohydrate 
+                                                                                        !! reserve (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: use_reserve		!! Mass of carbohydrate reserve used to 
+                                                                                        !! support growth 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                               :: transloc_leaf		!! Fraction of carbohydrate reserve used 
+                                                                                        !! (::use_reserve) to support leaf growth 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                               :: leaf_mass_young	!! Leaf biomass in youngest leaf age class 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lm_old		!! Variable to store leaf biomass from 
+                                                                                        !! previous time step 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std)                                                :: reserve_time		!! Maximum number of days during which 
+                                                                                        !! carbohydrate reserve may be used (days)
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lai_around		!! lai on natural part of the grid cell, or
+                                                                                        !! of agricultural PFTs 
+                                                                                        !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                           :: veget_max_nat 	!! Vegetation cover of natural PFTs on the 
+                                                                                        !! grid cell (agriculture masked) 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: natveg_tot		!! Total natural vegetation cover on 
+                                                                                        !! natural part of the grid cell 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: lai_nat		!! Average LAI on natural part of the grid
+                                                                                        !! cell @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                               :: zdiff_min		!! [DISPENSABLE] intermediate array for 
+                                                                                        !! looking for minimum
+    REAL(r_std), DIMENSION(npts)                               :: alloc_sap_above	!! Prescribed fraction of sapwood 
+                                                                                        !! allocation to above ground sapwood 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: z_soil                !! Variable to store depth of the different
+                                                                                        !! soil layers (m)
+!$OMP THREADPRIVATE(z_soil)
+    INTEGER(i_std)                                             :: i,j,l,m		!! Indices (unitless)
+    INTEGER(i_std)                                             :: ier                   !! Error handling
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering alloc'
+
+!! 1. Initialize
+
+    !! 1.1 First call only
+    IF ( firstcall_alloc ) THEN
+
+       !
+       ! 1.1.0 Initialization
+       !
+       L0(2:nvm) = un - R0(2:nvm) - S0(2:nvm)  
+       IF ((MINVAL(L0(2:nvm)) .LT. zero) .OR. (MAXVAL(S0(2:nvm)) .EQ. un)) THEN
+          CALL ipslerr_p (3,'in module stomate_alloc', &
+               &           'Something wrong happened', &
+               &           'L0 negative or division by zero if S0 = 1', &
+               &           '(Check your parameters.)')
+       ENDIF
+
+       
+       !! 1.1.1 Copy the depth of the different soil layers (number of layers=nbdl) 
+       !        previously calculated as variable diaglev in routines sechiba.f90 and slowproc.f90  
+       ALLOCATE(z_soil(0:nbdl), stat=ier)
+       IF ( ier /= 0 ) CALL ipslerr_p(3,'stomate_alloc','Pb in allocate of z_soil','','')
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+       !! 1.1.2 Print flags and parameter settings
+       WRITE(numout,*) 'alloc:'
+       WRITE(numout,'(a,$)') '    > We'
+       IF ( .NOT. ok_minres ) WRITE(numout,'(a,$)') ' do NOT'
+       WRITE(numout,*) 'try to reach a minumum reservoir when severely stressed.'
+       WRITE(numout,*) '   > Time delay (days) to build leaf mass (::tau_leafinit): ', &
+            tau_leafinit(:)
+       WRITE(numout,*) '   > Curvature of root mass with increasing soil depth (::z_nitrogen): ', &
+            z_nitrogen
+       WRITE(numout,*) '   > Sap allocation above the ground / total sap allocation (0-1, unitless): '
+       WRITE(numout,*) '       grasses (::alloc_sap_above_grass) :', alloc_sap_above_grass
+       WRITE(numout,*) '   > Default root alloc fraction (1; ::R0): ', R0(:)
+       WRITE(numout,*) '   > Default sapwood alloc fraction (1; ::S0): ', S0(:)
+       WRITE(numout,*) '   > Default fruit allocation (1, ::f_fruit): ', f_fruit
+       WRITE(numout,*) '   > Minimum (min_LtoLSR)/maximum (::max_LtoLSR)leaf alloc fraction (0-1, unitless): ',&
+            min_LtoLSR,max_LtoLSR
+       WRITE(numout,*) '   > Maximum time (days) the carbon reserve can be used:'
+       WRITE(numout,*) '       trees (reserve_time_tree):',reserve_time_tree
+       WRITE(numout,*) '       grasses (reserve_time_grass):',reserve_time_grass
+
+       firstcall_alloc = .FALSE.
+
+    ENDIF
+
+
+    !! 1.2 Every call
+    !! 1.2.1 Reset output variable (::f_alloc)
+    f_alloc(:,:,:) = zero
+    f_alloc(:,:,icarbres) = un
+
+ 
+    !! 1.2.2 Proxy for soil nitrogen stress
+    !        Nitrogen availability and thus N-stress can not be calculated by the model. Water and
+    !        temperature stress are used as proxy under the assumption that microbial activity is 
+    !        determined by soil temperature and water availability. In turn, microbial activity is 
+    !         assumed to be an indicator for nitrogen mineralisation and thus its availability. 
+
+    !! 1.2.2.1 Convolution of nitrogen stress with root profile 
+    !          Here we calculate preliminary soil temperature and soil humidity stresses that will be used 
+    !          as proxies for nitrogen stress. Their calculation follows the nitrogen-uptake capacity of roots.
+    !          The capacity of roots to take up nitrogen is assumed to decrease exponentially with 
+    !          increasing soil depth. The curvature of the exponential function describing the 
+    !          nitrogen-uptake capacity of roots (= root mass * uptake capacity) is given by 
+    !          ::z_nitrogen. Strictly speaking its unit is meters (m). Despite its units this parameter 
+    !          has no physical meaning.
+    !          Because the roots are described by an exponential function but the soil depth is limited to
+    !          ::z_soil(nbdl), the root profile is truncated at ::z_soil(nbdl). For numerical reasons, 
+    !          the total capacity of the soil profile for nitrogen uptake should be 1. To this aim a scaling
+    !          factor (::rpc) is calculated as follows:\n
+    !          \latexonly
+    !            \input{alloc2.tex} 
+    !          \endlatexonly
+    !          Then temperature (::t_nitrogen) and humidity (::h_nitrogen) proxies for nitrogen stress are 
+    !          calculated using mean weighted (weighted by nitrogen uptake capacity) soil temperature (::tsoil_month)
+    !          or soil moisture (::soil_hum_month) (calculated in stomate_season.f90). 
+    !          \latexonly
+    !            \input{alloc3.tex} 
+    !          \endlatexonly
+    !          \latexonly
+    !            \input{alloc4.tex} 
+    !          \endlatexonly	
+    !          \n 
+		  
+    ! Scaling factor for integration
+    rpc(:) = un / ( un - EXP( -z_soil(nbdl) / z_nitrogen ) )
+
+    ! Integrate over # soil layers
+    t_nitrogen(:) = zero
+
+    DO l = 1, nbdl ! Loop over # soil layers
+
+       t_nitrogen(:) = &
+            t_nitrogen(:) + tsoil_month(:,l) * rpc(:) * &
+            ( EXP( -z_soil(l-1)/z_nitrogen ) - EXP( -z_soil(l)/z_nitrogen ) )
+
+    ENDDO ! Loop over # soil layers
+
+ 
+!!$    !! 1.2.2.2 Convolution for soil moisture
+!!$    !          Scaling factor for integration
+!!$    rpc(:) = 1. / ( 1. - EXP( -z_soil(nbdl) / z_nitrogen ) )
+
+    ! Integrate over # soil layers
+    h_nitrogen(:) = zero
+
+    DO l = 1, nbdl ! Loop over # soil layers
+
+       h_nitrogen(:) = &
+            h_nitrogen(:) + soilhum_month(:,l) * rpc(:) * &
+            ( EXP( -z_soil(l-1)/z_nitrogen ) - EXP( -z_soil(l)/z_nitrogen ) )
+
+    ENDDO ! Loop over # soil layers
+
+
+    !! 1.2.3 Separate between natural and agrigultural LAI
+    !        The model distinguishes different natural PFTs but does not contain information
+    !        on whether these PFTs are spatially separated or mixed. In line with the DGVM the 
+    !        models treats the natural PFT's as mixed. Therefore, the average LAI over the
+    !        natural PFTs is calculated to estimate light stress. Agricultural PFTs are spatially
+    !        separated. 
+    natveg_tot(:) = zero
+    lai_nat(:) = zero
+
+    DO j = 2, nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN
+          ! Mask agricultural vegetation
+          veget_max_nat(:,j) = veget_max(:,j)
+       ELSE
+          ! Mask natural vegetation
+          veget_max_nat(:,j) = zero
+       ENDIF
+
+       ! Sum up fraction of natural space covered by vegetation
+       natveg_tot(:) = natveg_tot(:) + veget_max_nat(:,j)
+
+       ! Sum up lai
+       lai_nat(:) = lai_nat(:) + veget_max_nat(:,j) * lai(:,j)
+
+    ENDDO ! Loop over # PFTs
+
+    DO j = 2, nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN
+
+          ! Use the mean LAI over all natural PFTs when estimating light stress 
+          ! on a specific natural PFT
+          lai_around(:,j) = lai_nat(:)
+       ELSE
+
+          ! Use the actual LAI (specific for that PFT) when estimating light
+          ! stress on a specific agricultural PFT
+          lai_around(:,j) = lai(:,j)
+       ENDIF
+
+    ENDDO ! Loop over # PFTs
+
+
+    !! 1.2.4 Calculate LAI threshold below which carbohydrate reserve is used.
+    !        Lai_max is a PFT-dependent parameter specified in stomate_constants.f90
+    lai_happy(:) = lai_max(:) * lai_max_to_happy(:)
+
+ !! 2. Use carbohydrate reserve to support growth and update leaf age
+
+    ! Save old leaf mass, biomass got last updated in stomate_phenology.f90
+    lm_old(:,:) = biomass(:,:,ileaf,icarbon)
+
+    DO j = 2, nvm ! Loop over # PFTs 
+
+       !! 2.1 Calculate demand for carbohydrate reserve to support leaf and root growth.
+       !      Maximum time (days) since start of the growing season during which carbohydrate 
+       !      may be used
+       IF ( is_tree(j) ) THEN
+          reserve_time = reserve_time_tree
+       ELSE
+          reserve_time = reserve_time_grass
+       ENDIF
+
+       ! Growth is only supported by the use of carbohydrate reserves if the following 
+       ! conditions are  statisfied:\n
+       ! - PFT is not senescent;\n
+       ! - LAI must be low (i.e. below ::lai_happy) and\n
+       ! - Day of year of the simulation is in the beginning of the growing season.
+       WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. & 
+            ( .NOT. senescence(:,j) ) .AND. &
+            ( lai(:,j) .LT. lai_happy(j) ) .AND. &
+            ( when_growthinit(:,j) .LT. reserve_time ) ) 
+
+          ! Determine the mass from the carbohydrate reserve that can be used @tex $(gC m^{-2})$ @endtex. 
+          ! Satisfy the demand or use everything that is available 
+          ! (i.e. ::biomass(:,j,icarbres)). Distribute the demand evenly over the time 
+          ! required (::tau_leafinit) to develop a minimal canopy from reserves (::lai_happy). 
+          use_reserve(:) = &
+               MIN( biomass(:,j,icarbres,icarbon), &
+               deux * dt/tau_leafinit(j) * lai_happy(j)/ sla(j) )
+
+          ! Distribute the reserve over leaves and fine roots.
+	  ! The part of the reserve going to the leaves is the ratio of default leaf allocation to default root and leaf allocation.
+	  ! The remaining of the reserve is alocated to the roots.
+          transloc_leaf(:) = L0(j)/(L0(j)+R0(j)) * use_reserve(:)
+          biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) + transloc_leaf(:)
+          biomass(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) + ( use_reserve(:) - transloc_leaf(:) )
+
+ 	  biomass(:,j,ileaf,icarbon14) = biomass(:,j,ileaf,icarbon) 
+          biomass(:,j,iroot,icarbon14) = biomass(:,j,iroot,icarbon) 
+
+          ! Adjust the carbohydrate reserve mass by accounting for the reserves allocated to leaves and roots during
+          ! this time step
+          biomass(:,j,icarbres,icarbon) = biomass(:,j,icarbres,icarbon) - use_reserve(:)
+	  biomass(:,j,icarbres,icarbon14) = biomass(:,j,icarbres,icarbon) 
+
+       ELSEWHERE
+
+          transloc_leaf(:) = zero
+
+       ENDWHERE
+    
+       !! 2.2 Update leaf age
+       !! 2.2.1 Decrease leaf age in youngest class
+       !        Adjust the mass of the youngest leaves by the newly grown leaves
+       leaf_mass_young(:) = leaf_frac(:,j,1) * lm_old(:,j) + transloc_leaf(:)
+
+       WHERE ( ( transloc_leaf(:) .GT. min_stomate ) .AND. ( leaf_mass_young(:) .GT. min_stomate ) )
+          
+          ! Adjust leaf age by the ratio of leaf_mass_young (t-1)/leaf_mass_young (t) 
+          leaf_age(:,j,1) = MAX( zero, leaf_age(:,j,1) * ( leaf_mass_young(:) - transloc_leaf(:) ) / &
+               leaf_mass_young(:) )
+
+       ENDWHERE
+
+       !! 2.2.2 Update leaf mass fraction for the different age classes
+       !        Mass fraction in the youngest age class is calculated as the ratio between
+       !        the new mass in the youngest class and the total leaf biomass 
+       !        (inc. the new leaves)
+       WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+          
+          leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf,icarbon)
+
+       ENDWHERE
+
+
+       ! Mass fraction in the other classes is calculated as the ratio bewteen
+       ! the current mass in that age and the total leaf biomass 
+       ! (inc. the new leaves)\n
+       DO m = 2, nleafages ! Loop over # leaf age classes
+
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+             leaf_frac(:,j,m) = leaf_frac(:,j,m) * lm_old(:,j) / biomass(:,j,ileaf,icarbon)
+
+          ENDWHERE
+
+       ENDDO ! Loop over # leaf age classes
+
+    ENDDO ! loop over # PFTs
+
+ !! 3. Calculate allocatable fractions of biomass production (NPP) 
+     
+    ! Calculate fractions of biomass production (NPP) to be allocated to the different 
+    ! biomass components.\n
+    ! The fractions of NPP allocated (0-1, unitless) to the different compartments depend on the
+    ! availability of light, water, and nitrogen.
+    DO j = 2, nvm ! Loop over # PFTs
+
+       ! Reset values
+       RtoLSR(:) = zero
+       LtoLSR(:) = zero
+       StoLSR(:) = zero
+
+       ! For trees, partitioning between above and belowground sapwood biomass is a function 
+       ! of age. An older tree gets more allocation to the aboveground sapwoood than a younger tree.
+       ! For the other PFTs it is prescribed. 
+       ! ::alloc_min, ::alloc_max and ::demi_alloc are specified in stomate_constants.f90
+       IF ( is_tree(j) ) THEN
+
+          alloc_sap_above(:) = alloc_min(j)+(alloc_max(j)-alloc_min(j))*(un-EXP(-age(:,j)/demi_alloc(j)))
+       
+       ELSE
+          
+          alloc_sap_above(:) = alloc_sap_above_grass
+       
+       ENDIF
+
+
+       !! 3.1 Calculate light stress, water stress and proxy for nitrogen stress.\n
+       !      For the limiting factors a low value indicates a strong limitation
+       WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+          !! 3.1.1 Light stress
+          !        Light stress is a function of the mean lai on the natural part of the grid box 
+          !        and of the PFT-specific LAI for agricultural crops. In line with the DGVM, natural
+          !        PFTs in the same gridbox are treated as if they were spatially mixed whereas 
+          !        agricultural PFTs are considered to be spatially separated.
+          !        The calculation of the lights stress depends on the extinction coefficient (set to 0.5)
+          !        and of a mean LAI.
+          WHERE( lai_around(:,j) < max_possible_lai )
+
+             limit_L(:) = MAX( 0.1_r_std, EXP( -ext_coeff(j) * lai_around(:,j) ) )
+          
+          ELSEWHERE
+             
+             limit_L(:) = 0.1_r_std
+          
+          ENDWHERE
+
+          !! 3.1.2 Water stress
+          !        Water stress is calculated as the weekly moisture availability.
+          !        Weekly moisture availability is calculated in stomate_season.f90.
+          limit_W(:) = MAX( 0.1_r_std, MIN( un, moiavail_week(:,j) ) )
+
+
+          !! 3.1.3 Proxy for nitrogen stress
+          !         The proxy for nitrogen stress depends on monthly soil water availability
+          !         (::soilhum_month) and monthly soil temperature (::tsoil_month). See section
+          !         1.2.2 for details on how ::t_nitrogen and ::h_nitrogen were calculated.\n
+          !         Currently nitrogen-stress is calculated for both natural and agricultural PFTs.
+          !         Due to intense fertilization of agricultural PFTs this is a strong 
+          !         assumption for several agricultural regions in the world (US, Europe, India, ...)
+          !         Water stress on nitrogen mineralisation 
+          limit_N_hum(:) = MAX( undemi, MIN( un, h_nitrogen(:) ) )
+
+	  ! Temperature stress on nitrogen mineralisation using a Q10 decomposition model
+          ! where Q10 was set to 2
+          limit_N_temp(:) = 2.**((t_nitrogen(:) - ZeroCelsius - Nlim_tref )/Nlim_Q10)
+          limit_N_temp(:) = MAX( 0.1_r_std, MIN( un, limit_N_temp(:) ) )
+
+          ! Combine water and temperature factors to get total nitrogen stress
+          limit_N(:) = MAX( 0.1_r_std, MIN( un, limit_N_hum(:) * limit_N_temp(:) ) )
+
+          ! Take the most limiting factor among soil water and nitrogen 
+          limit_WorN(:) = MIN( limit_W(:), limit_N(:) )
+
+          ! Take the most limiting factor among aboveground (i.e. light) and belowground 
+          ! (i.e. water & nitrogen) limitations
+          limit(:) = MIN( limit_WorN(:), limit_L(:) )
+
+          !! 3.2 Calculate ratio between allocation to leaves, sapwood and roots
+          !      Partitioning between belowground and aboveground biomass components is assumed 
+          !      to be proportional to the ratio of belowground and aboveground stresses.\n
+          !      \latexonly 
+          !        \input{alloc1.tex} 
+          !      \endlatexonly
+          !      Root allocation is the default root allocation corrected by a normalized ratio of aboveground stress to total stress.
+	  !      The minimum root allocation is 0.15.
+          RtoLSR(:) = &
+               MAX( .15_r_std, &
+               R0(j) * trois * limit_L(:) / ( limit_L(:) + deux * limit_WorN(:) ) )
+
+          ! Sapwood allocation is the default sapwood allocation corrected by a normalized ratio of belowground stress to total stress.
+          StoLSR(:) = S0(j) * 3. * limit_WorN(:) / ( 2._r_std * limit_L(:) + limit_WorN(:) )
+
+          ! Leaf allocation is calculated as the remaining allocation fraction
+	  ! The range of variation of leaf allocation is constrained by ::min_LtoLSR and ::max_LtoLSR. 
+          LtoLSR(:) = un - RtoLSR(:) - StoLSR(:)
+          LtoLSR(:) = MAX( min_LtoLSR, MIN( max_LtoLSR, LtoLSR(:) ) )
+
+          ! Roots allocation is recalculated as the residual carbon after leaf allocation has been calculated. 
+          RtoLSR(:) = un - LtoLSR(:) - StoLSR(:)
+
+       ENDWHERE
+	   
+       ! Check whether allocation needs to be adjusted. If LAI exceeds maximum LAI 
+       ! (::lai_max), no addition carbon should be allocated to leaf biomass. Allocation is 
+       ! then partioned between root and sapwood biomass.
+       WHERE ( (biomass(:,j,ileaf,icarbon) .GT. min_stomate) .AND. (lai(:,j) .GT. lai_max(j)) )
+
+          StoLSR(:) = StoLSR(:) + LtoLSR(:)
+          LtoLSR(:) = zero
+
+       ENDWHERE
+
+       !! 3.3 Calculate the allocation fractions.
+       !      The allocation fractions (::f_alloc) are an output variable (0-1, unitless). f_alloc
+       !      has three dimensions (npts,nvm,nparts). Where ::npts is the number of grid cells, ::nvm is the 
+       !      number of PFTs and ::nparts the number of biomass components. Currently six biomass compartments
+       !      are distinguished: (1) Carbon reserves, (2) Aboveground sapwood, (3) Belowground 
+       !      sapwood, (4) Roots, (5) fruits/seeds and (6) Leaves.@tex $(gC m^{-2})$ @endtex \n
+       DO i = 1, npts ! Loop over grid cells 
+
+          IF ( biomass(i,j,ileaf,icarbon) .GT. min_stomate ) THEN
+      
+             IF ( senescence(i,j) ) THEN
+                
+                !! 3.3.1 Allocate all C to carbohydrate reserve
+                !        If the PFT is senescent allocate all C to carbohydrate reserve, 
+                !        then the allocation fraction to reserves is 1. 
+                f_alloc(i,j,icarbres) = un
+
+             ELSE
+
+                !! 3.3.2 Allocation during the growing season  
+                f_alloc(i,j,ifruit) = f_fruit
+
+
+                ! Allocation to the carbohydrate reserve is proportional to leaf and root 
+                ! allocation. If carbon is allocated to the carbohydrate reserve, rescaling 
+                ! of allocation factors is required to ensure carbon mass preservation.\n
+                ! Carbon is allocated to the carbohydrate reserve when the pool size of the 
+                ! reserve is less than the carbon needed to grow a canopy twice the size of 
+                ! the maximum LAI (::lai_max). Twice the size was used as a threshold because
+                ! the reserves needs to be sufficiently to grow a canopy and roots. In case 
+                ! the carbohydrate pool is full, there is no need to rescale the other
+                ! allocation factors.
+	        ! If there is no rescaling of the allocation factors (carbres=1, no carbon put
+		! to reserve), then fraction remaining after fruit allocation (1-fruit_alloc) 
+		! is distributed between leaf, root and sap (sap carbon also distributed between   
+		! sap_above and sap_below with factor alloc_sap_above).
+		! If carbon is allocated to the carbohydrate reserve, all these factors are 
+		! rescaled through carb_rescale, and an allocation fraction for carbohydrate pool 
+		! appears. carb_rescale depends on the parameter (::ecureuil). 
+                ! (::ecureuil) is the fraction of primary leaf and root allocation put into 
+                ! reserve, it is specified in stomate_constants.f90 and is either 0 or 1.
+                IF ( ( biomass(i,j,icarbres,icarbon)*sla(j) ) .LT. 2*lai_max(j) ) THEN
+                   carb_rescale(i) = un / ( un + ecureuil(j) * ( LtoLSR(i) + RtoLSR(i) ) )
+                ELSE
+                   carb_rescale(i) = un
+                ENDIF
+
+                f_alloc(i,j,ileaf) = LtoLSR(i) * ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,isapabove) = StoLSR(i) * alloc_sap_above(i) * &
+                     ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,isapbelow) = StoLSR(i) * ( un - alloc_sap_above(i) ) * &
+                     ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,iroot) = RtoLSR(i) * (un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,icarbres) = ( un - carb_rescale(i) ) * ( un - f_alloc(i,j,ifruit) )
+
+             ENDIF  ! Is senescent?
+
+          ENDIF  ! There are leaves
+
+       ENDDO  ! Loop over # pixels - domain size
+
+    ENDDO  ! loop over # PFTs
+
+    IF (printlev>=3) WRITE(numout,*) 'Leaving alloc'
+
+  END SUBROUTINE alloc
+
+END MODULE stomate_alloc
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_data.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_data.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_data.f90	(revision 5166)
@@ -0,0 +1,690 @@
+! =================================================================================================================================
+! MODULE 	: stomate_data
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "stomate_data" module defines the values about the PFT parameters. It will print
+!! the values of the parameters for STOMATE in the standard outputs. 
+!!
+!!\n DESCRIPTION: None 
+!!
+!! RECENT CHANGE(S): Sonke Zaehle: Reich et al, 1992 find no statistically significant differences 
+!!                  between broadleaved and coniferous forests, specifically, the assumption that grasses grow 
+!!                  needles is not justified. Replacing the function with the one based on Reich et al. 1997. 
+!!                  Given that sla=100cm2/gDW at 9 months, sla is:
+!!                  sla=exp(5.615-0.46*ln(leaflon in months))
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_data
+
+  ! modules used:
+
+  USE constantes
+  USE pft_parameters
+  USE defprec
+  
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: hori_index     !! Move to Horizontal indices
+!$OMP THREADPRIVATE(hori_index)
+
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horipft_index  !! Horizontal + PFT indices
+!$OMP THREADPRIVATE(horipft_index)
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horisoillayer_index  !! Horizontal + soil layers indices
+!$OMP THREADPRIVATE(horisoillayer_index)
+
+  ! Land cover change
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip10_index   !! Horizontal + P10 indices
+!$OMP THREADPRIVATE(horip10_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip100_index  !! Horizontal + P100 indice
+!$OMP THREADPRIVATE(horip100_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip11_index   !! Horizontal + P11 indices
+!$OMP THREADPRIVATE(horip11_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip101_index  !! Horizontal + P101 indices
+!$OMP THREADPRIVATE(horip101_index)
+
+  INTEGER(i_std),SAVE :: itime                 !! time step
+!$OMP THREADPRIVATE(itime)
+  INTEGER(i_std),SAVE :: hist_id_stomate       !! STOMATE history file ID
+!$OMP THREADPRIVATE(hist_id_stomate)
+  INTEGER(i_std),SAVE :: hist_id_stomate_IPCC  !! STOMATE history file ID for IPCC output
+!$OMP THREADPRIVATE(hist_id_stomate_IPCC)
+  INTEGER(i_std),SAVE :: rest_id_stomate       !! STOMATE restart file ID
+!$OMP THREADPRIVATE(rest_id_stomate)
+
+  REAL(r_std),PARAMETER :: adapted_crit = 1. - ( 1. / euler ) !! critical value for being adapted (1-1/e) (unitless)
+  REAL(r_std),PARAMETER :: regenerate_crit = 1. / euler       !! critical value for being regenerative (1/e) (unitless)
+
+
+  ! private & public routines
+
+  PUBLIC data
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: data
+!!
+!>\BRIEF         This routine defines the values of the PFT parameters. It will print the values of the parameters for STOMATE
+!!               in the standard outputs of ORCHIDEE. 
+!!
+!! DESCRIPTION : This routine defines PFT parameters. It initializes the pheno_crit structure by tabulated parameters.\n
+!!               Some initializations are done for parameters. The SLA is calculated according *to* Reich et al (1992).\n
+!!               Another formulation by Reich et al(1997) could be used for the computation of the SLA.
+!!               The geographical coordinates might be used for defining some additional parameters
+!!               (e.g. frequency of anthropogenic fires, irrigation of agricultural surfaces, etc.). \n
+!!               For the moment, this possibility is not used. \n
+!!               The specifc leaf area (SLA) is calculated according Reich et al, 1992 by :
+!!               \latexonly
+!!               \input{stomate_data_SLA.tex}
+!!               \endlatexonly
+!!               The sapling (young) biomass for trees and for each compartment of biomass is calculated by :
+!!               \latexonly
+!!               \input{stomate_data_sapl_tree.tex}
+!!               \endlatexonly
+!!               The sapling biomass for grasses and for each compartment of biomass is calculated by :
+!!               \latexonly
+!!               \input{stomate_data_sapl_grass.tex}
+!!               \endlatexonly
+!!               The critical stem diameter is given by the following formula :
+!!               \latexonly
+!!               \input{stomate_data_stem_diameter.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): Sonke Zaehle: Reich et al, 1992 find no statistically significant differences 
+!!                  between broadleaved and coniferous forests, specifically, the assumption that grasses grow 
+!!                  needles is not justified. Replacing the function with the one based on Reich et al. 1997. 
+!!                  Given that sla=100cm2/gDW at 9 months, sla is:
+!!                  sla=exp(5.615-0.46*ln(leaflon in months)) 
+!!                   \latexonly
+!!                   \input{stomate_data_SLA_Reich_97.tex}
+!!                   \endlatexonly
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!! - Reich PB, Walters MB, Ellsworth DS, (1992), Leaf life-span in relation to leaf, plant and 
+!! stand characteristics among diverse ecosystems. Ecological Monographs, Vol 62, pp 365-392.
+!! - Reich PB, Walters MB, Ellsworth DS (1997) From tropics to tundra: global convergence in plant 
+!!  functioning. Proc Natl Acad Sci USA, 94:13730 13734
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE data (npts, lalo)
+
+
+    !! 0. Variables and parameter declaration
+
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                   :: npts    !! [DISPENSABLE] Domain size (unitless)
+    REAL(r_std),DIMENSION (npts,2), INTENT (in)  :: lalo    !! [DISPENSABLE] Geographical coordinates (latitude,longitude)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                               :: j       !! Index (unitless)
+    REAL(r_std)                                  :: alpha   !! alpha's : (unitless)
+    REAL(r_std)                                  :: dia     !! stem diameter (m)
+    REAL(r_std)                                  :: csa_sap !! Crown specific area sapling @tex $(m^2.ind^{-1})$ @endtex
+
+!_ ================================================================================================================================
+
+    IF ( printlev>=1 ) WRITE(numout,*) 'data: PFT characteristics'
+
+    !- pheno_gdd_crit
+    pheno_gdd_crit(:,1) = pheno_gdd_crit_c(:)
+    pheno_gdd_crit(:,2) = pheno_gdd_crit_b(:)         
+    pheno_gdd_crit(:,3) = pheno_gdd_crit_a(:) 
+    !
+    !- senescence_temp
+    senescence_temp(:,1) = senescence_temp_c(:)
+    senescence_temp(:,2) = senescence_temp_b(:)
+    senescence_temp(:,3) = senescence_temp_a(:)
+    !
+    !- maint_resp_slope
+    maint_resp_slope(:,1) = maint_resp_slope_c(:)              
+    maint_resp_slope(:,2) = maint_resp_slope_b(:)
+    maint_resp_slope(:,3) = maint_resp_slope_a(:)
+    !
+    !-coeff_maint_zero
+    coeff_maint_zero(:,ileaf) = cm_zero_leaf(:)
+    coeff_maint_zero(:,isapabove) = cm_zero_sapabove(:)
+    coeff_maint_zero(:,isapbelow) = cm_zero_sapbelow(:)
+    coeff_maint_zero(:,iheartabove) = cm_zero_heartabove(:)
+    coeff_maint_zero(:,iheartbelow) = cm_zero_heartbelow(:)
+    coeff_maint_zero(:,iroot) = cm_zero_root(:)
+    coeff_maint_zero(:,ifruit) = cm_zero_fruit(:)
+    coeff_maint_zero(:,icarbres) = cm_zero_carbres(:)
+
+    DO j = 2,nvm ! Loop over # PFTS 
+
+       IF ( printlev >= 1 ) WRITE(numout,'(a,i3,a,a)') '    > PFT#',j,': ', PFT_name(j)
+
+       !
+       ! 1 tree? (true/false)
+       !
+       IF ( printlev >= 1 ) WRITE(numout,*) '       tree: (::is_tree) ', is_tree(j)
+
+       !
+       ! 2 flamability (0-1, unitless)
+       !
+
+       IF ( printlev >= 1 ) WRITE(numout,*) '       litter flamability (::flam) :', flam(j)
+
+       !
+       ! 3 fire resistance (unitless)
+       !
+
+       IF ( printlev >= 1 ) WRITE(numout,*) '       fire resistance (::resist) :', resist(j)
+
+       !
+       ! 4 specific leaf area per mass carbon = 2 * sla / dry mass (m^2.gC^{-1})
+       !
+
+       ! S. Zaehle: Reich et al, 1992 find no statistically significant differences between broadleaved and coniferous
+       ! forests, specifically, the assumption that grasses grow needles is not justified. Replacing the function
+       ! with the one based on Reich et al. 1997. Given that sla=100cm2/gDW at 9 months, sla is:
+       ! sla=exp(5.615-0.46*ln(leaflon in months))
+
+       ! Oct 2010 : sla values are prescribed by values given by N.Viovy 
+
+       ! includes conversion from 
+       !!       sla(j) = 2. * 1e-4 * EXP(5.615 - 0.46 * log(12./leaflife_tab(j)))
+       !!\latexonly
+       !!\input{stomate_data_SLA.tex}
+       !!\endlatexonly
+!       IF ( leaf_tab(j) .EQ. 2 ) THEN
+!
+!          ! needle leaved tree
+!          sla(j) = 2. * ( 10. ** ( 2.29 - 0.4 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
+!
+!       ELSE
+!
+!          ! broad leaved tree or grass (Reich et al 1992)
+!          sla(j) = 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
+!
+!       ENDIF
+
+!!!$      IF ( leaf_tab(j) .EQ. 1 ) THEN
+!!!$
+!!!$        ! broad leaved tree
+!!!$
+!!!$        sla(j) = 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
+!!!$
+!!!$      ELSE
+!!!$
+!!!$        ! needle leaved or grass (Reich et al 1992)
+!!!$
+!!!$        sla(j) = 2. * ( 10. ** ( 2.29 - 0.4 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
+!!!$
+!!!$      ENDIF
+!!!$
+!!!$      IF ( ( leaf_tab(j) .EQ. 2 ) .AND. ( pheno_type_tab(j) .EQ. 2 ) ) THEN
+!!!$
+!!!$        ! summergreen needle leaf
+!!!$
+!!!$        sla(j) = 1.25 * sla(j)
+!!!$
+!!!$      ENDIF
+
+       IF ( printlev >= 1 ) WRITE(numout,*) '       specific leaf area (m**2/gC) (::sla):', sla(j), 12./leaflife_tab(j)
+
+       !
+       ! 5 sapling characteristics
+       !
+
+       IF ( is_tree(j) ) THEN
+
+          !> 5.1 trees
+
+          !!\latexonly
+          !!\input{stomate_data_sapl_tree.tex}
+          !!\endlatexonly
+
+          alpha = alpha_tree
+
+          bm_sapl(j,ileaf,icarbon) = &
+               &     ((bm_sapl_leaf(1)*pipe_tune1*(mass_ratio_heart_sap *bm_sapl_leaf(2)*sla(j)/(pi*pipe_k1)) & 
+               &     **bm_sapl_leaf(3))/sla(j))**bm_sapl_leaf(4)
+
+          IF ( pheno_type(j) .NE. 1 ) THEN
+             ! not evergreen
+             bm_sapl(j,icarbres,icarbon) = bm_sapl_carbres * bm_sapl(j,ileaf,icarbon)
+          ELSE
+             bm_sapl(j,icarbres,icarbon) = zero
+          ENDIF ! (pheno_type_tab(j) .NE. 1 )
+
+          csa_sap = bm_sapl(j,ileaf,icarbon) / ( pipe_k1 / sla(j) )
+
+          dia = (mass_ratio_heart_sap * csa_sap * dia_coeff(1) / pi ) ** dia_coeff(2)
+
+          bm_sapl(j,isapabove,icarbon) = &
+               bm_sapl_sapabove * pipe_density * csa_sap * pipe_tune2 * dia ** pipe_tune3
+          bm_sapl(j,isapbelow,icarbon) = bm_sapl(j,isapabove,icarbon)
+
+          bm_sapl(j,iheartabove,icarbon) = bm_sapl_heartabove * bm_sapl(j,isapabove,icarbon)
+          bm_sapl(j,iheartbelow,icarbon) = bm_sapl_heartbelow * bm_sapl(j,isapbelow,icarbon)
+
+       ELSE
+
+          !> 5.2 grasses
+
+          !!\latexonly
+          !!\input{stomate_data_sapl_grass.tex}
+          !!\endlatexonly
+
+          alpha = alpha_grass
+
+          IF ( natural(j) ) THEN
+             bm_sapl(j,ileaf,icarbon) = init_sapl_mass_leaf_nat / sla(j)
+	     bm_sapl(j,ileaf,icarbon14) = bm_sapl(j,ileaf,icarbon) 
+          ELSE
+             bm_sapl(j,ileaf,icarbon) = init_sapl_mass_leaf_agri / sla(j)
+	     bm_sapl(j,ileaf,icarbon14) = bm_sapl(j,ileaf,icarbon) 
+          ENDIF
+
+          bm_sapl(j,icarbres,icarbon) = init_sapl_mass_carbres *bm_sapl(j,ileaf,icarbon)
+	  bm_sapl(j,icarbres,icarbon14) = bm_sapl(j,icarbres,icarbon) 
+
+          bm_sapl(j,isapabove,icarbon) = zero
+          bm_sapl(j,isapbelow,icarbon) = zero
+
+          bm_sapl(j,iheartabove,icarbon) = zero
+          bm_sapl(j,iheartbelow,icarbon) = zero
+
+	  bm_sapl(j,isapabove,icarbon14) = zero
+          bm_sapl(j,isapbelow,icarbon14) = zero
+
+          bm_sapl(j,iheartabove,icarbon14) = zero
+          bm_sapl(j,iheartbelow,icarbon14) = zero
+
+       ENDIF !( is_tree(j) )
+
+       bm_sapl(j,iroot,icarbon) = init_sapl_mass_root * (1./alpha) * bm_sapl(j,ileaf,icarbon)
+       bm_sapl(j,iroot,icarbon14) = bm_sapl(j,iroot,icarbon) 
+
+       bm_sapl(j,ifruit,icarbon) = init_sapl_mass_fruit  * bm_sapl(j,ileaf,icarbon)
+       bm_sapl(j,ifruit,icarbon14) = bm_sapl(j,ifruit,icarbon)
+
+       IF ( printlev >= 1 ) THEN
+          WRITE(numout,*) '       sapling biomass (gC):'
+          WRITE(numout,*) '         leaves: (::bm_sapl(j,ileaf,icarbon))',bm_sapl(j,ileaf,icarbon)
+          WRITE(numout,*) '         sap above ground: (::bm_sapl(j,ispabove,icarbon)):',bm_sapl(j,isapabove,icarbon)
+          WRITE(numout,*) '         sap below ground: (::bm_sapl(j,isapbelow,icarbon))',bm_sapl(j,isapbelow,icarbon)
+          WRITE(numout,*) '         heartwood above ground: (::bm_sapl(j,iheartabove,icarbon))',bm_sapl(j,iheartabove,icarbon)
+          WRITE(numout,*) '         heartwood below ground: (::bm_sapl(j,iheartbelow,icarbon))',bm_sapl(j,iheartbelow,icarbon)
+          WRITE(numout,*) '         roots: (::bm_sapl(j,iroot,icarbon))',bm_sapl(j,iroot,icarbon)
+          WRITE(numout,*) '         fruits: (::bm_sapl(j,ifruit,icarbon))',bm_sapl(j,ifruit,icarbon)
+          WRITE(numout,*) '         carbohydrate reserve: (::bm_sapl(j,icarbres,icarbon))',bm_sapl(j,icarbres,icarbon)
+       ENDIF
+
+       !
+       ! 6 migration speed (m/year)
+       !
+
+       IF ( is_tree(j) ) THEN
+
+          migrate(j) = migrate_tree
+
+       ELSE
+
+          ! can be any value as grasses are, per *definition*, everywhere (big leaf).
+          migrate(j) = migrate_grass
+
+       ENDIF !( is_tree(j) )
+
+       IF ( printlev >= 1 ) WRITE(numout,*) '       migration speed (m/year): (::migrate(j))', migrate(j)
+
+       !
+       ! 7 critical stem diameter: beyond this diameter, the crown area no longer
+       !     increases (m)
+       !
+
+       IF ( is_tree(j) ) THEN
+
+          !!\latexonly
+          !!\input{stomate_data_stem_diameter.tex}
+          !!\endlatexonly
+
+          maxdia(j) = ( ( pipe_tune4 / ((pipe_tune2*pipe_tune3)/(maxdia_coeff(1)**pipe_tune3)) ) &
+               ** ( un / ( pipe_tune3 - un ) ) ) * maxdia_coeff(2)
+          cn_sapl(j) = cn_sapl_init !crown of individual tree, first year
+
+       ELSE
+
+          maxdia(j) = undef
+          cn_sapl(j)=1
+
+       ENDIF !( is_tree(j) )
+
+       IF ( printlev >= 1 ) WRITE(numout,*) '       critical stem diameter (m): (::maxdia(j))', maxdia(j)
+
+       !
+       ! 8 Coldest tolerable temperature (K)
+       !
+
+       IF ( ABS( tmin_crit(j) - undef ) .GT. min_stomate ) THEN
+          tmin_crit(j) = tmin_crit(j) + ZeroCelsius
+       ELSE
+          tmin_crit(j) = undef
+       ENDIF 
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       coldest tolerable temperature (K): (::tmin_crit(j))', tmin_crit(j)
+
+       !
+       ! 9 Maximum temperature of the coldest month: need to be below this temperature
+       !      for a certain time to regrow leaves next spring *(vernalization)* (K)
+       !
+
+       IF ( ABS ( tcm_crit(j) - undef ) .GT. min_stomate ) THEN
+          tcm_crit(j) = tcm_crit(j) + ZeroCelsius
+       ELSE
+          tcm_crit(j) = undef
+       ENDIF
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       vernalization temperature (K): (::tcm_crit(j))', tcm_crit(j)
+
+       !
+       ! 10 critical values for phenology
+       !
+
+       ! 10.1 model used
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       phenology model used: (::pheno_model(j)) ',pheno_model(j)
+
+       ! 10.2 growing degree days. What kind of gdd is meant (i.e. threshold 0 or -5 deg C
+       !        or whatever), depends on how this is used in stomate_phenology.
+
+
+       IF ( ( printlev >= 1 ) .AND. ( ALL(pheno_gdd_crit(j,:) .NE. undef) ) ) THEN
+          WRITE(numout,*) '         critical GDD is a function of long term T (C): (::gdd)'
+          WRITE(numout,*) '          ',pheno_gdd_crit(j,1), &
+               ' + T *',pheno_gdd_crit(j,2), &
+               ' + T^2 *',pheno_gdd_crit(j,3)
+       ENDIF
+
+       ! consistency check
+
+       IF ( ( ( pheno_model(j) .EQ. 'moigdd' ) .OR. &
+            ( pheno_model(j) .EQ. 'humgdd' )       ) .AND. &
+            ( ANY(pheno_gdd_crit(j,:) .EQ. undef) )                      ) THEN
+          CALL ipslerr_p(3,'stomate_data','problem with phenology parameters, critical GDD. (::pheno_model)','','')
+       ENDIF
+
+       ! 10.3 number of growing days
+
+       IF ( ( printlev >= 1 ) .AND. ( ngd_crit(j) .NE. undef ) ) &
+            WRITE(numout,*) '         critical NGD: (::ngd_crit(j))', ngd_crit(j)
+
+       ! 10.4 critical temperature for ncd vs. gdd function in phenology (C)
+
+       IF ( ( printlev >= 1 ) .AND. ( ncdgdd_temp(j) .NE. undef ) ) &
+            WRITE(numout,*) '         critical temperature for NCD vs. GDD (C): (::ncdgdd_temp(j))', &
+            ncdgdd_temp(j)
+
+       ! 10.5 humidity fractions (0-1, unitless)
+
+       IF ( ( printlev >= 1 ) .AND. ( hum_frac(j) .NE. undef ) ) &
+            WRITE(numout,*) '         critical humidity fraction: (::hum_frac(j))', &
+            &  hum_frac(j)
+
+
+       ! 10.6 minimum time elapsed since moisture minimum (days)
+
+       IF ( ( printlev >= 1 ) .AND. ( hum_min_time(j) .NE. undef ) ) &
+            WRITE(numout,*) '         time to wait after moisture min (d): (::hum_min_time(j))', &
+        &    hum_min_time(j)
+
+       !
+       ! 11 critical values for senescence
+       !
+
+       ! 11.1 type of senescence
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       type of senescence: (::senescence_type(j))',senescence_type(j)
+
+       ! 11.2 critical temperature for senescence (C)
+
+       IF ( ( printlev >= 1 ) .AND. ( ALL(senescence_temp(j,:) .NE. undef) ) ) THEN
+          WRITE(numout,*) '         critical temperature for senescence (C) is'
+          WRITE(numout,*) '          a function of long term T (C): (::senescence_temp)'
+          WRITE(numout,*) '          ',senescence_temp(j,1), &
+               ' + T *',senescence_temp(j,2), &
+               ' + T^2 *',senescence_temp(j,3)
+       ENDIF
+
+       ! consistency check
+
+       IF ( ( ( senescence_type(j) .EQ. 'cold' ) .OR. &
+            ( senescence_type(j) .EQ. 'mixed' )      ) .AND. &
+            ( ANY(senescence_temp(j,:) .EQ. undef ) )           ) THEN
+          CALL ipslerr_p(3,'stomate_data','Problem with senescence parameters, temperature. (::senescence_type)','','')
+       ENDIF
+
+       ! 11.3 critical relative moisture availability for senescence
+
+       IF ( ( printlev >= 1 ) .AND. ( senescence_hum(j) .NE. undef ) ) &
+            WRITE(numout,*)  ' max. critical relative moisture availability for' 
+            WRITE(numout,*)  ' senescence: (::senescence_hum(j))',  &
+            & senescence_hum(j)
+
+       ! consistency check
+
+       IF ( ( ( senescence_type(j) .EQ. 'dry' ) .OR. &
+            ( senescence_type(j) .EQ. 'mixed' )     ) .AND. &
+            ( senescence_hum(j) .EQ. undef )                   ) THEN
+          CALL ipslerr_p(3,'stomate_data','Problem with senescence parameters, humidity.(::senescence_type)','','')
+       ENDIF
+
+       ! 14.3 relative moisture availability above which there is no moisture-related
+       !      senescence (0-1, unitless)
+
+       IF ( ( printlev >= 1 ) .AND. ( nosenescence_hum(j) .NE. undef ) ) &
+            WRITE(numout,*) '         relative moisture availability above which there is' 
+            WRITE(numout,*) '             no moisture-related senescence: (::nosenescence_hum(j))', &
+            &  nosenescence_hum(j)
+
+       ! consistency check
+
+       IF ( ( ( senescence_type(j) .EQ. 'dry' ) .OR. &
+            ( senescence_type(j) .EQ. 'mixed' )     ) .AND. &
+            ( nosenescence_hum(j) .EQ. undef )                   ) THEN
+          CALL ipslerr_p(3,'stomate_data','Problem with senescence parameters, humidity. (::senescence_type)','','')
+       ENDIF
+
+       !
+       ! 12 sapwood -> heartwood conversion time (days)
+       !
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       sapwood -> heartwood conversion time (d): (::tau_sap(j))', tau_sap(j)
+
+       !
+       ! 13 fruit lifetime (days)
+       !
+
+       IF ( printlev >= 1 ) WRITE(numout,*) '       fruit lifetime (d): (::tau_fruit(j))', tau_fruit(j)
+
+       !
+       ! 14 length of leaf death (days)
+       !      For evergreen trees, this variable determines the lifetime of the leaves.
+       !      Note that it is different from the value given in leaflife_tab.
+       !
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       length of leaf death (d): (::leaffall(j))', leaffall(j)
+
+       !
+       ! 15 maximum lifetime of leaves (days)
+       !
+
+       IF ( ( printlev >= 1 ) .AND. ( leafagecrit(j) .NE. undef ) ) &
+            WRITE(numout,*) '       critical leaf age (d): (::leafagecrit(j))', leafagecrit(j)
+
+       !
+       ! 16 time constant for leaf age discretisation (days)
+       !
+
+       leaf_timecst(j) = leafagecrit(j) / REAL( nleafages,r_std )
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       time constant for leaf age discretisation (d): (::leaf_timecst(j))', &
+            leaf_timecst(j)
+
+       !
+       ! 17 minimum lai, initial (m^2.m^{-2})
+       !
+
+       IF ( is_tree(j) ) THEN
+          lai_initmin(j) = lai_initmin_tree
+       ELSE
+          lai_initmin(j) = lai_initmin_grass
+       ENDIF !( is_tree(j) )
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       initial LAI: (::lai_initmin(j))', lai_initmin(j)
+
+       !
+       ! 19 maximum LAI (m^2.m^{-2})
+       !
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       critical LAI above which no leaf allocation: (::lai_max(j))', lai_max(j)
+
+       !
+       ! 20 fraction of primary leaf and root allocation put into reserve (0-1, unitless)
+       !
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       reserve allocation factor: (::ecureuil(j))', ecureuil(j)
+
+       !
+       ! 21 maintenance respiration coefficient (g/g/day) at 0 deg C
+       !
+
+       IF ( printlev >= 1 ) THEN
+
+          WRITE(numout,*) '       maintenance respiration coefficient (g/g/day) at 0 deg C:'
+          WRITE(numout,*) '         . leaves: (::coeff_maint_zero(j,ileaf))',coeff_maint_zero(j,ileaf)
+          WRITE(numout,*) '         . sapwood above ground: (::coeff_maint_zero(j,isapabove)) ',&
+                        & coeff_maint_zero(j,isapabove)
+          WRITE(numout,*) '         . sapwood below ground: (::coeff_maint_zero(j,isapbelow))  ',&
+                       & coeff_maint_zero(j,isapbelow)
+          WRITE(numout,*) '         . heartwood above ground: (::coeff_maint_zero(j,iheartabove)) ',&
+                       & coeff_maint_zero(j,iheartabove)
+          WRITE(numout,*) '         . heartwood below ground: (::coeff_maint_zero(j,iheartbelow)) ',&
+                       & coeff_maint_zero(j,iheartbelow)
+          WRITE(numout,*) '         . roots: (::coeff_maint_zero(j,iroot))',coeff_maint_zero(j,iroot)
+          WRITE(numout,*) '         . fruits: (::coeff_maint_zero(j,ifruit)) ',coeff_maint_zero(j,ifruit)
+          WRITE(numout,*) '         . carbohydrate reserve: (::coeff_maint_zero(j,icarbres)) ',&
+                       & coeff_maint_zero(j,icarbres)
+
+       ENDIF !( printlev >= 1 )
+
+       !
+       ! 22 parameter for temperature sensitivity of maintenance respiration
+       !
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       temperature sensitivity of maintenance respiration (1/K) is'
+       WRITE(numout,*) '          a function of long term T (C): (::maint_resp_slope)'
+       WRITE(numout,*) '          ',maint_resp_slope(j,1),' + T *',maint_resp_slope(j,2), &
+            ' + T^2 *',maint_resp_slope(j,3)
+
+       !
+       ! 23 natural ?
+       !
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       Natural: (::natural(j))', natural(j)
+
+       !
+       ! 24 Vcmax et Vjmax (umol.m^{-2}.s^{-1}) 
+       !
+
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       Maximum rate of carboxylation: (::Vcmax_25(j))', vcmax25(j)
+       !
+       ! 25 constants for photosynthesis temperatures
+       !
+
+       IF ( printlev >= 1 ) THEN
+
+
+
+          !
+          ! 26 Properties
+          !
+
+          WRITE(numout,*) '       C4 photosynthesis: (::is_c4(j))', is_c4(j)
+          WRITE(numout,*) '       Depth constant for root profile (m): (::1./humcste(j))', 1./humcste(j)
+
+       ENDIF !( bavard .GE. 1 ) 
+
+       !
+       ! 27 extinction coefficient of the Monsi and Saeki (1953) relationship 
+       !
+       IF ( printlev >= 1 ) THEN
+          WRITE(numout,*) '       extinction coefficient: (::ext_coeff(j))', ext_coeff(j)
+       ENDIF
+
+       !
+       ! 30 fraction of allocatable biomass which is lost as growth respiration (0-1, unitless)
+       !
+       IF ( printlev >= 1 ) &
+            WRITE(numout,*) '       growth respiration fraction: (::frac_growthresp(j))', frac_growthresp(j)
+
+    ENDDO ! Loop over # PFTS 
+
+    !
+    ! 29 time scales for phenology and other processes (in days)
+    !
+
+    tau_longterm_max = coeff_tau_longterm * one_year
+
+    IF ( printlev >= 1 ) THEN
+
+       WRITE(numout,*) '   > time scale for ''monthly'' moisture availability (d): (::tau_hum_month)', &
+            tau_hum_month
+       WRITE(numout,*) '   > time scale for ''weekly'' moisture availability (d): (::tau_hum_week)', &
+           tau_hum_week
+       WRITE(numout,*) '   > time scale for ''monthly'' 2 meter temperature (d): (::tau_t2m_month)', &
+            tau_t2m_month
+       WRITE(numout,*) '   > time scale for ''weekly'' 2 meter temperature (d): (::tau_t2m_week)', &
+            tau_t2m_week
+       WRITE(numout,*) '   > time scale for ''weekly'' GPP (d): (::tau_gpp_week)', &
+            tau_gpp_week
+       WRITE(numout,*) '   > time scale for ''monthly'' soil temperature (d): (::tau_tsoil_month)', &
+            tau_tsoil_month
+       WRITE(numout,*) '   > time scale for ''monthly'' soil humidity (d): (::tau_soilhum_month)', &
+            tau_soilhum_month
+       WRITE(numout,*) '   > time scale for vigour calculations (y): (::tau_longterm_max / one_year)', &
+            tau_longterm_max / one_year
+
+    ENDIF  
+
+    IF (printlev >= 4) WRITE(numout,*) 'Leaving data'
+
+  END SUBROUTINE data
+
+END MODULE stomate_data
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_io.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_io.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_io.f90	(revision 5166)
@@ -0,0 +1,2639 @@
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+! IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+MODULE stomate_io
+  !---------------------------------------------------------------------
+  !- Not all variables saved in the start files are absolutely necessary.
+  !- However, Sechiba's and Stomate's PFTs are not necessarily identical,
+  !- and for that case this information needs to be saved.
+  !---------------------------------------------------------------------
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE mod_orchidee_para
+  USE ioipsl_para 
+  !-
+  IMPLICIT NONE
+  !-
+  PRIVATE
+  PUBLIC readstart, writerestart
+  !-
+  ! reference temperature (K)
+  !-
+  REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE :: trefe
+!$OMP THREADPRIVATE(trefe)
+  !-
+CONTAINS
+  !-
+  !===
+  !-
+  SUBROUTINE readstart &
+       & (npts, index, lalo, resolution, t2m, dt_days, date, &
+       &  ind, adapted, regenerate, moiavail_daily, gdd_init_date, litterhum_daily, &
+       &  t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+       &  soilhum_daily, precip_daily, &
+       &  gpp_daily, npp_daily, turnover_daily, &
+       &  moiavail_month, moiavail_week, t2m_longterm, tau_longterm, &
+       &  t2m_month, t2m_week, tsoil_month, soilhum_month, &
+       &  fireindex, firelitter, &
+       &  maxmoiavail_lastyear, maxmoiavail_thisyear, &
+       &  minmoiavail_lastyear, minmoiavail_thisyear, &
+       &  maxgppweek_lastyear, maxgppweek_thisyear, &
+       &  gdd0_lastyear, gdd0_thisyear, precip_lastyear, precip_thisyear, &
+       &  gdd_m5_dormance,  gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       &  PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+       &  maxfpc_lastyear, maxfpc_thisyear, &
+       &  turnover_longterm, gpp_week, biomass, resp_maint_part, &
+       &  leaf_age, leaf_frac, senescence, when_growthinit, age, &
+       &  resp_hetero, resp_maint, resp_growth, co2_fire, co2_to_bm_dgvm, &
+       &  veget_lastlight, everywhere, need_adjacent, RIP_time, &
+       &  time_hum_min, hum_min_dormance, &
+       &  litterpart, litter_above, litter_below, dead_leaves, &
+       &  carbon, DOC, lignin_struc_above, lignin_struc_below, turnover_time, &
+       &  prod10,prod100,flux10, flux100, &
+       &  convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total, &
+       &  Tseason, Tseason_length, Tseason_tmp, & 
+       &  Tmin_spring_time, begin_leaves, onset_date, &
+       &  assim_param)
+
+    !---------------------------------------------------------------------
+    !- read start file
+    !---------------------------------------------------------------------
+    !-
+    ! 0 declarations
+    !-
+    ! 0.1 input
+    !-
+    ! Domain size
+    INTEGER(i_std),INTENT(in) :: npts
+    ! Indices of the points on the map
+    INTEGER(i_std),DIMENSION(npts),INTENT(in) :: index
+    ! Geogr. coordinates (latitude,longitude) (degrees)
+    REAL(r_std),DIMENSION(npts,2),INTENT(in) :: lalo
+    ! size in x an y of the grid (m)
+    REAL(r_std),DIMENSION(npts,2),INTENT(in) :: resolution
+    REAL(r_std),DIMENSION(npts),INTENT(in)   :: t2m                !! 2 m air temperature from forcing file or coupled model (K)
+    !-
+    ! 0.2 output
+    !-
+    ! time step of STOMATE in days
+    REAL(r_std),INTENT(out) :: dt_days
+    ! date (d)
+    INTEGER(i_std),INTENT(out) :: date
+    ! density of individuals (1/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ind
+    ! Winter too cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: adapted
+    ! Winter sufficiently cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: regenerate
+    ! daily moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_daily
+    ! date for beginning of gdd count
+    REAL(r_std),DIMENSION(npts,2),INTENT(out) :: gdd_init_date
+    ! daily litter humidity
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: litterhum_daily
+    ! daily 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_daily
+    ! daily minimum 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_min_daily
+    ! daily surface temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: tsurf_daily
+    ! daily soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: tsoil_daily
+    ! daily soil humidity
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: soilhum_daily
+    ! daily precipitations (mm/day) (for phenology)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: precip_daily
+    ! daily gross primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gpp_daily
+    ! daily net primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: npp_daily
+    ! daily turnover rates (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out) :: turnover_daily
+    ! "monthly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_month
+    ! "weekly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_week
+    ! "long term" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_longterm
+    ! "tau_longterm"
+    REAL(r_std), INTENT(out)        :: tau_longterm
+    ! "monthly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_month
+    ! "seasonal" 2 meter temperatures (K) 
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: Tseason
+    ! temporary variable to calculate Tseason
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: Tseason_length
+    ! temporary variable to calculate Tseason
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: Tseason_tmp
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out)  :: Tmin_spring_time
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out)  :: onset_date
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out)      :: begin_leaves
+
+    ! "weekly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_week
+    ! "monthly" soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: tsoil_month
+    ! "monthly" soil humidity
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: soilhum_month
+    ! Probability of fire
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: fireindex
+    ! Longer term total litter above the ground, gC/m**2 of ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: firelitter
+    ! last year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxmoiavail_lastyear
+    ! this year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxmoiavail_thisyear
+    ! last year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: minmoiavail_lastyear
+    ! this year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: minmoiavail_thisyear
+    ! last year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxgppweek_lastyear
+    ! this year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxgppweek_thisyear
+    ! last year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: gdd0_lastyear
+    ! this year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: gdd0_thisyear
+    ! last year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: precip_lastyear
+    ! this year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: precip_thisyear
+    ! growing degree days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_m5_dormance
+    ! growing degree days, from begin of season
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_from_growthinit
+    ! growing degree days since midwinter (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_midwinter
+    ! number of chilling days since leaves were lost (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ncd_dormance
+    ! number of growing days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ngd_minus5
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out)    :: PFTpresent
+    ! "long term" net primary productivity (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: npp_longterm
+    ! last year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lm_lastyearmax
+    ! this year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lm_thisyearmax
+    ! last year's maximum fpc for each natural PFT, on ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxfpc_lastyear
+    ! this year's maximum fpc for each PFT,
+    ! on *total* ground (see stomate_season)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxfpc_thisyear
+    ! "long term" turnover rate (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out) :: turnover_longterm
+    ! "weekly" GPP (gC/day/(m**2 covered)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gpp_week
+    ! biomass (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out) :: biomass
+    ! maintenance resp (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(out) :: resp_maint_part
+    ! leaf age (days)
+    REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(out) :: leaf_age
+    ! fraction of leaves in leaf age class
+    REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(out) :: leaf_frac
+    ! is the plant senescent ? 
+    !(only for deciduous trees - carbohydrate reserve)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out) :: senescence
+    ! how many days ago was the beginning of the growing season
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: when_growthinit
+    ! mean age (years)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: age
+    ! heterotrophic respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nelements),INTENT(out) :: resp_hetero
+    ! maintenance respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: resp_maint
+    ! growth respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: resp_growth
+    ! carbon emitted into the atmosphere by fire (living and dead biomass)
+    ! (in gC/m**2/time step)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: co2_fire
+    ! biomass uptaken (gC/(m**2 of total ground)/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: co2_to_bm_dgvm
+    ! vegetation fractions (on ground) after last light competition
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: veget_lastlight
+    ! is the PFT everywhere in the grid box or very localized
+    ! (after its introduction)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: everywhere
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box?
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out) :: need_adjacent
+    ! How much time ago was the PFT eliminated for the last time (y)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: RIP_time
+    ! time elapsed since strongest moisture availability (d)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: time_hum_min
+    ! minimum moisture during dormance
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: hum_min_dormance
+    ! fraction of litter above the ground belonging to different PFTs
+    ! separated for natural and agricultural PFTs.
+    REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(out) :: litterpart
+    ! metabolic and structural litter, natural and agricultural,
+    ! above ground (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nelements),INTENT(out):: litter_above
+    ! metabolic and structural litter, natural and agricultural,
+    ! below ground (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nbdl,nelements),INTENT(out):: litter_below
+    ! dead leaves on ground, per PFT, metabolic and structural,
+    ! in gC/(m**2 of ground)
+    REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(out) :: dead_leaves
+    ! carbon pool: active, slow, or passive, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,ncarb,nvm,nbdl,nelements),INTENT(out) :: carbon
+    ! dissoled organic carbon in soils: free or adsrobed (gC/m**3 of water)
+    REAL(r_std),DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements),INTENT(out) :: DOC
+    ! ratio Lignine/Carbon in structural litter, above ground,(gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lignin_struc_above
+    ! ratio Lignine/Carbon in structural litter, below ground,(gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nbdl),INTENT(out) :: lignin_struc_below
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: turnover_time
+
+    !-
+    REAL(r_std), DIMENSION(npts,nvm,npco2),   INTENT(out) :: assim_param
+
+    ! 0.4 local
+    !-
+    ! date, real
+    REAL(r_std) :: date_real
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs), real
+    REAL(r_std),DIMENSION(npts,nvm) :: PFTpresent_real
+    ! is the plant senescent ?
+    ! (only for deciduous trees - carbohydrate reserve), real
+    REAL(r_std),DIMENSION(npts,nvm) :: senescence_real
+    REAL(r_std),DIMENSION(npts,nvm) :: begin_leaves_real
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box? - real
+    REAL(r_std),DIMENSION(npts,nvm) :: need_adjacent_real
+    REAL(r_std), DIMENSION(1) :: vartmp  !! temporary variable because restget/restput needs an array and not a scalar
+    ! To store variables names for I/O
+    CHARACTER(LEN=80) :: var_name
+    ! string suffix indicating an index
+    CHARACTER(LEN=10) :: part_str
+    ! string suffix indicating litter type
+    CHARACTER(LEN=3),DIMENSION(nlitt) :: litter_str
+    ! temporary storage
+    REAL(r_std),DIMENSION(1) :: xtmp
+    ! index
+    INTEGER(i_std) :: j,k,l,m
+    ! reference temperature (K)
+
+    CHARACTER(LEN=1),DIMENSION(nelements) :: element_str   !! string suffix indicating element
+    REAL(r_std), DIMENSION(1) :: temp_global_years
+    CHARACTER(LEN=10), DIMENSION(nbpools) :: pools_str
+    REAL(r_std), DIMENSION(npts) :: ok_equilibrium_real    
+    ! land cover change variables 
+    ! products remaining in the 10/100 year-turnover pool after the annual release for each compartment
+    ! (10 or 100 + 1 : input from year of land cover change)
+    REAL(r_std),DIMENSION(npts,0:10),INTENT(out)                           :: prod10
+    REAL(r_std),DIMENSION(npts,0:100),INTENT(out)                          :: prod100
+    ! annual release from the 10/100 year-turnover pool compartments
+    REAL(r_std),DIMENSION(npts,10),INTENT(out)                           :: flux10
+    REAL(r_std),DIMENSION(npts,100),INTENT(out)                          :: flux100
+    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: convflux
+    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: cflux_prod10
+    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: cflux_prod100
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out)         :: bm_to_litter
+    REAL(r_std),DIMENSION(npts),INTENT(out)                              :: carb_mass_total
+    REAL(r_std),DIMENSION(npts,nvm)                                      :: vcmax_tmp
+    !---------------------------------------------------------------------
+    IF (printlev >= 3) WRITE(numout,*) 'Entering readstart'
+    !-
+    ! 1 string definitions
+    !-
+    DO l=1,nlitt
+       IF     (l == imetabolic) THEN
+          litter_str(l) = 'met'
+       ELSEIF (l == istructural) THEN
+          litter_str(l) = 'str'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io readstart', 'Define litter_str','','')
+       ENDIF
+    ENDDO
+    !-
+!    DO l=1,nlevs
+!       IF     (l == iabove) THEN
+!          level_str(l) = 'ab'
+!       ELSEIF (l == ibelow) THEN
+!          level_str(l) = 'be'
+!       ELSE
+!          CALL ipslerr_p(3,'stomate_io readstart','Define level_str','','')
+!       ENDIF
+!    ENDDO
+
+    !-
+    DO l=1,nelements
+       IF     (l == icarbon) THEN
+          element_str(l) = 'carbon_total'
+       ELSEIF (l == icarbon14) THEN
+          element_str(l) = '_carbon14'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io readstart','Define element_str','','')
+       ENDIF
+    ENDDO
+    !-
+    ! 2 run control
+    !-
+    ! 2.2 time step of STOMATE in days
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'dt_days'
+       CALL restget (rest_id_stomate, var_name, 1   , 1     , 1, itime, &
+            &                 .TRUE., xtmp)
+       dt_days = xtmp(1)
+       IF (dt_days == val_exp) dt_days = un
+    ENDIF
+    CALL bcast(dt_days)
+    !-
+    ! 2.3 date
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'date'
+       CALL restget (rest_id_stomate, var_name, 1   , 1     , 1, itime, &
+            &                 .TRUE., xtmp)
+       date_real = xtmp(1)
+       IF (date_real == val_exp) date_real = zero
+       date = NINT(date_real)
+    ENDIF
+    CALL bcast(date)
+    !-
+    ! 3 daily meteorological variables
+    !-
+    moiavail_daily(:,:) = val_exp
+    var_name = 'moiavail_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., moiavail_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(moiavail_daily(:,:) == val_exp)) moiavail_daily(:,:) = zero
+    !-
+    gdd_init_date(:,:) = val_exp
+    var_name = 'gdd_init_date'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 2 , 1, itime, &
+         &              .TRUE., gdd_init_date, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_init_date(:,1) == val_exp)) gdd_init_date(:,1) = 365.
+    !-
+    litterhum_daily(:) = val_exp
+    var_name = 'litterhum_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., litterhum_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(litterhum_daily(:) == val_exp)) litterhum_daily(:) = zero
+    !-
+    t2m_daily(:) = val_exp
+    var_name = 't2m_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., t2m_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(t2m_daily(:) == val_exp)) t2m_daily(:) = zero
+    !-
+    t2m_min_daily(:) = val_exp
+    var_name = 't2m_min_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., t2m_min_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(t2m_min_daily(:) == val_exp)) t2m_min_daily(:) = large_value
+    !-
+    tsurf_daily(:) = val_exp
+    var_name = 'tsurf_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., tsurf_daily, 'gather', nbp_glo, index_g)
+    ! The initial value is set to the current temperature at 2m
+    IF (ALL(tsurf_daily(:) == val_exp)) tsurf_daily(:) = t2m(:)
+    !-
+    tsoil_daily(:,:) = val_exp
+    var_name = 'tsoil_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nbdl, 1, itime, &
+         &                .TRUE., tsoil_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(tsoil_daily(:,:) == val_exp)) tsoil_daily(:,:) = zero
+    !-
+    soilhum_daily(:,:) = val_exp
+    var_name = 'soilhum_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nbdl, 1, itime, &
+         &                .TRUE., soilhum_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(soilhum_daily(:,:) == val_exp)) soilhum_daily(:,:) = zero
+    !-
+    precip_daily(:) = val_exp
+    var_name = 'precip_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., precip_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(precip_daily(:) == val_exp)) precip_daily(:) = zero
+    !-
+    ! 4 productivities
+    !-
+    gpp_daily(:,:) = val_exp
+    var_name = 'gpp_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gpp_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(gpp_daily(:,:) == val_exp)) gpp_daily(:,:) = zero
+    !-
+    npp_daily(:,:) = val_exp
+    var_name = 'npp_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., npp_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(npp_daily(:,:) == val_exp)) npp_daily(:,:) = zero
+    !-
+    turnover_daily(:,:,:,:) = val_exp
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'turnover_daily_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               &                .TRUE., turnover_daily(:,:,k,l), 'gather', nbp_glo, index_g)
+          IF (ALL(turnover_daily(:,:,k,l) == val_exp)) &
+               &       turnover_daily(:,:,k,l) = zero
+       ENDDO
+    END DO
+    !-
+    ! 5 monthly meteorological variables
+    !-
+    moiavail_month(:,:) = val_exp
+    var_name = 'moiavail_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., moiavail_month, 'gather', nbp_glo, index_g)
+    IF (ALL(moiavail_month(:,:) == val_exp)) moiavail_month(:,:) = zero
+    !-
+    moiavail_week(:,:) = val_exp
+    var_name = 'moiavail_week'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., moiavail_week, 'gather', nbp_glo, index_g)
+    IF (ALL(moiavail_week(:,:) == val_exp)) moiavail_week(:,:) = zero
+    
+
+    !
+    ! Longterm temperature at 2m
+    !
+    var_name = 't2m_longterm'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., t2m_longterm, 'gather', nbp_glo, index_g)
+
+    IF (ALL(t2m_longterm(:) == val_exp)) THEN
+       ! t2m_longterm is not in restart file
+       ! The initial value for the reference temperature is set to the current temperature
+       t2m_longterm(:)=t2m(:)
+       ! Set the counter to 2 time steps
+       tau_longterm=2
+    ELSE
+       ! t2m_longterm was in the restart file
+       ! Now read tau_longterm
+       ! tau_longterm is a scalar, therefor only master process read this value
+       IF (is_root_prc) THEN
+          CALL restget (rest_id_stomate, 'tau_longterm', 1 ,1  , 1, itime, &
+               .TRUE., vartmp)
+          IF (vartmp(1) == val_exp) THEN
+             ! tau_longterm is not found in restart file. 
+             ! This is not normal as t2m_longterm was in restart file. Write a warning and initialize it to tau_longterm_max
+             CALL ipslerr(2, 'stomate_io readstart','tau_longterm was not in restart file',&
+                  'But t2m_longterm was in restart file','')
+             tau_longterm = tau_longterm_max
+          ELSE
+             tau_longterm = vartmp(1)
+          END IF
+       ENDIF
+       CALL bcast(tau_longterm)
+
+    END IF
+    !-
+    t2m_month(:) = val_exp
+    var_name = 't2m_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., t2m_month, 'gather', nbp_glo, index_g)
+    IF (ALL(t2m_month(:) == val_exp)) t2m_month(:) = t2m(:)
+    
+    CALL restget_p (rest_id_stomate, 'Tseason', nbp_glo, 1     , 1, itime, &
+         .TRUE., Tseason, 'gather', nbp_glo, index_g)
+    IF (ALL(Tseason(:) == val_exp)) Tseason(:) = t2m(:)
+    
+    CALL restget_p (rest_id_stomate,'Tseason_length', nbp_glo, 1     , 1, itime, &
+         .TRUE., Tseason_length, 'gather', nbp_glo, index_g)
+    IF (ALL(Tseason_length(:) == val_exp)) Tseason_length(:) = zero
+    
+    CALL restget_p (rest_id_stomate, 'Tseason_tmp', nbp_glo, 1     , 1, itime, &
+         .TRUE., Tseason_tmp, 'gather', nbp_glo, index_g)
+    IF (ALL(Tseason_tmp(:) == val_exp)) Tseason_tmp(:) = zero
+
+    CALL restget_p (rest_id_stomate, 'Tmin_spring_time', nbp_glo, nvm, 1, itime, &
+         .TRUE., Tmin_spring_time, 'gather', nbp_glo, index_g)
+    IF (ALL(Tmin_spring_time(:,:) == val_exp)) Tmin_spring_time(:,:) = zero
+    
+    CALL restget_p (rest_id_stomate, 'onset_date', nbp_glo, nvm  , 1, itime, &
+         .TRUE., onset_date(:,:), 'gather', nbp_glo, index_g)
+    IF (ALL(onset_date(:,:) == val_exp)) onset_date(:,:) = zero
+
+    t2m_week(:) = val_exp
+    var_name = 't2m_week'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., t2m_week, 'gather', nbp_glo, index_g)
+    ! The initial value is set to the current temperature
+    IF (ALL(t2m_week(:) == val_exp)) t2m_week(:) = t2m(:)
+    
+    tsoil_month(:,:) = val_exp
+    var_name = 'tsoil_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nbdl, 1, itime, &
+         &              .TRUE., tsoil_month, 'gather', nbp_glo, index_g)
+
+    ! The initial value is set to the current temperature
+    IF (ALL(tsoil_month(:,:) == val_exp)) THEN
+       DO l=1,nbdl
+          tsoil_month(:,l) = t2m(:)
+       ENDDO
+    ENDIF
+    !-
+    soilhum_month(:,:) = val_exp
+    var_name = 'soilhum_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nbdl, 1, itime, &
+         &              .TRUE., soilhum_month, 'gather', nbp_glo, index_g)
+    IF (ALL(soilhum_month(:,:) == val_exp)) soilhum_month(:,:) = zero
+    !-
+    ! 6 fire probability
+    !-
+    fireindex(:,:) = val_exp
+    var_name = 'fireindex'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              .TRUE., fireindex, 'gather', nbp_glo, index_g)
+    IF (ALL(fireindex(:,:) == val_exp)) fireindex(:,:) = zero
+    !-
+    firelitter(:,:) = val_exp
+    var_name = 'firelitter'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              .TRUE., firelitter, 'gather', nbp_glo, index_g)
+    IF (ALL(firelitter(:,:) == val_exp)) firelitter(:,:) = zero
+    !-
+    ! 7 maximum and minimum moisture availabilities for tropic phenology
+    !-
+    maxmoiavail_lastyear(:,:) = val_exp
+    var_name = 'maxmoistr_last'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxmoiavail_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxmoiavail_lastyear(:,:) == val_exp)) &
+         &     maxmoiavail_lastyear(:,:) = zero
+    !-
+    maxmoiavail_thisyear(:,:) = val_exp
+    var_name = 'maxmoistr_this'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxmoiavail_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxmoiavail_thisyear(:,:) == val_exp)) &
+         &     maxmoiavail_thisyear(:,:) = zero
+    !-
+    minmoiavail_lastyear(:,:) = val_exp
+    var_name = 'minmoistr_last'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., minmoiavail_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(minmoiavail_lastyear(:,:) == val_exp)) &
+         &     minmoiavail_lastyear(:,:) = un
+    !-
+    minmoiavail_thisyear(:,:) = val_exp
+    var_name = 'minmoistr_this'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., minmoiavail_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL( minmoiavail_thisyear(:,:) == val_exp)) &
+         &     minmoiavail_thisyear(:,:) = un
+    !-
+    ! 8 maximum "weekly" GPP
+    !-
+    maxgppweek_lastyear(:,:) = val_exp
+    var_name = 'maxgppweek_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxgppweek_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxgppweek_lastyear(:,:) == val_exp)) &
+         &     maxgppweek_lastyear(:,:) = zero
+    !-
+    maxgppweek_thisyear(:,:) = val_exp
+    var_name = 'maxgppweek_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxgppweek_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxgppweek_thisyear(:,:) == val_exp)) &
+         &     maxgppweek_thisyear(:,:) = zero
+    !-
+    ! 9 annual GDD0
+    !-
+    gdd0_thisyear(:) = val_exp
+    var_name = 'gdd0_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., gdd0_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd0_thisyear(:) == val_exp)) gdd0_thisyear(:) = zero
+    !-
+    gdd0_lastyear(:) = val_exp
+    var_name = 'gdd0_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., gdd0_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd0_lastyear(:) == val_exp)) gdd0_lastyear(:) = gdd_crit_estab
+    !-
+    ! 10 annual precipitation
+    !-
+    precip_thisyear(:) = val_exp
+    var_name = 'precip_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., precip_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(precip_thisyear(:) == val_exp)) precip_thisyear(:) = zero
+    !-
+    precip_lastyear(:) = val_exp
+    var_name = 'precip_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., precip_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(precip_lastyear(:) == val_exp)) &
+         &     precip_lastyear(:) = precip_crit
+    !-
+    ! 11 derived "biometeorological" variables
+    !-
+    gdd_m5_dormance(:,:) = val_exp
+    var_name = 'gdd_m5_dormance'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gdd_m5_dormance, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_m5_dormance(:,:) == val_exp)) &
+         &     gdd_m5_dormance(:,:) = undef
+    !-
+    gdd_from_growthinit(:,:) = val_exp
+    var_name = 'gdd_from_growthinit'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gdd_from_growthinit, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_from_growthinit(:,:) == val_exp)) &
+         &     gdd_from_growthinit(:,:) = zero
+    !-
+    gdd_midwinter(:,:) = val_exp
+    var_name = 'gdd_midwinter'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gdd_midwinter, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_midwinter(:,:) == val_exp)) gdd_midwinter(:,:) = undef
+    !-
+    ncd_dormance(:,:) = val_exp
+    var_name = 'ncd_dormance'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., ncd_dormance, 'gather', nbp_glo, index_g)
+    IF (ALL(ncd_dormance(:,:) == val_exp)) ncd_dormance(:,:) = undef
+    !-
+    ngd_minus5(:,:) = val_exp
+    var_name = 'ngd_minus5'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., ngd_minus5, 'gather', nbp_glo, index_g)
+    IF (ALL(ngd_minus5(:,:) == val_exp)) ngd_minus5(:,:) = zero
+    !-
+    time_hum_min(:,:) = val_exp
+    var_name = 'time_hum_min'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., time_hum_min, 'gather', nbp_glo, index_g)
+    IF (ALL(time_hum_min(:,:) == val_exp)) time_hum_min(:,:) = undef
+    !-
+    hum_min_dormance(:,:) = val_exp
+    var_name = 'hum_min_dormance'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., hum_min_dormance, 'gather', nbp_glo, index_g)
+    IF (ALL(hum_min_dormance(:,:) == val_exp)) &
+         &     hum_min_dormance(:,:) = undef
+    !-
+    ! 12 Plant status
+    !-
+    PFTpresent_real(:,:) = val_exp
+    var_name = 'PFTpresent'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., PFTpresent_real, 'gather', nbp_glo, index_g)
+    IF (ALL(PFTpresent_real(:,:) == val_exp)) PFTpresent_real(:,:) = zero
+    WHERE (PFTpresent_real(:,:) >= .5)
+       PFTpresent = .TRUE.
+    ELSEWHERE
+       PFTpresent = .FALSE.
+    ENDWHERE
+    !-
+    ind(:,:) = val_exp
+    var_name = 'ind'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., ind, 'gather', nbp_glo, index_g)
+    IF (ALL(ind(:,:) == val_exp)) ind(:,:) = zero
+    !-
+    adapted(:,:) = val_exp
+    var_name = 'adapted'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., adapted, 'gather', nbp_glo, index_g)
+    IF (ALL(adapted(:,:) == val_exp)) adapted(:,:) = zero
+    !-
+    regenerate(:,:) = val_exp
+    var_name = 'regenerate'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., regenerate, 'gather', nbp_glo, index_g)
+    IF (ALL(regenerate(:,:) == val_exp)) regenerate(:,:) = zero
+    !-
+    npp_longterm(:,:) = val_exp
+    var_name = 'npp_longterm'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., npp_longterm, 'gather', nbp_glo, index_g)
+    IF (ALL(npp_longterm(:,:) == val_exp)) npp_longterm(:,:) = zero
+    !-
+    lm_lastyearmax(:,:) = val_exp
+    var_name = 'lm_lastyearmax'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., lm_lastyearmax, 'gather', nbp_glo, index_g)
+    IF (ALL(lm_lastyearmax(:,:) == val_exp)) lm_lastyearmax(:,:) = zero
+    !-
+    lm_thisyearmax(:,:) = val_exp
+    var_name = 'lm_thisyearmax'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., lm_thisyearmax, 'gather', nbp_glo, index_g)
+    IF (ALL(lm_thisyearmax(:,:) == val_exp)) lm_thisyearmax(:,:) = zero
+    !-
+    maxfpc_lastyear(:,:) = val_exp
+    var_name = 'maxfpc_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxfpc_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxfpc_lastyear(:,:) == val_exp)) maxfpc_lastyear(:,:) = zero
+    !-
+    maxfpc_thisyear(:,:) = val_exp
+    var_name = 'maxfpc_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxfpc_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxfpc_thisyear(:,:) == val_exp)) maxfpc_thisyear(:,:) = zero
+    !-
+    turnover_time(:,:) = val_exp
+    var_name = 'turnover_time'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., turnover_time, 'gather', nbp_glo, index_g)
+    IF ( ALL( turnover_time(:,:) == val_exp)) turnover_time(:,:) = 100.
+    !-
+    turnover_longterm(:,:,:,:) = val_exp
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF ( k < 10 ) part_str(1:1) = '0'
+          var_name = 'turnover_long_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               &              .TRUE., turnover_longterm(:,:,k,l), 'gather', nbp_glo, index_g)
+          IF (ALL(turnover_longterm(:,:,k,l) == val_exp)) &
+               &       turnover_longterm(:,:,k,l) = zero
+       ENDDO
+    END DO
+    !-
+    gpp_week(:,:) = val_exp
+    var_name = 'gpp_week'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gpp_week, 'gather', nbp_glo, index_g)
+    IF (ALL(gpp_week(:,:) == val_exp)) gpp_week(:,:) = zero
+    !-
+    biomass(:,:,:,:) = val_exp
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF ( k < 10 ) part_str(1:1) = '0'
+          var_name = 'biomass_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               &                   .TRUE., biomass(:,:,k,l), 'gather', nbp_glo, index_g)
+          IF (ALL(biomass(:,:,k,l) == val_exp)) biomass(:,:,k,l) = zero
+       ENDDO
+    END DO
+    !-
+    resp_maint_part(:,:,:) = val_exp
+    DO k=1,nparts
+       WRITE(part_str,'(I2)') k
+       IF ( k < 10 ) part_str(1:1) = '0'
+       var_name = 'maint_resp_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., resp_maint_part(:,:,k), 'gather', nbp_glo, index_g)
+       IF (ALL(resp_maint_part(:,:,k) == val_exp)) resp_maint_part(:,:,k) = zero
+    ENDDO
+    !-
+    leaf_age(:,:,:) = val_exp
+    DO m=1,nleafages
+       WRITE (part_str,'(I2)') m
+       IF ( m < 10 ) part_str(1:1) = '0'
+       var_name = 'leaf_age_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., leaf_age(:,:,m), 'gather', nbp_glo, index_g)
+       IF (ALL(leaf_age(:,:,m) == val_exp)) leaf_age(:,:,m) = zero
+    ENDDO
+    !-
+    leaf_frac(:,:,:) = val_exp
+    DO m=1,nleafages
+       WRITE(part_str,'(I2)') m
+       IF ( m < 10 ) part_str(1:1) = '0'
+       var_name = 'leaf_frac_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                  .TRUE., leaf_frac(:,:,m), 'gather', nbp_glo, index_g)
+       IF (ALL(leaf_frac(:,:,m) == val_exp)) leaf_frac(:,:,m) = zero
+    ENDDO
+    !-
+    senescence_real(:,:) = val_exp
+    var_name = 'senescence'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., senescence_real, 'gather', nbp_glo, index_g)
+    IF (ALL(senescence_real(:,:) == val_exp)) senescence_real(:,:) = zero
+    WHERE ( senescence_real(:,:) >= .5 )
+       senescence = .TRUE.
+    ELSEWHERE
+       senescence = .FALSE.
+    ENDWHERE
+
+
+    ! Read real value for begin_leaves
+    CALL restget_p (rest_id_stomate, 'begin_leaves', nbp_glo, nvm  , 1, itime, &
+         .TRUE., begin_leaves_real, 'gather', nbp_glo, index_g)
+    IF (ALL(begin_leaves_real(:,:) == val_exp)) begin_leaves_real(:,:) = zero
+
+    ! Transform into logical needed by the modele
+    WHERE ( begin_leaves_real(:,:) >= 0.5 )
+       begin_leaves = .TRUE.
+    ELSEWHERE
+       begin_leaves = .FALSE.
+    ENDWHERE
+
+
+    when_growthinit(:,:) = val_exp
+    var_name = 'when_growthinit'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., when_growthinit, 'gather', nbp_glo, index_g)
+    IF (ALL(when_growthinit(:,:) == val_exp)) &
+         &     when_growthinit(:,:) = zero
+    !-
+    age(:,:) = val_exp
+    var_name = 'age'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., age, 'gather', nbp_glo, index_g)
+    IF (ALL(age(:,:) == val_exp)) age(:,:) = zero
+    !-
+    ! 13 CO2
+    !-
+    resp_hetero(:,:,icarbon) = val_exp
+    var_name = 'resp_hetero'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                .TRUE., resp_hetero(:,:,icarbon), 'gather', nbp_glo, index_g)
+    IF (ALL(resp_hetero(:,:,icarbon) == val_exp)) resp_hetero(:,:,icarbon) = zero
+    !-
+    resp_maint(:,:) = val_exp
+    var_name = 'resp_maint'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., resp_maint, 'gather', nbp_glo, index_g)
+    IF (ALL(resp_maint(:,:) == val_exp)) resp_maint(:,:) = zero
+    !-
+    resp_growth(:,:) = val_exp
+    var_name = 'resp_growth'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., resp_growth, 'gather', nbp_glo, index_g)
+    IF (ALL(resp_growth(:,:) == val_exp)) resp_growth(:,:) = zero
+    !-
+    co2_fire(:,:) = val_exp
+    var_name = 'co2_fire'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &                .TRUE., co2_fire, 'gather', nbp_glo, index_g)
+    IF (ALL(co2_fire(:,:) == val_exp)) co2_fire(:,:) = zero
+    !-
+    co2_to_bm_dgvm(:,:) = val_exp
+    var_name = 'co2_to_bm_dgvm'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &                .TRUE., co2_to_bm_dgvm, 'gather', nbp_glo, index_g)
+    IF (ALL(co2_to_bm_dgvm(:,:) == val_exp)) co2_to_bm_dgvm(:,:) = zero
+    !-
+    ! 14 vegetation distribution after last light competition
+    !-
+    veget_lastlight(:,:) = val_exp
+    var_name = 'veget_lastlight'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., veget_lastlight, 'gather', nbp_glo, index_g)
+    IF (ALL(veget_lastlight(:,:) == val_exp)) veget_lastlight(:,:) = zero
+    !-
+    ! 15 establishment criteria
+    !-
+    everywhere(:,:) = val_exp
+    var_name = 'everywhere'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., everywhere, 'gather', nbp_glo, index_g)
+    IF (ALL(everywhere(:,:) == val_exp)) everywhere(:,:) = zero
+    !-
+    need_adjacent_real(:,:) = val_exp
+    var_name = 'need_adjacent'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., need_adjacent_real, 'gather', nbp_glo, index_g)
+    IF (ALL(need_adjacent_real(:,:) == val_exp)) &
+         &     need_adjacent_real(:,:) = zero
+    WHERE ( need_adjacent_real(:,:) >= .5 )
+       need_adjacent = .TRUE.
+    ELSEWHERE
+       need_adjacent = .FALSE.
+    ENDWHERE
+    !-
+    RIP_time(:,:) = val_exp
+    var_name = 'RIP_time'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., RIP_time, 'gather', nbp_glo, index_g)
+    IF (ALL(RIP_time(:,:) == val_exp)) RIP_time(:,:) = large_value
+    !-
+    ! 17 litter
+    !-
+    litterpart(:,:,:) = val_exp
+    DO l=1,nlitt
+       var_name = 'litterpart_'//litter_str(l)
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., litterpart(:,:,l), 'gather', nbp_glo, index_g)
+       IF (ALL(litterpart(:,:,l) == val_exp)) litterpart(:,:,l) = zero
+    ENDDO
+    !-
+    litter_above(:,:,:,:) = val_exp
+    DO k = 1,nelements 
+        DO m = 1,nvm 
+            WRITE (part_str, '(I2)') m 
+            IF (m<10) part_str(1:1)='0' 
+            var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_above'//element_str(k) 
+            CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, & 
+                 &                     .TRUE., litter_above(:,:,m,k), 'gather', nbp_glo, index_g) 
+           IF (ALL(litter_above(:,:,m,k) == val_exp)) litter_above(:,:,m,k) = zero 
+        ENDDO 
+  END DO 
+    !- 
+    litter_below(:,:,:,:,:) = val_exp
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z01'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,1,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,1,k) == val_exp)) litter_below(:,:,m,1,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z02'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,2,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,2,k) == val_exp)) litter_below(:,:,m,2,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z03'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,3,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,3,k) == val_exp)) litter_below(:,:,m,3,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z04'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,4,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,4,k) == val_exp)) litter_below(:,:,m,4,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z05'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,5,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,5,k) == val_exp)) litter_below(:,:,m,5,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z06'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,6,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,6,k) == val_exp)) litter_below(:,:,m,6,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z07'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,7,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,7,k) == val_exp)) litter_below(:,:,m,7,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z08'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,8,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,8,k) == val_exp)) litter_below(:,:,m,8,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z09'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,9,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,9,k) == val_exp)) litter_below(:,:,m,9,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z10'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,10,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,10,k) == val_exp)) litter_below(:,:,m,10,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z11'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,11,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,11,k) == val_exp)) litter_below(:,:,m,11,k) = zero
+          ENDDO
+    END DO
+    !-
+    dead_leaves(:,:,:) = val_exp
+    DO l=1,nlitt
+       var_name = 'dead_leaves_'//litter_str(l)
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., dead_leaves(:,:,l), 'gather', nbp_glo, index_g)
+       IF (ALL(dead_leaves(:,:,l) == val_exp)) dead_leaves(:,:,l) = zero
+    ENDDO
+    !-
+   carbon(:,:,:,:,:) = val_exp
+DO k=1,nelements
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z01_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,1,k), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,1,k) == val_exp)) carbon(:,:,m,1,k) = zero
+    ENDDO
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z02_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,2,k), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,2,k) == val_exp)) carbon(:,:,m,2,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z03_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,3,k), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,3,k) == val_exp)) carbon(:,:,m,3,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z04_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,4,k), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,4,k) == val_exp)) carbon(:,:,m,4,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z05_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,5,k), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,5,k) == val_exp)) carbon(:,:,m,5,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z06_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,6,k), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,6,k) == val_exp)) carbon(:,:,m,6,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z07_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,7,k), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,7,k) == val_exp)) carbon(:,:,m,7,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z08_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,8,k), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,8,k) == val_exp)) carbon(:,:,m,8,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z09_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,9,k), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,9,k) == val_exp)) carbon(:,:,m,9,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,10,k), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,10,k) == val_exp)) carbon(:,:,m,10,k) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,11,k), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,11,k) == val_exp)) carbon(:,:,m,11,k) = zero
+    ENDDO
+ENDDO
+
+ DOC(:,:,:,:,:,:) = val_exp
+     DO m=1,npool
+	DO k=1,nelements
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z1_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,1,ifree,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,1,ifree,m,k)== val_exp))DOC(:,:,1,ifree,m,k) = zero
+
+         var_name = 'freedoc_z2_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,2,ifree,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,2,ifree,m,k)== val_exp))DOC(:,:,2,ifree,m,k) = zero
+
+         var_name = 'freedoc_z3_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,3,ifree,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,3,ifree,m,k)== val_exp))DOC(:,:,3,ifree,m,k) = zero
+
+         var_name = 'freedoc_z4_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,4,ifree,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,4,ifree,m,k)== val_exp))DOC(:,:,4,ifree,m,k) = zero
+
+         var_name = 'freedoc_z5_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,5,ifree,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,5,ifree,m,k)== val_exp))DOC(:,:,5,ifree,m,k) = zero
+
+         var_name = 'freedoc_z6_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,6,ifree,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,6,ifree,m,k)== val_exp))DOC(:,:,6,ifree,m,k) = zero
+
+         var_name = 'freedoc_z7_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,7,ifree,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,7,ifree,m,k)== val_exp))DOC(:,:,7,ifree,m,k) = zero
+
+         var_name = 'freedoc_z8_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,8,ifree,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,8,ifree,m,k)== val_exp))DOC(:,:,8,ifree,m,k) = zero
+
+         var_name = 'freedoc_z9_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,9,ifree,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,9,ifree,m,k)== val_exp))DOC(:,:,9,ifree,m,k) = zero
+
+         var_name = 'freedoc_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,10,ifree,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,10,ifree,m,k)== val_exp))DOC(:,:,10,ifree,m,k) = zero
+
+         var_name = 'freedoc_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,11,ifree,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,11,ifree,m,k)== val_exp))DOC(:,:,11,ifree,m,k) = zero
+
+         var_name = 'adsdoc_z1_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,1,iadsorbed,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,1,iadsorbed,m,k)== val_exp))DOC(:,:,1,iadsorbed,m,k) = zero
+
+         var_name = 'adsdoc_z2_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,2,iadsorbed,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,2,iadsorbed,m,k)== val_exp))DOC(:,:,2,iadsorbed,m,k) = zero
+
+         var_name = 'adsdoc_z3_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,3,iadsorbed,m,k),'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,3,iadsorbed,m,k)== val_exp))DOC(:,:,3,iadsorbed,m,k) = zero
+
+         var_name = 'adsdoc_z4_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,4,iadsorbed,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,4,iadsorbed,m,k)== val_exp))DOC(:,:,4,iadsorbed,m,k) = zero
+
+         var_name = 'adsdoc_z5_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,5,iadsorbed,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,5,iadsorbed,m,k)== val_exp))DOC(:,:,5,iadsorbed,m,k) = zero
+
+         var_name = 'adsdoc_z6_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,6,iadsorbed,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,6,iadsorbed,m,k)== val_exp))DOC(:,:,6,iadsorbed,m,k) = zero
+
+         var_name = 'adsdoc_z7_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,7,iadsorbed,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,7,iadsorbed,m,k)== val_exp))DOC(:,:,7,iadsorbed,m,k) = zero
+
+         var_name = 'adsdoc_z8_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,8,iadsorbed,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,8,iadsorbed,m,k)== val_exp))DOC(:,:,8,iadsorbed,m,k) = zero
+
+         var_name = 'adsdoc_z9_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,9,iadsorbed,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,9,iadsorbed,m,k)== val_exp))DOC(:,:,9,iadsorbed,m,k) = zero
+
+         var_name = 'adsdoc_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,10,iadsorbed,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,10,iadsorbed,m,k)== val_exp))DOC(:,:,10,iadsorbed,m,k) = zero
+
+         var_name = 'adsdoc_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,11,iadsorbed,m,k), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,11,iadsorbed,m,k)== val_exp))DOC(:,:,11,iadsorbed,m,k) = zero
+	ENDDO
+     ENDDO
+
+    !-
+    lignin_struc_above(:,:) = val_exp
+       var_name = 'lignin_struc_above'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_above(:,:), 'gather', nbp_glo, index_g) 
+       IF (ALL(lignin_struc_above(:,:) == val_exp)) lignin_struc_above(:,:) = zero 
+    !- 
+    lignin_struc_below(:,:,:) = val_exp
+       var_name = 'lig_struc_be_z01'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,1), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,1) == val_exp)) lignin_struc_below(:,:,1) = zero
+
+       var_name = 'lig_struc_be_z02'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,2), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,2) == val_exp)) lignin_struc_below(:,:,2) = zero
+
+       var_name = 'lig_struc_be_z03'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,3), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,3) == val_exp)) lignin_struc_below(:,:,3) = zero
+
+       var_name = 'lig_struc_be_z04'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,4), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,4) == val_exp)) lignin_struc_below(:,:,4) = zero
+    !-
+       var_name = 'lig_struc_be_z05'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,5), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,5) == val_exp)) lignin_struc_below(:,:,5) = zero
+
+       var_name = 'lig_struc_be_z06'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,6), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,6) == val_exp)) lignin_struc_below(:,:,6) = zero
+
+       var_name = 'lig_struc_be_z07'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,7), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,7) == val_exp)) lignin_struc_below(:,:,7) = zero
+
+       var_name = 'lig_struc_be_z08'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,8), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,8) == val_exp)) lignin_struc_below(:,:,8) = zero
+
+       var_name = 'lig_struc_be_z09'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,9), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,9) == val_exp)) lignin_struc_below(:,:,9) = zero
+
+       var_name = 'lig_struc_be_z10'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,10), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,10) == val_exp)) lignin_struc_below(:,:,10) = zero
+
+       var_name = 'lig_struc_be_z11'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,11), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,11) == val_exp)) lignin_struc_below(:,:,11) = zero
+
+    !-
+    ! 18 land cover change
+    !-
+    prod10(:,:) = val_exp
+    var_name = 'prod10'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 11     , 1, itime, &
+         &                .TRUE., prod10, 'gather', nbp_glo, index_g)
+    IF (ALL(prod10(:,:) == val_exp)) prod10(:,:) = zero
+
+    prod100(:,:) = val_exp
+    var_name = 'prod100'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 101     , 1, itime, &
+         &                .TRUE., prod100, 'gather', nbp_glo, index_g)
+    IF (ALL(prod100(:,:) == val_exp)) prod100(:,:) = zero
+
+
+    flux10(:,:) = val_exp
+    var_name = 'flux10'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 10     , 1, itime, &
+         &                .TRUE., flux10, 'gather', nbp_glo, index_g)
+    IF (ALL(flux10(:,:) == val_exp)) flux10(:,:) = zero
+
+    flux100(:,:) = val_exp
+    var_name = 'flux100'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 100     , 1, itime, &
+         &                .TRUE., flux100, 'gather', nbp_glo, index_g)
+    IF (ALL(flux100(:,:) == val_exp)) flux100(:,:) = zero
+
+    convflux(:) = val_exp
+    var_name = 'convflux'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., convflux, 'gather', nbp_glo, index_g)
+    IF (ALL(convflux(:) == val_exp)) convflux(:) = zero
+
+    cflux_prod10(:) = val_exp
+    var_name = 'cflux_prod10'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., cflux_prod10, 'gather', nbp_glo, index_g)
+    IF (ALL(cflux_prod10(:) == val_exp)) cflux_prod10(:) = zero
+
+    cflux_prod100(:) = val_exp
+    var_name = 'cflux_prod100'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., cflux_prod100, 'gather', nbp_glo, index_g)
+    IF (ALL(cflux_prod100(:) == val_exp)) cflux_prod100(:) = zero
+
+    bm_to_litter(:,:,:,:) = val_exp
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF ( k < 10 ) part_str(1:1) = '0'
+          var_name = 'bm_to_litter_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               &                .TRUE., bm_to_litter(:,:,k,l), 'gather', nbp_glo, index_g)
+          IF (ALL(bm_to_litter(:,:,k,l) == val_exp)) bm_to_litter(:,:,k,l) = zero
+       ENDDO
+    END DO
+
+    carb_mass_total(:) = val_exp
+    var_name = 'carb_mass_total'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., carb_mass_total, 'gather', nbp_glo, index_g)
+    IF (ALL(carb_mass_total(:) == val_exp)) carb_mass_total(:) = zero
+    !-
+
+    ! Read assim_param from restart file. The initialization of assim_param will 
+    ! be done in stomate_var_init if the variable is not in the restart file.
+    assim_param(:,:,:)  = val_exp
+    DO k= 1,npco2
+       WRITE(part_str,'(I2)') k
+       IF (k < 10) part_str(1:1) = '0' 
+       var_name = 'assim_param_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., assim_param(:,:,k), 'gather', nbp_glo, index_g)
+    END DO
+ 
+    IF (printlev >= 4) WRITE(numout,*) 'Leaving readstart'
+    !-----------------------
+  END SUBROUTINE readstart
+  !-
+  !===
+  !-
+  SUBROUTINE writerestart &
+       & (npts, index, dt_days, date, &
+       &  ind, adapted, regenerate, moiavail_daily, gdd_init_date, litterhum_daily, &
+       &  t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+       &  soilhum_daily, precip_daily, gpp_daily, npp_daily, &
+       &  turnover_daily, moiavail_month, moiavail_week, &
+       &  t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+       &  tsoil_month, soilhum_month, fireindex, firelitter, &
+       &  maxmoiavail_lastyear, maxmoiavail_thisyear, &
+       &  minmoiavail_lastyear, minmoiavail_thisyear, &
+       &  maxgppweek_lastyear, maxgppweek_thisyear, &
+       &  gdd0_lastyear, gdd0_thisyear, precip_lastyear, precip_thisyear, &
+       &  gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       &  PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+       &  maxfpc_lastyear, maxfpc_thisyear, &
+       &  turnover_longterm, gpp_week, biomass, resp_maint_part, &
+       &  leaf_age, leaf_frac, senescence, when_growthinit, age, &
+       &  resp_hetero, resp_maint, resp_growth, co2_fire, co2_to_bm_dgvm, &
+       &  veget_lastlight, everywhere, need_adjacent, RIP_time, &
+       &  time_hum_min, hum_min_dormance, &
+       &  litterpart, litter_above, litter_below, dead_leaves, &
+       &  carbon, DOC, lignin_struc_above, lignin_struc_below, turnover_time, &
+       &  prod10,prod100 ,flux10, flux100, &
+       &  convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total, &
+       &  Tseason, Tseason_length, Tseason_tmp, & 
+       &  Tmin_spring_time, begin_leaves, onset_date, &
+       &  assim_param)
+
+    !---------------------------------------------------------------------
+    !- write restart file
+    !---------------------------------------------------------------------
+    !-
+    ! 0 declarations
+    !-
+    ! 0.1 input
+    !-
+    ! Domain size
+    INTEGER(i_std),INTENT(in) :: npts
+    ! Indices of the points on the map
+    INTEGER(i_std),DIMENSION(npts),INTENT(in) :: index
+    ! time step of STOMATE in days
+    REAL(r_std),INTENT(in) :: dt_days
+    ! date (d)
+    INTEGER(i_std),INTENT(in) :: date
+    ! density of individuals (1/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ind
+    ! Winter too cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: adapted
+    ! Winter sufficiently cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: regenerate
+    ! daily moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_daily
+    ! gdd init date
+    REAL(r_std),DIMENSION(npts,2),INTENT(in) :: gdd_init_date
+    ! daily litter humidity
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: litterhum_daily
+    ! daily 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_daily
+    ! daily minimum 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_min_daily
+    ! daily surface temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: tsurf_daily
+    ! daily soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: tsoil_daily
+    ! daily soil humidity
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: soilhum_daily
+    ! daily precipitations (mm/day) (for phenology)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_daily
+    ! daily gross primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gpp_daily
+    ! daily net primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: npp_daily
+    ! daily turnover rates (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: turnover_daily
+    ! "monthly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_month
+    ! "weekly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_week
+    ! "long term" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_longterm
+    ! "tau_longterm"
+    REAL(r_std), INTENT(IN)             :: tau_longterm
+    ! "monthly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_month
+    ! "seasonal" 2 meter temperatures (K) 
+    REAL(r_std),DIMENSION(npts),INTENT(in)      :: Tseason
+    ! temporary variable to calculate Tseason
+    REAL(r_std),DIMENSION(npts),INTENT(in)      :: Tseason_length
+    ! temporary variable to calculate Tseason
+    REAL(r_std),DIMENSION(npts),INTENT(in)      :: Tseason_tmp
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)  :: Tmin_spring_time
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)  :: onset_date
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in)      :: begin_leaves
+
+    ! "weekly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_week
+    ! "monthly" soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: tsoil_month
+    ! "monthly" soil humidity
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: soilhum_month
+    ! Probability of fire
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: fireindex
+    ! Longer term total litter above the ground, gC/m**2 of ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: firelitter
+    ! last year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxmoiavail_lastyear
+    ! this year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxmoiavail_thisyear
+    ! last year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: minmoiavail_lastyear
+    ! this year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: minmoiavail_thisyear
+    ! last year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxgppweek_lastyear
+    ! this year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxgppweek_thisyear
+    ! last year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: gdd0_lastyear
+    ! this year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: gdd0_thisyear
+    ! last year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_lastyear
+    ! this year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_thisyear
+    ! growing degree days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_m5_dormance
+    ! growing degree days, from begin of season (crops)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_from_growthinit
+    ! growing degree days since midwinter (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_midwinter
+    ! number of chilling days since leaves were lost (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ncd_dormance
+    ! number of growing days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ngd_minus5
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: PFTpresent
+    ! "long term" net primary productivity (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: npp_longterm
+    ! last year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: lm_lastyearmax
+    ! this year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: lm_thisyearmax
+    ! last year's maximum fpc for each natural PFT, on ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxfpc_lastyear
+    ! this year's maximum fpc for each PFT,
+    ! on *total* ground (see stomate_season)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxfpc_thisyear
+    ! "long term" turnover rate (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: turnover_longterm
+    ! "weekly" GPP (gC/day/(m**2 covered)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gpp_week
+    ! biomass (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: biomass
+    ! maintenance respiration (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(in) :: resp_maint_part
+    ! leaf age (days)
+    REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(in) :: leaf_age
+    ! fraction of leaves in leaf age class
+    REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(in) :: leaf_frac
+    ! is the plant senescent ?
+    ! (only for deciduous trees - carbohydrate reserve)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: senescence
+    ! how many days ago was the beginning of the growing season
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: when_growthinit
+    ! mean age (years)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: age
+    ! heterotrophic respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nelements),INTENT(in) :: resp_hetero
+    ! maintenance respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: resp_maint
+    ! growth respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: resp_growth
+    ! carbon emitted into the atmosphere by fire (living and dead biomass)
+    ! (in gC/m**2/time step)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: co2_fire
+    ! biomass uptaken (gC/(m**2 of total ground)/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: co2_to_bm_dgvm
+    ! vegetation fractions (on ground) after last light competition
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: veget_lastlight
+    ! is the PFT everywhere in the grid box or very localized
+    ! (after its introduction)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: everywhere
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box?
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: need_adjacent
+    ! How much time ago was the PFT eliminated for the last time (y)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: RIP_time
+    ! time elapsed since strongest moisture availability (d)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: time_hum_min
+    ! minimum moisture during dormance
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: hum_min_dormance
+    ! fraction of litter above the ground belonging to different PFTs
+    REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(in) :: litterpart
+    ! metabolic and structural litter, above ground (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nelements),INTENT(in) :: litter_above
+    ! metabolic and structural litter, below ground (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nbdl,nelements),INTENT(in) :: litter_below
+    ! dead leaves on ground, per PFT, metabolic and structural,
+    ! in gC/(m**2 of ground)
+    REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(in) :: dead_leaves
+    ! carbon pool: active, slow, or passive, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,ncarb,nvm,nbdl,nelements),INTENT(in) :: carbon
+    ! dissoled organic carbon in soils: free or adsrobed (gC/m**2 of ground)
+    REAL(r_std),DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements),INTENT(out) :: DOC
+    ! ratio Lignine/Carbon in structural litter, above ground, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: lignin_struc_above
+    ! ratio Lignine/Carbon in structural litter, below ground, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nbdl),INTENT(in) :: lignin_struc_below
+
+    ! turnover_time of leaves
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: turnover_time
+
+    REAL(r_std), DIMENSION(npts,nvm,npco2),   INTENT(in) :: assim_param
+    !-
+    ! 0.2 local
+    !-
+    ! date, real
+    REAL(r_std) :: date_real
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs), real
+    REAL(r_std),DIMENSION(npts,nvm) :: PFTpresent_real
+    ! is the plant senescent ?
+    ! (only for deciduous trees - carbohydrate reserve), real
+    REAL(r_std),DIMENSION(npts,nvm) :: senescence_real
+    REAL(r_std),DIMENSION(npts,nvm) :: begin_leaves_real
+
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box? - real
+    REAL(r_std),DIMENSION(npts,nvm) :: need_adjacent_real
+    ! To store variables names for I/O
+    CHARACTER(LEN=80) :: var_name
+    ! string suffix indicating an index
+    CHARACTER(LEN=10) :: part_str
+    ! string suffix indicating litter type
+    CHARACTER(LEN=3),DIMENSION(nlitt) :: litter_str
+    ! temporary storage
+    REAL(r_std),DIMENSION(1) :: xtmp
+    REAL(r_std), DIMENSION(1) :: vartmp  !! temporary variable because restget/restput needs a variable with DIMESION(:)
+    ! index
+    INTEGER(i_std) :: j,k,l,m
+    CHARACTER(LEN=1),DIMENSION(nelements) :: element_str  !! string suffix indicating element
+    REAL(r_std), DIMENSION(1) :: temp_global_years
+    CHARACTER(LEN=10),DIMENSION(nbpools) :: pools_str
+    REAL(r_std), DIMENSION(npts) :: ok_equilibrium_real    
+
+    ! land cover change variables 
+    ! products remaining in the 10/100 year-turnover pool after the annual release for each compartment
+    ! (10 or 100 + 1 : input from year of land cover change)
+    REAL(r_std),DIMENSION(npts,0:10),INTENT(in)                           :: prod10
+    REAL(r_std),DIMENSION(npts,0:100),INTENT(in)                          :: prod100
+    ! annual release from the 10/100 year-turnover pool compartments
+    REAL(r_std),DIMENSION(npts,10),INTENT(in)                           :: flux10
+    REAL(r_std),DIMENSION(npts,100),INTENT(in)                          :: flux100
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: convflux
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: cflux_prod10
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: cflux_prod100
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in)         :: bm_to_litter
+    REAL(r_std),DIMENSION(npts),INTENT(in)                              :: carb_mass_total
+    !---------------------------------------------------------------------
+    IF (printlev >= 3) WRITE(numout,*) 'Entering writerestart'
+    !-
+    ! 1 string definitions
+    !-
+    DO l=1,nlitt
+       IF     (l == imetabolic) THEN
+          litter_str(l) = 'met'
+       ELSEIF (l == istructural) THEN
+          litter_str(l) = 'str'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io writerestart','Define litter_str','','')
+       ENDIF
+    ENDDO
+    !-
+!    DO l=1,nlevs
+!       IF     (l == iabove) THEN
+!          level_str(l) = 'ab'
+!       ELSEIF (l == ibelow) THEN
+!          level_str(l) = 'be'
+!       ELSE
+!          CALL ipslerr_p(3,'stomate_io writerestart','Define level_str','','')
+!       ENDIF
+!    ENDDO
+    !-
+    DO l=1,nelements
+       IF     (l == icarbon) THEN
+          element_str(l) = 'carbon_total'
+       ELSEIF (l == icarbon14) THEN
+          element_str(l) = '_carbon14'
+       ELSE
+          CALL ipslerr_p(3,'stomate_io writerestart','Define element_str','','')
+       ENDIF
+    ENDDO
+    !-
+    pools_str(1:nbpools) =(/'str_ab    ',&
+                            'strbe_z1  ','strbe_z2  ','strbe_z3  ','strbe_z4  ','strbe_z5  ','strbe_z6  ',&
+                            'strbe_z7  ','strbe_z8  ','strbe_z9  ','strbe_z10 ','strbe_z11 ',&
+                            'met_ab    ',&
+                            'metbe_z1  ','metbe_z2  ','metbe_z3  ','metbe_z4  ','metbe_z5  ','metbe_z6  ',&
+                            'metbe_z7  ','metbe_z8  ','metbe_z9  ','metbe_z10 ','metbe_z11 ',&
+                            'act_z1    ','act_z2    ','act_z3    ','act_z4    ','act_z5    ',&
+                            'act_z6    ','act_z7    ','act_z8    ','act_z9    ','act_z10   ','act_z11   ',&
+                            'slow_z1   ','slow_z2   ','slow_z3   ','slow_z4   ','slow_z5   ','slow_z6   ',&
+                            'slow_z7   ','slow_z8   ','slow_z9   ','slow_z10  ','slow_z11  ',&
+                            'pas_z1    ','pas_z2    ','pas_z3    ','pas_z4    ','pas_z5    ','pas_z6    ',&
+                            'pas_z7    ','pas_z8    ','pas_z9    ','pas_z10   ','pas_z11   ',&
+                            'free_z1_1 ','free_z2_1 ','free_z3_1 ','free_z4_1 ','free_z5_1 ','free_z6_1 ',&
+                            'free_z7_1 ','free_z8_1 ','free_z9_1 ','free_z10_1','free_z11_1',&
+                            'adso_z1_1 ','adso_z2_1 ','adso_z3_1 ','adso_z4_1 ','adso_z5_1 ','adso_z6_1 ',&
+                            'adso_z7_1 ','adso_z8_1 ','adso_z9_1 ','adso_z10_1','adso_z11_1',&
+                            'free_z1_2 ','free_z2_2 ','free_z3_2 ','free_z4_2 ','free_z5_2 ','free_z6_2 ',&
+                            'free_z7_2 ','free_z8_2 ','free_z9_2 ','free_z10_2','free_z11_2',&
+                            'adso_z1_2 ','adso_z2_2 ','adso_z3_2 ','adso_z4_2 ','adso_z5_2 ','adso_z6_2 ',&
+                            'adso_z7_2 ','adso_z8_2 ','adso_z9_2 ','adso_z10_2','adso_z11_2',&
+                            'free_z1_3 ','free_z2_3 ','free_z3_3 ','free_z4_3 ','free_z5_3 ','free_z6_3 ',&
+                            'free_z7_3 ','free_z8_3 ','free_z9_3 ','free_z10_3','free_z11_3',&
+                            'adso_z1_3 ','adso_z2_3 ','adso_z3_3 ','adso_z4_3 ','adso_z5_3 ','adso_z6_3 ',&
+                            'adso_z7_3 ','adso_z8_3 ','adso_z9_3 ','adso_z10_3','adso_z11_3',&
+                            'free_z1_4 ','free_z2_4 ','free_z3_4 ','free_z4_4 ','free_z5_4 ','free_z6_4 ',&
+                            'free_z7_4 ','free_z8_4 ','free_z9_4 ','free_z10_4','free_z11_4',&
+                            'adso_z1_4 ','adso_z2_4 ','adso_z3_4 ','adso_z4_4 ','adso_z5_4 ','adso_z6_4 ',&
+                            'adso_z7_4 ','adso_z8_4 ','adso_z9_4 ','adso_z10_4','adso_z11_4',&
+                            'free_z1_5 ','free_z2_5 ','free_z3_5 ','free_z4_5 ','free_z5_5 ','free_z6_5 ',&
+                            'free_z7_5 ','free_z8_5 ','free_z9_5 ','free_z10_5','free_z11_5',&
+                            'adso_z1_5 ','adso_z2_5 ','adso_z3_5 ','adso_z4_5 ','adso_z5_5 ','adso_z6_5 ',&
+                            'adso_z7_5 ','adso_z8_5 ','adso_z9_5 ','adso_z10_5','adso_z11_5',&
+                            'free_z1_6 ','free_z2_6 ','free_z3_6 ','free_z4_6 ','free_z5_6 ','free_z6_6 ',&
+                            'free_z7_6 ','free_z8_6 ','free_z9_6 ','free_z10_6','free_z11_6',&
+                            'adso_z1_6 ','adso_z2_6 ','adso_z3_6 ','adso_z4_6 ','adso_z5_6 ','adso_z6_6 ',&
+                            'adso_z7_6 ','adso_z8_6 ','adso_z9_6 ','adso_z10_6','adso_z11_6',&
+                            'free_z1_7 ','free_z2_7 ','free_z3_7 ','free_z4_7 ','free_z5_7 ','free_z6_7 ',&
+                            'free_z7_7 ','free_z8_7 ','free_z9_7 ','free_z10_7','free_z11_7',&
+                            'adso_z1_7 ','adso_z2_7 ','adso_z3_7 ','adso_z4_7 ','adso_z5_7 ','adso_z6_7 ',&
+                            'adso_z7_7 ','adso_z8_7 ','adso_z9_7 ','adso_z10_7','adso_z11_7'/)
+    !-
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p ('UNITS','-')
+       CALL ioconf_setatt_p ('LONG_NAME',' ')
+    ENDIF
+    !-
+    ! 2 run control
+    !-
+    ! 2.2 time step of STOMATE in days
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'dt_days'
+       xtmp(1) = dt_days
+       CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
+    ENDIF
+    !-
+    ! 2.3 date
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'date'
+       date_real = REAL(date,r_std)
+       xtmp(1) = date_real
+       CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
+    ENDIF
+    !-
+    ! 3 daily meteorological variables
+    !-
+    var_name = 'moiavail_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                moiavail_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd_init_date'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    2, 1, itime, &
+         &              gdd_init_date, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'litterhum_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                litterhum_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 't2m_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 't2m_min_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_min_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'tsurf_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                tsurf_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'tsoil_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
+         &                tsoil_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'soilhum_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
+         &                soilhum_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'precip_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                precip_daily, 'scatter', nbp_glo, index_g)
+    !-
+    ! 4 productivities
+    !-
+    var_name = 'gpp_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gpp_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'npp_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                npp_daily, 'scatter', nbp_glo, index_g)
+    !-
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'turnover_daily_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                   turnover_daily(:,:,k,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    END DO
+    !-
+    ! 5 monthly meteorological variables
+    !-
+    var_name = 'moiavail_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                moiavail_month, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'moiavail_week'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                moiavail_week, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 't2m_longterm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_longterm, 'scatter', nbp_glo, index_g)
+    
+    IF (is_root_prc) THEN
+       var_name='tau_longterm'
+       vartmp(1)=tau_longterm
+       CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, vartmp)
+    ENDIF
+       
+
+    var_name = 't2m_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+                         t2m_month, 'scatter', nbp_glo, index_g)
+    
+
+    CALL restput_p (rest_id_stomate, 'Tseason', nbp_glo,    1, 1, itime, &
+         Tseason, 'scatter', nbp_glo, index_g)
+    
+    CALL restput_p (rest_id_stomate, 'Tseason_length', nbp_glo,    1, 1, itime, &
+         Tseason_length, 'scatter', nbp_glo, index_g)
+    
+    CALL restput_p (rest_id_stomate, 'Tseason_tmp', nbp_glo,    1, 1, itime, &
+         Tseason_tmp, 'scatter', nbp_glo, index_g)
+    
+    CALL restput_p (rest_id_stomate, 'Tmin_spring_time', nbp_glo, nvm, 1, itime, &
+         Tmin_spring_time, 'scatter', nbp_glo, index_g)
+    
+    CALL restput_p (rest_id_stomate, 'onset_date', nbp_glo, nvm, 1, itime, &
+         onset_date(:,:), 'scatter', nbp_glo, index_g)
+    
+    var_name = 't2m_week'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_week, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'tsoil_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
+         &                tsoil_month, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'soilhum_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
+         &                soilhum_month, 'scatter', nbp_glo, index_g)
+    !-
+    ! 6 fire probability
+    !-
+    var_name = 'fireindex'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                fireindex, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'firelitter'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                firelitter, 'scatter', nbp_glo, index_g)
+    !-
+    ! 7 maximum and minimum moisture availabilities for tropic phenology
+    !-
+    var_name = 'maxmoistr_last'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxmoiavail_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxmoistr_this'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxmoiavail_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'minmoistr_last'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                minmoiavail_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'minmoistr_this'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                minmoiavail_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 8 maximum "weekly" GPP
+    !-
+    var_name = 'maxgppweek_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxgppweek_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxgppweek_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxgppweek_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 9 annual GDD0
+    !-
+    var_name = 'gdd0_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                gdd0_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd0_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                gdd0_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 10 annual precipitation
+    !-
+    var_name = 'precip_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                precip_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'precip_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                precip_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 11 derived "biometeorological" variables
+    !-
+    var_name = 'gdd_m5_dormance'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gdd_m5_dormance, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd_from_growthinit'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              gdd_from_growthinit, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd_midwinter'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gdd_midwinter, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'ncd_dormance'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                ncd_dormance, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'ngd_minus5'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                ngd_minus5, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'time_hum_min'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                time_hum_min, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'hum_min_dormance'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                hum_min_dormance, 'scatter', nbp_glo, index_g)
+    !-
+    ! 12 Plant status
+    !-
+    var_name = 'PFTpresent'
+    WHERE ( PFTpresent(:,:) )
+       PFTpresent_real = un
+    ELSEWHERE
+       PFTpresent_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                PFTpresent_real, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'ind'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                ind, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'turnover_time'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                turnover_time, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'adapted'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                adapted, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'regenerate'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                regenerate, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'npp_longterm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                npp_longterm, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'lm_lastyearmax'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                lm_lastyearmax, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'lm_thisyearmax'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                lm_thisyearmax, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxfpc_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxfpc_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxfpc_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxfpc_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'turnover_long_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                   turnover_longterm(:,:,k,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    END DO
+    !-
+    var_name = 'gpp_week'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gpp_week, 'scatter', nbp_glo, index_g)
+    !-
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'biomass_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                   biomass(:,:,k,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    END DO
+    !-
+    DO k=1,nparts
+       WRITE(part_str,'(I2)') k
+       IF (k < 10) part_str(1:1) = '0'
+       var_name = 'maint_resp_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                   resp_maint_part(:,:,k), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO m=1,nleafages
+       WRITE(part_str,'(I2)') m
+       IF (m < 10) part_str(1:1) = '0'
+       var_name = 'leaf_age_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                  leaf_age(:,:,m), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO m=1,nleafages
+       WRITE(part_str,'(I2)') m
+       IF (m < 10) part_str(1:1) = '0'
+       var_name = 'leaf_frac_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                   leaf_frac(:,:,m), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    var_name = 'senescence'
+    WHERE ( senescence(:,:) )
+       senescence_real = un
+    ELSEWHERE
+       senescence_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                senescence_real, 'scatter', nbp_glo, index_g)
+ 
+    ! Transform the logical variable begin_leaves to real before writing to restart file
+    WHERE ( begin_leaves(:,:) )
+       begin_leaves_real = un
+    ELSEWHERE
+       begin_leaves_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, 'begin_leaves', nbp_glo, nvm, 1, itime, &
+         begin_leaves_real, 'scatter', nbp_glo, index_g)
+
+
+    var_name = 'when_growthinit'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                when_growthinit, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'age'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                age, 'scatter', nbp_glo, index_g)
+    !-
+    ! 13 CO2
+    !-
+    var_name = 'resp_hetero'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                resp_hetero(:,:,icarbon), 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'resp_maint'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                resp_maint, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'resp_growth'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                resp_growth, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'co2_fire'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,  nvm, 1, itime, &
+         &                co2_fire, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'co2_to_bm_dgvm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                co2_to_bm_dgvm, 'scatter', nbp_glo, index_g)
+    !-
+    ! 14 vegetation distribution after last light competition
+    !-
+    var_name = 'veget_lastlight'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                veget_lastlight, 'scatter', nbp_glo, index_g)
+    !-
+    ! 15 establishment criteria
+    !-
+    var_name = 'everywhere'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                everywhere, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'need_adjacent'
+    WHERE (need_adjacent(:,:))
+       need_adjacent_real = un
+    ELSEWHERE
+       need_adjacent_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                need_adjacent_real, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'RIP_time'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                RIP_time, 'scatter', nbp_glo, index_g)
+    !-
+    ! 17 litter
+    !-
+    DO l=1,nlitt
+       var_name = 'litterpart_'//litter_str(l)
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo,  nvm, 1, itime, &
+            &                   litterpart(:,:,l), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO k = 1,nelements 
+       DO m = 1,nvm 
+          WRITE (part_str, '(I2)') m 
+          IF (m<10) part_str(1:1)='0' 
+          var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_above'//element_str(k) 
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, & 
+          &                     litter_above(:,:,m,k), 'scatter', nbp_glo, index_g) 
+       ENDDO 
+    END DO
+    !-
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z01'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,1,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z02'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,2,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z03'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,3,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z04'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,4,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z05'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,5,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z06'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,6,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z07'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,7,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z08'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,8,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z09'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,9,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z10'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,10,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z11'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,11,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    !-
+    DO l=1,nlitt
+       var_name = 'dead_leaves_'//litter_str(l)
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo,  nvm, 1, itime, &
+            &                   dead_leaves(:,:,l), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO m=1,nvm
+	DO k=1,nelements
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z01_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,1,k), 'scatter', nbp_glo, index_g)
+	ENDDO
+    ENDDO
+    DO m=1,nvm
+	DO k=1,nelements
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z02_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,2,k), 'scatter', nbp_glo, index_g)
+	ENDDO
+    ENDDO
+
+    DO m=1,nvm
+	DO k=1,nelements
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z03_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,3,k), 'scatter', nbp_glo, index_g)
+	ENDDO
+    ENDDO
+
+    DO m=1,nvm
+	DO k=1,nelements
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z04_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,4,k), 'scatter', nbp_glo, index_g)
+	ENDDO
+    ENDDO
+
+    DO m=1,nvm
+	DO k=1,nelements
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z05_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,5,k), 'scatter', nbp_glo, index_g)
+	ENDDO
+    ENDDO
+
+    DO m=1,nvm
+	DO k=1,nelements
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z06_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,6,k), 'scatter', nbp_glo, index_g)
+	ENDDO
+    ENDDO
+
+    DO m=1,nvm
+	DO k=1,nelements
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z07_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,7,k), 'scatter', nbp_glo, index_g)
+	ENDDO
+    ENDDO
+
+    
+    DO m=1,nvm
+	DO k=1,nelements
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z08_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,8,k), 'scatter', nbp_glo, index_g)
+	ENDDO
+    ENDDO
+
+    DO m=1,nvm
+	DO k=1,nelements
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z09_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,9,k), 'scatter', nbp_glo, index_g)
+	ENDDO
+    ENDDO
+
+    DO m=1,nvm
+	DO k=1,nelements
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,10,k), 'scatter', nbp_glo, index_g)
+	ENDDO
+    ENDDO
+
+    DO m=1,nvm
+	DO k=1,nelements
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,11,k), 'scatter', nbp_glo, index_g)
+	ENDDO
+    ENDDO
+    DO m=1,npool
+	Do k=1,nelements
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z1_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,1,ifree,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z2_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,2,ifree,m,k), 'scatter', nbp_glo, index_g)
+
+         var_name = 'freedoc_z3_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,3,ifree,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z4_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,4,ifree,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z5_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,5,ifree,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z6_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,6,ifree,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z7_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,7,ifree,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z8_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,8,ifree,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z9_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,9,ifree,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,10,ifree,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,11,ifree,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z1_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,1,iadsorbed,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z2_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,2,iadsorbed,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z3_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,3,iadsorbed,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z4_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,4,iadsorbed,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z5_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,5,iadsorbed,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z6_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,6,iadsorbed,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z7_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,7,iadsorbed,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z8_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,8,iadsorbed,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z9_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,9,iadsorbed,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z10_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,10,iadsorbed,m,k), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z11_'//part_str(1:LEN_TRIM(part_str))//element_str(k)
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,11,iadsorbed,m,k), 'scatter', nbp_glo, index_g)
+	ENDDO
+    ENDDO
+
+    !-
+       var_name = 'lignin_struc_above'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_above(:,:), 'scatter', nbp_glo, index_g)
+       var_name = 'lig_struc_be_z01'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,1), 'scatter', nbp_glo, index_g)
+       var_name = 'lig_struc_be_z02'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,2), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z03'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,3), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z04'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,4), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z05'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,5), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z06'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,6), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z07'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,7), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z08'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,8), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z09'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,9), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z10'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,10), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z11'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,11), 'scatter', nbp_glo, index_g)
+
+    !-
+    ! 18 land cover change
+    !-
+    var_name = 'prod10'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 11, 1, itime, &
+         &                prod10, 'scatter', nbp_glo, index_g)
+    var_name = 'prod100'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 101, 1, itime, &
+         &                prod100, 'scatter', nbp_glo, index_g)
+    var_name = 'flux10'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 10, 1, itime, &
+         &                flux10, 'scatter', nbp_glo, index_g)
+    var_name = 'flux100'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 100, 1, itime, &
+         &                flux100, 'scatter', nbp_glo, index_g)
+
+    var_name = 'convflux'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &              convflux, 'scatter', nbp_glo, index_g)
+    var_name = 'cflux_prod10'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &              cflux_prod10, 'scatter', nbp_glo, index_g)
+    var_name = 'cflux_prod100'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &              cflux_prod100, 'scatter', nbp_glo, index_g)
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'bm_to_litter_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                bm_to_litter(:,:,k,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    END DO
+
+    var_name = 'carb_mass_total'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &              carb_mass_total, 'scatter', nbp_glo, index_g)
+    !-
+
+
+    DO k = 1,npco2
+       WRITE(part_str,'(I2)') k
+       IF (k < 10) part_str(1:1) = '0' 
+       var_name = 'assim_param_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                assim_param(:,:,k), 'scatter', nbp_glo, index_g)
+    ENDDO
+       
+
+    IF (printlev >= 4) WRITE(numout,*) 'Leaving writerestart'
+    !--------------------------
+  END SUBROUTINE writerestart
+  !-
+  !===
+  !-
+END MODULE stomate_io
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_lcchange.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_lcchange.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_lcchange.f90	(revision 5166)
@@ -0,0 +1,404 @@
+! =================================================================================================================================
+! MODULE       : stomate_lcchange
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Impact of land cover change on carbon stocks
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE stomate_lcchange
+
+  ! modules used:
+  
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE constantes_soil
+  
+  IMPLICIT NONE
+  
+  PRIVATE
+  PUBLIC lcchange_main
+  
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : lcchange_main
+!!
+!>\BRIEF        Impact of land cover change on carbon stocks
+!!
+!! DESCRIPTION  : This subroutine is always activate if VEGET_UPDATE>0Y in the configuration file, which means that the 
+!! vegetation map is updated regulary. lcchange_main is called from stomateLpj the first time step after the vegetation 
+!! map has been changed. 
+!! The impact of land cover change on carbon stocks is computed in this subroutine. The land cover change is written
+!! by the difference of current and previous "maximal" coverage fraction of a PFT. 
+!! On the basis of this difference, the amount of 'new establishment'/'biomass export',
+!! and increase/decrease of each component, are estimated.\n
+!!
+!! Main structure of lpj_establish.f90 is:
+!! 1. Initialization
+!! 2. Calculation of changes in carbon stocks and biomass by land cover change
+!! 3. Update 10 year- and 100 year-turnover pool contents
+!! 4. History
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::prod10, ::prod100, ::flux10, ::flux100,
+!!   :: cflux_prod10 and :: cflux_prod100 
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!!     \includegraphics[scale=0.5]{lcchange.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  
+  SUBROUTINE lcchange_main ( npts, dt_days, veget_max_old, veget_max_new, &
+       biomass, ind, age, PFTpresent, senescence, when_growthinit, everywhere, &        
+       co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, cn_ind,flux10,flux100, &
+       prod10,prod100,&
+       convflux,&
+       cflux_prod10,cflux_prod100, leaf_frac,&
+       npp_longterm, lm_lastyearmax, litter_above, litter_below,&
+       carbon,DOC,moist_soil)
+    
+    IMPLICIT NONE
+    
+  !! 0. Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+    
+    INTEGER, INTENT(in)                                       :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), INTENT(in)                                   :: dt_days          !! Time step of vegetation dynamics for stomate
+                                                                                  !! (days)
+    REAL(r_std), DIMENSION(nvm, nparts,nelements), INTENT(in) :: bm_sapl          !! biomass of sapling 
+                                                                                  !! @tex ($gC individual^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)             :: moist_soil       !! moisture in soil for one pixel (m3/m3) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: veget_max_old    !! Current "maximal" coverage fraction of a PFT (LAI
+                                                                                  !! -> infinity) on ground
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: veget_max_new    !! New "maximal" coverage fraction of a PFT (LAI ->
+                                                                                  !! infinity) on ground (unitless) 
+ 
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: convflux         !! release during first year following land cover
+                                                                                  !! change
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: cflux_prod10     !! total annual release from the 10 year-turnover
+                                                                                  !! pool @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: cflux_prod100    !! total annual release from the 100 year-
+                                                                                  !! turnover pool @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: turnover_daily   !! Turnover rates 
+                                                                                      !! @tex ($gC m^{-2} day^{-1}$) @endtex
+
+    !! 0.3 Modified variables   
+    
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass    !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind              !! Number of individuals @tex ($m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age              !! mean age (years)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: senescence       !! plant senescent (only for deciduous trees) Set
+                                                                                  !! to .FALSE. if PFT is introduced or killed
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent       !! Is pft there (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere       !! is the PFT everywhere in the grid box or very 
+                                                                                  !! localized (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit  !! how many days ago was the beginning of the 
+                                                                                  !! growing season (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm        !! biomass uptaken 
+                                                                                  !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! conversion of biomass to litter 
+                                                                                  !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: cn_ind           !! crown area of individuals 
+                                                                                  !! @tex ($m^{2}$) @endtex
+    REAL(r_std), DIMENSION(npts,0:10), INTENT(inout)          :: prod10           !! products remaining in the 10 year-turnover
+                                                                                  !! pool after the annual release for each 
+                                                                                  !! compartment (10 + 1 : input from year of land
+                                                                                  !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100), INTENT(inout)         :: prod100          !! products remaining in the 100 year-turnover
+                                                                                  !! pool after the annual release for each 
+                                                                                  !! compartment (100 + 1 : input from year of land
+                                                                                  !! cover change)
+    REAL(r_std), DIMENSION(npts,10), INTENT(inout)            :: flux10           !! annual release from the 10/100 year-turnover 
+                                                                                  !! pool compartments
+    REAL(r_std), DIMENSION(npts,100), INTENT(inout)           :: flux100          !! annual release from the 10/100 year-turnover
+                                                                                  !! pool compartments
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac        !! fraction of leaves in leaf age class 
+                                                                                  !! (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: lm_lastyearmax   !! last year's maximum leaf mass for each PFT 
+                                                                                  !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm     !! "long term" net primary productivity 
+                                                                                  !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std),DIMENSION(npts,nlitt,nvm, nelements), INTENT(inout):: litter_above !! metabolic and structural litter, above 
+                                                                                  !! ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nbdl,nelements), INTENT(inout):: litter_below !! metabolic and structural litter, below 
+                                                                                  !! ground @tex ($gC m^{-2}$) @endtex
+                                                                                  !@endtex
+    REAL(r_std),DIMENSION(npts,ncarb,nvm,nbdl,nelements), INTENT(inout) :: carbon           !! carbon pool: active, slow, or passive 
+                                                                                  !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements), INTENT(inout) :: DOC     !! Dissolved Organic Carbon in soil
+                                                                                       !! The unit is guven by m^3 of water
+                                                                                       !! @tex $(gC m{-3} of water)$ @endtex
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                            :: i, j, k, l, m    !! indices (unitless)
+    REAL(r_std),DIMENSION(npts,nelements)                     :: bm_new           !! biomass increase @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,nparts,nelements)              :: biomass_loss     !! biomass loss @tex ($gC m^{-2}$) @endtex
+    REAL(r_std)                                               :: above            !! aboveground biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,nlitt,nelements)               :: dilu_lit_above   !! Above ground litter dilution @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,nlitt,nbdl,nelements)          :: dilu_lit_below   !! Below ground litter dilution @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,ncarb,nbdl)                    :: dilu_soil_carbon !! Soil Carbondilution @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(nvm)                                :: delta_veg        !! changes in "maximal" coverage fraction of PFT 
+    REAL(r_std)                                               :: delta_veg_sum    !! sum of delta_veg
+    REAL(r_std),DIMENSION(npts,nvm)                           :: delta_ind        !! change in number of individuals  
+    REAL(r_std),DIMENSION(0:nbdl)                             :: z_soil           !! Variable to store depth of the different
+                                                                                  !! soil layers (m)
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering lcchange_main'
+    
+  !! 1. initialization
+    
+    prod10(:,0)         = zero
+    prod100(:,0)        = zero   
+    above               = zero
+    convflux(:)         = zero
+    cflux_prod10(:)     = zero
+    cflux_prod100(:)    = zero
+    delta_ind(:,:)      = zero
+    delta_veg(:)        = zero
+       !! 1.1.1 Copy the depth of the different soil layers (number of layers=nbdl) 
+       !        previously calculated as variable diaglev in routines
+       !        sechiba.f90 and slowproc.f90  
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+    
+  !! 2. calculation of changes in carbon stocks and biomass by land cover change\n
+    
+    DO i = 1, npts ! Loop over # pixels - domain size
+       
+       !! 2.1 initialization of carbon stocks\n
+       delta_veg(:) = veget_max_new(i,:)-veget_max_old(i,:)
+       delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.0.)
+       
+       dilu_lit_above(i,:,:) = zero
+       dilu_lit_below(i,:,:,:) = zero
+       dilu_soil_carbon(i,:,:) = zero
+       biomass_loss(i,:,:) = zero
+       
+       !! 2.2 if vegetation coverage decreases, compute dilution of litter, soil carbon, and biomass.\n
+
+
+       DO j=2, nvm
+          IF ( delta_veg(j) < -min_stomate ) THEN 
+             dilu_lit_above(i,:,icarbon) = dilu_lit_above(i,:,icarbon) + delta_veg(j)*litter_above(i,:,j,icarbon) / delta_veg_sum
+	     dilu_lit_above(i,:,icarbon14) = dilu_lit_above(i,:,icarbon14) + delta_veg(j)*litter_above(i,:,j,icarbon14) / delta_veg_sum
+
+             dilu_lit_below(i,:,:,icarbon) = dilu_lit_below(i,:,:,icarbon) + delta_veg(j)*litter_below(i,:,j,:,icarbon) / delta_veg_sum
+	     dilu_lit_below(i,:,:,icarbon14) = dilu_lit_below(i,:,:,icarbon14) + delta_veg(j)*litter_below(i,:,j,:,icarbon14) / delta_veg_sum
+             DO k=2,nbdl
+               DO m = 1,npool
+               dilu_soil_carbon(i,:,k) =  dilu_soil_carbon(i,:,k) + delta_veg(j) * (carbon(i,:,j,k,icarbon) + &
+                                        (DOC(:,j,k,ifree,m,icarbon) + DOC(:,j,k,iadsorbed,m,icarbon))* moist_soil(:,k) * (z_soil(k)-z_soil(k-1))) / delta_veg_sum
+               ENDDO
+             ENDDO
+               DO m=1,npool
+               dilu_soil_carbon(i,:,1) =  dilu_soil_carbon(i,:,1) + delta_veg(j) * (carbon(i,:,j,1,icarbon)+ &
+                                        (DOC(:,j,1,ifree,m,icarbon) + DOC(:,j,1,iadsorbed,m,icarbon))* moist_soil(:,1) * (z_soil(1))) / delta_veg_sum
+               ENDDO
+             biomass_loss(i,:,icarbon) = biomass_loss(i,:,icarbon) + biomass(i,j,:,icarbon)*delta_veg(j) / delta_veg_sum
+	     biomass_loss(i,:,icarbon14) = biomass_loss(i,:,icarbon)
+          ENDIF
+       ENDDO
+       
+       !! 2.3 
+!WRITE (numout,*) "litter_above_#1_lc_PFT6=",litter_above(:,:,6,:)
+!WRITE (numout,*) "litter_above_#1_lc_PFT10=",litter_above(:,:,10,:)
+       DO j=2, nvm ! Loop over # PFTs
+
+          !! 2.3.1 The case that vegetation coverage of PFTj increases
+          IF ( delta_veg(j) > min_stomate) THEN
+
+             !! 2.3.1.1 Initial setting of new establishment
+             IF (veget_max_old(i,j) .LT. min_stomate) THEN 
+                IF (is_tree(j)) THEN
+
+                   ! cn_sapl(j)=0.5; stomate_data.f90
+                   cn_ind(i,j) = cn_sapl(j) 
+                ELSE
+                   cn_ind(i,j) = un
+                ENDIF
+                ind(i,j)= delta_veg(j) / cn_ind(i,j)
+                PFTpresent(i,j) = .TRUE.
+                everywhere(i,j) = 1.
+                senescence(i,j) = .FALSE.
+                age(i,j) = zero
+
+                ! large_value = 1.E33_r_std
+                when_growthinit(i,j) = large_value 
+                leaf_frac(i,j,1) = 1.0
+                npp_longterm(i,j) = npp_longterm_init
+                lm_lastyearmax(i,j) = bm_sapl(j,ileaf,icarbon) * ind(i,j)
+             ENDIF
+             IF ( cn_ind(i,j) > min_stomate ) THEN
+                delta_ind(i,j) = delta_veg(j) / cn_ind(i,j) 
+             ENDIF
+             
+             !! 2.3.1.2 Update of biomass in each each carbon stock component 
+             !!         Update of biomass in each each carbon stock component (leaf, sapabove, sapbelow,
+             !>         heartabove, heartbelow, root, fruit, and carbres)\n
+             DO k = 1, nparts ! loop over # carbon stock components, nparts = 8; stomate_constant.f90 
+               ! DO l = 1,nelements ! loop over # elements
+
+                   bm_new(i,icarbon) = delta_ind(i,j) * bm_sapl(j,k,icarbon) 
+		   bm_new(i,icarbon14) = bm_new(i,icarbon) 
+                   IF (veget_max_old(i,j) .GT. min_stomate) THEN
+
+                      ! in the case that bm_new is overestimated compared with biomass?
+                      IF ((bm_new(i,icarbon)/delta_veg(j)) > biomass(i,j,k,icarbon)) THEN
+                         bm_new(i,icarbon) = biomass(i,j,k,icarbon)*delta_veg(j)
+			 bm_new(i,icarbon14) = bm_new(i,icarbon) 
+                      ENDIF
+                   ENDIF
+                   biomass(i,j,k,icarbon) = (biomass(i,j,k,icarbon) * veget_max_old(i,j) + bm_new(i,icarbon) ) / veget_max_new(i,j)
+		   biomass(i,j,k,icarbon14) =  biomass(i,j,k,icarbon) 
+                   co2_to_bm(i,j) = co2_to_bm(i,j) + (bm_new(i,icarbon)* dt_days) / (one_year * veget_max_new(i,j))
+               ! END DO ! loop over # elements
+             ENDDO ! loop over # carbon stock components
+
+             !! 2.3.1.3 Calculation of dilution in litter, soil carbon, and  input of litter
+             !!        In this 'IF statement', dilu_* is zero. Formulas for litter and soil carbon
+             !!         could be shortend?? Are the following formulas correct?
+
+             ! Litter
+             litter_above(i,:,j,icarbon)=(litter_above(i,:,j,icarbon) * veget_max_old(i,j) + &
+                  dilu_lit_above(i,:,icarbon) * delta_veg(j)) / veget_max_new(i,j)
+
+	     litter_above(i,:,j,icarbon14)= ratio *  litter_above(i,:,j,icarbon)
+            
+             ! Soil carbon
+             carbon(i,:,j,:,icarbon)=(carbon(i,:,j,:,icarbon) * veget_max_old(i,j) + dilu_soil_carbon(i,:,:) * delta_veg(j)) / veget_max_new(i,j)
+	     carbon(i,:,j,:,icarbon14)= (carbon(i,:,j,:,icarbon14) * veget_max_old(i,j) + dilu_soil_carbon(i,:,:) * delta_veg(j)) / veget_max_new(i,j)
+
+            ! DO l = 1,nelements
+
+                ! Litter input
+                bm_to_litter(i,j,isapbelow,icarbon) = bm_to_litter(i,j,isapbelow,icarbon) + &
+                     &                         biomass_loss(i,isapbelow,icarbon)*delta_veg(j) / veget_max_new(i,j)
+                bm_to_litter(i,j,iheartbelow,icarbon) = bm_to_litter(i,j,iheartbelow,icarbon) + biomass_loss(i,iheartbelow,icarbon) *delta_veg(j) &
+                     &  / veget_max_new(i,j)
+                bm_to_litter(i,j,iroot,icarbon) = bm_to_litter(i,j,iroot,icarbon) + biomass_loss(i,iroot,icarbon)*delta_veg(j) / veget_max_new(i,j)
+                bm_to_litter(i,j,ifruit,icarbon) = bm_to_litter(i,j,ifruit,icarbon) + biomass_loss(i,ifruit,icarbon)*delta_veg(j) / veget_max_new(i,j)
+                bm_to_litter(i,j,icarbres,icarbon) = bm_to_litter(i,j,icarbres,icarbon) + &
+                     &                         biomass_loss(i,icarbres,icarbon)   *delta_veg(j) / veget_max_new(i,j)
+                bm_to_litter(i,j,ileaf,icarbon) = bm_to_litter(i,j,ileaf,icarbon) + biomass_loss(i,ileaf,icarbon)*delta_veg(j) / veget_max_new(i,j)
+
+		bm_to_litter(i,j,isapbelow,icarbon14) = bm_to_litter(i,j,isapbelow,icarbon) 
+                bm_to_litter(i,j,iheartbelow,icarbon14) = bm_to_litter(i,j,iheartbelow,icarbon) 
+                bm_to_litter(i,j,iroot,icarbon14) = bm_to_litter(i,j,iroot,icarbon) 
+                bm_to_litter(i,j,ifruit,icarbon14) = bm_to_litter(i,j,ifruit,icarbon) 
+                bm_to_litter(i,j,icarbres,icarbon14) = bm_to_litter(i,j,icarbres,icarbon) 
+                bm_to_litter(i,j,ileaf,icarbon14) = bm_to_litter(i,j,ileaf,icarbon) 
+
+
+           !  END DO
+
+             age(i,j)=age(i,j)*veget_max_old(i,j)/veget_max_new(i,j)
+             
+          !! 2.3.2 The case that vegetation coverage of PFTj is no change or decreases
+          ELSE 
+ 
+             !! 2.3.2.1 Biomass export
+             ! coeff_lcchange_*:  Coeff of biomass export for the year, decade, and century
+             above = biomass(i,j,isapabove,icarbon) + biomass(i,j,iheartabove,icarbon)
+             convflux(i)  = convflux(i)  - ( coeff_lcchange_1(j) * above * delta_veg(j) ) 
+             prod10(i,0)  = prod10(i,0)  - ( coeff_lcchange_10(j) * above * delta_veg(j) )
+             prod100(i,0) = prod100(i,0) - ( coeff_lcchange_100(j) * above * delta_veg(j) )
+
+
+             !! 2.3.2.2 Total reduction
+             !! If the vegetation is to small, it has been set to 0.
+             IF ( veget_max_new(i,j) .LT. min_stomate ) THEN 
+                
+                ind(i,j) = zero
+                biomass(i,j,:,:) = zero
+                PFTpresent(i,j) = .FALSE.
+                senescence(i,j) = .FALSE.
+                age(i,j) = zero
+                when_growthinit(i,j) = undef
+                everywhere(i,j) = zero
+                carbon(i,:,j,:,:) = zero
+                litter_above(i,:,j,:) = zero
+                litter_below(i,:,j,:,:) = zero
+                bm_to_litter(i,j,:,:) = zero
+                turnover_daily(i,j,:,:) = zero
+                
+             ENDIF
+ 
+          ENDIF ! End if PFT's coverage reduction
+          
+       ENDDO ! Loop over # PFTs
+!WRITE (numout,*) "litter_above_#2_lc_PFT6=",litter_above(:,:,6,:)
+!WRITE (numout,*) "litter_above_#2_lc_PFT10=",litter_above(:,:,10,:)
+       
+       !! 2.4 update 10 year-turnover pool content following flux emission
+       !!     (linear decay (10%) of the initial carbon input)
+       DO  l = 0, 8
+          m = 10 - l
+          cflux_prod10(i) =  cflux_prod10(i) + flux10(i,m)
+          prod10(i,m)     =  prod10(i,m-1)   - flux10(i,m-1)
+          flux10(i,m)     =  flux10(i,m-1)
+          
+          IF (prod10(i,m) .LT. 1.0) prod10(i,m) = zero
+       ENDDO
+       
+       cflux_prod10(i) = cflux_prod10(i) + flux10(i,1) 
+       flux10(i,1)     = 0.1 * prod10(i,0)
+       prod10(i,1)     = prod10(i,0)
+       
+       !! 2.5 update 100 year-turnover pool content following flux emission\n
+       DO   l = 0, 98
+          m = 100 - l
+          cflux_prod100(i)  =  cflux_prod100(i) + flux100(i,m)
+          prod100(i,m)      =  prod100(i,m-1)   - flux100(i,m-1)
+          flux100(i,m)      =  flux100(i,m-1)
+          
+          IF (prod100(i,m).LT.1.0) prod100(i,m) = zero
+       ENDDO
+       
+       cflux_prod100(i)  = cflux_prod100(i) + flux100(i,1) 
+       flux100(i,1)      = 0.01 * prod100(i,0)
+       prod100(i,1)      = prod100(i,0)
+       prod10(i,0)        = zero
+       prod100(i,0)       = zero 
+       
+    ENDDO ! Loop over # pixels - domain size
+    
+  !! 3. history
+    convflux        = convflux/one_year*dt_days
+    cflux_prod10    = cflux_prod10/one_year*dt_days
+    cflux_prod100   = cflux_prod100/one_year*dt_days
+    
+    IF (printlev>=4) WRITE(numout,*) 'Leaving lcchange_main'
+    
+  END SUBROUTINE lcchange_main
+  
+END MODULE stomate_lcchange
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_litter.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_litter.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_litter.f90	(revision 5166)
@@ -0,0 +1,1754 @@
+! =================================================================================================================================
+! MODULE       : stomate_litter
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Update litter and lignine content after litter fall and 
+!! calculating litter decomposition.      
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_litter
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC littercalc,littercalc_clear, deadleaf
+
+
+
+  LOGICAL, SAVE                        :: firstcall = .TRUE.       !! first call
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : littercalc_calc
+!!
+!!\BRIEF        Set the flag ::firstcall to .TRUE. and as such activate section
+!! 1.1 of the subroutine littercalc (see below).
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE littercalc_clear
+    firstcall =.TRUE.
+  END SUBROUTINE littercalc_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : littercalc
+!!
+!!\BRIEF        Calculation of the litter decomposition and therefore of the 
+!! heterotrophic respiration from litter following Parton et al. (1987).
+!!
+!! DESCRIPTION  : The littercal routine splits the litter in 4 pools: 
+!! aboveground metaboblic, aboveground structural, belowground metabolic and 
+!! belowground structural. the fraction (F) of plant material going to metabolic 
+!! and structural is defined following Parton et al. (1987). The below ground
+!! litter is discretized over 11 layers (the same used by the CWRR hydrology
+!! scheme).
+!! \latexonly
+!! \input{littercalc1.tex}
+!! \endlatexonly
+!! \n
+!! where L is the lignin content of the plant carbon pools considered and CN 
+!! its CN ratio. L and CN are fixed parameters for each plant carbon pools,
+!! therefore it is the ratio between each plant carbon pool within a PFT, which
+!! controlled the part of the total litter, that will be considered as
+!! recalcitrant (i.e. structural litter) or labile (i.e. metabolic litter).\n  
+!! 
+!! The routine calculates the fraction of aboveground litter which is metabolic
+!! or structural (the litterpart variable) which is then used in lpj_fire.f90.\n 
+!! 
+!! In the section 2, the routine calculate the new plant material entering the
+!! litter pools by phenological death of plants organs (corresponding to the
+!! variable turnover) and by fire, herbivory and others non phenological causes
+!! (variable bm_to_litter). This calculation is first done for each PFT and then
+!! the values calculated for each PFT are added up. Following the same approach
+!! the lignin content of the total structural litter is calculated and will be
+!! then used as a factor control of the decomposition of the structural litter
+!! (lignin_struc) in the section 5.1.2. A test is performed to avoid that we add
+!! more lignin than structural litter. Finally, the variable litterpart is
+!! updated.\n
+!! 
+!! In the section 3 and 4 the temperature and the moisture controlling the
+!! decomposition are calculated for above and belowground. For aboveground
+!! litter, air temperature and litter moisture are calculated in sechiba and used 
+!! directly. For belowground, soil temperature and moisture are also calculated 
+!! in sechiba but are modulated as a function of the soil depth. The modulation 
+!! is a multiplying factor exponentially distributed between 0 (in depth) and 1
+!! in surface.\n  
+!! 
+!! Then, in the section 5 and 6, the routine calculates the structural litter decomposition 
+!! (C) following first order kinetics following Parton et al. (1987).
+!! \latexonly
+!! \input{littercalc2.tex}
+!! \endlatexonly
+!! \n
+!! with k the decomposition rate of the structural litter. 
+!! k corresponds to
+!! \latexonly
+!! \input{littercalc3.tex}
+!! \endlatexonly
+!! \n
+!! with littertau the turnover rate, T a function of the temperature and M a function of
+!! the moisture described below.\n
+!!  
+!! Then, the fraction of dead leaves (DL) composed by aboveground structural litter is
+!! calculated as following
+!! \latexonly
+!! \input{littercalc4.tex}
+!! \endlatexonly
+!! \n
+!! with k the decomposition rate of the structural litter previously
+!! described.\n
+!!
+!! In the section 5.1 and 6.1, the fraction of decomposed structural litter
+!! incorporated to the soil (Input) and its associated heterotrophic respiration are
+!! calculated. For structural litter, the C decomposed could go in the active
+!! soil carbon pool or in the slow carbon, as described in 
+!! stomate_soilcarbon.f90.\n
+!! \latexonly
+!! \input{littercalc5.tex}
+!! \endlatexonly
+!! \n
+!! with f a parameter describing the fraction of structural litter incorporated
+!! into the considered soil carbon pool, C the amount of litter decomposed and L 
+!! the amount of lignin in the litter. The litter decomposed which is not
+!! incorporated into the soil is respired.\n
+!!
+!! In the section 5.2 and 6.2, the fraction of decomposed metabolic litter
+!! incorporated to the soil and its associated heterotrophic respiration are
+!! calculated with the same approaches presented for 5.1 but no control factor
+!! depending on the lignin content are used.\n
+!! 
+!! In the section 7 the dead leaf cover is calculated through a call to the 
+!! deadleaf subroutine presented below.\n
+!!
+!! MAIN OUTPUT VARIABLES: ::deadleaf_cover, ::resp_hetero_litter, 
+!! ::control_temp, ::control_moist
+!!
+!! REFERENCES:
+!! - Parton, WJ, Schimel, DS, Cole, CV, and Ojima, DS. 1987. Analysis
+!! of factors controlling soil organic matter levels in Great Plains
+!! grasslands. Soil Science Society of America journal (USA)
+!! (51):1173-1179.
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART    :
+!! \latexonly
+!! \includegraphics(scale=0.5){littercalcflow.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE littercalc (npts, dt, &
+       turnover, bm_to_litter, &
+       veget_max, tsurf, tsoil, soilhum, litterhum, rprof, &
+       litterpart, litter_above, litter_below, dead_leaves, &
+       lignin_struc_above, lignin_struc_below, &
+       deadleaf_cover, resp_hetero_litter, &
+       control_temp_above, control_temp_soil, &
+       control_moist_above, control_moist_soil, &
+       litter_mc,soilcarbon_input, soil_mc, soiltile, &
+       clay, bulk_dens, soil_ph, carbon)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                  :: npts                !! Domain size - number of grid pixels
+    REAL(r_std), INTENT(in)                                     :: dt                  !! Time step of the simulations for stomate
+                                                                                       !! @tex $(dtradia one\_day^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover          !! Turnover rates of plant biomass 
+                                                                                       !! @tex $(gC m^{-2} dt\_slow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: bm_to_litter      !! Conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} dt\_slow^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                   :: veget_max          !! PFT "Maximal" coverage fraction of a PFT 
+                                                                                       !! defined in the input vegetation map 
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: tsurf              !! Temperature (K) at the surface
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)                :: tsoil              !! Soil temperature (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)                :: soilhum            !! Daily soil humidity of each soil layer 
+                                                                                       !! (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: litterhum          !! Daily litter humidity (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                 :: rprof              !! PFT root depth as calculated in stomate.f90 from parameter 
+                                                                                       !! humcste which is root profile for different PFTs 
+                                                                                       !! in slowproc.f90 (m)
+    REAL(r_std),DIMENSION (npts,nstm), INTENT(in)                :: litter_mc          !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (npts,nbdl,nstm), INTENT(in)           :: soil_mc            !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (npts,nstm), INTENT (in)               :: soiltile           !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: clay               !! Clay fraction (unitless, 0-1) 
+    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)
+
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: soil_ph            !! soil pH (pH unit, 0-14) 
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl,nelements), INTENT(in)   :: carbon      !! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts), INTENT(out)                    :: deadleaf_cover     !! Fraction of soil covered by dead leaves 
+                                                                                       !! over all PFTs (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nelements), INTENT(out)      :: resp_hetero_litter !! Litter heterotrophic respiration. The unit
+                                                                                       !! is given by m^2 of ground.  
+                                                                                       !! @tex $(gC dtradia one\_day^{-1}) m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nbdl,npool*2), INTENT(out)       :: control_temp_soil  !! Temperature control of heterotrophic 
+                                                                                       !! respiration belowground,(0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nbdl,nvm), INTENT(out)           :: control_moist_soil !! Moisture control of heterotrophic 
+                                                                                       !! respiration aboveground(0.25-1,unitless)
+    REAL(r_std), DIMENSION(npts,nlitt), INTENT(out)              :: control_temp_above !! Temperature control of heterotrophic  
+                                                                                       !! respiration, above (0-1,  
+                                                                                       !! unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                :: control_moist_above!! Moisture control of heterotrophic  
+                                                                                       !! respiration aboveground(0.25-1, unitless) 
+
+    !! 0.3 Modified variables
+    
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)       :: litterpart         !! Fraction of litter above the ground 
+                                                                                      !! belonging to the different PFTs (0-1, 
+                                                                                      !! unitless)
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements), INTENT(inout) :: litter_above   !! Metabolic and structural litter,above ground
+                                                                                      !! The unit is given by m^2 of 
+                                                                                      !! ground @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements), INTENT(inout) ::litter_below  !! Metabolic and structural litter, below ground
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! ground @tex $(gC m^{-2} $ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)       :: dead_leaves        !! Dead leaves per ground unit area, per PFT,
+                                                                                      !! metabolic and structural in 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: lignin_struc_above  !! Ratio Lignin content in structural litter,
+                                                                                      !! above ground, (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nbdl), INTENT(inout)       :: lignin_struc_below  !! Ratio Lignin content in structural litter,
+                                                                                      !! below ground, (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,npool,nelements), INTENT(inout) :: soilcarbon_input !! Dissolved Organic Carbon input from litter decomposition
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! water @tex $(gC m^{-2})$ @endtex
+    !! 0.4 Local variables
+ 
+    REAL(r_std), SAVE, DIMENSION(nparts,nlitt)                  :: litterfrac         !! The fraction of leaves, wood, etc. that 
+                                                                                      !! goes into metabolic and structural 
+                                                                                      !! litterpools (0-1, unitless)
+!$OMP THREADPRIVATE(litterfrac)
+    REAL(r_std),DIMENSION(0:nbdl)                               :: z_soil             !! Soil levels (m)
+!$OMP THREADPRIVATE(z_soil)
+                                                                                      !! profiles (unitless)
+    REAL(r_std), SAVE, DIMENSION(nlitt)                         :: litter_tau         !! Turnover time in litter pools (days)
+!$OMP THREADPRIVATE(litter_tau)
+    REAL(r_std), SAVE, DIMENSION(npool)                         :: pool_tau         !! Turnover time in litter and soil carbon pools (days)
+!$OMP THREADPRIVATE(pool_tau)
+    REAL(r_std), DIMENSION(npool,nvm)                           :: DOC_tau          !! Residence time of DOC (days)    
+!$OMP THREADPRIVATE(DOC_tau)
+    REAL(r_std), SAVE, DIMENSION(nlitt,ncarb,nlevs)             :: frac_soil          !! Fraction of litter that goes into soil 
+                                                                                      !! (litter -> carbon, above and below). The
+                                                                                      !! remaining part goes to the atmosphere
+!$OMP THREADPRIVATE(frac_soil)
+    REAL(r_std), DIMENSION(npts)                                :: tsoil_decomp       !! Temperature used for decompostition in 
+                                                                                      !! soil (K)
+    REAL(r_std), DIMENSION(npts)                                :: soilhum_decomp     !! Humidity used for decompostition in soil
+                                                                                      !! (unitless)
+ !   REAL(r_std), SAVE, DIMENSION(npts)                          :: z_lit              !! Thickness of the above ground litter layer (mm)
+!!$OMP THREADPRIVATE(z_lit)
+
+    REAL(r_std), DIMENSION(npts)                                :: fd                 !! Fraction of structural or metabolic litter
+                                                                                      !! decomposed (unitless)
+    REAL(r_std), DIMENSION(npts,nelements)                      :: qd                 !! Quantity of structural or metabolic litter
+                                                                                      !! decomposed @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                            :: old_struc_above    !! Old structural litter, above ground 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbdl)                       :: old_struc_below    !! Old structural litter, below ground 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt, nelements)           :: litter_inc_PFT_above  !! Increase of litter, per PFT, metabolic and
+                                                                                      !! structural, above ground. The 
+                                                                                      !! unit is given by m^2 of ground.  
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nbdl,nelements)      :: litter_inc_PFT_below     !! Increase of litter, per PFT, metabolic and
+                                                                                      !! structural, above ground. The 
+                                                                                      !!unit is given by m^2 of ground.
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements)            :: litter_inc_above   !! Increase of metabolic and structural 
+                                                                                      !! litter, above ground. The unit 
+                                                                                      !! is given by m^2 of ground. 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements)       :: litter_inc_below   !! Increase of metabolic and structural 
+                                                                                      !! litter below ground. The unit
+                                                                                      !! is given by m^2 of ground
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+
+    REAL(r_std), DIMENSION(npts,nvm)                            :: lignin_struc_inc_above !! Lignin increase in structural litter, 
+                                                                                      !! above ground. The unit is given 
+                                                                                      !! by m^2 of ground. 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbdl)                       :: lignin_struc_inc_below   !! Lignin increase in structural litter, 
+                                                                                      !! below ground. The unit is given
+                                                                                      !! by m^2 of ground
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements)            :: litter_pft         !! Metabolic and structural litter above the 
+                                                                                      !! ground per PFT
+    REAL(r_std), DIMENSION(npts)                                :: zdiff_min          !! Intermediate field for looking for minimum
+                                                                                      !! of what? this is not used in the code. 
+                                                                                      !! [??CHECK] could we delete it?
+    CHARACTER(LEN=10), DIMENSION(nlitt)                         :: litter_str         !! Messages to write output information about
+                                                                                      !! the litter
+    CHARACTER(LEN=22), DIMENSION(nparts)                        :: part_str           !! Messages to write output information about
+                                                                                      !! the plant
+    CHARACTER(LEN=7), DIMENSION(ncarb)                          :: carbon_str         !! Messages to write output information about
+                                                                                      !! the soil carbon
+    CHARACTER(LEN=5), DIMENSION(nlevs)                          :: level_str          !! Messages to write output information about
+                                                                                      !! the level (aboveground or belowground litter)
+    INTEGER(i_std)                                              :: i,j,k,l,m          !! Indices (unitless)
+    !REAL(r_std), DIMENSION(npts)                                :: Dif_coef           !! Diffusion coeficient used for bioturbation (m2 days-1)
+   REAL(r_std), DIMENSION(npts,nbdl)                         :: Dif_coef             !! Diffusion coeficient used for bioturbation (m2 dt-1)
+ !!$OMP THREADPRIVATE(Dif_coef)
+
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements)       :: litter_flux        !! Belowground litter carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements)       :: litter_flux_old    !! Belowground litter carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f
+                                                                                      !! used for storage
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements)            :: litter_above_flux  !! Above litter carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f 
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements)            :: litter_above_flux_old  !! Above litter carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f
+                                                                                      !! used for storage
+    REAL(r_std), DIMENSION(npts)                                :: rpc                !! Scaling factor for integrating vertical soil 
+                                                                                      !! profiles (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)     :: check_intern       !! Contains the components of the internal
+                                                                                      !! mass balance chech for this routine
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)             :: closure_intern     !! Check closure of internal mass balance
+
+    REAL(r_std), DIMENSION(npts,nvm,nelements)             :: pool_start         !! Start and end pool of this routine 
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)             :: pool_end           !! End pool of this routine not corrected
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nelements)             :: pool_end_after           !! Start and end pool of this routine 
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nbdl)                      :: moist_soil         !! moisture in soil for one pixel (m3/m3)
+
+   ! REAL(r_std), DIMENSION(npts,nvm,nbdl)                       :: resp_hetero_litter_layer !! Litter heterotrophic respiration per layer. The unit
+                                                                                      !! is given by m^2 of ground by z.  
+                                                                                      !! @tex $(gC dtradia one\_day^{-1}) m^{-2} z^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements)  ::litter_below_old         !! Metabolic and structural litter, below ground
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! ground @tex $(gC m^{-2} $ @endtex used for storage
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements)  ::litter_below_old_buffer  !! Metabolic and structural litter, below ground
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! ground @tex $(gC m^{-2} $ @endtex used for storage
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements)       :: litter_above_old        !! Metabolic and structural litter,above ground
+                                                                                      !! The unit is given by m^2 of 
+                                                                                      !! ground @tex $(gC m^{-2})$ @endtex used for storage
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering littercalc'
+
+  !! 1. Initialisations of the different fields during the first call of the routine 
+    !! 1.0 Calculation of soil moisture
+    moist_soil(:,:) = zero
+      DO l = 1,nbdl
+          DO i = 1, nstm
+             moist_soil(:,l)= moist_soil(:,l) + soil_mc(:,l,i)*soiltile(:,i)
+          ENDDO
+      ENDDO
+
+    WHERE (bulk_dens(:) .LT. 500)
+    bulk_dens(:) = bulk_dens(:)*1e3
+    ENDWHERE
+
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+    !! 1.1 Initialize check for mass balance closure
+    !  The mass balance is calculated at the end of this routine
+    !  in section 14. Initial biomass and harvest pool and all other
+    !  relevant pools were set to zero before calling this routine.
+    pool_start(:,:,:) = zero
+IF (ld_doc) THEN
+    DO m = 2, nvm
+       DO i = 1,nlitt
+          DO l = 1, nbdl
+                 pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
+                           ( litter_below(:,i,m,l,icarbon) ) * veget_max(:,m)
+          ENDDO
+       ENDDO
+    ENDDO
+
+    DO m = 2, nvm
+       DO i = 1,nlitt
+                 pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
+                           ( litter_above(:,i,m,icarbon) ) * veget_max(:,m)
+       ENDDO
+    ENDDO
+
+    DO m = 2, nvm
+       DO i = 1, nparts
+          pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
+                    (turnover(:,m,i,icarbon) + bm_to_litter(:,m,i,icarbon)) * veget_max(:,m)
+      ENDDO
+    ENDDO
+ENDIF
+    IF ( firstcall ) THEN
+
+       !! 1.2.1 litter fractions:
+       !!   what fraction of leaves, wood, etc. goes into metabolic and structural litterpools
+       DO k = 1, nparts
+
+          litterfrac(k,imetabolic) = metabolic_ref_frac - metabolic_LN_ratio * LC(k) * CN(k)
+          litterfrac(k,istructural) = un - litterfrac(k,imetabolic)
+
+       ENDDO
+
+       !! 1.2.2 residence times in litter pools (days)
+       litter_tau(imetabolic) = tau_metabolic * one_year      ! .5 years
+       litter_tau(istructural) = tau_struct * one_year     ! 3 years
+
+       pool_tau(imetabo) = tau_metabolic 
+       pool_tau(istrabo) = tau_struct 
+       pool_tau(imetbel) = tau_metabolic 
+       pool_tau(istrbel) = tau_struct 
+       pool_tau(iact) = carbon_tau_iactive 
+       pool_tau(islo) = carbon_tau_islow 
+       pool_tau(ipas) = carbon_tau_ipassive 
+		DO m=1,nvm 
+	DOC_tau(imetabo,m) = DOC_tau_labile(m) / one_year 
+	DOC_tau(istrabo,m) = DOC_tau_labile(m) / one_year 
+	DOC_tau(imetbel,m) = DOC_tau_labile(m) / one_year 
+	DOC_tau(istrbel,m) = DOC_tau_labile(m) / one_year 
+	DOC_tau(iact,m) = DOC_tau_labile(m) / one_year 
+	DOC_tau(islo,m) = DOC_tau_stable(m) / one_year 
+	DOC_tau(ipas,m) = DOC_tau_stable(m) / one_year 
+		ENDDO 
+       
+
+       !! 1.2.3 decomposition flux fraction that goes into soil
+       !       (litter -> carbon, above and below)
+       !       1-frac_soil goes into atmosphere
+       frac_soil(:,:,:) = zero
+
+       ! structural litter: lignin fraction goes into slow pool + respiration,
+       !                    rest into active pool + respiration
+       frac_soil(istructural,iactive,iabove) = frac_soil_struct_aa
+       frac_soil(istructural,iactive,ibelow) = frac_soil_struct_ab
+       frac_soil(istructural,islow,iabove) = frac_soil_struct_sa
+       frac_soil(istructural,islow,ibelow) = frac_soil_struct_sb
+
+       ! metabolic litter: all goes into active pool + respiration.
+       !   Nothing into slow or passive pool.
+       frac_soil(imetabolic,iactive,iabove) = frac_soil_metab_aa
+       frac_soil(imetabolic,iactive,ibelow) = frac_soil_metab_ab
+       
+ 
+       !! 1.4 messages
+       litter_str(imetabolic) = 'metabolic'
+       litter_str(istructural) = 'structural'
+
+       carbon_str(iactive) = 'active'
+       carbon_str(islow) = 'slow'
+       carbon_str(ipassive) = 'passive'
+
+       level_str(iabove) = 'above'
+       level_str(ibelow) = 'below'
+
+       part_str(ileaf) = 'leaves'
+       part_str(isapabove) = 'sap above ground'
+       part_str(isapbelow) = 'sap below ground'
+       part_str(iheartabove) = 'heartwood above ground'
+       part_str(iheartbelow) = 'heartwood below ground'
+       part_str(iroot) = 'roots'
+       part_str(ifruit) = 'fruits'
+       part_str(icarbres) = 'carbohydrate reserve'
+
+       WRITE(numout,*) 'litter:'
+
+       WRITE(numout,*) '   > C/N ratios: '
+       DO k = 1, nparts
+          WRITE(numout,*) '       ', part_str(k), ': ',CN(k)
+       ENDDO
+
+       WRITE(numout,*) '   > Lignine/C ratios: '
+       DO k = 1, nparts
+          WRITE(numout,*) '       ', part_str(k), ': ',LC(k)
+       ENDDO
+
+       WRITE(numout,*) '   > fraction of compartment that goes into litter: '
+       DO k = 1, nparts
+          DO m = 1, nlitt
+             WRITE(numout,*) '       ', part_str(k), '-> ',litter_str(m), ':',litterfrac(k,m)
+          ENDDO
+       ENDDO
+
+       WRITE(numout,*) '   > minimal carbon residence time in litter pools (d):'
+       DO m = 1, nlitt
+          WRITE(numout,*) '       ',litter_str(m),':',litter_tau(m)
+       ENDDO
+
+       WRITE(numout,*) '   > litter decomposition flux fraction that really goes '
+       WRITE(numout,*) '     into carbon pools (rest into the atmosphere):'
+       DO m = 1, nlitt
+          DO l = 1, nlevs
+             DO k = 1, ncarb
+                WRITE(numout,*) '       ',litter_str(m),' ',level_str(l),' -> ',&
+                     carbon_str(k),':', frac_soil(m,k,l)
+             ENDDO
+          ENDDO
+       ENDDO
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+		DO m=1,nvm 
+ 		          DOC_tau(imetabo,m) = DOC_tau_labile(m) / one_year 
+ 		          DOC_tau(istrabo,m) = DOC_tau_labile(m) / one_year 
+ 		          DOC_tau(imetbel,m) = DOC_tau_labile(m) / one_year 
+ 		          DOC_tau(istrbel,m) = DOC_tau_labile(m) / one_year 
+ 		          DOC_tau(iact,m) = DOC_tau_labile(m) / one_year 
+ 		          DOC_tau(islo,m) = DOC_tau_stable(m) / one_year 
+ 		          DOC_tau(ipas,m) = DOC_tau_stable(m) / one_year 
+		ENDDO 
+
+
+    !! 1.3 Initialization
+    litter_above_flux(:,:,:,:) = zero
+    litter_flux(:,:,:,:,:) = zero
+    litter_flux_old(:,:,:,:,:) = zero
+    old_struc_above(:,:) = zero
+    old_struc_below(:,:,:) = zero
+    litter_pft(:,:,:,:) = zero
+    !Dif_coef(:) = (Dif/one_year)*dt 
+  
+	Dif_coef(:,1)=0.000540941406485744
+	Dif_coef(:,2)=0.000537778015618221
+	Dif_coef(:,3)=0.000529432453874695
+	Dif_coef(:,4)=0.00051312785464185
+	Dif_coef(:,5)=0.000482009560366733
+	Dif_coef(:,6)=0.000425319968125143
+	Dif_coef(:,7)=0.00033115858607203
+	Dif_coef(:,8)=0.000200759688792712
+	Dif_coef(:,9)=0.0000737832025989453
+	Dif_coef(:,10)=0.0000099659677737995
+	Dif_coef(:,11)=4.94723389072555E-07
+
+	
+
+	DO k=1,nbdl 
+ 		            Dif_coef(:,k)=(Dif_coef(:,k)/one_year)*dt
+ 	ENDDO 
+
+
+    
+    !! 1.3 litter above the ground per PFT.
+    DO j = 2, nvm ! Loop over # PFTs
+       DO k = 1, nlitt !Loop over litter pool
+          litter_pft(:,j,k,icarbon) = litterpart(:,j,k) * litter_above(:,k,j,icarbon)
+	  litter_pft(:,j,k,icarbon14) = litterpart(:,j,k) * litter_above(:,k,j,icarbon14)
+       ENDDO
+    ENDDO
+
+    
+    !! 1.4 set output to zero
+    deadleaf_cover(:) = zero
+    resp_hetero_litter(:,:,:) = zero
+    soilcarbon_input(:,:,:,:,:)= zero
+    !resp_hetero_litter_layer(:,:,:) = zero
+
+  !! 2. Add biomass to different litterpools (per m^2 of ground)
+    
+    !! 2.1 first, save old structural litter (needed for lignin fractions).
+    !     above
+       DO m = 2,nvm !Loop over PFTs
+
+          old_struc_above(:,m) = litter_above(:,istructural,m,icarbon)
+
+       ENDDO
+
+    !below
+    DO l = 1, nbdl !Loop over soil levels (below ground)
+       DO m = 2,nvm !Loop over PFTs
+
+          old_struc_below(:,m,l) = litter_below(:,istructural,m,l,icarbon)
+
+       ENDDO
+    ENDDO
+    
+    !! 2.2 update litter, dead leaves, and lignin content in structural litter
+    litter_inc_above(:,:,:,:) = zero
+    lignin_struc_inc_above(:,:) = zero
+    litter_inc_below(:,:,:,:,:) = zero
+    lignin_struc_inc_below(:,:,:) = zero
+    litter_inc_PFT_above(:,:,:,:) = zero
+    litter_inc_PFT_below(:,:,:,:,:) = zero
+
+
+    DO j = 2,nvm !Loop over PFTs
+
+       !! 2.2.1 litter
+       DO k = 1, nlitt    !Loop over litter pools (metabolic and structural)
+
+          !! 2.2.2 calculate litter increase (per m^2 of ground).
+          !       Only a given fracion of fruit turnover is directly coverted into litter.
+          !       Litter increase for each PFT, structural and metabolic, above/below. It must
+          !       be noted that the distribution of above ground litter is done within the soil layers
+          !       as a proportion of the layer size. But for the below ground layer it follows the root profile
+
+          ! For the first litter layer
+          litter_inc_PFT_above(:,j,k,icarbon) = &
+               litterfrac(ileaf,k) * bm_to_litter(:,j,ileaf,icarbon) + &
+               litterfrac(isapabove,k) * bm_to_litter(:,j,isapabove,icarbon) + &
+               litterfrac(iheartabove,k) * bm_to_litter(:,j,iheartabove,icarbon) + &
+               litterfrac(ifruit,k) * bm_to_litter(:,j,ifruit,icarbon) + &
+               litterfrac(icarbres,k) * bm_to_litter(:,j,icarbres,icarbon) + &
+               litterfrac(ileaf,k) * turnover(:,j,ileaf,icarbon) + &
+               litterfrac(isapabove,k) * turnover(:,j,isapabove,icarbon) + &
+               litterfrac(iheartabove,k) * turnover(:,j,iheartabove,icarbon) + &
+               litterfrac(ifruit,k) * turnover(:,j,ifruit,icarbon) + &
+               litterfrac(icarbres,k) * turnover(:,j,icarbres,icarbon) 
+
+	  litter_inc_PFT_above(:,j,k,icarbon14) = litter_inc_PFT_above(:,j,k,icarbon)
+
+             ! litter increase, met/struct, above
+             litter_inc_above(:,k,j,icarbon) = litter_inc_above(:,k,j,icarbon) + litter_inc_PFT_above(:,j,k,icarbon)
+	     litter_inc_above(:,k,j,icarbon14) = litter_inc_above(:,k,j,icarbon) 
+
+          !! The function used for root profile is coming from stomate_npp.f90
+       rpc(:) = un /( ( un - EXP( -z_soil(nbdl) / rprof(:,j) )) ) 
+
+          DO l = 1, nbdl
+
+             litter_inc_PFT_below(:,j,k,l,icarbon) = &
+                  litterfrac(isapbelow,k) * bm_to_litter(:,j,isapbelow,icarbon) *  &
+               rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  litterfrac(iheartbelow,k) * bm_to_litter(:,j,iheartbelow,icarbon) * &
+               rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  litterfrac(iroot,k) * bm_to_litter(:,j,iroot,icarbon) * &
+               rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  litterfrac(isapbelow,k) * turnover(:,j,isapbelow,icarbon) * &
+               rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  litterfrac(iheartbelow,k) * turnover(:,j,iheartbelow,icarbon) * &
+               rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  litterfrac(iroot,k) * turnover(:,j,iroot,icarbon) * &
+               rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) )
+	     
+	     litter_inc_PFT_below(:,j,k,l,icarbon14) = litter_inc_PFT_below(:,j,k,l,icarbon) 
+
+             ! litter increase, met/struct, below
+             litter_inc_below(:,k,j,l,icarbon) = litter_inc_below(:,k,j,l,icarbon) + litter_inc_PFT_below(:,j,k,l,icarbon)
+	     litter_inc_below(:,k,j,l,icarbon14) = litter_inc_below(:,k,j,l,icarbon)
+          ENDDO
+          !! 2.2.3 dead leaves, for soil cover.
+          dead_leaves(:,j,k) = &
+               dead_leaves(:,j,k) + &
+               litterfrac(ileaf,k) * ( bm_to_litter(:,j,ileaf,icarbon) + turnover(:,j,ileaf,icarbon) )
+
+          !! 2.2.4 lignin increase in structural litter
+          IF ( k .EQ. istructural ) THEN
+
+             lignin_struc_inc_above(:,j) = &
+                  lignin_struc_inc_above(:,j) + &
+                  LC(ileaf) * bm_to_litter(:,j,ileaf,icarbon) + &
+                  LC(isapabove) * bm_to_litter(:,j,isapabove,icarbon) + &
+                  LC(iheartabove) * bm_to_litter(:,j,iheartabove,icarbon) + &
+                  LC(ifruit) * bm_to_litter(:,j,ifruit,icarbon) + &
+                  LC(icarbres) * bm_to_litter(:,j,icarbres,icarbon) + &
+                  LC(ileaf) * turnover(:,j,ileaf,icarbon) + &
+                  LC(isapabove) * turnover(:,j,isapabove,icarbon) + &
+                  LC(iheartabove) * turnover(:,j,iheartabove,icarbon) + &
+                  LC(ifruit) * turnover(:,j,ifruit,icarbon) + &
+                  LC(icarbres) * turnover(:,j,icarbres,icarbon) 
+
+            !! The function used for root profile is coming from stomate_npp.f90
+            DO l = 1, nbdl
+
+               lignin_struc_inc_below(:,j,l) = &
+                  lignin_struc_inc_below(:,j,l) + &
+                  LC(isapbelow) * bm_to_litter(:,j,isapbelow,icarbon) * &
+                  rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  LC(iheartbelow) * bm_to_litter(:,j,iheartbelow,icarbon) * &
+                  rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  LC(iroot) * bm_to_litter(:,j,iroot,icarbon) * &
+                  rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  LC(isapbelow)*turnover(:,j,isapbelow,icarbon) * &
+                  rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  LC(iheartbelow)*turnover(:,j,iheartbelow,icarbon) * &
+                  rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  LC(iroot)*turnover(:,j,iroot,icarbon) * &
+                  rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) )
+            ENDDO
+
+          ENDIF
+       ENDDO
+     ENDDO
+
+
+
+    !! 2.2.5 add new litter (struct/met, above/below)
+         litter_above(:,:,:,icarbon) = litter_above(:,:,:,icarbon) + litter_inc_above(:,:,:,icarbon)
+	 litter_above(:,:,:,icarbon14) = ratio * litter_above(:,:,:,icarbon)
+
+         litter_below(:,:,:,:,icarbon) = litter_below(:,:,:,:,icarbon) + litter_inc_below(:,:,:,:,icarbon)
+	 litter_below(:,:,:,:,icarbon14) = ratio * litter_below(:,:,:,:,icarbon)
+
+
+    !! 2.2.6 for security: can't add more lignin than structural litter (above/below)
+       DO m = 2,nvm !Lopp over PFTs
+
+          lignin_struc_inc_above(:,m) = &
+               MIN( lignin_struc_inc_above(:,m), litter_inc_above(:,istructural,m,icarbon) )
+
+       ENDDO
+
+    DO l = 1, nbdl !Loop over soil levels (below ground)
+       DO m = 2,nvm !Lopp over PFTs
+
+          lignin_struc_inc_below(:,m,l) = &
+               MIN( lignin_struc_inc_below(:,m,l), litter_inc_below(:,istructural,m,l,icarbon) )
+
+       ENDDO
+    ENDDO
+
+    !! 2.2.7.1 new lignin content: add old lignin and lignin increase, divide by 
+    !!       total structural litter (above)
+
+       DO m = 2,nvm !Loop over PFTs
+          WHERE( litter_above(:,istructural,m,icarbon) .GT. min_stomate )
+
+       !MM : Soenke modif
+       ! Best vectorization ?
+!!$       lignin_struc(:,:,:) = &
+!!$            ( lignin_struc(:,:,:)*old_struc(:,:,:) + lignin_struc_inc(:,:,:) ) / &
+!!$            litter(:,istructural,:,:,icarbon)
+
+             lignin_struc_above(:,m) = lignin_struc_above(:,m) * old_struc_above(:,m)
+             lignin_struc_above(:,m) = lignin_struc_above(:,m) + lignin_struc_inc_above(:,m)
+             lignin_struc_above(:,m) = lignin_struc_above(:,m) / litter_above(:,istructural,m,icarbon)
+          ELSEWHERE
+             lignin_struc_above(:,m) = zero
+          ENDWHERE
+       ENDDO
+
+    !! 2.2.7.2 new lignin content: add old lignin and lignin increase, divide by 
+    !!       total structural litter (below)
+    DO l = 1, nbdl !Loop over soil levels (below ground)
+       DO m = 2,nvm !Loop over PFTs
+          WHERE( litter_below(:,istructural,m,l,icarbon) .GT. min_stomate )
+
+       !MM : Soenke modif
+       ! Best vectorization ?
+!!$       lignin_struc(:,:,:) = &
+!!$            ( lignin_struc(:,:,:)*old_struc(:,:,:) + lignin_struc_inc(:,:,:)) / &
+!!$            litter(:,istructural,:,:,icarbon)
+
+             lignin_struc_below(:,m,l) = lignin_struc_below(:,m,l) * old_struc_below(:,m,l)
+             lignin_struc_below(:,m,l) = lignin_struc_below(:,m,l) + lignin_struc_inc_below(:,m,l)
+             lignin_struc_below(:,m,l) = lignin_struc_below(:,m,l) /litter_below(:,istructural,m,l,icarbon)
+          ELSEWHERE
+             lignin_struc_below(:,m,l) = zero
+          ENDWHERE
+       ENDDO
+    ENDDO
+
+    
+    !! 2.3 new litter fraction per PFT (for structural and metabolic litter, above
+    !!       the ground).
+       DO j = 2,nvm !Loop over PFTs
+         DO l =1,nlitt 
+         WHERE ( litter_above(:,l,j,icarbon) .GT. min_stomate )
+
+          litterpart(:,j,l) = &
+               ( litter_pft(:,j,l,icarbon) + litter_inc_PFT_above(:,j,l,icarbon) ) / litter_above(:,l,j,icarbon)
+
+         ELSEWHERE
+
+          litterpart(:,j,l) = zero
+
+         ENDWHERE
+         ENDDO
+       ENDDO
+  !! 3. Temperature control on decay: Factor between 0 and 1
+
+    !! 3.1 above: surface temperature 
+    DO j=1,nlitt
+       control_temp_above(:,j) = control_temp_func (npts, tsurf,litter_tau(j)) 
+    ENDDO         
+    !! 3.2 below: convolution of temperature and decomposer profiles
+    !!            (exponential decomposer profile supposed)
+   
+    !! 3.2.1 integrate over the nbdl levels
+    tsoil_decomp(:) = zero
+
+    DO l = 1, nbdl
+       DO j = 1,npool
+
+          tsoil_decomp(:) = tsoil(:,l) 
+
+          control_temp_soil(:,l,j) = control_temp_func (npts,tsoil_decomp,pool_tau(j))
+
+       ENDDO
+    ENDDO
+
+    DO l = 1, nbdl
+       DO j = 1,npool
+
+          tsoil_decomp(:) = tsoil(:,l)
+
+          control_temp_soil(:,l,npool+j) = control_temp_func(npts,tsoil_decomp,DOC_tau(j,m))
+
+       ENDDO
+    ENDDO
+
+  !! 4. Moisture control. Factor between 0 and 1
+
+    !! 4.1 above the ground: litter humidity 
+
+
+    soilhum_decomp(:) = zero
+    DO m= 1,nvm
+       !We used the sum over the 4 first layer as it is done to
+       !compute litterhum in hydrol.f90
+         soilhum_decomp(:) =soil_mc(:,1,pref_soil_veg(m))*(z_soil(1)/z_soil(4)) + &
+                            soil_mc(:,2,pref_soil_veg(m))*((z_soil(2)-z_soil(1))/z_soil(4)) + &
+                            soil_mc(:,3,pref_soil_veg(m))*((z_soil(3)-z_soil(2))/z_soil(4)) + &
+                            soil_mc(:,4,pref_soil_veg(m))*((z_soil(4)-z_soil(3))/z_soil(4))
+
+       IF (moist_func_Moyano) THEN
+        control_moist_above(:,m) = control_moist_func_moyano (npts, soilhum_decomp,bulk_dens, &
+                                                    clay, carbon, veget_max)
+       ELSE 
+         control_moist_above(:,m) = control_moist_func (npts,soilhum_decomp)
+       ENDIF
+    ENDDO
+    !! 4.2 below: soil humidity for each soil layers 
+
+    !! 4.2.1 integrate over the nbdl levels
+    soilhum_decomp(:) = zero
+
+    DO l = 1, nbdl !Loop over soil levels
+      DO m =1,nvm
+         soilhum_decomp(:) =soil_mc(:,l,pref_soil_veg(m))
+         IF (moist_func_Moyano) THEN
+         control_moist_soil(:,l,m) = control_moist_func_moyano (npts, soilhum_decomp,bulk_dens, &
+                                                  clay, carbon, veget_max)
+         ELSE
+         control_moist_soil(:,l,m) = control_moist_func (npts, soilhum_decomp)
+         ENDIF
+
+      ENDDO
+    ENDDO
+
+  !! 5. fluxes from above ground litter to carbon pools and respiration
+      DO m = 2,nvm !Loop over PFTs
+
+          !! 5.1 structural litter: goes into active and slow carbon pools + respiration
+
+          !! 5.1.1 total quantity of above ground structural litter which is decomposed
+
+      WHERE (soil_mc(:,1,pref_soil_veg(m)) .GT. zero)
+          fd(:) = dt/litter_tau(istructural) * &
+             control_temp_above(:,istructural) * control_moist_above(:,m) * exp( -litter_struct_coef * lignin_struc_above(:,m) ) 
+      ELSEWHERE
+          fd(:) = zero
+      ENDWHERE
+         ! DO k = 1,nelements
+
+             qd(:,icarbon) = litter_above(:,istructural,m,icarbon) * fd(:)
+	     qd(:,icarbon14) =  litter_above(:,istructural,m,icarbon14) * fd(:)
+
+
+         ! ENDDO
+
+          !! 5.1.2 decompose same fraction of structural part of dead leaves. Not exact
+          !!       as lignine content is not the same as that of the total structural litter.
+          dead_leaves(:,m,istructural) = dead_leaves(:,m,istructural) * ( un - fd(:) )
+
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m,icarbon) = resp_hetero_litter(:,m,icarbon) + &
+               ( 1. - frac_soil(istructural,iactive,iabove) ) * qd(:,icarbon) * &
+               ( 1. - lignin_struc_above(:,m) ) / dt
+
+	 resp_hetero_litter(:,m,icarbon14) = resp_hetero_litter(:,m,icarbon14) + &
+               ( 1. - frac_soil(istructural,iactive,iabove) ) * qd(:,icarbon14) * &
+               ( 1. - lignin_struc_above(:,m) ) / dt
+
+
+          !resp_hetero_litter_layer(:,m,1) = resp_hetero_litter_layer(:,m,1) + &
+          !    ( 1. - frac_soil(istructural,iactive,iabove) ) * qd(:,icarbon) * &
+          !     ( 1. - lignin_struc_above(:,m) ) / dt
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m,icarbon) = resp_hetero_litter(:,m,icarbon) + &
+               ( 1. - frac_soil(istructural,islow,iabove) ) * qd(:,icarbon) * lignin_struc_above(:,m) / dt
+
+	  resp_hetero_litter(:,m,icarbon14) = resp_hetero_litter(:,m,icarbon14) + &
+               ( 1. - frac_soil(istructural,islow,iabove) ) * qd(:,icarbon14) * lignin_struc_above(:,m) / dt
+
+         ! resp_hetero_litter_layer(:,m,1) = resp_hetero_litter_layer(:,m,1) + &
+         !      ( 1. - frac_soil(istructural,islow,iabove) ) * qd(:,icarbon) *lignin_struc_above(:,m) / dt
+
+          !! 5.1.3 Calculation of the soilcarbon_input in gC m^-2 of water
+
+          DO k = 1, nelements
+
+            ! soilcarbon_input(:,m,1,istrabo,icarbon) = (frac_soil(istructural,iactive,iabove) * ( 1. - lignin_struc_above(:,m) ) *  qd(:,icarbon) + &
+             !                     frac_soil(istructural,islow,iabove) *  qd(:,icarbon) * lignin_struc_above(:,m) ) /dt
+	     
+             !soilcarbon_input(:,m,1,istrabo,icarbon14) = (frac_soil(istructural,iactive,iabove) * ( 1. - lignin_struc_above(:,m) ) *  qd(:,icarbon14) + &
+              !                    frac_soil(istructural,islow,iabove) *  qd(:,icarbon14) * lignin_struc_above(:,m) ) /dt
+
+		soilcarbon_input(:,m,1,istrabo,k) = (z_soil(1)/z_soil(sro_bottom))*(frac_soil(istructural,iactive,iabove) * ( 1. - lignin_struc_above(:,m) ) * qd(:,k) + &
+				frac_soil(istructural,islow,iabove) * qd(:,k) * lignin_struc_above(:,m) ) /dt
+					IF (sro_bottom .GT. 1) THEN
+						DO l=2,sro_bottom !Loop over the first layers
+
+			soilcarbon_input(:,m,l,istrabo,k) = ((z_soil(l)-z_soil(l-1))/z_soil(sro_bottom))*(frac_soil(istructural,iactive,iabove)* ( 1. - lignin_struc_above(:,m) ) * qd(:,k) + &
+			frac_soil(istructural,islow,iabove) * qd(:,k) * lignin_struc_above(:,m)) /dt
+						ENDDO
+					ENDIF
+
+          ENDDO
+
+          litter_above(:,istructural,m,icarbon) = litter_above(:,istructural,m,icarbon) - qd(:,icarbon)
+	  litter_above(:,istructural,m,icarbon14) = litter_above(:,istructural,m,icarbon14) - qd(:,icarbon14)
+
+
+          
+          !! 5.2 above ground metabolic litter goes into active carbon pool + respiration
+         
+          !! 5.2.1 total quantity of aboveground metabolic litter that is decomposed
+      WHERE (soil_mc(:,1,pref_soil_veg(m)) .GT. zero)
+          fd(:) = dt/litter_tau(imetabolic) * control_temp_above(:,imetabolic) * control_moist_above(:,m)
+      ELSEWHERE
+          fd(:) = zero
+      ENDWHERE
+
+          !DO k = 1,nelements
+          
+             qd(:,icarbon) = litter_above(:,imetabolic,m,icarbon) * fd(:)
+             qd(:,icarbon14) = litter_above(:,imetabolic,m,icarbon14) * fd(:)
+
+          !ENDDO
+
+
+          !! 5.2.2 decompose same fraction of metabolic part of dead leaves.
+          dead_leaves(:,m,imetabolic) = dead_leaves(:,m,imetabolic) * ( 1. - fd(:) )
+
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m,icarbon) = resp_hetero_litter(:,m,icarbon) + &
+               ( 1. - frac_soil(imetabolic,iactive,iabove) ) * qd(:,icarbon) / dt
+          resp_hetero_litter(:,m,icarbon14) = resp_hetero_litter(:,m,icarbon14) + &
+               ( 1. - frac_soil(imetabolic,iactive,iabove) ) * qd(:,icarbon14) / dt
+
+         ! resp_hetero_litter_layer(:,m,1) = resp_hetero_litter_layer(:,m,1) + &
+         !      ( 1. - frac_soil(imetabolic,iactive,iabove) ) * qd(:,icarbon) / dt
+
+          !! 5.2.3 Calculation of the soilcarbon_input in gC m^-2 of water
+             ! For above ground litter we assume that the soilcarbon_input coming from AB
+             ! litter decomposition is directly incorporated into the 1st soil
+             ! layers
+
+          DO k = 1, nelements
+
+            ! soilcarbon_input(:,m,1,imetabo,icarbon) = frac_soil(imetabolic,iactive,iabove) *  qd(:,icarbon) / dt 
+	     !soilcarbon_input(:,m,1,imetabo,icarbon14) = frac_soil(imetabolic,iactive,iabove) *  qd(:,icarbon14) / dt 
+ 
+		soilcarbon_input(:,m,1,imetabo,k) = (z_soil(1)/z_soil(sro_bottom))*frac_soil(imetabolic,iactive,iabove) * qd(:,k) / dt
+			IF (sro_bottom .GT. 1) THEN
+				DO l = 2,sro_bottom
+
+			soilcarbon_input(:,m,l,imetabo,k) =((z_soil(l)-z_soil(l-1))/z_soil(sro_bottom))*frac_soil(imetabolic,iactive,iabove)* qd(:,k) / dt
+
+				ENDDO
+			ENDIF
+
+         ENDDO
+
+          litter_above(:,imetabolic,m,icarbon) = litter_above(:,imetabolic,m,icarbon) - qd(:,icarbon)
+	  litter_above(:,imetabolic,m,icarbon14) = litter_above(:,imetabolic,m,icarbon14) - qd(:,icarbon14)
+
+      ENDDO
+
+!! 6. fluxes from below ground litter to carbon pools and respiration
+   DO l = 1,nbdl
+       DO m = 2,nvm !Loop over PFTs
+
+          !! 6.1 structural litter: goes into active and slow carbon pools respiration
+
+          !! 6.1.1 total quantity of below ground structural litter which is decomposed
+    WHERE (soil_mc(:,l,pref_soil_veg(m)) .GT. zero)
+          fd(:) = dt/litter_tau(istructural) * &
+               control_temp_soil(:,l,istrbel) * control_moist_soil(:,l,m) * exp(-litter_struct_coef * lignin_struc_below(:,m,l) )
+    ELSEWHERE
+          fd(:) = zero
+    ENDWHERE
+
+          !DO k = 1,nelements
+
+             qd(:,icarbon) = litter_below(:,istructural,m,l,icarbon) * fd(:)
+	     qd(:,icarbon14) = litter_below(:,istructural,m,l,icarbon14) * fd(:)
+
+          !ENDDO
+
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m,icarbon) = resp_hetero_litter(:,m,icarbon) + &
+               ( 1. - frac_soil(istructural,iactive,ibelow) ) * qd(:,icarbon) * &
+               ( 1. - lignin_struc_below(:,m,l) ) / dt
+	  resp_hetero_litter(:,m,icarbon14) = resp_hetero_litter(:,m,icarbon14) + &
+               ( 1. - frac_soil(istructural,iactive,ibelow) ) * qd(:,icarbon14) * &
+               ( 1. - lignin_struc_below(:,m,l) ) / dt
+
+         ! resp_hetero_litter_layer(:,m,l) = resp_hetero_litter_layer(:,m,l) + &
+         !      ( 1. - frac_soil(istructural,iactive,ibelow) ) * qd(:,icarbon) * &
+         !      ( 1. - lignin_struc_below(:,m,l) ) / dt
+
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m,icarbon) = resp_hetero_litter(:,m,icarbon) + &
+               ( 1. - frac_soil(istructural,islow,ibelow) ) * qd(:,icarbon) * lignin_struc_below(:,m,l) / dt
+          resp_hetero_litter(:,m,icarbon14) = resp_hetero_litter(:,m,icarbon14) + &
+               ( 1. - frac_soil(istructural,islow,ibelow) ) * qd(:,icarbon14) * lignin_struc_below(:,m,l) / dt
+
+
+         ! resp_hetero_litter_layer(:,m,l) = resp_hetero_litter_layer(:,m,l) + &
+         !      ( 1. - frac_soil(istructural,islow,ibelow) ) * qd(:,icarbon) * lignin_struc_below(:,m,l) / dt
+
+          !! 6.1 Calculation of the soilcarbon_input in gC m^-2
+
+          !DO k = 1, nelements
+
+
+                  soilcarbon_input(:,m,l,istrbel,icarbon) = (frac_soil(istructural,iactive,ibelow) * ( 1. - lignin_struc_below(:,m,l) ) * qd(:,icarbon) + & 
+                                             (frac_soil(istructural,islow,ibelow) * qd(:,icarbon) * lignin_struc_below(:,m,l) )) / dt 
+
+	         soilcarbon_input(:,m,l,istrbel,icarbon14) = (frac_soil(istructural,iactive,ibelow) * ( 1. - lignin_struc_below(:,m,l) ) * qd(:,icarbon14) + & 
+                                             (frac_soil(istructural,islow,ibelow) * qd(:,icarbon14) * lignin_struc_below(:,m,l) )) / dt 
+        ! ENDDO
+
+      litter_below(:,istructural,m,l,icarbon) = litter_below(:,istructural,m,l,icarbon) - qd(:,icarbon)
+      litter_below(:,istructural,m,l,icarbon14) = litter_below(:,istructural,m,l,icarbon14) - qd(:,icarbon14)
+
+          !! 6.2 below ground metabolic litter goes into active carbon pool + respiration
+
+          !! 6.2.1 total quantity of belowground metabolic litter that is decomposed
+    WHERE (soil_mc(:,l,pref_soil_veg(m)) .GT. zero)
+          fd(:) = dt/litter_tau(imetabolic) * control_temp_soil(:,l,imetbel) * control_moist_soil(:,l,m)
+    ELSEWHERE
+          fd(:) = zero
+    ENDWHERE
+
+         ! DO k = 1,nelements
+
+             qd(:,icarbon) = litter_below(:,imetabolic,m,l,icarbon) * fd(:)
+	     qd(:,icarbon14) = litter_below(:,imetabolic,m,l,icarbon14) * fd(:)
+
+          !ENDDO
+
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m,icarbon) = resp_hetero_litter(:,m,icarbon) + &
+               ( 1. - frac_soil(imetabolic,iactive,ibelow) ) * qd(:,icarbon) /dt
+
+          resp_hetero_litter(:,m,icarbon14) = resp_hetero_litter(:,m,icarbon14) + &
+               ( 1. - frac_soil(imetabolic,iactive,ibelow) ) * qd(:,icarbon14) /dt
+
+
+        !  resp_hetero_litter_layer(:,m,l) = resp_hetero_litter_layer(:,m,l) + &
+        !       ( 1. - frac_soil(imetabolic,iactive,ibelow) ) * qd(:,icarbon) /dt
+
+
+          !! 6.2.3 Calculation of the soilcarbon_input in gC m^-2 of water
+
+          !DO k = 1, nelements
+                soilcarbon_input(:,m,l,imetbel,icarbon) = frac_soil(imetabolic,iactive,ibelow) * qd(:,icarbon) / dt
+                soilcarbon_input(:,m,l,imetbel,icarbon14) =  frac_soil(imetabolic,iactive,ibelow) * qd(:,icarbon14) / dt
+
+         !ENDDO
+    
+      litter_below(:,imetabolic,m,l,icarbon) = litter_below(:,imetabolic,m,l,icarbon) - qd(:,icarbon)
+      litter_below(:,imetabolic,m,l,icarbon14) = litter_below(:,imetabolic,m,l,icarbon14)- qd(:,icarbon14)
+
+       ENDDO
+   ENDDO
+
+
+  !! 7. Transport of particulate organic C (i.e. active, slow and passive
+  !! pools) following the second Fick's Law (OÂ¿Brien and Stout, 1978; Wynn
+  !! et al., 2005). Represent the bioturbation and is generally associated
+  !! with transport in the liquid phase like in the section 3.2.5 (Elzein
+  !! and Balesdent, 1995; Bruun et al., 2007; Braakhekke et al., 2011,
+  !! Guenet et al., 2013) 
+
+  ! Definition of the diffusion rate from Guenet et al., (2013) BG for the
+  ! moment but must depends on clay, ph organic C, or whatever...
+
+!   DO m =2,nvm
+!      DO k = 1, nelements
+!         DO j = 1,nlitt
+!            litter_above_flux(:,j,m,k) = Dif_coef(:)*ABS(litter_above(:,j,m,k)/(z_litter*1e-3)-litter_below(:,j,m,1,k)/(z_litter*1e-3-z_soil(1)))
+!            ! BE CAREFUL: Here very important assumption we assume the above ground litter layers to be 10mm thick by default. 
+!
+!            litter_flux(:,j,m,1,k) = Dif_coef(:)*ABS(litter_below(:,j,m,1,k)/(z_soil(1))-litter_below(:,j,m,2,k)/(z_soil(2)-z_soil(1)))/(z_soil(2)-z_soil(1))
+!
+!           DO l = 2, nbdl-1
+!            litter_flux(:,j,m,l,k) = Dif_coef(:)*ABS(litter_below(:,j,m,l,k)/(z_soil(l)-z_soil(l-1))-litter_below(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)))/(z_soil(l+1)-z_soil(l))  
+!           ENDDO
+!
+!           WHERE ((litter_above(:,j,m,k)/(z_litter*1e-3) .LT. litter_below(:,j,m,1,k)/(z_soil(1))) )
+!            litter_above(:,j,m,k) = litter_above(:,j,m,k) + MIN(litter_below(:,j,m,1,k),litter_above_flux(:,j,m,k))
+!            litter_below(:,j,m,1,k) = litter_below(:,j,m,1,k) - MIN(litter_below(:,j,m,1,k),litter_above_flux(:,j,m,k))
+!           ELSEWHERE ((litter_above(:,j,m,k)/(z_litter*1e-3) .GT. litter_below(:,j,m,1,k)/(z_soil(1)))) 
+!            litter_above(:,j,m,k) = litter_above(:,j,m,k) - MIN(litter_above(:,j,m,k),litter_above_flux(:,j,m,k))
+!            litter_below(:,j,m,1,k) = litter_below(:,j,m,1,k) + MIN(litter_above(:,j,m,k),litter_above_flux(:,j,m,k))
+!           ELSEWHERE 
+!            litter_above(:,j,m,k) = litter_above(:,j,m,k)
+!            litter_below(:,j,m,1,k) = litter_below(:,j,m,1,k)
+!           ENDWHERE
+! 
+!           WHERE ((litter_below(:,j,m,1,k)/(z_soil(1)) .LT. litter_below(:,j,m,2,k)/(z_soil(2)-z_soil(1)))) 
+!            litter_below(:,j,m,1,k) = litter_below(:,j,m,1,k) + MIN(litter_below(:,j,m,2,k),litter_flux(:,j,m,1,k))
+!            litter_below(:,j,m,2,k) = litter_below(:,j,m,2,k) - MIN(litter_below(:,j,m,2,k),litter_flux(:,j,m,1,k))
+!           ELSEWHERE ((litter_below(:,j,m,1,k)/(z_soil(1)) .GT. litter_below(:,j,m,2,k)/(z_soil(2)-z_soil(1))) )
+!            litter_below(:,j,m,1,k) = litter_below(:,j,m,1,k) - MIN(litter_below(:,j,m,1,k),litter_flux(:,j,m,1,k))
+!            litter_below(:,j,m,2,k) = litter_below(:,j,m,2,k) + MIN(litter_below(:,j,m,1,k),litter_flux(:,j,m,1,k))
+!           ELSEWHERE 
+!            litter_below(:,j,m,1,k) = litter_below(:,j,m,1,k)
+!            litter_below(:,j,m,2,k) = litter_below(:,j,m,2,k)
+!           ENDWHERE
+!
+!
+ !     DO l= 2, nbdl-1 ! Loop over soil layers
+!
+!           WHERE ((litter_below(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .LT. litter_below(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l))) )
+!            litter_below(:,j,m,l,k) = litter_below(:,j,m,l,k) + MIN(litter_below(:,j,m,l+1,k),litter_flux(:,j,m,l,k))
+!            litter_below(:,j,m,l+1,k) = litter_below(:,j,m,l+1,k) - MIN(litter_below(:,j,m,l+1,k),litter_flux(:,j,m,l,k))
+!           ELSEWHERE ((litter_below(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .GT. litter_below(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l))) )
+!            litter_below(:,j,m,l,k) = litter_below(:,j,m,l,k) - MIN(litter_below(:,j,m,l,k),litter_flux(:,j,m,l,k))
+!            litter_below(:,j,m,l+1,k) = litter_below(:,j,m,l+1,k) + MIN(litter_below(:,j,m,l,k),litter_flux(:,j,m,l,k))
+!           ELSEWHERE
+!            litter_below(:,j,m,l,k) = litter_below(:,j,m,l,k)
+!           ENDWHERE
+!
+!          ENDDO ! End loop over elements
+!        ENDDO ! End loop over carbon pools
+!      ENDDO ! End loop over soil layers
+!
+!    ENDDO
+
+DO m =2,nvm
+
+litter_below_old(:,:,m,:,:)=zero
+litter_below_old_buffer(:,:,m,:,:)=zero
+litter_below_old(:,:,m,:,icarbon)=litter_below(:,:,m,:,icarbon)
+litter_below_old(:,:,m,:,icarbon14)=litter_below(:,:,m,:,icarbon14)
+litter_above_old(:,:,m,:)=zero
+litter_above_old(:,:,m,icarbon)=litter_above(:,:,m,icarbon)
+litter_above_old(:,:,m,icarbon14)=litter_above(:,:,m,icarbon14)
+      DO k = 1, nelements ! Loop over elements
+         DO j = 1,nlitt ! Loop over litter pools
+
+        litter_flux(:,j,m,1,k) = Dif_coef(:,1)*ABS(litter_below_old(:,j,m,1,k)/(z_soil(1))-litter_below_old(:,j,m,2,k)/(z_soil(2)-z_soil(1)))/(z_soil(2)-z_soil(1))
+        litter_above_flux(:,j,m,k) = Dif_coef(:,1)*ABS(litter_above(:,j,m,k)/(z_litter*1e-3)-litter_below(:,j,m,1,k)/(z_litter*1e-3-z_soil(1)))
+            ! BE CAREFUL: Here very important assumption we assume the above ground litter layers to be 10mm thick by default.
+
+      DO l= 2, nbdl-1 ! Loop over soil layers
+        litter_flux(:,j,m,l,k) = Dif_coef(:,l)*ABS(litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1))-litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)))/(z_soil(l+1)-z_soil(l))
+      ENDDO
+        litter_flux_old(:,j,m,:,k) = litter_flux(:,j,m,:,k)
+        litter_above_flux_old(:,j,m,k) = litter_above_flux(:,j,m,k)
+
+       !Below we checked if in case that, in a given layer, you have diffusion in the above and below litters, both fluxes are not higher than the stocks of the given layer.
+           WHERE (litter_above_old(:,j,m,k)/(z_litter*1e-3) .LT. litter_below_old(:,j,m,1,k)/(z_soil(1)) .AND. &
+                  litter_below_old(:,j,m,2,k)/(z_soil(2)-z_soil(1)) .LT. litter_below_old(:,j,m,1,k)/(z_soil(1)) .AND. &
+                  litter_above_flux_old(:,j,m,k)+litter_flux_old(:,j,m,1,k) .GT. litter_below_old(:,j,m,1,k))
+            litter_above_flux(:,j,m,k) = litter_below_old(:,j,m,1,k)*(litter_above_flux_old(:,j,m,k)/(litter_above_flux_old(:,j,m,k)+litter_flux_old(:,j,m,1,k)))
+            litter_flux(:,j,m,1,k) = litter_below_old(:,j,m,1,k)*(litter_flux_old(:,j,m,1,k)/(litter_above_flux_old(:,j,m,k)+litter_flux_old(:,j,m,1,k)))
+           ELSEWHERE (litter_above_old(:,j,m,k)/(z_litter*1e-3) .GE. litter_below_old(:,j,m,1,k)/(z_soil(1)) .AND. &
+                      litter_below_old(:,j,m,2,k)/(z_soil(2)-z_soil(1)) .LT. litter_below_old(:,j,m,1,k)/(z_soil(1)) .AND. &
+                      litter_below_old(:,j,m,1,k) + litter_above_flux_old(:,j,m,k) - litter_flux_old(:,j,m,1,k) .LE. min_stomate)
+            litter_above_flux(:,j,m,k) = litter_above_flux_old(:,j,m,k)
+            litter_flux(:,j,m,1,k) = litter_below_old(:,j,m,1,k) + litter_above_flux_old(:,j,m,k)
+           ELSEWHERE (litter_above_old(:,j,m,k)/(z_litter*1e-3) .LT. litter_below_old(:,j,m,1,k)/(z_soil(1)) .AND. &
+                      litter_below_old(:,j,m,2,k)/(z_soil(2)-z_soil(1)) .GE. litter_below_old(:,j,m,1,k)/(z_soil(1)) .AND. &
+                      litter_below_old(:,j,m,1,k) - litter_above_flux_old(:,j,m,k) + litter_flux_old(:,j,m,1,k) .LE. min_stomate)
+            litter_above_flux(:,j,m,k) = litter_below_old(:,j,m,1,k) + litter_flux_old(:,j,m,1,k) 
+            litter_flux(:,j,m,1,k) = litter_flux_old(:,j,m,1,k)
+           ELSEWHERE
+            litter_above_flux(:,j,m,k) = litter_above_flux_old(:,j,m,k)
+            litter_flux(:,j,m,1,k) = litter_flux_old(:,j,m,1,k)
+           ENDWHERE
+
+
+      DO l =1, nbdl-2
+           WHERE (litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .LT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)) .AND. &
+                  litter_below_old(:,j,m,l+2,k)/(z_soil(l+2)-z_soil(l+1)) .LT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)) .AND. &
+                  litter_flux_old(:,j,m,l,k)+litter_flux_old(:,j,m,l+1,k) .GT. litter_below_old(:,j,m,l+1,k))
+            litter_flux(:,j,m,l,k) = litter_below_old(:,j,m,l+1,k)*(litter_flux_old(:,j,m,l,k)/(litter_flux_old(:,j,m,l,k)+litter_flux_old(:,j,m,l+1,k)))
+            litter_flux(:,j,m,l+1,k) = litter_below_old(:,j,m,l+1,k)*(litter_flux_old(:,j,m,l+1,k)/(litter_flux_old(:,j,m,l,k)+litter_flux_old(:,j,m,l+1,k)))
+           ELSEWHERE (litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .GE. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)) .AND. &
+                      litter_below_old(:,j,m,l+2,k)/(z_soil(l+2)-z_soil(l+1)) .LT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)) .AND. &
+                      litter_below_old(:,j,m,l+1,k) + litter_flux_old(:,j,m,l,k) - litter_flux_old(:,j,m,l+1,k) .LE. min_stomate)
+            litter_flux(:,j,m,l,k) = litter_flux_old(:,j,m,l,k)
+            litter_flux(:,j,m,l+1,k) = litter_below_old(:,j,m,l+1,k) + litter_flux_old(:,j,m,l,k)
+           ELSEWHERE (litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .LT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)) .AND. &
+                      litter_below_old(:,j,m,l+2,k)/(z_soil(l+2)-z_soil(l+1)) .GE. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)) .AND. &
+                      litter_below_old(:,j,m,l+1,k) - litter_flux_old(:,j,m,l,k) + litter_flux_old(:,j,m,l+1,k) .LE. min_stomate)
+            litter_flux(:,j,m,l,k) = litter_below_old(:,j,m,l+1,k) + litter_flux_old(:,j,m,l+1,k)
+            litter_flux(:,j,m,l+1,k) = litter_flux_old(:,j,m,l+1,k)
+           ELSEWHERE
+            litter_flux(:,j,m,l,k) = litter_flux_old(:,j,m,l,k)
+            litter_flux(:,j,m,l+1,k) = litter_flux_old(:,j,m,l+1,k)
+           ENDWHERE
+      ENDDO
+
+          WHERE ((litter_above_old(:,j,m,k)/(z_litter*1e-3) .LT. litter_below_old(:,j,m,1,k)/(z_soil(1))) .AND. &
+                 ((litter_above_flux(:,j,m,k) - litter_below_old(:,j,m,1,k)) .GE. min_stomate))
+            litter_above(:,j,m,k) = litter_above_old(:,j,m,k) + litter_below_old(:,j,m,1,k) 
+            litter_below_old_buffer(:,j,m,1,k) = -litter_below_old(:,j,m,1,k) 
+            litter_below(:,j,m,1,k) = zero
+           ELSEWHERE ((litter_above_old(:,j,m,k)/(z_litter*1e-3) .LT. litter_below_old(:,j,m,1,k)/(z_soil(1))) .AND. &
+                  ((litter_below_old(:,j,m,1,k) - litter_above_flux(:,j,m,k)) .GT. min_stomate))
+            litter_above(:,j,m,k) = litter_above_old(:,j,m,k) + litter_above_flux(:,j,m,k) 
+            litter_below_old_buffer(:,j,m,1,k) =  - litter_above_flux(:,j,m,k)
+            litter_below(:,j,m,1,k) = litter_below_old(:,j,m,1,k) - litter_above_flux(:,j,m,k)
+           ELSEWHERE ((litter_above_old(:,j,m,k)/(z_litter*1e-3) .GT. litter_below_old(:,j,m,1,k)/(z_soil(1))) .AND. &
+                  ((litter_above_flux(:,j,m,k) - litter_above_old(:,j,m,k)) .GE. min_stomate))
+            litter_above(:,j,m,k) = zero 
+            litter_below_old_buffer(:,j,m,1,k) = litter_above_old(:,j,m,k)
+            litter_below(:,j,m,1,k) = litter_below_old(:,j,m,1,k) + litter_above_old(:,j,m,k)
+           ELSEWHERE ((litter_above_old(:,j,m,k)/(z_litter*1e-3) .GT. litter_below_old(:,j,m,1,k)/(z_soil(1))) .AND. &
+                  ((litter_above_old(:,j,m,k) - litter_above_flux(:,j,m,k)) .GT. min_stomate))
+            litter_above(:,j,m,k) = litter_above_old(:,j,m,k) - litter_above_flux(:,j,m,k)
+            litter_below_old_buffer(:,j,m,1,k) = litter_above_flux(:,j,m,k)
+            litter_below(:,j,m,1,k) = litter_below_old(:,j,m,1,k) + litter_above_flux(:,j,m,k)
+           ELSEWHERE
+            litter_above(:,j,m,k) = litter_above_old(:,j,m,k)
+            litter_below(:,j,m,1,k) = litter_below_old(:,j,m,1,k)
+           ENDWHERE
+
+      DO l= 1, nbdl-1 ! Loop over soil layers
+           WHERE ((litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .LT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l))) .AND. &
+                 ((litter_flux(:,j,m,l,k) - litter_below_old(:,j,m,l+1,k)) .GE. min_stomate))
+            litter_below(:,j,m,l,k) = litter_below_old(:,j,m,l,k) + litter_below_old(:,j,m,l+1,k) + litter_below_old_buffer(:,j,m,l,k)
+            litter_below_old_buffer(:,j,m,l+1,k) = -litter_below_old(:,j,m,l+1,k)
+            litter_below(:,j,m,l+1,k) = zero
+           ELSEWHERE ((litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .LT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l))) .AND. &
+                  ((litter_below_old(:,j,m,l+1,k) - litter_flux(:,j,m,l,k)) .GT. min_stomate))
+            litter_below(:,j,m,l,k) = litter_below_old(:,j,m,l,k) + litter_flux(:,j,m,l,k) + litter_below_old_buffer(:,j,m,l,k)
+            litter_below_old_buffer(:,j,m,l+1,k) =  - litter_flux(:,j,m,l,k)
+            litter_below(:,j,m,l+1,k) = litter_below_old(:,j,m,l+1,k) - litter_flux(:,j,m,l,k)
+           ELSEWHERE ((litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .GT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l))) .AND. &
+                  ((litter_flux(:,j,m,l,k) - litter_below_old(:,j,m,l,k)) .GE. min_stomate))
+            litter_below(:,j,m,l,k) = zero + litter_below_old_buffer(:,j,m,l,k)
+            litter_below_old_buffer(:,j,m,l+1,k) = litter_below_old(:,j,m,l,k)
+            litter_below(:,j,m,l+1,k) = litter_below_old(:,j,m,l+1,k) + litter_below_old(:,j,m,l,k)
+           ELSEWHERE ((litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .GT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l))) .AND. &
+                  ((litter_below_old(:,j,m,l,k) - litter_flux(:,j,m,l,k)) .GT. min_stomate))
+            litter_below(:,j,m,l,k) = litter_below_old(:,j,m,l,k) - litter_flux(:,j,m,l,k) + litter_below_old_buffer(:,j,m,l,k)
+            litter_below_old_buffer(:,j,m,l+1,k) = litter_flux(:,j,m,l,k)
+            litter_below(:,j,m,l+1,k) = litter_below_old(:,j,m,l+1,k) + litter_flux(:,j,m,l,k)
+           ELSEWHERE
+            litter_below(:,j,m,l,k) = litter_below_old(:,j,m,l,k)
+            litter_below(:,j,m,l+1,k) = litter_below_old(:,j,m,l+1,k)
+           ENDWHERE
+        ENDDO ! End loop over soil layers
+      ENDDO ! End loop over litter pools
+    ENDDO ! End loop over elements
+ENDDO ! End loop over PFT
+
+  !! 8. calculate fraction of total soil covered by dead leaves
+
+    CALL deadleaf (npts, veget_max, dead_leaves, deadleaf_cover)
+
+!! 9. Check mass balance closure
+
+    !! 9.1 Calculate components of the mass balance
+    pool_end_after(:,:,:) = zero
+    pool_end(:,:,:) = zero
+IF (ld_doc) THEN
+    DO m = 2, nvm
+       DO i = 1,nlitt
+          DO l = 1, nbdl
+                 pool_end(:,m,icarbon) = pool_end(:,m,icarbon) + &
+                           ( litter_below(:,i,m,l,icarbon) ) * veget_max(:,m)
+          ENDDO
+       ENDDO
+    ENDDO
+
+    DO m = 2, nvm
+       DO i = 1,nlitt
+                 pool_end(:,m,icarbon) = pool_end(:,m,icarbon) + &
+                           ( litter_above(:,i,m,icarbon) ) * veget_max(:,m)
+       ENDDO
+    ENDDO
+
+
+    !! 9.2 Calculate mass balance
+    !  Note that soilcarbon is transfered to other pools but that the pool
+    !  was not updated. We should not account for it in ::pool_end
+
+WRITE(numout,*) " pool_start(:,m,icarbon) litter=",  pool_start(:,4,icarbon)
+WRITE(numout,*) " pool_end(:,m,icarbon) litter=",  pool_end(:,4,icarbon)
+
+    check_intern(:,:,:,:) = zero
+       check_intern(:,:,iatm2land,icarbon) = zero 
+
+    
+    check_intern(:,:,iland2atm,icarbon) = -un * resp_hetero_litter(:,:,icarbon) * &
+         veget_max(:,:) * dt
+    
+
+    DO m = 1,nvm
+       DO l = 1, nbdl
+          check_intern(:,m,ilat2out,icarbon) = check_intern(:,m,ilat2out,icarbon) -un * &
+                      (soilcarbon_input(:,m,l,imetbel,icarbon)+soilcarbon_input(:,m,l,istrbel,icarbon)) * &
+                      veget_max(:,m) * dt
+      ENDDO
+    ENDDO
+
+    
+	!DO m = 1,nvm
+      ! check_intern(:,m,ilat2out,icarbon) = check_intern(:,m,ilat2out,icarbon) -un * &
+                   !(soilcarbon_input(:,m,1,imetabo,icarbon)+soilcarbon_input(:,m,1,istrabo,icarbon)) * &
+                  ! veget_max(:,m) * dt
+    	!ENDDO
+
+
+		DO m = 1,nvm
+      		 DO l = 1, nbdl
+       check_intern(:,m,ilat2out,icarbon) = check_intern(:,m,ilat2out,icarbon) -un * &
+                   (soilcarbon_input(:,m,l,imetabo,icarbon)+soilcarbon_input(:,m,l,istrabo,icarbon)) * &
+                   veget_max(:,m) * dt
+       		 ENDDO
+    		ENDDO
+
+
+    check_intern(:,:,ilat2in,icarbon) = zero
+    
+    check_intern(:,:,ipoolchange,icarbon) = -un * (pool_end(:,:,icarbon) - &
+         pool_start(:,:,icarbon))
+    
+    closure_intern = zero
+    DO i = 1,nmbcomp
+      closure_intern(:,:,icarbon) = closure_intern(:,:,icarbon) + &
+            check_intern(:,:,i,icarbon)
+    ENDDO
+
+    !! 9.3 Write verdict
+
+
+    !WRITE(numout,*) 'l=',l
+!    WRITE(numout,*) 'check_intern litter =',  check_intern(:,6,:,icarbon)
+    IF (SUM(SUM(closure_intern(:,:,icarbon),2),1) .LT. min_stomate .AND. &
+         SUM(SUM(closure_intern(:,:,icarbon),2),1) .GT. -min_stomate) THEN
+       WRITE(numout,*) 'Mass balance closure in stomate_litter.f90'
+    ELSE
+       WRITE(numout,*) 'Error: mass balance is not closed in stomate_litter.f90'
+       WRITE(numout,*) '   Difference is, ', SUM(SUM(closure_intern(:,:,icarbon),2),1)
+       WRITE(numout,*) '   Difference is, ', closure_intern(:,:,icarbon)
+    ENDIF
+ENDIF
+
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving littercalc'
+
+  END SUBROUTINE littercalc
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE   : deadleaf
+!!
+!>\BRIEF        This routine calculates the deadleafcover. 
+!!
+!! DESCRIPTION  : It first calculates the lai corresponding to the dead leaves (LAI) using 
+!! the dead leaves carbon content (DL) the specific leaf area (sla) and the 
+!! maximal coverage fraction of a PFT (vegetmax) using the following equations:
+!! \latexonly
+!! \input{deadleaf1.tex}
+!! \endlatexonly
+!! \n
+!! Then, the dead leaf cover (DLC) is calculated as following:\n
+!! \latexonly
+!! \input{deadleaf2.tex}
+!! \endlatexonly
+!! \n
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE: ::deadleaf_cover
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE deadleaf (npts, veget_max, dead_leaves, deadleaf_cover)
+
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: npts           !! Domain size - number of grid pixels (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)  :: dead_leaves    !! Dead leaves per ground unit area, per PFT, 
+                                                                          !! metabolic and structural  
+                                                                          !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)          :: veget_max      !! PFT "Maximal" coverage fraction of a PFT defined in 
+                                                                          !! the input vegetation map 
+                                                                          !! @tex $(m^2 m^{-2})$ @endtex 
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts), INTENT(out)           :: deadleaf_cover !! Fraction of soil covered by dead leaves over all PFTs
+                                                                          !! (0-1, unitless)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                        :: dead_lai       !! LAI of dead leaves @tex $(m^2 m^{-2})$ @endtex
+    INTEGER(i_std)                                      :: j              !! Index (unitless)
+!_ ================================================================================================================================
+    
+  !! 1. LAI of dead leaves
+  
+    dead_lai(:) = zero
+
+    DO j = 2,nvm !Loop over PFTs
+       dead_lai(:) = dead_lai(:) + ( dead_leaves(:,j,imetabolic) + dead_leaves(:,j,istructural) ) * sla(j) &
+            * veget_max(:,j)
+    ENDDO
+
+  !! 2. fraction of soil covered by dead leaves
+
+    deadleaf_cover(:) = un - exp( - 0.5 * dead_lai(:) )
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving deadleaf'
+
+  END SUBROUTINE deadleaf
+
+
+!! ================================================================================================================================
+!! FUNCTION     : control_moist_func_moyano
+!!
+!>\BRIEF        Calculate moisture control for litter and soild C decomposition
+!!
+!! DESCRIPTION  : Calculate moisture control factor applied
+!! to litter decomposition and to soil carbon decomposition in
+!! stomate_soilcarbon.f90 using the following equation: \n
+!! \latexonly
+!! \input{control_moist_func1.tex}
+!! \endlatexonly
+!! \n
+!! with M the moisture control factor and soilmoisutre, the soil moisture 
+!! calculated in sechiba.
+!! Then, the function is ranged between 0.25 and 1:\n
+!! \latexonly
+!! \input{control_moist_func2.tex}
+!! \endlatexonly
+!! \n
+!! RECENT CHANGE(S) : None
+!!
+!! RETURN VALUE : ::moistfunc_result
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  FUNCTION control_moist_func_moyano (npts, moist_in,bulk_dens, clay, carbon,veget_max) RESULT (moistfunc_result)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)               :: npts                !! Domain size - number of grid pixel (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in) :: moist_in            !! relative humidity (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: clay               !! Clay fraction (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: bulk_dens          !! Variable local of bulk density for the moment must change in the futur (kg m-3)
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl,nelements), INTENT(in)     :: carbon   !! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                  :: veget_max          !! Maximum fraction of vegetation type including 
+                                                                                      !! non-biological fraction (unitless)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts)          :: moistfunc_result    !! Moisture control factor (0-1, unitless)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+   REAL(r_std), DIMENSION(npts)           :: total_soc              !! Total soil organic carbon for a grid pixel (g-C g-1 soil)
+   INTEGER(i_std)                         :: k,i,j                  !! Indices
+   INTEGER, PARAMETER                     :: nummoist = 120         !! We used numoist then divived by 100. because to calculate the function
+                                                                    !! we need to predict PRsr for all the possible soil moisture values
+   REAL(r_std), DIMENSION(npts,nummoist)  :: PRsr                   !! Proportional response or soil respiration at moist_in 
+   REAL(r_std), DIMENSION(npts,nummoist)  :: SR                     !! Soil respiration at moist_in to facilitate the understanding regarding 
+                                                                    !! the Moyano et al paper we keep the same nomenclature than in the paper
+                                                                    !! but **BE CAREFUL** it does not correspond to the variable resp_hetero_soil
+                                                                    !! or resp_hetero_litter in ORCHIDEE
+   REAL(r_std), DIMENSION(0:nbdl)   :: z_soil                 !! Soil levels (m)
+!$OMP THREADPRIVATE(z_soil)
+   REAL(r_std), DIMENSION(npts,nummoist)  :: moistfunc              !! An intermediate variable to calculate the Moisture control factor
+   INTEGER(i_std)                         :: ind                    !! A local variable to know what is the index of the max value for the statistical function
+   INTEGER(i_std), DIMENSION(npts)        :: ind_i                  !! A local variable to know what is the index of the max value for the 
+                                                                    !! statistical function at each points
+   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: moistfunc_below_1 !! A allocatable variable to store the value of moistfunc that are below the max value
+                                                                       !! to then rescale at is it done in Moyano et al. 2012 BG
+!$OMP THREADPRIVATE(moistfunc_below_1)
+   INTEGER(i_std)                         :: ier                    !! Check errors in netcdf call (unitless)
+   LOGICAL                                :: l_error                !! Check errors in netcdf call
+
+!_ ================================================================================================================================
+
+       !! 1.3 soil levels
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+    ! In Moyano et al. 2012 BG, the function obtained is based on soil 
+    ! incubations were litter is generally manually removed, therefore we used 
+    ! only the variable carbon corresponding to the soil organic carbon even
+    ! if some litter (metabolic litter) is not easy to remove manually since it
+    ! corresponds to roots exudates. Therefore, we probably underestimate a bit
+    ! the soil organic carbon compared to what is used in Moyano et al., 2012
+    ! BG.
+
+ PRsr(:,:) = zero
+ SR(:,:) = zero
+ moistfunc(:,:) = zero
+    l_error = .FALSE.
+
+    total_soc(:) = zero
+    DO k = 1,nvm
+       DO j = 1,nbdl
+       total_soc(:) =  total_soc(:) + &
+                      ((carbon(:,iactive,k,j,icarbon)*veget_max(:,k) + &
+                       carbon(:,islow,k,j,icarbon)*veget_max(:,k) + &
+                       carbon(:,ipassive,k,j,icarbon)*veget_max(:,k))* &
+                       ((z_soil(j)-z_soil(j-1))/z_soil(nbdl))) / &
+                      (bulk_dens(:) ) 
+       ENDDO
+    ENDDO
+
+     DO k = 1,nummoist
+
+        PRsr(:,k) = 1.11066-0.83344*(k/100.) + 1.48095*((k/100.)**2) - 1.02959*((k/100.)**3) + 0.07995*clay(:) + 1.27892*total_soc(:)
+
+     ENDDO
+
+        SR(:,1)=PRsr(:,1)
+     DO k=2,nummoist
+        SR(:,k)= SR(:,k-1)* PRsr(:,k)
+     ENDDO
+
+     DO i = 1,npts
+         DO k= 1, nummoist
+                moistfunc(i,k) = SR(i,k)/MAXVAL(SR(i,:))
+         ENDDO
+    ENDDO
+
+       ind_i(:) = MAXLOC(moistfunc(:,:),DIM=2)
+
+     DO i = 1,npts
+         ind=ind_i(i)
+
+    ALLOCATE(moistfunc_below_1(npts,ind),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for moistfunc_below_1. '
+    ENDIF
+
+         DO k= 1,ind
+            moistfunc_below_1(i,k)= moistfunc(i,k)
+         ENDDO
+
+         DO k= 1,ind           
+            moistfunc(i,k)=moistfunc(i,k) - MINVAL(moistfunc_below_1(i,:))
+         ENDDO
+
+         DO k= 1,ind
+            moistfunc_below_1(i,k)= moistfunc(i,k)
+         ENDDO
+
+         DO k=1,ind
+
+            moistfunc(i,k)=moistfunc(i,k)/MAXVAL(moistfunc_below_1(i,:))
+         ENDDO
+
+    IF (ALLOCATED(moistfunc_below_1)) DEALLOCATE(moistfunc_below_1)
+
+    ENDDO
+    DO i=1,npts
+               IF (NINT(moist_in(i)) .GT. zero) THEN
+               moistfunc_result(i) = moistfunc(i,NINT(moist_in(i)*100))
+               ELSE
+               moistfunc_result(i) = zero
+               ENDIF
+    ENDDO
+
+  END FUNCTION control_moist_func_moyano
+
+!! ================================================================================================================================
+!! FUNCTION     : control_moist_func
+!!
+!>\BRIEF        Calculate moisture control for litter and soild C decomposition
+!!
+!! DESCRIPTION  : Calculate moisture control factor applied
+!! to litter decomposition and to soil carbon decomposition in
+!! stomate_soilcarbon.f90 using the following equation: \n
+!! \latexonly
+!! \input{control_moist_func1.tex}
+!! \endlatexonly
+!! \n
+!! with M the moisture control factor and soilmoisutre, the soil moisture 
+!! calculated in sechiba.
+!! Then, the function is ranged between 0.25 and 1:\n
+!! \latexonly
+!! \input{control_moist_func2.tex}
+!! \endlatexonly
+!! \n
+!! RECENT CHANGE(S) : None
+!!
+!! RETURN VALUE : ::moistfunc_result
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION control_moist_func (npts, moist_in) RESULT (moistfunc_result)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)               :: npts                !! Domain size - number of grid pixel (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in) :: moist_in            !! relative humidity (unitless)
+
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts)          :: moistfunc_result    !! Moisture control factor (0-1, unitless)
+
+    !! 0.3 Modified variables
+
+
+!_ ================================================================================================================================
+
+
+          moistfunc_result(:) = -moist_coeff(1) * moist_in(:) * moist_in(:) + moist_coeff(2)* moist_in(:) - moist_coeff(3)
+          moistfunc_result(:) = MAX( 0.25_r_std, MIN( un, moistfunc_result(:) ) )
+    
+  END FUNCTION control_moist_func
+
+!! ================================================================================================================================
+!! FUNCTION     : control_temp_func
+!!
+!>\BRIEF        Calculate temperature control for litter and soild C decomposition
+!!
+!! DESCRIPTION  : Calculate temperature control factor applied
+!! to litter decomposition and to soil carbon decomposition in
+!! stomate_soilcarbon.f90 using the following equation: \n
+!! \latexonly
+!! \input{control_temp_func1.tex}
+!! \endlatexonly
+!! \n
+!! with T the temperature control factor, temp the temperature in Kelvin of 
+!! the air (for aboveground litter) or of the soil (for belowground litter 
+!! and soil)
+!! Then, the function is limited in its maximal range to 1:\n
+!! \latexonly
+!! \input{control_temp_func2.tex}
+!! \endlatexonly
+!! \n
+!! RECENT CHANGE(S) : None
+!!
+!! RETURN VALUE: ::tempfunc_result
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION control_temp_func (npts, temp_in,tau) RESULT (tempfunc_result)
+
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                 :: npts            !! Domain size - number of land pixels (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)   :: temp_in         !! Temperature (K)
+    REAL(r_std), INTENT(in)                    :: tau             !! residence time of the pool considered (days)
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts)               :: tempfunc_result !! Temperature control factor (0-1, unitless)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts)               :: Ea              !! Activation Energy 
+    REAL(r_std), DIMENSION(npts)               :: Q10_soil        !! Q10 values calculated based on Ea
+!_ ================================================================================================================================
+
+    ! This relationship is based on a reanalysis of the data published by LefÃšvre et al. 2014 in global change biology 
+    ! We use MAX(cent,(temp_in(:)-ZeroCelsius)*(temp_in(:)-ZeroCelsius)))) because for values between -10 and 10 degC
+    ! the Q10 values are close to infinity 
+   !Ea(:)=a_term_Q10_soil*log(tau) + b_term_Q10_soil
+    Ea(:)=a_term_Q10_soil*tau + b_term_Q10_soil
+
+    !Q10_soil(:)=exp((dix*Ea(:))/(RR*MAX(cent,(temp_in(:)-ZeroCelsius)*(temp_in(:)-ZeroCelsius))))
+    Q10_soil(:)=0.69
+    tempfunc_result(:) = exp( log(Q10_soil(:)) * ( temp_in(:) - (ZeroCelsius+tsoil_ref)) / Q10 )
+    tempfunc_result(:) = MIN( un, tempfunc_result(:) )
+    WHERE (temp_in(:) .LT. zero) 
+        tempfunc_result(:) = zero
+    ENDWHERE
+  END FUNCTION control_temp_func
+
+END MODULE stomate_litter
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_lpj.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_lpj.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_lpj.f90	(revision 5166)
@@ -0,0 +1,2073 @@
+! ================================================================================================================================
+! MODULE       : stomate_lpj
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Main entry point for daily processes in STOMATE and LPJ (phenology, 
+!! allocation, npp_calc, kill, turn, light, establish, crown, cover, lcchange)
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! SVN          :
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_lpj
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE xios_orchidee
+  USE grid
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE lpj_constraints
+  USE lpj_pftinout
+  USE lpj_kill
+  USE lpj_crown
+  USE lpj_fire
+  USE lpj_gap
+  USE lpj_light
+  USE lpj_establish
+  USE lpj_cover
+  USE stomate_prescribe
+  USE stomate_phenology
+  USE stomate_alloc
+  USE stomate_npp
+  USE stomate_turnover
+  USE stomate_litter
+  USE stomate_soilcarbon
+  USE stomate_vmax
+  USE stomate_lcchange
+!  USE Orch_Write_field_p
+
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC StomateLpj,StomateLpj_clear
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : StomateLpj_clear
+!!
+!>\BRIEF        Re-initialisation of variable
+!!
+!! DESCRIPTION  : This subroutine reinitializes variables. To be used if we want to relaunch 
+!! ORCHIDEE but the routine is not used in current version.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE StomateLpj_clear
+
+    CALL prescribe_clear
+    CALL phenology_clear
+    CALL npp_calc_clear
+    CALL turn_clear
+    CALL soilcarbon_clear
+    CALL constraints_clear
+    CALL establish_clear
+    CALL fire_clear
+    CALL gap_clear
+    CALL light_clear
+    CALL pftinout_clear
+    CALL alloc_clear
+  END SUBROUTINE StomateLpj_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : StomateLPJ
+!!
+!>\BRIEF        Main entry point for daily processes in STOMATE and LPJ, structures the call sequence 
+!!              to the different processes such as dispersion, establishment, competition and mortality of PFT's.
+!! 
+!! DESCRIPTION  : This routine is the main entry point to all processes calculated on a 
+!! daily time step. Is mainly devoted to call the different STOMATE and LPJ routines 
+!! depending of the ok_dgvm (is dynamic veg used) and lpj_constant_mortality (is background mortality used).
+!! It also prepares the cumulative 
+!! fluxes or pools (e.g TOTAL_M TOTAL_BM_LITTER etc...)
+!!
+!! This routine makes frequent use of "weekly", "monthly" and "long term" variables. Quotion is used because
+!! by default "weekly" denotes 7 days, by default "monthly" denotes 20 days and by default "Long term" denotes
+!! 3 years. dtslow refers to 24 hours (1 day).
+!!
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): All variables related to stomate and required for LPJ dynamic vegetation mode.
+!!
+!! REFERENCE(S) : 
+!! - Krinner, G., N. Viovy, N. de Noblet-DucoudrÃ©, J. OgeÃ©, J. Polcher, P. Friedlingstein, P. Ciais, S. Sitch, 
+!! and I. C. Prentice. 2005. A dynamic global vegetation model for studies of the coupled atmosphere-biosphere 
+!! system. Global Biogeochemical Cycles 19:GB1015, doi:1010.1029/2003GB002199.
+!! - Sitch, S., B. Smith, I. C. Prentice, A. Arneth, A. Bondeau, W. Cramer, J. O. Kaplan, S. Levis, W. Lucht, 
+!! M. T. Sykes, K. Thonicke, and S. Venevsky. 2003. Evaluation of ecosystem dynamics, plant geography and 
+!! terrestrial carbon cycling in the LPJ dynamic global vegetation model. Global Change Biology 9:161-185.
+!!
+!! FLOWCHART    : Update with existing flowchart from N Viovy (Jan 19, 2012)
+!! \n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE StomateLpj (npts, dt_days, &
+       neighbours, resolution, &
+       clay, herbivores, &
+       tsurf_daily, tsoil_daily, t2m_daily, t2m_min_daily, &
+       litterhum_daily, soilhum_daily, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       gdd0_lastyear, precip_lastyear, &
+       moiavail_month, moiavail_week, t2m_longterm, t2m_month, t2m_week, &
+       tsoil_month, soilhum_month, &
+       gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       turnover_longterm, gpp_daily, &
+       time_hum_min, maxfpc_lastyear, resp_maint_part, &
+       PFTpresent, age, fireindex, firelitter, &
+       leaf_age, leaf_frac, biomass, ind, adapted, regenerate, &
+       senescence, when_growthinit, &
+       litterpart, litter_above, litter_below, dead_leaves, carbon, DOC, DOC_EXP, & 
+       lignin_struc_above, &
+       veget_max, veget_max_new, npp_longterm, lm_lastyearmax, veget_lastlight, &
+       everywhere, need_adjacent, RIP_time, &
+       lai, rprof,npp_daily, turnover_daily, turnover_time,&
+       soilcarbon_input, co2_to_bm, co2_fire, resp_hetero, resp_maint, resp_growth, &
+       height, deadleaf_cover, vcmax, &
+       bm_to_litter, &
+       prod10,prod100,flux10, flux100, &
+       convflux,cflux_prod10,cflux_prod100, harvest_above, carb_mass_total, &
+       fpc_max, &
+       Tseason, Tmin_spring_time, begin_leaves, onset_date, moist_soil)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 input
+
+    INTEGER(i_std), INTENT(in)                                 :: npts                 !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                                    :: dt_days              !! Time step of Stomate (days)
+    INTEGER(i_std), DIMENSION(npts,8), INTENT(in)              :: neighbours           !! Indices of the 8 neighbours of each grid 
+                                                                                       !! point [1=N, 2=NE, 3=E, 4=SE,
+                                                                                       !!  5=S, 6=SW, 7=W, 8=NW] 
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)                 :: resolution           !! Resolution at each grid point (m)  
+                                                                                       !! [1=E-W, 2=N-S] 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: clay                 !! Clay fraction (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: herbivores           !! Time constant of probability of a leaf to 
+                                                                                       !! be eaten by a herbivore (days) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: tsurf_daily          !! Daily surface temperatures (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: tsoil_daily          !! Daily soil temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_daily            !! Daily 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_min_daily        !! Daily minimum 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: litterhum_daily      !! Daily litter humidity (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: soilhum_daily        !! Daily soil humidity (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: maxmoiavail_lastyear !! Last year's maximum moisture availability 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: minmoiavail_lastyear !! Last year's minimum moisture availability 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: gdd0_lastyear        !! Last year's GDD0 (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: precip_lastyear      !! Lastyear's precipitation 
+                                                                                       !! @tex $(mm year^{-1})$ @endtex
+										       !! to determine if establishment possible
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_month       !! "Monthly" moisture availability (0 to 1, 
+                                                                                       !! unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_week        !! "Weekly" moisture availability 
+                                                                                       !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_longterm         !! "Long term" 2 meter reference 
+                                                                                       !! temperatures (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_month            !! "Monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_week             !! "Weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: Tseason              !! "seasonal" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: Tmin_spring_time     !! Number of days after begin_leaves (leaf onset) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: onset_date           !! Date in the year at when the leaves started to grow(begin_leaves)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: tsoil_month          !! "Monthly" soil temperatures (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: soilhum_month        !! "Monthly" soil humidity
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: gdd_m5_dormance      !! Growing degree days (K), threshold -5 deg 
+                                                                                       !! C (for phenology) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: gdd_from_growthinit  !! growing degree days, since growthinit for crops
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: gdd_midwinter        !! Growing degree days (K), since midwinter 
+                                                                                       !! (for phenology) - this is written to the history files 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: ncd_dormance         !! Number of chilling days (days), since 
+                                                                                       !! leaves were lost (for phenology) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: ngd_minus5           !! Number of growing days (days), threshold 
+                                                                                       !! -5 deg C (for phenology) 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)        :: turnover_longterm    !! "Long term" turnover rate  
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: gpp_daily            !! Daily gross primary productivity  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: time_hum_min         !! Time elapsed since strongest moisture 
+                                                                                       !! availability (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: maxfpc_lastyear      !! Last year's maximum foliage projected
+                                                                                       !! coverage for each natural PFT,
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)        :: resp_maint_part      !! Maintenance respiration of different 
+                                                                                       !! plant parts  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: fpc_max              !! "Maximal" coverage fraction of a PFT (LAI 
+                                                                                       !! -> infinity) on ground  
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(in)                :: veget_max_new        !! Old timestep "maximal" coverage fraction of a PFT 
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,npool,nelements), INTENT(in) :: soilcarbon_input      !! Amount of carbon going into the DOC pools from litter decomposition \f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)             :: moist_soil            !! moisture in soil for one pixel (m3/m3)
+
+  !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: npp_daily            !! Net primary productivity 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: turnover_daily       !! Turnover rates 
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: co2_to_bm            !! CO2 taken up from atmosphere when 
+                                                                                       !! introducing a new PFT (introduced for 
+                                                                                       !! carbon balance closure) 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: co2_fire             !! Carbon emitted into the atmosphere by 
+                                                                                       !! fire (living and dead biomass)  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nelements), INTENT(inout)  :: resp_hetero          !! Heterotrophic respiration
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: resp_maint           !! Maintenance respiration  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: resp_growth          !! Growth respiration  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                :: deadleaf_cover       !! Fraction of soil covered by dead leaves 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax                !! Maximum rate of carboxylation 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out):: bm_to_litter      !! Conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(out)                  :: begin_leaves         !! signal to start putting leaves on (true/false)
+
+    !! 0.3 Modified variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: height               !! Height of vegetation (m) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: lai                  !! Leaf area index OF AN INDIVIDUAL PLANT,
+										       !! where a PFT contains n indentical plants
+										       !! i.e., using the mean individual approach 
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: rprof                !! Prescribed root depth (m) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)                :: PFTpresent           !! Tab indicating which PFTs are present in 
+                                                                                       !! each pixel 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: age                  !! Age (years)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: fireindex            !! Probability of fire (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: firelitter           !! Longer term litter above the ground that 
+                                                                                       !! can be burned, @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age             !! Leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac            !! Fraction of leaves in leaf age class, 
+                                                                                       !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! Biomass @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: ind                  !! Density of individuals 
+                                                                                       !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: adapted              !! Adaptation of PFT (killed if too cold) 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: regenerate           !! "Fitness": Winter sufficiently cold for 
+                                                                                       !! PFT regeneration ? (0 to 1, unitless) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)                :: senescence           !! Flag for setting senescence stage (only 
+                                                                                       !! for deciduous trees) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: when_growthinit      !! How many days ago was the beginning of 
+                                                                                       !! the growing season (days) 
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)      :: litterpart           !! Fraction of litter above the ground 
+                                                                                       !! belonging to different PFTs
+                                                                                       !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nlitt,nvm, nelements), INTENT(inout):: litter_above    !! Metabolic and structural litter, above ground 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements), INTENT(inout):: litter_below !! Metabolic and structural litter, below ground
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)      :: dead_leaves          !! Dead leaves on ground, per PFT, metabolic 
+                                                                                       !! and structural,  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl,nelements), INTENT(inout) :: carbon     !! Carbon pool: active, slow, or passive, 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements), INTENT(inout) :: DOC   !! Dissolved Organic Carbon in soil
+                                                                                       !! The unit is given by m^2 of ground
+                                                                                       !! @tex $(gC m{-2} of ground)$ @endtex
+        REAL(r_std), DIMENSION(npts,nvm,nexp,nelements), INTENT(inout) :: DOC_EXP      !! Exported Dissolved Organic Carbon from soil
+                                                                                       !! The unit is given by m^2 of ground
+                                                                                       !! @tex $(gC m{-2} of ground) $ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: lignin_struc_above   !! Ratio of Lignin/Carbon in structural 
+                                                                                       !! litter, above ground,  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: veget_max            !! "Maximal" coverage fraction of a PFT (LAI 
+                                                                                       !! -> infinity) on ground 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: npp_longterm         !! "Long term" mean yearly primary 
+                                                                                       !! productivity 
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: lm_lastyearmax       !! Last year's maximum leaf mass, for each 
+                                                                                       !! PFT @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: veget_lastlight      !! Vegetation fractions (on ground) after 
+                                                                                       !! last light competition  
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: everywhere           !! Is the PFT everywhere in the grid box or 
+                                                                                       !! very localized (after its introduction) 
+                                                                                       !! (unitless) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)                :: need_adjacent        !! In order for this PFT to be introduced, 
+                                                                                       !! does it have to be present in an 
+                                                                                       !! adjacent grid box? 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: RIP_time             !! How much time ago was the PFT eliminated 
+                                                                                       !! for the last time (y) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: turnover_time        !! Turnover_time of leaves for grasses 
+                                                                                       !! (days)
+    REAL(r_std),DIMENSION(npts,0:10), INTENT(inout)            :: prod10               !! Products remaining in the 10
+                                                                                       !! year-turnover pool after the annual 
+                                                                                       !! release for each compartment (10
+                                                                                       !! + 1 : input from year of land cover 
+                                                                                       !! change) @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,0:100), INTENT(inout)           :: prod100              !! Products remaining in the 100 
+                                                                                       !! year-turnover pool after the annual 
+                                                                                       !! release for each compartment (100 
+                                                                                       !! + 1 : input from year of land cover 
+                                                                                       !! change) @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,10), INTENT(inout)              :: flux10               !! Annual release from the 10
+                                                                                       !! year-turnover pool compartments  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,100), INTENT(inout)             :: flux100              !! Annual release from the 100 
+                                                                                       !! year-turnover pool compartments  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts), INTENT(inout)                 :: convflux             !! Release during first year following land 
+                                                                                       !! cover change @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts), INTENT(inout)                 :: cflux_prod10         !! Total annual release from the 10 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts), INTENT(inout)                 :: cflux_prod100        !! Total annual release from the 100 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                :: harvest_above        !! Harvest above ground biomass for 
+                                                                                       !! agriculture @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                :: carb_mass_total      !! Carbon Mass total (soil, litter, veg) 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex  
+   
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: tot_bm_to_litter    !! Total conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: tot_live_biomass    !! Total living biomass  
+                                                                                       !! @tex $(gC m{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements)           :: bm_alloc            !! Biomass increase, i.e. NPP per plant part 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: tot_turnover        !! Total turnover rate  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,nelements)             :: tot_litter_soil_carb!! Total soil and litter carbon  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,nelements)             :: tot_litter_carb     !! Total litter carbon 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,nelements)             :: tot_soil_carb       !! Total soil carbon  
+   
+    REAL(r_std), DIMENSION(npts)                                :: carb_mass_variation !! Carbon Mass variation  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: cn_ind              !! Crown area of individuals 
+                                                                                       !! @tex $(m^{2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: woodmass_ind        !! Woodmass of individuals (gC) 
+    REAL(r_std), DIMENSION(npts,nvm,nparts)                     :: f_alloc             !! Fraction that goes into plant part 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: avail_tree          !! Space availability for trees 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: avail_grass         !! Space availability for grasses 
+                                                                                       !! (0 to 1, unitless) 
+    INTEGER                                                     :: j,k,l,m
+    REAL(r_std),DIMENSION(npts)                                 :: prod10_total        !! Total products remaining in the pool 
+                                                                                       !! after the annual release 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts)                                 :: prod100_total       !! Total products remaining in the pool 
+                                                                                       !! after the annual release 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts)                                 :: cflux_prod_total    !! Total flux from conflux and the 10/100 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(npts,nvm)                             :: veget_max_tmp       !! "Maximal" coverage fraction of a PFT  
+                                                                                       !! (LAI-> infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: mortality           !! Fraction of individual dying this time 
+                                                                                       !! step (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: vartmp              !! Temporary variable used to add history
+    REAL(r_std), DIMENSION(npts,nbdl)                           :: var_tmp             !! Temporary variable used to add history
+    REAL(r_std), DIMENSION(npts,nvm)                            :: tmp_var             !! Temporary variable used to add history
+    REAL(r_std), DIMENSION(npts,nvm)                            :: histvar             !! History variables
+    REAL(r_std), DIMENSION(0:nbdl)                              :: z_soil              !! Variable to store depth of the different
+                                                                                       !! soil layers (m)
+   REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl)	        :: F_Pool   	 	       !! Modern Fraction : Ratio of the isotopic ratio 14C/Ctotal of a sample to the isotopic 									                       !! ratio 14C/Ctotal of the reference (stuiver and polach, 1977), for each carbon pool: active, 											       !! slow, or passive,and per soil depth \f$unitless$\f
+   REAL(r_std), DIMENSION(npts,nvm,nbdl)    		:: F_Mean   	               !! Modern Fraction: Mean Ratio of the isotopic ratio 14C/Ctotal of a sample to the 											       !!isotopic ratio 14C/Ctotal of the reference, per soil depth          											       !! \f$unitless$\f
+  REAL(r_std), DIMENSION(npts,nvm,nbdl)    		:: pMC   	               !! Percentage of Modern Carbon (%)
+  REAL(r_std), DIMENSION(npts,nvm,nbdl)    		:: age_14C   	               !! carbon14 age (years Bp)
+  REAL(r_std), DIMENSION(npts,nvm,nbdl)    		:: delta_14C   	               !! delta carbon14 (per mil)
+
+
+   REAL(r_std), DIMENSION(npts,nvm,nbdl,npool,nelements):: DOC_local 		       !! Dissolved Organic Carbon in soil
+                                                                                       !! The unit is given by m^2 of ground
+                                                                                       !! @tex $(gC m{-2} of ground)$ @endtex
+    
+   REAL(r_std), DIMENSION(npts,nvm,nbdl,npool)	        :: F_Pool_DOC   	       !! Ratio of the isotopic ratio 14C/Ctotal of a sample to the isotopic 									                       !! ratio 14C/Ctotal of the reference, for each carbon pool: active, 											       !! slow, or passive,and per soil depth \f$unitless$\f
+   REAL(r_std), DIMENSION(npts,nvm,nbdl)    		:: F_Mean_DOC 	               !! Mean Ratio of the isotopic ratio 14C/Ctotal of a sample to the 											       !!isotopic ratio 14C/Ctotal of the reference, per soil depth          											       !! \f$unitless$\f
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering stomate_lpj'
+
+  
+  !! 1. Initializations
+    
+    !! 1.1 Initialize variables to zero
+    co2_to_bm(:,:) = zero
+    co2_fire(:,:) = zero
+    npp_daily(:,:) = zero
+    resp_maint(:,:) = zero
+    resp_growth(:,:) = zero
+    harvest_above(:) = zero
+    bm_to_litter(:,:,:,:) = zero
+    cn_ind(:,:) = zero
+    woodmass_ind(:,:) = zero
+    turnover_daily(:,:,:,:) = zero
+
+       !! 1.1.1 Copy the depth of the different soil layers (number of layers=nbdl) 
+       !        previously calculated as variable diaglev in routines sechiba.f90 and slowproc.f90  
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+    
+    !! 1.2  Initialize variables to veget_max
+    veget_max_tmp(:,:) = veget_max(:,:)
+
+    !! 1.3 Calculate some vegetation characteristics
+    
+    !! 1.3.1 Calculate some vegetation characteristics 
+    !        Calculate cn_ind (individual crown mass) and individual height from
+    !        state variables if running DGVM or dynamic mortality in static cover mode
+    !??        Explain (maybe in the header once) why you mulitply with veget_max in the DGVM
+    !??        and why you don't multiply with veget_max in stomate.
+    IF ( ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN
+       IF(ok_dgvm) THEN
+          WHERE (ind(:,:).GT.min_stomate)
+             woodmass_ind(:,:) = &
+                  ((biomass(:,:,isapabove,icarbon)+biomass(:,:,isapbelow,icarbon) &
+                  +biomass(:,:,iheartabove,icarbon)+biomass(:,:,iheartbelow,icarbon)) & 
+                  *veget_max(:,:))/ind(:,:)
+          ENDWHERE
+       ELSE
+          WHERE (ind(:,:).GT.min_stomate)
+             woodmass_ind(:,:) = &
+                  (biomass(:,:,isapabove,icarbon)+biomass(:,:,isapbelow,icarbon) &
+                  +biomass(:,:,iheartabove,icarbon)+biomass(:,:,iheartbelow,icarbon))/ind(:,:)
+          ENDWHERE
+       ENDIF
+
+       CALL crown (npts,  PFTpresent, &
+            ind, biomass, woodmass_ind, &
+            veget_max, cn_ind, height)
+    ENDIF
+
+
+    !! 1.3.2 Prescribe characteristics if the vegetation is not dynamic
+    !        IF the DGVM is not activated, the density of individuals and their crown
+    !        areas don't matter, but they should be defined for the case we switch on
+    !        the DGVM afterwards. At the first call, if the DGVM is not activated, 
+    !        impose a minimum biomass for prescribed PFTs and declare them present.
+    CALL prescribe (npts, &
+         veget_max, dt_days, PFTpresent, everywhere, when_growthinit, &
+         biomass, leaf_frac, ind, cn_ind, co2_to_bm)
+
+
+  !! 2. Climatic constraints for PFT presence and regenerativeness
+
+    !   Call this even when DGVM is not activated so that "adapted" and "regenerate"
+    !   are kept up to date for the moment when the DGVM is activated.
+    CALL constraints (npts, dt_days, &
+         t2m_month, t2m_min_daily,when_growthinit, Tseason, &
+         adapted, regenerate)
+
+    
+  !! 3. Determine introduction and elimination of PTS based on climate criteria
+ 
+    IF ( ok_dgvm ) THEN
+      
+       !! 3.1 Calculate introduction and elimination
+       CALL pftinout (npts, dt_days, adapted, regenerate, &
+            neighbours, veget_max, &
+            biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, &
+            PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, &
+            co2_to_bm, &
+            avail_tree, avail_grass)
+
+       !! 3.2 Reset attributes for eliminated PFTs.
+       !     This also kills PFTs that had 0 leafmass during the last year. The message
+       !     "... after pftinout" is misleading in this case.
+       CALL kill (npts, 'pftinout  ', lm_lastyearmax, &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_max, bm_to_litter)
+
+       
+       !! 3.3 Calculate new crown area and diameter 
+       !      Calculate new crown area, diameter and maximum vegetation cover**[No longer used in the subroutine]
+       !      unsure whether this is really required
+       !      - in theory this could ONLY be done at the END of stomate_lpj
+       !      calculate woodmass of individual tree
+       WHERE ((ind(:,:).GT.min_stomate))
+          WHERE  ( veget_max(:,:) .GT. min_stomate)
+             woodmass_ind(:,:) = &
+                  ((biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) &
+                  + biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon))*veget_max(:,:))/ind(:,:)
+          ELSEWHERE
+             woodmass_ind(:,:) =(biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) &
+                  + biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon))/ind(:,:)
+          ENDWHERE
+
+       ENDWHERE
+       
+       ! Calculate crown area and diameter for all PFTs (including the newly established)
+       CALL crown (npts, PFTpresent, &
+            ind, biomass, woodmass_ind, &
+            veget_max, cn_ind, height)
+
+    ENDIF
+    
+  !! 4. Phenology
+
+    !! 4.1 Write values to history file
+    !      Current values for ::when_growthinit 
+    CALL xios_orchidee_send_field("WHEN_GROWTHINIT",when_growthinit)
+
+    CALL histwrite_p (hist_id_stomate, 'WHEN_GROWTHINIT', itime, when_growthinit, npts*nvm, horipft_index)
+
+    ! Set and write values for ::PFTpresent
+    WHERE(PFTpresent)
+       histvar=un
+    ELSEWHERE
+       histvar=zero
+    ENDWHERE
+
+    CALL xios_orchidee_send_field("PFTPRESENT",histvar)
+
+    CALL histwrite_p (hist_id_stomate, 'PFTPRESENT', itime, histvar, npts*nvm, horipft_index)
+
+    ! Set and write values for gdd_midwinter
+    WHERE(gdd_midwinter.EQ.undef)
+       histvar=val_exp
+    ELSEWHERE
+       histvar=gdd_midwinter
+    ENDWHERE
+
+    CALL xios_orchidee_send_field("GDD_MIDWINTER",histvar)
+
+    CALL histwrite_p (hist_id_stomate, 'GDD_MIDWINTER', itime, histvar, npts*nvm, horipft_index)
+
+    ! Set and write values for gdd_m5_dormance
+    WHERE(gdd_m5_dormance.EQ.undef)
+       histvar=val_exp
+    ELSEWHERE
+       histvar=gdd_m5_dormance
+    ENDWHERE
+    
+    CALL xios_orchidee_send_field('GDD_M5_DORMANCE',histvar)
+    CALL histwrite_p (hist_id_stomate, 'GDD_M5_DORMANCE', itime, histvar, npts*nvm, horipft_index)
+
+    ! Set and write values for ncd_dormance
+    WHERE(ncd_dormance.EQ.undef)
+       histvar=val_exp
+    ELSEWHERE
+       histvar=ncd_dormance
+    ENDWHERE
+
+    CALL xios_orchidee_send_field("NCD_DORMANCE",histvar)
+
+    CALL histwrite_p (hist_id_stomate, 'NCD_DORMANCE', itime, histvar, npts*nvm, horipft_index)
+
+    !! 4.2 Calculate phenology
+    CALL phenology (npts, dt_days, PFTpresent, &
+         veget_max, &
+         t2m_longterm, t2m_month, t2m_week, gpp_daily, &
+         maxmoiavail_lastyear, minmoiavail_lastyear, &
+         moiavail_month, moiavail_week, &
+         gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+         senescence, time_hum_min, &
+         biomass, leaf_frac, leaf_age, &
+         when_growthinit, co2_to_bm, &
+         begin_leaves)
+    
+  !! 5. Allocate C to different plant parts
+    
+    CALL alloc (npts, dt_days, &
+         lai, veget_max, senescence, when_growthinit, &
+         moiavail_week, tsoil_month, soilhum_month, &
+         biomass, age, leaf_age, leaf_frac, rprof, f_alloc)
+
+  !! 6. NPP, maintenance and growth respiration
+
+    !! 6.1 Calculate NPP and respiration terms
+    CALL npp_calc (npts, dt_days, &
+         PFTpresent, &
+         t2m_daily, tsoil_daily, lai, rprof, &
+         gpp_daily, f_alloc, bm_alloc, resp_maint_part,&
+         biomass, leaf_age, leaf_frac, age, &
+         resp_maint, resp_growth, npp_daily)
+
+    !! 6.2 Kill slow growing PFTs in DGVM or STOMATE with constant mortality
+    IF ( ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN
+       CALL kill (npts, 'npp       ', lm_lastyearmax,  &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_max, bm_to_litter)
+
+       !! 6.2.1 Update wood biomass      
+       !        For the DGVM
+       IF(ok_dgvm) THEN
+          WHERE (ind(:,:).GT.min_stomate)
+             woodmass_ind(:,:) = &
+                  ((biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) &
+                  + biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon)) & 
+                  *veget_max(:,:))/ind(:,:)
+          ENDWHERE
+
+       ! For all pixels with individuals
+       ELSE
+          WHERE (ind(:,:).GT.min_stomate)
+             woodmass_ind(:,:) = &
+                  (biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) &
+                  + biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon))/ind(:,:)
+          ENDWHERE
+       ENDIF ! ok_dgvm
+
+       !! 6.2.2 New crown area and maximum vegetation cover after growth
+       CALL crown (npts, PFTpresent, &
+            ind, biomass, woodmass_ind,&
+            veget_max, cn_ind, height)
+
+    ENDIF ! ok_dgvm
+    
+  !! 7. fire
+
+    !! 7.1. Burn PFTs
+    CALL fire (npts, dt_days, litterpart, &
+         litterhum_daily, t2m_daily, lignin_struc_above, veget_max, &
+         fireindex, firelitter, biomass, ind, &
+         litter_above, dead_leaves, bm_to_litter, &
+         co2_fire)
+
+    !! 7.2 Kill PFTs in DGVM
+    IF ( ok_dgvm ) THEN
+
+       ! reset attributes for eliminated PFTs
+       CALL kill (npts, 'fire      ', lm_lastyearmax, &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_max, bm_to_litter)
+
+    ENDIF ! ok_dgvm
+ 
+  !! 8. Tree mortality
+
+    ! Does not depend on age, therefore does not change crown area.
+    CALL gap (npts, dt_days, &
+         npp_longterm, turnover_longterm, lm_lastyearmax, &
+         PFTpresent, t2m_min_daily, Tmin_spring_time, &
+         biomass, ind, bm_to_litter, mortality)
+
+
+    IF ( ok_dgvm ) THEN
+
+       ! reset attributes for eliminated PFTs
+       CALL kill (npts, 'gap       ', lm_lastyearmax, &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_max, bm_to_litter)
+
+    ENDIF
+
+  !! 9. Calculate vcmax 
+
+    CALL vmax (npts, dt_days, &
+         leaf_age, leaf_frac, &
+         vcmax)
+
+  !! 10. Leaf senescence, new lai and other turnover processes
+
+    CALL turn (npts, dt_days, PFTpresent, &
+         herbivores, &
+         maxmoiavail_lastyear, minmoiavail_lastyear, &
+         moiavail_week,  moiavail_month,t2m_longterm, t2m_month, t2m_week, veget_max, &
+         gdd_from_growthinit, leaf_age, leaf_frac, age, lai, biomass, &
+         turnover_daily, senescence,turnover_time)
+
+    !! 11. Light competition
+    
+    !! If not using constant mortality then kill with light competition
+!    IF ( ok_dgvm .OR. .NOT.(lpj_gap_const_mort) ) THEN
+    IF ( ok_dgvm ) THEN
+ 
+       !! 11.1 Light competition
+       CALL light (npts, dt_days, &
+            veget_max, fpc_max, PFTpresent, cn_ind, lai, maxfpc_lastyear, &
+            lm_lastyearmax, ind, biomass, veget_lastlight, bm_to_litter, mortality)
+       
+       !! 11.2 Reset attributes for eliminated PFTs
+       CALL kill (npts, 'light     ', lm_lastyearmax, &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_max, bm_to_litter)
+
+    ENDIF
+
+    
+  !! 12. Establishment of saplings
+    
+    IF ( ok_dgvm .OR. .NOT.lpj_gap_const_mort ) THEN
+
+       !! 12.1 Establish new plants
+       CALL establish (npts, dt_days, PFTpresent, regenerate, &
+            neighbours, resolution, need_adjacent, herbivores, &
+            precip_lastyear, gdd0_lastyear, lm_lastyearmax, &
+            cn_ind, lai, avail_tree, avail_grass, npp_longterm, &
+            leaf_age, leaf_frac, &
+            ind, biomass, age, everywhere, co2_to_bm, veget_max, woodmass_ind, &
+            mortality, bm_to_litter)
+
+       !! 12.2 Calculate new crown area (and maximum vegetation cover)
+       CALL crown (npts, PFTpresent, &
+            ind, biomass, woodmass_ind, &
+            veget_max, cn_ind, height)
+
+    ENDIF
+
+  !! 13. Calculate final LAI and vegetation cover
+    
+    CALL cover (npts, cn_ind, ind, biomass, &
+         veget_max, veget_max_tmp, lai, &
+         litter_above, litter_below, carbon, DOC, turnover_daily, bm_to_litter, &
+         co2_to_bm, co2_fire, resp_hetero, resp_maint, resp_growth, gpp_daily, moist_soil)
+
+  !! 14. Update litter pools to account for harvest
+ 
+    ! the whole litter stuff:
+    !    litter update, lignin content, PFT parts, litter decay, 
+    !    litter heterotrophic respiration, dead leaf soil cover.
+    !    No vertical discretisation in the soil for litter decay.\n
+    ! added by shilong for harvest
+    IF(harvest_agri) THEN
+       CALL harvest(npts, dt_days, veget_max, &
+            bm_to_litter, turnover_daily, &
+            harvest_above)
+    ENDIF
+
+    !! 15. Land cover change if it is time to do so
+    !! The flag do_now_lcchange is set in slowproc_main at the same time as the vegetation is read from file.
+    !! The vegetation fractions are not updated yet and will be updated in the end of sechiba_main.
+    IF (do_now_stomate_lcchange) THEN
+       CALL lcchange_main (npts, dt_days, veget_max, veget_max_new, &
+            biomass, ind, age, PFTpresent, senescence, when_growthinit, everywhere, &
+            co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, cn_ind,flux10,flux100, &
+            prod10,prod100,convflux,cflux_prod10,cflux_prod100,leaf_frac,&
+            npp_longterm, lm_lastyearmax, litter_above, litter_below, carbon, &
+            DOC, moist_soil)
+       do_now_stomate_lcchange=.FALSE.
+
+       ! Set the flag done_stomate_lcchange to be used in the end of sechiba_main to update the fractions.
+       done_stomate_lcchange=.TRUE.
+    ENDIF
+    !MM dÃ©placement pour initialisation correcte des grandeurs cumulÃ©es :
+    cflux_prod_total(:) = convflux(:) + cflux_prod10(:) + cflux_prod100(:)
+    prod10_total(:)=SUM(prod10,dim=2)
+    prod100_total(:)=SUM(prod100,dim=2)
+    
+  !! 16. Total heterotrophic respiration
+
+    tot_soil_carb(:,:,:,:) = zero
+    tot_litter_carb(:,:,:,:) = zero
+    DO j=2,nvm
+          !tot_litter_carb(:,j,1,icarbon) = tot_litter_carb(:,j,1,icarbon) + &
+          !     &          litter_above(:,istructural,j,icarbon) + litter_above(:,imetabolic,j,icarbon)
+
+	  !tot_litter_carb(:,j,1,icarbon14) = tot_litter_carb(:,j,1,icarbon) 
+       DO l=1,nbdl
+          tot_litter_carb(:,j,l,icarbon) = tot_litter_carb(:,j,l,icarbon) + &
+               &          litter_below(:,istructural,j,l,icarbon) + litter_below(:,imetabolic,j,l,icarbon)
+
+          tot_litter_carb(:,j,l,icarbon14) =  tot_litter_carb(:,j,l,icarbon14) + &
+               &          litter_below(:,istructural,j,l,icarbon14) + litter_below(:,imetabolic,j,l,icarbon14)
+
+      ENDDO
+
+       DO l=1,nbdl
+
+          tot_soil_carb(:,j,l,icarbon) = tot_soil_carb(:,j,l,icarbon) + (carbon(:,iactive,j,l,icarbon) + &
+               &          carbon(:,islow,j,l,icarbon) + carbon(:,ipassive,j,l,icarbon)) 
+	  tot_soil_carb(:,j,l,icarbon14) = tot_soil_carb(:,j,l,icarbon14) + (carbon(:,iactive,j,l,icarbon14) + &
+               &          carbon(:,islow,j,l,icarbon14) + carbon(:,ipassive,j,l,icarbon14)) 
+       ENDDO
+
+     DO k =1,npool
+       DO l=1,nbdl
+
+          tot_soil_carb(:,j,l,icarbon) = tot_soil_carb(:,j,l,icarbon) + &
+               &          (DOC(:,j,l,ifree,k,icarbon) + DOC(:,j,l,iadsorbed,k,icarbon))
+          tot_soil_carb(:,j,l,icarbon14) = tot_soil_carb(:,j,l,icarbon14) + &
+               &          (DOC(:,j,l,ifree,k,icarbon14) + DOC(:,j,l,iadsorbed,k,icarbon14))
+       ENDDO
+
+    ENDDO
+
+    ENDDO 
+
+    tot_litter_soil_carb(:,:,:,:) = tot_litter_carb(:,:,:,:) + tot_soil_carb(:,:,:,:)
+
+!!$     DO k = 1, nelements ! Loop over # elements
+!!$        tot_live_biomass(:,:,k) = biomass(:,:,ileaf,k) + biomass(:,:,isapabove,k) + biomass(:,:,isapbelow,k) +&
+!!$             &                    biomass(:,:,iheartabove,k) + biomass(:,:,iheartbelow,k) + &
+!!$             &                    biomass(:,:,iroot,k) + biomass(:,:,ifruit,k) + biomass(:,:,icarbres,k)
+!!$    END DO ! Loop over # elements
+
+    tot_live_biomass(:,:,icarbon) = biomass(:,:,ileaf,icarbon) + biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) +&
+             &                    biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon) + &
+             &                    biomass(:,:,iroot,icarbon) + biomass(:,:,ifruit,icarbon) + biomass(:,:,icarbres,icarbon)
+    tot_live_biomass(:,:,icarbon14) = tot_live_biomass(:,:,icarbon)
+
+
+    tot_turnover(:,:,icarbon) = turnover_daily(:,:,ileaf,icarbon) + turnover_daily(:,:,isapabove,icarbon) + &
+         &         turnover_daily(:,:,isapbelow,icarbon) + turnover_daily(:,:,iheartabove,icarbon) + &
+         &         turnover_daily(:,:,iheartbelow,icarbon) + turnover_daily(:,:,iroot,icarbon) + &
+         &         turnover_daily(:,:,ifruit,icarbon) + turnover_daily(:,:,icarbres,icarbon)
+    tot_turnover(:,:,icarbon14) =tot_turnover(:,:,icarbon) 
+
+   
+    tot_bm_to_litter(:,:,icarbon) = bm_to_litter(:,:,ileaf,icarbon) + bm_to_litter(:,:,isapabove,icarbon) +&
+         &             bm_to_litter(:,:,isapbelow,icarbon) + bm_to_litter(:,:,iheartbelow,icarbon) +&
+         &             bm_to_litter(:,:,iheartabove,icarbon) + bm_to_litter(:,:,iroot,icarbon) + &
+         &             bm_to_litter(:,:,ifruit,icarbon) + bm_to_litter(:,:,icarbres,icarbon)
+
+    tot_bm_to_litter(:,:,icarbon14) =tot_bm_to_litter(:,:,icarbon) 
+
+    carb_mass_variation(:)=-carb_mass_total(:)
+  DO k=1,nvm
+    DO l= 1,nbdl
+      carb_mass_total(:)=carb_mass_total(:)+ tot_live_biomass(:,k,icarbon)*veget_max(:,k)+&
+           &                 (tot_litter_carb(:,k,l,icarbon)+tot_soil_carb(:,k,l,icarbon))*veget_max(:,k)*(z_soil(l)/z_soil(nbdl)) + &
+           &                 (prod10_total + prod100_total)
+    ENDDO
+  ENDDO
+    carb_mass_variation(:)=carb_mass_total(:)+carb_mass_variation(:)
+
+!! Calculation of the ratio F (F_Pool) per pool and per soil depth and then the mean value of this ratio F (F_Mean) per soil depth 
+
+F_Pool(:,:,:,:) = zero
+
+	
+	DO m=1,nvm
+		DO l = 1, nbdl !Loop over soil layers
+	
+       F_Pool(:,iactive,m,l) = F_Pool(:,iactive,m,l) +  carbon(:,iactive,m,l,icarbon14)
+       F_Pool(:,iactive,m,l) = F_Pool(:,iactive,m,l)* (un/ MAX(min_stomate, carbon(:,iactive,m,l,icarbon)))		
+ 	F_Pool(:,islow,m,l) =   F_Pool(:,islow,m,l) + carbon(:,islow,m,l,icarbon14)
+	F_Pool(:,islow,m,l) =   F_Pool(:,islow,m,l)* (un / MAX(min_stomate, carbon(:,islow,m,l,icarbon)))
+	 F_Pool(:,ipassive,m,l) =   F_Pool(:,ipassive,m,l) + carbon(:,ipassive,m,l,icarbon14)
+	 F_Pool(:,ipassive,m,l) =   F_Pool(:,ipassive,m,l)* (un / MAX(min_stomate, carbon(:,ipassive,m,l,icarbon)))
+
+      		ENDDO ! End of loop over carbon pools
+	ENDDO
+
+F_Mean(:,:,:) =zero     
+      
+          
+	DO m=1,nvm
+ 		DO l = 1, nbdl !Loop over soil layers
+	
+       F_Mean(:,m,l) =  (F_Pool(:,iactive,m,l)*carbon(:,iactive,m,l,icarbon14) + F_Pool(:,islow,m,l)*carbon(:,islow,m,l,icarbon14) +F_Pool(:,ipassive,m,l)*carbon(:,ipassive,m,l,icarbon14)) / &
+			(MAX(min_stomate,(carbon(:,iactive,m,l,icarbon) + carbon(:,islow,m,l,icarbon) + carbon(:,ipassive,m,l,icarbon)))) 
+	
+     		ENDDO ! End of loop over soil layers
+	ENDDO
+
+!! Calculation of the pMC, age AND DELTA 14C per soil depth 
+
+pMC(:,:,:) =zero 
+age_14C(:,:,:) =zero 
+delta_14C(:,:,:) =zero 
+
+	DO j=2,nvm
+		DO k =1,nbdl
+
+pMC(:,j,k) = (F_Mean(:,j,k)/exp((year-1950.0)/(5730.0/log10(2.0)))) * 100.0
+	
+age_14C(:,j,k)= -(5568.0/log10(2.0)) * log10(MAX(min_stomate,F_Mean(:,j,k)))
+
+delta_14C(:,j,k) = ( (F_Mean(:,j,k)/exp((year-1950.0)/(5730.0/log10(2.0)))) -1.0 ) * 1000.0
+		ENDDO
+	ENDDO
+
+
+!! Calculation of the ratio F (F_Pool) per pool and per soil depth and then the mean value of this ratio F (F_Mean) per soil depth for the dissolved organic matter
+
+DOC_local(:,:,:,:,:)= zero
+
+ DO j=2,nvm
+	 DO k =1,npool
+		DO l=1,nbdl
+
+DOC_local(:,j,l,k,icarbon)=DOC_local(:,j,l,k,icarbon)+DOC(:,j,l,ifree,k,icarbon)
+DOC_local(:,j,l,k,icarbon14)=DOC_local(:,j,l,k,icarbon14)+DOC(:,j,l,ifree,k,icarbon14)
+
+DOC_local(:,j,l,k,icarbon)=DOC_local(:,j,l,k,icarbon)+DOC(:,j,l,iadsorbed,k,icarbon)
+DOC_local(:,j,l,k,icarbon14)=DOC_local(:,j,l,k,icarbon14)+DOC(:,j,l,iadsorbed,k,icarbon14)
+ 		ENDDO
+	ENDDO
+ ENDDO
+
+F_Pool_DOC(:,:,:,:) = zero
+
+  	DO m=2,nvm	
+		Do j=1,npool
+			DO l = 1, nbdl !Loop over soil layers
+	
+       F_Pool_DOC(:,m,l,j) = F_Pool_DOC(:,m,l,j)+  DOC_local(:,m,l,j,icarbon14)
+       F_Pool_DOC(:,m,l,j) = F_Pool_DOC(:,m,l,j)* (un/ MAX(min_stomate, DOC_local(:,m,l,j,icarbon)))		
+ 	
+	
+			ENDDO      		
+		ENDDO 
+	ENDDO
+
+F_Mean_DOC(:,:,:) =zero     
+      
+DO m=2,nvm 
+	Do j=1,npool 
+		DO l = 1, nbdl !Loop over soil layers
+	
+       F_Mean_DOC(:,m,l)=  (F_Pool_DOC(:,m,l,iact)*DOC_local(:,m,l,iact,icarbon14) + F_Pool_DOC(:,m,l,islo)*DOC_local(:,m,l,islo,icarbon14) +F_Pool_DOC(:,m,l,ipas)*DOC_local(:,m,l,ipas,icarbon14)+F_Pool_DOC(:,m,l,imetabo)*DOC_local(:,m,l,imetabo,icarbon14)+F_Pool_DOC(:,m,l,istrabo)*DOC_local(:,m,l,istrabo,icarbon14)+F_Pool_DOC(:,m,l,imetbel)*DOC_local(:,m,l,imetbel,icarbon14)+F_Pool_DOC(:,m,l,istrbel)*DOC_local(:,m,l,istrbel,icarbon14)) / &
+			(MAX(min_stomate,(DOC_local(:,m,l,iact,icarbon)+DOC_local(:,m,l,islo,icarbon)+DOC_local(:,m,l,ipas,icarbon)+DOC_local(:,m,l,imetabo,icarbon)+DOC_local(:,m,l,istrabo,icarbon)+DOC_local(:,m,l,imetbel,icarbon)+DOC_local(:,m,l,istrbel,icarbon)))) 
+	
+     		ENDDO ! End of loop over soil layers
+	ENDDO
+ENDDO
+
+
+   
+  !! 17. Write history
+
+    CALL xios_orchidee_send_field("RESOLUTION_X",resolution(:,1))
+    CALL xios_orchidee_send_field("RESOLUTION_Y",resolution(:,2))
+    CALL xios_orchidee_send_field("CONTFRAC_STOMATE",contfrac(:))
+    CALL xios_orchidee_send_field("T2M_MONTH",t2m_month)
+    CALL xios_orchidee_send_field("T2M_WEEK",t2m_week)
+    CALL xios_orchidee_send_field("TSEASON",Tseason)
+    CALL xios_orchidee_send_field("TMIN_SPRING_TIME", Tmin_spring_time)
+    CALL xios_orchidee_send_field("ONSET_DATE",onset_date)
+    CALL xios_orchidee_send_field("FPC_MAX",fpc_max)
+    CALL xios_orchidee_send_field("MAXFPC_LASTYEAR",maxfpc_lastyear)
+    CALL xios_orchidee_send_field("HET_RESP",resp_hetero(:,:,icarbon))
+    CALL xios_orchidee_send_field("CO2_FIRE",co2_fire)
+    CALL xios_orchidee_send_field("CO2_TAKEN",co2_to_bm)
+    CALL xios_orchidee_send_field("LAI",lai)
+    CALL xios_orchidee_send_field("VEGET_MAX",veget_max)
+    CALL xios_orchidee_send_field("NPP_STOMATE",npp_daily)
+    CALL xios_orchidee_send_field("GPP",gpp_daily)
+    CALL xios_orchidee_send_field("IND",ind)
+    CALL xios_orchidee_send_field("CN_IND",cn_ind)
+    CALL xios_orchidee_send_field("WOODMASS_IND",woodmass_ind)
+    CALL xios_orchidee_send_field("TOTAL_M",tot_live_biomass(:,:,icarbon))
+    CALL xios_orchidee_send_field("MOISTRESS",moiavail_week)
+    CALL xios_orchidee_send_field("LEAF_M",biomass(:,:,ileaf,icarbon))
+    CALL xios_orchidee_send_field("SAP_M_AB",biomass(:,:,isapabove,icarbon))
+    CALL xios_orchidee_send_field("SAP_M_BE",biomass(:,:,isapbelow,icarbon))
+    CALL xios_orchidee_send_field("HEART_M_AB",biomass(:,:,iheartabove,icarbon))
+    CALL xios_orchidee_send_field("HEART_M_BE",biomass(:,:,iheartbelow,icarbon))
+    CALL xios_orchidee_send_field("ROOT_M",biomass(:,:,iroot,icarbon))
+    CALL xios_orchidee_send_field("FRUIT_M",biomass(:,:,ifruit,icarbon))
+    CALL xios_orchidee_send_field("RESERVE_M",biomass(:,:,icarbres,icarbon))
+    CALL xios_orchidee_send_field("TOTAL_TURN",tot_turnover(:,:,icarbon))
+    CALL xios_orchidee_send_field("LEAF_TURN",turnover_daily(:,:,ileaf,icarbon))
+    CALL xios_orchidee_send_field("MAINT_RESP",resp_maint)
+    CALL xios_orchidee_send_field("GROWTH_RESP",resp_growth)
+    CALL xios_orchidee_send_field("SAP_AB_TURN",turnover_daily(:,:,isapabove,icarbon))
+    CALL xios_orchidee_send_field("ROOT_TURN",turnover_daily(:,:,iroot,icarbon))
+    CALL xios_orchidee_send_field("FRUIT_TURN",turnover_daily(:,:,ifruit,icarbon))
+    CALL xios_orchidee_send_field("TOTAL_BM_LITTER",tot_bm_to_litter(:,:,icarbon))
+    CALL xios_orchidee_send_field("LEAF_BM_LITTER",bm_to_litter(:,:,ileaf,icarbon))
+    CALL xios_orchidee_send_field("SAP_AB_BM_LITTER",bm_to_litter(:,:,isapabove,icarbon))
+    CALL xios_orchidee_send_field("SAP_BE_BM_LITTER",bm_to_litter(:,:,isapbelow,icarbon))
+    CALL xios_orchidee_send_field("HEART_AB_BM_LITTER",bm_to_litter(:,:,iheartabove,icarbon))
+    CALL xios_orchidee_send_field("HEART_BE_BM_LITTER",bm_to_litter(:,:,iheartbelow,icarbon))
+    CALL xios_orchidee_send_field("ROOT_BM_LITTER",bm_to_litter(:,:,iroot,icarbon))
+    CALL xios_orchidee_send_field("FRUIT_BM_LITTER",bm_to_litter(:,:,ifruit,icarbon))
+    CALL xios_orchidee_send_field("RESERVE_BM_LITTER",bm_to_litter(:,:,icarbres,icarbon))
+    CALL xios_orchidee_send_field("LITTER_STR_AB",litter_above(:,istructural,:,icarbon))
+    CALL xios_orchidee_send_field("LITTER_MET_AB",litter_above(:,imetabolic,:,icarbon))
+var_tmp(:,:)=zero
+
+ DO l= 1,nvm
+   var_tmp(:,1)=var_tmp(:,1)+litter_below(:,istructural,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+
+ DO j= 2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+litter_below(:,istructural,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("LITTER_STR_BE",var_tmp(:,:))
+var_tmp(:,:)=zero
+ DO l= 1,nvm
+   var_tmp(:,1)=var_tmp(:,1)+litter_below(:,imetabolic,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+litter_below(:,imetabolic,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("LITTER_MET_BE",var_tmp(:,:))
+    CALL xios_orchidee_send_field("DEADLEAF_COVER",deadleaf_cover)
+
+
+var_tmp(:,:)=zero
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+tot_litter_soil_carb(:,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+tot_litter_soil_carb(:,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("TOTAL_SOIL_CARB",var_tmp(:,:))
+
+
+var_tmp(:,:)=zero
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+tot_litter_soil_carb(:,l,1,icarbon14)*veget_max(:,l)/z_soil(1)
+ ENDDO
+
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+tot_litter_soil_carb(:,l,j,icarbon14)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("TOTAL_SOIL_CARB14",var_tmp(:,:))
+
+
+var_tmp(:,:)=zero
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,iactive,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,iactive,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("CARBON_ACTIVE",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,iactive,l,1,icarbon14)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,iactive,l,j,icarbon14)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("CARBON14_ACTIVE",var_tmp(:,:))
+
+
+var_tmp(:,:)=zero
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,islow,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j= 2,nbdl
+   DO l=1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,islow,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("CARBON_SLOW",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,islow,l,1,icarbon14)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j= 2,nbdl
+   DO l=1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,islow,l,j,icarbon14)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("CARBON14_SLOW",var_tmp(:,:))
+ 
+
+
+var_tmp(:,:)=zero
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,ipassive,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j= 2,nbdl
+   DO l=1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,ipassive,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("CARBON_PASSIVE",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,ipassive,l,1,icarbon14)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j= 2,nbdl
+   DO l=1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,ipassive,l,j,icarbon14)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("CARBON14_PASSIVE",var_tmp(:,:))
+ 
+
+
+var_tmp(:,:)=zero
+ 
+DO j=1,nbdl
+ DO l= 1,nvm
+ var_tmp(:,j)=var_tmp(:,j)+F_Pool(:,iactive,l,j)*veget_max(:,l)
+ ENDDO
+ENDDO
+    CALL xios_orchidee_send_field("F_Pool_ACTIVE",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ 
+DO j=1,nbdl
+  DO l= 1,nvm
+  var_tmp(:,j)=var_tmp(:,j)+F_Pool(:,islow,l,j)*veget_max(:,l)
+  ENDDO
+ENDDO
+  CALL xios_orchidee_send_field("F_Pool_SLOW",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ 
+DO j=1,nbdl
+ DO l= 1,nvm
+ var_tmp(:,j)=var_tmp(:,j)+F_Pool(:,ipassive,l,j)*veget_max(:,l)
+ ENDDO
+ENDDO
+    CALL xios_orchidee_send_field("F_Pool_PASSIVE",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ 
+ DO j=1,nbdl
+  DO l= 1,nvm
+  var_tmp(:,j)=var_tmp(:,j)+F_Mean(:,l,j)*veget_max(:,l)
+ ENDDO
+ ENDDO
+   CALL xios_orchidee_send_field("F_MEAN",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ 
+ DO j=1,nbdl
+  DO l= 1,nvm
+  var_tmp(:,j)=var_tmp(:,j)+pMC(:,l,j)*veget_max(:,l)
+ ENDDO
+ ENDDO
+   CALL xios_orchidee_send_field("pMC",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ 
+ DO j=1,nbdl
+  DO l= 1,nvm
+  var_tmp(:,j)=var_tmp(:,j)+age_14C(:,l,j)*veget_max(:,l)
+ ENDDO
+ ENDDO
+   CALL xios_orchidee_send_field("age_14C",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ 
+ DO j=1,nbdl
+  DO l= 1,nvm
+  var_tmp(:,j)=var_tmp(:,j)+delta_14C(:,l,j)*veget_max(:,l)
+ ENDDO
+ ENDDO
+   CALL xios_orchidee_send_field("delta_14C",var_tmp(:,:))
+
+
+
+var_tmp(:,:)=zero
+ 
+DO j=1,nbdl
+ DO l= 1,nvm
+ var_tmp(:,j)=var_tmp(:,j)+F_Pool_DOC(:,l,j,iact)*veget_max(:,l)
+ ENDDO
+ENDDO
+    CALL xios_orchidee_send_field("F_Pool_ACT_DOC",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ 
+DO j=1,nbdl
+ DO l= 1,nvm
+ var_tmp(:,j)=var_tmp(:,j)+F_Pool_DOC(:,l,j,islo)*veget_max(:,l)
+ ENDDO
+ENDDO
+    CALL xios_orchidee_send_field("F_Pool_SLO_DOC",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ 
+DO j=1,nbdl
+ DO l= 1,nvm
+ var_tmp(:,j)=var_tmp(:,j)+F_Pool_DOC(:,l,j,ipas)*veget_max(:,l)
+ ENDDO
+ENDDO
+    CALL xios_orchidee_send_field("F_Pool_PAS_DOC",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ 
+DO j=1,nbdl
+ DO l= 1,nvm
+ var_tmp(:,j)=var_tmp(:,j)+F_Pool_DOC(:,l,j,imetabo)*veget_max(:,l)
+ ENDDO
+ENDDO
+    CALL xios_orchidee_send_field("F_Pool_abmet_DOC",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ 
+DO j=1,nbdl
+ DO l= 1,nvm
+ var_tmp(:,j)=var_tmp(:,j)+F_Pool_DOC(:,l,j,istrabo)*veget_max(:,l)
+ ENDDO
+ENDDO
+    CALL xios_orchidee_send_field("F_Pool_abstr_DOC",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+ 
+DO j=1,nbdl
+ DO l= 1,nvm
+ var_tmp(:,j)=var_tmp(:,j)+F_Pool_DOC(:,l,j,imetbel)*veget_max(:,l)
+ ENDDO
+ENDDO
+    CALL xios_orchidee_send_field("F_Pool_bemet_DOC",var_tmp(:,:))
+
+
+var_tmp(:,:)=zero
+ 
+DO j=1,nbdl
+ DO l= 1,nvm
+ var_tmp(:,j)=var_tmp(:,j)+F_Pool_DOC(:,l,j,istrbel)*veget_max(:,l)
+ ENDDO
+ENDDO
+    CALL xios_orchidee_send_field("F_Pool_bestr_DOC",var_tmp(:,:))
+
+
+
+var_tmp(:,:)=zero
+ 
+ DO j=1,nbdl
+  DO l= 1,nvm
+  var_tmp(:,j)=var_tmp(:,j)+F_Mean_DOC(:,l,j)*veget_max(:,l)
+ ENDDO
+ ENDDO
+   CALL xios_orchidee_send_field("F_MEAN_DOC",var_tmp(:,:))
+
+
+	
+var_tmp(:,:)=zero
+   DO l=1,nvm
+     DO k= 1,npool
+    var_tmp(:,1)=var_tmp(:,1)+DOC(:,l,1,ifree,k,icarbon)*veget_max(:,l)/ &
+                              (z_soil(1))
+     ENDDO
+   ENDDO
+
+ DO j= 2,nbdl
+   DO l=1,nvm
+     DO k= 1,npool
+    var_tmp(:,j)=var_tmp(:,j)+DOC(:,l,j,ifree,k,icarbon)*veget_max(:,l)/ &
+                              (z_soil(j)-z_soil(j-1))
+     ENDDO
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("FREE_DOC",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+   DO l=1,nvm
+     DO k= 1,npool
+    var_tmp(:,1)=var_tmp(:,1)+DOC(:,l,1,ifree,k,icarbon14)*veget_max(:,l)/ &
+                              (z_soil(1))
+     ENDDO
+   ENDDO
+
+ DO j= 2,nbdl
+   DO l=1,nvm
+     DO k= 1,npool
+    var_tmp(:,j)=var_tmp(:,j)+DOC(:,l,j,ifree,k,icarbon14)*veget_max(:,l)/ &
+                              (z_soil(j)-z_soil(j-1))
+     ENDDO
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("FREE_DOC14",var_tmp(:,:))
+
+
+var_tmp(:,:)=zero
+   DO l=1,nvm
+     DO k=1,npool
+    var_tmp(:,1)=var_tmp(:,1)+DOC(:,l,1,iadsorbed,k,icarbon)*veget_max(:,l)/ &
+                              (z_soil(1))
+
+     ENDDO
+   ENDDO
+
+ DO j= 2,nbdl
+   DO l=1,nvm
+     DO k=1,npool
+    var_tmp(:,j)=var_tmp(:,j)+DOC(:,l,j,iadsorbed,k,icarbon)*veget_max(:,l)/ &
+                              (z_soil(j)-z_soil(j-1))
+
+     ENDDO
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("ADSORBED_DOC",var_tmp(:,:))
+
+var_tmp(:,:)=zero
+   DO l=1,nvm
+     DO k=1,npool
+    var_tmp(:,1)=var_tmp(:,1)+DOC(:,l,1,iadsorbed,k,icarbon14)*veget_max(:,l)/ &
+                              (z_soil(1))
+
+     ENDDO
+   ENDDO
+
+ DO j= 2,nbdl
+   DO l=1,nvm
+     DO k=1,npool
+    var_tmp(:,j)=var_tmp(:,j)+DOC(:,l,j,iadsorbed,k,icarbon14)*veget_max(:,l)/ &
+                              (z_soil(j)-z_soil(j-1))
+
+     ENDDO
+   ENDDO
+ ENDDO
+    CALL xios_orchidee_send_field("ADSORBED_DOC14",var_tmp(:,:))
+
+    CALL xios_orchidee_send_field("EXPORTED_DOC_RUNOFF",DOC_EXP(:,:,irunoff,icarbon))
+    CALL xios_orchidee_send_field("EXPORTED_DOC_DRAIN",DOC_EXP(:,:,idrainage,icarbon))
+    CALL xios_orchidee_send_field("EXPORTED_DOC_FLOOD",DOC_EXP(:,:,iflooded,icarbon))
+    CALL xios_orchidee_send_field("LITTERHUM",litterhum_daily)
+    CALL xios_orchidee_send_field("TURNOVER_TIME",turnover_time)
+    CALL xios_orchidee_send_field("PROD10",prod10)
+    CALL xios_orchidee_send_field("FLUX10",flux10)
+    CALL xios_orchidee_send_field("PROD100",prod100)
+    CALL xios_orchidee_send_field("FLUX100",flux100)
+    CALL xios_orchidee_send_field("CONVFLUX",convflux)
+    CALL xios_orchidee_send_field("CFLUX_PROD10",cflux_prod10)
+    CALL xios_orchidee_send_field("CFLUX_PROD100",cflux_prod100)
+    CALL xios_orchidee_send_field("HARVEST_ABOVE",harvest_above)
+    CALL xios_orchidee_send_field("VCMAX",vcmax)
+    CALL xios_orchidee_send_field("AGE",age)
+    CALL xios_orchidee_send_field("HEIGHT",height)
+    CALL xios_orchidee_send_field("FIREINDEX",fireindex(:,:))
+! ipcc history
+     CALL xios_orchidee_send_field("cVeg",SUM(tot_live_biomass(:,:,icarbon)*veget_max,dim=2)/1e3*contfrac)
+     !CALL xios_orchidee_send_field("cLitter",SUM(tot_litter_carb*veget_max,dim=2)/1e3*contfrac)
+     !CALL xios_orchidee_send_field("cSoil",SUM(tot_soil_carb*veget_max,dim=2)/1e3*contfrac)
+     CALL xios_orchidee_send_field("cProduct",(prod10_total + prod100_total)/1e3)
+     CALL xios_orchidee_send_field("cMassVariation",carb_mass_variation/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("lai_ipcc",SUM(lai*veget_max,dim=2)*contfrac)
+     CALL xios_orchidee_send_field("gpp_ipcc",SUM(gpp_daily*veget_max,dim=2)/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("ra",SUM((resp_maint+resp_growth)*veget_max,dim=2)/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("npp_ipcc",SUM(npp_daily*veget_max,dim=2)/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("rh",SUM(resp_hetero(:,:,icarbon)*veget_max,dim=2)/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("fFire",SUM(co2_fire*veget_max,dim=2)/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("fHarvest",harvest_above/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("fLuc",cflux_prod_total/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("nbp",(SUM((gpp_daily-(resp_maint+resp_growth+resp_hetero(:,:,icarbon))-co2_fire) &
+            &        *veget_max,dim=2)-cflux_prod_total-harvest_above)/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("fVegLitter",SUM((tot_bm_to_litter(:,:,icarbon) + tot_turnover(:,:,icarbon))*&
+          veget_max,dim=2)/1e3/one_day*contfrac)
+     !CALL xios_orchidee_send_field("fLitterSoil",SUM(SUM(soilcarbon_input,dim=2)*veget_max,dim=2)/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("cLeaf",SUM(biomass(:,:,ileaf,icarbon)*veget_max,dim=2)/1e3*contfrac)
+     CALL xios_orchidee_send_field("cWood",SUM((biomass(:,:,isapabove,icarbon)+biomass(:,:,iheartabove,icarbon))*&
+          veget_max,dim=2)/1e3*contfrac)
+     CALL xios_orchidee_send_field("cRoot",SUM(( biomass(:,:,iroot,icarbon) + biomass(:,:,isapbelow,icarbon) + &
+          biomass(:,:,iheartbelow,icarbon) )*veget_max,dim=2)/1e3*contfrac)
+     CALL xios_orchidee_send_field("cMisc",SUM(( biomass(:,:,icarbres,icarbon) + biomass(:,:,ifruit,icarbon))*&
+          veget_max,dim=2)/1e3*contfrac)
+     !CALL xios_orchidee_send_field("cLitterAbove",SUM((litter(:,istructural,:,iabove,icarbon)+&
+     !     litter(:,imetabolic,:,iabove,icarbon))*veget_max,dim=2)/1e3*contfrac)
+     !CALL xios_orchidee_send_field("cLitterBelow",SUM((litter(:,istructural,:,ibelow,icarbon)+&
+     !     litter(:,imetabolic,:,ibelow,icarbon))*veget_max,dim=2)/1e3*contfrac)
+     !CALL xios_orchidee_send_field("cSoilFast",SUM(carbon(:,iactive,:)*veget_max,dim=2)/1e3*contfrac)
+     !CALL xios_orchidee_send_field("cSoilMedium",SUM(carbon(:,islow,:)*veget_max,dim=2)/1e3*contfrac)
+     !CALL xios_orchidee_send_field("cSoilSlow",SUM(carbon(:,ipassive,:)*veget_max,dim=2)/1e3*contfrac)
+       DO j=1,nvm
+          histvar(:,j)=veget_max(:,j)*contfrac(:)*100
+       ENDDO
+     CALL xios_orchidee_send_field("landCoverFrac",histvar)
+       vartmp(:)=zero
+       DO j = 2,nvm
+          IF (is_deciduous(j)) THEN
+             vartmp(:) = vartmp(:) + veget_max(:,j)*contfrac*100
+          ENDIF
+       ENDDO
+     CALL xios_orchidee_send_field("treeFracPrimDec",vartmp)
+       vartmp(:)=zero
+       DO j = 2,nvm
+          IF (is_evergreen(j)) THEN
+             vartmp(:) = vartmp(:) + veget_max(:,j)*contfrac*100
+          ENDIF
+       ENDDO
+     CALL xios_orchidee_send_field("treeFracPrimEver",vartmp)
+       vartmp(:)=zero
+       DO j = 2,nvm
+          IF ( .NOT.(is_c4(j)) ) THEN
+             vartmp(:) = vartmp(:) + veget_max(:,j)*contfrac*100
+          ENDIF
+       ENDDO
+     CALL xios_orchidee_send_field("c3PftFrac",vartmp)
+       vartmp(:)=zero
+       DO j = 2,nvm
+          IF ( is_c4(j) ) THEN
+             vartmp(:) = vartmp(:) + veget_max(:,j)*contfrac*100
+          ENDIF
+       ENDDO
+     CALL xios_orchidee_send_field("c4PftFrac",vartmp)
+     CALL xios_orchidee_send_field("rGrowth",SUM(resp_growth*veget_max,dim=2)/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("rMaint",SUM(resp_maint*veget_max,dim=2)/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("nppLeaf",SUM(bm_alloc(:,:,ileaf,icarbon)*veget_max,dim=2)/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("nppWood",SUM(bm_alloc(:,:,isapabove,icarbon)*veget_max,dim=2)/1e3/one_day*contfrac)
+     CALL xios_orchidee_send_field("nppRoot",SUM(( bm_alloc(:,:,isapbelow,icarbon) + bm_alloc(:,:,iroot,icarbon) )*&
+          veget_max,dim=2)/1e3/one_day*contfrac)     
+
+IF (.NOT. xios_orchidee_ok) THEN
+    CALL histwrite_p (hist_id_stomate, 'RESOLUTION_X', itime, &
+         resolution(:,1), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'RESOLUTION_Y', itime, &
+         resolution(:,2), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CONTFRAC', itime, &
+         contfrac(:), npts, hori_index)
+
+
+    CALL histwrite_p (hist_id_stomate, 'LITTER_STR_AB', itime, &
+         litter_above(:,istructural,:,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LITTER_MET_AB', itime, &
+         litter_above(:,imetabolic,:,icarbon), npts*nvm, horipft_index)
+
+ var_tmp(:,:)=zero
+
+ DO l= 1,nvm
+   var_tmp(:,1)=var_tmp(:,1)+litter_below(:,istructural,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+
+ DO j= 2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+litter_below(:,istructural,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'LITTER_STR_BE', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+ DO l= 1,nvm   
+   var_tmp(:,1)=var_tmp(:,1)+litter_below(:,imetabolic,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+litter_below(:,imetabolic,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'LITTER_MET_BE', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+
+    CALL histwrite_p (hist_id_stomate, 'DEADLEAF_COVER', itime, &
+         deadleaf_cover, npts, hori_index)
+ var_tmp(:,:)=zero
+
+
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+tot_litter_soil_carb(:,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+tot_litter_soil_carb(:,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'TOTAL_SOIL_CARB', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+tot_litter_soil_carb(:,l,1,icarbon14)*veget_max(:,l)/z_soil(1)
+ ENDDO
+
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+tot_litter_soil_carb(:,l,j,icarbon14)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'TOTAL_SOIL_CARB14', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+
+
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,iactive,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,iactive,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'CARBON_ACTIVE', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,iactive,l,1,icarbon14)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,iactive,l,j,icarbon14)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'CARBON14_ACTIVE', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+
+
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,islow,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j= 2,nbdl
+   DO l=1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,islow,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'CARBON_SLOW', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+
+DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,islow,l,1,icarbon14)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j= 2,nbdl
+   DO l=1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,islow,l,j,icarbon14)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'CARBON14_SLOW', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+
+
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,ipassive,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j= 2,nbdl
+   DO l=1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,ipassive,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'CARBON_PASSIVE', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+
+DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,ipassive,l,1,icarbon14)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j= 2,nbdl
+   DO l=1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,ipassive,l,j,icarbon14)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'CARBON14_PASSIVE', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+
+
+   DO l=1,nvm
+     DO k= 1,npool
+    var_tmp(:,1)=var_tmp(:,1)+DOC(:,l,1,ifree,k,icarbon)*veget_max(:,l)/ &
+                              (z_soil(1))
+     ENDDO
+   ENDDO
+
+ DO j= 2,nbdl
+   DO l=1,nvm
+     DO k= 1,npool
+    var_tmp(:,j)=var_tmp(:,j)+DOC(:,l,j,ifree,k,icarbon)*veget_max(:,l)/ &
+                              (z_soil(j)-z_soil(j-1))
+     ENDDO
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'FREE_DOC', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ 
+ var_tmp(:,:)=zero
+
+DO l=1,nvm
+     DO k= 1,npool
+    var_tmp(:,1)=var_tmp(:,1)+DOC(:,l,1,ifree,k,icarbon14)*veget_max(:,l)/ &
+                              (z_soil(1))
+     ENDDO
+   ENDDO
+
+ DO j= 2,nbdl
+   DO l=1,nvm
+     DO k= 1,npool
+    var_tmp(:,j)=var_tmp(:,j)+DOC(:,l,j,ifree,k,icarbon14)*veget_max(:,l)/ &
+                              (z_soil(j)-z_soil(j-1))
+     ENDDO
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'FREE_DOC14', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ 
+ var_tmp(:,:)=zero
+
+
+   DO l=1,nvm
+     DO k=1,npool
+    var_tmp(:,1)=var_tmp(:,1)+DOC(:,l,1,iadsorbed,k,icarbon)*veget_max(:,l)/ &
+                              (z_soil(1))
+   
+     ENDDO
+   ENDDO
+
+ DO j= 2,nbdl
+   DO l=1,nvm
+     DO k=1,npool
+    var_tmp(:,j)=var_tmp(:,j)+DOC(:,l,j,iadsorbed,k,icarbon)*veget_max(:,l)/ &
+                              (z_soil(j)-z_soil(j-1))
+
+     ENDDO
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'ADSORBED_DOC', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+
+   var_tmp(:,:)=zero
+ DO l=1,nvm
+     DO k=1,npool
+    var_tmp(:,1)=var_tmp(:,1)+DOC(:,l,1,iadsorbed,k,icarbon14)*veget_max(:,l)/ &
+                              (z_soil(1))
+   
+     ENDDO
+   ENDDO
+
+ DO j= 2,nbdl
+   DO l=1,nvm
+     DO k=1,npool
+    var_tmp(:,j)=var_tmp(:,j)+DOC(:,l,j,iadsorbed,k,icarbon14)*veget_max(:,l)/ &
+                              (z_soil(j)-z_soil(j-1))
+
+     ENDDO
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'ADSORBED_DOC14', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+
+
+    CALL histwrite_p (hist_id_stomate, 'EXPORTED_DOC_RUNOFF', itime, &
+         DOC_EXP(:,:,irunoff,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'EXPORTED_DOC_DRAIN', itime, &
+         DOC_EXP(:,:,idrainage,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'EXPORTED_DOC_FLOOD', itime, &
+         DOC_EXP(:,:,iflooded,icarbon), npts*nvm, horipft_index)
+!    DO l=1,nvm
+!    tmp_var(:,j)=(DOC_EXP(:,l,iflooded, icarbon)+DOC_EXP(:,l,irunoff,icarbon))
+!    ENDDO
+!    CALL histwrite_p (hist_id_stomate, 'EXPORTED_DOC_STOCK', itime, &
+!         tmp_var(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'T2M_MONTH', itime, &
+         t2m_month, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'T2M_WEEK', itime, &
+         t2m_week, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'TSEASON', itime, &
+         Tseason, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'TMIN_SPRING_TIME', itime, &
+         Tmin_spring_time, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ONSET_DATE', itime, &
+         onset_date(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FPC_MAX', itime, &
+         fpc_max, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'MAXFPC_LASTYEAR', itime, &
+         maxfpc_lastyear, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HET_RESP', itime, &
+         resp_hetero(:,:,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FIREINDEX', itime, &
+         fireindex(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LITTERHUM', itime, &
+         litterhum_daily, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CO2_FIRE', itime, &
+         co2_fire, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'CO2_TAKEN', itime, &
+         co2_to_bm, npts*nvm, horipft_index)
+    ! land cover change
+    CALL histwrite_p (hist_id_stomate, 'CONVFLUX', itime, &
+         convflux, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CFLUX_PROD10', itime, &
+         cflux_prod10, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CFLUX_PROD100', itime, &
+         cflux_prod100, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'HARVEST_ABOVE', itime, &
+         harvest_above, npts, hori_index)
+
+    CALL histwrite_p (hist_id_stomate, 'LAI', itime, &
+         lai, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'VEGET_MAX', itime, &
+         veget_max, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'NPP', itime, &
+         npp_daily, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'GPP', itime, &
+         gpp_daily, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'IND', itime, &
+         ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'CN_IND', itime, &
+         cn_ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'WOODMASS_IND', itime, &
+         woodmass_ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'TOTAL_M', itime, &
+         tot_live_biomass(:,:,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LEAF_M', itime, &
+         biomass(:,:,ileaf,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_M_AB', itime, &
+         biomass(:,:,isapabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_M_BE', itime, &
+         biomass(:,:,isapbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEART_M_AB', itime, &
+         biomass(:,:,iheartabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEART_M_BE', itime, &
+         biomass(:,:,iheartbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ROOT_M', itime, &
+         biomass(:,:,iroot,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FRUIT_M', itime, &
+         biomass(:,:,ifruit,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'RESERVE_M', itime, &
+         biomass(:,:,icarbres,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'TOTAL_TURN', itime, &
+         tot_turnover(:,:,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LEAF_TURN', itime, &
+         turnover_daily(:,:,ileaf,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_AB_TURN', itime, &
+         turnover_daily(:,:,isapabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ROOT_TURN', itime, &
+         turnover_daily(:,:,iroot,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FRUIT_TURN', itime, &
+         turnover_daily(:,:,ifruit,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'TOTAL_BM_LITTER', itime, &
+         tot_bm_to_litter(:,:,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LEAF_BM_LITTER', itime, &
+         bm_to_litter(:,:,ileaf,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_AB_BM_LITTER', itime, &
+         bm_to_litter(:,:,isapabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_BE_BM_LITTER', itime, &
+         bm_to_litter(:,:,isapbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEART_AB_BM_LITTER', itime, &
+         bm_to_litter(:,:,iheartabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEART_BE_BM_LITTER', itime, &
+         bm_to_litter(:,:,iheartbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ROOT_BM_LITTER', itime, &
+         bm_to_litter(:,:,iroot,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FRUIT_BM_LITTER', itime, &
+         bm_to_litter(:,:,ifruit,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'RESERVE_BM_LITTER', itime, &
+         bm_to_litter(:,:,icarbres,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'MAINT_RESP', itime, &
+         resp_maint, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'GROWTH_RESP', itime, &
+         resp_growth, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AGE', itime, &
+         age, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEIGHT', itime, &
+         height, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'MOISTRESS', itime, &
+         moiavail_week, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'VCMAX', itime, &
+         vcmax, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'TURNOVER_TIME', itime, &
+         turnover_time, npts*nvm, horipft_index)
+    ! land cover change
+    CALL histwrite_p (hist_id_stomate, 'PROD10', itime, &
+         prod10, npts*11, horip11_index)
+    CALL histwrite_p (hist_id_stomate, 'PROD100', itime, &
+         prod100, npts*101, horip101_index)
+    CALL histwrite_p (hist_id_stomate, 'FLUX10', itime, &
+         flux10, npts*10, horip10_index)
+    CALL histwrite_p (hist_id_stomate, 'FLUX100', itime, &
+         flux100, npts*100, horip100_index)
+
+    IF ( hist_id_stomate_IPCC > 0 ) THEN
+       vartmp(:)=SUM(tot_live_biomass(:,:,icarbon)*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cVeg", itime, &
+            vartmp, npts, hori_index)
+       DO l=1,nbdl
+            var_tmp(:,l)=SUM(tot_litter_carb(:,:,l,icarbon)*veget_max,dim=2)/1e3*contfrac
+       ENDDO
+             vartmp(:)=vartmp(:)+var_tmp(:,1)*(z_soil(1)/z_soil(nbdl))
+
+       DO l=2,nbdl
+             vartmp(:)=vartmp(:)+var_tmp(:,l)*((z_soil(l)-z_soil(l-1))/z_soil(nbdl))
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "cLitter", itime, &
+            vartmp, npts, hori_index)
+       DO l=1,nbdl
+            var_tmp(:,l)=SUM(tot_soil_carb(:,:,l,icarbon)*veget_max,dim=2)/1e3*contfrac
+       ENDDO
+             vartmp(:)=vartmp(:)+var_tmp(:,1)*(z_soil(1)/z_soil(nbdl))
+
+       DO l=2,nbdl
+             vartmp(:)=vartmp(:)+var_tmp(:,l)*((z_soil(l)-z_soil(l-1))/z_soil(nbdl))
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "cSoil", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=(prod10_total + prod100_total)/1e3
+       CALL histwrite_p (hist_id_stomate_IPCC, "cProduct", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=carb_mass_variation/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cMassVariation", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(lai*veget_max,dim=2)*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "lai", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(gpp_daily*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "gpp", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM((resp_maint+resp_growth)*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "ra", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(npp_daily*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "npp", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_hetero(:,:,icarbon)*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "rh", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2_fire*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "fFire", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=harvest_above/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "fHarvest", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=cflux_prod_total/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "fLuc", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=(SUM((gpp_daily-(resp_maint+resp_growth+resp_hetero(:,:,icarbon))-co2_fire) &
+            &        *veget_max,dim=2)-cflux_prod_total-harvest_above)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "nbp", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM((tot_bm_to_litter(:,:,icarbon) + tot_turnover(:,:,icarbon))*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "fVegLitter", itime, &
+            vartmp, npts, hori_index)
+       DO l=2,nbdl
+        DO k=1,nvm
+         DO j=1,4 !just the litter pools are used
+          vartmp(:)=SUM(soilcarbon_input(:,k,l,j,icarbon)*veget_max(:,k)*((z_soil(l)-z_soil(l-1))/z_soil(nbdl)))/1e3/one_day*contfrac
+         ENDDO
+        ENDDO
+       ENDDO
+        DO k=1,nvm
+         DO j=1,4 !just the litter pools are used
+          vartmp(:)=vartmp(:) + SUM(soilcarbon_input(:,k,1,j,icarbon)*veget_max(:,k)*((z_soil(1))/z_soil(nbdl)))/1e3/one_day*contfrac
+         ENDDO
+        ENDDO
+
+       CALL histwrite_p (hist_id_stomate_IPCC, "fLitterSoil", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(biomass(:,:,ileaf,icarbon)*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cLeaf", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM((biomass(:,:,isapabove,icarbon)+biomass(:,:,iheartabove,icarbon))*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cWood", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(( biomass(:,:,iroot,icarbon) + biomass(:,:,isapbelow,icarbon) + biomass(:,:,iheartbelow,icarbon) ) &
+            &        *veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cRoot", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(( biomass(:,:,icarbres,icarbon) + biomass(:,:,ifruit,icarbon))*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cMisc", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM((litter_above(:,istructural,:,icarbon)+litter_above(:,imetabolic,:,icarbon))*&
+            veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cLitterAbove", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=0
+       DO l=2,nbdl
+        DO k=1,nvm
+         DO j=1,nlitt
+          vartmp(:)=SUM(litter_below(:,j,k,l,icarbon)*veget_max(:,k)*((z_soil(l)-z_soil(l-1))/z_soil(nbdl)))/1e3/one_day*contfrac
+         ENDDO
+        ENDDO
+       ENDDO
+        DO k=1,nvm
+         DO j=1,nlitt
+          vartmp(:)=vartmp(:) + SUM(litter_below(:,j,k,1,icarbon)*veget_max(:,k)*((z_soil(1))/z_soil(nbdl)))/1e3/one_day*contfrac
+         ENDDO
+        ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "cLitterBelow", itime, &
+            vartmp, npts, hori_index)
+       DO l=2,nbdl
+          vartmp(:)=SUM(carbon(:,iactive,:,l,icarbon)*((z_soil(l)-z_soil(l-1))/z_soil(nbdl))*veget_max,dim=2)/1e3*contfrac
+       ENDDO
+          vartmp(:)=vartmp(:) + SUM(carbon(:,iactive,:,1,icarbon)*(z_soil(1)/z_soil(nbdl))*veget_max,dim=2)/1e3*contfrac
+
+       CALL histwrite_p (hist_id_stomate_IPCC, "cSoilFast", itime, &
+            vartmp, npts, hori_index)
+       DO l=2,nbdl
+          vartmp(:)=SUM(carbon(:,islow,:,l,icarbon)*((z_soil(l)-z_soil(l-1))/z_soil(nbdl))*veget_max,dim=2)/1e3*contfrac
+       ENDDO
+          vartmp(:)=vartmp(:) + SUM(carbon(:,islow,:,1,icarbon)*(z_soil(1)/z_soil(nbdl))*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cSoilMedium", itime, &
+            vartmp, npts, hori_index)
+       DO l=2,nbdl
+          vartmp(:)=SUM(carbon(:,ipassive,:,l,icarbon)*((z_soil(l)-z_soil(l-1))/z_soil(nbdl))*veget_max,dim=2)/1e3*contfrac
+       ENDDO
+          vartmp(:)=vartmp(:) + SUM(carbon(:,ipassive,:,1,icarbon)*(z_soil(1)/z_soil(nbdl))*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cSoilSlow", itime, &
+            vartmp, npts, hori_index)
+       DO j=1,nvm
+          histvar(:,j)=veget_max(:,j)*contfrac(:)*100
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "landCoverFrac", itime, &
+            histvar, npts*nvm, horipft_index)
+       !-
+       vartmp(:)=zero
+       DO j = 2,nvm
+          IF (is_deciduous(j)) THEN
+             vartmp(:) = vartmp(:) + veget_max(:,j)*contfrac*100
+          ENDIF
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "treeFracPrimDec", itime, &
+            vartmp, npts, hori_index)
+       !-
+       vartmp(:)=zero
+       DO j = 2,nvm
+          IF (is_evergreen(j)) THEN
+             vartmp(:) = vartmp(:) + veget_max(:,j)*contfrac*100
+          ENDIF
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "treeFracPrimEver", itime, &
+            vartmp, npts, hori_index)
+       !-
+       vartmp(:)=zero
+       DO j = 2,nvm
+          IF ( .NOT.(is_c4(j)) ) THEN
+             vartmp(:) = vartmp(:) + veget_max(:,j)*contfrac*100
+          ENDIF
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "c3PftFrac", itime, &
+            vartmp, npts, hori_index)
+       !-
+       vartmp(:)=zero
+       DO j = 2,nvm
+          IF ( is_c4(j) ) THEN
+             vartmp(:) = vartmp(:) + veget_max(:,j)*contfrac*100
+          ENDIF
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "c4PftFrac", itime, &
+            vartmp, npts, hori_index)
+       !-
+       vartmp(:)=SUM(resp_growth*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "rGrowth", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_maint*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "rMaint", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(bm_alloc(:,:,ileaf,icarbon)*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "nppLeaf", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(bm_alloc(:,:,isapabove,icarbon)*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "nppWood", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(( bm_alloc(:,:,isapbelow,icarbon) + bm_alloc(:,:,iroot,icarbon) )*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "nppRoot", itime, &
+            vartmp, npts, hori_index)
+
+       CALL histwrite_p (hist_id_stomate_IPCC, 'RESOLUTION_X', itime, &
+            resolution(:,1), npts, hori_index)
+       CALL histwrite_p (hist_id_stomate_IPCC, 'RESOLUTION_Y', itime, &
+            resolution(:,2), npts, hori_index)
+       CALL histwrite_p (hist_id_stomate_IPCC, 'CONTFRAC', itime, &
+            contfrac(:), npts, hori_index)
+     ENDIF
+    ENDIF
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving stomate_lpj'
+
+  END SUBROUTINE StomateLpj
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : harvest
+!!
+!>\BRIEF        Harvest of croplands
+!!
+!! DESCRIPTION  : To take into account biomass harvest from crop (mainly to take 
+!! into account for the reduced litter input and then decreased soil carbon. it is a 
+!! constant (40\%) fraction of above ground biomass.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::harvest_above the harvested biomass
+!!
+!! REFERENCE(S) :
+!! - Piao, S., P. Ciais, P. Friedlingstein, N. de Noblet-Ducoudre, P. Cadule, N. Viovy, and T. Wang. 2009. 
+!!   Spatiotemporal patterns of terrestrial carbon cycle during the 20th century. Global Biogeochemical 
+!!   Cycles 23:doi:10.1029/2008GB003339.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE harvest(npts, dt_days, veget_max, &
+       bm_to_litter, turnover_daily, &
+       harvest_above)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                    :: npts            !! Domain size (unitless) 
+    REAL(r_std), INTENT(in)                                :: dt_days         !! Time step (days)                               
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget_max       !! new "maximal" coverage fraction of a PFT (LAI -> 
+                                                                              !! infinity) on ground @tex $(m^2 m^{-2})$ @endtex 
+    
+   !! 0.2 Output variables
+   
+   !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! [DISPENSABLE] conversion of biomass to litter 
+                                                                                     !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: turnover_daily   !! Turnover rates 
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: harvest_above    !! harvest above ground biomass for agriculture 
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                         :: i, j, k, l, m    !! indices                       
+    REAL(r_std)                                            :: above_old        !! biomass of previous time step 
+                                                                               !! @tex $(gC m^{-2})$ @endtex 
+!_ ================================================================================================================================
+
+  !! 1. Yearly initialisation
+
+    above_old             = zero
+    harvest_above         = zero
+
+    DO i = 1, npts
+       DO j = 1,nvm
+          IF (.NOT. natural(j)) THEN
+             above_old = turnover_daily(i,j,ileaf,icarbon) + turnover_daily(i,j,isapabove,icarbon) + &
+                  &       turnover_daily(i,j,iheartabove,icarbon) + turnover_daily(i,j,ifruit,icarbon) + &
+                  &       turnover_daily(i,j,icarbres,icarbon) + turnover_daily(i,j,isapbelow,icarbon) + &
+                  &       turnover_daily(i,j,iheartbelow,icarbon) + turnover_daily(i,j,iroot,icarbon)
+
+             turnover_daily(i,j,ileaf,icarbon) = turnover_daily(i,j,ileaf,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,isapabove,icarbon) = turnover_daily(i,j,isapabove,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,isapbelow,icarbon) = turnover_daily(i,j,isapbelow,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,iheartabove,icarbon) = turnover_daily(i,j,iheartabove,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,iheartbelow,icarbon) = turnover_daily(i,j,iheartbelow,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,iroot,icarbon) = turnover_daily(i,j,iroot,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,ifruit,icarbon) = turnover_daily(i,j,ifruit,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,icarbres,icarbon) = turnover_daily(i,j,icarbres,icarbon)*frac_turnover_daily
+             harvest_above(i)  = harvest_above(i) + veget_max(i,j) * above_old *(un - frac_turnover_daily)
+          ENDIF
+       ENDDO
+    ENDDO
+
+!!$    harvest_above = harvest_above
+  END SUBROUTINE harvest
+END MODULE stomate_lpj
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_npp.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_npp.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_npp.f90	(revision 5166)
@@ -0,0 +1,533 @@
+! =================================================================================================================================
+! MODULE          : stomate_npp
+!
+! CONTACT         : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE         : IPSL (2006)
+!                 This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF          This modules calculates NPP: Maintenance and growth respiration
+!!
+!!\n DESCRIPTION: We calculate first the maintenance respiration. This is substracted from the
+!!                allocatable biomass (and from the present biomass if the GPP is too low).\n
+!!                Of the rest, a part is lost as growth respiration, while the other part is
+!!                effectively allocated.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_npp
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC npp_calc,npp_calc_clear
+
+  LOGICAL, SAVE                                              :: firstcall_npp = .TRUE.         !! first call
+!$OMP THREADPRIVATE(firstcall_npp)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: npp_calc_clear
+!!
+!>\BRIEF        : Set the flag ::firstcall_npp to .TRUE. and as such activate section 
+!! 1.1 of the subroutine npp_calc (see below).\n
+!_ ================================================================================================================================
+
+  SUBROUTINE npp_calc_clear
+    firstcall_npp=.TRUE.
+  END SUBROUTINE npp_calc_clear
+
+
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	: npp_calc
+!!
+!>\BRIEF        Calculate NPP as the difference between GPP and respiration (= growth + maintenance respiration).
+!!              Update biomass of all compartments after calculating respiration and allocation.
+!!
+!!
+!! DESCRIPTION  : NPP is calculated from three components: Gross Primary Productivity (GPP), maintenance respiration 
+!! and growth respiration (all in @tex $ gC.m^{-2}dt^{-1} $ @endtex), following the convention that positive fluxes denote 
+!! fluxes plants to the atmosphere. GPP is the input variable from which, in the end, NPP or total allocatable biomass 
+!! @tex $(gC.m^{-2}dt^{-1}))$ @endtex is calculated. Net primary production is then calculated as:\n	
+!! NPP = GPP - growth_resp - maint-resp   [eq. 1]\n   
+!!	
+!! The calculation of maintenance respiration is done in routine stomate_resp.f90. Maintenance respiration is calculated for 
+!! the whole plant and is therefore removed from the total allocatable biomass. In order to prevent all allocatable biomass 
+!! from being used for maintenance respiration, a limit fraction of total allocatable biomass, tax_max, is defined (in 
+!! variables declaration). If maintenance respiration exceeds tax_max (::bm_tax_max), the maximum allowed allocatable biomass
+!! will be respired and the remaining respiration, required in excess of tax_max, is taken out from tissues already present in
+!! the plant (biomass).\n  
+!! 
+!! After total allocatable biomass has been updated by removing maintenance respiration, total allocatable biomass is distributed 
+!! to all plant compartments according to the f_alloc fractions calculated in stomate_alloc.f90.\n
+!!
+!! Growth respiration is calculated as a fraction of allocatable biomass for each part of the plant. The fraction coefficient 
+!! ::frac_growth_resp is defined in stomate_constants.f90 and is currently set to be the same for all plant compartments. 
+!! Allocatable biomass of all plant compartments are updated by removing what is lost through growth respiration. Net allocatable
+!! biomass (total allocatable biomass after maintenance and growth respiration) is added to the current biomass for  each plant 
+!! compartment.
+!!
+!! Finally, leaf age and plant age are updated. Leaf age is described with the concept of "leaf age classes". A number of leaf 
+!! age classes (nleafages) is defined in stomate_constants.f90. Each leaf age class contains a fraction (::leaf_frac) of the 
+!! total leaf biomass. When new biomass is added to leaves, the age of the biomass in the youngest leaf age class is decreased. 
+!! The fractions of leaves in the other leaf ages classes are also updated as the total biomass has increased. Plant age is 
+!! updated first by increasing the age of the previous biomass by one time step, and then by adjusting this age as the average 
+!! of the ages of the previous and the new biomass.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::npp
+!!
+!! REFERENCE(S)	: 
+!! - F.W.T.Penning De Vries, A.H.M. Brunsting, H.H. Van Laar. 1974. Products, requirements and efficiency of biosynthesis a 
+!! quantitative approach. Journal of Theoretical Biology, Volume 45, Issue 2, June 1974, Pages 339-377.
+!! 
+!! FLOWCHART : 
+!! \latexonly
+!! \includegraphics[scale=0.14]{stomate_npp_flow.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE npp_calc (npts, dt, &
+       PFTpresent, &
+       t2m, tsoil, lai, rprof, &
+       gpp, f_alloc, bm_alloc, resp_maint_part,&
+       biomass, leaf_age, leaf_frac, age, &
+       resp_maint, resp_growth, npp)
+   
+!! 0 Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), INTENT(in)                                   :: dt               !! Time step (days)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                  :: PFTpresent       !! PFT exists (true/false)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: t2m              !! Temperature at 2 meter (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)             :: tsoil            !! Soil temperature of each soil layer (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lai              !! PFT leaf area index (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: rprof            !! PFT root depth as calculated in stomate.f90
+                                                                                  !! from root profile parameter humcste (m) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: gpp              !! PFT gross primary productivity 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)       :: f_alloc          !! Fraction of total allocatable biomass that 
+                                                                                  !! goes into each plant part (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)       :: resp_maint_part  !! Maintenance respiration of different plant 
+                                                                                  !! parts @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: resp_maint       !! PFT maintenance respiration 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex		    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: resp_growth      !! PFT growth respiration 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex				
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: npp              !! PFT net primary productivity 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex		
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: bm_alloc    !! PFT biomass increase, i.e. NPP per plant part 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex		
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass   !! PFT total biomass of each plant part 
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age         !! PFT age of different leaf age classes (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac        !! PFT fraction of total leaves in leaf age 
+                                                                                  !! class (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age              !! PFT age (years)
+
+    !! 0.4 Local variables
+
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)              :: z_soil           !! Soil levels  representing soil depth (m)
+!$OMP THREADPRIVATE(z_soil)
+    REAL(r_std), DIMENSION(npts,nvm)                          :: t_root           !! Root temperature (convolution of root and 
+                                                                                  !! soil temperature profiles)(K)
+    REAL(r_std), DIMENSION(npts,nvm,nparts)                   :: coeff_maint      !! PFT maintenance respiration coefficients of 
+                                                                                  !! different plant compartments at 0 deg C 
+                                                                                  !! @tex $(g.g^{-1}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nparts)                       :: t_maint          !! Temperature which is pertinent for maintenance
+                                                                                  !! respiration, which is air/root temperature for
+                                                                                  !! above/below-ground compartments (K)
+    REAL(r_std), DIMENSION(npts)                              :: rpc              !! Scaling factor for integrating vertical soil 
+                                                                                  !! profiles (unitless)
+    REAL(r_std), DIMENSION(npts)                              :: tl               !! Long term annual mean temperature (C)
+    REAL(r_std), DIMENSION(npts)                              :: slope            !! Slope of maintenance respiration coefficient
+                                                                                  !! (1/K)
+    REAL(r_std), DIMENSION(npts,nparts)                       :: resp_growth_part !! Growth respiration of different plant parts
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex		
+    REAL(r_std), DIMENSION(npts,nvm)                          :: bm_alloc_tot     !! Allocatable biomass for the whole plant
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                              :: bm_add           !! Biomass increase @tex $(gC.m^{-2})$ @endtex		
+    REAL(r_std), DIMENSION(npts)                              :: bm_new           !! New biomass @tex $(gC.m^{-2})$ @endtex	
+    REAL(r_std), DIMENSION(npts,nvm)                          :: leaf_mass_young  !! Leaf mass in youngest age class 
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex		
+    REAL(r_std), DIMENSION(npts,nvm)                          :: lm_old           !! Leaf mass after maintenance respiration 
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex			
+    REAL(r_std), DIMENSION(npts,nvm)                          :: bm_create        !! Biomass created when biomass<0 because of dark
+                                                                                  !! respiration @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                              :: bm_tax_max       !! Maximum part of allocatable biomass used for 
+                                                                                  !! respiration @tex $(gC.m^{-2})$ @endtex	
+    REAL(r_std), DIMENSION(npts)                              :: bm_pump          !! Biomass that remains to be taken away 
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex
+    INTEGER(i_std)                                            :: i,j,k,l,m        !! Indeces(unitless)
+    INTEGER(i_std)                                            :: ier              !! Error handling
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering npp'
+    
+ !! 1. Initializations
+    
+    !! 1.1 First call
+    IF ( firstcall_npp ) THEN
+
+       !! 1.1.1 Soil levels
+       !  Get the depth of the different soil layers (number of layers=nbdl) 
+       !  previously calculated as variable diaglev in routines sechiba.f90 and slowproc.f90  
+       ALLOCATE(z_soil(0:nbdl), stat=ier)
+       IF ( ier /= 0 ) CALL ipslerr_p(3,'npp_calc','Pb in allocate of z_soil','','')
+
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+       !! 1.1.2 Output message
+       !  Write message including value used for tax_max 	
+       WRITE(numout,*) 'npp:'
+
+       WRITE(numout,*) '   > max. fraction of allocatable biomass used for'// &
+            ' maint. resp.:', tax_max
+
+       firstcall_npp = .FALSE.
+
+    ENDIF ! End if first call
+
+    !! 1.2 Set output variables to zero
+    bm_alloc(:,:,:,:) = zero
+    resp_maint(:,:) = zero
+    resp_growth(:,:) = zero
+    npp(:,:) = zero
+
+    !! 1.3 Total allocatable biomass
+    ! total allocatable biomass during this time step determined from GPP.
+    ! GPP was calculated as CO2 assimilation in enerbil.f90
+    bm_alloc_tot(:,:) = gpp(:,:) * dt
+
+    
+ 
+    !! 3. Calculate maintenance and growth respiration
+    ! First, total maintenance respiration for the whole plant is calculated by summing maintenance 
+    ! respiration of the different plant compartments. Then, maintenance respiration is subtracted 
+    ! from whole-plant allocatable biomass (up to a maximum fraction of the total allocatable biomass). 
+    ! Growth respiration is then calculated for each plant compartment as a fraction of remaining 
+    ! allocatable biomass for this compartment. NPP is calculated by substracting total autotrophic 
+    ! respiration from GPP i.e. NPP = GPP - maintenance resp - growth resp.
+    DO j = 2,nvm	! Loop over # of PFTs
+
+       !! 3.1 Maintenance respiration of the different plant parts
+       !      Maintenance respiration of the different plant parts is calculated in 
+       !      stomate_resp.f90 as a function of the plant's temperature, 
+       !      the long term temperature and plant coefficients 
+       !      VPP killer:
+       resp_maint(:,j) = zero
+
+       !  Following the calculation of hourly maintenance respiration, verify that 
+       !  the PFT has not been killed after calcul of resp_maint_part in stomate.
+       DO k= 1, nparts
+          WHERE (PFTpresent(:,j))
+             resp_maint(:,j) = resp_maint(:,j) + resp_maint_part(:,j,k)
+          ENDWHERE
+       ENDDO
+       
+       !! 3.2 Substract maintenance respiration from allocatable biomass
+       !      The total maintenance respiration calculated in 3.2 is substracted  from the newly 
+       !      produced allocatable biomass (bm_alloc_tot). However, ensure that not all allocatable 
+       !      biomass is removed by setting a maximum to the fraction of allocatable biomass used 
+       !      for maintenance respiration: tax_max. If the maintenance respiration is larger than 
+       !      tax_max,the amount tax_max is taken from allocatable biomass, and the remaining of 
+       !      maintenance respiration is taken from the tissues themselves (biomass). We suppose 
+       !      that respiration is not dependent on leaf age -> therefore the leaf age structure is 
+       !      not changed. 
+       !      The maximum fraction of allocatable biomass used for respiration is defined as tax_max. 
+       !      The value of tax_max is set in the declarations section (0.4 Local variables) of this
+       !      routine
+       bm_tax_max(:) = tax_max * bm_alloc_tot(:,j)
+
+       DO i = 1, npts	! Loop over # of pixels
+
+          ! If there is enough allocatable biomass to cover maintenance respiration, 
+	  ! then biomass associated with maintenance respiration is removed from allocatable biomass
+          IF ( bm_alloc_tot(i,j) .GT. zero ) THEN
+               IF ( ( resp_maint(i,j) * dt ) .LT. bm_tax_max(i) )  THEN	
+	
+                  bm_alloc_tot(i,j) = bm_alloc_tot(i,j) - resp_maint(i,j) * dt
+
+                  ! If there is not enough allocatable biomass to cover maintenance respiration, the  
+                  ! - maximum allowed allocatable biomass (bm_tax_max) is removed from allocatable biomass.
+               ELSE
+	     
+                  bm_alloc_tot(i,j) = bm_alloc_tot(i,j) - bm_tax_max(i)
+
+                  ! ::bm_pump is the amount of maintenance respiration that exceeds the maximum allocatable biomass
+                  ! This amount of biomass still needs to be respired and will be removed from tissues biomass of each
+                  ! plant compartment
+                  bm_pump(i) = resp_maint(i,j) * dt - bm_tax_max(i)
+
+                  ! The biomass is removed from each plant compartment tissues as the ratio of the maintenance		
+                  ! respiration of the plant compartment to the total maintenance respiration (resp_maint_part/resp_maint)
+                  biomass(i,j,ileaf,icarbon) = biomass(i,j,ileaf,icarbon) - &
+                       bm_pump(i) * resp_maint_part(i,j,ileaf) / resp_maint(i,j)
+                  biomass(i,j,isapabove,icarbon) = biomass(i,j,isapabove,icarbon) - &
+                       bm_pump(i) * resp_maint_part(i,j,isapabove) / resp_maint(i,j)
+                  biomass(i,j,isapbelow,icarbon) = biomass(i,j,isapbelow,icarbon) - &
+                       bm_pump(i) * resp_maint_part(i,j,isapbelow) / resp_maint(i,j)
+                  biomass(i,j,iroot,icarbon) = biomass(i,j,iroot,icarbon) - &
+                       bm_pump(i) * resp_maint_part(i,j,iroot) / resp_maint(i,j)
+                  biomass(i,j,ifruit,icarbon) = biomass(i,j,ifruit,icarbon) - &
+                       bm_pump(i) * resp_maint_part(i,j,ifruit) / resp_maint(i,j)
+                  biomass(i,j,icarbres,icarbon) = biomass(i,j,icarbres,icarbon) - &
+                       bm_pump(i) * resp_maint_part(i,j,icarbres) / resp_maint(i,j)
+
+                  biomass(i,j,ileaf,icarbon14) = biomass(i,j,ileaf,icarbon) 
+                  biomass(i,j,isapabove,icarbon14) = biomass(i,j,isapabove,icarbon) 
+                  biomass(i,j,isapbelow,icarbon14) = biomass(i,j,isapbelow,icarbon) 
+                  biomass(i,j,iroot,icarbon14) = biomass(i,j,iroot,icarbon) 
+                  biomass(i,j,ifruit,icarbon14) = biomass(i,j,ifruit,icarbon) 
+                  biomass(i,j,icarbres,icarbon14) = biomass(i,j,icarbres,icarbon) 
+               ENDIF
+          ELSE
+             biomass(i,j,icarbres,icarbon) = biomass(i,j,icarbres,icarbon) - & 
+                  bm_alloc_tot(i,j) - resp_maint(i,j) * dt 
+	     biomass(i,j,icarbres,icarbon14) = biomass(i,j,icarbres,icarbon) 
+             bm_alloc_tot(i,j) = 0. 
+          ENDIF	! End if there is enough allocatable biomass to cover maintenance respiration
+
+       ENDDO   ! Fortran95: WHERE - ELSEWHERE construct
+
+       
+       !! 3.3 Allocate allocatable biomass to different plant compartments.
+       !      The amount of allocatable biomass of each compartment is a fraction according f_alloc of total 
+       !      allocatable biomass (the f_alloc of the different plant parts are calculated in stomate_alloc.f90)
+       DO k = 1, nparts
+          bm_alloc(:,j,k,icarbon) = f_alloc(:,j,k) * bm_alloc_tot(:,j)
+       ENDDO
+
+       
+       !! 3.4 Calculate growth respiration of each plant compartment.
+       !      Growth respiration of a plant compartment is a fraction of the allocatable biomass remaining after
+       !      maintenance respiration losses have been taken into account. The fraction of allocatable biomass 
+       !      removed for growth respiration is the same for all plant compartments and is defined by the parameter
+       !      frac_growth_resp in stomate_constants.f90. Allocatable biomass ::bm_alloc is updated as a result of 
+       !      the removal of growth resp.
+       resp_growth_part(:,:) = frac_growthresp(j) * bm_alloc(:,j,:,icarbon) / dt
+       bm_alloc(:,j,:,icarbon) = ( un - frac_growthresp(j) ) * bm_alloc(:,j,:,icarbon)
+
+       
+       !! 3.5 Total growth respiration 
+       !      Calculate total growth respiration of the plant as the sum of growth respiration of all plant parts	
+       resp_growth(:,j) = zero
+
+       DO k = 1, nparts
+          resp_growth(:,j) = resp_growth(:,j) + resp_growth_part(:,k)
+       ENDDO
+
+    ENDDO ! # End Loop over # of PFTs
+
+    
+ !! 4. Update the biomass with newly allocated biomass after respiration
+ 
+    !  Save the old leaf biomass for later. "old" leaf mass is leaf mass after maintenance respiration in the case 
+    !  where maintenance respiration has required taking biomass from tissues in section 3.3 
+    lm_old(:,:) = biomass(:,:,ileaf,icarbon)
+    biomass(:,:,:,icarbon) = biomass(:,:,:,icarbon) + bm_alloc(:,:,:,icarbon)
+    biomass(:,:,:,icarbon14) = biomass(:,:,:,icarbon)
+
+    
+ !! 5. Deal with negative biomasses
+    
+    !  Biomass can become negative in some rare cases, as the GPP can be negative. This corresponds to very 
+    !  situations that can be seen as the 'creation' of a seed ('virtual photosynthesis'). In this case, we set
+    !  biomass to some small value min_stomate. For carbon budget to remain balanced, this creation of matter (carbon) 
+    !  is taken into account by decreasing the autotrophic respiration by the same amount that has been added to biomass 
+    !  for it to become positive. In this case, maintenance respiration can become negative in extreme cases (deserts)!!
+
+    DO k = 1, nparts	! Loop over # of plant parts
+
+       DO j = 2,nvm	! Loop over # of PFTs
+
+          WHERE ( biomass(:,j,k,icarbon) .LT. zero )
+
+             bm_create(:,j) = min_stomate - biomass(:,j,k,icarbon)
+             
+             biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) + bm_create(:,j)
+             biomass(:,j,k,icarbon14) = biomass(:,j,k,icarbon) 
+             
+             resp_maint(:,j) = resp_maint(:,j) - bm_create(:,j) / dt
+
+          ENDWHERE
+
+       ENDDO	! Loop over # of PFTs
+
+    ENDDO	! Loop over # plant parts
+
+    
+ !! 6. Calculate NPP (See Eq 1 in header)
+    
+    !  Calculate the NPP @tex $(gC.m^{-2}dt^{-1})$ @endtex as the difference between GPP
+    !  and autotrophic respiration (maintenance and growth respirations)
+    DO j = 2,nvm	! Loop over # PFTs
+       npp(:,j) = gpp(:,j) - resp_growth(:,j) - resp_maint(:,j)
+    ENDDO	! Loop over # PFTs
+
+    
+ !! 7. Update leaf age
+
+    !  Leaf age is needed for calculation of turnover and vmax in stomate_turnover.f90 and stomate_vmax.f90 routines. 
+    !  Leaf biomass is distributed according to its age into several "age classes" with age class=1 representing the
+    !  youngest class, and consisting of the most newly allocated leaf biomass 
+    
+    !! 7.1 Update quantity and age of the leaf biomass in the youngest class
+    !      The new amount of leaf biomass in the youngest age class (leaf_mass_young) is the sum of :
+    !      - the leaf biomass that was already in the youngest age class (leaf_frac(:,j,1) * lm_old(:,j)) with the 
+    !        leaf age given in leaf_age(:,j,1) 
+    !      - and the new biomass allocated to leaves (bm_alloc(:,j,ileaf)) with a leaf age of zero.
+    DO j = 2,nvm
+       leaf_mass_young(:,j) = leaf_frac(:,j,1) * lm_old(:,j) + bm_alloc(:,j,ileaf,icarbon)
+    ENDDO
+
+    ! The age of the updated youngest age class is the average of the ages of its 2 components: bm_alloc(leaf) of age
+    ! '0', and leaf_frac*lm_old(=leaf_mass_young-bm_alloc) of age 'leaf_age(:,j,1)' 
+    DO j = 2,nvm
+       WHERE ( ( bm_alloc(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+         ( leaf_mass_young(:,j) .GT. zero ) )
+
+          leaf_age(:,j,1) = MAX ( zero, &
+               & leaf_age(:,j,1) * &
+               & ( leaf_mass_young(:,j) - bm_alloc(:,j,ileaf,icarbon) ) / &
+               & leaf_mass_young(:,j) )
+          
+       ENDWHERE
+    ENDDO
+
+    !! 7.2 Update leaf age
+    !      Update fractions of leaf biomass in each age class (fraction in youngest class increases)
+
+    !! 7.2.1 Update age of youngest leaves
+    !        For age class 1 (youngest class), because we have added biomass to the youngest class, we need to update
+    !        the fraction of total leaf biomass that belongs to the youngest age class : updated mass in class divided
+    !        by new total leaf mass
+    DO j = 2,nvm
+       WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+          leaf_frac(:,j,1) = leaf_mass_young(:,j) / biomass(:,j,ileaf,icarbon)
+
+       ENDWHERE
+    ENDDO
+
+    !! 7.2.2 Update age of other age classes
+    !        Because the total leaf biomass has changed, we need to update the fraction of leaves in each age class:
+    !        mass in leaf age class (from previous fraction of leaves in this class and previous total leaf biomass) 
+    !        divided by new total mass
+    DO m = 2, nleafages	! Loop over # leaf age classes
+
+       DO j = 2,nvm	! Loop over # PFTs
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+             leaf_frac(:,j,m) = leaf_frac(:,j,m) * lm_old(:,j) / biomass(:,j,ileaf,icarbon)
+
+          ENDWHERE
+       ENDDO
+
+    ENDDO	! Loop over # leaf age classes
+
+ !! 8. Update whole-plant age 
+    
+    !! 8.1 PFT age
+    !      At every time step, increase age of the biomass that was already present at previous time step. 
+    !      Age is expressed in years, and the time step 'dt' in days so age increase is: dt divided by number 
+    !      of days in a year.
+    WHERE ( PFTpresent(:,:) )
+
+       age(:,:) = age(:,:) + dt/one_year
+
+    ELSEWHERE
+
+       age(:,:) = zero
+
+    ENDWHERE
+
+    !! 8.2 Age of grasses and crops
+    !  For grasses and crops, biomass with age 0 has been added to the whole plant with age 'age'. New biomass is the sum of 
+    !  the current total biomass in all plant parts (bm_new), bm_new(:) = SUM( biomass(:,j,:), DIM=2 ). The biomass that has 
+    !  just been added is the sum of the allocatable biomass of all plant parts (bm_add), its age is zero. bm_add(:) = 
+    !  SUM( bm_alloc(:,j,:), DIM=2 ). Before allocation, the plant biomass is bm_new-bm_add, its age is "age(:,j)". The age of
+    !  the new biomass is the average of the ages of previous and added biomass.
+    !  For trees, age is treated in "establish" if vegetation is dynamic, and in turnover routines if it is static (in this 
+    !  case, only the age of the heartwood is accounted for).
+    DO j = 2,nvm
+
+       IF ( .NOT. is_tree(j) ) THEN
+
+          bm_new(:) = biomass(:,j,ileaf,icarbon) + biomass(:,j,isapabove,icarbon) + &
+               biomass(:,j,iroot,icarbon) + biomass(:,j,ifruit,icarbon)
+          bm_add(:) = bm_alloc(:,j,ileaf,icarbon) + bm_alloc(:,j,isapabove,icarbon) + &
+               bm_alloc(:,j,iroot,icarbon) + bm_alloc(:,j,ifruit,icarbon)
+
+          WHERE ( ( bm_new(:) .GT. zero ) .AND. ( bm_add(:) .GT. zero ) )
+             age(:,j) = age(:,j) * ( bm_new(:) - bm_add(:) ) / bm_new(:)
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+ !! 9. Write history files
+
+    CALL xios_orchidee_send_field("BM_ALLOC_LEAF",bm_alloc(:,:,ileaf,icarbon))
+    CALL xios_orchidee_send_field("BM_ALLOC_SAP_AB",bm_alloc(:,:,isapabove,icarbon))
+    CALL xios_orchidee_send_field("BM_ALLOC_SAP_BE",bm_alloc(:,:,isapbelow,icarbon))
+    CALL xios_orchidee_send_field("BM_ALLOC_ROOT",bm_alloc(:,:,iroot,icarbon))
+    CALL xios_orchidee_send_field("BM_ALLOC_FRUIT",bm_alloc(:,:,ifruit,icarbon))
+    CALL xios_orchidee_send_field("BM_ALLOC_RES",bm_alloc(:,:,icarbres,icarbon))
+
+
+    ! Save in history file the variables describing the biomass allocated to the plant parts
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_LEAF', itime, &
+         bm_alloc(:,:,ileaf,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_SAP_AB', itime, &
+         bm_alloc(:,:,isapabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_SAP_BE', itime, &
+         bm_alloc(:,:,isapbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_ROOT', itime, &
+         bm_alloc(:,:,iroot,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_FRUIT', itime, &
+         bm_alloc(:,:,ifruit,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_RES', itime, &
+         bm_alloc(:,:,icarbres,icarbon), npts*nvm, horipft_index)
+
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving npp'
+
+  END SUBROUTINE npp_calc
+
+END MODULE stomate_npp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_phenology.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_phenology.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_phenology.f90	(revision 5166)
@@ -0,0 +1,1682 @@
+! =================================================================================================================================
+! MODULE        : stomate_phenology
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module manages the beginning of the growing season (leaf onset).
+!!      
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN          :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ =================================================================================================================================
+
+MODULE stomate_phenology
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC phenology,phenology_clear
+
+  ! first call
+  LOGICAL, SAVE                                              :: firstcall_all_phenology = .TRUE.
+!$OMP THREADPRIVATE(firstcall_all_phenology)
+  LOGICAL, SAVE                                              :: firstcall_hum = .TRUE.
+!$OMP THREADPRIVATE(firstcall_hum)
+  LOGICAL, SAVE                                              :: firstcall_moi = .TRUE.
+!$OMP THREADPRIVATE(firstcall_moi)
+  LOGICAL, SAVE                                              :: firstcall_humgdd = .TRUE.
+!$OMP THREADPRIVATE(firstcall_humgdd)
+  LOGICAL, SAVE                                              :: firstcall_moigdd = .TRUE.
+!$OMP THREADPRIVATE(firstcall_moigdd)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : phenology_clear
+!!
+!>\BRIEF          Flags setting   
+!!
+!! DESCRIPTION  : This subroutine sets flags 
+!!                ::firstcall_all_phenology, ::firstcall_hum, ::firstcall_moi, ::firstcall_humgdd, 
+!!                ::firstcall_moigdd to .TRUE., and therefore activates section 1.1 of each 
+!!                subroutine which writes messages to the output. \n
+!!                This subroutine is called at the beginning of ::stomateLpj_clear in the 
+!!                ::stomate_lpj module.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::firstcall_all_phenology, ::firstcall_hum, ::firstcall_moi, ::firstcall_humgdd, 
+!!                ::firstcall_moigdd
+!!
+!! REFERENCE(S)  : None
+!!
+!! FLOWCHART     : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE phenology_clear
+    firstcall_all_phenology=.TRUE.
+    firstcall_hum=.TRUE.
+    firstcall_moi = .TRUE.
+    firstcall_humgdd = .TRUE.
+    firstcall_moigdd = .TRUE.
+  END SUBROUTINE phenology_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : phenology
+!!
+!>\BRIEF          This subroutine controls the detection of the beginning of the growing season 
+!!                (if dormancy has been long enough), leaf onset, given favourable biometeorological 
+!!                conditions, and leaf growth and biomass allocation when leaf biomass is low (i.e. 
+!!                at the start of the growing season.
+!!
+!! DESCRIPTION  : This subroutine is called by the module ::stomate_lpj and deals with the beginning of the  
+!!                growing season. First it is established whether the beginning of the growing season is
+!!                allowed. This occurs if the dormance period has been long enough (i.e. greater 
+!!                than a minimum PFT-dependent threshold, specified by ::lowgpp_time), 
+!!                AND if the last beginning of the growing season was a sufficiently long time ago 
+!!                (i.e. when the growing season length is greater than a minimum threshold, specified
+!!                by ::min_growthinit_time, which is defined in this module to be 300 days. \n
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                ::lowgpp_time is set for each PFT in ::stomate_data from a table of all
+!!                PFT values (::lowgpp_time_tab), which is defined in ::stomate_constants. \n
+!!                The growing season length is given by ::when_growthinit, which increases
+!!                by the stomate time-step at each call to this phenology module, except for when
+!!                leaf onset is detected, when it is set to 0. \n
+!!                If these two conditions are met, leaf onset occurs if the biometeorological 
+!!                conditions are also met. This is determined by the leaf onset models, which are
+!!                biome-specific. Each PFT is looped over (ignoring bare soil).
+!!                The onset phenology model is selected, (according to the parameter 
+!!                ::pheno_model, which is initialised in stomate_data), and called. \n
+!!                There are six leaf onset phenology models currently being used by ORCHIDEE. 
+!!                These are: 'hum' and 'moi', which are based exclusively on moisture conditions,
+!!                'humgdd' and 'moigdd', which are based on both temperature and moisture conditions,
+!!                'ncdgdd', which is based on a "chilling" requirement for leaf onset, and 
+!!                'ngd', which is based on the number of growing days since the temperature was 
+!!                above a certain threshold, to account for the end of soil frost.
+!!                Those models which are based mostly on temperature conditions are used for
+!!                temperate and boreal biomes, and those which include a moisture condition are used
+!!                for tropical biomes. More detail on the biometeorological conditions is provided
+!!                in the sections on the individual onset models. \n
+!!                The moisture conditions are based on the concept of plant "moisture availability".
+!!                This is based on the soil humidity (relative soil moisture), but is moderated by
+!!                the root density profile, as per the equation:
+!!                \latexonly
+!!                \input{phenology_moiavail_eqn1.tex}
+!!                \endlatexonly
+!!                \n
+!!                Although some studies have shown that the length of the photoperiod is important
+!!                in determining onset (and senescence) dates, this is not considered in the current
+!!                versions of the onset models (Krinner et al., 2005). \n
+!!                If conditions are favourable, leaf onset occurs (::begin_leaves is set to TRUE), 
+!!                ::when_growthinit is set to 0.0, and the growing season has begun. \n
+!!                Following the detection of leaf onset, biomass is allocated from the carbohydrate 
+!!                reserves equally to the leaves and roots IF the leaf biomass is lower than a minimum
+!!                threshold, which is calculated in this subroutine from the parameter
+!!                ::lai_initmin, divided by the specific leaf area (both of which are
+!!                PFT-dependent and set in ::stomate_constants). \n
+!!                Finally, if biomass is required to be allocated from the carbohydrate reserve 
+!!                because the leaf biomass is too low, the leaf age and leaf age distribution is 
+!!                re-set. In this case the youngest age class fraction is set to 1 and all other   
+!!                leaf age class fractions are set to 0. All leaf ages are set to 0. If there is 
+!!                no biomass in the carbohydrate reserve, leaf onset will not occur and the PFT
+!!                will disappear from the grid cell (Krinner et al., 2005). \n
+!!                This subrouting is called in ::stomate_lpj.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::biomass, 
+!!                        ::when_growthinit,
+!!                        ::leaf age distribution
+!!                        ::leaf fraction
+!!
+!! REFERENCE(S) :
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{phenology_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE phenology (npts, dt, PFTpresent, &
+       veget_max, &
+       t2m_longterm, t2m_month, t2m_week, gpp, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       moiavail_month, moiavail_week, &
+       gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       senescence, time_hum_min, &
+       biomass, leaf_frac, leaf_age, &
+       when_growthinit, co2_to_bm, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                                          :: npts                 !! Domain size - number of grid 
+                                                                                                !! cells (unitless) 
+    REAL(r_std), INTENT(in)                                             :: dt                   !! time step (dt_days)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                            :: PFTpresent           !! PFT exists (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: veget_max            !! "maximal" coverage fraction of a 
+                                                                                                !! PFT (LAI -> infinity) on ground 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: t2m_longterm         !! "long term" 2 meter reference 
+                                                                                                !! temperatures (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: t2m_month            !! "monthly" 2-meter temperatures 
+                                                                                                !! (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: t2m_week             !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: gpp                  !! daily gross primary productivity 
+                                                                                                !! @tex ($gC m^{-2} of 
+                                                                                                !! ground/day$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: maxmoiavail_lastyear !! last year's maximum moisture 
+                                                                                                !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: minmoiavail_lastyear !! last year's minimum moisture 
+                                                                                                !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: moiavail_month       !! "monthly" moisture availability 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: moiavail_week        !! "weekly" moisture availability 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: gdd_m5_dormance      !! growing degree days above a 
+                                                                                                !! threshold of -5 deg C (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                     :: gdd_midwinter        !! growing degree days, since 
+                                                                                                !! midwinter (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: ncd_dormance         !! number of chilling days since 
+                                                                                                !! leaves were lost (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: ngd_minus5           !! number of growing days above a 
+                                                                                                !! threshold of -5 deg C (days) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                            :: senescence           !! is the plant senescent? (only 
+                                                                                                !! for deciduous trees - 
+                                                                                                !! carbohydrate reserve) 
+                                                                                                !! (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: time_hum_min         !! time elapsed since strongest 
+                                                                                                !! moisture availability (days) 
+
+    !
+    !! 0.2 Ouput variables 
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)    :: biomass              !! biomass @tex ($gC m^{-2} of 
+                                                                                                !! ground$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)           :: leaf_frac            !! fraction of leaves in leaf age 
+                                                                                                !! class (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)           :: leaf_age             !! leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                     :: when_growthinit      !! how many days since the 
+                                                                                                !! beginning of the growing season 
+                                                                                                !! (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                     :: co2_to_bm            !! co2 taken up by carbohydrate 
+                                                                                                !! reserve at the beginning of the 
+                                                                                                !! growing season @tex ($gC m^{-2} 
+                                                                                                !! of total ground/day$) @endtex 
+                                                                                                ! NV passge 2D
+    LOGICAL, DIMENSION(npts,nvm), INTENT(out)                           :: begin_leaves         !! signal to start putting leaves on (true/false) 
+
+    !
+    !! 0.4 Local variables
+    !
+    LOGICAL, DIMENSION(npts,nvm)                                        :: allow_initpheno      !! are we allowed to decalre the 
+                                                                                                !! beginning of the growing 
+                                                                                                !! season? (true/false) 
+    REAL(r_std), DIMENSION(npts)                                        :: bm_wanted            !! biomass we would like to have 
+                                                                                                !! @tex ($gC m^{-2} of ground$) 
+                                                                                                !! @endtex 
+    REAL(r_std), DIMENSION(npts)                                        :: bm_use               !! biomass we use (from 
+                                                                                                !! carbohydrate reserve or from 
+                                                                                                !! atmosphere) @tex ($gC m^{-2} of 
+                                                                                                !! ground$) @endtex
+    REAL(r_std), DIMENSION(npts)                                        :: lm_min               !! minimum leaf mass @tex ($gC 
+                                                                                                !! m^{-2} of ground$) @endtex 
+    LOGICAL(r_std), DIMENSION(npts)                                     :: age_reset            !! does the leaf age distribution 
+                                                                                                !! have to be reset? (true/false) 
+    INTEGER(i_std)                                                      :: i,j,m                !! indices (unitless)
+    REAL(r_std), DIMENSION(npts,nvm)                                    :: histvar              !! controls the history output 
+                                                                                                !! level - 0: nothing is written; 
+                                                                                                !! 10: everything is written 
+                                                                                                !! (0-10, unitless) 
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering phenology'
+
+    !
+    !! 1. first call - output message giving the setting of the ::always_init
+    !!    and ::min_growthinit_time parameters.
+    !
+
+    IF ( firstcall_all_phenology ) THEN
+
+       WRITE(numout,*) 'phenology:'
+
+       WRITE(numout,*) '   > take carbon from atmosphere if carbohydrate' // &
+            ' reserve too small (::always_init): ', always_init
+
+       WRITE(numout,*) '   > minimum time since last beginning of a growing' // &
+            ' season (d) (::min_growthinit_time): ', min_growthinit_time
+
+       firstcall_all_phenology = .FALSE.
+
+    ENDIF
+
+    !
+    !! 2. Detection of the beginning of the growing season.
+    !
+
+    !
+    !! 2.1 allow detection of the beginning of the growing season if dormance was
+    !!     long enough (i.e. when ::time_lowgpp, which is calculated in ::stomate_season, 
+    !!     is above a certain PFT-dependent threshold, ::lowgpp_time, 
+    !!     which is given in ::stomate_constants),
+    !!     AND the last beginning of growing season was a sufficiently long time ago 
+    !!     (i.e. when ::when_growthinit, which is calculated in this module, 
+    !!     is greater than ::min_growthinit_time, which is declared at the beginning of this module).
+    !!     If these conditions are met, allow_initpheno is set to TRUE. Each PFT is looped over.
+    !
+
+    allow_initpheno(:,1) = .FALSE.
+    DO j = 2,nvm
+
+       WHERE ( when_growthinit(:,j) .GT. min_growthinit_time )
+          allow_initpheno(:,j) = .TRUE.
+       ELSEWHERE
+          allow_initpheno(:,j) = .FALSE.
+       ENDWHERE
+
+    ENDDO
+
+    WHERE(allow_initpheno)
+       histvar=un
+    ELSEWHERE
+       histvar=zero
+    ENDWHERE
+
+    CALL xios_orchidee_send_field("ALLOW_INITPHENO",histvar)
+
+    CALL histwrite_p (hist_id_stomate, 'ALLOW_INITPHENO', itime, histvar, npts*nvm, horipft_index)
+
+    !
+    !! 2.2 increase the ::when_growthinit counter, which gives the number of days since the beginning of the growing season.
+    !!     Needed for allocation and for the detection of the beginning of the growing season.
+    !
+
+    when_growthinit(:,:) = when_growthinit(:,:) + dt
+
+    !
+    !! 3. Leaf onset.
+    !!    Check biometeorological conditions using the onset phenological models, 
+    !!    which are different for each PFT group (i.e. grass versus tropical etc. 
+    !!    See below for more detail on the different models and which PFTs use each model).
+    !
+
+    !! - By default: phenology does not start (::begin_leaves set to FALSE).
+    begin_leaves(:,:) = .FALSE.
+
+    !! - The onset phenology model is selected, (according to the parameter ::pheno_model, 
+    !! which is initialised in stomate_data), and called.
+    !! Each PFT is looped over (ignoring bare soil). 
+    !! If conditions are favourable, begin_leaves is set to TRUE.
+    
+    ! parameter used in all the differents models of phenology 
+    t_always = ZeroCelsius + t_always_add
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       SELECT CASE ( pheno_model(j) )
+
+       CASE ( 'hum' )
+
+          CALL pheno_hum (npts, j, PFTpresent, allow_initpheno, &
+               moiavail_month, moiavail_week, &
+               maxmoiavail_lastyear, minmoiavail_lastyear, &
+               begin_leaves)
+
+       CASE ( 'moi' )
+
+          CALL pheno_moi (npts, j, PFTpresent, allow_initpheno, &
+               time_hum_min, &
+               moiavail_month, moiavail_week, &
+               begin_leaves)
+
+
+       CASE ( 'ncdgdd' )
+
+          CALL pheno_ncdgdd (npts, j, PFTpresent, allow_initpheno, &
+               ncd_dormance, gdd_midwinter, &
+               t2m_month, t2m_week, begin_leaves)
+
+       CASE ( 'ngd' )
+
+          CALL pheno_ngd (npts, j, PFTpresent, allow_initpheno, ngd_minus5, &
+               t2m_month, t2m_week, begin_leaves)
+
+       CASE ( 'humgdd' )
+
+          CALL pheno_humgdd (npts, j, PFTpresent, allow_initpheno, gdd_m5_dormance, &
+               maxmoiavail_lastyear, minmoiavail_lastyear, &
+               t2m_longterm, t2m_month, t2m_week, &
+               moiavail_week, moiavail_month, &
+               begin_leaves)
+
+       CASE ( 'moigdd' )
+
+          CALL pheno_moigdd (npts, j, PFTpresent, allow_initpheno, gdd_m5_dormance, &
+               time_hum_min, &
+               t2m_longterm, t2m_month, t2m_week, &
+               moiavail_week, moiavail_month, &
+               begin_leaves)
+
+       CASE ( 'none' )
+
+          ! no action
+
+       CASE default
+
+          WRITE(numout,*) 'phenology: don''t know how to treat this PFT.'
+          WRITE(numout,*) '  number: (::j)',j
+          WRITE(numout,*) '  phenology model (::pheno_model(j)) : ',pheno_model(j)
+          CALL ipslerr_p(3,'stomate phenology','Cannot treat this PFT','','')
+
+       END SELECT
+
+    ENDDO
+
+    WHERE(begin_leaves)
+       histvar=un
+    ELSEWHERE
+       histvar=zero
+    ENDWHERE
+
+    CALL xios_orchidee_send_field("BEGIN_LEAVES",histvar)
+
+    CALL histwrite_p (hist_id_stomate, 'BEGIN_LEAVES', itime, histvar, npts*nvm, horipft_index)
+
+    !
+    !! 4. Leaf growth and biomass allocation when leaf biomass is low.
+    !!   Leaves start to grow if biometeorological conditions are favourable (::begin_leaves == TRUE) and if
+    !!   leaf growth is allowed (::allow_initpheno == TRUE).
+    !!   PFTs and then grid cells are looped over.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       age_reset(:) = .FALSE.
+
+       DO i = 1, npts
+
+          IF ( begin_leaves(i,j) ) THEN
+
+             !! 4.1 First minimum biomass is calculated using the following equation:
+             !!     \latexonly
+             !!     \input{phenology_lm_min_eqn2.tex}
+             !!     \endlatexonly
+             !!     \n
+
+             lm_min(i) = lai_initmin(j) / sla(j)
+
+             !! 4.2 If leaf biomass is lower than the minimum biomass then biomass must be allocated from the carbohydrate 
+             !!     reserves to leaves and roots.
+
+             IF ( biomass(i,j,ileaf,icarbon) .LT. lm_min(i) ) THEN
+
+                !
+                !! 4.2.1 Determine how much biomass is available to use
+                !!       First calculate how much biomass is wanted/required 
+                !!       (::bm_wanted = 2 x the minimum leaf biomass).
+                !
+
+                bm_wanted(i) = 2. * lm_min(i)
+
+                !! 4.2.2 If the biomass in the carbohydrate reserves is less than the required biomass
+                !!       take the required amount of carbon from the atmosphere and put it into the
+                !!       carbohydrate reserve. This only occurs if the parameter ::always_init 
+                !!       (set at beginning of this ::subroutine) is TRUE. Default is FALSE. 
+
+                IF ( always_init .AND. ( biomass(i,j,icarbres,icarbon) .LT. bm_wanted(i) ) ) THEN
+                   !NV passage 2D
+                   co2_to_bm(i,j) = co2_to_bm(i,j) + ( bm_wanted(i) - biomass(i,j,icarbres,icarbon) ) / dt
+
+                   biomass(i,j,icarbres,icarbon) = bm_wanted(i)
+		   biomass(:,j,icarbres,icarbon14) = biomass(:,j,icarbres,icarbon) 
+
+                ENDIF
+                
+                !! 4.2.3 The biomass available to use is set to be the minimum of the biomass of the carbohydrate reservoir (if 
+                !! carbon not taken from the atmosphere), and the wanted biomass.
+                bm_use(i) = MIN( biomass(i,j,icarbres,icarbon), bm_wanted(i) )
+
+                !
+                !! 4.2.4 divide the biomass which is available to use equally between the leaves and roots.
+                !
+
+                biomass(i,j,ileaf,icarbon) = biomass(i,j,ileaf,icarbon) + bm_use(i) / 2.
+
+                biomass(i,j,iroot,icarbon) = biomass(i,j,iroot,icarbon) + bm_use(i) / 2.
+
+                biomass(i,j,ileaf,icarbon14) = biomass(i,j,ileaf,icarbon) 
+
+                biomass(i,j,iroot,icarbon14) = biomass(i,j,iroot,icarbon) 
+
+                !
+                !! 4.2.5 decrease carbohydrate reservoir biomass by the amount that's been allocated to the leaves and roots
+                !
+
+                biomass(i,j,icarbres,icarbon) = biomass(i,j,icarbres,icarbon) - bm_use(i)
+		biomass(i,j,icarbres,icarbon14) = biomass(i,j,icarbres,icarbon) 
+
+                !
+                !! 4.2.6 set reset leaf age distribution (::age_reset) flag. Default is TRUE.
+                !     (done later for better vectorization)
+                !
+
+                age_reset(i) = .TRUE.
+
+             ENDIF  ! leaf mass is very low
+
+             !
+             !! 4.3 reset when_growthinit counter: start of the growing season
+             !
+
+             when_growthinit(i,j) = zero
+
+          ENDIF    ! start of the growing season
+
+       ENDDO      ! loop over grid points
+
+       !
+       !! 4.4 reset leaf age distribution where necessary (i.e. when age_reset is TRUE)
+       !!     simply say that everything is in the youngest age class
+       !
+
+       !! 4.4.1 fractions - set the youngest age class fraction to 1 and all other leaf age class fractions to 0.
+
+       WHERE ( age_reset(:) )
+          leaf_frac(:,j,1) = un
+       ENDWHERE
+       DO m = 2, nleafages
+          WHERE ( age_reset(:) )
+             leaf_frac(:,j,m) = zero
+          ENDWHERE
+       ENDDO
+
+       !! 4.4.2 ages - set all leaf ages to 0.
+
+       DO m = 1, nleafages
+          WHERE ( age_reset(:) )
+             leaf_age(:,j,m) = zero
+          ENDWHERE
+       ENDDO
+
+    ENDDO        ! loop over # PFTs
+
+
+    IF (printlev>=3) WRITE(numout,*) 'Leaving phenology'
+
+  END SUBROUTINE phenology
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_hum 
+!!
+!>\BRIEF          The 'hum' onset model initiate leaf onset based exclusively on moisture 
+!!                availability criteria. 
+!!                Currently no PFTs are assigned to this onset model.
+!!
+!! DESCRIPTION  : This model is for tropical biomes, where temperatures are high but moisture
+!!                might be a limiting factor on growth. It is based on leaf onset model 4a in 
+!!                Botta et al. (2000), which adopts the approach of Le Roux (1995). \n
+!!                Leaf onset occurs if the monthly moisture availability is still quite
+!!                low (i.e. lower than the weekly availability), but the weekly availability is 
+!!                higher than the critical threshold ::availability_crit (as it reacts faster), 
+!!                which indicates the weekly moisture availability is increasing.
+!!                OR if the monthly moisture availability is high enough (i.e. above the 
+!!                threshold value ::moiavail_always), leaf onset is initiated if this has not 
+!!                already happened. This allows vegetation in arid areas to respond to rapidly
+!!                changing soil moisture conditions (Krinner et al., 2005). \n
+!!                The critical weekly moisture availability threshold (::availability_crit), is
+!!                calculated in this subroutine, and is a function of last year's maximum and
+!!                minimum moisture availability and the PFT-dependent parameter
+!!                ::hum_frac, which specifies how much of last year's available 
+!!                moisture is required for leaf onset, as per the equation:
+!!                \latexonly
+!!                \input{phenology_moi_availcrit_eqn3.tex}
+!!                \endlatexonly
+!!                \n
+!!                ::hum_frac is set for each PFT in ::stomate_data from a table
+!!                which contains all the PFT values (::hum_frac_tab) in ::stomate_constants. \n
+!!                Last year's maximum and minimum moisture availability and the monthly and 
+!!                weekly moisture availability are  
+!!                The ::pheno_hum subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start.
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Le Roux, X. (1995), Etude et modelisation des echanges d'eau et d'energie
+!! sol-vegetation-atmosphere dans une savane humide, PhD Thesis, University
+!! Pierre et Marie Curie, Paris, France.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_hum.png}
+!! \endlatexonly
+!! \n             
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_hum (npts, j, PFTpresent, allow_initpheno, &
+       moiavail_month, moiavail_week, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declarations
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                                             :: npts                  !! Domain size - number of 
+                                                                                                    !! grid cells (unitless) 
+    INTEGER(i_std), INTENT(in)                                             :: j                     !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                               :: PFTpresent            !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                               :: allow_initpheno       !! are we allowed to 
+                                                                                                    !! declare the beginning of 
+                                                                                                    !! the growing season? 
+                                                                                                    !! (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                           :: moiavail_month        !! "monthly" moisture 
+                                                                                                    !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                           :: moiavail_week         !! "weekly" moisture 
+                                                                                                    !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                           :: maxmoiavail_lastyear  !! last year's maximum 
+                                                                                                    !! moisture availability 
+                                                                                                    !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                           :: minmoiavail_lastyear  !! last year's minimum 
+                                                                                                    !! moisture availability 
+                                                                                                    !! (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)                            :: begin_leaves          !! signal to start putting 
+                                                                                                    !! leaves on (true/false) 
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                                            :: moiavail_always       !! critical monthly 
+                                                                                                    !! moisture availability - set 
+                                                                                                    !! for tree or grass 
+                                                                                                    !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                                           :: availability_crit     !! critical weekly moisture 
+                                                                                                    !! availability (0-1, unitless)
+    INTEGER(i_std)                                                         :: i                     !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering hum'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of onset model and the moisture availability 
+    !!     parameters for tree and grass
+    !
+
+    IF ( firstcall_hum ) THEN
+
+       WRITE(numout,*) 'pheno_hum:'
+       WRITE(numout,*) '   > moisture availability above which moisture tendency doesn''t matter: '
+       WRITE(numout,*) '         trees (::moiavail_always_tree): ', moiavail_always_tree
+       WRITE(numout,*) '         grasses (::moiavail_always_grass):', moiavail_always_grass
+
+       firstcall_hum = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.3 check the critical value ::hum_frac is defined. If not, stop.
+    !
+
+    IF ( hum_frac(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'hum: hum_frac is undefined for PFT (::j)',j
+       CALL ipslerr_p(3,'stomate phenology','hum_frac is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical monthly moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(j) ) THEN
+       moiavail_always = moiavail_always_tree
+    ELSE
+       moiavail_always = moiavail_always_grass
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !! The PFT has to be there and start of growing season must be allowed
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) ) THEN
+
+          !! 2.1 Calculate the critical weekly moisture availability: depends linearly on the last year 
+          !! minimum and maximum moisture availabilities, and on the parameter ::hum_frac.
+
+          availability_crit(i) = minmoiavail_lastyear(i,j) + hum_frac(j) * &
+               ( maxmoiavail_lastyear(i,j) - minmoiavail_lastyear(i,j) )
+
+          !! 2.2 Determine if growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     Leaf onset occurs if the monthly moisture availability is still quite
+          !!     low (i.e. lower than the weekly availability), but the weekly availability is 
+          !!     already higher than the critical threshold ::availability_crit (as it reacts faster), 
+          !!     which indicates the weekly moisture availability is increasing.
+          !!     OR if the monthly moisture availability is high enough (i.e. above the threshold value 
+          !!     ::moiavail_always), leaf onset is initiated if this has not already happened.
+
+          IF ( ( ( moiavail_week(i,j)  .GE. availability_crit(i) ) .AND. &
+               ( moiavail_month(i,j) .LT. moiavail_week(i,j) )   ) .OR. &
+               ( moiavail_month(i,j) .GE. moiavail_always )                ) THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving hum'
+
+  END SUBROUTINE pheno_hum
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_moi
+!!
+!>\BRIEF          The 'moi' onset model (::pheno_moi) initiates leaf onset based exclusively 
+!!                on moisture availability criteria. 
+!!                It is very similar to the 'hum' onset model but instead of the weekly moisture 
+!!                availability being higher than a constant threshold, the condition is that the 
+!!                moisture minimum happened a sufficiently long time ago. 
+!!                Currently PFT 3 (Tropical Broad-leaved Raingreen) is assigned to this model.
+!!
+!! DESCRIPTION  : This model is for tropical biomes, where temperatures are high but moisture
+!!                might be a limiting factor on growth. It is based on leaf onset model 4b in 
+!!                Botta et al. (2000).
+!!                Leaf onset begins if the plant moisture availability minimum was a sufficiently  
+!!                time ago, as specified by the PFT-dependent parameter ::hum_min_time 
+!!                AND if the "monthly" moisture availability is lower than the "weekly"
+!!                availability (indicating that soil moisture is increasing).
+!!                OR if the monthly moisture availability is high enough (i.e. above the threshold 
+!!                value ::moiavail_always), leaf onset is initiated if this has not already 
+!!                happened. \n
+!!                ::hum_min_time is set for each PFT in ::stomate_data, and is 
+!!                defined in the table ::hum_min_time_tab in ::stomate_constants. \n
+!!                ::moiavail_always is defined for both tree and grass in this subroutine 
+!!                (set to 1. and 0.6 respectively). \n
+!!                The ::pheno_moi subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!        
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start.
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_moi.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_moi (npts, j, PFTpresent, allow_initpheno, &
+       time_hum_min, &
+       moiavail_month, moiavail_week, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts            !! Domain size - number of grid cells (unitless)
+    INTEGER(i_std), INTENT(in)                               :: j               !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to declare the beginning of the 
+                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: time_hum_min    !! time elapsed since strongest moisture 
+                                                                                !! availability (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_month  !! "monthly" moisture availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_week   !! "weekly" moisture availability (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves    !! signal to start putting leaves on (true/false)
+
+    !
+    !! 0.3 Modified variables
+    !
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    INTEGER(i_std)                                           :: i                               !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering moi'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of onset model and the moisture availability 
+    !!     parameters for tree and grass
+    !
+
+    IF ( firstcall_moi ) THEN
+
+       WRITE(numout,*) 'pheno_moi:'
+       WRITE(numout,*) '   > moisture availability above which moisture tendency doesn''t matter: '
+       WRITE(numout,*) '         trees (::moiavail_always_tree):', moiavail_always_tree
+       WRITE(numout,*) '         grasses (::moiavail_always_grass):', moiavail_always_grass
+
+       firstcall_moi = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.3 check the critical value ::hum_min_time is definded. If not, stop
+    !
+
+    IF ( hum_min_time(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'moi: hum_min_time is undefined for PFT (::j) ',j
+       CALL ipslerr_p(3,'stomate phenology','hum_min_time is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical monthly moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(j) ) THEN
+       moiavail_always = moiavail_always_tree
+    ELSE
+       moiavail_always = moiavail_always_grass
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !! The PFT has to be there and start of growing season must be allowed.
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) ) THEN
+          
+          !! 2.1 Determine if growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     The favorable season starts if the moisture minimum (::time_hum_min) was a sufficiently long 
+          !!     time ago, i.e. greater than the threshold specified by the parameter ::hum_min_time 
+          !!     and if the "monthly" moisture availability is lower than the "weekly"
+          !!     availability (indicating that soil moisture is increasing).
+          !!     OR if the monthly moisture availability is high enough (i.e. above the threshold value 
+          !!     ::moiavail_always), initiate the growing season if this has not happened yet.
+
+          IF  ( ( ( moiavail_week(i,j) .GT. moiavail_month(i,j) ) .AND. &
+               ( time_hum_min(i,j) .GT. hum_min_time(j) )    ) .OR. &
+               ( moiavail_month(i,j) .GE. moiavail_always )                     ) THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving moi'
+
+  END SUBROUTINE pheno_moi
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_humgdd
+!!
+!>\BRIEF          The 'humgdd' onset model initiates leaf onset based on mixed conditions of 
+!!                temperature and moisture availability criteria. 
+!!                Currently no PFTs are assigned to this onset model. 
+!!
+!! DESCRIPTION  : In this model the Growing Degree Day (GDD) model (Chuine, 2000) is combined 
+!!                with the 'hum' onset model (::pheno_hum), which has previously been described,
+!!                in order to account for dependence on both temperature and moisture conditions 
+!!                in warmer climates. \n. 
+!!                The GDD model specifies that daily temperatures above a threshold of -5  
+!!                degrees C are summed, minus this threshold, giving the GDD, starting from 
+!!                the beginning of the dormancy period (::time_lowgpp>0), i.e. since the leaves 
+!!                were lost. \n.
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                Leaf onset begins when the a PFT-dependent GDD-threshold is reached.
+!!                In addition there are temperature and moisture conditions.
+!!                The temperature condition specifies that the monthly temperature has to be 
+!!                higher than a constant threshold (::t_always) OR
+!!                the weekly temperature is higher than the monthly temperature.
+!!                There has to be at least some moisture. The moisture condition 
+!!                is exactly the same as the 'hum' onset model (::pheno_hum), which has already
+!!                been described. \n
+!!                The GDD (::gdd_m5_dormance) is calculated in ::stomate_season. GDD is set to 
+!!                undef if beginning of the growing season detected, i.e. when there is GPP 
+!!                (::time_lowgpp>0).
+!!                The parameter ::t_always is defined as 10 degrees C in this subroutine, 
+!!                as are the parameters ::moisture_avail_tree and ::moisture_avail_grass 
+!!                (set to 1 and 0.6 respectively), which are used in the moisture condition 
+!!                (see ::pheno_moi onset model description). \n
+!!                The PFT-dependent GDD threshold (::gdd_crit) is calculated as in the onset 
+!!                model ::pheno_humgdd, using the equation:
+!!                \latexonly
+!!                \input{phenology_hummoigdd_gddcrit_eqn4.tex}
+!!                \endlatexonly
+!!                \n
+!!                The three GDDcrit parameters (::gdd(j,*)) are set for each PFT in 
+!!                ::stomate_data, and three tables defining each of the three critical GDD
+!!                parameters for each PFT is given in ::gdd_crit1_tab, ::gdd_crit2_tab and 
+!!                ::gdd_crit3_tab in ::stomate_constants. \n
+!!                The ::pheno_humgdd subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGES: None
+!!                
+!! MAIN OUTPUT VARIABLES: ::begin_leaves - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Chuine, I (2000), A unified model for the budburst of trees, Journal of 
+!! Theoretical Biology, 207, 337-347.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_humgdd.png}
+!! \endlatexonly
+!! \n             
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_humgdd (npts, j, PFTpresent, allow_initpheno, gdd, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       t2m_longterm, t2m_month, t2m_week, &
+       moiavail_week, moiavail_month, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts                    !! Domain size - number of grid cells 
+                                                                                        !! (unitless) 
+    INTEGER(i_std), INTENT(in)                               :: j                       !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent              !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno         !! are we allowed to declare the beginning 
+                                                                                        !! of the growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: gdd                     !! growing degree days, calculated since 
+                                                                                        !! leaves have fallen (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: maxmoiavail_lastyear    !! last year's maximum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: minmoiavail_lastyear    !! last year's minimum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_longterm            !! "long term" 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month               !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week                !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_week           !! "weekly" moisture availability 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_month          !! "monthly" moisture availability 
+                                                                                        !! (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves            !! signal to start putting leaves on 
+                                                                                        !! (true/false) 
+
+    !
+    !! 0.3 Modified variables
+    !
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                             :: moiavail_crit                   !! critical moisture availability 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                             :: tl                              !! long term temperature (C)
+    REAL(r_std), DIMENSION(npts)                             :: gdd_crit                        !! critical GDD (C)
+    INTEGER(i_std)                                           :: i                               !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering humgdd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of the onset model, the values of the  
+    !!     moisture availability parameters for tree and grass, and the value of the 
+    !!     critical monthly temperature.
+    !
+
+    IF ( firstcall_humgdd ) THEN
+
+       WRITE(numout,*) 'pheno_humgdd:'
+       WRITE(numout,*) '   > moisture availability above which moisture tendency doesn''t matter: '
+       WRITE(numout,*) '         trees (::moiavail_always_tree): ', moiavail_always_tree
+       WRITE(numout,*) '         grasses (::moiavail_always_grass): ', moiavail_always_grass
+       WRITE(numout,*) '   > monthly temp. above which temp. tendency doesn''t matter: ', &
+            t_always
+
+       firstcall_humgdd = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.3 check the critical values ::gdd and ::pheno_crit_hum_frac are defined.
+    !!     If not, stop.
+    !
+
+    IF ( ANY(pheno_gdd_crit(j,:) .EQ. undef) ) THEN
+
+       WRITE(numout,*) 'humgdd: pheno_gdd_crit is undefined for PFT (::j) ',j
+       CALL ipslerr_p(3,'stomate phenology','pheno_gdd_crit is undefined for this PFT','','')
+
+    ENDIF
+
+    IF ( hum_frac(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'humgdd: hum_frac is undefined for PFT (::j) ',j
+       CALL ipslerr_p(3,'stomate phenology','hum_frac is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(j) ) THEN
+       moiavail_always = moiavail_always_tree
+    ELSE
+       moiavail_always = moiavail_always_grass
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !!   The PFT has to be there, start of growing season must be allowed, 
+    !!   and GDD has to be defined.
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) .AND. &
+            ( gdd(i,j) .NE. undef )                           ) THEN
+
+          !! 2.1 Calculate the critical weekly moisture availability: depends linearly on the last year 
+          !! minimum and maximum moisture availabilities, and on the parameter ::hum_frac.,
+          !! (as in the ::pheno_hum model), as per the equation:
+
+          moiavail_crit(i) = minmoiavail_lastyear(i,j) + hum_frac(j) * &
+               ( maxmoiavail_lastyear(i,j) - minmoiavail_lastyear(i,j) )
+
+          !! 2.2 Calculate the critical GDD (::gdd_crit), which is a function of the PFT-dependent 
+          !!     critical GDD and the "long term" 2 meter air temperatures.  
+
+          tl(i) =  t2m_longterm(i) - ZeroCelsius
+          gdd_crit(i) = pheno_gdd_crit(j,1) + tl(i)*pheno_gdd_crit(j,2) + &
+               tl(i)*tl(i)*pheno_gdd_crit(j,3)
+          
+          !! 2.3 Determine if the growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     - Has the critical gdd been reached and is the temperature increasing?
+          !!     - Is there at least some humidity/moisture availability?
+          !!     This occurs if the critical gdd (::gdd_crit) has been reached 
+          !!     AND that is temperature increasing, which is true either if the monthly
+          !!     temperature being higher than the threshold ::t_always, OR if the weekly
+          !!     temperature is higher than the monthly, 
+          !!     AND finally that there is sufficient moisture availability, which is 
+          !!     the same condition as for the ::pheno_hum onset model.
+
+          IF ( ( gdd(i,j) .GE. gdd_crit(i) ) .AND. &
+               ( ( t2m_week(i) .GT. t2m_month(i) ) .OR. &
+               ( t2m_month(i) .GT. t_always )          ) .AND. &
+               ( ( ( moiavail_week(i,j)  .GE. moiavail_crit(i) ) .AND. &
+               ( moiavail_month(i,j) .LT. moiavail_crit(i) )        ) .OR. &
+               ( moiavail_month(i,j) .GE. moiavail_always )                   ) )  THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! End loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving humgdd'
+
+  END SUBROUTINE pheno_humgdd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_moigdd
+!!
+!>\BRIEF          The 'moigdd' onset model initiates leaf onset based on mixed temperature 
+!!                and moisture availability criteria.
+!!                Currently PFTs 10 - 13 (C3 and C4 grass, and C3 and C4 agriculture) 
+!!                are assigned to this model. 
+!!
+!! DESCRIPTION  : This onset model combines the GDD model (Chuine, 2000), as described for 
+!!                the 'humgdd' onset model (::pheno_humgdd), and the 'moi' model, in order 
+!!                to account for dependence on both temperature and moisture conditions in
+!!                warmer climates. \n
+!!                Leaf onset begins when the a PFT-dependent GDD threshold is reached.
+!!                In addition there are temperature and moisture conditions.
+!!                The temperature condition specifies that the monthly temperature has to be 
+!!                higher than a constant threshold (::t_always) OR
+!!                the weekly temperature is higher than the monthly temperature.
+!!                There has to be at least some moisture. The moisture condition 
+!!                is exactly the same as the 'moi' onset model (::pheno_moi), which has
+!!                already been described. \n
+!!                GDD is set to undef if beginning of the growing season detected.
+!!                As in the ::pheno_humgdd model, the parameter ::t_always is defined as 
+!!                10 degrees C in this subroutine, as are the parameters ::moisture_avail_tree
+!!                and ::moisture_avail_grass (set to 1 and 0.6 respectively), which are used
+!!                in the moisture condition (see ::pheno_moi onset model description). \n
+!!                The PFT-dependent GDD threshold (::gdd_crit) is calculated as in the onset 
+!!                model ::pheno_humgdd, using the equation:
+!!                \latexonly
+!!                \input{phenology_hummoigdd_gddcrit_eqn4.tex}
+!!                \endlatexonly
+!!                \n
+!!                where i and j are the grid cell and PFT respectively.
+!!                The three GDDcrit parameters (::gdd(j,*)) are set for each PFT in 
+!!                ::stomate_data, and three tables defining each of the three critical GDD
+!!                parameters for each PFT is given in ::gdd_crit1_tab, ::gdd_crit2_tab and 
+!!                ::gdd_crit3_tab in ::stomate_constants. \n
+!!                The ::pheno_moigdd subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): Added temperature threshold for C4 grass (pheno_moigdd_t_crit), Dan Zhu april 2015
+!!                
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Chuine, I (2000), A unified model for the budburst of trees, Journal of 
+!! Theoretical Biology, 207, 337-347.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!! - Still et al., Global distribution of C3 and C4 vegetation: Carbon cycle implications, 
+!! 2003, Global Biogeochemmical Cycles, DOI: 10.1029/2001GB001807. 
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_moigdd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_moigdd (npts, j, PFTpresent, allow_initpheno, gdd, &
+       time_hum_min, &
+       t2m_longterm, t2m_month, t2m_week, &
+       moiavail_week, moiavail_month, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts            !! Domain size - number of grid cells (unitless)
+    INTEGER(i_std), INTENT(in)                               :: j               !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to decalre the beginning of the 
+                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: gdd             !! growing degree days, calculated since leaves 
+                                                                                !! have fallen (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: time_hum_min    !! time elapsed since strongest moisture 
+                                                                                !! availability (days) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_longterm    !! "long term" 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month       !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week        !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_week   !! "weekly" moisture availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_month  !! "monthly" moisture availability (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves    !! signal to start putting leaves on (true/false)
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                             :: tl                              !! long term temperature (C)
+    REAL(r_std), DIMENSION(npts)                             :: gdd_crit                        !! critical GDD (C)
+    INTEGER(i_std)                                           :: i                               !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering moigdd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of the onset model, the values of the  
+    !!     moisture availability parameters for tree and grass, and the value of the 
+    !!     critical monthly temperature.
+    !
+
+    IF ( firstcall_moigdd ) THEN
+
+       WRITE(numout,*) 'pheno_moigdd:'
+       WRITE(numout,*) '   > moisture availability above which moisture tendency doesn''t matter: '
+       WRITE(numout,*) '         trees (::moiavail_always_tree) :', moiavail_always_tree
+       WRITE(numout,*) '         grasses (::moiavail_always_grass) :', moiavail_always_grass
+       WRITE(numout,*) '   > monthly temp. above which temp. tendency doesn''t matter (::t_always): ', &
+            t_always
+
+       firstcall_moigdd = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.3 check the critical values ::gdd and ::pheno_crit_hum_min_time are defined.
+    !!     If not, stop.
+    !
+
+    IF ( ANY(pheno_gdd_crit(j,:) .EQ. undef) ) THEN
+
+       WRITE(numout,*) 'moigdd: pheno_gdd_crit is undefined for PFT',j
+       CALL ipslerr_p(3,'stomate phenology','pheno_gdd is undefined for this PFT','','')
+
+    ENDIF
+
+    IF ( hum_min_time(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'moigdd: hum_min_time is undefined for PFT',j
+       CALL ipslerr_p(3,'stomate phenology','hum_min is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(j) ) THEN
+       moiavail_always = moiavail_always_tree
+    ELSE
+       moiavail_always = moiavail_always_grass
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !!    The PFT has to be there, the start of growing season must be allowed, 
+    !!    and GDD has to be defined.
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) .AND. &
+            ( gdd(i,j) .NE. undef )                           ) THEN
+          
+          !! 2.1 Calculate the critical GDD (::gdd_crit), which is a function of the PFT-dependent 
+          !!     critical GDD and the "long term" 2 meter air temperatures 
+          
+          tl(i) = t2m_longterm(i) - ZeroCelsius
+          gdd_crit(i) = pheno_gdd_crit(j,1) + tl(i)*pheno_gdd_crit(j,2) + &
+               tl(i)*tl(i)*pheno_gdd_crit(j,3)
+
+          !! 2.2 Determine if the growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     This occurs if the critical gdd (::gdd_crit) has been reached 
+          !!     AND that is temperature increasing, which is true either if the monthly
+          !!     temperature being higher than the threshold ::t_always, OR if the weekly
+          !!     temperature is higher than the monthly, 
+          !!     AND finally that there is sufficient moisture availability, which is 
+          !!     the same condition as for the ::pheno_moi onset model.
+          !!     AND when pheno_moigdd_t_crit is set(for C4 grass), if the average temperature threshold is reached
+
+          IF ( ( gdd(i,j) .GE. gdd_crit(i) ) .AND. &
+               ( ( t2m_week(i) .GT. t2m_month(i) ) .OR. &
+                 ( t2m_month(i) .GT. t_always )  ) .AND. &
+               ( ( ( time_hum_min(i,j) .GT. hum_min_time(j) ) .AND. &
+                 ( moiavail_week(i,j) .GT. moiavail_month(i,j) ) ) .OR. &
+                 ( moiavail_month(i,j) .GE. moiavail_always )  ) .AND. &
+               ( ( pheno_moigdd_t_crit(j) == undef ) .OR. &
+                 (t2m_month(i) .GT. (ZeroCelsius + pheno_moigdd_t_crit(j))) ) ) THEN
+
+             begin_leaves(i,j) = .TRUE.
+             
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving moigdd'
+
+  END SUBROUTINE pheno_moigdd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_ncdgdd
+!!
+!>\BRIEF          The Number of Chilling Days - Growing Degree Day (NCD-GDD) model initiates 
+!!                leaf onset if a certain relationship between the number of chilling days (NCD) 
+!!                since leaves were lost, and the growing degree days (GDD) since midwinter, is 
+!!                fulfilled. 
+!!                Currently PFT 6 (Temperate Broad-leaved Summergreen) and PFT 8 (Boreal Broad-
+!!                leaved Summergreen) are assigned to this model.
+!! 
+!! DESCRIPTION  : Experiments have shown that some
+!!                species have a "chilling" requirement, i.e. their physiology needs cold 
+!!                temperatures to trigger the mechanism that will allow the following budburst 
+!!                (e.g. Orlandi et al., 2004). 
+!!                An increase in chilling days, defined as a day with a daily mean air
+!!                temperature below a PFT-dependent threshold, reduces a plant's GDD demand 
+!!                (Cannell and Smith, 1986; Murray et al., (1989); Botta et al., 2000).
+!!                The GDD threshold therefore decreases as NCD 
+!!                increases, using the following empirical negative explonential law:
+!!                \latexonly
+!!                \input{phenology_ncdgdd_gddmin_eqn5.tex}
+!!                \endlatexonly
+!!                \n
+!!                The constants used have been calibrated against data CHECK FOR REFERENCE OR PERSON WHO DID UPDATE.
+!!                Leaf onset begins if the GDD is higher than the calculated minimum GDD
+!!                (dependent upon NCD) AND if the weekly temperature is higher than the monthly 
+!!                temperature. This is to ensure the temperature is increasing. \n
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                The NCD (::ncd_dormance) is calculated in ::stomate_season as  
+!!                the number of days with a temperature below a PFT-dependent constant threshold
+!!                (::ncdgdd_temp), starting from the beginning of the dormancy period
+!!                (::time_lowgpp>0), i.e. since the leaves were lost. \n
+!!                The growing degree day sum of the temperatures higher than 
+!!                ::ncdgdd_temp (GDD) since midwinter (::gdd_midwinter) 
+!!                is also calculated in ::stomate_season.
+!!                Midwinter is detected if the monthly temperature is lower than the weekly
+!!                temperature AND  the monthly temperature is lower than the long-term
+!!                temperature. ::gdd_minter is therefore set to 0 at the beginning of midwinter
+!!                and increased with each temperature greater than the PFT-dependent threshold.
+!!                When midsummer is detected (the opposite of the above conditions), 
+!!                ::gdd_midwinter is set to undef.
+!!                CHECK! WHEN TO START OF DORMANCY BEEN MODIFIED FROM BOTTA- ADD IN?
+!!                The ::pheno_ncdgdd subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!                
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) :
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Cannell, M.J.R. and R.I. Smith (1986), Climatic warming, spring budburst and
+!! frost damage on trees, Journal of Applied Ecology, 23, 177-191.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!! - Murray, M.B., G.R. Cannell and R.I. Smith (1989), Date of budburst of fifteen 
+!! tree species in Britain following climatic warming, Journal of Applied Ecology,
+!! 26, 693-700.
+!! - Orlandi, F., H. Garcia-Mozo, L.V. Ezquerra, B. Romano, E. Dominquez, C. Galan,
+!! and M. Fornaciari (2004), Phenological olive chilling requirements in Umbria
+!! (Italy) and Andalusia (Spain), Plant Biosystems, 138, 111-116. 
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_ncdgdd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_ncdgdd (npts, j, PFTpresent, allow_initpheno, &
+       ncd_dormance, gdd_midwinter, &
+       t2m_month, t2m_week, begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts            !! Domain size - number of grid cells (unitless)
+    INTEGER(i_std), INTENT(in)                               :: j               !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to declare the beginning of the 
+                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: ncd_dormance    !! number of chilling days since leaves were lost 
+                                                                                !! (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)          :: gdd_midwinter   !! growing degree days since midwinter (C)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month       !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week        !! "weekly" 2-meter temperatures (K)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves    !! signal to start putting leaves on (true/false)
+
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                           :: i               !! index (unitless)
+    REAL(r_std)                                              :: gdd_min         !! critical gdd (C)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering ncdgdd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.2 check the critical value ::ncdgdd_temp is defined.
+    !!     If not, stop.
+    !
+
+    IF ( ncdgdd_temp(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'ncdgdd: ncdgdd_temp is undefined for PFT (::j) ',j
+       CALL ipslerr_p(3,'stomate phenology','ncdgdd_temp this PFT','','')
+
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.    
+    !!    PFT has to be there and start of growing season must be allowed.
+    !
+
+    DO i = 1, npts ! loop over grid points
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) .AND. &
+            ( gdd_midwinter(i,j) .NE. undef ) .AND. &
+            ( ncd_dormance(i,j) .NE. undef )                  ) THEN
+
+          !! 2.1 Calculate the critical gdd, which is related to ::ncd_dormance
+          !!     using an empirical negative exponential law as described above.           
+
+          gdd_min = ( gddncd_ref / exp(gddncd_curve*ncd_dormance(i,j)) - gddncd_offset )
+
+          !! 2.2 Determine if the growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     This occurs if the critical GDD been reached AND the temperatures are increasing.
+          !!     If the growing season has started, ::gdd_midwinter is set to "undef". 
+
+          IF ( ( gdd_midwinter(i,j) .GE. gdd_min ) .AND. &
+               ( t2m_week(i) .GT. t2m_month(i) ) ) THEN
+             begin_leaves(i,j) = .TRUE.
+             gdd_midwinter(i,j)=undef
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving ncdgdd'
+
+  END SUBROUTINE pheno_ncdgdd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_ngd
+!!
+!>\BRIEF          The Number of Growing Days (NGD) leaf onset model initiates leaf onset if the NGD, 
+!!                defined as the number of days with temperature above a constant threshold, 
+!!                exceeds a critical value.
+!!                Currently PFT 9 (Boreal Leedleleaf Summergreen) is assigned to this model. 
+!!
+!! DESCRIPTION    The NGD model is a variant of the GDD model. The model was proposed by Botta et
+!!                al. (2000) for boreal and arctic biomes, and is designed to estimate 
+!!                leaf onset after the end of soil frost. 
+!!                The NDG (::ngd_minus5) is the number of days with a daily mean air 
+!!                temperature of greater than -5 degrees C, 
+!!                starting from the beginning of the dormancy period (i.e. time since the leaves 
+!!                were lost/GPP below a certain threshold).
+!!                Leaf onset begins if the NGD is higher than the PFT-dependent constant threshold, 
+!!                ::ngd,  AND if the weekly temperature is higher than the monthly 
+!!                temperature. \n
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                ::ngd_minus5 is also calculated in ::stomate_season. It is initialised at the
+!!                beginning of the dormancy period (::time_lowgpp>0), and increased by the 
+!!                stomate time step when the temperature > -5 degrees C. \n
+!!                ::ngd is set for each PFT in ::stomate_data, and a 
+!!                table defining the minimum NGD for each PFT is given in ::ngd_crit_tab
+!!                in ::stomate_constants. \n
+!!                The ::pheno_ngd subroutine is called in the subroutine ::phenology.      
+!!
+!! RECENT CHANGE(S): None
+!!                
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347. 
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_ngd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_ngd (npts, j, PFTpresent, allow_initpheno, ngd, &
+       t2m_month, t2m_week, begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts            !! Domain size - number of grid cells (unitless)
+    INTEGER(i_std), INTENT(in)                               :: j               !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to declare the beginning of the 
+                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: ngd             !! growing degree days (C)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month       !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week        !! "weekly" 2-meter temperatures (K)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves    !! signal to start putting leaves on (true/false)
+
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                           :: i               !! index (unitless)
+
+    !! =========================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering ngd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.2 check the critical value ::ngd_crit is defined.
+    !!     If not, stop.
+    !
+
+    IF ( ngd_crit(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'ngd: ngd_crit is undefined for PFT (::j) ',j
+       CALL ipslerr_p(3,'stomate phenology','ngd_crit is undefined for this PFT','','')
+
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !!    PFT has to be there and start of growing season must be allowed.
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) ) THEN
+
+          !! 2.1 Determine if the growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     This occurs if the critical NGD has been reached AND are temperatures increasing.
+
+          IF ( ( ngd(i,j) .GE. ngd_crit(j) ) .AND. &
+               ( t2m_week(i) .GT. t2m_month(i) )        ) THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving ngd'
+
+  END SUBROUTINE pheno_ngd
+
+END MODULE stomate_phenology
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_prescribe.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_prescribe.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_prescribe.f90	(revision 5166)
@@ -0,0 +1,351 @@
+! =================================================================================================================================
+! MODULE       : stomate_prescribe
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Initialize and update density, crown area.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_prescribe
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC prescribe,prescribe_clear
+
+    ! first call
+    LOGICAL, SAVE                                              :: firstcall_prescribe = .TRUE.
+!$OMP THREADPRIVATE(firstcall_prescribe)
+
+CONTAINS
+
+! =================================================================================================================================
+!! SUBROUTINE   : prescribe_clear
+!!
+!>\BRIEF        : Set the firstcall_prescribe flag back to .TRUE. to prepare for the next simulation.
+!_=================================================================================================================================
+
+  SUBROUTINE prescribe_clear
+    firstcall_prescribe=.TRUE.
+  END SUBROUTINE prescribe_clear
+
+!! ================================================================================================================================
+!! SUBROUTINE   : prescribe
+!!
+!>\BRIEF         Works only with static vegetation and agricultural PFT. Initialize biomass,
+!!               density, crown area in the first call and update them in the following.
+!!
+!! DESCRIPTION (functional, design, flags): \n
+!! This module works only with static vegetation and agricultural PFT.
+!! In the first call, initialize density of individuals, biomass, crown area,
+!! and leaf age distribution to some reasonable value. In the following calls,
+!! these variables are updated.
+!!
+!! To fulfill these purposes, pipe model are used:
+!! \latexonly 
+!!     \input{prescribe1.tex}
+!!     \input{prescribe2.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLES(S): ::ind, ::cn_ind, ::leaf_frac
+!!
+!! REFERENCES   :
+!! - Krinner, G., N. Viovy, et al. (2005). "A dynamic global vegetation model 
+!!   for studies of the coupled atmosphere-biosphere system." Global 
+!!   Biogeochemical Cycles 19: GB1015, doi:1010.1029/2003GB002199.
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!   plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!   global vegetation model, Global Change Biology, 9, 161-185.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE prescribe (npts, &
+                        veget_max, dt, PFTpresent, everywhere, when_growthinit, &
+                        biomass, leaf_frac, ind, cn_ind, co2_to_bm)
+
+!! 0. Parameters and variables declaration
+
+   !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: veget_max       !! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground (unitless;0-1)
+    REAL(r_std), INTENT(in)                                   :: dt              !! time step (dt_days)
+    !! 0.2 Output variables 
+
+    !! 0.3 Modified variables
+
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent      !! PFT present (0 or 1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! is the PFT everywhere in the grid box or very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit !! how many days ago was the beginning of the growing season (days)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass   !! biomass (gC/(m^2 of ground))
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! density of individuals (1/(m^2 of ground))
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: cn_ind          !! crown area per individual (m^2)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm       !! co2 taken up by carbohydrate 
+                                                                                 !! reserve at the beginning of the
+                                                                                 !! growing season @tex ($gC m^{-2} 
+                                                                                 !! of total ground/day$) @endtex 
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                              :: dia             !! stem diameter (m)
+    REAL(r_std), DIMENSION(npts)                              :: woodmass        !! woodmass (gC/(m^2 of ground))
+    REAL(r_std), DIMENSION(npts)                              :: woodmass_ind    !! woodmass of an individual (gC)
+    INTEGER(i_std)                                            :: i,j             !! index (unitless)
+
+!_ ================================================================================================================================
+
+    DO j = 2,nvm
+
+      ! only when the DGVM is not activated or agricultural PFT.
+
+      IF ( ( .NOT. ok_dgvm .AND. lpj_gap_const_mort ) .OR. ( .NOT. natural(j) ) ) THEN
+
+        !
+        !! 1.Update crown area
+        !
+
+        cn_ind(:,j) = zero
+
+        IF ( is_tree(j) ) THEN
+
+          !
+          !! 1.1 treat for trees
+          !
+
+          dia(:) = zero
+
+          DO i = 1, npts ! loop over grid points
+
+            IF ( veget_max(i,j) .GT. zero ) THEN
+
+              !! 1.1.1 calculate wood mass on an area basis, which include sapwood and heartwood aboveground and belowground.
+
+              woodmass(i) = (biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) + &
+                   biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon)) * veget_max(i,j)  
+
+              IF ( woodmass(i) .GT. min_stomate ) THEN
+
+                !! 1.1.2 calculate critical individual density
+!?? the logic for 1.1.3 and 1.1.2 is strange, it should be the case that first to calculate critical woodmass per individual,
+!?? then calculate critical density.
+
+
+                ! how to derive the following equation:
+                ! first, TreeHeight=pipe_tune2 * Diameter^{pipe_tune3}
+                ! we assume the tree is an ideal cylinder, so it volume is: Volume = pi*(Dia/2)^2*Height = pi/4 * Dia * pipe_tune2*Dia^{pipe_tune3} 
+                !                                                                  = pi/4 * pipe_tune2 * Dia^{2+pipe_tune3}
+                ! last, the woodmass_per_individual = pipe_density * Volume = pipe_density*pi/4.*pipe_tune2 * Dia^{2+pipe_tune3}             
+                ind(i,j) = woodmass(i) / &
+                           ( pipe_density*pi/4.*pipe_tune2 * maxdia(j)**(2.+pipe_tune3) )
+
+                !! 1.1.3 individual biomass corresponding to this critical density of individuals
+
+                woodmass_ind(i) = woodmass(i) / ind(i,j)
+
+                !! 1.1.4 calculate stem diameter per individual tree
+
+                dia(i) = ( woodmass_ind(i) / ( pipe_density * pi/4. * pipe_tune2 ) ) ** &
+                         ( un / ( 2. + pipe_tune3 ) )
+
+                !! 1.1.5 calculate provisional tree crown area for per individual tree
+
+                ! equation: CrownArea=pipe_tune1 * Diameter^{1.6}
+                cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** pipe_tune_exp_coeff
+
+                !! 1.1.6 If total tree crown area for this tree PFT exceeds its veget_max, tree density is recalculated.
+
+                IF ( cn_ind(i,j) * ind(i,j) .GT. 1.002* veget_max(i,j) ) THEN
+
+                  ind(i,j) = veget_max(i,j) / cn_ind(i,j)
+
+                ELSE
+
+                   ind(i,j) = ( veget_max(i,j) / &
+                        &     ( pipe_tune1 * (woodmass(i)/(pipe_density*pi/4.*pipe_tune2)) &
+                        &     **(pipe_tune_exp_coeff/(2.+pipe_tune3)) ) ) &
+                        &     ** (1./(1.-(pipe_tune_exp_coeff/(2.+pipe_tune3))))
+                   
+
+                  woodmass_ind(i) = woodmass(i) / ind(i,j)
+
+                  dia(i) = ( woodmass_ind(i) / ( pipe_density * pi/4. * pipe_tune2 ) ) ** &
+                           ( un / ( 2. + pipe_tune3 ) )
+
+                  ! final crown area
+                  cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** pipe_tune_exp_coeff
+
+                ENDIF
+
+              ELSE !woodmas=0  => impose some value
+
+                dia(:) = maxdia(j)
+
+                cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** pipe_tune_exp_coeff
+
+              ENDIF ! IF ( woodmass(i) .GT. min_stomate )
+
+            ENDIF    ! veget_max .GT. 0.
+
+          ENDDO      ! loop over grid points
+
+        ELSE !grass
+
+          !
+          !! 1.2 grasses: crown area always set to 1m**2
+          !
+
+          WHERE ( veget_max(:,j) .GT. zero )
+            cn_ind(:,j) = un
+          ENDWHERE
+
+        ENDIF   !IF ( is_tree(j) )
+
+        !
+        !! 2 density of individuals
+        !
+        
+        WHERE ( veget_max(:,j) .GT. zero )
+
+          ind(:,j) = veget_max(:,j) / cn_ind(:,j)  
+
+        ELSEWHERE
+
+          ind(:,j) = zero
+
+        ENDWHERE
+
+      ENDIF     ! IF ( ( .NOT. ok_dgvm .AND. lpj_gap_const_mort ) .OR. ( .NOT. natural(j) ) )
+
+    ENDDO       ! loop over PFTs
+
+    !
+    !!? it's better to move the code for first call at the beginning of the module.
+    !! 2 If it's the first call for this module, 
+    !
+
+    IF (( firstcall_prescribe ) .AND. (TRIM(stom_restname_in) == 'NONE')) THEN
+
+      WRITE(numout,*) 'prescribe:'
+
+      ! impose some biomass if zero and PFT prescribed
+
+      WRITE(numout,*) '   > Imposing initial biomass for prescribed trees, '// &
+                      'initial reserve mass for prescribed grasses.'
+      WRITE(numout,*) '   > Declaring prescribed PFTs present.'
+
+      DO j = 2,nvm ! loop over PFTs
+        DO i = 1, npts ! loop over grid points
+
+          ! is vegetation static or PFT agricultural?
+          ! Static vegetation or agricultural PFT
+          IF ( ( .NOT. ok_dgvm ) .OR. &
+               ( ( .NOT. natural(j) ) .AND. ( veget_max(i,j) .GT. min_stomate ) ) ) THEN
+
+            !
+            !! 2.1 if tree biomass is extremely small, prescribe the biomass by assuming they have sapling biomass, which is a constant in the model.
+            !!     then set all the leaf age as 1.
+            !
+            ! if tree PFT and biomass too small, prescribe the biomass to a value.
+            IF ( is_tree(j) .AND. &
+                 ( veget_max(i,j) .GT. min_stomate ) .AND. &
+                 ( SUM( biomass(i,j,:,icarbon) ) .LE. min_stomate ) ) THEN
+               !!? here the code is redundant, as "veget_max(i,j) .GT. min_stomate" is already met in the above if condition.
+               IF (veget_max(i,j) .GT. min_stomate) THEN
+                  biomass(i,j,:,icarbon) = (bm_sapl_rescale * bm_sapl(j,:,icarbon) * ind(i,j)) / veget_max(i,j)
+		  biomass(i,j,:,icarbon14) = biomass(i,j,:,icarbon)
+               ELSE
+                  biomass(i,j,:,icarbon) = zero
+		  biomass(i,j,:,icarbon14) = zero
+               ENDIF
+
+              ! set leaf age classes
+              leaf_frac(i,j,:) = zero
+              leaf_frac(i,j,1) = un
+
+              ! set time since last beginning of growing season
+              when_growthinit(i,j) = large_value
+
+              ! seasonal trees: no leaves at beginning
+
+              IF ( pheno_model(j) .NE. 'none' ) THEN
+
+                biomass(i,j,ileaf,icarbon) = zero
+		biomass(i,j,ileaf,icarbon14) = zero
+                leaf_frac(i,j,1) = zero
+
+              ENDIF
+
+              co2_to_bm(i,j) = co2_to_bm(i,j) + ( SUM(biomass(i,j,:,icarbon))  / dt )
+            ENDIF
+
+            !
+            !! 2.2 for grasses, set only the carbon reserve pool to "sapling" carbon reserve pool.
+            !!     and set all leaf age to 1.
+
+            IF ( ( .NOT. is_tree(j) ) .AND. &
+                 ( veget_max(i,j) .GT. min_stomate ) .AND. &
+                 ( SUM( biomass(i,j,:,icarbon) ) .LE. min_stomate ) ) THEN
+
+              biomass(i,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(i,j) / veget_max(i,j)
+	      biomass(i,j,icarbres,icarbon14) = biomass(i,j,icarbres,icarbon)
+
+              ! set leaf age classes
+              leaf_frac(i,j,:) = zero
+              leaf_frac(i,j,1) = un
+
+              ! set time since last beginning of growing season
+              when_growthinit(i,j) = large_value
+
+              co2_to_bm(i,j) = co2_to_bm(i,j) + ( biomass(i,j,icarbres,icarbon)  / dt )
+            ENDIF
+
+            !
+            !! 2.3 declare all PFTs with positive veget_max as present everywhere in that grid box
+            !
+
+            IF ( veget_max(i,j) .GT. min_stomate ) THEN
+              PFTpresent(i,j) = .TRUE.
+              everywhere(i,j) = un
+            ENDIF
+
+          ENDIF   ! not ok_dgvm  or agricultural
+
+        ENDDO ! loop over grid points
+      ENDDO ! loop over PFTs
+
+      firstcall_prescribe = .FALSE.
+
+    ENDIF
+
+  END SUBROUTINE prescribe
+
+END MODULE stomate_prescribe
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_resp.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_resp.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_resp.f90	(revision 5166)
@@ -0,0 +1,368 @@
+! =================================================================================================================================
+! MODULE           : stomate_resp
+!
+! CONTACT          : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE          : IPSL (2006)
+!                  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF           Calculates maintenance respiration for different plant components
+!!
+!!\n DESCRIPTION   : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	   :
+!!- McCree KJ. An equation for the respiration of white clover plants grown under controlled conditions. 
+!! In: Setlik I, editor. Prediction and measurement of photosynthetic productivity. Wageningen, The Netherlands: Pudoc; 1970. p. 221-229.
+!! - Krinner G, Viovy N, de Noblet-Ducoudre N, Ogee J, Polcher J, Friedlingstein P,
+!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
+!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
+!! doi: 10.1029/2003GB002199.\n
+!! Ruimy A., Dedieu G., Saugier B. (1996), TURC: A diagnostic model
+!! of continental gross primary productivity and net primary productivity,
+!! Global Biogeochemical Cycles, 10, 269-285.\n
+
+!! SVN :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+ 
+MODULE stomate_resp
+
+  ! modules used:
+  USE stomate_data
+  USE pft_parameters
+  USE constantes  
+  USE constantes_soil 
+
+  IMPLICIT NONE
+
+  ! private & public routines
+  PRIVATE
+  PUBLIC maint_respiration,maint_respiration_clear
+
+  LOGICAL, SAVE                                              :: firstcall_resp = .TRUE.                 !! first call
+!$OMP THREADPRIVATE(firstcall_resp)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: maint_respiration_clear
+!!
+!>\BRIEF        : Set the flag ::firstcall_resp to .TRUE. and as such activate section 
+!!                1.1 of the subroutine maint_respiration (see below).
+!_ ================================================================================================================================
+
+  SUBROUTINE maint_respiration_clear
+    firstcall_resp=.TRUE.
+  END SUBROUTINE maint_respiration_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: maint_respiration
+!!
+!>\BRIEF         Calculate PFT maintenance respiration of each living plant part by 
+!! multiplying the biomass of plant part by maintenance respiration coefficient which
+!! depends on long term mean annual temperature. PFT maintenance respiration is carbon flux 
+!! with the units @tex $(gC.m^{-2}dt_sechiba^{-1})$ @endtex, and the convention is from plants to the 
+!! atmosphere.
+!!
+!! DESCRIPTION : The maintenance respiration of each plant part for each PFT is the biomass of the plant 
+!! part multiplied by maintenance respiration coefficient. The biomass allocation to different 
+!! plant parts is done in routine stomate_alloc.f90. The maintenance respiration coefficient is 
+!! calculated in this routine.\n
+!!
+!! The maintenance respiration coefficient is the fraction of biomass that is lost during 
+!! each time step, which increases linearly with temperature (2-meter air temperature for aboveground plant
+!! tissues; root-zone temperature for below-ground tissues). Air temperature is an input forcing variable. 
+!! Root-zone temperature is a convolution of root and soil temperature profiles and also calculated 
+!! in this routine.\n
+!!
+!! The calculation of maintenance respiration coefficient (fraction of biomass respired) depends linearly
+!! on temperature:
+!! - the relevant temperature for different plant parts (air temperature or root-zone temperature)\n
+!! - intercept: prescribed maintenance respiration coefficients at 0 Degree Celsius for 
+!!   different plant parts for each PFT in routine stomate_constants.f90\n
+!! - slope: calculated with a quadratic polynomial with the multi-annual mean air temperature 
+!! (the constants are in routine stomate_constants.f90) as follows\n 
+!!    \latexonly
+!!      \input{resp3.tex} 
+!!    \endlatexonly
+!!   Where, maint_resp_slope1, maint_resp_slope2, maint_resp_slope3 are constant in stomate_constants.f90.
+!!   Then coeff_maint is calculated as follows:\n
+!!    \latexonly
+!!      \input{resp4.tex} 
+!!    \endlatexonly  
+!! If the calculation result is negative, maintenance respiration coefficient will take the value 0.
+!! Therefore the maintenance respiration will also be 0.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): PFT maintenance respiration of different plant parts (::resp_maint_part_radia)
+!!
+!! REFERENCE(S)	:
+!! McCree KJ. An equation for the respiration of white clover plants grown under controlled conditions. In: 
+!! Setlik I, editor. Prediction and measurement of photosynthetic productivity. Wageningen, 
+!! The Netherlands: Pudoc; 1970. p. 221-229.
+!! Krinner G, Viovy N, de Noblet-Ducoudre N, Ogee J, Polcher J, Friedlingstein P,
+!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
+!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
+!! doi: 10.1029/2003GB002199.\n
+!! Ruimy A., Dedieu G., Saugier B. (1996), TURC: A diagnostic model
+!! of continental gross primary productivity and net primary productivity,
+!! Global Biogeochemical Cycles, 10, 269-285.\n
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE maint_respiration ( npts,lai, t2m,t2m_longterm,stempdiag,height,veget_max,&
+       rprof,biomass,resp_maint_part_radia)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: npts      !! Domain size - number of grid cells (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)           :: t2m       !! 2 meter air temperature - forcing variable (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)           :: t2m_longterm !! Long term annual mean 2 meter reference air temperatures 
+                                                                       !! calculated in stomate_season.f90 (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT (in)     :: stempdiag !! Soil temperature of each soil layer (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)       :: height    !! height of vegetation (m)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)       :: veget_max !! PFT "maximal" coverage fraction of a PFT (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)       :: rprof     !! PFT root depth as calculated in stomate.f90 from parameter 
+                                                                    !! humcste which is root profile for different PFTs 
+                                                                    !! in slowproc.f90 (m)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: biomass   !! PFT total biomass calculated in stomate_alloc.f90 
+                                                                    !! @tex $(gC.m^{-2})$ @endtex
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)        :: lai                   !! PFT leaf area index @tex $(m^2 m^{-2})$ @endtex
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out) :: resp_maint_part_radia !! PFT maintenance respiration of different plant
+                                                                                  !! parts @tex $(gC.m^{-2}dt_sechiba^{-1} )$ @endtex
+
+    !! 0.3 Modified variables
+ 
+    !! 0.4 Local variables
+
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)    :: z_soil       !! Variable to store depth of the different soil layers (m)
+!$OMP THREADPRIVATE(z_soil)
+    REAL(r_std), DIMENSION(npts,nvm)        :: t_root               !! PFT root temperature (convolution of root and soil 
+                                                                    !! temperature profiles) (K)
+    REAL(r_std), DIMENSION(npts,nvm,nparts) :: coeff_maint          !! PFT maintenance respiration coefficients of different 
+                                                                    !! plant compartments at 0 deg C 
+                                                                    !! @tex $(g.g^{-1}dt_sechiba^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts)            :: rpc                  !! Scaling factor for integrating vertical soil 
+                                                                    !! profiles (unitless)
+    REAL(r_std), DIMENSION(npts,nparts)     :: t_maint_radia        !! Temperature which is pertinent for maintenance respiration, 
+                                                                    !! which is air/root temperature for above/below-ground 
+                                                                    !! compartments (K) 
+    REAL(r_std), DIMENSION(npts)            :: tl                   !! Long term reference temperature in degrees Celcius 
+                                                                    !! (= t2m_longterm - 273.15) (C)
+    REAL(r_std), DIMENSION(npts)            :: slope                !! slope of the temperature dependence of maintenance 
+                                                                    !! respiration coefficient (1/K)
+    INTEGER(i_std)                          :: i,j,k,l,m            !! Indeces (unitless)
+    INTEGER(i_std)                          :: ier                  !! Error handling 
+
+!_ ================================================================================================================================
+    
+    
+    IF (printlev>=3) WRITE(numout,*) 'Entering respiration'
+    
+ !! 1. Initializations
+    
+    IF ( firstcall_resp ) THEN
+
+       !! 1.1. Soil levels (first call only)
+       !       Set the depth of the different soil layers (number of layers: nbdl) 
+       !       previously calculated as variable diaglev in routines sechiba.f90 and slowproc.f90
+       ALLOCATE(z_soil(0:nbdl), stat=ier)
+       IF ( ier /= 0 ) CALL ipslerr_p(3,'maint_respiration','Pb in allocate of z_soil','','')
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+       !! 1.1.2. Write message
+       !         Notify user of the start of this subroutine
+       WRITE(numout,*) 'respiration:'
+
+       firstcall_resp = .FALSE.
+
+    ENDIF
+
+    
+    
+    !! 1.2. Calculate root temperature
+    !       Calculate root temperature as the convolution of root and soil temperature profiles
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! 1.2.1 Calculate rpc
+       !  - rpc is an integration constant to make the integral over the root profile is equal 'one', 
+       !    calculated as follows:\n
+       !  \latexonly
+       !    \input{resp1.tex} 
+       !  \endlatexonly
+       rpc(:) = un / ( un - EXP( -z_soil(nbdl) / rprof(:,j) ) )
+
+       !! 1.2.2 Calculate root temperature
+       !        - Integrate root profile temperature (K) over soil layers (number of layers = nbdl)
+       !          with rpc and soil temperature (K) of each soil layer as follows:\n
+       !        \latexonly
+       !          \input{resp2.tex} 
+       !        \endlatexonly
+       !        Where, stempdiag is diagnostic temperature profile of soil (K)\n
+       t_root(:,j) = zero
+
+       DO l = 1, nbdl ! Loop over # soil layers
+
+          t_root(:,j) = &
+               t_root(:,j) + stempdiag(:,l) * rpc(:) * &
+               ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) )
+
+       ENDDO ! Loop over # soil layers
+
+    ENDDO ! Loop over # PFTs
+
+ !! 2. Define maintenance respiration coefficients
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! 2.1 Temperature for maintenanace respiration
+       !      Temperature which is used to calculate maintenance respiration for different plant compartments
+       !      (above- and belowground)\n
+       !      - for aboveground parts, we use 2-meter air temperature, t2m\n
+       !      - for belowground parts, we use root temperature calculated in section 1.2 of this subroutine\n
+       
+       ! 2.1.1 Aboveground biomass
+       t_maint_radia(:,ileaf) = t2m(:)
+       t_maint_radia(:,isapabove) = t2m(:)
+       t_maint_radia(:,ifruit) = t2m(:)
+
+       ! 2.1.2 Belowground biomass
+       t_maint_radia(:,isapbelow) = t_root(:,j)
+       t_maint_radia(:,iroot) = t_root(:,j)
+
+       !! 2.1.3 Heartwood biomass
+       !        Heartwood does does not respire (coeff_maint_zero is set to zero)
+
+       t_maint_radia(:,iheartbelow) = t_root(:,j)
+       t_maint_radia(:,iheartabove) = t2m(:)
+
+       !! 2.1.4 Reserve biomass
+       !        Use aboveground temperature for trees and belowground temeperature for grasses
+       IF ( is_tree(j) ) THEN
+          t_maint_radia(:,icarbres) = t2m(:)
+       ELSE
+          t_maint_radia(:,icarbres) = t_root(:,j)
+       ENDIF
+
+       
+       !! 2.2 Calculate maintenance respiration coefficients (coeff_maint)
+       !      Maintenance respiration is a fraction of biomass defined by the coefficient 
+       !      coeff_maint [Mc Cree, 1969]. Coeff_maint is defined through a linear relationship of temperature [Ruimy et al, 1996]
+       !      which slope is the coefficient 'slope' and which intercept is 'coeff_maint_zero'.
+       !     - Coeff_maint_zero is defined in stomate_data to cm_zero_plantpartname
+       !     - Slope is calculated here through a second-degree polynomial [Krinner et al, 2005] 
+       !    equation that makes it dependent on the long term temperature (to represent adaptation
+       !    of the ecosystem to long term temperature).
+       !         \latexonly
+       !           \input{resp3.tex} 
+       !         \endlatexonly
+       !        Where, maint_resp_slope1, maint_resp_slope2, maint_resp_slope3 are constant in stomate_constants.f90.
+       !        Then coeff_maint is calculated as follows:\n
+       !         \latexonly
+       !           \input{resp4.tex} 
+       !         \endlatexonly
+       ! If the calculation result is negative, coeff_maint will take the value 0.\n	
+       tl(:) = t2m_longterm(:) - ZeroCelsius
+       slope(:) = maint_resp_slope(j,1) + tl(:) * maint_resp_slope(j,2) + &
+            tl(:)*tl(:) * maint_resp_slope(j,3)
+
+       DO k = 1, nparts ! Loop over # plant parts
+
+          coeff_maint(:,j,k) = &
+               MAX( (coeff_maint_zero(j,k)*dt_sechiba/one_day) * &
+               ( un + slope(:) * (t_maint_radia(:,k)-ZeroCelsius) ), zero )
+
+       ENDDO ! Loop over # plant parts
+
+    ENDDO ! Loop over # PFTs
+    
+ !! 3. Calculate maintenance respiration
+
+    ! The maintenance respiration @tex $(gC.m^{-2}dt_sechiba^{-1})$ @endtex of each plant compartment for each PFT is 
+    ! the biomass @tex $(gC.m^{-2})$ @endtex of the plant part multiplied by maintenance respiration 
+    ! coefficient @tex $(g.g^{-1}dt_sechiba^{-1})$ @endtex, except that the maintenance respiration of leaves is 
+    ! corrected by leaf area index (LAI) as follows:\n
+    ! \latexonly     
+    !   \input{resp5.tex} 
+    ! \endlatexonly
+
+    ! ibare_sechiba = 1, which means the there is only bare soil but not any PFT, consequently no LAI and
+    !  maintenance respiration
+    lai(:,ibare_sechiba) = zero
+    resp_maint_part_radia(:,ibare_sechiba,:) = zero
+    
+    DO j = 2,nvm ! Loop over # PFTs
+       
+       ! 3.1 Maintenance respiration of the different plant parts
+       lai(:,j) = biomass(:,j,ileaf,icarbon) * sla(j)
+
+       DO k = 1, nparts ! Loop over # plant parts
+
+          IF ( k .EQ. ileaf ) THEN
+
+             ! Leaves: respiration depends on leaf mass AND LAI.
+!!$                WHERE ( (biomass(:,j,ileaf) > min_stomate) .AND. (lai(:,j) > 0.0) .AND. (lai(:,j) < val_exp) )
+!!$                resp_maint_part_radia(:,j,k) = coeff_maint(:,j,k) * biomass(:,j,k) * &
+!!$                        ( .3*lai(:,j) + 1.4*(1.-exp(-.5*lai(:,j))) ) / lai(:,j)
+!!$             ELSEWHERE
+!!$                resp_maint_part_radia(:,j,k) = 0.0
+!!$             ENDWHERE
+             DO i = 1, npts ! Loop over # pixels
+                IF ( (biomass(i,j,ileaf,icarbon) > min_stomate) .AND. (lai(i,j) > min_stomate) ) THEN
+
+!$                         IF (lai(i,j) < 100._r_std) THEN
+!$                            resp_maint_part_radia(i,j,k) = coeff_maint(i,j,k) * biomass(i,j,k,icarbon) * &
+!$                                 ( .3*lai(i,j) + 1.4*(1.-exp(-.5*lai(i,j))) ) / lai(i,j)
+!$                         ELSE
+!$                            resp_maint_part_radia(i,j,k) = coeff_maint(i,j,k) * biomass(i,j,k,icarbon) * &
+!$                                 ( .3*lai(i,j) + 1.4 ) / lai(i,j)
+!$                         ENDIF
+
+                   ! Maintenance respiration is calculated as a fraction of biomass as defined by coeff_maint and 
+                   ! is adjusted for the nitrogen effect through a third factor depending on LAI. The hypothesis 
+                   ! here is that the vcmax (i.e. the nitrogen distribution) in the canopy decreases exponentially 
+                   ! with LAI following the Beer-Lambert law with an asymptote defining the minimum of the function
+                   ! at 30% of the LAI. The 1.4 parameter is an integration constant.
+                   ! This method is also used in diffuco_trans_co2 2.4.1 for scaling vmax based on nitrogen reduction 
+                   ! in the canopy.
+
+                   resp_maint_part_radia(i,j,k) = coeff_maint(i,j,k) * biomass(i,j,k,icarbon) * &
+                        ( maint_resp_min_vmax*lai(i,j) + maint_resp_coeff*(un - exp(-ext_coeff(j)*lai(i,j))) ) / lai(i,j)
+                ELSE
+                   resp_maint_part_radia(i,j,k) = zero
+                ENDIF
+             ENDDO ! Loop over # pixels
+          ELSE
+
+             resp_maint_part_radia(:,j,k) = coeff_maint(:,j,k) * biomass(:,j,k,icarbon)
+
+          ENDIF
+
+       ENDDO ! Loop over # plant parts
+
+       ! 3.2 Total maintenance respiration of the plant
+       !     VPP killer:
+       !     resp_maint(:,j) = SUM( resp_maint_part(:,:), DIM=2 )
+
+    ENDDO ! Loop over # PFTs
+
+
+  END SUBROUTINE maint_respiration
+
+END MODULE stomate_resp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_season.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_season.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_season.f90	(revision 5166)
@@ -0,0 +1,1484 @@
+! =================================================================================================================================
+! MODULE        : stomate_season
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module calculates long-term meteorological parameters from daily temperatures
+!! and precipitations (essentially for phenology). 
+!!      
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN          :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ =================================================================================================================================
+
+MODULE stomate_season
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters 
+  USE solar
+  USE grid
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC season,season_clear
+
+  LOGICAL, SAVE              :: firstcall_season = .TRUE.  !! first call (true/false)
+!$OMP THREADPRIVATE(firstcall_season)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : season_clear
+!!
+!>\BRIEF          Flag setting 
+!!
+!! DESCRIPTION  : This subroutine sets flags ::firstcall_season, to .TRUE., and therefore activates   
+!!                section 1.1 of the ::season subroutine which writes messages to the output. \n
+!!                This subroutine is called at the end of the subroutine ::stomate_clear, in the 
+!!                module ::stomate.
+!!
+!! RECENT CHANGE(S):None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::firstcall_season
+!!
+!! REFERENCE(S)  : None 
+!!
+!! FLOWCHART     : None
+!! \n             
+!_ =================================================================================================================================
+
+  SUBROUTINE season_clear
+    firstcall_season=.TRUE.
+  END SUBROUTINE season_clear
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : season
+!!
+!>\BRIEF          This subroutine calculates many of the long-term biometeorological variables
+!!                needed in the phenology subroutines and in the calculation of long-term vegetation
+!!                dynamics in the LPJ DGVM. 
+!!
+!! DESCRIPTION    This subroutine is called by the module ::stomate before LPJ, and mainly deals  
+!!                with the calculation of long-term meteorological variables, carbon fluxes and 
+!!                vegetation-related variables that are used to calculate vegetation dynamics 
+!!                in the stomate modules relating to the phenology and to the longer-term 
+!!                changes in vegetation type and fractional cover in the LPJ DGVM modules. \n
+!!                In sections 2 to 5, longer-term meteorological variables are calculated. The
+!!                long-term moisture availabilities are used in the leaf onset and senescence
+!!                phenological models ::stomate_phenology and ::stomate_turnover that require
+!!                a moisture condition. The long term temperatures are also required for phenology
+!!                but in addition they are used in calculations of C flux and the presence and
+!!                establishment of vegetation patterns on a longer timescale in the LPJ DGVM modules.
+!!                Finally the monthly soil humidity/relative soil moisture is used in the C
+!!                allocation module ::stomate_alloc. \n
+!!                Sections 12 to 14 also calculate long-term variables of C fluxes, including NPP,
+!!                turnover and GPP. The first two are used to calculate long-term vegetation 
+!!                dynamics and land cover change in the LPJ DVGM modules. The weekly GPP is used
+!!                to determine the dormancy onset and time-length, as described below. \n
+!!                The long-term variables described above are are used in certain vegetation
+!!                dynamics processes in order to maintain consistency with the basic hypotheses of the 
+!!                parameterisations of LPJ, which operates on a one year time step (Krinner et al., 2005).
+!!                In order to reduce the computer memory requirements, short-term variables (e.g. daily
+!!                temperatures) are not stored for averaging over a longer period. Instead
+!!                the long-term variables (e.g. monthly temperature) are calculated at each time step
+!!                using a linear relaxation method, following the equation:
+!!                \latexonly
+!!                \input{season_lin_relax_eqn1.tex}
+!!                \endlatexonly
+!!                \n 
+!!                The long-term variables are therefore updated on a daily basis. This method allows for 
+!!                smooth temporal variation of the long-term variables which are used to calculate 
+!!                vegetation dynamics (Krinner et al., 2005). \n
+!!                Sections 6 to 11 calculate the variables required for to determine leaf onset in
+!!                the module ::stomate_phenology. 
+!!                These include :
+!!                - the dormance onset and time-length, when GPP is below a certain threshold \n
+!!                - the growing degree days (GDD), which is the sum of daily temperatures greater than
+!!                -5 degrees C, either since the onset of the dormancy period, or since midwinter \n
+!!                - the number of chilling days, which is the number of days with a daily temperature
+!!                lower than a PFT-dependent threshold since the beginning of the dormancy period \n
+!!                - the number of growing days, which is the the number of days with a temperature
+!!                greater than -5 degrees C since the onset of the dormancy period \n
+!!                - the time since the minimum moisture availability in the dormancy period. \n
+!!                These variables are used to determine the conditions needed for the start of the
+!!                leaf growing season. The specific models to which they correspond are given below. \n
+!!                Sections 15 to 20 are used to update the maximum/minimum or the sum of various 
+!!                meteorological and biological variables during the year that are required for
+!!                calculating either leaf onset or longer-term vegetation dynamics the following year. \n
+!!                At the end of the year, these variables are updated from "thisyear" to "lastyear", 
+!!                in Section 21 of this subroutine, for use the following year. \n
+!!                Finally the probably amount of herbivore consumption is calculated in Section 22,
+!!                following McNaughton et al. (1989).
+!!
+!! RECENT CHANGE(S): None
+!!                
+!! MAIN OUTPUT VARIABLE(S): :: herbivores,
+!!                        :: maxmoiavail_lastyear, :: maxmoiavail_thisyear, 
+!!                        :: minmoiavail_lastyear, :: minmoiavail_thisyear, 
+!!                        :: maxgppweek_lastyear, :: maxgppweek_thisyear, 
+!!                        :: gdd0_lastyear, :: gdd0_thisyear, 
+!!                        :: precip_lastyear, :: precip_thisyear, 
+!!                        :: lm_lastyearmax, :: lm_thisyearmax, 
+!!                        :: maxfpc_lastyear, :: maxfpc_thisyear, 
+!!                        :: moiavail_month, :: moiavail_week, 
+!!                        :: t2m_longterm, :: t2m_month, :: t2m_week, 
+!!                        :: tsoil_month, :: soilhum_month, 
+!!                        :: npp_longterm, :: turnover_longterm, :: gpp_week, 
+!!                        :: gdd_m5_dormance, :: gdd_midwinter, 
+!!                        :: ncd_dormance, :: ngd_minus5, :: time_lowgpp, 
+!!                        :: time_hum_min, :: hum_min_dormance 
+!!      
+!! REFERENCES   : 
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!! - McNaughton, S.J., M. Oesterheld, D.A. Frank and K.J. Williams (1989), 
+!! Ecosystem-level patterns of primary productivity and herbivory in terrestrial
+!! habitats, Nature, 341, 142-144.
+!!                       
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{season_flowchart_part1.png}
+!! \includegraphics[scale = 1]{season_flowchart_part2.png}
+!! \includegraphics[scale = 1]{season_flowchart_part3.png}
+!! \endlatexonly
+!! \n   
+!_ =================================================================================================================================
+
+  SUBROUTINE season (npts, dt, EndOfYear, veget, veget_max, &
+       moiavail_daily, t2m_daily, tsoil_daily, soilhum_daily, lalo,  &
+       precip_daily, npp_daily, biomass, turnover_daily, gpp_daily, when_growthinit, &
+       maxmoiavail_lastyear, maxmoiavail_thisyear, &
+       minmoiavail_lastyear, minmoiavail_thisyear, &
+       maxgppweek_lastyear, maxgppweek_thisyear, &
+       gdd0_lastyear, gdd0_thisyear, &
+       precip_lastyear, precip_thisyear, &
+       lm_lastyearmax, lm_thisyearmax, &
+       maxfpc_lastyear, maxfpc_thisyear, &
+       moiavail_month, moiavail_week, t2m_longterm, tau_longterm, t2m_month, t2m_week, &
+       tsoil_month, soilhum_month, &
+       npp_longterm, turnover_longterm, gpp_week, &
+       gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       time_hum_min, hum_min_dormance, gdd_init_date , & 
+       gdd_from_growthinit, herbivores, &
+       Tseason, Tseason_length, Tseason_tmp, &
+       Tmin_spring_time, t2m_min_daily, begin_leaves, onset_date)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                             :: npts              !! Domain size - number of grid cells (unitless)
+    REAL(r_std), INTENT(in)                                :: dt                !! time step in days (dt_days)
+    LOGICAL, INTENT(in)                                    :: EndOfYear         !! update yearly variables? (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget             !! coverage fraction of a PFT. Here: fraction of 
+                                                                                !! total ground. (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget_max         !! "maximal" coverage fraction of a PFT (for LAI -> 
+                                                                                !! infinity) (0-1, unitless)Here: fraction of 
+                                                                                !! total ground. 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: moiavail_daily    !! Daily moisture availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: t2m_daily         !! Daily 2 meter temperature (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)          :: tsoil_daily       !! Daily soil temperature (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)          :: soilhum_daily     !! Daily soil humidity (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)             :: lalo              !!  array of lat/lon
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: precip_daily      !! Daily mean precipitation @tex ($mm day^{-1}$) 
+                                                                                !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: npp_daily         !! daily net primary productivity @tex ($gC m^{-2} 
+                                                                                !! day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: biomass     !! biomass @tex ($gC m^{-2} of ground$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover_daily  !! Turnover rates @tex ($gC m^{-2} day^{-1}$) 
+                                                                                !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: gpp_daily         !! daily gross primary productivity  
+                                                                                !! (Here: @tex $gC m^{-2} of total ground 
+                                                                                !! day^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: when_growthinit   !! how many days ago was the beginning of the 
+                                                                                !! growing season (days) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: begin_leaves      !! signal to start putting leaves on (true/false)
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: t2m_min_daily     !! Daily minimum 2-meter temperature (K)
+
+    !
+    !! 0.2 Output variables 
+    ! (diagnostic)
+    !
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)          :: herbivores        !! time constant of probability of a leaf to be 
+                                                                                !! eaten by a herbivore (days) 
+
+    !
+    !! 0.3 Modified variables
+    !
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxmoiavail_lastyear      !! last year's maximum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxmoiavail_thisyear      !! this year's maximum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: minmoiavail_lastyear      !! last year's minimum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: minmoiavail_thisyear      !! this year's minimum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxgppweek_lastyear       !! last year's maximum weekly GPP 
+                                                                                        !! @tex ($gC m^{-2} week^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxgppweek_thisyear       !! this year's maximum weekly GPP 
+                                                                                        !! @tex ($gC m^{-2} week^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: gdd0_lastyear             !! last year's annual GDD0 (C)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: gdd0_thisyear             !! this year's annual GDD0 (C)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: precip_lastyear           !! last year's annual precipitation 
+                                                                                        !! @tex ($mm year^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: precip_thisyear           !! this year's annual precipitation 
+                                                                                        !! @tex ($mm year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: lm_lastyearmax            !! last year's maximum leaf mass, for each 
+                                                                                        !! PFT @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: lm_thisyearmax            !! this year's maximum leaf mass, for each 
+                                                                                        !! PFT @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxfpc_lastyear           !! last year's maximum fpc for each PFT, on 
+                                                                                        !! ground (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxfpc_thisyear           !! this year's maximum fpc for each PFT, on 
+                                                                                        !! ground (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: moiavail_month            !! "monthly" moisture availability 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: moiavail_week             !! "weekly" moisture availability 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: t2m_longterm              !! "long term" 2-meter temperatures (K)
+    REAL(r_std), INTENT(inout)                             :: tau_longterm     
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: t2m_month                 !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: t2m_week                  !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: Tseason                   !! "seasonal" 2-meter temperatures (K), 
+                                                                                        !! used to constrain boreal treeline
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: Tseason_tmp               !! temporary variable to calculate Tseason 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: Tseason_length            !! temporary variable to calculate Tseason: 
+                                                                                        !! number of days when t2m_week is higher than 0 degree 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: Tmin_spring_time          !! Number of days after begin_leaves (leaf onset)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: onset_date                !! Date in the year at when the leaves started to grow(begin_leaves)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(inout)       :: tsoil_month               !! "monthly" soil temperatures (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(inout)       :: soilhum_month             !! "monthly" soil humidity (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: npp_longterm              !! "long term" net primary productivity 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: turnover_longterm !! "long term" turnover rate 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gpp_week                  !! "weekly" GPP @tex ($gC m^{-2} day^{-1}$) 
+                                                                                        !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gdd_m5_dormance           !! growing degree days above threshold -5 
+                                                                                        !! deg. C (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gdd_midwinter             !! growing degree days since midwinter (C)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: ncd_dormance              !! number of chilling days since leaves 
+                                                                                        !! were lost (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: ngd_minus5                !! number of growing days (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: time_hum_min              !! time elapsed since strongest moisture 
+                                                                                        !! availability (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: hum_min_dormance          !! minimum moisture during dormance 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,2), INTENT(inout)          :: gdd_init_date             !! inital date for gdd count
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gdd_from_growthinit       !! growing degree days, threshold 0 deg. C 
+                                                                                        !! since beginning of season
+
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                          :: j                        !! indices (unitless)
+    REAL(r_std)                                             :: ncd_max                  !! maximum ncd (to avoid floating point 
+                                                                                        !! underflows) (days) 
+    REAL(r_std), DIMENSION(npts)                            :: sumfpc_nat               !! sum of natural fpcs (0-1, unitless)
+                                                                                        !! [DISPENSABLE] 
+    REAL(r_std), DIMENSION(npts,nvm)                        :: weighttot                !! weight of biomass @tex ($gC m^{-2}$) 
+                                                                                        !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                        :: nlflong_nat              !! natural long-term leaf NPP 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                        :: green_age                !! residence time of green tissue (years)
+    REAL(r_std), DIMENSION(npts)                            :: consumption              !! herbivore consumption 
+                                                                                        !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts)                            :: fracnat                  !! fraction of each gridcell occupied by 
+                                                                                        !! natural vegetation (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                            :: solad                    !! maximal radation during current day 
+                                                                                        !! (clear sky condition)
+    REAL(r_std), DIMENSION(npts)                            :: solai                    !! maximal radation during current day
+                                                                                        !! (clear sky condition)
+    REAL(r_std), DIMENSION(npts)                            :: cloud                    !! cloud fraction
+
+!_ =================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering season'
+
+    !
+    !! 1. Initializations
+    !! 1.1 Calculate ::ncd_max - the maximum possible NCD (number of chilling days) as:
+    !!     \latexonly
+    !!     \input{season_ncdmax_eqn2.tex}
+    !!     \endlatexonly
+    !!     \n
+    !!     where one_year is 1 year in seconds (defined in ::constantes).
+    !
+    ncd_max = ncd_max_year * one_year
+
+    IF ( firstcall_season ) THEN
+
+       !
+       !! 1.2 first call - output message giving the setting of the ::gppfrac_dormance,
+       !!     ::hvc1, ::hvc2 and ::leaf_frac (as a percentage) parameters which are 
+       !!     defined at the beginning of this subroutine. Also outputs the value of 
+       !!     ::ncd_max.
+       !
+
+       IF ( printlev>=1 ) THEN
+
+          WRITE(numout,*) 'season: '
+
+          WRITE(numout,*) '   > maximum GPP/GGP_max ratio for dormance (::gppfrac_dormance) :',gppfrac_dormance !*
+
+          WRITE(numout,*) '   > maximum possible ncd(days) (::ncd_max) : ',ncd_max !*
+
+          WRITE(numout,*) '   > herbivore consumption C (gC/m2/d) as a function of NPP (gC/m2/d): (::hvc1) (::hvc2)' !*
+          WRITE(numout,*) '     C=',hvc1,' * NPP^',hvc2
+          WRITE(numout,*) '   > for herbivores, suppose that (::leaf_frac_hvc)',leaf_frac_hvc*100., &
+               '% of NPP is allocated to leaves'
+
+       ENDIF
+
+       !
+       !! 1.3 Check whether longer-term meteorological and phenology-related variables are not initialized
+       !!     to less than zero. If the following meteorological variables are less than ::min_stomate which is set 
+       !!     to 1.E-8 in ::grid, then they are set to the current daily value. If the phenology-
+       !!     related variables are less than ::min_stomate, they are set to "undef". 
+       !!     Warning messages are output in each case, and are also output if "long-term" C fluxes GPP,
+       !!     NPP and turnover are less than ::min_stomate.
+       !
+
+       !! 1.3.1 moisture availabilities (i.e. relative soil moisture, including the root soil profile):
+
+       !! 1.3.1.1 "monthly" (::moiavail_month)
+       !MM PAS PARALLELISE!!
+       IF ( ABS( SUM( moiavail_month(:,2:nvm) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them it today's moisture availability
+          WRITE(numout,*) 'Warning! We have to initialize the ''monthly'' moisture availabilities. '
+          moiavail_month(:,:) = moiavail_daily(:,:)
+
+       ENDIF
+
+       !! 1.3.1.2 "weekly" (::moiavail_week)
+
+       IF ( ABS( SUM( moiavail_week(:,2:nvm) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them it today's moisture availability
+          WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' moisture availabilities. '
+          moiavail_week(:,:) = moiavail_daily(:,:)
+
+       ENDIF
+
+       !! 1.3.2 2-meter temperatures:
+
+       !!  "monthly" (::t2m_month)
+       IF ( ABS( SUM( t2m_month(:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's temperature
+          WRITE(numout,*) 'Warning! We have to initialize the ''monthly'' 2m temperatures.'
+          t2m_month(:) = t2m_daily(:)
+
+       ENDIF
+
+       !!  "weekly" (::2m_week)
+       IF ( ABS( SUM( t2m_week(:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's temperature
+          WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' 2m temperatures.'
+          t2m_week(:) = t2m_daily(:)
+
+       ENDIF
+
+       !! 1.3.3 "monthly" soil temperatures (::tsoil_month):
+       !MM PAS PARALLELISE!!
+       IF ( ABS( SUM( tsoil_month(:,:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's temperature
+          WRITE(numout,*) 'Warning!'// &
+               ' We have to initialize the ''monthly'' soil temperatures.'
+          tsoil_month(:,:) = tsoil_daily(:,:)
+
+       ENDIF
+
+       !! 1.3.4 "monthly" soil humidity (::soilhum_month):
+       IF ( ABS( SUM( soilhum_month(:,:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's humidity
+          WRITE(numout,*) 'Warning!'// &
+               ' We have to initialize the ''monthly'' soil humidity.'
+          soilhum_month(:,:) = soilhum_daily(:,:)
+
+       ENDIF
+
+       !! 1.3.5 growing degree days, threshold -5 deg C (::gdd_m5_dormance):
+       IF ( ABS( SUM( gdd_m5_dormance(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Growing degree days (-5 deg) are initialized to ''undef''.'
+          gdd_m5_dormance(:,:) = undef
+       ENDIF
+
+       !! 1.3.6 growing degree days since midwinter (::gdd_midwinter):
+       IF ( ABS( SUM( gdd_midwinter(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Growing degree days since midwinter' // &
+               ' are initialized to ''undef''.'
+          gdd_midwinter(:,:) = undef
+       ENDIF
+
+       !! 1.3.7 number of chilling days since leaves were lost (::ncd_dormance):
+       IF ( ABS( SUM( ncd_dormance(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Number of chilling days is initialized to ''undef''.'
+          ncd_dormance(:,:) = undef
+       ENDIF
+
+       !! 1.3.8 number of growing days, threshold -5 deg C (::ngd_minus5):
+       IF ( ABS( SUM( ngd_minus5(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Number of growing days (-5 deg) is initialized to 0.'
+       ENDIF
+
+       !! 1.3.9 "long term" npp (::npp_longterm):
+       IF ( ABS( SUM( npp_longterm(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Long term NPP is initialized to 0.'
+       ENDIF
+
+       !! 1.3.10 "long term" turnover (::turnover_longterm):
+       IF ( ABS( SUM( turnover_longterm(:,2:nvm,:,icarbon) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Long term turnover is initialized to 0.'
+       ENDIF
+
+       !! 1.3.11 "weekly" GPP (::gpp_week):
+       IF ( ABS( SUM( gpp_week(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Weekly GPP is initialized to 0.'
+       ENDIF
+
+       !! 1.3.12 minimum moisture availabilities (::minmoiavail_thisyear)
+       !!        In this case, if the minimum moisture
+       !!        is less than ::min_stomate, the variable is set to ::large_value,
+       !!        which is defined in ::stomate_constants as 1.E33_r_std:
+       IF ( ABS( SUM( minmoiavail_thisyear(:,2:nvm) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to a very high value
+          WRITE(numout,*) 'Warning! We have to initialize this year''s minimum '// &
+               'moisture availabilities.'
+          minmoiavail_thisyear(:,:) = large_value
+
+       ENDIF
+
+       !
+       !! 1.4 reset firstcall_season flag
+       !
+
+       firstcall_season = .FALSE.
+
+    ENDIF
+
+    ! determine min yearly clear sky radiation (solstice) as beginning for gdd count
+    cloud(:) = zero
+    CALL downward_solar_flux (npts, lalo(:,1),calendar_str,julian_diff,12.,cloud,1,solad,solai)
+
+    WHERE (solad(:) .LT. gdd_init_date(:,2))
+       gdd_init_date(:,1)= julian_diff
+       gdd_init_date(:,2)= solad(:)
+    ENDWHERE
+
+
+    !
+    !! NOTE: Sections 2. to 5. compute slowly-varying, "long-term" (i.e. weekly/monthly)
+    !! input variables using a linear relaxation method, following the equation:
+    !! \latexonly
+    !! \input{season_lin_relax_eqn1.tex}
+    !! \endlatexonly
+    !! \n 
+    !! as described in the introduction to this subroutine (see Krinner et al., 2005).  
+    !! The time constant in the above equation is given for each of the variables
+    !! described.
+    !
+
+    !
+    !! 2. Moisture availability (relative soil moisture, including the root profile) :
+    !!    The time constants (as in the above equation) for these calculations are 
+    !!    given by the parameters ::tau_hum_month (for the monthly
+    !!    calculation) or ::tau_hum_week (for the weekly),
+    !!    which are set in ::stomate_data to be 20 and 7 days respectively.
+    !!    If the moisture availability is less than zero, it is set to zero. 
+    !!    These variables are mostly used in the phenological leaf onset and senescence
+    !!    models in the modules ::stomate_phenology and ::stomate_turnover, 
+    !!    respectively. They are used in models which require a moisture limitation
+    !!    condition. These are the 'hum', 'moi', 'humgdd' and 'moigdd' onset models,
+    !!    and the 'mixed' and 'dry' (weekly only) senescence models. In addition,
+    !!    the weekly moisture availability is used to calculate the limitation
+    !!    on the fraction of NPP allocated to different compartments in the module
+    !!    ::stomate_alloc. 
+    !
+
+    !
+    !! 2.1 "monthly" (::moiavail_month)
+    !
+
+    moiavail_month = ( moiavail_month * ( tau_hum_month - dt ) + &
+         moiavail_daily * dt ) / tau_hum_month
+
+    DO j = 2,nvm  ! Loop over # PFTs
+       WHERE ( ABS(moiavail_month(:,j)) .LT. EPSILON(zero) )
+          moiavail_month(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 2.2 "weekly" (::moiavail_week)
+    !
+
+    moiavail_week = ( moiavail_week * ( tau_hum_week - dt ) + &
+         moiavail_daily * dt ) / tau_hum_week
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(moiavail_week(:,j)) .LT. EPSILON(zero) ) 
+          moiavail_week(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 3. 2-meter temperatures
+    !!    The time constants for the "long-term", "monthly" and "weekly" 2-meter
+    !!    temperatures are given by the parameters ::tau_longterm_max, 
+    !!    ::tau_t2m_month, and ::tau_t2m_week,
+    !!    which are set in ::stomate_data to be 3 * one year (in seconds, as 
+    !!    described above) and 20 and 7 days respectively.
+    !!    If the temperature is less than zero, it is set to zero.
+    !!    In addition the "long term" temperature is written to the history file. \n
+    !!    These variables are used in many different modules of STOMATE. 
+    !!    The longterm t2m is limied to the intervall [tlong_ref_min, tlong_ref_max]
+    !!    using the equation:
+    !!      \latexonly
+    !!      \input{season_t2m_long_ref_eqn3.tex}
+    !!      \endlatexonly
+    !!      \n
+    !!    The "monthly" and "weekly" temperature is used in the modules 
+    !!    ::stomate_phenology and ::stomate_turnover for the onset and senescence 
+    !!    phenological models which require a temperature condition. In addition
+    !!    the "monthly" temperature is used in ::lpj_constraints to determine 
+    !!    the presence and regeneration of the vegetation and in the module
+    !!    ::stomate_assimtemp to calculate photosynthesis temperatures.
+        
+    ! Update tau_longterm
+    tau_longterm = MIN(tau_longterm+dt,tau_longterm_max)
+    
+    ! Recalculate the reference temperature using the old reference temperature and the current temperature
+    t2m_longterm(:) = ( t2m_longterm(:) * ( tau_longterm - dt ) + &
+         t2m_daily(:) * dt ) / tau_longterm
+
+    ! The longterm reference is not allowed to go outside the interval [tlong_ref_min, tlong_ref_max]
+    t2m_longterm(:) = MAX( tlong_ref_min, MIN( tlong_ref_max, t2m_longterm(:) ) )
+
+    CALL xios_orchidee_send_field("T2M_LONGTERM",t2m_longterm)
+
+    CALL histwrite_p (hist_id_stomate, 'T2M_LONGTERM', itime, &
+         t2m_longterm, npts, hori_index)
+
+    !
+    !! 3.3 "monthly" (::t2m_month)
+    !
+
+    t2m_month = ( t2m_month * ( tau_t2m_month - dt ) + &
+         t2m_daily * dt ) / tau_t2m_month
+
+    WHERE ( ABS(t2m_month(:)) .LT. EPSILON(zero) )
+       t2m_month(:) = zero
+    ENDWHERE
+
+    ! Store the day in onset_date when the leaves started grow. julian_diff is the day in the year [1-366].
+    WHERE ( begin_leaves(:,:) )
+       onset_date(:,:)=julian_diff
+    ELSEWHERE
+       onset_date(:,:)=0
+    ENDWHERE
+    
+    ! Calculate "seasonal" temperature
+    WHERE ( t2m_week (:) .GT. ZeroCelsius )
+       Tseason_tmp(:) = Tseason_tmp(:) + t2m_week(:)
+       Tseason_length(:)=Tseason_length(:) + dt
+    ENDWHERE
+
+    ! calculate Tmin in spring (after onset)
+    DO j=1, nvm
+       IF (leaf_tab(j)==1 .AND. pheno_type(j)==2) THEN
+          ! leaf_tab=broadleaf and pheno_typ=summergreen
+          ! Only treat broadleag and summergreen pfts
+          
+          WHERE ( Tmin_spring_time(:,j)>0 .AND. (Tmin_spring_time(:,j)<spring_days_max) )
+             Tmin_spring_time(:,j)=Tmin_spring_time(:,j)+1
+          ELSEWHERE
+             Tmin_spring_time(:,j)=0
+          ENDWHERE
+          
+          WHERE ( begin_leaves(:,j) )
+             Tmin_spring_time(:,j)=1
+          ENDWHERE
+       END IF
+    END DO
+
+    !
+    !! 3.4 "weekly" (::t2m_week)
+    !
+
+    t2m_week = ( t2m_week * ( tau_t2m_week - dt ) + &
+         t2m_daily * dt ) / tau_t2m_week
+
+    WHERE ( ABS(t2m_week(:)) .LT. EPSILON(zero) )
+       t2m_week(:) = zero
+    ENDWHERE
+
+    !
+    !! 4. "monthly" soil temperatures (::tsoil_month)
+    !!    The time constant is given by the parameter ::tau_tsoil_month, 
+    !!    which is set in ::stomate_data to be 20 days.
+    !!    If the monthly soil temperature is less than zero, it is set to zero. \n
+    !!    This variable is used in the ::stomate_allocation module.
+    !
+
+    tsoil_month = ( tsoil_month * ( tau_tsoil_month - dt ) + &
+         tsoil_daily(:,:) * dt ) / tau_tsoil_month
+
+    WHERE ( ABS(tsoil_month(:,:)) .LT. EPSILON(zero) )
+       tsoil_month(:,:) = zero
+    ENDWHERE
+
+    !
+    !! 5. ''monthly'' soil humidity (or relative soil moisture - ::soilhum_month) 
+    !!    The time constant is given by the parameter ::tau_soilhum_month, 
+    !!    which is set in ::stomate_data to be 20 days.
+    !!    If the monthly soil humidity is less than zero, it is set to zero.
+    !
+
+    soilhum_month = ( soilhum_month * ( tau_soilhum_month - dt ) + &
+         soilhum_daily * dt ) / tau_soilhum_month
+
+    WHERE ( ABS(soilhum_month(:,:)) .LT. EPSILON(zero) )
+       soilhum_month(:,:) = zero
+    ENDWHERE
+
+    !
+    !! 6. Calculate the dormance time-length (::time_lowgpp).
+    !!    The dormancy time-length is increased by the stomate time step when   
+    !!    the weekly GPP is below one of two thresholds, 
+    !!    OR if the growing season started more than 2 years ago AND the amount of biomass
+    !!    in the carbohydrate reserve is 4 times as much as the leaf biomass.
+    !!    i.e. the plant is declared dormant if it is accumulating carbohydrates but not 
+    !!    using them, so that the beginning of the growing season can be detected .
+    !     This last condition was added by Nicolas Viovy.
+    !!    - NV: special case (3rd condition)
+    !!    Otherwise, set ::time_lowgpp to zero. \n
+    !!    The weekly GPP must be below either the parameter ::min_gpp_allowed, which is set at 
+    !!    the beginning of this subroutine to be 0.3gC/m^2/year, 
+    !!    OR it must be less than last year's maximum weekly GPP multiplied by the
+    !!    maximal ratio of GPP to maximum GPP (::gppfrac_dormance), which is set to 0.2 at the 
+    !!    beginning of this subroutine. \n
+    !!    This variable is used in the ::stomate_phenology module to allow the detection of the
+    !!    beginning of the vegetation growing season for different onset models.
+    !!    Each PFT is looped over.
+    !
+    !NVMODIF
+!!$    DO j = 2,nvm ! Loop over # PFTs
+!!$       WHERE ( ( gpp_week(:,j) .LT. min_gpp_allowed ) .OR. & 
+!!$            ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. &
+!!$            ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. &
+!!$            ( biomass(:,j,icarbres,icarbon) .GT. biomass(:,j,ileaf,icarbon)*4. ) ) )
+!!$          !       WHERE ( ( gpp_week(:,j) .EQ. zero ) .OR. & 
+!!$          !            ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. &
+!!$          !            ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. &
+!!$          !            ( biomass(:,j,icarbres,icarbon) .GT. biomass(:,j,ileaf,icarbon)*4. ) ) )
+!!$       
+!!$          time_lowgpp(:,j) = time_lowgpp(:,j) + dt
+!!$          
+!!$       ELSEWHERE
+!!$          
+!!$          time_lowgpp(:,j) = zero
+!!$
+!!$       ENDWHERE
+!!$    ENDDO
+
+    !
+    !! 7. Calculate the growing degree days (GDD - ::gdd_m5_dormance).
+    !!    This variable is the GDD sum of the temperatures higher than -5 degrees C.
+    !!    It is inititalised to 0 at the beginning of the dormancy period (i.e.
+    !!    when ::time_lowgpp>0), and is set to "undef" when there is GPP 
+    !!    (::time_lowgpp=0), as it is not used during the growing season. \n 
+    !!    ::gdd_m5_dormance is further scaled by (::tau_gdd -dt / ::tau_gdd), 
+    !!    - ::tau_gdd is set to 40. in the module ::stomate_constants. \n
+    !     Nicolas Viovy - not sure why this is...
+    !!    This variable is used in the ::stomate_phenology module for the 
+    !!    'humgdd' and 'moigdd' leaf onset models. \n
+    !!    Each PFT is looped over but ::gdd_m5_dormance is only calculated for 
+    !!    those PFTs for which a critical GDD is defined, i.e. those which are 
+    !!    assigned to the 'humgdd' or 'moigdd' models. \n
+    !!    Finally if GDD sum is less than zero, then it is set to zero. 
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF (.NOT. natural(j)) THEN
+          ! reset counter: start of the growing season
+          WHERE ((when_growthinit(:,j) .EQ. zero))
+	     gdd_from_growthinit(:,j) = zero
+	  ENDWHERE
+          ! increase gdd counter
+          WHERE ( t2m_daily(:) .GT. (ZeroCelsius)  )
+             gdd_from_growthinit(:,j) = gdd_from_growthinit(:,j) + &
+                                 dt * ( t2m_daily(:) - (ZeroCelsius) )
+          ENDWHERE
+       ELSE
+          gdd_from_growthinit(:,j) = undef
+       ENDIF
+
+       ! only for PFTs for which critical gdd is defined
+       ! gdd_m5_dormance is set to 0 at the end of the growing season. It is set to undef
+       ! at the beginning of the growing season.
+
+       IF ( ALL(pheno_gdd_crit(j,:) .NE. undef) ) THEN
+
+          !
+          !! 7.1 set to zero if undefined and there is no GPP
+          !
+
+          WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+
+             gdd_m5_dormance(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 7.2 set to undef if there is GPP
+          !
+
+          WHERE ( when_growthinit(:,j) .EQ. zero )
+
+             gdd_m5_dormance(:,j) = undef
+
+          ENDWHERE
+
+          !
+          !! 7.3 normal update as described above where ::gdd_m5_dormance is defined (not set to "undef").
+          !
+
+          WHERE ( ( t2m_daily(:) .GT. ( ZeroCelsius - gdd_threshold ) ) .AND. &
+               ( gdd_m5_dormance(:,j) .NE. undef )           )
+             gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) + &
+                  dt * ( t2m_daily(:) - ( ZeroCelsius - gdd_threshold ) )
+          ENDWHERE
+
+          WHERE ( gdd_m5_dormance(:,j) .NE. undef ) 
+             gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) * &
+                  ( tau_gdd - dt ) / tau_gdd
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 7.4 Set to zero if GDD is less than zero.
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(gdd_m5_dormance(:,j)) .LT. EPSILON(zero) )
+          gdd_m5_dormance(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 8. Calculate the growing degree days (GDD) since midwinter (::gdd_midwinter)
+    !!    This variable represents the GDD sum of temperatures higher than a PFT-dependent
+    !!    threshold (::ncdgdd_temp), since midwinter.
+    !!    Midwinter is detected if the monthly temperature (::t2m_month) is lower than the weekly 
+    !!    temperature (::t2m_week) AND if the monthly temperature is lower than the long-term 
+    !!    temperature (t2m_longterm). These variables were calculated earlier in this subroutine. \n
+    !!    ::gdd_midwinter is initialised to 0.0 when midwinter is detected, and from then on 
+    !!    increased with each temperature greater than ::ncdgdd_temp, which is defined
+    !!    in the module ::stomate_constants. \n
+    !!    ::gdd_midwinter is set to "undef" when midsummer is detected, following the opposite
+    !!    conditions to those used to define midwinter. \n
+    !!    The variable is used in the ::stomate_phenology module for the leaf onset model 'ncdgdd'.
+    !!    Each PFT is looped over but the ::gdd_midwinter is only calculated for those
+    !!    PFTs for which a critical 'ncdgdd' temperature is defined, i.e. those which are 
+    !!    assigned to the 'ncdgdd' model. \n
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       ! only for PFTs for which ncdgdd_crittemp is defined
+
+       IF ( ncdgdd_temp(j) .NE. undef ) THEN
+
+          !
+          !! 8.1 set to 0 if undef and if we detect "midwinter"
+          !
+
+!!$          WHERE ( ( gdd_midwinter(:,j) .EQ. undef ) .AND. &
+!!$               ( t2m_month(:) .LT. t2m_week(:) ) .AND. &
+!!$               ( t2m_month(:) .LT. t2m_longterm(:) )    )
+          WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+
+             gdd_midwinter(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 8.2 set to undef if we detect "midsummer"
+          !
+
+          WHERE ( ( t2m_month(:) .GT. t2m_week(:) ) .AND. &
+               ( t2m_month(:) .GT. t2m_longterm(:) )    )
+
+             gdd_midwinter(:,j) = undef
+
+          ENDWHERE
+
+          !
+          !! 8.3 normal update as described above
+          !
+
+          WHERE ( ( gdd_midwinter(:,j) .NE. undef ) .AND. &
+               ( t2m_daily(:) .GT. ncdgdd_temp(j)+ZeroCelsius ) )
+
+             gdd_midwinter(:,j) = &
+                  gdd_midwinter(:,j) + &
+                  dt * ( t2m_daily(:) - ( ncdgdd_temp(j)+ZeroCelsius ) )
+
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 9. Calculate the number of chilling days (NCD) since leaves were lost (::ncd_dormance).
+    !!    This variable is initialised to 0 at the beginning of the dormancy period (::time_lowgpp>0)
+    !!    and increased by the stomate time step when the daily temperature is lower than the 
+    !!    PFT-dependent threshold ::ncdgdd_temp, which is defined for each PFT 
+    !!    in a table (::ncdgdd_temp_tab) in the module ::stomate_data. \n
+    !!    It is set to "undef" when there is GPP (::time_lowgpp=0) as it is not needed during
+    !!    the growing season. \n
+    !!    The variable is used in the ::stomate_phenology module for the leaf onset model 'ncdgdd'.
+    !!    Each PFT is looped over but the ::ncd_dormance is only calculated for those
+    !!    PFTs for which a critical 'ncdgdd' temperature is defined, i.e. those which are 
+    !!    assigned to the 'ncdgdd' model.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( ncdgdd_temp(j) .NE. undef ) THEN
+
+          !
+          !! 9.1 set to zero if undefined and there is no GPP
+          !
+
+          WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+
+             ncd_dormance(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 9.2 set to undef if there is GPP
+          !
+
+          WHERE ( when_growthinit(:,j) .EQ. zero )
+
+             ncd_dormance(:,j) = undef
+
+          ENDWHERE
+
+          !
+          !! 9.3 normal update, as described above, where ::ncd_dormance is defined
+          !
+
+          WHERE ( ( ncd_dormance(:,j) .NE. undef ) .AND. &
+               ( t2m_daily(:) .LE. ncdgdd_temp(j)+ZeroCelsius ) )
+
+             ncd_dormance(:,j) = MIN( ncd_dormance(:,j) + dt, ncd_max )
+
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 10. Calculate the number of growing days (NGD) since leaves were lost (::ngd_minus5).
+    !!     This variable is initialised to 0 at the beginning of the dormancy period (::time_lowgpp>0)
+    !!     and increased by the stomate time step when the daily temperature is higher than the threshold
+    !!     -5 degrees C. \n    
+    !!     ::ngd_minus5 is further scaled by (::tau_ngd -dt / ::tau_ngd), 
+    !!     - ::tau_ngd is set to 50. in the module ::stomate_constants. \n
+    !      Nicolas Viovy - not sure why this is...
+    !!     The variable is used in the ::stomate_phenology module for the leaf onset model 'ngd'.
+    !!     Each PFT is looped over.
+    !!     If the NGD is less than zero, it is set to zero.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !
+       !! 10.1 Where there is GPP (i.e. ::time_lowgpp=0), set NGD to 0. 
+       !!      This means that we only take into account NGDs when the leaves are off
+       !
+
+       WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+          ngd_minus5(:,j) = zero
+       ENDWHERE
+
+       !
+       !! 10.2 normal update, as described above.
+       !
+
+       WHERE ( t2m_daily(:) .GT. (ZeroCelsius - gdd_threshold) )
+          ngd_minus5(:,j) = ngd_minus5(:,j) + dt
+       ENDWHERE
+
+       ngd_minus5(:,j) = ngd_minus5(:,j) * ( tau_ngd - dt ) / tau_ngd
+
+    ENDDO
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(ngd_minus5(:,j)) .LT. EPSILON(zero) )
+          ngd_minus5(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 11. Calculate the minimum humidity/relative soil moisture since dormance began (::hum_min_dormance) 
+    !!     and the time elapsed since this minimum (::time_hum_min). \n
+    !!     The minimum moisture availability occurs when the monthly moisture availability, which is updated 
+    !!     daily earlier in this subroutine as previously described, is at a minimum during the dormancy period.
+    !!     Therefore the ::hum_min_dormance is initialised to the monthly moisture availability 
+    !!     at the beginning of the dormancy period (i.e. if it was previously set to undefined and the
+    !!     ::time_lowgpp>0) AND then whenever the monthly moisture availability is less than it has previously
+    !!     been. \n
+    !!     Consequently, the time counter (::time_hum_min) is initialised to 0 at the beginning of the dormancy  
+    !!     period (i.e. if it was previously set to undefined and the ::time_lowgpp>0) AND when the minimum 
+    !!     moisture availability is reached, and is increased by the stomate time step every day throughout
+    !!     the dormancy period. \n
+    !!     ::time_hum_min is used in the ::stomate_phenology module for the leaf onset models 'moi' and 'moigdd'.
+    !!     Each PFT is looped over but the two variables are only calculated for those
+    !!     PFTs for which the critical parameter ::hum_min_time is defined, i.e.   
+    !!     those which are assigned to the 'moi' or 'moigdd' models.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( hum_min_time(j) .NE. undef ) THEN
+
+          !
+          !! 11.1 initialize if undefined and there is no GPP
+          !
+
+          WHERE (when_growthinit(:,j) .EQ. zero)
+
+             time_hum_min(:,j) = zero
+             hum_min_dormance(:,j) = moiavail_month(:,j)
+
+          ENDWHERE
+
+          !
+          !! 11.3 normal update, as described above, where ::time_hum_min and ::hum_min_dormance are defined
+          !
+
+          !! 11.3.1 increase time counter by the stomate time step
+
+          WHERE ( hum_min_dormance(:,j) .NE. undef )
+
+             time_hum_min(:,j) = time_hum_min(:,j) + dt
+
+          ENDWHERE
+
+          !! 11.3.2 set time counter to zero if minimum is reached
+
+          WHERE (( hum_min_dormance(:,j) .NE. undef ) .AND. &
+               ( moiavail_month(:,j) .LE. hum_min_dormance(:,j) ) )
+
+             hum_min_dormance(:,j) = moiavail_month(:,j)
+             time_hum_min(:,j) = zero
+
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! NOTE: Sections 12. to 14. compute slowly-varying, "long-term" (i.e. weekly/monthly)
+    !! C fluxes (NPP, turnover, GPP) using the same linear relaxation method as in 
+    !! Sections 2. and 5. and described in the introduction to this section, as given 
+    !! by the following equation:
+    !! \latexonly
+    !! \input{season_lin_relax_eqn1.tex}
+    !! \endlatexonly
+    !! \n 
+    !! The following variables are calculated using the above equation, and the time constant 
+    !! is given for each. 
+    !
+
+    !
+    !! 12. Update the "long term" NPP. (::npp_daily in gC/m^2/day, ::npp_longterm in gC/m^2/year.)
+    !!     The time constant is given by the parameter ::tau_longterm, 
+    !!     which is set in ::stomate_data to be 3 * one year (in seconds, as 
+    !!     described above). If the ::npp_longterm is less than zero then set it to zero. \n
+    !!     ::npp_longterm is used in ::stomate_lpj in the calculation of long-term
+    !!     vegetation dynamics and in ::stomate_lcchange in the calculation of 
+    !!     land cover change. It is also used to calculate diagnose the hebivory activity in 
+    !!     Section 22 of this subroutine.
+    !
+
+    npp_longterm = ( npp_longterm * ( tau_longterm - dt ) + &
+         (npp_daily*one_year) * dt                          ) / &
+         tau_longterm
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(npp_longterm(:,j)) .LT. EPSILON(zero) )
+          npp_longterm(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 13. Update the "long term" turnover rates (in gC/m^2/year).
+    !!     The time constant is given by the parameter ::tau_longterm, 
+    !!     which is set in ::stomate_data to be 3 * one year (in seconds, as 
+    !!     described above). If the ::turnover_longterm is less than zero then set it to zero.\n
+    !!     ::turnover_longterm is used in ::stomate_lpj and :: lpg_gap in the calculation 
+    !!     of long-term vegetation dynamics.
+    !
+
+    turnover_longterm(:,:,:,icarbon) = ( turnover_longterm(:,:,:,icarbon) * ( tau_longterm - dt ) + &
+         (turnover_daily(:,:,:,icarbon)*one_year) * dt                          ) / &
+         tau_longterm
+
+    turnover_longterm(:,:,:,icarbon14) =  turnover_longterm(:,:,:,icarbon)
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(turnover_longterm(:,j,:,icarbon)) .LT. EPSILON(zero) )
+          turnover_longterm(:,j,:,icarbon) = zero
+	  turnover_longterm(:,j,:,icarbon14) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 14. Update the "weekly" GPP (where there is vegetation), otherwise set to zero.
+    !!     The time constant is given by the parameter ::tau_gpp_week, 
+    !!     which is set in ::stomate_data to be 7 days. If the ::gpp_week is 
+    !!     less than zero then set it to zero. \n
+    !!     ::gpp_week is used to update the annual maximum weekly GPP (::maxgppweek_thisyear)
+    !!     in Section 16 of this subroutine, which is then used to update the variable
+    !!     ::maxgppweek_lastyear in Section 21 of this subroutine. Both ::gpp_week and 
+    !!     ::maxgppweek_lastyear are used in Section 6 of this subroutine to calculate
+    !!     the onset and time-length of the dormancy period. 
+    !      Note: Used to be weekly GPP divided by veget_max, i.e. per ground covered, but not anymore.
+    !
+
+    WHERE ( veget_max .GT. zero )
+
+       gpp_week = ( gpp_week * ( tau_gpp_week - dt ) + &
+            gpp_daily * dt ) / tau_gpp_week
+
+    ELSEWHERE
+
+       gpp_week = zero
+
+    ENDWHERE
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(gpp_week(:,j)) .LT. EPSILON(zero) )
+          gpp_week(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 15. Update the maximum and minimum moisture availabilities (::maxmoiavail_thisyear 
+    !!     and ::minmoiavail_thisyear). If the daily moisture availability, ::moiavail_daily,
+    !!     which was calculated earlier in this subroutine, is greater or less than the current
+    !!     value of the maximum or minimum moisture availability, then set the value for the maximum
+    !!     or minimum to the current daily value respectively. \n
+    !!     ::maxmoiavail_thisyear and ::minmoiavail_thisyear are used to update the variables 
+    !!     ::maxmoiavail_lastyear and ::minmoiavail_lastyear in Section 21 of this subroutine, 
+    !!     which are used in the module ::stomate_phenology for the leaf onset models 'hum' and 
+    !!     'humgdd', and in the module ::stomate_turnover for the leaf senescence models 'dry' 
+    !!     and 'mixed'.
+    !
+
+    WHERE ( moiavail_daily .GT. maxmoiavail_thisyear )
+       maxmoiavail_thisyear = moiavail_daily
+    ENDWHERE
+
+    WHERE ( moiavail_daily .LT. minmoiavail_thisyear )
+       minmoiavail_thisyear = moiavail_daily
+    ENDWHERE
+
+    !
+    !! 16. Update the annual maximum weekly GPP (::maxgppweek_thisyear), if the weekly GPP
+    !!     is greater than the current value of the annual maximum weekly GPP.
+    !!     The use of this variable is described in Section 14.
+    !
+
+    WHERE ( gpp_week .GT. maxgppweek_thisyear )
+       maxgppweek_thisyear = gpp_week
+    ENDWHERE
+
+    !
+    !! 17. Update the annual GDD0 by adding the current daily 2-meter temperature 
+    !!     (multiplied by the stomate time step, which is one day), if it is greater
+    !!     than zero degrees C. \n
+    !!     This variable is mostly used in the module ::lpj_establish.
+    !
+
+    WHERE ( t2m_daily .GT. ZeroCelsius )
+       gdd0_thisyear = gdd0_thisyear + dt * ( t2m_daily - ZeroCelsius )
+    ENDWHERE
+
+    !
+    !! 18. Update the annual precipitation by adding the current daily precipitation
+    !!     amount (multiplied by the stomate time step, which is usually one day). \n
+    !
+
+    precip_thisyear = precip_thisyear + dt * precip_daily
+
+    
+!
+    !! 19. Update the annual maximum leaf mass for each PFT (::lm_thisyearmax) and the maximum fractional
+    !!     plant cover if the LPJ DGVM is activated.       
+    !
+    
+    !
+    !! 19.1 If the LPJ DGVM is activated first the fraction of natural vegetation (::fracnat), i.e. non-
+    !!      agricultural vegetation (PFTs 2-11) is calculated for each PFT. Each PFT is looped over.
+    !
+    IF(ok_dgvm ) THEN
+
+       fracnat(:) = un
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( .NOT. natural(j) ) THEN
+             fracnat(:) = fracnat(:) - veget_max(:,j)
+          ENDIF
+       ENDDO
+
+    ENDIF
+
+    !
+    !! 19.2 If LPJ and STOMATE are activated, first the maximum fractional plant cover needs to be updated, 
+    !!      and then this year's leaf biomass. Each PFT is looped over.
+    !!      Both are updated according to the linear relaxation method described above. 
+    !!      \latexonly
+    !!      \input{season_lin_relax_eqn1.tex}
+    !!      \endlatexonly
+    !!      \n
+    !!      The time constant for this process is set as one year (in seconds) divided by the parameter
+    !!      ::leaflife_tab, which gives the leaf lifetime in years and is set for each PFT in the module 
+    !!      ::stomate_constants. Each PFT is looped over. \n
+    !
+
+    IF ( ok_stomate ) THEN
+       IF(ok_dgvm ) THEN
+          DO j=2,nvm ! Loop over # PFTs
+
+             !
+             !! 19.2.1 Calculate maximum fractional plant cover (::maxfpc_lastyear).
+             !!        If natural vegetation is present in the grid cell, and the leaf
+             !!        biomass is greater than three-quarters of last year's leaf biomass, the maximum fractional plant
+             !!        cover for last year is updated. \n 
+             !!        The short-term variable (Xs in the above equation) that is being used to update the long-term 
+             !!        maximum fractional plant cover is the fractional cover of natural vegetation, specified as 
+             !!        ::veget/::fracnat. Last year's value is then set to be this year's value.
+             !
+
+             IF ( natural(j) .AND. ok_dgvm ) THEN
+
+                WHERE ( fracnat(:) .GT. min_stomate .AND. biomass(:,j,ileaf,icarbon).GT. lm_lastyearmax(:,j)*0.75 )
+                   maxfpc_lastyear(:,j) = ( maxfpc_lastyear(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
+                        veget(:,j) / fracnat(:) * dt ) / (one_year/leaflife_tab(j))
+                ENDWHERE
+                maxfpc_thisyear(:,j) = maxfpc_lastyear(:,j) ! just to initialise value
+
+             ENDIF
+
+!NV : correct initialization
+!!$             WHERE(biomass(:,j,ileaf,icarbon).GT. lm_lastyearmax(:,j)*0.75)
+!!$                lm_lastyearmax(:,j) = ( lm_lastyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
+!!$                     biomass(:,j,ileaf,icarbon) * dt ) / (one_year/leaflife_tab(j))
+!!$             ENDWHERE
+!!$             lm_thisyearmax(:,j)=lm_lastyearmax(:,j) ! just to initialise value
+
+             
+             !
+             !! 19.2.2 Update this year's leaf biomass (::lm_thisyearmax).
+             !!        The short-term variable (Xs in the above equation) that is being used to update the long-term 
+             !!        this year's leaf biomass is the leaf biomass pool (::biomass(i,j,ileaf).
+             !
+             WHERE (lm_thisyearmax(:,j) .GT. min_stomate)
+                WHERE(biomass(:,j,ileaf,icarbon).GT. lm_thisyearmax(:,j)*0.75)
+                   lm_thisyearmax(:,j) = ( lm_thisyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
+                        biomass(:,j,ileaf,icarbon) * dt ) / (one_year/leaflife_tab(j))
+                ENDWHERE
+             ELSEWHERE
+                lm_thisyearmax(:,j) =biomass(:,j,ileaf,icarbon)
+             ENDWHERE
+
+          ENDDO
+
+       ELSE
+          
+          !
+          !! 19.3 If LPJ DGVM is not activated but STOMATE is, the maximum leaf mass is set to be the same  
+          !!      as the leaf biomass (::biomass(i,j,ileaf), without a change in the maximum fractional plant cover. 
+          !
+          DO j = 2,nvm ! Loop over # PFTs
+             WHERE ( biomass(:,j,ileaf,icarbon) .GT. lm_thisyearmax(:,j) )
+                lm_thisyearmax(:,j) = biomass(:,j,ileaf,icarbon)
+             ENDWHERE
+          ENDDO
+
+       ENDIF !(ok_dgvm)
+    ELSE
+
+          !
+          !! 19.4 If STOMATE is not activated, the maximum leaf biomass is set to be the maximum possible 
+          !!      LAI of the PFT.
+          !
+
+       DO j = 2,nvm ! Loop over # PFTs
+          lm_thisyearmax(:,j) = lai_max(j)  / sla(j)
+       ENDDO
+
+    ENDIF  !(ok_stomate)
+
+    !
+    !! 20. Update the annual maximum fractional plant cover for each PFT if the current fractional cover 
+    !!     (::veget), is larger than the current maximum value.
+    !!     ::veget is defined as fraction of total ground. Therefore, maxfpc_thisyear has the same unit.
+    !
+
+    WHERE ( veget(:,:) .GT. maxfpc_thisyear(:,:) )
+       maxfpc_thisyear(:,:) = veget(:,:)
+    ENDWHERE
+
+    !
+    !! 21. At the end of the every year, last year's maximum and minimum moisture availability,
+    !!     annual GDD0, annual precipitation, annual max weekly GPP, and maximum leaf mass are 
+    !!     updated with the value calculated for the current year, and then their value reset.
+    !!     Either to zero for the maximum variables, or to ::large_value (set to be 1.E33 in ::
+    !!     the module ::stomate_constants) for the minimum variable ::minmoiavail_thisyear.
+    !
+
+    IF ( EndOfYear ) THEN
+
+       !
+       !! 21.1 Update last year's values. \n
+       !!      The variables ::maxmoiavail_lastyear, ::minmoiavail_lastyear and ::maxgppweek_lastyear  
+       !!      are updated using the relaxation method:
+       !!      \latexonly
+       !!      \input{season_lin_relax_eqn1.tex}
+       !!      \endlatexonly
+       !!      \n
+       !!      where Xs is this year's value, dt (Delta-t) is set to 1 (year), and the time constant (tau) !??
+       !!      is set by the parameter ::tau_climatology, which is set to 20 years at the beginning 
+       !!      of this subroutine. \n
+       !!      The other variables (::gdd0_lastyear, ::precip_lastyear, ::lm_lastyearmax and 
+       !!      ::maxfpc_lastyear) are just replaced with this year's value.
+       !
+       !NVMODIF
+       maxmoiavail_lastyear(:,:) = (maxmoiavail_lastyear(:,:)*(tau_climatology-1)+ maxmoiavail_thisyear(:,:))/tau_climatology
+       minmoiavail_lastyear(:,:) = (minmoiavail_lastyear(:,:)*(tau_climatology-1)+ minmoiavail_thisyear(:,:))/tau_climatology
+       maxgppweek_lastyear(:,:) =( maxgppweek_lastyear(:,:)*(tau_climatology-1)+ maxgppweek_thisyear(:,:))/tau_climatology
+       !       maxmoiavail_lastyear(:,:) = maxmoiavail_thisyear(:,:)
+       !       minmoiavail_lastyear(:,:) = minmoiavail_thisyear(:,:)
+       !       maxgppweek_lastyear(:,:) = maxgppweek_thisyear(:,:)
+       
+       gdd0_lastyear(:) = gdd0_thisyear(:)
+
+       precip_lastyear(:) = precip_thisyear(:)
+
+       lm_lastyearmax(:,:) = lm_thisyearmax(:,:)
+
+       maxfpc_lastyear(:,:) = maxfpc_thisyear(:,:)
+
+       ! Calculate Tseason
+       Tseason(:) = zero
+       WHERE ( Tseason_length(:) .GT. zero )
+          Tseason(:) = Tseason_tmp(:) / Tseason_length(:)
+       ENDWHERE
+
+       !
+       !! 21.2 Reset new values for the "this year" variables. \n
+       !!      The maximum variables are set to zero and the minimum variable ::minmoiavail_thisyear
+       !!      is set to ::large_value (set to be 1.E33 in the module ::stomate_constants).
+       !
+
+       maxmoiavail_thisyear(:,:) = zero
+       minmoiavail_thisyear(:,:) = large_value
+
+       maxgppweek_thisyear(:,:) = zero
+
+       gdd0_thisyear(:) = zero
+
+       precip_thisyear(:) = zero
+
+       lm_thisyearmax(:,:) = zero
+
+       maxfpc_thisyear(:,:) = zero
+
+       Tseason_tmp(:) = zero
+       Tseason_length(:) =zero
+       Tmin_spring_time(:,:)=zero
+       onset_date(:,:)=zero
+
+       !
+       ! 21.3 Special treatment for maxfpc. !?? 
+       !! 21.3 Set the maximum fractional plant cover for non-natural vegetation 
+       !!      (i.e. agricultural C3 and C4 - PFT 12 and 13) vegetation for last year to be zero.
+       !
+
+       !
+       ! 21.3.1 Only take into account natural PFTs
+       !
+
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( .NOT. natural(j) ) THEN
+             maxfpc_lastyear(:,j) = zero
+          ENDIF
+       ENDDO
+
+       ! 21.3.2 In Stomate, veget is defined as a fraction of ground, not as a fraction 
+       !        of total ground. maxfpc_lastyear will be compared to veget in lpj_light.
+       !        Therefore, we have to transform maxfpc_lastyear.
+
+
+       ! 21.3.3 The sum of the maxfpc_lastyear for natural PFT must not exceed fpc_crit (=.95).
+       !        However, it can slightly exceed this value as not all PFTs reach their maximum 
+       !        fpc at the same time. Therefore, if sum(maxfpc_lastyear) for the natural PFTs
+       !        exceeds fpc_crit, we scale the values of maxfpc_lastyear so that the sum is
+       !        fpc_crit.
+
+!!$       ! calculate the sum of maxfpc_lastyear
+!!$       sumfpc_nat(:) = zero
+!!$       DO j = 2,nvm ! Loop over # PFTs
+!!$          sumfpc_nat(:) = sumfpc_nat(:) + maxfpc_lastyear(:,j)
+!!$       ENDDO
+!!$
+!!$       ! scale so that the new sum is fpc_crit
+!!$       DO j = 2,nvm ! Loop over # PFTs 
+!!$          WHERE ( sumfpc_nat(:) .GT. fpc_crit )
+!!$             maxfpc_lastyear(:,j) = maxfpc_lastyear(:,j) * (fpc_crit/sumfpc_nat(:))
+!!$          ENDWHERE
+!!$       ENDDO
+
+    ENDIF  ! EndOfYear
+
+    !
+    !! 22. Diagnose herbivore activity (::herbivores), determined as probability for a leaf to be
+    !!     eaten in a day (follows McNaughton et al., 1989). \n
+    !!     The amount of herbivore activity is used in the modules ::lpj_establish  
+    !!     and ::stomate_turnover.
+    !
+
+    !
+    !! 22.1 First calculate the mean long-term leaf NPP in grid box, mean residence
+    !!      time (years) of green tissue to give the biomass available for herbivore consumption.
+    !!      Each PFT is looped over, though the calculation is only made for
+    !!      natural vegetation (PFTs 2-11).
+    !
+
+    nlflong_nat(:,:) = zero
+    weighttot(:,:) = zero
+    green_age(:,:) = zero
+    !
+    DO j = 2,nvm ! Loop over # PFTs
+       !
+       IF ( natural(j) ) THEN
+          !
+          !! 22.1.1 Calculate the total weight of the leaves (::weighttot) as last year's leaf biomass
+          !
+          weighttot(:,j) = lm_lastyearmax(:,j)
+          
+          !
+          !! 22.1.2 Calculate the mean long-term leaf NPP as the long-term NPP calculated in Section 12 of 
+          !!        this subroutine weighted by the leaf fraction (::leaf_frac), which is defined to be 0.33
+          !!        at the beginning of this subroutine.
+          !
+          nlflong_nat(:,j) = npp_longterm(:,j) * leaf_frac_hvc
+          
+          !
+          !! 22.1.3 Calculate the mean residence time of the green tissue (::green_age) 
+          !!        This is calculated as the sum of 6 months 
+          !!        for natural seasonal vegetation (i.e. PFTs 3, 6, 8-11), and 2 years for evergreen 
+          !!        (PFTs 2, 4, 5, 8), multiplied by last year's leaf biomass for each PFT, divided by the 
+          !!        total weight of the leaves for all PFTs.
+          !         This is a crude approximation.  !!?? By whom?
+          !!        The difference between seasonal and evergreen vegetation is determined by the parameter
+          !!        ::pheno_model, which specifies the onset model of the PFT.
+ 
+          !
+          IF ( pheno_model(j) .EQ. 'none' ) THEN
+             green_age(:,j) = green_age_ever * lm_lastyearmax(:,j)
+          ELSE
+             green_age(:,j) = green_age_dec * lm_lastyearmax(:,j)
+          ENDIF
+          !
+       ENDIF
+       !
+    ENDDO
+    !
+    WHERE ( weighttot(:,:) .GT. zero )
+       green_age(:,:) = green_age(:,:) / weighttot(:,:)
+    ELSEWHERE
+       green_age(:,:) = un
+    ENDWHERE
+
+    !
+    !! 22.2 McNaughton et al. (1989) give herbivore consumption as a function of mean, long-term leaf NPP.
+    !!      as it gives an estimate of the edible biomass. The consumption of biomass by herbivores and the 
+    !!      resultant herbivore activity are calculated following the equations:
+    !!      \latexonly
+    !!      \input{season_consumption_eqn4.tex}
+    !!      \endlatexonly
+    !!      \n 
+    !!      and 
+    !!      \latexonly
+    !!      \input{season_herbivore_eqn5.tex}
+    !!      \endlatexonly
+    !!      \n 
+    !       
+
+    DO j = 2,nvm ! Loop over # PFTs
+       !
+       IF ( natural(j) ) THEN
+          !
+          WHERE ( nlflong_nat(:,j) .GT. zero )
+             consumption(:) = hvc1 * nlflong_nat(:,j) ** hvc2
+             herbivores(:,j) = one_year * green_age(:,j) * nlflong_nat(:,j) / consumption(:)
+          ELSEWHERE
+             herbivores(:,j) = 100000.
+          ENDWHERE
+          !
+       ELSE
+          !
+          herbivores(:,j) = 100000.
+          !
+       ENDIF
+       !
+    ENDDO
+    herbivores(:,ibare_sechiba) = zero
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving season'
+
+  END SUBROUTINE season
+
+END MODULE stomate_season
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_soilcarbon.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_soilcarbon.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_soilcarbon.f90	(revision 5166)
@@ -0,0 +1,1351 @@
+
+! MODULE       : stomate_soilcarbon
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Calculate soil dynamics largely following the Century model
+!
+!!	
+!!\n DESCRIPTION: 11 layers discretization: Layers 1-11 are soil layers
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN		:
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_soilcarbon
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE pft_parameters_var
+  USE vertical_soil
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC soilcarbon,soilcarbon_clear
+
+  ! Variables shared by all subroutines in this module
+  
+  LOGICAL, SAVE    :: firstcall = .TRUE.   !! Is this the first call? (true/false)
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : soilcarbon_clear
+!!
+!>\BRIEF        Set the flag ::firstcall to .TRUE. and as such activate sections 1.1.2 and 1.2 of the subroutine soilcarbon 
+!! (see below).
+!! 
+!_ ================================================================================================================================
+  
+  SUBROUTINE soilcarbon_clear
+    firstcall=.TRUE.
+  ENDSUBROUTINE soilcarbon_clear
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : soilcarbon
+!!
+!>\BRIEF        Computes the soil respiration and carbon stocks, essentially 
+!! following Parton et al. (1987).
+!!
+!! DESCRIPTION	: The soil is divided into 3 carbon pools, with different 
+!! characteristic turnover times : active (1-5 years), slow (20-40 years) 
+!! and passive (200-1500 years).\n
+!! There are three types of carbon transferred in the soil:\n
+!! - carbon input in active and slow pools from litter decomposition,\n
+!! - carbon fluxes between the three pools,\n
+!! - carbon losses from the pools to the atmosphere, i.e., soil respiration.\n
+!!
+!! The subroutine performs the following tasks:\n
+!!
+!! Section 1.\n
+!! The flux fractions (f) between carbon pools are defined based on Parton et 
+!! al. (1987). The fractions are constants, except for the flux fraction from
+!! the active pool to the slow pool, which depends on the clay content,\n
+!! \latexonly
+!! \input{soilcarbon_eq1.tex}
+!! \endlatexonly\n
+!! In addition, to each pool is assigned a constant turnover time.\n
+!!
+!! Section 2.\n
+!! The carbon input, calculated in the stomate_litter module, is added to the 
+!! carbon stock of the different pools.\n
+!!
+!! Section 3.\n
+!! First, the outgoing carbon flux of each pool is calculated. It is 
+!! proportional to the product of the carbon stock and the ratio between the 
+!! iteration time step and the residence time:\n
+!! \latexonly
+!! \input{soilcarbon_eq2.tex}
+!! \endlatexonly
+!! ,\n
+!! Note that in the case of crops, the additional multiplicative factor 
+!! integrates the faster decomposition due to tillage (following Gervois et 
+!! al. (2008)).
+!! In addition, the flux from the active pool depends on the clay content:\n
+!! \latexonly
+!! \input{soilcarbon_eq3.tex}
+!! \endlatexonly
+!! ,\n
+!! Each pool is then cut from the carbon amount corresponding to each outgoing
+!! flux:\n
+!! \latexonly
+!! \input{soilcarbon_eq4.tex}
+!! \endlatexonly\n
+!! Second, the flux fractions lost to the atmosphere is calculated in each pool
+!! by subtracting from 1 the pool-to-pool flux fractions. The soil respiration 
+!! is then the summed contribution of all the pools,\n
+!! \latexonly
+!! \input{soilcarbon_eq5.tex}
+!! \endlatexonly\n
+!! Finally, each carbon pool accumulates the contribution of the other pools:
+!! \latexonly
+!! \input{soilcarbon_eq6.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUTS VARIABLE(S): carbon, resp_hetero_soil
+!!
+!! REFERENCE(S)   :
+!! - Parton, W.J., D.S. Schimel, C.V. Cole, and D.S. Ojima. 1987. Analysis of 
+!! factors controlling soil organic matter levels in Great Plains grasslands. 
+!! Soil Sci. Soc. Am. J., 51, 1173-1179.
+!! - Gervois, S., P. Ciais, N. de Noblet-Ducoudre, N. Brisson, N. Vuichard, 
+!! and N. Viovy (2008), Carbon and water balance of European croplands 
+!! throughout the 20th century, Global Biogeochem. Cycles, 22, GB2022, 
+!! doi:10.1029/2007GB003018.
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART    :
+!! \latexonly
+!! \includegraphics[scale=0.5]{soilcarbon_flowchart.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE soilcarbon (npts, dt, clay, &
+       soilcarbon_input, control_temp_soil, control_moist_soil, &
+       carbon, &
+       resp_hetero_soil, &
+       litter_above,litter_below,&
+       soilhum, DOC, moist_soil, DOC_EXP, &
+       lignin_struc_above, lignin_struc_below, &
+       floodout, runoff_per_soil, drainage_per_soil, wat_flux0, wat_flux,&
+       bulk_dens, soil_ph, veget_max, soil_mc, soiltile, &
+       DOC_to_topsoil, DOC_to_subsoil)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                                        :: npts                  !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                                           :: dt                    !! Time step \f$(dtradia one_day^{-1})$\f
+    REAL(r_std), DIMENSION(npts), INTENT(in)                          :: clay                  !! Clay fraction (unitless, 0-1) 
+    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)
+
+    REAL(r_std), DIMENSION(npts), INTENT(in)                          :: soil_ph               !! soil pH (pH unit, 0-14) 
+    REAL(r_std), DIMENSION(npts,nbdl,npool*2), INTENT(in)             :: control_temp_soil     !! Temperature control of heterotrophic respiration (unitless: 0->1)
+    REAL(r_std), DIMENSION(npts,nbdl,nvm), INTENT(in)                 :: control_moist_soil    !! Moisture control of heterotrophic respiration (unitless: 0.25->1)
+
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements), INTENT(in)      :: litter_above          !! Metabolic and structural litter,above ground
+                                                                                               !! The unit is given by m^2 of ground
+                                                                                               !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements), INTENT(in) ::litter_below           !! Metabolic and structural litter, below ground
+                                                                                               !! The unit is given by m^2 of
+                                                                                               !! ground @tex $(gC m^{-2}) $ @endtex
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)                     :: soilhum               !! Daily soil humidity of each soil layer 
+                                                                                               !! (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                      :: lignin_struc_above    !! Ratio Lignin content in structural litter,
+                                                                                               !! above ground, (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nbdl), INTENT(in)                 :: lignin_struc_below    !! Ratio Lignin content in structural litter,
+                                                                                               !! below ground, (0-1, unitless)
+    REAL(r_std),DIMENSION (npts), INTENT (in)                         :: floodout              !! flux out of floodplains
+    REAL(r_std),DIMENSION (npts,nstm), INTENT (in)                    :: runoff_per_soil       !! Runoff per soil type [mm]
+    REAL(r_std),DIMENSION (npts,nstm), INTENT (in)                    :: drainage_per_soil     !! Drainage per soil type [mm]
+    REAL(r_std),DIMENSION (npts,nstm), INTENT(in)                     :: wat_flux0             !! Water flux in the first soil layers exported for soil C calculations(mm)
+    REAL(r_std),DIMENSION (npts,nslm,nstm), INTENT(in)                :: wat_flux              !! Water flux in the soil layers exported for soil C calculations(mm)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                        :: veget_max             !! PFT "Maximal" coverage fraction of a PFT 
+                                                                                               !! defined in the input vegetation map 
+                                                                                               !! @tex $(m^2 m^{-2})$ @endtex 
+                                                                                               !! The unit is given by m^2 of
+                                                                                               !! water @tex $(gC m{-2} of water)$ @endtex
+    REAL(r_std),DIMENSION (npts,nbdl,nstm), INTENT(in)                :: soil_mc               !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (npts,nstm), INTENT (in)                    :: soiltile              !! Fraction of each soil tile (0-1, unitless)
+
+    REAL(r_std),DIMENSION (npts,nelements), INTENT(in)                :: DOC_to_topsoil        !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                                               !! floodplains and from irrigation
+                                                                                               !! @tex $(gC m^{-2} day{-1})$ @endtex
+    REAL(r_std),DIMENSION (npts,nelements), INTENT(in)                :: DOC_to_subsoil        !! DOC inputs to bottom of the soil column, from returnflow
+                                                                                               !! in swamps and lakes
+                                                                                               !! @tex $(gC m^{-2} day{-1})$ @endtex
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts,nvm,nelements), INTENT(out)           :: resp_hetero_soil      !! Soil heterotrophic respiration \f$(gC m^{-2} (dtradia one_day^{-1})^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nexp,nelements), INTENT(out) :: DOC_EXP                    !! Exported DOC through runoff, drainage, flood,
+                                                                                               !! The unit is given by m^2 of
+                                                                                               !! ground \f$(gC m^{-2} day^{-1})$\f
+       REAL(r_std), DIMENSION(npts,nbdl), INTENT(out)               :: moist_soil                !! moisture in soil for one pixel (m3/m3)
+    
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,npool,nelements), INTENT(inout)      :: soilcarbon_input    !! Amount of carbon going into the carbon pools 
+                                                                                          !! from litter decomposition \f$(gC m^{-2} day^{-1})$\f    
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl,nelements), INTENT(inout)      :: carbon   !! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f
+    
+
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements), INTENT(inout) :: DOC      !! Dissolved Organic Carbon in soil
+                                                                                          !! The unit is given by m^2 of
+                                                                                          !! ground @tex $(gC m{-2} of ground)$ @endtex
+    
+   
+    !! 0.4 Local variables
+    
+    REAL(r_std), SAVE, DIMENSION(ncarb)                           :: carbon_tau       !! Residence time in carbon pools (years)
+!$OMP THREADPRIVATE(carbon_tau)
+    REAL(r_std), DIMENSION(npts,ncarb,ncarb)                      :: frac_carb        !! Flux fractions between carbon pools 
+                                                                                      !! (second index=origin, third index=destination) 
+                                                                                      !! (unitless, 0-1)
+      
+    REAL(r_std), DIMENSION(npts,ncarb,nelements,nbdl)             :: fluxtot          !! Total flux out of carbon pools \f$(gC m^{2})$\f
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl)                   :: flux_decrease    !! flux 14C out of carbon pools \f$(gC m^{2})$\f 
+    REAL(r_std), DIMENSION(npts,nvm)                 		  :: flux_decrease_tot    !! flux 14C out of carbon pools \f$(gC m^{2})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,npool,nelements)         :: fluxtot_DOC      !! Total flux out of dissolved organic carbon pools \f$(gC m^{2}ground)$\f
+    REAL(r_std), DIMENSION(npts,npool,ncarb,nelements,nbdl)       :: flux             !! Fluxes between carbon pools \f$(gC m^{2})$\f
+    CHARACTER(LEN=7), DIMENSION(ncarb)                            :: carbon_str       !! Name of the carbon pools for informative outputs (unitless)
+    REAL(r_std), SAVE, DIMENSION(ncarb)                           :: priming_param    !! parmater controlling the sensitvity of priming effect on  each pools to the amount of LOM
+!$OMP THREADPRIVATE(priming_param)
+    REAL(r_std), DIMENSION(npool,nvm)	                          :: DOC_tau          !! Residence time of DOC (days)
+!$OMP THREADPRIVATE(DOC_tau)
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,nelements)               :: litter_tot       !! total litter (gC/m**2 of ground)
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,nelements)               :: LOM              !! total labile organic matter that could induce the decompostion rate
+                                                                                      !! (gC/m**2 of ground)
+    INTEGER(i_std)                                                :: k,kk,m,j,l,i,kkk,n !! Indices (unitless)
+    REAL(r_std),DIMENSION(0:nbdl)                                 :: z_soil           !! Soil levels (m)
+    REAL(r_std), DIMENSION(npts,nvm, nbdl,npool,nelements)        :: DOC_RE           !! Adsoprtion Desorption flux of DOC (mmol C/kg)
+    REAL(r_std), DIMENSION(npts,nvm, nbdl,npool,nelements)        :: DOC_FLUX         !! DOC flux between layers in f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm, nbdl,npool,nelements)        :: DOC_FLUX_DIFF    !! DOC flux by diffusion between layers in f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm, nbdl,npool,nelements)        :: DOC_FLUX_DIFF_old !! DOC flux by diffusion between layers in f$(gC m^{-2} day^{-1})$\f for storage
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: DOC_RUN          !! DOC lost with runoff in f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: DOC_FLOOD        !! DOC lost with flooding in f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: DOC_DRAIN        !! DOC lost with drainage in f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements)    :: DOC_old          !! Dissolved Organic Carbon in soil
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! ground @tex $(gC m{-2} of ground)$ @endtex variable used for storage
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements)    :: DOC_old2         !! Dissolved Organic Carbon in soil
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! ground @tex $(gC m{-2} of ground)$ @endtex variable used for storage
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements)    :: DOC_old_buffer   !! Dissolved Organic Carbon in soil
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! ground @tex $(gC m{-2} of ground)$ @endtex variable used for storage
+
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl,nelements)         :: carbon_old       !! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f used for storage
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl,nelements)          :: carbon_old_buffer!! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f used for storage
+    REAL(r_std), DIMENSION(npts)                                  :: Qmax             !! Maximum adsorption capacity for DOC in the Langmuir equation (mg kgÂ¿1)
+    REAL(r_std), DIMENSION(npts,nbdl)                             :: Kd               !! distribution coefficient between DOC adsorbed and DOC free (unitless [0-1])
+    REAL(r_std), DIMENSION(npts,nbdl)                             :: b                !! desorption term of the Initial Mass (IM) isotherm (mmol C/kg)
+    REAL(r_std), DIMENSION(npts,nbdl)                             :: IM               !! sorption affinity of the Initial Mass (IM) isotherm (unitless)
+
+    !REAL(r_std), DIMENSION(npts)                             :: Dif_coef         !! Diffusion coeficient used for bioturbation (m2 dt-1)	
+
+    REAL(r_std), DIMENSION(npts,nbdl)                         :: Dif_coef         !! Diffusion coeficient used for bioturbation (m2 dt-1)
+
+    REAL(r_std), DIMENSION(npts)                                  :: Dif_DOC          !! Diffusion coeficient used for DOC diffusion (m2 dt-1)
+
+    REAL(r_std), DIMENSION(npts,nvm)                              :: CUE_coef         !! Partition coefficient for DOC decomposed between CO2 and POC (unitless, 0-1)
+                                                                                    
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl,nelements)         :: carbon_flux      !! Soil carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl,nelements)         :: carbon_flux_old  !! Soil carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f
+                                                                                      !! used for storage
+    REAL(r_std), DIMENSION(npts,nstm)                             :: soilwater_31mm   !! Soil water content of the first 5 layers (m)
+
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)            :: check_intern     !! Contains the components of the internal
+                                                                              !! mass balance chech for this routine
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: closure_intern   !! Check closure of internal mass balance
+
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: pool_start       !! Start and end pool of this routine 
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: pool_end         !! Start and end pool of this routine 
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: pool_end_after    !! Start and end pool of this routine after mass balance correction 
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex 
+!_ ================================================================================================================================
+
+    !! bavard is the level of diagnostic information, 0 (none) to 4 (full)
+    IF (printlev>=3) WRITE(numout,*) 'Entering soilcarbon' 
+
+!! 1. Initializations
+
+    !! 1.0 Calculation of soil moisture
+    moist_soil(:,:) = zero
+      DO l = 1,nbdl
+          DO i = 1, nstm
+             moist_soil(:,l)= moist_soil(:,l) + soil_mc(:,l,i)*soiltile(:,i)
+          ENDDO
+      ENDDO
+!! 1.3 soil levels
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+    !! 1.1 Initialize check for mass balance closure
+    !  The mass balance is calculated at the end of this routine
+    !  in section 14. Initial biomass and harvest pool and all other
+    !  relevant pools were set to zero before calling this routine.
+    pool_start(:,:,:) = zero
+IF (ld_doc) THEN
+!Starting carbon pool
+    DO m = 1, nvm
+       DO i = 1,ncarb
+          DO l = 1, nbdl
+		DO n=1,nelements
+                 	pool_start(:,m,n) = pool_start(:,m,n) + &
+                           ( carbon(:,i,m,l,n) ) * veget_max(:,m)
+		ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
+!Starting DOC pool
+    DO m = 1, nvm
+       DO i = 1,npool
+          DO l = 1, nbdl
+             DO j = 1, ndoc
+		DO n=1,nelements
+                    pool_start(:,m,n) = pool_start(:,m,n) + &
+                              ( DOC(:,m,l,j,i,n)) * veget_max(:,m)
+		ENDDO
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
+
+!Starting litter below pool
+    DO m = 1,nvm
+       DO l = 1, nbdl
+	DO n=1,nelements
+          pool_start(:,m,n) = pool_start(:,m,n) + &
+                      (soilcarbon_input(:,m,l,imetbel,n)+soilcarbon_input(:,m,l,istrbel,n)+ &
+                      soilcarbon_input(:,m,l,imetabo,n)+soilcarbon_input(:,m,l,istrabo,n)) * &
+                      veget_max(:,m) * dt
+	ENDDO
+      ENDDO
+    ENDDO
+
+!Starting litter above pool
+    DO m = 1,nvm
+	DO n=1,nelements
+          WHERE (veget_max(:,m) .GT. zero)
+       pool_start(:,m,n) = pool_start(:,m,n) + &
+             DOC_to_topsoil(:,n)*dt/veget_max(:,m) + &
+             DOC_to_subsoil(:,n)*dt/veget_max(:,m)
+          ELSEWHERE
+       pool_start(:,m,n) = pool_start(:,m,n) 
+          ENDWHERE
+	ENDDO
+    ENDDO
+ENDIF
+
+    !! 1.2 Get soil "constants"
+    !! 1.2.1 Flux fractions between carbon pools: depend on clay content, recalculated each time
+    ! From active pool: depends on clay content
+    frac_carb(:,iactive,iactive) = zero
+    frac_carb(:,iactive,islow) = metabolic_ref_frac - active_to_pass_clay_frac*clay(:)
+    frac_carb(:,iactive,ipassive) = un - frac_carb(:,iactive,islow)
+    ! 1.2.1.2 from slow pool
+    frac_carb(:,islow,islow) = zero
+    frac_carb(:,islow,iactive) = frac_carb_sa
+    frac_carb(:,islow,ipassive) = un - frac_carb(:,islow,iactive)
+	!frac_carb(:,islow,ipassive) = 0.07*(un-frac_carb_sa)
+	!frac_carb(:,islow,iactive)=un-frac_carb(:,islow,ipassive)
+    ! From passive pool
+    frac_carb(:,ipassive,ipassive) = zero
+    frac_carb(:,ipassive,iactive) = frac_carb_pa
+    frac_carb(:,ipassive,islow) = un - frac_carb(:,ipassive,iactive)
+
+    ! 1.2.1.3 Initialization
+    carbon_flux(:,:,:,:,:) =  zero
+    carbon_flux_old(:,:,:,:,:) =  zero
+    IF ( firstcall ) THEN
+
+        !! 1.2.2 Residence times in carbon pools (in year converted in days)
+        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
+        carbon_tau(islow) = carbon_tau_islow * one_year          ! See Guenet et al., (In prep)
+        carbon_tau(ipassive) = carbon_tau_ipassive * one_year    
+
+        priming_param(iactive)=priming_param_iactive  !Priming parameter for mineralization obtained from optimization of SOM-FOM-DEP see Guenet et al., (In prep)
+        priming_param(islow)=priming_param_islow
+        priming_param(ipassive)=priming_param_ipassive
+
+        ! The values of DOC_tau are coming from Kalbitz et al 2003 Geoderma
+        ! (already in days) 
+        
+			DO m = 1, nvm 
+ 		           DOC_tau(imetabo,m) = DOC_tau_labile(m)  
+ 		           DOC_tau(istrabo,m) = DOC_tau_labile(m)  
+ 		           DOC_tau(imetbel,m) = DOC_tau_labile(m)   
+ 		           DOC_tau(istrbel,m) = DOC_tau_labile(m)   
+ 		           DOC_tau(iact,m) = DOC_tau_labile(m)   
+ 		           DOC_tau(islo,m) = DOC_tau_stable(m)   
+ 		           DOC_tau(ipas,m) = DOC_tau_stable(m)   
+ 		        ENDDO 
+
+       !! 1.3 soil levels
+        !! 1.4 Messages : display the residence times  
+        carbon_str(iactive) = 'active'
+        carbon_str(islow) = 'slow'
+        carbon_str(ipassive) = 'passive'
+        
+        WRITE(numout,*) 'soilcarbon:'
+        
+        WRITE(numout,*) '   > minimal carbon residence time in carbon pools (d):'
+        DO k = 1, ncarb ! Loop over carbon pools
+          WRITE(numout,*) '(1, ::carbon_str(k)):',carbon_str(k),' : (1, ::carbon_tau(k)):',carbon_tau(k)
+        ENDDO
+        
+        WRITE(numout,*) '   > flux fractions between carbon pools: depend on clay content'
+        firstcall = .FALSE.
+        
+    ENDIF
+
+! The values of DOC_tau are coming from Kalbitz et al 2003 Geoderma 
+ 		        ! (already in days)  
+ 		        DO m = 1, nvm 
+ 		           DOC_tau(imetabo,m) = DOC_tau_labile(m) 
+ 		           DOC_tau(istrabo,m) = DOC_tau_labile(m) 
+ 		           DOC_tau(imetbel,m) = DOC_tau_labile(m) 
+ 		           DOC_tau(istrbel,m) = DOC_tau_labile(m) 
+ 		           DOC_tau(iact,m) = DOC_tau_labile(m) 
+ 		           DOC_tau(islo,m) = DOC_tau_stable(m) 
+ 		           DOC_tau(ipas,m) = DOC_tau_stable(m) 
+ 		        ENDDO 
+
+    !! 1.5 Initialization
+    !! 1.5.1 Initialization of parameters
+        
+	!Dif_coef(:) = (Dif/one_year)*dt
+
+	Dif_coef(:,1)=0.000540941406485744
+	Dif_coef(:,2)=0.000537778015618221
+	Dif_coef(:,3)=0.000529432453874695
+	Dif_coef(:,4)=0.00051312785464185
+	Dif_coef(:,5)=0.000482009560366733
+	Dif_coef(:,6)=0.000425319968125143
+	Dif_coef(:,7)=0.00033115858607203
+	Dif_coef(:,8)=0.000200759688792712
+	Dif_coef(:,9)=0.0000737832025989453
+	Dif_coef(:,10)=0.0000099659677737995
+	Dif_coef(:,11)=4.94723389072555E-07
+	
+	
+
+	DO k=1,nbdl 
+ 		            Dif_coef(:,k)=(Dif_coef(:,k)/one_year)*dt
+ 	ENDDO 
+
+
+	Dif_DOC(:)=D_DOC*dt        !We divided by one_year  
+                                   !because the unit of the Dif
+                                   !parameter is m2 yr-1 and the time stept of the model
+                                   !is dt (1/48, by default, i.e. the fraction
+                                   !of 30 min expressed in days) 
+        
+		    DO k=1,nvm 
+ 		            CUE_coef(:,k)=CUE(k) 
+ 		    ENDDO 
+
+    !! 1.5.2 Set soil respiration and DOC fluxes to zero
+    resp_hetero_soil(:,:,:) = zero
+    !resp_hetero_soil_layer(:,:,:) = zero
+    DOC_EXP(:,:,:,:) = zero
+    DOC_RE(:,:,:,:,:) = zero
+    DOC_FLUX(:,:,:,:,:) = zero
+    DOC_FLUX_DIFF(:,:,:,:,:) = zero
+    DOC_FLUX_DIFF_old(:,:,:,:,:) = zero
+    DOC_RUN(:,:,:)= zero
+    DOC_FLOOD(:,:,:)= zero
+    DOC_DRAIN(:,:,:)= zero
+    fluxtot(:,:,:,:)= zero
+    fluxtot_DOC(:,:,:,:,:) = zero
+    flux_decrease(:,:,:,:)= zero
+    litter_tot(:,:,:,:) = zero
+    ! bulk_density must be in kg m-3 and is generally given in g cm-3
+    WHERE (bulk_dens(:) .LT. 500)
+    bulk_dens(:) = bulk_dens(:)*1e3
+    ENDWHERE
+
+    !!1.6 Calculating water content of the first 5 layers
+    soilwater_31mm(:,:)= zero
+    soilwater_31mm(:,:)= soilwater_31mm(:,:) + (z_soil(1) * soil_mc(:,1,:))   
+     IF (sro_bottom .GT. 1) THEN
+      DO l=2, sro_bottom
+         soilwater_31mm(:,:)= soilwater_31mm(:,:) + ((z_soil(l)-z_soil(l-1)) * soil_mc(:,l,:))
+      ENDDO
+    ENDIF
+
+!! 2. Fluxes between carbon reservoirs, and to the atmosphere (respiration) \n
+    !! 2.2 Input from litter to DOC and from reinflitration in floodplains
+    !! For the variables DOC_to_topsoil and DOC_to_subsoil we multiplied by
+    !veget_max because it is not defined per PFT and therefore we redistribute
+    !it following veget_max. Moreover we assume the all the DOC coming from
+    !floodplains reinfiltration is going to DOC coming from the active pool.
+    DO m = 2, nvm
+       DO l = 1,nbdl
+
+          DOC(:,m,l,ifree,imetabo,icarbon) = DOC(:,m,l,ifree,imetabo,icarbon) + soilcarbon_input(:,m,l,imetabo,icarbon)*dt 
+          DOC(:,m,l,ifree,istrabo,icarbon) = DOC(:,m,l,ifree,istrabo,icarbon) + soilcarbon_input(:,m,l,istrabo,icarbon)*dt
+          DOC(:,m,l,ifree,imetbel,icarbon) = DOC(:,m,l,ifree,imetbel,icarbon) + soilcarbon_input(:,m,l,imetbel,icarbon)*dt
+          DOC(:,m,l,ifree,istrbel,icarbon) = DOC(:,m,l,ifree,istrbel,icarbon) + soilcarbon_input(:,m,l,istrbel,icarbon)*dt
+
+	  DOC(:,m,l,ifree,imetabo,icarbon14) = DOC(:,m,l,ifree,imetabo,icarbon14) + soilcarbon_input(:,m,l,imetabo,icarbon14)*dt 
+          DOC(:,m,l,ifree,istrabo,icarbon14) = DOC(:,m,l,ifree,istrabo,icarbon14) + soilcarbon_input(:,m,l,istrabo,icarbon14)*dt
+          DOC(:,m,l,ifree,imetbel,icarbon14) = DOC(:,m,l,ifree,imetbel,icarbon14) + soilcarbon_input(:,m,l,imetbel,icarbon14)*dt
+          DOC(:,m,l,ifree,istrbel,icarbon14) = DOC(:,m,l,ifree,istrbel,icarbon14) + soilcarbon_input(:,m,l,istrbel,icarbon14)*dt
+
+       ENDDO
+          WHERE (veget_max(:,m) .GT. zero)
+          DOC(:,m,1,ifree,iact,icarbon) = DOC(:,m,1,ifree,iact,icarbon) + DOC_to_topsoil(:,icarbon)*dt/veget_max(:,m)
+          DOC(:,m,nbdl,ifree,iact,icarbon) = DOC(:,m,nbdl,ifree,iact,icarbon) + DOC_to_subsoil(:,icarbon)*dt/veget_max(:,m)
+
+          DOC(:,m,1,ifree,iact,icarbon14) = DOC(:,m,1,ifree,iact,icarbon14) + DOC_to_topsoil(:,icarbon14)*dt/veget_max(:,m)
+          DOC(:,m,nbdl,ifree,iact,icarbon14) = DOC(:,m,nbdl,ifree,iact,icarbon14) + DOC_to_subsoil(:,icarbon14)*dt/veget_max(:,m)
+
+          ELSEWHERE
+          DOC(:,m,1,ifree,iact,icarbon) = DOC(:,m,1,ifree,iact,icarbon) 
+          DOC(:,m,nbdl,ifree,iact,icarbon) = DOC(:,m,nbdl,ifree,iact,icarbon)
+
+          DOC(:,m,1,ifree,iact,icarbon14) = DOC(:,m,1,ifree,iact,icarbon14) 
+          DOC(:,m,nbdl,ifree,iact,icarbon14) = DOC(:,m,nbdl,ifree,iact,icarbon14)
+
+          ENDWHERE
+    ENDDO
+
+    !! 2.3. Calculate fluxes
+    DO m = 2,nvm
+      !calculate total litter available
+      litter_tot(:,m,1,icarbon)=litter_above(:,imetabolic,m,icarbon)+litter_above(:,istructural,m,icarbon)
+      litter_tot(:,m,1,icarbon14)=litter_above(:,imetabolic,m,icarbon14)+litter_above(:,istructural,m,icarbon14)
+    
+      DO l = 1, nbdl
+      litter_tot(:,m,l,icarbon)=litter_tot(:,m,l,icarbon) + litter_below(:,imetabolic,m,l,icarbon)+litter_below(:,istructural,m,l,icarbon)
+      litter_tot(:,m,l,icarbon14)=litter_tot(:,m,l,icarbon14) + litter_below(:,imetabolic,m,l,icarbon14)+litter_below(:,istructural,m,l,icarbon14)
+      ENDDO
+   ENDDO
+
+    DO m = 2,nvm ! Loop over #Â PFTs
+
+
+      !! 2.3.1. Flux out of pools
+
+      DO k = 1, ncarb ! Loop over carbon pools from which the flux comes
+
+        DO l = 1, nbdl !Loop over soil layers
+
+         ! Determine total flux out of pool
+         ! S.L. Piao 2006/05/05 - for crop multiply tillage factor of decomposition
+         ! Not crop
+         
+
+          IF (k == iactive) THEN
+             LOM(:,m,l,icarbon) = litter_tot(:,m,l,icarbon) + DOC(:,m,l,ifree,imetabo,icarbon) + DOC(:,m,l,ifree,istrabo,icarbon) + DOC(:,m,l,ifree,imetbel,icarbon) + DOC(:,m,l,ifree,istrbel,icarbon)
+	     LOM(:,m,l,icarbon14) = litter_tot(:,m,l,icarbon14) + DOC(:,m,l,ifree,imetabo,icarbon14) + DOC(:,m,l,ifree,istrabo,icarbon14) + DOC(:,m,l,ifree,imetbel,icarbon14) + DOC(:,m,l,ifree,istrbel,icarbon14)
+
+          ELSEIF (k == islow) THEN
+             LOM(:,m,l,icarbon) = litter_tot(:,m,l,icarbon) + carbon(:,iactive,m,l,icarbon) + DOC(:,m,l,ifree,iact,icarbon) + &
+                          DOC(:,m,l,ifree,imetabo,icarbon) + DOC(:,m,l,ifree,istrabo,icarbon) + DOC(:,m,l,ifree,imetbel,icarbon) + DOC(:,m,l,ifree,istrbel,icarbon)
+             LOM(:,m,l,icarbon14) = litter_tot(:,m,l,icarbon14) + carbon(:,iactive,m,l,icarbon14) + DOC(:,m,l,ifree,iact,icarbon14) + &
+                          DOC(:,m,l,ifree,imetabo,icarbon14) + DOC(:,m,l,ifree,istrabo,icarbon14) + DOC(:,m,l,ifree,imetbel,icarbon14) + DOC(:,m,l,ifree,istrbel,icarbon14)
+
+          ELSEIF (k == ipassive) THEN
+             LOM(:,m,l,icarbon) = litter_tot(:,m,l,icarbon) + carbon(:,iactive,m,l,icarbon) + carbon(:,islow,m,l,icarbon) + DOC(:,m,l,ifree,iact,icarbon) + DOC(:,m,l,ifree,islo,icarbon) + &
+                          DOC(:,m,l,ifree,imetabo,icarbon) + DOC(:,m,l,ifree,istrabo,icarbon) + DOC(:,m,l,ifree,imetbel,icarbon) + DOC(:,m,l,ifree,istrbel,icarbon)
+             LOM(:,m,l,icarbon14) = litter_tot(:,m,l,icarbon14) + carbon(:,iactive,m,l,icarbon14) + carbon(:,islow,m,l,icarbon14) + DOC(:,m,l,ifree,iact,icarbon14) + DOC(:,m,l,ifree,islo,icarbon14) + &
+                          DOC(:,m,l,ifree,imetabo,icarbon14) + DOC(:,m,l,ifree,istrabo,icarbon14) + DOC(:,m,l,ifree,imetbel,icarbon14) + DOC(:,m,l,ifree,istrbel,icarbon14)
+
+          ELSE
+             WRITE(numout,*) "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
+             WRITE(numout,*) "BE CAREFUL SOMETHING STRANGE HAPPENS"
+             WRITE(numout,*) "IN STOMATE_SOILCARBON FOR LOM CALCULATION"
+             WRITE(numout,*) "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
+
+          ENDIF
+
+       WHERE ((soil_mc(:,l,pref_soil_veg(m)) .GT. zero) .AND. (natural(m)))
+               fluxtot(:,k,icarbon,l) =(dt/carbon_tau(k))*(un-exp(-priming_param(k)*LOM(:,m,l,icarbon))) * carbon(:,k,m,l,icarbon) * &
+                    control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4)
+
+               fluxtot(:,k,icarbon14,l) =(dt/carbon_tau(k))*(un-exp(-priming_param(k)*LOM(:,m,l,icarbon14))) * carbon(:,k,m,l,icarbon14) * &
+                    control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4)
+            ! C3 crop
+       ELSEWHERE ((soil_mc(:,l,pref_soil_veg(m)) .GT. zero) .AND.( (.NOT. natural(m)) .AND. (.NOT. is_c4(m)) ))
+               fluxtot(:,k,icarbon,l) =(dt/carbon_tau(k))*(un-exp(-priming_param(k)*LOM(:,m,l,icarbon))) * carbon(:,k,m,l,icarbon) * &
+                    control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4) * flux_tot_coeff(1)
+
+              fluxtot(:,k,icarbon14,l) =(dt/carbon_tau(k))*(un-exp(-priming_param(k)*LOM(:,m,l,icarbon14))) * carbon(:,k,m,l,icarbon14) * &
+                    control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4) * flux_tot_coeff(1)
+            ! C4 crop
+       ELSEWHERE ((soil_mc(:,l,pref_soil_veg(m)) .GT. zero) .AND.( (.NOT. natural(m)) .AND. (is_c4(m)) )) 
+               fluxtot(:,k,icarbon,l) =(dt/carbon_tau(k))*(un-exp(-priming_param(k)*LOM(:,m,l,icarbon))) * carbon(:,k,m,l,icarbon) * &
+                    control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4) * flux_tot_coeff(2)
+              
+	       fluxtot(:,k,icarbon14,l) =(dt/carbon_tau(k))*(un-exp(-priming_param(k)*LOM(:,m,l,icarbon14))) * carbon(:,k,m,l,icarbon14) * &
+                    control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4) * flux_tot_coeff(2)
+       ELSEWHERE
+               fluxtot(:,k,icarbon,l) = zero
+	       fluxtot(:,k,icarbon14,l) = zero
+       ENDWHERE
+
+          ! END - S.L. Piao 2006/05/05 - for crop multiply tillage factor of decomposition
+
+          ! Carbon flux from active pools depends on clay content
+          IF ( k .EQ. iactive ) THEN
+              fluxtot(:,k,icarbon,l) = fluxtot(:,k,icarbon,l) * ( un - flux_tot_coeff(3) * clay(:) )
+	      fluxtot(:,k,icarbon14,l) = fluxtot(:,k,icarbon14,l) * ( un - flux_tot_coeff(3) * clay(:) )
+          ENDIF
+        ENDDO ! End of loop over soil layers
+
+      ENDDO ! End of loop over carbon pools
+     
+      !! 2.3.2 respiration
+      !BE CAREFUL: Here resp_hetero_soil is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_soil is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+      !
+      DO l = 1,nbdl !Loop over soil layers
+	DO k=1,nelements !Loop over nelements
+         resp_hetero_soil(:,m,k) = resp_hetero_soil(:,m,k)+&
+            ( (un-CUE_coef(:,m)) * fluxtot(:,iactive,k,l) + &
+            (un-CUE_coef(:,m)) * fluxtot(:,islow,k,l) + &
+            (un-CUE_coef(:,m))* fluxtot(:,ipassive,k,l)  ) / dt
+	ENDDO !End loop over nelements
+
+      ENDDO !End loop over soil layers
+
+      !! 2.3.3 DOC calculation
+      !! 2.3.3.1 DOC decomposition
+      ! In the Kalbitz et al., 2003 Geoderma as well
+      ! as in Qualls and Haines 1992 SSAJ
+      ! the equation are defined with exponential but for the time
+      ! step we used we can approximate the values with 1st order kinetics.
+
+     DO j = 1,npool  !Loop over pools
+       DO l = 1,nbdl !Loop over soil layers
+        WHERE (soil_mc(:,l,pref_soil_veg(m)) .GT. zero) 
+                 fluxtot_DOC(:,m,l,j,icarbon) = (dt/DOC_tau(j,m))* &
+                                         DOC(:,m,l,ifree,j,icarbon)*control_temp_soil(:,l,npool+j)
+
+		 fluxtot_DOC(:,m,l,j,icarbon14) = (dt/DOC_tau(j,m))* &
+                                         DOC(:,m,l,ifree,j,icarbon14)*control_temp_soil(:,l,npool+j)
+         ELSEWHERE
+                 fluxtot_DOC(:,m,l,j,icarbon) = zero
+		 fluxtot_DOC(:,m,l,j,icarbon14) = zero
+         ENDWHERE
+
+          resp_hetero_soil(:,m,icarbon) = resp_hetero_soil(:,m,icarbon)+&
+             (un-CUE_coef(:,m))*fluxtot_DOC(:,m,l,j,icarbon)/dt
+
+ 	  resp_hetero_soil(:,m,icarbon14) = resp_hetero_soil(:,m,icarbon14)+&
+             (un-CUE_coef(:,m))*fluxtot_DOC(:,m,l,j,icarbon14)/dt
+
+      ENDDO !End loop over soil layers!
+     ENDDO !End loop over soil pool!
+
+      !! 2.3.4 Pools update
+      !! 2.3.4.1 For POC
+      DO l= 1, nbdl ! Loop over soil layers
+
+      carbon(:,iactive,m,l,icarbon) = carbon(:,iactive,m,l,icarbon)+ &
+                               frac_carb(:,ipassive,iactive)*(CUE_coef(:,m))*fluxtot_DOC(:,m,l,ipas,icarbon) + &
+                               frac_carb(:,islow,iactive)*(CUE_coef(:,m))*fluxtot_DOC(:,m,l,islo,icarbon) + &
+                               (CUE_coef(:,m))*fluxtot_DOC(:,m,l,imetbel,icarbon) + &
+                               (CUE_coef(:,m))*fluxtot_DOC(:,m,l,istrbel,icarbon) * (un - lignin_struc_below(:,m,l)) + &
+                               (CUE_coef(:,m))*fluxtot_DOC(:,m,l,imetabo,icarbon) + &
+                               (CUE_coef(:,m))*fluxtot_DOC(:,m,l,istrabo,icarbon) * (un - lignin_struc_above(:,m))
+
+      carbon(:,iactive,m,l,icarbon14) = carbon(:,iactive,m,l,icarbon14)+ &
+                               frac_carb(:,ipassive,iactive)*(CUE_coef(:,m))*fluxtot_DOC(:,m,l,ipas,icarbon14) + &
+                               frac_carb(:,islow,iactive)*(CUE_coef(:,m))*fluxtot_DOC(:,m,l,islo,icarbon14) + &
+                               (CUE_coef(:,m))*fluxtot_DOC(:,m,l,imetbel,icarbon14) + &
+                               (CUE_coef(:,m))*fluxtot_DOC(:,m,l,istrbel,icarbon14) * (un - lignin_struc_below(:,m,l)) + &
+                               (CUE_coef(:,m))*fluxtot_DOC(:,m,l,imetabo,icarbon14) + &
+                               (CUE_coef(:,m))*fluxtot_DOC(:,m,l,istrabo,icarbon14) * (un - lignin_struc_above(:,m))
+
+      carbon(:,islow,m,l,icarbon) = carbon(:,islow,m,l,icarbon)+ &
+                               frac_carb(:,ipassive,islow)*(CUE_coef(:,m))*fluxtot_DOC(:,m,l,ipas,icarbon) + &
+                               frac_carb(:,iactive,islow)*(CUE_coef(:,m))*fluxtot_DOC(:,m,l,iact,icarbon) + &
+                               (CUE_coef(:,m))*fluxtot_DOC(:,m,l,istrbel,icarbon) *lignin_struc_below(:,m,l) + &
+                               (CUE_coef(:,m))*fluxtot_DOC(:,m,l,istrabo,icarbon) *lignin_struc_above(:,m)
+
+      carbon(:,islow,m,l,icarbon14) = carbon(:,islow,m,l,icarbon14)+ &
+                               frac_carb(:,ipassive,islow)*(CUE_coef(:,m))*fluxtot_DOC(:,m,l,ipas,icarbon14) + &
+                               frac_carb(:,iactive,islow)*(CUE_coef(:,m))*fluxtot_DOC(:,m,l,iact,icarbon14) + &
+                               (CUE_coef(:,m))*fluxtot_DOC(:,m,l,istrbel,icarbon14) *lignin_struc_below(:,m,l) + &
+                               (CUE_coef(:,m))*fluxtot_DOC(:,m,l,istrabo,icarbon14) *lignin_struc_above(:,m)
+
+      carbon(:,ipassive,m,l,icarbon) = carbon(:,ipassive,m,l,icarbon)+ &
+                               frac_carb(:,iactive,ipassive)*(CUE_coef(:,m))*fluxtot_DOC(:,m,l,iact,icarbon) + &
+                               frac_carb(:,islow,ipassive)*(CUE_coef(:,m))*fluxtot_DOC(:,m,l,islo,icarbon)
+
+      carbon(:,ipassive,m,l,icarbon14) = carbon(:,ipassive,m,l,icarbon14)+ &
+                               frac_carb(:,iactive,ipassive)*(CUE_coef(:,m))*fluxtot_DOC(:,m,l,iact,icarbon14) + &
+                               frac_carb(:,islow,ipassive)*(CUE_coef(:,m))*fluxtot_DOC(:,m,l,islo,icarbon14)
+
+
+      ENDDO ! End loop over soil layers
+
+     
+
+
+	DO k = 1, ncarb ! Loop over carbon pools from which the flux comes
+           DO l = 1, nbdl !Loop over soil layers
+
+        carbon(:,k,m,l,icarbon) = carbon(:,k,m,l,icarbon) - fluxtot(:,k,icarbon,l)
+	carbon(:,k,m,l,icarbon14) = carbon(:,k,m,l,icarbon14) - fluxtot(:,k,icarbon14,l) 
+
+        ENDDO ! End of loop over soil layers
+      ENDDO ! End of loop over carbon pools
+
+      
+
+	DO k = 1, ncarb ! Loop over carbon pools from which the flux comes
+           DO l = 1, nbdl !Loop over soil layers
+	
+       
+        flux_decrease(:,k,m,l)= ((k_decrease)/one_year) * carbon(:,k,m,l,icarbon14) * dt
+        
+
+        ENDDO ! End of loop over soil layers
+      ENDDO ! End of loop over carbon pools
+
+	
+	DO k = 1, ncarb ! Loop over carbon pools from which the flux comes
+           DO l = 1, nbdl !Loop over soil layers
+	
+        carbon(:,k,m,l,icarbon14) = carbon(:,k,m,l,icarbon14) - flux_decrease(:,k,m,l)
+!
+        ENDDO ! End of loop over soil layers
+      ENDDO ! End of loop over carbon pools
+
+ 
+      !! 2.3.4.2 For DOC
+      DO l = 1,nbdl !Loop over soil layers
+         DO kk = 1,nelements !Loop over elements
+           !For Active pool
+
+           DOC(:,m,l,ifree,iact,kk) = DOC(:,m,l,ifree,iact,kk) + (CUE_coef(:,m)) * fluxtot(:,iactive,kk,l)
+
+           !For Slow pool    
+
+           DOC(:,m,l,ifree,islo,kk) = DOC(:,m,l,ifree,islo,kk) + (CUE_coef(:,m)) * fluxtot(:,islow,kk,l)
+
+           !For Passive pool
+
+           DOC(:,m,l,ifree,ipas,kk) = DOC(:,m,l,ifree,ipas,kk) + (CUE_coef(:,m)) * fluxtot(:,ipassive,kk,l)
+
+      ENDDO !End loop over elements
+    ENDDO !End loop over soil layers
+
+     DO j = 1,npool  !Loop over pools
+       DO l = 1,nbdl !Loop over soil layers
+
+          DOC(:,m,l,ifree,j,icarbon) = DOC(:,m,l,ifree,j,icarbon) - fluxtot_DOC(:,m,l,j,icarbon)
+	  DOC(:,m,l,ifree,j,icarbon14) = DOC(:,m,l,ifree,j,icarbon14) - fluxtot_DOC(:,m,l,j,icarbon14)
+
+       ENDDO !End loop over soil layers!
+     ENDDO !End loop over soil pool!
+
+      !! 2.3.5 Adsorption/resorption of DOC using linear Mass isotherm assuming
+      !that DOC from native soil is zero (b parameters in Nodvin et al., 1986,
+      !Soil Science)
+      !For the moment, fixed parameters taken from Kaiser and others,1996, b in mg/g soil
+Kd(:,:)=kd_ads
+!IM(:,)=m_ads
+!b(:,:)=b_ads
+
+   !     Kd(:,1) = dix**(-3.1+0.2*log10(clay(:)*cent)+log10(z_soil(1)*cent/deux)) 
+ 	 DO l = 1,nbdl 
+
+         ! IM, b or Kd calculating following the statistical model obtained in 
+         ! Camino Serrano et al. in prep
+         ! !Kd(:,l) = dix**(-3.1+0.2*log10(clay(:)*cent)+log10((z_soil(l)+z_soil(l-1))/deux)) 
+	 Kd(:,l) = 0.001225841-0.000212346*soil_ph(:)+0.003739918*clay(:)
+	 Kd(:,l) = MAX(zero,Kd(:,l))
+   ENDDO
+
+	     !Kd(:,:)=MAX(Kd(:,:),dix**(-3.2)) 
+ 	     !Kd(:,:)=MIN(Kd(:,:),dix**(-1.5)) 
+
+! Calculation of amount adsorbed/desorbed based on 
+! Ota et al., 2013 JGR
+    DO l = 1,nbdl !Loop over soil layers
+         DO kk = 1,nelements !Loop over elements
+             DO kkk = 1,npool !Loop over soil and litter pool
+                DOC_RE(:,m,l,kkk,kk) = (Kd(:,l)*bulk_dens(:))/(Kd(:,l)*bulk_dens(:)+un)* &
+                                       (DOC(:,m,l,ifree,kkk,kk)+DOC(:,m,l,iadsorbed,kkk,kk)) 
+            ENDDO !End loop over soil and litter pool
+         ENDDO !End loop over elements
+    ENDDO !End loop over soil layers
+
+DOC_old(:,m,:,:,:,:)= zero
+DOC_old(:,m,:,:,:,:)=DOC(:,m,:,:,:,:)
+      DO l = 1,nbdl !Loop over soil layers
+          DO kk = 1,nelements !Loop over elements
+             DO kkk = 1,npool !Loop over soil and litter pool
+                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)))
+               !To avoid adsorbing more DOC than existing (when there is not enough free carbon)
+                   DOC(:,m,l,iadsorbed,kkk,kk)= DOC_old(:,m,l,iadsorbed,kkk,kk)+ DOC_old(:,m,l,ifree,kkk,kk)
+                   DOC(:,m,l,ifree,kkk,kk)= zero           
+                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)))
+               !To avoid desorbing more DOC than existing (when there is not enough adsorbed carbon)
+                   DOC(:,m,l,iadsorbed,kkk,kk)= zero 
+                   DOC(:,m,l,ifree,kkk,kk)= DOC_old(:,m,l,iadsorbed,kkk,kk)+ DOC_old(:,m,l,ifree,kkk,kk)        
+                ELSEWHERE ((DOC_RE(:,m,l,kkk,kk)-DOC_old(:,m,l,iadsorbed,kkk,kk)) .NE. zero) 
+                !The normal functioning of the distribution coefficient to reach equilibrium between DOC adsorbed and DOC free   
+                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))  
+                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))
+                ELSEWHERE
+                DOC(:,m,l,ifree,kkk,kk)=DOC_old(:,m,l,ifree,kkk,kk)
+                DOC(:,m,l,iadsorbed,kkk,kk)= DOC_old(:,m,l,iadsorbed,kkk,kk)
+                ENDWHERE
+              ENDDO !End loop over soil and litter pool
+          ENDDO !End loop over elements
+    ENDDO !End loop over soil layers
+
+
+      !! 2.3.6 Transport of DOC with the water fluxes following Futter et al.,
+      ! (2007) Water ressources research. 
+
+      !! 2.3.6.1 Change DOC free from gC m-2 of soil to g C m^-3 of water  
+       DO kk = 1, nelements !Loop over elements
+
+            DO k = 1, npool ! Loop over soil and litter pools
+
+           WHERE( soil_mc(:,1,pref_soil_veg(m)) .GT. zero)
+
+             DOC(:,m,1,ifree,k,kk) = DOC(:,m,1,ifree,k,kk) / (z_soil(1)*soil_mc(:,1,pref_soil_veg(m)))
+
+           ELSEWHERE
+             DOC(:,m,1,ifree,k,kk) = DOC(:,m,1,ifree,k,kk)
+           ENDWHERE
+
+            ENDDO ! End loop over soil and litter pools
+
+       ENDDO !End loop over elements
+
+      DO l = 2,nbdl !Loop over soil layers
+
+       DO kk = 1, nelements !Loop over elements
+
+           DO k = 1, npool ! Loop over soil and litter pools
+
+           WHERE( soil_mc(:,l,pref_soil_veg(m)) .GT. zero)
+
+             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)))
+
+           ELSEWHERE
+             DOC(:,m,l,ifree,k,kk) = DOC(:,m,l,ifree,k,kk)
+           ENDWHERE
+
+            ENDDO ! End loop over soil and litter pools
+
+       ENDDO !End loop over elements
+
+     ENDDO !End loop over soil layers 
+     ! DOC fluxes between layers calculated (we multiplied by
+      ! 1E-3 to convert from kg/m2 to m3/m2)
+      ! Be careful we multiply by dt because the unit is per day in hydrol.f90 
+       DO l = 1,nbdl-1 !Loop over soil layers
+          DO kk = 1,nelements !Loop over elements
+               DO kkk = 1,npool !Loop over soil and litter pool
+
+                  WHERE ((wat_flux(:,l,pref_soil_veg(m)) .GT. 0.) .AND. (soil_mc(:,l,pref_soil_veg(m)) .GT. zero))
+                  DOC_FLUX(:,m,l,kkk,kk) = DOC(:,m,l,ifree,kkk,kk)*wat_flux(:,l,pref_soil_veg(m))*1E-3*dt
+                  ELSEWHERE ((wat_flux(:,l,pref_soil_veg(m)) .LT. 0.) .AND. (soil_mc(:,l,pref_soil_veg(m)) .GT. zero))
+                  DOC_FLUX(:,m,l,kkk,kk) = DOC(:,m,l+1,ifree,kkk,kk)*abs(wat_flux(:,l,pref_soil_veg(m)))*1E-3*dt
+                  ELSEWHERE 
+                  DOC_FLUX(:,m,l,kkk,kk) = zero
+                  ENDWHERE
+ 
+               ENDDO !End loop over soil and litter pool
+           ENDDO !End loop over elements
+      ENDDO !End loop over soil layers
+
+         !For the last layer
+          DO kk = 1,nelements !Loop over elements
+               DO kkk = 1,npool !Loop over soil and litter pool
+                  
+                  WHERE ((wat_flux(:,nbdl,pref_soil_veg(m)) .GT. 0.) .AND. (soil_mc(:,nbdl,pref_soil_veg(m)) .GT. zero))
+                  DOC_FLUX(:,m,nbdl,kkk,kk) = DOC(:,m,nbdl,ifree,kkk,kk)*wat_flux(:,nbdl,pref_soil_veg(m))*1E-3*dt
+                  ELSEWHERE 
+                  DOC_FLUX(:,m,nbdl,kkk,kk) = zero
+                  ENDWHERE
+               ENDDO !End loop over soil and litter pool
+           ENDDO !End loop over elements
+
+      !! 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
+      !For the first layer
+
+        DO k = 1, npool ! Loop over soil and litter pools
+           DO kk = 1,nelements !Loop over elements
+            WHERE(soil_mc(:,1,pref_soil_veg(m)) .GT. zero)              
+             DOC(:,m,1,ifree,k,kk)=DOC(:,m,1,ifree,k,kk) * soil_mc(:,1,pref_soil_veg(m)) * z_soil(1)
+            ELSEWHERE
+             DOC(:,m,1,ifree,k,kk)=DOC(:,m,1,ifree,k,kk) 
+            ENDWHERE      
+           ENDDO !End loop over elements
+        ENDDO ! End loop over soil and litter pools
+
+      !For the other layers
+
+     DO l= 2, nbdl ! Loop over soil layers
+        DO k = 1, npool ! Loop over soil and litter pools
+           DO kk = 1,nelements !Loop over elements
+            WHERE(soil_mc(:,l,pref_soil_veg(m)) .GT. zero)
+              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))
+            ELSEWHERE
+              DOC(:,m,l,ifree,k,kk)=DOC(:,m,l,ifree,k,kk) 
+            ENDWHERE
+           ENDDO !End loop over elements
+        ENDDO ! End loop over soil and litter pools
+      ENDDO ! End loop over soil layers
+
+       ! DOC update
+           !For the first layer
+DOC_old(:,m,:,:,:,:)= zero
+DOC_old(:,m,:,:,:,:)=DOC(:,m,:,:,:,:)
+
+        DO kk = 1,nelements !Loop over elements
+               DO kkk = 1,npool !Loop over soil and litter pool
+              
+                  WHERE (wat_flux(:,1,pref_soil_veg(m)) .GT. 0.) 
+                   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)) 
+                  ELSEWHERE (wat_flux(:,1,pref_soil_veg(m)) .LT. 0.) 
+                   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))
+                  ELSEWHERE
+                   DOC(:,m,1,ifree,kkk,kk) = DOC_old(:,m,1,ifree,kkk,kk)
+                  ENDWHERE
+ 
+               ENDDO !End loop over soil and litter pool
+           ENDDO !End loop over elements
+
+      ! For the other layers
+     DO l = 2,nbdl-1 !Loop over soil layers
+     DO kk = 1,nelements !Loop over elements
+            DO kkk = 1,npool !Loop over soil and litter pool
+                 WHERE ((wat_flux(:,l,pref_soil_veg(m)) .GT. 0.) .AND. (wat_flux(:,l-1,pref_soil_veg(m)) .GT. 0.))
+                  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))
+                 ELSEWHERE ((wat_flux(:,l,pref_soil_veg(m)) .LT. 0.) .AND. (wat_flux(:,l-1,pref_soil_veg(m)) .LT. 0.))
+                  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))
+                 ELSEWHERE ((wat_flux(:,l,pref_soil_veg(m)) .GT. 0.) .AND. (wat_flux(:,l-1,pref_soil_veg(m)) .LT. 0.))
+                  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))
+                 ELSEWHERE ((wat_flux(:,l,pref_soil_veg(m)) .LT. 0.) .AND. (wat_flux(:,l-1,pref_soil_veg(m)) .GT. 0.))
+                  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))
+                 ELSEWHERE 
+                  DOC(:,m,l,ifree,kkk,kk) = DOC_old(:,m,l,ifree,kkk,kk)
+                 ENDWHERE
+
+           ENDDO !End loop over soil and litter pool
+        ENDDO !End loop over elements
+      ENDDO !End loop over soil layers
+
+         !For the last layer
+         DO kk = 1,nelements !Loop over elements
+            DO kkk = 1,npool !Loop over soil and litter pool
+                  WHERE (wat_flux(:,nbdl-1,pref_soil_veg(m)) .GT. 0.)
+                  DOC(:,m,nbdl,ifree,kkk,kk) = DOC_old(:,m,nbdl,ifree,kkk,kk) + MIN(DOC_FLUX(:,m,nbdl-1,kkk,kk),DOC_old(:,m,nbdl-1,ifree,kkk,kk))
+                 ELSEWHERE (wat_flux(:,nbdl-1,pref_soil_veg(m)) .LT. 0.)
+                  DOC(:,m,nbdl,ifree,kkk,kk) = DOC_old(:,m,nbdl,ifree,kkk,kk) - MIN(DOC_FLUX(:,m,nbdl-1,kkk,kk),DOC_old(:,m,nbdl,ifree,kkk,kk))
+                 ELSEWHERE
+                  DOC(:,m,nbdl,ifree,kkk,kk) = DOC_old(:,m,nbdl,ifree,kkk,kk)
+                 ENDWHERE
+
+           ENDDO !End loop over soil and litter pool
+        ENDDO !End loop over elements
+
+       !! 2.3.8 DOC transport by diffusion
+       !! 2.3.8.1 Calculation of the DOC fluxes by diffusion
+       ! Here we use the DOC concentration in the soil and not in water to
+       ! stabilize the calcul of
+       ! water distribution is continuous in the soil column (no dry places)
+
+DOC_old2(:,m,:,:,:,:)=zero
+DOC_old_buffer(:,m,:,:,:,:)=zero
+DOC_old2(:,m,:,:,:,:)=DOC(:,m,:,:,:,:)
+
+     DO kkk = 1, npool ! Loop over soil and litter pools
+       DO kk = 1, nelements ! Loop over elements
+               
+        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))
+
+      DO l= 2, nbdl-1 ! Loop over soil layers
+        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))
+      ENDDO
+
+       !Below we checked if in case that, in a given layer, you have diffusion
+       !in the above and below litters, both fluxes are not higher than the
+       !stocks of the given layer.
+      DO l =1, nbdl-2
+           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. &
+                  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. &
+                  DOC_FLUX_DIFF(:,m,l,kkk,kk) + DOC_FLUX_DIFF(:,m,l+1,kkk,kk) .GT. DOC_old2(:,m,l+1,ifree,kkk,kk))
+            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)))
+            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)))
+           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. &
+                      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. &
+                      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)
+            DOC_FLUX_DIFF(:,m,l,kkk,kk) = DOC_FLUX_DIFF(:,m,l,kkk,kk)
+            DOC_FLUX_DIFF(:,m,l+1,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_FLUX_DIFF(:,m,l,kkk,kk)
+           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. &
+                      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. &
+                      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)
+            DOC_FLUX_DIFF(:,m,l,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_FLUX_DIFF(:,m,l+1,kkk,kk)
+            DOC_FLUX_DIFF(:,m,l+1,kkk,kk) = DOC_FLUX_DIFF(:,m,l+1,kkk,kk)
+           ELSEWHERE
+            DOC_FLUX_DIFF(:,m,l,kkk,kk) = DOC_FLUX_DIFF(:,m,l,kkk,kk)
+            DOC_FLUX_DIFF(:,m,l+1,kkk,kk) = DOC_FLUX_DIFF(:,m,l+1,kkk,kk)
+           ENDWHERE
+      ENDDO
+
+      DO l= 1, nbdl-1 ! Loop over soil layers
+           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. &
+                 ((DOC_FLUX_DIFF(:,m,l,kkk,kk) - DOC_old2(:,m,l+1,ifree,kkk,kk)) .GE. min_stomate))
+            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)
+            DOC_old_buffer(:,m,l+1,ifree,kkk,kk) = - DOC_old2(:,m,l+1,ifree,kkk,kk) 
+            DOC(:,m,l+1,ifree,kkk,kk) = zero
+           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. &
+                  ((DOC_old2(:,m,l+1,ifree,kkk,kk) - DOC_FLUX_DIFF(:,m,l,kkk,kk)) .GT. min_stomate))
+            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)
+            DOC_old_buffer(:,m,l+1,ifree,kkk,kk) =  - DOC_FLUX_DIFF(:,m,l,kkk,kk)
+            DOC(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) - DOC_FLUX_DIFF(:,m,l,kkk,kk)
+           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. &
+                  ((DOC_FLUX_DIFF(:,m,l,kkk,kk) - DOC_old2(:,m,l,ifree,kkk,kk)) .GE. min_stomate))
+            DOC(:,m,l,ifree,kkk,kk) = zero + DOC_old_buffer(:,m,l,ifree,kkk,kk)
+            DOC_old_buffer(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l,ifree,kkk,kk)
+            DOC(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_old2(:,m,l,ifree,kkk,kk)
+           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. &
+                  ((DOC_old2(:,m,l,ifree,kkk,kk) - DOC_FLUX_DIFF(:,m,l,kkk,kk)) .GT. min_stomate))
+            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)
+            DOC_old_buffer(:,m,l+1,ifree,kkk,kk) = DOC_FLUX_DIFF(:,m,l,kkk,kk)
+            DOC(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_FLUX_DIFF(:,m,l,kkk,kk)
+           ELSEWHERE
+            DOC(:,m,l,ifree,kkk,kk) = DOC_old2(:,m,l,ifree,kkk,kk)
+            DOC(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk)
+           ENDWHERE
+        ENDDO ! End loop over soil layers
+       ENDDO ! End loop over elements
+      ENDDO ! End loop over DOC pools
+
+        !! 2.3.9 DOC export 
+        !! Calculate total DOC going out of the system (the factor 1E-3 is
+        !! applied to convert runoff, floodout, drainage from kg/m2 to m3/m2) 
+        !! We assume that runoff and floodout affects the first layer of soil
+        !! and drainage only the last layer. 
+        !! Drainage and runoff are given by soil type by hydrol.f90 but not floodout (it is a weighed mean) explaining why 
+        !! the calculation is a bit different between DOC_RUN and DOC_FLOOD. Moreover, floodout is computed as evaporation-precipitation,
+        !! so it represent an export to the rivers only if floodout is negative explaing why we have to multiply by -un.
+        !! Be careful we do not * by dt because it is already done in hydrol.f90
+         DO kk = 1,nelements !Loop over elements
+            DO kkk = 1,npool !Loop over soil and litter pool
+               !DOC lost through runoff for the first layer
+                 !WHERE (soil_mc(:,1,pref_soil_veg(m)) .GT. zero)
+                 !DOC_RUN(:,m,kk) = DOC_RUN(:,m,kk) + MIN(DOC(:,m,1,ifree,kkk,kk),&
+                 !                                        DOC(:,m,1,ifree,kkk,kk)*runoff_per_soil(:,pref_soil_veg(m))*1E-3/(z_soil(1) * soil_mc(:,1,pref_soil_veg(m))))
+                 !ELSEWHERE
+                 !DOC_RUN(:,m,kk) = DOC_RUN(:,m,kk)
+                 !ENDWHERE
+                 WHERE (soilwater_31mm(:,pref_soil_veg(m)) .GT. zero)
+                 DOC_RUN(:,m,kk) = DOC_RUN(:,m,kk) + MIN(DOC(:,m,1,ifree,kkk,kk),DOC(:,m,1,ifree,kkk,kk) &
+                                      * (runoff_per_soil(:,pref_soil_veg(m))*1E-3/soilwater_31mm(:,pref_soil_veg(m))) &
+                                      * (z_soil(1) * soil_mc(:,1,pref_soil_veg(m)))/soilwater_31mm(:,pref_soil_veg(m)))
+                 ELSEWHERE
+                 DOC_RUN(:,m,kk) = DOC_RUN(:,m,kk)
+                 ENDWHERE               
+                 !And for the layers 2-? layers
+                 IF (sro_bottom .GT. 1) THEN
+                    DO l=2,sro_bottom
+                      WHERE (soilwater_31mm(:,pref_soil_veg(m)) .GT. zero)
+                         DOC_RUN(:,m,kk) = DOC_RUN(:,m,kk) + MIN(DOC(:,m,l,ifree,kkk,kk),DOC(:,m,l,ifree,kkk,kk) &
+                                     * (runoff_per_soil(:,pref_soil_veg(m))*1E-3/soilwater_31mm(:,pref_soil_veg(m))) &
+                                     * ((z_soil(l)-z_soil(l-1)) * soil_mc(:,l,pref_soil_veg(m)))/soilwater_31mm(:,pref_soil_veg(m)))                 
+                       ELSEWHERE
+                       DOC_RUN(:,m,kk) = DOC_RUN(:,m,kk)
+                       ENDWHERE
+                    ENDDO
+                 ENDIF !sro_bottom .GT. 1
+                 WHERE ((soil_mc(:,1,pref_soil_veg(m)) .GT. zero) .AND. (floodout(:) .LT. zero))
+                 DOC_FLOOD(:,m,kk) = DOC_FLOOD(:,m,kk) + MIN(DOC(:,m,1,ifree,kkk,kk),&
+                                                                 DOC(:,m,1,ifree,kkk,kk)*moins_un*floodout(:)*1E-3/(z_soil(1) * moist_soil(:,1)))
+                 ELSEWHERE
+                 DOC_FLOOD(:,m,kk) = DOC_FLOOD(:,m,kk)
+                 ENDWHERE
+
+                 WHERE (soil_mc(:,nbdl,pref_soil_veg(m)) .GT. zero)
+                 DOC_DRAIN(:,m,kk) = DOC_DRAIN(:,m,kk) + MIN(DOC(:,m,nbdl,ifree,kkk,kk),&
+                                                             DOC(:,m,nbdl,ifree,kkk,kk)*drainage_per_soil(:,pref_soil_veg(m))*1E-3/((z_soil(nbdl)-z_soil(nbdl-1)) * soil_mc(:,nbdl,pref_soil_veg(m))))
+                 ELSEWHERE
+                 DOC_DRAIN(:,m,kk) = DOC_DRAIN(:,m,kk)
+                 ENDWHERE
+
+           ENDDO !End loop over soil and litter pool
+        ENDDO !End loop over elements
+
+         DO kk = 1,nelements !Loop over elements
+             DOC_EXP(:,m,irunoff,kk) = DOC_RUN(:,m,kk)/dt
+             DOC_EXP(:,m,iflooded,kk) = DOC_FLOOD(:,m,kk)/dt
+             DOC_EXP(:,m,idrainage,kk) = DOC_DRAIN(:,m,kk)/dt
+        ENDDO !End loop over elements
+! We substract runoff, floodout and drainage from DOC pools
+    DO kkk = 1,npool !Loop over soil and litter pool    
+          DO kk = 1, nelements
+
+!For the first layer
+          WHERE (soilwater_31mm(:,pref_soil_veg(m)) .GT. zero)
+           DOC(:,m,1,ifree,kkk,kk) = DOC(:,m,1,ifree,kkk,kk) -  MIN(DOC(:,m,1,ifree,kkk,kk),DOC(:,m,1,ifree,kkk,kk) &
+                               * (runoff_per_soil(:,pref_soil_veg(m))*1E-3/soilwater_31mm(:,pref_soil_veg(m))) &
+                               * (z_soil(1) * soil_mc(:,1,pref_soil_veg(m)))/soilwater_31mm(:,pref_soil_veg(m)))
+           ELSEWHERE
+           DOC(:,m,1,ifree,kkk,kk) = DOC(:,m,1,ifree,kkk,kk)
+          ENDWHERE             
+          !And for the layers 2-5
+          IF (sro_bottom .GT. 1) THEN
+             DO l=2,sro_bottom
+                WHERE (soilwater_31mm(:,pref_soil_veg(m)) .GT. zero)
+                  DOC(:,m,l,ifree,kkk,kk) = DOC(:,m,l,ifree,kkk,kk) -  MIN(DOC(:,m,l,ifree,kkk,kk),DOC(:,m,l,ifree,kkk,kk) &
+                              * (runoff_per_soil(:,pref_soil_veg(m))*1E-3/soilwater_31mm(:,pref_soil_veg(m))) &
+                              * ((z_soil(l)-z_soil(l-1)) * soil_mc(:,l,pref_soil_veg(m)))/soilwater_31mm(:,pref_soil_veg(m)))                 
+                ELSEWHERE
+                  DOC(:,m,l,ifree,kkk,kk) = DOC(:,m,l,ifree,kkk,kk)
+                ENDWHERE
+              ENDDO
+            ENDIF !sro_bottom .GT. 1
+
+           WHERE ((soil_mc(:,1,pref_soil_veg(m)) .GT. zero) .AND. (floodout(:) .LT. zero))
+           DOC(:,m,1,ifree,kkk,kk) = DOC(:,m,1,ifree,kkk,kk) -  &
+                                      MIN(DOC(:,m,1,ifree,kkk,kk),&
+                                           DOC(:,m,1,ifree,kkk,kk)*moins_un*floodout(:)*1E-3/(z_soil(1) * moist_soil(:,1)))
+
+           ELSEWHERE
+           DOC(:,m,1,ifree,kkk,kk) = DOC(:,m,1,ifree,kkk,kk)
+           ENDWHERE
+
+!For the last layer
+           WHERE (soil_mc(:,nbdl,pref_soil_veg(m)) .GT. zero)
+           DOC(:,m,nbdl,ifree,kkk,kk) = DOC(:,m,nbdl,ifree,kkk,kk) - &
+                                        MIN (DOC(:,m,nbdl,ifree,kkk,kk),&
+                                            DOC(:,m,nbdl,ifree,kkk,kk)*drainage_per_soil(:,pref_soil_veg(m))*1E-3/((z_soil(nbdl)-z_soil(nbdl-1)) * soil_mc(:,nbdl,pref_soil_veg(m))))
+           ELSEWHERE
+           DOC(:,m,nbdl,ifree,kkk,kk) = DOC(:,m,nbdl,ifree,kkk,kk)
+           ENDWHERE
+         ENDDO ! End loop over elements
+    ENDDO !End loop over soil and litter pool
+
+      !! 2.3.10 Transport of particulate organic C (i.e. active, slow and passive
+      !! pools) following the second Fick's Law (OÂ¿Brien and Stout, 1978; Wynn
+      !! et al., 2005). Represent the bioturbation and is generally associated
+      !! with transport  plant debris (Elzein and Balesdent, 1995; Bruun et al., 
+      !! 2007; Braakhekke et al., 2011, Guenet et al., 2013) 
+
+      ! Definition of the diffusion rate from Guenet et al., (2013) BG for the
+      ! moment but must depends on clay, ph organic C, or whatever...
+      
+
+ carbon_old(:,:,m,:,:)=zero
+ carbon_old_buffer(:,:,m,:,:)=zero
+ carbon_old(:,:,m,:,icarbon)=carbon(:,:,m,:,icarbon)
+ carbon_old(:,:,m,:,icarbon14)=carbon(:,:,m,:,icarbon14)
+
+     DO kk = 1, ncarb ! Loop over soil and litter pools
+
+        carbon_flux(:,kk,m,1,icarbon) = Dif_coef(:,1)*ABS(carbon_old(:,kk,m,1,icarbon)/(z_soil(1))-carbon_old(:,kk,m,2,icarbon)/(z_soil(2)-z_soil(1)))/(z_soil(2)-z_soil(1))
+	carbon_flux(:,kk,m,1,icarbon14) = Dif_coef(:,1)*ABS(carbon_old(:,kk,m,1,icarbon14)/(z_soil(1))-carbon_old(:,kk,m,2,icarbon14)/(z_soil(2)-z_soil(1)))/(z_soil(2)-z_soil(1))
+
+      DO l= 2, nbdl-1 ! Loop over soil layers
+        carbon_flux(:,kk,m,l,icarbon) = Dif_coef(:,l)*ABS(carbon_old(:,kk,m,l,icarbon)/(z_soil(l)-z_soil(l-1))-carbon_old(:,kk,m,l+1,icarbon)/(z_soil(l+1)-z_soil(l)))/(z_soil(l+1)-z_soil(l))
+	carbon_flux(:,kk,m,l,icarbon14) = Dif_coef(:,l)*ABS(carbon_old(:,kk,m,l,icarbon14)/(z_soil(l)-z_soil(l-1))-carbon_old(:,kk,m,l+1,icarbon14)/(z_soil(l+1)-z_soil(l)))/(z_soil(l+1)-z_soil(l))	
+      ENDDO
+        carbon_flux_old(:,kk,m,:,icarbon) = carbon_flux(:,kk,m,:,icarbon)
+	carbon_flux_old(:,kk,m,:,icarbon14) = carbon_flux(:,kk,m,:,icarbon14)
+
+       !Below we checked if in case that, in a given layer, you have diffusion
+       !in the above and below litters, both fluxes are not higher than the
+       !stocks of the given layer.
+
+      DO l =1, nbdl-2
+	DO n=1,nelements
+           WHERE (carbon_old(:,kk,m,l,n)/(z_soil(l)-z_soil(l-1)) .LT. carbon_old(:,kk,m,l+1,n)/(z_soil(l+1)-z_soil(l)) .AND. &
+                  carbon_old(:,kk,m,l+2,n)/(z_soil(l+2)-z_soil(l+1)) .LT. carbon_old(:,kk,m,l+1,n)/(z_soil(l+1)-z_soil(l)) .AND. &
+                  carbon_flux(:,kk,m,l,n)+carbon_flux(:,kk,m,l+1,n) .GT. carbon_old(:,kk,m,l+1,n))
+            carbon_flux(:,kk,m,l,n) = carbon_old(:,kk,m,l+1,n)*(carbon_flux(:,kk,m,l,n)/(carbon_flux(:,kk,m,l,n)+carbon_flux(:,kk,m,l+1,n)))
+            carbon_flux(:,kk,m,l+1,n) = carbon_old(:,kk,m,l+1,n)*(carbon_flux(:,kk,m,l+1,n)/(carbon_flux(:,kk,m,l,n)+carbon_flux(:,kk,m,l+1,n)))
+           ELSEWHERE (carbon_old(:,kk,m,l,n)/(z_soil(l)-z_soil(l-1)) .GE. carbon_old(:,kk,m,l+1,n)/(z_soil(l+1)-z_soil(l)) .AND. &
+                      carbon_old(:,kk,m,l+2,n)/(z_soil(l+2)-z_soil(l+1)) .LT. carbon_old(:,kk,m,l+1,n)/(z_soil(l+1)-z_soil(l)) .AND. &
+                      carbon_old(:,kk,m,l+1,n) + carbon_flux(:,kk,m,l,n) - carbon_flux(:,kk,m,l+1,n) .LE. min_stomate)
+            carbon_flux(:,kk,m,l,n) = carbon_flux(:,kk,m,l,n)
+            carbon_flux(:,kk,m,l+1,n) = carbon_old(:,kk,m,l+1,n) + carbon_flux(:,kk,m,l,n)
+           ELSEWHERE (carbon_old(:,kk,m,l,n)/(z_soil(l)-z_soil(l-1)) .LT. carbon_old(:,kk,m,l+1,n)/(z_soil(l+1)-z_soil(l)) .AND. &
+                      carbon_old(:,kk,m,l+2,n)/(z_soil(l+2)-z_soil(l+1)) .GE. carbon_old(:,kk,m,l+1,n)/(z_soil(l+1)-z_soil(l)) .AND. &
+                      carbon_old(:,kk,m,l+1,n) - carbon_flux(:,kk,m,l,n) + carbon_flux(:,kk,m,l+1,n) .LE. min_stomate)
+            carbon_flux(:,kk,m,l,n) = carbon_old(:,kk,m,l+1,n) + carbon_flux(:,kk,m,l+1,n)
+            carbon_flux(:,kk,m,l+1,n) = carbon_flux(:,kk,m,l+1,n)
+           ELSEWHERE
+            carbon_flux(:,kk,m,l,n) = carbon_flux(:,kk,m,l,n)
+            carbon_flux(:,kk,m,l+1,n) = carbon_flux(:,kk,m,l+1,n)
+           ENDWHERE
+	ENDDO
+      ENDDO
+
+      DO l= 1, nbdl-1 ! Loop over soil layers
+	DO n=1,nelements
+           WHERE ((carbon_old(:,kk,m,l,n)/(z_soil(l)-z_soil(l-1)) .LT. carbon_old(:,kk,m,l+1,n)/(z_soil(l+1)-z_soil(l))) .AND. &
+                 ((carbon_flux(:,kk,m,l,n) - carbon_old(:,kk,m,l+1,n)) .GE. min_stomate))
+            carbon(:,kk,m,l,n) = carbon_old(:,kk,m,l,n) + carbon_old(:,kk,m,l+1,n) + carbon_old_buffer(:,kk,m,l,n)
+            carbon_old_buffer(:,kk,m,l+1,n) = -carbon_old(:,kk,m,l+1,n) 
+            carbon(:,kk,m,l+1,n) = zero
+           ELSEWHERE ((carbon_old(:,kk,m,l,n)/(z_soil(l)-z_soil(l-1)) .LT. carbon_old(:,kk,m,l+1,n)/(z_soil(l+1)-z_soil(l))) .AND. &
+                  ((carbon_old(:,kk,m,l+1,n) - carbon_flux(:,kk,m,l,n)) .GT. min_stomate))
+            carbon(:,kk,m,l,n) = carbon_old(:,kk,m,l,n) + carbon_flux(:,kk,m,l,n) + carbon_old_buffer(:,kk,m,l,n)
+            carbon_old_buffer(:,kk,m,l+1,n) =  - carbon_flux(:,kk,m,l,n)
+            carbon(:,kk,m,l+1,n) = carbon_old(:,kk,m,l+1,n) - carbon_flux(:,kk,m,l,n)
+           ELSEWHERE ((carbon_old(:,kk,m,l,n)/(z_soil(l)-z_soil(l-1)) .GT. carbon_old(:,kk,m,l+1,n)/(z_soil(l+1)-z_soil(l))) .AND. &
+                  ((carbon_flux(:,kk,m,l,n) - carbon_old(:,kk,m,l,n)) .GE. min_stomate))
+            carbon(:,kk,m,l,n) =zero + carbon_old_buffer(:,kk,m,l,n)
+            carbon_old_buffer(:,kk,m,l+1,n) = carbon_old(:,kk,m,l,n)
+            carbon(:,kk,m,l+1,n) = carbon_old(:,kk,m,l+1,n) + carbon_old(:,kk,m,l,n)
+           ELSEWHERE ((carbon_old(:,kk,m,l,n)/(z_soil(l)-z_soil(l-1)) .GT. carbon_old(:,kk,m,l+1,n)/(z_soil(l+1)-z_soil(l))) .AND. &
+                  ((carbon_old(:,kk,m,l,n) - carbon_flux(:,kk,m,l,n)) .GT. min_stomate))
+            carbon(:,kk,m,l,n) = carbon_old(:,kk,m,l,n) - carbon_flux(:,kk,m,l,n) + carbon_old_buffer(:,kk,m,l,n)
+            carbon_old_buffer(:,kk,m,l+1,n) = carbon_flux(:,kk,m,l,n)
+            carbon(:,kk,m,l+1,n) = carbon_old(:,kk,m,l+1,n) + carbon_flux(:,kk,m,l,n)
+           ELSEWHERE
+            carbon(:,kk,m,l,n) = carbon_old(:,kk,m,l,n)
+            carbon(:,kk,m,l+1,n) = carbon_old(:,kk,m,l+1,n)
+           ENDWHERE
+	ENDDO 
+        ENDDO ! End loop over soil layers
+
+
+
+      ENDDO ! End loop over carbon pools
+  ENDDO ! End loop over PFTs
+
+
+
+!! 3. Check mass balance closure
+IF (ld_doc) THEN    
+    !! 3.1 Calculate components of the mass balance
+    pool_end(:,:,:) = zero 
+
+!Ending carbon pool
+    DO m = 1, nvm
+       DO i = 1,ncarb
+          DO l = 1, nbdl
+		DO n=1,nelements
+                 pool_end(:,m,n) = pool_end(:,m,n) + &
+                           ( carbon(:,i,m,l,n)* veget_max(:,m) ) 
+		ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
+!Ending DOC pool
+    DO m = 1, nvm
+       DO i = 1,npool
+          DO l = 1, nbdl
+             DO j = 1, ndoc
+		DO n=1,nelements
+                    pool_end(:,m,n) = pool_end(:,m,n) + &
+                              ( DOC(:,m,l,j,i,n) * veget_max(:,m))
+		ENDDO 
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
+WRITE(numout,*) " pool_start(:,m,icarbon) soil=",  pool_start(:,4,icarbon)
+WRITE(numout,*) " pool_end(:,m,icarbon) soil=",  pool_end(:,4,icarbon)
+
+WRITE(numout,*) " pool_start(:,m,icarbon14) soil=",  pool_start(:,4,icarbon14)
+WRITE(numout,*) " pool_end(:,m,icarbon14) soil=",  pool_end(:,4,icarbon14)
+
+ !! 3.2 Calculate mass balance
+    !  Note that soilcarbon is transfered to other pools but that the pool
+    !  was not updated. We should not account for it in ::pool_end
+   
+   
+	flux_decrease_tot(:,:)= zero
+
+    DO k=1,nbdl
+	DO l=1,ncarb
+		flux_decrease_tot(:,:)=flux_decrease_tot(:,:)+flux_decrease(:,l,:,k)
+    ENDDO
+	ENDDO
+
+    check_intern(:,:,:,:) = zero
+    closure_intern(:,:,:) = zero
+    
+
+    
+   check_intern(:,:,iland2atm,icarbon14) = -un * (flux_decrease_tot(:,:) + resp_hetero_soil(:,:,icarbon14)* dt)* &
+         veget_max(:,:) 
+
+    check_intern(:,:,iland2atm,icarbon) = -un * resp_hetero_soil(:,:,icarbon) * &
+         veget_max(:,:) * dt 
+    
+DO n=1,nelements
+
+    !check_intern(:,:,iland2atm,n) = -un * resp_hetero_soil(:,:,n) * &
+         !veget_max(:,:) * dt 
+   
+   check_intern(:,:,ilat2out,n) = -un * (DOC_EXP(:,:,irunoff,n)+ &
+         DOC_EXP(:,:,iflooded,n)+ DOC_EXP(:,:,idrainage,n)) * veget_max(:,:) * dt
+   
+   check_intern(:,:,ilat2in,n) = un * zero
+    
+   check_intern(:,:,ipoolchange,n) = -un * (pool_end(:,:,n) - &
+         pool_start(:,:,n))
+    
+
+    DO i = 1,nmbcomp
+       closure_intern(:,:,n) = closure_intern(:,:,n) + &
+           check_intern(:,:,i,n)
+    ENDDO
+
+ENDDO
+
+!! 3.3 Write verdict
+DO n=1,nelements
+    IF (SUM(SUM(closure_intern(:,:,n),2),1) .LT. min_stomate .AND. &
+         SUM(SUM(closure_intern(:,:,n),2),1) .GT. -min_stomate) THEN
+       WRITE(numout,*) 'Mass balance closure in stomate_soilcarbon.f90'
+    ELSE
+       WRITE(numout,*) 'Error: mass balance is not closed in stomate_soilcarbon.f90'
+       WRITE(numout,*) '   Difference is, ', SUM(SUM(closure_intern(:,:,n),2),1) 
+   ENDIF
+ENDDO
+ENDIF
+
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving soilcarbon'
+    
+  END SUBROUTINE soilcarbon
+
+END MODULE stomate_soilcarbon
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_turnover.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_turnover.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_turnover.f90	(revision 5166)
@@ -0,0 +1,907 @@
+! =================================================================================================================================
+! MODULE       : stomate_turnover.f90
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module manages the end of the growing season and calculates herbivory and turnover of leaves, fruits, fine roots.
+!! 
+!!\n DESCRIPTION: This subroutine calculates leaf senescence due to climatic conditions or as a 
+!! function of leaf age and new LAI, and subsequent turnover of the different plant biomass compartments (sections 1 to 6), 
+!! herbivory (section 7), fruit turnover for trees (section 8) and sapwood conversion (section 9). 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_turnover
+
+  ! modules used:
+  USE xios_orchidee
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC turn, turn_clear
+
+  LOGICAL, SAVE                          :: firstcall_turnover = .TRUE.           !! first call (true/false)
+!$OMP THREADPRIVATE(firstcall_turnover)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : turn_clear
+!!
+!>\BRIEF        Set flag ::firstcall_turnover to .TRUE., and therefore activate section 1 
+!!              of subroutine turn which writes a message to the output.
+!!                
+!_ ================================================================================================================================
+
+  SUBROUTINE turn_clear
+    firstcall_turnover=.TRUE.
+  END SUBROUTINE turn_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : turn
+!!
+!>\BRIEF         Calculate turnover of leaves, roots, fruits and sapwood due to aging or climatic 
+!!               induced senescence. Calculate herbivory.
+!!
+!! DESCRIPTION : This subroutine determines the turnover of leaves and fine roots (and stems for grasses)
+!! and simulates following processes:
+!! 1. Mean leaf age is calculated from leaf ages of separate leaf age classes. Should actually 
+!!    be recalculated at the end of the routine, but it does not change too fast. The mean leaf 
+!!    age is calculated using the following equation:
+!!    \latexonly
+!!    \input{turnover_lma_update_eqn1.tex}
+!!    \endlatexonly
+!!    \n 
+!! 2. Meteorological senescence: the detection of the end of the growing season and shedding 
+!!    of leaves, fruits and fine roots due to unfavourable meteorological conditions.
+!!    The model distinguishes three different types of "climatic" leaf senescence, that do not 
+!!    change the age structure: sensitivity to cold temperatures, to lack of water, or both. 
+!!    If meteorological conditions are fulfilled, a flag ::senescence is set to TRUE. Note
+!!    that evergreen species do not experience climatic senescence.
+!!    Climatic senescence is triggered by sensitivity to cold temperatures where the critical 
+!!    temperature for senescence is calculated using the following equation:
+!!    \latexonly
+!!    \input{turnover_temp_crit_eqn2.tex}
+!!    \endlatexonly
+!!    \n
+!!    Climatic senescence is triggered by sensitivity to lack of water availability where the 
+!!    moisture availability critical level is calculated using the following equation:
+!!    \latexonly
+!!    \input{turnover_moist_crit_eqn3.tex}
+!!    \endlatexonly
+!!    \n
+!!    Climatic senescence is triggered by sensitivity to temperature or to lack of water where
+!!    critical temperature and moisture availability are calculated as above.\n
+!!    Trees in climatic senescence lose their fine roots at the same rate as they lose their leaves. 
+!!    The rate of biomass loss of both fine roots and leaves is presribed through the equation:
+!!    \latexonly
+!!    \input{turnover_clim_senes_biomass_eqn4.tex}
+!!    \endlatexonly
+!!    \n
+!!    with ::leaffall(j) a PFT-dependent time constant which is given in 
+!!    ::stomate_constants. In grasses, leaf senescence is extended to the whole plant 
+!!    (all carbon pools) except to its carbohydrate reserve.    
+!! 3. Senescence due to aging: the loss of leaves, fruits and  biomass due to aging
+!!    At a certain age, leaves fall off, even if the climate would allow a green plant
+!!    all year round. Even if the meteorological conditions are favorable for leaf maintenance,
+!!    plants, and in particular, evergreen trees, have to renew their leaves simply because the 
+!!    old leaves become inefficient. Roots, fruits (and stems for grasses) follow leaves. 
+!!    The ??senescence?? rate varies with leaf age. Note that plant is not declared senescent 
+!!    in this case (wchich is important for allocation: if the plant loses leaves because of 
+!!    their age, it can renew them). The leaf turnover rate due to aging of leaves is calculated
+!!    using the following equation:
+!!    \latexonly
+!!    \input{turnover_age_senes_biomass_eqn5.tex}
+!!    \endlatexonly
+!!    \n
+!!    Drop all leaves if there is a very low leaf mass during senescence. After this, the biomass 
+!!    of different carbon pools both for trees and grasses is set to zero and the mean leaf age 
+!!    is reset to zero. Finally, the leaf fraction and leaf age of the different leaf age classes 
+!!    is set to zero. For deciduous trees: next to leaves, also fruits and fine roots are dropped.
+!!    For grasses: all aboveground carbon pools, except the carbohydrate reserves are affected:
+!! 4. Update the leaf biomass, leaf age class fraction and the LAI
+!!    Older leaves will fall more frequently than younger leaves and therefore the leaf age 
+!!    distribution needs to be recalculated after turnover. The fraction of biomass in each 
+!!    leaf class is updated using the following equation:
+!!    \latexonly
+!!    \input{turnover_update_LeafAgeDistribution_eqn6.tex}
+!!    \endlatexonly
+!!    \n
+!! 5. Simulate herbivory activity and update leaf and fruits biomass. Herbivore activity 
+!!    affects the biomass of leaves and fruits as well as stalks (only for grasses).
+!!    However, herbivores do not modify leaf age structure.
+!! 6. Calculates fruit turnover for trees. Trees simply lose their fruits with a time 
+!!    constant ::tau_fruit(j), that is set to 90 days for all PFTs in ::stomate_constants 
+!! 7. Convert sapwood to heartwood for trees and update heart and softwood above and 
+!!    belowground biomass. Sapwood biomass is converted into heartwood biomass 
+!!    with a time constant tau ::tau_sap(j) of 1 year. Note that this biomass conversion 
+!!    is not added to "turnover" as the biomass is not lost. For the updated heartwood, 
+!!    the sum of new heartwood above and new heartwood below after converting sapwood to 
+!!    heartwood, is saved as ::hw_new(:). Creation of new heartwood decreases the age of 
+!!    the plant ??carbon?? with a factor that is determined by: old heartwood ::hw_old(:) 
+!!    divided by the new heartwood ::hw_new(:)
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLES: ::Biomass of leaves, fruits, fine roots and sapwood above (latter for grasses only), 
+!!                        ::Update LAI, ::Update leaf age distribution with new leaf age class fraction 
+!!
+!! REFERENCE(S) : 
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199. 
+!! - McNaughton, S. J., M. Oesterheld, D. A. Frank and K. J. Williams (1989), 
+!! Ecosystem-level patterns of primary productivity and herbivory in terrestrial habitats, 
+!! Nature, 341, 142-144, 1989. 
+!! - Sitch, S., C. Huntingford, N. Gedney, P. E. Levy, M. Lomas, S. L. Piao, , Betts, R., Ciais, P., Cox, P., 
+!! Friedlingstein, P., Jones, C. D., Prentice, I. C. and F. I. Woodward : Evaluation of the terrestrial carbon  
+!! cycle, future plant geography and climate-carbon cycle feedbacks using 5 dynamic global vegetation 
+!! models (dgvms), Global Change Biology, 14(9), 2015â2039, 2008. 
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale=0.5]{turnover_flowchart_1.png}
+!! \includegraphics[scale=0.5]{turnover_flowchart_2.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE turn (npts, dt, PFTpresent, &
+       herbivores, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       moiavail_week, moiavail_month, t2m_longterm, t2m_month, t2m_week, veget_max, &
+       gdd_from_growthinit, leaf_age, leaf_frac, age, lai, biomass, &
+       turnover, senescence,turnover_time)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+
+    INTEGER(i_std), INTENT(in)                                 :: npts                 !! Domain size - number of grid cells 
+                                                                                       !! (unitless) 
+    REAL(r_std), INTENT(in)                                    :: dt                   !! time step (dt_days)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                   :: PFTpresent           !! PFT exists (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: herbivores           !! time constant of probability of a leaf to 
+                                                                                       !! be eaten by a herbivore (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: maxmoiavail_lastyear !! last year's maximum moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: minmoiavail_lastyear !! last year's minimum moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_week        !! "weekly" moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_month       !! "monthly" moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_longterm         !! "long term" 2 meter reference 
+                                                                                       !! temperatures (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_month            !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_week             !! "weekly" 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_max            !! "maximal" coverage fraction of a PFT (LAI 
+                                                                                       !! -> infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: gdd_from_growthinit  !! gdd senescence for crop
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: turnover         !! Turnover @tex ($gC m^{-2}$) @endtex
+    LOGICAL, DIMENSION(npts,nvm), INTENT(out)                  :: senescence           !! is the plant senescent? (true/false) 
+                                                                                       !! (interesting only for deciduous trees: 
+                                                                                       !! carbohydrate reserve) 
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age             !! age of the leaves (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac            !! fraction of leaves in leaf age class 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: age                  !! age (years)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: lai                  !! leaf area index @tex ($m^2 m^{-2}$) 
+                                                                                       !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: turnover_time        !! turnover_time of grasses (days)
+
+    !! 0.4 Local  variables
+
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_meanage         !! mean age of the leaves (days)
+    REAL(r_std), DIMENSION(npts)                               :: dturnover            !! Intermediate variable for turnover ??
+                                                                                       !! @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: moiavail_crit        !! critical moisture availability, function 
+                                                                                       !! of last year's moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: tl                   !! long term annual mean temperature, (C)
+    REAL(r_std), DIMENSION(npts)                               :: t_crit               !! critical senescence temperature, function 
+                                                                                       !! of long term annual temperature (K) 
+    LOGICAL, DIMENSION(npts)                                   :: shed_rest            !! shed the remaining leaves? (true/false)
+    REAL(r_std), DIMENSION(npts)                               :: sapconv              !! Sapwood conversion @tex ($gC m^{-2}$) 
+                                                                                       !! @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: hw_old               !! old heartwood mass @tex ($gC m^{-2}$) 
+                                                                                       !! @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: hw_new               !! new heartwood mass @tex ($gC m^{-2}$) 
+                                                                                       !! @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: lm_old               !! old leaf mass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nleafages)                     :: delta_lm             !! leaf mass change for each age class @tex 
+                                                                                       !! ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: turnover_rate        !! turnover rate (unitless) 
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_age_crit        !! critical leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm)                           :: new_turnover_time    !! instantaneous turnover time (days)
+    INTEGER(i_std)                                             :: j,m,k                !! Index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering turnover'
+
+    !! 1. first call - output messages
+
+    IF ( firstcall_turnover ) THEN
+
+       WRITE(numout,*) 'turnover:'
+
+       WRITE(numout,*) ' > minimum mean leaf age for senescence (days) (::min_leaf_age_for_senescence) : '&
+            ,min_leaf_age_for_senescence
+
+       firstcall_turnover = .FALSE.
+
+
+    ENDIF
+
+    !! 2. Initializations 
+
+    !! 2.1 set output to zero
+    turnover(:,:,:,:) = zero
+    new_turnover_time(:,:) = zero
+    senescence(:,:) = .FALSE.
+
+    !! 2.2 Recalculate mean leaf age
+    !      Mean leaf age is recalculated from leaf ages of separate leaf age classes. Should actually be recalculated at the 
+    !      end of this routine, but it does not change too fast.
+    !      The mean leaf age is calculated using the following equation:
+    !      \latexonly
+    !      \input{turnover_lma_update_eqn1.tex}
+    !      \endlatexonly
+    !      \n
+    leaf_meanage(:,:) = zero
+
+    DO m = 1, nleafages
+       leaf_meanage(:,:) = leaf_meanage(:,:) + leaf_age(:,:,m) * leaf_frac(:,:,m)
+    ENDDO
+
+    !! 3. Climatic senescence
+
+    !     Three different types of "climatic" leaf senescence,
+    !     that do not change the age structure. 
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! 3.1 Determine if there is climatic senescence. 
+       !      The climatic senescence can be of three types:
+       !      sensitivity to cold temperatures, to lack of water, or both. If meteorological conditions are 
+       !      fulfilled, a flag senescence is set to TRUE.
+       !      Evergreen species do not experience climatic senescence.
+
+       SELECT CASE ( senescence_type(j) )
+
+
+       CASE ('crop' )!for crop senescence is based on a GDD criterium as in crop models
+	  WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+               ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+               ( gdd_from_growthinit(:,j) .GT.  gdd_senescence(j)))
+             senescence(:,j) = .TRUE.
+          ENDWHERE
+
+       CASE ( 'cold' )
+
+          !! 3.1.1 Summergreen species: Climatic senescence is triggered by sensitivity to cold temperatures
+          !        Climatic senescence is triggered by sensitivity to cold temperatures as follows: 
+          !        If biomass is large enough (i.e. when it is greater than zero), 
+          !        AND (i.e. when leaf mean age is above a certain PFT-dependent treshold ::min_leaf_age_for_senescence,
+          !        which is given in ::stomate_constants),      
+          !        AND the monthly temperature is low enough (i.e. when monthly temperature ::t2m_month(:) is below a critical 
+          !        temperature ::t_crit(:), which is calculated in this module),
+          !        AND the temperature tendency is negative (i.e. when weekly temperatures ::t2m_week(:) are lower than monthly 
+          !        temperatures ::t2m_month(:))
+          !        If these conditions are met, senescence is set to TRUE.
+          !
+          !        The critical temperature for senescence is calculated using the following equation:
+          !        \latexonly
+          !        \input{turnover_temp_crit_eqn2.tex}
+          !        \endlatexonly
+          !        \n
+          !
+          ! Critical temperature for senescence may depend on long term annual mean temperature
+          tl(:) = t2m_longterm(:) - ZeroCelsius
+          t_crit(:) = ZeroCelsius + senescence_temp(j,1) + &
+               tl(:) * senescence_temp(j,2) + &
+               tl(:)*tl(:) * senescence_temp(j,3)
+
+          WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+               ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+               ( t2m_month(:) .LT. t_crit(:) ) .AND. ( t2m_week(:) .LT. t2m_month(:) ) )
+
+             senescence(:,j) = .TRUE.
+
+          ENDWHERE
+
+       CASE ( 'dry' )
+
+          !! 3.1.2 Raingreen species: Climatic senescence is triggered by sensitivity to lack of water availability 
+          !        Climatic senescence is triggered by sensitivity to lack of water availability as follows:  
+          !        If biomass is large enough (i.e. when it is greater than zero), 
+          !        AND (i.e. when leaf mean age is above a certain PFT-dependent treshold ::min_leaf_age_for_senescence,
+          !        which is given in ::stomate_constants),      
+          !        AND the moisture availability drops below a critical level (i.e. when weekly moisture availability 
+          !        ::moiavail_week(:,j) is below a critical moisture availability ::moiavail_crit(:),
+          !        which is calculated in this module), 
+          !        If these conditions are met, senescence is set to TRUE.
+          !
+          !        The moisture availability critical level is calculated using the following equation:
+          !        \latexonly
+          !        \input{turnover_moist_crit_eqn3.tex}
+          !        \endlatexonly
+          !        \n
+          moiavail_crit(:) = &
+               MIN( MAX( minmoiavail_lastyear(:,j) + hum_frac(j) * &
+               ( maxmoiavail_lastyear(:,j) - minmoiavail_lastyear(:,j) ), &
+               senescence_hum(j) ), &
+               nosenescence_hum(j) )
+
+          WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+               ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+               ( moiavail_week(:,j) .LT. moiavail_crit(:) ) )
+
+             senescence(:,j) = .TRUE.
+
+          ENDWHERE
+
+       CASE ( 'mixed' )
+
+          !! 3.1.3 Mixed criterion: Climatic senescence is triggered by sensitivity to temperature or to lack of water  
+          !        Climatic senescence is triggered by sensitivity to temperature or to lack of water availability as follows:
+          !        If biomass is large enough (i.e. when it is greater than zero), 
+          !        AND (i.e. when leaf mean age is above a certain PFT-dependent treshold ::min_leaf_age_for_senescence,
+          !        which is given in ::stomate_constants),      
+          !        AND the moisture availability drops below a critical level (i.e. when weekly moisture availability 
+          !        ::moiavail_week(:,j) is below a critical moisture availability ::moiavail_crit(:), calculated in this module), 
+          !        OR 
+          !        the monthly temperature is low enough (i.e. when monthly temperature ::t2m_month(:) is below a critical 
+          !        temperature ::t_crit(:), calculated in this module),
+          !        AND the temperature tendency is negative (i.e. when weekly temperatures ::t2m_week(:) are lower than 
+          !        monthly temperatures ::t2m_month(:)).
+          !        If these conditions are met, senescence is set to TRUE.
+          moiavail_crit(:) = &
+               MIN( MAX( minmoiavail_lastyear(:,j) + hum_frac(j) * &
+               (maxmoiavail_lastyear(:,j) - minmoiavail_lastyear(:,j) ), &
+               senescence_hum(j) ), &
+               nosenescence_hum(j) )
+
+          tl(:) = t2m_longterm(:) - ZeroCelsius
+          t_crit(:) = ZeroCelsius + senescence_temp(j,1) + &
+               tl(:) * senescence_temp(j,2) + &
+               tl(:)*tl(:) * senescence_temp(j,3)
+
+          IF ( is_tree(j) ) THEN
+             ! critical temperature for senescence may depend on long term annual mean temperature
+             WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+                  ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+                  ( ( moiavail_week(:,j) .LT. moiavail_crit(:) ) .OR. &
+                  ( ( t2m_month(:) .LT. t_crit(:) ) .AND. ( t2m_week(:) .LT. t2m_month(:) ) ) ) )
+                senescence(:,j) = .TRUE.
+             ENDWHERE
+          ELSE
+
+            turnover_time(:,j) = max_turnover_time(j)
+
+            WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+                 ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+                 ( ( moiavail_week(:,j) .LT. moiavail_crit(:) )))
+                turnover_time(:,j) = max_turnover_time(j) * &
+                     (1.-   (1.- (moiavail_week(:,j)/  moiavail_crit(:)))**2)		
+            ENDWHERE
+
+            WHERE ( turnover_time(:,j) .LT. min_turnover_time(j) )		 
+	       turnover_time(:,j) = min_turnover_time(j)			 
+            ENDWHERE 									 
+
+            WHERE ((( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+                ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+                ((t2m_month(:) .LT. t_crit(:)) .AND. (lai(:,j) .GT. lai_max(j)/4.) .OR. &
+                (t2m_month(:) .LT. ZeroCelsius)) .AND. ( t2m_week(:) .LT. t2m_month(:) )))
+               turnover_time(:,j)= leaffall(j) 
+            ENDWHERE
+            
+         ENDIF
+
+
+       !! Evergreen species do not experience climatic senescence
+       CASE ( 'none' )
+
+          
+       !! In case no climatic senescence type is recognized.
+       CASE default
+
+          WRITE(numout,*) '  turnover: don''t know how to treat this PFT.'
+          WRITE(numout,*) '  number (::j) : ',j
+          WRITE(numout,*) '  senescence type (::senescence_type(j)) : ',senescence_type(j)
+
+          CALL ipslerr_p(3,"turn","Dont know how to treat this PFT.","","")
+
+       END SELECT
+
+       !! 3.2 Drop leaves and roots, plus stems and fruits for grasses
+
+       IF ( is_tree(j) ) THEN
+
+          !! 3.2.1 Trees in climatic senescence lose their fine roots at the same rate as they lose their leaves. 
+          !        The rate of biomass loss of both fine roots and leaves is presribed through the equation:
+          !        \latexonly
+          !        \input{turnover_clim_senes_biomass_eqn4.tex}
+          !        \endlatexonly
+          !        \n
+          !         with ::leaffall(j) a PFT-dependent time constant which is given in ::stomate_constants),
+          WHERE ( senescence(:,j) )
+
+             turnover(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) * dt / leaffall(j)
+             turnover(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) * dt / leaffall(j)
+
+	     turnover(:,j,ileaf,icarbon14) = turnover(:,j,ileaf,icarbon)
+             turnover(:,j,iroot,icarbon14) = turnover(:,j,iroot,icarbon)
+
+          ENDWHERE
+
+       ELSE
+
+          !! 3.2.2 In grasses, leaf senescence is extended to the whole plant 
+          !        In grasses, leaf senescence is extended to the whole plant (all carbon pools) except to its
+          !        carbohydrate reserve.      
+
+          IF (senescence_type(j) .EQ. 'crop') THEN
+             ! 3.2.2.1 crops with 'crop' phenological model
+             WHERE ( senescence(:,j) )
+                turnover(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) * dt / leaffall(j)
+                turnover(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) * dt / leaffall(j)
+                turnover(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) * dt / leaffall(j)
+                turnover(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) * dt /leaffall(j)
+
+		turnover(:,j,ileaf,icarbon14) = biomass(:,j,ileaf,icarbon) * dt / leaffall(j)
+                turnover(:,j,iroot,icarbon14) = biomass(:,j,iroot,icarbon) * dt / leaffall(j)
+                turnover(:,j,isapabove,icarbon14) = biomass(:,j,isapabove,icarbon) * dt / leaffall(j)
+                turnover(:,j,ifruit,icarbon14) = biomass(:,j,ifruit,icarbon) * dt /leaffall(j)
+             ENDWHERE
+          ELSE
+          ! 3.2.2.2 grass or crops based on 'mixed' phenological model
+             WHERE (turnover_time(:,j) .LT. max_turnover_time(j)) 
+                turnover(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) * dt / turnover_time(:,j)
+                turnover(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) * dt / turnover_time(:,j)
+                turnover(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) * dt / turnover_time(:,j) 
+                turnover(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) * dt / turnover_time(:,j)
+
+		turnover(:,j,ileaf,icarbon14) = biomass(:,j,ileaf,icarbon) * dt / turnover_time(:,j)
+                turnover(:,j,isapabove,icarbon14) = biomass(:,j,isapabove,icarbon) * dt / turnover_time(:,j)
+                turnover(:,j,iroot,icarbon14) = biomass(:,j,iroot,icarbon) * dt / turnover_time(:,j) 
+                turnover(:,j,ifruit,icarbon14) = biomass(:,j,ifruit,icarbon) * dt / turnover_time(:,j)
+             ENDWHERE
+          ENDIF
+       ENDIF      ! tree/grass
+       biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - turnover(:,j,ileaf,icarbon)
+       biomass(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) - turnover(:,j,isapabove,icarbon)
+       biomass(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) - turnover(:,j,iroot,icarbon)
+       biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - turnover(:,j,ifruit,icarbon)
+
+       biomass(:,j,ileaf,icarbon14) = biomass(:,j,ileaf,icarbon) 
+       biomass(:,j,isapabove,icarbon14) = biomass(:,j,isapabove,icarbon) 
+       biomass(:,j,iroot,icarbon14) = biomass(:,j,iroot,icarbon) 
+       biomass(:,j,ifruit,icarbon14) = biomass(:,j,ifruit,icarbon) 
+
+    ENDDO        ! loop over PFTs
+
+    !! 4. Leaf fall
+    !     At a certain age, leaves fall off, even if the climate would allow a green plant
+    !     all year round. Even if the meteorological conditions are favorable for leaf maintenance,
+    !     plants, and in particular, evergreen trees, have to renew their leaves simply because the 
+    !     old leaves become inefficient.   
+    !     Roots, fruits (and stems) follow leaves. The decay rate varies with leaf age.
+    !     Note that plant is not declared senescent in this case (wchich is important for allocation:
+    !     if the plant loses leaves because of their age, it can renew them).
+    !
+    !     The leaf turnover rate due to aging of leaves is calculated using the following equation:
+    !     \latexonly
+    !     \input{turnover_age_senes_biomass_eqn5.tex}
+    !     \endlatexonly
+    !     \n
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! save old leaf mass
+       lm_old(:) = biomass(:,j,ileaf,icarbon)
+
+       !! initialize leaf mass change in age class
+       delta_lm(:,:) = zero
+
+       IF ( is_tree(j) .OR. (.NOT. natural(j)) ) THEN
+
+          !! 4.1 Trees: leaves, roots, fruits roots and fruits follow leaves.
+
+          !! 4.1.1 Critical age: prescribed for trees
+          leaf_age_crit(:,j) = leafagecrit(j)
+
+       ELSE
+
+          !! 4.2 Grasses: leaves, roots, fruits, sap follow leaves.
+
+          !! 4.2.1 Critical leaf age depends on long-term temperature
+          !        Critical leaf age depends on long-term temperature
+          !        generally, lower turnover in cooler climates.
+          leaf_age_crit(:,j) = &
+               MIN( leafagecrit(j) * leaf_age_crit_coeff(1) , &
+               MAX( leafagecrit(j) * leaf_age_crit_coeff(2) , &
+               leafagecrit(j) - leaf_age_crit_coeff(3) * &
+               ( t2m_longterm(:)-ZeroCelsius - leaf_age_crit_tref ) ) )
+
+       END IF
+          
+       ! 4.2.2 Loop over leaf age classes
+       DO m = 1, nleafages
+
+          turnover_rate(:) = zero
+
+          WHERE ( leaf_age(:,j,m) .GT. leaf_age_crit(:,j)/2. )
+
+             turnover_rate(:) =  &
+                  MIN( 0.99_r_std, dt / ( leaf_age_crit(:,j) * &
+                  ( leaf_age_crit(:,j) / leaf_age(:,j,m) )**quatre ) )
+
+          ENDWHERE
+          
+          dturnover(:) = biomass(:,j,ileaf,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+          turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + dturnover(:)
+	  turnover(:,j,ileaf,icarbon14) = turnover(:,j,ileaf,icarbon) 
+          biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - dturnover(:)
+	  biomass(:,j,ileaf,icarbon14) = biomass(:,j,ileaf,icarbon) 
+
+          ! save leaf mass change
+          delta_lm(:,m) = - dturnover(:)
+          
+          dturnover(:) = biomass(:,j,iroot,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+          turnover(:,j,iroot,icarbon) = turnover(:,j,iroot,icarbon) + dturnover(:)
+	  turnover(:,j,iroot,icarbon14) = turnover(:,j,iroot,icarbon) 
+          biomass(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) - dturnover(:)
+	  biomass(:,j,iroot,icarbon14) = biomass(:,j,iroot,icarbon) 
+          
+          dturnover(:) = biomass(:,j,ifruit,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+          turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + dturnover(:)
+	  turnover(:,j,ifruit,icarbon14) = turnover(:,j,ifruit,icarbon) 
+          biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - dturnover(:)
+	  biomass(:,j,ifruit,icarbon14) = biomass(:,j,ifruit,icarbon) 
+          
+          IF (.NOT. is_tree(j)) THEN
+             dturnover(:) = biomass(:,j,isapabove,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+             turnover(:,j,isapabove,icarbon) = turnover(:,j,isapabove,icarbon) + dturnover(:)
+	     turnover(:,j,isapabove,icarbon14) = turnover(:,j,isapabove,icarbon) 
+             biomass(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) - dturnover(:)
+	     biomass(:,j,isapabove,icarbon14) = biomass(:,j,isapabove,icarbon) 
+          ENDIF
+          
+       ENDDO
+
+       !! 4.3 Recalculate the fraction of leaf biomass in each leaf age class.
+       !      Older leaves will fall more fast than younger leaves and therefore 
+       !      the leaf age distribution needs to be recalculated after turnover. 
+       !      The fraction of biomass in each leaf class is updated using the following equation:
+       !      \latexonly
+       !      \input{turnover_update_LeafAgeDistribution_eqn6.tex}
+       !      \endlatexonly
+       !      \n
+       !
+       !      new fraction = new leaf mass of that fraction / new total leaf mass
+       !                   = (old fraction*old total leaf mass ::lm_old(:) + biomass change of that fraction ::delta_lm(:,m)  ) /
+       !                     new total leaf mass ::biomass(:,j,ileaf
+       DO m = 1, nleafages
+          
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. zero )
+             leaf_frac(:,j,m) = ( leaf_frac(:,j,m)*lm_old(:) + delta_lm(:,m) ) / biomass(:,j,ileaf,icarbon)
+          ELSEWHERE
+             leaf_frac(:,j,m) = zero
+          ENDWHERE
+        
+       ENDDO
+       
+    ENDDO         ! loop over PFTs
+
+    !! 5. New (provisional) LAI 
+    !     ::lai(:,j) is determined from the leaf biomass ::biomass(:,j,ileaf,icarbon) and the 
+    !     specific leaf surface :: sla(j) (m^2 gC^{-1})
+    !     The leaf area index is updated using the following equation:
+    !     \latexonly
+    !     \input{turnover_update_LAI_eqn7.tex}
+    !     \endlatexonly
+    !     \n
+
+    !    lai(:,ibare_sechiba) = zero
+    !    DO j = 2, nvm ! Loop over # PFTs
+    !        lai(:,j) = biomass(:,j,ileaf,icarbon) * sla(j)
+    !    ENDDO
+
+    !! 6. Definitely drop all leaves if there is a very low leaf mass during senescence.
+
+    !     Both for deciduous trees and grasses same conditions are checked:
+    !     If biomass is large enough (i.e. when it is greater than zero), 
+    !     AND when senescence is set to true
+    !     AND the leaf biomass drops below a critical minimum biomass level (i.e. when it is lower than half
+    !     the minimum initial LAI ::lai_initmin(j) divided by the specific leaf area ::sla(j),
+    !     ::lai_initmin(j) is set to 0.3 in stomate_data.f90 and sla is a constant that is set to 0.015366 m2/gC), 
+    !     If these conditions are met, the flag ::shed_rest(:) is set to TRUE.
+    !
+    !     After this, the biomass of different carbon pools both for trees and grasses is set to zero
+    !     and the mean leaf age is reset to zero.
+    !     Finally, the leaf fraction and leaf age of the different leaf age classes is set to zero.
+    DO j = 2,nvm ! Loop over # PFTs
+
+       shed_rest(:) = .FALSE.
+
+       !! 6.1 For deciduous trees: next to leaves, also fruits and fine roots are dropped 
+       !      For deciduous trees: next to leaves, also fruits and fine roots are dropped: fruit ::biomass(:,j,ifruit) 
+       !      and fine root ::biomass(:,j,iroot) carbon pools are set to zero.
+       IF ( is_tree(j) .AND. ( senescence_type(j) .NE. 'none' ) ) THEN
+
+          ! check whether we shed the remaining leaves
+          WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. senescence(:,j) .AND. &
+               ( biomass(:,j,ileaf,icarbon) .LT. (lai_initmin(j) / 2.)/sla(j) )             )
+
+             shed_rest(:) = .TRUE.
+
+             turnover(:,j,ileaf,icarbon)  = turnover(:,j,ileaf,icarbon) + biomass(:,j,ileaf,icarbon)
+             turnover(:,j,iroot,icarbon)  = turnover(:,j,iroot,icarbon) + biomass(:,j,iroot,icarbon)
+             turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + biomass(:,j,ifruit,icarbon)
+		
+	     turnover(:,j,ileaf,icarbon14)  = turnover(:,j,ileaf,icarbon) 
+             turnover(:,j,iroot,icarbon14)  = turnover(:,j,iroot,icarbon) 
+             turnover(:,j,ifruit,icarbon14) = turnover(:,j,ifruit,icarbon) 
+
+
+             biomass(:,j,ileaf,icarbon)  = zero
+             biomass(:,j,iroot,icarbon)  = zero
+             biomass(:,j,ifruit,icarbon) = zero
+
+             biomass(:,j,ileaf,icarbon14)  = zero
+             biomass(:,j,iroot,icarbon14)  = zero
+             biomass(:,j,ifruit,icarbon14) = zero
+
+             ! reset leaf age
+             leaf_meanage(:,j) = zero
+
+          ENDWHERE
+
+       ENDIF
+
+       !! 6.2 For grasses: all aboveground carbon pools, except the carbohydrate reserves are affected: 
+       !      For grasses: all aboveground carbon pools, except the carbohydrate reserves are affected: 
+       !      fruit ::biomass(:,j,ifruit,icarbon), fine root ::biomass(:,j,iroot,icarbon) and sapwood above 
+       !      ::biomass(:,j,isapabove,icarbon) carbon pools are set to zero. 
+       IF ( .NOT. is_tree(j) ) THEN
+
+          ! Shed the remaining leaves if LAI very low.
+          WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. senescence(:,j) .AND. &
+               (  biomass(:,j,ileaf,icarbon) .LT. (lai_initmin(j) / 2.)/sla(j) ))
+
+             shed_rest(:) = .TRUE.
+
+             turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + biomass(:,j,ileaf,icarbon)
+             turnover(:,j,isapabove,icarbon) = turnover(:,j,isapabove,icarbon) + biomass(:,j,isapabove,icarbon)
+             turnover(:,j,iroot,icarbon) = turnover(:,j,iroot,icarbon) + biomass(:,j,iroot,icarbon)
+             turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + biomass(:,j,ifruit,icarbon)
+
+	     turnover(:,j,ileaf,icarbon14) = turnover(:,j,ileaf,icarbon) 
+             turnover(:,j,isapabove,icarbon14) = turnover(:,j,isapabove,icarbon) 
+             turnover(:,j,iroot,icarbon14) = turnover(:,j,iroot,icarbon) 
+             turnover(:,j,ifruit,icarbon14) = turnover(:,j,ifruit,icarbon) 
+
+             biomass(:,j,ileaf,icarbon) = zero
+             biomass(:,j,isapabove,icarbon) = zero
+             biomass(:,j,iroot,icarbon) = zero
+             biomass(:,j,ifruit,icarbon) = zero
+
+             biomass(:,j,ileaf,icarbon14) = zero
+             biomass(:,j,isapabove,icarbon14) = zero
+             biomass(:,j,iroot,icarbon14) = zero
+             biomass(:,j,ifruit,icarbon14) = zero
+
+             ! reset leaf age
+             leaf_meanage(:,j) = zero
+
+          ENDWHERE
+
+       ENDIF
+
+       !! 6.3 Reset the leaf age structure: the leaf fraction and leaf age of the different leaf age classes is set to zero.
+      
+       DO m = 1, nleafages
+
+          WHERE ( shed_rest(:) )
+
+             leaf_age(:,j,m) = zero
+             leaf_frac(:,j,m) = zero
+
+          ENDWHERE
+
+       ENDDO
+
+    ENDDO          ! loop over PFTs
+    
+    !! 7. Herbivore activity: elephants, cows, gazelles but no lions.
+ 
+    !     Herbivore activity affects the biomass of leaves and fruits as well 
+    !     as stalks (only for grasses). Herbivore activity does not modify leaf 
+    !     age structure. Herbivores ::herbivores(:,j) is the time constant of 
+    !     probability of a leaf to be eaten by a herbivore, and is calculated in 
+    !     ::stomate_season. following Mc Naughton et al. [1989].
+
+    IF ( ok_herbivores ) THEN
+
+       ! If the herbivore activity is allowed (if ::ok_herbivores is true, which is set in run.def), 
+       ! remove the amount of biomass consumed by herbivory from the leaf biomass ::biomass(:,j,ileaf,icarbon) and 
+       ! the fruit biomass ::biomass(:,j,ifruit,icarbon).
+       ! The daily amount consumed equals the biomass multiplied by 1 day divided by the time constant ::herbivores(:,j).
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( is_tree(j) ) THEN
+
+             !! For trees: only the leaves and fruit carbon pools are affected
+
+             WHERE (biomass(:,j,ileaf,icarbon) .GT. zero)
+                ! added by shilong
+                WHERE (herbivores(:,j).GT. zero)
+                   dturnover(:) = biomass(:,j,ileaf,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + dturnover(:)
+                   biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - dturnover(:)
+		   turnover(:,j,ileaf,icarbon14) = turnover(:,j,ileaf,icarbon) 
+		   biomass(:,j,ileaf,icarbon14) = biomass(:,j,ileaf,icarbon) 
+
+                   dturnover(:) = biomass(:,j,ifruit,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + dturnover(:)
+                   biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - dturnover(:)
+		   turnover(:,j,ifruit,icarbon14) = turnover(:,j,ifruit,icarbon) 
+		   biomass(:,j,ifruit,icarbon14) = biomass(:,j,ifruit,icarbon) 
+                ENDWHERE
+             ENDWHERE
+
+          ELSE
+
+             ! For grasses: all aboveground carbon pools are affected: leaves, fruits and sapwood above
+             WHERE ( biomass(:,j,ileaf,icarbon) .GT. zero )
+                ! added by shilong
+                WHERE (herbivores(:,j) .GT. zero)
+                   dturnover(:) = biomass(:,j,ileaf,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + dturnover(:)
+                   biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - dturnover(:)
+		   turnover(:,j,ileaf,icarbon14) = turnover(:,j,ileaf,icarbon) 
+		   biomass(:,j,ileaf,icarbon14) = biomass(:,j,ileaf,icarbon) 
+
+                   dturnover(:) = biomass(:,j,isapabove,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,isapabove,icarbon) = turnover(:,j,isapabove,icarbon) + dturnover(:)
+                   biomass(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) - dturnover(:)
+		   turnover(:,j,isapabove,icarbon14) = turnover(:,j,isapabove,icarbon)
+ 		   biomass(:,j,isapabove,icarbon14) = biomass(:,j,isapabove,icarbon) 
+
+
+                   dturnover(:) = biomass(:,j,ifruit,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + dturnover(:)
+                   biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - dturnover(:)
+		   turnover(:,j,ifruit,icarbon14) = turnover(:,j,ifruit,icarbon) 
+		   biomass(:,j,ifruit,icarbon14) = biomass(:,j,ifruit,icarbon) 
+                ENDWHERE
+
+             ENDWHERE
+
+          ENDIF  ! tree/grass?
+
+       ENDDO    ! loop over PFTs
+
+    ENDIF ! end herbivores
+
+    !! 8. Fruit turnover for trees
+
+    !     Fruit turnover for trees: trees simply lose their fruits with a time constant ::tau_fruit(j), 
+    !     that is set to 90 days for all PFTs in ::stomate_constants
+
+   ! DO k = 1,nelements 
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( is_tree(j) ) THEN
+
+             dturnover(:) = biomass(:,j,ifruit,icarbon) * dt / tau_fruit(j)
+             turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + dturnover(:)
+	     biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - dturnover(:)
+             turnover(:,j,ifruit,icarbon14) = turnover(:,j,ifruit,icarbon) 
+             biomass(:,j,ifruit,icarbon14) = biomass(:,j,ifruit,icarbon) 
+             
+          ENDIF
+       ENDDO       ! loop over PFTs
+   ! END DO
+
+    !! 9 Conversion of sapwood to heartwood both for aboveground and belowground sapwood and heartwood.
+
+    !   Following LPJ (Sitch et al., 2003), sapwood biomass is converted into heartwood biomass 
+    !   with a time constant tau ::tau_sap(j) of 1 year.
+    !   Note that this biomass conversion is not added to "turnover" as the biomass is not lost!
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( is_tree(j) ) THEN
+
+          !! For the recalculation of age in 9.2 (in case the vegetation is not dynamic ie. ::ok_dgvm is FALSE), 
+          !! the heartwood above and below is stored in ::hw_old(:).
+          IF ( .NOT. ok_dgvm ) THEN
+             hw_old(:) = biomass(:,j,iheartabove,icarbon) + biomass(:,j,iheartbelow,icarbon)
+          ENDIF
+
+          !! 9.1 Calculate the rate of sapwood to heartwood conversion 
+          !      Calculate the rate of sapwood to heartwood conversion with the time constant ::tau_sap(j) 
+          !      and update aboveground and belowground sapwood ::biomass(:,j,isapabove) and ::biomass(:,j,isapbelow)
+          !      and heartwood ::biomass(:,j,iheartabove) and ::biomass(:,j,iheartbelow).
+
+          !DO k = 1,nelements
+
+             ! Above the ground
+             sapconv(:) = biomass(:,j,isapabove,icarbon) * dt / tau_sap(j)
+             biomass(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) - sapconv(:)
+             biomass(:,j,iheartabove,icarbon) =  biomass(:,j,iheartabove,icarbon) + sapconv(:)
+             biomass(:,j,isapabove,icarbon14) = biomass(:,j,isapabove,icarbon) 
+             biomass(:,j,iheartabove,icarbon14) =  biomass(:,j,iheartabove,icarbon) 
+             ! Below the ground
+             sapconv(:) = biomass(:,j,isapbelow,icarbon) * dt / tau_sap(j)
+             biomass(:,j,isapbelow,icarbon) = biomass(:,j,isapbelow,icarbon) - sapconv(:)
+             biomass(:,j,iheartbelow,icarbon) =  biomass(:,j,iheartbelow,icarbon) + sapconv(:)
+             biomass(:,j,isapbelow,icarbon14) = biomass(:,j,isapbelow,icarbon) 
+             biomass(:,j,iheartbelow,icarbon14) =  biomass(:,j,iheartbelow,icarbon) 
+
+          !END DO
+
+          !! 9.2 If the vegetation is not dynamic, the age of the plant is decreased. 
+          !      The updated heartwood, the sum of new heartwood above and new heartwood below after 
+          !      converting sapwood to heartwood, is saved as ::hw_new(:) .
+          !      Creation of new heartwood decreases the age of the plant with a factor that is determined by: 
+          !      old heartwood ::hw_old(:) divided by the new heartwood ::hw_new(:)
+          IF ( .NOT. ok_dgvm ) THEN
+
+             hw_new(:) = biomass(:,j,iheartabove,icarbon) + biomass(:,j,iheartbelow,icarbon)
+
+             WHERE ( hw_new(:) .GT. zero )
+
+                age(:,j) = age(:,j) * hw_old(:)/hw_new(:)
+
+             ENDWHERE
+
+          ENDIF
+
+       ENDIF
+
+    ENDDO       ! loop over PFTs
+
+
+    CALL xios_orchidee_send_field("HERBIVORES",herbivores)
+    CALL xios_orchidee_send_field("LEAF_AGE",leaf_meanage)
+    
+
+    ! Write mean leaf age and time constant of probability of a leaf to be eaten by a herbivore 
+    ! to the stomate output file.
+    CALL histwrite_p (hist_id_stomate, 'LEAF_AGE', itime, &
+         leaf_meanage, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HERBIVORES', itime, &
+         herbivores, npts*nvm, horipft_index)
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving turnover'
+
+  END SUBROUTINE turn
+
+END MODULE stomate_turnover
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_vmax.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_vmax.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_stomate/stomate_vmax.f90	(revision 5166)
@@ -0,0 +1,351 @@
+! =================================================================================================================================
+! MODULE 	: stomate_vmax
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        calculates the leaf efficiency.
+!!	
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN		:
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ =================================================================================================================================
+
+MODULE stomate_vmax
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC vmax, vmax_clear
+
+  ! first call
+  LOGICAL, SAVE                                              :: firstcall_vmax = .TRUE.
+!$OMP THREADPRIVATE(firstcall_vmax)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE	: vmax_clear
+!!
+!>\BRIEF	  Flag setting 
+!!
+!!\n DESCRIPTION: This subroutine sets flags ::firstcall_vmax, to .TRUE., and therefore activates   
+!!		  section 1.1 of the ::vmax subroutine which writes messages to the output. \n
+!!		  This subroutine is called at the end of the subroutine ::stomate_clear, in the 
+!!		  module ::stomate.
+!!
+!! RECENT CHANGE(S):None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::firstcall_vmax
+!!
+!! REFERENCE(S)  : None 
+!!
+!! FLOWCHART     : None
+!! \n		  
+!_ =================================================================================================================================
+
+  SUBROUTINE vmax_clear
+    firstcall_vmax=.TRUE.
+  END SUBROUTINE vmax_clear
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : vmax
+!!
+!>\BRIEF         This subroutine computes vcmax photosynthesis parameters 
+!! given optimal vcmax parameter values and a leaf age-related efficiency.
+!!
+!! DESCRIPTION (functional, design, flags): 
+!! Leaf age classes are introduced to take into account the fact that photosynthetic activity depends on leaf age
+!! (Ishida et al., 1999). There are \f$nleafages\f$ classes (constant defined in stomate_constants.f90).
+!! This subroutine first calculates the new age of each leaf age-class based on fraction of leaf 
+!! that goes from one to another class.                                              
+!! Then calculation of the new fraction of leaf in each class is performed.      
+!! Last, leaf efficiency is calculated for each PFT and for each leaf age class.
+!! vcmax is defined as vcmax25 and vjmax_opt weighted by a mean leaf
+!! efficiency. vcmax25 is PFT-dependent constants defined in constants_mtc.f90.
+!!
+!! This routine is called once at the beginning by stomate_var_init and then at each stomate time step by stomateLpj.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): vcmax
+!!
+!! REFERENCE(S)	: 
+!! - Ishida, A., A. Uemura, N. Koike, Y. Matsumoto, and A. Lai Hoe (1999),
+!! Interactive effects of leaf age and self-shading on leaf structure, photosynthetic
+!! capacity and chlorophyll fluorescence in the rain forest tree,
+!! dryobalanops aromatica, Tree Physiol., 19, 741-747
+!!
+!! FLOWCHART    : None
+!!
+!! REVISION(S)	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE vmax (npts, dt, &
+       leaf_age, leaf_frac, &
+       vcmax)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                                 :: npts                    !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                                    :: dt                      !! time step of stomate (days)
+
+    !
+    !! 0.2 Output variables 
+    !
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax                   !! Maximum rate of carboxylation 
+                                                                                          !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+
+    !
+    !! 0.3 Modified variables
+    !
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age                !! Leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac               !! fraction of leaves in leaf age 
+                                                                                          !! classes 
+                                                                                          !! (unitless)
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std), DIMENSION(npts)                               :: leaf_efficiency         !! leaf efficiency (vcmax/vcmax25)
+                                                                                          !! (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages)                 :: d_leaf_frac             !! turnover between age classes
+                                                                                          !! (unitless)
+    REAL(r_std), DIMENSION(npts,nleafages)                     :: leaf_age_new            !! new leaf age (days)
+    REAL(r_std), DIMENSION(npts)                               :: sumfrac                 !! sum of leaf age fractions, 
+                                                                                          !! for normalization
+                                                                                          !! (unitless)
+    REAL(r_std), DIMENSION(npts)                               :: rel_age                 !! relative leaf age (age/critical age)
+                                                                                          !! (unitless)
+    INTEGER(i_std)                                             :: j,m                     !! indices (unitless)
+
+!_ ================================================================================================================================
+
+    IF (printlev>=3) WRITE(numout,*) 'Entering vmax'
+
+    !
+    !! 1 Initialization
+    !
+
+    !
+    !! 1.1 first call: info about flags and parameters.
+    !
+
+    IF ( firstcall_vmax ) THEN
+
+       WRITE(numout,*) 'vmax:'
+
+       WRITE(numout,*) '   > offset (minimum vcmax/vmax_opt):' , vmax_offset
+       WRITE(numout,*) '   > relative leaf age at which vmax reaches vcmax_opt:', leafage_firstmax 
+       WRITE(numout,*) '   > relative leaf age at which vmax falls below vcmax_opt:', leafage_lastmax
+       WRITE(numout,*) '   > relative leaf age at which vmax reaches its minimum:', leafage_old
+
+       firstcall_vmax = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    vcmax(:,:) = zero
+
+    !
+    !! 2 leaf age: general increase and turnover between age classes.
+    !
+
+    !
+    !! 2.1 increase leaf age
+    !
+!
+!! The age of the leaves in each leaf-age-class increases by 1 time step.
+    DO m = 1, nleafages	! Loop over # leaf age classes 
+       DO j = 2,nvm	! Loop over # PFTs
+          WHERE ( leaf_frac(:,j,m) .GT. min_stomate )
+
+             leaf_age(:,j,m) = leaf_age(:,j,m) + dt
+             
+          ENDWHERE
+       ENDDO	! Loop over # PFTs 
+
+    ENDDO	! Loop over # leaf age classes
+
+    !
+    !! 2.2 turnover between leaf age classes
+    !     d_leaf_frac(:,:,m) = what leaves m-1 and goes into m
+    !
+
+    DO j = 2,nvm	! Loop over # PFTs
+
+       !! 2.2.1 fluxes
+
+       !! nothing goes into first age class
+       d_leaf_frac(:,j,1) = zero
+
+       !! for others age classes (what goes from m-1 to m)
+       DO m = 2, nleafages 
+!! leaf_timecst is defined in stomate_constants.f90 as the quotient of the critical leaf age per the number of age classes.
+!! The critical leaf age is a PFT-dependent constant defined in stomate_constants.f90, that represents the leaf life span.
+!! This time constant (leaf_timecst) determines the turnover between the nleafages different leaf age classes
+!! (see section [118] in Krinner et al. (2005)).
+          d_leaf_frac(:,j,m) = leaf_frac(:,j,m-1) * dt/leaf_timecst(j)
+
+       ENDDO
+
+       !! 2.2.2 new leaf age in class
+       !!       new age = ( old age * (old fraction - fractional loss) + fractional increase * age of the source class ) / new fraction
+       !!       The leaf age of the youngest class (m=1) is updated into stomate_alloc          
+       leaf_age_new(:,:) = zero
+
+       DO m = 2, nleafages-1       ! Loop over age classes
+	!! For all age classes except first and last 
+          WHERE ( d_leaf_frac(:,j,m) .GT. min_stomate )
+
+             leaf_age_new(:,m) = ( ( (leaf_frac(:,j,m)- d_leaf_frac(:,j,m+1)) * leaf_age(:,j,m) )  + &
+                  ( d_leaf_frac(:,j,m) * leaf_age(:,j,m-1) ) ) / &
+                  ( leaf_frac(:,j,m) + d_leaf_frac(:,j,m)- d_leaf_frac(:,j,m+1) )
+
+          ENDWHERE
+
+       ENDDO       ! Loop over age classes
+
+	!! For last age class, there is no leaf fraction leaving the class. 
+
+       WHERE ( d_leaf_frac(:,j,nleafages) .GT. min_stomate )
+
+          leaf_age_new(:,nleafages) = ( ( leaf_frac(:,j,nleafages) * leaf_age(:,j,nleafages) )  + &
+               ( d_leaf_frac(:,j,nleafages) * leaf_age(:,j,nleafages-1) ) ) / &
+               ( leaf_frac(:,j,nleafages) + d_leaf_frac(:,j,nleafages) )
+
+       ENDWHERE
+
+       DO m = 2, nleafages       ! Loop over age classes
+
+          WHERE ( d_leaf_frac(:,j,m) .GT. min_stomate )
+
+             leaf_age(:,j,m) = leaf_age_new(:,m)
+
+          ENDWHERE
+
+       ENDDO       ! Loop over age classes
+
+       !! 2.2.3 calculate new fraction
+
+       DO m = 2, nleafages       ! Loop over age classes
+
+          ! where the change comes from
+          leaf_frac(:,j,m-1) = leaf_frac(:,j,m-1) - d_leaf_frac(:,j,m)
+
+          ! where it goes to
+          leaf_frac(:,j,m) = leaf_frac(:,j,m) + d_leaf_frac(:,j,m)
+
+       ENDDO       ! Loop over age classes
+
+       !! 2.2.4 renormalize fractions in order to prevent accumulation 
+       !       of numerical errors
+
+       ! correct small negative values
+
+       DO m = 1, nleafages
+          leaf_frac(:,j,m) = MAX( zero, leaf_frac(:,j,m) )
+       ENDDO
+
+       ! total of fractions, should be very close to one where there is leaf mass
+
+       sumfrac(:) = zero
+
+       DO m = 1, nleafages       ! Loop over age classes
+
+          sumfrac(:) = sumfrac(:) + leaf_frac(:,j,m)
+
+       ENDDO       ! Loop over age classes
+
+       ! normalize
+
+       DO m = 1, nleafages       ! Loop over age classes
+
+          WHERE ( sumfrac(:) .GT. min_stomate )
+
+             leaf_frac(:,j,m) = leaf_frac(:,j,m) / sumfrac(:) 
+
+          ELSEWHERE
+
+             leaf_frac(:,j,m) = zero
+
+          ENDWHERE
+
+       ENDDO       ! Loop over age classes
+
+    ENDDO         ! Loop over PFTs
+
+    !
+    !! 3 calculate vmax as a function of the age
+    !
+
+    DO j = 2,nvm
+
+       vcmax(:,j) = zero
+
+       ! sum up over the different age classes
+       IF (ok_dgvm .AND. pheno_type(j)==1 .AND. leaf_tab(j)==2) THEN
+          ! pheno_typ=evergreen and leaf_tab=needleleaf
+          vcmax(:,j) = Vcmax25(j)
+
+       ELSE 
+          ! for deciduous tree
+          DO m = 1, nleafages       ! Loop over age classes
+
+             !
+             !! 3.1 efficiency in each of the age classes
+             !!     it varies from vmax_offset to 1 
+             !!     linearly increases from vmax_offset to 1 for 0 < rel_age < leafage_firstmax
+             !!     is 1 when leafage_firstmax < rel_age < leafage_lastmax
+             !!     linearly decreases from 1 to vmax_offset for leafage_lastmax < rel_age < leafage_firstmax
+             !!     vmax_offset for rel_age >= leafage_old
+             !!     (Ishida et al., 1999)
+             rel_age(:) = leaf_age(:,j,m) / leafagecrit(j)
+
+             leaf_efficiency(:) = MAX( vmax_offset, MIN( un, &
+                  vmax_offset + (un - vmax_offset) * rel_age(:) / leafage_firstmax, &
+                  un - (un - vmax_offset) * ( rel_age(:) - leafage_lastmax ) / &
+                  ( leafage_old - leafage_lastmax ) ) )
+
+             !
+             !! 3.2 add to mean vmax
+             !             
+             vcmax(:,j) = vcmax(:,j) + Vcmax25(j) * leaf_efficiency(:) * leaf_frac(:,j,m)
+
+          ENDDO     ! loop over age classes
+       ENDIF
+
+    ENDDO       ! loop over PFTs
+
+    IF (printlev>=4) WRITE(numout,*) 'Leaving vmax'
+
+  END SUBROUTINE vmax
+
+END MODULE stomate_vmax
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/context_orchidee.xml
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/context_orchidee.xml	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/context_orchidee.xml	(revision 5166)
@@ -0,0 +1,53 @@
+<!-- =========================================================================================================== -->
+<!-- ORCHIDEE context                                                                                            -->
+<!-- context_orchidee.xml : Configuration file for ORCHIDEE for production of output files using XIOS            -->
+<!-- =========================================================================================================== -->
+<context id="orchidee">
+  
+  
+  <!-- =========================================================================================================== -->
+  <!-- Definition of all existing variables                                                                        -->
+  <!-- DO NOT CHANGE THIS FILE                                                                                     -->
+  <!-- =========================================================================================================== -->
+  <field_definition src="./field_def_orchidee.xml"/>
+  
+  
+  <!-- =========================================================================================================== -->
+  <!-- Definition of output files                                                                                  -->
+  <!-- Definition of variables or groups included in the different files                                           -->
+  <!-- CHANGE THIS FILE BY ADDING THE FILES AND/OR VARIABLES YOU WANT TO PRODUCE                                   -->
+  <!-- Only variables and groups existing in field_def_orchidee.xml can be used                                    -->
+  <!-- =========================================================================================================== -->
+  <file_definition src="./file_def_orchidee.xml"/>
+  
+  
+  <!-- =========================================================================================================== -->
+  <!-- Definition of horizontal domain                                                                             -->
+  <!-- =========================================================================================================== -->
+  <domain_definition>
+    <domain id="domain_landpoints"/>
+  </domain_definition>
+  
+  <!-- =========================================================================================================== -->
+  <!-- Definition of vertical axis and extra dimensions                                                            -->
+  <!-- =========================================================================================================== -->
+  <axis_definition>
+    <!-- Vertical axis and extra dimensions in sechiba -->
+    <axis id="nvm" name="veget" standard_name="model_level_number" long_name="Vegetation types" unit="1"/>
+    <axis id="nlaip1" name="laiax" standard_name="model_level_number" long_name="Interface of LAI layers" unit="1"/>
+    <axis id="ngrnd" name="solth" standard_name="model_level_number" long_name="Thermal soil levels" unit="m"/>
+    <axis id="nstm" name="soiltyp" standard_name="model_level_number" long_name="Soil tiles" unit="1"/>
+    <axis id="nnobio" name="nobio" standard_name="model_level_number" long_name="Other surface types" unit="1"/>
+    <axis id="albtyp" standard_name="model_level_number" long_name="Albedo types" unit="1"/>
+    <axis id="nslm" name="solay" standard_name="model_level_number" long_name="Hydrological soil levels" unit="1"/>
+    <axis id="nbdl" name="soildiag" standard_name="model_level_number" long_name="Diagnostic soil levels" unit="m"/>
+    <axis id="nsnow" name="snowlev" standard_name="model_level_number" long_name="Snow levels" unit="1"/>
+
+    <!-- Vertical axis and extra dimensions in stomate -->
+    <axis id="P10" standard_name="model_level_number" long_name="Pool 10 years" unit="1"/>
+    <axis id="P100" standard_name="model_level_number" long_name="Pool 100 years" unit="1"/>
+    <axis id="P11" standard_name="model_level_number" long_name="Pool 10 years + 1" unit="1"/>
+    <axis id="P101" standard_name="model_level_number" long_name="Pool 100 years + 1" unit="1"/>
+  </axis_definition>
+
+</context>
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/field_def_orchidee.xml
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/field_def_orchidee.xml	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/field_def_orchidee.xml	(revision 5166)
@@ -0,0 +1,403 @@
+<!-- =========================================================================================================== -->
+<!-- field_def_orchidee.xml : Definition of all existing variables                                               -->
+<!-- This file must only be changed if a call xios_orchidee_send_field is added, changed or removed              -->
+<!-- =========================================================================================================== -->
+
+<field_definition id="orchidee" prec="4" domain_ref="domain_landpoints" operation="average" freq_op="1ts" enabled=".TRUE." default_value="9.96921e+36">
+
+
+  <!-- Definition of all variables in sechiba -->
+  <field_group id="sechiba">
+    <field id="mrsos" name="mrsos" long_name="Moisture in Upper 0.1 m of Soil Column" unit="kg m-2"/>
+    <field id="Areas" name="Areas" long_name="Mesh areas" unit="m2" operation="once"/>
+    <field id="LandPoints" name="LandPoints" long_name="Land Points" unit="1" operation="once"/>
+    <field id="Contfrac" name="Contfrac" long_name="Continental fraction" unit="1" operation="once"/>
+    <field id="mrro" name="mrro" long_name="Total Runoff" unit="kg m-2 s-1"/>
+    <field id="ptn" name="ptn" long_name="Deep ground temperature" unit="K" axis_ref="ngrnd"/>
+    <field id="npp" name="npp" long_name="Net Primary Production" unit="gC/m^2/s" axis_ref="nvm"/>
+    <field id="cdrag" name="cdrag" long_name="Drag coefficient for LE and SH" unit="?"/>
+    <field id="soilalb_vis" name="soilalb_vis" long_name="Soil Albedo visible" unit="1"/>
+    <field id="soilalb_nir" name="soilalb_nir" long_name="Soil Albedo near infrared" unit="1"/>
+    <field id="vegalb_vis" name="vegalb_vis" long_name="Vegetation Albedo visible" unit="1"/>
+    <field id="vegalb_nir" name="vegalb_nir" long_name="Vegetation Albedo near infrared" unit="1"/>
+    <field id="z0" name="z0" long_name="Surface roughness" unit="m"/>
+    <field id="evap" name="evap" long_name="Evaporation" unit="mm/d"/>
+    <field id="coastalflow" name="coastalflow" long_name="Diffuse coastal flow" unit="m^3/s"/>
+    <field id="riverflow" name="riverflow" long_name="River flow to the oceans" unit="m^3/s"/>
+    <field id="tsol_rad" name="tsol_rad" long_name="Radiative surface temperature" unit="C"/>
+    <field id="vevapnu" name="vevapnu" long_name="Bare soil evaporation" unit="mm/d"/>
+
+    <field id="temp_sol_C" name="temp_sol" long_name="New Surface Temperature" unit="C"/>
+    <field id="temp_sol_K" name="AvgSurfT" long_name="Average surface temperature" unit="K"/>
+    <field id="tsol_max" name="tsol_max" field_ref="temp_sol_C" long_name="Maximum Surface Temperature" unit="C" operation="maximum"/>
+    <field id="tsol_min" name="tsol_min" field_ref="temp_sol_C" long_name="Minimum Surface Temperature" unit="C" operation="minimum"/>
+    <field id="temp_sol_Cloc" name="temp_sol_Cloc" field_ref="temp_sol_K" long_name="New Surface Temperature" unit="C"> temp_sol_K - 273.15  </field>
+
+    <field id="qsurf" name="qsurf" long_name="Near surface specific humidity" unit="g/g"/>
+    <field id="albedo" name="albedo" long_name="Albedo" unit="1" axis_ref="albtyp"/>
+    <field id="fluxsens" name="fluxsens" long_name="Sensible Heat Flux" unit="W/m^2"/>
+    <field id="fluxlat" name="fluxlat" long_name="Latent Heat Flux" unit="W/m^2"/>
+    <field id="emis" name="emis" long_name="Surface emissivity" unit="1"/>
+    <field id="rain" name="rain" long_name="Rainfall" unit="mm/d"/>
+    <field id="snowf" name="snowf" long_name="Snowfall" unit="mm/d"/>
+    <field id="netrad" name="netrad" long_name="Net radiation" unit="W/m^2"/>
+    <field id="lai" name="lai" long_name="Leaf Area Index" unit="1" axis_ref="nvm"/>
+    <field id="reinf_slope" name="reinf_slope" long_name="Slope index for each grid box" unit="1" operation="once"/>
+    <field id="soilindex" name="soilindex" long_name="Soil index" unit="1" operation="once"/>
+    <field id="basinmap" name="basinmap" long_name="Aproximate map of the river basins" operation="once"/>
+    <field id="nbrivers" name="nbrivers" long_name="Number or rivers in the outflow grid box" operation="once"/>
+    <field id="subli" name="subli" long_name="Sublimation" unit="mm/d"/>
+    <field id="runoff" name="runoff" long_name="Surface runoff" unit="mm/d"/>
+    <field id="drainage" name="drainage" long_name="Deep drainage" unit="mm/d"/>
+    <field id="riversret" name="riversret" long_name="Return from endorheic riversD" unit="mm/d"/>
+    <field id="hydrographs" name="hydrographs" long_name="Hydrographs of gridbox outflow" unit="m^3/s"/>
+    <field id="evapnu_soil" name="evapnu_soil" long_name="Bare soil evap for soil type" unit="mm/d" axis_ref="nstm"/>
+    <field id="drainage_soil" name="drainage_soil" long_name="Drainage for soil type" unit="mm/d" axis_ref="nstm"/>
+    <field id="transpir_soil" name="transpir_soil" long_name="Transpir for soil type" unit="mm/d" axis_ref="nstm"/>
+    <field id="runoff_soil" name="runoff_soil" long_name="Runoff for soil type" unit="mm/d" axis_ref="nstm"/>
+    <field id="tair" name="tair" long_name="Air Temperature" unit="K"/>
+    <field id="qair" name="qair" long_name="Air Humidity" unit="g/g"/>
+    <field id="q2m" name="q2m" long_name="2m Air Humidity" unit="g/g"/>
+    <field id="t2m" name="t2m" long_name="2m Air temperature" unit="K"/>
+    <field id="alb_vis" name="alb_vis" long_name="Albedo visible" unit="1"/>
+    <field id="alb_nir" name="alb_nir" long_name="Albedo near infrared" unit="1"/>
+    <field id="roughheight" name="roughheight" long_name="Effective roughness height" unit="m"/>
+    <field id="transpir" name="transpir" long_name="Transpiration" unit="mm/d" axis_ref="nvm"/>
+    <field id="inter" name="inter" long_name="Interception loss" unit="mm/d" axis_ref="nvm"/>
+    <field id="evapnu" name="evapnu" long_name="Bare soil evaporation" unit="mm/d"/>
+    <field id="snow" name="snow" long_name="Snow mass" unit="kg/m^2"/>
+    <field id="snowage" name="snowage" long_name="Snow age" unit="?"/>
+    <field id="snownobio" name="snownobio" long_name="Snow on other surfaces" unit="kg/m^2" axis_ref="nnobio"/>
+    <field id="snownobioage" name="snownobioage" long_name="Snow age on other surfaces" unit="d" axis_ref="nnobio"/>
+    <field id="vegetfrac" name="vegetfrac" long_name="Fraction of vegetation" unit="1" axis_ref="nvm"/>
+    <field id="maxvegetfrac" name="maxvegetfrac" long_name="Maximum fraction of vegetation" unit="1" axis_ref="nvm"/>
+    <field id="tot_bare_soil" name="tot_bare_soil" long_name="Total Bare Soil Fraction" unit="%"/>
+    <field id="nobiofrac" name="nobiofrac" long_name="Fraction of other surface types" unit="1" axis_ref="nnobio"/>
+    <field id="flood_frac" name="flood_frac" long_name="Flooded fraction" unit="1"/>
+    <field id="reinfiltration" name="reinfiltration" long_name="Reinfiltration from floodplains" unit="mm/d"/>
+    <field id="frac_bare" name="frac_bare" long_name="Bare soil fraction for each tile" unit="-" axis_ref="nvm"/>
+    <field id="soiltile" name="soiltile" long_name="Fraction of soil tiles" unit="%" axis_ref="nstm" operation="once"/>
+    <field id="dss" name="dss" long_name="Up-reservoir Height" unit="m" axis_ref="nvm"/>
+    <field id="gqsb" name="gqsb" long_name="Upper Soil Moisture" unit="Kg/m^2"/>
+    <field id="bqsb" name="bqsb" long_name="Lower Soil Moisture" unit="Kg/m^2"/>
+    <field id="humtot" name="humtot" long_name="Total soil Moisture" unit="Kg/m^2"/>
+    <field id="humtot_soil" name="humtot_soil" long_name="Soil Moisture for soil type" unit="Kg/m^2" axis_ref="nstm"/>
+    <field id="humtot_pro" name="humtot_pro" long_name="Water content in soil layer" unit="Kg/m^2" axis_ref="nslm"/>
+    <field id="SWI" name="SWI" long_name="Soil wetness index" unit="-"/>
+    <field id="njsc" name="njsc" long_name="Soil class used for hydrology" unit="-" operation="once"/>
+    <field id="qsintveg" name="qsintveg" long_name="Water on canopy" unit="Kg/m^2" axis_ref="nvm"/>
+    <field id="rstruct" name="rstruct" long_name="Structural resistance" unit="s/m" axis_ref="nvm"/>
+    <field id="gpp" name="gpp" long_name="Net assimilation of carbon by the vegetation" unit="gC/m^2/s" axis_ref="nvm"/>
+    <field id="nee" name="nee" long_name="Net Ecosystem Exchange" unit="gC/m^2/s" axis_ref="nvm"/>
+    <field id="maint_resp" name="maint_resp" long_name="Maintenance respiration" unit="gC/m^2/s" axis_ref="nvm"/>
+    <field id="hetero_resp" name="hetero_resp" long_name="Heterotrophic respiration" unit="gC/m^2/s" axis_ref="nvm"/>
+    <field id="growth_resp" name="growth_resp" long_name="Growth respiration" unit="gC/m^2/s" axis_ref="nvm"/>
+    <field id="precisol" name="precisol" long_name="Throughfall" unit="mm/d" axis_ref="nvm"/>
+    <field id="drysoil_frac" name="drysoil_frac" long_name="Fraction of visibly dry soil" unit="1"/>
+    <field id="evapot" name="evapot" long_name="Potential evaporation" unit="mm/d"/>
+    <field id="evapot_corr" name="evapot_corr" long_name="Potential evaporation" unit="mm/d"/>
+    <field id="swnet" name="swnet" long_name="Net solar radiation" unit="W/m^2"/>
+    <field id="swdown" name="swdown" long_name="Incident solar radiation" unit="W/m^2"/>
+    <field id="lwdown" name="lwdown" long_name="Absorbed downward longwave radiation" unit="W/m^2"/>
+    <field id="lwnet" name="lwnet" long_name="Net surface longwave radiation" unit="W/m^2"/>
+    <field id="fastr" name="fastr" long_name="Fast flow reservoir" unit="kg/m^2"/>
+    <field id="slowr" name="slowr" long_name="Slow flow reservoir" unit="kg/m^2"/>
+    <field id="streamr" name="streamr" long_name="Stream flow reservoir" unit="kg/m^2"/>
+    <field id="lakevol" name="lakevol" long_name="Volume in lake reservoir" unit="kg/m^2"/>
+    <field id="pondr" name="pondr" long_name="Ponds reservoir" unit="kg/m^2"/>
+    <field id="swampmap" name="swampmap" long_name="Map of swamps" unit="m^2" operation="once"/>
+    <field id="irrigation" name="irrigation" long_name="Net irrigation" unit="mm/d"/>
+    <field id="netirrig" name="netirrig" long_name="Net irrigation requirement" unit="mm/d"/>
+    <field id="irrigmap" name="irrigmap" long_name="Map of irrigated surfaces" unit="m^2" operation="once"/>
+    <field id="floodmap" name="floodmap" long_name="Map of floodplains" unit="m^2" operation="once"/>
+    <field id="floodh" name="floodh" long_name="Floodplains height" unit="mm"/>
+    <field id="floodr" name="floodr" long_name="Floodplains reservoir" unit="kg/m^2"/>
+    <field id="floodout" name="floodout" long_name="Flow out of floodplains" unit="mm/d"/>
+    <field id="TotWater" name="TotWater" long_name="Total amount of water at end of time step" unit="mm/d"/>
+    <field id="TotWaterFlux" name="TotWater" long_name="Total water flux" unit="mm/d"/>
+    <field id="evapflo" name="evapflo" long_name="Floodplains evaporation" unit="mm/d"/>
+    <field id="k_litt" name="k_litt" long_name="Litter cond" unit="mm/d"/>
+    <field id="beta" name="beta" long_name="Beta Function" unit="1"/>
+    <field id="raero" name="raero" long_name="Aerodynamic resistance" unit="s/m"/>
+    <field id="Wind" name="Wind" long_name="Wind speed" unit="m/s"/>
+    <field id="qsatt" name="qsatt" long_name="Surface saturated humidity" unit="g/g"/>
+    <field id="vbeta1" name="vbeta1" long_name="Beta for sublimation" unit="1"/>
+    <field id="vbeta4" name="vbeta4" long_name="Beta for bare soil" unit="1"/>
+    <field id="vbeta5" name="vbeta5" long_name="Beta for floodplains" unit="1"/>
+    <field id="gsmean" name="gsmean" long_name="beta for CO2" unit="mm/d" axis_ref="nvm"/>
+    <field id="humrel" name="humrel" long_name="Soil moisture stress" unit="-" axis_ref="nvm"/>
+    <field id="cimean" name="cimean" long_name="Stomatal CO2 concentation" unit="mmole/m2/s" axis_ref="nvm" enabled=".FALSE."/>
+    <field id="vbeta3" name="vbeta3" long_name="Beta for Transpiration" unit="mm/d" axis_ref="nvm"/>
+    <field id="rveget" name="rveget" long_name="Canopy resistance" unit="s/m" axis_ref="nvm"/>
+    <field id="rsol" name="rsol" long_name="Soil resistance" unit="s/m"/>
+    <field id="vbeta2" name="vbeta2" long_name="Beta for Interception loss" unit="mm/d" axis_ref="nvm"/>
+    <field id="qsintmax" name="qsintmax" long_name="Maximum Interception capacity" unit="Kg/m^2" axis_ref="nvm"/>
+    <field id="mrso" name="mrso" long_name="Total Soil Moisture Content" unit="kg m-2"/>
+    <field id="mrros" name="mrros" long_name="Surface Runoff" unit="kg m-2 s-1"/>
+    <field id="prveg" name="prveg" long_name="Precipitation onto Canopy" unit="kg m-2 s-1"/>
+    <field id="evspsblveg" name="evspsblveg" long_name="Evaporation from Canopy" unit="kg m-2 s-1"/>
+    <field id="evspsblsoi" name="evspsblsoi" long_name="Water Evaporation from Soil" unit="kg m-2 s-1"/>
+    <field id="tran" name="tran" long_name="Transpiration" unit="kg m-2 s-1"/>
+    <field id="treeFrac" name="treeFrac" long_name="Tree Cover Fraction" unit="%"/>
+    <field id="grassFrac" name="grassFrac" long_name="Natural Grass Fraction" unit="%"/>
+    <field id="cropFrac" name="cropFrac" long_name="Crop Fraction" unit="%"/>
+    <field id="baresoilFrac" name="baresoilFrac" long_name="Bare Soil Fraction" unit="%"/>
+    <field id="residualFrac" name="residualFrac" long_name="Fraction of Grid Cell that is Land but Neither Vegetation-Covered nor Bare Soil" unit="%"/>
+    <field id="PAR" name="PAR" long_name="Photosynthetic active radiation, half of swdown" unit="umol phot/m^2/s"/>
+    <field id="PARsun" name="PARsun" long_name="PAR received by sun leaves" unit="umol phot/m^2/s" axis_ref="nvm"/>
+    <field id="PARsh" name="PARsh" long_name="PAR received by shaded leaves" unit="umol phot/m^2/s" axis_ref="nvm"/>
+    <field id="laisun" name="laisun" long_name="Sunlit Leaf Area Index" unit="1" axis_ref="nvm"/>
+    <field id="laish" name="laish" long_name="Shaded Leaf Area Index" unit="1" axis_ref="nvm"/>
+    <field id="PARsuntab" name="PARsuntab" long_name="PAR received by sun leaves over LAI layers" unit="umol phot/m^2/s" axis_ref="nlaip1"/>
+    <field id="PARshtab" name="PARshtab" long_name="PAR received by shaded leaves over LAI layers" unit="umol phot/m^2/s" axis_ref="nlaip1"/>
+    <field id="coszang" name="coszang" long_name="Cosine of the solar zenith angle" unit="1"/>
+    <field id="PARdf" name="PARdf" long_name="Diffuse photosynthetic active radiation" unit="umol phot/m^2/s"/>
+    <field id="PARdr" name="PARdr" long_name="Direct photosynthetic active radiation" unit="umol phot/m^2/s"/>
+    <field id="CRF" name="CRF" long_name="Canopy reduction factor for net NO flux calculation" unit="1" axis_ref="nvm" />
+    <field id="flx_co2_bbg_year" name="flx_co2_bbg_year" long_name="CO2 emissions from biomass burning - Read in an input file" unit="kgC/m^2/yr" operation="once"/>
+    <field id="N_qt_WRICE_year" name="N_qt_WRICE_year" long_name="N fertilizers applied on wetland rice - Read in an input file" unit="kgN/yr" operation="once"/>
+    <field id="N_qt_OTHER_year" name="N_qt_OTHER_year" long_name="N fertilizers applied on other crops and grasses - Read in an input file" unit="kgN/yr" operation="once"/>
+    <field id="flx_iso" name="flx_iso" long_name="Isoprene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_mono" name="flx_mono" long_name="Monoterpene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_ORVOC" name="flx_ORVOC" long_name="Other Volatile Organic Compound emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_MBO" name="flx_MBO" long_name="2-methyl-3-buten-2-ol emissions from vegetation (mainly pines in America)" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_methanol" name="flx_methanol" long_name="Methanol emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_acetone" name="flx_acetone" long_name="Acetone emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_acetal" name="flx_acetal" long_name="Acetaldehyde emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_formal" name="flx_formal" long_name="Formaldehyde emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_acetic" name="flx_acetic" long_name="Acetic acid emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_formic" name="flx_formic" long_name="Formic acid emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm"/>
+    <field id="flx_apinen" name="flx_apinen" long_name="Alpha pinene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_bpinen" name="flx_bpinen" long_name="Beta pinene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_limonen" name="flx_limonen" long_name="Limonene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_myrcen" name="flx_myrcen" long_name="Myrcene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_sabinen" name="flx_sabinen" long_name="Sabinene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_camphen" name="flx_camphen" long_name="Camphene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_3caren" name="flx_3caren" long_name="3-Carene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_tbocimen" name="flx_tbocimen" long_name="T-beta Ocimene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_othermono" name="flx_othermono" long_name="Emissions of other monoterpenes from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_sesquiter" name="flx_sesquiter" long_name="Sesquiterpene emissions from vegetation" unit="kgC/m^2/s" axis_ref="nvm" />
+    <field id="flx_fertil_no" name="flx_fertil_no" long_name="Biogenic nitrogen oxide soil emission due to N-fertilisation" unit="ngN/m^2/s" axis_ref="nvm"/>
+    <field id="flx_no_soil" name="flx_no_soil" long_name="Nitrogen Oxide emissions from soil, before deposition on canopy" unit="ngN/m^2/s" axis_ref="nvm"/>
+    <field id="flx_no" name="flx_no" long_name="Net nitrogen Oxide emissions from soil, after deposition on canopy" unit="ngN/m^2/s" axis_ref="nvm"/>
+    <field id="fco2" name="fco2" long_name="Function for CO2 impact on BVOC (isoprene)" unit="1" axis_ref="nvm" />
+    <field id="cim" name="cim" long_name="Intercellular CO2 over nlai" unit="ppm" axis_ref="nvm" />
+    <field id="Psurf" name="Psurf" long_name="Surface pressure" unit="Pa"/>
+    <field id="Qb" name="Qb" long_name="Slowflow hydrographs of gridbox outflow" unit="m^3/s"/> 
+    <field id="CanopInt" name="CanopInt" long_name="Water on canopy" unit="Kg/m^2"/>  
+    <field id="LAImean" name="LAImean" long_name="Mean Leaf Area Index" unit="-"/>
+    <field id="SoilSat" name="SoilSat" long_name="Mean volumetric water content at saturation" unit="m^3/m^3" axis_ref="nslm" operation="once"/>   
+    <field id="RootDist" name="RootDist" long_name="Cumulative root density" unit="-"  axis_ref="nslm" operation="once"/>   
+    <field id="SoilThick" name="SoilThick" long_name="Hydrological soil layer thickness" unit="m"  axis_ref="nslm" operation="once"/>   
+    <field id="water2infilt" name="water2infilt" long_name="Variable water2infilt in hydrol" unit="Kg/m^2" axis_ref="nstm"/>  
+
+
+
+    <!-- ALMA -->
+    <field id="twbr" name="TWBR" long_name="Total water budget residu" unit="Kg/m^2/s"/>
+    <field id="Qg" name="Qg" long_name="Ground heat flux" unit="W/m^2"/>
+    <field id="Qf" name="Qf" long_name="Energy of fusion" unit="W/m^2"/>
+    <field id="Qv" name="Qv" long_name="Energy of sublimation" unit="W/m^2"/>
+    <field id="DelSurfHeat" name="DelSurfHeat" long_name="Change in surface layer heat" unit="J/m^2" operation="accumulate"/>
+    <field id="DelColdCont" name="DelColdCont" long_name="Change in snow surface layer cold content" unit="J/m^2" operation="accumulate"/>
+    <field id="snowf_alma" name="Snowf" long_name="Snowfall rate" unit="kg/m^2/s"/>
+    <field id="rain_alma" name="Rainf" long_name="Rainfall rate" unit="kg/m^2/s"/>
+    <field id="evap_alma" name="evap_alma" long_name="Total Evapotranspiration" unit="kg/m^2/s"/>
+    <field id="Qs" name="Qs" long_name="Surface runoff" unit="kg/m^2/s"/>
+    <field id="Qsb" name="Qsb" long_name="Sub-surface runoff" unit="kg/m^2/s"/>
+    <field id="Qsm" name="Qsm" long_name="Snowmelt" unit="kg/m^2/s"/>
+    <field id="DelSoilMoist" name="DelSoilMoist" long_name="Change in soil moisture" unit="kg/m^2" operation="accumulate"/>
+    <field id="DelSurfStor" name="DelSurfStor" long_name="Change in Surface Water Storage" unit="kg/m^2" operation="accumulate"/>
+    <field id="DelIntercept" name="DelIntercept" long_name="Change in interception storage" unit="kg/m^2" operation="accumulate"/>
+    <field id="DelSWE" name="DelSWE" long_name="Change in Snow Water Equivalent" unit="kg/m^2" operation="accumulate"/>
+    <field id="irrigation_alma" name="Qirrig" long_name="Irrigation" unit="kg/m^2/s"/>
+    <field id="netirrig_alma" name="Qirrig_req" long_name="Irrigation requirement" unit="kg/m^2/s"/>
+    <field id="PotSurfT" name="PotSurfT" long_name="Potential (Unstressed) surface temperature" unit="K"/>
+    <field id="albedo_alma" name="Albedo" long_name="Albedo" unit="1"/>
+    <field id="SurfStor" name="SurfStor" long_name="Surface Water Storage" unit="kg/m^2"/>
+    <field id="SoilMoist" name="SoilMoist" long_name="3D average layer soil moisture" unit="kg/m^2" axis_ref="nslm"/>
+    <field id="RootMoist" name="RootMoist" long_name="Root zone soil water" unit="kg/m^2"/>
+    <field id="SoilWet" name="SoilWet" long_name="Total soil wetness" unit="-"/>
+    <field id="evapot_corr_alma" name="PotEvap" long_name="Potential evapotranspiration" unit="kg/m^2/s"/>
+    <field id="evapot_alma" name="PotEvapOld" long_name="Potential evapotranspiration old method" unit="kg/m^2/s"/>
+    <field id="ECanop" name="ECanop" long_name="Interception evaporation" unit="kg/m^2/s"/>
+    <field id="TVeg" name="TVeg" long_name="Transpiration" unit="kg/m^2/s"/>
+    <field id="vevapnu_alma" name="ESoil" long_name="Bare soil evaporation" unit="kg/m^2/s"/>
+    <field id="evapflo_alma" name="EWater" long_name="Floodplains evaporation" unit="kg/m^2/s"/>
+    <field id="SubSnow" name="SubSnow" long_name="Snow sublimation" unit="kg/m^2/s"/>
+    <field id="ACond" name="ACond" long_name="Aerodynamic conductance" unit="m/s"/>
+    <field id="SAlbedo" name="SAlbedo" long_name="Snow albedo" unit="1"/>
+    <field id="SnowDepth" name="SnowDepth" long_name="3D snow depth" unit="m"/>
+    <field id="moistc_1" name="moistc_1" long_name="Soil Moisture profile for soil type 1" unit="m3/m3" axis_ref="nslm"/>
+    <field id="moistc_2" name="moistc_2" long_name="Soil Moisture profile for soil type 2" unit="m3/m3" axis_ref="nslm"/>
+    <field id="moistc_3" name="moistc_3" long_name="Soil Moisture profile for soil type 3" unit="m3/m3" axis_ref="nslm"/>
+    <field id="kfactroot_1" name="kfactroot_1" long_name="Root fraction profile for soil type 1" unit="%" axis_ref="nslm"/>
+    <field id="kfactroot_2" name="kfactroot_2" long_name="Root fraction profile for soil type 2" unit="%" axis_ref="nslm"/>
+    <field id="kfactroot_3" name="kfactroot_3" long_name="Root fraction profile for soil type 3" unit="%" axis_ref="nslm"/>
+    <field id="vegetsoil_1" name="vegetsoil_1" long_name="Fraction of vegetation on soil type 1" unit="%" axis_ref="nvm"/>
+    <field id="vegetsoil_2" name="vegetsoil_2" long_name="Fraction of vegetation on soil type 2" unit="%" axis_ref="nvm"/>
+    <field id="vegetsoil_3" name="vegetsoil_3" long_name="Fraction of vegetation on soil type 3" unit="%" axis_ref="nvm"/>
+  </field_group>
+
+
+  <!-- Definition of all variables in stomate -->
+  <field_group id="stomate">
+    <field id="T2M_MONTH" name="T2M_MONTH" long_name="Monthly 2 m temperature" unit="K"/>
+    <field id="T2M_WEEK" name="T2M_WEEK" long_name="Weekly 2 m temperature" unit="K"/>
+    <field id="TSEASON" name="TSEASON" long_name="Seasonal 2 m temperature" unit="K"/>
+    <field id="TMIN_SPRING_TIME" name="TMIN_SPRING_TIME" long_name="Number of days after onset" unit="-" axis_ref="nvm"/>
+    <field id="ONSET_DATE" name="ONSET_DATE" long_name="The day in the year when leaves start to grow" unit="days" axis_ref="nvm"/>
+    <field id="FPC_MAX" name="FPC_MAX" long_name="Foliage projective cover" unit="-" axis_ref="nvm"/>
+    <field id="MAXFPC_LASTYEAR" name="MAXFPC_LASTYEAR" long_name="Foliage projective cover of last year" unit="-" axis_ref="nvm"/>
+    <field id="HET_RESP" name="HET_RESP" long_name="heterotr. resp. from ground" unit="gC/m^2 tot/pft/day" axis_ref="nvm"/>
+    <field id="FIREFRAC" name="FIREFRAC" long_name="Fire fraction on ground " unit="1/day" axis_ref="nvm"/>
+    <field id="CO2FLUX" name="CO2FLUX" long_name="CO2 flux " unit="gC/m^2/pft/mth" axis_ref="nvm"/>
+    <field id="CO2_FIRE" name="CO2_FIRE" long_name="Output CO2 flux from fire " unit="gC/day/m^2/pft" axis_ref="nvm"/>
+    <field id="CO2_TAKEN" name="CO2_TAKEN" long_name="CO2 taken from atmosphere for initiate growth " unit="gC/day/m^2/pft" axis_ref="nvm"/>
+    <field id="LAI" name="LAI" long_name="Leaf Area Index " unit="-" axis_ref="nvm"/>
+    <field id="VEGET_MAX" name="VEGET_MAX" long_name="Maximum vegetation fraction (LAI -&gt; infinity) " unit="-" axis_ref="nvm"/>
+    <field id="NPP_STOMATE" name="NPP" long_name="Net primary productivity " unit="gC/day/(m^2 tot)" axis_ref="nvm"/>
+    <field id="GPP" name="GPP" long_name="Gross primary productivity " unit="gC/day/m^2" axis_ref="nvm"/>
+    <field id="LEAF_M" name="LEAF_M" long_name="Leaf mass" unit="gC/m^2 " axis_ref="nvm"/>
+    <field id="SAP_M_AB" name="SAP_M_AB" long_name="Sap mass above ground" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="SAP_M_BE" name="SAP_M_BE" long_name="Sap mass below ground" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="HEART_M_AB" name="HEART_M_AB" long_name="Heartwood mass above ground" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="HEART_M_BE" name="HEART_M_BE" long_name="Heartwood mass below ground" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="ROOT_M" name="ROOT_M" long_name="Root mass" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="FRUIT_M" name="FRUIT_M" long_name="Fruit mass" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="RESERVE_M" name="RESERVE_M" long_name="Carbohydrate reserve mass" unit="gC/m^2" axis_ref="nvm"/>
+    <field id="MAINT_RESP" name="MAINT_RESP" long_name="Maintenance respiration" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="GROWTH_RESP" name="GROWTH_RESP" long_name="Growth respiration" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="IND" name="IND" long_name="Density of individuals" unit="1/ m^2" axis_ref="nvm"/>
+    <field id="ADAPTATION" name="ADAPTATION" long_name="Adaptation to climate (DGVM)" unit="-" axis_ref="nvm"/>
+    <field id="REGENERATION" name="REGENERATION" long_name="Probability from regenerative (DGVM)" unit="-" axis_ref="nvm"/>
+    <field id="CN_IND" name="CN_IND" long_name="crown area of individuals" unit="m^2" axis_ref="nvm"/>
+    <field id="WOODMASS_IND" name="WOODMASS_IND" long_name="Woodmass of individuals" unit="gC/pft" axis_ref="nvm"/>
+    <field id="TOTAL_M" name="TOTAL_M" long_name="Total living biomass" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="MOISTRESS" name="MOISTRESS" long_name="weekly moisture stress" unit="-" axis_ref="nvm"/>
+    <field id="TOTAL_TURN" name="TOTAL_TURN" long_name="total turnover rate" unit="gC/m^2/day " axis_ref="nvm"/>
+    <field id="LEAF_TURN" name="LEAF_TURN" long_name="Leaf turnover" unit="gC/m^2/day " axis_ref="nvm"/>
+    <field id="SAP_AB_TURN" name="SAP_AB_TURN" long_name="Sap turnover above" unit="gC/m^2/day " axis_ref="nvm"/>
+    <field id="ROOT_TURN" name="ROOT_TURN" long_name="Root turnover" unit="gC/m^2/day " axis_ref="nvm"/>
+    <field id="FRUIT_TURN" name="FRUIT_TURN" long_name="Fruit turnover" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="TOTAL_BM_LITTER" name="TOTAL_BM_LITTER" long_name="total conversion of biomass to litter" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="LEAF_BM_LITTER" name="LEAF_BM_LITTER" long_name="Leaf death" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="SAP_AB_BM_LITTER" name="SAP_AB_BM_LITTER" long_name="Sap death above ground" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="SAP_BE_BM_LITTER" name="SAP_BE_BM_LITTER" long_name="Sap death below ground" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="HEART_AB_BM_LITTER" name="HEART_AB_BM_LITTER" long_name="Heartwood death above ground" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="HEART_BE_BM_LITTER" name="HEART_BE_BM_LITTER" long_name="Heartwood death below ground" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="ROOT_BM_LITTER" name="ROOT_BM_LITTER" long_name="Root death" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="FRUIT_BM_LITTER" name="FRUIT_BM_LITTER" long_name="Fruit death" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="RESERVE_BM_LITTER" name="RESERVE_BM_LITTER" long_name="Carbohydrate reserve death" unit="gC/m^2/day" axis_ref="nvm"/>
+    <field id="LITTER_STR_AB" name="LITTER_STR_AB" long_name="structural litter above ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTER_MET_AB" name="LITTER_MET_AB" long_name="metabolic litter above ground" unit="gC/m^2/pft" axis_ref="nvm"/>
+    <field id="LITTER_STR_BE" name="LITTER_STR_BE" long_name="structural litter below ground" unit="gC/m^3/z" axis_ref="nbdl"/>
+    <field id="LITTER_MET_BE" name="LITTER_MET_BE" long_name="metabolic litter below ground" unit="gC/m^3/z" axis_ref="nbdl"/>
+    <field id="DEADLEAF_COVER" name="DEADLEAF_COVER" long_name="fraction of soil covered by dead leaves" unit="-"/>
+    <field id="TOTAL_SOIL_CARB" name="TOTAL_SOIL_CARB" long_name="total soil and litter carbon" unit="gC/m^3/z" axis_ref="nbdl"/>
+    <field id="TOTAL_SOIL_CARB14" name="TOTAL_SOIL_CARB14" long_name="total soil and litter carbon14" unit="gC/m^3/z" axis_ref="nbdl"/>
+    <field id="CARBON_ACTIVE" name="CARBON_ACTIVE" long_name="active soil carbon in ground " unit="gC/m^3/z" axis_ref="nbdl"/>
+    <field id="CARBON_SLOW" name="CARBON_SLOW" long_name="slow soil carbon in ground" unit="gC/m^3/z" axis_ref="nbdl"/>
+    <field id="CARBON_PASSIVE" name="CARBON_PASSIVE" long_name="passive soil carbon in ground" unit="gC/m^3/z" axis_ref="nbdl"/>
+    <field id="CARBON14_ACTIVE" name="CARBON14_ACTIVE" long_name="active soil carbon14 in ground " unit="gC/m^3/z" axis_ref="nbdl"/>
+    <field id="CARBON14_SLOW" name="CARBON14_SLOW" long_name="slow soil carbon14 in ground" unit="gC/m^3/z" axis_ref="nbdl"/>
+    <field id="CARBON14_PASSIVE" name="CARBON14_PASSIVE" long_name="passive soil carbon14 in ground" unit="gC/m^3/z" axis_ref="nbdl"/>
+    <field id="F_Pool_ACTIVE" name="F_Pool_ACTIVE" long_name="isotopic ratio for active pool" unit="Uniteless" axis_ref="nbdl"/>
+    <field id="F_Pool_SLOW" name="F_Pool_SLOW" long_name="isotopic ratio for slow pool" unit="Uniteless" axis_ref="nbdl"/>
+    <field id="F_Pool_PASSIVE" name="F_Pool_PASSIVE" long_name="isotopic ratio for passive pool" unit="Uniteless" axis_ref="nbdl"/>
+    <field id="F_MEAN" name="F_MEAN" long_name="Modern Fraction F" unit="Uniteless" axis_ref="nbdl"/>
+    <field id="pMC" name="pMC" long_name="Percentage of Modern Carbon PMC (%)" unit="(%)" axis_ref="nbdl"/>
+    <field id="age_14C" name="age_14C" long_name=" Carbon 14 Age BP" unit="years Bp" axis_ref="nbdl"/>
+    <field id="delta_14C" name="delta_14C" long_name="Delta Carbon 14 (per mil)" unit="per mil" axis_ref="nbdl"/>
+    <field id="F_Pool_ACT_DOC" name="F_Pool_ACT_DOC" long_name="isotopic ratio for active pool for DOC" unit="Uniteless" axis_ref="nbdl"/>
+    <field id="F_Pool_SLO_DOC" name="F_Pool_SLO_DOC" long_name="isotopic ratio for slow pool for DOC" unit="Uniteless" axis_ref="nbdl"/>
+    <field id="F_Pool_PAS_DOC" name="F_Pool_PAS_DOC" long_name="isotopic ratio for passive pool for DOC" unit="Uniteless" axis_ref="nbdl"/>
+<field id="F_Pool_abmet_DOC" name="F_Pool_abmet_DOC" long_name="isotopic ratio for above metabolic pool for DOC" unit="Uniteless" axis_ref="nbdl"/>
+<field id="F_Pool_abstr_DOC" name="F_Pool_abstr_DOC" long_name="isotopic ratio for above structural pool for DOC" unit="Uniteless" axis_ref="nbdl"/>
+<field id="F_Pool_bemet_DOC" name="F_Pool_bemet_DOC" long_name="isotopic ratio for below metabolic pool for DOC" unit="Uniteless" axis_ref="nbdl"/>
+<field id="F_Pool_bestr_DOC" name="F_Pool_bestr_DOC" long_name="isotopic ratio for below structural pool for DOC" unit="Uniteless" axis_ref="nbdl"/>
+    <field id="F_MEAN_DOC" name="F_MEAN_DOC" long_name="isotopic ratio mean value for DOC" unit="Uniteless" axis_ref="nbdl"/>
+    <field id="FREE_DOC" name="FREE_DOC" long_name="free dissolved organic carbon in ground" unit="gC/m^3/z" axis_ref="nbdl"/>
+    <field id="ADSORBED_DOC" name="ADSORBED_DOC" long_name="adsorbed dissolved organic carbon in ground" unit="gC/m^3/z" axis_ref="nslm"/>
+    <field id="FREE_DOC14" name="FREE_DOC14" long_name="free dissolved organic carbon14 in ground" unit="gC/m^3/z" axis_ref="nbdl"/>
+    <field id="ADSORBED_DOC14" name="ADSORBED_DOC14" long_name="adsorbed dissolved organic carbon14 in ground" unit="gC/m^3/z" axis_ref="nslm"/>
+    <field id="EXPORTED_DOC_RUNOFF" name="EXPORTED_DOC_RUNOFF" long_name="exported DOC by runoff" unit="gC/m**2/day" axis_ref="nvm"/>
+    <field id="EXPORTED_DOC_DRAIN" name="EXPORTED_DOC_DRAIN" long_name="exported DOC by drainage" unit="gC/m**2/day" axis_ref="nvm"/>
+    <field id="EXPORTED_DOC_FLOOD" name="EXPORTED_DOC_FLOOD" long_name="exported DOC by flooding" unit="gC/m**2/day" axis_ref="nvm"/>
+    <field id="LITTERHUM" name="LITTERHUM" long_name="Litter humidity" unit="-"/>
+    <field id="BM_ALLOC_LEAF" name="BM_ALLOC_LEAF" long_name="biomass allocated to leaves" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_SAP_AB" name="BM_ALLOC_SAP_AB" long_name="biomass allocated to sapwood above ground" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_SAP_BE" name="BM_ALLOC_SAP_BE" long_name="biomass allocated to sapwood below ground" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_ROOT" name="BM_ALLOC_ROOT" long_name="biomass allocated to roots" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_FRUIT" name="BM_ALLOC_FRUIT" long_name="biomass allocated to fruits" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="BM_ALLOC_RES" name="BM_ALLOC_RES" long_name="biomass allocated to carbohydrate reserve" unit="gC/m**2/pft/dt" axis_ref="nvm"/>
+    <field id="HERBIVORES" name="HERBIVORES" long_name="time constant of herbivore activity" unit="days" axis_ref="nvm"/>
+    <field id="TURNOVER_TIME" name="TURNOVER_TIME" long_name="turnover time for grass leaves" unit="days" axis_ref="nvm"/>
+    <field id="PROD10" name="PROD10" long_name="10 year wood product pool" unit="gC/m**2" axis_ref="P11"/>
+    <field id="FLUX10" name="FLUX10" long_name="annual flux for each 10 year wood product pool" unit="gC/m**2/yr" axis_ref="P10"/>
+    <field id="PROD100" name="PROD100" long_name="100 year wood product pool" unit="gC/m**2" axis_ref="P101"/>
+    <field id="FLUX100" name="FLUX100" long_name="annual flux for each 100 year wood product pool" unit="gC/m**2/yr" axis_ref="P100"/>
+    <field id="CONVFLUX" name="CONVFLUX" long_name="annual release right after deforestation" unit="gC/m**2/day"/>
+    <field id="CFLUX_PROD10" name="CFLUX_PROD10" long_name="annual release from all 10 year wood product pools" unit="gC/m**2/day"/>
+    <field id="CFLUX_PROD100" name="CFLUX_PROD100" long_name="annual release from all 100 year wood product pools" unit="gC/m**2/day"/>
+    <field id="HARVEST_ABOVE" name="HARVEST_ABOVE" long_name="annual release product after harvest" unit="gC/m**2/day"/>
+    <field id="RESOLUTION_X" name="RESOLUTION_X" long_name="E-W resolution" unit="m" operation="once"/>
+    <field id="RESOLUTION_Y" name="RESOLUTION_Y" long_name="N-S resolution" unit="m" operation="once"/>
+    <field id="CONTFRAC_STOMATE" name="CONTFRAC" long_name="Continental fraction" unit="1" operation="once"/>
+    <field id="VCMAX" name="VCMAX" long_name="Maximum rate of carboxylation" unit="-" axis_ref="nvm"/>
+    <field id="LEAF_AGE" name="LEAF_AGE" long_name="leaf age" unit="days" axis_ref="nvm"/>
+    <field id="MORTALITY" name="MORTALITY" long_name="Fraction of trees that dies (gap)" unit="1/day" axis_ref="nvm"/>
+    <field id="FIREDEATH" name="FIREDEATH" long_name="Fraction of plants killed by fire" unit="1/day" axis_ref="nvm"/>
+    <field id="IND_ESTAB" name="IND_ESTAB" long_name="Density of newly established saplings" unit="1/day" axis_ref="nvm"/>
+    <field id="ESTABTREE" name="ESTABTREE" long_name="Rate of tree establishement" unit="1/day"/>
+    <field id="ESTABGRASS" name="ESTABGRASS" long_name="Rate of grass establishement" unit="1/day"/>
+    <field id="LIGHT_DEATH" name="LIGHT_DEATH" long_name="Fraction of plants that dies (light competition)" unit="1/day" axis_ref="nvm"/>
+    <field id="AGE" name="AGE" long_name="age" unit="years" axis_ref="nvm"/>
+    <field id="HEIGHT" name="HEIGHT" long_name="height" unit="m" axis_ref="nvm"/>
+    <field id="WHEN_GROWTHINIT" name="WHEN_GROWTHINIT" long_name="Time elapsed from season beginning" unit="d" axis_ref="nvm"/>
+    <field id="PFTPRESENT" name="PFTPRESENT" long_name="PFT exists" unit="d" axis_ref="nvm"/>
+    <field id="GDD_MIDWINTER" name="GDD_MIDWINTER" long_name="Growing degree days, since midwinter" unit="degK" axis_ref="nvm"/>
+    <field id="GDD_M5_DORMANCE" name="GDD_M5_DORMANCE" long_name="Growing degree days threshold" unit="degK" axis_ref="nvm"/>
+    <field id="NCD_DORMANCE" name="NCD_DORMANCE" long_name="Number of chilling days, since leaves were lost" unit="d" axis_ref="nvm"/>
+    <field id="ALLOW_INITPHENO" name="ALLOW_INITPHENO" long_name="Allow to declare beginning of the growing season" unit="-" axis_ref="nvm"/>
+    <field id="BEGIN_LEAVES" name="BEGIN_LEAVES" long_name="Signal to start putting leaves on" unit="-" axis_ref="nvm"/>
+    <field id="T2M_LONGTERM" name="T2M_LONGTERM" long_name="Longterm 2 m temperature" unit="K"/>
+    <field id="FIREINDEX" name="FIREINDEX" long_name="Fire index on ground" unit="-" axis_ref="nvm"/>
+    <field id="cVeg" name="cVeg" long_name="Carbon in Vegetation" unit="kg C m-2"/>
+    <field id="cLitter" name="cLitter" long_name="Carbon in Litter Pool" unit="kg C m-2"/>
+    <field id="cSoil" name="cSoil" long_name="Carbon in Soil Pool" unit="kg C m-2"/>
+    <field id="cProduct" name="cProduct" long_name="Carbon in Products of Land Use Change" unit="kg C m-2"/>
+    <field id="cMassVariation" name="cMassVariation" long_name="Terrestrial Carbon Mass Variation" unit="kg C m-2 s-1"/>
+    <field id="lai_ipcc" name="lai" long_name="Leaf Area Fraction" unit="1"/>
+    <field id="gpp_ipcc" name="gpp" long_name="Gross Primary Production" unit="kg C m-2 s-1"/>
+    <field id="ra" name="ra" long_name="Autotrophic Respiration" unit="kg C m-2 s-1"/>
+    <field id="npp_ipcc" name="npp" long_name="Net Primary Production" unit="kg C m-2 s-1"/>
+    <field id="rh" name="rh" long_name="Heterotrophic Respiration" unit="kg C m-2 s-1"/>
+    <field id="fFire" name="fFire" long_name="CO2 Emission from Fire" unit="kg C m-2 s-1"/>
+    <field id="fHarvest" name="fHarvest" long_name="CO2 Flux to Atmosphere from Crop Harvesting" unit="kg C m-2 s-1"/>
+    <field id="fLuc" name="fLuc" long_name="CO2 Flux to Atmosphere from Land Use Change" unit="kg C m-2 s-1"/>
+    <field id="nbp" name="nbp" long_name="Net Biospheric Production" unit="kg C m-2 s-1"/>
+    <field id="fVegLitter" name="fVegLitter" long_name="Total Carbon Flux from Vegetation to Litter" unit="kg C m-2 s-1"/>
+    <field id="fLitterSoil" name="fLitterSoil" long_name="Total Carbon Flux from Litter to Soil" unit="kg C m-2 s-1"/>
+    <field id="cLeaf" name="cLeaf" long_name="Carbon in Leaves" unit="kg C m-2"/>
+    <field id="cWood" name="cWood" long_name="Carbon in Wood" unit="kg C m-2"/>
+    <field id="cRoot" name="cRoot" long_name="Carbon in Roots" unit="kg C m-2"/>
+    <field id="cMisc" name="cMisc" long_name="Carbon in Other Living Compartments" unit="kg C m-2"/>
+    <field id="cLitterAbove" name="cLitterAbove" long_name="Carbon in Above-Ground Litter" unit="kg C m-2"/>
+    <field id="cLitterBelow" name="cLitterBelow" long_name="Carbon in Below-Ground Litter" unit="kg C m-2"/>
+    <field id="cSoilFast" name="cSoilFast" long_name="Carbon in Fast Soil Pool" unit="kg C m-2"/>
+    <field id="cSoilMedium" name="cSoilMedium" long_name="Carbon in Medium Soil Pool" unit="kg C m-2"/>
+    <field id="cSoilSlow" name="cSoilSlow" long_name="Carbon in Slow Soil Pool" unit="kg C m-2"/>
+    <field id="landCoverFrac" name="landCoverFrac" long_name="Fractional Land Cover of PFT" unit="%" axis_ref="nvm"/>
+    <field id="treeFracPrimDec" name="treeFracPrimDec" long_name="Total Primary Deciduous Tree Cover Fraction" unit="%"/>
+    <field id="treeFracPrimEver" name="treeFracPrimEver" long_name="Total Primary Evergreen Tree Cover Fraction" unit="%"/>
+    <field id="c3PftFrac" name="c3PftFrac" long_name="Total C3 PFT Cover Fraction" unit="%"/>
+    <field id="c4PftFrac" name="c4PftFrac" long_name="Total C4 PFT Cover Fraction" unit="%"/>
+    <field id="rGrowth" name="rGrowth" long_name="Growth Autotrophic Respiration" unit="kg C m-2 s-1"/>
+    <field id="rMaint" name="rMaint" long_name="Maintenance Autotrophic Respiration" unit="kg C m-2 s-1"/>
+    <field id="nppLeaf" name="nppLeaf" long_name="CO2 Flux from Atmosphere due to NPP Allocation to Leaf" unit="kg C m-2 s-1"/>
+    <field id="nppWood" name="nppWood" long_name="CO2 Flux from Atmosphere due to NPP Allocation to Wood" unit="kg C m-2 s-1"/>
+    <field id="nppRoot" name="nppRoot" long_name="CO2 Flux from Atmosphere due to NPP Allocation to Root" unit="kg C m-2 s-1"/>
+    <field id="nep" name="nep" long_name="Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity." unit="kg C m-2 s-1"/>
+  </field_group>
+</field_definition>
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/file_def_orchidee.xml
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/file_def_orchidee.xml	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/file_def_orchidee.xml	(revision 5166)
@@ -0,0 +1,687 @@
+<!-- =========================================================================================================== -->
+<!-- file_def_orchidee.xml : Definition of output files                                                          -->
+
+<!-- Definition of variables or groups included in the different files                                           -->
+<!-- Change this file by adding the files and/or variables you want to produce                                   -->
+<!-- Only variables and groups existing in field_def_orchidee.xml can be used                                    -->
+
+<!-- Note: The keyword _AUTO_ will be changed by the drivers using libIGCM configurations. It can also be        -->
+<!-- changed manually. For example instead of _AUTO_ set :  enabled=".TRUE." or enabled=".FALSE."                -->
+<!-- output_freq="1mo" for monthly, output_freq="1d" for daily, output_freq="10800s" for 3-hour output frequency -->
+<!-- =========================================================================================================== -->
+
+<file_definition type="one_file" par_access="collective" enabled=".TRUE." min_digits="4">
+
+  <!-- Definition of files with sechiba diagnostics -->
+
+  <!-- Sechiba file 1 -->
+  <file id="sechiba1" name="sechiba_history" output_level="11" output_freq="_AUTO_" enabled="_AUTO_">
+    <!-- level 1 -->
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="LandPoints" level="20"/>
+    <field field_ref="Contfrac" level="1"/>
+    <field field_ref="evap" level="1"/>
+    <field field_ref="coastalflow" level="1"/>
+    <field field_ref="riverflow" level="1"/>
+    <field field_ref="temp_sol_C" level="1"/>
+    <field field_ref="rain" level="1"/>
+    <field field_ref="snowf" level="1"/>
+    <field field_ref="netrad" level="1"/>
+    <field field_ref="lai" level="1"/>
+    <field field_ref="reinf_slope" level="1"/>
+    <field field_ref="soilindex" level="1"/>
+    <field field_ref="basinmap" level="1"/>
+    <field field_ref="nbrivers" level="1"/>
+    <field field_ref="npp" level="1"/>
+    <!-- level 2 -->
+    <field field_ref="subli" level="2"/>
+    <field field_ref="runoff" level="2"/>
+    <field field_ref="drainage" level="2"/>
+    <field field_ref="riversret" level="2"/>
+    <field field_ref="hydrographs" level="2"/>
+    <field field_ref="evapnu" level="2"/>
+    <field field_ref="evapnu_soil" level="2"/>
+    <field field_ref="drainage_soil" level="2"/>
+    <field field_ref="transpir_soil" level="2"/>
+    <field field_ref="runoff_soil" level="2"/>
+    <field field_ref="tair" level="2"/>
+    <field field_ref="qair" level="2"/>
+    <field field_ref="q2m" level="2"/>
+    <field field_ref="t2m" level="2"/>
+    <field field_ref="alb_vis" level="2"/>
+    <field field_ref="alb_nir" level="2"/>
+    <field field_ref="soilalb_vis" level="2"/>
+    <field field_ref="soilalb_nir" level="2"/>
+    <field field_ref="vegalb_vis" level="2"/>
+    <field field_ref="vegalb_nir" level="2"/>
+    <field field_ref="z0" level="2"/>
+    <field field_ref="roughheight" level="2"/>
+    <field field_ref="transpir" level="2"/>
+    <field field_ref="inter" level="2"/>
+    <!-- level 3 -->
+    <field field_ref="tsol_max" level="3"/>
+    <field field_ref="tsol_min" level="3"/>
+    <field field_ref="fluxsens" level="3"/>
+    <field field_ref="fluxlat" level="3"/>
+    <field field_ref="snow" level="3"/>
+    <field field_ref="snowage" level="3"/>
+    <field field_ref="snownobio" level="3"/>
+    <field field_ref="snownobioage" level="3"/>
+    <field field_ref="vegetfrac" level="3"/>
+    <field field_ref="maxvegetfrac" level="3"/>
+    <field field_ref="tot_bare_soil" level="3"/>
+    <field field_ref="nobiofrac" level="3"/>
+    <field field_ref="flood_frac" level="3"/>
+    <field field_ref="reinfiltration" level="3"/>
+    <field field_ref="frac_bare" level="3"/>
+    <field field_ref="soiltile" level="3"/>
+    <field field_ref="moistc_1" level="3"/>
+    <field field_ref="moistc_2" level="3"/>
+    <field field_ref="moistc_3" level="3"/>
+    <field field_ref="kfactroot_1" level="3"/>
+    <field field_ref="kfactroot_2" level="3"/>
+    <field field_ref="kfactroot_3" level="3"/>
+    <field field_ref="vegetsoil_1" level="3"/>
+    <field field_ref="vegetsoil_2" level="3"/>
+    <field field_ref="vegetsoil_3" level="3"/>
+    <field field_ref="humtot_pro" level="3"/>
+    <!-- level 4 -->
+    <field field_ref="dss" level="4"/>
+    <field field_ref="gqsb" level="4"/>
+    <field field_ref="bqsb" level="4"/>
+    <field field_ref="humtot" level="4"/>
+    <field field_ref="humtot_soil" level="4"/>
+    <field field_ref="SWI" level="4"/>
+    <field field_ref="njsc" level="4"/>
+    <field field_ref="qsintveg" level="4"/>
+    <field field_ref="rstruct" level="4"/>
+    <field field_ref="gpp" level="4"/>
+    <field field_ref="nee" level="4"/>
+    <field field_ref="maint_resp" level="4"/>
+    <field field_ref="hetero_resp" level="4"/>
+    <field field_ref="growth_resp" level="4"/>
+    <field field_ref="precisol" level="4"/>
+    <field field_ref="drysoil_frac" level="4"/>
+    <field field_ref="evapot" level="4"/>
+    <field field_ref="evapot_corr" level="4"/>
+    <!-- level 5 -->
+    <field field_ref="swnet" level="5"/>
+    <field field_ref="swdown" level="5"/>
+    <field field_ref="lwdown" level="5"/>
+    <field field_ref="lwnet" level="5"/>
+    <!-- level 6 -->
+    <field field_ref="twbr" level="6"/>
+    <field field_ref="ptn" level="6"/>
+    <!-- level 7 -->
+    <field field_ref="fastr" level="7"/>
+    <field field_ref="slowr" level="7"/>
+    <field field_ref="streamr" level="7"/>
+    <field field_ref="lakevol" level="7"/>
+    <!-- level 8 -->
+    <field field_ref="pondr" level="8"/>
+    <field field_ref="swampmap" level="8"/>
+    <field field_ref="irrigation" level="8"/>
+    <field field_ref="netirrig" level="8"/>
+    <field field_ref="irrigmap" level="8"/>
+    <field field_ref="floodmap" level="8"/>
+    <field field_ref="floodh" level="8"/>
+    <field field_ref="floodr" level="8"/>
+    <field field_ref="floodout" level="8"/>
+    <field field_ref="evapflo" level="8"/>
+    <field field_ref="k_litt" level="8"/>
+    <field field_ref="beta" level="8"/>
+    <field field_ref="raero" level="8"/>
+    <field field_ref="cdrag" level="8"/>
+    <field field_ref="Wind" level="8"/>
+    <field field_ref="qsatt" level="8"/>
+    <field field_ref="vbeta1" level="8"/>
+    <field field_ref="vbeta4" level="8"/>
+    <field field_ref="vbeta5" level="8"/>
+    <field field_ref="gsmean" level="8"/>
+    <field field_ref="humrel" level="8"/>
+    <!-- level 10 -->
+    <field field_ref="cimean" level="10"/>
+    <field field_ref="vbeta3" level="10"/>
+    <field field_ref="rveget" level="10"/>
+    <field field_ref="rsol" level="10"/>
+    <field field_ref="vbeta2" level="10"/>
+    <field field_ref="qsintmax" level="10"/>
+    <!-- level 11 -->
+    <field field_ref="mrsos" level="11"/>
+    <field field_ref="mrso" level="11"/>
+    <field field_ref="mrros" level="11"/>
+    <field field_ref="mrro" level="11"/>
+    <field field_ref="prveg" level="11"/>
+    <field field_ref="evspsblveg" level="11"/>
+    <field field_ref="evspsblsoi" level="11"/>
+    <field field_ref="tran" level="11"/>
+    <field field_ref="treeFrac" level="11"/>
+    <field field_ref="grassFrac" level="11"/>
+    <field field_ref="cropFrac" level="11"/>
+    <field field_ref="baresoilFrac" level="11"/>
+    <field field_ref="residualFrac" level="11"/>
+    <field field_ref="PAR" level="11"/>
+    <field field_ref="PARsun" level="11"/>
+    <field field_ref="PARsh" level="11"/>
+    <field field_ref="laisun" level="11"/>
+    <field field_ref="laish" level="11"/>
+    <field field_ref="PARsuntab" level="11"/>
+    <field field_ref="PARshtab" level="11"/>
+    <field field_ref="coszang" level="11"/>
+    <field field_ref="PARdf" level="11"/>
+    <field field_ref="PARdr" level="11"/>
+    <field field_ref="flx_fertil_no" level="11"/>
+    <field field_ref="CRF" level="11"/>
+    <field field_ref="flx_co2_bbg_year" level="11"/>
+    <field field_ref="N_qt_WRICE_year" level="11"/>
+    <field field_ref="N_qt_OTHER_year" level="11"/>
+    <field field_ref="flx_iso" level="11"/>
+    <field field_ref="flx_mono" level="11"/>
+    <field field_ref="flx_ORVOC" level="11"/>
+    <field field_ref="flx_MBO" level="11"/>
+    <field field_ref="flx_methanol" level="11"/>
+    <field field_ref="flx_acetone" level="11"/>
+    <field field_ref="flx_acetal" level="11"/>
+    <field field_ref="flx_formal" level="11"/>
+    <field field_ref="flx_acetic" level="11"/>
+    <field field_ref="flx_formic" level="11"/>
+    <field field_ref="flx_no_soil" level="11"/>
+    <field field_ref="flx_no" level="11"/>
+    <field field_ref="Psurf" level="11"/>
+    <field field_ref="Qb" level="11"/>
+    <field field_ref="CanopInt" level="11"/>
+    <field field_ref="LAImean" level="11"/>
+    <field field_ref="SoilSat" level="11"/>
+    <field field_ref="RootDist" level="11"/>
+    <field field_ref="SoilThick" level="11"/>
+    <field field_ref="water2infilt" level="11"/>
+    <field field_ref="flx_apinen"  level="11" />
+    <field field_ref="flx_bpinen"  level="11" />
+    <field field_ref="flx_limonen" level="11" />
+    <field field_ref="flx_myrcen"  level="11" />
+    <field field_ref="flx_sabinen" level="11" />
+    <field field_ref="flx_camphen" level="11" />
+    <field field_ref="flx_3caren"  level="11" />
+    <field field_ref="flx_tbocimen" level="11"/>
+    <field field_ref="flx_othermono" level="11"/>
+    <field field_ref="flx_sesquiter" level="11"/>
+    <field field_ref="fco2" level="11"/>
+    <field field_ref="cim" level="11"/>
+  </file>
+
+
+  <!-- Sechiba file 2 -->
+  <file id="sechiba2" name="sechiba_out_2" output_level="2" output_freq="10800s" enabled="_AUTO_">
+    <!-- level 1 -->
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="LandPoints" level="20"/>
+    <field field_ref="Contfrac" level="1"/>
+    <field field_ref="mrsos" level="1"/>
+    <field field_ref="mrro" level="1"/>
+    <field field_ref="ptn" level="1"/>
+    <!-- level 2 -->
+    <field field_ref="cdrag" level="2"/>
+    <field field_ref="soilalb_vis" level="2"/>
+    <field field_ref="soilalb_nir" level="2"/>
+    <field field_ref="vegalb_vis" level="2"/>
+    <field field_ref="vegalb_nir" level="2"/>
+    <field field_ref="z0" level="2"/>
+    <field field_ref="coastalflow" level="2"/>
+    <field field_ref="riverflow" level="2"/>
+    <field field_ref="tsol_rad" level="2"/>
+    <field field_ref="vevapnu" level="2"/>
+    <field field_ref="temp_sol_C" level="2"/>
+    <field field_ref="qsurf" level="2"/>
+    <field field_ref="albedo" level="2"/>
+    <field field_ref="fluxsens" level="2"/>
+    <field field_ref="fluxlat" level="2"/>
+    <field field_ref="emis" level="2"/>
+    <field field_ref="riversret" level="2"/>
+    <field field_ref="hydrographs" level="2"/>
+    <!-- level 3 -->
+    <field field_ref="evap" level="3"/>
+    <field field_ref="rain" level="3"/>
+    <field field_ref="snowf" level="3"/>
+    <field field_ref="netrad" level="3"/>
+    <field field_ref="lai" level="3"/>
+    <field field_ref="basinmap" level="3"/>
+    <field field_ref="nbrivers" level="3"/>
+    <field field_ref="moistc_1" level="3"/>
+    <field field_ref="moistc_2" level="3"/>
+    <field field_ref="moistc_3" level="3"/>
+    <field field_ref="humtot_pro" level="3"/>
+    <!-- level 4 -->
+    <field field_ref="subli" level="4"/>
+    <field field_ref="runoff" level="4"/>
+    <field field_ref="drainage" level="4"/>
+    <field field_ref="tair" level="4"/>
+    <field field_ref="qair" level="4"/>
+    <field field_ref="q2m" level="4"/>
+    <field field_ref="t2m" level="4"/>
+    <field field_ref="alb_vis" level="4"/>
+    <field field_ref="alb_nir" level="4"/>
+    <field field_ref="roughheight" level="4"/>
+    <field field_ref="transpir" level="4"/>
+    <field field_ref="inter" level="4"/>
+    <field field_ref="evapnu_soil" level="4"/>
+    <field field_ref="drainage_soil" level="4"/>
+    <field field_ref="transpir_soil" level="4"/>
+    <field field_ref="runoff_soil" level="4"/>
+    <!-- level 5 -->
+    <field field_ref="tsol_max" level="5"/>
+    <field field_ref="tsol_min" level="5"/>
+    <field field_ref="snow" level="5"/>
+    <field field_ref="snowage" level="5"/>
+    <field field_ref="snownobio" level="5"/>
+    <field field_ref="snownobioage" level="5"/>
+    <field field_ref="vegetfrac" level="5"/>
+    <field field_ref="maxvegetfrac" level="5"/>
+    <field field_ref="nobiofrac" level="5"/>
+    <field field_ref="kfactroot_1" level="5"/>
+    <field field_ref="kfactroot_2" level="5"/>
+    <field field_ref="kfactroot_3" level="5"/>
+    <field field_ref="vegetsoil_1" level="5"/>
+    <field field_ref="vegetsoil_2" level="5"/>
+    <field field_ref="vegetsoil_3" level="5"/>
+    <!-- level 6 -->
+    <field field_ref="dss" level="6"/>
+    <field field_ref="gqsb" level="6"/>
+    <field field_ref="bqsb" level="6"/>
+    <field field_ref="humtot" level="6"/>
+    <field field_ref="humtot_soil" level="6"/>
+    <field field_ref="SWI" level="6"/>
+    <field field_ref="qsintveg" level="6"/>
+    <field field_ref="rstruct" level="6"/>
+    <field field_ref="gpp" level="6"/>
+    <field field_ref="nee" level="6"/>
+    <field field_ref="maint_resp" level="6"/>
+    <field field_ref="hetero_resp" level="6"/>
+    <field field_ref="growth_resp" level="6"/>
+    <field field_ref="npp" level="6"/>
+    <field field_ref="precisol" level="6"/>
+    <field field_ref="drysoil_frac" level="6"/>
+    <field field_ref="evapot" level="6"/>
+    <field field_ref="evapot_corr" level="6"/>
+    <field field_ref="twbr" level="6"/>
+    <!-- level 7 -->
+    <field field_ref="swnet" level="7"/>
+    <field field_ref="swdown" level="7"/>
+    <field field_ref="lwdown" level="7"/>
+    <field field_ref="lwnet" level="7"/>
+    <!-- level 8 -->
+    <field field_ref="fastr" level="8"/>
+    <field field_ref="slowr" level="8"/>
+    <field field_ref="streamr" level="8"/>
+    <field field_ref="floodr" level="8"/>
+    <field field_ref="floodh" level="8"/>
+    <field field_ref="pondr" level="8"/>
+    <field field_ref="lakevol" level="8"/>
+    <field field_ref="irrigation" level="8"/>
+    <field field_ref="netirrig" level="8"/>
+    <field field_ref="irrigmap" level="8"/>
+    <field field_ref="floodmap" level="8"/>
+    <field field_ref="swampmap" level="8"/>
+    <!-- level 9 -->
+    <field field_ref="beta" level="9"/>
+    <field field_ref="raero" level="9"/>
+    <field field_ref="Wind" level="9"/>
+    <field field_ref="qsatt" level="9"/>
+    <field field_ref="vbeta1" level="9"/>
+    <field field_ref="vbeta4" level="9"/>
+    <field field_ref="gsmean" level="9"/>
+    <field field_ref="vbeta5" level="9"/>
+    <field field_ref="reinf_slope" level="9"/>
+    <field field_ref="soilindex" level="9"/>
+    <field field_ref="humrel" level="9"/>
+    <!-- level 10 -->
+    <field field_ref="cimean" level="10"/>
+    <field field_ref="vbeta3" level="10"/>
+    <field field_ref="rveget" level="10"/>
+    <field field_ref="rsol" level="10"/>
+    <field field_ref="vbeta2" level="10"/>
+    <field field_ref="qsintmax" level="10"/>
+    <field field_ref="PAR" level="10"/>
+    <field field_ref="PARsun" level="10"/>
+    <field field_ref="PARsh" level="10"/>
+    <field field_ref="laisun" level="10"/>
+    <field field_ref="laish" level="10"/>
+    <field field_ref="PARsuntab" level="10"/>
+    <field field_ref="PARshtab" level="10"/>
+    <field field_ref="coszang" level="10"/>
+    <field field_ref="PARdf" level="10"/>
+    <field field_ref="PARdr" level="10"/>
+    <field field_ref="flx_fertil_no" level="10"/>
+    <field field_ref="CRF" level="10"/>
+    <field field_ref="flx_co2_bbg_year" level="10"/>
+    <field field_ref="N_qt_WRICE_year" level="10"/>
+    <field field_ref="N_qt_OTHER_year" level="10"/>
+    <field field_ref="flx_iso" level="10"/>
+    <field field_ref="flx_mono" level="10"/>
+    <field field_ref="flx_ORVOC" level="10"/>
+    <field field_ref="flx_MBO" level="10"/>
+    <field field_ref="flx_methanol" level="10"/>
+    <field field_ref="flx_acetone" level="10"/>
+    <field field_ref="flx_acetal" level="10"/>
+    <field field_ref="flx_formal" level="10"/>
+    <field field_ref="flx_acetic" level="10"/>
+    <field field_ref="flx_formic" level="10"/>
+    <field field_ref="flx_no_soil" level="10"/>
+    <field field_ref="flx_no" level="10"/>
+    <field field_ref="Psurf" level="11"/>
+    <field field_ref="Qb" level="11"/>
+    <field field_ref="CanopInt" level="11"/>
+    <field field_ref="LAImean" level="11"/>
+    <field field_ref="SoilSat" level="11"/>
+    <field field_ref="RootDist" level="11"/>
+    <field field_ref="SoilThick" level="11"/>
+    <field field_ref="water2infilt" level="11"/>
+  </file>
+
+  <!-- Sechiba alma file 1 -->
+  <file id="sechiba1_alma" name="sechiba_history_alma" output_level="10" output_freq="1mo" enabled=".FALSE.">
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="LandPoints" level="20"/>
+    <field field_ref="Contfrac" level="1"/>
+    <field field_ref="Qg" level="1"/>
+    <field field_ref="Qv" level="1"/>
+    <field field_ref="Qs" level="1"/>
+    <field field_ref="Qsb" level="1"/>
+    <field field_ref="DelSurfHeat" level="1"/>
+    <field field_ref="DelColdCont" level="1"/>
+    <field field_ref="fluxsens" name="Qh" level="1"/>
+    <field field_ref="fluxlat" name="Qle" level="1"/>
+    <field field_ref="lwnet" name="LWnet" level="1"/>
+    <field field_ref="swnet" name="SWnet" level="1"/>
+    <field field_ref="snowf_alma" level="1"/>
+    <field field_ref="rain_alma" level="1"/>
+    <field field_ref="evap_alma" name="Evap" level="1"/>
+    <field field_ref="Qsm" level="1"/>
+    <field field_ref="irrigation_alma" level="1"/>
+    <field field_ref="netirrig_alma" level="1"/>
+    <field field_ref="temp_sol_K" level="1"/>
+    <field field_ref="PotSurfT" level="1"/>
+    <field field_ref="albedo_alma" level="1"/>
+    <field field_ref="SurfStor" level="1"/>
+    <field field_ref="snow" name="SWE" long_name="Snow Water Equivalent" level="1"/>
+    <field field_ref="SoilWet" level="1"/>
+    <field field_ref="evapot_corr_alma" level="1"/>
+    <field field_ref="evapot_alma" level="1"/>
+    <field field_ref="ECanop" level="1"/>
+    <field field_ref="TVeg" level="1"/>
+    <field field_ref="SubSnow" level="1"/>
+    <field field_ref="irrigmap" name="IrrigationMap" level="1"/>
+    <field field_ref="floodmap" name="FloodplainsMap" level="1"/>
+    <field field_ref="swampmap" name="SwampMap" level="1"/>
+    <field field_ref="hydrographs" name="Dis" level="1"/>
+    <field field_ref="gpp" name="GPP" level="1"/>
+    <field field_ref="nee" name="NEE" level="1"/>
+    <field field_ref="maint_resp" level="1"/>
+    <field field_ref="hetero_resp" level="1"/>
+    <field field_ref="growth_resp" level="1"/>
+    <field field_ref="npp" level="1"/>
+    <field field_ref="z0" name="Z0" long_name="Roughness height" level="1"/>
+    <field field_ref="roughheight" name="EffectHeight" long_name="Effective displacement height (h-d)" level="1"/>
+    <field field_ref="DelSoilMoist" level="1"/>
+    <field field_ref="DelSurfStor" level="1"/>
+    <field field_ref="DelIntercept" level="1"/>
+    <field field_ref="DelSWE" level="1"/>
+    <field field_ref="vevapnu_alma" level="1"/>
+    <field field_ref="evapflo_alma" level="1"/>
+    <field field_ref="ACond" level="1"/>
+    <field field_ref="tair" name="Tair" level="2"/>
+    <field field_ref="qair" name="Qair" level="2"/>
+    <field field_ref="Qf" level="2"/>
+    <field field_ref="vegetfrac" level="3"/>
+    <field field_ref="maxvegetfrac" level="3"/>
+    <field field_ref="nobiofrac" level="3"/>
+    <field field_ref="SoilMoist" level="7"/>
+    <field field_ref="RootMoist" level="1"/>
+    <field field_ref="ptn" name="SoilTemp" level="7"/>
+    <field field_ref="vbeta1" name="SnowFrac" level="7"/>
+    <field field_ref="SAlbedo" level="7"/>
+    <field field_ref="SnowDepth" level="7"/>
+    <field field_ref="temp_sol_K" name="RadT" level="1"/>
+    <field field_ref="twbr" level="1"/>
+  </file>
+
+  <!-- Sechiba alma file 2 -->
+  <file id="sechiba2_alma" name="sechiba_out_2_alma" output_level="10" output_freq="1d" enabled=".FALSE.">
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="LandPoints" level="20"/>
+    <field field_ref="Contfrac" level="1"/>
+    <field field_ref="Qg" level="1"/>
+    <field field_ref="Qv" level="1"/>
+    <field field_ref="Qs" level="1"/>
+    <field field_ref="Qsb" level="1"/>
+    <field field_ref="DelSurfHeat" level="1"/>
+    <field field_ref="DelColdCont" level="1"/>
+    <field field_ref="fluxsens" name="Qh" level="1"/>
+    <field field_ref="fluxlat" name="Qle" level="1"/>
+    <field field_ref="lwnet" name="LWnet" level="1"/>
+    <field field_ref="swnet" name="SWnet" level="1"/>
+    <field field_ref="snowf_alma" level="1"/>
+    <field field_ref="rain_alma" level="1"/>
+    <field field_ref="evap_alma" name="Evap" level="1"/>
+    <field field_ref="Qsm" level="1"/>
+    <field field_ref="irrigation_alma" level="1"/>
+    <field field_ref="netirrig_alma" level="1"/>
+    <field field_ref="temp_sol_K" level="1"/>
+    <field field_ref="albedo_alma" level="1"/>
+    <field field_ref="SurfStor" level="1"/>
+    <field field_ref="snow" name="SWE" long_name="Snow Water Equivalent" level="1"/>
+    <field field_ref="SoilWet" level="1"/>
+    <field field_ref="evapot_corr_alma" level="1"/>
+    <field field_ref="ECanop" level="1"/>
+    <field field_ref="TVeg" level="1"/>
+    <field field_ref="SubSnow" level="1"/>
+    <field field_ref="irrigmap" name="IrrigationMap" level="1"/>
+    <field field_ref="floodmap" name="FloodplainsMap" level="1"/>
+    <field field_ref="swampmap" name="SwampMap" level="1"/>
+    <field field_ref="hydrographs" name="Dis" level="1"/>
+    <field field_ref="gpp" name="GPP" level="1"/>
+    <field field_ref="nee" name="NEE" level="1"/>
+    <field field_ref="maint_resp" level="1"/>
+    <field field_ref="hetero_resp" level="1"/>
+    <field field_ref="growth_resp" level="1"/>
+    <field field_ref="npp" level="1"/>
+    <field field_ref="DelSoilMoist" level="1"/>
+    <field field_ref="DelSurfStor" level="1"/>
+    <field field_ref="DelIntercept" level="1"/>
+    <field field_ref="DelSWE" level="1"/>
+    <field field_ref="vevapnu_alma" level="1"/>
+    <field field_ref="evapflo_alma" level="1"/>
+    <field field_ref="ACond" level="1"/>
+    <field field_ref="SoilMoist" level="7"/>
+    <field field_ref="RootMoist" level="1"/>
+    <field field_ref="ptn" name="SoilTemp" level="7"/>
+    <field field_ref="vbeta1" name="SnowFrac" level="7"/>
+    <field field_ref="SAlbedo" level="7"/>
+    <field field_ref="SnowDepth" level="7"/>
+    <field field_ref="Qf" level="2"/>
+    <field field_ref="vegetfrac" level="3"/>
+    <field field_ref="maxvegetfrac" level="3"/>
+    <field field_ref="nobiofrac" level="3"/>
+    <field field_ref="temp_sol_K" name="RadT" level="5"/>
+  </file>
+
+  <!-- Definition of files with stomate diagnostics -->
+  <!-- Stomate file 1 -->
+  <file id="stomate1" name="stomate_history" output_level="10" output_freq="_AUTO_" enabled="_AUTO_">
+    <!-- level 1 -->
+    <field field_ref="RESOLUTION_X" level="1"/>
+    <field field_ref="RESOLUTION_Y" level="1"/>
+    <field field_ref="CONTFRAC_STOMATE" level="1"/>
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="T2M_MONTH" level="1"/>
+    <field field_ref="T2M_WEEK" level="1"/>
+    <field field_ref="FIREFRAC" level="1"/>
+    <field field_ref="CO2FLUX" level="1"/>
+    <field field_ref="CO2_FIRE" level="1"/>
+    <field field_ref="CO2_TAKEN" level="1"/>
+    <field field_ref="LAI" level="1"/>
+    <field field_ref="VEGET_MAX" level="1"/>
+    <field field_ref="NPP_STOMATE" level="1"/>
+    <field field_ref="GPP" level="1"/>
+    <!-- level 2 -->
+    <field field_ref="LEAF_M" level="2"/>
+    <field field_ref="SAP_M_AB" level="2"/>
+    <field field_ref="SAP_M_BE" level="2"/>
+    <field field_ref="HEART_M_AB" level="2"/>
+    <field field_ref="HEART_M_BE" level="2"/>
+    <field field_ref="ROOT_M" level="2"/>
+    <field field_ref="FRUIT_M" level="2"/>
+    <field field_ref="RESERVE_M" level="2"/>
+    <field field_ref="MAINT_RESP" level="2"/>
+    <field field_ref="GROWTH_RESP" level="2"/>
+    <!-- level 3 -->
+    <field field_ref="IND" level="3"/>
+    <field field_ref="ADAPTATION" level="3"/>
+    <field field_ref="REGENERATION" level="3"/>
+    <field field_ref="CN_IND" level="3"/>
+    <field field_ref="WOODMASS_IND" level="3"/>
+    <field field_ref="MOISTRESS" level="3"/>
+    <field field_ref="HET_RESP" level="3"/>
+    <!-- level 4 -->
+    <field field_ref="SAP_AB_TURN" level="4"/>
+    <field field_ref="ROOT_TURN" level="4"/>
+    <field field_ref="FRUIT_TURN" level="4"/>
+    <field field_ref="TOTAL_BM_LITTER" level="4"/>
+    <field field_ref="LEAF_BM_LITTER" level="4"/>
+    <field field_ref="SAP_AB_BM_LITTER" level="4"/>
+    <field field_ref="SAP_BE_BM_LITTER" level="4"/>
+    <field field_ref="HEART_AB_BM_LITTER" level="4"/>
+    <field field_ref="HEART_BE_BM_LITTER" level="4"/>
+    <field field_ref="ROOT_BM_LITTER" level="4"/>
+    <field field_ref="FRUIT_BM_LITTER" level="4"/>
+    <field field_ref="RESERVE_BM_LITTER" level="4"/>
+    <field field_ref="TOTAL_M" level="4"/>
+    <field field_ref="TOTAL_TURN" level="4"/>
+    <field field_ref="LEAF_TURN" level="4"/>
+    <!-- level 5 -->
+    <field field_ref="LITTER_STR_AB" level="5"/>
+    <field field_ref="LITTER_MET_AB" level="5"/>
+    <field field_ref="LITTER_STR_BE" level="5"/>
+    <field field_ref="LITTER_MET_BE" level="5"/>
+    <field field_ref="DEADLEAF_COVER" level="5"/>
+    <field field_ref="TOTAL_SOIL_CARB" level="5"/>
+    <field field_ref="TOTAL_SOIL_CARB14" level="5"/>
+    <field field_ref="CARBON_ACTIVE" level="5"/>
+    <field field_ref="CARBON_SLOW" level="5"/>
+    <field field_ref="CARBON_PASSIVE" level="5"/>
+    <field field_ref="CARBON14_ACTIVE" level="5"/>
+    <field field_ref="CARBON14_SLOW" level="5"/>
+    <field field_ref="CARBON14_PASSIVE" level="5"/>
+    <field field_ref="F_Pool_ACTIVE" level="5"/>
+    <field field_ref="F_Pool_SLOW" level="5"/>
+    <field field_ref="F_Pool_PASSIVE" level="5"/>
+    <field field_ref="F_MEAN" level="5"/>
+    <field field_ref="pMC" level="5"/>
+    <field field_ref="age_14C" level="5"/>
+    <field field_ref="delta_14C" level="5"/>
+    <field field_ref="F_Pool_ACT_DOC" level="5"/>
+    <field field_ref="F_Pool_SLO_DOC" level="5"/>
+    <field field_ref="F_Pool_PAS_DOC" level="5"/>
+    <field field_ref="F_Pool_abmet_DOC" level="5"/>
+    <field field_ref="F_Pool_abstr_DOC" level="5"/>
+    <field field_ref="F_Pool_bemet_DOC" level="5"/>
+    <field field_ref="F_Pool_bestr_DOC" level="5"/>
+    <field field_ref="F_MEAN_DOC" level="5"/>
+    <field field_ref="FREE_DOC" level="5"/>
+    <field field_ref="ADSORBED_DOC" level="5"/>
+    <field field_ref="FREE_DOC14" level="5"/>
+    <field field_ref="ADSORBED_DOC14" level="5"/>
+    <field field_ref="EXPORTED_DOC_RUNOFF" level="5"/>
+    <field field_ref="EXPORTED_DOC_DRAIN" level="5"/>
+    <field field_ref="EXPORTED_DOC_FLOOD" level="5"/>
+    <field field_ref="LITTERHUM" level="5"/>
+    <field field_ref="BM_ALLOC_LEAF" level="5"/>
+    <field field_ref="BM_ALLOC_SAP_AB" level="5"/>
+    <field field_ref="BM_ALLOC_SAP_BE" level="5"/>
+    <field field_ref="BM_ALLOC_ROOT" level="5"/>
+    <field field_ref="BM_ALLOC_FRUIT" level="5"/>
+    <field field_ref="BM_ALLOC_RES" level="5"/>
+    <field field_ref="HERBIVORES" level="5"/>
+    <field field_ref="TURNOVER_TIME" level="5"/>
+    <field field_ref="PROD10" level="5"/>
+    <field field_ref="FLUX10" level="5"/>
+    <field field_ref="PROD100" level="5"/>
+    <field field_ref="FLUX100" level="5"/>
+    <field field_ref="CONVFLUX" level="5"/>
+    <field field_ref="CFLUX_PROD10" level="5"/>
+    <field field_ref="CFLUX_PROD100" level="5"/>
+    <field field_ref="HARVEST_ABOVE" level="5"/>
+    <!-- level 6 -->
+    <field field_ref="VCMAX" level="6"/>
+    <field field_ref="LEAF_AGE" level="6"/>
+    <field field_ref="MORTALITY" level="6"/>
+    <field field_ref="FIREDEATH" level="6"/>
+    <field field_ref="IND_ESTAB" level="6"/>
+    <field field_ref="ESTABTREE" level="6"/>
+    <field field_ref="ESTABGRASS" level="6"/>
+    <field field_ref="LIGHT_DEATH" level="6"/>
+    <!-- level 7 -->
+    <field field_ref="AGE" level="7"/>
+    <field field_ref="HEIGHT" level="7"/>
+    <!-- level 9 -->
+    <field field_ref="WHEN_GROWTHINIT" level="9"/>
+    <field field_ref="PFTPRESENT" level="9"/>
+    <field field_ref="GDD_MIDWINTER" level="9"/>
+    <field field_ref="GDD_M5_DORMANCE" level="9"/>
+    <field field_ref="NCD_DORMANCE" level="9"/>
+    <field field_ref="ALLOW_INITPHENO" level="9"/>
+    <field field_ref="BEGIN_LEAVES" level="9"/>
+    <field field_ref="T2M_LONGTERM" level="9"/>
+    <field field_ref="TSEASON"  level="9"/>
+    <field field_ref="TMIN_SPRING_TIME" level="9"/>
+    <field field_ref="ONSET_DATE" level="9"/>
+    <field field_ref="FPC_MAX" level="9"/>
+    <field field_ref="MAXFPC_LASTYEAR" level="9"/>
+    <!-- level 10 -->
+    <field field_ref="FIREINDEX" level="10"/>
+  </file>
+
+  <!-- Stomate file 2 -->
+  <file id="stomate2" name="stomate_ipcc_history" output_level="1" output_freq="_AUTO_" enabled="_AUTO_">
+    <!-- level 1 -->
+    <field field_ref="RESOLUTION_X" level="1"/>
+    <field field_ref="RESOLUTION_Y" level="1"/>
+    <field field_ref="CONTFRAC_STOMATE" level="1"/>
+    <field field_ref="Areas" level="1"/>
+    <field field_ref="cVeg" level="1"/>
+    <field field_ref="cLitter" level="1"/>
+    <field field_ref="cSoil" level="1"/>
+    <field field_ref="cProduct" level="1"/>
+    <field field_ref="cMassVariation" level="1"/>
+    <field field_ref="lai_ipcc" level="1"/>
+    <field field_ref="gpp_ipcc" level="1"/>
+    <field field_ref="ra" level="1"/>
+    <field field_ref="npp_ipcc" level="1"/>
+    <field field_ref="rh" level="1"/>
+    <field field_ref="fFire" level="1"/>
+    <field field_ref="fHarvest" level="1"/>
+    <field field_ref="fLuc" level="1"/>
+    <field field_ref="nbp" level="1"/>
+    <field field_ref="fVegLitter" level="1"/>
+    <field field_ref="fLitterSoil" level="1"/>
+    <field field_ref="cLeaf" level="1"/>
+    <field field_ref="cWood" level="1"/>
+    <field field_ref="cRoot" level="1"/>
+    <field field_ref="cMisc" level="1"/>
+    <field field_ref="cLitterAbove" level="1"/>
+    <field field_ref="cLitterBelow" level="1"/>
+    <field field_ref="cSoilFast" level="1"/>
+    <field field_ref="cSoilMedium" level="1"/>
+    <field field_ref="cSoilSlow" level="1"/>
+    <field field_ref="landCoverFrac" level="1"/>
+    <field field_ref="treeFracPrimDec" level="1"/>
+    <field field_ref="treeFracPrimEver" level="1"/>
+    <field field_ref="c3PftFrac" level="1"/>
+    <field field_ref="c4PftFrac" level="1"/>
+    <field field_ref="rGrowth" level="1"/>
+    <field field_ref="rMaint" level="1"/>
+    <field field_ref="nppLeaf" level="1"/>
+    <field field_ref="nppWood" level="1"/>
+    <field field_ref="nppRoot" level="1"/>
+    <field field_ref="nep" level="1"/>
+  </file>
+</file_definition>
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/iodef_xios1.xml
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/iodef_xios1.xml	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/iodef_xios1.xml	(revision 5166)
@@ -0,0 +1,30 @@
+<?xml version="1.0"?>
+<!-- =========================================================================================================== -->
+<!-- iodef.xml : Main configuration file for production of output files using XIOS                               -->
+<!--             A seperatate file context_orchidee.xml contains all specifications for ORCHIDEE                 -->
+<!-- =========================================================================================================== -->
+
+<simulation>
+
+  <!-- =========================================================================================================== -->
+  <!-- XIOS context                                                                                                -->
+  <!-- =========================================================================================================== -->
+  <context id="xios">
+    <variable_definition>
+	  <variable id="buffer_size"               type="integer">10000000</variable>
+	  <variable id="buffer_server_factor_size" type="integer">2</variable>
+	  <variable id="info_level"                type="integer">1</variable>
+	  <variable id="using_server"              type="boolean">false</variable>
+	  <variable id="using_oasis"               type="boolean">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >LMDZ,oceanx</variable>
+      </variable_definition>
+
+  </context>
+
+  <!-- =========================================================================================================== -->
+  <!-- ORCHIDEE context                                                                                            -->
+  <!-- The file context_orchidee.xml is included here. This file needs to exist during run time.                   -->
+  <!-- =========================================================================================================== -->
+  <context id="orchidee" src="./context_orchidee.xml"/>
+
+</simulation>
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/iodef_xios2.xml
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/iodef_xios2.xml	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/src_xml/iodef_xios2.xml	(revision 5166)
@@ -0,0 +1,28 @@
+<?xml version="1.0"?>
+<!-- =========================================================================================================== -->
+<!-- iodef.xml : Main configuration file for production of output files using XIOS                               -->
+<!--             A seperatate file context_orchidee.xml contains all specifications for ORCHIDEE                 -->
+<!-- =========================================================================================================== -->
+
+<simulation>
+
+  <!-- =========================================================================================================== -->
+  <!-- XIOS context                                                                                                -->
+  <!-- =========================================================================================================== -->
+  <context id="xios">
+    <variable_definition>
+	  <variable id="info_level"                type="int">1</variable>
+	  <variable id="using_server"              type="bool">false</variable>
+	  <variable id="using_oasis"               type="bool">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >LMDZ,oceanx</variable>
+      </variable_definition>
+
+  </context>
+
+  <!-- =========================================================================================================== -->
+  <!-- ORCHIDEE context                                                                                            -->
+  <!-- The file context_orchidee.xml is included here. This file needs to exist during run time.                   -->
+  <!-- =========================================================================================================== -->
+  <context id="orchidee" src="./context_orchidee.xml"/>
+
+</simulation>
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/COPYRIGHT.txt
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/COPYRIGHT.txt	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/COPYRIGHT.txt	(revision 5166)
@@ -0,0 +1,109 @@
+!------------------------------------------------------------------------------!
+!              Flexible Configuration Management Software License              !
+!                                                                              !
+!     Please read this Software Licence as you will be bound by its terms      !
+!                           if you use the Software                            !
+!------------------------------------------------------------------------------!
+
+The Licensor:
+-------------
+
+The Met Office of FitzRoy Road, Exeter EX1 3PB, United Kingdom
+--------------------------------------------------------------------------------
+
+1. Licence.
+-----------
+
+The Met Office grants you a non-exclusive, royalty free; world-wide,
+transferable Licence to use, modify, copy and distribute the Flexible
+Configuration Management software ("the software") accompanying this License
+providing:
+
+a. you undertake to provide to the Met Office a copy of any modifications made
+   by you on the same terms contained within this licence agreement;
+
+b. modified files carry prominent notices stating that you changed the files
+   and the date of change;
+
+c. distribution of original or modified files is made free of charge under the
+   terms of this Licence;
+
+d. the appropriate copyright notices, the above copyright notice and a
+   disclaimer of warranty is included with the distribution.
+
+2. Ownership.
+-------------
+
+The Flexible Configuration Management software is Crown copyright and is
+reproduced with the permission of Met Office under delegated authority from
+the Controller of HMSO. The software and documentation are provided to you to
+allow you to exercise your rights under this License, which is granted to you.
+
+3. Duration.
+------------
+
+This license will remain in effect until terminated.
+ 
+4. Termination.
+---------------
+
+You may terminate this license at any time by removing all copies of the
+software from your system.  This License will terminate immediately without
+notice from us if you fail to comply with any of the provisions of this
+License or in the event of your breaching the terms of this licence you are
+given notice that the license has been terminated.  Upon termination you will
+delete all copies of the software and any related documentation.
+
+5. Disclaimer of Warranty.
+--------------------------
+
+a. THE MET OFFICE DISCLAIMS ALL WARRANTIES, REPRESENTATIONS AND PROMISES,
+   INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF SATISFACTORY QUALITY
+   AND FIT FOR THE PURPOSE.  NEITHER DOES THE MET OFFICE MAKE ANY
+   REPRESENTATIONS AS TO COMPATABILITY WITH YOUR OPERATING SYSTEMS AND
+   PLATFORMS.
+
+b. In no event does the Met Office warrant that the software or related
+   documentation will satisfy your requirements, that the software and
+   documentation will be without errors or defects or that the operation of
+   the software will be uninterrupted.
+
+c. IN NO EVENT WILL THE MET OFFICE BE LIABLE FOR ANY OTHER DAMAGES, INCLUDING
+   BUT NOT LIMITED TO DAMAGES FOR LOSS OF PROFITS DATA OR USE OF THE SOFTWARE
+   OR FOR ANY INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES, EVEN IF THE MET
+   OFFICE HAS BEEN SPECIFICALLY ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+6. General Provisions.
+----------------------
+
+a. You will not do anything, relating to this software that will bring the Met
+   Office into disrepute.
+
+b. You will not use the name of the Met Office or any other contributor to
+   endorse or promote any products derived from the software without the
+   written permission of the Met Office.
+
+7. Acknowledgements.
+--------------------
+
+The Fortran 9X Interface Generator found in file
+./src/lib/Ecmwf/Fortran90_stuff.pm is adapted from a script developed at ECMWF
+and is provided by kind permission of ECMWF under the same terms of this
+Licence.
+
+8. Entire Agreement.
+--------------------
+
+This License constitutes the entire agreement between us with respect to your
+rights or warranties for using the software and related documentation.  If any
+provision of this agreement is determined to be invalid or unenforceable the
+remaining provisions shall continue in full force.
+
+9. Governing Law.
+-----------------
+
+This Agreement is governed by and construed in accordance with the Laws of
+England.
+
+--------------------------------------------------------------------------------
+                                               © British Crown copyright 2006-7.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/LICENSE.html
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/LICENSE.html	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/LICENSE.html	(revision 5166)
@@ -0,0 +1,150 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+
+<html>
+<head>
+  <title>Flexible Configuration Management Software License</title>
+  <meta name="copyright" content="&copy; British Crown Copyright">
+  <style type="text/css">
+  <!--
+  body {
+    font: normal normal 10pt Arial, sans-serif;
+  }
+
+  h1 {
+    text-align: center;
+    text-decoration: underline;
+    font: normal bold 14pt Arial, sans-serif;
+  }
+
+  h2 {
+    text-align: left;
+    text-decoration: none;
+    font: normal normal 14pt Arial, sans-serif;
+  }
+
+  h3 {
+    text-align: left;
+    text-decoration: none;
+    font: normal bold 10pt Arial, sans-serif;
+  }
+
+  .copyright {
+    text-align: right;
+    font: normal bold 11pt Arial, sans-serif;
+  }
+
+  ol li {
+    list-style: lower-alpha;
+  }
+  //-->
+  </style>
+</head>
+
+<body>
+  <h1>Flexible Configuration Management Software License</h1>
+
+  <h1>Please read this Software Licence as you will be bound by its terms if
+  you use the Software</h1>
+
+  <h2>The Licensor:</h2>
+
+  <h2>The Met Office of FitzRoy Road, Exeter EX1 3PB, United Kingdom</h2>
+
+  <h3>1. Licence.</h3>
+
+  <p>The Met Office grants you a non-exclusive, royalty free; world-wide,
+  transferable Licence to use, modify, copy and distribute the Flexible
+  Configuration Management software ("the software") accompanying this License
+  providing:</p>
+
+  <ol>
+    <li>you undertake to provide to the Met Office a copy of any modifications
+    made by you on the same terms contained within this licence agreement;</li>
+
+    <li>modified files carry prominent notices stating that you changed the
+    files and the date of change;</li>
+
+    <li>distribution of original or modified files is made free of charge under
+    the terms of this Licence;</li>
+
+    <li>the appropriate copyright notices, the above copyright notice and a
+    disclaimer of warranty is included with the distribution.</li>
+  </ol>
+
+  <h3>2. Ownership.</h3>
+
+  <p>The Flexible Configuration Management software is Crown copyright and is
+  reproduced with the permission of Met Office under delegated authority from
+  the Controller of HMSO. The software and documentation are provided to you to
+  allow you to exercise your rights under this License, which is granted to
+  you.</p>
+
+  <h3>3. Duration.</h3>
+
+  <p>This license will remain in effect until terminated.</p>
+
+  <h3>4. Termination.</h3>
+
+  <p>You may terminate this license at any time by removing all copies of the
+  software from your system. This License will terminate immediately without
+  notice from us if you fail to comply with any of the provisions of this
+  License or in the event of your breaching the terms of this licence you are
+  given notice that the license has been terminated. Upon termination you will
+  delete all copies of the software and any related documentation.</p>
+
+  <h3>5. Disclaimer of Warranty.</h3>
+
+  <ol>
+    <li>THE MET OFFICE DISCLAIMS ALL WARRANTIES, REPRESENTATIONS AND PROMISES,
+    INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF SATISFACTORY QUALITY
+    AND FIT FOR THE PURPOSE. NEITHER DOES THE MET OFFICE MAKE ANY
+    REPRESENTATIONS AS TO COMPATABILITY WITH YOUR OPERATING SYSTEMS AND
+    PLATFORMS.</li>
+
+    <li>In no event does the Met Office warrant that the software or related
+    documentation will satisfy your requirements, that the software and
+    documentation will be without errors or defects or that the operation of
+    the software will be uninterrupted.</li>
+
+    <li>IN NO EVENT WILL THE MET OFFICE BE LIABLE FOR ANY OTHER DAMAGES,
+    INCLUDING BUT NOT LIMITED TO DAMAGES FOR LOSS OF PROFITS DATA OR USE OF THE
+    SOFTWARE OR FOR ANY INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES, EVEN IF
+    THE MET OFFICE HAS BEEN SPECIFICALLY ADVISED OF THE POSSIBILITY OF SUCH
+    DAMAGES.</li>
+  </ol>
+
+  <h3>6. General Provisions.</h3>
+
+  <ol>
+    <li>You will not do anything, relating to this software that will bring the
+    Met Office into disrepute.</li>
+
+    <li>You will not use the name of the Met Office or any other contributor to
+    endorse or promote any products derived from the software without the
+    written permission of the Met Office.</li>
+  </ol>
+
+  <h3>7. Acknowledgements.</h3>
+
+  <p>The Fortran 9X Interface Generator found in file
+  ./src/lib/Ecmwf/Fortran90_stuff.pm is adapted from a script developed at
+  ECMWF and is provided by kind permission of ECMWF under the same terms of
+  this Licence.</p>
+
+  <h3>8. Entire Agreement.</h3>
+
+  <p>This License constitutes the entire agreement between us with respect to
+  your rights or warranties for using the software and related documentation.
+  If any provision of this agreement is determined to be invalid or
+  unenforceable the remaining provisions shall continue in full force.</p>
+
+  <h3>9. Governing Law.</h3>
+
+  <p>This Agreement is governed by and construed in accordance with the Laws of
+  England.</p>
+
+  <div class="copyright">
+    <p>&copy; British Crown copyright 2006-7.</p>
+  </div>
+</body>
+</html>
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/README
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/README	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/README	(revision 5166)
@@ -0,0 +1,4 @@
+FCM release 1-2 created from revision 2131
+
+For further details please refer to the release notes
+which can be found in the directory doc/release_notes.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm	(revision 5166)
@@ -0,0 +1,794 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm
+#
+# SYNOPSIS
+#   fcm SUBCOMMAND [OPTIONS...] ARGS...
+#
+# DESCRIPTION
+#   The fcm command is the frontend of the FCM system. The first argument to the
+#   command must be a recognised subcommand. See "fcm help" for a full list of
+#   functionalities.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas:
+use warnings;
+use strict;
+
+# Standard modules:
+use File::Basename;
+use File::Spec;
+use Getopt::Long;
+use Cwd;
+
+# FCM component modules:
+use lib File::Spec->catfile (dirname (dirname ($0)), 'lib');
+use Fcm::Config;
+use Fcm::Extract;
+use Fcm::Build;
+use Fcm::Util;
+
+BEGIN {
+  eval {
+    require Fcm::Cm;
+    import Fcm::Cm;
+
+    require Fcm::CmUrl;
+    import Fcm::CmUrl;
+  }
+}
+
+# Function declaration:
+sub cmp_ext_cfg;
+sub invoke_build_system;
+sub invoke_extract_system;
+sub invoke_cfg_printer;
+sub invoke_cm_system;
+sub invoke_www_browser;
+sub invoke_help;
+
+# ------------------------------------------------------------------------------
+
+my $prog      = basename $0;
+my $year      = (localtime)[5] + 1900;
+my $copyright = <<EOF;
+
+(C) Crown copyright $year Met Office. All rights reserved.
+EOF
+
+# List of sub-commands recognised by FCM
+my %subcommand = (
+  HLP => [qw/help ? h/],
+  BLD => [qw/build bld/],
+  EXT => [qw/extract ext/],
+  CFG => [qw/cfg/],
+  GUI => [qw/gui/],
+  CM  => [qw/
+    branch    br
+    conflicts cf
+    add
+    blame     praise annotate ann
+    cat
+    checkout  co
+    cleanup
+    commit    ci
+    copy      cp
+    delete    del    remove   rm
+    diff      di
+    export
+    import
+    info
+    list      ls
+    lock
+    log
+    merge
+    mkdir
+    mkpatch
+    move      mv     rename   ren
+    propdel   pdel   pd
+    propedit  pedit  pe
+    propget   pget   pg
+    proplist  plist  pl
+    propset   pset   ps
+    resolved
+    revert
+    status    stat   st
+    switch    sw
+    unlock
+    update    up
+  /],
+  CMP => [qw/cmp-ext-cfg/],
+  WWW => [qw/www trac/],
+);
+
+# Get configuration settings
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# Determine the functionality of this invocation of the command
+my $function = @ARGV ? shift @ARGV : '';
+
+# Run command accordingly
+if (grep {$_ eq $function} @{ $subcommand{BLD} }) {
+  invoke_build_system;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{EXT} }) {
+  invoke_extract_system;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{CFG} }) {
+  invoke_cfg_printer;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{GUI} }) {
+  &run_command (['fcm_gui', @ARGV], METHOD => 'exec');
+
+} elsif (grep {$_ eq $function} @{ $subcommand{CM} }) {
+  invoke_cm_system;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{CMP} }) {
+  cmp_ext_cfg;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{WWW} }) {
+  invoke_www_browser;
+
+} elsif ($function =~ /^\s*$/ or grep {$_ eq $function} @{ $subcommand{HLP} }) {
+  invoke_help;
+
+} else {
+  w_report 'Unknown command: ', $function;
+  e_report 'Type "', $prog, ' help" for usage';
+}
+
+exit;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfg = &main::cfg ();
+#
+# DESCRIPTION
+#   Return the $config variable.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  return $config;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &cmp_ext_cfg ();
+#
+# DESCRIPTION
+#   Compare two similar extract configuration files.
+# ------------------------------------------------------------------------------
+
+sub cmp_ext_cfg {
+  # Check options
+  # ----------------------------------------------------------------------------
+  my ($wiki, $verbose);
+
+  GetOptions ('wiki|w=s' => \$wiki, 'verbose|v' => \$verbose);
+
+  # Check arguments
+  # ----------------------------------------------------------------------------
+  e_report $prog, ' ', $function,
+           ': 2 extract config files must be specified, abort.'
+    if @ARGV < 2;
+
+  # Invoke 2 new instances of the Fcm::Extract class
+  # ----------------------------------------------------------------------------
+  my (@cfg, $rc);
+  for my $i (0 .. 1) {
+    $cfg[$i] = Fcm::Extract->new (CFG_SRC => $ARGV[$i]);
+
+    # Read the extract configuration file
+    $rc = $cfg[$i]->decipher_cfg;
+    $rc = $cfg[$i]->expand_cfg if $rc;
+
+    last if not $rc;
+  }
+
+  # Throw error if command has failed
+  # ----------------------------------------------------------------------------
+  e_report $prog, ' ', $function,
+           ': cannot read extract configuration file, abort' if not $rc;
+
+  # Get list of URLs
+  # ----------------------------------------------------------------------------
+  my @urls = ();
+  for my $i (0 .. 1) {
+    # List of branches in each extract configuration file
+    my @branches = $cfg[$i]->branches;
+
+    for my $branch (@branches) {
+      # Ignore declarations of local directories
+      next if $branch->type eq 'user';
+
+      # List of SRC declarations in each branch
+      my %dirs = $branch->dirs;
+
+      for my $dir (values %dirs) {
+        # Set up a new instance of Fcm::CmUrl object for each SRC declaration
+        my $cm_url = Fcm::CmUrl->new (
+          URL => $dir . ($branch->version ? '@' . $branch->version : ''),
+        );
+
+        $urls[$i]{$cm_url->branch_url}{$dir} = $cm_url;
+      }
+    }
+  }
+
+  # Compare
+  # ----------------------------------------------------------------------------
+  my %log;
+  for my $i (0 .. 1) {
+    # Compare the first file with the second one and then vice versa
+    my $j = ($i == 0) ? 1 : 0;
+
+    for my $branch (sort keys %{ $urls[$i] }) {
+      if (exists $urls[$j]{$branch}) {
+        # Same REPOS declarations in both files
+        for my $dir (sort keys %{ $urls[$i]{$branch} }) {
+          if (exists $urls[$j]{$branch}{$dir}) {
+            # Same SRC declarations in both files, only need to compare once
+            next if $i == 1;
+
+            my $this_url = $urls[$i]{$branch}{$dir};
+            my $that_url = $urls[$j]{$branch}{$dir};
+
+            # Check whether their last changed revisions are the same
+            my $this_rev = $this_url->svninfo (FLAG => 'Last Changed Rev');
+            my $that_rev = $that_url->svninfo (FLAG => 'Last Changed Rev');
+
+            # Make sure last changed revisions differ
+            next if $this_rev eq $that_rev;
+
+            # Not interested in the log before the minimum revision
+            my $min_rev = ($this_url->pegrev > $that_url->pegrev)
+                          ? $that_url->pegrev : $this_url->pegrev;
+
+            $this_rev = $min_rev if $this_rev < $min_rev;
+            $that_rev = $min_rev if $that_rev < $min_rev;
+
+            # Get list of changed revisions using the commit log
+            my $u   = ($this_rev > $that_rev) ? $this_url : $that_url;
+            my %revs = $u->svnlog (REV => [$this_rev, $that_rev]);
+
+            for my $rev (keys %revs) {
+              # Check if revision is already in the list
+              next if exists $log{$branch}{$rev};
+
+              # Not interested in the minimum revision
+              next if $rev == $min_rev;
+
+              # Get list of changed paths. Accept this revision only if it
+              # contains changes in the current branch
+              my %paths  = %{ $revs{$rev}{paths} };
+
+              for my $path (keys %paths) {
+                my $change_url = Fcm::CmUrl->new (URL => $u->root . $path);
+
+                if ($change_url->branch eq $u->branch) {
+                  $log{$branch}{$rev} = $u;
+                  last;
+                }
+              }
+            }
+
+          } else {
+            # Report SRC declaration in one file but not in another
+            print $urls[$i]{$branch}{$dir}->url_peg, ':', "\n";
+            print '  in    : ', $ARGV[$i], "\n";
+            print '  not in: ', $ARGV[$j], "\n\n";
+          }
+        }
+
+      } else {
+        # Report REPOS declaration in one file but not in another
+        print $branch, ':', "\n";
+        print '  in    : ', $ARGV[$i], "\n";
+        print '  not in: ', $ARGV[$j], "\n\n";
+      }
+    }
+  }
+
+  # Report modifications
+  # ----------------------------------------------------------------------------
+  print 'Revisions at which declared source directories are modified:', "\n\n"
+    if keys %log;
+
+  if (defined $wiki) {
+    # Output in wiki format
+    my $wiki_url  = Fcm::CmUrl->new (URL => &expand_url_keyword (URL => $wiki));
+    my $base_trac = $wiki
+                    ? &get_browser_url (URL => $wiki_url->project_url)
+                    : $wiki_url;
+    $base_trac    = $wiki_url if not $base_trac;
+
+    for my $branch (sort keys %log) {
+      # Name of the branch
+      my $branch_trac = &get_browser_url (URL => $branch);
+      $branch_trac =~ s#^$base_trac(?:/*|$)#source:#;
+
+      print '[', $branch_trac, ']:', "\n";
+
+      # Revision table
+      for my $rev (sort {$b <=> $a} keys %{ $log{$branch} }) {
+        print $log{$branch}{$rev}->display_svnlog ($rev, $base_trac), "\n";
+      }
+
+      print "\n";
+    }
+
+  } else {
+    my $separator = '-' x 80 . "\n";
+
+    for my $branch (sort keys %log) {
+      # Output in plain text format
+      print $branch, ':', "\n";
+
+      if ($verbose or &cfg->verbose > 1) {
+        # Verbose mode, print revision log
+        for my $rev (sort {$b <=> $a} keys %{ $log{$branch} }) {
+          print $separator, $log{$branch}{$rev}->display_svnlog ($rev), "\n";
+        }
+
+      } else {
+        # Normal mode, print list of revisions
+        print join (' ', sort {$b <=> $a} keys %{ $log{$branch} }), "\n";
+      }
+
+      print $separator, "\n";
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_build_system ();
+#
+# DESCRIPTION
+#   Invoke the build system.
+# ------------------------------------------------------------------------------
+
+sub invoke_build_system {
+  my ($archive, $full, $ignore_lock, $jobs, $stage, @targets, $verbose);
+
+  GetOptions (
+    'archive|a'   => \$archive,     # switch on archive mode?
+    'full|f'      => \$full,        # full build?
+    'ignore-lock' => \$ignore_lock, # ignore lock file?
+    'jobs|j=i'    => \$jobs,        # number of parallel jobs in make
+    'stage|s=s'   => \$stage,       # build up to and including this stage
+    'targets|t=s' => \@targets,     # make targets
+    'verbose|v=i' => \$verbose,     # verbose level
+  );
+
+  # Verbose level
+  $config->verbose ($verbose) if defined $verbose;
+
+  # Invoke a new instance of the Fcm::Build class
+  my $bld = Fcm::Build->new (CFG_SRC  => @ARGV ? join (' ', @ARGV) : cwd ());
+
+  # Perform build
+  $bld->build (
+    ARCHIVE     => $archive,
+    FULL        => $full,
+    IGNORE_LOCK => $ignore_lock,
+    JOBS        => $jobs ? $jobs : 1,
+    STAGE       => $stage ? $stage : 5,
+    TARGETS     => (@targets ? [split (/:/, join (':', @targets))] : [qw/all/]),
+  );
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_extract_system ();
+#
+# DESCRIPTION
+#   Invoke the extract system.
+# ------------------------------------------------------------------------------
+
+sub invoke_extract_system {
+  my ($full, $ignore_lock, $verbose);
+
+  GetOptions (
+    'full|f'      => \$full,        # full extract?
+    'ignore-lock' => \$ignore_lock, # ignore lock file?
+    'verbose|v=i' => \$verbose,     # verbose level
+  );
+
+  $config->verbose ($verbose) if defined $verbose;
+
+  # Invoke a new instance of the Fcm::Extract class
+  my $ext = Fcm::Extract->new (CFG_SRC => @ARGV ? join (' ', @ARGV) : cwd ());
+
+  # Perform extract
+  $ext->extract (FULL => $full, IGNORE_LOCK => $ignore_lock);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_cfg_printer ();
+#
+# DESCRIPTION
+#   Invoke the CFG file pretty printer.
+# ------------------------------------------------------------------------------
+
+sub invoke_cfg_printer {
+
+  use Fcm::CfgFile;
+
+  my $out_file;
+  GetOptions (
+    'output|o=s'  => \$out_file,  # output file for print
+  );
+
+  my $file = join (' ', @ARGV);
+  e_report $prog, ' ', $function, ': file not specified, abort.' if ! $file;
+
+  # Invoke a new Fcm::CfgFile instance
+  my $cfg = Fcm::CfgFile->new (SRC => $file);
+
+  # Read the cfg file
+  my $read = $cfg->read_cfg;
+  e_report if not $read;
+
+  # Pretty print CFG file
+  $cfg->print_cfg ($out_file);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_cm_system ();
+#
+# DESCRIPTION
+#   Invoke a code management system command.
+# ------------------------------------------------------------------------------
+
+sub invoke_cm_system {
+
+  &cm_command ($function);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_www_browser ();
+#
+# DESCRIPTION
+#   Invoke a web browser on the specified PATH.
+# ------------------------------------------------------------------------------
+
+sub invoke_www_browser {
+
+  # Options
+  my ($browser);
+  GetOptions (
+    'browser|b=s' => \$browser, # browser command
+  );
+
+  $browser = &cfg->setting (qw/MISC WEB_BROWSER/) unless $browser;
+
+  # Arguments
+  my ($arg) = @ARGV ? $ARGV[0] : (&is_wc () ? '.' : '');
+  e_report $prog, ' ', $function,
+           ': input URL not specified and . not a working copy, abort.'
+    if not $arg;
+
+  # Local PATH?
+  $arg = &expand_tilde ($arg);
+  $arg = &get_url_of_wc ($arg) if -e $arg;
+
+  # Expand URL and revision keywords
+  my $www_url = &expand_url_keyword (URL => $arg);
+  my $rev     = 'HEAD';
+
+  if ($www_url =~ m#^(\w+://\S+)@(\S+)$#) {
+    $www_url = $1;
+    $rev     = $2;
+  }
+
+  $rev = &expand_rev_keyword (URL => $www_url, REV => $rev, HEAD => 1)
+    unless uc ($rev) eq 'HEAD';
+
+  # Get web browser URL
+  $www_url = &get_browser_url (URL => $www_url);
+  die 'WWW URL not defined for "', $arg, '", abort' unless $www_url;
+
+  $www_url = $www_url . '?rev=' . $rev;
+
+  # Execute command
+  my @command = (split (/\s+/, $browser), $www_url);
+  &run_command (\@command, METHOD => 'exec', PRINT => 1);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_help ();
+#
+# DESCRIPTION
+#   Invoke help.
+# ------------------------------------------------------------------------------
+
+sub invoke_help {
+
+  my $cmd = @ARGV ? shift @ARGV : undef;
+
+  if ($cmd) {
+    if (grep {$_ eq $cmd} @{ $subcommand{BLD} }) {
+      print <<EOF;
+$prog $cmd: invoke the build system.
+usage: $prog $cmd [OPTIONS...] [CFGFILE]
+
+  The path to a CFG file may be provided. Otherwise, the build system
+  searches the default locations for a bld cfg file.
+
+  If no option is specified, the options "-s 5 -t all -j 1 -v 1" are assumed.
+
+  If the option for full build is specified, the sub-directories created by
+  previous builds will be removed, so that the current build can start cleanly.
+
+  The -s option can be used to limit the actions performed by the build system
+  up to a named stage. The stages are:
+    "1", "s" or "setup"                - stage 1, setup
+    "2", "pp" or "pre_process"         - stage 2, pre-process
+    "3", "gd" or "generate_dependency" - stage 3, generate dependency
+    "4", "gi" or "generate_interface"  - stage 4, generate Fortran 9X interface
+    "5", "m", "make"                   - stage 5, make
+
+  If a colon separated list of targets is specified using the -t option, the
+  default targets specified in the configuration file will not be used.
+
+  If archive mode is switched on, build sub-directories that are only used
+  in the build process will be archived to TAR files. The default is off.
+
+  If specified, the verbose level must be an integer greater than 0. Verbose
+  level 0 is the quiet mode. Increasing the verbose level will increase the
+  amount of diagnostic output.
+
+  When a build is invoked, it sets up a lock file in the build root directory.
+  The lock is normally removed at the end of the build. While the lock file is
+  in place, othe build commands invoked in the same root directory will fail.
+  If you need to bypass this check for whatever reason, you can invoke the
+  build system with the --ignore-lock option.
+
+Valid options:
+  -a [--archive]     : archive build sub-directories?
+  -f [--full]        : full build
+  --ignore-lock      : ignore lock files in build root directory
+  -j [--jobs] arg    : number of parallel jobs that "make" can handle
+  -s [--stage] arg   : perform build up to a named stage
+  -t [--targets] arg : build a colon (:) separated list of targets
+  -v [--verbose] arg : verbose level
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{EXT} }) {
+      print <<EOF;
+$prog $cmd: invoke the extract system.
+usage: $prog $cmd [OPTIONS...] [CFGFILE]
+
+  The path to a CFG file may be provided. Otherwise, the extract system
+  searches the default locations for an ext cfg file.
+
+  If no option is specified, the system will attempt an incremental extract
+  where appropriate.
+
+  If specified, the verbose level must be an integer greater than 0. Verbose
+  level 0 is the quiet mode. Increasing the verbose level will increase the
+  amount of diagnostic output.
+
+  When an extract is invoked, it sets up a lock file in the extract destination
+  root directory. The lock is normally removed at the end of the extract. While
+  the lock file is in place, othe extract commands invoked in the same
+  destination root directory will fail. If you need to bypass this check for
+  whatever reason, you can invoke the extract system with the --ignore-lock
+  option.
+
+Valid options:
+  -f [--full]        : perform a full/clean extract
+  --ignore-lock      : ignore lock files in build root directory
+  -v [--verbose] arg : verbose level
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{CFG} }) {
+      print <<EOF;
+$prog $cmd: invoke the CFG file pretty printer.
+usage: $prog $cmd [OPTIONS...] FILE
+
+  If no option is specified, the output will be sent to standard output.
+
+Valid options:
+  -o [--output] arg : send output to a file as specified by arg.
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{GUI} }) {
+      print <<EOF;
+$prog $cmd: invoke the GUI wrapper for CM commands.
+usage: $prog $cmd DIR
+
+  The optional argument DIR modifies the initial working directory.
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{CM} }) {
+      @ARGV = qw(--help);
+      cm_command ($cmd);
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{CMP} }) {
+      print <<EOF;
+$prog $cmd: compare two similar extract configuration files.
+usage: $prog $cmd [OPTIONS...] CFG1 CFG2
+
+  Compares the extract configurations of two similar extract configuration
+  files CFG1 and CFG2.
+
+Valid options:
+  -v [--verbose]  : print revision tables in verbose mode. In particular,
+                    display the change log of each revision.
+  -w [--wiki] arg : print revision tables in wiki format. The argument to this
+                    option must be the Subversion URL or FCM URL keyword of a
+                    FCM project associated with the intended Trac system. This
+                    option overrides the -v option.
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{WWW} }) {
+      print <<EOF;
+$prog $cmd: invoke the web repository browser on a Subversion URL.
+usage: $prog $cmd [OPTIONS...] [PATH]
+
+  If PATH is specified, it must be a FCM URL keyword, a Subversion URL or the
+  PATH to a local working copy. If not specified, the current working directory
+  is assumed to be a working copy. If the --browser option is specified, the
+  specified web browser command is used to launch the repository browser.
+  Otherwise, it attempts to use the default browser from the configuration
+  setting.
+
+Valid options:
+  -b [--browser] arg : specify a command arg for the web browser.
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{HLP} }) {
+      print <<EOF;
+help (?, h): Describe the usage of $prog or its subcommands.
+usage: $prog help [SUBCOMMAND...]
+$copyright
+EOF
+
+      &run_command ([qw/svn help/, $cmd, @ARGV], PRINT => 1);
+
+    } else {
+      warn $prog, ' help: "', $cmd, '" not recognised';
+      $cmd = undef;
+    }
+  }
+
+  if (not $cmd) {
+    # Get output from "svn help"
+    my @lines = &run_command (
+      [qw/svn help/], DEVNULL => 1, METHOD => 'qx', ERROR => 'ignore',
+    );
+
+    # Get release number, (and revision number from revision number file)
+    my $release  = &cfg->setting ('RELEASE');
+    my $rev_file = &cfg->setting ('REV_FILE');
+
+    if (-r $rev_file) {
+      open FILE, '<', $rev_file;
+      my $rev = readline 'FILE';
+      close FILE;
+
+      chomp $rev;
+      $release .= '-dev (r' . $rev . ')' if $rev;
+    }
+
+    # Print common help
+    print <<EOF;
+usage: $prog <subcommand> [options] [args]
+Flexible configuration management system, release $release.
+Type "$prog help <subcommand>" for help on a specific subcommand.
+
+Available subcommands:
+  help       (h, ?) - help
+  build      (bld)  - build system
+EOF
+
+    # The following are only available on platforms with "svn" installed
+    if (@lines) {
+      print <<EOF;
+  branch     (br)   - cm system: branch info & creation
+  cfg               - CFG file pretty printer
+  cmp-ext-cfg       - compare two similar extract configuration files
+  conflicts  (cf)   - cm system: resolve conflicts
+  extract    (ext)  - extract system
+  mkpatch           - create patches from specified revisions of a URL
+  trac       (www)  - cm system: browse a path using the web browser
+  <SVN COMMANDS>    - any Subversion sub-commands
+EOF
+    }
+
+    # Print FCM copyright notice
+    print $copyright;
+
+    # Print output from "svn help"
+    if (@lines) {
+      print "\n";
+      &print_command ([qw/svn help/]);
+      print @lines;
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ans = &main::get_input (MESSAGE => $mesg, TYPE => $type, DEFAULT => $def);
+#
+# DESCRIPTION
+#   Get an input string from the user and return it as $ans. MESSAGE is the
+#   main message printed on screen to prompt the user for an input.  If TYPE is
+#   'YN', print message to prompt user to enter either 'y' or 'n'. If TYPE is
+#   'YNA', then 'a' is given as a third option. If DEFAULT is set, print message
+#   to inform user that the return value will be set to the $def (if nothing is
+#   entered).
+# ------------------------------------------------------------------------------
+
+sub get_input {
+  my %args = @_;
+  my $type  = exists $args{TYPE}    ? $args{TYPE}    : '';
+  my $mesg  = exists $args{MESSAGE} ? $args{MESSAGE} : '';
+  my $def   = exists $args{DEFAULT} ? $args{DEFAULT} : '';
+
+  my $ans;
+
+  while (1) {
+    # Print the prompt
+    print $mesg;
+    print "\n", 'Enter "y" or "n"' if uc ($type) eq 'YN';
+    print "\n", 'Enter "y", "n" or "a"' if uc ($type) eq 'YNA';
+    print ' (or just press <return> for "', $def, '")' if $def;
+    print ': ';
+
+    # Get answer from STDIN
+    $ans = <STDIN>;
+    chomp $ans;
+
+    # Set answer to default, if necessary
+    $ans = $def if ($def and not $ans);
+
+    if ($type =~ /^yna?$/i) {
+      # For YN and YNA type dialog boxes,
+      # check that the answer is in the correct form
+      my $pat = (uc ($type) eq 'YN' ? 'y|n' : 'y|n|a');
+      last if $ans =~ /^(?:$pat)/i;
+
+    } else {
+      last;
+    }
+  }
+
+  return $ans;
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_graphic_diff
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_graphic_diff	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_graphic_diff	(revision 5166)
@@ -0,0 +1,90 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_graphic_diff
+#
+# SYNOPSIS
+#   fcm_graphic_diff [-u] [-L OLD_DESC] [-L NEW_DESC] OLD NEW
+#
+# DESCRIPTION
+#   Wrapper script which invokes a graphical diff tool. Its interface is
+#   compatible with the "svn diff" command and can be used in combination with
+#   its "--diff-cmd" option. The command prints the OLD_DESC and NEW_DESC if
+#   they are both set. The two arguments OLD and NEW must be set and are the
+#   files to compare. The graphical diff tool invoked depends on the value of
+#   the FCM_GRAPHIC_DIFF environment variable. The command exits if the
+#   environment variable is not set.
+#
+# COPYRIGHT
+#   This program is part of the FCM system.
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas:
+use warnings;
+use strict;
+
+use Getopt::Long;
+
+# ------------------------------------------------------------------------------
+
+my ($u, @label);
+GetOptions ('u' => \$u, 'L=s' => \@label);
+
+# Check existence of files
+for my $i (0 .. 1) {
+  die $ARGV[$i], ': not found, abort' unless $ARGV[$i] and -f $ARGV[$i];
+}
+
+my ($old, $new) = @ARGV;
+
+if ($old =~ m#.svn/empty-file$#) {
+  print 'Skipping new file', "\n\n";
+
+} elsif ($new =~ m#.svn/empty-file$#) {
+  print 'Skipping deleted file', "\n\n";
+
+} elsif (-z $old) {
+  print 'Skipping as old file is empty (or does not exist)', "\n\n";
+
+} elsif (-z $new) {
+  print 'Skipping as new file is empty (or deleted)', "\n\n";
+
+} elsif (-B $new) {
+  print 'Skipping binary file', "\n\n";
+
+} else {
+  # Print descriptions of files
+  if (@label >= 2) {
+    print '--- ', $label[0], "\n", '+++ ', $label[1], "\n\n";
+  }
+
+  # FCM_GRAPHIC_DIFF is the graphical diff tool command
+  my $cmd = (exists $ENV{FCM_GRAPHIC_DIFF} ? $ENV{FCM_GRAPHIC_DIFF} : 'xxdiff');
+
+  if ($cmd) {
+    my @options = ();
+
+    # Set options for labels if appropriate
+    if (@label >= 2) {
+      if ($cmd eq 'tkdiff') {
+        # Use tkdiff
+        @options = ('-L', $label[0], '-L', $label[1]);
+
+      } elsif ($cmd eq 'xxdiff') {
+        # Use xxdiff
+        @options = ('--title1', $label[0], '--title2', $label[1]);
+      }
+    }
+
+    # Execute the command
+    my @command = ($cmd, @options, $old, $new);
+    exec (@command) or die 'Cannot execute: ', join (' ', @command);
+  }
+
+  exit;
+}
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_gui
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_gui	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_gui	(revision 5166)
@@ -0,0 +1,1321 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_gui
+#
+# SYNOPSIS
+#   fcm_gui [DIR]
+#
+# DESCRIPTION
+#   The fcm_gui command is a simple graphical user interface for some of the
+#   commands of the FCM system. The optional argument DIR modifies the initial
+#   working directory.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas
+use warnings;
+use strict;
+
+# Standard modules
+use File::Basename;
+use File::Spec::Functions;
+use Cwd;
+use Tk;
+use Tk::ROText;
+
+# FCM component modules:
+use lib catfile (dirname (dirname ($0)), 'lib');
+use Fcm::Config;
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+
+# Argument
+if (@ARGV) {
+  my $dir = shift @ARGV;
+  chdir $dir if -d $dir;
+}
+
+# Get configuration settings
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# ------------------------------------------------------------------------------
+
+# FCM subcommands
+my @subcmds = qw/CHECKOUT BRANCH STATUS DIFF ADD DELETE MERGE CONFLICTS COMMIT
+                 UPDATE SWITCH/;
+
+# Subcommands allowed when CWD is not a WC
+my @nwc_subcmds = qw/CHECKOUT BRANCH/;
+
+# Subcommands allowed, when CWD is a WC
+my @wc_subcmds = qw/STATUS BRANCH DIFF ADD DELETE MERGE CONFLICTS COMMIT UPDATE
+                    SWITCH/;
+
+# Subcommands that apply to WC only
+my @wco_subcmds = qw/BRANCH STATUS DIFF ADD DELETE MERGE CONFLICTS COMMIT UPDATE
+                     SWITCH/;
+
+# Subcommands that apply to top level WC only
+my @wcto_subcmds = qw/BRANCH MERGE COMMIT UPDATE SWITCH/;
+
+# Selected subcommand
+my $selsubcmd = '';
+
+# Selected subcommand is running?
+my $cmdrunning = 0;
+
+# PID of running subcommand
+my $cmdpid = undef;
+
+# List of subcommand frames
+my %subcmd_f;
+
+# List of subcommand buttons
+my %subcmd_b;
+
+# List of subcommand button help strings
+my %subcmd_help = (
+  BRANCH    => 'list information about, create or delete a branch.',
+  CHECKOUT  => 'check out a working copy from a repository.',
+  STATUS    => 'print the status of working copy files and directories.',
+  DIFF      => 'display the differences in modified files.',
+  ADD       => 'put files and directories under version control.',
+  DELETE    => 'remove files and directories from version control.',
+  MERGE     => 'merge changes into your working copy.',
+  CONFLICTS => 'use "xxdiff" to resolve any conflicts within your working copy.',
+  COMMIT    => 'send changes from your working copy to the repository.',
+  UPDATE    => 'bring changes from the repository into your working copy.',
+  SWITCH    => 'update your working copy to a different URL.',
+);
+
+for (keys %subcmd_help) {
+  $subcmd_help{$_} = 'Select the "' . lc ($_) . '" sub-command - ' .
+                     $subcmd_help{$_};
+}
+
+# List of subcommand button bindings (key name and underline position)
+my %subcmd_bind = (
+  BRANCH    => {KEY => '<Alt-Key-b>', U => 0},
+  CHECKOUT  => {KEY => '<Alt-Key-o>', U => 5},
+  STATUS    => {KEY => '<Alt-Key-s>', U => 0},
+  DIFF      => {KEY => '<Alt-Key-d>', U => 0},
+  ADD       => {KEY => '<Alt-Key-a>', U => 0},
+  DELETE    => {KEY => '<Alt-Key-t>', U => 4},
+  MERGE     => {KEY => '<Alt-Key-m>', U => 0},
+  CONFLICTS => {KEY => '<Alt-Key-f>', U => 3},
+  COMMIT    => {KEY => '<Alt-Key-c>', U => 0},
+  UPDATE    => {KEY => '<Alt-Key-u>', U => 0},
+  SWITCH    => {KEY => '<Alt-Key-w>', U => 1},
+);
+
+# List of subcommand variables
+my %subcmdvar = (
+  CWD       => cwd (),
+  WCT       => '',
+  CWD_URL   => '',
+  WCT_URL   => '',
+
+  BRANCH    => {
+    OPT     => 'info',
+    URL     => '',
+    NAME    => '',
+    TYPE    => 'DEV',
+    REVFLAG => 'NORMAL',
+    REV     => '',
+    TICKET  => '',
+    SRCTYPE => 'trunk',
+    S_CHD   => 0,
+    S_SIB   => 0,
+    S_OTH   => 0,
+    VERBOSE => 0,
+    OTHER   => '',
+  },
+
+  CHECKOUT  => {
+    URL     => '',
+    REV     => 'HEAD',
+    PATH    => '',
+    OTHER   => '',
+  },
+
+  STATUS    => {
+    USEWCT  => 0,
+    UPDATE  => 0,
+    VERBOSE => 0,
+    OTHER   => '',
+  },
+
+  DIFF      => {
+    USEWCT  => 0,
+    GRAPHIC => 1,
+    BRANCH  => 0,
+    URL     => '',
+    OTHER   => '',
+  },
+
+  ADD       => {
+    USEWCT  => 0,
+    CHECK   => 1,
+    OTHER   => '',
+  },
+
+  DELETE    => {
+    USEWCT  => 0,
+    CHECK   => 1,
+    OTHER   => '',
+  },
+
+  MERGE     => {
+    USEWCT  => 1,
+    SRC     => '',
+    MODE    => 'automatic',
+    DRYRUN  => 0,
+    VERBOSE => 0,
+    REV     => '',
+    OTHER   => '',
+  },
+
+  CONFLICTS => {
+    USEWCT  => 0,
+    OTHER   => '',
+  },
+
+  COMMIT    => {
+    USEWCT  => 1,
+    DRYRUN  => 0,
+    OTHER   => '',
+  },
+
+  UPDATE    => {
+    USEWCT  => 1,
+    OTHER   => '',
+  },
+
+  SWITCH    => {
+    USEWCT  => 1,
+    URL     => '',
+    OTHER   => '',
+  },
+);
+
+# List of action buttons
+my %action_b;
+
+# List of action button help strings
+my %action_help = (
+  QUIT  => 'Quit fcm gui',
+  HELP  => 'Print help to the output text box for the selected sub-command',
+  CLEAR => 'Clear the output text box',
+  RUN   => 'Run the selected sub-command',
+);
+
+# List of action button bindings
+my %action_bind = (
+  QUIT  => {KEY => '<Control-Key-q>', U => undef},
+  HELP  => {KEY => '<F1>'           , U => undef},
+  CLEAR => {KEY => '<Alt-Key-l>'    , U => 1},
+  RUN   => {KEY => '<Alt-Key-r>'    , U => 0},
+);
+
+# List of branch subcommand options
+my %branch_opt = (
+  INFO   => undef,
+  CREATE => undef,
+  DELETE => undef,
+  LIST   => undef,
+);
+
+# List of branch create types
+my %branch_type = (
+  'DEV'         => undef,
+  'DEV::SHARE'  => undef,
+  'TEST'        => undef,
+  'TEST::SHARE' => undef,
+  'PKG'         => undef,
+  'PKG::SHARE'  => undef,
+  'PKG::CONFIG' => undef,
+  'PKG::REL'    => undef,
+);
+
+# List of branch create source type
+my %branch_srctype = (
+  TRUNK  => undef,
+  BRANCH => undef,
+);
+
+# List of branch create revision prefix option
+my %branch_revflag = (
+  NORMAL => undef,
+  NUMBER => undef,
+  NONE   => undef,
+);
+
+# List of branch info/delete options
+my %branch_info_opt = (
+  S_CHD   => 'Show children',
+  S_SIB   => 'Show siblings',
+  S_OTH   => 'Show other',
+  VERBOSE => 'Print extra information',
+);
+
+# Text in the status bar
+my $statustext = '';
+
+# ------------------------------------------------------------------------------
+
+my $mw = MainWindow->new ();
+
+my $mw_title = 'FCM GUI';
+$mw->title ($mw_title);
+
+# Frame containing subcommand selection buttons
+my $top_f = $mw->Frame ()->grid (
+  '-row'    => 0,
+  '-column' => 0,
+  '-sticky' => 'w',
+);
+
+# Frame containing subcommand options
+my $mid_f = $mw->Frame ()->grid (
+  '-row'    => 1,
+  '-column' => 0,
+  '-sticky' => 'ew',
+);
+
+# Frame containing action buttons
+my $bot_f = $mw->Frame ()->grid (
+  '-row'    => 2,
+  '-column' => 0,
+  '-sticky' => 'ew',
+);
+
+# Text box to display output
+my $out_t  = $mw->Scrolled ('ROText', '-scrollbars' => 'osow')->grid (
+  '-row'    => 3,
+  '-column' => 0,
+  '-sticky' => 'news',
+);
+
+# Text box - allow scroll with mouse wheel
+$out_t->bind (
+  '<4>' => sub {
+    $_[0]->yview ('scroll', -1, 'units') unless $Tk::strictMotif;
+  },
+);
+
+$out_t->bind (
+  '<5>' => sub {
+    $_[0]->yview ('scroll', +1, 'units') unless $Tk::strictMotif;
+  },
+);
+
+# Status bar
+$mw->Label (
+  '-textvariable' => \$statustext,
+  '-relief'       => 'groove',
+)->grid (
+  '-row'    => 4,
+  '-column' => 0,
+  '-sticky' => 'ews',
+);
+
+# Main window grid configure
+{
+  my ($cols, $rows) = $mw->gridSize ();
+  $mw->gridColumnconfigure ($_, '-weight' => 1) for (0 .. $cols - 1);
+  $mw->gridRowconfigure    ( 3, '-weight' => 1);
+}
+
+# Frame grid configure
+{
+  my ($cols, $rows) = $mid_f->gridSize ();
+  $bot_f->gridColumnconfigure (3, '-weight' => 1);
+}
+
+$mid_f->gridRowconfigure    (0, '-weight' => 1);
+$mid_f->gridColumnconfigure (0, '-weight' => 1);
+
+# ------------------------------------------------------------------------------
+
+# Buttons to select subcommands
+{
+  my $col = 0;
+  for my $name (@subcmds) {
+    $subcmd_b{$name} = $top_f->Button (
+      '-text'    => uc (substr ($name, 0, 1)) . lc (substr ($name, 1)),
+      '-command' => [\&button_clicked, $name],
+      '-width'   => 8,
+    )->grid (
+      '-row'    => 0,
+      '-column' => $col++,
+      '-sticky' => 'w',
+    );
+
+    $subcmd_b{$name}->bind ('<Enter>', sub {$statustext = $subcmd_help{$name}});
+    $subcmd_b{$name}->bind ('<Leave>', sub {$statustext = ''});
+
+    $subcmd_b{$name}->configure ('-underline' => $subcmd_bind{$name}{U})
+      if defined $subcmd_bind{$name}{U};
+
+    $mw->bind ($subcmd_bind{$name}{KEY}, sub {$subcmd_b{$name}->invoke});
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+# Frames to contain subcommands options
+{
+  my %row = ();
+
+  for my $name (@subcmds) {
+    $subcmd_f{$name} = $mid_f->Frame ();
+    $subcmd_f{$name}->gridColumnconfigure (1, '-weight' => 1);
+
+    $row{$name} = 0;
+
+    # Widgets common to all sub-commands
+    $subcmd_f{$name}->Label ('-text' => 'Current working directory: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Label ('-textvariable' => \($subcmdvar{CWD}))->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'w',
+    );
+  }
+
+  # Widgets common to all sub-commands that apply to working copies
+  for my $name (@wco_subcmds) {
+    my @labtxts = (
+      'Corresponding URL: ',
+      'Working copy top: ',
+      'Corresponding URL: ',
+    );
+    my @varrefs = \(
+      $subcmdvar{URL_CWD},
+      $subcmdvar{WCT},
+      $subcmdvar{URL_WCT},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Label ('-text' => $labtxts[$i])->grid (
+        '-row'    => $row{$name},
+        '-column' => 0,
+        '-sticky' => 'w',
+      );
+      $subcmd_f{$name}->Label ('-textvariable' => $varrefs[$i])->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+    }
+
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Apply sub-command to working copy top',
+      '-variable' => \($subcmdvar{$name}{USEWCT}),
+      '-state'    => (grep ({$_ eq $name} @wcto_subcmds) ? 'disabled' : 'normal'),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Branch sub-command
+  {
+    my $name = 'BRANCH';
+
+    # Radio buttons to select the sub-option of the branch sub-command
+    my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    my $col = 0;
+    for my $key (sort keys %branch_opt) {
+      my $opt = lc $key;
+
+      $branch_opt{$key} = $opt_f->Radiobutton (
+        '-text'     => $opt,
+        '-value'    => $opt,
+        '-variable' => \($subcmdvar{$name}{OPT}),
+        '-state'    => 'normal',
+      )->grid (
+        '-row'      => 0,
+        '-column'   => $col++,
+        '-sticky'   => 'w',
+      );
+    }
+
+    # Label and entry box for specifying URL
+    $subcmd_f{$name}->Label ('-text' => 'URL: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry box for specifying create branch name
+    $subcmd_f{$name}->Label (
+      '-text' => 'Branch name (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{NAME}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry box for specifying create branch source revision
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source revision (create/list only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{REV}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and radio buttons box for specifying create branch type
+    $subcmd_f{$name}->Label (
+      '-text' => 'Branch type (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_type) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{TYPE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and radio buttons box for specifying create source type
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source type (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_srctype) {
+        my $txt = lc $key;
+        my $opt = lc $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{SRCTYPE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and radio buttons box for specifying create prefix option
+    $subcmd_f{$name}->Label (
+      '-text' => 'Prefix option (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_revflag) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{REVFLAG}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and entry box for specifying ticket number
+    $subcmd_f{$name}->Label (
+      '-text' => 'Related Trac ticket(s) (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{TICKET}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Check button for info/delete
+    # --show-children, --show-siblings, --show-other, --verbose
+    $subcmd_f{$name}->Label (
+      '-text' => 'Options for info/delete only: ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+
+      for my $key (sort keys %branch_info_opt) {
+        $opt_f->Checkbutton (
+          '-text'     => $branch_info_opt{$key},
+          '-variable' => \($subcmdvar{$name}{$key}),
+        )->grid (
+          '-row'    => 0,
+          '-column' => $col++,
+          '-sticky' => 'w',
+        );
+      }
+    }
+  }
+
+  # Widget for the Checkout sub-command
+  {
+    my $name = 'CHECKOUT';
+
+    # Label and entry boxes for specifying URL and revision
+    my @labtxts = (
+      'URL: ',
+      'Revision: ',
+      'Path: ',
+    );
+    my @varrefs = \(
+      $subcmdvar{$name}{URL},
+      $subcmdvar{$name}{REV},
+      $subcmdvar{$name}{PATH},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Label ('-text' => $labtxts[$i])->grid (
+        '-row'    => $row{$name},
+        '-column' => 0,
+        '-sticky' => 'w',
+      );
+      $subcmd_f{$name}->Entry (
+        '-textvariable' => $varrefs[$i],
+      )->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'ew',
+      );
+    }
+  }
+
+  # Widget for the Status sub-command
+  {
+    my $name = 'STATUS';
+
+    # Checkbuttons for various options
+    my @labtxts = (
+      'Display update information',
+      'Print extra information',
+    );
+    my @varrefs = \(
+      $subcmdvar{$name}{UPDATE},
+      $subcmdvar{$name}{VERBOSE},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Checkbutton (
+        '-text'     => $labtxts[$i],
+        '-variable' => $varrefs[$i],
+      )->grid (
+        '-row'        => $row{$name}++,
+        '-column'     => 0,
+        '-columnspan' => 2,
+        '-sticky'     => 'w',
+      );
+    }
+  }
+
+  # Widget for the Diff sub-command
+  {
+    my $name = 'DIFF';
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Use xxdiff to display differences',
+      '-variable' => \($subcmdvar{$name}{GRAPHIC}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    my $entry;
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Show differences relative to the base of the branch',
+      '-variable' => \($subcmdvar{$name}{BRANCH}),
+      '-command'  => sub {
+        $entry->configure (
+          '-state' => ($subcmdvar{$name}{BRANCH} ? 'normal' : 'disabled'),
+        );
+      },
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    $subcmd_f{$name}->Label ('-text' => 'Branch URL')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    $entry = $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+      '-state'        => ($subcmdvar{$name}{BRANCH} ? 'normal' : 'disabled'),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widget for the Add/Delete sub-command
+  for my $name (qw/ADD DELETE/) {
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Check for files or directories not under version control',
+      '-variable' => \($subcmdvar{$name}{CHECK}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Merge sub-command
+  {
+    my $name = 'MERGE';
+
+    # Label and radio buttons box for specifying merge mode
+    $subcmd_f{$name}->Label (
+      '-text' => 'Mode: ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (qw/automatic custom reverse/) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{MODE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Check buttons for dry-run
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Dry run',
+      '-variable' => \($subcmdvar{$name}{DRYRUN}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    # Check buttons for verbose mode
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Print extra information',
+      '-variable' => \($subcmdvar{$name}{VERBOSE}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    # Label and entry boxes for specifying merge source
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source (automatic/custom only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{SRC}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry boxes for specifying merge revision (range)
+    $subcmd_f{$name}->Label (
+      '-text' => 'Revision (custom/reverse only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{REV}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widget for the Commit sub-command
+  {
+    my $name = 'COMMIT';
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Dry run',
+      '-variable' => \($subcmdvar{$name}{DRYRUN}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Switch sub-command
+  {
+    my $name = 'SWITCH';
+
+    # Label and entry boxes for specifying switch URL
+    $subcmd_f{$name}->Label ('-text' => 'URL: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widgets common to all sub-commands
+  for my $name (@subcmds) {
+    $subcmd_f{$name}->Label ('-text' => 'Other options: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{OTHER}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+# Buttons to perform main actions
+{
+  my $col = 0;
+  for my $name (qw/QUIT HELP CLEAR RUN/) {
+    $action_b{$name} = $bot_f->Button (
+      '-text'    => uc (substr ($name, 0, 1)) . lc (substr ($name, 1)),
+      '-command' => [\&button_clicked, $name],
+      '-width'   => 8,
+    )->grid (
+      '-row'    => 0,
+      '-column' => $col++,
+      '-sticky' => ($name eq 'RUN' ? 'ew' : 'w'),
+    );
+
+    $action_b{$name}->bind ('<Enter>', sub {$statustext = $action_help{$name}});
+    $action_b{$name}->bind ('<Leave>', sub {$statustext = ''});
+
+    $action_b{$name}->configure ('-underline' => $action_bind{$name}{U})
+      if defined $action_bind{$name}{U};
+
+    $mw->bind ($action_bind{$name}{KEY}, sub {$action_b{$name}->invoke});
+  }
+}
+
+&change_cwd ($subcmdvar{CWD});
+
+# ------------------------------------------------------------------------------
+
+# Handle the situation when the user attempts to quit the window while a
+# sub-command is running
+
+$mw->protocol ('WM_DELETE_WINDOW', sub {
+  if (defined $cmdpid) {
+    my $ans = $mw->messageBox (
+      '-title'   => $mw_title,
+      '-message' => $selsubcmd . ' is still running. Really quit?',
+      '-type'    => 'YesNo',
+      '-default' => 'No',
+    );
+
+    if ($ans eq 'Yes') {
+      kill 9, $cmdpid; # Need to kill the sub-process before quitting
+
+    } else {
+      return; # Do not quit
+    }
+  }
+
+  exit;
+});
+
+MainLoop;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfg = &main::cfg ();
+#
+# DESCRIPTION
+#   Return the $config variable.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  return $config;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &change_cwd ($dir);
+#
+# DESCRIPTION
+#   Change current working directory to $dir
+# ------------------------------------------------------------------------------
+
+sub change_cwd {
+  my $dir = $_[0];
+  my @allowed_subcmds = (&is_wc ($dir) ? @wc_subcmds : @nwc_subcmds);
+
+  for my $subcmd (@subcmds) {
+    if (grep {$_ eq $subcmd} @allowed_subcmds) {
+      $subcmd_b{$subcmd}->configure ('-state' => 'normal');
+
+    } else {
+      $subcmd_b{$subcmd}->configure ('-state' => 'disabled');
+    }
+  }
+
+  &display_subcmd_frame ($allowed_subcmds[0])
+    if not grep {$_ eq $selsubcmd} @allowed_subcmds;
+
+  chdir $dir;
+  $subcmdvar{CWD} = $dir;
+
+  if (&is_wc ($dir)) {
+    $subcmdvar{WCT}     = &get_wct ($dir);
+    $subcmdvar{URL_CWD} = &get_url_of_wc ($dir);
+    $subcmdvar{URL_WCT} = &get_url_of_wc ($subcmdvar{WCT});
+
+    $branch_opt{INFO}  ->configure ('-state' => 'normal');
+    $branch_opt{DELETE}->configure ('-state' => 'normal');
+    $subcmdvar{BRANCH}{OPT} = 'info';
+
+  } else {
+    $branch_opt{INFO}  ->configure ('-state' => 'disabled');
+    $branch_opt{DELETE}->configure ('-state' => 'disabled');
+    $subcmdvar{BRANCH}{OPT} = 'create';
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &button_clicked ($name);
+#
+# DESCRIPTION
+#   Call back function to handle a click on a command button named $name.
+# ------------------------------------------------------------------------------
+
+sub button_clicked {
+  my $name = $_[0];
+
+  if (grep {$_ eq $name} keys %subcmd_b) {
+    &display_subcmd_frame ($name);
+
+  } elsif ($name eq 'CLEAR') {
+    $out_t->delete ('1.0', 'end');
+
+  } elsif ($name eq 'QUIT') {
+    exit;
+
+  } elsif ($name eq 'HELP') {
+    &invoke_cmd ('help ' . lc ($selsubcmd));
+
+  } elsif ($name eq 'RUN') {
+    &invoke_cmd (&setup_cmd ($selsubcmd));
+
+  } else {
+    $out_t->insert ('end', $name . ': function to be implemented' . "\n");
+    $out_t->yviewMoveto (1);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &display_subcmd_frame ($name);
+#
+# DESCRIPTION
+#   Change selected subcommand to $name, and display the frame containing the
+#   widgets for configuring the options and arguments of that subcommand.
+# ------------------------------------------------------------------------------
+
+sub display_subcmd_frame {
+  my $name = $_[0];
+
+  if ($selsubcmd ne $name and not $cmdrunning) {
+    $subcmd_b{$name     }->configure ('-relief' => 'sunken');
+    $subcmd_b{$selsubcmd}->configure ('-relief' => 'raised') if $selsubcmd;
+
+    $subcmd_f{$name     }->grid ('-sticky' => 'new');
+    $subcmd_f{$selsubcmd}->gridForget if $selsubcmd;
+
+    $selsubcmd = $name;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $pos = &get_wm_pos ();
+#
+# DESCRIPTION
+#   Returns the position part of the geometry string of the main window.
+# ------------------------------------------------------------------------------
+
+sub get_wm_pos {
+  my $geometry = $mw->geometry ();
+  $geometry =~ /^=?(?:\d+x\d+)?([+-]\d+[+-]\d+)$/;
+  return $1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $command = &setup_cmd ($name);
+#
+# DESCRIPTION
+#   Setup the the system command for the sub-command $name.
+# ------------------------------------------------------------------------------
+
+sub setup_cmd {
+  my $name = $_[0];
+  my $cmd  = '';
+
+  if ($name eq 'BRANCH') {
+    $cmd .= lc ($name);
+    if ($subcmdvar{$name}{OPT} eq 'create') {
+      $cmd .= ' -c --svn-non-interactive';
+      $cmd .= ' -n '     . $subcmdvar{$name}{NAME} if $subcmdvar{$name}{NAME};
+      $cmd .= ' -t '     . $subcmdvar{$name}{TYPE};
+      $cmd .= ' --rev-flag ' . $subcmdvar{$name}{REVFLAG};
+      $cmd .= ' -r ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+      $cmd .= ' -k ' . $subcmdvar{$name}{TICKET} if $subcmdvar{$name}{TICKET};
+      $cmd .= ' --branch-of-branch ' if $subcmdvar{$name}{SRCTYPE} eq 'branch';
+
+    } elsif ($subcmdvar{$name}{OPT} eq 'delete') {
+      $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+      $cmd .= ' -d --svn-non-interactive';
+
+    } elsif ($subcmdvar{$name}{OPT} eq 'list') {
+      $cmd .= ' -l';
+      $cmd .= ' -r ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+
+    } else {
+      $cmd .= ' -i';
+      $cmd .= ' --show-children' if $subcmdvar{$name}{S_CHD};
+      $cmd .= ' --show-siblings' if $subcmdvar{$name}{S_SIB};
+      $cmd .= ' --show-other'    if $subcmdvar{$name}{S_OTH};
+      $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+    }
+    $cmd .= ' ' . $subcmdvar{$name}{URL}   if $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'CHECKOUT') {
+    $cmd .= lc ($name);
+    $cmd .= ' -r' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+    $cmd .= ' ' . $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{PATH} if $subcmdvar{$name}{PATH};
+
+  } elsif ($name eq 'STATUS') {
+    $cmd .= lc ($name);
+    $cmd .= ' -u' if $subcmdvar{$name}{UPDATE};
+    $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'DIFF') {
+    $cmd .= lc ($name);
+    $cmd .= ' -g' if $subcmdvar{$name}{GRAPHIC};
+
+    if ($subcmdvar{$name}{BRANCH}) {
+      $cmd .= ' -b';
+      $cmd .= ' ' . $subcmdvar{$name}{URL} if $subcmdvar{$name}{URL};
+    }
+
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'ADD' or $name eq 'DELETE') {
+    $cmd .= lc ($name);
+    $cmd .= ' -c' if $subcmdvar{$name}{CHECK};
+    $cmd .= ' --non-interactive'
+      if $name eq 'DELETE' and not $subcmdvar{$name}{CHECK};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'MERGE') {
+    $cmd .= lc ($name);
+
+    if ($subcmdvar{$name}{MODE} ne 'automatic') {
+      $cmd .= ' --' . $subcmdvar{$name}{MODE};
+      $cmd .= ' --revision ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+    }
+
+    $cmd .= ' --dry-run' if $subcmdvar{$name}{DRYRUN};
+    $cmd .= ' -v'        if $subcmdvar{$name}{VERBOSE};
+    $cmd .= ' ' . $subcmdvar{$name}{SRC}   if $subcmdvar{$name}{SRC};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'CONFLICTS') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'COMMIT') {
+    $cmd .= lc ($name);
+    $cmd .= ' --dry-run' if $subcmdvar{$name}{DRYRUN};
+    $cmd .= ' --svn-non-interactive';
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'SWITCH') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{URL}   if $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'UPDATE') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  }
+
+  return $cmd;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_cmd ($cmd);
+#
+# DESCRIPTION
+#   Invoke the command $cmd.
+# ------------------------------------------------------------------------------
+
+sub invoke_cmd {
+  my $cmd      = $_[0];
+  return unless $cmd;
+
+  my $disp_cmd = 'fcm ' . $cmd;
+  $cmd         = (index ($cmd, 'help ') == 0)
+                 ? $disp_cmd
+                 : ('fcm_gui_internal ' . &get_wm_pos () . ' ' . $cmd);
+
+  # Change directory to working copy top if necessary
+  if ($subcmdvar{$selsubcmd}{USEWCT} and $subcmdvar{WCT} ne $subcmdvar{CWD}) {
+    chdir $subcmdvar{WCT};
+    $out_t->insert ('end', 'cd ' . $subcmdvar{WCT} . "\n");
+    $out_t->yviewMoveto (1);
+  }
+
+  # Report start of command
+  $out_t->insert ('end', timestamp_command ($disp_cmd, 'Start'));
+  $out_t->yviewMoveto (1);
+
+  # Open the command as a pipe
+  if ($cmdpid = open CMD, '-|', $cmd . ' 2>&1') {
+    # Disable all action buttons
+    $action_b{$_}->configure ('-state' => 'disabled') for (keys %action_b);
+    $cmdrunning = 1;
+
+    # Set up a file event to read output from the command
+    $mw->fileevent (\*CMD, readable => sub {
+      if (sysread CMD, my ($buf), 1024) {
+        # Insert text into the output text box as it becomes available
+        $out_t->insert ('end', $buf);
+        $out_t->yviewMoveto (1);
+
+      } else {
+        # Delete the file event and close the file when the command finishes
+        $mw->fileevent(\*CMD, readable => '');
+        close CMD;
+        $cmdpid = undef;
+
+        # Check return status
+        if ($?) {
+          $out_t->insert (
+            'end', '"' . $disp_cmd . '" failed (' . $? . ')' . "\n",
+          );
+          $out_t->yviewMoveto (1);
+        }
+
+        # Report end of command
+        $out_t->insert ('end', timestamp_command ($disp_cmd, 'End'));
+        $out_t->yviewMoveto (1);
+
+        # Change back to CWD if necessary
+        if ($subcmdvar{$selsubcmd}{USEWCT} and
+            $subcmdvar{WCT} ne $subcmdvar{CWD}) {
+          chdir $subcmdvar{CWD};
+          $out_t->insert ('end', 'cd ' . $subcmdvar{CWD} . "\n");
+          $out_t->yviewMoveto (1);
+        }
+
+        # Enable all action buttons again
+        $action_b{$_}->configure ('-state' => 'normal') for (keys %action_b);
+        $cmdrunning = 0;
+
+        # If the command is "checkout", change directory to working copy
+        if (lc ($selsubcmd) eq 'checkout') {
+          my $url = expand_url_keyword (URL => $subcmdvar{CHECKOUT}{URL});
+          my $dir = $subcmdvar{CHECKOUT}{PATH}
+                  ? $subcmdvar{CHECKOUT}{PATH}
+                  : basename $url;
+          $dir    = File::Spec->rel2abs ($dir);
+          &change_cwd ($dir);
+
+        # If the command is "switch", change URL
+        } elsif (lc ($selsubcmd) eq 'switch') {
+          $subcmdvar{URL_CWD} = &get_url_of_wc ($subcmdvar{CWD}, 1);
+          $subcmdvar{URL_WCT} = &get_url_of_wc ($subcmdvar{WCT}, 1);
+        }
+      }
+      1;
+    });
+
+  } else {
+    $mw->messageBox (
+      '-title'   => 'Error',
+      '-message' => 'Error running "' . $cmd . '"',
+      '-icon'    => 'error',
+    );
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_gui_internal
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_gui_internal	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_gui_internal	(revision 5166)
@@ -0,0 +1,272 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_gui_internal
+#
+# SYNOPSIS
+#   fcm_gui_internal POS FUNCTION
+#
+# DESCRIPTION
+#   The fcm_gui_internal command is part of a simple graphical user interface
+#   for some of the commands of the FCM system. The argument POS is a geometry
+#   string used by the &Main::get_input method to determine the location of the
+#   pop up window. The argument FUNCTION must be a keyword recognised by the
+#   &Fcm::Cm::cm_command function.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas
+use warnings;
+use strict;
+
+# Standard modules
+use Tk;
+use File::Basename;
+use File::Spec::Functions;
+
+# FCM component modules:
+use lib catfile (dirname (dirname ($0)), 'lib');
+use Fcm::Cm;
+use Fcm::Config;
+
+# ------------------------------------------------------------------------------
+
+# Get configuration settings
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+my $pos      = shift @ARGV;
+my $function = shift @ARGV;
+cm_command $function;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfg = &main::cfg ();
+#
+# DESCRIPTION
+#   Return the $config variable.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  return $config;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ans = &main::get_input (
+#     TITLE   => $title,
+#     MESSAGE => $mesg,
+#     TYPE    => $type,
+#     DEFAULT => $def,
+#   );
+#
+# DESCRIPTION
+#   Get an input string from the user and return it as $ans. If TYPE is 'YN', a
+#   'YesNo' type message box will be displayed to prompt the user to click
+#   either the 'yes' or 'no' button. If TYPE is 'YNA', then an 'all' button is
+#   provided as a third option. Otherwise, a dialog box with an entry box for
+#   the user to type in a string will be displayed. TITLE is the title of the
+#   dialog box, and MESSAGE is the main message of the dialog box. If DEFAULT is
+#   set, $ans is set to the default value when the dialog box is invoked.
+# ------------------------------------------------------------------------------
+
+sub get_input {
+  my %args  = @_;
+  my $title = exists $args{TITLE}   ? $args{TITLE}   : '';
+  my $mesg  = exists $args{MESSAGE} ? $args{MESSAGE} : '';
+  my $type  = exists $args{TYPE}    ? $args{TYPE}    : '';
+  my $def   = exists $args{DEFAULT} ? $args{DEFAULT} : '';
+  my $ans   = '';
+
+  # Create a main window
+  my $mw = MainWindow->new;
+  $mw->title ($title);
+
+  # Define the default which applies if the dialog box is just closed or
+  # the user selects 'cancel'
+  $ans = $def ? $def : '';
+
+  if ($type =~ /^yn/i) {
+    # Create a yes-no(-all) dialog box
+
+    # If TYPE is YNA then add a third button: 'all'
+    my $buttons;
+    if ($type =~ /a$/i) {
+      $buttons = 3;
+
+    } else {
+      $buttons = 2;
+    }
+
+    # Message of the dialog box
+    $mw->Label ('-text' => $mesg)->grid (
+      '-row'        => 0,
+      '-column'     => 0,
+      '-columnspan' => $buttons,
+      '-padx'       => 10,
+      '-pady'       => 10,
+    );
+
+    # The "yes" button
+    my $y_b = $mw->Button (
+      '-text'      => 'Yes',
+      '-underline' => 0,
+      '-command'   => sub {$ans = 'y'; $mw->destroy},
+    )->grid (
+      '-row'    => 1,
+      '-column' => 0,
+      '-padx'   => 5,
+      '-pady'   => 5,
+    );
+
+    # The "no" button
+    my $n_b = $mw->Button (
+      '-text'      => 'No',
+      '-underline' => 0,
+      '-command'   => sub {$ans = 'n'; $mw->destroy},
+    )->grid (
+      '-row'    => 1,
+      '-column' => 1,
+      '-padx'   => 5,
+      '-pady'   => 5,
+    );
+
+    # The "all" button
+    my $a_b;
+    if ($buttons == 3) {
+      $a_b = $mw->Button (
+        '-text'      => 'All',
+        '-underline' => 0,
+        '-command'   => sub {$ans = 'a'; $mw->destroy},
+      )->grid (
+        '-row'    => 1,
+        '-column' => 2,
+        '-padx'   => 5,
+        '-pady'   => 5,
+      );
+    }
+
+    # Keyboard binding
+    if ($buttons == 3) {
+      $mw->bind ('<Key>' => sub {
+	if ($Tk::event->K eq 'Y' or $Tk::event->K eq 'y') {
+	  $y_b->invoke;
+
+	} elsif ($Tk::event->K eq 'N' or $Tk::event->K eq 'n') {
+	  $n_b->invoke;
+
+	} elsif ($Tk::event->K eq 'A' or $Tk::event->K eq 'a') {
+	  $a_b->invoke;
+	}
+      });
+
+    } else {
+      $mw->bind ('<Key>' => sub {
+	if ($Tk::event->K eq 'Y' or $Tk::event->K eq 'y') {
+	  $y_b->invoke;
+
+	} elsif ($Tk::event->K eq 'N' or $Tk::event->K eq 'n') {
+	  $n_b->invoke;
+	}
+      });
+    }
+
+    # Handle the situation when the user attempts to quit the window
+    $mw->protocol ('WM_DELETE_WINDOW', sub {
+      $ans = $def if $def;
+      $mw->destroy;
+    });
+
+  } else {
+    # Create a dialog box to obtain an input string
+
+    # Message of the dialog box
+    $mw->Label ('-text' => $mesg)->grid (
+      '-row'    => 0,
+      '-column' => 0,
+      '-padx'   => 5,
+      '-pady'   => 5,
+    );
+
+    # Entry box for the user to type in the input string
+    my $entry   = $ans;
+    my $input_e = $mw->Entry (
+      '-textvariable'    => \$entry,
+      '-width'           => 40,
+    )->grid (
+      '-row'    => 0,
+      '-column' => 1,
+      '-sticky' => 'ew',
+      '-padx'   => 5,
+      '-pady'   => 5,
+    );
+
+    my $b_f = $mw->Frame->grid (
+      '-row'        => 1,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'e',
+    );
+
+    # An OK button to accept the input string
+    my $ok_b = $b_f->Button (
+      '-text' => 'OK',
+      '-command' => sub {$ans = $entry; $mw->destroy},
+    )->grid (
+      '-row'        => 0,
+      '-column'     => 0,
+      '-padx'       => 5,
+      '-pady'       => 5,
+    );
+
+    # A Cancel button to reject the input string
+    my $cancel_b = $b_f->Button (
+      '-text' => 'Cancel',
+      '-command' => sub {$ans = undef; $mw->destroy},
+    )->grid (
+      '-row'        => 0,
+      '-column'     => 1,
+      '-padx'       => 5,
+      '-pady'       => 5,
+    );
+
+    # Keyboard binding
+    $mw->bind ('<Key>' => sub {
+      if ($Tk::event->K eq 'Return' or $Tk::event->K eq 'KP_Enter') {
+        $ok_b->invoke;
+
+      } elsif ($Tk::event->K eq 'Escape') {
+        $cancel_b->invoke;
+      }
+    });
+
+    # Allow the entry box to expand
+    $mw->gridColumnconfigure (1, '-weight' => 1);
+
+    # Set initial focus on the entry box
+    $input_e->focus;
+    $input_e->icursor ('end');
+  }
+
+  $mw->geometry ($pos);
+
+  # Switch on "always on top" property for $mw
+  $mw->property (
+    qw/set _NET_WM_STATE ATOM/,
+    32,
+    ['_NET_WM_STATE_STAYS_ON_TOP'],
+    ($mw->toplevel->wrapper)[0],
+  );
+
+  MainLoop;
+
+  return $ans;
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_internal
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_internal	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_internal	(revision 5166)
@@ -0,0 +1,581 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_internal
+#
+# SYNOPSIS
+#   fcm_internal SUBCOMMAND ARGS
+#
+# DESCRIPTION
+#   The fcm_internal command is a frontend for some of the internal commands of
+#   the FCM build system. The subcommand can be "compile", "load" or "archive"
+#   for invoking the compiler, loader and library archiver respectively. If
+#   "compile" is specified, it can be suffixed with ":TYPE" to specify the
+#   nature of the source file. If TYPE is not specified, it is set to F by
+#   default (for Fortran source). For compile and load, the other arguments are
+#   the 1) name of the container package of the source file, 2) the path to the
+#   source file and 3) the target name after compiling or loading the source
+#   file. For compile, the 4th argument is a flag to indicate whether
+#   pre-processing is required for compiling the source file. For load, the 4th
+#   and the rest of the arguments is a list of object files that cannot be
+#   archived into the temporary load library and must be linked into the target
+#   through the linker command. (E.g. Fortran BLOCKDATA program units must be
+#   linked this way.) If archive is specified, the first argument should be the
+#   name of the library archive target and the rest should be the object files
+#   to be included in the archive. This command is invoked via the build system
+#   and should never be called directly by the user.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas:
+use warnings;
+use strict;
+
+# FCM component modules
+use Fcm::Timer;
+
+# Function declarations
+sub catfile;
+sub basename;
+sub dirname;
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %unusual_tool_name = ();
+
+# ------------------------------------------------------------------------------
+
+MAIN: {
+  # Name of program
+  my $this = basename $0;
+
+  # Arguments
+  my $subcommand = shift @ARGV;
+  my ($function, $type) = split /:/, $subcommand; 
+  my ($srcpackage, $src, $target, $requirepp, @objects, @blockdata);
+  
+  if ($subcommand eq 'archive') {
+    ($target, @objects) = @ARGV;
+
+  } elsif ($subcommand eq 'load') {
+    ($srcpackage, $src, $target, @blockdata) = @ARGV;
+
+  } else {
+    ($srcpackage, $src, $target, $requirepp) = @ARGV;
+  }
+
+  # Set up hash reference for all the required information
+  my %info = (
+    SRCPACKAGE => $srcpackage,
+    SRC        => $src,
+    TYPE       => $type,
+    TARGET     => $target,
+    REQUIREPP  => $requirepp,
+    OBJECTS    => \@objects,
+    BLOCKDATA  => \@blockdata,
+  );
+
+  # Get list of unusual tools
+  my $i = 0;
+  while (my $label = &get_env ('FCM_UNUSUAL_TOOL_LABEL' . $i)) {
+    my $value = &get_env ('FCM_UNUSUAL_TOOL_VALUE' . $i);
+    $unusual_tool_name{$label} = $value;
+    $i++;
+  }
+
+  # Invoke the action
+  my $rc = 0;
+  if ($function eq 'compile') {
+    $rc = &compile (\%info);
+
+  } elsif ($function eq 'load') {
+    $rc = &load (\%info);
+
+  } elsif ($function eq 'archive') {
+    $rc = &archive (\%info);
+
+  } else {
+    print STDERR $this, ': incorrect usage, abort';
+    $rc = 1;
+  }
+
+  # Throw error if action failed
+  if ($rc) {
+    print STDERR $this, ' ', $function, ' failed (', $rc, ')', "\n";
+    exit 1;
+
+  } else {
+    exit;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &compile (\%info);
+#
+# DESCRIPTION
+#   This method invokes the correct compiler with the correct options to
+#   compile the source file into the required target. The argument $info is a
+#   hash reference set up in MAIN. The following environment variables are
+#   used, where * is the source file type (F for Fortran, and C for C/C++):
+# 
+#   *C          - compiler command
+#   *C_OUTPUT   - *C option to specify the name of the output file
+#   *C_DEFINE   - *C option to declare a pre-processor def
+#   *C_INCLUDE  - *C option to declare an include directory
+#   *C_COMPILE  - *C option to ask the compiler to perform compile only
+#   *CFLAGS     - *C user options
+#   *PPKEYS     - list of pre-processor defs (may have sub-package suffix)
+#   FCM_VERBOSE - verbose level
+#   FCM_OBJDIR  - destination directory of object file
+#   FCM_TMPDIR  - temporary destination directory of object file
+# ------------------------------------------------------------------------------
+
+sub compile {
+  my $info = shift;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  my @command = ();
+
+  # Only support C and Fortran source files at the moment
+  my $type = $info->{TYPE};
+  $type    = ($info->{SRC} =~ /\.c(\w+)?$/i) ? 'C' : 'F' if not $type;
+
+  # Compiler
+  push @command, &get_env ($type . 'C', 1);
+
+  # Compile output target (typical -o option)
+  push @command, &get_env ($type . 'C_OUTPUT', 1), $info->{TARGET};
+
+  # Pre-processor definition macros
+  if ($info->{REQUIREPP}) {
+    my @ppkeys = split /\s+/, &select_flags ($info, $type . 'PPKEYS');
+    my $defopt = &get_env ($type . 'C_DEFINE', 1);
+
+    push @command, (map {$defopt . $_} @ppkeys);
+  }
+
+  # Include search path
+  my $incopt  = &get_env ($type . 'C_INCLUDE', 1);
+  my @incpath = split /:/, &get_env ('FCM_INCPATH');
+  push @command, (map {$incopt . $_} @incpath);
+
+  # Other compiler flags
+  my $flags = &select_flags ($info, $type . 'FLAGS');
+  push @command, $flags if $flags;
+
+  my $compile_only = &get_env ($type . 'C_COMPILE');
+  if ($flags !~ /(?:^|\s)$compile_only\b/) {
+    push @command, &get_env ($type . 'C_COMPILE');
+  }
+
+  # Name of source file
+  push @command, $info->{SRC};
+
+  # Execute command
+  my $objdir = &get_env ('FCM_OBJDIR', 1);
+  my $tmpdir = &get_env ('FCM_TMPDIR', 1);
+  chdir $tmpdir;
+
+  my $command = join ' ', @command;
+  if ($verbose > 1) {
+    print 'cd ', $tmpdir, "\n";
+    print &timestamp_command ($command, 'Start');
+
+  } elsif ($verbose) {
+    print $command, "\n";
+  }
+
+  my $rc = system $command;
+
+  print &timestamp_command ($command, 'End  ') if $verbose > 1;
+
+  # Move temporary output to correct location on success
+  # Otherwise, remove temporary output
+  if ($rc) { # error
+    unlink $info->{TARGET};
+
+  } else {   # success
+    print 'mv ', $info->{TARGET}, ' ', $objdir, "\n" if $verbose > 1;
+    rename $info->{TARGET}, &catfile ($objdir, $info->{TARGET});
+  }
+
+  # Move any Fortran module definition files to the INC directory
+  my @modfiles = <*.mod *.MOD>;
+  for my $file (@modfiles) {
+    rename $file, &catfile ($incpath[0], $file);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &load (\%info);
+#
+# DESCRIPTION
+#   This method invokes the correct loader with the correct options to link
+#   the main program object into an executable. The argument $info is a hash
+#   reference set up in MAIN. The following environment variables are used:
+# 
+#   LD           - linker command
+#   LD_OUTPUT    - LD option to specify the name of the output file
+#   LD_LIBSEARCH - LD option to declare a directory in the library search path
+#   LD_LIBLINK   - LD option to declare an object library
+#   LDFLAGS      - LD user options
+#   FCM_VERBOSE  - verbose level
+#   FCM_LIBDIR   - destination directory of object libraries
+#   FCM_OBJDIR   - destination directory of object files
+#   FCM_BINDIR   - destination directory of executable file
+#   FCM_TMPDIR   - temporary destination directory of executable file
+# ------------------------------------------------------------------------------
+
+sub load {
+  my $info = shift;
+
+  my $rc = 0;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  # Create temporary object library
+  (my $name   = $info->{TARGET}) =~ s/\.\S+$//;
+  my $libname = '__fcm__' . $name;
+  my $lib     = 'lib' . $libname . '.a';
+  my $libfile = catfile (&get_env ('FCM_LIBDIR', 1), $lib);
+  $rc = &archive ({TARGET => $lib});
+
+  unless ($rc) {
+    my @command = ();
+
+    # Linker
+    push @command, &select_flags ($info, 'LD');
+
+    # Linker output target (typical -o option)
+    push @command, &get_env ('LD_OUTPUT', 1), $info->{TARGET};
+
+    # Name of main object file
+    my $mainobj = (basename ($info->{SRC}) eq $info->{SRC})
+                  ? catfile (&get_env ('FCM_OBJDIR'), $info->{SRC})
+                  : $info->{SRC};
+    push @command, $mainobj;
+
+    # Link with Fortran BLOCKDATA objects if necessary
+    if (@{ $info->{BLOCKDATA} }) {
+      my @blockdata = @{ $info->{BLOCKDATA} };
+      my @objpath   = split /:/, &get_env ('FCM_OBJPATH');
+
+      # Search each BLOCKDATA object file from the object search path
+      for my $file (@blockdata) {
+        for my $dir (@objpath) {
+          my $full = catfile ($dir, $file);
+
+          if (-r $full) {
+            $file = $full;
+            last;
+          }
+        }
+
+        push @command, $file;
+      }
+    }
+
+    # Library search path
+    my $libopt  = &get_env ('LD_LIBSEARCH', 1);
+    my @libpath = split /:/, &get_env ('FCM_LIBPATH');
+    push @command, (map {$libopt . $_} @libpath);
+
+    # Link with temporary object library if it exists
+    push @command, &get_env ('LD_LIBLINK', 1) . $libname if -f $libfile;
+
+    # Other linker flags
+    my $flags = &select_flags ($info, 'LDFLAGS');
+    push @command, $flags;
+
+    # Execute command
+    my $tmpdir = &get_env ('FCM_TMPDIR', 1);
+    my $bindir = &get_env ('FCM_BINDIR', 1);
+    chdir $tmpdir;
+
+    my $command = join ' ', @command;
+    if ($verbose > 1) {
+      print 'cd ', $tmpdir, "\n";
+      print &timestamp_command ($command, 'Start');
+
+    } elsif ($verbose) {
+      print $command, "\n";
+    }
+
+    $rc = system $command;
+
+    print &timestamp_command ($command, 'End  ') if $verbose > 1;
+
+    # Move temporary output to correct location on success
+    # Otherwise, remove temporary output
+    if ($rc) { # error
+      unlink $info->{TARGET};
+
+    } else {   # success
+      print 'mv ', $info->{TARGET}, ' ', $bindir, "\n" if $verbose > 1;
+      rename $info->{TARGET}, &catfile ($bindir, $info->{TARGET});
+    }
+  }
+
+  # Remove the temporary object library
+  unlink $libfile if -f $libfile;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &archive (\%info);
+#
+# DESCRIPTION
+#   This method invokes the library archiver to create an object library. The
+#   argument $info is a hash reference set up in MAIN. The following
+#   environment variables are used:
+# 
+#   AR           - archiver command
+#   ARFLAGS      - AR options to update/create an object library
+#   FCM_VERBOSE  - verbose level
+#   FCM_LIBDIR   - destination directory of object libraries
+#   FCM_OBJPATH  - search path of object files
+#   FCM_OBJDIR   - destination directory of object files
+#   FCM_TMPDIR   - temporary destination directory of executable file
+# ------------------------------------------------------------------------------
+
+sub archive {
+  my $info = shift;
+
+  my $rc = 0;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  # Set up the archive command
+  my $lib     = &basename ($info->{TARGET});
+  my $tmplib  = &catfile (&get_env ('FCM_TMPDIR', 1), $lib);
+  my @ar_cmd  = ();
+  push @ar_cmd, (&get_env ('AR', 1), &get_env ('ARFLAGS', 1));
+  push @ar_cmd, $tmplib;
+
+  # Get object directories and their files
+  my %objdir;
+  if (exists $info->{OBJECTS}) {
+    # List of objects set in the argument, sort into directory/file list
+    for my $name (@{ $info->{OBJECTS} }) {
+      my $dir = (&dirname ($name) eq '.')
+                ? &get_env ('FCM_OBJDIR', 1) : &dirname ($name);
+      $objdir{$dir}{&basename ($name)} = 1;
+    }
+
+  } else {
+    # Objects not listed in argument, search object path for all files
+    my @objpath  = split /:/, &get_env ('FCM_OBJPATH', 1);
+    my %objbase  = ();
+
+    # Get registered objects into a hash (keys = objects, values = 1)
+    my %objects = map {($_, 1)} split (/\s+/, &get_env ('OBJECTS'));
+
+    # Seach object path for all files
+    for my $dir (@objpath) {
+      next unless -d $dir;
+
+      chdir $dir;
+
+      # Use all files from each directory in the object search path
+      for ((glob ('*'))) {
+        next unless exists $objects{$_}; # consider registered objects only
+        $objdir{$dir}{$_} = 1 unless exists $objbase{$_};
+        $objbase{$_} = 1;
+      }
+    }
+  }
+
+  for my $dir (keys %objdir) {
+    next unless -d $dir;
+
+    # Go to each object directory and executes the library archive command 
+    chdir $dir;
+    my $command = join ' ', (@ar_cmd, sort keys %{ $objdir{$dir} });
+
+    if ($verbose > 1) {
+      print 'cd ', $dir, "\n";
+      print &timestamp_command ($command, 'Start');
+
+    } else {
+      print $command, "\n" if exists $info->{OBJECTS};
+    }
+
+    $rc = system $command;
+
+    print &timestamp_command ($command, 'End  ')
+      if $verbose > 1;
+    last if $rc;
+  }
+
+  # Move temporary output to correct location on success
+  # Otherwise, remove temporary output
+  if ($rc) { # error
+    unlink $tmplib;
+
+  } else {   # success
+    my $libdir = &get_env ('FCM_LIBDIR', 1);
+
+    print 'mv ', $tmplib, ' ', $libdir, "\n" if $verbose > 1;
+    rename $tmplib, &catfile ($libdir, $lib);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flags = &select_flags (\%info, $set);
+#
+# DESCRIPTION
+#   This function selects the correct compiler/linker flags for the current
+#   sub-package from the environment variable prefix $set. The argument $info
+#   is a hash reference set up in MAIN.
+# ------------------------------------------------------------------------------
+
+sub select_flags {
+  my ($info, $set) = @_;
+
+  (my $srcroot = &basename ($info->{SRC})) =~ s/\.\S+$//;
+  my @names    = ($set);
+  push @names, split (/__/, $info->{SRCPACKAGE} . '__' . $srcroot);
+
+  my $string   = '';
+  while (@names) {
+    my $name = join '__', @names;
+    my $var  = &get_env ($name);
+
+    if (defined $var) {
+      $string = $var;
+      last;
+
+    } else {
+      pop @names;
+    }
+  }
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $variable = &get_env ($name);
+#   $variable = &get_env ($name, $compulsory);
+#
+# DESCRIPTION
+#   This internal method gets a variable from $ENV{$name}. If $compulsory is
+#   set to true, it throws an error if the variable is a not set or is an empty
+#   string. Otherwise, it returns C<undef> if the variable is not set.
+# ------------------------------------------------------------------------------
+
+sub get_env {
+  (my $name, my $compulsory) = @_;
+  my $string;
+
+  if ($name =~ /^\w+$/) {
+    # $name contains only word characters, variable is exported normally
+    die 'The environment variable "', $name, '" must be set, abort'
+      if $compulsory and not exists $ENV{$name};
+
+    $string = exists $ENV{$name} ? $ENV{$name} : undef;
+
+  } else {
+    # $name contains unusual characters
+    die 'The environment variable "', $name, '" must be set, abort'
+      if $compulsory and not exists $unusual_tool_name{$name};
+
+    $string = exists $unusual_tool_name{$name}
+              ? $unusual_tool_name{$name} : undef;
+  }
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = &catfile (@paths);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Spec module.
+# ------------------------------------------------------------------------------
+
+sub catfile {
+  my @names = split (m!/!, join ('/', @_));
+  my $path  = shift @names;
+
+  for my $name (@names) {
+    $path .= '/' . $name if $name;
+  }
+
+  return $path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $basename = &basename ($path);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Basename module.
+# ------------------------------------------------------------------------------
+
+sub basename {
+  my $name = $_[0];
+
+  $name =~ s{/*$}{}; # remove trailing slashes
+
+  if ($name =~ m#.*/([^/]+)$#) {
+    return $1;
+
+  } else {
+    return $name;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dirname = &dirname ($path);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Basename module.
+# ------------------------------------------------------------------------------
+
+sub dirname {
+  my $name = $_[0];
+
+  if ($name =~ m#^/+$#) {
+    return '/'; # dirname of root is root
+
+  } else {
+    $name =~ s{/*$}{}; # remove trailing slashes
+
+    if ($name =~ m#^(.*)/[^/]+$#) {
+      my $dir = $1;
+      $dir =~ s{/*$}{}; # remove trailing slashes
+      return $dir;
+
+    } else {
+      return '.';
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_setup_konqueror
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_setup_konqueror	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_setup_konqueror	(revision 5166)
@@ -0,0 +1,44 @@
+#!/usr/bin/ksh
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_setup_konqueror
+#
+# SYNOPSIS
+#   fcm_setup_konqueror
+#
+# DESCRIPTION
+#   Set up Konqueror to use "fcm gui".
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Check number of arguments
+script=$(basename $0)
+usage="$script: no argument required"
+if (( $# != 0 )); then
+  echo "$usage, abort..." >&2
+  exit 1
+fi
+
+filename=fcm_gui.desktop
+
+file=$(dirname $0)
+file=${file%/bin}/etc/$filename
+
+if [[ ! -f $file ]]; then
+  echo "$script: $file not found, abort..." >&2
+  exit 1
+fi
+
+dir=$HOME/.kde/share/applnk/.hidden
+mkdir -p $dir
+cd $dir
+rm -f $filename             # Always remove.
+ln -s $file .
+
+echo "$script: finished"
+
+#EOF
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_update_version_dir.pl
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_update_version_dir.pl	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/bin/fcm_update_version_dir.pl	(revision 5166)
@@ -0,0 +1,302 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_update_version_dir.pl
+#
+# SYNOPSIS
+#   fcm_update_version_dir.pl [OPTIONS] [CFGFILE]
+#
+# DESCRIPTION
+#   See $usage for detail.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas
+use strict;
+use warnings;
+
+# Standard modules
+use Getopt::Long;
+use Cwd;
+use File::Basename;
+use File::Path;
+use File::Spec;
+
+# FCM component modules:
+use lib File::Spec->catfile (dirname (dirname ($0)), 'lib');
+use Fcm::Config;
+use Fcm::Util;
+
+# Usage
+# ------------------------------------------------------------------------------
+my $this  = basename $0;
+my $usage = <<EOF;
+NAME
+  $this
+
+SYNOPSIS
+  $this [OPTIONS] [CFGFILE]
+
+DESCRIPTION
+  Update the version directories for a list of relative paths in the source
+  repository URL.
+
+OPTIONS
+  -d [--dest] arg: Specify a destination for the extraction. If not specified,
+                   the command extracts to the current working directory.
+  -h [--help]    : Print help and exit.
+  -f [--full]    : Specify the full mode. If not specified, the command runs
+                   in incremental mode.
+  -u [--url]  arg: Specify the source repository URL. No default.
+
+ARGUMENTS
+  A configuration file may be given to this command, or it will attempt to
+  read from the standard input. Each line in the configuration must contain
+  a relative path that resides under the given source repository URL. (Empty
+  lines and lines beginning with a "#" are ignored.) Optionally, each
+  relative path may be followed by a list of space separated "conditions".
+  Each condition is a conditional operator (>, >=, <, <=, == or !=) followed
+  by a revision number or the keyword HEAD. The command uses the revision
+  log to determine the revisions at which the relative path has been updated
+  in the source repository URL. If these revisions also satisfy the
+  "conditions" set by the user, they will be considered in the extraction.
+  In full mode, everything is re-extracted. In incremental mode, the version
+  directories are only updated if they do not already exist.
+
+COPYRIGHT
+  This program is part of the FCM system.
+  (C) Crown copyright Met Office. All rights reserved.
+  For further details please refer to the file COPYRIGHT.txt
+  which you should have received as part of this distribution.
+EOF
+
+# Options
+# ------------------------------------------------------------------------------
+my ($dest, $full, $help, $url);
+GetOptions (
+  'dest|d=s' => \$dest,
+  'full|f'   => \$full,
+  'help'     => \$help,
+  'url|u=s'  => \$url,
+);
+
+if ($help) {
+  print $usage;
+  exit;
+}
+
+$dest = cwd () unless $dest;
+
+die 'An URL must be specified with the --url option, abort' unless $url;
+
+# Arguments
+# ------------------------------------------------------------------------------
+if (@ARGV) {
+  die 'Cannot read: ', $ARGV[0], ', abort' unless -f $ARGV[0] and -r $ARGV[0];
+}
+
+# Get configuration settings
+# ------------------------------------------------------------------------------
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# Expand URL keyword
+$url = &expand_url_keyword (URL => $url);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfg = &main::cfg ();
+#
+# DESCRIPTION
+#   Return the $config variable.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  return $config;
+}
+
+# ------------------------------------------------------------------------------
+
+MAIN: {
+  my $date = localtime;
+  print $this, ': started on ', $date, "\n";
+
+  my %dirs;
+
+  # Read input (file) for a list directories and update conditions
+  while (<>) {
+    chomp;
+
+    # Ignore empty and comment lines
+    next if /^\s*(?:#|$)/;
+
+    # Each line must contain a relative path, and optionally a list of
+    # space delimited conditions
+    my @words = split /\s+/;
+    my $dir   = shift @words;
+
+    # Check that the conditions are valid
+    my @conditions;
+    for my $word (@words) {
+      if ($word =~ /^([<>]=?|[!=]=)(.+)$/i) {
+        # Condition must be a conditional operator followed by a revision
+        my ($operator, $rev) = ($1, $2);
+        $rev = &expand_rev_keyword (REV => $rev, URL => $url, HEAD => 1);
+        push @conditions, $operator . $rev;
+
+      } else {
+        print STDERR 'Warning: ignore unknown syntax for update condition: ',
+                     $word, "\n";
+      }
+    }
+
+    # Add directory and its conditions to a hash
+    if ($dir =~ s#/\*$##) { # Directory finishes with wildcard
+
+      # Run "svn ls" in recursive mode
+      my $dirurl  = join ('/', ($url, $dir));
+      my @files   = &run_command ([qw/svn ls -R/, $dirurl], METHOD => 'qx');
+
+      # Find directories containing regular files
+      while (my $file = shift @files) {
+	# Skip directories
+	next if $file =~ m#/$#;
+
+	# Get "dirname" of regular file and add to hash
+	my $subdir = join ('/', ($dir, dirname ($file)));
+	$dirs{$subdir} = \@conditions;
+      }
+
+    } else {
+      $dirs{$dir} = \@conditions;
+    }
+
+  }
+
+  # Update each directory, if required
+  for my $dir (sort keys %dirs) {
+    # Use "svn log" to determine the revisions that need to be updated
+    my %allversions;
+    {
+      my $command = 'svn log -q ' . join ('/', ($url, $dir));
+      my @log     = &run_command (
+        [qw/svn log -q/, join ('/', ($url, $dir))], METHOD => 'qx',
+      );
+      @log        = grep /^r\d+/, @log;
+
+      # Assign a sequential "version" number to each sub-directory
+      my $version = scalar @log;
+      for (@log) {
+        m/^r(\d+)/;
+        $allversions{$1} = 'v' . $version--;
+      }
+    }
+    my %versions = %allversions;
+
+    # Extract only revisions matching the conditions
+    if (@{ $dirs{$dir} }) {
+      my @conditions = @{ $dirs{$dir} };
+
+      for my $condition (@conditions) {
+        for my $rev (keys %versions) {
+          delete $versions{$rev} unless eval ($rev . $condition);
+        }
+      }
+    }
+
+    # Destination directory
+    my $dirpath = File::Spec->catfile ($dest, $dir);
+
+    if (-d $dirpath) {
+      if ($full or not keys %versions) {
+        # Remove destination directory top, in full mode
+        # or if there are no matching revisions
+        &run_command ([qw/rm -rf/, $dirpath], PRINT => 1);
+
+      } else {
+        # Delete excluded revisions if they exist, in incremental mode
+        if (opendir DIR, $dirpath) {
+          while (my $rev = readdir 'DIR') {
+            next unless $rev =~ /^\d+$/;
+
+            if (not grep {$_ eq $rev} keys %versions) {
+              my @command = (qw/rm -rf/, File::Spec->catfile ($dirpath, $rev));
+              &run_command (\@command, PRINT => 1);
+
+              # Remove "version" symlink
+              my $verlink = File::Spec->catfile ($dirpath, $allversions{$rev});
+              unlink $verlink if -l $verlink;
+            }
+          }
+          closedir DIR;
+        }
+      }
+    }
+
+    # Create container directory of destination if it does not already exist
+    if (keys %versions and not -d $dirpath) {
+      print '-> mkdir -p ', $dirpath, "\n";
+      my $rc = mkpath $dirpath;
+      die 'mkdir -p ', $dirpath, ' failed' unless $rc;
+    }
+
+    # Update each version directory that needs updating
+    for my $rev (keys %versions) {
+      my $revpath = File::Spec->catfile ($dest, $dir, $rev);
+
+      # Create version directory if it does not exist
+      if (not -e $revpath) {
+        # Use "svn export" to create the version directory
+        my @command = (
+          qw/svn export -q -r/,
+          $rev,
+          join ('/', ($url, $dir)),
+          $revpath,
+        );
+
+        &run_command (\@command, PRINT => 1);
+
+        # Run GenScr_GenRule on any component directories
+        # This can be removed once old versions of the SCSUI are no longer used
+	if ($dir =~ m#(?:^|/)components/#) {
+          my @command = (
+            "GenScr_GenRule",
+            File::Spec->catfile ($revpath, join ('.', (basename ($dir), "rule")))
+          );
+
+          &run_command (\@command, PRINT => 1);
+	}
+      }
+
+      # Create "version" symlink if necessary
+      my $verlink = File::Spec->catfile ($dest, $dir, $versions{$rev});
+      symlink $rev, $verlink unless -l $verlink;
+    }
+
+    # Symbolic link to the "latest" version directory
+    my $headlink = File::Spec->catfile ($dest, $dir, 'latest');
+    my $headrev  = 0;
+    for my $rev (keys %versions) {
+      $headrev = $rev if $rev > $headrev;
+    }
+
+    if (-l $headlink) {
+      # Remove old symbolic link if there is no revision to update or if it
+      # does not point to the correct version directory
+      my $org = readlink $headlink;
+      unlink $headlink if (! $headrev or $org ne $headrev);
+    }
+
+    # (Re-)create the "latest" symbolic link, if necessary
+    symlink $headrev, $headlink if ($headrev and not -l $headlink);
+  }
+
+  $date = localtime;
+  print $this, ': finished normally on ', $date, "\n";
+}
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/etc/fcm.cfg.eg
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/etc/fcm.cfg.eg	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/etc/fcm.cfg.eg	(revision 5166)
@@ -0,0 +1,266 @@
+# ------------------------------------------------------------------------------
+# FCM central configuration file
+# ------------------------------------------------------------------------------
+
+# ------------------------------------------------------------------------------
+# Standard repository locations
+# ------------------------------------------------------------------------------
+
+# AMV repository
+set::url::amv                svn://fcm7/AMV_svn/AMV
+
+set::trac::amv               http://fcm7/projects/AMV/browser/AMV
+
+# ANCIL repository
+set::url::ancil              svn://fcm8/ANCIL_svn/ANCIL
+
+set::trac::ancil             http://fcm8/projects/ANCIL/browser/ANCIL
+
+# ATSR repository
+set::url::atsr               svn://fcm7/ATSR_svn/ATSR
+
+set::trac::atsr              http://fcm7/projects/ATSR/browser/ATSR
+
+# CICE repository
+set::url::cice               svn://fcm3/CICE_svn/CICE
+
+set::trac::cice              http://fcm3/projects/CICE/browser/CICE
+
+# CVC repository
+set::url::cvc_admin          svn://fcm6/CVC_svn/Admin
+set::url::bullseye           svn://fcm6/CVC_svn/Bullseye
+set::url::cat                svn://fcm6/CVC_svn/CAT
+set::url::deicing            svn://fcm6/CVC_svn/Deicing
+set::url::ea                 svn://fcm6/CVC_svn/EA  
+set::url::ensemble           svn://fcm6/CVC_svn/Ensemble
+set::url::gales              svn://fcm6/CVC_svn/Gales
+set::url::ifv                svn://fcm6/CVC_svn/IFV
+set::url::mogreps            svn://fcm6/CVC_svn/MOGREPS
+set::url::openroad           svn://fcm6/CVC_svn/OpenRoad
+set::url::powertable         svn://fcm6/CVC_svn/PowerTable
+set::url::qnh                svn://fcm6/CVC_svn/QNH
+
+set::trac::cvc_admin         http://fcm6/projects/CVC/browser/Admin
+set::trac::bullseye          http://fcm6/projects/CVC/browser/Bullseye
+set::trac::cat               http://fcm6/projects/CVC/browser/CAT
+set::trac::deicing           http://fcm6/projects/CVC/browser/Deicing
+set::trac::ea                http://fcm6/projects/CVC/browser/EA
+set::trac::ensemble          http://fcm6/projects/CVC/browser/Ensemble
+set::trac::gales             http://fcm6/projects/CVC/browser/Gales
+set::trac::ifv               http://fcm6/projects/CVC/browser/IFV
+set::trac::mogreps           http://fcm6/projects/CVC/browser/MOGREPS
+set::trac::openroad          http://fcm6/projects/CVC/browser/OpenRoad
+set::trac::powertable        http://fcm6/projects/CVC/browser/PowerTable
+set::trac::qnh               http://fcm6/projects/CVC/browser/QNH
+
+# DA repository
+set::url::da                 svn://fcm5/DA_svn/DA
+
+set::trac::da                http://fcm5/projects/DA/browser/DA
+
+# ENS repository
+set::url::ens                svn://fcm9/ENS_svn/ENS
+
+set::trac::ens               http://fcm9/projects/ENS/browser/ENS
+
+# FCM repository
+set::url::fcm                svn://fcm1/FCM_svn/FCM
+set::url::fcm_admin          svn://fcm1/FCM_svn/Admin
+
+set::trac::fcm               http://fcm1/projects/FCM/browser/FCM
+set::trac::fcm_admin         http://fcm1/projects/FCM/browser/Admin
+
+# FLUME repository
+set::url::flume_metadata     svn://fcm2/FLUME_svn/metadata
+
+set::trac::flume_metadata    http://fcm2/projects/FLUME/browser/metadata
+
+# GEN repository
+set::url::gen                svn://fcm1/GEN_svn/GEN
+
+set::trac::gen               http://fcm1/projects/GEN/browser/GEN
+
+# LEM repository
+set::url::lem                svn://fcm2/LEM_svn/LEM
+
+set::trac::lem               http://fcm2/projects/LEM/browser/LEM
+
+# LINK repository
+set::url::link               svn://fcm1/LINK_svn/LINK
+
+set::trac::link              http://fcm1/projects/LINK/browser/LINK
+
+# NEMO repository
+set::url::nemosys            svn://fcm3/NEMO_svn/NEMOSYS
+
+set::trac::nemosys           http://fcm3/projects/NEMO/browser/NEMOSYS
+
+# NWPWEB repository
+set::url::www_nwp            svn://fcm1/NWPWEB_svn/www_nwp
+
+set::trac::www_nwp           http://fcm1/projects/NWPWEB_svn/browser/www_nwp
+
+# obsmon repository
+set::url::obsmon_dc          svn://fcm4/obsmon_svn/DC
+set::url::obsmon_rtm         svn://fcm4/obsmon_svn/RTM
+
+set::trac::obsmon_dc         http://fcm4/projects/obsmon/browser/DC
+set::trac::obsmon_rtm        http://fcm4/projects/obsmon/browser/RTM
+
+# OCN repository
+set::url::polcoms            svn://fcm3/OCN_svn/POLCOMS
+
+set::trac::polcoms           http://fcm3/projects/OCN/browser/POLCOMS
+
+# OPFC repository
+set::url::opfc               svn://fcm9/OPFC_svn/OPFC
+
+set::trac::opfc              http://fcm9/projects/OPFC/browser/OPFC
+
+# OPS repository
+set::url::ops                svn://fcm4/OPS_svn/OPS
+set::url::ops_admin          svn://fcm4/OPS_svn/Admin
+set::url::ops_data           svn://fcm4/OPS_svn/Data
+
+set::trac::ops               http://fcm4/projects/OPS/browser/OPS
+set::trac::ops_admin         http://fcm4/projects/OPS/browser/Admin
+set::trac::ops_data          http://fcm4/projects/OPS/browser/Data
+
+# OSTIA repository
+set::url::ostia              svn://fcm3/OSTIA_svn/OSTIA
+
+set::trac::ostia             http://fcm3/projects/OSTIA/browser/OSTIA
+
+# PF repository
+set::url::pf                 svn://fcm5/PF_svn/PF
+
+set::trac::pf                http://fcm5/projects/PF/browser/PF
+
+# PostProc repository
+set::url::pp                 svn://fcm9/PostProc_svn/PostProc
+set::url::ppancil            svn://fcm9/PostProc_svn/PostProcAncil
+
+set::trac::pp                http://fcm9/projects/PostProc/browser/PostProc
+set::trac::ppancil           http://fcm9/projects/PostProc/browser/PostProcAncil
+
+# PRISM repository
+set::url::oasis4             svn://fcm2/PRISM_svn/oasis4
+
+set::trac::oasis4            http://fcm2/projects/PRISM/browser/oasis4
+
+# radarnet repository
+set::url::radarnet4          svn://fcm9/radarnet_svn/radarnet4
+
+set::trac::radarnet4         http://fcm7/projects/radarnet/browser/radarnet4
+
+# ROPP repository
+set::url::ropp_doc           svn://fcm7/ROPP_svn/ropp_doc
+set::url::ropp_src           svn://fcm7/ROPP_svn/ropp_src
+set::url::ropp_test          svn://fcm7/ROPP_svn/ropp_test
+set::url::ropp_web           svn://fcm7/ROPP_svn/ropp_web
+
+set::trac::ropp_doc          http://fcm7/projects/ROPP/browser/ropp_doc
+set::trac::ropp_src          http://fcm7/projects/ROPP/browser/ropp_src
+set::trac::ropp_test         http://fcm7/projects/ROPP/browser/ropp_test
+set::trac::ropp_web          http://fcm7/projects/ROPP/browser/ropp_web
+
+# RTTOV repository
+set::url::rttov8             svn://fcm7/RTTOV_svn/RTTOV8
+set::url::rttov9             svn://fcm7/RTTOV_svn/RTTOV9
+
+set::trac::rttov8            http://fcm7/projects/RTTOV/browser/RTTOV8
+set::trac::rttov9            http://fcm7/projects/RTTOV/browser/RTTOV9
+
+# SAUtils repository
+set::url::autoscat_global      svn://fcm7/SAUtils_svn/AUTOSCAT_Global
+set::url::autoscat_nae         svn://fcm7/SAUtils_svn/AUTOSCAT_NAE
+set::url::gpsiwv_mon           svn://fcm7/SAUtils_svn/GPSIWV_Mon
+set::url::gpsro_mon            svn://fcm7/SAUtils_svn/GPSRO_Mon
+set::url::iasi_mon             svn://fcm7/SAUtils_svn/IASI_Mon
+set::url::metstrike            svn://fcm7/SAUtils_svn/METSTRIKE
+set::url::scatwind_mon         svn://fcm7/SAUtils_svn/Scatwind_Mon
+
+set::trac::autoscat_global     http://fcm7/projects/SAUtils/browser/AUTOSCAT_Global
+set::trac::autoscat_nae        http://fcm7/projects/SAUtils/browser/AUTOSCAT_NAE
+set::trac::gpsiwv_mon          http://fcm7/projects/SAUtils/browser/GPSIWV_Mon
+set::trac::gpsro_mon           http://fcm7/projects/SAUtils/browser/GPSRO_Mon
+set::trac::iasi_mon            http://fcm7/projects/SAUtils/browser/IASI_Mon
+set::trac::metstrike           http://fcm7/projects/SAUtils/browser/METSTRIKE
+set::trac::scatwind_mon        http://fcm7/projects/SAUtils/browser/Scatwind_Mon
+
+# SBV repository
+set::url::sbv                svn://fcm6/SBV_svn/SBV
+set::url::sbv_admin          svn://fcm6/SBV_svn/Admin
+
+set::trac::sbv               http://fcm6/projects/SBV/browser/SBV
+set::trac::sbv_admin         http://fcm6/projects/SBV/browser/Admin
+
+# SCS repository
+set::url::scs                svn://fcm1/SCS_svn/SCS
+set::url::tik                svn://fcm1/SCS_svn/TIK
+set::url::tt                 svn://fcm1/SCS_svn/TT
+
+set::trac::scs               http://fcm1/projects/SCS/browser/SCS
+set::trac::tik               http://fcm1/projects/SCS/browser/TIK
+set::trac::tt                http://fcm1/projects/SCS/browser/TT
+
+# SPS repository
+set::url::sps                svn://fcm7/SPS_svn/SPS
+set::url::sps_archive        svn://fcm7/SPS_svn/Archive
+
+set::trac::sps               http://fcm7/projects/SPS/browser/SPS
+set::trac::sps_archive       http://fcm7/projects/SPS/browser/Archive
+
+# SURF repository
+set::url::surf               svn://fcm8/SURF_svn/SURF
+
+set::trac::surf              http://fcm8/projects/SURF/browser/SURF
+
+# test repository
+set::url::test               svn://fcm1/test_svn/OPS
+
+set::trac::test              http://fcm1/projects/test/browser/OPS
+
+# tutorial repository
+set::url::tutorial           svn://fcm1/tutorial_svn/tutorial
+
+set::trac::tutorial          http://fcm1/projects/tutorial/browser/tutorial
+
+# TRUI repository
+set::url::trui               svn://fcm1/TRUI_svn/TRUI
+
+set::trac::trui              http://fcm1/projects/TRUI/browser/TRUI
+
+# UM repository
+set::url::um                 svn://fcm2/UM_svn/UM
+set::url::um_admin           svn://fcm2/UM_svn/Admin
+set::url::gcom               svn://fcm2/UM_svn/GCOM
+
+set::trac::um                http://fcm2/projects/UM/browser/UM
+set::trac::um_admin          http://fcm2/projects/UM/browser/Admin
+set::trac::gcom              http://fcm2/projects/UM/browser/GCOM
+
+# UM tutorial repository
+set::url::um_tutorial        svn://fcm2/UM_TUTORIAL_svn/UM
+
+set::trac::um_tutorial       http://fcm2/projects/UM_TUTORIAL/browser/UM
+
+# VAR repository
+set::url::var                svn://fcm5/VAR_svn/VAR
+set::url::var_admin          svn://fcm5/VAR_svn/Admin
+set::url::var_data           svn://fcm5/VAR_svn/Data
+
+set::trac::var               http://fcm5/projects/VAR/browser/VAR
+set::trac::var_admin         http://fcm5/projects/VAR/browser/Admin
+set::trac::var_data          http://fcm5/projects/VAR/browser/Data
+
+# VER repository
+set::url::ver                svn://fcm6/VER_svn/VER
+set::url::ver_admin          svn://fcm6/VER_svn/Admin
+set::url::ver_archive        svn://fcm6/VER_svn/Archive
+
+set::trac::ver               http://fcm6/projects/VER/browser/VER
+set::trac::ver_admin         http://fcm6/projects/VER/browser/Admin
+set::trac::ver_archive       http://fcm6/projects/VER/browser/Archive
+
+# EOF
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/etc/fcm_gui.desktop
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/etc/fcm_gui.desktop	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/etc/fcm_gui.desktop	(revision 5166)
@@ -0,0 +1,13 @@
+[Desktop Entry]
+Comment=
+Exec=fcm gui %f
+Hidden=false
+Icon=wizard
+MimeType=inode/directory
+Name=FCM GUI
+Path=
+Terminal=0
+TerminalOptions=
+Type=Application
+X-KDE-SubstituteUID=false
+X-KDE-Username=
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Ecmwf/Fortran90_stuff.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Ecmwf/Fortran90_stuff.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Ecmwf/Fortran90_stuff.pm	(revision 5166)
@@ -0,0 +1,2736 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Ecmwf::Fortran90_stuff
+#
+# DESCRIPTION
+#   This is a module for analysing Fortran 9X code. It is used by the FCM
+#   system to generate interface blocks for Fortran 9X free source files.
+#
+# ABOUT THIS MODULE:
+#   The original version of this module was developed by the European Centre
+#   for Medium-Range Weather Forecasts (ECMWF). This version has been modified
+#   by UK Met Office to become part of the FCM system.
+# ------------------------------------------------------------------------------
+
+package Ecmwf::Fortran90_stuff;
+
+# Standard pragmas
+use strict;
+use warnings;
+
+# Standard modules
+require Exporter;
+
+our @ISA      = qw(Exporter);
+our @EXPORT   = qw(study setup_parse pre_tidy remove_macro expcont 
+                   process_include_files tidy tidy_decl getvars 
+		   find_unused_vars remove_unused_vars doctor_viol
+		   fix_doctor_viol various cont_lines f90_indent
+		   writefile readfile create_interface_block
+		   add_interface_blocks change_var_names insert_hook
+		   remake_arg_decl remove_some_comments parse_prog_unit
+		   get_calls_inc);
+
+# ------------------------------------------------------------------------------
+
+# Module variables
+
+my $fname = '';
+
+# ------------------------------------------------------------------------------
+# SYNPOSIS
+#   $file = &Ecmwf::Fortran90_stuff::fname ();
+#   &Ecmwf::Fortran90_stuff::fname ($file);
+#
+# DESCRIPTION
+#   This function returns the value in the module variable $fname, which is the
+#   name of the input Fortran source file from FCM. If an argument exists, the
+#   value of $fname is set to the value of the argument.
+#
+# ------------------------------------------------------------------------------
+
+sub fname {
+  $fname = $_[0] if @_;
+  return $fname;
+}
+
+#==========================================================================
+sub study{
+# Study statements and put attributes into array $statements
+# Attributes assigned:
+# $href->{content}       - What statement it is
+# $href->{decl}       - true if declaration,
+#                       5 means statement function
+#                       4 means USE statement,
+#                       2 means type decleration
+#                       3 means FORMAT statement
+#                       1 means the rest
+# $href->{in_contain} - true while in internal procedure(s)
+# $href->{exec}       - true if executable statement
+#                     - 2 means first executable statement in program unit
+#                     - 3 means last executable statement in program unit
+#                     - 23 means first and last executable statement in program unit
+# $href->{prog_unit}  - program unit number (numbered from 0)
+# $href->{number}     - statement number (numbered from 0)
+ 
+# Further attributes will be assigned later (action attributes)
+
+  my($statements,$prog_info) = @_;
+
+  our ($name,$nest_par);
+  my ($unit_name,@args,$prog_unit,$href,@punit,$current_punit);
+  my ($content,$decl,$exec);
+  my($type_def)=0;
+  my($unit_count)=-1;
+  @punit=();
+  $current_punit='';
+  my $number=-1;
+  my $in_contain=0;
+  my $in_interface=0;
+  my $contain_host='';
+  my $current_unit_name='';
+  our($study_called);
+#  if(! $study_called) {
+#    $$prog_info{has_interface_block}=0;
+#  }
+# Initial "parsing" loop
+
+  foreach $href (@$statements) {
+    $href->{in_contain}=$in_contain;
+    $href->{contain_host}=$contain_host if($in_contain);
+    $number++;
+    $_=$href->{statement};
+    $content='unknown';
+    my $content2='';
+    $decl=0;
+    $exec=0;
+
+    if($type_def) {
+ #     $href->{content}='typedef';
+    }
+    
+# Comment
+CRACK:    {
+      if(/^\s*(?:!|$)/) {
+	$content='comment';
+	last CRACK;
+      }
+
+      $_ = uc unless /^#/;
+      s/^\s*//;
+      s/\!.*\n/\n/g; # Remove trailing comments in all lines
+#      print "AA $_";
+ 
+# Program name statement 
+      if($content eq 'unknown' and ! $in_interface) {
+	$prog_unit=&parse_prog_unit(\$unit_name,\@args);
+	if($prog_unit) {
+          $current_unit_name=$unit_name;
+	  $content=uc($prog_unit);
+	  push(@punit,$prog_unit);
+	  $current_punit=$prog_unit;
+	  $unit_count++;
+	  if(! $study_called) {
+	    $$prog_info{'unit_name'}[$unit_count]=uc($unit_name);
+	    $$prog_info{'unit_name'}[$unit_count]=uc($unit_name);
+#	  $$prog_info{'tokens'}[$unit_count]=[];
+	    if($prog_unit eq 'module') {
+	      $$prog_info{'is_module'}=1;
+	      $$prog_info{'module_name'}=$unit_name;
+	    }
+	  }
+	  last CRACK;
+	}
+      }
+      if($content eq 'unknown') {
+	$decl=0;
+	$exec=1;
+# Executable constructs
+	&study_exec(\$content,$prog_info,\$study_called);
+	if($content eq 'IF') {
+	  s/^IF\s*$nest_par\s*//;
+	  &study_exec(\$content2,$prog_info,\$study_called);
+	}
+      }
+      
+
+      if($content eq 'unknown') {
+# Specification statemnts
+	$exec=0;
+	$decl=1;
+	if(/^USE\b/) {
+	  $content='USE';
+	  $decl=4;
+	}
+	elsif(/^INTEGER\b/) {
+	  $content='INTEGER';
+	  $decl=2;
+	}
+	elsif(/^REAL\b/) {
+	  $content='REAL';
+	  $decl=2;
+	}
+	elsif(/^LOGICAL\b/) {
+	  $content='LOGICAL';
+	  $decl=2;
+	}
+	elsif(/^CHARACTER\b/) {
+	  $content='CHARACTER';
+	  $decl=2;
+	}
+	elsif(/^DOUBLE\s*PRECISION\b/) {
+	  $content='DOUBLE PRECISION';
+	  $decl=2;
+	}
+	elsif(/^COMPLEX\b/) {
+	  $content='COMPLEX';
+	  $decl=2;
+	}
+	elsif(/^TYPE *\(/) {
+	  $content='type_decl';
+	  $decl=2;
+	}
+	elsif(/^ALLOCATABLE\b/) {
+	  $content='ALLOCATABLE';
+	}
+	elsif(/^COMMON\b/) {
+	  $content='COMMON';
+	}
+	elsif(/^DATA\b/) {
+	  $content='DATA';
+	}
+	elsif(/^DIMENSION\b/) {
+	  $content='DIMENSION';
+	}
+	elsif(/^EQUIVALENCE\b/) {
+	  $content='EQUIVALENCE';
+	}
+	elsif(/^EXTERNAL\b/) {
+	  $content='EXTERNAL';
+	}
+	elsif(/^\d+\s+FORMAT\b/) {
+	  $content='FORMAT';
+	  $decl=3;
+	}
+	elsif(/^IMPLICIT\b\s+NONE\b/) {
+	  $content='IMPLICIT NONE';
+	}
+	elsif(/^IMPLICIT\b/) {
+	  $content='IMPLICIT';
+	}
+	elsif(/^INTENT\b/) {
+	  $content='INTENT';
+	}
+	elsif(/^INTRINSIC\b/) {
+	  $content='INTRINSIC';
+	}
+	elsif(/^NAMELIST\b/) {
+	  $content='NAMELIST';
+	}
+	elsif(/^OPTIONAL\b/) {
+	  $content='OPTIONAL';
+	}
+	elsif(/^PARAMETER\b/) {
+	  $content='PARAMETER';
+          $decl = 2;
+	}
+	elsif(/^POINTER\b/) {
+	  $content='POINTER';
+	}
+	elsif(/^PUBLIC\b/) {
+	  $content='PUBLIC';
+	}
+	elsif(/^PRIVATE\b/) {
+	  $content='PRIVATE';
+	}
+	elsif(/^SAVE\b/) {
+	  $content='SAVE';
+	}
+	elsif(/^TARGET\b/) {
+	  $content='TARGET';
+	}
+	elsif(/^SEQUENCE\b/) {
+	  $content='SEQUENCE';
+	}
+	elsif(/^INTERFACE\b/) {
+	  $content='INTERFACE';
+	  if(! $study_called) {
+	    $$prog_info{has_interface_block}=1;
+	    $in_interface=1;
+	  }
+	}
+	elsif(/^END ?INTERFACE\b/) {
+	  $content='END INTERFACE';
+	    $in_interface=0;
+	}
+	elsif(/^TYPE *[^\( ]/i) {
+	  $content='type_def';
+	  $type_def=1;
+	}
+	elsif(/^END\s*TYPE\b/){
+	  $content='type_def';
+	  $type_def=0;
+	}
+        elsif( $in_interface ) {
+          if(/^MODULE PROCEDURE\b/) {
+            $content='MODULE PROCEDURE';
+          }
+        }
+      }
+# Other constructs
+      if($content eq 'unknown') {
+	$decl=0;
+	$exec=0;
+	
+	if(/^CONTAINS\b/) {
+	  $content='CONTAINS';
+	  $in_contain=1;
+          $contain_host=uc($current_unit_name);
+	  if(! $study_called) {
+	    $$prog_info{has_contain}=1;
+	    $$prog_info{containing}=1;
+	  }
+	}
+	elsif(/^(?:INCLUDE|#include)\b/) {
+	  $content='include';
+	  if(! $study_called) {
+	    $$prog_info{has_include}=1;
+	  }
+	}
+	elsif(/^\#/) {
+	  $content='cpp';
+	}
+	elsif(/^\@/) {
+	  $content='compiler_directive';
+	}
+	
+	else{
+	  if(/^END\b/ and ! $in_interface) {
+	    $prog_unit=pop(@punit);
+	    $content='END '.uc($prog_unit);
+	    if($in_contain) {
+	      unless(@punit) {
+		$unit_count=0;
+		$href->{in_contain}=0;
+		$in_contain=0;
+	      }
+	    }
+	  }
+	} 
+      }
+    }
+    
+    if($in_interface and $content ne 'INTERFACE') {
+      $content='in_interface';
+      $exec=0;
+      $decl=1;
+    }
+
+#    print "BB $unit_count $content $_";
+    if($content  eq 'unknown') {
+      print STDERR $fname, ': failed to crack statement starting at line ',
+                   $href->{first_line}, ', - syntax error?', "\n";
+      print STDERR ' ', $_, "\n";
+#      print STDERR "study_called $study_called in_interface $in_interface \n";
+#      print STDERR Dumper($statements);
+      #die "Failed in study";
+    }
+#    unless($content eq 'comment') {
+#      my @tmpvar=/\b$name\b/g;
+#      my $i=0;
+#      foreach my $tmp (@tmpvar){ 
+#	$href->{'tokens'}[$i]=$tmp;
+#	$i++;
+#	if(! $study_called and $unit_count > -1) {
+#	  $$prog_info{'token_hash'}[$unit_count]{$tmp}++;
+#	}
+#      }
+#    }
+               
+    $href->{content}=$content;
+    $href->{content2}=$content2 if($content2);
+    $href->{decl}=$decl;
+    $href->{exec}=$exec;
+#    $href->{type_decl}=$type_decl;
+    $href->{prog_unit}=$unit_count;
+    $href->{number}=$number;
+    unless($content eq 'comment') {
+      $href->{multi_line} = 1 if(tr/\n// > 1);
+    }
+  }
+
+
+# Find first executable statement in each program unit
+# Also repair statement functions wrongly assigned as executable
+  my $prev_unit_count=-2;
+  my $stat_func_suspicion=0;
+  my @lastexec=();
+
+  foreach $href (@$statements) {
+    $exec=$href->{exec};
+    $unit_count=$href->{prog_unit};
+    if($exec) {
+      if($unit_count > $prev_unit_count) {
+	$content=$href->{content};
+	if($content eq 'array_assign') {
+	  $stat_func_suspicion=1;
+	  $_=$href->{statement};
+	  if(/^\s*$name\s*\(\s*:/){
+	    $stat_func_suspicion=0;
+#	    print " A $_";
+	   } 
+	  elsif(/^\s*$name\s*\(\s*$name\s*:/){
+	    $stat_func_suspicion=0;
+#	    print " B $_";
+	  } 
+	  elsif(/^\s*$name\s*\(\s*\d+/){
+	    $stat_func_suspicion=0;
+#	    print " C $_";
+	  }
+	  else {
+	    $href->{exec}=0;
+	    $href->{decl}=5;
+	    $href->{content}='statmf';
+#	    print " D $_";
+	    next;
+	  }
+	}
+	$href->{exec}=2;
+	$prev_unit_count=$unit_count;
+	$content=$href->{content};
+      }
+      $lastexec[$unit_count]=$href->{number}  unless ($unit_count < 0);  
+# No prog_unit assigned, include file?
+    }
+  }
+
+# Assign last executable statement
+  if(@lastexec) {
+    foreach my $last (@lastexec) {
+      if(defined ($last)) {
+	if($$statements[$last]->{exec} == 1) {
+	  $$statements[$last]->{exec}=3;
+	}
+	else{
+	  $$statements[$last]->{exec}=23;
+	}      
+      }
+    }
+  }
+# Consistency checks
+  my $fail=0;
+  my $prev_exec=0;
+  $prev_unit_count=-1;
+  foreach $href (@$statements) {
+    $content=$href->{content};
+    next if($content eq 'comment');
+    $unit_count=$href->{prog_unit};
+    $exec=$href->{exec};
+    $decl=$href->{decl};
+    if($unit_count == $prev_unit_count) {
+      if($decl and $prev_exec) {
+	unless ($content eq 'FORMAT' | $content eq 'DATA' ) {
+          die $fname, ': declaration after executable statement', "\n",
+              $href->{first_line}, ' ', $href->{statement}, "\n";
+	}
+      }
+    }
+    $prev_unit_count=$unit_count;
+    $prev_exec=$exec;
+  }
+
+  $study_called=1;
+}
+
+#==========================================================================
+sub study_exec{
+  my($content,$prog_info,$study_called) = @_;
+  our ($name,$nest_par);
+  if(/^(\w+\s*:\s*)*IF\s*$nest_par\s*THEN/) {
+    $$content='IF_construct';
+  }
+  elsif(/^ELSE\s*IF\s*\(/) {
+    $$content='ELSEIF';
+  }
+  elsif(/^ELSE\b\s*($name)*/) {
+    $$content='ELSE';
+  }
+  elsif(/^END\s*IF\b\s*($name)*/) {
+    $$content='ENDIF';
+  }
+  elsif(/^(?:\d+\s+)?($name\s*:\s*)*DO(\s+WHILE)?\b/) {
+    $$content='DO';
+  }
+  elsif(/^(?:\d+\s+)?END\s*DO\b/) {
+    $$content='ENDDO';
+  }
+  elsif(/^(?:\d+\s+)?ALLOCATE\b/) {
+    $$content='ALLOCATE';
+  }
+  elsif(/^ASSIGN\b/) {
+    $$content='ASIGN';
+  }
+  elsif(/^(?:\d+\s+)?BACKSPACE\b/) {
+    $$content='BACKSPACE';
+  }
+  elsif(/^(?:\d+\s+)?CALL\b/) {
+    $$content='CALL';
+    if(!$$study_called) {
+      $$prog_info{no_calls}++;
+    }
+  }
+  elsif(/^(?:\d+\s+)?CLOSE\b/) {
+    $$content='CLOSE';
+  }
+  elsif(/^(?:\d+\s+)?CONTINUE\b/) {
+    $$content='CONTINUE';
+  }
+  elsif(/^(?:\d+\s+)?CYCLE\b/) {
+    $$content='CYCLE';
+  }
+  elsif(/^(?:\d+\s+)?DEALLOCATE\b/) {
+    $$content='DEALLOCATE';
+  }
+  elsif(/^ENDFILE\b/) {
+    $$content='ENDFILE';
+  }
+  elsif(/^(?:\d+\s+)?EXIT\b/) {
+    $$content='EXIT';
+  }
+  elsif(/^(?:\d+\s+)?GO\s*TO\b/) {
+    $$content='GOTO';
+  }
+  elsif(/^(?:\d+\s+)?IF\s*\(/) {
+    $$content='IF';
+  }
+  elsif(/^(?:\d+\s+)?INQUIRE\b/) {
+    $$content='INQUIRE';
+  }
+  elsif(/^(?:\d+\s+)?NULLIFY\b/) {
+    $$content='NULLIFY';
+  }
+  elsif(/^(?:\d+\s+)?OPEN\b/) {
+    $$content='OPEN';
+  }
+  elsif(/^(?:\d+\s+)?PAUSE\b/) {
+    $$content='PAUSE';
+  }
+  elsif(/^(?:\d+\s+)?PRINT\b/) {
+    $$content='PRINT';
+  }
+  elsif(/^(?:\d+\s+)?(?:READ|BUFFER\s*IN)\b/) {
+    $$content='READ';
+  }
+  elsif(/^(?:\d+\s+)?RETURN\b/) {
+    $$content='RETURN';
+  }
+  elsif(/^(?:\d+\s+)?REWIND\b/) {
+    $$content='REWIND';
+  }
+  elsif(/^(?:\d+\s+)?STOP\b/) {
+    $$content='STOP';
+  }
+  elsif(/^(?:\d+\s+)?(?:WRITE|BUFFER\s*OUT)\s*\(/) {
+    $$content='WRITE';
+  }
+  elsif(/^(?:\d+\s+)?($name\s*:\s*)*SELECT\s*CASE\b/) {
+    $$content='SELECT CASE';
+  }
+  elsif(/^(?:\d+\s+)?CASE\b/) {
+    $$content='CASE';
+  }
+  elsif(/^(?:\d+\s+)?END\s*SELECT\b/) {
+    $$content='END SELECT';
+  }
+  elsif(/^(?:\d+\s+)?WHERE\s*$nest_par\s*$name.*=/) {
+    $$content='WHERE';
+  }
+  elsif(/^(?:\d+\s+)?WHERE\s*\(/) {
+    $$content='WHERE_construct';
+  }
+  elsif(/^ELSE\s*WHERE\b/) {
+    $$content='ELSEWHERE';
+  }
+  elsif(/^END\s*WHERE\b/) {
+    $$content='ENDWHERE';
+  }
+  elsif(/^(?:\d+\s+)?FORALL\s*\(/) {
+    $$content='FORALL';
+  }
+  elsif(/^END\s*FORALL\b/) {
+    $$content='ENDFORALL';
+  }
+  elsif(/^(?:\d+\s+)?$name(?:\s*%\s*$name)*\s*=/o) {
+    $$content='scal_assign';
+  }
+  elsif(/^(?:\d+\s+)?$name(?:\s*$nest_par)*(?:\s*%\s*$name(?:\s*$nest_par)?)*\s*=/o) {
+    $$content='array_assign';
+  }
+}
+#===================================================================================
+sub pre_tidy {
+
+# Initial tidying to make the rest work
+
+  my($lines)=@_;
+  foreach (@$lines) {
+
+# Substitute tab with four blanks
+    s/\t/    /g;
+    s/^ *INTEGER /INTEGER_M /i;
+    s/^ *REAL /REAL_B /i;
+  }
+}
+#==========================================================================
+sub remove_macro {
+
+# Remove INTEGER_M, _ONE_ etc. macros and replace by expanded statement
+
+  my($lines)=@_;
+
+  my($im)=1; # Until I start checking include files
+  my($ia)=0;
+  my($ib)=0;
+  my($rb)=1; # Until I start checking include files
+  my($is)=0;
+  my($rh)=0;
+  my($rm)=0;
+  my(@pars,$string);
+  for (@$lines) {
+    next if(/^ *$/ | /^ *!/);
+# The following two substitutions should be restored at end of processing
+    s/(\'[^!]*)!+(.*\')/$1\£$2/;   # Protect against mischief 
+    s/(["][^!]*)!+(.*["])/$1\£$2/;      # Protect against mischief
+    $im=$im+/JPIM\b/i unless($im);
+    $rb=$rb+/JPRB\b/i unless($rb);
+    $rm=$rm+/JPRM\b/i unless($rm);
+    $im=$im+s/\bINTEGER_M\b/INTEGER(KIND=JPIM)/o;
+    $ia=$ia+s/\bINTEGER_A\b/INTEGER(KIND=JPIA)/o;
+    $ib=$ib+s/\bINTEGER_B\b/INTEGER(KIND=JPIB)/o;
+    $is=$is+s/\bINTEGER_S\b/INTEGER(KIND=JPIS)/o;
+    $rb=$rb+s/\bREAL_B\b/REAL(KIND=JPRB)/o;
+    $rh=$rh+s/\bREAL_H\b/REAL(KIND=JPRH)/o;
+    $rm=$rm+s/\bREAL_M\b/REAL(KIND=JPRM)/o;
+    $rb=$rb+s/\b_ZERO_\b/0.0_JPRB/og;
+    $rb=$rb+s/\b_ONE_\b/1.0_JPRB/og;
+    $rb=$rb+s/\b_TWO_\b/2.0_JPRB/og;
+    $rb=$rb+s/\b_HALF_\b/0.5_JPRB/og;
+  }
+  @pars=();
+  push(@pars,"JPIM") if $im;
+  push(@pars,"JPRB") if $rb;
+  push(@pars,"JPRM") if $rm;
+  push(@pars,"JPIA") if $ia;
+  push(@pars,"JPIB") if $ib;
+  push(@pars,"JPIS") if $is;
+  ($string=join('     ,',@pars))=~s/ *$//;
+  for (@$lines) {
+    next unless (/^\#/);
+    if(@pars) {
+      s/^#include +"tsmbkind.h"/USE PARKIND1  ,ONLY : $string/ ;
+    }
+    else {
+      s/^#include +"tsmbkind.h"//;
+    }
+#    if($rh) {
+      s/^#include +"hugekind.h"/USE PARKIND2  ,ONLY : JPRH/ ;
+#    }
+#    else {
+#      s/^#include +"hugekind.h"// ;
+#    }
+  }
+}
+
+#==========================================================================
+sub readfile  {
+# Read file 
+  my($fname)=@_;
+  my(@lines);
+  if(!open(INFIL,$fname)) {
+    print STDERR "Can't open $fname for reading\n";
+    die("Can't open $fname for reading\n");
+  }
+  @lines=<INFIL>;
+  close INFIL;
+  (@lines);
+}
+
+#==========================================================================
+sub writefile  {
+# Write file
+  my($fname,$lines)=@_;
+  if(!open(OUTFIL,">".$fname)) {
+    print STDERR "Can't open $fname for writing\n";
+    exit;
+  }
+  print OUTFIL @$lines;
+  close OUTFIL;
+}
+
+#==========================================================================
+sub expcont {
+#
+# Expand continuation lines into statements for free-format Fortran while
+# maintaining line-breaking and all comments
+# Put statements onto array of references to anonymous hashes as key 'statement'
+# Also put into the hash the linenumber of first line of statement as key 'first_line'
+  my ($lines, $statements) = @_;
+  my ($statm, $first_line);
+
+  my $prev        = 0;
+  my $line_number = 0;
+
+  for (@$lines) {
+    $line_number++;
+
+    s/^([^'"]*)(?:\s*!.*)$/$1/; # Remove trailing comments
+
+    s/^(\s*)&(.*)$/$1$2/s;
+
+    if (!/^\s*!.*$/ && /^.+?&(?:\s*!.*)*\s*$/) {
+      s/(.+?)&(.+)/$1\n/s;
+
+      $statm     .= $_;
+      $first_line = $line_number unless $prev;
+      $prev       = 1;
+      next;
+
+    } elsif ($prev && /^\s*(?:!|$)/) { # ignore blank/comment lines
+      next;
+
+    } else {
+      s/!.*?$//;
+
+      $statm     .= $_;
+      push @$statements, {
+        'statement'  => $statm,
+        'first_line' => $prev ? $first_line : $line_number,
+      };
+
+      $statm = "";
+      $prev  = 0;
+    }
+  }
+}
+#==========================================================================
+
+sub cont_lines {
+#
+# Put back continuation character in correct place and execute delayed actions
+#
+  my($statements,$lines,$line_hash) = @_;
+  my(@temp,$i,$iup,$href);
+
+
+# Put back continuation characters and split statements into lines as they were
+  @$lines=();
+  @$line_hash=();
+  foreach $href (@$statements) {
+    $_=$href->{statement};
+    if (/\n.*\n/){                      # This is a multi-line statement
+      @temp=split /\n/;                 # Split statement into lines (removes EOL)
+      $iup=scalar(@temp);               # Number of lines in statement
+      for ($i=0;$i < $iup;$i++) {       # Loop through lines
+	$_=$temp[$i];
+	if($i == 0 ){                   # First line
+	  if(/^([^!]+)(!.*)$/) {        # Line has trailing comment
+	    s/^([^!]+)(!.*)$/$1&$2\n/;  # Put back & at end of line before comment
+	  }
+	  else {                        # No trailing comment
+	    s/^([^!]+)$/$1&\n/;         # Put back & and EOL at end of line
+	  }	    
+	}
+	elsif ($i == ($iup-1)) {        # Last line
+	  s/^( *)(.*)$/$1& $2 \n/;      # Put back & at beginning of line
+	}
+	else {                          # Other lines
+	  if (/^ *!/) {                 # Line is comment line
+	    $_=$_."\n";                 # Restore EOL for comments
+	  }
+	  else {
+	    if(/^( *)([^!]*)(!.*)$/) {  # Line has trailing comment
+	      s/^( *)([^!]*)(!.*)*$/$1& $2&$3\n/;  # & at beginning and end of line
+	    }
+	    else {                      # No trailing comment
+	      s/^( *)([^!]*)$/$1& $2&\n/; # & at beggining and end of line
+	    }	 
+	  }  
+	}
+	if($i == 0        && exists $href->{pre_insert}) {
+	  my @templines=split('\n',$href->{pre_insert});
+	  foreach my $tline (@templines) {
+	    my $rec={};
+	    $rec->{'content'}='unknown';
+	    $rec->{'line'}=$tline."\n";
+	    push(@$lines,$rec->{'line'});
+	    push(@$line_hash,$rec);
+	  }
+	}
+	unless(exists $href->{remove}) {
+	  my $rec={};
+	  $rec->{'line'}=$_;
+	  if($i == 0) {
+	    $rec->{'content'}=$href->{content};
+	  }
+	  else {
+	    $rec->{'content'}='cont_line';
+	  }
+	  push(@$lines,$rec->{'line'});
+	  push(@$line_hash,$rec);
+	}
+	if($i == ($iup-1) && exists $href->{post_insert}) {
+	  my @templines=split('\n',$href->{post_insert});
+	  foreach my $tline (@templines) {
+	    my $rec={};
+	    $rec->{'content'}='unknown';
+	    $rec->{'line'}=$tline."\n";
+	    push(@$lines,$rec->{'line'});
+	    push(@$line_hash,$rec);
+	  }
+	}
+      }
+    }
+    else {  # Not multiline statement
+      if(exists $href->{pre_insert}) {
+	my @templines=split('\n',$href->{pre_insert});
+	foreach my $tline (@templines) {
+	  my $rec={};
+	  $rec->{'content'}='unknown';
+	  $rec->{'line'}=$tline."\n";
+	  push(@$lines,$rec->{'line'});
+	  push(@$line_hash,$rec);
+	}
+      }
+      unless(exists $href->{remove}) {
+	my $rec={};
+	$rec->{'line'}=$_;
+	$rec->{'content'}=$href->{content};
+	push(@$lines,$rec->{'line'});
+	push(@$line_hash,$rec);
+#	print $rec;
+      }
+      if(exists $href->{post_insert}) {
+	my @templines=split('\n',$href->{post_insert});
+	foreach my $tline (@templines) {
+	  my $rec={};
+	  $rec->{'content'}='unknown';
+	  $rec->{'line'}=$tline."\n";
+	  push(@$lines,$rec->{'line'});
+	  push(@$line_hash,$rec);
+	}
+      }
+    }
+  }
+}
+#==========================================================================
+sub getvars {
+# Return list of locally declared variables with type and scope information
+# 
+  my($statements,$prog_info,$vars,$use_vars) = @_;
+  my ($test,$type,@vars1,$func,$prog_unit,$dum,$tmp_name,@pu_args);
+  my ($preserve,$rank,$href);
+  our($nest_par,$name);
+
+  %$vars=();
+  $func="";
+  $prog_unit=0;
+  %$use_vars=();
+  foreach $href (@$statements) {
+    next if($href->{content} eq 'comment');           # Skip comments
+    next if($href->{exec});                        # Don't look in executable statements
+    next if($$prog_info{is_module} and ! $href->{in_contain}); # Unless inside CONTAIN skip module 
+    $prog_unit=$href->{prog_unit};
+    if($href->{content} eq 'FUNCTION') {
+      $_=$href->{statement};
+      my $dum=&parse_prog_unit(\$func,\@pu_args);          # Get name of FUNCTION
+#      print "GETVARS FUNCTION $func \n";
+      $func=uc($func);
+    }
+    if($href->{decl} == 2 or $href->{content} eq 'EXTERNAL'){  # Real parse starts
+      $_=$href->{statement};
+      $_=uc($_);                                   # Upcase to avoid /.../i
+      s/^ *//;                                     # remove leading blanks
+      if($href->{decl} == 2) {
+	$type=lc(substr($href->{content},0,1));
+      }
+      else {
+	$type='e';
+      }
+      s/\!.*\n/\n/g;                               # Remove trailing comments in all lines
+      $preserve=$_;
+      s/(.+)::(.+)/$2/s;                           #REAL(KIND=JPRB) :: zsig(:) -> zsig(:),
+      s/^EXTERNAL (.+)$/$1/;
+      s/\s+//g;                                    # Remove all white-space
+      if($href->{content} eq 'CHARACTER') {
+	s/($name)\*\d+/$1/g;
+	s/($name)\*$nest_par/$1/g;
+	s/($name)$nest_par\*\w+/$1/g;
+      }
+      s#=\(/.+/\)##;      # ZVAL(1:2)=(/1.0,2.0/) -> ZVAL(1:2)
+#?      s/=[^,\n]+//g;
+      s/$nest_par//g;     # ISEC3(SIZE(NSEC3)),ISEC4(SIZE(NSEC4)) -> ISEC3,ISEC4
+      s/=\w+//g;          # ZVAL=1.0 -> ZVAL
+      s@/.*/@@;           # What?
+      @vars1=split(',',$_);
+      for(@vars1) {
+	next unless /^$name$/;          # A bit of security
+	if($preserve =~ /\b$_\b *\(/ | $preserve =~ /DIMENSION/) {
+	  $rank=1;        # Variable is array
+	}
+	else {
+	  $rank=0;        # Variable is scalar
+	}
+	if($_ eq $func) {
+	  $$vars{$_}{type_spec}="f";
+	} 
+	else {
+	  if($href->{content} eq 'FUNCTION') {
+	    $$vars{$_}{type_spec}='f';
+	  }
+	  else {
+	    $$vars{$_}{type_spec}=$type;
+	  }
+	}
+	$$vars{$_}{scope}=$prog_unit;
+	$$vars{$_}{rank}=$rank;
+	$$vars{$_}{usage}='local';
+      }
+    }
+# Perhaps the variable is really a statement function?
+    if($href->{decl} == 5) {
+      $_=$href->{statement};
+      s/\s+//g;                                    # Remove all white-space
+      /^($name)\((.+)\)=/i;
+      my $tvar=uc($1);
+      my @stmf_args=split(',',$2);
+      if (exists($$vars{$tvar})) {
+	$$vars{$tvar}{type_spec}='s';
+#	print "STATMF OK $tvar \n ";
+      }
+      for (@stmf_args) {
+	if (exists($$vars{$_})) {
+	  $$vars{$_}{type_spec}='s';
+#	  print "STATMF ARG OK $_ \n ";
+	}
+      }
+    }
+  }
+# Perhaps instead the variable is a declaration of an external function?
+  my @extract=();                  # Extract part of statements for efficiency
+  foreach $href (@$statements) {
+    if($href->{exec}) {                 # Function call must be in executable stat.
+      next if($href->{content} eq 'CALL'); # A call can't contain an undeclared function
+      push(@extract,$href->{statement});
+    }
+  }
+  
+  foreach my $var (keys (%$vars)) {
+    next if($$vars{$var}{rank} > 0);   # Can't be a function if rank > 0
+    next if($$vars{$var}{type_spec} eq 's' | $$vars{$var}{type_spec} eq 'f');
+    my $dec_unit=$$vars{$var}{scope};
+    my $regex1=qr/\b$var\b\s*\(/i;      # As var's rank=0 this could be function call
+    for(@extract) {
+      if(/${regex1}/) {
+	s/\!.*\n/\n/g;                       # Remove trailing comments in all lines
+	s/\s+//g;                            # Remove all white-space
+	if(/${regex1}/) {
+	  if($$vars{$var}{type_spec} eq 'c') {   # Avoid CLVAR(1:3) etc.
+	    next if(/${regex1}\s*(\d+|$name)*\s*:\s*(\d+|$name)*\s*\)/);
+	  }
+#	  print "TYPE changed to function $var $_ \n";
+	  $$vars{$var}{type_spec}='f';
+	  last;
+	}
+      }
+    }
+  }
+# ---------------------------------------------------------------------
+# Assign  "usage" in Doctor sense to variable (default usage is 'local')
+# 
+  foreach $href (@$statements) {
+# Is the varaible a dummy argument
+    if($href->{content} eq 'FUNCTION' or $href->{content} eq 'SUBROUTINE') {
+      $_=$href->{statement};
+      @pu_args=();
+      my $dum=&parse_prog_unit(\$func,\@pu_args);   # Get arguments
+      for(@pu_args) {
+	if( exists $$vars{$_} ) {
+	  if($$vars{$_}{scope} == $href->{prog_unit}) {
+	    $$vars{$_}{usage}='arg';
+	  }
+
+	} else {
+          print STDERR "Argument $_ has not got a corresponding declaration " .
+                       "statement\n";
+          print STDERR "Bailing out at this point\n";
+          die "Bailing out";
+	}
+      }
+    }
+# Does the variable appear in a NAMELIST
+# We want to distinguish this for more lenient Doctor check
+    if($href->{content} eq 'NAMELIST') {
+      $_=$href->{statement};
+      s/\!.*\n/\n/g;     # Remove trailing comments in all lines
+      s/\s+//g;          # Remove all white-space
+      m:NAMELIST/\w+/(.+):;
+      my @namvars=split(',',uc($1));
+      for (@namvars) {
+	if( exists $$vars{$_} ) {
+	  if($$vars{$_}{scope} == $href->{prog_unit}) {
+	    $$vars{$_}{usage}='namvar';
+	  }
+	}
+      }
+    }
+    if(exists $href->{inc_statm}) { # We also have to look in include files
+      my $incs=$href->{inc_statm};
+      foreach my $hrefi (@$incs) {
+	if($hrefi->{content} eq 'NAMELIST') {
+	  $_=$hrefi->{statement};
+	  s/\!.*\n/\n/g;     # Remove trailing comments in all lines
+	  s/\s+//g;          # Remove all white-space
+	m:NAMELIST/\w+/(.+):;
+	  my @namvars=split(',',uc($1));
+	  for (@namvars) {
+	    if( exists $$vars{$_} ) {
+	      if($$vars{$_}{scope} == $href->{prog_unit}) {
+		$$vars{$_}{usage}='namvar';
+	      }
+	    }
+	  }
+	}
+      }
+    }
+  }
+# -----------------------------------------------------------------------------
+# Find use variables
+  my %use_count=();
+  foreach $href (@$statements) {
+    if($href->{content} eq 'USE') {
+      $prog_unit=$href->{prog_unit};
+      $_=$href->{statement};
+      s/\!.*\n/\n/g;                               # Remove trailing comments in all lines
+      s/\s+//g;                                    # Remove all white-space
+      $_=uc($_);                                   # Upcase to avoid /.../i
+      if(/^USE($name),ONLY:(.+)$/){
+	my $modname=$1;
+	if( exists $use_count{$modname}) {
+	  if($prog_unit == $use_count{$modname}) {
+	    print STDERR "-> $href->{statement}";
+            print STDERR "USE $modname appears more than once in program unit $prog_unit \n\n";
+
+	  }
+	}
+	$use_count{$modname} = $prog_unit;
+	my @usevars = split /,/ ,$2;
+	my %usevars=();
+	foreach my $usevar (@usevars) {
+	  $usevars{$usevar}++;
+	  $$use_vars{$usevar}{module}=$modname;
+	  $$use_vars{$usevar}{scope}=$prog_unit;
+	  $$use_vars{$usevar}{count}++;
+	}
+	foreach my $usevar (keys (%usevars)) {
+	  if($usevars{$usevar} >1) {
+	    print STDERR "DUPLICATE USE ONLY VARIABLE ",
+	    "$modname $usevar $prog_unit \n";
+	    $_=$href->{statement};
+	    s/\b$usevar\b//i;
+	    s/,\s*,/,/;
+	    s/,\s*\n$/\n/;
+	    s/\n *\n/\n/;
+	    s/^(.+:\s*),/$1/;
+	    $href->{statement}=$_;
+	  }
+	}
+      }
+      else {
+#	print "WARNING:USE without ONLY \n";
+      }
+    }
+  }
+}
+#==========================================================================
+sub find_unused_vars {
+# Find declared variables not used
+  my($statements,$vars,$unused_vars,$use_vars,$unused_use_vars) = @_;
+  my ($var,@tokens,$href);
+  @tokens=();
+# Find all tokens in file
+  foreach $href (@$statements) {
+    next if($href->{content} eq 'comment');
+    if(exists $href->{inc_statm}) {  # Look also in include files
+      my $incs=$href->{inc_statm};
+      foreach my $hrefi (@$incs) {
+	die "FUV $href->{content} $href->{statement}" unless exists $hrefi->{statement};
+	$_=$hrefi->{statement};
+	if(/\b[a-zA-Z]\w*\b/) {
+	  push(@tokens,/\b[a-zA-Z]\w*\b/g);
+	}
+      }
+    }
+    else {
+      $_=$href->{statement};
+      push(@tokens,/\b[a-zA-Z]\w*\b/g);
+    }
+  }
+  @tokens= map {uc} @tokens; # Upcase array of tokens, the variables are upper-case
+
+# Find out how many times the variable appears in array tokens
+  foreach $var (keys (%$vars)) {
+    $$vars{$var}{uses}=0;
+  }
+  foreach $var (keys (%$use_vars)) {
+    $$use_vars{$var}{uses}=0;
+  }
+  for (@tokens) {
+    if(exists($$vars{$_})){
+      $$vars{$_}{uses}++; 
+    }
+    if(exists($$use_vars{$_})){
+      $$use_vars{$_}{uses}++; 
+    }
+  }
+# If it appears only one time (which must be in a declaration) it is unused
+  @$unused_vars=();
+  foreach $var (keys (%$vars)) {
+    push(@$unused_vars,$var) if($$vars{$var}{uses} < 2);
+  }
+  @$unused_use_vars=();
+  foreach $var (keys (%$use_vars)) {
+    push(@$unused_use_vars,$var) if($$use_vars{$var}{uses} < 2);
+  }
+}
+#==========================================================================
+sub remove_unused_vars {
+# Does what it says on the tin
+  my($statements,$unused_vars,$unused_use_vars) = @_;
+  my ($var,$href);
+  our $nest_par;
+  for (@$unused_vars) {
+    $var=$_;
+    foreach $href (@$statements) {
+      $_=$href->{statement};
+      next unless(($href->{decl}) | ($href->{content} eq 'comment'));
+      if($href->{content} eq 'comment') {
+	next unless(/^ *!\$OMP/);
+      }
+      if(/\b$var\b/i) {
+#	print $_;
+	
+	if(/\b$var\b *\(/i) {
+#	  print "ZYZ $var $_";
+	  s/\b$var\b *$nest_par *(=\s*\(\/.*\/\))*//si;
+#	  print "ZZZ $var $_";
+	}
+	s/\b$var\b\s*=\s*\d+(\.\d*)*//i;
+	s/\b$var\b *(\* *\d+)*//i if($href->{content} eq 'CHARACTER') ;
+	s/\b$var\b//i; 
+#	print $_;
+        s/^.+:: *\n$//;
+        s/^.+:: *\!.*\n$//;
+#	print $_;
+        s/,\s*,/,/;
+#	print $_;
+	s/, *\n$/\n/;
+#	print $_;
+        s/(::\s*),(.+)$/$1$2/s;
+        s/\n *\n/\n/;
+        s/\n *!.*\n/\n/;
+	s/, *\n$/\n/;
+# Remove "empty" lines
+        s/^.+::\s*$//;
+        s/^.+::\s*=.*$//;
+        s/^.+::\s*!.*$//;
+#	print $_;
+        s/^CHARACTER *\*\d+ *\n$//i if($href->{content} eq 'CHARACTER') ;
+	$href->{statement}=$_;
+      }
+    }
+  }
+  for (@$unused_use_vars) {
+    $var=$_;
+    foreach $href (@$statements) {
+      next unless($href->{decl} == 4);
+      $_=$href->{statement};
+      next if(/PARKIND/); #I am sure this could be done betterh
+
+      if(/\b$var\b/i) {
+	s/\b$var\b//i;
+        s/,\s*,/,/;
+        s/,\s*\n$/\n/;
+        s/\n *\n/\n/;
+	s/^(.+:\s*),/$1/;
+	s/^.+:\s*$//;
+	$href->{statement}=$_;
+      }
+    }
+  }
+}
+#==========================================================================
+sub tidy_decl {
+# Tidy up declarions
+  my($statements) = @_;
+  my($href,$content);
+
+  foreach $href (@$statements) {
+    next unless($href->{decl} == 2);
+    $_=$href->{statement};
+    $content=$href->{content};
+    
+    if($content eq 'CHARACTER') {
+      s/CHARACTER *\* *(\w+)/CHARACTER \(LEN = $1\)/i; 
+      s/CHARACTER *\* *\(\*\)/CHARACTER \(LEN = \*\)/i;
+      s/CHARACTER *\* *\( *(\w+) *\)/CHARACTER \(LEN = $1)/i;
+    }
+    if($content eq 'INTEGER') {
+      if(/^ *INTEGER[^\(]/i) {
+	s/INTEGER\b/INTEGER(KIND=JPIM)/;
+      }
+    }
+    unless (/::/) {
+      s/^( *LOGICAL )/$1:: /i;
+      s/^( *INTEGER\(KIND=JPI\w\) )/$1:: /;
+      s/^( *REAL\(KIND=JPR\w\) )/$1:: /;
+      if(/^ *CHARACTER/i) {
+	if( s/^( *CHARACTER *\( *LEN *= *\w+ *\))/$1 :: /i) {
+	  $href->{statement}=$_;
+	  next;
+	}
+	if(s/^( *CHARACTER *\( *LEN *= *\* *\))/$1 :: /i) {
+	  $href->{statement}=$_;
+	  next;
+	}
+	s/^( *CHARACTER )/$1:: /i;
+      }
+    }
+    $href->{statement}=$_;
+  }
+}
+#==========================================================================
+
+sub doctor_viol {
+# Find Doctor violations
+
+  my($vars,$fix_doc) = @_;
+  my ($var,$type,$zz,$prog_unit,$usage);
+  %$fix_doc=();
+
+  foreach $var (keys (%$vars)) {
+    $type=$$vars{$var}{type_spec};
+    $prog_unit=$$vars{$var}{scope};
+    $usage=$$vars{$var}{usage};
+#    print "DOC $var $type $prog_unit $usage \n";
+    if($zz=&doc_char($type,$usage,$var)) {
+#      print "DOCTOR VIOL - ",$var," $type $zz $prog_unit\n";
+      $$fix_doc{$var}=$zz.'_'.$var.','.$prog_unit
+    }
+  }  
+}
+#==========================================================================
+
+sub fix_doctor_viol {
+# Fix Doctor violations
+  my($statements,$fix_doc) = @_;
+  my($doc_viol,$repl,$prog_unit,$cur_prog_unit,@allowed,$href,$content);
+  my($tmp_name,@pu_args);
+
+  @allowed=('NRGRI'); # Hack
+
+  VIOL:foreach $doc_viol (keys (%$fix_doc)) {
+    # Let's allow some violations
+    for (@allowed){ 
+      next VIOL if($doc_viol eq $_);
+    }
+
+    ($repl,$prog_unit)=split(',',$$fix_doc{$doc_viol});
+
+    print "FIX $repl $prog_unit \n";
+    foreach $href (@$statements) {
+      $content=$href->{content};
+      $_=$href->{statement};
+      if($href->{content} eq 'comment') {
+	next unless(/^ *!\$OMP/);
+      }
+      $cur_prog_unit=$href->{prog_unit};
+      if($prog_unit == $cur_prog_unit) {  # Could be fine in other program units
+	if(/\b$doc_viol\b/i) {
+	  s/%$doc_viol\b/_X_$doc_viol/ig; # Protect type-components
+	  s/\b$doc_viol\b/$repl/ig;
+	  s/_X_$doc_viol\b/%$doc_viol/ig; # Restore type-components
+	}
+      }
+      $href->{statement}=$_;
+    }
+  }
+  
+}
+#==========================================================================
+sub various{
+# 
+  my($statements,$prog_info,$vars) = @_;
+  my($punit,@args,$tmp_name,$cont,$statm);
+  my($href,$exec);
+  our $nest_par;
+#------------------------------------------------------------------
+# Remove unneccesary RETURN statement
+  foreach $href (@$statements) {
+    $cont=$href->{content};
+    if($cont eq 'RETURN') {
+      if($href->{exec} == 3) {   # $href->{exec} == 3 means last executable statement
+	$href->{remove} = 1;     # Post remove line for later
+      }
+    }
+  }
+
+
+# Make sure all CALL MPL_... has a CDSTRING argument
+  foreach $href (@$statements) {
+    $cont=$href->{content};
+    if($href->{content} eq 'CALL' ) {
+      $_=$href->{statement};
+      if(/^\s*CALL\s+MPL_/i) {
+	next if(/^\s*CALL\s+MPL_ABORT/i);
+	next if(/^\s*CALL\s+MPL_WRITE/i);
+	next if(/^\s*CALL\s+MPL_READ/i);
+	next if(/^\s*CALL\s+MPL_OPEN/i);
+	next if(/^\s*CALL\s+MPL_CLOSE/i);
+	next if(/^\s*CALL\s+MPL_INIT/i);
+	next if(/^\s*CALL\s+MPL_GROUPS_CREATE/i);
+	next if(/^\s*CALL\s+MPL_BUFFER_METHOD/i);
+	next if(/^\s*CALL\s+MPL_IOINIT/i);
+	next if(/^\s*CALL\s+MPL_CART_COORD/i);
+#	print "CDSTRING=$$prog_info{'unit_name'}[$href->{prog_unit}]: \n";
+	unless(/CDSTRING\s*=/i) {
+	  s/\)(\s)$/,CDSTRING=\'$$prog_info{'unit_name'}[$href->{prog_unit}]:\'\)$1/;
+	  $href->{statement}=$_;
+	}
+      }
+    }
+  }
+	
+
+
+#------------------------------------------------------------------
+# Add Standard Modification Line
+
+  my $start=0;
+  foreach $href (@$statements) {
+    $cont=$href->{content};
+    if($cont eq 'comment') {
+      $_=$href->{statement};
+      if($start) {                        # Found header - look for end of mod lines
+	if(/^ *$/ || /^! *------------------------/) {
+	  $href->{pre_insert} = "!        M.Hamrud      01-Oct-2003 CY28 Cleaning\n";
+	  last;
+	}
+	next;
+      }
+      $start=1 if(/^! +Modifications/i) ;  # This how the header should look
+      next;
+    }
+    last if($href->{exec});                # We have failed - bail out
+  }
+
+# Change subroutine and call multi-line statements so that the comma
+# beetwen variables comes at the end of the line
+  my @lines=();
+  foreach $href (@$statements) {
+    if(exists $href->{multi_line}) {
+      $cont=$href->{content};
+      if($cont eq 'SUBROUTINE' | $cont eq 'CALL' ) {
+	$statm=$href->{statement};
+	@lines=split "\n", $statm;
+	@lines = reverse @lines;
+	my $append_comma=0;
+	for (@lines) {
+#	  print "A $append_comma $_ \n";
+	  next if(/^ *!/);
+	  if($append_comma) {
+	    if(/\S *!.*$/) {
+	      s/(\S)( *!.*)$/$1,$2/;
+	    }
+	    else {
+	      s/(\S) *$/$1,/;
+	    }
+	  }
+	  $append_comma=s/^ *,//;
+#	  print "B $append_comma $_ \n";
+	}
+	@lines = reverse @lines;
+	$statm=join  "\n",@lines;
+	$statm=$statm."\n";
+	$href->{statement}=$statm;
+      }
+    }
+  }
+  our $name;
+  foreach $href (@$statements) {
+    if($href->{content} eq 'USE') {
+      $_=$href->{statement};
+      unless(/^\s*USE\s+$name\s*,\s*ONLY\s*:/i){
+	print $_;
+	print "WARNING:USE without ONLY \n";
+      }
+    }
+  }    
+}
+#==========================================================================
+sub insert_hook{
+# 
+  my($statements,$prog_info,$vars) = @_;
+  my($punit,@args,$tmp_name,$cont,$statm);
+  my($href,$exec);
+  our $nest_par;
+#------------------------------------------------------------------
+# Add HOOK function
+  my $unit_name='';
+  my $last_use=0;
+  my $hook_status=0;
+  my $in_contain=0;
+  my $prev_prog=0;
+  my ($decl,$remember);
+  foreach $href (@$statements) {
+    $cont=$href->{content};
+    next if($cont eq 'comment');
+
+    $decl=$href->{decl};
+    $exec=$href->{exec};
+    $in_contain=$href->{in_contain};
+    if(! $in_contain and $href->{prog_unit} > $prev_prog) {
+      $hook_status=0;
+      $prev_prog=$href->{prog_unit};
+      print "resetting hook status \n";
+    }
+
+    if($cont eq 'FUNCTION' or $cont eq 'SUBROUTINE' or 
+       $cont eq 'PROGRAM'){ # Need name of routine
+      $_=$href->{statement};
+      &parse_prog_unit(\$unit_name,\@args);
+      $unit_name=uc($unit_name);
+# If in module pre-pend module name
+      $unit_name=$$prog_info{module_name}.':'.$unit_name if($$prog_info{is_module}); 
+      $remember=0;
+    }
+
+    if($hook_status == 0) {   # $hook_status == 0 means we have not done anything yet
+      if($cont eq 'USE') {    # Add USE YOMHOOK as second use statement
+	$href->{post_insert}="USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\n";
+	$hook_status=1;
+      }
+      elsif($cont eq 'IMPLICIT NONE') { # No previous USE, add USE YOMHOOK before IMPLICIT NONE
+	$href->{pre_insert} ="USE PARKIND1  ,ONLY : JPRB\n".
+	  "USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\n";
+	$hook_status=1;
+      } 
+    }
+    $remember=$href->{number} if($decl == 2); 
+
+#   Use statement added ($hook_status == 1), now insert HOOK switch on statement
+#   before first executable statement in program unit ($exec == 2)
+    if($hook_status == 1 && $exec == 2) {
+      if($remember) {
+	$$statements[$remember]->{post_insert}="REAL(KIND=JPRB) :: ZHOOK_HANDLE\n";
+	$href->{pre_insert}="IF (LHOOK) CALL DR_HOOK(\'${unit_name}\',0,ZHOOK_HANDLE)\n";
+      }
+      else {
+	$href->{pre_insert}="REAL(KIND=JPRB) :: ZHOOK_HANDLE\n".
+	    "IF (LHOOK) CALL DR_HOOK(\'${unit_name}\',0,ZHOOK_HANDLE)\n";
+      }   
+      if($cont eq 'IF') {
+	if($href->{content2} eq 'RETURN') {
+	  $_=$href->{statement};
+	  s/(\s*IF\s*$nest_par).*\n/$1/i;
+	  s/\)$/ .AND. LHOOK\)/;
+	  $href->{pre_insert}=$href->{pre_insert}."$_ CALL DR_HOOK(\'${unit_name}\',1,ZHOOK_HANDLE)\n";
+	}
+      }
+      $hook_status=2;
+    }
+#   Hook switched on($hook_status == 2), switch off after last executable statement
+#   ($exec == 3)
+    elsif($hook_status == 2) {
+      if($exec == 3 or $exec == 23) {
+	$href->{post_insert}="IF (LHOOK) CALL DR_HOOK(\'${unit_name}\',1,ZHOOK_HANDLE)\n";
+	$hook_status=3;
+      }
+      elsif($cont eq 'RETURN') {
+	$href->{pre_insert}="IF (LHOOK) CALL DR_HOOK(\'${unit_name}\',1,ZHOOK_HANDLE)\n";
+      }
+      elsif($cont eq 'IF') {
+	if($href->{content2} eq 'RETURN') {
+	  $_=$href->{statement};
+	  s/(\s*IF\s*$nest_par).*\n/$1/i;
+	  s/\)$/ .AND. LHOOK\)/;
+	  $href->{pre_insert}="$_ CALL DR_HOOK(\'${unit_name}\',1,ZHOOK_HANDLE)\n";
+	}
+      }	
+    }
+    $hook_status=1 if($in_contain && $hook_status==3); # Reset hook status in CONTAIN region
+  }
+  die "Adding HOOK function failed " if($hook_status == 2);
+}
+#==========================================================================
+
+sub doc_char{
+# Returns suggested prefix in case of DOCTOR violation (otherwise null string)
+  my($type,$usage,$var) = @_;
+  my $prefix="";
+# INTEGER variables
+  if( $type eq "i") {
+    if($usage eq "arg") {
+      $prefix="K" unless($var=~/^K/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="I" unless($var=~/^[IJ]/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="N" unless($var=~/^[MN]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="I" unless($var=~/^[MNIJ]/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+# REAL variables
+  elsif( $type eq "r") {
+    if($usage eq "arg") {
+      $prefix="P" unless($var=~/^P/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="Z" unless($var=~/^Z|^PP/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="R" if ($var=~/^[ZPIJKLMNCY]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="Z" if ($var=~/^[PIJKLMNCY]/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+#LOGICAL variables
+  elsif( $type eq "l") {
+    if($usage eq "arg") {
+      $prefix="LD" unless($var=~/^LD/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="LL" unless($var=~/^LL/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="L" unless($var=~/^L[^LD]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="LL" unless($var=~/^L/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+#CHARACTER variables
+  elsif( $type eq "c") {
+    if($usage eq "arg") {
+      $prefix="CD" unless($var=~/^CD/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="CL" unless($var=~/^CL/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="C" unless($var=~/^C[^LD]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="CL" unless($var=~/^C/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+# USER DEFINED TYPES
+  elsif( $type eq 't') {
+    if($usage eq "arg") {
+      $prefix="YD" unless($var=~/^YD/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="YL" unless($var=~/^YL/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="Y" unless($var=~/^Y[^LD]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="YL" unless($var=~/^Y/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+# FUNCTION/EXTERNAL declarations
+  elsif( $type eq 'f' || $type eq 'e' || $type eq 's') {
+# Everything is OK
+  }
+  else {
+    die "Unknown type $type"
+  }
+  ($prefix);
+}
+#==========================================================================
+     
+sub parse_prog_unit {
+  # Find out type (return), name ($$unit_name) and arguments (@$args)
+  # from a program unit statement ($_)
+  my ($unit_name, $args) = @_;
+  $$unit_name = '';
+  @$args      = ();
+
+  my $type = '';
+
+  our ($name, $type_spec, $attribute);
+
+  if (/^\s*(MODULE|PROGRAM|BLOCK\s*DATA)\s+($name)\s*$/io) {
+    $type       = lc ($1);
+    $$unit_name = $2;
+
+    # Remove space from "block data"
+    $type       =~ s/\s*//;
+
+  } elsif (/^\s*(?:$attribute)?\s*(SUBROUTINE)\s+($name)\b/io or
+           /^\s*(?:$attribute)?\s*(?:$type_spec)?\s*(FUNCTION)\s+($name)\b/io) {
+    $type       = lc ($1);
+    $$unit_name = $2;
+
+    # Get arguments/keywords from SUBROUTINE/FUNCTION
+    if(/^[^\(]+\([^\)]+\)/) {
+      my $tstatm = $_;
+
+      # Remove trailing comment
+      $tstatm =~ s/\!.*\n/\n/g;
+
+      # Remove space characters
+      $tstatm =~ s/\s//g;
+
+      # Add the RESULT clause to the argument/keyword list
+      $tstatm =~ s/\)result\((\w+\))$/,$1/i if $type eq 'function';
+
+      # Remove the parenthesis around the argument list
+      $tstatm =~ s/.+\((.+)\)/$1/;
+
+      @$args = split (',', uc ($tstatm));
+
+      # For FUNCTION, add its name to the list if necessary
+      push @$args, uc ($$unit_name)
+        if $type eq 'function' and not grep {$_ eq uc ($$unit_name)} @$args;
+    }
+  }
+
+  return $type;
+}
+
+#==========================================================================
+
+sub setup_parse {
+  # Set up some "global" variables that helps with parsing statements
+
+  # Pattern for nested parenthesis
+  our $nest_par;
+  $nest_par = qr/\((?:(?>[^()]+)|(??{$nest_par}))*\)/; #Camel p214
+
+  # Patterns for variable name and natural digit
+  our $name='[a-zA-Z]\w*';
+  our $digit_string='\d+';
+  our $type_name=$name;
+
+  # Patterns for specification
+  our $specification_expr='(?:'.$name.'|'.$digit_string.')'; # Simplification
+  our $type_param_value='(?:\*|'.$specification_expr.')';
+
+  # Patterns for length/kind attributes
+  our $char_selector='LEN *= *'.$type_param_value; # Simplification
+  our $kind_selector='\( *KIND *= *'.$name.' *\)';    # Simplification
+
+  # Pattern for type specification
+  our $type_spec='INTEGER *(?:'.$kind_selector.')?|REAL *(?:'.$kind_selector.
+    ')?|DOUBLE PRECISION|COMPLEX *(?:'.$kind_selector.')?|CHARACTER *'.
+    $char_selector.'|LOGICAL *(?:'.$kind_selector.')?|TYPE\s*\(\s*'.$type_name.
+    '\s*\)';
+
+  # Pattern for function/subroutine attribute
+  our $attribute = 'ELEMENTAL|(?:RECURSIVE(?:\s+PURE)?|PURE(?:\s+RECURSIVE)?)';
+
+  return;
+}
+
+#==========================================================================
+
+sub f90_indent {
+# Indent free-format F90 program to our standards
+  my($line_hash,$lines)=@_;
+  my($delta)='  '; 
+  my($cur_indent)='';
+  @$lines=();
+  foreach my $href (@$line_hash) {
+    $_=$href->{line};
+    if($href->{content} eq 'comment') {
+      push(@$lines,$_);
+      next;
+    }
+    s/^ *//; # Remove current indentation
+    my($post_chg)=0;
+    my($pre_chg)=0;
+    my($cont_line)='';
+    exit if (! exists $href->{content});
+    if($href->{content} eq 'DO') {
+      $post_chg=1 unless /^DO\s+\d/;
+    }
+    elsif($href->{content} eq 'ENDDO') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'IF_construct') {
+      $post_chg=1;
+    }
+    elsif($href->{content} eq 'ELSEIF') {
+      $post_chg=1;
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ELSE') {
+      $post_chg=1;
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ENDIF') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ENDIF') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'WHERE_construct') {
+      $post_chg=1;
+    }
+    elsif($href->{content} eq 'ELSEWHERE') {
+      $post_chg=1;
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ENDWHERE') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ENDIF') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'SELECT CASE') {
+      $post_chg=1;
+    }
+    elsif($href->{content} eq 'CASE') {
+      $post_chg=1;
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'END SELECT') {
+      $pre_chg=1;
+    }
+    $cont_line=' ' if($href->{content} eq 'cont_line');
+    if( $pre_chg ) {
+      unless($cur_indent=~s/^$delta//o) {
+	print STDERR $_;
+	die  "f90_indent: something wrong, indent negative\n";;
+      }
+    }
+#    print "$cur_indent$cont_line$_";
+    
+    $_=$cur_indent.$cont_line.$_;
+    push(@$lines,$_);
+    $cur_indent.=$delta if( $post_chg );
+  }
+
+  if(! ($cur_indent eq '')) {
+    die "f90_indent: something wrong, indent=XX${cur_indent}XX\n";
+  }
+}
+
+#==========================================================================
+
+sub tidy {
+# Straigthforward tidiyng of statements
+  my($statements) = @_;
+  my($href,$content);
+  foreach $href (@$statements) {
+    $_=$href->{statement};
+    $content=$href->{content};
+# Substitute tab with four blanks
+    s/\t/    /g;
+    if($content eq 'comment') {
+# Substitute empty comment line with empty line
+      s/^[!] *\n$/\n/;
+      $href->{statement}=$_;
+      next;
+    }
+    if($href->{exec}) {
+      if($content eq 'ENDDO') {
+	s/\bEND DO\b/ENDDO/i;
+	$href->{statement}=$_;
+	next;
+      }
+      if($content eq 'ENDIF') {
+	s/\bEND IF\b/ENDIF/i;
+	$href->{statement}=$_;
+	next;
+      }
+      if($content eq 'ENDWHERE') {
+	s/\bEND WHERE\b/ENDWHERE/i;
+	$href->{statement}=$_;
+	next;
+      }
+
+      s/\bELSE IF\b/ELSEIF/i  if($content eq 'ELSEIF');
+
+      if(/\./) {
+	s/ *\.EQ\. */ == /gi;
+	s/ *\.NE\. */ \/= /gi;
+	s/ *\.LT\. */ < /gi;
+	s/ *\.LE\. */ <= /gi;
+	s/ *\.GT\. */ > /gi;
+	s/ *\.GE\. */ >= /gi;
+      }
+
+#
+      s/\bA?MAX[01]\b/MAX/gi;
+      s/\bA?MIN[01]\b/MIN/gi;
+      s/\bAMOD\b/MOD/gi;
+      s/\bALOG\b/LOG/gi;
+      s/\bALOG10\b/LOG10/gi;
+#      s/\bI(SIGN *\()/$1/gi; # Goes wrong in larcinad etc.
+      s/\bFLOAT\b/REAL/g;
+      s/\bfloat\b/real/g;
+    }
+    
+    $href->{statement}=$_;
+  }
+}
+
+#==========================================================================
+
+sub process_include_files {
+# Read include files and put reference to the anonomys array
+# holding the array of "statement" hashes in $href->{inc_statm}
+  my($statements,$prog_info,$inc_statements) = @_;
+  my ($content,$fname,$href);
+  return unless ($$prog_info{has_include});
+  my @lines=();
+  foreach $href (@$statements) {
+    $content=$href->{content};
+    if($content eq 'include'){
+      $_=$href->{statement};
+      /["](\S+)["]/;
+      $fname=$1;
+      &get_inc_lines($fname,\@lines);
+# Macro-removal
+      &remove_macro(\@lines);
+# Expand lines into statements and put refernce to this
+# array of hashes into $href->{inc_statm}
+      my @inc_statms=();
+      my $dum={};
+      &expcont(\@lines,\@inc_statms);
+      $href->{inc_statm}=[@inc_statms];
+      my $incs=$href->{inc_statm};
+# Study the read in file and add more attributes
+      &study($incs);
+#      print Dumper($incs,$dum);
+      
+    }
+  }
+}
+#==========================================================================
+sub get_inc_lines{
+# Recurcivly get lines from include files, flatten into array of lines
+  my ($fname,$lines) = @_;
+  my ($VPATH,@vpath,@tmp_lines);
+
+  $VPATH=$ENV{VPATH} or die "VPATH not defined ";
+# IFS VPATH /tmp/27/ifs/function:/tmp/27/ifs/common:/tmp/27/ifs/interface:/tmp/27/ifs/namelist:/tmp/27/ifsaux/include:/tmp/27/trans/interface:/tmp/27/obsort/interface:/tmp/27/ifs/ald_inc/function:/tmp/27/ifs/ald_inc/interface:/tmp/27/ifs/ald_inc/namelist
+  @vpath=split(":",$VPATH);
+# Look for include file in VPATH
+  foreach my $path (@vpath) {
+    my $ffname=$path.'/'.$fname;
+    if( -f $ffname) {
+# Read lines from include file
+      @tmp_lines = &readfile($ffname);
+#      print "$ffname \n";
+      for (@tmp_lines) {
+	if(/^\#include\b/){
+	  /["](\S+)["]/;
+	  my $fname2=$1;
+	  &get_inc_lines($fname2,$lines);
+	}
+	else {
+	  push(@$lines,$_);
+	}
+      }
+      last;
+    }
+  }
+  die "Include file $fname not found in VPATH=$VPATH " unless(@$lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &create_interface_block (\@statements, \@interface_block);
+#
+# DESCRIPTION
+#   This function analyses the Fortran statements in \@statements and returns
+#   an interface block in \@interface_block.
+# ------------------------------------------------------------------------------
+
+sub create_interface_block {
+  # Create a "minimal" interface block for subroutines
+  my  ($statements, $interface_block) = @_;
+  my  (%pu_args, %tokens);
+  our ($name, $nest_par);
+
+  @$interface_block = ();
+
+  my @tokens_in_lines = (); # List of tokens in each line
+
+  # Gather information needed to create interface block for routine
+  for my $href (@$statements) {
+    last if $href->{exec}; # exit loop at beginning of executable statements
+
+    # Get arguments of subroutine or function
+    if ($href->{content} eq 'SUBROUTINE' or $href->{content} eq 'FUNCTION') {
+      my $func;
+      my @pu_args;
+      $_ = $href->{statement};
+      &parse_prog_unit (\$func, \@pu_args);
+      $pu_args{uc ($_)} = 1 for @pu_args;
+      next;
+    }
+
+    # Get tokens from lines where arguments are present
+    # Inspect only type declaration statements
+    next unless $href->{decl} == 2;
+
+    my $statement = uc $href->{statement};
+    $statement =~ s/!.*$//; # Remove trailing comment
+
+    my @line_tokens = ();
+    if ($statement =~ s/^(.*?):://) {
+      # New style declaration statement contains "::"
+
+      # Tokens in specification part
+      my $spec = $1;
+      my @tokens = ($spec =~ /\b$name\b/g);
+      shift @tokens; # Remove leading token
+
+      for (@tokens) {
+        push @line_tokens, $_
+          unless /^(?:KIND|LEN|ALLOCATABLE|POINTER|TARGET|DIMENSION|OPTIONAL|
+                  SAVE|INTENT|IN|OUT|INOUT|PARAMETER)$/x;
+      }
+
+      # Tokens in declaration part
+      push @line_tokens, ($statement =~ /\b$name\b/g);
+
+    } else {
+      # Old style declaration statement does not contain "::"
+      @line_tokens = ($statement =~ /\b$name\b/g);
+      shift @line_tokens; # Remove leading token
+    }
+
+    push @tokens_in_lines, \@line_tokens;
+
+    # Check whether each token matches an argument
+    for my $token (@line_tokens) {
+      if (exists $pu_args{$token}) {
+        $tokens{$_} = 1 for @line_tokens;
+        last;
+      }
+    }
+  }
+
+  # Parse statements one more time to ensure all required tokens are included
+  for (@tokens_in_lines) {
+    my @line_tokens = @{ $_ };
+
+    # Check whether line contains an essential token
+    for my $token (@line_tokens) {
+      if (exists $tokens{$token}) {
+        $tokens{$_} = 1 for @line_tokens;
+        last;
+      }
+    }
+  }
+
+  # Create the interface block
+  for my $href (@$statements) {
+    my %myhref  = %$href;
+    my $content = $myhref{content};
+
+    # Ignore comment, executable statements and items in CONTAINS block
+    next if $content eq 'comment';
+    next if $myhref{exec};
+    next if $myhref{in_contain};
+
+    # Delete existing pre- and post -inserts
+    delete $myhref{pre_insert}  if exists $myhref{pre_insert};
+    delete $myhref{post_insert} if exists $myhref{post_insert};
+
+    # Put SUBROUTINE/FUNCTION statement into interface block
+    if ($content =~ /^(?:SUBROUTINE|FUNCTION)$/) {
+      $myhref{pre_insert} = 'INTERFACE' . "\n"; # Insert INTERFACE statement
+      push @$interface_block, \%myhref;
+    }
+
+    # Add USE statement in interface block, if necessary
+    if($myhref{decl} == 4) {
+      $_ = uc $myhref{statement};
+      tr/ \n//d;
+
+      if(/^USE$name,ONLY:(.+)$/) {
+        # USE statement with ONLY, check token to see if it is necessary
+	my @line_tokens = /\b$name\b/g;
+
+	for (@line_tokens) {
+	  if (exists $tokens{$_}) {
+	    push @$interface_block, \%myhref;
+	    last;
+	  }
+	}
+
+      } else {
+        # Always add USE statement without ONLY
+	push @$interface_block, \%myhref;
+      }  
+    }
+
+    if ($myhref{decl} == 1 or $myhref{decl} == 2) {
+      $_ = uc ($myhref{statement});
+      s/\s*!.*$//;
+
+      if ($content eq 'INTEGER' or $content eq 'PARAMETER') {
+        # INTEGER and PARAMETER may be used for dimensioning
+	my @line_tokens = /\b$name\b/g;
+
+	for (@line_tokens) {
+	  if (exists $tokens{$_}) {
+	    push @$interface_block, \%myhref;
+	    last;
+	  }
+	}
+      } else {
+        # Add line only if an argument is present
+	s/$nest_par//g;
+	my @line_tokens = /\b$name\b/g;
+
+	for (@line_tokens) {
+	  if (exists $pu_args{$_}) {
+	    push @$interface_block, \%myhref;
+	    last;
+	  }
+	}
+      }
+    }
+
+    # Add END statement to interface block
+    if ($content =~ /^END\s+(?:SUBROUTINE|FUNCTION)/) {
+      $myhref{post_insert} = 'END INTERFACE' . "\n";
+      push @$interface_block, \%myhref;
+    }
+  }
+
+  # Beautify the interface block
+  for my $href (@$interface_block) {
+    $_ = $href->{statement};
+
+    s/\!.*\n/\n/g; # Remove trailing comments
+    s/ +/ /g;      # Only one space
+    s/\n *\n/\n/g; # Remove empty lines
+    s/\n *\n/\n/g; # Remove empty lines again
+    s/ +\n/\n/g;   # No trailing spaces
+
+    $href->{statement} = $_;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub change_var_names{
+  my($statements) = @_;
+  foreach my $href (@$statements) {
+    $_=$href->{statement};
+    s/\bVAZX\b/YVAZX/ig;
+    s/\bPVAZX\b/YDVAZX/ig;
+    s/\bVAZG\b/YVAZG/ig;
+    s/\bPVAZG\b/YDVAZG/ig;
+    s/\bSCALP_DV\b/YSCALP/ig;
+    s/\bRSCALP_DV\b/YRSCALP/ig;
+    s/\bSCALPSQRT_DV\b/YSCALPSQRT/ig;
+    s/\bRSCALPSQRT_DV\b/YRSCALPSQRT/ig;
+    s/\bPYBAR\b/YDYBAR/ig;
+    s/\bPSBAR\b/YDSBAR/ig;
+    s/\bVCGLPC\b/YVCGLPC/ig;
+    s/\bVCGLEV\b/YVCGLEV/ig;
+    s/\bSKFROT\b/YSKFROT/ig;
+    s/\bSKFMAT\b/YSKFMAT/ig;
+    s/\bSTATE_VECTOR_4D\b/YSTATE_VECTOR_4D/ig;
+    s/\bVAZX0\b/YVAZX0/ig;
+    s/\bVAZG0\b/YVAZG0/ig;
+    s/\bRSPFORCE\b/YSPFORCE/ig;
+    $href->{statement}=$_;
+  }
+}
+# =========================================================================
+sub remake_arg_decl{
+  my($statements,$prog_info) = @_;
+  my($href,$content,@pu_args,$func,%tokens);
+  my($left,$right,%arghash,$dim);
+  our($nest_par,$name);
+
+  my $dims='';
+# Crack existing dummy declarations, build hash arghash
+  foreach $href (@$statements) {
+    last if($href->{prog_unit} >0);
+    if($href->{content} eq 'SUBROUTINE') {   # Get arguments of subroutine
+      $_=$href->{statement};
+      my $dum=&parse_prog_unit(\$func,\@pu_args);
+#      print Dumper(\@pu_args);
+      for(@pu_args) {
+	$_=uc($_);
+	$arghash{$_}{other}='';
+	$arghash{$_}{dimuse}=0;
+	$arghash{$_}{intent}='';
+	$arghash{$_}{used}=0;
+	$arghash{$_}{set}=0;
+	$arghash{$_}{reallyset}=0;
+	$arghash{$_}{type}='';
+	$arghash{$_}{comment}='';
+	$arghash{$_}{inif}=0;
+      }
+      next;
+    }
+    if($href->{decl} == 2) {
+      $_=$href->{statement};
+      my $comment='';
+      $comment=$1 if(/.*(\!.*)$/);
+      s/\!.*\n/\n/g;                        # Remove trailing comments in all lines
+      $_=uc($_);
+      s/\s//g;
+      if(/^(.+)::(.+)$/){
+	$left=$1;
+	$right=$2;
+	$_=$right;
+	s/$nest_par//g;
+	s/($name)\*\w+/$1/g;
+#	print "XX  $_ \n";
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/) {
+#	    print "ARG $arg $left $_ \n";
+	    $arghash{$arg}{linedec}=$href->{number};
+	    $arghash{$arg}{comment}=$comment;
+	    my @locdec =split ',',$left;
+	    my $i=0;
+	    foreach my $locdec (@locdec) {
+	      if($i == 0) {
+		$arghash{$arg}{type}=$locdec;
+	      }
+	      elsif($locdec=~/\bINTENT/) {
+		$arghash{$arg}{intent}=','.$locdec;
+	      }
+	      else {
+		$arghash{$arg}{other}=$arghash{$arg}{other}.','.$locdec;
+	      }
+	      $i++;
+	    }
+	    if($right=~/\b$arg\b(\*\w+)/) {
+	      $dim=$1;
+	    }
+	    elsif($right=~/\b$arg\b($nest_par\*$nest_par)/) {
+	      $dim=$1;
+	    }
+	    elsif($right=~/\b$arg\b($nest_par\*\w+)/) {
+	      $dim=$1;
+	    }
+	    elsif($right=~/\b$arg\b(\*$nest_par)/) {
+	      $dim=$1;
+	    }
+	    elsif($right=~/\b$arg\b($nest_par)/) {
+	      $dim=$1;
+	    }
+	    else {
+	      $dim='';
+	    }
+	    $arghash{$arg}{dim}=$dim;
+	    $dims=$dims.$dim
+	      }
+	}
+	foreach my $arg (@pu_args) {  # Is arg. used for dimensioning other args?
+	  if($dims=~/\b$arg\b/i) {
+	    $arghash{$arg}{dimuse}=1;
+	  }
+	}  
+      }
+    }
+  }
+  my $insert_line=0;
+  foreach $href (@$statements) {
+    last if($href->{prog_unit} >0);
+    if($href->{decl} == 2 or $href->{content} eq 'PARAMETER') {                 
+      $_=uc($href->{statement});
+      next unless /\bPARAMETER\b/;
+      my @tmpvar=/\b$name\b/g;
+      foreach my $token (@tmpvar) {
+	if($dims=~/\b$token\b/) {
+	  $insert_line=$href->{number};
+	}
+      }
+    }
+  }
+      
+# Gather info to decide INTENT status
+  my $inif=0;
+  my @inif_stack=();
+  my $cur_inif=0;
+  foreach $href (@$statements) {
+    last if($href->{prog_unit} >0);
+    if($href->{exec}) {
+      if($href->{content} eq 'ENDIF') {
+	$inif--;
+	$cur_inif=pop @inif_stack;
+	next;
+      }
+      elsif($href->{content} eq 'ELSEIF' or $href->{content} eq 'ELSE') {
+	$cur_inif=pop @inif_stack;
+	$cur_inif=$href->{number};
+	push @inif_stack,$cur_inif;
+      }
+      my ($left,$right);
+      $_=$href->{statement};
+      s/\!.*\n/\n/g;                        # Remove trailing comments in all lines
+      my %setnow=();
+      foreach my $arg (@pu_args) {
+	$setnow{$arg}=0;
+	$setnow{$arg}=1 if($arghash{$arg}{reallyset});
+	unless ($setnow{$arg}) {
+	  foreach my $xx (@inif_stack) {
+	    $setnow{$arg}=1 if($xx == $arghash{$arg}{inif});
+	  }
+	}
+      }
+      
+      if($href->{content} eq 'scal_assign' or $href->{content} eq 'array_assign') {
+	s/\s//g;
+	($left,$right)=/^(.+)=(.+)$/;
+	$_=$right;
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/i) {
+	    $arghash{$arg}{used}=1 unless $setnow{$arg};
+	  }
+	}
+	$_=$left;
+	if(/($nest_par)/) {
+	  $_=$1;
+	  foreach my $arg (@pu_args) {
+	    if(/\b$arg\b/i) {
+	      $arghash{$arg}{used}=1 unless $setnow{$arg};
+	    }
+	  }
+	}
+	$_=$left;
+	foreach my $arg (@pu_args) {
+	  if(/^$arg\b/i) {
+	    $arghash{$arg}{set}=1;
+	    $arghash{$arg}{inif}=$cur_inif;
+	    $arghash{$arg}{reallyset}=1 unless($inif);
+	  }
+	}
+      }
+      elsif($href->{content} eq 'IF' ) {
+	if($href->{content2} eq 'scal_assign' or $href->{content2} eq 'array_assign' or 
+	   $href->{content2} eq 'CALL') {
+	  s/\n//g;
+	  ($left,$right)=/^\s*(IF\b\s*$nest_par)(.+)/i;
+	  $_=$left;
+	  foreach my $arg (@pu_args) {
+	    if(/\b$arg\b/i) {
+	      $arghash{$arg}{used}=1 unless $setnow{$arg};
+	    }
+	  }
+	  $_=$right;
+	  if($href->{content2} eq 'CALL') {
+	    my $statement=$right;
+	    my $inifx=1;
+	    &propag_arg(\$statement,\%arghash,\$inifx,\%setnow);
+	  }
+	  else {
+	    s/\s//g;
+	    ($left,$right)=/^(.+)=(.+)$/;
+	    $_=$right;
+	    foreach my $arg (@pu_args) {
+	      if(/\b$arg\b/i) {
+		$arghash{$arg}{used}=1 unless $setnow{$arg};
+	      }
+	    }
+	    $_=$left;
+	    if(/($nest_par)/) {
+	      $_=$1;
+	      foreach my $arg (@pu_args) {
+		if(/\b$arg\b/i) {
+		  $arghash{$arg}{used}=1 unless $setnow{$arg};
+		}
+	      }
+	    }
+	    $_=$left;
+	    foreach my $arg (@pu_args) {
+	      if(/^$arg\b/i) {
+		$arghash{$arg}{inif}=$cur_inif;
+		$arghash{$arg}{set}=1;
+	      }
+	    }
+	  }
+	}
+	else {
+	  foreach my $arg (@pu_args) {
+	    if(/\b$arg\b/i) {
+	      $arghash{$arg}{used}=1 unless $setnow{$arg};
+	    }
+	  }
+	}
+      }
+      elsif($href->{content} eq 'WHERE' ) {
+	s/\s//g;
+	($left,$right)=/^(WHERE$nest_par)(.+)/i;
+	$_=$left;
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/i) {
+	    $arghash{$arg}{used}=1 unless $setnow{$arg};
+	  }
+	}
+	$_=$right;
+	($left,$right)=/^(.+)=(.+)$/;
+	$_=$right;
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/i) {
+	    $arghash{$arg}{used}=1 unless $setnow{$arg};
+	  }
+	}
+	$_=$left;
+	foreach my $arg (@pu_args) {
+	  if(/^$arg\b/i) {
+	    $arghash{$arg}{inif}=$cur_inif;
+	    $arghash{$arg}{set}=1;
+	  }
+	}
+      }
+      elsif($href->{content} eq 'CALL') {
+	my $statement=$_;
+	&propag_arg(\$statement,\%arghash,\$inif);
+      }
+      else{
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/i) {
+	    $arghash{$arg}{used}=1 unless $setnow{$arg};
+	  }
+	}
+      }
+      if($href->{content} eq 'IF_construct') {
+	$inif++;
+	$cur_inif=$href->{number};
+	push @inif_stack,$cur_inif;
+      }
+    }	  
+  }
+
+# Create INTENT statemant based on gathered info
+  foreach my $arg (@pu_args) {
+    if($arghash{$arg}{linedec}) {
+      if($arghash{$arg}{nointent}) {
+	unless($arghash{$arg}{intent}) {
+	  $arghash{$arg}{intent}=' ';
+	  $arghash{$arg}{comment}='! UNDETERMINED INTENT';
+	}
+      }
+      else{
+	my $intent='';
+	$intent='IN' if($arghash{$arg}{used} or $arghash{$arg}{dimuse});
+	$intent=$intent.'OUT' if($arghash{$arg}{set});
+	if($intent) {
+	  if($arghash{$arg}{intent} and $intent eq 'OUT') {
+	    $intent='INOUT' if $arghash{$arg}{intent}=~/INOUT/i;
+	  }
+	  $arghash{$arg}{intent}=',INTENT('.$intent.')';
+	}
+	else {
+	  $arghash{$arg}{intent}=' ';
+	  $arghash{$arg}{comment}='! Argument NOT used';
+	}
+      }
+    }
+  }
+
+# Remove existing argument declarations
+  foreach my $arg (@pu_args) {
+    if($arghash{$arg}{linedec}) {
+      $_=$$statements[$arghash{$arg}{linedec}]->{statement};
+      #   print "BEFORE $arg $_";
+      if(/.*::\s*\b$arg\b\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*$nest_par\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*\*\s*\w+\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*\*\s*$nest_par\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*$nest_par\s*\*\s*\w+\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*$nest_par\s*\*\s*$nest_par\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      else{
+	/^(.*::)(.*)$/s;
+	my $left=$1;
+	$_=$2;
+	s/\b$arg\b\s*$nest_par//i;
+	s/\b$arg\b\s*\*\s*\w+//i;
+	s/\b$arg\b\s*\*\s*$nest_par//i;
+	s/\b$arg\b//i;
+	s/,\s*,/,/;
+	s/,(\s*)$/$1/;
+	s/\n\s*\n/\n/g;
+	$_=$left.$_;
+	s/::\s*,/::/;
+      }
+ #   print "AFTER $arg $_\n";
+      $$statements[$arghash{$arg}{linedec}]->{statement}=$_; 
+    }
+  }
+
+ # Write out
+
+  my $newdecl='';
+  my $linedec;
+  foreach my $arg (@pu_args) {
+    if($arghash{$arg}{linedec}) {
+      if($arghash{$arg}{other} and ! $arghash{$arg}{dim}) {
+	$arghash{$arg}{other}=~s/\s//g;
+	if($arghash{$arg}{other}=~/^,DIMENSION($nest_par)$/i) {
+	  $arghash{$arg}{other}='';
+	  $arghash{$arg}{dim}=$1;
+	}
+      }
+      if($arghash{$arg}{dimuse}) { # Put declerations of args first
+	$linedec=sprintf "%-18s%s%-14s%s%s%s%s %s",
+	$arghash{$arg}{type},$arghash{$arg}{other},$arghash{$arg}{intent},
+	    ' :: ',$arg,$arghash{$arg}{dim},$arghash{$arg}{comment},"\n";
+	$newdecl=$newdecl.$linedec;
+      }
+    }
+  }
+  foreach my $arg (@pu_args) {
+    if($arghash{$arg}{linedec}) {
+      unless($arghash{$arg}{dimuse}) {
+	$linedec=sprintf "%-18s%s%-14s%s%s%s %s%s",
+	$arghash{$arg}{type},$arghash{$arg}{other},$arghash{$arg}{intent},
+	    ' :: ',$arg,$arghash{$arg}{dim},$arghash{$arg}{comment},"\n";
+	$newdecl=$newdecl.$linedec;
+      }
+    }
+  }
+#  print "INSERT_LINE $insert_line \n";
+  if($insert_line) {
+    $$statements[$insert_line]->{post_insert}=$newdecl;
+  }
+  else{
+    foreach $href (@$statements) {
+      if($href->{decl} == 2) {                 
+	$href->{pre_insert}=$newdecl;
+	last;
+      }
+    }
+  }
+
+#  print $newdecl;
+#  print Dumper(\%arghash);
+}
+
+sub propag_arg{
+  my ($statement,$arghash,$inif,$setnow) = @_;
+  our ($name,$nest_par);
+  my (%argpos);
+  $_=$$statement;
+  s/^\s*CALL\s+($name)//i;
+  my $called=lc($1);
+  s/\s//g;
+  s/^\((.*)\)$/$1/s;
+  my @inpars=/$nest_par/g;
+  s/$nest_par//g;
+  s/($name)%$name/$1/g;
+  $_=uc($_);
+#  print "PROPAG $called $_ ££ @inpars \n";
+  my @call_args=split ',' , $_;
+  my $i=0;
+  my $interesting=0;
+  %argpos=();
+  foreach my $call (@call_args) {
+    
+#    print "CALL $called $call \n" ;
+    if($call=~/(.+)=(.+)/) {
+      $call=$2; #This just by-passes the problem
+    }
+    if(exists $$arghash{$call}) {
+      if(exists $argpos{$call}) {
+	push @{$argpos{$call}},$i;
+      }
+      else {
+	my @i=($i);
+	$argpos{$call}=[@i];
+      }
+      $interesting=1;
+    }
+    $i++;
+  }
+  if($interesting) {
+    my $fname='/tmp/intblocks/'.$called.'.intfb.h';
+    if( -f $fname ) {
+      my @dumargs=();
+      my $unit_name;
+      print "FILE $fname FOUND \n";
+      my @lines = &readfile($fname);
+      my @loc_statements=(); 
+      &expcont(\@lines,\@loc_statements);
+      foreach my $href (@loc_statements) {
+	$_=$href->{statement};
+	if(/^\s*SUBROUTINE/i) {
+	  my $dum=&parse_prog_unit(\$unit_name,\@dumargs);
+	  next;
+	}
+	if(/::/) {
+	  s/\s//g;
+	  foreach my $arg (keys (%argpos)) {
+	    my $set_before=$$setnow{$arg};
+	    foreach my $i (@{$argpos{$arg}}){
+	      if(/::$dumargs[$i]/) {
+		if(/INTENT\(IN\)/i) {
+		  $$arghash{$arg}{used}=1 unless $set_before;
+		}
+		elsif(/INTENT\(OUT\)/i) {
+		  $$arghash{$arg}{set}=1;
+		  $$setnow{$arg}=1 unless($$inif);
+		}
+		elsif(/INTENT\(INOUT\)/i) {
+		  $$arghash{$arg}{set}=1;
+		  $$arghash{$arg}{used}=1 unless $set_before;;
+		  $$arghash{$arg}{reallyset}=1 unless($$inif);
+		}
+		elsif(/\! UNDETERMINED INTENT/) {
+		  $$arghash{$arg}{nointent}=1;
+		}
+	      }
+	    }
+	  }
+	}
+      }
+    }
+    else {
+      foreach my $arg (keys (%argpos)) {
+	$$arghash{$arg}{nointent}=1;
+      }
+    }
+  }
+  for (@inpars) {
+    foreach my $arg (keys (%$arghash)) {
+      if(exists $$arghash{$arg}) {
+	if(/\b$arg\b/i) {
+	  $$arghash{$arg}{used}=1 unless $$setnow{$arg};
+	}
+      }
+    }
+  }
+}
+  
+sub add_interface_blocks {
+# Add interface block for called routines
+  use File::Find;
+  my($statements,$prog_info) = @_;
+  my($href,$call);
+  our($name,$nest_par);
+  our(@call_names,@call_names_found,%call_names);
+
+  return unless ($$prog_info{no_calls}); # Skip if there are no calls
+  @call_names=();
+  %call_names=();
+
+  my $last_decl=0;
+  my $in_intfblk=0;
+  my %already_in=();
+  ST:foreach $href (@$statements) {
+    last if($href->{prog_unit} > 0);  # Only consider first program unit (no contains)
+    if($href->{content} eq 'INTERFACE') {
+      $in_intfblk=1;
+      next;
+    }
+    if($href->{content} eq 'END INTERFACE') {
+      $in_intfblk=0;
+      next;
+    }
+    if($in_intfblk) {
+      $_=$href->{statement};
+      s/\#include\s*\"(\w+)\.h\"\s*$/$1/;
+      $_=lc($_);
+      $already_in{$_}++;
+      next;
+    }
+    
+# Find last declaration
+    if($href->{decl}) {
+      next if($href->{content} eq 'FORMAT');
+      next if($href->{content} eq 'DATA');
+      $last_decl = $href->{number} ;
+    }
+# Find calls
+    next unless($href->{exec});
+    if($href->{content} eq 'CALL' or 
+       (exists  $href->{content2} and$ href->{content2} eq 'CALL') ) {
+      $_=$href->{statement};
+      /\s*\bCALL\b\s*($name)/i;
+      my $call=lc($1);
+      next if($already_in{$call}); # Exclude already existing interface block
+      next if($call eq 'packmsg'); # A couple of special exceptions
+      next if($call eq 'unpkmsg');
+      $call_names{$call}++;
+    }
+  }
+  
+
+# Check that routine exists in IFS
+  @call_names_found=();
+  find(\&calls_wanted,'/tmp/27/ifs/');
+#  find(\&calls_wanted,'/home/mats/work/cy28/ifs/');
+#  find(\&calls_wanted,'/tmp/27/trans/');
+  @call_names_found=sort(@call_names_found);
+#  print "P2 @call_names_found \n";
+  @call_names=@call_names_found;
+
+# Contruct include block
+  my $block='';
+  for (@call_names) {
+    $block=$block.'#include "'.$_.'.intfb.h"'."\n";
+  }
+#  print $block;
+
+  my $clean=0;
+  if(@call_names) {
+    if($$prog_info{has_interface_block}) {
+      foreach $href (@$statements) {
+# Add interface block to routine that already has INTERFACE statement
+	if($href->{content} eq 'END INTERFACE'){
+	  if($href->{post_insert}) {
+	    $href->{post_insert}=$href->{post_insert}."\n".$block;
+	  }
+	  else {
+	    $href->{post_insert}="\n".$block;
+	  }	    
+	  last;
+	}
+      }
+    }
+# Add interface block to routine that does not have previous INTERFACE statement
+    else {
+      $href=@$statements[$last_decl];
+      if($href->{post_insert}) {
+	$href->{post_insert}=$href->{post_insert}."\n".$block;
+      }
+      else {
+	$href->{post_insert}="\n".$block;
+      }	    
+    }
+# Remove from EXTERNAL statement where interface block has been added
+    foreach $href (@$statements) {
+      if($href->{content} eq 'EXTERNAL') {
+	$_=$href->{statement};
+	foreach my $ext (@call_names) {
+	  s/\b$ext\b//i;
+	}
+	s/,\s*,/,/g;
+	s/^(\s*EXTERNAL\s*),/$1/i;
+	s/^(\s*EXTERNAL.*),\s*$/$1/i;
+	s/^\s*EXTERNAL\s*,*\s*$//i;
+	$href->{statement}=$_;	
+      }
+    }
+  }
+}
+#======================================================================================
+sub calls_wanted {
+  # Used by Find as called from add_interface_blocks
+  our(%call_names,@call_names_found);
+  return unless (/^(\w+)\.F90$/);
+  my $call=$1;
+  if($call_names{$call}) {
+    push(@call_names_found,$call);
+  }    
+}
+sub remove_some_comments{
+  my($statements) = @_;
+  my $prev_empty=0;
+  foreach my $href (@$statements) {
+    if($href->{content} eq 'comment'){
+      $_=$href->{statement};
+      if(/^\s*$/) {
+	if($prev_empty) {
+	  s/\s*//;
+	  $href->{statement}=$_;
+	}
+	else {
+	  $prev_empty=1;
+	} 
+	next;
+      }
+      $prev_empty=0;
+      s/^\s*![\s\*]*\bLOCAL\s+(INTEGER|REAL|LOGICAL|CHARACTER)\s+(SCALARS|ARRAYS).*\n$//i;
+      s/^\s*![\s\*]*\bDUMMY\s+(INTEGER|REAL|LOGICAL|CHARACTER)\s+(SCALARS|ARRAYS).*\n$//i;
+      s/^\s*![\s\*]*\bLOCAL\s+(INTEGER|REAL|LOGICAL|CHARACTER).*\n$//i;
+      s/^\s*![\s\*]*\bDUMMY\b\s*$//i;
+      s/^\s*![\s\*]*\bLOCAL\b\s*$//i;
+      s/^\s*![\s\*]*\bLOCAL\b:\s*$//i;
+      s/^\s*![\s\*]*\bLOCAL ARRAYS\b[\s\*]*$//i;
+      s/^\s*![\s\*]*\bLOCAL SCALARS\b\s*$//i;
+      s/^\s*![\s\*]*\s*\d\.\d+\s*\bLOCAL ARRAYS\b\s*$//i;
+      s/^\s*![\s\*]*\s*=== LOCAL ARRAYS ===\s*$//i;
+      $href->{statement}=$_;
+    }
+    else {
+      $prev_empty=0;
+    }
+  }
+}      
+sub get_calls_inc {
+  my($statements,$calls,$intfb) = @_;
+  foreach my $href (@$statements) {
+    if($href->{content} eq 'CALL') {
+      $_=$href->{statement};
+      /^\s*CALL\s+([A-Z]\w*)/i;
+      $$calls{lc($1)}++;
+    }
+    elsif($href->{content} eq 'IF') {
+      if($href->{content2} eq 'CALL') {
+	$_=$href->{statement};
+	/\bCALL\s+([A-Z]\w*)/i;
+	$$calls{lc($1)}++;
+      }
+    }
+    elsif($href->{content} eq 'include') {
+      $_=$href->{statement};
+      $$intfb{$1}=1 if(/["](\S+)\.intfb\.h["]/);
+      $$intfb{$1}=2 if(/["](\S+)\.h["]/); # For old-style interface blocks
+    }
+  }
+}
+
+1;
+      
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Build.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Build.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Build.pm	(revision 5166)
@@ -0,0 +1,2428 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Build
+#
+# DESCRIPTION
+#   The main purpose of this class is to process the build configuration,
+#   generate the required files for the build and invoke make to create the
+#   build.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Build;
+
+# Standard pragma
+use strict;
+use warnings;
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Path;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::CfgFile;
+use Fcm::SrcPackage;
+use Fcm::BuildTask;
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $bld = Fcm::Build->new (
+#     CONFIG  => $config,
+#     CFG_SRC => $cfg_src,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Build class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   CFG_SRC    - source path to the build configuration file
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $cfg    = exists $args{CFG_SRC} ? $args{CFG_SRC} : undef;
+  my $config = exists $args{CONFIG}  ? $args{CONFIG}  : &main::cfg;
+
+  my $self  = {
+    CONFIG   => $config,            # configuration settings
+    CFG      => Fcm::CfgFile->new ( # bld cfg
+      TYPE   => 'bld',              # config file type
+      SRC    => $cfg,               # source path of the bld cfg
+      CONFIG => $config,            # configuration settings
+    ),
+    NAME     => '',                 # name of this build
+    DIR      => {                   # directory tree of this build
+      ROOT    => '',                # root directory of this build
+    },
+    PATH     => {},                 # search paths of this build
+    SEARCH   => 1,                  # search for source directories in src/?
+    SRCDIR   => {},                 # source directories of this build
+    PP       => {},                 # pre-process flags
+    PACKAGE  => {},                 # source directory packages of this build
+    TARGET   => [],                 # targets of this build
+    USE      => [],                 # list of inherited builds
+    INHERIT  => {                   # inheritance flags
+      SRCDIR => 1,                  # inherit source directories?
+      PP     => 1,                  # inherit pre-process flags?
+      TARGET => 0,                  # inherit targets?
+    },
+    LIB      => {'' => ''},         # name of libraries
+    LOCK     => undef,              # lock file
+  };
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->DESTROY;
+#
+# DESCRIPTION
+#   This method is called automatically when a Fcm::Build object is
+#   destroyed.
+# ------------------------------------------------------------------------------
+
+sub DESTROY {
+  my $self = shift;
+
+  # Remove the lock if it is set
+  unlink $self->{LOCK} if $self->{LOCK} and -e $self->{LOCK};
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $bld->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile = $bld->cfg;
+#
+# DESCRIPTION
+#   This method returns a reference to a Fcm::CfgFile instance for the build
+#   configuration file.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  my $self = shift;
+
+  return $self->{CFG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %allpcks = $bld->allpcks ();
+#
+# DESCRIPTION
+#   This method returns a hash table with keys representing all the packages
+#   declared in the current build. The value of each element in the hash is a
+#   reference to a list of children of the current package.
+# ------------------------------------------------------------------------------
+
+sub allpcks {
+  my $self        = shift;
+  my %allpcks = ();
+
+  for my $pckname (keys %{ $self->{PACKAGE} }) {
+    $allpcks{$pckname} = [];
+  }
+
+  for my $pckname (keys %{ $self->{PACKAGE} }) {
+    my @names = split /__/, $pckname;
+
+    my $cur = $pckname;
+    while ($cur) {
+      pop @names;
+      my $depend = @names ? join '__', @names : '';
+      $allpcks{$depend} = [] unless exists $allpcks{$depend};
+
+      push @{ $allpcks{$depend} }, $cur
+        unless grep {$_ eq $cur} @{ $allpcks{$depend} };
+
+      $cur = $depend;
+    }
+  }
+
+  return %allpcks;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $bld->build (
+#     [ARCHIVE     => $archive,]
+#     [FULL        => $full,]
+#     [IGNORE_LOCK => $ignore_lock,]
+#     [JOBS        => $jobs,]
+#     [STAGE       => $stage,]
+#     [TARGETS     => \@targets,]
+#   );
+#
+# DESCRIPTION
+#   This method performs a build based on the current configuration. The
+#   method returns 1 on success.
+#
+# ARGUMENTS
+#   ARCHIVE      - If set to "true", invoke the "archive" mode. Most build files
+#                  and directories created by this build will be archived using
+#                  the "tar" command. If not set, the default is not to invoke
+#                  the "archive" mode.
+#   FULL         - If set to "true", invoke the build in "full" mode. Build files
+#                  and directories created by previous builds in the same
+#                  location will be removed before the current build is
+#                  performed. If not set, the default is to perform the build
+#                  in "incremental" mode.
+#   IGNORE_LOCK  - If set to "true", it ignores any lock files that may exist in
+#                  the build root directory. 
+#   JOBS         - Specify number of jobs that can be handled by "make". If set,
+#                  the value must be a natural integer. If not set, the default
+#                  value is 1 (i.e. run "make" in serial mode).
+#   STAGE        - If set, it should be an integer number or a recognised
+#                  keyword or abbreviation. If set, the build is performed up
+#                  to the named stage. If not set, the default is to perform
+#                  all stages of the build. Allowed values are:
+#                  1, setup or s
+#                  2, pre_process or pp
+#                  3, generate_dependency or gd
+#                  4, generate_interface or gi
+#                  5, all, a, make or m
+#   TARGETS      - Specify targets to be built. If set, these targets will be
+#                  built instead of the ones specified in the build
+#                  configuration file.
+# ------------------------------------------------------------------------------
+
+sub build {
+  my $self = shift;
+  my %args = @_;
+
+  # Process arguments
+  my $archive     = exists $args{ARCHIVE}     ? $args{ARCHIVE}     : 0;
+  my $full        = exists $args{FULL}        ? $args{FULL}        : 0;
+  my $ignore_lock = exists $args{IGNORE_LOCK} ? $args{IGNORE_LOCK} : 0;
+  my $jobs        = exists $args{JOBS}        ? $args{JOBS}        : 1;
+  my $stage       = exists $args{STAGE}       ? $args{STAGE}       : 5;
+  my $targets     = exists $args{TARGETS}     ? $args{TARGETS}     : [qw/all/];
+
+  # Resolve named stages
+  $stage = 5 unless $stage;
+  if ($stage !~ /^\d$/) {
+    my %stagenames = (
+      'S(?:ETUP)?'                      => 1,
+      'P(?:RE)?_?P(?:ROCESS)?'          => 2,
+      'G(?:ENERATE)?_?D(?:ENPENDENCY)?' => 3,
+      'G(?:ENERATE)?_?I(?:NTERFACE)?'   => 4,
+      '(?:A(?:LL)|M(?:AKE)?)'           => 5,
+    );
+
+    for my $name (keys %stagenames) {
+      if ($stage =~ /$name/i) {
+        $stage = $stagenames{$name};
+        last;
+      }
+    }
+
+    if ($stage !~ /^\d$/) {
+      w_report 'Warning: invalid build stage: ', $stage, ', default to "5"';
+      $stage = 5;
+    }
+  }
+
+  # Get verbose mode
+  my $verbose = $self->config->verbose;
+
+  # Stage 1: setup
+  my $date = localtime;
+  print 'Build command started on ', $date, '.', "\n" if $verbose;
+  my $otime = time;
+
+  print '->Setup              : start', "\n" if $verbose;
+  my $stime = time;
+
+  # Read configurations
+  my $rc = $self->decipher_cfg;
+
+  # Check directories are set
+  $rc = $self->check_dir if $rc;
+
+  # Check for lock files
+  $rc = $self->check_lock if $rc and not $ignore_lock;
+
+  # Set a lock file
+  $rc = $self->_set_lock if $rc;
+
+  # Create build root directory if necessary
+  $rc = $self->_create_build_dir if $rc;
+
+  # Set up directory inheritance
+  $rc = $self->_setup_dir (FULL => $full) if $rc;
+
+  # Set up source directories, targets, etc
+  $rc = $self->_update_bld_info if $rc;
+
+  # Set up PP flag cache
+  $rc = $self->_update_pp_info if $rc;
+
+  # Set up build tools cache
+  $rc = $self->_update_tool_info if $rc;
+
+  # Set up regenerate make rule cache
+  $rc = $self->_update_regen_rule_info if $rc;
+
+  my $ftime = time;
+  my $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+  print '->Setup              : ', $ftime - $stime, ' ', $s_str, "\n";
+
+  # Stage 2: Pre-process
+  if ($rc and $stage >= 2) {
+    print '->Pre-process        : start', "\n" if $verbose;
+    my $stime = time;
+
+    $rc = $self->_pre_process;
+
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Pre-process        : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  # Stage 3: Scan dependency and write make rules
+  if ($rc and $stage >= 3) {
+    print '->Scan dependency    : start', "\n" if $verbose;
+    my $stime = time;
+
+    $rc = $self->_scan_dependency;
+    $rc = $self->_write_make_rules if $rc;
+    $rc = $self->_write_makefile if $rc;
+
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Scan dependency    : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  # Stage 4: Generate Fortran 9x interface block
+  if ($rc and $stage >= 4) {
+    print '->Generate interface : start', "\n" if $verbose;
+    my $stime = time;
+
+    $rc = $self->_generate_f9x_interface;
+
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Generate interface : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  # Stage 5: Make the build
+  if ($rc and $stage >= 5) {
+    print '->Make               : start', "\n" if $verbose;
+    my $stime = time;
+
+    $rc = $self->_invoke_make (
+      TARGETS => $targets,
+      JOBS    => $jobs,
+      ARCHIVE => $archive,
+    );
+
+    # Remove empty build directories
+    $rc = $self->_remove_empty_dirs () if $rc;
+
+    # Create TAR archives if necessary
+    $rc = $self->_tar_build_dirs () if $rc and $archive;
+
+    # Create run time environment script if necessary
+    $rc = $self->_create_runenv_script () if $rc;
+
+    # Create exclude dependency configurations for libraries
+    $rc = $self->_create_lib_excl_dep () if $rc;
+
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Make               : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  if ($verbose) {
+    $s_str = $ftime - $otime > 1 ? 'seconds' : 'second';
+    print '->TOTAL              : ', $ftime - $otime, ' ', $s_str, "\n";
+  }
+
+  $date = localtime;
+  if ($rc) {
+    print 'Build command finished on ', $date, '.', "\n" if $verbose;
+
+  } else {
+    e_report 'Build command failed on ', $date, '.';
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $bld->decipher_cfg ();
+#
+# DESCRIPTION
+#   This method deciphers the build configuration file and assigns the
+#   configurations to the variables of the current build.
+# ------------------------------------------------------------------------------
+
+sub decipher_cfg {
+  my $self = shift;
+
+  my $read = $self->cfg->read_cfg;
+
+  # Check config file type
+  if ($read) {
+    if ($self->cfg->type ne 'bld') {
+      w_report 'Error: ', $self->cfg->src, ': not a build config file.';
+      return;
+    }
+
+  } else {
+    return;
+  }
+
+  my %cfg_label = %{ $self->config->setting ('CFG_LABEL') };
+  my %tools     = %{ $self->config->setting ('TOOL') };
+
+  # Get lines from cfg file
+  my @cfg_lines  = $self->cfg->lines;
+
+  LINE: for my $line (@cfg_lines) {
+    # Label and value of each line
+    my $label = $line->{LABEL};
+    my $value = $line->{VALUE};
+
+    next LINE unless $label; # ignore blank or comment line
+
+    # Strip out BLD prefix from all labels
+    my $prefix = $cfg_label{BDECLARE} . '::';
+    $label = substr ($label, length ($prefix))
+      if index (uc ($label), $prefix) == 0;
+
+    next LINE unless $label; # ignore blank or comment line
+
+    # Configuration file type/version, ignore
+    next LINE if uc $label eq $cfg_label{CFGFILE}{TYPE};
+    next LINE if uc $label eq $cfg_label{CFGFILE}{VERSION};
+
+    # User variable, ignore
+    next LINE if index (uc ($label), '%') == 0;
+
+    # Build name
+    if (uc $label eq $cfg_label{NAME}) {
+      $self->{NAME} = $value;
+      next LINE;
+    }
+
+    # Build directory tree
+    $prefix = $cfg_label{DIR} . '::';
+    if (index (uc ($label), $prefix) == 0) {
+      my $name = substr uc ($label), length ($prefix);
+      $self->{DIR}{$name} = expand_tilde $value;
+      next LINE;
+    }
+
+    # Source directory
+    $prefix = $cfg_label{SRCDIR} . '::';
+    if (index (uc ($label), $prefix) == 0) {
+      my $name = substr $label, length ($prefix);
+      $name    =~ s/::/__/g;
+      $self->{SRCDIR}{$name} = expand_tilde $value;
+      next LINE;
+    }
+
+    # Automatic source directory search?
+    if (uc $label eq $cfg_label{SEARCH_SRC}) {
+      $self->{SEARCH} = $value;
+      next LINE;
+    }
+
+    # Pre-process flag, directory/file requires pre-processing before all tasks
+    $prefix = $cfg_label{PP};
+    if (index (uc ($label), $prefix) == 0) {
+      my @flds = split /::/, $label;
+      my $name = uc shift @flds;
+      $name    = join '__', ($name, @flds) if @flds;
+      $self->{PP}{$name} = $value;
+      next LINE;
+    }
+
+    # Specify name of top level or package library
+    $prefix = $cfg_label{LIB};
+    if (index (uc ($label), $prefix) == 0) {
+      my @flds = split /::/, $label;
+      shift @flds;
+      my $name = @flds ? join ('__', @flds) : '';
+      $self->{LIB}{$name} = $value;
+
+      next LINE;
+    }
+
+    # Specify extra executable dependencies and BLOCKDATA dependency
+    for my $name (qw/EXE_DEP BLOCKDATA/) {
+      $prefix = $cfg_label{$name};
+
+      if (index (uc ($label), $prefix) == 0) {
+        my @flds = split /::/, $label;
+        shift @flds;
+        my $target = @flds ? $flds[0] : '';
+        my @deps   = split /\s+/, $value;
+
+        # If $value is a null string, set executable to depend on all objects
+        if (not @deps) {
+          if ($name eq 'BLOCKDATA') {
+
+            # Label not recognised
+            w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
+                     ': "', $label, '" declaration must have a value';
+            next LINE;
+
+          } else {
+            push @deps, '';
+          }
+        }
+
+        for my $dep (@deps) {
+          $dep =~ s/::/__/g;
+
+          $self->config->assign_setting (
+            LABELS => [$name, $target, $dep],
+            VALUE  => 1,
+          );
+        }
+
+        next LINE;
+      }
+    }
+
+    # Build target
+    if (uc $label eq $cfg_label{TARGET}) {
+      push @{ $self->{TARGET} }, split (/\s+/, $value);
+      next LINE;
+    }
+
+    # Rename a main program target
+    $prefix = $cfg_label{EXE_NAME};
+    if (index (uc ($label), $prefix) == 0) {
+      my @flds = split /::/, $label;
+      shift @flds;
+      my $name = shift @flds;
+
+      if ($name and $value) {
+        $self->config->assign_setting (
+          LABELS => ['EXE_NAME', $name],
+          VALUE  => $value,
+        );
+
+        next LINE;
+      }
+    }
+
+    # Build tool
+    $prefix = $cfg_label{TOOL} . '::';
+    if (index (uc ($label), $prefix) == 0) {
+      my $name = substr $label, length ($prefix);
+      my @flds = split /::/, $name;
+
+      $name = uc (shift @flds);
+
+      if (exists $tools{$name}) {
+        $name = join '__', ($name, @flds) if @flds;
+
+        $self->config->assign_setting (
+          LABELS => ['TOOL', $name],
+          VALUE  => $value,
+        );
+        next LINE;
+      }
+    }
+
+    # File name extension and type
+    for my $name (qw/INFILE_EXT OUTFILE_EXT/) {
+      $prefix = $cfg_label{$name};
+      if (index (uc ($label), $prefix) == 0) {
+        my $key = (split /::/, $label)[1];
+        $key    = uc $key if $name eq 'OUTFILE_EXT';
+
+        my $val = ($name eq 'INFILE_EXT') ? uc $value : $value;
+
+        $self->config->assign_setting (
+          LABELS => [$name, $key],
+          VALUE  => $val,
+        );
+        next LINE;
+      }
+    }
+
+    # Dependency scan exclusion
+    $prefix = $cfg_label{EXCL_DEP};
+    if (index (uc ($label), $prefix) == 0) {
+      my @flds = split /::/, $label;
+      shift @flds;
+
+      my $pk = @flds ? join ('__', @flds) : '';
+      $self->config->assign_setting (
+        LABELS => ['EXCL_DEP', uc ($value), $pk],
+        VALUE  => 1,
+      );
+      next LINE;
+    }
+
+    # Use (inherit from) another build
+    if (uc $label eq $cfg_label{USE}) {
+      my $use = Fcm::Build->new (
+        CONFIG  => $self->config,
+        CFG_SRC => expand_tilde ($value),
+      );
+      $use->decipher_cfg;
+      $use->check_dir;
+      push @{ $self->{USE} }, $use;
+      next LINE;
+    }
+
+    # Inheritance flag
+    $prefix = $cfg_label{INHERIT} . '::';
+    if (index (uc ($label), $prefix) == 0) {
+      my $name = substr $label, length ($prefix);
+      my @flds = split /::/, $name;
+
+      $name = uc (shift @flds);
+
+      for my $flag (qw/SRCDIR PP LIB TARGET/) {
+        if ($name eq $cfg_label{$flag}) {
+          $name = @flds ? join ('__', ($flag, @flds)) : $flag;
+          $self->{INHERIT}{$name} = $value;
+          next LINE;
+        }
+      }
+    }
+
+    # Label not recognised
+    w_report 'ERROR: ', $line->{SRC}, ': LINE ', $line->{NUMBER}, ': label "',
+             $label, '" not recognised';
+    return;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $bld->check_dir ();
+#
+# DESCRIPTION
+#   This method checks whether the build directories are set correctly.
+# ------------------------------------------------------------------------------
+
+sub check_dir {
+  my $self = shift;
+
+  # Make sure build root directory is set
+  if (not $self->{DIR}{ROOT}) {
+    w_report 'Error: build root directory not set.';
+    return;
+  }
+
+  # Set value of build sub-directories if necessary
+  for my $name (keys %{ $self->config->setting ('DIR') }) {
+    next if $self->{DIR}{$name};
+
+    $self->{DIR}{$name} = catfile (
+      $self->{DIR}{ROOT},
+      $self->config->setting ('DIR', $name),
+    );
+  }
+
+  # Search src/ sub-directory if necessary
+  if ($self->{SEARCH} and -d $self->{DIR}{SRC}) {
+    my %dir = find_srcdir ($self->{DIR}{SRC});
+    for my $name (keys %dir) {
+      $self->{SRCDIR}{$name} = $dir{$name} unless $self->{SRCDIR}{$name};
+    }
+  }
+
+  # Expand source directory paths if necessary
+  for my $name (keys %{ $self->{SRCDIR} }) {
+    if ($self->{SRCDIR}{$name} =~ /^\w/) {
+      my $src_search  = catfile $self->{DIR}{SRC} , $self->{SRCDIR}{$name};
+      my $root_search = catfile $self->{DIR}{ROOT}, $self->{SRCDIR}{$name};
+
+      if ($self->{DIR}{SRC} and -d $src_search) {
+        $self->{SRCDIR}{$name} = $src_search;
+
+      } elsif (-d $root_search) {
+        $self->{SRCDIR}{$name} = $root_search;
+
+      } else {
+        w_report 'Warning: cannot locate declared source directory: ',
+                 $self->{SRCDIR}{$name};
+        next;
+      }
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $bld->check_lock ();
+#
+# DESCRIPTION
+#   This method checks whether a lock is set in the current build.
+# ------------------------------------------------------------------------------
+
+sub check_lock {
+  my $self = shift;
+
+  my $rootdir  = $self->{DIR}{ROOT};
+  my $lock_ext = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_EXT/));
+  my $lock_bld = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_BLD/));
+
+  # Always throw error if extract lock exists
+  if (-e $lock_ext) {
+    w_report 'ERROR: extract lock file exists: ', $lock_ext, ',';
+    w_report '       an extract may be running at ', $rootdir, ', abort.';
+    return;
+  }
+
+  # Always throw error if build lock exists
+  if (-e $lock_bld) {
+    w_report 'ERROR: build lock file exists: ', $lock_bld, ',';
+    w_report '       a build may be running at ', $rootdir, ', abort.';
+    return;
+  }
+
+  # Check locks in inherited build
+  for my $use (@{ $self->{USE} }) {
+    return unless $use->check_lock;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_set_lock ();
+#
+# DESCRIPTION
+#   This method sets a lock is set in the current build.
+# ------------------------------------------------------------------------------
+
+sub _set_lock {
+  my $self = shift;
+
+  $self->{LOCK} = catfile (
+    $self->{DIR}{ROOT}, $self->config->setting (qw/MISC LOCK_BLD/),
+  );
+
+  &touch_file ($self->{LOCK});
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_setup_dir (FULL => $full);
+#
+# DESCRIPTION
+#   This internal method sets up the build directories.
+# ------------------------------------------------------------------------------
+
+sub _setup_dir {
+  my $self = shift;
+  my %args = @_;
+
+  my $full = exists $args{FULL} ? $args{FULL} : 0;
+
+  my $tar      = $self->config->setting (qw/OUTFILE_EXT TAR/);
+  my @tar_dirs = split /,/, $self->config->setting (qw/TAR_DIRS/);
+  my $verbose  = $self->config->verbose;
+
+  if ($full) {
+    # Remove sub-directories/archives created from previous builds
+    for my $name (qw/BIN BLD DONE ETC FLAGS INC LIB PPSRC OBJ TMP/) {
+      &run_command ([qw/rm -rf/, $self->{DIR}{$name}], PRINT => $verbose)
+        if -d $self->{DIR}{$name};
+
+      &run_command ([qw/rm -f/, $self->{DIR}{$name} . $tar], PRINT => $verbose)
+        if -f $self->{DIR}{$name} . $tar;
+    }
+
+    # Remove cache
+    my @files;
+    if (-d $self->{DIR}{CACHE} and opendir DIR, $self->{DIR}{CACHE}) {
+      @files = grep {$_ ne '.' and $_ ne '..'} readdir 'DIR';
+      closedir DIR;
+    }
+
+    my $extension = '\\' . $self->config->setting (qw/CACHE PCKFILE/) . '|' .
+                    '\\' . $self->config->setting (qw/CACHE PCKPPDEPEND/) . '|' .
+                    '\\' . $self->config->setting (qw/CACHE PCKDEPEND/);
+
+
+    for my $file (@files) {
+      next unless $file eq $self->config->setting (qw/CACHE BLDTOOL/) or
+                  $file eq $self->config->setting (qw/CACHE PPOPTION/) or
+                  $file eq $self->config->setting (qw/CACHE EXE_DEP/) or
+                  $file =~ /$extension$/;
+
+      my $path = File::Spec->catfile ($self->{DIR}{CACHE}, $file);
+      &run_command ([qw/rm -f/, $path], PRINT => $verbose);
+    }
+
+  } else {
+    # Extract archives if necessary
+    for my $name (@tar_dirs) {
+      my $tar_file = $self->{DIR}{$name} . $tar;
+
+      if (-f $tar_file) {
+        &run_command ([qw/tar -x -f/, $tar_file], PRINT => $verbose > 1);
+        &run_command ([qw/rm -f/, $tar_file], PRINT => $verbose > 1);
+      }
+    }
+  }
+
+  # Set up search paths
+  for my $name (keys %{ $self->{DIR} }) {
+    $self->{PATH}{$name} = [$self->_get_inherited_paths ($name)];
+
+    $self->config->assign_setting (
+      LABELS => ['PATH', $name],
+      VALUE  => $self->{PATH}{$name},
+    )
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_bld_info ();
+#
+# DESCRIPTION
+#   This internal method sets up the inheritance relationship for source
+#   directories and targets, and other configurations required by the build.
+# ------------------------------------------------------------------------------
+
+sub _update_bld_info {
+  my $self = shift;
+
+  # Set up build targets
+  $self->{TARGET} = [$self->_get_inherited_items ('TARGET')];
+
+  # Set up PP switches
+  $self->{PP} = {$self->_get_inherited_items ('PP')};
+
+  # Set up source directory packages for this build
+  my %srcdir = $self->_get_inherited_items ('SRCDIR');
+  for my $name (keys %srcdir) {
+    my $package = Fcm::SrcPackage->new (
+      CONFIG     => $self->config,
+      NAME       => $name,
+      CURRENT    => exists $self->{SRCDIR}{$name},
+      REQUIREPP  => $self->_require_pp ($name),
+      SEARCHPATH => [$self->_get_inherited_srcdirs ($name)],
+    );
+
+    $package->update_file_info ();
+
+    $self->{PACKAGE}{$name} = $package;
+  }
+
+  # Set up runtime dependency scan patterns
+  my %dep_pattern = %{ $self->config->setting ('DEP_PATTERN') };
+  for my $key (keys %dep_pattern) {
+    my $pattern = $dep_pattern{$key};
+
+    while ($pattern =~ /##([\w:]+)##/g) {
+      my $match = $1;
+      my $val   = $self->config->setting (split (/::/, $match));
+
+      last unless defined $val;
+      $val =~ s/\./\\./;
+
+      $pattern =~ s/##$match##/$val/;
+    }
+
+    $self->config->assign_setting (
+      LABELS => ['DEP_PATTERN', $key],
+      VALUE  => $pattern,
+    ) unless $pattern eq $dep_pattern{$key};
+  }
+
+  # Set up top level library name
+  {
+    $self->{LIB} = {$self->_get_inherited_items ('LIB')};
+
+    my $lib = $self->{LIB}{''};
+    $lib    = ($self->{NAME} ? $self->{NAME} : 'fcm_default') unless $lib;
+    $self->{LIB}{''} = $lib;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_regen_rule_info ();
+#
+# DESCRIPTION
+#   This internal method compares the current EXE_DEP, BLOCKDATA and EXE_NAME
+#   declarations and the previous. If changed, the REGEN_MAKERULE flag will be
+#   set to true and the cache will be updated.
+# ------------------------------------------------------------------------------
+
+sub _update_regen_rule_info {
+  my $self = shift;
+
+  # Look for an extra executable dependency cache file
+  my $cachebase = $self->config->setting (qw/CACHE EXE_DEP/);
+  my $incache   = find_file_in_path $cachebase, $self->{PATH}{CACHE};
+
+  my $uptodate = 0;
+  my @inlines  = ();
+
+  # Read cache if it exists
+  if ($incache and -r $incache) {
+    my $incfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $incache);
+    $incfg->read_cfg;
+
+    @inlines  = $incfg->lines;
+    $uptodate = 1;
+  }
+
+  # Prepare output lines
+  my $outcfg = Fcm::CfgFile->new (CONFIG => $self->config);
+  $outcfg->add_line (COMMENT => 'EXE_DEP cache');
+
+  # List of extra executable dependencies
+  my %exe_dep   = %{ $self->config->setting ('EXE_DEP') };
+  for my $target (sort keys %exe_dep) {
+    $outcfg->add_line (
+      LABEL => ($target ? 'OBJECTS__' . $target : 'OBJECTS'),
+      VALUE => join (' ', sort keys %{ $exe_dep{$target} }),
+    );
+  }
+
+  # List of BLOCKDATA dependencies
+  my %blockdata = %{ $self->config->setting ('BLOCKDATA') };
+  for my $target (sort keys %blockdata) {
+    $outcfg->add_line (
+      LABEL => ($target ? 'BLOCKDATA__' . $target : 'BLOCKDATA'),
+      VALUE => join (' ', sort keys %{ $blockdata{$target} }),
+    );
+  }
+
+  # List of EXE_NAME
+  my %exe_name = %{ $self->config->setting ('EXE_NAME') };
+  for my $target (sort keys %exe_name) {
+    $outcfg->add_line (
+      LABEL => 'EXE_NAME__' . $target,
+      VALUE => $exe_name{$target},
+    );
+  }
+
+  # Compare cache with current output
+  my @outlines = $outcfg->lines ();
+
+  $uptodate = 0 if @inlines != @outlines;
+
+  if ($uptodate) {
+    for my $i (0 .. $#outlines) {
+      next unless $inlines[$i]->{LABEL} and $outlines[$i]->{LABEL};
+
+      if ($inlines[$i]->{LABEL} ne $outlines[$i]->{LABEL} or
+          $inlines[$i]->{VALUE} ne $outlines[$i]->{VALUE}) {
+        $uptodate = 0;
+        last;
+      }
+    }
+  }
+
+  # Update cache if it is out of date
+  $outcfg->print_cfg (catfile ($self->{DIR}{CACHE}, $cachebase))
+    unless $uptodate;
+
+  # If out to date, set regenerate make rule flag to true
+  $self->config->assign_setting (
+    LABELS => [qw/REGEN_MAKERULE/],
+    VALUE  => ! $uptodate,
+  );
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_pp_info ();
+#
+# DESCRIPTION
+#   This internal method compares the current set of pre-processor options
+#   with that of the previous build using a "cache" file. If some
+#   pre-processor options have changed, the method updates the cache file and
+#   remove the "make" rules for the appropriate source packages.
+# ------------------------------------------------------------------------------
+
+sub _update_pp_info {
+  my $self = shift;
+
+  # Look for a PP option cache file
+  my $cachebase = $self->config->setting (qw/CACHE PPOPTION/);
+  my $incache   = find_file_in_path $cachebase, $self->{PATH}{CACHE};
+
+  my @chgpp = ();
+  my %newpp = %{ $self->{PP} };
+
+  # Read config if exists, otherwise marked all current PP flags as "changed"
+  if ($incache and -r $incache) {
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $incache);
+    $cfg->read_cfg;
+
+    my @lines   = $cfg->lines;
+    my %oldpp = ();
+
+    for my $line (@lines) {
+      next unless $line->{LABEL};
+
+      $oldpp{$line->{LABEL}} = $line->{VALUE};
+    }
+
+    # Compare new and old, mark as "changed" if changed or does not exist in old
+    @chgpp = (grep {
+      exists $oldpp{$_} ? $oldpp{$_} ne $newpp{$_} : 1;
+    } keys %newpp);
+
+    # Compare old and new, mark as "changed" if not exist in new
+    push @chgpp, (grep {not exists $newpp{$_}} keys %oldpp);
+
+  } else {
+    @chgpp = keys %newpp;
+  }
+
+  if (@chgpp) {
+    for my $name (@chgpp) {
+      for my $package (values %{ $self->{PACKAGE} }) {
+        next if $package->newpp;
+
+        if (('PP__' . $package->name) =~ /^$name(?:__|$)/) {
+          $package->current (1);
+          $package->newpp   (1);
+        }
+      }
+    }
+
+    # Update the PP cache file if necessary
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+    for my $name (keys %newpp) {
+      $cfg->add_line (LABEL => $name, VALUE => $newpp{$name});
+    }
+    $cfg->add_line unless $cfg->lines;
+
+    $cfg->print_cfg (catfile ($self->{DIR}{CACHE}, $cachebase));
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_tool_info ();
+#
+# DESCRIPTION
+#   This internal method compares the current set of build tools with that of
+#   the previous build using a "cache" file. If some build tools have changed,
+#   the method updates the cache file and (the time stamps of) dummy "flags"
+#   files to denote changes in build tools from the previous build.
+# ------------------------------------------------------------------------------
+
+sub _update_tool_info {
+  my $self = shift;
+
+  # Look for a build tool cache file
+  my $cachebase = $self->config->setting (qw/CACHE BLDTOOL/);
+  my $incache   = find_file_in_path $cachebase, $self->{PATH}{CACHE};
+
+  my @chgtool = ();
+  my %newtool = %{ $self->config->setting ('TOOL') };
+
+  # Read config if exists, otherwise marked all current tools as "changed"
+  if ($incache and -r $incache) {
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $incache);
+    $cfg->read_cfg;
+
+    my @lines   = $cfg->lines;
+    my %oldtool = ();
+
+    for my $line (@lines) {
+      next unless $line->{LABEL};
+
+      $oldtool{$line->{LABEL}} = $line->{VALUE};
+    }
+
+    # Compare new and old, mark as "changed" if changed or does not exist in old
+    @chgtool = (grep {
+      exists $oldtool{$_} ? $oldtool{$_} ne $newtool{$_} : 1;
+    } keys %newtool);
+
+    # Compare old and new, mark as "changed" if not exist in new
+    push @chgtool, (grep {not exists $newtool{$_}} keys %oldtool);
+
+  } else {
+    @chgtool = keys %newtool;
+  }
+
+  if (@chgtool) {
+    # Update the time stamps of dummy files for changed tools
+    $self->_create_build_dir ('FLAGS');
+
+    my $ext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+    for my $name (@chgtool) {
+      my $file = catfile $self->{DIR}{FLAGS}, $name . $ext;
+
+      # Create/touch the file
+      touch_file $file or croak 'Unable to update: ', $file, ', abort';
+
+      print 'Updated: ', $file, "\n" if $self->config->verbose > 2;
+    }
+
+    # Update the build tool cache file if necessary
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+    for my $name (keys %newtool) {
+      $cfg->add_line (LABEL => $name, VALUE => $newtool{$name});
+    }
+
+    $cfg->print_cfg (catfile ($self->{PATH}{CACHE}->[0], $cachebase));
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_pre_process ();
+#
+# DESCRIPTION
+#   This internal method obtains a list of source files that require
+#   pre-processing in the source packages of this build, and attempts to
+#   pre-process them. The method returns 1 on success.
+# ------------------------------------------------------------------------------
+
+sub _pre_process {
+  my $self = shift;
+
+  # Go through source packages/files to see if PP is required
+  my @srcfiles = ();
+  for my $package (values %{ $self->{PACKAGE} }) {
+    next unless $package->requirepp;
+
+    $package->scan_dependency (HEADER_ONLY => 1);
+
+    push @srcfiles, grep ({$_->is_type_or (qw/FPP C/)} $package->srcfile);
+  }
+
+  return 1 unless @srcfiles;
+
+  my %task     = ();
+  my $flagsext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+  my $pdoneext = $self->config->setting (qw/OUTFILE_EXT PDONE/);
+
+  # Set up tasks for each source file
+  for my $srcfile (@srcfiles) {
+    my $command  = $srcfile->is_type ('FPP') ? 'FPP' : 'CPP';
+    my @pck_list = $srcfile->get_package_list;
+    my @pknames  = split '__', pop (@pck_list);
+
+    # Set up a PP build task for each source file
+    my $target    = $srcfile->base . $pdoneext;
+    my $ppkeyname = join ('__', ($command . 'KEYS' , @pknames)) . $flagsext;
+    my $flagsname = join ('__', ($command . 'FLAGS', @pknames)) . $flagsext;
+
+    # Issue warning for duplicated tasks
+    if (exists $task{$target}) {
+      w_report 'Warning: ', $target, ': unable to create task for: ',
+               $srcfile->src, ': task already exists for: ',
+               $task{$target}->srcfile->src;
+      next;
+    }
+
+    $task{$target} = Fcm::BuildTask->new (
+      CONFIG     => $self->config,
+      TARGET     => $target,
+      TARGETPATH => $self->{PATH}{DONE},
+      SRCFILE    => $srcfile,
+      DEPENDENCY => [$ppkeyname, $flagsname, ($srcfile->dep ('H'))],
+      ACTIONTYPE => 'PP',
+    );
+
+    # Set up update ppkeys/flags build tasks for each source file/package
+    for my $i (0 .. $#pknames) {
+      my $name  = join '__', @pknames [0 .. $i];     # package name
+      my $dname = join '__', @pknames [0 .. $i - 1]; # dependent package name
+
+      for my $flag (qw/KEYS FLAGS/) {
+        my $fullflag = $command . $flag;
+        my $target   = join '__', ($fullflag, $name);
+        my $depend   = $dname ? join '__', ($fullflag, $dname) : $fullflag;
+
+        $target .= $flagsext;
+        $depend .= $flagsext;
+
+        next if exists $task{$target};
+
+        $task{$target} = Fcm::BuildTask->new (
+          CONFIG     => $self->config,
+          TARGET     => $target,
+          TARGETPATH => $self->{PATH}{FLAGS},
+          DEPENDENCY => [$depend],
+          ACTIONTYPE => 'UPDATE',
+        );
+      }
+    }
+  }
+
+  # Set up update global ppkeys/flags build tasks
+  for my $command (qw/CPP FPP/) {
+    for my $flag ('', qw/KEYS FLAGS/) {
+      my $target = $command . $flag . $flagsext;
+
+      $task{$target} = Fcm::BuildTask->new (
+        CONFIG     => $self->config,
+        TARGET     => $target,
+        TARGETPATH => $self->{PATH}{FLAGS},
+        ACTIONTYPE => 'UPDATE',
+      );
+    }
+  }
+
+  # Set up build tasks to copy all header files
+  for my $package (values %{ $self->{PACKAGE} }) {
+    my @files = grep {$_->is_type (qw/CPP INCLUDE/)} $package->srcfile;
+
+    # Author's note: may also want to issue warning for duplicated tasks
+
+    for my $file (@files) {
+      $task{$file->base} = Fcm::BuildTask->new (
+        CONFIG     => $self->config,
+        TARGET     => $file->base,
+        TARGETPATH => $self->{PATH}{INC},
+        SRCFILE    => $file,
+        DEPENDENCY => [$file->dep ('H')],
+        ACTIONTYPE => 'COPY',
+      );
+    }
+  }
+
+  # Build all PP tasks
+  my $count = 0;
+
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'PP';
+
+    my $rc = $task->action (TASKLIST => \%task);
+    $count++ if $rc;
+  }
+
+  print 'Number of pre-processed files: ', $count, "\n"
+    if $self->config->verbose and $count;
+
+  # Change path and file type of pre-processed source files
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'PP';
+
+    # Remove header dependencies from source file
+    my %dep = $task->srcfile->dep ();
+    for my $key (keys %dep) {
+      delete $dep{$key} if $dep{$key} eq 'H';
+    }
+    $task->srcfile->dep (\%dep);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_generate_f9x_interface ();
+#
+# DESCRIPTION
+#   This internal method obtains a list of Fortran 9X source files in the
+#   source packages of this build, and attempts to generate an interface block
+#   file for each of the Fortran 9X source files. The method returns 1 on
+#   success.
+# ------------------------------------------------------------------------------
+
+sub _generate_f9x_interface {
+  my $self = shift;
+
+  # Go through source packages/files for Fortran 9x source files with
+  # standalone subroutines or functions
+  my @srcfiles = ();
+  for my $package (values %{ $self->{PACKAGE} }) {
+    next unless $package->current;
+
+    push @srcfiles, grep {
+      $_->is_type_or (qw/FORTRAN9X FPP9X/) and
+      uc ($_->select_tool ('GENINTERFACE')) ne 'NONE' and
+      not $_->is_type_or (qw/PROGRAM MODULE INCLUDE/)
+    } $package->srcfile;
+  }
+
+  my $flagsext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+  my $pdoneext = $self->config->setting (qw/OUTFILE_EXT PDONE/);
+
+  # Set up build task to generate interface files for all selected Fortran 9x
+  # sources
+  my %task         = ();
+  for my $srcfile (@srcfiles) {
+    my $target  = $srcfile->interfacebase . $pdoneext;
+    my @pknames = split '__', ($srcfile->get_package_list)[-1];
+    my $flag    = join ('__', ('GENINTERFACE', @pknames)) . $flagsext;
+
+    $task{$target} = Fcm::BuildTask->new (
+      CONFIG     => $self->config,
+      TARGET     => $target,
+      TARGETPATH => $self->{PATH}{DONE},
+      SRCFILE    => $srcfile,
+      DEPENDENCY => [$flag],
+      ACTIONTYPE => 'GENINTERFACE',
+    );
+
+    # Set up build tasks for each source file/package flags file for interface
+    # generator tool
+    for my $i (0 .. $#pknames) {
+      my $name   = join '__', @pknames [0 .. $i];     # package name
+      my $dname  = join '__', @pknames [0 .. $i - 1]; # dependent package name
+
+      my $target = join '__', ('GENINTERFACE', $name);
+      my $depend = $dname ? join '__', ('GENINTERFACE', $dname) : 'GENINTERFACE';
+
+      $target .= $flagsext;
+      $depend .= $flagsext;
+
+      next if exists $task{$target};
+
+      $task{$target} = Fcm::BuildTask->new (
+        CONFIG     => $self->config,
+        TARGET     => $target,
+        TARGETPATH => $self->{PATH}{FLAGS},
+        DEPENDENCY => [$depend],
+        ACTIONTYPE => 'UPDATE',
+      );
+    }
+  }
+
+  # Set up build task to update the flags file for interface generator tool
+  {
+    my $target     = 'GENINTERFACE' . $flagsext;
+    $task{$target} = Fcm::BuildTask->new (
+      CONFIG     => $self->config,
+      TARGET     => $target,
+      TARGETPATH => $self->{PATH}{FLAGS},
+      ACTIONTYPE => 'UPDATE',
+    );
+  }
+
+  my $count = 0;
+
+  # Performs task
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'GENINTERFACE';
+
+    my $rc = $task->action (TASKLIST => \%task);
+    $count++ if $rc;
+  }
+
+  print 'Number of generated interfaces: ', $count, "\n"
+    if $self->config->verbose and $count;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_scan_dependency ();
+#
+# DESCRIPTION
+#   This internal method goes through each source package to obtain dependency
+#   information from their source files. It returns 1 on success.
+# ------------------------------------------------------------------------------
+
+sub _scan_dependency {
+  my $self = shift;
+
+  # Go through source packages/files
+  my $count = 0;
+
+  for my $package (values %{ $self->{PACKAGE} }) {
+    my $rc = $package->scan_dependency;
+    $count++ if $rc;
+  }
+
+  print 'Scanned files in ', $count, ' package(s) for dependency', "\n"
+    if $self->config->verbose and $count;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_set_targets ();
+#
+# DESCRIPTION
+#   This internal method determines the default targets to be built.
+# ------------------------------------------------------------------------------
+
+sub _set_targets {
+  my $self = shift;
+
+  # Targets of the build
+  if (not @{ $self->{TARGET} }) {
+    # Build targets not specified by user, default to building all main programs
+    my @programs = ();
+
+    # Get all main programs from all packages
+    for my $package (values %{ $self->{PACKAGE} }) {
+      my @srcfiles = grep {$_->exebase} $package->srcfile;
+
+      for (@srcfiles) {
+        push @programs, $_->exebase;
+      }
+    }
+
+    @programs = sort (@programs);
+
+    if (@programs) {
+      # Build main programs, if there are any
+      @{ $self->{TARGET} } = @programs;
+
+    } else {
+      # No main program in source tree, build the default library
+      @{ $self->{TARGET} } = (
+        'lib' . $self->{LIB}{''} . $self->config->setting (qw/OUTFILE_EXT LIB/),
+      );
+    }
+  }
+
+  return @{ $self->{TARGET} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_write_make_rules ();
+#
+# DESCRIPTION
+#   This internal method writes the included make rules if necessary.
+# ------------------------------------------------------------------------------
+
+sub _write_make_rules {
+  my $self   = shift;
+  my $return = 1;
+
+  # Get list of all packages
+  my %allpcks = $self->allpcks;
+
+  # Get list of types that cannot have duplicated targets
+  my @no_duplicated_target_types = split (
+    /,/, $self->config->setting ('NO_DUPLICATED_TARGET_TYPE'),
+  );
+
+  my $unusual = 0;
+  my $count   = 0;
+  my %targets;
+  for my $name (sort keys %allpcks) {
+    # Check whether package is an actual package of the build
+    my $package  = exists $self->{PACKAGE}{$name} ? $self->{PACKAGE}{$name} : '';
+
+    # Regenerate make rules if this flag is set to true
+    my $regen_mk;
+
+    # Register non-word package name
+    if (not $name =~ /^\w*$/) {
+      $self->config->assign_setting (
+        LABELS => ['FCM_PCK_OBJECTS', $name],
+        VALUE  => 'FCM_PCK_OBJECTS' . $unusual++,
+      );
+
+      # Set regenerate make rule flag to true
+      $regen_mk = 1;
+    }
+
+    # Cycle loop if not an actual package of the build
+    next unless $package;
+
+    # Check whether make rule for each source package needs updating. Yes if:
+    # 1. package name contains non-word characters
+    # 2. the config setting REGEN_MAKERULE is set to true
+    # 3. package is current and the make rule for the package is out of date
+    $regen_mk = (
+      $regen_mk or
+      $self->config->setting ('REGEN_MAKERULE') or
+      ($package->current and not $package->makerule_uptodate)
+    );
+
+    # Update make rule for source package, if necessary
+    $count += $package->write_makerule () if $regen_mk;
+
+    # Check for duplicated rules
+    for my $srcfile (sort $package->srcfile) {
+      next unless $srcfile->type;
+
+      my %rules = $srcfile->required_rules;
+
+      for my $key (sort keys %rules) {
+        if (exists $targets{$key}) {
+          # Duplicated target: warning for most file types
+          my $status = 'WARNING';
+
+          # Duplicated target: error for the following file types
+          if (@no_duplicated_target_types and
+              $srcfile->is_type_or (@no_duplicated_target_types) and
+              $targets{$key}->is_type_or (@no_duplicated_target_types)) {
+            $status = 'ERROR';
+            $return = 0;
+          }
+
+          # Report the warning/error
+          w_report $status, ': ', $key, ': duplicated targets for building:';
+          w_report '       ', $targets{$key}->src;
+          w_report '       ', $srcfile->src;
+
+        } else {
+          $targets{$key} = $srcfile;
+        }
+      }
+    }
+  }
+
+  # Diagnostic
+  print 'Updated make rules for ', $count, ' package(s).', "\n"
+    if $count and $self->config->verbose;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_write_makefile ();
+#
+# DESCRIPTION
+#   This internal method writes the "Makefile" for this build.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile {
+  my $self = shift;
+
+  # Makefile header
+  # ----------------------------------------------------------------------------
+  my $makefile = '# Automatic Makefile' . "\n\n";
+
+  # Name of the build
+  $makefile .= 'FCM_BUILD_NAME = ' . $self->{NAME} . "\n" if $self->{NAME};
+  
+  # Location of FCM config file
+  $makefile .= 'FCM_BLD_CFG = ' . $self->cfg->src . "\n";
+
+  # Targets of the build
+  $makefile .= 'FCM_BLD_TARGETS = ' . join (' ', ($self->_set_targets)) . "\n\n";
+
+  # Perl library
+  # ----------------------------------------------------------------------------
+  {
+    my $libdir  = dirname (dirname ($INC{'Fcm/Build.pm'}));
+    my @libpath = split /:/, ($ENV{PERL5LIB} ? $ENV{PERL5LIB} : '');
+
+    if (not grep (m/$libdir/, @libpath)) {
+      $makefile .= 'export PERL5LIB := ' . $libdir;
+      $makefile .= ':$(PERL5LIB)' if exists $ENV{PERL5LIB};
+      $makefile .= "\n\n";
+    }
+  }
+
+  # Build directories
+  # ----------------------------------------------------------------------------
+  my @keys    = ('ROOT', sort grep {$_ ne 'ROOT'} keys (%{ $self->{DIR} }));
+  my $rootdir = $self->{DIR}{ROOT};
+
+  # Build sub-directories
+  for my $name (@keys) {
+    my $dir = $self->{DIR}{$name};
+    $dir    =~ s/^$rootdir/\$(FCM_ROOTDIR)/ unless $name eq 'ROOT';
+
+    $makefile .= 'export FCM_' . $name . 'DIR = ' . $dir . "\n";
+  }
+
+  $makefile .= "\n";
+
+  # Build sub-directory paths
+  for my $name (@keys) {
+    my @path = @{ $self->{PATH}{$name} };
+    shift @path;
+
+    $makefile .= 'export FCM_' . $name . 'PATH = ' .
+                 join (':', ('$(FCM_' . $name . 'DIR)', @path)) . "\n";
+  }
+
+  $makefile .= "\n";
+
+  # Build tools
+  # ----------------------------------------------------------------------------
+  # List of build tools
+  my $tool          = $self->config->setting ('TOOL');
+
+  # List of tools local to FCM, (will not be exported)
+  my %localtool     = map {($_, 1)} split (    # map into a hash table
+    /,/, $self->config->setting ('LOCALTOOL'), # split comma separated list
+  );
+
+  # Export required tools
+  my $unusual_count = 0;
+  for my $name (sort keys %$tool) {
+    # Ignore local tools
+    my $topname = (split (/__/, $name))[0];
+    next if exists $localtool{$topname};
+
+    if ($name =~ /^\w+$/) {
+      # Tools with normal name, just export it as an environment variable
+      $makefile .= 'export ' . $name . ' = ' . $tool->{$name} . "\n";
+
+    } else {
+      # Tools with unusual characters, export using a label/value pair
+      $makefile .= 'export FCM_UNUSUAL_TOOL_LABEL' . $unusual_count . ' = ' .
+                   $name . "\n";
+      $makefile .= 'export FCM_UNUSUAL_TOOL_VALUE' . $unusual_count . ' = ' .
+                   $tool->{$name} . "\n";
+      $unusual_count++;
+    }
+  }
+
+  $makefile .= "\n";
+
+  # Verbose mode
+  # ----------------------------------------------------------------------------
+  $makefile .= 'export FCM_VERBOSE ?= ' . $self->config->verbose . "\n\n";
+
+  # VPATH
+  # ----------------------------------------------------------------------------
+  # $name is internal name of build sub-directories
+  # $type is the type of files
+  for my $name (sort keys %{ $self->config->setting ('VPATH') }) {
+    my @types = split /,/, $self->config->setting ('VPATH', $name);
+
+    for my $type (sort @types) {
+      # If $type is EMPTY, it is a file with no file name extension
+      if (uc ($type) eq 'EMPTY') {
+        $makefile .= 'vpath % $(FCM_' . $name . 'PATH)' . "\n";
+
+      } elsif ($type =~ s/^(in|out)://i) {
+        if (uc ($1) eq 'IN') {
+          # If $type begins with IN:<type>, it is a list of file extensions that
+          # can be found under the INFILE_EXT hash in the configuration setting,
+          # with <type> matching a keyword in the values of the hash.
+          my %infile_ext = %{ $self->config->setting ('INFILE_EXT') };
+
+          for my $ext (sort keys %infile_ext) {
+            $makefile .= 'vpath %.' . $ext . ' $(FCM_' . $name . 'PATH)' . "\n"
+              if grep {$_ eq $type} split /::/, $infile_ext{$ext};
+          }
+
+        } else {
+          # If $type begins with OUT:<type>, it is the value of a hash element
+          # in the OUTFILE_EXT hash in the configuration setting, with <type>
+          # matching the key.
+          my $ext    = $self->config->setting ('OUTFILE_EXT', $type);
+          $makefile .= 'vpath %' . $ext . ' $(FCM_' . $name . 'PATH)' . "\n";
+        }
+
+      } else {
+        # Otherwise, $type is a VPATH pattern recognised by "make".
+        $makefile .= 'vpath ' . $type . ' $(FCM_' . $name . 'PATH)' . "\n";
+      }
+    }
+  }
+
+  # VPATH for dummy files
+  $makefile .= 'vpath %.dummy $(FCM_DONEDIR)' . "\n";
+  $makefile .= "\n";
+
+  # Default targets
+  # ----------------------------------------------------------------------------
+  $makefile .= '.PHONY : all clean' . "\n\n";
+  $makefile .= 'all : $(FCM_BLD_TARGETS)' . "\n\n";
+  $makefile .= 'clean : ' . "\n";
+  $makefile .= "\t" . 'rm -rf';
+  for my $dir (qw/BIN LIB OBJ DONE/) {
+    $makefile .= ' $(FCM_' . $dir . 'DIR)' if exists $self->{DIR}{$dir};
+  }
+  $makefile .= "\n";
+  $makefile .= "\t" . 'rm -f lib__*' .
+               $self->config->setting (qw/OUTFILE_EXT LIB/) .
+               ' *' . $self->config->setting (qw/OUTFILE_EXT OBJ/) . "\n";
+  $makefile .= "\n";
+
+  # Targets for copy dummy
+  $makefile .= $self->config->setting (qw/MISC CPDUMMY/) . ' :' . "\n";
+  $makefile .= "\t" . 'touch $@' . "\n\n";
+
+  # Targets for all (non-main-program) objects and libraries
+  # ----------------------------------------------------------------------------
+  my %allpcks = $self->allpcks;
+  for my $key (reverse sort keys %allpcks) {
+    # Objects variable
+    my $var;
+    if ($self->config->setting ('FCM_PCK_OBJECTS', $key)) {
+      # Package name contains unusual characters, use predefined variable
+      $var = $self->config->setting ('FCM_PCK_OBJECTS', $key);
+
+    } else {
+      # Normal package name, prefix the package name with "OBJECTS__"
+      # Top level package, simply set to "OBJECTS"
+      $var = $key ? join ('__', ('OBJECTS', $key)) : 'OBJECTS';
+    }
+
+    # Export top level OBJECTS variable
+    # but keep sub-package OBJECTS variables local to the Makefile
+    $makefile .= ($var eq 'OBJECTS' ? 'export ' : '') . $var . ' =';
+
+    # Add objects from children
+    if (@{ $allpcks{$key} }) {
+      # List of sub-packages of current package
+      my @deps   = map {
+        if ($self->config->setting ('FCM_PCK_OBJECTS', $_)) {
+          # Package name contains unusual characters, use predefined variable
+          '$(' . $self->config->setting ('FCM_PCK_OBJECTS', $_) . ')';
+
+        } else {
+          # Normal package name, prefix the package name with "OBJECTS__"
+          '$(OBJECTS__' . $_ . ')';
+        }
+      } @{ $allpcks{$key} };
+
+      $makefile .= ' ' . join (' ', sort @deps);
+    }
+
+    # Add its own objects
+    if (exists $self->{PACKAGE}{$key}) {
+      # List of source files in the current package
+      my @files = sort {$a->base cmp $b->base} $self->{PACKAGE}{$key}->srcfile;
+
+      for my $file (@files) {
+        # Consider compilable source files only
+        next unless $file->objbase;
+
+        # Ignore main programs and Fortran BLOCKDATA program units
+        next if $file->is_type_or (qw/PROGRAM BLOCKDATA/);
+
+        # Add to object list
+        $makefile .= ' ' . $file->objbase;
+      }
+    }
+
+    $makefile .= "\n\n";
+
+    # Library target
+    my $lib = exists ($self->{LIB}{$key}) ? $self->{LIB}{$key} : $key;
+    $lib    = 'lib' . $lib . $self->config->setting (qw/OUTFILE_EXT LIB/);
+
+    $makefile .= $lib . ' : $(' . $var . ')' . "\n";
+    $makefile .= "\t" . 'fcm_internal archive $@ $(^F)' . "\n\n";
+  }
+
+  # Targets for top level and package flags files and dummy dependencies
+  my %src_tool   = %{ $self->config->setting ('SRC_TOOL') };
+  my %flags_tool = (LD => '', LDFLAGS => '');
+
+  for my $key (keys %src_tool) {
+    $flags_tool{$src_tool{$key}{FLAGS}} = $src_tool{$key}{COMPILER}
+      if exists $src_tool{$key}{FLAGS};
+
+    $flags_tool{$src_tool{$key}{PPKEYS}} = ''
+      if exists $src_tool{$key}{PPKEYS};
+  }
+
+  my $ext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+  for my $name (sort keys %flags_tool) {
+    # Flags files for tool command
+    if ($flags_tool{$name}) {
+      $makefile .= $flags_tool{$name} . $ext . ' :' . "\n";
+      $makefile .= "\t" . 'touch ' . catfile ('$(FCM_FLAGSDIR)', '$@') . "\n\n";
+    }
+
+    # Top level flags files
+    $makefile .= $name . $ext . ' :';
+    $makefile .= ' ' . $flags_tool{$name} . $ext if $flags_tool{$name};
+    $makefile .= "\n\t" . 'touch ' . catfile ('$(FCM_FLAGSDIR)', '$@') . "\n\n";
+
+    # Package level flags files
+    for my $key (sort keys %allpcks) {
+      next unless @{ $allpcks{$key} }; # ignore packages without children
+
+      my $depend  = $key ? join '__', ($name, $key) : $name;
+      my @targets = sort map {$name . '__' . $_ . $ext} @{ $allpcks{$key} };
+
+      $makefile .= join (' ', @targets) . ' : ' . $depend . $ext . "\n";
+      $makefile .= "\t" . 'touch ' . catfile ('$(FCM_FLAGSDIR)', '$@') .
+                   "\n\n";
+    }
+  }
+
+  # Include source package make rules
+  # ----------------------------------------------------------------------------
+  for my $package (sort {$a->name cmp $b->name} values %{ $self->{PACKAGE} }) {
+    my $mkbase = $package->name . $self->config->setting (qw/OUTFILE_EXT MK/);
+    my $mkfile = find_file_in_path ($mkbase, $self->{PATH}{BLD});
+
+    if ($mkfile) {
+      if (index ($mkfile, $self->{DIR}{BLD}) == 0) {
+        $mkfile = catfile '$(FCM_BLDDIR)',
+                  substr ($mkfile, length ($self->{DIR}{BLD}) + 1);
+
+      } elsif (index ($mkfile, $self->{DIR}{ROOT}) == 0) {
+        $mkfile = catfile '$(FCM_ROOTDIR)',
+                  substr ($mkfile, length ($self->{DIR}{ROOT}) + 1);
+      }
+
+      $makefile .= 'include ' . $mkfile . "\n";
+
+    } else {
+      my $pck = join ('::', split (/__/, $package->name));
+      w_report 'Warning: no make rule file for source package: ', $pck;
+    }
+  }
+
+  $makefile .= "\n" . '# EOF' . "\n";
+
+  # Print Makefile
+  # ----------------------------------------------------------------------------
+  $self->_create_build_dir ('BLD');
+  my $out = catfile (
+    $self->{DIR}{BLD}, $self->config->setting (qw/MISC MAKEFILE/),
+  );
+
+  # Check whether an old file exists, if so compare current contents with it
+  my $old = '';
+
+  if (-r $out) {
+    open OLD, '<', $out or croak 'Cannot open "', $out, '" (', $!, '), abort';
+    my @lines = readline 'OLD';
+    close OLD;
+
+    $old = join ('', @lines);
+  }
+
+  # Update Makefile if changed
+  if ($old ne $makefile) {
+    open OUT, '>', $out or croak 'Cannot open "', $out, '" (', $!, '), abort';
+    print OUT $makefile;
+    close OUT or croak 'Cannot close "', $out, '" (', $!, '), abort';
+
+    print 'Updated Makefile: ', $out, "\n" if $self->config->verbose;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_invoke_make (
+#     TARGETS => \@targets,
+#     JOBS    => $jobs,
+#     ARCHIVE => $archive,
+#   );
+#
+# DESCRIPTION
+#   This internal method invokes the "make" command to make the build.
+#
+# ARGUMENTS
+#   TARGETS - Specify targets to be built. If set, these targets will be built
+#             instead of the ones specified in the build configuration file.
+#   JOBS    - Specify number of jobs that can be handled by "make". If set,
+#             the value must be a natural integer. If not set, the default
+#             value is 1 (i.e. run "make" in serial mode).
+#   ARCHIVE - If set to "true", invoke the "archive" mode. Most build files and
+#             directories created by this build will be archived using the
+#             "tar" command. If not set, the default is not to invoke the
+#             "archive" mode.
+# ------------------------------------------------------------------------------
+
+sub _invoke_make {
+  my $self = shift;
+  my %args = @_;
+
+  # Build the make command from the specified targets
+  my @targets  = exists $args{TARGETS} ? @{ $args{TARGETS} } : qw/all/;
+  my $jobs     = exists $args{JOBS}    ? $args{JOBS}         : 1;
+  my $archive  = exists $args{ARCHIVE} ? $args{ARCHIVE}      : 0;
+  my $verbose  = $self->config->verbose;
+
+  # Create the required build directories
+  for my $dir (qw/BIN DONE ETC INC FLAGS LIB OBJ TMP/) {
+    $self->_create_build_dir ($dir);
+  }  
+
+  my @commands = ();
+  my @make_cmd = ($self->config->setting (qw/TOOL MAKE/));
+  push @make_cmd, split (/\s+/, $self->config->setting (qw/TOOL MAKEFLAGS/));
+  push @make_cmd, $self->config->setting (qw/TOOL MAKE_SILENT/)
+    unless $verbose > 2;
+
+  if ($jobs > 1) { # multi-process "make"
+    my $make_job = $self->config->setting (qw/TOOL MAKE_JOB/);
+
+    # Setup the "make" commands for each target
+    while (my $target = shift @targets) {
+      if ($target eq 'clean') { # Do not run "clean" in parallel
+        push @commands, [@make_cmd, $target];
+
+      } else {
+        push @commands, [@make_cmd, $make_job, $jobs, $target];
+      }
+    }
+
+  } else { # single process "make"
+
+    # Setup the "make" command
+    push @commands, [@make_cmd, @targets];
+
+  }
+  
+  # Run the make command
+  my $rc  = 0;
+  my $cwd = cwd;
+  print 'cd ', $self->{DIR}{BLD}, "\n" if $verbose > 2;
+  chdir $self->{DIR}{BLD};
+  while (my $cmd = shift @commands) {
+    $| = 1; # flush STDOUT before running "make"
+    print timestamp_command (&get_command_string ($cmd)) if $verbose > 2;
+    $| = 0;
+    &run_command ($cmd, ERROR => 'warn', RC => \$rc);
+    print timestamp_command (&get_command_string ($cmd), 'End') if $verbose > 2;
+    last if $rc;
+  }
+  print 'cd ', $cwd, "\n" if $verbose > 2;
+  chdir $cwd;
+
+  return $rc ? undef : 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_remove_empty_dirs ();
+#
+# DESCRIPTION
+#   This internal method removes empty build directories.
+# ------------------------------------------------------------------------------
+
+sub _remove_empty_dirs {
+  my $self = shift;
+
+  for my $name (qw/BIN CACHE DONE ETC FLAGS INC LIB PPSRC OBJ TMP/) {
+    opendir DIR, $self->{DIR}{$name};
+    my @files = readdir DIR;
+    @files    = grep !/^\.\.?$/, @files;
+    closedir DIR;
+
+    if (not @files) {
+      print 'Remove directory: ', $self->{DIR}{$name}, "\n"
+        if $self->config->verbose > 1;
+      rmdir $self->{DIR}{$name};
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_tar_build_dirs ();
+#
+# DESCRIPTION
+#   This internal method creates TAR archives for selected build directories.
+# ------------------------------------------------------------------------------
+
+sub _tar_build_dirs {
+  my $self = shift;
+
+  # Create TAR archives if necessary
+  my $cwd = cwd;
+
+  my $tar      = $self->config->setting (qw/OUTFILE_EXT TAR/);
+  my @tar_dirs = split /,/, $self->config->setting (qw/TAR_DIRS/);
+  my $verbose  = $self->config->verbose;
+
+  for my $name (@tar_dirs) {
+    my $dir = $self->{DIR}{$name};
+
+    if (-d $dir) {
+      my $base = basename ($dir);
+      print 'cd ', dirname ($dir), "\n" if $verbose > 2;
+      chdir dirname ($dir);
+
+      my $rc = &run_command (
+        [qw/tar -c -f/, $base . $tar, $base],
+        PRINT => $verbose > 1, ERROR => 'warn',
+      );
+
+      &run_command ([qw/rm -rf/, $base], PRINT => $verbose > 1) if not $rc;
+    }
+  }
+
+  print 'cd ', $cwd, "\n" if $verbose > 2;
+  chdir $cwd;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_create_runenv_script ();
+#
+# DESCRIPTION
+#   This internal method creates the runtime environment script if necessary.
+# ------------------------------------------------------------------------------
+
+sub _create_runenv_script {
+  my $self = shift;
+
+  # More diagnostic on how to use the build
+  my @bin_dirs = grep {-d} @{ $self->{PATH}{BIN} };
+  my $etc_dir  = -d $self->{DIR}{ETC} ? $self->{DIR}{ETC} : undef;
+
+  if (@bin_dirs or $etc_dir) {
+    # Create a runtime environment script if necessary
+    my $run_env_sh_base = $self->config->setting (qw/MISC RUN_ENV_SH/);
+    my $run_env_sh      = catfile $self->{DIR}{ROOT}, $run_env_sh_base;
+
+    open FILE, '>', $run_env_sh
+      or croak $run_env_sh, ': cannot open (', $!, '), abort';
+    print FILE '#!/usr/bin/ksh', "\n";
+    print FILE 'export PATH=', join (':', @bin_dirs), ':$PATH', "\n"
+      if @bin_dirs;
+    print FILE 'export FCM_ETCDIR=', $self->{DIR}{ETC}, "\n" if $etc_dir;
+    close FILE or croak $run_env_sh, ': cannot close (', $!, '), abort';
+
+    # Create symbolic link in bin/ sub-directory for backward compatibility
+    if (-d $self->{DIR}{BIN}) {
+      my $file = catfile ($self->{DIR}{BIN}, $run_env_sh_base);
+      
+      # Remove old link if necessary
+      unlink $file if -l $file and readlink ($file) ne $run_env_sh;
+
+      # Create the new link
+      symlink $run_env_sh, $file if not -l $file;
+    }
+
+    # Information on the location/usage of the runtime environment script
+    if ($self->config->verbose > 1 and $run_env_sh) {
+      print '# ', '-' x 78, "\n";
+      print '# To use this build, source the following shell script:', "\n";
+      print '. ', $run_env_sh, "\n";
+      print '# ', '-' x 78, "\n";
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_create_lib_excl_dep ();
+#
+# DESCRIPTION
+#   This internal method creates a set of exclude dependency configurations for
+#   libraries of this build.
+# ------------------------------------------------------------------------------
+
+sub _create_lib_excl_dep {
+  my $self = shift;
+
+  if (-d $self->{DIR}{LIB}) {
+    $self->_create_build_dir ('ETC');
+    
+    my %allpcks  = $self->allpcks;
+    my $cfgext   = $self->config->setting (qw/OUTFILE_EXT CFG/);
+    my %cfglabel = %{ $self->config->setting ('CFG_LABEL') };
+
+    for my $key (reverse sort keys %allpcks) {
+      my $outcfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+      # Include configurations from sub-packages
+      for my $subpck (@{ $allpcks{$key} }) {
+        my $base = 'lib' . $subpck . $cfgext;
+        ($base = $self->{LIB}{$subpck}) =~ s/\.\w+$/$cfgext/
+          if exists ($self->{LIB}{$subpck});
+        my $file = catfile ('$HERE', $base);
+
+        $outcfg->add_line (LABEL => $cfglabel{INC}, VALUE => $file)
+          if -r catfile ($self->{DIR}{ETC}, $base);;
+      }
+
+      # Exclude dependency for source files in current package
+      if (exists $self->{PACKAGE}{$key}) {
+        my @srcfiles = $self->{PACKAGE}{$key}->srcfile;
+
+        for my $srcfile (@srcfiles) {
+          if ($srcfile->is_type ('INCLUDE')) {
+            if ($srcfile->is_type ('CPP')) {
+              $outcfg->add_line (
+                LABEL => $cfglabel{EXCL_DEP},
+                VALUE => 'H::' . $srcfile->base,
+              );
+
+            } elsif ($srcfile->is_type ('INTERFACE')) {
+              $outcfg->add_line (
+                LABEL => $cfglabel{EXCL_DEP},
+                VALUE => 'INTERFACE::' . $srcfile->base,
+              );
+
+            } else {
+              $outcfg->add_line (
+                LABEL => $cfglabel{EXCL_DEP},
+                VALUE => 'INC::' . $srcfile->base,
+              );
+            }
+
+          } elsif ($srcfile->is_type ('SOURCE')) {
+            next if $srcfile->is_type_or (qw/PROGRAM BLOCKDATA/);
+
+            if ($srcfile->is_type ('FORTRAN')) {
+              if ($srcfile->is_type (qw/FORTRAN MODULE/)) {
+                $outcfg->add_line (
+                  LABEL => $cfglabel{EXCL_DEP},
+                  VALUE => 'USE::' . $srcfile->root,
+                );
+
+              } else {
+                $outcfg->add_line (
+                  LABEL => $cfglabel{EXCL_DEP},
+                  VALUE => 'INTERFACE::' . $srcfile->interfacebase,
+                ) if $srcfile->interfacebase;
+
+                $outcfg->add_line (
+                  LABEL => $cfglabel{EXCL_DEP},
+                  VALUE => 'OBJ::' . $srcfile->root,
+                );
+              }
+
+            } else {
+              $outcfg->add_line (
+                LABEL => $cfglabel{EXCL_DEP},
+                VALUE => 'OBJ::' . $srcfile->root,
+              );
+            }
+          }
+        }
+      }
+
+      # Name of configuration file, follows the name of library
+      my $outbase ='lib' . $key . $cfgext;
+      ($outbase = $self->{LIB}{$key}) =~ s/\.\w+$/$cfgext/
+        if exists ($self->{LIB}{$key});
+      my $outfile = catfile ($self->{DIR}{ETC}, $outbase);
+
+      # Write to configuration file
+      $outcfg->print_cfg ($outfile);
+    }
+
+    # Information on the location/usage of the exclude dependency configurations
+    if ($self->config->verbose > 1) {
+      my $etcdir = $self->{DIR}{ETC};
+      print '# ', '-' x 78, "\n";
+      print <<EOF;
+# To use a library archive of this build in another FCM build, you need to
+# include in the new build configuration the corresponding configuration file
+# that has the relevant exclude dependency information. These configurations
+# files can be found in $etcdir.
+EOF
+      print '# ', '-' x 78, "\n";
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_create_build_dir ();
+#   $self->_create_build_dir ($label);
+#
+# DESCRIPTION
+#   This internal method creates a build directory. If $label is specified,
+#   the method will attempt to create a named sub-directory according to
+#   $label. Otherwise, the method attempts to create the build root
+#   directory. Returns the name of the directory if it is created successfully
+#   or if it already exists.
+# ------------------------------------------------------------------------------
+
+sub _create_build_dir {
+  my $self  = shift;
+  my $label = $_[0] ? uc $_[0] : 'ROOT';
+
+  my $dir = undef;
+
+  # Make sure the variable is set
+  if ($self->{DIR}{$label}) {
+    $dir = $self->{DIR}{$label};
+
+    # Expand relative path if necessary
+    $dir = catfile $self->{DIR}{ROOT}, $dir if $dir =~ /^\w/;
+
+  } else {
+    if ($label eq 'ROOT') {
+      w_report 'Error: build root directory not set.';
+      return;
+
+    } elsif ($self->config->setting ('DIR', $label)) {
+      $dir = catfile $self->{DIR}{ROOT}, $self->config->setting ('DIR', $label);
+
+    } else {
+      carp 'Directory label "', $label, '" not recognised';
+      return undef;
+    }
+  }
+
+  # Set up the bld directory, if required
+  if (not -d $dir) {
+    print 'Make directory: ', $dir, "\n" if $self->config->verbose > 1;
+    mkpath $dir or croak 'Cannot create directory "', $dir, '"';
+  }
+
+  $self->{DIR}{$label} = $dir unless $self->{DIR}{$label};
+
+  return $dir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_inherited_paths ($name);
+#
+# DESCRIPTION
+#   This recursive internal method returns a list containing the search path
+#   for a build directory named by the internal label $name. (Please note that
+#   a build directory will only be placed into the search path if the
+#   directory exists.)
+# ------------------------------------------------------------------------------
+
+sub _get_inherited_paths {
+  my $self = shift;
+  my $name = shift;
+
+  return () unless $name and exists $self->{DIR}{$name};
+
+  my @path = ();
+
+  # Recursively inherit the search path for a this type of build directory
+  for my $use (@{ $self->{USE} }) {
+    my @cur_path = $use->_get_inherited_paths ($name);
+    unshift @path, @cur_path;
+  }
+
+  # Place the path of the current build in the front
+  unshift @path, $self->{DIR}{$name};
+
+  return @path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_inherited_srcdirs ($name);
+#
+# DESCRIPTION
+#   This recursive internal method returns a list containing the search path
+#   for a source directory named by the internal package label $name. (Please
+#   note that a source directory will only be placed into the search path if
+#   the directory exists.)
+# ------------------------------------------------------------------------------
+
+sub _get_inherited_srcdirs {
+  my $self = shift;
+  my $name = shift;
+
+  return () unless $name;
+
+  my @path = ();
+
+  # Recursively inherit the search path for this source directory
+  my $key = 'SRCDIR__' . $name;
+  if ($self->_inherit_ok ($key)) {
+    for my $use (@{ $self->{USE} }) {
+      my @cur_path = $use->_get_inherited_srcdirs ($name);
+      unshift @path, @cur_path;
+    }
+  }
+
+  # Place the path of the current source in the front
+  unshift @path, $self->{SRCDIR}{$name}
+    if exists $self->{SRCDIR}{$name} and -d $self->{SRCDIR}{$name};
+
+  return @path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_inherited_items ($type);
+#
+# DESCRIPTION
+#   This recursive internal method returns a list containing an inherited
+#   build item of the type $type. (Depending of $type, the returned list can
+#   be an array or a hash.)
+# ------------------------------------------------------------------------------
+
+sub _get_inherited_items {
+  my $self = shift;
+  my $type = shift;
+
+  return () if not exists $self->{$type};
+
+  if (ref $self->{$type} eq 'ARRAY') {
+
+    my @items = ();
+
+    # Recursively inherit from used builds
+    if ($self->{INHERIT}{$type}) {
+      for my $use (@{ $self->{USE} }) {
+        my @cur_items = $use->_get_inherited_items ($type);
+
+        for my $item (@cur_items) {
+          my $type_item = $type . '__' . $item;
+
+          # Check inheritance option of current item
+          next unless $self->_inherit_ok ($type_item);
+
+          # The statement ensures that there is no duplication
+          push @items, $item unless grep {$_ eq $item} @items;
+        }
+      }
+    }
+
+    # Items in current build
+    if (@{ $self->{$type} }) {
+      for my $item (@{ $self->{$type} }) {
+        # The statement ensures that there is no duplication
+        push @items, $item unless grep {$_ eq $item} @items;
+      }
+    }
+
+    return @items;
+
+  } elsif (ref $self->{$type} eq 'HASH') {
+
+    my %items = ();
+
+    # Recursively inherit from used builds
+    if ($self->{INHERIT}{$type}) {
+      for my $use (@{ $self->{USE} }) {
+        my %cur_items = $use->_get_inherited_items ($type);
+
+        for my $name (keys %cur_items) {
+          my $type_name = $type . '__' . $name;
+
+          # Check inheritance option of current item
+          next unless $self->_inherit_ok ($type_name);
+
+          # "Closer" ancestors overrides more "distant" ones
+          $items{$name} = $cur_items{$name};
+        }
+      }
+    }
+
+    # Items in current build
+    if (%{ $self->{$type} }) {
+      for my $name (keys %{ $self->{$type} }) {
+        # Settings in current build override inherited settings
+        $items{$name} = $self->{$type}{$name};
+      }
+    }
+
+    return %items;
+
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_require_pp ($name);
+#
+# DESCRIPTION
+#   This internal method returns true if source package $name requires
+#   pre-processing.
+# ------------------------------------------------------------------------------
+
+sub _require_pp {
+  my $self = shift;
+  my $name = $_[0];
+
+  my $rc    = 0;
+  my @names = 'PP';
+  push @names, (split /__/, $name);
+
+  # Check whether pre-process flag exists, going up the source package hierarchy
+  do {
+    my $cur_name = join '__', @names;
+    if (exists $self->{PP}{$cur_name}) {
+      $rc = $self->{PP}{$cur_name};
+      return $rc;
+    }
+  } while pop @names;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_inherit_ok ($name);
+#
+# DESCRIPTION
+#   This internal method returns true if it is OK to inherit an item specified
+#   by $name, (where $name is a double underscore "__" delimited positional
+#   list of source package names).
+# ------------------------------------------------------------------------------
+
+sub _inherit_ok {
+  my $self  = shift;
+  my $name  = $_[0];
+
+  my $rc    = 1;
+  my @names = split /__/, $name;
+
+  # Check whether INHERIT flag exists, going up the source package hierarchy
+  do {
+    my $cur_name = join '__', @names;
+    if (exists $self->{INHERIT}{$cur_name}) {
+      $rc = $self->{INHERIT}{$cur_name};
+      return $rc;
+    }
+  } while pop @names;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/BuildTask.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/BuildTask.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/BuildTask.pm	(revision 5166)
@@ -0,0 +1,406 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::BuildTask
+#
+# DESCRIPTION
+#   This class hosts information of a build task in the FCM build system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::BuildTask;
+
+# Standard pragma
+use strict;
+use warnings;
+
+# Standard modules
+use Carp;
+use File::Compare;
+use File::Basename;
+use File::Path;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $task = Fcm::BuildTask->new (
+#     CONFIG     => $config,
+#     TARGET     => $target,
+#     TARGETPATH => \@targetpath,
+#     SRCFILE    => $srcfile,
+#     DEPENDENCY => \@dependency,
+#     TASKTYPE   => $tasktype,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::BuildTask class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   TARGET     - target name for this task
+#   TARGETPATH - search path for the target
+#   SRCFILE    - reference to input Fcm::SrcFile instance
+#   DEPENDENCY - list of dependencies for this target
+#   TASKTYPE   - type of task to build the target
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self  = {
+    CONFIG      => exists $args{CONFIG}     ? $args{CONFIG}     : &main::cfg,
+    TARGET      => exists $args{TARGET}     ? $args{TARGET}     : undef,
+    TARGETPATH  => exists $args{TARGETPATH} ? $args{TARGETPATH} : [],
+    SRCFILE     => exists $args{SRCFILE}    ? $args{SRCFILE}    : undef,
+    DEPENDENCY  => exists $args{DEPENDENCY} ? $args{DEPENDENCY} : [],
+    ACTIONTYPE  => exists $args{ACTIONTYPE} ? $args{ACTIONTYPE} : undef,
+
+    OUTPUT      => undef,
+    OUTPUTMTIME => undef,
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $task->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcfile = $task->srcfile;
+#   $task->srcfile ($srcfile);
+#
+# DESCRIPTION
+#   This method returns the reference to the input Fcm::SrcFile instance
+#   associated with this task. If an argument is specified, the reference is
+#   modified to the value given by the argument.
+# ------------------------------------------------------------------------------
+
+sub srcfile {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SRCFILE} = $_[0];
+  }
+
+  return $self->{SRCFILE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $actiontype = $task->actiontype;
+#   $task->actiontype ($actiontype);
+#
+# DESCRIPTION
+#   This method returns the action type of this task. If an argument is
+#   specified, the action type of this task is set to the value of the
+#   argument.
+# ------------------------------------------------------------------------------
+
+sub actiontype {
+  my $self = shift;
+
+  if (@_) {
+    $self->{ACTIONTYPE} = $_[0];
+  }
+
+  return $self->{ACTIONTYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $output = $task->output;
+#   $task->output ($output);
+#
+# DESCRIPTION
+#   This method returns the name of the output file after the task has been
+#   performed successfully. If an argument is specified, it sets the output
+#   file (and its last modified time) to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub output {
+  my $self = shift;
+
+  if (@_) {
+    $self->{OUTPUT}      = $_[0];
+    $self->{OUTPUTMTIME} = (stat $self->{OUTPUT}) [9];
+  }
+
+  return $self->{OUTPUT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $time = $task->outputmtime;
+#
+# DESCRIPTION
+#   This method returns the modified time of the output file.
+# ------------------------------------------------------------------------------
+
+sub outputmtime {
+  my $self = shift;
+
+  return $self->{OUTPUTMTIME};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $task->action (TASKLIST => \%tasklist);
+#
+# DESCRIPTION
+#   This method performs the task action and sets the output accordingly. The
+#   argument TASKLIST must be a reference to a hash containing the other tasks
+#   of the build, which this task may depend on. The keys of the hash must the
+#   name of the target names of the tasks, and the values of the hash must be
+#   the references to the corresponding Fcm::BuildTask instances. The method
+#   returns true if the task has been performed to create a new version of the
+#   target.
+# ------------------------------------------------------------------------------
+
+sub action {
+  my $self     = shift;
+  my %args     = @_;
+  my $tasklist = exists $args{TASKLIST} ? $args{TASKLIST} : {};
+
+  return unless $self->actiontype;
+
+  my $uptodate     = 1;
+  my $dep_uptodate = 1;
+
+  # Check if dependencies are up to date
+  # ----------------------------------------------------------------------------
+  for my $depend (@{ $self->{DEPENDENCY} }) {
+    if (exists $tasklist->{$depend}) {
+      if (not $tasklist->{$depend}->output) {
+        # Dependency task output is not set, performs its task action
+        if ($tasklist->{$depend}->action (TASKLIST => $tasklist)) {
+          $uptodate     = 0;
+          $dep_uptodate = 0;
+        }
+      }
+
+    } elsif ($self->config->verbose > 1) {
+      w_report 'Warning: Task for "', $depend,
+               '" does not exist, may be required by ', $self->{TARGET};
+    }
+  }
+
+  # Check if the target exists in the search path
+  # ----------------------------------------------------------------------------
+  if (@{ $self->{TARGETPATH} }) {
+    my $output = find_file_in_path ($self->{TARGET}, $self->{TARGETPATH});
+    $self->output ($output) if $output;
+  }
+
+  # Target is out of date if it does not exist
+  if ($uptodate) {
+    $uptodate = 0 if not $self->output;
+  }
+
+  # Check if current target is older than its dependencies
+  # ----------------------------------------------------------------------------
+  if ($uptodate) {
+    for my $depend (@{ $self->{DEPENDENCY} }) {
+      next unless exists $tasklist->{$depend};
+
+      if ($tasklist->{$depend}->outputmtime > $self->outputmtime) {
+        $uptodate     = 0;
+        $dep_uptodate = 0;
+      }
+    }
+
+    if ($uptodate and ref $self->srcfile) {
+      $uptodate = 0 if $self->srcfile->mtime > $self->outputmtime;
+    }
+  }
+
+  if ($uptodate) {
+    # Current target and its dependencies are up to date
+    # --------------------------------------------------------------------------
+    if ($self->actiontype eq 'PP') {
+      # "done" file up to date, set name of pre-processed source file
+      # ------------------------------------------------------------------------
+      my $base     = $self->srcfile->root . lc ($self->srcfile->ext);
+      my @pck_list = $self->srcfile->get_package_list;
+      pop @pck_list;
+      my @pknames  = split '__', pop (@pck_list);
+      my @path     = map {
+        catfile ($_, @pknames);
+      } @{ $self->config->setting (qw/PATH PPSRC/) };
+      my $oldfile = find_file_in_path ($base, \@path);
+      $self->srcfile->ppsrc ($oldfile);
+    }
+
+  } else {
+    # Perform action is not up to date
+    # --------------------------------------------------------------------------
+    # (For GENINTERFACE and PP, perform action if "done" file not up to date)
+    my $new_output = @{ $self->{TARGETPATH} }
+                     ? catfile ($self->{TARGETPATH}[0], $self->{TARGET})
+                     : $self->{TARGET};
+
+    # Create destination container directory if necessary
+    my $destdir = dirname $new_output;
+
+    if (not -d $destdir) {
+      print 'Make directory: ', $destdir, "\n" if $self->config->verbose > 2;
+      mkpath $destdir;
+    }
+
+    # List of actions
+    if ($self->actiontype eq 'UPDATE') {
+      # Action is UPDATE: Update file
+      # ------------------------------------------------------------------------
+      print 'Update: ', $new_output, "\n" if $self->config->verbose > 2;
+      touch_file $new_output
+        or croak 'Unable to update "', $new_output, '", abort';
+      $self->output ($new_output);
+
+    } elsif ($self->actiontype eq 'COPY') {
+      # Action is COPY: copy file to destination if necessary
+      # ------------------------------------------------------------------------
+      my $copy_required = ($dep_uptodate and $self->output and -r $self->output)
+                          ? compare ($self->output, $self->srcfile->src)
+                          : 1;
+
+      if ($copy_required) {
+        # Set up copy command
+        &run_command (
+          ['cp', $self->srcfile->src, $destdir],
+          TIME => $self->config->verbose > 2,
+        );
+
+        $self->output ($new_output);
+
+      } else {
+        $uptodate = 1;
+      }
+
+    } elsif ($self->actiontype eq 'PP' or $self->actiontype eq 'GENINTERFACE') {
+      # Action is PP or GENINTERFACE: process file
+      # ------------------------------------------------------------------------
+      my ($newlines, $base, @path);
+
+      if ($self->actiontype eq 'PP') {
+        # Invoke the pre-processor on the source file
+        # ----------------------------------------------------------------------
+        # Get lines in the pre-processed source
+        $newlines = $self->srcfile->pre_process;
+        $base     = $self->srcfile->root . lc ($self->srcfile->ext);
+
+        # Get search path for the existing pre-processed file
+        my @pck_list = $self->srcfile->get_package_list;
+        pop @pck_list;
+        my @pknames  = split '__', pop (@pck_list);
+        @path        = map {
+          catfile ($_, @pknames);
+        } @{ $self->config->setting (qw/PATH PPSRC/) };
+
+      } else { # if ($self->actiontype eq 'GENINTERFACE')
+        # Invoke the interface generator
+        # ----------------------------------------------------------------------
+        # Get new interface lines
+        $newlines = $self->srcfile->gen_interface;
+
+        # Get search path for the existing interface file
+        $base     = $self->srcfile->interfacebase;
+        @path     = @{ $self->config->setting (qw/PATH INC/) },
+      }
+
+
+      # If pre-processed or interface file exists,
+      # compare its content with new lines to see if it has been updated
+      my $update_required = 1;
+      my $oldfile = find_file_in_path ($base, \@path);
+
+      if ($oldfile and -r $oldfile) {
+        # Read old file
+        open FILE, '<', $oldfile;
+        my @oldlines = readline 'FILE';
+        close FILE;
+
+        # Compare old contents and new contents
+        if (@oldlines eq @$newlines) {
+          $update_required = grep {
+            $oldlines[$_] ne $newlines->[$_];
+          } (0 .. $#oldlines);
+        }
+      }
+
+      if ($update_required) {
+        # Update the pre-processed source or interface file
+        # ----------------------------------------------------------------------
+        # Determine container directory of the  pre-processed or interface file
+        my $newfile = @path ? catfile ($path[0], $base) : $base;
+
+        # Create the container directory if necessary
+        if (not -d $path[0]) {
+          print 'Make directory: ', $path[0], "\n"
+            if $self->config->verbose > 1;
+          mkpath $path[0];
+        }
+
+        # Update the pre-processor or interface file
+        open FILE, '>', $newfile
+          or croak 'Cannot write to "', $newfile, '" (', $!, '), abort';
+        print FILE @$newlines;
+        close FILE
+          or croak 'Cannot write to "', $newfile, '" (', $!, '), abort';
+        print 'Generated: ', $newfile, "\n" if $self->config->verbose > 1;
+
+        # Set the name of the pre-processed file
+        $self->srcfile->ppsrc ($newfile) if $self->actiontype eq 'PP';
+
+        # Set the "current" flag of the container source package to "true"
+        $self->srcfile->srcpackage->current (1);
+
+      } else {
+        # Content in pre-processed source or interface file is up to date
+        # ----------------------------------------------------------------------
+        $uptodate = 1;
+
+        # Set the name of the pre-processed file
+        $self->srcfile->ppsrc ($oldfile) if $self->actiontype eq 'PP';
+      }
+
+      # Update the "done" file
+      print 'Update: ', $new_output, "\n" if $self->config->verbose > 2;
+      touch_file $new_output
+        or croak 'Unable to update "', $new_output, '", abort';
+      $self->output ($new_output);
+
+    } else {
+      carp 'Action type "', $self->actiontype, "' not supported";
+    }
+  }
+
+  return not $uptodate;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CfgFile.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CfgFile.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CfgFile.pm	(revision 5166)
@@ -0,0 +1,861 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CfgFile
+#
+# DESCRIPTION
+#   This class is used for reading and writing FCM config files. A FCM config
+#   file is a line-based text file that provides information on how to perform
+#   a particular task using the FCM system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CfgFile;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Basename;
+use File::Path;
+use File::Spec;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::Util;
+
+# Local module variables
+my $expand_type   = 'bld|ext'; # config file type that needs variable expansions
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile = Fcm::CfgFile->new (CONFIG=> $config, SRC => $src, TYPE => $type);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CfgFile class.
+#
+# ARGUMENTS
+#   CONFIG - reference to a Fcm::Config instance
+#   SRC    - configuration file source
+#   TYPE   - type of expected configuration file
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG     => exists $args{CONFIG} ? $args{CONFIG} : &main::cfg,
+    SRC        => exists $args{SRC}    ? $args{SRC}    : undef,
+    TYPE       => exists $args{TYPE}   ? $args{TYPE}   : undef,
+
+    # Version of the configuration file
+    VERSION    => undef,
+
+    # List of references to hash tables for each line in the file
+    LINES      => [],
+
+    # Actual source of configuration file
+    ACTUAL_SRC => undef,
+    PEGREV     => undef,
+  };
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $cfgfile->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $src = $cfgfile->src ();
+#   $cfgfile->src ($src);
+#
+# DESCRIPTION
+#   This method returns the specified source of the configuration file. If an
+#   argument is specified, the source of the configuration file is modified to
+#   the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub src {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SRC} = shift;
+  }
+
+  return $self->{SRC};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $src = $cfgfile->actual_src ();
+#
+# DESCRIPTION
+#   This method returns the actual source of the configuration file. If an
+#   argument is specified, the source of the configuration file is modified to
+#   the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub actual_src {
+  my $self = shift;
+
+  return $self->{ACTUAL_SRC};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cfgfile->pegrev ();
+#
+# DESCRIPTION
+#   This method returns the peg revision of the configuration file.
+# ------------------------------------------------------------------------------
+
+sub pegrev {
+  my $self = shift;
+
+  return $self->{PEGREV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $cfgfile->type ();
+#   $cfgfile->type ($type);
+#
+# DESCRIPTION
+#   This method returns the configuration file type. If an argument is
+#   specified, the type is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub type {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TYPE} = shift;
+  }
+
+  return $self->{TYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version = $cfgfile->version ();
+#
+# DESCRIPTION
+#   This method returns the version of the configuration file.
+# ------------------------------------------------------------------------------
+
+sub version {
+  my $self = shift;
+
+  return $self->{VERSION};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @lines = $cfgfile->lines ();
+#
+# DESCRIPTION
+#   This method returns an array containing all "lines" in the configuration
+#   file. Each "line" is a reference to a hash table with the following keys:
+#
+#   SRC     - the source of the configuration file
+#   NUMBER  - the line number in the source
+#   LABEL   - the label of the of the configuration line
+#   VALUE   - the value of the configuration line
+#   COMMENT - comment in the configuration line
+# ------------------------------------------------------------------------------
+
+sub lines {
+  my $self = shift;
+
+  return @{ $self->{LINES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $line = $cfgfile->line ($line_number);
+#
+# DESCRIPTION
+#   This method return a "line" at $line_number in the configuration file. A
+#   "line" is a reference to a hash table with the following keys:
+#
+#   SRC     - the source of the configuration file
+#   NUMBER  - the line number in the source
+#   LABEL   - the label of the of the configuration line
+#   VALUE   - the value of the configuration line
+#   COMMENT - comment in the configuration line
+# ------------------------------------------------------------------------------
+
+sub line {
+  my $self     = shift;
+  my $line_num = shift;
+
+  if (exists $self->{LINES}[$line_num]) {
+    return $self->{LINES}[$line_num]; # returns a ref to a label:value pair hash
+
+  } else {
+    return undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile->add_line (
+#     LABEL   => $label,
+#     VALUE   => $value,
+#     COMMENT => $comment,
+#     SRC     => $src,
+#     NUMBER  => $line_number
+#   );
+#
+# DESCRIPTION
+#   This method adds a "line" to the configuration file. LABEL is the
+#   configuration line label. VALUE is the configuration line value. COMMENT
+#   is the comment in the line. VALUE should only be specified if LABEL is
+#   specified. COMMENT can be specified without LABEL. In such case, the whole
+#   line is a comment line. A blank line is inserted if no argument is
+#   specified. SRC can be specified to indicate the name of the source file
+#   from which this line is obtained. If not specified, the source file of the
+#   current configuration file is used. NUMBER can be specified to indicate
+#   the line number of the source file from which this line is obtained.
+# ------------------------------------------------------------------------------
+
+sub add_line {
+  my $self = shift;
+  my %args = @_;
+
+  my $line = {
+    SRC     => exists $args{SRC    } ? $args{SRC    } : $self->actual_src,
+    NUMBER  => exists $args{NUMBER } ? $args{NUMBER } : 0,
+    LABEL   => exists $args{LABEL  } ? $args{LABEL  } : '',
+    VALUE   => exists $args{VALUE  } ? $args{VALUE  } : '',
+    COMMENT => exists $args{COMMENT} ? $args{COMMENT} : '',
+  };
+
+  push @{ $self->{LINES} }, $line;
+
+  return $line;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile->add_comment_block ($line1, [$line2, ...]);
+#
+# DESCRIPTION
+#   This method adds a comment block to the configuration file. Each argument
+#   represents a line in the comment block.
+# ------------------------------------------------------------------------------
+
+sub add_comment_block {
+  my $self = shift;
+
+  $self->add_line (COMMENT => '-' x 78,);
+
+  while (my $line = shift @_) {
+    $self->add_line (COMMENT => $line,)
+  }
+
+  $self->add_line (COMMENT => '-' x 78,);
+  $self->add_line;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile->add_header ();
+#
+# DESCRIPTION
+#   This method adds a header to the configuration file, with its type and
+#   type version. It returns 1 on success.
+# ------------------------------------------------------------------------------
+
+sub add_header {
+  my $self = shift;
+
+  return undef unless $self->{TYPE};
+
+  $self->{VERSION} = $self->config->setting ('CFG_VERSION', uc ($self->{TYPE}))
+    if not $self->{VERSION};
+
+  $self->add_comment_block ('File header');
+
+  $self->add_line (
+    LABEL => $self->config->setting (qw/CFG_LABEL CFGFILE TYPE/),
+    VALUE => $self->{TYPE},
+  );
+
+  $self->add_line (
+    LABEL => $self->config->setting (qw/CFG_LABEL CFGFILE VERSION/),
+    VALUE => $self->{VERSION},
+  );
+
+  $self->add_line;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $exist = $cfg->label_exists ($label);
+#   @lines = $cfg->label_exists ($label);
+#
+# DESCRIPTION
+#   This method returns the (number of) "lines" with their LABEL matching the
+#   argument $label.
+# ------------------------------------------------------------------------------
+
+sub label_exists {
+  my $self  = shift;
+  my $label = shift;
+
+  return grep {$_->{LABEL} eq $label} @{ $self->{LINES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mtime = $cfgfile->mtime ();
+#
+# DESCRIPTION
+#   This method returns the modified time of the configuration file source.
+# ------------------------------------------------------------------------------
+
+sub mtime {
+  my $self  = shift;
+  my $mtime = undef;
+
+  if (-f $self->{SRC}) {
+    $mtime = (stat $self->{SRC})[9];
+  }
+
+  return $mtime;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $read = $cfgfile->read_cfg ();
+#
+# DESCRIPTION
+#   This method reads the current configuration file. It returns the number of
+#   lines read from the config file, or "undef" if it fails. The result is
+#   placed in the LINES array of the current instance, and can be accessed via
+#   the "lines" method.
+# ------------------------------------------------------------------------------
+
+sub read_cfg {
+  my $self = shift;
+
+  my @lines = $self->_get_cfg_lines;
+
+  # List of CFG labels
+  my %cfg_labels = %{ $self->config->setting ('CFG_LABEL') };
+
+  # List of CFG types that need INC declarations expansion
+  my %exp_inc    = ();
+  for (split (/,/, $self->config->setting ('CFG_EXP_INC'))) {
+    $exp_inc{uc ($_)} = 1;
+  }
+
+  # List of CFG labels that are reserved keywords
+  my %cfg_keywords = ();
+  for (split (/,/, $self->config->setting ('CFG_KEYWORD'))) {
+    $cfg_keywords{$cfg_labels{$_}} = 1;
+  }
+
+  # Loop each line, to separate lines into label : value pairs
+  my $cont = undef;
+  my $here = undef;
+  for my $line_num (1 .. @lines) {
+    my $line = $lines[$line_num - 1];
+    chomp $line;
+
+    my $label   = '';
+    my $value   = '';
+    my $comment = '';
+
+    # If this line is a continuation, set $start to point to the line that
+    # starts this continuation. Otherwise, set $start to undef
+    my $start   = defined ($cont) ? $self->line ($cont) : undef;
+
+    if ($line =~ /^(\s*#.*)$/) { # comment line
+      $comment = $1;
+
+    } elsif ($line =~ /\S/) {    # non-blank line
+      if (defined $cont) {
+        # Previous line has a continuation mark
+        $value = $line;
+
+        # Separate value and comment
+        if ($value =~ s/((?:\s+|^)#\s+.*)$//) {
+          $comment = $1;
+        }
+
+        # Remove leading spaces
+        $value =~ s/^\s*\\?//;
+
+        # Expand environment variables
+        $value = $self->_expand_variable ($value, 1) if $value;
+
+        # Expand internal variables
+        $value = $self->_expand_variable ($value) if $value;
+
+        # Get "line" that begins the current continuation
+        ($start->{VALUE} .= $value) =~ s/\\$//;
+
+      } else {
+        # Previous line does not have a continuation mark
+        if ($line =~ /^\s*(\S+)(?:\s+(.*))?$/) {
+          # Check line contains a valid label:value pair
+          $label = $1;
+          $value = defined ($2) ? $2 : '';
+
+          # Separate value and comment
+          if ($value =~ s/((?:\s+|^)#\s+.*)$//) {
+            $comment = $1;
+          }
+
+          # Remove trailing spaces
+          $value =~ s/\s+$//;
+
+          # Value begins with $HERE?
+          $here  = ($value =~ /\$\{?HERE\}?(?:[^A-Z_]|$)/);
+
+          # Expand environment variables
+          $value = $self->_expand_variable ($value, 1) if $value;
+
+          # Expand internal variables
+          $value = $self->_expand_variable ($value) if $value;
+        }
+      }
+
+      # Determine whether current line ends with a continuation mark
+      if ($value =~ s/\\$//) {
+        $cont = scalar ($self->lines) unless $cont;
+
+      } else {
+        $cont = undef;
+      }
+    }
+
+    if (exists $exp_inc{uc ($self->type)} and
+        uc ($start ? $start->{LABEL} : $label) eq $cfg_labels{INC} and
+        not defined $cont) {
+      # Current configuration file requires expansion of INC declarations
+      # The start/current line is an INC declaration
+      # The current line is not a continuation or is the end of the continuation
+
+      # Get lines from an "include" configuration file
+      my $src = ($start ? $start->{VALUE} : $value);
+      $src   .= '@' . $self->pegrev if $here and $self->pegrev;
+
+      if ($src) {
+        # Invoke a new instance to read the source
+        my $cfg = Fcm::CfgFile->new (
+          SRC    => expand_tilde ($src),
+          TYPE   => $self->type,
+          CONFIG => $self->config,
+        );
+
+        $cfg->read_cfg;
+
+        # Add lines to the "LINES" array in the current configuration file
+        $comment = 'INC ' . $src . ' ';
+        $self->add_line (
+          COMMENT => $comment . '# Start',
+          NUMBER  => ($start ? $start->{NUMBER} : $line_num),
+        );
+        $self->add_line (%{ $_ }) for (($cfg->lines));
+        $self->add_line (COMMENT => $comment . '# End');
+
+      } else {
+        $self->add_line (NUMBER  => $line_num);
+        w_report 'Warning: ', $self->actual_src, ': line ', $line_num,
+                 ': empty INC declaration.' if $self->config->verbose > 2;
+      }
+
+    } else {
+      # Push label:value pair into "LINES" array
+      $self->add_line (
+        LABEL   => $label,
+        VALUE   => ($label ? $value : ''),
+        COMMENT => $comment,
+        NUMBER  => $line_num,
+      );
+    }
+
+    next if defined $cont; # current line not a continuation
+
+    my $slabel = ($start ? $start->{LABEL} : $label);
+    my $svalue = ($start ? $start->{VALUE} : $value);
+    next unless $slabel;
+
+    # Check config file type and version
+    if (uc ($slabel) eq $cfg_labels{CFGFILE}{TYPE}) {
+      $self->type ($svalue);
+
+    } elsif (uc ($slabel) eq $cfg_labels{CFGFILE}{VERSION}) {
+      $self->version ($svalue);
+    }
+
+    # Set internal variable
+    $slabel =~ s/^\%//; # Remove leading "%" from label
+
+    $self->config->assign_variable (
+      LABEL => $slabel,
+      VALUE => $svalue,
+    ) unless exists $cfg_keywords{$slabel};
+  }
+
+  return $self->lines;
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $cfgfile->print_cfg ($file);
+#
+# DESCRIPTION
+#   This method prints the content of current configuration file. If no
+#   argument is specified, it prints output to the standard output. If $file
+#   is specified, and is a writable file name, the output is sent to the file.
+#   If the file already exists, its content is compared to the current output.
+#   Nothing will be written if the content is unchanged. Otherwise, for typed
+#   configuration files, the existing file is renamed using a prefix that
+#   contains its last modified time. The method returns 1 if there is no
+#   error.
+# ------------------------------------------------------------------------------
+
+sub print_cfg {
+  my $self = shift;
+  my $file = shift;
+
+  # Count maximum number of characters in the labels, (for pretty printing)
+  my $max_label_len = 0;
+  for my $line (@{ $self->{LINES} }) {
+    next unless $line->{LABEL};
+    my $label_len  = length $line->{LABEL};
+    $max_label_len = $label_len if $label_len > $max_label_len;
+  }
+
+  # Output string
+  my $out = '';
+
+  # Append each line of the config file to the output string
+  for my $line (@{ $self->{LINES} }) {
+    my $label   = $line->{LABEL};
+    my $value   = $line->{VALUE};
+    my $comment = $line->{COMMENT};
+
+    if ($label) {
+      # Line up label/value for pretty printing
+      $label   = $label . ' ' x ($max_label_len - length ($label));
+      $comment =~ s/^\s+/ / if $comment;
+
+      $out .= $label;
+      $out .= ' ' . $value if defined $value;
+
+    } else {
+      # Make sure comments begin with a "#"
+      $comment = '# ' . $comment if $comment and $comment !~ /^\s*($|#)/;
+      $comment =~ s/^\s*//;
+    }
+
+    $out .= $comment if $comment;
+    $out .= "\n";
+  }
+
+  if ($out) {
+
+    my $old_select = select;
+
+    # Open file if necessary
+    if ($file) {
+      # Make sure the host directory exists and is writable
+      my $dirname = dirname $file;
+      if (not -d $dirname) {
+        print 'Make directory: ', $dirname, "\n" if $self->config->verbose;
+        mkpath $dirname;
+      }
+      croak 'Cannot write to config file directory: "', $dirname, '", abort'
+        unless -d $dirname and -w $dirname;
+
+      # If config file already exists, make sure it is writable
+      if (-f $file) {
+        if (-r $file) {
+          # Read old config file to see if content has changed
+          open IN, '<', $file;
+          my $in_lines = '';
+          while (my $line = <IN>) {
+            $in_lines .= $line;
+          }
+          close IN;
+
+          # Return if content is up-to-date
+          if ($in_lines eq $out) {
+            print 'No change in ', lc ($self->{TYPE}), ' cfg: ', $file,
+                  "\n" if $self->config->verbose > 1 and $self->{TYPE};
+            return;
+          }
+        }
+
+        if (-w $file) {
+          if ($self->{TYPE}) {
+            # Existing config file writable, rename it using its time stamp
+            my $mtime = (stat $file)[9];
+            my ($sec, $min, $hour, $mday, $mon, $year) = (gmtime $mtime)[0 .. 5];
+            my $timestamp = sprintf '%4d%2.2d%2.2d_%2.2d%2.2d%2.2d_',
+                            $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
+            my $oldfile   = catfile $dirname, $timestamp . basename ($file);
+            rename $file, $oldfile;
+            print 'Renamed existing ', lc ($self->{TYPE}), ' cfg: ',
+                  $oldfile, "\n" if $self->config->verbose > 1;
+          }
+        } else {
+          # Existing config file not writable, throw an error
+          croak 'Config file "', $file, '" not writable, abort';
+        }
+      }
+
+      # Open file and select file handle
+      open OUT, '>', $file
+        or croak 'Cannot write to config file "', $file, '" (', $!, '), abort';
+      select OUT;
+    }
+
+    # Print output
+    print $out;
+
+    # Close file if necessary
+    if ($file) {
+      select $old_select;
+      close OUT;
+
+      if ($self->{TYPE} and $self->config->verbose > 1) {
+        print 'Generated ', lc ($self->{TYPE}), ' cfg: ', $file, "\n";
+      } elsif ($self->config->verbose > 2) {
+        print 'Generated cfg: ', $file, "\n";
+      }
+    }
+
+  } else {
+
+    # Warn if nothing to print
+    my $warning = 'Empty configuration';
+    $warning   .= ' - nothing written to file: "' . $file . '"' if $file;
+    carp $warning if $self->{TYPE};
+
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @lines = $self->_get_cfg_lines ();
+#
+# DESCRIPTION
+#   This internal method reads from a configuration file residing in a
+#   Subversion repository or in the normal file system.
+# ------------------------------------------------------------------------------
+
+sub _get_cfg_lines {
+  my $self  = shift;
+  my @lines = ();
+
+  my $verbose = $self->config->verbose;
+
+  # Expand URL keywords if necessary
+  {
+    my $src = expand_url_keyword (URL => $self->src, CFG => $self->config);
+    $self->src ($src) if $src ne $self->src;
+  }
+
+  if (&is_url ($self->src)) {
+    # Config file resides in a SVN repository
+    # --------------------------------------------------------------------------
+    # Set URL source and version
+    my $src = $self->src;
+    my $rev = 'HEAD';
+
+    # Extract version from source if it exists
+    if ($src =~ s/@(.+)$//) {
+      $rev = $1;
+    }
+
+    # Expand revision keyword, if required
+    $rev = expand_rev_keyword (REV => $rev, URL => $src, HEAD => 1);
+
+    # Check whether URL is a config file
+    my $rc;
+    my @cmd = (qw/svn cat/, $src . '@' . $rev);
+    @lines = &run_command (
+      \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+    );
+
+    # Error in "svn cat" command
+    if ($rc) {
+      # See whether specified config file is a known type
+      my %cfgname = %{ $self->config->setting ('CFG_NAME') };
+      my $key     = uc $self->type;
+      my $file    = exists $cfgname{$key} ? $cfgname{$key} : '';
+
+      # If config file is a known type, specified URL may be a directory
+      if ($file) {
+        # Check whether a config file with a default name exists in the URL
+        my $sep  = $self->config->setting (qw/MISC DIR_SEPARATOR/);
+        my $path = $src . $sep . $file;
+        my @cmd  = (qw/svn cat/, $path . '@' . $rev);
+
+        @lines = &run_command (
+          \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+        );
+
+        # Check whether a config file with a default name exists under the "cfg"
+        # sub-directory of the URL
+        if ($rc) {
+          my $cfgdir = $self->config->setting (qw/DIR CFG/);
+          $path   = $src . $sep . $cfgdir . $sep . $file;
+          my @cmd = (qw/svn cat/, $path . '@' . $rev);
+
+          @lines  = &run_command (
+            \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+          );
+        }
+
+        $src = $path unless $rc;
+      }
+    }
+
+    if ($rc) {
+      # Error in "svn cat"
+      croak 'Unable to locate config file from "', $self->src, '", abort';
+
+    } else {
+      # Print diagnostic, if necessary
+      if ($verbose and $self->type and $self->type =~ /$expand_type/) {
+        print '# Config file (', $self->type, '): ', $src;
+        print '@', $rev if $rev;
+        print "\n";
+      }
+    }
+
+    # Record the actual source location
+    $self->{PEGREV    } = $rev;
+    $self->{ACTUAL_SRC} = $src;
+
+  } else {
+    # Config file resides in the normal file system
+    # --------------------------------------------------------------------------
+    my $src = $self->src;
+
+    if (-d $src) { # Source is a directory
+      croak 'Config file "', $src, '" is a directory, abort' if not $self->type;
+
+      # Get name of the config file by looking at the type
+      my %cfgname = %{ $self->config->setting ('CFG_NAME') };
+      my $key     = uc $self->type;
+      my $file    = exists $cfgname{$key} ? $cfgname{$key} : '';
+
+      if ($file) {
+        my $cfgdir = $self->config->setting (qw/DIR CFG/);
+
+        # Check whether a config file with a default name exists in the
+        # specified path, then check whether a config file with a default name
+        # exists under the "cfg" sub-directory of the specified path
+        if (-f catfile $self->src, $file) {
+          $src = catfile $self->src, $file;
+
+        } elsif (-f catfile ($self->src, $cfgdir, $file)) {
+          $src = catfile $self->src, $cfgdir, $file;
+
+        } else {
+          croak 'Unable to locate config file from "', $self->src, '", abort';
+        }
+
+      } else {
+        croak 'Unknown config file type "', $self->type, '", abort';
+      }
+    }
+
+    if (-r $src) {
+      open FILE, '<', $src;
+      print '# Config file (', $self->type, '): ', $src, "\n"
+        if $verbose and $self->type and $self->type =~ /$expand_type/;
+
+      @lines = readline 'FILE';
+      close FILE;
+
+    } else {
+      croak 'Unable to read config file "', $src, '", abort';
+    }
+
+    # Record the actual source location
+    $self->{ACTUAL_SRC} = $src;
+  }
+
+  return @lines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_expand_variable ($string[, $env]);
+#
+# DESCRIPTION
+#   This internal method expands variables in $string. If $env is specified
+#   and is true, it expands environment variables. Otherwise, it expands
+#   local variables.
+# ------------------------------------------------------------------------------
+
+sub _expand_variable {
+  my ($self, $string, $env) = @_;
+
+  # Pattern for environment/local variable
+  my $pattern = $env ? '\$\{?([A-Z][A-Z0-9_]+)\}?' : '%\{?([\w:]+)\}?';
+
+  while ($string and $string =~ /$pattern/) {
+    my $var_label = $1; # variable label
+
+    # Get variable value from environment or local configuration
+    my $variable = $env
+                   ? (exists $ENV{$var_label} ? $ENV{$var_label} : undef)
+                   : $self->config->variable ($var_label);
+
+    $variable = dirname ($self->actual_src)
+      if $env and $var_label eq 'HERE' and not defined $variable;
+
+    # Substitute match with value of variable
+    if (defined $variable) {
+      $string =~ s/$pattern/$variable/;
+
+    } else {
+      w_report 'Warning: ', $self->actual_src, ': variable "',
+               ($env ? '$' : '%'), $var_label, '" not expanded.';
+      last;
+    }
+  }
+
+  return $string;
+}
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Cm.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Cm.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Cm.pm	(revision 5166)
@@ -0,0 +1,2243 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Cm
+#
+# DESCRIPTION
+#   This module contains the FCM code management functionalities and wrappers
+#   to Subversion commands.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Cm;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+our (@ISA, @EXPORT, @EXPORT_OK);
+use Getopt::Long;
+use File::Basename;
+use File::Path;
+use File::Spec;
+use File::Temp qw/tempfile/;
+use Cwd;
+
+# FCM component modules
+use Fcm::CmBranch;
+use Fcm::CmUrl;
+use Fcm::Util;
+
+sub cm_command;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(
+  cm_command
+);
+
+# Function declaration:
+sub cm_add;
+sub cm_branch;
+sub cm_commit;
+sub cm_conflicts;
+sub cm_delete;
+sub cm_diff;
+sub cm_merge;
+sub cm_mkpatch;
+sub cm_svn;
+sub cm_switch;
+sub _construct_branch_url;
+
+# ------------------------------------------------------------------------------
+
+my @subcommand_url = qw/
+  blame     praise annotate ann
+  branch    br
+  cat
+  checkout  co
+  copy      cp
+  delete    del    remove   rm
+  diff      di
+  export
+  import
+  info
+  list      ls
+  lock
+  log
+  merge
+  mkdir
+  mkpatch
+  move      mv     rename   ren
+  propdel   pdel   pd
+  propedit  pedit  pe
+  propget   pget   pg
+  proplist  plist  pl
+  propset   pset   ps
+  switch    sw
+  unlock
+/; # List of subcommands that accept URL inputs
+
+my @subcommand_rev = qw/
+  blame     praise annotate ann
+  branch    br
+  cat
+  checkout  co
+  copy      cp
+  diff      di
+  export
+  info
+  list      ls
+  log
+  merge
+  mkpatch
+  move      mv     rename   ren
+  propdel   pdel   pd
+  propedit  pedit  pe
+  propget   pget   pg
+  proplist  plist  pl
+  propset   pset   ps
+  switch    sw
+  update    up
+/; # List of subcommands that accept revision inputs
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &cm_command ($function);
+#
+# DESCRIPTION
+#   This is the generic FCM code management wrapper. It calls the correct FCM
+#   code management function or a wrapper to a Subversion command based on the
+#   value of the argument $function.
+# ------------------------------------------------------------------------------
+
+sub cm_command {
+
+  my ($function) = shift @_;
+
+  # Expand URL keywords if necessary
+  if (grep {$_ eq $function} @subcommand_url) {
+    for my $arg (@ARGV) {
+      my $var = expand_url_keyword (URL => $arg);
+      $arg = $var if $arg ne $var;
+    }
+  }
+
+  # Expand revision keywords (for -r or --revision options) if necessary
+  if (grep {$_ eq $function} @subcommand_rev) {
+    my @new_argv = ();
+
+    while (defined (my $arg = shift @ARGV)) {
+      if ($arg eq '--revision') {
+        # Long --revision option, must be followed by a space before the
+        # revision argument
+        push @new_argv, $arg;
+
+      } elsif ($arg =~ s/^-r//) {
+        # Short -r option, may be followed by the revision argument with or
+        # without a space in between
+        push @new_argv, '--revision';
+        unshift @ARGV, $arg if $arg;
+
+      } else {
+        # Other option or argument
+        push @new_argv, $arg;
+        next;
+      }
+
+      # First revision number/keyword
+      my $rev1 = '';
+
+      # Get the next argument from the list
+      $arg = shift @ARGV;
+
+      if (index ($arg, '{') == 0) {
+        # A revision date argument may contain a space. Therefore, it may need
+        # the next argument(s) from the list
+        while (index ($arg, '}') == -1) {
+          my $shift = shift @ARGV;
+          last unless $shift;
+          $arg     .= ' ' . $shift;
+        }
+
+        $arg  =~ s/^(\{.+?\})//;
+        $rev1 = $1;
+
+      } else {
+        # Other revision argument
+        $arg  =~ s/^(\S+?)(?::|$)//;
+        $rev1 = $1;
+      }
+
+      # The rest of $arg is the second revision number/keyword
+      my $rev2 = $arg;
+      $rev2 =~ s/^:*//;
+
+      # A revision date argument may contain a space. Therefore, it may need
+      # the next argument(s) from the list
+      if (index ($rev2, '{') == 0) {
+        while (index ($rev2, '}') == -1) {
+          my $shift = shift @ARGV;
+          last unless $shift;
+          $rev2    .= ' ' . $shift;
+        }
+      }
+
+      # Expand revision keyword if necessary
+      if ($rev1 !~ /^(?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\})$/i or
+          $rev2 !~ /^(?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\})$/i) {
+        # Find out the associated URLs by inspecting the argument list
+        my $url1 = '';
+        my $url2 = '';
+
+        for (@new_argv, @ARGV) {
+          my $arg = Fcm::CmUrl->new (URL => $_);
+          next unless $arg->is_url;
+
+          if ($url1) {
+            $url2 = $arg->url_peg;
+            last;
+
+          } else {
+            $url1 = $arg->url_peg;
+          }
+        }
+
+        # Argument list does not contain a URL, try "svn info" on WC
+        $url1 = &get_url_of_wc () if not $url1;
+        $url2 = $url1 if not $url2;
+
+        # Expand 1st revision keyword if necessary
+        $rev1 = expand_rev_keyword (REV => $rev1, URL => $url1)
+          if $rev1 !~ /^(?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\})$/i;
+
+        # Expand 2nd revision keyword if necessary
+        $rev2 = expand_rev_keyword (REV => $rev2, URL => $url2)
+          if $rev2 and $rev2 !~ /^(?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\})$/i;
+      }
+
+      # Append revision argument to argument list
+      push @new_argv, ($rev2 ? $rev1 . ':' . $rev2 : $rev1);
+    }
+
+    @ARGV = @new_argv;
+  }
+
+  # Expand revision keywords (for peg revision TARGET@REVSION) if necessary
+  for (@ARGV) {
+    if (m#^(\w+://\S+)@(\S+)$#) {
+      my $url = $1;
+      my $rev = $2;
+
+      my $new_rev = expand_rev_keyword (URL => $url, REV => $rev, HEAD => 1);
+
+      $_ = $url . '@' . $new_rev if $new_rev ne $rev;
+    }
+  }
+
+  # List of special sub-commands recognised by FCM
+  my %subcommand = (
+    ADD       => [qw/add/],
+    BRANCH    => [qw/branch br/],
+    COMMIT    => [qw/commit ci/],
+    CONFLICTS => [qw/conflicts cf/],
+    CHECKOUT  => [qw/checkout co/],
+    DELETE    => [qw/delete del remove rm/],
+    DIFF      => [qw/diff di/],
+    MERGE     => [qw/merge/],
+    MKPATCH   => [qw/mkpatch/],
+    SWITCH    => [qw/switch sw/],
+  );
+
+  if (grep {$_ eq $function} @{ $subcommand{ADD} }) {
+    cm_add;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{BRANCH} }) {
+    cm_branch;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{CHECKOUT} }) {
+    # Check whether the last argument is a PATH.
+    # If so, check whether it is a working copy.
+    # Otherwise, check whether the current directory is a working copy.
+    # If current working direcory (or PATH) is a working copy, fail the command.
+    if (@ARGV) {
+      my $arg  = Fcm::CmUrl->new (URL => $ARGV [-1]);
+      my $path = $arg->is_url ? cwd () : $ARGV [-1];
+
+      e_report $path, ': already a working copy, abort checkout.'
+        if &is_wc ($path);
+    }
+
+    # Invoke checkout
+    cm_svn ('checkout');
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{COMMIT} }) {
+    cm_commit;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{CONFLICTS} }) {
+    cm_conflicts;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{DELETE} }) {
+    cm_delete;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{DIFF} }) {
+    cm_diff;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{MERGE} }) {
+    cm_merge;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{MKPATCH} }) {
+    cm_mkpatch;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{SWITCH} }) {
+    cm_switch;
+
+  } else {
+    cm_svn ($function);
+  }
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_add ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn add". It adds an extra functionality to check
+#   for any files or directories reported by "svn status" as not under version
+#   control, and to prompt the user whether these files or directories should
+#   be added.
+# ------------------------------------------------------------------------------
+
+sub cm_add {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+usage: fcm add [options] [args]
+
+Valid options:
+  -c [--check]  : Check for any files or directories reported by svn status as
+                  not under version control and add them.
+  <SVN options> : Standard options to svn add as described below ...
+
+EOF
+
+    &run_command ([qw/svn add --help/], PRINT => 1, METHOD => 'exec');
+  }
+
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--check -c)) {
+    # The --check option is specified, add any new files
+    # Execute "svn status", print lines starting with a "?"
+    my $pat    = '^\?.{4}\s*';
+    my @status = grep /$pat.*/, &run_command ([qw/svn status/], METHOD => 'qx');
+    print @status if @status;
+
+    # Get list of "?" files
+    my @files  = map {chomp; s/$pat//; $_} @status;
+    my $reply  = '';
+
+    # Execute "add" command depending on user reply
+    for my $file (@files) {
+      # Get a user reply, unless previous reply is "a" for "all"
+      $reply = &main::get_input (
+        TITLE   => 'fcm add',
+        MESSAGE => "Add file '$file'?",
+        TYPE    => 'yna',
+        DEFAULT => 'n',
+      ) unless $reply eq "a";
+
+      # Add current $file if reply is "y" for "yes" or "a" for "all"
+      &run_command ([qw/svn add/, $file]) if $reply =~ /^[ya]$/;
+    }
+
+  } else {
+    # The --check option is not specified, just call "svn add"
+    cm_svn ("add");
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_branch ();
+#
+# DESCRIPTION
+#   This is a FCM command to check information, create or delete a branch in
+#   a Subversion repository.
+# ------------------------------------------------------------------------------
+
+sub cm_branch {
+  my $usage = <<EOF;
+branch: Create, delete or display information of a branch
+usage: 1. fcm branch [--info] [OPTIONS] [TARGET]
+       2. fcm branch --delete [OPTIONS] [TARGET]
+       3. fcm branch --create [OPTIONS] [SOURCE]
+       4. fcm branch --list   [OPTIONS] [SOURCE]
+
+  1. --info or -i: Display information about a branch. This is the default
+     option if --create, --delete and --list are not specified.
+
+  2. --delete or -d: Delete a branch.
+
+  3. --create or -c: Create a new branch from SOURCE. The --name option must be
+     used to specify a short name for the new branch.
+
+  4. --list or -l: List all the branches owned by the current user in SOURCE. If
+     the --user option is specified with a list of users, list all the branches
+     owned by these users instead of the current user.
+
+  TARGET (and SOURCE) can be an URL or a Subversion working copy. Otherwise,
+  the current working directory must be a working copy. For --info and
+  --delete, the specified URL (or the URL of the working copy) must be a URL
+  under a valid branch in a standard FCM project. For --create and --list, it
+  must be a URL under a standard FCM project.
+
+Valid options with --info and --delete:
+  -v [--verbose]        : Print extra information.
+  -a [--show-all]       : Set --show-children, --show-other and --show-siblings.
+  --show-children       : Report children of the current branch.
+  --show-other          : Report custom/ reverse merges into the current branch.
+  --show-siblings       : Report merges with siblings of the current branch.
+
+Valid options with --delete and --create:
+  --non-interactive     : Do no interactive prompting. This option implies
+                          --svn-non-interactive.
+  --password arg        : Specify a password for write access to the repository.
+  --svn-non-interactive : Do no interactive prompting at commit time. This
+                          option is implied by --non-interactive.
+
+Valid options with --create and --list:
+  -r [--revision] arg   : Specify the operative revision of the SOURCE for
+                          creating the branch.
+
+Valid options with --create:
+  --branch-of-branch    : If this option is specified and the SOURCE is a
+                          branch, it will create a new branch from the SOURCE
+                          branch. Otherwise, the branch is created from the
+                          trunk.
+  -k [--ticket] arg     : Specify one (or more) Trac ticket. If specified, the
+                          command will add to the commit log the line "Relates
+                          to ticket #<ticket>". Multiple tickets can be set by
+                          specifying this option multiple times, or by
+                          specifying the tickets in a comma-separated list.
+  -n [--name] arg       : Specify a short name for the branch, which should
+                          contain only word characters, i.e. [A-Za-z0-9_].
+  --rev-flag arg        : Specify a flag for determining the prefix of the
+                          branch name. The flag can be the the string "NORMAL",
+                          "NUMBER" or "NONE".  "NORMAL" is the default
+                          behaviour, in which the branch name will be prefixed
+                          with a Subversion revision number if the revision is
+                          not associated with a registered FCM revision
+                          keyword. If the revision is registered with a FCM
+                          revision keyword, the keyword will be used in place
+                          of the number. If "NUMBER" is specified, the branch
+                          name will always be prefixed with a Subversion
+                          revision number. If "NONE" is specified, the branch
+                          name will not be prefixed by a revision number or
+                          keyword.
+  -t [--type] arg       : Specify the type of the branch to be created. It must
+                          be one of the following:
+                            DEV::USER   - a development branch for the user
+                            DEV::SHARE  - a shared development branch
+                            DEV         - same as DEV::USER
+                            TEST::USER  - a test branch for the user
+                            TEST::SHARE - a shared test branch
+                            TEST        - same as TEST::USER
+                            PKG::USER   - a package branch for the user
+                            PKG::SHARE  - a shared package branch
+                            PKG::CONFIG - a configuration branch
+                            PKG::REL    - a release branch
+                            PKG         - same as PKG::USER
+                            CONFIG      - same as PKG::CONFIG
+                            REL         - same as PKG::REL
+                            SHARE       - same as DEV::SHARE
+                            USER        - same as DEV::USER
+                          If not specified, the default is to create a
+                          development branch for the current user, i.e.
+                          DEV::USER.
+
+Valid options with --list:
+  -u [--user] arg       : Specify a colon-separated list of users. List branches
+                          owned by these users instead of the current user.
+  -v [--verbose]        : Print Subversion URL instead of FCM URL keywords.
+EOF
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print $usage;
+    return 1;
+  }
+
+  # Process command line options
+  # ----------------------------------------------------------------------------
+  my (
+    $info,
+    $delete,
+    $create,
+    $list,
+    $branch_of_branch,
+    $name,
+    $non_interactive,
+    $password,
+    $rev,
+    $rev_flag,
+    $show_all,
+    $show_children,
+    $show_other,
+    $show_siblings,
+    $svn_non_interactive,
+    @tickets,
+    $type,
+    @userlist,
+    $verbose,
+  );
+  GetOptions (
+    'info|i'              => \$info,
+    'delete|d'            => \$delete,
+    'create|c'            => \$create,
+    'list|l'              => \$list,
+    'branch-of-branch'    => \$branch_of_branch,
+    'name|n=s'            => \$name,
+    'non-interactive'     => \$non_interactive,
+    'password=s'          => \$password,
+    'revision|r=s'        => \$rev,
+    'rev-flag=s'          => \$rev_flag,
+    'show-all|a'          => \$show_all,
+    'show-children'       => \$show_children,
+    'show-other'          => \$show_other,
+    'show-siblings'       => \$show_siblings,
+    'svn-non-interactive' => \$svn_non_interactive,
+    'ticket|k=s'          => \@tickets,
+    'type|t=s'            => \$type,
+    'user|u=s'            => \@userlist,
+    'verbose|v'           => \$verbose,
+  );
+
+  my $num_options = 0;
+  $num_options++ if defined $info;
+  $num_options++ if defined $delete;
+  $num_options++ if defined $create;
+  $num_options++ if defined $list;
+
+  # Report invalid usage
+  # ----------------------------------------------------------------------------
+  e_report $usage if $num_options > 1;
+
+  # Get URL of repository or branch
+  # ----------------------------------------------------------------------------
+  my $url;
+  if ($ARGV[0]) {
+    $url = Fcm::CmUrl->new (URL => $ARGV[0]);
+
+    if (not $url->is_url) {
+      # An argument is specified and is not a URL
+      # Assume that it is a path with a working copy
+      if (&is_wc ($ARGV[0])) {
+        $url = Fcm::CmUrl->new (URL => &get_url_of_wc ($ARGV[0]));
+
+      } else {
+        e_report $ARGV[0], ': is not a working copy, abort.';
+      }
+    }
+
+  } else {
+    # An argument is not specified
+    # Assume that the current directory is a working copy
+    if (&is_wc ()) {
+      $url = Fcm::CmUrl->new (URL => &get_url_of_wc ());
+
+    } else {
+      e_report 'The current directory is not a working copy, please specify a ',
+               'URL or a path to a working copy, abort.';
+    }
+  }
+
+  # Ensure $url->url_peg is a URL of a standard FCM project
+  e_report $url->url_peg, ': not a URL of a standard FCM project, abort.'
+    if not $url->project_url;
+
+  if ($create) {
+    # The --create option is specified, create a branch
+    # --------------------------------------------------------------------------
+
+    # Check branch type flags
+    if ($type) {
+      $type = uc ($type);
+
+      if ($type =~ /^(USER|SHARE)$/) {
+        $type = 'DEV::' . $1;
+
+      } elsif ($type =~ /^(CONFIG|REL)$/) {
+        $type = 'PKG::' . $1;
+
+      } elsif ($type =~ /^(DEV|TEST|PKG)$/) {
+        $type = $1 . '::USER';
+
+      } elsif ($type !~ /^(?:DEV|TEST|PKG)::(?:USER|SHARE)$/ and
+               $type !~ /^PKG::(?:CONFIG|REL)/) {
+        e_report $type, ': is not a valid type flag, abort.';
+      }
+
+    } else {
+      $type = 'DEV::USER';
+    }
+
+    # Check branch name
+    e_report 'The option --name must be used to specify a branch name, abort.'
+      if not $name;
+
+    e_report $name, ': invalid characters in name, abort.' if $name !~ /^\w+$/;
+
+    # Check revision flag is valid
+    if ($rev_flag) {
+      $rev_flag = uc ($rev_flag);
+
+      e_report $rev_flag, ': invalid argument to the --rev-flag option, abort.'
+        if $rev_flag !~ /^(?:NORMAL|NUMBER|NONE)$/;
+
+    } else {
+      $rev_flag = 'NORMAL';
+    }
+
+    # Handle multiple tickets
+    @tickets = split (/,/, join (',', @tickets));
+    s/^#// for (@tickets);
+    @tickets = sort {$a <=> $b} @tickets;
+
+    # Determine whether to create a branch of a branch
+    $url->branch ('trunk') unless $branch_of_branch;
+
+    # Create the branch
+    my $branch = Fcm::CmBranch->new;
+    $branch->create (
+      SRC                 => $url,
+      TYPE                => $type,
+      NAME                => $name,
+      PASSWORD            => $password,
+      REV_FLAG            => $rev_flag,
+      TICKET              => \@tickets,
+      REV                 => $rev,
+      NON_INTERACTIVE     => $non_interactive,
+      SVN_NON_INTERACTIVE => $svn_non_interactive,
+    );
+
+  } elsif ($list) {
+    # The option --list is specified
+    # List branches owned by current or specified users
+    # --------------------------------------------------------------------------
+    # Get URL of the project "branches/" sub-directory
+    $url->subdir ('');
+    $url->branch ('');
+    my @list = map {$_, 1} $url->branch_list ($rev);
+
+    if (@userlist) {
+      # Sort list of users
+      @userlist = sort (split /:/, join (':', @userlist));
+
+    } else {
+      # No user specified, add currrent user to list
+      push @userlist, $ENV{LOGNAME} unless @userlist;
+    }
+
+    # Filter branches matching user list
+    my @branches;
+    for my $branch (@list) {
+      next unless $branch =~ m#/([^/]+)/[^/]+/*$#;
+
+      my $user = $1;
+
+      push @branches, $branch if grep {$user eq $_} @userlist;
+    }
+
+    # Output, number of branches found
+    print scalar (@branches), ' ',
+          (scalar (@branches) > 1 ? 'branches' : 'branch'), ' found for ',
+          join (', ', @userlist), ' in ', $url->project_url_peg,
+          ($rev ? (' at r', $rev) : ()), "\n";
+
+    if (@branches) {
+      # Output the URL of each branch
+      if (not $verbose) {
+        my $project = $url->project_url;
+        my $keyword = &get_url_keyword (URL => $project);
+        @branches = map {s#^$project/+branches#$keyword-br#; $_} @branches
+          if defined $keyword;
+      }
+      @branches = map {$_ . "\n"} sort @branches;
+      print @branches;
+
+    } else {
+      # No branch found, exit with an error code
+      exit 1;
+    }
+
+  } else {
+    # The option --info or --delete is specified
+    # Report branch information (and/or delete a branch)
+    # --------------------------------------------------------------------------
+    # Set verbose level
+    &main::cfg->verbose ($verbose ? 1 : 0);
+
+    # Set up the branch, report any error
+    my $branch = Fcm::CmBranch->new (URL => $url->url_peg);
+    e_report $branch->url_peg, ': not a branch, abort.' unless $branch->branch;
+
+    e_report $branch->url_peg, ': does not exist, abort.'
+      unless $branch->url_exists;
+
+    # Remove the sub-directory part of the URL
+    $branch->subdir ('');
+
+    # Report branch info
+    $branch->display_info (
+      SHOW_CHILDREN => ($show_all || $show_children),
+      SHOW_OTHER    => ($show_all || $show_other   ),
+      SHOW_SIBLINGS => ($show_all || $show_siblings),
+    );
+
+    # Delete branch if --delete is specified
+    $branch->del (
+      PASSWORD            => $password,
+      NON_INTERACTIVE     => $non_interactive,
+      SVN_NON_INTERACTIVE => $svn_non_interactive,
+    ) if $delete;
+  }
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_commit ();
+#
+# DESCRIPTION
+#   This is a FCM wrapper to the "svn commit" command.
+# ------------------------------------------------------------------------------
+
+sub cm_commit {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+commit (ci): Send changes from your working copy to the repository.
+usage: fcm commit [PATH]
+
+  Invoke your favourite editor to prompt you for a commit log message. Send
+  changes from your working copy to the repository. Update your working copy
+  following the commit.
+
+Valid options:
+  --dry-run             : Allows you to add to the commit message without
+                          committing.
+  --svn-non-interactive : Do no interactive prompting at commit time.
+  --password arg        : Specify a password ARG.
+EOF
+    return 1;
+  }
+
+  my ($dry_run, $svn_non_interactive, $password);
+  GetOptions (
+    'dry-run'             => \$dry_run,
+    'svn-non-interactive' => \$svn_non_interactive,
+    'password'            => \$password,
+  );
+
+  # The remaining argument is the path to a working copy
+  my ($path) = @ARGV;
+
+  if ($path) {
+    # Check that specified path exists
+    e_report $path, ': does not exist, abort.' if not -e $path;
+
+  } else {
+    # No argument specified, use current working directory
+    $path = cwd ();
+  }
+
+  # Make sure we are in a working copy
+  e_report $path, ': not a working copy, abort.' if not &is_wc ($path);
+
+  # Make sure we are at the top level of the working copy
+  # (otherwise we might miss any template commit message)
+  my $dir = &get_wct ($path);
+
+  if ($dir ne cwd ()) {
+    chdir $dir or die 'Cannot change directory to: ', $dir;
+    print 'Committing changes from ', $dir, ' ...', "\n";
+  }
+
+  # Get update status of working copy
+  # Check working copy files are not in conflict, missing, or out of date
+  my @status = &run_command ([qw/svn status --show-updates/], METHOD => 'qx');
+  unless (defined $dry_run) {
+    my (@conflict, @missing, @outdate);
+
+    for (@status) {
+      if (/^C/) {
+        push @conflict, $_;
+        next;
+      }
+
+      if (/^!/) {
+        push @missing, $_;
+        next;
+      }
+
+      if (/^.{7}\*/) {
+        push @outdate, $_;
+        next;
+      }
+
+      # Check that all files which have been added have the svn:executable
+      # property set correctly (in case the developer adds a script before they
+      # remember to set the execute bit)
+      next unless /^A.{7} *\d+ +(.*)/;
+      my $file = $1;
+
+      next unless -f $file;
+      my @command = (-x $file)
+                    ? (qw/svn propset -q svn:executable */, $file)
+                    : (qw/svn propdel -q svn:executable/  , $file);
+      &run_command (\@command);
+    }
+
+    # Abort commit if files are in conflict, missing, or out of date
+    if (@conflict or @missing or @outdate) {
+      w_report 'File(s) in conflict:', "\n", @conflict if @conflict;
+      w_report 'File(s) missing:'    , "\n", @missing  if @missing;
+      w_report 'File(s) out of date:', "\n", @outdate  if @outdate;
+      e_report 'Abort commit.';
+    }
+  }
+
+  # Read in any existing message
+  my $ci_mesg = Fcm::CmCommitMessage->new ();
+  $ci_mesg->read_file;
+
+  # Execute "svn status" for a list of changed items
+  @status = grep !/^\?/, &run_command ([qw/svn status/], METHOD => 'qx');
+
+  # Abort if there is no change in the working copy
+  if (not @status) {
+    print 'No change in working copy, abort.', "\n";
+    return;
+  }
+
+  # Get associated URL of current working copy
+  my $url = Fcm::CmUrl->new (URL => &get_url_of_wc ());
+
+  # Include URL, or project, branch and sub-directory info in @status
+  unshift @status, "\n";
+
+  if ($url->project and $url->branch) {
+    unshift @status, (
+      '[Project: ' . $url->project                           . ']' . "\n",
+      '[Branch : ' . $url->branch                            . ']' . "\n",
+      '[Sub-dir: ' . ($url->subdir ? $url->subdir : '<top>') . ']' . "\n",
+    );
+
+  } else {
+    unshift @status, '[URL: ' . $url->url . ']' . "\n";
+  }
+
+  # Use a temporary file to store the final commit log message
+  $ci_mesg->ignore_mesg (@status);
+  my $logfile = $ci_mesg->edit_file (TEMP => 1);
+
+  # Check with the user to see if he/she wants to go ahead
+  my $reply = 'n';
+  if (not defined $dry_run) {
+    # Add extra warning for trunk commit
+    my $mesg = $url->is_trunk
+      ? "\n" .
+        '*** WARNING: YOU ARE COMMITTING TO THE TRUNK.' . "\n" .
+        '*** Please ensure that your change conforms to your project\'s ' .
+        'working practices.' . "\n\n"
+      : '';
+    $mesg   .= 'Would you like to commit this change?';
+
+    # Prompt the user
+    $reply = &main::get_input (
+      TITLE   => 'fcm commit',
+      MESSAGE => $mesg,
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+  }
+
+  if ($reply eq 'y') {
+    # Commit the change if user replies "y" for "yes"
+    my @command = (
+      qw/svn commit -F/, $logfile,
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+    );
+    my $rc;
+    &run_command (\@command, RC => \$rc, ERROR => 'warn');
+
+    if ($rc) {
+      # Commit failed
+      # Write temporary commit log content to commit log message file
+      $ci_mesg->write_file;
+
+      # Fail the command
+      e_report;
+    }
+
+    # Remove commit message file
+    unlink $ci_mesg->file;
+
+    # Update the working copy
+    print 'Performing update to make sure your working copy is at this new ',
+          'revision ...', "\n";
+    &run_command ([qw/svn update/]);
+
+  } else {
+    # Abort commit if dry run or user replies "n" for "no"
+    w_report 'Commit aborted by user.' unless $dry_run;
+
+    # Write temporary commit log content to commit log message file
+    $ci_mesg->write_file;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_conflicts ();
+#
+# DESCRIPTION
+#   This is a FCM command for resolving conflicts within working copy using a
+#   graphical merge tool.
+# ------------------------------------------------------------------------------
+
+sub cm_conflicts {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+conflicts: Use graphical tool to resolve any conflicts within your working copy.
+usage: fcm conflicts [PATH]
+
+  Invoke the xxdiff graphical merge tool to help you resolve conflicts in your
+  working copy. It prompts you to run "svn resolved" each time you have
+  resolved the conflicts in a file.
+EOF
+    return 1;
+  }
+
+  # Path to the working copy
+  my $path = $ARGV[0];
+  $path    = cwd () if not $path;
+
+  # Check for any files with conflicts
+  my @status = grep /^C.{4} *(.*)/, &run_command (
+    [qw/svn st/, ($path eq cwd () ? () : $path)], METHOD => 'qx',
+  );
+  my @files  = map {m/^C.{4} *(.*)/; $1} @status;
+
+  # Save current working directory
+  my $topdir = cwd ();
+
+  for my $file (@files) {
+    # Print name of file in conflicts
+    print "Conflicts in file: $file\n";
+
+    # Determine directory and base name of file in conflicts
+    my $base = basename $file;
+    my $dir  = dirname $file;
+
+    # Change to container directory of file in conflicts
+    chdir File::Spec->catfile ($topdir, $dir) or die "Directory change to $dir failed";
+
+    # Use "svn info" to determine conflict marker files
+    my @info = &run_command ([qw/svn info/, $base], METHOD => 'qx');
+
+    # Ignore if $base is a binary file
+    if (-B $base) {
+      w_report $base,
+               ': ignoring binary file, please resolve conflicts manually.';
+      next;
+    }
+
+    # Get conflicts markers files
+    my ($older, $mine, $yours);
+
+    for (@info) {
+      $older = $1 if (/^Conflict Previous Base File: (.*)/);
+      $mine  = $1 if (/^Conflict Previous Working File: (.*)/);
+      $yours = $1 if (/^Conflict Current Base File: (.*)/);
+    }
+
+    if ((stat $base)[9] > (stat $mine)[9]) {
+      # If $base is newer, it may contain saved changes
+      my $reply = &main::get_input (
+        TITLE   => 'fcm conflicts',
+        MESSAGE => 'Existing changes in ' . $base . ' will be overwritten.' .
+                   "\n" . 'Do you wish to continue?',
+        TYPE    => 'yn',
+        DEFAULT => 'n',
+      );
+
+      next if $reply ne 'y';
+    }
+
+    # Launch "xxdiff" to allow user to perform graphical merging
+    my $xxdiffrc;
+    my @command  = (qw/xxdiff -m -M/, $base, qw/-O -X/, $mine, $older, $yours);
+    my ($decision) = &run_command (
+      \@command, METHOD => 'qx', RC => \$xxdiffrc, ERROR => 'ignore',
+    );
+    die &get_command_string (\@command), ' failed' if $xxdiffrc and ! $decision;
+    chomp $decision;
+
+    # Perform different actions depending on the user's decision
+    if ($decision eq "NODECISION") {
+      print "No decision taken\n";
+
+    } elsif ($decision eq "MERGED" and $xxdiffrc != 0) {
+      print "Merge conflicts were not all resolved\n";
+
+    } else {
+      # User has MERGED, ACCEPTED or REJECTED all changes
+      if ($decision eq "MERGED") {
+        print "All merge conflicts resolved\n";
+
+      } else {
+        print "You have chosen to $decision all the changes\n";
+      }
+
+      # Prompt user to run "svn resolved" on the file
+      my $reply = &main::get_input (
+        TITLE   => 'fcm conflicts',
+        MESSAGE => 'Would you like to run "svn resolved"?',
+        TYPE    => 'yn',
+        DEFAULT => 'n',
+      );
+
+      # If reply is "yes"...
+      &run_command ([qw/svn resolved/, $base]) if $reply eq 'y';
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_delete ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn delete". It adds an extra functionality to check
+#   for any files or directories reported by "svn status" as missing, and to
+#   prompt the user whether these files or directories should be deleted.
+# ------------------------------------------------------------------------------
+
+sub cm_delete {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+usage: fcm delete [options] [args]
+
+Valid options:
+  -c [--check]  : Check for any files or directories reported by svn status as
+                  missing and delete them.
+  <SVN options> : Standard options to svn delete as described below ...
+
+EOF
+
+    &run_command ([qw/svn delete --help/], PRINT => 1, METHOD => 'exec');
+  }
+
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--check -c)) {
+    # The --check option is specified, delete any missing files
+    # Execute "svn status", print lines starting with a "!"
+    my $pat    = '^!.{4}\s*';
+    my @status = grep /$pat.*/, &run_command ([qw/svn status/], METHOD => 'qx');
+    print @status if @status;
+
+    # Get list of "!" files
+    my @files  = map {chomp; s/$pat//; $_} @status;
+    my $reply  = '';
+
+    # Execute "delete" command depending on user reply
+    for my $file (@files) {
+      # Get a user reply, unless previous reply is "a" for "all"
+      $reply = &main::get_input (
+        TITLE   => 'fcm delete',
+        MESSAGE => "Delete file '$file'?",
+        TYPE    => 'yna',
+        DEFAULT => 'n',
+      ) unless $reply eq "a";
+
+      # Delete current $file if reply is "y" for "yes" or "a" for "all"
+      &run_command ([qw/svn delete/, $file]) if $reply =~ /^[ya]$/;
+    }
+
+  } else {
+    # The --check option is not specified, just call "svn delete"
+    cm_svn ("delete");
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_diff ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn diff". It adds two extra functionalities. The
+#   first one allows the command to show differences relative to the base of
+#   the branch. The second one allows differences to be displayed via a
+#   graphical tool.
+# ------------------------------------------------------------------------------
+
+sub cm_diff {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+usage: 1. fcm diff --branch [OPTIONS] [TARGET]
+       2. fcm diff [OPTIONS] [ARGS]
+
+  1. --branch or -b: Show differences relative to the base of the target branch,
+     i.e. the changes available for merging from the target branch into its
+     parent. If TARGET is specified, it must either be a URL or a working copy.
+     Otherwise, the target is the the current directory which must be a working
+     copy. The target URL must be a branch in a standard FCM project.
+
+  2. See description of "svn diff" below.
+
+Valid options:
+  -g [--graphical] : Use a graphical diff tool to display the differences. This
+                     option should not be used in combination with --diff-cmd.
+  <SVN options>    : Standard options to "svn diff" as described below.
+
+Valid options with --branch:
+  --diff-cmd arg        : As described below in the help for "svn diff".
+  -g [--graphical]      : As described above.
+  -t [--trac]           : If TARGET is a URL, use Trac to display the diff.
+  --wiki                : If TARGET is a URL, print Trac link for the diff.
+  -x [--extensions] arg : As described below in the help for "svn diff".
+
+EOF
+
+    &run_command ([qw/svn diff --help/], PRINT => 1, METHOD => 'exec');
+  }
+
+  # Set up environment for graphical diff
+  # Use environment variable if set, otherwise use default setting
+  my $env = 'FCM_GRAPHIC_DIFF';
+  $ENV{$env} = &main::cfg->setting (qw/TOOL GRAPHIC_DIFF/)
+    unless exists $ENV{$env} or not &main::cfg->setting (qw/TOOL GRAPHIC_DIFF/);
+
+  # Check for the --branch options
+  # ----------------------------------------------------------------------------
+  my $branch = grep {$_ eq '-b' or $_ eq '--branch'} @ARGV;
+
+  if (not $branch) {
+    # The --branch option not specified, just call "svn diff"
+    # Convert the --graphical to qw/--diff-cmd fcm_graphical_diff/
+    @ARGV = map {
+      ($_ eq '-g' or $_ eq '--graphical')
+      ? (qw/--diff-cmd fcm_graphic_diff/)
+      : $_
+    } @ARGV;
+
+    # Execute the command
+    cm_svn ('diff');
+  }
+
+  # The --branch option is specified
+  # ----------------------------------------------------------------------------
+
+  # Determine whether the --graphical option is specified,
+  # if so set the appropriate command
+  # ----------------------------------------------------------------------------
+  my ($diff_cmd, $extensions, $graphical, $trac, $wiki);
+  GetOptions (
+    'b|branch'       => \$branch,
+    'diff-cmd=s'     => \$diff_cmd,
+    'x|extensions=s' => \$extensions,
+    'g|graphical'    => \$graphical,
+    't|trac'         => \$trac,
+    'wiki'           => \$wiki,
+  );
+
+  my @diff_cmd = ();
+  
+  if ($graphical) {
+    @diff_cmd = (qw/--diff-cmd fcm_graphic_diff/);
+
+  } elsif ($diff_cmd) {
+    @diff_cmd = ('--diff-cmd', $diff_cmd);
+
+    push @diff_cmd, '--extensions', split (/\s+/, $extensions) if $extensions;
+  }
+
+  # The remaining argument should either be a URL or a PATH
+  my ($url_arg, $path_arg);
+
+  if (@ARGV) {
+    my $arg = Fcm::CmUrl->new (URL => $ARGV[0]);
+
+    if ($arg->is_url) {
+      $url_arg = $ARGV[0];
+
+    } else {
+      $path_arg = $ARGV[0];
+    }
+  }
+
+  # Get repository and branch information
+  # ----------------------------------------------------------------------------
+  my ($url, $path);
+  if (defined $url_arg) {
+    # If a URL is specified, get repository and branch information from it
+    $url = Fcm::CmBranch->new (URL => $url_arg);
+
+  } else {
+    # Get repository and branch information from the specified path or the
+    # current directory if it is a working copy
+    $path = $path_arg ? $path_arg : cwd ();
+    e_report $path, ': not a working copy, abort.' unless &is_wc ($path);
+
+    $url  = Fcm::CmBranch->new (URL => &get_url_of_wc ($path));
+  }
+
+  # Check that URL is a standard FCM branch
+  e_report $url->url_peg, ': not a standard FCM branch, abort.'
+    unless $url->is_branch;
+
+  # Save and remove sub-directory part of the URL
+  my $subdir = $url->subdir ();
+  $url->subdir ('');
+
+  # Check that $url exists
+  e_report $url->url_peg, ': not a valid URL, abort.' unless $url->url_exists;
+
+  # Compare current branch with its parent
+  # ----------------------------------------------------------------------------
+  my $parent = Fcm::CmBranch->new (URL => $url->parent->url);
+  $parent->pegrev ($url->pegrev) if $url->pegrev;
+
+  e_report $parent->url, ': branch parent no longer exists',
+           ($parent->pegrev ? ' at ' . $parent->pegrev : ''), ', abort.'
+    unless $parent->url_exists;
+
+  my $base = $parent->base_of_merge_from ($url);
+
+  # Ensure the correct diff (syntax) is displayed
+  # ----------------------------------------------------------------------------
+  # Reinstate the sub-tree part into the URL
+  $url->subdir ($subdir);
+  $base->subdir ($subdir);
+
+  # Ensure the branch URL has a peg revision
+  $url->pegrev ($url->svninfo (FLAG => 'Last Changed Rev')) if not $url->pegrev;
+
+  if ($trac or $wiki) {
+    # Trac/wiki
+    # --------------------------------------------------------------------------
+    if (not $url_arg) {
+      if (&run_command ([qw/svn status/], METHOD => 'qx')) {
+        w_report 'WARNING: the working copy at "', ($path_arg ? $path_arg : '.'),
+                 '" contains local changes, which cannot be displayed in Trac.';
+      }
+    }
+
+    # Trac wiki syntax
+    my $wiki_syntax = 'diff:' . $base->path_peg . '//' . $url->path_peg;
+
+    if ($wiki) {
+      # Print Trac wiki syntax only
+      print $wiki_syntax, "\n";
+
+    } else { # if $trac
+      # Use Trac to view "diff"
+      my $browser  = &main::cfg->setting (qw/MISC WEB_BROWSER/);
+      die 'ERROR: web browser not set, abort' if not $browser;
+
+      my $trac_url = &get_browser_url (URL => $url->project_url);
+      e_report 'ERROR: ', $url->project_url,
+               ': not associated with a Trac URL, abort.'
+        if not $trac_url;
+
+      $trac_url =~ s#/browser/.*$#/intertrac/$wiki_syntax#;
+
+      &run_command ([$browser, $trac_url], METHOD => 'exec', PRINT => 1);
+    }
+
+  } else {
+    # Execute the "diff" command
+    # --------------------------------------------------------------------------
+    my @command = (
+      qw/svn diff/, @diff_cmd,
+      '--old', $base->url_peg,
+      '--new', ($url_arg ? $url->url_peg : ($path_arg ? $path_arg : '.')),
+    );
+    &run_command (\@command, PRINT => 1);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_merge ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn merge".
+# ------------------------------------------------------------------------------
+
+sub cm_merge {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+merge: Merge changes from a source into your working copy.
+usage: 1. fcm merge SOURCE
+       2. fcm merge --custom  --revision N[:M] SOURCE
+          fcm merge --custom  URL[\@REV1] URL[\@REV2]
+       3. fcm merge --reverse --revision [M:]N
+
+  1. If neither --custom nor --reverse is specified, the command merges changes
+     automatically from SOURCE into your working copy. SOURCE must be a valid
+     URL[\@REV] of a branch in a standard FCM project. The base of the merge
+     will be calculated automatically based on the common ancestor and latest
+     merge information between the SOURCE and the branch of the working copy.
+
+  2. If --custom is specified, the command can be used in two forms.
+  
+     In the first form, it performs a custom merge from the specified
+     changeset(s) of SOURCE into your working copy. SOURCE must be a valid
+     URL[\@REV] of a branch in a standard FCM project. If a single revision is
+     specified, the merge delta is (N - 1):N of SOURCE. Otherwise, the merge
+     delta, is N:M of SOURCE, where N < M.
+     
+     In the second form, it performs a custom merge using the delta between the
+     two specified branch URLs. For each URL, if a peg revision is not
+     specified, the command will peg the URL with its last changed revision.
+
+  3. If --reverse is specified, the command performs a reverse merge of the
+     changeset(s) specified by the --revision option. If a single revision is
+     specified, the merge delta is N:(N - 1). Otherwise, the merge delta is
+     M:N, where M > N. Note that you do not have to specify a SOURCE for a
+     reverse merge, because the SOURCE should always be the branch your working
+     copy is pointing to.
+  
+  The command provide a commit log message template following the merge.
+
+Valid options:
+  --dry-run          : Try operation but make no changes.
+  --non-interactive  : Do no interactive prompting.
+  -r [--revision] arg: Specify a (range of) revision number(s).
+  --verbose          : Print extra information.
+EOF
+    return 1;
+  }
+
+  # Options
+  # ----------------------------------------------------------------------------
+  my ($custom, $dry_run, $non_interactive, $reverse, $rev, $verbose);
+  GetOptions (
+    'custom'          => \$custom,
+    'dry-run'         => \$dry_run,
+    'non-interactive' => \$non_interactive,
+    'reverse'         => \$reverse,
+    'revision|r=s'    => \$rev,
+    'verbose|v'       => \$verbose,
+  );
+
+  # Find out the URL of the working copy
+  # ----------------------------------------------------------------------------
+  my ($target, $wct);
+  if (&is_wc ()) {
+    $wct = &get_wct ();
+
+    if ($wct ne cwd ()) {
+      print 'Change directory to top of working copy: ', $wct, "\n";
+      chdir $wct or die 'Cannot change directory to: ', $wct;
+    }
+
+    $target = Fcm::CmBranch->new (URL => &get_url_of_wc ($wct));
+
+  } else {
+    e_report 'The current directory is not a working copy, abort.';
+  }
+
+  e_report 'Your working copy URL does not exist at the HEAD revision, abort.'
+    unless $target->url_exists;
+
+  # The target must be at the top of a branch
+  # $subdir will be used later to determine whether the merge is allowed or not
+  my $subdir = $target->subdir;
+  $target->subdir ('') if $subdir;
+
+  # Check for any local modifications
+  # ----------------------------------------------------------------------------
+  return
+    if ! ($dry_run or $non_interactive) and &_abort_modified_wc ('fcm merge');
+
+  # Determine the SOURCE URL
+  # ----------------------------------------------------------------------------
+  my $source;
+
+  if ($reverse) {
+    # Reverse merge, the SOURCE is the the working copy URL
+    $source = Fcm::CmBranch->new (URL => $target->url);
+
+  } else {
+    # Automatic/custom merge, argument 1 is the SOURCE of the merge
+    my $source_url = shift (@ARGV);
+    e_report 'Error: argument 1 must be the URL/name of a source branch in ',
+             'automatic/custom mode, abort.'
+      if not $source_url;
+
+    $source = &_construct_branch_url ($source_url, $target);
+  }
+
+  # Parse the revision option
+  # ----------------------------------------------------------------------------
+  my @revs;
+  if ($reverse or $custom) {
+    if ($reverse and not $rev) {
+      e_report 'Error: a revision (range) must be specified with ',
+               '--revision in reverse mode, abort.'
+    }
+
+    @revs = split (/:/, $rev) if $rev;
+  }
+
+  # Determine the merge delta and the commit log message
+  # ----------------------------------------------------------------------------
+  my (@delta, $mesg);
+  my $separator = '-' x 80 . "\n";
+
+  if ($reverse) {
+    # Reverse merge
+    # --------------------------------------------------------------------------
+    if (@revs == 1) {
+      $revs[1] = ($revs[0] - 1);
+
+    } else {
+      @revs = sort {$b <=> $a} @revs;
+    }
+
+    $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev'))
+      unless $source->pegrev;
+    $source->subdir ($subdir);
+
+    # "Delta" of the "svn merge" command
+    @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg);
+
+    # Template message
+    $mesg = 'Reversed r' . $revs[0] .
+            (($revs[1] < $revs[0] - 1) ? ':' . $revs[1] : '') . ' of ' .
+            $source->path . "\n";
+
+  } elsif ($custom) {
+    # Custom merge
+    # --------------------------------------------------------------------------
+    if (@revs) {
+      # Revision specified
+      # ------------------------------------------------------------------------
+      # Only one revision N specified, use (N - 1):N as the delta
+      unshift @revs, ($revs[0] - 1) if @revs == 1;
+
+      $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev'))
+        unless $source->pegrev;
+      $source->subdir ($subdir);
+      $target->subdir ($subdir);
+
+      # "Delta" of the "svn merge" command
+      @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg);
+
+      # Template message
+      $mesg = 'Custom merge into ' . $target->path . ': r' . $revs[1] .
+              ' cf. r' . $revs[0] . ' of ' . $source->path_peg . "\n";
+
+    } else {
+      # Revision not specified
+      # ------------------------------------------------------------------------
+      # Get second source URL
+      my $source2_url = shift (@ARGV);
+      e_report 'Error: argument 2 must be the URL/name of a source branch in ',
+               'custom mode when --revision is not specified, abort.'
+        if not $source2_url;
+
+      my $source2 = &_construct_branch_url ($source2_url, $target);
+
+      $source->pegrev  ($source->svninfo  (FLAG => 'Last Changed Rev'))
+        unless $source->pegrev;
+      $source2->pegrev ($source2->svninfo (FLAG => 'Last Changed Rev'))
+        unless $source2->pegrev;
+      $source->subdir  ($subdir);
+      $source2->subdir ($subdir);
+      $target->subdir  ($subdir);
+
+      # "Delta" of the "svn merge" command
+      @delta = ($source->url_peg, $source2->url_peg);
+
+      # Template message
+      $mesg = 'Custom merge into ' . $target->path . ': ' . $source->path_peg .
+              ' cf. ' . $source2->path_peg . "\n";
+    }
+
+  } else {
+    # Automatic merge
+    # --------------------------------------------------------------------------
+    # Check to ensure source branch is not the same as the target branch
+    e_report 'Error: cannot merge ', $source->branch,
+             ' to its own working copy, abort.'
+      if $source->branch eq $target->branch;
+
+    # Only allow the merge if the source and target are "directly related"
+    # --------------------------------------------------------------------------
+    my $anc = $target->ancestor ($source);
+    e_report 'Error: source and target are not directly related' unless
+      ($anc->url eq $target->url and $anc->url_peg eq $source->parent->url_peg)
+      or
+      ($anc->url eq $source->url and $anc->url_peg eq $target->parent->url_peg)
+      or
+      ($anc->url eq $source->parent->url and $anc->url eq $target->parent->url);
+
+    # Check for available merges from the source
+    # --------------------------------------------------------------------------
+    my @revs = $target->avail_merge_from ($source, 1);
+
+    if (@revs) {
+      print 'Available Merge', (@revs > 1 ? 's' : ''), ' From ',
+            $source->path_peg, ':';
+
+      if ($verbose) {
+        # Verbose mode, print log messages of available merges
+        print "\n";
+
+        for (@revs) {
+          print $separator, $source->display_svnlog ($_);
+        }
+
+        print $separator;
+
+      } else {
+        # Normal mode, list revisions of available merges
+        print ' ', join (' ', @revs), "\n";
+      }
+
+    } else {
+      w_report 'No merge available from ', $source->path_peg, ', abort.';
+      return;
+    }
+
+    # If more than one merge available, prompt user to enter a revision number
+    # to merge from, default to $revs [0]
+    # --------------------------------------------------------------------------
+    my $reply = ($non_interactive or @revs == 1) ? $revs[0] : &main::get_input (
+      TITLE   => 'fcm merge',
+      MESSAGE => 'Please enter the revision you wish to merge from',
+      DEFAULT => $revs [0],
+    );
+
+    if (not defined ($reply)) {
+      w_report 'Merge aborted by user.';
+      return;
+    }
+
+    # Expand revision keyword if necessary
+    if ($reply) {
+      $reply = expand_rev_keyword (REV => $reply, URL => $target->project_url);
+    }
+
+    # Check that the reply is a number in the available merges list
+    e_report $reply, ': not a revision in the list of available merges.'
+      unless (grep {$_ == $reply} @revs);
+
+    $source->pegrev ($1) if ($reply =~ /^(\d+)/);
+
+    # If the working copy top is pointing to a sub-directory of a branch,
+    # we need to check whether the merge will result in losing changes made in
+    # other sub-directories of the source.
+    if ($subdir and not $target->allow_subdir_merge_from ($source, $subdir)) {
+      e_report 'SOURCE contains changes outside the current sub-directory.', "\n",
+               'Please use a full tree for the merge, abort.';
+    }
+
+    # Calculate the base of the merge
+    my $base = $target->base_of_merge_from ($source);
+
+    # $source and $base must take into account the sub-directory
+    my $s = Fcm::CmBranch->new (URL => $source->url_peg);
+    my $b = Fcm::CmBranch->new (URL => $base->url_peg);
+
+    $s->subdir ($subdir) if $subdir;
+    $b->subdir ($subdir) if $subdir;
+
+    # Diagnostic
+    print 'About to merge in changes from ', $s->path_peg, ' compared with ',
+          $b->path_peg, "\n";
+
+    # Delta of the "svn merge" command
+    @delta = ($b->url_peg, $s->url_peg);
+
+    # Template message
+    $mesg = 'Merged into ' . $target->path . ': ' . $source->path_peg .
+            ' cf. ' . $base->path_peg . "\n";
+  }
+
+  # Run "svn merge" in "--dry-run" mode to see the result
+  # ----------------------------------------------------------------------------
+  my @out   = &run_command (
+    [qw/svn merge --dry-run/, @delta],
+    METHOD => 'qx', PRINT => ($dry_run and $verbose),
+  );
+
+  # Abort merge if it will result in no change
+  if (not @out) {
+    print 'This merge will not result in any change, abort.', "\n";
+    return;
+  }
+
+  # Report result of "svn merge --dry-run"
+  if (not $non_interactive) {
+    print 'This merge will result in the following change',
+          (@out > 1 ? 's' : ''), ':', "\n";
+    print $separator, @out, $separator;
+  }
+
+  return if $dry_run;
+
+  # Prompt the user to see if (s)he would like to go ahead
+  # ----------------------------------------------------------------------------
+  my $reply = $non_interactive ? 'y' : &main::get_input (
+    TITLE   => 'fcm merge',
+    MESSAGE => 'Would you like to go ahead with the merge?',
+    TYPE    => 'yn',
+    DEFAULT => 'n',
+  );
+
+  # Go ahead with merge only if user replies "y"
+  if ($reply eq "y") {
+    print "Performing merge ...\n";
+    &run_command ([qw/svn merge/, @delta], PRINT => $verbose);
+
+  } else {
+    w_report 'Merge aborted by user.';
+    return;
+  }
+
+  # Prepare the commit log
+  # ----------------------------------------------------------------------------
+  # Read in any existing message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->read_file;
+  $ci_mesg->auto_mesg ($mesg, ($ci_mesg->auto_mesg));
+  $ci_mesg->write_file;
+
+  if ($verbose) {
+    print <<EOF;
+${separator}The following line has been added to your commit message file:
+$mesg
+EOF
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_mkpatch ();
+#
+# DESCRIPTION
+#   This is a FCM command to create a patching script from particular revisions
+#   of a URL.
+# ------------------------------------------------------------------------------
+
+sub cm_mkpatch {
+  my $usage = <<EOF;
+mkpatch: Create patches from specified revisions of a URL
+usage: fcm mkpatch [OPTIONS] URL [OUTDIR]
+
+  URL must be the URL of a branch in a FCM project. If the URL is a
+  sub-directory of a branch, it will use the root of the branch.
+
+  Create patches from specified revisions of the specified URL. If OUTDIR is
+  specified, the output is sent to OUTDIR. Otherwise, the output will be sent
+  to a default location in the current directory (\$PWD/fcm-mkpatch-out). The
+  output directory will contain the patch for each revision as well as a script
+  for importing the patch.
+
+  If a revision is specified with the --revision option, it will attempt to
+  create a patch based on the changes at that revision. If a revision is not
+  specified, it will attempt to create a patch based on the changes at the HEAD
+  revision. If a revision range is specified, it will attempt to create a patch
+  for each revision in that range (including the change in the lower range)
+  where changes have taken place in the URL. No output will be written if there
+  is no change in the given revision (range).
+
+  The --exclude option can be used to exclude a path in the URL. The specified
+  path must be a relative path of the URL. Glob patterns such as * and ? are
+  acceptable. Changes in an excluded path will not be considered in the patch.
+  A changeset containing changes only in the excluded path will not be
+  considered at all.
+
+  The --organisation option can be used to specify the name of your
+  organisation. The command will attempt to parse the commit log message for
+  each revision in the patch. It will remove all merge templates, replace links
+  to Trac tickets with a simple string, and add information about the original
+  changeset. If you specify the name of your organisation, it will replace Trac
+  ticket links such as "ticket:123" to "Original \$organisation ticket 123",
+  and report the orginal changeset with a message such as "Original
+  \$organisation changeset 1000". Otherwise, it will report without the
+  organisation name, e.g. "Original ticket 123" and "Original  changeset 1000".
+
+Valid options:
+  --exclude       arg : Exclude a path in the URL. Multiple paths can be
+                        specified by using a colon-separated list of paths, or
+                        by specifying this option multiple times.
+  --organisation  arg : Specify the name of your organisation.
+  -r [--revision] arg : Specify a revision number or a revision number range.
+EOF
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print $usage;
+    return 1;
+  }
+
+  # Process command line options and arguments
+  # ----------------------------------------------------------------------------
+  my (@exclude, $organisation, $revision);
+  GetOptions (
+    'exclude=s'      => \@exclude,
+    'organisation=s' => \$organisation,
+    'r|revision=s'   => \$revision,
+  );
+
+  # Excluded paths, convert glob into regular patterns
+  @exclude = split (/:/, join (':', @exclude));
+  for (@exclude) {
+    s#\*#[^/]*#; # match any number of non-slash character
+    s#\?#[^/]#;  # match a non-slash character
+    s#/*$##;     # remove trailing slash
+  }
+
+  # Organisation prefix
+  $organisation = $organisation ? $organisation : 'original';
+
+  # Make sure revision option is set correctly
+  my @revs = $revision ? split (/:/, $revision) : ();
+  @revs    = @revs [0, 1] if @revs > 2;
+
+  # Arguments
+  my ($u, $outdir) = @ARGV;
+
+  if (not $u) {
+    print $usage;
+    return 1;
+  }
+
+  my $url = Fcm::CmUrl->new (URL => $u);
+  e_report $u, ': URL is not a URL, abort.' if not $url->is_url;
+  e_report $u, ': URL does not exist, abort.' if not $url->url_exists;
+  e_report $u, ': URL is not a valid branch in a FCM project, abort.'
+    if not $url->branch;
+
+  $url->subdir ('');
+
+  if (@revs) {
+    # If HEAD revision is given, convert it into a number
+    # --------------------------------------------------------------------------
+    for my $rev (@revs) {
+      $rev = $url->svninfo (FLAG => 'Revision') if uc ($rev) eq 'HEAD';
+    }
+
+  } else {
+    # If no revision is given, use the HEAD
+    # --------------------------------------------------------------------------
+    $revs[0] = $url->svninfo (FLAG => 'Revision');
+  }
+
+  $revs[1] = $revs[0] if @revs == 1;
+
+  # Check that output directory is set
+  # ----------------------------------------------------------------------------
+  $outdir = File::Spec->catfile (cwd (), 'fcm-mkpatch-out') if not $outdir;
+
+  if (-e $outdir) {
+    # Ask user to confirm removal of old output directory if it exists
+    my $reply = &main::get_input (
+      TITLE   => 'fcm mkpatch',
+      MESSAGE => 'Output location ' . $outdir . ' exists. OK to overwrite?',
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+
+    if ($reply ne 'y') {
+      w_report 'fcm mkpatch: command aborted by user.';
+      return 1;
+    }
+
+    rmtree $outdir or die $outdir, ': cannot remove';
+  }
+
+  # (Re-)create output directory
+  mkpath $outdir or die $outdir, ': cannot create';
+  print 'Output directory: ', $outdir, "\n";
+
+  # Get and process log of URL
+  # ----------------------------------------------------------------------------
+  my @script     = (); # output script, from the log
+  my %log        = $url->svnlog (REV => \@revs);
+  my $url_path   = $url->path;
+  my $file_count = 0;
+
+  for my $rev (sort {$a <=> $b} keys %log) {
+    # Look at the changed paths for each revision
+    my @paths;
+
+    # Skip excluded paths if necessary
+    PATH: for my $path (sort keys %{ $log{$rev}{paths} }) {
+      for my $exclude (@exclude) {
+        (my $file = $path) =~ s#^$url_path/*##;
+
+        next PATH if $file =~ m#^$exclude(?:/*|$)#;
+      }
+
+      push @paths, $path;
+    }
+
+    next unless @paths;
+
+    # Parse commit log message
+    my @msg = split /\n/, $log{$rev}{msg};
+    for (@msg) {
+      # Re-instate line break
+      $_ .= "\n";
+
+      # Remove line if it matches a merge template
+      $_ = '' if /^Reversed r\d+(?::\d+)? of \S+$/;
+      $_ = '' if /^Custom merge into \S+:.+$/;
+      $_ = '' if /^Merged into \S+: \S+ cf\. \S+$/;
+
+      # Modify Trac ticket link
+      s/(?:#|ticket:)(\d+)/[$organisation ticket $1]/g;
+
+      # Modify Trac changeset link
+      s/(?:r|changeset:)(\d+)/[$organisation changeset $1]/g;
+      s/\[(\d+)\]/[$organisation changeset $1]/g;
+    }
+
+    push @msg, '[' . $organisation . ' changeset ' . $rev . ']' . "\n";
+
+    # Write commit log message in a file
+    my $f_revlog = File::Spec->catfile ($outdir, $rev . '-log');
+    open FILE, '>', $f_revlog or die $f_revlog, ': cannot open (', $!, ')';
+    print FILE @msg;
+    close FILE or die $f_revlog, ': cannot close (', $!, ')';
+
+    # Create a directory for this revision in the output directory
+    my $outdir_rev = File::Spec->catfile ($outdir, $rev);
+    mkpath $outdir_rev or die $outdir_rev, ': cannot create';
+
+    # Handle modified/copy/new path, export the path, + script to copy/add it
+    for my $path (@paths) {
+      next unless $log{$rev}{paths}{$path}{action} =~ /^[AMR]$/;
+
+      (my $file = $path) =~ s#^$url_path/*##;
+
+      # Download the file using "svn export"
+      my $patch    = File::Spec->catfile ($outdir_rev, $file_count++);
+      my $url_file = $url->url . '/' . $file . '@' . $rev;
+      &run_command ([qw/svn export -q -r/, $rev, $url_file, $patch]);
+
+      (my $patch_path = $patch) =~ s#^$outdir/*##;
+
+      # Script to copy the file, if required
+      my $is_newfile = 0;
+      if ($log{$rev}{paths}{$path}{action} eq 'A') {
+        if (exists $log{$rev}{paths}{$path}{'copyfrom-path'}) {
+          # History exists for this file
+          my $copyfrom_path = $log{$rev}{paths}{$path}{'copyfrom-path'};
+          my $copyfrom_rev  = $log{$rev}{paths}{$path}{'copyfrom-rev'};
+
+          # Check whether file is copied from a file under the specified URL
+          # It is likely to be a new file if it is copied from outside of the
+          # specified URL.
+          $is_newfile = not ($copyfrom_path =~ s#^$url_path/*##);
+
+          if ($is_newfile) {
+            # File copied from outside of the specified URL
+            # If it is copied from a branch, follow its history, stop on copy
+            my $cp_url = Fcm::CmUrl->new (
+              URL => $url->root . $copyfrom_path . '@' . $copyfrom_rev,
+            );
+
+            # Log of the copied file
+            my %cp_log = $cp_url->svnlog (STOP_ON_COPY => 1);
+
+            # "First" revision of the copied file
+            my $cp_rev = (sort {$a <=> $b} keys %cp_log) [0];
+            my %attrib = exists $cp_log{$cp_rev}{paths}{$cp_url->path}
+                         ? %{ $cp_log{$cp_rev}{paths}{$cp_url->path} } : ();
+
+            # Check whether the "first" revision is copied from elsewhere.
+            if (exists $attrib{'copyfrom-path'}) {
+              # Check whether source exists in the current branch
+              my $cp_cp_url = Fcm::CmUrl->new (
+                URL => $url->root . $attrib{'copyfrom-path'} . '@' .
+                       $attrib{'copyfrom-rev'},
+              );
+
+              $cp_cp_url->branch ($url->branch);
+
+              # If source exists in current branch, set up copy from the source
+              if ($cp_cp_url->url_exists ($rev - 1)) {
+                $is_newfile     = 0;
+                (my $cp_cp_path = $cp_cp_url->path) =~ s#^$url_path/*##;
+
+                push @script, 'svn copy ' . $cp_cp_path .  ' ' . $file;
+              }
+            }
+
+          } else {
+            # File copied from a location under the specified URL
+            # Script to copy file
+            push @script, 'svn copy ' . $copyfrom_path .  ' ' . $file;
+          }
+
+        } else {
+          # History does not exist, must be a new file
+          $is_newfile = 1;
+        }
+      }
+
+      # Copy the "patch" into the file
+      push @script, 'cp -r ${fcm_patch_dir}/' . $patch_path . ' ' . $file;
+
+      # Script to add the file, if required
+      push @script, 'svn add ' . $file
+        if $log{$rev}{paths}{$path}{action} eq 'A' and $is_newfile;
+    }
+
+    # Handle deleted path, script to delete it
+    for my $path (@paths) {
+      next unless $log{$rev}{paths}{$path}{action} eq 'D';
+
+      (my $file = $path) =~ s#^$url_path/*##;
+
+      push @script, 'svn delete ' . $file;
+    }
+
+    # Script to commit the change
+    push @script, 'svn commit -F ${fcm_patch_dir}/' . $rev . '-log';
+    push @script, '';
+  }
+
+  # Write the script if necessary. Otherwise remove output directory
+  # ----------------------------------------------------------------------------
+  if (@script) {
+    # Add line break to each line in @script
+    @script = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")} @script;
+
+    # Write script to output
+    my $out = File::Spec->catfile ($outdir, 'fcm-import-patch');
+    open FILE, '>', $out or die $out, ': cannot open (', $!, ')';
+
+    # Script header
+    print FILE <<EOF;
+#!/bin/sh
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm-import-patch
+#
+# SYNOPSIS
+#   fcm-import-patch TARGET
+#
+# DESCRIPTION
+#   This script is generated automatically by the "fcm mkpatch" command,
+#   together with the revision "patches" it creates. The script imports the
+#   patches into TARGET, which must either be a URL or a working copy of a
+#   valid project tree that can accept the import of the patches.
+#
+#   Patch created from $organisation URL: $u
+# ------------------------------------------------------------------------------
+
+this=`basename \$0`
+
+# Check argument
+target=\$1
+
+# First argument must be a URL or working copy
+if [[ -z \$target ]]; then
+  echo "\$this: the first argument must be a URL or a working copy, abort." >&2
+  exit 1
+fi
+
+if [[ \$target == svn://*  || \$target == svn+ssh://* || \\
+      \$target == http://* || \$target == https://*   || \\
+      \$target == file://* ]]; then
+  # A URL, checkout a working copy in a temporary location
+  fcm_tmp_dir=`mktemp -d \$TMPDIR/\$0.XXXXXX`
+  fcm_working_copy=\$fcm_tmp_dir
+  svn checkout -q \$target \$fcm_working_copy || exit 1
+
+else
+  # A working copy, check that it does not have local changes
+  status=`svn status \$target`
+
+  if [[ -n \$status ]]; then
+    echo "\$target: working copy contains changes, abort." >&2
+    exit 1
+  fi
+
+  fcm_working_copy=\$target
+fi
+
+# Location of the patches, base on the location of this script
+cd `dirname \$0` || exit 1
+fcm_patch_dir=\$PWD
+
+# Change directory to the working copy
+cd \$fcm_working_copy || exit 1
+
+# Commands to apply patches
+EOF
+
+    # Script content
+    print FILE @script;
+
+    # Script footer
+    print FILE <<EOF;
+# Remove temporary working copy, if necessary
+if [[ -d \$fcm_tmp_dir && -w \$fcm_tmp_dir ]]; then
+  rm -rf \$fcm_tmp_dir
+fi
+
+echo "\$this: finished normally."
+#EOF
+EOF
+
+    close FILE or die $out, ': cannot close (', $!, ')';
+
+    # Add executable permission
+    chmod 0755, $out;
+
+    # Diagnostic
+    print $outdir, ': patch generated.', "\n";
+
+  } else {
+    # Remove output directory
+    rmtree $outdir or die $outdir, ': cannot remove';
+
+    # Diagnostic
+    w_report 'No patch is required, abort.';
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_svn ();
+#
+# DESCRIPTION
+#   This is a generic wrapper for all "other" Subversion commands.
+# ------------------------------------------------------------------------------
+
+sub cm_svn {
+  &run_command (
+    ['svn', @_, @ARGV],
+    PRINT => ($_[0] ne 'cat' and not grep {$_ eq '--xml'} @ARGV),
+    METHOD => 'exec',
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_switch ();
+#
+# DESCRIPTION
+#   This is a wrapper for the Subversion "switch" command.
+# ------------------------------------------------------------------------------
+
+sub cm_switch {
+  if (grep {$_ eq '-h' or $_ eq '--help'} @ARGV or not @ARGV) {
+    # Print usage message if requested
+    print <<EOF;
+usage: 1. switch URL [PATH]
+       2. switch --relocate FROM TO [PATH...]
+
+Note: if --relocate is not specified, "fcm switch" will only support the
+      options --non-interactive, -r [--revision] and -q [--quiet].
+
+EOF
+
+    &run_command ([qw/svn switch --help/], PRINT => 1, METHOD => 'exec');
+
+  } elsif (grep {$_ eq '--relocate'} @ARGV) {
+    # If "--relocate" is specified, call the command "as is"
+    cm_svn ('switch');
+  }
+
+  # "--help" and "--relocate" not specified, implement custom switch command
+
+  # Get command line options
+  my ($non_interactive, $rev, $quiet);
+  GetOptions (
+    'non-interactive' => \$non_interactive,
+    'revision|r=s'    => \$rev,
+    'quiet|q'         => \$quiet,
+  );
+
+  # The remaining arguments
+  $rev = 'HEAD' if not $rev;
+
+  # The remaining arguments
+  my ($newurl_arg, $path) = @ARGV;
+
+  # Make sure we are in a working copy
+  if ($path) {
+    e_report $path, ': does not exist, abort.' if not -e $path;
+
+  } else {
+    $path = cwd ();
+  }
+
+  e_report $path, ': not a working copy, abort.' if not &is_wc ($path);
+
+  # Make sure we are at the top level of the working copy
+  my $dir = &get_wct ($path);
+
+  # Check for merge template in the commit log file in the working copy
+  my $ci_mesg = Fcm::CmCommitMessage->new (DIR => $dir);
+  $ci_mesg->read_file;
+  e_report (
+    (($path eq $dir) ? $ci_mesg->base : $ci_mesg->file),
+    ': merge template exists, please remove it before running switch, abort.',
+  ) if $ci_mesg->auto_mesg;
+
+  # Check for any local modifications
+  return if ! $non_interactive and &_abort_modified_wc ('fcm switch', $dir);
+
+  # Get current URL information associated with the working copy
+  my $oldurl = Fcm::CmBranch->new (URL => &get_url_of_wc ($dir));
+
+  # Analyse new URL
+  my $newurl = &_construct_branch_url ($newurl_arg, $oldurl);
+
+  # Construct the switch command
+  my @command = (
+    qw/svn switch/,
+    ($non_interactive ? '--non-interactive' : ()),
+    ($rev             ? ('-r', $rev)        : ()),
+    ($quiet           ? '--quiet'           : ()),
+    $newurl->url,
+    ($dir eq cwd () ? () : $dir),
+  );
+
+  # Execute the command
+  &run_command (\@command, METHOD => 'exec', PRINT => 1);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $source = &_construct_branch_url ($src_url, $target);
+#
+# DESCRIPTION
+#   The function takes a string $src_url, which is normally the SOURCE URL
+#   argument for "merge" and "switch", and a target, which is an instance of a
+#   Fcm::CmBranch object with a valid URL of a standard FCM branch. It returns
+#   an instance of a Fcm::CmBranch object that represents a valid URL for
+#   $src_url.
+# ------------------------------------------------------------------------------
+
+sub _construct_branch_url {
+  my ($src_url, $target) = @_;
+
+  my $source = Fcm::CmBranch->new (URL => $src_url);
+
+  if (not $source->is_url) {
+    # Not a full URL, construct full URL based on current URL
+    $source->url_peg ($target->url_peg);
+
+    my $path    = '';
+    my $project = $target->project;
+
+    # Construct the branch URL
+    if ($src_url =~ m#^/*$project/(?:trunk|branches|tags)$#) {
+      # Argument contains the full path under the repository root
+      $path = $src_url;
+
+    } elsif ($src_url =~ m#^/*trunk/*(?:@\d+)?$# or
+             $src_url =~ m#^/*(?:trunk|branches|tags)/+#) {
+      # Argument contains the full branch name
+      $src_url =~ s#^/*##;
+      $path    = $target->project_path . '/' . $src_url;
+
+    } else {
+      # Argument contains the shorter branch name
+      $src_url =~ s#^/*##;
+      $path    = $target->project_path . '/branches/' . $src_url;
+    }
+
+    $source->path_peg ($path);
+  }
+
+  # Replace source sub-directory with the target sub-directory
+  $source->subdir ($target->subdir);
+
+  # Ensure that the branch name exists
+  e_report $src_url, ': not a valid URL, abort.'
+    if not $source->url_exists;
+
+  # Ensure that the branch name is valid
+  e_report $src_url, ': not a standard branch in a FCM project, abort.'
+    if not $source->branch;
+
+  # Ensure that the source and target URLs are in the same project
+  e_report 'Source and target URLs are in different projects, abort.'
+    if $source->project_url ne $target->project_url;
+
+  return $source;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &_abort_modified_wc ($title, [$wc]);
+#
+# DESCRIPTION
+#   The function checks for any local modifications in a working copy and
+#   prompts the user whether he/she wants to continue with the command. $title
+#   is the title of the current command. If $wc is specified, it must be the
+#   path to a working copy. Otherwise, the current working directory is used.
+# ------------------------------------------------------------------------------
+
+sub _abort_modified_wc {
+  my ($title, $wc) = @_;
+
+  my @status = &run_command ([qw/svn status/, ($wc ? $wc : ())], METHOD => 'qx');
+
+  if (@status) {
+    print 'You have local modifications:', "\n", @status;
+    my $reply = &main::get_input (
+      TITLE   => $title,
+      MESSAGE => 'Are you sure you want to continue?',
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+
+    # Abort if user gives any reply other than "y"
+    if ($reply ne 'y') {
+      w_report $title, ': command aborted by user.';
+      return 1;
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmBranch.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmBranch.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmBranch.pm	(revision 5166)
@@ -0,0 +1,1199 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmBranch
+#
+# DESCRIPTION
+#   This class contains methods for manipulating a branch. It is a sub-class of
+#   Fcm::CmUrl, and inherits all methods from that class.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmBranch;
+@ISA = qw(Fcm::CmUrl);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+
+# FCM component modules
+use Fcm::CmCommitMessage;
+use Fcm::CmUrl;
+use Fcm::Util qw/run_command e_report w_report get_rev_keyword svn_date/;
+
+my @properties = (
+  'CREATE_REV',  # revision at which the branch is created
+  'DELETE_REV',  # revision at which the branch is deleted
+  'PARENT',      # reference to parent branch Fcm::CmBranch
+  'ANCESTOR',    # list of common ancestors with other branches
+                 # key = URL, value = ancestor Fcm::CmBranch
+  'LAST_MERGE',  # list of last merges from branches
+                 # key = URL@REV, value = [TARGET, UPPER, LOWER]
+  'AVAIL_MERGE', # list of available revisions for merging
+                 # key = URL@REV, value = [REV ...]
+  'CHILDREN',    # list of children of this branch
+  'SIBLINGS',    # list of siblings of this branch
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch = Fcm::CmBranch->new (
+#     CONFIG  => $config,
+#     URL     => $url,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmBranch class.
+#
+# ARGUMENTS
+#   CONFIG - reference to a Fcm::Config instance
+#   URL    - URL of a branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::CmUrl->new (%args);
+
+  $self->{$_} = undef for (@properties);
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_branch->url_peg;
+#   $cm_branch->url_peg ($url);
+#
+# DESCRIPTION
+#   This method returns/sets the current URL.
+# ------------------------------------------------------------------------------
+
+sub url_peg {
+  my $self = shift;
+
+  if (@_) {
+    if (! $self->{URL} or $_[0] ne $self->{URL}) {
+      # Re-set URL and other essential variables in the SUPER-class
+      $self->SUPER::url_peg (@_);
+
+      # Re-set essential variables
+      $self->{$_} = undef for (@properties);
+    }
+  }
+
+  return $self->{URL};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_branch->create_rev;
+#
+# DESCRIPTION
+#   This method returns the revision at which the branch was created.
+# ------------------------------------------------------------------------------
+
+sub create_rev {
+  my $self = shift;
+
+  if (not $self->{CREATE_REV}) {
+    return unless $self->url_exists ($self->pegrev);
+
+    # Use "svn log" to find out the first revision of the branch
+    my %log = $self->svnlog (STOP_ON_COPY => 1);
+
+    # Look at log in ascending order
+    my $rev   = (sort {$a <=> $b} keys %log) [0];
+    my $paths = $log{$rev}{paths};
+
+    # Get revision when URL is first added to the repository
+    if (exists $paths->{$self->branch_path}) {
+      $self->{CREATE_REV} = $rev if $paths->{$self->branch_path}{action} eq 'A';
+    }
+  }
+
+  return $self->{CREATE_REV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $parent = $cm_branch->parent;
+#
+# DESCRIPTION
+#   This method returns the parent (a Fcm::CmBranch object) of the current
+#   branch.
+# ------------------------------------------------------------------------------
+
+sub parent {
+  my $self = shift;
+
+  if (not $self->{PARENT}) {
+    # Use the log to find out the parent revision
+    my %log = $self->svnlog (REV => $self->create_rev);
+
+    if (exists $log{paths}{$self->branch_path}) {
+      my $path = $log{paths}{$self->branch_path};
+
+      if ($path->{action} eq 'A') {
+        if (exists $path->{'copyfrom-path'}) {
+          # Current branch is copied from somewhere, set the source as the parent
+          my $url = $self->root .  $path->{'copyfrom-path'};
+          my $rev = $path->{'copyfrom-rev'};
+          $self->{PARENT} = Fcm::CmBranch->new (URL => $url . '@' . $rev);
+
+        } else {
+          # Current branch is not copied from somewhere
+          $self->{PARENT} = $self;
+        }
+      }
+    }
+  }
+
+  return $self->{PARENT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_branch->delete_rev;
+#
+# DESCRIPTION
+#   This method returns the revision at which the branch was deleted.
+# ------------------------------------------------------------------------------
+
+sub delete_rev {
+  my $self = shift;
+
+  if (not $self->{DELETE_REV}) {
+    return if $self->url_exists ('HEAD');
+
+    # Container of the current URL
+    (my $dir_url = $self->branch_url) =~ s#/+[^/]+/*$##;
+
+    # Use "svn log" on the container between a revision where the branch exists
+    # and the HEAD
+    my $dir = Fcm::CmUrl->new (URL => $dir_url);
+    my %log = $dir->svnlog (
+      REV => ['HEAD', ($self->pegrev ? $self->pegrev : $self->create_rev)],
+    );
+
+    # Go through the log to see when branch no longer exists
+    for my $rev (sort {$a <=> $b} keys %log) {
+      next unless exists $log{$rev}{paths}{$self->branch_path} and
+                  $log{$rev}{paths}{$self->branch_path}{action} eq 'D';
+
+      $self->{DELETE_REV} = $rev;
+      last;
+    }
+  }
+
+  return $self->{DELETE_REV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->is_child_of ($branch);
+#
+# DESCRIPTION
+#   This method returns true if the current branch is a child of $branch.
+# ------------------------------------------------------------------------------
+
+sub is_child_of {
+  my ($self, $branch) = @_;
+
+  # The trunk cannot be a child branch
+  return if $self->is_trunk;
+
+  # If $branch is a branch, use name of $self to see when it is created
+  if ($branch->is_branch and $self->url =~ m#/r(\d+)_[^/]+/*$#) {
+    my $rev = $1;
+
+    # $self can only be a child if it is copied from a revision > the create
+    # revision of $branch
+    return if $rev < $branch->create_rev;
+  }
+
+  return if $self->parent->url ne $branch->url;
+
+  # If $branch is a branch, ensure that it is created before $self
+  return if $branch->is_branch and $self->create_rev <= $branch->create_rev;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->is_sibling_of ($branch);
+#
+# DESCRIPTION
+#   This method returns true if the current branch is a sibling of $branch.
+# ------------------------------------------------------------------------------
+
+sub is_sibling_of {
+  my ($self, $branch) = @_;
+
+  # The trunk cannot be a sibling branch
+  return if $branch->is_trunk;
+
+  return if $self->parent->url ne $branch->parent->url;
+
+  # If the parent is a branch, ensure they are actually the same branch
+  return if $branch->parent->is_branch and
+            $self->parent->create_rev != $branch->parent->create_rev;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_relatives ($relation);
+#
+# DESCRIPTION
+#   This method sets the $self->{$relation} variable by inspecting the list of
+#   branches at the current revision of the current branch. $relation can be
+#   either "CHILDREN" or "SIBLINGS".
+# ------------------------------------------------------------------------------
+
+sub _get_relatives {
+  my ($self, $relation) = @_;
+
+  my @branch_list = $self->branch_list;
+
+  $self->{$relation} = [];
+
+  # If we are searching for CHILDREN, get list of SIBLINGS, and vice versa
+  my $other = ($relation eq 'CHILDREN' ? 'SIBLINGS' : 'CHILDREN');
+  my %other_list;
+  if ($self->{$other}) {
+    %other_list = map {$_->url, 1} @{ $self->{$other} };
+  }
+
+  for my $u (@branch_list) {
+    # Ignore URL of current branch and its parent
+    next if $u eq $self->url;
+    next if $self->is_branch and $u eq $self->parent->url;
+
+    # Ignore if URL is a branch detected to be another type of relative
+    next if exists $other_list{$u};
+
+    # Construct new Fcm::CmBranch object from branch URL
+    my $url = $u . ($self->pegrev ? '@' . $self->pegrev : '');
+    my $branch = Fcm::CmBranch->new (URL => $url);
+
+    # Test whether $branch is a relative we are looking for
+    if ($relation eq 'CHILDREN') {
+      push @{ $self->{$relation} }, $branch if $branch->is_child_of ($self);
+
+    } else {
+      push @{ $self->{$relation} }, $branch if $branch->is_sibling_of ($self);
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @children = $cm_branch->children;
+#
+# DESCRIPTION
+#   This method returns a list of children (Fcm::CmBranch objects) of the
+#   current branch that exists in the current revision.
+# ------------------------------------------------------------------------------
+
+sub children {
+  my $self = shift;
+
+  $self->_get_relatives ('CHILDREN') if not $self->{CHILDREN};
+
+  return @{ $self->{CHILDREN} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @siblings = $cm_branch->siblings;
+#
+# DESCRIPTION
+#   This method returns a list of siblings (Fcm::CmBranch objects) of the
+#   current branch that exists in the current revision.
+# ------------------------------------------------------------------------------
+
+sub siblings {
+  my $self = shift;
+
+  $self->_get_relatives ('SIBLINGS') if not $self->{SIBLINGS};
+
+  return @{ $self->{SIBLINGS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ancestor = $cm_branch->ancestor ($branch);
+#
+# DESCRIPTION
+#   This method returns the common ancestor (a Fcm::CmBranch object) of a
+#   specified $branch and the current branch. The argument $branch must be a
+#   Fcm::CmBranch object. Both the current branch and $branch are assumed to be
+#   in the same project.
+# ------------------------------------------------------------------------------
+
+sub ancestor {
+  my ($self, $branch) = @_;
+
+  if (not exists $self->{ANCESTOR}{$branch->url_peg}) {
+    if ($self->url_peg eq $branch->url_peg) {
+      $self->{ANCESTOR}{$branch->url_peg} = $self;
+
+    } else {
+      # Get family tree of current branch, from trunk to current branch
+      my @this_family = ($self);
+      while (not $this_family [0]->is_trunk) {
+        unshift @this_family, $this_family [0]->parent;
+      }
+
+      # Get family tree of $branch, from trunk to $branch
+      my @that_family = ($branch);
+      while (not $that_family [0]->is_trunk) {
+        unshift @that_family, $that_family [0]->parent;
+      }
+
+      # Find common ancestor from list of parents
+      my $ancestor = undef;
+
+      while (not $ancestor) {
+        # $this and $that should both start as some revisions on the trunk.
+        # Walk down a generation each time it loops around.
+        my $this = shift @this_family;
+        my $that = shift @that_family;
+
+        if ($this->url eq $that->url) {
+          if ($this->is_trunk or $this->create_rev eq $that->create_rev) {
+            # $this and $that are the same branch
+            if (@this_family and @that_family) {
+              # More generations in both branches, try comparing the next
+              # generations.
+              next;
+
+            } else {
+              # End of lineage in one of the branches, ancestor is at the lower
+              # revision of the current URL.
+              if ($this->pegrev and $that->pegrev) {
+                $ancestor = $this->pegrev < $that->pegrev ? $this : $that;
+
+              } else {
+                $ancestor = $this->pegrev ? $this : $that;
+              }
+            }
+
+          } else {
+            # Despite the same URL, $this and $that are different branches as
+            # they are created at different revisions. The ancestor must be the
+            # parent with the lower revision. (This should not occur at the
+            # start.)
+            $ancestor = $this->parent->pegrev < $that->parent->pegrev
+                        ? $this->parent : $that->parent;
+          }
+
+        } else {
+          # Different URLs, ancestor must be the parent with the lower revision.
+          # (This should not occur at the start.)
+          $ancestor = $this->parent->pegrev < $that->parent->pegrev
+                      ? $this->parent : $that->parent;
+        }
+      }
+
+      $self->{ANCESTOR}{$branch->url_peg} = $ancestor;
+    }
+  }
+
+  return $self->{ANCESTOR}{$branch->url_peg};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($target, $upper, $lower) = $cm_branch->last_merge_from (
+#     $branch, $stop_on_copy,
+#   );
+#
+# DESCRIPTION
+#   This method returns a 3-element list with information of the last merge
+#   into the current branch from a specified $branch. The first element in the
+#   list $target (a Fcm::CmBranch object) is the target at which the merge was
+#   performed. (This can be the current branch or a parent branch up to the
+#   common ancestor with the specified $branch.) The second and third elements,
+#   $upper and $lower, (both Fcm::CmBranch objects), are the upper and lower
+#   ends of the source delta. If there is no merge from $branch into the
+#   current branch from their common ancestor to the current revision, this
+#   method will return an empty list. If $stop_on_copy is specified, it ignores
+#   merges from parents of $branch, and merges into parents of the current
+#   branch.
+# ------------------------------------------------------------------------------
+
+sub last_merge_from {
+  my ($self, $branch, $stop_on_copy) = @_;
+
+  if (not exists $self->{LAST_MERGE}{$branch->url_peg}) {
+    # Get "log" of current branch down to the common ancestor
+    my %log = $self->svnlog (
+      REV => [
+       ($self->pegrev ? $self->pegrev : 'HEAD'),
+       $self->ancestor ($branch)->pegrev,
+      ],
+
+      STOP_ON_COPY => $stop_on_copy,
+    );
+
+    my $cr = $self;
+
+    # Go down the revision log, checking for merge template messages
+    REV: for my $rev (sort {$b <=> $a} keys %log) {
+      # Loop each line of the log message at each revision
+      my @msg = split /\n/, $log{$rev}{msg};
+
+      # Also consider merges into parents of current branch
+      $cr = $cr->parent if ($cr->is_branch and $rev < $cr->create_rev);
+
+      for (@msg) {
+        # Ignore unless log message matches a merge template
+        next unless /Merged into \S+: (\S+) cf\. (\S+)/;
+
+        # Upper $1 and lower $2 ends of the source delta
+        my $u_path = $1;
+        my $l_path = $2;
+
+        # Add the root directory to the paths if necessary
+        $u_path = '/' . $u_path if substr ($u_path, 0, 1) ne '/';
+        $l_path = '/' . $l_path if substr ($l_path, 0, 1) ne '/';
+
+        # Only consider merges with specified branch (and its parent)
+        (my $path = $u_path) =~ s/@(\d+)$//;
+        my $u_rev = $1;
+
+        my $br = $branch;
+        $br    = $br->parent while (
+          $br->is_branch and $u_rev < $br->create_rev and not $stop_on_copy
+        );
+
+        next unless $br->branch_path eq $path;
+
+        # If $br is a parent of branch, ignore those merges with the parent
+        # above the branch point of the current branch
+        next if $br->pegrev and $br->pegrev < $u_rev;
+
+        # Set the return values
+        $self->{LAST_MERGE}{$branch->url_peg} = [
+          Fcm::CmBranch->new (URL => $cr->url . '@' . $rev), # target
+          Fcm::CmBranch->new (URL => $self->root . $u_path), # delta upper
+          Fcm::CmBranch->new (URL => $self->root . $l_path), # delta lower
+        ];
+
+        last REV;
+      }
+    }
+  }
+
+  return (exists $self->{LAST_MERGE}{$branch->url_peg}
+          ? @{ $self->{LAST_MERGE}{$branch->url_peg} } : ());
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @revs = $cm_branch->avail_merge_from ($branch[, $stop_on_copy]);
+#
+# DESCRIPTION
+#   This method returns a list of revisions of a specified $branch, which are
+#   available for merging into the current branch. If $stop_on_copy is
+#   specified, it will not list available merges from the parents of $branch.
+# ------------------------------------------------------------------------------
+
+sub avail_merge_from {
+  my ($self, $branch, $stop_on_copy) = @_;
+
+  if (not exists $self->{AVAIL_MERGE}{$branch->url_peg}) {
+    # Find out the revision of the upper delta at the last merge from $branch
+    # If no merge is found, use revision of common ancestor with $branch
+    my @last_merge = $self->last_merge_from ($branch);
+    my $rev        = $self->ancestor ($branch)->pegrev;
+    $rev           = $last_merge [1]->pegrev
+      if @last_merge and $last_merge [1]->pegrev > $rev;
+
+    # Get the "log" of the $branch down to $rev
+    my %log = $branch->svnlog (
+      REV          => [($branch->pegrev ? $branch->pegrev : 'HEAD'), $rev],
+      STOP_ON_COPY => $stop_on_copy,
+    );
+
+    # No need to include $rev itself, as it has already been merged
+    delete $log{$rev};
+
+    # No need to include the branch create revision
+    delete $log{$branch->create_rev}
+      if $branch->is_branch and exists $log{$branch->create_rev};
+
+    if (keys %log) {
+      # Check whether there is a latest merge from $self into $branch, if so,
+      # all revisions of $branch below that merge should become unavailable
+      my @last_merge_into = $branch->last_merge_from ($self);
+
+      if (@last_merge_into) {
+        for my $rev (keys %log) {
+          delete $log{$rev} if $rev < $last_merge_into [0]->pegrev;
+        }
+      }
+    }
+
+    # Available merges include all revisions above the branch creation revision
+    # or the revision of the last merge
+    $self->{AVAIL_MERGE}{$branch->url_peg} = [sort {$b <=> $a} keys %log];
+  }
+
+  return @{ $self->{AVAIL_MERGE}{$branch->url_peg} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $lower = $cm_branch->base_of_merge_from ($branch);
+#
+# DESCRIPTION
+#   This method returns the lower delta (a Fcm::CmBranch object) for the next
+#   merge from $branch.
+# ------------------------------------------------------------------------------
+
+sub base_of_merge_from {
+  my ($self, $branch) = @_;
+
+  # Base is the ancestor if there is no merge between $self and $branch
+  my $return = $self->ancestor ($branch);
+
+  # Get configuration for the last merge from $branch to $self
+  my @merge_from = $self->last_merge_from ($branch);
+
+  # Use the upper delta of the last merge from $branch, as all revisions below
+  # that have already been merged into the $self
+  $return = $merge_from [1]
+    if @merge_from and $merge_from [1]->pegrev > $return->pegrev;
+
+  # Get configuration for the last merge from $self to $branch
+  my @merge_into = $branch->last_merge_from ($self);
+
+  # Use the upper delta of the last merge from $self, as the current revision
+  # of $branch already contains changes of $self up to the peg revision of the
+  # upper delta
+  $return = $merge_into [1]
+    if @merge_into and $merge_into [0]->pegrev > $return->pegrev;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->allow_subdir_merge_from ($branch, $subdir);
+#
+# DESCRIPTION
+#   This method returns true if a merge from the sub-directory $subdir in
+#   $branch  is allowed - i.e. it does not result in losing changes made in
+#   $branch outside of $subdir.
+# ------------------------------------------------------------------------------
+
+sub allow_subdir_merge_from {
+  my ($self, $branch, $subdir) = @_;
+
+  # Get revision at last merge from $branch or ancestor
+  my @merge_from = $self->last_merge_from ($branch);
+  my $last       = @merge_from ? $merge_from [1] : $self->ancestor ($branch);
+  my $rev        = $last->pegrev;
+
+  if ($branch->pegrev > $rev) {
+    # Inspect log from revision at last merge/ancestor to current revision
+    my %log = $branch->svnlog (REV => [$branch->pegrev, $rev + 1]);
+    my $br  = $branch;
+
+    # Check whether there are changes outside of $subdir
+    for my $rev (sort {$b <=> $a} keys %log) {
+      $br = $br->parent if $br->is_branch and $rev < $br->create_rev;
+
+      for my $path (keys %{ $log{$rev}{paths} }) {
+        next if $path eq $br->branch_path; # Ignore branch creation
+
+        my $p_subdir = substr ($path, length ($br->branch_path) + 1);
+
+        return if $p_subdir !~ m#^$subdir(?:/|$)#;
+      }
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->create (
+#     SRC                  => $src,
+#     TYPE                 => $type,
+#     NAME                 => $name,
+#     [PASSWORD            => $password,]
+#     [REV_FLAG            => $rev_flag,]
+#     [TICKET              => \@tickets,]
+#     [REV                 => $rev,]
+#     [NON_INTERACTIVE     => 1,]
+#     [SVN_NON_INTERACTIVE => 1,]
+#   );
+#
+# DESCRIPTION
+#   This method creates a branch in a Subversion repository.
+#
+# OPTIONS
+#   SRC                 - reference to a Fcm::CmUrl object.
+#   TYPE                - Specify the branch type. See help in "fcm branch" for
+#                         further information.
+#   NAME                - specify the name of the branch.
+#   NON_INTERACTIVE     - Do no interactive prompting, set SVN_NON_INTERACTIVE
+#                         to true automatically.
+#   PASSWORD            - specify the password for commit access.
+#   REV                 - specify the operative revision of the source.
+#   REV_FLAG            - A flag to specify the behaviour of the prefix to the
+#                         branch name. See help in "fcm branch" for further
+#                         information.
+#   SVN_NON_INTERACTIVE - Do no interactive prompting when running svn commit,
+#                         etc. This option is implied by NON_INTERACTIVE.
+#   TICKET              - Specify one or more related tickets for the branch.
+# ------------------------------------------------------------------------------
+
+sub create {
+  my $self = shift;
+  my %args = @_;
+
+  # Options
+  # ----------------------------------------------------------------------------
+  # Compulsory options
+  my $src  = $args{SRC};
+  my $type = $args{TYPE};
+  my $name = $args{NAME};
+
+  # Other options
+  my $rev_flag        = $args{REV_FLAG}        ? $args{REV_FLAG}    : 'NORMAL';
+  my @tickets         = exists $args{TICKET}   ? @{ $args{TICKET} } : ();
+  my $password        = exists $args{PASSWORD} ? $args{PASSWORD}    : undef;
+  my $orev            = exists $args{REV}      ? $args{REV}         : 'HEAD';
+
+  my $non_interactive     = exists $args{NON_INTERACTIVE}
+                            ? $args{NON_INTERACTIVE} : 0;
+  my $svn_non_interactive = exists $args{SVN_NON_INTERACTIVE}
+                            ? $args{SVN_NON_INTERACTIVE} : 0;
+  $svn_non_interactive    = $non_interactive ? 1 : $svn_non_interactive;
+
+  # Analyse the source URL
+  # ----------------------------------------------------------------------------
+  # Create branch from the trunk by default
+  $src->branch ('trunk') if not $src->branch;
+
+  # Remove "sub-directory" part from source URL
+  $src->subdir ('')      if $src->subdir;
+
+  # Remove "peg revision" part because it does not work with "svn copy"
+  $src->pegrev ('')      if $src->pegrev;
+
+  # Find out the URL and the last changed revision of the specified URL at the
+  # specified operative revision
+  my $url = $src->svninfo (FLAG => 'URL', REV => $orev);
+  e_report $src->url, ': cannot determine the operative URL at revision ',
+           $orev, ', abort.' if not $url;
+
+  $src->url ($url) if $url ne $src->url;
+
+  my $rev = $src->svninfo (FLAG => 'Last Changed Rev', REV => $orev);
+  e_report $src->url, ': cannot determine the last changed rev at revision',
+           $orev, ', abort.' if not $rev;
+
+  # Warn user if last changed revision is not the specified revision
+  w_report 'Warning: branch will be created from revision ', $rev,
+           ', i.e. the last changed rev.'
+    unless $orev and $orev eq $rev;
+
+  # Determine the sub-directory names of the branch
+  # ----------------------------------------------------------------------------
+  my @branch_dirs = ('branches');
+
+  # Split branch type flags into a hash table
+  my %type_flags = ();
+  $type_flags{$_} = 1 for ((split /::/, $type));
+
+  # Branch sub-directory 1, development, test or package
+  for my $flag (qw/DEV TEST PKG/) {
+    if (exists $type_flags{$flag}) {
+      push @branch_dirs, lc ($flag);
+      last;
+    }
+  }
+
+  # Branch sub-directory 2, user, share, configuration or release
+  if (exists $type_flags{USER}) {
+    my $userid = getlogin;
+    $userid    = $ENV{LOGNAME} unless $userid;
+    $userid    = $ENV{USER}    unless $userid;
+    die 'Unable to determine your user ID, abort' unless $userid;
+
+    push @branch_dirs, $userid;
+
+  } else {
+    for my $flag (qw/SHARE CONFIG REL/) {
+      if (exists $type_flags{$flag}) {
+        push @branch_dirs, uc (substr $flag, 0, 1) . lc (substr $flag, 1);
+        last;
+      }
+    }
+  }
+
+  # Branch sub-directory 3, branch name
+  # Prefix branch name with revision number/keyword if necessary
+  my $prefix = '';
+  if ($rev_flag ne 'NONE') {
+    $prefix = $rev;
+
+    # Attempt to replace revision number with a revision keyword if necessary
+    $prefix = &get_rev_keyword (
+      REV => $rev,
+      URL => $src->url_peg,
+    ) if $rev_flag eq 'NORMAL';
+
+    # $prefix is still a revision number, add "r" in front of it
+    $prefix = 'r' . $prefix if $prefix eq $rev;
+
+    # Add an underscore before the branch name
+    $prefix.= '_';
+  }
+
+  # Branch name
+  push @branch_dirs, $prefix . $name;
+
+  # Check whether the branch already exists, fail if so
+  # ----------------------------------------------------------------------------
+  # Construct the URL of the branch
+  $self->project_url ($src->project_url);
+  $self->branch  (join ('/', @branch_dirs));
+
+  # Check that branch does not already exists
+  e_report $self->url, ': branch already exists, abort.' if $self->url_exists;
+
+  # Message for the commit log
+  # ----------------------------------------------------------------------------
+  my @message = ('Created ' . $self->branch_path .  ' from ' .
+                 $src->branch_path . '@' . $rev . '.' . "\n");
+
+  # Add related Trac ticket links to commit log if set
+  if (@tickets) {
+    my $ticket_mesg = 'Relates to ticket' . (@tickets > 1 ? 's' : '');
+
+    while (my $ticket = shift @tickets) {
+      $ticket_mesg .= ' #' . $ticket;
+      $ticket_mesg .= (@tickets > 1 ? ',' : ' and') if @tickets >= 1;
+    }
+
+    push @message, $ticket_mesg . ".\n";
+  }
+
+  # Create a temporary file for the commit log message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->auto_mesg (@message);
+  $ci_mesg->ignore_mesg ('A' . ' ' x 4 . $self->url . "\n");
+  my $logfile = $ci_mesg->edit_file (TEMP => 1, BATCH => $non_interactive);
+
+  # Check with the user to see if he/she wants to go ahead
+  # ----------------------------------------------------------------------------
+  if (not $non_interactive) {
+    my $reply = &main::get_input (
+      TITLE   => 'fcm branch',
+      MESSAGE => 'Would you like to go ahead and create this branch?',
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+
+    return unless $reply eq 'y';
+  }
+
+  # Ensure existence of container sub-directories of the branch
+  # ----------------------------------------------------------------------------
+  for my $i (0 .. $#branch_dirs - 1) {
+    my $subdir     = join ('/', @branch_dirs[0 .. $i]);
+    my $subdir_url = Fcm::CmUrl->new (URL => $src->project_url . '/' . $subdir);
+
+    # Check whether each sub-directory of the branch already exists,
+    # if sub-directory does not exist, create it
+    next if $subdir_url->url_exists;
+
+    print 'Creating sub-directory: ', $subdir, "\n";
+
+    my @command = (
+      qw/svn mkdir/,
+      '-m', 'Created ' . $subdir . ' directory.',
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+
+      $subdir_url->url,
+    );
+    &run_command (\@command);
+  }
+
+  # Create the branch
+  # ----------------------------------------------------------------------------
+  {
+    print 'Creating branch ', $self->url, ' ...', "\n";
+    my @command = (
+      qw/svn copy/,
+      '-r', $rev,
+      '-F', $logfile,
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+
+      $src->url, $self->url,
+    );
+    &run_command (\@command);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->delete (
+#     [NON_INTERACTIVE     => 1,]
+#     [PASSWORD            => $password,]
+#     [SVN_NON_INTERACTIVE => 1,]
+#   );
+#
+# DESCRIPTION
+#   This method deletes the current branch from the Subversion repository.
+#
+# OPTIONS
+#   NON_INTERACTIVE     - Do no interactive prompting, set SVN_NON_INTERACTIVE
+#                         to true automatically.
+#   PASSWORD            - specify the password for commit access.
+#   SVN_NON_INTERACTIVE - Do no interactive prompting when running svn commit,
+#                         etc. This option is implied by NON_INTERACTIVE.
+# ------------------------------------------------------------------------------
+
+sub del {
+  my $self = shift;
+  my %args = @_;
+
+  # Options
+  # ----------------------------------------------------------------------------
+  my $password            = exists $args{PASSWORD} ? $args{PASSWORD} : undef;
+  my $non_interactive     = exists $args{NON_INTERACTIVE}
+                            ? $args{NON_INTERACTIVE} : 0;
+  my $svn_non_interactive = exists $args{SVN_NON_INTERACTIVE}
+                            ? $args{SVN_NON_INTERACTIVE} : 0;
+  $svn_non_interactive    = $non_interactive ? 1 : $svn_non_interactive;
+
+  # Ensure URL is a branch
+  # ----------------------------------------------------------------------------
+  e_report $self->url_peg, ': not a branch, abort.' if not $self->is_branch;
+
+  # Message for the commit log
+  # ----------------------------------------------------------------------------
+  my @message = ('Deleted ' . $self->branch_path . '.' . "\n");
+
+  # Create a temporary file for the commit log message
+  my $ci_mesg = Fcm::CmCommitMessage->new ();
+  $ci_mesg->auto_mesg (@message);
+  $ci_mesg->ignore_mesg ('D' . ' ' x 4 . $self->url . "\n");
+  my $logfile = $ci_mesg->edit_file (TEMP => 1, BATCH => $non_interactive);
+
+  # Check with the user to see if he/she wants to go ahead
+  # ----------------------------------------------------------------------------
+  if (not $non_interactive) {
+    my $reply = &main::get_input (
+      TITLE   => 'fcm branch',
+      MESSAGE => 'Would you like to go ahead and delete this branch?',
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+
+    return unless $reply eq 'y';
+  }
+
+  # Delete branch if answer is "y" for "yes"
+  # ----------------------------------------------------------------------------
+  print 'Deleting branch ', $self->url, ' ...', "\n";
+  my @command = (
+    qw/svn delete/,
+    '-F', $logfile,
+    (defined $password    ? ('--password', $password) : ()),
+    ($svn_non_interactive ? '--non-interactive'       : ()),
+
+    $self->url,
+  );
+  &run_command (\@command);
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->display_info (
+#     [SHOW_CHILDREN => 1],
+#     [SHOW_OTHER    => 1]
+#     [SHOW_SIBLINGS => 1]
+#   );
+#
+# DESCRIPTION
+#   This method displays information of the current branch. If SHOW_CHILDREN is
+#   set, it shows information of all current children branches of the current
+#   branch. If SHOW_SIBLINGS is set, it shows information of siblings that have
+#   been merged recently with the current branch. If SHOW_OTHER is set, it shows
+#   information of custom/reverse merges.
+# ------------------------------------------------------------------------------
+
+sub display_info {
+  my $self = shift;
+  my %args = @_;
+
+  # Arguments
+  # ----------------------------------------------------------------------------
+  my $show_children = exists $args{SHOW_CHILDREN} ? $args{SHOW_CHILDREN} : 0;
+  my $show_other    = exists $args{SHOW_OTHER   } ? $args{SHOW_OTHER}    : 0;
+  my $show_siblings = exists $args{SHOW_SIBLINGS} ? $args{SHOW_SIBLINGS} : 0;
+
+  # Useful variables
+  # ----------------------------------------------------------------------------
+  my $separator  = '-' x 80 . "\n";
+  my $separator2 = '  ' . '-' x 78 . "\n";
+
+  # Print "info" as returned by "svn info"
+  # ----------------------------------------------------------------------------
+  for my $key ('URL', 'Repository Root', 'Revision', 'Last Changed Author',
+               'Last Changed Rev', 'Last Changed Date') {
+    print $key, ': ', $self->svninfo (FLAG => $key), "\n"
+      if $self->svninfo (FLAG => $key);
+  }
+
+  if ($self->config->verbose) {
+    # Verbose mode, print log message at last changed revision
+    my %log = $self->svnlog (REV => $self->svninfo (FLAG => 'Last Changed Rev'));
+    my @log = split /\n/, $log{msg};
+    print 'Last Changed Log:', "\n\n", map ({'  ' . $_ . "\n"} @log), "\n";
+  }
+
+  if ($self->is_branch) {
+    # Print create information
+    # --------------------------------------------------------------------------
+    my %log = $self->svnlog (REV => $self->create_rev);
+
+    print $separator;
+    print 'Branch Create Author: ', $log{author}, "\n" if $log{author};
+    print 'Branch Create Rev: ', $self->create_rev, "\n";
+    print 'Branch Create Date: ', &svn_date ($log{date}), "\n";
+
+    if ($self->config->verbose) {
+      # Verbose mode, print log message at last create revision
+      my @log = split /\n/, $log{msg};
+      print 'Branch Create Log:', "\n\n", map ({'  ' . $_ . "\n"} @log), "\n";
+    }
+
+    # Print delete information if branch no longer exists
+    # --------------------------------------------------------------------------
+    print 'Branch Delete Rev: ', $self->delete_rev, "\n" if $self->delete_rev;
+
+    # Report merges into/from the parent
+    # --------------------------------------------------------------------------
+    # Print the URL@REV of the parent branch
+    print $separator, 'Branch Parent: ', $self->parent->url_peg, "\n";
+
+    # Set up a new object for the parent at the current revision
+    # --------------------------------------------------------------------------
+    my $p_url  = $self->parent->url;
+    $p_url    .= '@' . $self->pegrev if $self->pegrev;
+    my $parent = Fcm::CmBranch->new (URL => $p_url);
+
+    if (not $parent->url_exists) {
+      print 'Branch parent deleted.', "\n";
+      return;
+    }
+
+    # Report merges into/from the parent
+    # --------------------------------------------------------------------------
+    print $self->_report_merges ($parent, 'Parent');
+  }
+
+  # Report merges with siblings
+  # ----------------------------------------------------------------------------
+  if ($show_siblings) {
+    # Report number of sibling branches found
+    print $separator, 'Seaching for siblings ... ';
+    my @siblings = $self->siblings;
+    print scalar (@siblings), ' ', (@siblings> 1 ? 'siblings' : 'sibling'),
+          ' found.', "\n";
+
+    # Report branch name and merge information only if there are recent merges
+    my $out = '';
+    for my $sibling (@siblings) {
+      my $string = $self->_report_merges ($sibling, 'Sibling');
+
+      $out .= $separator2 . '  ' . $sibling->url . "\n" . $string if $string;
+    }
+
+    if (@siblings) {
+      if ($out) {
+        print 'Merges with existing siblings:', "\n", $out;
+
+      } else {
+        print 'No merges with existing siblings.', "\n";
+      }
+    }
+  }
+
+  # Report children
+  # ----------------------------------------------------------------------------
+  if ($show_children) {
+    # Report number of child branches found
+    print $separator, 'Seaching for children ... ';
+    my @children = $self->children;
+    print scalar (@children), ' ', (@children > 1 ? 'children' : 'child'),
+          ' found.', "\n";
+
+    # Report children if they exist
+    print 'Current children:', "\n" if @children;
+
+    for my $child (@children) {
+      print $separator2, '  ', $child->url, "\n";
+      print '  Child Create Rev: ', $child->create_rev, "\n";
+      print $self->_report_merges ($child, 'Child');
+    }
+  }
+
+  # Report custom/reverse merges into the branch
+  # ----------------------------------------------------------------------------
+  if ($show_other) {
+    my %log = $self->svnlog (STOP_ON_COPY => 1);
+    my @out;
+
+    # Go down the revision log, checking for merge template messages
+    REV: for my $rev (sort {$b <=> $a} keys %log) {
+      # Loop each line of the log message at each revision
+      my @msg = split /\n/, $log{$rev}{msg};
+
+      for (@msg) {
+        # Ignore unless log message matches a merge template
+        if (/^Reversed r\d+(:\d+)? of \S+$/ or
+            s/^(Custom merge) into \S+(:.+)$/$1$2/) {
+          push @out, ('r' . $rev . ': ' . $_) . "\n";
+        }
+      }
+    }
+
+    print $separator, 'Other merges:', "\n", @out if @out;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_report_merges ($branch, $relation);
+#
+# DESCRIPTION
+#   This method returns a string for displaying merge information with a
+#   branch, the $relation of which can be a Parent, a Sibling or a Child.
+# ------------------------------------------------------------------------------
+
+sub _report_merges {
+  my ($self, $branch, $relation) = @_;
+
+  my $indent    = ($relation eq 'Parent') ? '' : '  ';
+  my $separator = ($relation eq 'Parent') ? ('-' x 80) : ('  ' . '-' x 78);
+  $separator   .= "\n";
+
+  my $return = '';
+
+  # Report last merges into/from the $branch
+  # ----------------------------------------------------------------------------
+  my %merge  = (
+    'Last Merge From ' . $relation . ':'
+    => [$self->last_merge_from ($branch, 1)],
+    'Last Merge Into ' . $relation . ':'
+    => [$branch->last_merge_from ($self, 1)],
+  );
+
+  if ($self->config->verbose) {
+    # Verbose mode, print the log of the merge
+    for my $key (keys %merge) {
+      next if not @{ $merge{$key} };
+
+      # From: target (0) is self, upper delta (1) is $branch
+      # Into: target (0) is $branch, upper delta (1) is self
+      my $t = ($key =~ /From/) ? $self : $branch;
+
+      $return .= $indent . $key . "\n";
+      $return .= $separator . $t->display_svnlog ($merge{$key}[0]->pegrev);
+    }
+
+  } else {
+    # Normal mode, print in simplified form (rREV Parent@REV)
+    for my $key (keys %merge) {
+      next if not @{ $merge{$key} };
+
+      # From: target (0) is self, upper delta (1) is $branch
+      # Into: target (0) is $branch, upper delta (1) is self
+      $return .= $indent . $key . ' r' . $merge{$key}[0]->pegrev . ' ' .
+                 $merge{$key}[1]->path_peg . ' cf. ' .
+                 $merge{$key}[2]->path_peg . "\n";
+    }
+  }
+
+  if ($relation eq 'Sibling') {
+    # For sibling, do not report further if there is no recent merge
+    my @values = values %merge;
+
+    return $return unless (@{ $values[0] } or @{ $values[1] });
+  }
+
+  # Report available merges into/from the $branch
+  # ----------------------------------------------------------------------------
+  my %avail = (
+    'Merges Avail From ' . $relation . ':'
+    => ($self->delete_rev ? [] : [$self->avail_merge_from ($branch, 1)]),
+    'Merges Avail Into ' . $relation . ':'
+    => [$branch->avail_merge_from ($self, 1)],
+  );
+
+  if ($self->config->verbose) {
+    # Verbose mode, print the log of each revision
+    for my $key (keys %avail) {
+      next unless @{ $avail{$key} };
+
+      $return .= $indent . $key . "\n";
+
+      my $s = ($key =~ /From/) ? $branch: $self;
+
+      for my $rev (@{ $avail{$key} }) {
+        $return .= $separator . $s->display_svnlog ($rev);
+      }
+    }
+
+  } else {
+    # Normal mode, print only the revisions
+    for my $key (keys %avail) {
+      next unless @{ $avail{$key} };
+
+      $return .= $indent . $key . ' ' . join (' ', @{ $avail{$key} }) . "\n";
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmCommitMessage.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmCommitMessage.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmCommitMessage.pm	(revision 5166)
@@ -0,0 +1,395 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmCommitMessage
+#
+# DESCRIPTION
+#   This class contains methods to read, write and edit the commit message file
+#   in a working copy.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmCommitMessage;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Spec;
+use File::Temp qw/tempfile/;
+
+# FCM component modules
+use Fcm::Util qw/e_report run_command/;
+
+# Commit log delimiter messages
+my $ignore_line = '--This line, and those below, will be ignored--';
+my $auto_line   = '--This line will be ignored and those below will be ' .
+                  'inserted automatically--';
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ci_mesg = Fcm::CmCommitMessage->new (
+#     CONFIG  => $config,
+#     DIR     => $dir,
+#     BASE    => $base,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmCommitMessageFile class.
+#
+# ARGUMENTS
+#   CONFIG - reference to a Fcm::Config instance
+#   DIR    - directory containing the commit message file
+#   BASE   - base name of the commit message file
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG => (exists $args{CONFIG} ? $args{CONFIG} : &main::cfg),
+    DIR    => (exists $args{DIR}    ? $args{DIR}    : cwd),
+    BASE   => (exists $args{BASE}   ? $args{BASE}   : '#commit_message#'),
+    USER_M => [],
+    AUTO_M => [],
+    IGNORE => [],
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $ci_mesg->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $ci_mesg->dir;
+#   $ci_mesg->dir ($dir);
+#
+# DESCRIPTION
+#   This method returns the directory container of the commit message file. If
+#   an argument is specified, the directory is reset using the value of the
+#   argument. (It does nothing is the directory does not already exist.)
+# ------------------------------------------------------------------------------
+
+sub dir {
+  my $self = shift;
+
+  if (@_) {
+    my $dir = shift;
+    $self->{DIR} = $dir if -d $dir;
+  }
+
+  return $self->{DIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $ci_mesg->base;
+#   $ci_mesg->base ($base);
+#
+# DESCRIPTION
+#   This method returns the base name of the commit message file. If an
+#   argument is specified, the file is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub base {
+  my $self = shift;
+
+  if (@_) {
+    $self->{BASE} = shift;
+  }
+
+  return $self->{BASE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $ci_mesg->file;
+#   $ci_mesg->file ($file);
+#
+# DESCRIPTION
+#   This method returns the full name of the commit message file. If an
+#   argument is specified, the file is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub file {
+  my $self = shift;
+
+  if (@_) {
+    my $file      = shift;
+    $self->{DIR}  = dirname  ($file);
+    $self->{BASE} = basename ($file);
+  }
+
+  return File::Spec->catfile ($self->{DIR}, $self->{BASE});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @mesg = $ci_mesg->user_mesg;
+#   $ci_mesg->user_mesg (@mesg);
+#
+# DESCRIPTION
+#   This method returns the user defined commit message. If an argument is
+#   specified, the message is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub user_mesg {
+  my $self = shift;
+
+  if (@_) {
+    @{ $self->{USER_M} } = @_;
+  }
+
+  return @{ $self->{USER_M} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @mesg = $ci_mesg->auto_mesg;
+#   $ci_mesg->auto_mesg (@mesg);
+#
+# DESCRIPTION
+#   This method returns the automatically inserted commit message. If an
+#   argument is specified, the message is reset using the value of the
+#   argument.
+# ------------------------------------------------------------------------------
+
+sub auto_mesg {
+  my $self = shift;
+
+  if (@_) {
+    @{ $self->{AUTO_M} } = @_;
+  }
+
+  return @{ $self->{AUTO_M} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @mesg = $ci_mesg->ignore_mesg;
+#   $ci_mesg->ignore_mesg (@mesg);
+#
+# DESCRIPTION
+#   This method returns the ignored part of a commit message. If an argument is
+#   specified, the message is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub ignore_mesg {
+  my $self = shift;
+
+  if (@_) {
+    @{ $self->{IGNORE} } = @_;
+  }
+
+  return @{ $self->{IGNORE} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($user, $auto) = $ci_mesg->read_file ();
+#
+# DESCRIPTION
+#   This function reads from the commit log message file. It resets the user
+#   and the automatic messages after reading the file. It returns the message
+#   back in two array references.
+# ------------------------------------------------------------------------------
+
+sub read_file {
+  my $self = shift;
+
+  my @user = ();
+  my @auto = ();
+  my $file = $self->file;
+
+  if (-r $file) {
+    open FILE, '<', $file or croak 'Cannot open ', $file, '(', $!, '), abort';
+
+    my $in_auto = 0;
+    while (<FILE>) {
+      last if index ($_, $ignore_line) == 0; # ignore after the ignore delimiter
+
+      if (index ($_, $auto_line) == 0) {
+        # Beginning of the automatically inserted message delimiter
+        $in_auto = 1;
+        next;
+      }
+
+      if ($in_auto) {
+        push @auto, $_;
+
+      } else {
+        push @user, $_;
+      }
+    }
+
+    close FILE;
+
+    $self->user_mesg (@user);
+    $self->auto_mesg (@auto);
+  }
+
+  return (\@user, \@auto);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ci_mesg->write_file ();
+#
+# DESCRIPTION
+#   This function writes to the commit log message file based on the content of
+#   the user defined message, and the automatically inserted message.
+# ------------------------------------------------------------------------------
+
+sub write_file {
+  my $self = shift;
+  my %args = @_;
+
+  my @user = $self->user_mesg;
+  my @auto = $self->auto_mesg;
+  my $file = $self->file;
+
+  open FILE, '>', $file or die 'Cannot open ', $file, '(', $!, '), abort';
+  print FILE @user;
+  print FILE $auto_line, "\n", @auto if @auto;
+  close FILE or croak 'Cannot close ', $file, '(', $!, '), abort';
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $ci_mesg->edit_file ([TEMP => 1,] [BATCH => 1,]);
+#
+# DESCRIPTION
+#   This function normally triggers an editor for editing the commit message.
+#   If TEMP is set, it edits a temporary file. Otherwise, it edits the current
+#   commit message file. It resets the user defined message on success. Returns
+#   the name of the commit log file. Do not start the editor if BATCH is set.
+# ------------------------------------------------------------------------------
+
+sub edit_file {
+  my $self  = shift;
+  my %args  = @_;
+  my $temp  = exists $args{TEMP}  ? $args{TEMP}  : 0;
+  my $batch = exists $args{BATCH} ? $args{BATCH} : 0;
+
+  my @user   = $self->user_mesg;
+  my @auto   = $self->auto_mesg;
+  my @ignore = $self->ignore_mesg;
+  my $file   = $self->file;
+
+  if ($temp) {
+    my $fh;
+    ($fh, $file) = tempfile (SUFFIX => ".fcm", UNLINK => 1);
+    close $fh;
+  }
+
+  # Add original or code driven message and status information to the file
+  my $select = select;
+  open FILE, '>', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  select FILE;
+
+  print @user;
+  print (@auto || @user ? '' : "\n");
+  print $auto_line, "\n", @auto, "\n" if @auto;
+  print $ignore_line, "\n\n";
+  print @ignore if @ignore;
+
+  close FILE or die 'Cannot close ', $file, ' (', $!, '), abort';
+  select $select;
+
+  if (not $batch) {
+    # Select editor
+    my $editor = 'nedit';
+    
+    if ($ENV{'SVN_EDITOR'}) {
+      $editor = $ENV{'SVN_EDITOR'};
+
+    } elsif ($ENV{'VISUAL'}) {
+      $editor = $ENV{'VISUAL'};
+
+    } elsif ($ENV{'EDITOR'}) {
+      $editor = $ENV{'EDITOR'};
+    }
+
+    # Execute command to start the editor
+    print 'Starting ', $editor, ' to edit commit message ...', "\n";
+    &run_command ([split (/\s+/, $editor), $file]);
+  }
+
+  # Read the edited file, and extract user log message from it
+  open FILE, '<', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  my (@log);
+  my $in_auto    = 0;
+  my $in_ignored = 0;
+
+  while (<FILE>) {
+    if (index ($_, $auto_line) == 0) {
+      $in_auto = 1;
+
+    } elsif (index ($_, $ignore_line) == 0) {
+      $in_ignored = 1;
+      last;
+
+    } else {
+      next if $in_auto;
+      push @log, $_;
+    }
+  }
+
+  close FILE;
+
+  # Ensure auto and ignored lines are not altered
+  e_report 'Error: the line "', $auto_line, '" has been altered, abort.'
+    if @auto and not $in_auto;
+
+  e_report 'Error: the line "', $ignore_line, '" has been altered, abort.'
+    if not $in_ignored;
+
+  # Check for empty commit log
+  e_report 'Error: log message unchanged or not specified, abort.'
+    if join (' ', (@log, @auto)) =~ /^\s*$/;
+
+  # Echo the commit message to standard output
+  my $separator = '-' x 80 . "\n";
+  print 'Commit message is as follows:', "\n";
+  print $separator, @log, @auto, $ignore_line, "\n", @ignore, $separator;
+
+  open FILE, '>', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  print FILE @log, @auto;
+  close FILE or croak 'Cannot close ', $file, ' (', $!, '), abort';
+
+  # Reset the array for the user specified log message
+  $self->user_mesg (@log);
+
+  return $file;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmUrl.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmUrl.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmUrl.pm	(revision 5166)
@@ -0,0 +1,1138 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmUrl
+#
+# DESCRIPTION
+#   This class contains methods for manipulating a Subversion URL in a standard
+#   FCM project.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmUrl;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+use HTTP::Date;
+use XML::DOM;
+
+# FCM component modules
+use Fcm::Util qw/run_command svn_date get_browser_url/;
+
+# Revision pattern
+my $rev_pattern = '\d+|HEAD|BASE|COMMITTED|PREV|\{.+\}';
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_url = Fcm::CmUrl->new (
+#     CONFIG  => $config,
+#     URL     => $url,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmUrl class.
+#
+# ARGUMENTS
+#   CONFIG - reference to a Fcm::Config instance
+#   URL    - URL of a branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG      => (exists $args{CONFIG} ? $args{CONFIG} : &main::cfg),
+    URL         => (exists $args{URL}    ? $args{URL}    : ''),
+    ANALYSED    => undef,
+    PROJECT     => undef,
+    BRANCH      => undef,
+    SUBDIR      => undef,
+    PEGREV      => undef,
+    LIST        => undef,
+    RLIST       => undef,
+    LOG         => undef,
+    LOG_RANGE   => undef,
+    INFO        => undef,
+    BRANCH_LIST => undef, # list of branches in current project
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $cm_url->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->url_peg;
+#   $cm_url->url_peg ($url);
+#
+# DESCRIPTION
+#   This method returns/sets the current URL@PEG.
+# ------------------------------------------------------------------------------
+
+sub url_peg {
+  my $self = shift;
+
+  if (@_) {
+    if (! $self->{URL} or $_[0] ne $self->{URL}) {
+      # Re-set URL
+      $self->{URL} = shift;
+
+      # Re-set essential variables
+      $self->{$_}  = undef for (qw/ANALYSED RLIST LIST INFO LOG LOG_RANGE/);
+    }
+  }
+
+  return $self->{URL};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_url ();
+#
+# DESCRIPTION
+#   Returns true if current url is a valid Subversion URL.
+# ------------------------------------------------------------------------------
+
+sub is_url {
+  my $self = shift;
+
+  # This should handle URL beginning with svn://, http:// and svn+ssh://
+  return ($self->url_peg =~ m#^[\+\w]+://#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->url_exists ([$rev]);
+#
+# DESCRIPTION
+#   Returns true if current url exists (at operative revision $rev) in a
+#   Subversion repository.
+# ------------------------------------------------------------------------------
+
+sub url_exists {
+  my ($self, $rev) = @_;
+
+  my $exists = $self->svnlist (REV => $rev);
+
+  return defined ($exists);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $cm_url->svninfo ([FLAG => $flag], [REV => $rev]);
+#
+# DESCRIPTION
+#   Returns the value of $flag, where $flag is a field returned by "svn info".
+#   (If $flag is not set, default to "URL".) Otherwise returns an empty string.
+#   If REV is specified, it will be used as the operative revision.
+# ------------------------------------------------------------------------------
+
+sub svninfo {
+  my $self = shift;
+  my %args = @_;
+
+  my $flag = exists $args{FLAG} ? $args{FLAG} : 'URL';
+  my $rev  = exists $args{REV}  ? $args{REV}  : undef;
+
+  $rev = ($self->pegrev ? $self->pegrev : 'HEAD') if not $rev;
+
+  return if not $self->is_url;
+
+  # Get "info" for the specified revision if necessary
+  if (not exists $self->{INFO}{$rev}) {
+    # Invoke "svn info" command
+    my @info = &run_command (
+      [qw/svn info -r/, $rev, $self->url_peg],
+      PRINT   => $self->config->verbose > 2,
+      METHOD  => 'qx',
+      DEVNULL => 1,
+      ERROR   => 'ignore',
+    );
+
+    # Store selected information
+    for (@info) {
+      chomp;
+
+      if (/^(.+?):\s*(.+)$/) {
+        $self->{INFO}{$rev}{$1} = $2;
+      }
+    }
+  }
+
+  my $return = exists $self->{INFO}{$rev}{$flag}
+               ? $self->{INFO}{$rev}{$flag} : undef;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %logs = $cm_url->svnlog (
+#     [REV          => $rev,]
+#     [REV          => \@revs,] # reference to a 2-element array
+#     [STOP_ON_COPY => 1,]
+#   );
+#
+# DESCRIPTION
+#   Returns the logs for the current URL. If REV is a range of revisions or not
+#   specified, return a hash where the keys are revision numbers and the values
+#   are the entries (which are hash references). If a single REV is specified,
+#   return the entry (a hash reference) at the specified REV. Each entry in the
+#   returned list is a hash reference, with the following structure:
+#
+#   $entry = {
+#     author => $author,              # the commit author
+#     date   => $date,                # the commit date (in seconds since epoch)
+#     msg    => $msg,                 # the log message
+#     paths  => {                     # list of changed paths
+#       $path1  => {                  # a changed path
+#         copyfrom-path => $frompath, # copy-from-path
+#         copyfrom-rev  => $fromrev,  # copy-from-revision
+#         action        => $action,   # action status code
+#       },
+#       ...     => { ... },           # ... more changed paths ...
+#     },
+#   }
+# ------------------------------------------------------------------------------
+
+sub svnlog {
+  my $self = shift;
+  my %args = @_;
+
+  my $stop_on_copy  = exists $args{STOP_ON_COPY} ? $args{STOP_ON_COPY} : 0;
+  my $rev_arg       = exists $args{REV}          ? $args{REV}          : 0;
+
+  my @revs;
+
+  # Get revision options
+  # ----------------------------------------------------------------------------
+  if ($rev_arg) {
+    if (ref ($rev_arg)) {
+      # Revsion option is an array, a range of revisions specified?
+      ($revs [0], $revs [1]) = @$rev_arg;
+
+    } else {
+      # A single revision specified
+      $revs [0] = $rev_arg;
+    }
+
+    # Expand 'HEAD' revision
+    for my $rev (@revs) {
+      next unless uc ($rev) eq 'HEAD';
+      $rev = $self->svninfo (FLAG => 'Revision', REV => 'HEAD');
+    }
+
+  } else {
+    # No revision option specified, get log for all revisions
+    $revs [0] = $self->svninfo (FLAG => 'Revision');
+    $revs [1] = 1;
+  }
+
+  $revs [1] = $revs [0] if not $revs [1];
+  @revs     = sort {$b <=> $a} @revs;
+
+  # Check whether a "svn log" run is necessary
+  # ----------------------------------------------------------------------------
+  my $need_update = ! ($revs [0] == $revs [1] and exists $self->{LOG}{$revs [0]});
+  my @ranges      = @revs;
+  if ($need_update and $self->{LOG_RANGE}) {
+    my %log_range = %{ $self->{LOG_RANGE} };
+
+    if ($stop_on_copy) {
+      $ranges [1] = $log_range{UPPER} if $ranges [1] >= $log_range{LOWER_SOC};
+
+    } else {
+      $ranges [1] = $log_range{UPPER} if $ranges [1] >= $log_range{LOWER};
+    }
+  }
+
+  $need_update = 0 if $ranges [0] < $ranges [1];
+
+  if ($need_update) {
+    # Invoke "svn log" command for all revisions of the current branch
+    # --------------------------------------------------------------------------
+    my @command = (
+      qw/svn log --xml -v/, ($stop_on_copy ? '--stop-on-copy' : ()),
+      '-r' . join (':', @ranges),
+      $self->url,
+    );
+
+    my $rc;
+    my @xml = &run_command (
+      \@command,
+      PRINT   => $self->config->verbose > 2,
+      METHOD  => 'qx',
+      DEVNULL => 1,
+      ERROR   => 'ignore',
+      RC      => \$rc,
+    );
+
+    # Parse the XML
+    # --------------------------------------------------------------------------
+    if (not $rc) {
+      my $parser = XML::DOM::Parser->new;
+      my $doc    = $parser->parse (join ('', @xml));
+
+      my $entry_list = $doc->getElementsByTagName ('logentry');
+
+      # Record the author, date, message and path change for each revision
+      for my $i (0 .. $entry_list->getLength - 1) {
+        # Select current entry from node list
+        my $entry = $entry_list->item ($i);
+        my %this = ();
+
+        # Revision is an attribute of the entry node
+        my $rev   = $entry->getAttributeNode ('revision')->getValue;
+
+        # Author, date and log message are children elements of the entry node
+        for my $key (qw/author date msg/) {
+          # Get data of each node, also convert date to seconds since epoch
+          my $node    = $entry->getElementsByTagName ($key)->item (0);
+          my $data    = ($node and $node->getFirstChild)
+                        ? $node->getFirstChild->getData : '';
+          $this{$key} = ($key eq 'date' ? str2time ($data) : $data);
+        }
+
+        # Path nodes are grand children elements of the entry node
+        my $paths = $entry->getElementsByTagName ('path');
+
+        for my $p (0 .. $paths->getLength - 1) {
+          # Select current path node from node list
+          my $node = $paths->item ($p);
+
+          # Get data from the path node
+          my $path = $node->getFirstChild->getData;
+          $this{paths}{$path} = {};
+
+          # Action, copyfrom-path and copyfrom-rev are attributes of path nodes
+          for my $key (qw/action copyfrom-path copyfrom-rev/) {
+            next unless $node->getAttributeNode ($key); # ensure attribute exists
+
+            $this{paths}{$path}{$key} = $node->getAttributeNode ($key)->getValue;
+          }
+        }
+
+        $self->{LOG}{$rev} = \%this;
+      }
+    }
+
+    # Update the range cache
+    # --------------------------------------------------------------------------
+    # Upper end of the range
+    $self->{LOG_RANGE}{UPPER} = $ranges [0]
+      if ! $self->{LOG_RANGE}{UPPER} or $ranges [0] > $self->{LOG_RANGE}{UPPER};
+
+    # Lower end of the range, need to take into account the stop-on-copy option
+    if ($stop_on_copy) {
+      # Lower end of the range with stop-on-copy option
+      $self->{LOG_RANGE}{LOWER_SOC} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER_SOC} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER_SOC};
+
+      my $low = (sort {$a <=> $b} keys %{ $self->{LOG} }) [0];
+      $self->{LOG_RANGE}{LOWER} = $low
+        if ! $self->{LOG_RANGE}{LOWER} or $low < $self->{LOG_RANGE}{LOWER};
+
+    } else {
+      # Lower end of the range without the stop-on-copy option
+      $self->{LOG_RANGE}{LOWER} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER};
+
+      $self->{LOG_RANGE}{LOWER_SOC} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER_SOC} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER_SOC};
+    }
+  }
+
+  my %return = ();
+
+  if (! $rev_arg or ref ($rev_arg)) {
+    # REV is an array, return log entries if they are within range
+    for my $rev (sort {$b <=> $a} keys %{ $self->{LOG} }) {
+      next if $rev > $revs [0] or $revs [1] > $rev;
+
+      $return{$rev} = $self->{LOG}{$rev};
+
+      if ($stop_on_copy) {
+        last if exists $self->{LOG}{$rev}{paths}{$self->branch_path} and
+           $self->{LOG}{$rev}{paths}{$self->branch_path}{action} eq 'A';
+      }
+    }
+
+  } else {
+    # REV is a scalar, return log of the specified revision if it exists
+    %return = %{ $self->{LOG}{$revs [0]} } if exists $self->{LOG}{$revs [0]};
+  }
+
+  return %return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $cm_branch->display_svnlog ($rev, [$wiki]);
+#
+# DESCRIPTION
+#   This method returns a string for displaying the log of the current branch
+#   at a $rev. If $wiki is set, returns a string for displaying in a Trac wiki
+#   table.  The value of $wiki should be the Subversion URL of a FCM project
+#   associated with the intended Trac system.
+# ------------------------------------------------------------------------------
+
+sub display_svnlog {
+  my ($self, $rev, $wiki) = @_;
+  my $return = '';
+
+  my %log = $self->svnlog (REV => $rev);
+
+  if ($wiki) {
+    # Output in Trac wiki format
+    # --------------------------------------------------------------------------
+    $return .= '|| ' . &svn_date ($log{date}) . ' || ' . $log{author} . ' || ';
+
+    my $trac_url = &get_browser_url (URL => $self->url);
+
+    # Get list of tickets from log
+    my @tickets;
+    while ($log{msg} =~ /(?:#|ticket:)(\d+)/g) {
+      push @tickets, $1;
+    }
+    @tickets = sort {$a <=> $b} @tickets;
+
+    if ($trac_url =~ m#^$wiki(?:/*|$)#) {
+      # URL is in the specified $wiki, use Trac link
+      $return .= '[' . $rev . '] ||';
+
+      for my $ticket (@tickets) {
+        $return .= ' #' . $ticket;
+      }
+
+      $return .= ' ||';
+
+    } else {
+      # URL is not in the specified $wiki, use full URL
+      my $rev_url = $trac_url;
+      $rev_url    =~ s#/browser/.*$##;
+      $rev_url   .= '/changeset/' . $rev;
+      $return    .= '[' . $rev_url . ' ' . $rev . '] ||';
+
+      my $ticket_url = $trac_url;
+      $ticket_url    =~ s#/browser/.*$#/ticket/#;
+
+      for my $ticket (@tickets) {
+        $return .= ' [' . $ticket_url . $ticket . ' ' . $ticket . ']';
+      }
+
+      $return .= ' ||';
+    }
+
+  } else {
+    # Output in plain text format
+    # --------------------------------------------------------------------------
+    my @msg  = split /\n/, $log{msg};
+    my $line = (@msg > 1 ? ' lines' : ' line');
+
+    $return .= join (
+      ' | ',
+      ('r' . $rev, $log{author}, &svn_date ($log{date}), scalar (@msg) . $line),
+    );
+    $return .= "\n\n";
+    $return .= $log{msg};
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @list = $cm_url->svnlist ([REV => $rev], [RECURSIVE => 1]);
+#
+# DESCRIPTION
+#   The method returns a list of paths as returned by "svn list". If RECURSIVE
+#   is set, "svn list" is invoked with the "-R" option.
+# ------------------------------------------------------------------------------
+
+sub svnlist {
+  my $self = shift;
+  my %args = @_;
+
+  my $recursive = exists $args{RECURSIVE} ? $args{RECURSIVE} : 0;
+  my $rev       = exists $args{REV}       ? $args{REV}       : undef;
+  my $key       = $recursive ? 'RLIST' : 'LIST';
+
+  # Find out last changed revision of the current URL
+  $rev = $self->svninfo (FLAG => 'Last Changed Rev', REV => $rev);
+  return () if not $rev;
+
+  # Get directory listing for the current URL at the last changed revision
+  if (not exists $self->{$key}{$rev}) {
+    my $rc;
+
+    my @list = map {chomp; $_} &run_command (
+      [qw/svn list -r/, $rev, ($recursive ? '-R' : ()), $self->url_peg],
+      METHOD => 'qx', ERROR => 'ignore', DEVNULL => 1, RC => \$rc,
+    );
+
+    $self->{$key}{$rev} = $rc ? undef : \@list;
+  }
+
+  return (defined ($self->{$key}{$rev}) ? @{ $self->{$key}{$rev} } : undef);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @list = $cm_url->branch_list ($rev);
+#
+# DESCRIPTION
+#   The method returns a list of branches in the current project, assuming the
+#   FCM naming convention. If $rev if specified, it returns the list of
+#   branches at $rev.
+# ------------------------------------------------------------------------------
+
+sub branch_list {
+  my ($self, $rev) = @_;
+
+  # Current URL must be a valid FCM project
+  return if not $self->project;
+
+  # Find out last changed revision of the current URL
+  $rev = $self->svninfo (FLAG => 'Revision', REV => $rev);
+  return () if not $rev;
+
+  if (not exists $self->{BRANCH_LIST}{$rev}) {
+    $self->{BRANCH_LIST}{$rev} = [];
+
+    # Get URL of the project "branches/" sub-directory
+    my $url = Fcm::CmUrl->new (URL => $self->project_url . '/branches');
+
+    # List three levels underneath "branches/"
+    # First level, i.e. dev, test, pkg, etc
+    my @list1 = map {$url->url . '/' . $_} $url->svnlist (REV => $rev);
+    @list1    = grep m#/$#, @list1;
+
+    # Second level, i.e. user name, Shared, Rel or Config
+    my @list2;
+    for (@list1) {
+      my $u    = Fcm::CmUrl->new (URL => $_);
+      my @list = $u->svnlist (REV => $rev);
+
+      push @list2, map {$u->url . $_} @list;
+    }
+
+    # Third level, branch name
+    for (@list2) {
+      my $u    = Fcm::CmUrl->new (URL => $_);
+      my @list = map {s#/*$##; $_} $u->svnlist (REV => $rev);
+
+      push @{ $self->{BRANCH_LIST}{$rev} }, map {$u->url . $_} @list;
+    }
+  }
+
+  return @{ $self->{BRANCH_LIST}{$rev} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_analyse_url ();
+#
+# DESCRIPTION
+#   The method analyses the current URL, breaking it up into the project
+#   (substring of URL up to the slash before "trunk", "branches" or "tags"),
+#   branch name ("trunk", "branches/<type>/<id>/<name>" or "tags/<name>") and
+#   the sub-directory below the top of the project sub-tree. It re-sets the
+#   corresponding interal variables.
+# ------------------------------------------------------------------------------
+
+sub _analyse_url {
+  my $self = shift;
+  my ($url, $project, $branch, $subdir, $pegrev);
+
+  # Check that URL is set
+  $url    = $self->url_peg;
+  return if not $url;
+  return if not $self->is_url;
+
+  # Extract from URL the peg revision
+  $pegrev = $1 if $url =~ s/@($rev_pattern)$//i;
+
+  if ($url =~ m#^(.*?)/+(trunk|branches|tags)(?:/+(.*))?/*$#) {
+    # URL is under the "trunk", a branch or a tag
+    $project                 = $1;
+    my ($branch_id, $remain) = ($2, $3);
+
+    $remain = '' if not defined $remain;
+
+    if ($branch_id eq 'trunk') {
+      # URL under the "trunk"
+      $branch = 'trunk';
+
+    } else {
+      # URL under a branch or a tag
+      $branch = $branch_id;
+
+      # Assume "3 sub-directories", FCM branch naming convention
+      for (1 .. 3) {
+        if ($remain =~ s#^([^/]+)(?:/+|$)##) {
+          $branch .=  '/' . $1;
+
+        } else {
+          $branch = undef;
+          last;
+        }
+      }
+    }
+
+    $subdir = $remain ? $remain : '' if $branch;
+
+  } else {
+    # URL is at some level above the "trunk", a branch or a tag
+    # Use "svn ls" to determine whether it is a project URL
+    my @list = $self->svnlist (REV => ($pegrev ? $pegrev : 'HEAD'));
+    my %lines = map {chomp $_; ($_, 1)} @list;
+
+    # A project URL should have the "trunk", "branches" and "tags" directories
+    ($project = $url) =~ s#/*$##
+      if $lines{'trunk/'} and $lines{'branches/'} and $lines{'tags/'};
+  }
+
+  $self->{PROJECT}  = $project;
+  $self->{BRANCH}   = $branch;
+  $self->{SUBDIR}   = $subdir;
+  $self->{PEGREV}   = $pegrev;
+  $self->{ANALYSED} = 1;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->root ();
+#
+# DESCRIPTION
+#   The method returns the repository root of the current URL.
+# ------------------------------------------------------------------------------
+
+sub root {
+  my $self = shift;
+
+  return $self->svninfo (FLAG => 'Repository Root');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->project_url_peg ();
+#   $cm_url->project_url_peg ($url);
+#
+# DESCRIPTION
+#   The method returns the URL@PEG of the "project" part of the current URL. If
+#   an argument is specified, the URL of the "project" part and the peg
+#   revision of the current URL are re-set.
+# ------------------------------------------------------------------------------
+
+sub project_url_peg {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project_url_peg or $url ne $self->project_url_peg) {
+      my $pegrev = ($url =~ s/@($rev_pattern)$//i) ? $1 : '';
+
+      $url .= '/' . $self->branch if $self->branch;
+      $url .= '/' . $self->subdir if $self->subdir;
+      $url .= '@' . $pegrev       if $pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PROJECT} . ($self->pegrev ? '@' . $self->pegrev : '');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->project_url ();
+#   $cm_url->project_url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL of the "project" part of the current URL. If an
+#   argument is specified, the URL of the "project" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub project_url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->project_url or $url ne $self->project_url) {
+      $url .= '/' . $self->branch if $self->branch;
+      $url .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PROJECT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->project_path ();
+#   $cm_url->project_path ($path);
+#
+# DESCRIPTION
+#   The method returns the path of the "project" part of the current URL. If an
+#   argument is specified, the path of the "project" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub project_path {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project_path or $path ne $self->project_path) {
+      $path .= '/' . $self->branch if $self->branch;
+      $path .= '/' . $self->subdir if $self->subdir;
+
+      $self->path ($path);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->{PROJECT}, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $cm_url->project ();
+#   $cm_url->project ($name);
+#
+# DESCRIPTION
+#   The method returns the basename of the "project" part of the current URL.
+#   If an argument is specified, the basename of the "project" part of the
+#   current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub project {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project or $name ne $self->project) {
+      my $url = '';
+      if ($self->project) {
+        $url =  $self->project;
+        $url =~ s#/[^/]+$##;
+
+      } else {
+        $url =  $self->root;
+      }
+
+      $url .=  '/' . $name;
+      $url .=  '/' . $self->branch if $self->branch;
+      $url .=  '/' . $self->subdir if $self->subdir;
+      $url .=  '@' . $self->pegrev if $self->pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  my $name = $self->{PROJECT};
+  $name =~ s#^.*/([^/]+)$#$1# if $name;
+
+  return $name;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->branch_url_peg ();
+#   $cm_url->branch_url_peg ($url);
+#
+# DESCRIPTION
+#   The method returns the URL@PEG of the "branch" part of the current URL. If
+#   an argument is specified, the URL@PEG of the "branch" part of the current
+#   URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_url_peg {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_url_peg or $url ne $self->branch_url_peg) {
+      my $pegrev = ($url =~ s/@($rev_pattern)$//i) ? $1 : '';
+
+      $url .= '/' . $self->subdir if $self->subdir;
+      $url .= '@' . $pegrev       if $pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_url . '/' . $self->branch .
+         ($self->pegrev ? '@' . $self->pegrev : '');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->branch_url ();
+#   $cm_url->branch_url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL of the "branch" part of the current URL. If an
+#   argument is specified, the URL of the "branch" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_url or $url ne $self->branch_url) {
+      $url .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_url . '/' . $self->branch;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->branch_path ();
+#   $cm_url->branch_path ($path);
+#
+# DESCRIPTION
+#   The method returns the path of the "branch" part of the current URL. If an
+#   argument is specified, the path of the "branch" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_path {
+  my $self = shift;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_path or $path ne $self->branch_path) {
+      $path .= '/' . $self->subdir if $self->subdir;
+
+      $self->path ($path);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_path . '/' . $self->branch;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch = $cm_url->branch ();
+#   $cm_url->branch ($branch);
+#
+# DESCRIPTION
+#   The method returns the "branch" part of the current URL. If an argument is
+#   specified, the "branch" part of the current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub branch {
+  my $self = shift;
+
+  if (@_) {
+    my $branch = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch or $branch ne $self->branch) {
+      my $url = $self->project_url;
+      $url   .= '/' . $branch;
+      $url   .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{BRANCH};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_trunk ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) the trunk.
+# ------------------------------------------------------------------------------
+
+sub is_trunk {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch eq 'trunk');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_branch ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) a branch.
+# ------------------------------------------------------------------------------
+
+sub is_branch {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch =~ m#^branches/#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_tag ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) a tag.
+# ------------------------------------------------------------------------------
+
+sub is_tag {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch =~ m#^tags/#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $subdir = $cm_url->subdir ();
+#   $cm_url->subdir ($subdir);
+#
+# DESCRIPTION
+#   The method returns the "subdir" part of the current URL. If an argument is
+#   specified, the "subdir" part of the current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub subdir {
+  my $self = shift;
+
+  if (@_) {
+    my $subdir = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->subdir or $subdir ne $self->subdir) {
+      my $url = $self->project_url;
+      $url   .= '/' . $self->branch if $self->branch;
+      $url   .= '/' . $subdir if $subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{SUBDIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->url ();
+#   $cm_url->url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL without the "peg revision" part. If an argument
+#   is specified, the URL is re-set without modifying the "peg revision" part.
+# ------------------------------------------------------------------------------
+
+sub url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url    =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL if necessary
+    if (! $self->url or $url ne $self->url) {
+      $self->url_peg ($url . ($self->pegrev ? '@' . $self->pegrev : ''));
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  (my $url = $self->url_peg) =~ s/@($rev_pattern)$//i;
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->path ();
+#   $cm_url->path ($path);
+#
+# DESCRIPTION
+#   The method returns the "path" part of the URL (i.e. URL without the
+#   "root" part). If an argument is specified, the "path" part of the URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub path {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+    $path    =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->path or $path ne $self->path) {
+      my $url = ($root . (substr ($path, 0, 1) eq '/' ? '' : '/') . $path);
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->url, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->path_peg ();
+#   $cm_url->path_peg ($path);
+#
+# DESCRIPTION
+#   The method returns the PATH@PEG part of the URL (i.e. URL without the
+#   "root" part). If an argument is specified, the PATH@PEG part of the URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub path_peg {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->path_peg or $path ne $self->path_peg) {
+      my $url = ($root . (substr ($path, 0, 1) eq '/' ? '' : '/') . $path);
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->url_peg, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_url->pegrev ();
+#   $cm_url->pegrev ($rev);
+#
+# DESCRIPTION
+#   The method returns the "peg revision" part of the current URL. If an
+#   argument is specified, the "peg revision" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub pegrev {
+  my $self = shift;
+
+  if (@_) {
+    my $pegrev = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->pegrev or $pegrev ne $self->pegrev) {
+      $self->url_peg ($self->url . ($pegrev ? '@' . $pegrev : ''));
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PEGREV};
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Config.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Config.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Config.pm	(revision 5166)
@@ -0,0 +1,735 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Config
+#
+# DESCRIPTION
+#   This is a class for reading and processing central and user configuration
+#   settings for FCM.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Config;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use File::Basename;
+use File::Spec::Functions;
+use FindBin;
+use POSIX qw/setlocale LC_ALL/;
+
+# FCM component modules
+use Fcm::CfgFile;
+
+# Other declarations:
+sub _get_hash_value;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = Fcm::Config->new (VERBOSE => $verbose);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Config class.
+#
+# ARGUMENTS
+#   VERBOSE - Set the verbose level of diagnostic output
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  # Ensure that all subsequent Subversion output is in UK English
+  if (setlocale (LC_ALL, 'en_GB')) {
+    $ENV{LANG} = 'en_GB';
+  }
+
+  # Location of the central/user configuration file
+  my $cntl_config = catfile (dirname ($FindBin::Bin), 'etc', 'fcm.cfg');
+  $cntl_config    = catfile $FindBin::Bin, 'fcm.cfg' unless -r $cntl_config;
+  my $user_config = exists $ENV{HOME} ? catfile $ENV{HOME}, '.fcm' : '';
+
+  # Verbose mode
+  my $verbose     = exists $ENV{FCM_VERBOSE} ? $ENV{FCM_VERBOSE} : 1;
+
+  my $self = {
+    CNTL_CONFIG => -r $cntl_config ? $cntl_config : '',
+    USER_CONFIG => -r $user_config ? $user_config : '',
+    VERBOSE     => exists $args{VERBOSE} ? $args{VERBOSE} : $verbose,
+    VARIABLE    => {},
+
+    # Primary settings
+    SETTING => {
+      # Release identifier/version
+      RELEASE  => '1.2',
+
+      # Location of file with the last changed revision of the FCM trunk
+      REV_FILE => catfile (dirname ($FindBin::Bin), 'etc', 'fcm_rev'),
+
+      # Default names of known FCM configuration files
+      CFG_NAME => {
+        BLD        => 'bld.cfg',      # bld cfg
+        EXT        => 'ext.cfg',      # ext cfg
+        SRCPACKAGE => '@PACKAGE.cfg', # source package cfg
+      },
+
+      # Latest version of known FCM configuration files
+      CFG_VERSION => {
+        BLD        => '1.0', # bld cfg
+        EXT        => '1.0', # ext cfg
+        SRCPACKAGE => '1.0', # source package cfg
+      },
+
+      # Labels for all types of FCM configuration files
+      CFG_LABEL => {
+        CFGFILE => {
+          TYPE    => 'CFG::TYPE',       # config file type
+          VERSION => 'CFG::VERSION',    # version of config file syntax
+        },
+
+        # Labels for central/user internal config setting
+        SETTING    => 'SET',
+
+        # Labels for ext and bld cfg
+        USE        => 'USE',            # use (inherit from) another ext/bld
+        SRCDIR     => 'SRC',            # prefix, source directory
+
+        # Labels for bld and pck cfg
+        TARGET     => 'TARGET',         # BLD: targets of current build
+                                        # PCK: target name of source file
+
+        # Labels for bld cfg
+        NAME        => 'NAME',          # build name
+        DIR         => 'DIR',           # prefix, build directory
+        PP          => 'PP',            # prefix, pre-process?
+        LIB         => 'LIB',           # declare name of a library
+        SEARCH_SRC  => 'SEARCH_SRC',    # search src/ sub-directory?
+        EXE_NAME    => 'EXE_NAME',      # rename a main program target
+        TOOL        => 'TOOL',          # prefix, build tool
+        INHERIT     => 'INHERIT',       # prefix, inheritance flag
+        EXCL_DEP    => 'EXCL_DEP',      # exclude these automatic dependencies
+        INFILE_EXT  => 'INFILE_EXT',    # input file name extension and type
+        OUTFILE_EXT => 'OUTFILE_EXT',   # output file type and name extension
+        EXE_DEP     => 'EXE_DEP',       # extra executable dependencies
+        BLOCKDATA   => 'BLOCKDATA',     # BLOCKDATA dependencies
+
+        # Labels for ext cfg
+        DEST       => {                 # local extract destinations
+          ROOTDIR  => 'DEST::ROOTDIR',  # top directory for this extract
+          SRCDIR   => 'DEST::SRCDIR',   # extracted source directory
+          CFGDIR   => 'DEST::CFGDIR',   # generated configuration directory
+          CACHEDIR => 'DEST::CACHEDIR', # cache directory for fast extract
+          BLD_CFG  => 'DEST::BLD_CFG',  # generated bld cfg file
+          EXT_CFG  => 'DEST::EXT_CFG',  # generated ext cfg file
+        },
+        RDEST      => {                 # remote extract destionations
+          MACHINE  => 'RDEST::MACHINE', # name of remote machine
+          LOGNAME  => 'RDEST::LOGNAME', # user logname on remote machine
+          ROOTDIR  => 'RDEST::ROOTDIR', # top directory for this extract
+          SRCDIR   => 'RDEST::SRCDIR',  # extracted source directory
+          CFGDIR   => 'RDEST::CFGDIR',  # generated configuration directory
+          BLD_CFG  => 'RDEST::BLD_CFG', # generated bld cfg file
+          EXT_CFG  => 'RDEST::EXT_CFG', # generated ext cfg file
+        },
+        INC        => 'INC',            # "include" settings in another cfg file
+        BDECLARE   => 'BLD',            # declare entries for build system
+        OVERRIDE   => 'OVERRIDE',       # set conflict override option
+        REPOS      => 'REPOS',          # set repos loc for a project branch
+        VERSION    => 'VERSION',        # set version for a project branch
+        EXPSRCDIR  => 'EXPSRC',         # prefix, expandable source directory
+        MIRROR     => 'MIRROR',         # mirror tool
+
+        # Labels for pck cfg
+        TYPE       => 'TYPE',           # type of source file/build task
+        SCAN       => 'SCAN',           # scan source file for dependency
+        INTNAME    => 'INTNAME',        # internal name of source file
+        DEP        => 'DEP',            # source file/build task dependencies
+      },
+
+      # Keywords in known FCM configuration files
+      CFG_KEYWORD => 'USE,INC,TARGET,EXCL_DEP',
+
+      # Types of "inc" statements expandable CFG files
+      CFG_EXP_INC => 'BLD,EXT,FCM',
+
+      # Standard sub-directories for extract/build
+      DIR => {
+        BIN    => 'bin',    # executable
+        BLD    => 'bld',    # build
+        CACHE  => '.cache', # cache
+        CFG    => 'cfg',    # configuration
+        DONE   => 'done',   # "done"
+        ETC    => 'etc',    # miscellaneous items
+        FLAGS  => 'flags',  # "flags"
+        INC    => 'inc',    # include
+        LIB    => 'lib',    # library
+        OBJ    => 'obj',    # object
+        PPSRC  => 'ppsrc',  # pre-processed source
+        SRC    => 'src',    # source
+        TMP    => 'tmp',    # temporary directory
+      },
+
+      # Build commands and options (i.e. tools)
+      TOOL => {
+        SHELL        => '/usr/bin/ksh',    # Default shell
+
+        CPP          => 'cpp',             # C pre-processor
+        CPPFLAGS     => '-C',              # CPP flags
+        CPP_INCLUDE  => '-I',              # CPP flag, specify "include" path
+        CPP_DEFINE   => '-D',              # CPP flag, define macro
+        CPPKEYS      => '',                # CPP keys (definition macro)
+
+        CC           => 'cc',              # C compiler
+        CFLAGS       => '',                # CC flags
+        CC_COMPILE   => '-c',              # CC flag, compile only
+        CC_OUTPUT    => '-o',              # CC flag, specify output file name
+        CC_INCLUDE   => '-I',              # CC flag, specify "include" path
+        CC_DEFINE    => '-D',              # CC flag, define macro
+
+        FPP          => 'cpp',             # Fortran pre-processor
+        FPPFLAGS     => '-P -traditional', # FPP flags
+        FPP_INCLUDE  => '-I',              # FPP flag, specify "include" path
+        FPP_DEFINE   => '-D',              # FPP flag, define macro
+        FPPKEYS      => '',                # FPP keys (definition macro)
+
+        FC           => 'f90',             # Fortran compiler
+        FFLAGS       => '',                # FC flags
+        FC_COMPILE   => '-c',              # FC flag, compile only
+        FC_OUTPUT    => '-o',              # FC flag, specify output file name
+        FC_INCLUDE   => '-I',              # FC flag, specify "include" path
+        FC_DEFINE    => '-D',              # FC flag, define macro
+
+        LD           => 'ld',              # linker
+        LDFLAGS      => '',                # LD flags
+        LD_OUTPUT    => '-o',              # LD flag, specify output file name
+        LD_LIBSEARCH => '-L',              # LD flag, specify "library" path
+        LD_LIBLINK   => '-l',              # LD flag, specify link library
+
+        AR           => 'ar',              # library archiver
+        ARFLAGS      => 'rs',              # AR flags
+
+        MAKE         => 'make',            # make command
+        MAKEFLAGS    => '',                # make flags
+        MAKE_SILENT  => '-s',              # make flag, silent diagnostic
+        MAKE_JOB     => '-j',              # make flag, number of jobs
+
+        INTERFACE    => 'file',            # name interface after file/program
+        GENINTERFACE => 'ECMWF',           # Fortran 9x interface generator
+
+        MIRROR       => 'rsync',           # extract mirroring tool
+        REMOTE_SHELL => 'remsh',           # command to invoke the remote shell
+        GRAPHIC_DIFF => 'xxdiff',          # graphical diff tool
+      },
+
+      # List of tools that are local to FCM, (will not be exported to a Makefile)
+      LOCALTOOL => 'CPP,CPPFLAGS,CPP_INCLUDE,CPP_DEFINE,FPP,FPPFLAGS,' .
+                   'FPP_INCLUDE,FPP_DEFINE,GRAPHIC_DIFF,MAKE,MAKEFLAGS,' .
+                   'MAKE_SILENT,MAKE_JOB,INTERFACE,GENINTERFACE,MIRROR,' .
+                   'REMOTE_SHELL',
+
+      # Supported tools for compilable source
+      SRC_TOOL => {
+        FORTRAN => {
+          COMPILER => 'FC',
+          FLAGS    => 'FFLAGS',
+          OUTPUT   => 'FC_OUTPUT',
+          INCLUDE  => 'FC_INCLUDE',
+        },
+
+        FPP     => {
+          COMPILER => 'FC',
+          FLAGS    => 'FFLAGS',
+          PPKEYS   => 'FPPKEYS',
+          OUTPUT   => 'FC_OUTPUT',
+          INCLUDE  => 'FC_INCLUDE',
+          DEFINE   => 'FC_DEFINE',
+        },
+
+        C       => {
+          COMPILER => 'CC',
+          FLAGS    => 'CFLAGS',
+          PPKEYS   => 'CPPKEYS',
+          OUTPUT   => 'CC_OUTPUT',
+          INCLUDE  => 'CC_INCLUDE',
+          DEFINE   => 'CC_DEFINE',
+        },
+      },
+
+      # Cache file names/extensions
+      CACHE => {
+        EXTCONFIG   => '.config',       # ext cache, commit version info
+        PCKFILE     => '.pck_file',     # bld cache, source package list
+        PCKPPDEPEND => '.pck_ppdepend', # bld cache, source package PP dependency
+        PCKDEPEND   => '.pck_depend',   # bld cache, source package dependency
+        BLDTOOL     => '.bld_tool',     # bld cache, build tool list
+        PPOPTION    => '.bld_pp',       # bld cache, PP option
+        EXE_DEP     => '.exe_dep',      # bld cache, executable extra dependency
+      },
+
+      # Input file name extension and type
+      # (may overlap with output and vpath, see below)
+      INFILE_EXT => {
+        # General extensions
+        'f'    => 'FORTRAN::SOURCE',
+        'for'  => 'FORTRAN::SOURCE',
+        'ftn'  => 'FORTRAN::SOURCE',
+        'f77'  => 'FORTRAN::SOURCE',
+        'f90'  => 'FORTRAN::FORTRAN9X::SOURCE',
+        'f95'  => 'FORTRAN::FORTRAN9X::SOURCE',
+        'F'    => 'FPP::SOURCE',
+        'FOR'  => 'FPP::SOURCE',
+        'FTN'  => 'FPP::SOURCE',
+        'F77'  => 'FPP::SOURCE',
+        'F90'  => 'FPP::FPP9X::SOURCE',
+        'F95'  => 'FPP::FPP9X::SOURCE',
+        'c'    => 'C::SOURCE',
+        'cpp'  => 'C::C++::SOURCE',
+        'h'    => 'CPP::INCLUDE',
+        'o'    => 'BINARY::OBJ',
+        'obj'  => 'BINARY::OBJ',
+        'exe'  => 'BINARY::EXE',
+        'a'    => 'BINARY::LIB',
+        'sh'   => 'SHELL::SCRIPT',
+        'ksh'  => 'SHELL::SCRIPT',
+        'bash' => 'SHELL::SCRIPT',
+        'csh'  => 'SHELL::SCRIPT',
+        'pl'   => 'PERL::SCRIPT',
+        'pm'   => 'PERL::SCRIPT',
+        'py'   => 'PYTHON::SCRIPT',
+        'tcl'  => 'TCL::SCRIPT',
+        'pro'  => 'PVWAVE::SCRIPT',
+
+        # Local extensions
+        'cfg'       => 'CFGFILE',
+        'h90'       => 'CPP::INCLUDE',
+        'inc'       => 'FORTRAN::FORTRAN9X::INCLUDE',
+        'interface' => 'FORTRAN::FORTRAN9X::INCLUDE::INTERFACE',
+      },
+
+      # Input file name pattern and type
+      INFILE_PAT => {
+        '\w+Scr_\w+'              => 'SHELL::SCRIPT',
+        '\w+Comp_\w+'             => 'SHELL::SCRIPT::GENTASK',
+        '\w+(?:IF|Interface)_\w+' => 'SHELL::SCRIPT::GENIF',
+        '\w+Suite_\w+'            => 'SHELL::SCRIPT::GENSUITE',
+        '\w+List_\w+'             => 'SHELL::SCRIPT::GENLIST',
+        '\w+Sql_\w+'              => 'SCRIPT::SQL',
+      },
+
+      # Input text file pattern and type
+      INFILE_TXT => {
+        '(?:[ck]|ba)?sh'  => 'SHELL::SCRIPT',
+        'perl'            => 'PERL::SCRIPT',
+        'python'          => 'PYTHON::SCRIPT',
+        'tcl(?:sh)?|wish' => 'TCL::SCRIPT',
+      },
+
+      # Ignore input files matching the following names (comma-separated list)
+      INFILE_IGNORE => 'fcm_env.ksh',
+
+      # Output file type and extension
+      # (may overlap with input (above) and vpath (below))
+      OUTFILE_EXT => {
+        CFG       => '.cfg',       # FCM configuration file
+        DONE      => '.done',      # "done" files for compiled source
+        ETC       => '.etc',       # "etc" dummy file
+        EXE       => '.exe',       # binary executables
+        FLAGS     => '.flags',     # "flags" files, compiler flags config
+        IDONE     => '.idone',     # "done" files for included source
+        INTERFACE => '.interface', # interface for F90 subroutines/functions
+        LIB       => '.a',         # archive object library
+        MK        => '.mk',        # dependency files, Makefile fragments
+        MOD       => '.mod',       # compiled Fortran module information files
+        OBJ       => '.o',         # compiled object files
+        PDONE     => '.pdone',     # "done" files for pre-processed files
+        TAR       => '.tar',       # TAR archive
+      },
+
+      # VPATH, each value must be a comma separate list
+      # EMPTY      translates to %
+      # IN:<FLAG>  translates to any key in {INFILE_EXT} if the value contains
+      #            the word in <FLAG>
+      # OUT:<FLAG> translates to {OUTFILE_EXT}{<FLAG>}
+      VPATH   => {
+        BIN   => 'EMPTY,OUT:EXE,IN:SCRIPT',
+        BLD   => 'OUT:MK',
+        DONE  => 'OUT:DONE,OUT:IDONE,OUT:ETC',
+        FLAGS => 'OUT:FLAGS',
+        INC   => 'IN:INCLUDE',
+        LIB   => 'OUT:LIB',
+        OBJ   => 'OUT:OBJ',
+      },
+
+      # Dependency scan types for pre-processing
+      PP_DEP_TYPE => {
+        FPP => 'H',
+        CPP => 'H',
+        C   => 'H',
+      },
+
+      # Dependency scan types
+      DEP_TYPE => {
+        FORTRAN => 'USE::INTERFACE::INC::OBJ',
+        FPP     => 'USE::INTERFACE::INC::H::OBJ',
+        CPP     => 'H::OBJ',
+        C       => 'H::OBJ',
+        SCRIPT  => 'EXE',
+      },
+
+      # Dependency pattern for each type
+      DEP_PATTERN => {
+        H         => q/^#\s*include\s*['"](\S+)['"]/,
+        USE       => q/^\s*use\s+(\w+)/,
+        INTERFACE => q/^#?\s*include\s+['"](\S+##OUTFILE_EXT::INTERFACE##)['"]/,
+        INC       => q/^\s*include\s+['"](\S+)['"]/,
+        OBJ       => q#^\s*(?:/\*|!)\s*depends\s*on\s*:\s*(\S+)#,
+        EXE       => q/^\s*(?:#|;)\s*(?:calls|list|if|interface)\s*:\s*(\S+)/,
+      },
+
+      # Types that always need to be built
+      ALWAYS_BUILD_TYPE => 'PVWAVE,GENLIST,SQL',
+
+      # Types that cannot have duplicated targets
+      NO_DUPLICATED_TARGET_TYPE => '',
+
+      # Excluded dependency
+      EXCL_DEP => {
+        # Fortran intrinsic modules
+        'USE::ISO_C_BINDING'            => {'' => 1},
+        'USE::IEEE_EXCEPTIONS'          => {'' => 1},
+        'USE::IEEE_ARITHMETIC'          => {'' => 1},
+        'USE::IEEE_FEATURES'            => {'' => 1},
+
+        # Fortran intrinsic subroutines
+        'OBJ::CPU_TIME'                 => {'' => 1},
+        'OBJ::GET_COMMAND'              => {'' => 1},
+        'OBJ::GET_COMMAND_ARGUMENT'     => {'' => 1},
+        'OBJ::GET_ENVIRONMENT_VARIABLE' => {'' => 1},
+        'OBJ::MOVE_ALLOC'               => {'' => 1},
+        'OBJ::MVBITS'                   => {'' => 1},
+        'OBJ::RANDOM_NUMBER'            => {'' => 1},
+        'OBJ::RANDOM_SEED'              => {'' => 1},
+        'OBJ::SYSTEM_CLOCK'             => {'' => 1},
+
+        # Dummy statements
+        'OBJ::NONE'                     => {'' => 1},
+        'EXE::NONE'                     => {'' => 1},
+      },
+
+      # Extra executable dependencies
+      EXE_DEP => {},
+
+      # Fortran BLOCKDATA dependencies
+      BLOCKDATA => {},
+
+      # Rename main program targets
+      EXE_NAME => {},
+
+      # Build sub-directories that can be archived by "tar"
+      TAR_DIRS => 'BLD,CACHE,DONE,FLAGS,INC,PPSRC,OBJ',
+
+      # Misc
+      MISC => {
+        CPDUMMY       => '$(FCM_DONEDIR)/FCM_CP.dummy',
+                                         # build system "copy" dummy target
+        DIR_SEPARATOR => '/',            # repository directory separator
+        EXPURL_PREFIX => 'fcm:',         # expandable URL keyword prefix
+        LOCK_BLD      => 'fcm.bld.lock', # build lock file
+        LOCK_EXT      => 'fcm.ext.lock', # extract lock file
+        MAKEFILE      => 'Makefile',     # name of Makefile
+        RUN_ENV_SH    => 'fcm_env.ksh',  # bld runtime environment shell script
+        WEB_BROWSER   => 'firefox',      # web browser
+      },
+
+      # URL, revision, and Trac URL keywords
+      URL      => {},
+      REVISION => {},
+      TRAC     => {},
+    },
+  };
+
+  # Backward compatibility: the REPOS setting is equivalent to the URL setting
+  $self->{SETTING}{REPOS} = $self->{SETTING}{URL};
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $config->central_config ();
+#   $config->central_config ($file);
+#
+# DESCRIPTION
+#   This method returns the path name of the central configuration file. If an
+#   argument $file is specified, the path name of the central configuration
+#   file is set to its value.
+# ------------------------------------------------------------------------------
+
+sub central_config {
+  my $self = shift;
+
+  if (@_) {
+    $self->{CNTL_CONFIG} = $_[0];
+  }
+
+  return $self->{CNTL_CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $config->user_config ();
+#   $config->user_config ($file);
+#
+# DESCRIPTION
+#   This method returns the path name of the user configuration file. If an
+#   argument $file is specified, the path name of the user configuration file
+#   is set to its value.
+# ------------------------------------------------------------------------------
+
+sub user_config {
+  my $self = shift;
+
+  if (@_) {
+    $self->{USER_CONFIG} = $_[0];
+  }
+
+  return $self->{USER_CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mode = $config->verbose ();
+#   $config->verbose ($mode);
+#
+# DESCRIPTION
+#   This method returns the diagnostic verbose level. If an argument $mode is
+#   specified, the diagnostic verbose level is set to its value.
+# ------------------------------------------------------------------------------
+
+sub verbose {
+  my $self = shift;
+
+  if (@_) {
+    $self->{VERBOSE} = $_[0];
+  }
+
+  return $self->{VERBOSE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $setting = $config->setting (arg, [...]);
+#
+# DESCRIPTION
+#   This method returns an item under the SETTING hash table. The depth within
+#   the hash table is given by the list of arguments, which should match with
+#   the keys in the multi-dimension SETTING hash table.
+# ------------------------------------------------------------------------------
+
+sub setting {
+  my $self = shift;
+
+  if (@_) {
+    my $label   = shift;
+    my $setting = $self->{SETTING};
+    return _get_hash_value ($setting->{$label}, @_) if exists $setting->{$label};
+  }
+
+  return undef;
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config->assign_setting (
+#     LABELS => \@labels, # setting labels
+#     VALUE  => $value,   # setting value
+#   );
+#
+# DESCRIPTION
+#   This method assigns a VALUE to a SETTING specified by the names in LABEL.
+# ------------------------------------------------------------------------------
+
+sub assign_setting {
+  my $self = shift;
+  my %args = @_;
+
+  my @labels = exists $args{LABELS} ? @{ $args{LABELS} } : ();
+  my $value  = exists $args{VALUE}  ? $args{VALUE}       : undef;
+
+  my $setting = $self->{SETTING};
+  while (defined (my $label = shift @labels)) {
+    if (exists $setting->{$label}) {
+      if (ref $setting->{$label}) {
+        $setting = $setting->{$label};
+
+      } else {
+        $setting->{$label} = $value;
+        last;
+      }
+
+    } else {
+      if (@labels) {
+        $setting->{$label} = {};
+        $setting           = $setting->{$label};
+
+      } else {
+        $setting->{$label} = $value;
+      }
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $variable = $config->variable ([arg]);
+#
+# DESCRIPTION
+#   If arg is set, this method returns the value of a variable named arg. If
+#   arg is not set, this method returns the VARIABLE hash.
+# ------------------------------------------------------------------------------
+
+sub variable {
+  my $self     = shift;
+
+  my $variable = $self->{VARIABLE};
+
+  if (@_) {
+    my $label   = shift;
+    return exists $variable->{$label} ? $variable->{$label} : undef;
+
+  } else {
+    return %{ $variable };
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config->assign_variable (
+#     LABEL => $label, # variable label
+#     VALUE => $value, # variable value
+#   );
+#
+# DESCRIPTION
+#   This method assigns a VALUE to a VARIABLE named by LABEL.
+# ------------------------------------------------------------------------------
+
+sub assign_variable {
+  my $self = shift;
+  my %args = @_;
+
+  my $label = exists $args{LABEL} ? $args{LABEL} : undef;
+  my $value = exists $args{VALUE} ? $args{VALUE} : undef;
+
+  if ($label) {
+    $self->{VARIABLE}{$label} = $value;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config->get_config ();
+#
+# DESCRIPTION
+#   This method reads the configuration settings from the central and the user
+#   configuration files.
+# ------------------------------------------------------------------------------
+
+sub get_config {
+  my $self = shift;
+
+  $self->_read_config_file ($self->{CNTL_CONFIG}) if $self->{CNTL_CONFIG};  
+  $self->_read_config_file ($self->{USER_CONFIG}) if $self->{USER_CONFIG};
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config->_read_config_file ();
+#
+# DESCRIPTION
+#   This internal method reads a configuration file and assign values to the
+#   attributes of the current instance.
+# ------------------------------------------------------------------------------
+
+sub _read_config_file {
+  my $self        = shift;
+  my $config_file = $_[0];
+
+  return undef unless -r $config_file;
+
+  my $cfgfile = Fcm::CfgFile->new (SRC => $config_file, TYPE => 'FCM');
+  $cfgfile->read_cfg ();
+  my @lines = $cfgfile->lines ();
+
+  LINE: for my $line (@lines) {
+    my $label = $line->{LABEL};
+    my $value = $line->{VALUE};
+
+    next unless $label;
+
+    # "Environment variables" start with $
+    if ($label =~ s/^\$([A-Za-z_]\w*)$/$1/) {
+      $ENV{$label} = $value;
+      next LINE;
+    }
+
+    # "Settings variables" start with "set::"
+    my @tags = map {uc $_} split (/::/, $label);
+    if ($tags[0] eq uc $self->{SETTING}{CFG_LABEL}{SETTING}) {
+      shift @tags;
+      $self->assign_setting (LABELS => \@tags, VALUE => $value);
+      next LINE;
+    }
+
+    # Not a standard setting variable, put in internal variable list
+    $label =~ s/^\%//;
+    $self->assign_variable (LABEL => $label, VALUE => $value);
+  }
+
+  1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ref = _get_hash_value (arg1, arg2, ...);
+#
+# DESCRIPTION
+#   This internal method recursively gets a value from a multi-dimensional
+#   hash.
+# ------------------------------------------------------------------------------
+
+sub _get_hash_value {
+  my $value = shift;
+
+  while (defined (my $arg = shift)) {
+    if (exists $value->{$arg}) {
+      $value = $value->{$arg};
+
+    } else {
+      return undef;
+    }
+  }
+
+  return $value;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Extract.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Extract.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Extract.pm	(revision 5166)
@@ -0,0 +1,1768 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Extract
+#
+# DESCRIPTION
+#   This class contains methods for carrying out the various tasks that are
+#   required to extract code from the FCM Subversion repository for feeding
+#   into the prototype build system. At the end of the extract, it writes a
+#   build configuration file for feeding into the build system.  If the code
+#   is to be built on a remote machine, it is mirrored to the remote machine
+#   using a "rdist" or "rsync" interface.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Extract;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+use File::Spec::Functions;
+use File::Basename;
+use File::Path;
+use File::Compare;
+
+# FCM component modules
+use Fcm::CfgFile;
+use Fcm::ReposBranch;
+use Fcm::SrcDirLayer;
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext = Fcm::Extract->new (
+#     CONFIG    => $config,
+#     CFG_SRC   => $cfg_src,
+#     EXTRACTED => $extracted,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Extract class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   CFG_SRC    - source path to the extract configuration file
+#   EXTRACTED  - is it a pre-extracted object?
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $cfg       = exists $args{CFG_SRC}   ? $args{CFG_SRC}   : undef;
+  my $extracted = exists $args{EXTRACTED} ? $args{EXTRACTED} : undef;
+  my $config    = exists $args{CONFIG}    ? $args{CONFIG}    : &main::cfg;
+
+  my $self = {
+    CONFIG     => $config,            # configuration settings
+    CFG        => Fcm::CfgFile->new ( # ext cfg for this extract
+      SRC      => $cfg,               # source path of the config file
+      TYPE     => 'ext',              # config file type
+      CONFIG   => $config,            # configuration settings
+    ),
+    DEST       => {                   # destination info for this extract
+      ROOTDIR  => undef,              # destination root directory
+      CACHEDIR => undef,              # extract cache directory
+      CFGDIR   => undef,              # destination configuration directory
+      SRCDIR   => undef,              # destination source directory
+      BLD_CFG  => undef,              # bld cfg for the build system
+      EXT_CFG  => undef,              # ext cfg for subsequent extract
+    },
+    RDEST      => {                   # remote destination information
+      MACHINE  => undef,              # destination machine
+      LOGNAME  => undef,              # remote login name
+      ROOTDIR  => undef,              # destination root directory
+      CFGDIR   => undef,              # destination configuration directory
+      SRCDIR   => undef,              # destination source directory
+      BLD_CFG  => undef,              # bld cfg for the build system
+      EXT_CFG  => undef,              # ext cfg for subsequent extract
+    },
+    BDECLARE   => [],                 # list of declared bld cfg entries
+    OVERRIDE   => 0,                  # override conflicting patches?
+    EXTRACTED  => $extracted,         # is the current object pre-extracted?
+    USE        => [],                 # list of re-used extracts
+    BRANCHES   => [],                 # list of repository branch info
+    SRCDIRS    => {},                 # list of source directory extract info
+    LOCK       => undef,              # lock file
+  };
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->DESTROY;
+#
+# DESCRIPTION
+#   This method is called automatically when a Fcm::Extract object is
+#   destroyed.
+# ------------------------------------------------------------------------------
+
+sub DESTROY {
+  my $self = shift;
+
+  # Remove the lock if it is set
+  unlink $self->{LOCK} if $self->{LOCK} and -e $self->{LOCK};
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $ext->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile = $ext->cfg;
+#   $ext->cfg ($cfgfile);
+#
+# DESCRIPTION
+#   This method returns a reference to a Fcm::CfgFile instance for the extract
+#   configuration file.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  my $self = shift;
+
+  return $self->{CFG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dest = $ext->dest ([$name]);
+#
+# DESCRIPTION
+#   This method returns a hash containing the extract destination information
+#   (local) if no argument is specified. If $name is specified, it returns the
+#   named hash element if it exists.
+# ------------------------------------------------------------------------------
+
+sub dest {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+    $name    = uc $name;
+
+    if (exists $self->{DEST}{$name}) {
+      return $self->{DEST}{$name};
+    }
+  }
+
+  return %{ $self->{DEST} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rdest = $ext->rdest ([$name]);
+#
+# DESCRIPTION
+#   This method returns a hash containing the extract destination information
+#   (remote) if no argument is specified. If $name is specified, it returns the
+#   named hash element if it exists.
+# ------------------------------------------------------------------------------
+
+sub rdest {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+    $name    = uc $name;
+
+    if (exists $self->{RDEST}{$name}) {
+      return $self->{RDEST}{$name};
+    }
+  }
+
+  return %{ $self->{RDEST} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @bdeclare = $ext->bdeclare ();
+#
+# DESCRIPTION
+#   This method returns a list containing the build configuration file entries.
+# ------------------------------------------------------------------------------
+
+sub bdeclare {
+  my $self = shift;
+
+  return @{ $self->{BDECLARE} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @branches = $ext->branches ([$index]);
+#
+# DESCRIPTION
+#   This method returns a list of references to Fcm::ReposBranch instances. If
+#   $index is specified, it returns the numbered item in the list.
+# ------------------------------------------------------------------------------
+
+sub branches {
+  my $self = shift;
+
+  if (@_) {
+    my $index = $_[0];
+    return exists $self->{BRANCHES}[$index] ? $self->{BRANCHES}[$index] : undef;
+  }
+
+  return @{ $self->{BRANCHES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %srcdirs = $ext->srcdirs ([$name]);
+#
+# DESCRIPTION
+#   This method returns a hash of source directories to be processed by this
+#   extract. If $name is specified, a named element of the hash is returned
+#   instead.
+# ------------------------------------------------------------------------------
+
+sub srcdirs {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+    $name    = uc $name;
+
+    return exists $self->{SRCDIRS}{$name} ? $self->{SRCDIRS}{$name} : undef;
+  }
+
+  return %{ $self->{SRCDIRS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $ext->extract ([FULL => 1], [IGNORE_LOCK => 1]);
+#
+# DESCRIPTION
+#   This is the main class method. It performs an extract using the current
+#   configuration. If FULL is set to true, it runs in full mode. Otherwise, it
+#   runs in incremental mode. If IGNORE_LOCK is set to true, it ignores any lock
+#   files that may exist in the extract destination root directory.
+# ------------------------------------------------------------------------------
+
+sub extract {
+  my $self = shift;
+  my %args = @_;
+
+  my $full        = exists $args{FULL}        ? $args{FULL}        : 0;
+  my $ignore_lock = exists $args{IGNORE_LOCK} ? $args{IGNORE_LOCK} : 0;
+
+  my $verbose = $self->config->verbose;
+
+  my $date = localtime;
+  print 'Extract started on ', $date, '.', "\n" if $verbose;
+  my $otime = time;
+
+  my $rc;
+  $rc = $self->decipher_cfg;
+
+  print '->Extract: start', "\n" if $verbose;
+  my $stime = time;
+
+  $rc = $self->check_dest               if $rc;
+  $rc = $self->check_lock               if $rc and not $ignore_lock;
+  $rc = $self->_set_lock                if $rc;
+  $rc = $self->expand_cfg               if $rc;
+  $rc = $self->_create_dest_dir ($full) if $rc;
+  $rc = $self->create_dir_stack         if $rc;
+  $rc = $self->_extract_src             if $rc;
+
+  $rc = $self->_sort_bdeclare if $rc;
+  $rc = $self->_write_ext_cfg if $rc;
+  $rc = $self->_write_bld_cfg if $rc;
+
+  my $ftime = time;
+  my $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+  print '->Extract: ', $ftime - $stime, ' ', $s_str, "\n";
+
+  if ($rc and $self->{RDEST}{MACHINE}) {
+    print '->Mirror : start', "\n" if $verbose;
+    $stime = time;
+    $rc = $self->_mirror_extract;
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Mirror : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  if ($verbose) {
+    $s_str = $ftime - $otime > 1 ? 'seconds' : 'second';
+    print '->TOTAL  : ', $ftime - $otime, ' ', $s_str, "\n";
+  }
+
+  $date = localtime;
+  if ($rc) {
+    print 'Extract command finished on ', $date, '.', "\n" if $verbose;
+
+  } else {
+    e_report 'Extract command failed on ', $date, '.';
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->decipher_cfg ();
+#
+# DESCRIPTION
+#   This method deciphers the extract configuration file.
+# ------------------------------------------------------------------------------
+
+sub decipher_cfg {
+  my $self = shift;
+
+  return unless $self->cfg->src;
+
+  # Read config file
+  my $read = $self->cfg->read_cfg;
+
+  # Check config file type
+  if ($read) {
+    if ($self->cfg->type ne 'ext') {
+      w_report 'Error: ', $self->cfg->src, ': not an extract config file';
+      return;
+    }
+
+  } else {
+    return;
+  }
+
+  my %cfg_labels = %{ $self->config->setting ('CFG_LABEL') };
+
+  # Extract information from each line of the config file
+  my @lines    = $self->cfg->lines;
+  LINE: for my $line (@lines) {
+    my $label = $line->{LABEL};
+    my $value = $line->{VALUE};
+
+    next LINE unless $label;
+
+    # Configuration file type/version, ignore
+    for my $my_label (keys %{ $cfg_labels{CFGFILE} }) {
+      next LINE if uc ($label) eq uc ($cfg_labels{CFGFILE}{$my_label});
+    }
+
+    # Include another file, processed already, ignore this line
+    next LINE if uc ($label) eq $cfg_labels{INC};
+
+    # User variable, ignore
+    next LINE if index (uc ($label), '%') == 0;
+
+    # Local destination directories, config file, etc
+    for my $my_label (keys %{ $cfg_labels{DEST} }) {
+      if (uc ($label) eq uc ($cfg_labels{DEST}{$my_label})) {
+        $self->{DEST}{$my_label} = &expand_tilde ($value);
+        next LINE;
+      }
+    }
+
+    # Remote machine, logname, destination directories, config file, etc
+    for my $my_label (keys %{ $cfg_labels{RDEST} }) {
+      if (uc ($label) eq uc ($cfg_labels{RDEST}{$my_label})) {
+        $self->{RDEST}{$my_label} = $value;
+        next LINE;
+      }
+    }
+
+    # "USE" statements
+    if (uc ($label) eq uc ($cfg_labels{USE})) {
+      my $exists = grep {$_->cfg->src eq $value} @{ $self->{USE} };
+
+      # Initialise new Fcm::Extract object if not already exists
+      unless ($exists) {
+        my $extract = Fcm::Extract->new (
+          CONFIG    => $self->config,
+          CFG_SRC   => expand_tilde ($value),
+          EXTRACTED => 1,
+        );
+
+        $extract->decipher_cfg;
+        $extract->check_dest;
+        $extract->expand_cfg ();
+        push @{ $self->{USE} }, $extract;
+      }
+      next LINE;
+    }
+
+    # "Override" setting
+    if (uc ($label) eq uc ($cfg_labels{OVERRIDE})) {
+      $self->{OVERRIDE} = $value;
+      next LINE;
+    }
+
+    # "Mirror" command
+    if (uc ($label) eq uc ($cfg_labels{MIRROR})) {
+      $self->config->assign_setting (
+        LABELS => [qw/TOOL MIRROR/],
+        VALUE  => $value,
+      );
+      next LINE;
+    }
+
+    # Declared bld cfg entries
+    {
+      my $prefix = $cfg_labels{BDECLARE} . '::';
+
+      if (index (uc ($label), $prefix) == 0) {
+        my $name = substr $label, length ($prefix);
+
+        if ($name) {
+          push @{ $self->{BDECLARE} }, {LABEL => $name, VALUE => $value,};
+          next LINE;
+        }
+      }
+    }
+
+    # Repository, version and source directories
+    for my $my_label (qw/REPOS VERSION SRCDIR EXPSRCDIR/) {
+      my $prefix  = $cfg_labels{$my_label} . '::';
+
+      if (index (uc ($label), $prefix) == 0) {
+        my $name    = substr $label, length ($prefix);
+
+        # Detemine package and tag
+        my @names   = split /::/, $name;
+        my $tag     = pop @names;
+        my $pckroot = $names[0];
+        my $pck     = join '::', @names;
+
+        # Check that $tag and $pckroot are defined
+        last if not $tag;
+        last if not $pckroot;
+
+        # Check whether branch already exists
+        my @branches = grep {
+          $_->package eq $pckroot and $_->tag eq $tag
+        } @{ $self->{BRANCHES} };
+
+        my $branch   = undef;
+
+        if (@branches) { # If so, set $branch to point to existing branch
+          $branch = shift @branches;
+
+        } else {         # If not, create new branch
+          $branch = Fcm::ReposBranch->new (
+            CONFIG  => $self->config,
+            PACKAGE => $pckroot,
+            TAG     => $tag,
+          );
+
+          push @{ $self->{BRANCHES} }, $branch;
+        }
+
+        # Check package name for source directory declarations
+        if ($my_label eq 'SRCDIR' or $my_label eq 'EXPSRCDIR') {
+          if ($pck eq $pckroot and $value !~ m#^/#) {
+            # Sub-package name not set and source directory quoted as a relative
+            # path, determine package name from path name
+            my @subpck = File::Spec->splitdir ($value);
+            $pck       = join '::', ($pckroot, @subpck);
+          }
+        }
+
+        # Assign the value accordingly
+        if ($my_label eq 'REPOS') {          # Repository location
+          $branch->repos ($value);
+
+        } elsif ($my_label eq 'VERSION') {   # Version used
+          $branch->version ($value);
+
+        } elsif ($my_label eq 'SRCDIR') {    # Source directory used
+          $branch->dir ($pck, $value);
+
+        } elsif ($my_label eq 'EXPSRCDIR') { # Expandable source directory
+          $branch->expdir ($pck, $value);
+        }
+
+        next LINE;
+      }
+    }
+
+    # Label not recognised
+    w_report 'ERROR: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
+             ': label "', $label, '" not recognised';
+    return;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->check_dest ();
+#
+# DESCRIPTION
+#   This method checks that the extract destionations are set correctly.
+# ------------------------------------------------------------------------------
+
+sub check_dest {
+  my $self = shift;
+
+  my %subdir  = %{ $self->config->setting ('DIR') };
+  my %cfgname = %{ $self->config->setting ('CFG_NAME') };
+
+  # Default destination settings
+  my $dest = $self->{DEST};
+  if ($dest->{ROOTDIR}) {
+    unless ($dest->{SRCDIR}) {   # Location of extracted source
+      $dest->{SRCDIR} = catfile $dest->{ROOTDIR}, $subdir{SRC};
+    }
+    unless ($dest->{CFGDIR}) {   # Location of configuration files
+      $dest->{CFGDIR} = catfile $dest->{ROOTDIR}, $subdir{CFG};
+    }
+    unless ($dest->{CACHEDIR}) { # Location of cache
+      $dest->{CACHEDIR} = catfile $dest->{ROOTDIR}, $subdir{CACHE};
+    }
+    unless ($dest->{BLD_CFG}) {  # Location of (output) bld cfg
+      $dest->{BLD_CFG} = catfile $dest->{CFGDIR}, $cfgname{BLD};
+    }
+    unless ($dest->{EXT_CFG}) {  # Location of (output) ext cfg
+      $dest->{EXT_CFG} = catfile $dest->{CFGDIR}, $cfgname{EXT};
+    }
+  } else {
+    w_report 'Error: ', $self->cfg->src,
+             ': destination root directory not set.';
+    return;
+  }
+
+  # Default remote destination settings
+  if ($self->{RDEST}{MACHINE}) {
+
+    # Use local logname as remote logname if it is not set
+    $self->{RDEST}{LOGNAME} = getlogin      unless $self->{RDEST}{LOGNAME};
+    $self->{RDEST}{LOGNAME} = $ENV{LOGNAME} unless $self->{RDEST}{LOGNAME};
+    $self->{RDEST}{LOGNAME} = $ENV{USER}    unless $self->{RDEST}{LOGNAME};
+
+    unless ($self->{RDEST}{LOGNAME}) {
+      w_report 'Error: ', $self->cfg->src,
+               ': cannot determine your remote logname.';
+      return;
+    }
+
+    # Make sure remote destination root directory is set
+    unless ($self->{RDEST}{ROOTDIR}) {
+      w_report 'Error: ', $self->cfg->src,
+               ': remote destination root directory not set.';
+      return;
+    }
+
+    # Make sure remote destination source directory is set
+    $self->{RDEST}{SRCDIR} = catfile $self->{RDEST}{ROOTDIR}, $subdir{SRC}
+      unless $self->{RDEST}{SRCDIR};
+
+    # Make sure remote destination configuration directory is set
+    $self->{RDEST}{CFGDIR} = catfile $self->{RDEST}{ROOTDIR}, $subdir{CFG}
+      unless $self->{RDEST}{CFGDIR};
+
+    # Make sure remote bld cfg is set
+    $self->{RDEST}{BLD_CFG} = catfile $self->{RDEST}{CFGDIR}, $cfgname{BLD}
+      unless $self->{RDEST}{BLD_CFG};
+
+    # Make sure remote ext cfg is set
+    $self->{RDEST}{EXT_CFG} = catfile $self->{RDEST}{CFGDIR}, $cfgname{EXT}
+      unless $self->{RDEST}{EXT_CFG};
+
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->check_lock ();
+#
+# DESCRIPTION
+#   This method checks whether a lock is set in the current extract.
+# ------------------------------------------------------------------------------
+
+sub check_lock {
+  my $self = shift;
+
+  my $rootdir  = $self->{DEST}{ROOTDIR};
+  my $lock_ext = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_EXT/));
+  my $lock_bld = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_BLD/));
+
+  # Always throw error if extract lock exists
+  if (-e $lock_ext) {
+    w_report 'ERROR: extract lock file exists: ', $lock_ext, ',';
+    w_report '       an extract may be running at ', $rootdir, ', abort.';
+    return;
+  }
+
+  # Throw error if current object is not a "used" pre-extracted object and
+  # a build lock exists
+  if ((not $self->{EXTRACTED}) and -e $lock_bld) {
+    w_report 'ERROR: build lock file exists: ', $lock_bld, ',';
+    w_report '       a build may be running at ', $rootdir, ', abort.';
+    return;
+  }
+
+  # Check locks in inherited extract
+  for my $use (@{ $self->{USE} }) {
+    return unless $use->check_lock;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_set_lock ();
+#
+# DESCRIPTION
+#   This method sets a lock is set in the current extract.
+# ------------------------------------------------------------------------------
+
+sub _set_lock {
+  my $self = shift;
+
+  $self->{LOCK} = catfile (
+    $self->{DEST}{ROOTDIR}, $self->config->setting (qw/MISC LOCK_EXT/),
+  );
+
+  &touch_file ($self->{LOCK});
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->expand_cfg ();
+#
+# DESCRIPTION
+#   This method expands the settings of the extract configuration.
+# ------------------------------------------------------------------------------
+
+sub expand_cfg {
+  my $self = shift;
+
+  # Establish a set of source directories from the "base repository"
+  my %base_branches = ();
+
+  # Inherit "base" set of source directories from re-used extracts
+  my @uses = @{ $self->{USE} };
+
+  for my $use (@uses) {
+    my @branches = $use->branches;
+
+    for my $branch (@branches) {
+      my $package              = $branch->package;
+      $base_branches{$package} = $branch unless exists $base_branches{$package};
+    }
+  }
+
+  for my $branch (@{ $self->{BRANCHES} }) {
+    # Expand URL keywords if necessary
+    if ($branch->repos) {
+      my $repos = expand_url_keyword (
+        URL => $branch->repos,
+        CFG => $self->config,
+      );
+      $branch->repos ($repos) if $repos ne $branch->repos;
+    }
+
+    # Check that repository type and version are set
+    if ($branch->repos and &is_url ($branch->repos)) {
+      $branch->type    ('svn')  unless $branch->type;
+      $branch->version ('head') unless $branch->version;
+
+    } else {
+      $branch->type    ('user') unless $branch->type;
+      $branch->version ('user') unless $branch->version;
+    }
+
+    $branch->expand_version_tag; # Work out revision number a version tag
+    $branch->expand_path;        # Expand relative path to full path
+    $branch->expand_all;         # Search sub-directories
+
+    my $package = $branch->package;
+
+    if (exists $base_branches{$package}) {
+      # A base branch for this package exists
+
+      # If current branch has no source directory, use the set provided by the
+      # base branch
+      my %dirs = $branch->dirs;
+      $branch->add_base_dirs ($base_branches{$package}) unless keys %dirs;
+
+    } else {
+      # This package does not yet have a base branch, set this branch as base
+      $base_branches{$package} = $branch;
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_create_dest_dir ($full);
+#
+# DESCRIPTION
+#   This internal method (re-)creates all the destination directories if
+#   necessary. If $full is set to true, it removes existing directories/files
+#   in the destination directories.
+# ------------------------------------------------------------------------------
+
+sub _create_dest_dir {
+  my ($self, $full) = @_;
+
+  my $verbose = $self->config->verbose;
+
+  # Remove previous extract if "FULL" flag is set
+  if ($full) {
+    # Remove extracted source
+    if (-d $self->{DEST}{SRCDIR} and -w $self->{DEST}{SRCDIR}) {
+      print 'Remove directory: ', $self->{DEST}{SRCDIR}, "\n" if $verbose;
+      my $removed = rmtree $self->{DEST}{SRCDIR};
+      w_report 'WARNING: ', $self->{DEST}{SRCDIR}, ': cannot remove.'
+        if not $removed;
+    }
+
+    # Remove cache
+    my @files;
+    if (-d $self->{DEST}{CACHEDIR} and opendir DIR, $self->{DEST}{CACHEDIR}) {
+      @files = grep {$_ ne '.' and $_ ne '..'} readdir 'DIR';
+      closedir DIR;
+    }
+
+    for my $file (@files) {
+      my $path = File::Spec->catfile ($self->{DEST}{CACHEDIR}, $file);
+
+      next unless $file eq $self->config->setting (qw/CACHE EXTCONFIG/) or
+                  -d $path;
+
+      print 'Remove: ', $path, "\n" if $verbose;
+      my $removed = rmtree $path;
+      w_report 'WARNING: ', $path, ': cannot remove.' if not $removed;
+    }
+  }
+
+  # Create extract destinations if necessary
+  for my $my_label (qw/ROOTDIR CACHEDIR CFGDIR SRCDIR/) {
+    my $dirname = $self->{DEST}{$my_label};
+
+    # Create directory if it does not already exist
+    if (not -d $dirname) {
+      print 'Make directory: ', $dirname, "\n" if $verbose > 1;
+      mkpath $dirname;
+    }
+
+    unless (-d $dirname and -w $dirname) {
+      w_report 'ERROR: ', $dirname, ': cannot write to destination.';
+      return;
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->create_dir_stack (
+#     USE => $use, # Is this a pre-extracted configuration?
+#   );
+#
+# DESCRIPTION
+#   This method creates a hash of source directories to be processed. If the
+#   flag USE is set to true, the source directories are assumed processed and
+#   extracted.
+# ------------------------------------------------------------------------------
+
+sub create_dir_stack {
+  my $self = shift;
+  my %args = @_;
+  my $extracted = exists $args{USE} ? $args{USE} : undef;
+
+  # Inherit from USE ext cfg
+  if (@{ $self->{USE} } > 0) {
+    for my $use (@{ $self->{USE} }) {
+      $use->create_dir_stack (USE => 1);
+      my %use_srcdirs = $use->srcdirs;
+
+      while (my ($key, $value) = each %use_srcdirs) {
+        $self->{SRCDIRS}{$key} = $value;
+
+        # Re-set destination to current destination
+        my @path = split (/::/, $key);
+        $self->{SRCDIRS}{$key}{DEST} = catfile ($self->{DEST}{SRCDIR}, @path);
+      }
+    }
+  }
+
+  # Build stack from current ext cfg
+  for my $branch (@{ $self->{BRANCHES} }) {
+    my %branch_dirs = $branch->dirs;
+
+    for my $dir (keys %branch_dirs) {
+      # Check whether source directory is already in the list
+      if (not exists $self->{SRCDIRS}{$dir}) { # if not, create it
+        $self->{SRCDIRS}{$dir} = {
+          DEST  => catfile ($self->{DEST}{SRCDIR}, split (/::/, $dir)),
+          STACK => [],
+          FILES => {},
+        };
+      }
+
+      my $stack = $self->{SRCDIRS}{$dir}{STACK}; # copy reference
+
+      # Create a new layer in the input stack
+      my $layer = Fcm::SrcDirLayer->new (
+        CONFIG    => $self->config,
+        NAME      => $dir,
+        PACKAGE   => $branch->package,
+        TAG       => $branch->tag,
+        LOCATION  => $branch->dir ($dir),
+        REPOSROOT => $branch->repos,
+        VERSION   => $branch->version,
+        TYPE      => $branch->type,
+        EXTRACTED => $extracted ? $self->{SRCDIRS}{$dir}{DEST} : undef,
+      );
+
+      # Check whether layer is already in the stack
+      my $exist = grep {
+        $_->location eq $layer->location and $_->version  eq $layer->version;
+      } @{ $stack };
+
+      if (not $exist) {
+        # If not already exist, put layer into stack
+
+        # Note: user stack always comes last
+        if (! $layer->user and exists $stack->[-1] and $stack->[-1]->user) {
+          my $lastlayer = pop @{ $stack };
+          push @{ $stack }, $layer;
+          $layer = $lastlayer;
+        }
+
+        push @{ $stack }, $layer;
+
+      } elsif ($layer->user) {
+
+        # User layer already exists, overwrite it
+        $stack->[-1] = $layer;
+
+      }
+    }
+  }
+
+  # Read content of "commit cache" file if it exists
+  my $cachedir = $self->{DEST}{CACHEDIR};
+  my $cfgbase  = $self->config->setting (qw/CACHE EXTCONFIG/);
+  my $cfgfile  = catfile $cachedir, $cfgbase;
+  my %config_lines = ();
+  if (-r $cfgfile) {
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $cfgfile,);
+    $cfg->read_cfg;
+    my @lines = $cfg->lines;
+
+    for my $line (@lines) {
+      $config_lines{$line->{LABEL}} = $line->{VALUE};
+    }
+  }
+
+  my %new_config_lines;
+
+  # Compare each layer to base layer, discard unnecessary layers
+  for my $srcdir (keys %{ $self->{SRCDIRS} }) {
+    my @stack = ();
+
+    while (my $layer = shift @{ $self->{SRCDIRS}{$srcdir}{STACK} }) {
+      if ($layer->user) {
+        # User directory, check that the declared location exists
+        if (not -d $layer->location) {
+          w_report 'Error: declared source directory ', $layer->location,
+                   ' does not exists ';
+          return;
+        }
+
+        # Always override repository code
+        push @stack, $layer;
+
+      } else {
+        unless ($layer->extracted and $layer->commit) {
+
+          my $key = join '::', ($srcdir, $layer->location, $layer->version);
+
+          # See if commit version information is cached
+          if (keys %config_lines) {
+            if (exists $config_lines{$key}) {
+              $layer->commit ($config_lines{$key});
+            }
+          }
+
+          # Check source directory for commit version, if necessary
+          $layer->get_commit unless $layer->commit;
+          if (not $layer->commit) {
+            w_report 'Error: cannot determine the last changed revision of ',
+                     $layer->location;
+            return;
+          }
+
+          # Set cache directory for layer
+          my $tag_ver = $layer->tag . '__' . $layer->commit;
+          $layer->cachedir (catfile $cachedir, split (/::/, $srcdir), $tag_ver);
+
+          # New line in cache config file
+          $new_config_lines{$key} = $layer->commit;
+        }
+
+        # Push this layer in the stack:
+        # 1. it has a different version compared to the top layer
+        # 2. it is the top layer (base line code)
+        if (@stack > 0) {
+          push @stack, $layer if $layer->commit != $stack[0]->commit;
+
+        } else {
+          push @stack, $layer;
+        }
+
+      }
+    }
+
+    $self->{SRCDIRS}{$srcdir}{STACK} = \@stack;
+
+  }
+
+  # Write "commit cache" file
+  if (not $extracted) {
+    mkpath $cachedir if not -d $cachedir;
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config,);
+
+    while ((my $label, my $value) = each %new_config_lines) {
+      $cfg->add_line (LABEL => $label, VALUE => $value,);
+    }
+
+    $cfg->print_cfg ($cfgfile);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_extract_src ();
+#
+# DESCRIPTION
+#   This internal method performs the extract of the source directories and
+#   files if necessary.
+# ------------------------------------------------------------------------------
+
+sub _extract_src {
+  my $self = shift;
+
+  my $verbose = $self->config->verbose;
+  my %v_count = (
+    CREATED_DIRS    => 0,
+    IGNORED_SUBDIRS => 0,
+    UPDATED_FILES   => 0,
+    REMOVED_FILES   => 0,
+  );
+
+  my $cachedir = $self->{DEST}{CACHEDIR};
+
+  # Go through the "stack" of each source directory
+  # Extract the source directories/files if required
+
+  for my $srcdir (values %{ $self->{SRCDIRS} }) {
+
+    # Check if destionation exists and is not a directory
+    if (-f $srcdir->{DEST}) {
+      w_report $srcdir->{DEST},
+               ': destination exists and is not a directory, abort.';
+      return;
+    }
+
+    my %base_files   = (); # list of files in the base layer
+    my %used_files   = (); # keys = file basenames, values = layer reference
+    $srcdir->{FILES} = \%used_files;
+    my @destpath     = (); # search path for source directory destinations
+ 
+    for my $layer (@{ $srcdir->{STACK} }) {
+      # Update the cache for each layer of the stack if necessary
+      $layer->update_cache unless $layer->extracted or -d $layer->localdir;
+
+      # Search path for extract destinations of this source directory
+      unshift @destpath, $layer->extracted
+        if $layer->extracted and not grep {$_ eq $layer->extracted} @destpath;
+ 
+      # Get list of files in the cache or local directory
+      for my $file (($layer->get_files)) {
+        if (exists $base_files{$file}) {
+          # File exists in the base, compare current version with base version,
+          # discard if not changed
+          my $base_file = catfile $base_files{$file}->localdir, $file;
+          my $used_file = catfile $used_files{$file}->localdir, $file;
+          my $this_file = catfile $layer->localdir, $file;
+
+          if (compare ($base_file, $this_file)) { # Differs
+            if ($base_files{$file} eq $used_files{$file}) {
+              # Base and used are the same layer, use current layer
+              $used_files{$file} = $layer;
+
+            } elsif (compare ($used_file, $this_file) == 0) {
+              # Changes in used and this are the same, no update required
+
+              # Print a message at verbose mode 2 or above
+              if ($verbose > 1) {
+                print &_print_override_mesg (
+                  FILE   => $file,
+                  LAYER0 => $base_files{$file},
+                  LAYER1 => $used_files{$file},
+                  LAYER2 => $layer,
+                );
+                print '  Same modifications, use the source in URL 1.', "\n";
+              }
+
+            } elsif ($self->{OVERRIDE}) {
+              # Base and used are different, and used is not the same as this
+              # Override mode, use current layer
+
+              # Print override mode message
+              if ($verbose) {
+                print &_print_override_mesg (
+                  FILE   => $file,
+                  LAYER0 => $base_files{$file},
+                  LAYER1 => $used_files{$file},
+                  LAYER2 => $layer,
+                );
+                print '  ', $file, ' in URL 2 overrides that in URL 1.', "\n";
+              }
+
+              $used_files{$file} = $layer;
+
+            } else {
+              # Base and used are different, and used is not the same as this
+              # Non-override mode, fail the extract
+              w_report &_print_override_mesg (
+                FILE   => $file,
+                LAYER0 => $base_files{$file},
+                LAYER1 => $used_files{$file},
+                LAYER2 => $layer,
+              );
+              w_report '  Override mode is false, file in URL 1 cannot ',
+                       'override file in URL 2, abort.';
+              return;
+            }
+          }
+ 
+        } else {
+          # The first time the file is found
+          $base_files{$file} = $layer;
+          $used_files{$file} = $layer;
+        }
+      }
+    }
+
+    # Add current destination to the beginning of the destination search path
+    unshift @destpath, $srcdir->{DEST} if -d $srcdir->{DEST};
+
+    for my $file (keys %used_files) {
+      # Ignore sub-directories
+      if (-d catfile $used_files{$file}->localdir, $file) {
+        # Print diagnostic
+        if ($verbose > 1) {
+          print 'Ignore subdirectory: ', $file, "\n";
+          print '                Src: ', $used_files{$file}->location;
+          print '@', $used_files{$file}->version unless $used_files{$file}->user;
+          print "\n";
+        }
+        $v_count{IGNORED_SUBDIRS}++;
+        next;
+      }
+
+      # Determine whether file has changed, compared with the destination
+      my $diff = 1;
+      for my $dir (@destpath) {
+        my $old = catfile ($dir, $file);
+
+        if (-f $old) {
+          my $new = catfile ($used_files{$file}->localdir, $file);
+          $diff   = compare $old, $new;
+          last;
+        }
+      }
+
+      if ($diff) { # copy if differs
+        # Create extract destination, if required
+        if (not -d $srcdir->{DEST}) {
+          print 'Create directory: ', $srcdir->{DEST}, "\n" if $verbose > 1;
+          my $mkdirs = mkpath $srcdir->{DEST};
+
+          if (! -d $srcdir->{DEST} or ! -w $srcdir->{DEST}) {
+            w_report $srcdir->{DEST}, ': not a writable directory, abort.';
+            return;
+          }
+
+          $v_count{CREATED_DIRS} += $mkdirs;
+        }
+
+        # Set up the copy command
+        my @cmd = (
+          'cp',
+          catfile ($used_files{$file}->localdir, $file),
+          $srcdir->{DEST},
+        );
+
+        my $dest_file = catfile ($srcdir->{DEST}, $file);
+
+        # Print diagnostic
+        if ($verbose > 1) {
+          print 'Update: ', $dest_file, "\n";
+          print '   Src: ', $used_files{$file}->location;
+          print '@', $used_files{$file}->version unless $used_files{$file}->user;
+          print "\n";
+        }
+
+        # Remove old file if it exists
+        unlink $dest_file if -f $dest_file;
+
+        # Execute the copy command
+        &run_command (\@cmd, TIME => $self->config->verbose > 2);
+
+        $v_count{UPDATED_FILES}++;
+      }
+
+    }
+
+    # Check that the destination directory does not contain any removed files
+    opendir DIR, $srcdir->{DEST};
+    my @dest_files = readdir DIR;
+    closedir DIR;
+
+    while (my $file = shift @dest_files) {
+      next if $file =~ /^\.\.?/;                   # ignore hidden files
+      next if -d catfile ($srcdir->{DEST}, $file); # ignore sub-directories
+
+      # Check if the file exists in any of the versions
+      my $exists = 0;
+      for my $layer (@{ $srcdir->{STACK} }) {
+        if (-f catfile ($layer->localdir, $file)) {
+          $exists = 1;
+          last;
+        }
+      }
+
+      # File exists in destination but not in any versions...
+      if (not $exists) {
+        my @cmd = (
+          qw/rm -f/,
+          catfile ($srcdir->{DEST}, $file),
+        );
+
+        # Print diagnostic
+        print 'Remove: ', catfile ($srcdir->{DEST}, $file), "\n"
+          if $verbose > 1;
+
+        # Execute the command
+        &run_command (\@cmd, TIME => $self->config->verbose > 2);
+
+        $v_count{REMOVED_FILES}++;
+      }
+    }
+  }
+
+  if ($verbose) {
+    my %v_label = (
+      CREATED_DIRS    => 'Number of directories created    : ',
+      IGNORED_SUBDIRS => 'Number of ignored sub-directories: ',
+      UPDATED_FILES   => 'Number of updated files          : ',
+      REMOVED_FILES   => 'Number of removed files          : ',
+    );
+    for my $key (qw/CREATED_DIRS IGNORED_SUBDIRS UPDATED_FILES REMOVED_FILES/) {
+      print $v_label{$key}, $v_count{$key}, "\n" if $v_count{$key};
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = _print_override_mesg (
+#     FILE => $file,
+#     LAYER0 => $layer0,
+#     LAYER1 => $layer1,
+#     LAYER2 => $layer2,
+#   );
+#
+# DESCRIPTION
+#   This internal method returns a string containing an override mode message.
+#
+# ARGUMENTS
+#   FILE   - name of the source file
+#   LAYER0 - base location
+#   LAYER1 - source location overridden by LOC2
+#   LAYER2 - source location overriding LOC1
+# ------------------------------------------------------------------------------
+
+sub _print_override_mesg {
+  my %args = @_;
+
+  my $string = $args{FILE};
+  $string .= ': modified in both URL 1 and URL 2, relative to BASE:';
+  $string .= "\n";
+  $string .= '  BASE : ' . $args{LAYER0}->location;
+  $string .= '@' . $args{LAYER0}->version unless $args{LAYER0}->user;
+  $string .= "\n";
+  $string .= '  URL 1: ' . $args{LAYER1}->location;
+  $string .= '@' . $args{LAYER1}->version unless $args{LAYER1}->user;
+  $string .= "\n";
+  $string .= '  URL 2: ' . $args{LAYER2}->location;
+  $string .= '@' . $args{LAYER2}->version unless $args{LAYER2}->user;
+  $string .= "\n";
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_sort_bdeclare ();
+#
+# DESCRIPTION
+#   This internal method sorts the declared build configuration entries,
+#   filtering out repeated entries.
+# ------------------------------------------------------------------------------
+
+sub _sort_bdeclare {
+  my $self = shift;
+
+  # Get list of build configuration labels that can be declared multiple times
+  my %cfg_labels   = %{ $self->config->setting ('CFG_LABEL') };
+  my @cfg_keywords = split /,/, $self->config->setting ('CFG_KEYWORD');
+  @cfg_keywords    = map {$cfg_labels{$_}} @cfg_keywords;
+
+  # Filter out repeated declarations
+  my @bdeclares = ();
+  for my $bdeclare (reverse @{ $self->{BDECLARE} }) {
+    my $label = $bdeclare->{LABEL};
+
+    # Do not filter any declarations that can be declared multiple times
+    my $unshift_ok = grep {
+      uc ($label) eq $_ or index (uc ($label), $_ . '::') == 0;
+    } @cfg_keywords;
+    # @bdeclare contains nothing, last entry
+    $unshift_ok    = 1 unless $unshift_ok or @bdeclares;
+    # Check if a later entry already exists
+    $unshift_ok    = 1
+      unless $unshift_ok or grep {$_->{LABEL} eq $label} @bdeclares;
+
+    # Reconstruct array from bottom up
+    unshift @bdeclares, $bdeclare if $unshift_ok;
+  }
+
+  $self->{BDECLARE} = \@bdeclares;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_write_ext_cfg ();
+#
+# DESCRIPTION
+#   This internal method writes the expanded extract configuration file.
+# ------------------------------------------------------------------------------
+
+sub _write_ext_cfg {
+  my $self = shift;
+
+  my %cfg_labels = %{ $self->config->setting ('CFG_LABEL') };
+  my %subdir     = %{ $self->config->setting ('DIR') };
+  my %cfgname    = %{ $self->config->setting ('CFG_NAME') };
+
+  # Create new config file object and assign lines to it
+  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, TYPE => 'ext',);
+
+  # Set up config file header
+  $cfg->add_header ();
+
+  # Re-use pre-extracted expanded ext cfg
+  if (@{ $self->{USE} }) {
+    $cfg->add_comment_block ('Other ext cfg');
+
+    for my $reuse (@{ $self->{USE} }) {
+      my $rootdir = $reuse->dest ('ROOTDIR');
+      my $ext_cfg = $reuse->cfg->src;
+
+      # Default location of build config file
+      my $def_ext_cfg = catfile $rootdir, $subdir{CFG}, $cfgname{EXT};
+
+      $cfg->add_line (
+        LABEL => $cfg_labels{USE},
+        VALUE => $ext_cfg eq $def_ext_cfg ? $rootdir : $ext_cfg,
+      );
+    }
+
+    # Blank line
+    $cfg->add_line;
+  }
+
+  # Destination directories, config file, etc
+  my $dest = $self->{DEST};
+
+  $cfg->add_comment_block ('Destination');
+
+  $cfg->add_line (
+    LABEL => $cfg_labels{DEST}{ROOTDIR},
+    VALUE => $dest->{ROOTDIR},
+  );
+
+  for my $label (qw/CFG SRC CACHE/) {
+    my $dir = $label . 'DIR';
+
+    if ($dest->{$dir} ne catfile $dest->{ROOTDIR}, $subdir{$label}) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{DEST}{$dir},
+        VALUE => $dest->{$dir},
+      );
+    }
+  }
+
+  for my $name (qw/BLD EXT/) {
+    my $label = $name . '_CFG';
+
+    if ($dest->{$label} ne catfile $dest->{CFGDIR}, $cfgname{$name}) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{DEST}{$label},
+        VALUE => $dest->{$label},
+      );
+    }
+  }
+
+  # Blank line
+  $cfg->add_line;
+
+  # Remote destination directories, config file, etc
+  if ($self->{RDEST}{MACHINE}) {
+    my $rdest = $self->{RDEST};
+
+    $cfg->add_comment_block ('Remote destination');
+
+    for my $label (qw/MACHINE LOGNAME ROOTDIR/) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{RDEST}{$label},
+        VALUE => $rdest->{$label},
+      );
+    }
+
+    for my $label (qw/CFG SRC/) {
+      my $dir = $label . 'DIR';
+      if ($rdest->{$dir} ne catfile $rdest->{ROOTDIR}, $subdir{$label}) {
+        $cfg->add_line (
+          LABEL => $cfg_labels{RDEST}{$dir},
+          VALUE => $rdest->{$dir},
+        );
+      }
+    }
+
+    for my $name (qw/BLD EXT/) {
+      my $label = $name . '_CFG';
+
+      if ($rdest->{$label} ne catfile $rdest->{CFGDIR}, $cfgname{$name}) {
+        $cfg->add_line (
+          LABEL => $cfg_labels{RDEST}{$label},
+          VALUE => $rdest->{$label},
+        );
+      }
+    }
+
+    $cfg->add_line (
+      LABEL => $cfg_labels{MIRROR},
+      VALUE => $self->config->setting (qw/TOOL MIRROR/),
+    );
+
+    # Blank line
+    $cfg->add_line;
+  }
+
+  if ($self->{OVERRIDE}) {
+    $cfg->add_line (
+      LABEL => $cfg_labels{OVERRIDE},
+      VALUE => $self->{OVERRIDE} ? 1 : 0,
+    );
+    $cfg->add_line;
+  }
+
+  # Source directories
+  $cfg->add_comment_block ('Source directories');
+
+  # Set up lines in the ext cfg
+  my @lines = ();
+  for my $my_label (keys %{ $self->{SRCDIRS} }) {
+    for my $layer (@{ $self->{SRCDIRS}{$my_label}{STACK} }) {
+      next if $layer->extracted;
+
+      my $tag = $layer->package . '::' . $layer->tag;
+
+      # Repository
+      my $exists = grep {
+        $_->{LABEL} eq $cfg_labels{REPOS} . '::' . $tag;
+      } @lines;
+      push @lines, {
+        LABEL   => $cfg_labels{REPOS} . '::' . $tag,
+        VALUE   => $layer->reposroot,
+      } if not $exists;
+
+      # Version
+      $exists = grep {
+        $_->{LABEL} eq $cfg_labels{VERSION} . '::' . $tag;
+      } @lines;
+      push @lines, {
+        LABEL   => $cfg_labels{VERSION} . '::' . $tag,
+        VALUE   => $layer->version,
+      } unless $layer->user or $exists;
+
+      # Source directory
+      my ($pcks, $path);
+
+      if ($layer->reposroot) {
+        # Repository root declaration exists, print relative path
+        if ($layer->location eq $layer->reposroot) {
+          $path  = '';
+
+        } else {
+          $path  = substr ($layer->location, length ($layer->reposroot) + 1);
+        }
+        my @pcks = split /::/, $my_label;
+        shift @pcks;
+
+        if (join ('::', @pcks) eq join ('::', File::Spec->splitdir ($path))) {
+          # Print top package name if relative path matches sub-package name
+          $pcks = $layer->package;
+
+        } else {
+          # Print full sub-package name otherwise
+          $pcks = $my_label;
+        }
+
+      } else {
+        # No repository root declaration
+        # Print full path and full sub-package name
+        $path = $layer->location;
+        $pcks = $my_label;
+      }
+
+      my $length = $layer->reposroot ? length ($layer->reposroot) + 1 : 0;
+      push @lines, {
+        LABEL   => join ('::', ($cfg_labels{SRCDIR}, $pcks, $layer->tag)),
+        VALUE   => $path,
+      };
+    }
+  }
+
+  # Sort lines for specifying repository, version and source directories
+  @lines = sort {
+    my $rep_label = $cfg_labels{REPOS};
+    my $ver_label = $cfg_labels{VERSION};
+
+    if ($a->{LABEL} =~ /^$rep_label/) {
+
+      # Repository labels
+      if ($b->{LABEL} =~ /^$rep_label/) {
+        $a->{LABEL} cmp $b->{LABEL} or $a->{VALUE} cmp $b->{VALUE};
+      } else {
+        -1;
+      }
+
+    } elsif ($a->{LABEL} =~ /^$ver_label/) {
+
+      # Version labels
+      if ($b->{LABEL} =~ /^$rep_label/) {
+        1;
+      } elsif ($b->{LABEL} =~ /^$ver_label/) {
+        $a->{LABEL} cmp $b->{LABEL} or $a->{VALUE} cmp $b->{VALUE};
+      } else {
+        -1;
+      }
+    } else {
+
+      # Source directories labels
+      if ($b->{LABEL} =~ /^(?:$rep_label|$ver_label)/) {
+        1;
+      } else {
+        $a->{LABEL} cmp $b->{LABEL} or $a->{VALUE} cmp $b->{VALUE};
+      }
+
+    }
+  } @lines;
+
+  # Add lines for specifying repository, version and source directories
+  while (my $line = shift @lines) {
+    $cfg->add_line (
+      LABEL => $line->{LABEL},
+      VALUE => $line->{VALUE},
+    );
+  }
+
+  # Add declared bld cfg entries
+  if (@{ $self->{BDECLARE} }) {
+    # Blank line
+    $cfg->add_line;
+
+    $cfg->add_comment_block ('Declared bld cfg entries');
+    for my $bdeclare (@{ $self->{BDECLARE} }) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{BDECLARE} . '::' . $bdeclare->{LABEL},
+        VALUE => $bdeclare->{VALUE},
+      );
+    }
+  }
+
+  # Print lines to config file
+  $cfg->print_cfg ($self->{DEST}{EXT_CFG});
+
+  return 1;
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_write_bld_cfg ();
+#
+# DESCRIPTION
+#   This internal method writes the build configuration file.
+# ------------------------------------------------------------------------------
+
+sub _write_bld_cfg {
+  my $self = shift;
+
+  my %cfg_labels = %{ $self->config->setting ('CFG_LABEL') };
+  my %subdir     = %{ $self->config->setting ('DIR') };
+  my %cfgname    = %{ $self->config->setting ('CFG_NAME') };
+
+  # Create new config file object and assign lines to it
+  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, TYPE => 'bld');
+
+  # Set up config file header
+  $cfg->add_header ();
+
+  # Pre-compile source
+  if (@{ $self->{USE} }) {
+    $cfg->add_comment_block ('Pre-compile source');
+
+    for my $reuse (@{ $self->{USE} }) {
+      my $rootdir;
+      my $bld_cfg;
+
+      if ($self->{RDEST}{MACHINE}) {
+        $rootdir = $reuse->rdest ('ROOTDIR');
+        $bld_cfg = $reuse->rdest ('BLD_CFG');
+      } else {
+        $rootdir = $reuse->dest ('ROOTDIR');
+        $bld_cfg = $reuse->dest ('BLD_CFG');
+      }
+
+      # Default location of build config file
+      my $def_bld_cfg = catfile $rootdir, $subdir{CFG}, $cfgname{BLD};
+
+      $cfg->add_line (
+        LABEL => $cfg_labels{USE},
+        VALUE => $bld_cfg eq $def_bld_cfg ? $rootdir : $bld_cfg,
+      );
+    }
+
+    # Blank line
+    $cfg->add_line;
+  }
+
+  # Add declared bld cfg entries
+  if (@{ $self->{BDECLARE} }) {
+    $cfg->add_comment_block ('Declared build options...');
+
+    my @bdeclares = sort {$a->{LABEL} cmp $b->{LABEL}} @{ $self->{BDECLARE} };
+    for my $bdeclare (@bdeclares) {
+      $cfg->add_line (
+        LABEL => $bdeclare->{LABEL},
+        VALUE => $bdeclare->{VALUE},
+      );
+    }
+
+    # Blank line
+    $cfg->add_line;
+  }
+
+  # Add source directories to config file
+  $cfg->add_comment_block ('Project directory tree');
+
+  my $dest = $self->{RDEST}{MACHINE} ? $self->{RDEST} : $self->{DEST};
+  $cfg->add_line (
+    LABEL => $cfg_labels{DIR} . '::ROOT',
+    VALUE => $dest->{ROOTDIR},
+  );
+  for my $label (qw/SRC CFG/) {
+    my $dir = $label . 'DIR';
+    if ($dest->{$dir} ne catfile $dest->{ROOTDIR}, $subdir{$label}) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{DIR} . '::' . $label,
+        VALUE => $dest->{$dir},
+      );
+    }
+  }
+
+  # Blank line
+  $cfg->add_line;
+
+  # Add source directories to config file
+  $cfg->add_comment_block ('Source directories');
+
+  $cfg->add_line (LABEL => $cfg_labels{SEARCH_SRC}, VALUE => '0',);
+  $cfg->add_line;
+
+  for my $srcdir (sort keys %{ $self->{SRCDIRS} }) {
+
+    if (-d $self->{SRCDIRS}{$srcdir}{DEST}) {
+      # Check whether pre-extracted source exists
+      my $pre_extracted = grep {
+        $_->extracted;
+      } @{ $self->{SRCDIRS}{$srcdir}{STACK} };
+
+      # Source directory
+      my $dest = undef;
+      if ($self->{RDEST}{MACHINE}) {
+        my $base = substr $self->{SRCDIRS}{$srcdir}{DEST},
+                          length ($self->{DEST}{SRCDIR}) + 1;
+        $dest    = catfile $self->{RDEST}{SRCDIR}, $base;
+      } else {
+        $dest = $self->{SRCDIRS}{$srcdir}{DEST}
+      }
+
+      # Source directory label
+      my $label = join '::', ($cfg_labels{SRCDIR}, $srcdir);
+
+      $cfg->add_line (LABEL => $label, VALUE => $dest,)
+    }
+
+  }
+
+  # Print lines to config file
+  $cfg->print_cfg ($self->{DEST}{BLD_CFG});
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_mirror_extract ();
+#
+# DESCRIPTION
+#   This internal method mirrors the current extract to a remote machine.
+# ------------------------------------------------------------------------------
+
+sub _mirror_extract {
+  my $self = shift;
+
+  # Needs mirroring only if remote machine is set
+  return unless $self->{RDEST}{MACHINE};
+
+  my $verbose = $self->config->verbose;
+
+  my $mirror = $self->config->setting (qw/TOOL MIRROR/);
+
+  if ($mirror eq 'rdist') {
+    # Use "rdist" to mirror extract
+
+    # Variable for "remote_logname@remote_machine"
+    my $rhost = $self->{RDEST}{LOGNAME} . '@' . $self->{RDEST}{MACHINE};
+
+    # Print distfile content to temporary file
+    my @distfile = ();
+    for my $my_label (qw/BLD_CFG EXT_CFG SRCDIR/) {
+      push @distfile, '( ' . $self->{DEST}{$my_label} . ' ) -> ' . $rhost . "\n";
+      push @distfile, '  install ' . $self->{RDEST}{$my_label} . ';' . "\n";
+    }
+
+    # Set up mirroring command (use "rdist" at the moment)
+    my $command = 'rdist -R';
+    $command   .= ' -q' unless $verbose > 1;
+    $command   .= ' -f - 1>/dev/null';
+
+    # Diagnostic
+    my $croak = 'Cannot execute "' . $command . '"';
+    if ($verbose > 2) {
+      print timestamp_command ($command, 'Start');
+      print '  ', $_ for (@distfile);
+    }
+
+    # Execute the mirroring command
+    open COMMAND, '|-', $command or croak $croak, ' (', $!, '), abort';
+    for my $line (@distfile) {
+      print COMMAND $line;
+    }
+    close COMMAND or croak $croak, ' (', $?, '), abort';
+
+    # Diagnostic
+    print timestamp_command ($command, 'End  ') if $verbose > 2;
+
+  } elsif ($mirror eq 'rsync') {
+    # Use "rsync" to mirror extract
+
+    my $rsh = $self->config->setting (qw/TOOL REMOTE_SHELL/);
+
+    # Variable for "remote_logname@remote_machine"
+    my $rhost = $self->{RDEST}{LOGNAME} . '@' . $self->{RDEST}{MACHINE};
+
+    for my $my_label (qw/BLD_CFG EXT_CFG SRCDIR/) {
+      my $rdir = dirname $self->{RDEST}{$my_label}; # remote container directory
+
+      {
+        # Create remote container directory with remote shell command
+        my @command = (
+          $rsh, $self->{RDEST}{MACHINE}, '-n', '-l', $self->{RDEST}{LOGNAME},
+          qw/mkdir -p/, $rdir,
+        );
+
+        # Execute command
+        &run_command (\@command, TIME => $verbose > 2);
+      }
+
+      {
+        # Build the rsync command
+        my @command = qw/rsync -a --exclude='.*' --delete-excluded/;
+        push @command, '-v' if $verbose > 2;
+        push @command, $self->{DEST}{$my_label};
+        push @command, $rhost . ':' . $rdir;
+
+        # Execute command
+        &run_command (\@command, TIME => $verbose > 2);
+      }
+    }
+
+  } else {
+    w_report $mirror, ': unknown mirroring tool, abort.';
+    return;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/ReposBranch.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/ReposBranch.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/ReposBranch.pm	(revision 5166)
@@ -0,0 +1,516 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::ReposBranch
+#
+# DESCRIPTION
+#   This class contains methods for gathering information for a repository
+#   branch. It currently supports Subversion repository and local user
+#   directory.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::ReposBranch;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+use File::Spec::Functions;
+use File::Basename;
+use File::Find;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch = Fcm::ReposBranch->new (
+#     CONFIG  => $config,
+#     PACKAGE => $package,
+#     TAG     => $tag,
+#     REPOS   => $repos,
+#     VERSION => $version,
+#     TYPE    => $type,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::ReposBranch class.
+#
+# ARGUMENTS
+#   CONFIG  - reference to a Fcm::Config instance
+#   PACKAGE - package name of which this repository belongs
+#   TAG     - "tag" name of this branch of the repository
+#   REPOS   - repository branch root URL/path
+#   VERSION - this version of the branch is used by the extract
+#   TYPE    - repository type
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG  => (exists $args{CONFIG}  ? $args{CONFIG}  : &main::cfg),
+    PACKAGE => (exists $args{PACKAGE} ? $args{PACKAGE} : undef),
+    TAG     => (exists $args{TAG}     ? $args{TAG}     : undef),
+    REPOS   => (exists $args{REPOS}   ? $args{REPOS}   : undef),
+    VERSION => (exists $args{VERSION} ? $args{VERSION} : undef),
+    TYPE    => (exists $args{TYPE}    ? $args{TYPE}    : undef),
+
+    # Use this list of directories in this branch
+    DIRS    => {},
+
+    # Expand this list of directories in this branch
+    EXPDIRS => {},
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $branch->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package = $branch->package;
+#   $branch->package ($package);
+#
+# DESCRIPTION
+#   This method returns the package name of this repository branch. If an
+#   argument is specified, the name is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub package {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PACKAGE} = shift;
+  }
+
+  return $self->{PACKAGE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $tag = $branch->tag;
+#   $branch->tag ($tag);
+#
+# DESCRIPTION
+#   This method returns the tag name of this repository branch. If an
+#   argument is specified, the name is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub tag {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TAG} = shift;
+  }
+
+  return $self->{TAG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $repos = $branch->repos;
+#   $branch->repos ($repos);
+#
+# DESCRIPTION
+#   This method returns the URL/path name of this repository branch. If an
+#   argument is specified, the URL/path is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub repos {
+  my $self = shift;
+
+  if (@_) {
+    $self->{REPOS} = shift;
+  }
+
+  return $self->{REPOS};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version= $branch->version;
+#   $branch->version ($version);
+#
+# DESCRIPTION
+#   This method returns the revision number of this repository branch. If an
+#   argument is specified, the revision is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub version {
+  my $self = shift;
+
+  if (@_) {
+    $self->{VERSION} = shift;
+  }
+
+  return $self->{VERSION};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $branch->type;
+#   $branch->type ($type);
+#
+# DESCRIPTION
+#   This method returns the repository type ("svn" or "user"). If an
+#   argument is specified, the type is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub type {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TYPE} = shift;
+  }
+
+  return $self->{TYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $branch->dir ($name);
+#   $branch->dir ($name, $dir);
+#
+# DESCRIPTION
+#   This method returns the path to the source directory with sub-package name
+#   $name. If $dir is specified, the path is set to its value.
+# ------------------------------------------------------------------------------
+
+sub dir {
+  my $self = shift;
+  my $name = shift;
+
+  if (@_) {
+    $self->{DIRS}{$name} = $_[0];
+  }
+
+  if (exists $self->{DIRS}{$name}) {
+    return $self->{DIRS}{$name};
+
+  } else {
+    return undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %dirs = $branch->dirs;
+#
+# DESCRIPTION
+#   This method returns a hash containing the source directories of this
+#   repository. The keys of the hash are the sub-package names, and the values
+#   of the hash are the URL/path to the source directories.
+# ------------------------------------------------------------------------------
+
+sub dirs {
+  my $self = shift;
+
+  return %{ $self->{DIRS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $branch->expdir ($name);
+#   $branch->expdir ($name, $dir);
+#
+# DESCRIPTION
+#   This method returns the path to the expandable source directory with
+#   sub-package name $name. If $dir is specified, the path is set to its
+#   value.
+# ------------------------------------------------------------------------------
+
+sub expdir {
+  my $self = shift;
+  my $name = shift;
+
+  if (@_) {
+    $self->{EXPDIRS}{$name} = $_[0];
+  }
+
+  if (exists $self->{EXPDIRS}{$name}) {
+    return $self->{EXPDIRS}{$name};
+
+  } else {
+    return undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %dirs = $branch->expdirs;
+#
+# DESCRIPTION
+#   This method returns a hash containing the expandable source directories of
+#   this repository. The keys of the hash are the sub-package names, and the
+#   values of the hash are the URL/path to the expandable source directories.
+# ------------------------------------------------------------------------------
+
+sub expdirs {
+  my $self = shift;
+
+  return %{ $self->{EXPDIRS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch->expand_version_tag;
+#
+# DESCRIPTION
+#   This method expands the VERSION of the current repository branch to a
+#   revision number.
+# ------------------------------------------------------------------------------
+
+sub expand_version_tag {
+  my $self = shift;
+
+  if ($self->type eq 'svn') {
+    # Expand revision keyword
+    my $rev = expand_rev_keyword (
+      REV  => $self->version,
+      URL  => $self->repos,
+      HEAD => 1,
+    );
+
+    # Find out whether the specified revision is current or not
+    if (uc ($self->version) ne 'HEAD' and $self->config->verbose > 1) {
+      # Get last commit revision
+      my $lc_rev = expand_rev_keyword (
+        REV => 'HEAD',
+        URL => $self->repos,
+      );
+
+      # Print information if used rev is less than the last commit rev
+      print 'Info: using rev ', $rev, ' of ', $self->repos,
+            ', last commit rev is ', $lc_rev, ".\n"
+        if $rev < $lc_rev;
+    }
+
+    $self->version ($rev) if $rev ne $self->version;
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    e_report $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch->expand_path;
+#
+# DESCRIPTION
+#   This method expands the relative path names of sub-directories to full
+#   path names. It returns 1 on success.
+# ------------------------------------------------------------------------------
+
+sub expand_path {
+  my $self = shift;
+
+  my $separator = $self->{CONFIG}->setting (qw/MISC DIR_SEPARATOR/);
+
+  if ($self->type eq 'svn') {
+    # SVN repository
+    # Do nothing unless there is a declared repository for this branch
+    return unless $self->{REPOS};
+
+    # Remove trailing /
+    $self->{REPOS} =~ s/$separator+$//;
+
+    # Consider all declared (expandable) sub-directories
+    for my $name (qw/DIRS EXPDIRS/) {
+      for my $dir (keys %{ $self->{$name} }) {
+        # Do nothing if declared sub-directory is quoted as a full URL
+        next if &is_url ($self->{$name}{$dir});
+
+        # Expand sub-directory to full URL
+        $self->{$name}{$dir} = $self->{REPOS} . (
+          $self->{$name}{$dir} ? ($separator . $self->{$name}{$dir}) : ''
+        );
+      }
+    }
+    # Note: "catfile" cannot be used in the above statement because it has
+    #       the tendency of removing a slash from double slashes.
+
+  } elsif ($self->type eq 'user') {
+    # Local user directories
+
+    # Expand leading ~ for all declared (expandable) sub-directories
+    for my $name (qw/DIRS EXPDIRS/) {
+      for my $dir (keys %{ $self->{$name} }) {
+        $self->{$name}{$dir} = expand_tilde $self->{$name}{$dir};
+      }
+    }
+
+    # A top directory for the source is declared
+    if ($self->{REPOS}) {
+      # Expand leading ~ for the top directory
+      $self->{REPOS} = expand_tilde $self->{REPOS};
+
+      # Get the root directory of the file system
+      my $rootdir = File::Spec->rootdir ();
+
+      # Expand top directory to absolute path, if necessary
+      $self->{REPOS} = File::Spec->rel2abs ($self->{REPOS})
+        if $self->{REPOS} !~ m/^$rootdir/;
+
+      # Remove trailing /
+      $self->{REPOS} =~ s/$separator+$//;
+
+      # Consider all declared (expandable) sub-directories
+      for my $name (qw/DIRS EXPDIRS/) {
+        for my $dir (keys %{ $self->{$name} }) {
+          # Do nothing if declared sub-directory is quoted as a full path
+          next if $self->{$name}{$dir} =~ m#^$rootdir#;
+
+          # Expand sub-directory to full path
+          $self->{$name}{$dir} = $self->{$name}{$dir}
+                               ? catfile ($self->{REPOS}, $self->{$name}{$dir})
+                               : $self->{REPOS};
+        }
+      }
+    }
+
+  } else {
+    e_report $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch->expand_all;
+#
+# DESCRIPTION
+#   This method searches the expandable source directories recursively for
+#   source directories containing regular files. These sub-directories are
+#   then added to the source directory list. The method returns total number
+#   of sub-directories to be extracted from the current repository.
+# ------------------------------------------------------------------------------
+
+sub expand_all {
+  my $self = shift;
+
+  my %dirs = ();
+
+  # Directory separator for SVN repository
+  my $separator = $self->{CONFIG}->setting (qw/MISC DIR_SEPARATOR/);
+
+  if ($self->type eq 'user') {
+    for my $rootname (keys %{ $self->{EXPDIRS} }) {
+      my %subdirs = find_srcdir $self->{EXPDIRS}{$rootname}, $rootname, '::';
+
+      for my $key (keys %subdirs) {
+        $dirs{$key} = $subdirs{$key};
+      }
+    }
+
+  } elsif  ($self->type eq 'svn') {
+    for my $rootname (keys %{ $self->{EXPDIRS} }) {
+      # Execute the "svn ls -R" command
+      my @lines   = &run_command (
+        [qw/svn ls -R/, $self->{EXPDIRS}{$rootname} . '@' . $self->{VERSION}],
+        METHOD => 'qx', TIME => $self->config->verbose > 2,
+      );
+
+      # Get list of sub-directories containing source files
+      for my $line (@lines) {
+        chomp $line;
+        next if $line =~ /$separator$/;
+
+        my $dir = dirname $line;
+
+        my @pck = split /::/, $rootname;
+        push @pck, (File::Spec->splitdir ($dir)) unless $dir eq '.';
+        my $pck = join '::', @pck;
+
+        my $val = $self->{EXPDIRS}{$rootname};
+        $val   .= $separator . $dir unless $dir eq '.';
+
+        $dirs{$pck} = $val;
+      }
+    }
+
+  } else {
+    e_report $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+  }
+
+  for my $key (keys %dirs) {
+    $self->{DIRS}{$key} = $dirs{$key};
+  }
+
+  return scalar keys %dirs;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch->add_base_dirs ($base);
+#
+# DESCRIPTION
+#   Add a list of source directories to the current branch based on the set
+#   provided by $base, which must be a reference to a Fcm::ReposBranch
+#   instance. It returns the total number of used sub-directories in the
+#   current repositories.
+# ------------------------------------------------------------------------------
+
+sub add_base_dirs {
+  my $self = shift;
+  my $base = shift;
+
+  my %base_dirs = $base->dirs;
+
+  for my $key (keys %base_dirs) {
+    # Remove repository root from base directories
+    if ($base_dirs{$key} eq $base->repos) {
+      $base_dirs{$key} = '';
+
+    } else {
+      $base_dirs{$key} = substr $base_dirs{$key}, length ($base->repos) + 1;
+    }
+
+    # Append base directories to current repository root
+    $self->dir ($key, $base_dirs{$key}); 
+  }
+
+  # Expand relative path names of sub-directories
+  $self->expand_path;
+
+  return scalar keys %{ $self->{DIRS} };
+  
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcDirLayer.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcDirLayer.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcDirLayer.pm	(revision 5166)
@@ -0,0 +1,481 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::SrcDirLayer
+#
+# DESCRIPTION
+#   This class contains methods to manipulate the extract of a source
+#   directory from a branch of a (Subversion) repository.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::SrcDirLayer;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+use File::Spec::Functions;
+use File::Basename;
+use File::Path;
+use File::Compare;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $layer = Fcm::SrcDirLayer->new (
+#     CONFIG    => $config,
+#     NAME      => $dir,
+#     PACKAGE   => $package,
+#     TAG       => $tag,
+#     LOCATION  => $loc,
+#     REPOSROOT => $repos,
+#     VERSION   => $ver,
+#     TYPE      => $type,
+#     COMMIT    => $com,
+#     EXTRACTED => $ext,
+#     CACHEDIR  => $cac,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::SrcDirLayer class.
+#
+# ARGUMENTS
+#   CONFIG    - reference to a Fcm::Config instance
+#   NAME      - sub-package name of the source directory
+#   PACKAGE   - top level package name of which the current repository belongs
+#   TAG       - package/revision tag of the current repository branch
+#   LOCATION  - location of the source directory in the branch
+#   REPOSROOT - repository root URL
+#   VERSION   - revision of the repository branch
+#   TYPE      - type of the repository branch ("svn" or "user")
+#   COMMIT    - revision at which the source directory was changed
+#   EXTRACTED - is this branch already extracted?
+#   CACHEDIR  - cache directory for this directory branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG    => (exists $args{CONFIG}    ? $args{CONFIG}    : &main::cfg),
+    NAME      => (exists $args{NAME}      ? $args{NAME}      : undef),
+    PACKAGE   => (exists $args{PACKAGE}   ? $args{PACKAGE}   : undef),
+    TAG       => (exists $args{TAG}       ? $args{TAG}       : undef),
+    LOCATION  => (exists $args{LOCATION}  ? $args{LOCATION}  : undef),
+    REPOSROOT => (exists $args{REPOSROOT} ? $args{REPOSROOT} : undef),
+    VERSION   => (exists $args{VERSION}   ? $args{VERSION}   : undef),
+    TYPE      => (exists $args{TYPE}      ? $args{TYPE}      : undef),
+    COMMIT    => (exists $args{COMMIT}    ? $args{COMMIT}    : undef),
+    EXTRACTED => (exists $args{EXTRACTED} ? $args{EXTRACTED} : undef),
+    CACHEDIR  => (exists $args{CACHEDIR}  ? $args{CACHEDIR}  : undef),
+
+    # List of source files in this directory branch
+    FILES     => [],
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $layer->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $layer->name;
+#   $layer->name ($name);
+#
+# DESCRIPTION
+#   This method returns the sub-package name of the current source directory.
+#   If an argument is specified, the sub-package name is set to the value of
+#   the argument.
+# ------------------------------------------------------------------------------
+
+sub name {
+  my $self = shift;
+
+  if (@_) {
+    $self->{NAME} = shift;
+  }
+
+  return $self->{NAME};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package = $layer->package;
+#   $layer->package ($package);
+#
+# DESCRIPTION
+#   This method returns the top level package name in which the current source
+#   directory belongs. If an argument is specified, the package name is set to
+#   the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub package {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PACKAGE} = shift;
+  }
+
+  return $self->{PACKAGE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $tag = $layer->tag;
+#   $layer->tag ($tag);
+#
+# DESCRIPTION
+#   This method returns the branch/revision tag of the current repository
+#   branch. If an argument is specified, the tag is set to the value of the
+#   argument.
+# ------------------------------------------------------------------------------
+
+sub tag {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TAG} = shift;
+  }
+
+  return $self->{TAG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $location = $layer->location;
+#   $layer->location ($location);
+#
+# DESCRIPTION
+#   This method returns the URL/location of the source directory in the
+#   branch. If an argument is specified, the location is set to the value of
+#   the argument.
+# ------------------------------------------------------------------------------
+
+sub location {
+  my $self = shift;
+
+  if (@_) {
+    $self->{LOCATION} = shift;
+  }
+
+  return $self->{LOCATION};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $reposroot = $layer->reposroot;
+#   $layer->reposroot ($reposroot);
+#
+# DESCRIPTION
+#   This method returns the URL/location of the repository root of this
+#   branch. If an argument is specified, the location is set to the value of
+#   the argument.
+# ------------------------------------------------------------------------------
+
+sub reposroot {
+  my $self = shift;
+
+  if (@_) {
+    $self->{REPOSROOT} = shift;
+  }
+
+  return $self->{REPOSROOT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version = $layer->version;
+#   $layer->version ($version);
+#
+# DESCRIPTION
+#   This method returns the revision number of this branch. If an argument is
+#   specified, the revision number is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub version {
+  my $self = shift;
+
+  if (@_) {
+    $self->{VERSION} = shift;
+  }
+
+  return $self->{VERSION};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $layer->type;
+#   $layer->type ($type);
+#
+# DESCRIPTION
+#   This method returns the repository type ("svn" or "user"). If an argument is
+#   specified, the type is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub type {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TYPE} = shift;
+  }
+
+  return $self->{TYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version = $layer->commit;
+#   $layer->commit ($version);
+#
+# DESCRIPTION
+#   This method returns the last modified revision of the source directory in
+#   the branch. If an argument is specified, this revision is set to the value
+#   of the argument.
+# ------------------------------------------------------------------------------
+
+sub commit {
+  my $self = shift;
+
+  if (@_) {
+    $self->{COMMIT} = shift;
+  }
+
+  return $self->{COMMIT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $extracted = $layer->extracted;
+#   $layer->extracted ($extracted);
+#
+# DESCRIPTION
+#   This method returns the "extracted flag" of the source directory branch
+#   If an argument is specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub extracted {
+  my $self = shift;
+
+  if (@_) {
+    $self->{EXTRACTED} = shift;
+  }
+
+  return $self->{EXTRACTED};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $layer->cachedir;
+#   $layer->cachedir ($dir);
+#
+# DESCRIPTION
+#   This method returns the cache directory of the source directory branch
+#   If an argument is specified, the cache directory is set to the value of
+#   the argument.
+# ------------------------------------------------------------------------------
+
+sub cachedir {
+  my $self = shift;
+
+  if (@_) {
+    my $dir = shift;
+    $self->{CACHEDIR} = $dir;
+  }
+
+  return $self->{CACHEDIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $layer->localdir;
+#
+# DESCRIPTION
+#   This method returns the user or cache directory for the current revision
+#   of the repository branch.
+# ------------------------------------------------------------------------------
+
+sub localdir {
+  my $self = shift;
+
+  return $self->user ? $self->{LOCATION} : $self->{CACHEDIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @files = $layer->files;
+#
+# DESCRIPTION
+#   This method returns a list of regular files in this directory branch.
+#   This method should only be called after a successful operation of the
+#   get_files method that will be described below.
+# ------------------------------------------------------------------------------
+
+sub files {
+  my $self = shift;
+
+  return @{ $self->{FILES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $user = $layer->user;
+#
+# DESCRIPTION
+#   This method returns the string "user" if the current source directory
+#   branch is a local directory. Otherwise, it returns "undef".
+# ------------------------------------------------------------------------------
+
+sub user {
+  my $self = shift;
+
+  return $self->{TYPE} eq 'user' ? 'user' : undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version = $layer->get_commit;
+#
+# DESCRIPTION
+#   If the current repository type is "svn", this method attempts to obtain
+#   the revision in which the branch is last committed. On a successful
+#   operation, it returns this revision number. Otherwise, it returns
+#   "undef".
+# ------------------------------------------------------------------------------
+
+sub get_commit {
+  my $self = shift;
+
+  if ($self->type eq 'svn') {
+    # Execute the "svn info" command
+    my @lines   = &run_command (
+      [qw/svn info/, $self->{LOCATION} . '@' . $self->{VERSION}],
+      METHOD => 'qx', TIME => $self->config->verbose > 2,
+    );
+
+    my $rev;
+    for (@lines) {
+      if (/^Last\s+Changed\s+Rev\s*:\s*(\d+)/i) {
+        $rev = $1;
+        last;
+      }
+    }
+
+    # Commit version of this source directory
+    $self->{COMMIT} = $rev;
+
+    return $self->{COMMIT};
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    e_report 'Repository type "', $self->type, '" not supported.';
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $layer->update_cache;
+#
+# DESCRIPTION
+#   If the current repository type is "svn", this method attempts to extract
+#   the current version source directory from the current branch from the
+#   repository, sending the output to the cache directory. It returns true on
+#   a successful operation, or false if the repository is not of type "svn".
+# ------------------------------------------------------------------------------
+
+sub update_cache {
+  my $self = shift;
+
+  return unless $self->{CACHEDIR};
+
+  # Create cache extract destination, if necessary
+  my $dirname = dirname $self->{CACHEDIR};
+  mkpath $dirname if not -d $dirname;
+
+  e_report $dirname, ': cannot write to cache, abort.'
+    unless -d $dirname and -w $dirname;
+  
+  if ($self->type eq 'svn') {
+    # Set up the extract command, "svn export --force -q -N"
+    my @command = (
+      qw/svn export --force -q -N/,
+      $self->{LOCATION} . '@' . $self->{VERSION},
+      $self->{CACHEDIR},
+    );
+
+    &run_command (\@command, TIME => $self->config->verbose > 2);
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    e_report 'Repository type "', $self->type, '" not supported.';
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @files = $layer->get_files;
+#
+# DESCRIPTION
+#   This method returns a list of files in the cache or local user directory
+#   of the current version of the source directory in the current branch.
+# ------------------------------------------------------------------------------
+
+sub get_files {
+  my $self = shift;
+
+  # Get a list of files in the cache (or local user) directory
+  my @files = ();
+
+  opendir (DIR, $self->localdir)
+    or die $self->localdir, ': cannot read directory';
+
+  while (my $file = readdir DIR) {
+    next if $file =~ /^\.\.?/;                   # ignore . and .. and hidden
+    next if $file =~ /~$/;                       # ignore emacs swap files
+    next if -d catfile ($self->localdir, $file); # ignore sub-directories
+    push @files, $file;
+  }
+  closedir DIR;
+
+  # Return the (base name) of the list of files
+  $self->{FILES} = \@files;
+  return @files;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcFile.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcFile.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcFile.pm	(revision 5166)
@@ -0,0 +1,1538 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::SrcFile
+#
+# DESCRIPTION
+#   This class contains methods to manipulate the build process of a source
+#   file of supported type.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::SrcFile;
+
+# Standard pragma
+
+use strict;
+use warnings;
+
+# Standard modules
+use Cwd;
+use Carp;
+use File::Basename;
+use File::Spec;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::Timer;
+
+# Other modules
+use Ecmwf::Fortran90_stuff ();
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcfile = Fcm::SrcFile->new (
+#     CONFIG     => $config,
+#     SRCPACKAGE => $srcpackage,
+#     SRC        => $src,
+#     PPSRC      => $ppsrc,
+#     TYPE       => $type,
+#     SCAN       => $scan,
+#     EXEBASE    => $exebase,
+#     PCKCFG     => $pckcfg,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::SrcFile class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   SRCPACKAGE - reference to the container Fcm::SrcPackage instance
+#   SRC        - source path of this file
+#   PPSRC      - pre-processed source path of this file
+#   TYPE       - type flag of this source file
+#   SCAN       - scan source file for dependency?
+#   EXEBASE    - name of executable
+#   PCKCFG     - this source file is modified by a package cfg?
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG     => exists $args{CONFIG}     ? $args{CONFIG}     : &main::cfg,
+    SRCPACKAGE => exists $args{SRCPACKAGE} ? $args{SRCPACKAGE} : undef,
+    SRC        => exists $args{SRC}        ? $args{SRC}        : undef,
+    PPSRC      => exists $args{PPSRC}      ? $args{PPSRC}      : undef,
+    TYPE       => exists $args{TYPE}       ? $args{TYPE}       : undef,
+    SCAN       => exists $args{SCAN}       ? $args{SCAN}       : 1,
+    EXEBASE    => exists $args{EXEBASE}    ? $args{EXEBASE}    : undef,
+    PCKCFG     => exists $args{PCKCFG}     ? $args{PCKCFG}     : undef,
+
+    PROGNAME   => undef,
+    LANG       => undef,
+    DEP        => {}, 
+    RULES      => {},
+  };
+  bless $self, $class;
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $srcfile->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcpackage = $srcfile->srcpackage;
+#   $srcfile->srcpackage ($srcpackage);
+#
+# DESCRIPTION
+#   This method returns the reference to the container Fcm::SrcPackage of this
+#   source file. If an argument is specified, the reference is set to the
+#   value of the argument.
+# ------------------------------------------------------------------------------
+
+sub srcpackage {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SRCPACKAGE} = shift;
+  }
+
+  return $self->{SRCPACKAGE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $src = $srcfile->src;
+#   $srcfile->src ($src);
+#
+# DESCRIPTION
+#   This method returns the reference to the location of this source file. If
+#   an argument is specified, the location is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub src {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SRC} = shift;
+  }
+
+  return $self->{SRC};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ppsrc = $srcfile->ppsrc;
+#   $srcfile->ppsrc ($ppsrc);
+#
+# DESCRIPTION
+#   This method returns the reference to the location of the pre-processed
+#   file of this source file. If an argument is specified, the location is set
+#   to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub ppsrc {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PPSRC} = shift;
+  }
+
+  return $self->{PPSRC};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $time = $srcfile->mtime;
+#
+# DESCRIPTION
+#   This method returns the last modified time of the source file. If a
+#   pre-processed version of the source file exists, it returns the last
+#   modified time of the pre-processed source file instead.
+# ------------------------------------------------------------------------------
+
+sub mtime {
+  my $self = shift;
+
+  return $self->{PPSRC} ? (stat $self->{PPSRC})[9] : (stat $self->{SRC})[9];
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $srcfile->base;
+#
+# DESCRIPTION
+#   This method returns the base name of the source file.
+# ------------------------------------------------------------------------------
+
+sub base {
+  my $self = shift;
+
+  return basename ($self->{SRC});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ppbase = $srcfile->ppbase;
+#
+# DESCRIPTION
+#   This method returns the base name of the pre-processed source file.
+# ------------------------------------------------------------------------------
+
+sub ppbase {
+  my $self = shift;
+
+  return basename ($self->{PPSRC});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $interfacebase = $srcfile->interfacebase;
+#
+# DESCRIPTION
+#   This method returns the base name of the F9X interface file.
+# ------------------------------------------------------------------------------
+
+sub interfacebase {
+  my $self   = shift;
+  my $return = undef;
+
+  if ($self->is_type_or (qw/FORTRAN FPP/) and
+      uc ($self->select_tool ('GENINTERFACE')) ne 'NONE' and
+      not $self->is_type_or (qw/PROGRAM MODULE/)) {
+
+    my $flag = lc ($self->select_tool ('INTERFACE'));
+    my $ext  = $self->config->setting (qw/OUTFILE_EXT INTERFACE/);
+
+    $return = ($flag eq 'program' ? $self->intname : $self->root) . $ext;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $root = $srcfile->root;
+#
+# DESCRIPTION
+#   This method returns the root name (i.e. base name without file extension)
+#   of the source file.
+# ------------------------------------------------------------------------------
+
+sub root {
+  my $self = shift;
+
+  (my $root = $self->base) =~ s/\.\w+$//;
+
+  return $root;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext = $srcfile->ext;
+#
+# DESCRIPTION
+#   This method returns the file extension of the source file.
+# ------------------------------------------------------------------------------
+
+sub ext {
+  my $self = shift;
+
+  return substr $self->base, length ($self->root);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ppext = $srcfile->ppext;
+#
+# DESCRIPTION
+#   This method returns the file extension of the pre-processed source file.
+# ------------------------------------------------------------------------------
+
+sub ppext {
+  my $self = shift;
+
+  return substr $self->ppbase, length ($self->root);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $srcfile->dir;
+#
+# DESCRIPTION
+#   This method returns the dir name of the source file.
+# ------------------------------------------------------------------------------
+
+sub dir {
+  my $self = shift;
+
+  return dirname ($self->{SRC});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ppdir = $srcfile->ppdir;
+#
+# DESCRIPTION
+#   This method returns the dir name of the pre-processed source file.
+# ------------------------------------------------------------------------------
+
+sub ppdir {
+  my $self = shift;
+
+  return dirname ($self->{PPSRC});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $progname = $srcfile->progname();
+#   $srcfile->progname ($progname);
+#
+# DESCRIPTION
+#   This method returns the name of the first program unit in a Fortran source
+#   file. If an argument is specified, the name is set to the value of the
+#   argument.
+# ------------------------------------------------------------------------------
+
+sub progname {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PROGNAME} = $_[0];
+  }
+
+  return $self->{PROGNAME};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $intname = $srcfile->intname ();
+#
+# DESCRIPTION
+#   This method returns the internal name of the source file.
+# ------------------------------------------------------------------------------
+
+sub intname {
+  my $self = shift;
+
+  return $self->progname ? $self->progname : lc ($self->root);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $objbase = $srcfile->objbase ();
+#
+# DESCRIPTION
+#   If the source file contains a compilable procedure, this method returns
+#   the name of the object file.
+# ------------------------------------------------------------------------------
+
+sub objbase {
+  my $self   = shift;
+  my $return = undef;
+
+  if ($self->is_type ('SOURCE')) {
+    my $ext = $self->config->setting (qw/OUTFILE_EXT OBJ/);
+
+    if ($self->is_type_or (qw/FORTRAN FPP/)) {
+      $return = $self->progname . $ext if $self->progname;
+
+    } else {
+      $return = $self->intname . $ext;
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $donebase = $srcfile->donebase ();
+#
+# DESCRIPTION
+#   This method returns the DONE file for a source file containing a compilable
+#   procedure, or the IDONE file for an include file.
+# ------------------------------------------------------------------------------
+
+sub donebase {
+  my $self   = shift;
+  my $return = undef;
+
+  if ($self->is_type ('SOURCE')) {
+    if ($self->objbase and not $self->is_type ('PROGRAM')) {
+      $return = $self->intname . $self->config->setting (qw/OUTFILE_EXT DONE/);
+    }
+
+  } elsif ($self->is_type ('INCLUDE')) {
+    $return = $self->base . $self->config->setting (qw/OUTFILE_EXT IDONE/);
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $exebase = $srcfile->exebase ();
+#   $srcfile->exebase ($exebase);
+#
+# DESCRIPTION
+#   If the source file contains a compilable main program, this method returns
+#   the executable name. If an argument is specified, the executable name is
+#   set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub exebase {
+  my $self = shift;
+
+  if (@_) {
+    $self->{EXEBASE} = $_[0];
+  }
+
+  my $return;
+
+  if ($self->objbase and $self->is_type ('PROGRAM')) {
+    if ($self->config->setting ('EXE_NAME', $self->root)) {
+      $return = $self->config->setting ('EXE_NAME', $self->root);
+
+    } elsif ($self->{EXEBASE}) {
+      $return = $self->{EXEBASE};
+
+    } else {
+      $return = $self->root . $self->config->setting (qw/OUTFILE_EXT EXE/);
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $srcfile->flagsbase ([$flag]);
+#
+# DESCRIPTION
+#   If the source file contains a compilable program unit, it returns the base
+#   name of the compiler flags-file. If $flag is set, it returns the base name
+#   of the flags file as specified by $flag. The value of $flag can be:
+#     FLAGS   - compiler flags flags-file (default)
+#     PPKEYS  - pre-processor keys (i.e. macro definitions) flags-file
+#     LD      - linker flags-file
+#     LDFLAGS - linker flags flags-file
+# ------------------------------------------------------------------------------
+
+sub flagsbase {
+  my ($self, $flag) = @_;
+  $flag             = 'FLAGS' if not $flag;
+  my $return        = undef;
+
+  if ($self->is_type ('SOURCE')) {
+    if ($flag eq 'FLAGS' or $flag eq 'PPKEYS') {
+      my %src_tool = %{ $self->config->setting ('SRC_TOOL') };
+
+      if ($self->lang and exists $src_tool{$self->lang}{$flag}) {
+        $return = join ('__', (
+          $src_tool{$self->lang}{$flag}, $self->srcpackage->name, $self->root,
+        )) . $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+      }
+
+    } elsif ($self->is_type ('PROGRAM')) {
+      $return = join ('__', ($flag, $self->srcpackage->name, $self->root)) .
+                $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %dep   = $srcfile->dep;
+#   @files = $srcfile->dep ($type);
+#   $srcfile->dep (\%dep);
+#
+# DESCRIPTION
+#   This method returns the dependencies of this source file. If no argument
+#   is set, the method returns the dependency hash of this source file. The
+#   keys of the hash are the names of the files this source files depends on
+#   and the values of the hash are the dependency types of the corresponding
+#   files. If an argument is specified and the argument is a normal string,
+#   the method returns the keys of the dependency hash, which have their
+#   corresponding values equal to $type. If an argument is specified and the
+#   argument is a reference to a hash, the reference to the dependency hash of
+#   the current source file is re-set to point to the reference of this new
+#   hash.
+# ------------------------------------------------------------------------------
+
+sub dep {
+  my $self = shift;
+
+  if (@_) {
+    if (ref $_[0] eq 'HASH') {
+      $self->{DEP} = $_[0];
+
+    } else {
+      my $type = $_[0];
+      return grep {
+        $self->{DEP}{$_} eq $type;
+      } keys %{ $self->{DEP} };
+    }
+  }
+
+  return %{ $self->{DEP} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcfile->add_dep ($target, $type);
+#
+# DESCRIPTION
+#   This method adds (or modifies) a dependency to the dependency hash of the
+#   source file. The argument $type is the type of the dependency and the
+#   argument $target is the dependency target.
+# ------------------------------------------------------------------------------
+
+sub add_dep {
+  my $self = shift;
+  my ($target, $type) = @_;
+
+  $self->{DEP}{$target} = $type;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @pklist = $self->get_package_list ();
+#
+# DESCRIPTION
+#   This method returns a list of package names associated with this source
+#   file. The list begins with the top level container package to the
+#   sub-package name of the current source file.
+# ------------------------------------------------------------------------------
+
+sub get_package_list {
+  my $self = shift;
+
+  my @pknames = ();
+
+  my @packages = split /__/, $self->srcpackage->name;
+  push @packages, $self->root;
+
+  for my $i (0 .. $#packages) {
+    push @pknames, join ('__', (@packages[0 .. $i]));
+  }
+
+  return @pknames;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $pckcfg = $srcfile->pckcfg ();
+#   $srcfile->pckcfg ($pckcfg);
+#
+# DESCRIPTION
+#   This method returns the name of the flag to indicate whether this source
+#   file is modified by a package level configuration file. If an argument is
+#   specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub pckcfg {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PCKCFG} = $_[0];
+  }
+
+  return $self->{PCKCFG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $srcfile->scan ();
+#   $srcfile->scan ($flag);
+#
+# DESCRIPTION
+#   This method returns the "scan" flag that determines whether the source
+#   file needs to be scanned for dependency. If an argument is specified, the
+#   flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub scan {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SCAN} = $_[0];
+  }
+
+  return $self->{SCAN};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $srcfile->type;
+#   $srcfile->type ($type);
+#
+# DESCRIPTION
+#   This method returns the type flag of the source file. If an argument is
+#   specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub type {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TYPE} = shift;
+  }
+
+  return $self->{TYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $srcfile->is_type ($type1[, $type2, ...]);
+#
+# DESCRIPTION
+#   This method returns true if current file is a known type matching all the
+#   arguments.
+# ------------------------------------------------------------------------------
+
+sub is_type {
+  my $self    = shift;
+  my @intypes = @_;
+  my $rc      = 0;
+
+  if ($self->{TYPE}) {
+    my @types = split /::/, $self->{TYPE};
+
+    for my $intype (@intypes) {
+      $rc = grep {uc $_ eq uc $intype} @types;
+      last unless $rc;
+    }
+
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $srcfile->is_type_or ($type1[, $type2, ...]);
+#
+# DESCRIPTION
+#   This method returns true if current file is a known type matching any of
+#   the arguments.
+# ------------------------------------------------------------------------------
+
+sub is_type_or {
+  my $self    = shift;
+  my @intypes = @_;
+  my $rc      = 0;
+
+  if ($self->{TYPE}) {
+    my @types = split /::/, $self->{TYPE};
+
+    for my $intype (@intypes) {
+      $rc = grep {uc $_ eq uc $intype} @types;
+      last if $rc;
+    }
+
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $lang = $srcfile->lang ();
+#
+# DESCRIPTION
+#   This method returns the language name of the source file if it contains
+#   compilable source of a supported language.
+# ------------------------------------------------------------------------------
+
+sub lang {
+  my $self = shift;
+
+  if ((not $self->{LANG}) and $self->is_type ('SOURCE')) {
+    my %src_tool = %{ $self->config->setting ('SRC_TOOL') };
+
+    for my $key (keys %src_tool) {
+      if ($self->is_type ($key)) {
+        $self->{LANG} = $key;
+        last;
+      }
+    }
+  }
+
+  return $self->{LANG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcfile->determine_type;
+#
+# DESCRIPTION
+#   This method determines whether the source file is a type known to the
+#   build system. If so, it sets the "type" flag.
+# ------------------------------------------------------------------------------
+
+sub determine_type {
+  my $self = shift;
+
+  if (not $self->{TYPE}) {
+    # Do not set a type if the file name matches the "ignore" list
+    my @ignore = split /,/, $self->config->setting ('INFILE_IGNORE');
+
+    for (@ignore) {
+      return if $self->base eq $_;
+    }
+  }
+
+  if (not $self->{TYPE}) {
+    # Determine file type by comparing its extension with supported ones
+    my %known_ext = %{ $self->config->setting ('INFILE_EXT') };
+    my $ext       = $self->ext ? substr ($self->ext, 1) : 0;
+    $self->{TYPE} = $known_ext{$ext} if $ext and exists $known_ext{$ext};
+  }
+
+  if (not $self->{TYPE}) {
+    # Determine file type by comparing its name with known patterns
+    my %known_pat = %{ $self->config->setting ('INFILE_PAT') };
+    for my $pat (keys %known_pat) {
+      if ($self->base =~ /$pat/) {
+        $self->{TYPE} = $known_pat{$pat};
+        last;
+      }
+    }
+  }
+
+  if (-s $self->{SRC} and -T $self->{SRC} and not $self->{TYPE}) {
+    # Determine file type by inspecting its first line (text file only)
+    if (open SRC, '<', $self->{SRC}) {
+      my $line = <SRC>;
+      close SRC;
+
+      my %known_txt = %{ $self->config->setting ('INFILE_TXT') };
+      for my $txt (keys %known_txt) {
+        if ($line =~ /^#!.*$txt/) {
+          $self->{TYPE} = $known_txt{$txt};
+          last;
+        }
+      }
+    }
+  }
+
+  if ($self->is_type_or (qw/FORTRAN FPP/)) {
+    # Determine whether source file is a main Fortran program or module
+    if (open SRC, '<', $self->{SRC}) {
+      while (my $line = <SRC>) {
+        if ($line =~ /^\s*(PROGRAM|MODULE)\b/i) {
+          $self->{TYPE} = $self->{TYPE} . '::' . uc ($1);
+          last;
+
+        } elsif ($line =~ /^\s*BLOCK\s*DATA\b/i) {
+          $self->{TYPE} = $self->{TYPE} . '::' . 'BLOCKDATA';
+          last;
+        }
+      }
+      close SRC;
+    }
+
+  } elsif ($self->is_type (qw/C/)) {
+    # Determine whether source file is a main C program
+    if (open SRC, '<', $self->{SRC}) {
+      while (my $line = <SRC>) {
+        next unless $line =~ /int\s*main\s*\(/i;
+        $self->{TYPE} = $self->{TYPE} . '::PROGRAM';
+        last;
+      }
+      close SRC;
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @pp_src = @{ $srcfile->pre_process () };
+#
+# DESCRIPTION
+#   This method invokes the pre-processor on the source file. It returns a
+#   reference to an array containing the lines of the pre-processed source if
+#   the pre-processor command succeeded.
+# ------------------------------------------------------------------------------
+
+sub pre_process {
+  my $self = shift;
+
+  # Support only Fortran and C source files
+  return unless $self->is_type_or (qw/FPP C/);
+
+  # List of include directories
+  my @inc = @{ $self->config->setting (qw/PATH INC/) };
+
+  # Build the pre-processor command according to file type
+  my $name    = $self->is_type ('FPP') ? 'FPP' : 'CPP';
+  my %tool    = %{ $self->config->setting ('TOOL') };
+
+  # The pre-processor command and its options
+  my @command = ($tool{$name});
+  my @ppflags = split /\s+/, $self->select_tool ($name . 'FLAGS');
+
+  # List of defined macros, add "-D" in front of each macro
+  my @ppkeys  = split /\s+/, $self->select_tool ($name . 'KEYS');
+  @ppkeys     = map {($tool{$name . '_DEFINE' }. $_)} @ppkeys;
+
+  # Add "-I" in front of each include directories
+  @inc        = map {($tool{$name . '_INCLUDE'}. $_)} @inc;
+
+  push @command, (@ppflags, @ppkeys, @inc, $self->base);
+
+  my $verbose = $self->config->verbose;
+  my $cwd     = cwd;
+
+  # Change to container directory of source file
+  print 'cd ', $self->dir, "\n" if $verbose > 1;
+  chdir $self->dir;
+
+  # Execute the command, getting the output lines
+  my @outlines = &run_command (
+    \@command, METHOD => 'qx', PRINT => $verbose > 1, TIME => $verbose > 2,
+  );
+
+  # Change back to original directory
+  print 'cd ', $cwd, "\n" if $self->config->verbose > 1;
+  chdir $cwd;
+
+  return \@outlines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @interface_block = @{ $srcfile->gen_interface () };
+#
+# DESCRIPTION
+#   This method invokes the Fortran 9x interface block generator to generate
+#   an interface block for the current source file. It returns a reference to
+#   an array containing the lines of the interface block.
+# ------------------------------------------------------------------------------
+
+sub gen_interface {
+  my $self = shift;
+
+  my $generator = $self->select_tool ('GENINTERFACE');
+
+  my $src      = $self->{PPSRC} ? $self->{PPSRC} : $self->{SRC};
+  my @outlines = ();
+
+  if ($generator eq 'f90aib') {
+    # Use F90AIB
+
+    # Open pipeline to interface file generator and read its output
+    my $devnull = File::Spec->devnull;
+    my $command = $generator;
+    $command   .= " <'" . $src . "'" . " 2>'" . $devnull . "'";
+    my $croak   = $command . ' failed';
+
+    print timestamp_command ($command, 'Start') if $self->config->verbose > 2;
+    open COMMAND, '-|', $command or croak $croak, ' (', $!, '), abort';
+    @outlines = readline 'COMMAND';
+    close COMMAND or croak $croak, ' (', $?, '), abort';
+    print timestamp_command ($command, 'End  ') if $self->config->verbose > 2;
+
+  } elsif ($generator eq 'ECMWF') {
+    # Use ECMWF interface generator
+  
+    # Read source file into an array
+    open FILE, '<', $src or croak 'Cannot open "', $src, '" (', $!, '), abort';
+    my @src_lines = <FILE>;
+    close FILE;
+  
+    # Process standalone subroutines and functions only
+    if (not grep /^\s*(?:program|module)\b/i, @src_lines) {
+      print timestamp_command ('Analyse: ' . $self->src, 'Start')
+        if $self->config->verbose > 2;
+
+      my @statements = ();
+      my %prog_info  = ();
+  
+      # Set name of source file
+      &Ecmwf::Fortran90_stuff::fname ($src);
+  
+      # Parse lines in source
+      &Ecmwf::Fortran90_stuff::setup_parse ();
+
+      # Expand continuation lines in source
+      &Ecmwf::Fortran90_stuff::expcont (\@src_lines, \@statements);
+  
+      # Analyse statements in source
+      $Ecmwf::Fortran90_stuff::study_called = 0;
+      &Ecmwf::Fortran90_stuff::study (\@statements, \%prog_info);
+  
+      # Source code is not a module
+      if (not $prog_info{is_module}) {
+        my @interface_block = ();
+        my @line_hash       = ();
+  
+        # Create an interface block for the program unit
+        &Ecmwf::Fortran90_stuff::create_interface_block (
+          \@statements,
+          \@interface_block,
+        );
+
+        # Put continuation lines back
+        &Ecmwf::Fortran90_stuff::cont_lines (
+          \@interface_block,
+          \@outlines,
+          \@line_hash,
+        );
+      }
+
+      print timestamp_command ('Analyse: ' . $self->src, 'End')
+        if $self->config->verbose > 2;
+    }
+
+  } elsif (uc ($generator) eq 'NONE') {
+    print $self->root, ': interface generation is switched off', "\n"
+      if $self->config->verbose > 2;
+
+  } else {
+    e_report 'Error: Unknown Fortran 9x interface generator: ', $generator, '.';
+  }
+
+  return \@outlines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $tool = $self->select_tool ($name);
+#
+# DESCRIPTION
+#   This method selects the correct "tool" for the current source file by
+#   following the name of its container package. The argument $name must be
+#   the generic name of the "tool" to be selected. The method returns the
+#   value of the selected tool.
+# ------------------------------------------------------------------------------
+
+sub select_tool {
+  my $self  = shift;
+  my $name  = shift;
+
+  return undef unless $name;
+
+  my @pknames = $self->get_package_list ();
+
+  my %tool    = %{ $self->config->setting ('TOOL') };
+
+  for my $pkname (reverse @pknames) {
+    my $cur_name = join '__', ($name, $pkname);
+    return $tool{$cur_name} if exists $tool{$cur_name};
+  }
+
+  return exists $tool{$name} ? $tool{$name} : '';
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $srcfile->scan_dependency ();
+#   $rc = $srcfile->scan_dependency (HEADER_ONLY => 1);
+#
+# DESCRIPTION
+#   This method scans the source file for dependencies. If no argument is
+#   specified, the method scans the pre-processed source file if it exists.
+#   Otherwise, the original source file is scanned. If HEADER_ONLY is
+#   specified, only pre-processing header dependencies are scanned from the
+#   source file. (The HEADER_ONLY flag should only be specified if "ppsrc" is
+#   not already specified.) This method returns the number of 1 on success.
+# ------------------------------------------------------------------------------
+
+sub scan_dependency {
+  my $self = shift;
+  my %args = @_;
+
+  my $header_only = exists $args{HEADER_ONLY} ? $args{HEADER_ONLY} : 0;
+
+  return 0 unless $self->{SCAN};
+  return 0 unless $self->{TYPE};
+
+  my $src = $self->{PPSRC} ? $self->{PPSRC} : $self->{SRC};
+  return 0 unless $src;
+
+  # Determine what dependencies are supported by this known type
+  my %types = $header_only
+              ? %{ $self->config->setting ('PP_DEP_TYPE') }
+              : %{ $self->config->setting ('DEP_TYPE') };
+
+  # List of excluded dependencies
+  my %excl_dep = %{ $self->config->setting ('EXCL_DEP') };
+
+  # Package list
+  my @pknames = $self->get_package_list ();
+
+  my @depends = ();
+  for my $key (keys %types) {
+    # Check if current file is a type of file requiring dependency scan
+    next unless $self->is_type ($key);
+    
+    # Get list of dependency type for this file
+    DEPEND: for my $depend ((split /::/, $types{$key})) {
+      # Ignore a dependency type if the dependency is in the exclude list
+      if (exists $excl_dep{$depend}) {
+        # Global exclude
+        next DEPEND if exists $excl_dep{$depend}{''};
+
+        # Sub-package exclude
+        for my $pkname (@pknames) {
+          next DEPEND if exists $excl_dep{$depend}{$pkname};
+        }
+      }
+
+      # Add to dependency list for current file
+      push @depends, $depend;
+    }
+  }
+
+  # Scan dependencies, if necessary ...
+  if (@depends) {
+    # Print diagnostic
+    print timestamp_command ('scan dependency in file: ' . $src, 'Start')
+      if $self->config->verbose > 2;
+
+    open FILE, '<', $src or croak 'Cannot open "', $src, '" (', $!, ')';
+    my @lines = readline 'FILE';
+    close FILE;
+
+    # List of dependency patterns
+    my %dep_pattern = %{ $self->config->setting ('DEP_PATTERN') };
+
+    LINE: for my $line (@lines) {
+      # Ignore empty lines
+      next LINE if $line =~ /^\s*$/;
+
+      # Fortran source, also scan for program unit name
+      if (! $header_only and ! $self->progname) {
+        if ($self->is_type ('SOURCE') and $self->is_type_or (qw/FPP FORTRAN/)) {
+          my $pfx_pttn = '(?:(?:ELEMENTAL|(?:RECURSIVE(?:\s+PURE)?|' .
+                         'PURE(?:\s+RECURSIVE)?))\s+)?';
+          my $spc_pttn = '(?:(?:CHARACTER|COMPLEX|DOUBLE\s*PRECISION|INTEGER|' .
+                         'LOGICAL|REAL|TYPE)(?:\s*\(.+\)|\s*\*\d+\s*)??\s+)?';
+
+          if ($line =~ /^\s*PROGRAM\s+(\w+)/i) {
+            # Matches the beginning of a named main program
+            $self->progname (lc $1);
+            next LINE;
+
+          } elsif ($line =~ /^\s*MODULE\s+(\w+)/i) {
+            my $keyword = $1;
+
+            if (uc ($keyword) ne 'PROCEDURE') {
+              # Matches the beginning of a module
+              $self->progname (lc $keyword);
+              next LINE;
+            }
+
+          } elsif ($line =~ /^\s*BLOCK\s*DATA\s+(\w+)/i) {
+            # Matches the beginning of a named block data program unit
+            $self->progname (lc $1);
+            next LINE;
+
+          } elsif ($line =~ /^\s*$pfx_pttn SUBROUTINE\s+(\w+)/ix) {
+            # Matches the beginning of a subroutine
+            $self->progname (lc $1);
+            next LINE;
+
+          } elsif ($line =~ /^\s*$pfx_pttn $spc_pttn FUNCTION\s+(\w+)/ix) {
+            # Matches the beginning of a function
+            $self->progname (lc $1);
+            next LINE;
+          }
+        }
+      }
+
+      # Scan known dependencies
+      for my $depend (@depends) {
+        # Check if a pattern exists for the current dependency
+        next unless exists $dep_pattern{$depend};
+
+        # Attempt to match the pattern
+        my $pattern = $dep_pattern{$depend};
+
+        if ($line =~ /$pattern/i) {
+          my $match = $1;
+
+          # $match may contain multiple items delimited by space
+          NAME: for my $name (split /\s+/, $match) {
+            # Skip dependency if it is in the exclusion list
+            my $key = uc ($depend . '::' . $name);
+
+            if (exists $excl_dep{$key}) {
+              # Exclude this dependency, in the global list
+              next NAME if exists $excl_dep{$key}{''};
+
+              # Exclude this dependency, current sub-package
+              for my $pkname (@pknames) {
+                next NAME if exists $excl_dep{$key}{$pkname};
+              }
+            }
+
+            # Add this dependency to the list
+            $self->add_dep ($name, $depend);
+          }
+
+          next LINE;
+        }
+      }
+    }
+
+    # Diagnostic messages
+    if ($self->config->verbose > 2) {
+      my $base = $self->ppsrc ? $self->ppbase : $self->base;
+
+      print $self->srcpackage->name, ': ', $base;
+      print ': scanned ', scalar (@lines), ' lines for ';
+      print 'header ' if $header_only;
+      print 'dependencies: ', scalar (keys %{ $self->{DEP} }), "\n";
+      print timestamp_command ('scan dependency in file: ' . $src, 'End');
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %rules = $srcfile->required_rules ();
+#
+# DESCRIPTION
+#   This method returns a hash in the following format:
+#     %rules = (
+#       target => {ACTION => action, DEP => [dependencies], ...},
+#       ...    => {...},
+#     );
+#   where the 1st rank keys are the available targets for building this source
+#   file, the second rank keys are ACTION and DEP. The value of ACTION is the
+#   action for building the target, which can be "COMPILE", "LOAD", "TOUCH",
+#   "CP" or "AR". The value of DEP is a refernce to an array containing a list
+#   of dependencies suitable for insertion into the Makefile.
+# ------------------------------------------------------------------------------
+
+sub required_rules {
+  my $self = shift;
+
+  if (not keys %{ $self->{RULES} }) {
+    my %outfile_ext = %{ $self->config->setting ('OUTFILE_EXT') };
+
+    if ($self->is_type (qw/SOURCE/)) {
+      # Source file
+      # ------------------------------------------------------------------------
+      # Determine the whether the language of the source file is supported
+      my %src_tool = %{ $self->config->setting ('SRC_TOOL') };
+
+      return () unless $self->lang;
+
+      # Compile object
+      # ------------------------------------------------------------------------
+      if ($self->objbase) {
+        # Depends on the source file
+        my @dep = ($self->_makerule_srcfile);
+
+        # Depends on the compiler flags flags-file
+        my @flags;
+        push @flags, ('FLAGS' )
+          if $self->flagsbase ('FLAGS' );
+        push @flags, ('PPKEYS')
+          if $self->flagsbase ('PPKEYS') and not $self->ppsrc;
+
+        push @dep, $self->flagsbase ($_) for (@flags);
+
+        # Source file dependencies
+        for my $name (sort keys %{ $self->{DEP} }) {
+          # A Fortran 9X module, lower case object file name
+          if ($self->{DEP}{$name} eq 'USE') {
+            (my $root = $name) =~ s/\.\w+$//;
+            push @dep, lc ($root) . $outfile_ext{OBJ};
+
+          # An include file
+          } elsif ($self->{DEP}{$name} =~ /^(?:INC|H|INTERFACE)$/) {
+            push @dep, $name;
+          }
+        }
+
+        $self->{RULES}{$self->objbase} = {ACTION => 'COMPILE', DEP => \@dep};
+
+        # Touch flags-files
+        # ----------------------------------------------------------------------
+        for my $flag (@flags) {
+          next unless $self->flagsbase ($flag);
+
+          $self->{RULES}{$self->flagsbase ($flag)} = {
+            ACTION => 'TOUCH',
+            DEP    => [
+              $self->srcpackage->flagsbase ($src_tool{$self->lang}{$flag}),
+            ],
+            DEST   => '$(FCM_FLAGSDIR)',
+          };
+        }
+      }
+
+      if ($self->exebase) {
+        # Link into an executable
+        # ----------------------------------------------------------------------
+        my @dep = ();
+        push @dep, $self->objbase               if $self->objbase;
+        push @dep, $self->flagsbase ('LD'     ) if $self->flagsbase ('LD'     );
+        push @dep, $self->flagsbase ('LDFLAGS') if $self->flagsbase ('LDFLAGS');
+
+        # Depends on BLOCKDATA program units, for Fortran programs
+        my %blockdata = %{ $self->config->setting ('BLOCKDATA') };
+        my @blkobj    = ();
+
+        if ($self->is_type_or (qw/FPP FORTRAN/) and keys %blockdata) {
+          # List of BLOCKDATA object files
+          if (exists $blockdata{$self->exebase}) {
+            @blkobj = keys (%{ $blockdata{$self->exebase} });
+
+          } elsif (exists $blockdata{''}) {
+            @blkobj = keys (%{ $blockdata{''} });
+          }
+
+          for my $name (@blkobj) {
+            (my $root = $name) =~ s/\.\w+$//;
+            $name = $root . $outfile_ext{OBJ};
+            push @dep, $root . $outfile_ext{DONE};
+          }
+        }
+
+        # Extra executable dependencies
+        my %exe_dep = %{ $self->config->setting ('EXE_DEP') };
+        if (keys %exe_dep) {
+          my @exe_deps;
+          if (exists $exe_dep{$self->exebase}) {
+            @exe_deps = keys (%{ $exe_dep{$self->exebase} });
+
+          } elsif (exists $exe_dep{''}) {
+            @exe_deps = keys (%{ $exe_dep{''} });
+          }
+
+          my $pattern = '\\' . $outfile_ext{OBJ} . '$';
+
+          for my $name (@exe_deps) {
+            if ($name =~ /$pattern/) {
+              # Extra dependency is an object
+              (my $root = $name) =~ s/\.\w+$//;
+              push @dep, $root . $outfile_ext{DONE};
+
+            } else {
+              # Extra dependency is a sub-package
+              my $var;
+              if ($self->config->setting ('FCM_PCK_OBJECTS', $name)) {
+                # sub-package name contains unusual characters
+                $var = $self->config->setting ('FCM_PCK_OBJECTS', $name);
+
+              } else {
+                # sub-package name contains normal characters
+                $var = $name ? join ('__', ('OBJECTS', $name)) : 'OBJECTS';
+              }
+
+              push @dep, '$(' . $var . ')';
+            }
+          }
+        }
+
+        # Source file dependencies
+        for my $name (sort keys %{ $self->{DEP} }) {
+          (my $root = $name) =~ s/\.\w+$//;
+
+          # Lowercase name for object dependency
+          $root = lc ($root) unless $self->{DEP}{$name} =~ /^(?:INC|H)$/;
+
+          # Select "done" file extension
+          if ($self->{DEP}{$name} =~ /^(?:INC|H)$/) {
+            push @dep, $name . $outfile_ext{IDONE};
+
+          } else {
+            push @dep, $root . $outfile_ext{DONE};
+          }
+        }
+
+        $self->{RULES}{$self->exebase} = {
+          ACTION => 'LOAD', DEP => \@dep, BLOCKDATA => \@blkobj,
+        };
+
+        # Touch Linker flags-file
+        # ----------------------------------------------------------------------
+        for my $flag (qw/LD LDFLAGS/) {
+          $self->{RULES}{$self->flagsbase ($flag)} = {
+            ACTION => 'TOUCH',
+            DEP    => [$self->srcpackage->flagsbase ($flag)],
+            DEST   => '$(FCM_FLAGSDIR)',
+          };
+        }
+
+      }
+
+      if ($self->donebase) {
+        # Touch done file
+        # ----------------------------------------------------------------------
+        my @dep = ($self->objbase);
+
+        for my $name (sort keys %{ $self->{DEP} }) {
+          (my $root = $name) =~ s/\.\w+$//;
+
+          # Lowercase name for object dependency
+          $root = lc ($root) unless $self->{DEP}{$name} =~ /^(?:INC|H)$/;
+
+          # Select "done" file extension
+          if ($self->{DEP}{$name} =~ /^(?:INC|H)$/) {
+            push @dep, $name . $outfile_ext{IDONE};
+
+          } else {
+            push @dep, $root . $outfile_ext{DONE};
+          }
+        }
+
+        $self->{RULES}{$self->donebase} = {
+          ACTION => 'TOUCH', DEP => \@dep, DEST => '$(FCM_DONEDIR)',
+        };
+      }
+      
+      if ($self->interfacebase) {
+        # Interface target
+        # ----------------------------------------------------------------------
+        # Source file dependencies
+        my @dep = ();
+        for my $name (sort keys %{ $self->{DEP} }) {
+          # Depends on Fortran 9X modules
+          push @dep, lc ($name) . $outfile_ext{OBJ}
+            if $self->{DEP}{$name} eq 'USE';
+        }
+
+        $self->{RULES}{$self->interfacebase} = {DEP => \@dep};
+      }
+
+    } elsif ($self->is_type ('INCLUDE')) {
+      # Copy include target
+      # ------------------------------------------------------------------------
+      my @dep = ($self->_makerule_srcfile);
+
+      for my $name (sort keys %{ $self->{DEP} }) {
+        # A Fortran 9X module, lower case object file name
+        if ($self->{DEP}{$name} eq 'USE') {
+          (my $root = $name) =~ s/\.\w+$//;
+          push @dep, lc ($root) . $outfile_ext{OBJ};
+
+        # An include file
+        } elsif ($self->{DEP}{$name} =~ /^(?:INC|H|INTERFACE)$/) {
+          push @dep, $name;
+        }
+      }
+
+      $self->{RULES}{$self->base} = {
+        ACTION => 'CP', DEP => \@dep, DEST => '$(FCM_INCDIR)',
+      };
+
+      # Touch IDONE file
+      # ------------------------------------------------------------------------
+      if ($self->donebase) {
+        my @dep = ($self->_makerule_srcfile);
+
+        for my $name (sort keys %{ $self->{DEP} }) {
+          (my $root = $name) =~ s/\.\w+$//;
+
+          # Lowercase name for object dependency
+          $root   = lc ($root) unless $self->{DEP}{$name} =~ /^(?:INC|H)$/;
+
+          # Select "done" file extension
+          if ($self->{DEP}{$name} =~ /^(?:INC|H)$/) {
+            push @dep, $name . $outfile_ext{IDONE};
+
+          } else {
+            push @dep, $root . $outfile_ext{DONE};
+          }
+        }
+
+        $self->{RULES}{$self->donebase} = {
+          ACTION => 'TOUCH', DEP => \@dep, DEST => '$(FCM_DONEDIR)',
+        };
+      }
+
+    } elsif ($self->is_type_or (qw/EXE SCRIPT/)) {
+      # Copy executable file
+      # ------------------------------------------------------------------------
+      my @dep = ($self->_makerule_srcfile);
+
+      # Depends on dummy copy file, if file is an "always build type"
+      push @dep, $self->config->setting (qw/MISC CPDUMMY/)
+        if $self->is_type_or (
+          split (/,/, $self->config->setting ('ALWAYS_BUILD_TYPE'))
+        );
+
+      # Depends on other executable files
+      for my $name (sort keys %{ $self->{DEP} }) {
+        push @dep, $name if $self->{DEP}{$name} eq 'EXE';
+      }
+
+      $self->{RULES}{$self->base} = {
+        ACTION => 'CP', DEP => \@dep, DEST => '$(FCM_BINDIR)',
+      };
+
+    } elsif ($self->is_type ('LIB')) {
+      # Archive object library
+      # ------------------------------------------------------------------------
+      my @dep;
+      for my $name (sort keys %{ $self->{DEP} }) {
+        next unless $self->{DEP}{$name} eq 'OBJ';
+
+        if ($name =~ /^\$\(\w+\)$/) {
+          # Dependency is a Makefile variable
+          push @dep, $name;
+
+        } else {
+          # Dependency is an object
+          (my $root = $name) =~ s/\.\w+$//;
+          push @dep, lc ($root) . $outfile_ext{OBJ};
+        }
+      }
+
+      $self->{RULES}{$self->base} = {ACTION => 'AR', DEP => \@dep};
+    }
+  }
+
+  return %{ $self->{RULES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $srcfile->write_makerules ();
+#
+# DESCRIPTION
+#   This method returns a string containing the "Make" rules for building the
+#   source file.
+# ------------------------------------------------------------------------------
+
+sub write_makerules {
+  my $self  = shift;
+  my $mk    = '';
+  my %rules = $self->required_rules;
+  my $nl    = " \\\n" . ' ' x 10;
+
+  for my $target (sort keys %rules) {
+    $mk .= $target . ':';
+    
+    for my $dep (@{ $rules{$target}{DEP} }) {
+      $mk .= $nl . $dep;
+    }
+
+    $mk .= "\n";
+
+    if (exists $rules{$target}{ACTION}) {
+      if ($rules{$target}{ACTION} eq 'COMPILE') {
+        if ($self->lang) {
+          $mk .= "\t" . 'fcm_internal compile:' . substr ($self->lang, 0, 1) .
+                 ' ' . $self->srcpackage->name . ' $< $@';
+          $mk .= ' 1' if ($self->flagsbase ('PPKEYS') and not $self->ppsrc);
+          $mk .= "\n";
+        }
+
+      } elsif ($rules{$target}{ACTION} eq 'LOAD') {
+        $mk .= "\t" . 'fcm_internal load ' . $self->srcpackage->name . ' $< $@';
+        $mk .= ' ' . join (' ', @{ $rules{$target}{BLOCKDATA} })
+          if @{ $rules{$target}{BLOCKDATA} };
+        $mk .= "\n";
+
+      } elsif ($rules{$target}{ACTION} eq 'TOUCH') {
+        $mk .= "\t" . 'touch ' . catfile ($rules{$target}{DEST}, '$@') . "\n";
+
+      } elsif ($rules{$target}{ACTION} eq 'CP') {
+        $mk .= "\t" . 'cp $< ' . $rules{$target}{DEST} . "\n";
+        $mk .= "\t" . 'chmod u+w ' . catfile ($rules{$target}{DEST}, '$@') . "\n";
+
+      } elsif ($rules{$target}{ACTION} eq 'AR') {
+        $mk .= "\t" . 'fcm_internal archive $@ $(^F)' . "\n";
+      }
+    }
+
+    $mk .= "\n";
+  }
+
+  return $mk;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $srcfile->_makerule_srcfile ();
+#
+# DESCRIPTION
+#   This internal method returns a string containing the location of the
+#   source file relative to a package source path. This string will be
+#   suitable for use in a "Make" rule file for FCM.
+# ------------------------------------------------------------------------------
+
+sub _makerule_srcfile {
+  my $self = shift;
+
+  my $return;
+  my @searchpath;
+  my $label;
+  my $dir;
+  my $base;
+
+  if ($self->ppsrc) {
+    $return     = $self->ppsrc;
+    @searchpath = $self->srcpackage->ppsearchpath;
+    $label      = 'PPSRCDIR';
+    $dir        = $self->ppdir;
+    $base       = $self->ppbase;
+
+  } else {
+    $return     = $self->src;
+    @searchpath = $self->srcpackage->searchpath;
+    $label      = 'SRCDIR';
+    $dir        = $self->dir;
+    $base       = $self->base;
+  }
+
+  $return = catfile $dir, $base;
+
+  # Use variable for directory name
+  # if container package name contains word characters only
+  if ($self->srcpackage->name =~ /^\w+$/) {
+    for my $i (0 .. $#searchpath) {
+      if ($dir eq $searchpath[$i]) {
+        my $returndir = '$(' . $label . $i . '__' . $self->srcpackage->name .
+                        ')';
+        $return = catfile $returndir, $base;
+        last;
+      }
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcPackage.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcPackage.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcPackage.pm	(revision 5166)
@@ -0,0 +1,895 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::SrcPackage
+#
+# DESCRIPTION
+#   This is a class to process a source directory package. It uses the
+#   supplied inheritance hierarchy to obtain a list of source files of this
+#   package.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::SrcPackage;
+
+# Standard pragma
+use strict;
+use warnings;
+
+# Standard modules
+use Carp;
+use File::Spec::Functions;
+use File::Basename;
+use File::Path;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::SrcFile;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package = Fcm::SrcPackage->new (
+#     CONFIG     => $config,
+#     NAME       => $name,
+#     CURRENT    => $current,
+#     REQUIREPP  => $requirepp,
+#     NEWPP      => $newpp,
+#     SEARCHPATH => \@path,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::SrcPackage class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   NAME       - name of the source directory package
+#   CURRENT    - package declared in current build?
+#   REQUIREPP  - require pre-processing?
+#   NEWPP      - pre-process option has changed?
+#   SEARCHPATH - search path of files in the source package
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self  = {
+    CONFIG     => exists $args{CONFIG}     ? $args{CONFIG}     : &main::cfg,
+    NAME       => exists $args{NAME}       ? $args{NAME}       : undef,
+    CURRENT    => exists $args{CURRENT}    ? $args{CURRENT}    : undef,
+    REQUIREPP  => exists $args{REQUIREPP}  ? $args{REQUIREPP}  : undef,
+    NEWPP      => exists $args{NEWPP}      ? $args{NEWPP}      : undef,
+    SEARCHPATH => exists $args{SEARCHPATH} ? $args{SEARCHPATH} : [],
+
+    # Reference to Fcm::CfgFile, source package configuration file
+    CFG       => undef,
+
+    # References to Fcm::SrcFile, list of source files
+    SRCFILE   => [],
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $package->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $package->name;
+#   $package->name ($name);
+#
+# DESCRIPTION
+#   This method returns the name of this package. If an argument is specified,
+#   the name is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub name {
+  my $self = shift;
+
+  if (@_) {
+    $self->{NAME} = shift;
+  }
+
+  return $self->{NAME};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $package->current;
+#   $package->current ($flag);
+#
+# DESCRIPTION
+#   This method returns the "current" flag of the source package. If an
+#   argument is specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub current {
+  my $self = shift;
+
+  if (@_) {
+    $self->{CURRENT} = shift;
+  }
+
+  return $self->{CURRENT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $package->requirepp;
+#   $package->requirepp ($flag);
+#
+# DESCRIPTION
+#   This method returns the "require PP" flag of the source package. If an
+#   argument is specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub requirepp {
+  my $self = shift;
+
+  if (@_) {
+    $self->{REQUIREPP} = shift;
+  }
+
+  return $self->{REQUIREPP};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $package->newpp;
+#   $package->newpp ($flag);
+#
+# DESCRIPTION
+#   This method returns the flag to denote whether pre-processor option for
+#   this source package has changed. If an argument is specified, the flag is
+#   set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub newpp {
+  my $self = shift;
+
+  if (@_) {
+    $self->{NEWPP} = shift;
+  }
+
+  return $self->{NEWPP};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile = $package->cfg;
+#   $package->cfg ($cfgfile);
+#
+# DESCRIPTION
+#   This method returns a reference to a Fcm::CfgFile instance for the source
+#   package configuration file. If an argument is specified, the reference is
+#   set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  my $self = shift;
+
+  if (@_) {
+    $self->{CFG} = $_[0];
+  }
+
+  return $self->{CFG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @path = $package->searchpath;
+#   $package->searchpath (@path);
+#
+# DESCRIPTION
+#   This method returns the source file search path associated with this
+#   source package in the current build. If arguments are specified, the
+#   search path is replaced by the array in the argument list.
+# ------------------------------------------------------------------------------
+
+sub searchpath {
+  my $self = shift;
+
+  @{ $self->{SEARCHPATH} } = @_ if @_; 
+
+  return @{ $self->{SEARCHPATH} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @path = $package->ppsearchpath;
+#
+# DESCRIPTION
+#   This method returns the pre-processed source file search path associated
+#   with this source package in the current build.
+# ------------------------------------------------------------------------------
+
+sub ppsearchpath {
+  my $self = shift;
+
+  my @path = ();
+  my @name = split /__/, $self->name;
+
+  for my $ppsrcdir (@{ $self->config->setting (qw/PATH PPSRC/) }) {
+    push @path, catfile ($ppsrcdir, @name);
+  }
+
+  return @path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $package->flagsbase ($flag);
+#
+# DESCRIPTION
+#   Returns the base name of a flags-file, determined by $flag.
+# ------------------------------------------------------------------------------
+
+sub flagsbase {
+  my ($self, $flag) = @_;
+
+  return join ('__', ($flag, $self->name)) .
+         $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @srcfile = $package->srcfile;
+#
+# DESCRIPTION
+#   This method returns a list of references to Fcm::SrcFile instances
+#   associated with this package.
+# ------------------------------------------------------------------------------
+
+sub srcfile {
+  my $self = shift;
+
+  return @{ $self->{SRCFILE} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package->update_file_info ();
+#
+# DESCRIPTION
+#   This method updates the source file information of this package. Please
+#   note that information is only updated if the cache file for this package
+#   does not exist. For a package declared in the current build, the
+#   information is also updated if the cache file is out of date.
+# ------------------------------------------------------------------------------
+
+sub update_file_info {
+  my $self      = shift;
+
+  # Check if the cache file exists and up to date
+  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
+  my $cachefile = find_file_in_path ($self->_cache_basename, \@cachepath);
+
+  my $uptodate  = $cachefile ? 1 : 0;
+  if ($uptodate and $self->{CURRENT}) {
+    # Is cache file up to date compared with directory?
+    $uptodate = (stat $cachefile) [9] > (stat $self->{SEARCHPATH}[0]) [9];
+
+    # Is cache file up to date compared with each file?
+    if ($uptodate) {
+      my $dir = $self->{SEARCHPATH}[0];
+
+      if (opendir DIR, $dir) {
+        my @files = map {catfile $dir, $_} grep {!/^\.\.?/} readdir 'DIR';
+        closedir DIR;
+        $uptodate = (grep {(stat $cachefile) [9] > (stat) [9]} @files) ? 1 : 0;
+      }
+    }
+  }
+
+  # Read package source file information if it appears to be up to date
+  $uptodate = $self->_read_file_list_cache ($cachefile) if ($uptodate);
+
+  # Update package source file information if necessary
+  if (not $uptodate) {
+    # Get list of files by searching through the search path
+    my @files = ();
+    for my $dir (@{ $self->{SEARCHPATH} }) {
+      opendir DIR, $dir;
+      while (my $base = readdir 'DIR') {
+        next if $base =~ /^\./;
+
+        my $file = catfile $dir, $base;
+        next if -d $file;
+
+        push @files, $file unless grep {basename ($_) eq $base} @files;
+      }
+      closedir DIR;
+    }
+
+    # Declare new instances of source file objects
+    my @srcfile = ();
+    for my $file (@files) {
+      if (basename ($file) eq $self->config->setting (qw/CFG_NAME SRCPACKAGE/)) {
+        $self->{CFG} = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
+
+      } else {
+        my $srcfile = Fcm::SrcFile->new (
+          CONFIG     => $self->config,
+          SRC        => $file,
+          SRCPACKAGE => $self,
+        );
+
+        # Determine source file types
+        $srcfile->determine_type;
+
+        # Record files of known types
+        push @srcfile, $srcfile;
+      }
+    }
+
+    # Set each SRCFILE to reference the source file instances
+    $self->{SRCFILE} = \@srcfile;
+
+    # Decipher configuration file if necessary
+    $self->_decipher_cfg if $self->cfg;
+
+    # Write to a new cache file
+    $self->_update_file_list_cache ();
+
+    # Source package info updated. Make sure the "current" flag is set to true
+    $self->current (1);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $up_to_date = $self->_read_file_list_cache ($file);
+#
+# DESCRIPTION
+#   This internal method reads the cache $file of this package and assigns the
+#   information to the SRCFILE list. It returns true if the cache appears to
+#   be up to date.
+# ------------------------------------------------------------------------------
+
+sub _read_file_list_cache {
+  my $self = shift;
+  my $file = shift;
+
+  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
+
+  # Read from config file
+  $cfg->read_cfg;
+  my @lines = $cfg->lines;
+
+  my %filetype = ();
+  my $uptodate = 1;
+  for my $line (@lines) {
+    next unless $line->{LABEL};
+
+    # On package declared in the current build, check that file is not deleted
+    if (not -f $line->{LABEL}) {
+      $uptodate = 0;
+      last;
+    }
+
+    $filetype{$line->{LABEL}} = $line->{VALUE};
+  }
+
+  # Assign to SRCFILE list if cache file is up to date
+  if ($uptodate) {
+    my @srcfiles = ();
+
+    for my $file (sort keys %filetype) {
+      if ($filetype{$file} eq 'SRCPACKAGECFG') {
+        $self->{CFG} = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
+
+      } else {
+        my $srcfile = Fcm::SrcFile->new (
+          CONFIG     => $self->config,
+          SRC        => $file,
+          TYPE       => $filetype{$file},
+          SRCPACKAGE => $self,
+        );
+
+        push @srcfiles, $srcfile;
+      }
+    }
+
+    $self->{SRCFILE} = [@srcfiles];
+
+    $self->_decipher_cfg if $self->cfg;
+  }
+
+  return $uptodate;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_file_list_cache (\@cachepath);
+#
+# DESCRIPTION
+#   This internal method updates the cache file of this package by writing
+#   current SRCFILE information to it. The argument @cachepath must be the
+#   search path of the build cache directory.
+# ------------------------------------------------------------------------------
+
+sub _update_file_list_cache {
+  my $self      = shift;
+  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
+
+  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+  if ($self->{CFG}) {
+    $cfg->add_line (LABEL => $self->cfg->src, VALUE => 'SRCPACKAGECFG')
+  }
+
+  for my $file (@{ $self->{SRCFILE} }) {
+    $cfg->add_line (LABEL => $file->src, VALUE => $file->type);
+  }
+
+  my $cachefile = catfile $cachepath[0], $self->_cache_basename;
+  $cfg->print_cfg ($cachefile);
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $basename = $self->_cache_basename ($type);
+#
+# DESCRIPTION
+#   This internal method returns the basename of a cache file for this
+#   package. If no argument is specified, it returns the package file list
+#   cache name. Otherwise, it returns the package file dependency cache name.
+# ------------------------------------------------------------------------------
+
+sub _cache_basename {
+  my $self = shift;
+  my $type = $_[0] ? $_[0] : 'PCKFILE';
+
+  return $self->{NAME} . $self->config->setting ('CACHE', $type);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_decipher_cfg ();
+#
+# DESCRIPTION
+#   This internal method deciphers the CFG file associated with this source
+#   package.
+# ------------------------------------------------------------------------------
+
+sub _decipher_cfg {
+  my $self = shift;
+
+  $self->cfg->read_cfg;
+  my @lines = $self->cfg->lines;
+
+  my %cfg_label = %{ $self->config->setting ('CFG_LABEL') };
+
+  LINE: for my $line (@lines) {
+    my $label = $line->{LABEL};
+    my $value = $line->{VALUE};
+
+    next unless $label;
+    next if uc $label eq $cfg_label{CFGFILE}{TYPE};
+    next if uc $label eq $cfg_label{CFGFILE}{VERSION};
+
+    my ($prefix, $name) = split /::/, $label;
+
+    # Get name of file from the package cfg
+    my $srcfile;
+    if ($name) {
+      ($srcfile) = grep {$_->base eq $name} @{ $self->{SRCFILE} };
+
+      # Create new instance of Fcm::SrcFile if not already in package
+      if (not $srcfile) {
+        my $src    = find_file_in_path ($name, $self->{SEARCHPATH});
+        my $target = $name unless $src;
+
+        $srcfile   = Fcm::SrcFile->new (
+          CONFIG     => $self->config,
+          SRCPACKAGE => $self,
+          SRC        => $src ? $src : $name,
+          TARGET     => $target,
+          PCKCFG     => 1,
+        );
+        push @{ $self->{SRCFILE} }, $srcfile;
+
+      } else {
+        $srcfile->pckcfg (1);
+      }
+
+    } else {
+      w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
+               ': label "', $label, '" not recognised.';
+      next LINE;
+    }
+
+    $prefix = uc $prefix;
+    if ($prefix eq $cfg_label{TYPE}) {
+      # Type label of source file
+      $srcfile->type (uc $value);
+      $srcfile->scan (0) if $srcfile->is_type (qw/BINARY LIB/);
+      next LINE;
+
+    } elsif ($prefix eq $cfg_label{SCAN}) {
+      # Scan original file for dependency?
+      $srcfile->scan ($value);
+      next LINE;
+
+    } elsif ($prefix eq $cfg_label{TARGET}) {
+      # Name of build target for this source file
+      $srcfile->exebase ($value);
+      next LINE;
+
+    } elsif ($prefix eq $cfg_label{INTNAME}) {
+      # Program unit name of this source file
+      $srcfile->progname ($value);
+      next LINE;
+
+    } elsif ($prefix eq $cfg_label{DEP}) {
+      # Dependency of this source file
+      my ($type, $target) = split /::/, $value;
+      $srcfile->add_dep ($target, uc $type);
+      next LINE;
+
+    } else {
+      w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
+               ': label "', $label, '" not recognised.';
+      next LINE;
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package->scan_dependency ();
+#   $package->scan_dependency (HEADER_ONLY => 1);
+#
+# DESCRIPTION
+#   This method scans the dependency in each source file in this source
+#   package and updates the package dependency cache. If HEADER_ONLY is
+#   specified, it performs dependency scan for pre-processor headers only if
+#   this source package requires pre-processing.
+# ------------------------------------------------------------------------------
+
+sub scan_dependency {
+  my $self = shift;
+  my %args = @_;
+
+  # Search for include header dependencies only
+  my $header_only = exists $args{HEADER_ONLY} ? $args{HEADER_ONLY} : 0;
+
+  # Get list of source files
+  # If header dependencies only, only consider FPP, C and CPP files
+  my @srcfiles = $header_only
+                 ? grep {$_->is_type_or (qw/FPP C CPP/)} $self->srcfile
+                 : grep {$_->type} $self->srcfile;
+  return unless @srcfiles;
+
+  # Location of the cache
+  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
+  my $cachebase = $header_only
+                  ? $self->_cache_basename ('PCKPPDEPEND')
+                  : $self->_cache_basename ('PCKDEPEND');
+  my $cachefile = find_file_in_path ($cachebase, \@cachepath);
+
+  # Obtain old dependency information from cache file if it exists
+  my %dep     = ();
+  my %intname = ();
+
+  if ($cachefile) {
+    # Read the cache
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $cachefile);
+    $cfg->read_cfg;
+    my @lines = $cfg->lines;
+
+    # Get list of source file base names
+    my %srcfilebase;
+    for (@srcfiles) {
+      my $base = $_->ppsrc ? $_->ppbase : $_->base;
+      $srcfilebase{$base} = 1;
+    }
+
+    for my $line (@lines) {
+      next unless $line->{LABEL};
+
+      # Label is either INTNAME or a dependency type name
+      # For INTNAME, value is the program unit name
+      # Otherwise, value is file::dependency
+      my $type = $line->{LABEL};
+      (my $file, my $depend) = split /::/, $line->{VALUE};
+
+      # Make sure $file exists in the list of source file base names
+      next unless exists $srcfilebase{$file};
+
+      if ($type eq 'INTNAME') {
+        $intname{$file} = $depend;
+
+      } else {
+        $dep{$file}{$depend} = $type;
+      }
+    }
+  }
+
+  # If a source file is newer than the cache file, re-scan dependency for that
+  # source file.
+  my $uptodate        = $cachefile ? 1 : 0;
+  my $cachefile_mtime = $cachefile ? (stat $cachefile) [9] : undef;
+  my $count           = 0;
+
+  for my $srcfile (@srcfiles) {
+    # Check modified time of source file
+    my $srcfile_mtime = $srcfile->mtime;
+
+    # If a package config file exists and it affects the source file,
+    # compare its timestamp with that of the source file
+    if ($srcfile->pckcfg) {
+      $srcfile_mtime = $self->cfg->mtime if not defined $srcfile_mtime;
+      $srcfile_mtime = ($self->cfg->mtime > $srcfile_mtime) ? $self->cfg->mtime
+                                                            : $srcfile_mtime;
+    }
+
+    # For files requiring PP, must re-scan if PP option has changed
+    my $rescan = ($self->newpp and $srcfile->is_type_or (qw/FPP C/)) ? 1 : 0;
+
+    if ($cachefile_mtime and $cachefile_mtime > $srcfile_mtime and ! $rescan) {
+      # No need to re-scan dependency, read dependency from cache
+      my $base = ($srcfile->ppsrc ? $srcfile->ppbase : $srcfile->base);
+
+      $srcfile->progname ($intname{$base}) if $intname{$base};
+      $srcfile->dep ($dep{$base})          if $dep{$base};
+
+    } else {
+      # Rescan dependency
+      $srcfile->progname (undef);
+      my $rc = $srcfile->scan_dependency (HEADER_ONLY => $header_only);
+      my %dp = $srcfile->dep;
+
+      # Get list of dependencies for updating the cache
+      my $base = ($srcfile->ppsrc ? $srcfile->ppbase : $srcfile->base);
+
+      $intname{$base} = $srcfile->progname;
+      $dep    {$base} = \%dp;
+
+      $uptodate = 0;
+      $count++ if $rc;
+    }
+  }
+
+  # Output diagnostic, if necessary
+  if ($self->config->verbose > 1 and $count) {
+    my $out =  $self->name . ': scanned ' . $count . ' file(s) for';
+    $out   .= ' header' if $header_only;
+    $out   .= ' dependency' . "\n";
+    print $out;
+  }
+
+  # Check whether package config file is newer than the dependency cache
+  if ($uptodate and $self->cfg) {
+    $uptodate = $cachefile_mtime > $self->cfg->mtime ? 1 : 0;
+  }
+
+  if (not $uptodate) {
+    # Update dependency cache file
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+    # Program unit name of source files
+    for my $file (keys %intname) {
+      next unless $intname{$file};
+
+      $cfg->add_line (
+        LABEL => 'INTNAME',
+        VALUE => $file . '::' . $intname{$file},
+      );
+    }
+
+    # Dependencies of source files
+    for my $file (keys %dep) {
+      for my $depend (keys %{ $dep{$file} }) {
+        $cfg->add_line (
+          LABEL => $dep{$file}{$depend},
+          VALUE => $file . '::' . $depend,
+        );
+      }
+    }
+
+    # Create an empty config file if no dependency in this source package
+    $cfg->add_line unless $cfg->lines;
+
+    # Write to config file
+    my $outfile = catfile $cachepath[0], $cachebase;
+    $cfg->print_cfg ($outfile);
+  }
+
+  return not $uptodate;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $package->makerule_uptodate ();
+#
+# DESCRIPTION
+#   This method returns true if the make rule file for this source package
+#   is up to date.
+# ------------------------------------------------------------------------------
+
+sub makerule_uptodate {
+  my $self = shift;
+
+  my $return = 0;
+
+  if (not $self->newpp) {
+    # Check whether a Make rule file already exists
+    my $mkbase = $self->name . $self->config->setting (qw/OUTFILE_EXT MK/);
+    my $mkfile = find_file_in_path (
+      $mkbase,
+      $self->config->setting (qw/PATH BLD/),
+    );
+
+    # Check location of source package file type cache
+    my $pckfile = find_file_in_path (
+      $self->_cache_basename ('PCKFILE'),
+      $self->config->setting (qw/PATH CACHE/),
+    );
+
+    # Check location of source package dependency cache
+    my $pckdepend = find_file_in_path (
+      $self->_cache_basename ('PCKDEPEND'),
+      $self->config->setting (qw/PATH CACHE/),
+    );
+
+    # If make rule file exists, determine whether it is out of date
+    if ($pckdepend) {
+      if ($mkfile) {
+        my $pckfile_mt   = (stat $pckfile)  [9];
+        my $pckdepend_mt = (stat $pckdepend)[9];
+        my $mkfile_mt    = (stat $mkfile)   [9];
+
+        $return = 1 if $mkfile_mt >= $pckdepend_mt and $mkfile_mt >= $pckfile_mt;
+      }
+
+    } else {
+      $return = 1; # No cache file, no need to have a make rule
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package->write_makerule ();
+#
+# DESCRIPTION
+#   This method writes to the I<Make> rule file of the current source package.
+# ------------------------------------------------------------------------------
+
+sub write_makerule {
+  my $self = shift;
+
+  # Package Make rule header
+  my $mk = '# Automatic Make rule for ' . $self->name . "\n\n";
+
+  # Set up variable for directory name
+  # if package name contains only word characters
+  my @searchpath   = $self->searchpath;
+  my @ppsearchpath = $self->ppsearchpath;
+
+  if ($self->name =~ /^\w+$/) {
+    # Package search path
+    my %path = (SRCDIR => \@searchpath, PPSRCDIR => \@ppsearchpath);
+
+    for my $key (keys %path) {
+      my $count = 0;
+      my @dirs  = @{ $path{$key} };
+
+      for my $i (0 .. $#dirs) {
+        next unless -d $dirs[$i];
+        $mk .= $key . $i . '__' . $self->name . ' = ' . $dirs[$i] . "\n";
+        $count++;
+      }
+
+      $mk .= "\n" if $count;
+    }
+  }
+
+  my $mk_out;
+
+  # Make rules for copying data files, if necessary
+  {
+    # Get a list of files with no associated type
+    my @files = grep {not $_->type} @{ $self->{SRCFILE} };
+
+    if (@files) {
+      my $target = $self->name . $self->config->setting (qw/OUTFILE_EXT ETC/);
+      $mk_out .= $target . ' :';
+
+      # Depends on all un-typed source files
+      my $nl = " \\\n" . ' ' x 10;
+      for my $file (@files) {
+        my $dir = $file->dir;
+
+        # Use variable for directory name
+        # if package name contains only word characters
+        if ($self->name =~ /^\w+$/) {
+          for my $i (0 .. $#searchpath) {
+            if ($dir eq $searchpath[$i]) {
+              $dir = '$(SRCDIR' . $i . '__' . $self->name . ')';
+              last;
+            }
+          }
+        }
+
+        $mk_out .= $nl . catfile ($dir, $file->base);
+      }
+
+      # Depends on dummy copy file, so there will be no dependency inheritance
+      $mk_out .= $nl . $self->config->setting (qw/MISC CPDUMMY/);
+
+      # Actions for target
+      $mk_out .= "\n";
+      $mk_out .= "\t" . 'cp $^ $(FCM_ETCDIR)' . "\n";
+      $mk_out .= "\t" . 'touch ' . catfile ('$(FCM_DONEDIR)', '$@') . "\n";
+
+      $mk_out .= "\n";
+    }
+  }
+
+  # Make rules for source files
+  my @srcfiles = grep {$_->type} @{ $self->{SRCFILE} };
+  for my $srcfile (@srcfiles) {
+    $mk_out .= $srcfile->write_makerules;
+  }
+
+  # Write make rule file only if necessary
+  if ($mk_out) {
+    $mk .= $mk_out;
+
+    # Write to output file
+    my $mkbase = $self->name . $self->config->setting (qw/OUTFILE_EXT MK/);
+    my $blddir = ${ $self->config->setting (qw/PATH BLD/) }[0];
+    my $mkfile = catfile $blddir, $mkbase;
+
+    if (not -d $blddir) {
+      print 'Make directory: ', $blddir, "\n" if $self->config->verbose > 1;
+      mkpath $blddir or croak $blddir, ': cannot create directory, abort';
+    }
+
+    open OUT, '>', $mkfile
+      or croak 'Cannot open "', $mkfile, '" (', $!, '), abort';
+    print OUT $mk;
+    close OUT or croak 'Cannot close "', $mkfile, '" (', $!, '), abort';
+
+    print 'Generated: ', $mkfile, "\n" if $self->config->verbose > 1;
+
+    return 1;
+
+  } else {
+    return 0;
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Timer.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Timer.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Timer.pm	(revision 5166)
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Timer
+#
+# DESCRIPTION
+#   This is a package of timer utility used by the FCM command.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Timer;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Exports
+our (@ISA, @EXPORT, @EXPORT_OK);
+
+sub timestamp_command;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(timestamp_command);
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %cmd_start_time = (); # Command start time, (key = command, value = time)
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &Fcm::Timer::timestamp_command ($command[, $status]);
+#
+# DESCRIPTION
+#   This function returns a string adding to $command a prefix according the
+#   value of $status. If $status is not specified or does not match the word
+#   "end", the status is assumed to be "start". At "start", the prefix will
+#   contain the current timestamp. If $status is the word "end", the prefix
+#   will contain the total time taken since this function was called with the
+#   same $command at the "start" status.
+# ------------------------------------------------------------------------------
+
+sub timestamp_command {
+  (my $command, my $status) = @_;
+
+  my $prefix;
+  if ($status and $status =~ /end/i) {
+    # Status is "end", insert time taken
+    my $lapse = time () - $cmd_start_time{$command};
+    $prefix = sprintf "# Time taken: %12d s=> ", $lapse;
+
+  } else {
+    # Status is "start", insert time stamp
+    $cmd_start_time{$command} = time;
+
+    (my $sec, my $min, my $hour, my $mday, my $mon, my $year) = localtime;
+    $prefix = sprintf "# Start: %04d-%02d-%02d %02d:%02d:%02d=> ",
+              $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
+  }
+
+  return $prefix . $command . "\n";
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Util.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Util.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Util.pm	(revision 5166)
@@ -0,0 +1,848 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Util
+#
+# DESCRIPTION
+#   This is a package of misc utilities used by the FCM command.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Util;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Exports
+our (@ISA, @EXPORT, @EXPORT_OK);
+
+sub expand_rev_keyword;
+sub expand_tilde;
+sub expand_url_keyword;
+sub e_report;
+sub find_srcdir;
+sub find_file_in_path;
+sub get_browser_url;
+sub get_command_string;
+sub get_rev_of_wc;
+sub get_rev_keyword;
+sub get_url_of_wc;
+sub get_url_keyword;
+sub get_wct;
+sub is_url;
+sub is_wc;
+sub print_command;
+sub run_command;
+sub svn_date;
+sub touch_file;
+sub w_report;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(
+  expand_rev_keyword
+  expand_tilde
+  expand_url_keyword
+  e_report
+  find_srcdir
+  find_file_in_path
+  get_browser_url
+  get_command_string
+  get_rev_of_wc
+  get_rev_keyword
+  get_url_of_wc
+  get_url_keyword
+  get_wct
+  is_url
+  is_wc
+  print_command
+  run_command
+  svn_date
+  touch_file
+  w_report
+);
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Find;
+use File::Path;
+use File::Spec;
+use POSIX qw/strftime/;
+
+# FCM component modules
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %svn_info       = (); # "svn info" log, (key1 = path,
+                         # key2 = URL, Revision, Last Changed Rev)
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %srcdir = &Fcm::Util::find_srcdir ($topdir, $toppck, $join);
+#
+# DESCRIPTION
+#   Search $topdir for sub-directories containing regular files. Returns a hash
+#   with each key/value pair assigned to a unique name of the source directory
+#   and the location of the source directory. If $toppck is set the name of
+#   each source directory will be prefixed with this package name, and the
+#   search may include the $topdir in the result. If $join is set, the name of
+#   the sub-package will use $join as the delimiter of packages. Otherwise, the
+#   default double underscore '__' will be used.  Please note that all
+#   directories beginning with a ".", i.e. hidden directories, are ignored.
+# ------------------------------------------------------------------------------
+
+sub find_srcdir {
+  (my $topdir, my $toppck, my $join) = @_;
+  $join = defined ($join) ? $join : '__';
+
+  my @dirs = ();
+
+  # Locate all source directories containing regular files
+  if (-d $topdir) {
+    find (
+      sub {
+        my $dir = $File::Find::name;
+        return 0 if $dir eq $topdir and not $toppck;
+
+        if (-d $dir) {
+          # Ignore sub-directories with names beginning with .
+          if ($dir ne $topdir) {
+            my $subdir = substr ($dir, length ($topdir) + 1);
+            return 0 if grep {m/^\./} File::Spec->splitdir ($subdir);
+          }
+
+          # Read contents of directory
+          opendir DIR, $dir;
+          my @files = readdir 'DIR';
+          closedir DIR;
+
+          # Check if the directory contains one or more source file
+          my $contain_src;
+          for my $file (@files) {
+            next if $file =~ /^\./; # ignore hidden file
+
+            if (-f File::Spec->catfile ($dir, $file)) {
+              $contain_src = 1;
+              last;
+            }
+          }
+
+          push @dirs, $dir if $contain_src;
+          return 1;
+
+        } else {
+          return 0;
+        }
+      },
+
+      $topdir,
+    );
+  }
+
+  # String length of src directory name
+  my $topdir_len = length $topdir;
+
+  # Assign new source directories to current build
+  my @pck    = $toppck ? split (/$join/, $toppck) : ();
+  my %srcdir = ();
+  for my $dir (@dirs) {
+    my $name = ($dir eq $topdir) ? '' : substr $dir, $topdir_len + 1;
+    my @path = File::Spec->splitdir ($name);
+    my $key  = join $join, (@pck, @path);
+
+    $srcdir{$key} = $dir;
+  }
+
+  return %srcdir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %srcdir = &Fcm::Util::find_file_in_path ($file, \@path);
+#
+# DESCRIPTION
+#   Search $file in @path. Returns the full path of the $file if it is found
+#   in @path. Returns "undef" if $file is not found in @path.
+# ------------------------------------------------------------------------------
+
+sub find_file_in_path {
+  my ($file, $path) = @_;
+
+  for my $dir (@$path) {
+    my $full_file = File::Spec->catfile ($dir, $file);
+    return $full_file if -e $full_file;
+  }
+
+  return undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $expanded_path = &Fcm::Util::expand_tilde ($path);
+#
+# DESCRIPTION
+#   Returns an expanded path if $path is a path that begins with a tilde (~).
+# ------------------------------------------------------------------------------
+
+sub expand_tilde {
+  my $file = $_[0];
+
+  $file =~ s#^~([^/]*)#$1 ? (getpwnam $1)[7] : ($ENV{HOME} || $ENV{LOGDIR})#ex;
+
+  return $file;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &Fcm::Util::touch_file ($file);
+#
+# DESCRIPTION
+#   Touch $file if it exists. Create $file if it does not exist. Return 1 for
+#   success or 0 otherwise.
+# ------------------------------------------------------------------------------
+
+sub touch_file {
+  my $file = $_[0];
+  my $rc   = 1;
+
+  if (-e $file) {
+    my $now = time;
+    $rc = utime $now, $now, $file;
+
+  } else {
+    mkpath dirname ($file) unless -d dirname ($file);
+
+    $rc = open FILE, '>', $file;
+    $rc = close FILE if $rc;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $new_url = &Fcm::Util::expand_url_keyword (URL => $url[, CFG => $cfg]);
+#
+# DESCRIPTION
+#   Expand URL if its begins with a pre-defined pattern followed by a keyword
+#   that can be found in the setting of CFG. If URL is a genuine URL, the
+#   function also attempts to expand any . or .. in the path. If CFG is not
+#   set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub expand_url_keyword {
+  my %args = @_;
+  my $url  = $args{URL};
+  my $cfg  = exists $args{CFG} ? $args{CFG} : &main::cfg;
+
+  # Prefix for URL keyword
+  my $prefix = $cfg->setting (qw/MISC EXPURL_PREFIX/);
+
+  # Pattern for URL keyword
+  my $pattern = '^' . $prefix . '([^/]+)';
+
+  # Standard suffix for URL keyword
+  my %suffix_value = (tr => 'trunk', br => 'branches', tg => 'tags');
+
+  # URL matches pattern?
+  if ($url =~ /$pattern/) {
+    my $keyword = $1;
+
+    # Determine whether keyword is registered.
+    my $keyval = $cfg->setting ('URL', uc ($keyword));
+
+    if ((not $keyval) and $keyword =~ s/[-_](tr|br|tg)$//) {
+      # Keyword is not registered, but it matches a standard suffix
+      my $suffix = $suffix_value{$1};
+
+      $keyval = $cfg->setting ('URL', uc ($keyword)) . '/' . $suffix
+        if $cfg->setting ('URL', uc ($keyword));
+    }
+
+    # Expand if keyword is registered
+    $url =~ s/$pattern/$keyval/ if $keyval;
+  }
+
+  # Expand . and ..
+  if (&is_url ($url)) {
+    while ($url =~ s#/+\.(?:/+|$)#/#g) {next}
+    while ($url =~ s#/+[^/]+/+\.\.(?:/+|$)#/#g) {next}
+  }
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &Fcm::Util::get_url_keyword (URL => $url[, CFG => $cfg]);
+#
+# DESCRIPTION
+#   Return a FCM URL keyword if URL matches a registered project URL or undef
+#   otherwise. If CFG is not set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub get_url_keyword {
+  my %args = @_;
+  my $url  = $args{URL};
+  my $cfg  = exists $args{CFG} ? $args{CFG} : &main::cfg;
+
+  my $return;
+
+  for my $key (%{ $cfg->setting ('URL') }) {
+    my $value = $cfg->setting ('URL', $key);
+    next unless defined $value;
+    next unless $url =~ s#^$value(?:/+|$)##;
+
+    $return = $cfg->setting (qw/MISC EXPURL_PREFIX/) . $key .
+              ($url ? '/' . $url : '');
+    last;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $new_rev = &Fcm::Util::expand_rev_keyword (
+#     REV  => $rev,
+#     URL  => $url,
+#    [HEAD => $flag,]
+#    [CFG  => $cfg,]
+#  );
+#
+# DESCRIPTION
+#   Expand REV if URL is a known URL in CFG setting and REV matches a revision
+#   keyword of this URL, or if REV is "HEAD". SVN revision numbers, date and
+#   other keywords are ignored. HEAD should only be specified if REV has the
+#   value "HEAD". If HEAD is specified and is true, the return value of the
+#   function will be the operative revision number of the HEAD revision.
+#   Otherwise, the last commit revision will be returned. If CFG is not set,
+#   it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub expand_rev_keyword {
+  my %args = @_;
+  my $rev  = $args{REV};
+  my $url  = $args{URL};
+  my $head = exists $args{HEAD} ? $args{HEAD} : undef;
+  my $cfg  = exists $args{CFG } ? $args{CFG } : &main::cfg;
+
+  if (uc ($rev) eq 'HEAD') {
+    # Expand HEAD revision
+    &_invoke_svn_info (PATH => $url, CFG => $cfg) unless exists $svn_info{$url};
+    my $expanded_rev = $head
+                     ? $svn_info{$url}{Revision}
+                     : $svn_info{$url}{'Last Changed Rev'};
+
+    &w_report ($url, ': cannot determine HEAD revision.')
+      if $cfg->verbose > 1 and not $expanded_rev;
+
+    $rev = $expanded_rev if $expanded_rev;
+
+  } elsif ($rev !~ /^(?:\d+|BASE|COMMITTED|PREV|\{.+\})$/i) {
+    # Expand revision keyword, if required
+
+    # Get configuration settings
+    my %keywords  = %{ $cfg->setting (qw/REVISION/) };
+    my $separator = $cfg->setting (qw/MISC DIR_SEPARATOR/);
+
+    my $name      = '';
+
+    # Find out whether URL matches a registered repository
+    for my $keyword (keys %keywords) {
+      my $repos = $cfg->setting ('URL', uc ($keyword));
+      next unless $repos;
+
+      if ($url =~ m#^$repos(?:$separator|$)#) {
+        $name = $keyword;
+        last;
+      }
+    }
+
+    # If revision keyword exists for the registered repository, expand it
+    if ($name and exists $keywords{$name}{uc ($rev)}) {
+      $rev = $keywords{$name}{uc ($rev)};
+
+    } else {
+      &e_report (
+        $rev, ': revision keyword not found for ', $url,
+        ' in FCM configuration file, abort.',
+      );
+    }
+  }
+
+  return $rev;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $keyword = Fcm::Util::get_rev_keyword (
+#     REV => $rev,
+#     URL => $url,
+#    [CFG => $cfg,]
+#  );
+#
+# DESCRIPTION
+#   Returns a revision keyword if URL is a known URL in CFG setting and REV is
+#   a revision number that matches a revision keyword of this URL. Otherwise,
+#   it returns REV unchanged. If CFG is not set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub get_rev_keyword {
+  my %args = @_;
+  my $rev  = $args{REV};
+  my $url  = $args{URL};
+  my $cfg  = exists $args{CFG} ? $args{CFG} : &main::cfg;
+
+  if ($rev =~ /^\d+$/) {
+    # Get revision keyword, if REV is a revision number
+
+    # Get configuration settings
+    my %keywords  = %{ $cfg->setting (qw/REVISION/) };
+    my $separator = $cfg->setting (qw/MISC DIR_SEPARATOR/);
+
+    my $name      = '';
+
+    # Find out whether URL matches a registered repository
+    for my $keyword (keys %keywords) {
+      my $repos = $cfg->setting ('URL', uc ($keyword));
+      next unless $repos;
+
+      if ($url =~ m#^$repos(?:$separator|$)#) {
+        $name = $keyword;
+        last;
+      }
+    }
+
+    # If revision keyword for REV exists for the registered repository, get it
+    if ($name and exists $keywords{$name} and ref $keywords{$name} eq 'HASH') {
+      for my $key (keys %{ $keywords{$name} }) {
+        if ($rev eq $keywords{$name}{$key}) {
+          $rev = $key;
+          last;
+        }
+      }
+    }
+  }
+
+  return $rev;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $browser_url = Fcm::Util::get_browser_url (
+#     URL => $url,
+#    [CFG => $cfg,]
+#  );
+#
+# DESCRIPTION
+#   Returns a web address for browsing URL from Trac if URL is a known URL in
+#   CFG setting, and that it is a matching web address. Otherwise, it returns
+#   "undef". If CFG is not set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub get_browser_url {
+  my %args        = @_;
+  my $url         = $args{URL};
+  my $cfg         = exists $args{CFG} ? $args{CFG} : &main::cfg;
+  my $browser_url = undef;
+
+  # Get configuration settings
+  my %keywords  = %{ $cfg->setting (qw/TRAC/) };
+  my $separator = $cfg->setting (qw/MISC DIR_SEPARATOR/);
+
+  my $name  = '';
+  my $trail = '';
+
+  # Find out whether URL matches a registered repository
+  for my $keyword (keys %keywords) {
+    my $repos = $cfg->setting ('URL', uc ($keyword));
+    next unless $repos;
+
+    if ($url =~ m#^$repos(?:$separator(.*$)|$)#) {
+      $name  = $keyword;
+      $trail = $1 if $1;
+      last;
+    }
+  }
+
+  # If TRAC web address exists for the registered repository, get it
+  if ($name and exists $keywords{$name}) {
+    $browser_url  = $keywords{$name};
+    $browser_url .= $separator . $trail if $trail;
+  }
+
+  return $browser_url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = &is_wc ([$path]);
+#
+# DESCRIPTION
+#   Returns true if current working directory (or $path) is a Subversion
+#   working copy.
+# ------------------------------------------------------------------------------
+
+sub is_wc {
+  my $path = @_ ? $_[0] : cwd ();
+
+  if (-d $path) {
+    return (-e File::Spec->catfile ($path, qw/.svn format/)) ? 1 : 0;
+
+  } elsif (-f $path) {
+    return (-e File::Spec->catfile (dirname ($path), qw/.svn format/)) ? 1 : 0;
+
+  } else {
+    return 0;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = &is_url ($url);
+#
+# DESCRIPTION
+#   Returns true if $url is a URL.
+# ------------------------------------------------------------------------------
+
+sub is_url {
+  # This should handle URL beginning with svn://, http:// and svn+ssh://
+  return ($_[0] =~ m#^[\+\w]+://#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_wct ([$dir]);
+#
+# DESCRIPTION
+#   If current working directory (or $dir) is a Subversion working copy,
+#   returns the top directory of this working copy; otherwise returns an empty
+#   string.
+# ------------------------------------------------------------------------------
+
+sub get_wct {
+  my $dir = @_ ? $_[0] : cwd ();
+
+  return '' if not &is_wc ($dir);
+
+  my $updir = dirname $dir;
+  while (&is_wc ($updir)) {
+    $dir   = $updir;
+    $updir = dirname $dir;
+    last if $updir eq $dir;
+  }
+
+  return $dir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_url_of_wc ([$path[, $refresh]]);
+#
+# DESCRIPTION
+#   If current working directory (or $path) is a Subversion working copy,
+#   returns the URL of the associated Subversion repository; otherwise returns
+#   an empty string. If $refresh is specified, do not use the cached
+#   information.
+# ------------------------------------------------------------------------------
+
+sub get_url_of_wc {
+  my $path    = @_ ? $_[0] : cwd ();
+  my $refresh = exists $_[1] ? $_[1] : 0;
+  my $url  = '';
+
+  if (&is_wc ($path)) {
+    delete $svn_info{$path} if $refresh;
+    &_invoke_svn_info (PATH => $path) unless exists $svn_info{$path};
+    $url = $svn_info{$path}{URL};
+  }
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &_invoke_svn_info (PATH => $path, [CFG => $cfg]);
+#
+# DESCRIPTION
+#   The function is internal to this module. It invokes "svn info" on $path to
+#   gather information on URL, Revision and Last Changed Rev. The information
+#   is stored in a hash table at the module level, so that the information can
+#   be re-used. If CFG is not set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub _invoke_svn_info {
+  my %args = @_;
+  my $path = $args{PATH};
+  my $cfg  = exists $args{CFG} ? $args{CFG} : &main::cfg;
+
+  return if exists $svn_info{$path};
+
+  # Invoke "svn info" command
+  my @info = &run_command (
+    [qw/svn info/, $path],
+    PRINT => $cfg->verbose > 2, METHOD => 'qx', DEVNULL => 1, ERROR => 'ignore',
+  );
+  for (@info) {
+    chomp;
+
+    if (/^(URL|Revision|Last Changed Rev):\s*(.+)$/) {
+      $svn_info{$path}{$1} = $2;
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_command_string ($cmd);
+#   $string = &get_command_string (\@cmd);
+#
+# DESCRIPTION
+#   The function returns a string by converting the list in @cmd or the scalar
+#   $cmd to a form, where it can be executed as a shell command.
+# ------------------------------------------------------------------------------
+
+sub get_command_string {
+  my $cmd    = $_[0];
+  my $return = '';
+
+  if (ref ($cmd) and ref ($cmd) eq 'ARRAY') {
+    # $cmd is a reference to an array
+
+    # Print each argument
+    for my $i (0 .. @{ $cmd } - 1) {
+      my $arg = $cmd->[$i];
+
+      $arg =~ s/./*/g if $i > 0 and $cmd->[$i - 1] eq '--password';
+
+      if ($arg =~ /[\s'"*?]/) {
+        # Argument contains a space, quote it
+        if (index ($arg, "'") >= 0) {
+          # Argument contains an apostrophe, quote it with double quotes
+          $return .= ($i > 0 ? ' ' : '') . '"' . $arg . '"';
+
+        } else {
+          # Otherwise, quote argument with apostrophes
+          $return .= ($i > 0 ? ' ' : '') . "'" . $arg . "'";
+        }
+
+      } else {
+        # Argument does not contain a space, just print it
+        $return .= ($i > 0 ? ' ' : '') . ($arg eq '' ? "''" : $arg);
+      }
+    }
+
+  } else {
+    # $cmd is a scalar, just print it "as is"
+    $return = $cmd;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &print_command ($cmd);
+#   &print_command (\@cmd);
+#
+# DESCRIPTION
+#   The function prints the list in @cmd or the scalar $cmd, as it would be
+#   executed by the shell.
+# ------------------------------------------------------------------------------
+
+sub print_command {
+  my $cmd = $_[0];
+
+  print '=> ', &get_command_string ($cmd) , "\n";
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @return = &run_command (\@cmd, <OPTIONS>);
+#   @return = &run_command ($cmd , <OPTIONS>);
+#
+# DESCRIPTION
+#   This function executes the command in the list @cmd or in the scalar $cmd.
+#   The remaining are optional arguments in a hash table. Valid options are
+#   listed below. If the command is run using "qx", the function returns the
+#   standard output from the command. If the command is run using "system", the
+#   function returns true on success. By default, the function dies on failure.
+#
+# OPTIONS
+#   METHOD  => $method - this can be "system", "exec" or "qx". This determines
+#                        how the command will be executed. If not set, the
+#                        default is to run the command with "system".
+#   PRINT   => 1       - if set, print the command before executing it.
+#   ERROR   => $flag   - this should only be set if METHOD is set to "system"
+#                        or "qx". The $flag can be "die" (default), "warn" or
+#                        "ignore". If set to "die", the function dies on error.
+#                        If set to "warn", the function issues a warning on
+#                        error, and the function returns false. If set to
+#                        "ignore", the function returns false on error.
+#   RC      => 1       - if set, must be a reference to a scalar, which will be
+#                        set to the return code of the command.
+#   DEVNULL => 1       - if set, re-direct STDERR to /dev/null before running
+#                        the command.
+#   TIME    => 1       - if set, print the command with a timestamp before
+#                        executing it, and print the time taken when it
+#                        completes. This option supersedes the PRINT option.
+# ------------------------------------------------------------------------------
+
+sub run_command {
+  my $cmd     = shift;
+  my %options = @_;
+  my $method  = exists $options{METHOD}  ? $options{METHOD}  : 'system';
+  my $print   = exists $options{PRINT}   ? $options{PRINT}   : undef;
+  my $error   = exists $options{ERROR}   ? $options{ERROR}   : 'die';
+  my $rc      = exists $options{RC}      ? $options{RC}      : undef;
+  my $devnull = exists $options{DEVNULL} ? $options{DEVNULL} : undef;
+  my $time    = exists $options{TIME}    ? $options{TIME}    : undef;
+  my @return  = ();
+
+  # Check that the $error flag is set correctly
+  $error = 'die' unless $error =~ /^(?:die|warn|ignore)$/i;
+
+  # Print the command before execution, if necessary
+  if ($time) {
+    print &timestamp_command (&get_command_string ($cmd));
+
+  } elsif ($print) {
+    &print_command ($cmd);
+  }
+
+  # Re-direct to /dev/null if necessary
+  if ($devnull) {
+    $devnull = File::Spec->devnull;
+
+    # Save current STDERR
+    no warnings;
+    open OLDERR, ">&STDERR" or croak 'Cannot dup STDERR (', $!, '), abort';
+    use warnings;
+
+    # Redirect STDERR to /dev/null
+    open STDERR, '>', $devnull
+      or croak 'Cannot redirect STDERR (', $!, '), abort';
+
+    # Make sure the channels are unbuffered
+    my $select = select;
+    select STDERR; $| = 1;
+    select $select;
+  }
+
+  if (ref ($cmd) and ref ($cmd) eq 'ARRAY') {
+    # $cmd is an array
+    my @command = @{ $cmd };
+
+    if ($method eq 'qx') {
+      @return = qx(@command);
+
+    } elsif ($method eq 'exec') {
+      exec (@command);
+
+    } else {
+      system (@command);
+      @return = $? ? () : (1);
+    }
+
+  } else {
+    # $cmd is an scalar
+    if ($method eq 'qx') {
+      @return = qx($cmd);
+
+    } elsif ($method eq 'exec') {
+      exec ($cmd);
+
+    } else {
+      system ($cmd);
+      @return = $? ? () : (1);
+    }
+  }
+
+  # Put STDERR back to normal, if redirected previously
+  if ($devnull) {
+    close STDERR;
+
+    open STDERR, ">&OLDERR" or croak 'Cannot dup STDERR (', $!, '), abort';
+  }
+
+  # Print the time taken for command after execution, if necessary
+  print &timestamp_command (&get_command_string ($cmd), 'end') if $time;
+
+  if ($?) {
+    # The command has failed
+    if ($error eq 'die') {
+      # Throw fatal error if ERROR is set to "die"
+      croak &get_command_string ($cmd), ' failed (', $?, ')';
+
+    } elsif ($error eq 'warn') {
+      # Issue warning if ERROR is set to "warn"
+      carp  &get_command_string ($cmd), ' failed (', $?, ')';
+    }
+  }
+
+  # Set the return code if necessary
+  $$rc = $? if $rc;
+
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &e_report (@message);
+#
+# DESCRIPTION
+#   The function prints @message to STDERR and aborts with a error.
+# ------------------------------------------------------------------------------
+
+sub e_report {
+  print STDERR @_, "\n" if @_;
+
+  exit 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &w_report (@message);
+#
+# DESCRIPTION
+#   The function prints @message to STDERR and returns.
+# ------------------------------------------------------------------------------
+
+sub w_report {
+  print STDERR @_, "\n" if @_;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $date = &svn_date ($time);
+#
+# DESCRIPTION
+#   The function returns a date, formatted as by Subversion. The argument $time
+#   is the number of seconds since epoch.
+# ------------------------------------------------------------------------------
+
+sub svn_date {
+  my $time = shift;
+
+  return strftime ('%Y-%m-%d %H:%M:%S %z (%a, %d %b %Y)', localtime ($time));
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/AA_make	(revision 5166)
@@ -0,0 +1,51 @@
+#- $Id$
+all_lib : libioipsl libparallel libparameters liborglob libstomate libsechiba
+
+libioipsl:
+	(cd ../IOIPSL/src; $(M_K) -f Makefile)
+
+libparameters :
+	(cd src_parameters ; $(M_K) -f Makefile)
+
+libparallel :
+	(cd ../../modeles/ORCHIDEE/src_parallel ; $(M_K) -f Makefile)
+
+liborglob :
+	(cd src_global ; $(M_K) -f Makefile)
+
+libstomate :
+	(cd src_stomate ; $(M_K) -f Makefile)
+
+libsechiba :
+	(cd src_sechiba ; $(M_K) -f Makefile)
+
+driver : all_lib
+	(cd src_driver ; $(M_K) -f Makefile)
+
+config : 
+	(cd src_parameters; $(M_K) -f Makefile config)
+	(cd src_sechiba; $(M_K) -f Makefile config)
+	(cd src_stomate; $(M_K) -f Makefile config)
+
+clean : 
+	(cd src_parameters; $(M_K) -f Makefile clean)
+	(cd src_parallel; $(M_K) -f Makefile clean)
+	(cd src_global; $(M_K) -f Makefile clean)
+	(cd src_sechiba; $(M_K) -f Makefile clean)
+	(cd src_stomate; $(M_K) -f Makefile clean)
+	(cd src_driver; $(M_K) -f Makefile clean)
+	(rm -f ../../lib/*)
+
+doc:
+	doxygen Doxyfile_ORCHIDEE
+	export TEXINPUTS="${TEXINPUTS}:${PWD}/DOC//"; export BIBINPUTS="${BIBINPUTS}:${PWD}/DOC/BIB//"; cd docs/latex ; latex refman.tex 
+
+bib:
+	export TEXINPUTS="${TEXINPUTS}:${PWD}/DOC//"; export BIBINPUTS="${BIBINPUTS}:${PWD}/DOC/BIB//"; cd docs/latex ; bibtex refman 
+
+index:
+	export TEXINPUTS="${TEXINPUTS}:${PWD}/DOC//"; export BIBINPUTS="${BIBINPUTS}:${PWD}/DOC/BIB//"; cd docs/latex ; makeindex refman 
+
+toc:
+	export TEXINPUTS="${TEXINPUTS}:${PWD}/DOC//"; export BIBINPUTS="${BIBINPUTS}:${PWD}/DOC/BIB//"; cd docs/latex ; latex refman.tex 
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/AA_make.ldef	(revision 5166)
@@ -0,0 +1,3 @@
+#- $Id$
+#---------------------------------------------------------------------
+#-
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/BIB/orchidee.bib
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/BIB/orchidee.bib	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/BIB/orchidee.bib	(revision 5166)
@@ -0,0 +1,37 @@
+@Article{Chalita_94,
+  author = 	 {{Chalita, S.} and {Le Treut, H.}},
+  title = 	 {``{The albedo of temperate and boreal forest and the Northern Hemisphere climate: a sensitivity experiment using the LMD GCM}''},
+  journal = 	 {Climate Dynamics},
+  year = 	 {1994},
+  volume = 	 {10},
+  pages = 	 {231-240},
+}
+
+
+@Article{Chuine_00,
+  author = 	 {{Chuine, I.}},
+  title = 	 {``{A unified model for budburst of trees}''},
+  journal = 	 {Journal of Theoretical Biology},
+  volume = 	 {207},
+  year = 	 {2000},
+  pages = 	 {337-347}
+}
+
+
+@Article{Bott-Viov-Ciais-Frie-Monf_00,
+  author = 	 {{Botta, A.} and {Viovy, N.} and {Ciais, P.} and {Friedlingstein, P.} and {Monfray, P.}},
+  title = 	 {``{A global prognostic scheme of leaf onset using satellite data.}''},
+  journal = 	 {Global Change Biology},
+  year = 	 {2000},
+  volume = 	 {6},
+  pages = 	 {709-725},
+}
+
+@Article{Orla-Garc-Ezqu-Roma-Domi-Gala-Forn_04,
+  author = 	 {{Orlandi, F.} and {Garcia-Mozo, H.} and {Ezquerra, L.V.} and {Romano, B.} and {Dominguez, E.} and {Galan, C.} and {Fornaciari, M.}},
+  title = 	 {``{Phenological olive chilling requirements in Umbria (Italy) and Andalusia (Spain)}''},
+  journal = 	 {Plant Biosystems},
+  year = 	 {2004},
+  volume = 	 {138},
+  pages = 	 {111-116},
+}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex	(revision 5166)
@@ -0,0 +1,12 @@
+We calculate the deviation of the saturated humidity with the temperature and the pressure.
+\begin{equation}
+\delta q_{sat}(T) = \frac{(q_s(\lfloor T+\frac{1}{2}\rfloor + 1) - 2.q_s(\lfloor T +\frac{1}{2} \rfloor) + q_s(\lfloor T+\frac{1}{2} \rfloor -1))(\lbrace T + \frac{1}{2}\rbrace -1 ) + q_s(\lfloor T+\frac{1}{2} \rfloor +1) - q_s(\lfloor T+\frac{1}{2} \rfloor)}{P}
+\end{equation}
+
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T + \frac{1}{2} \rfloor $ represents the largest integer not greater than $T + \frac{1}{2} $. 
+ \item  $ \lbrace T + \frac{1}{2} \rbrace = T + \frac{1}{2} -\lfloor T + \frac{1}{2} \rfloor $ is the fractional part of $T + \frac{1}{2} $.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex	(revision 5166)
@@ -0,0 +1,14 @@
+We calculate the deviation of the saturated humidity with the temperature and the pressure for a given pixel $x$.
+\begin{multline}
+\delta q_{sat}(x,T) = \\
+\frac{(q_s(x,\lfloor T+\frac{1}{2}\rfloor + 1) - 2.q_s(x,\lfloor T +\frac{1}{2} \rfloor) + q_s(x,\lfloor T+\frac{1}{2} \rfloor -1))(\lbrace T + \frac{1}{2}\rbrace -1 )} {P}+ 
+\\ \frac{q_s(x,\lfloor T+\frac{1}{2} \rfloor +1) - q_s(x, \lfloor T+\frac{1}{2} \rfloor)}{P}
+\end{multline}
+
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T + \frac{1}{2} \rfloor $ represents the largest integer not greater than $T + \frac{1}{2} $. 
+ \item  $ \lbrace T + \frac{1}{2} \rbrace = T + \frac{1}{2} -\lfloor T + \frac{1}{2} \rfloor $ is the fractional part of $T + \frac{1}{2} $.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex	(revision 5166)
@@ -0,0 +1,30 @@
+The subroutine qsfrict\_init uses modified Goff-Gratch equations (1946). The original formulations are : \\
+\begin{multline}
+\log e_w = \\ -7.90298 \left( \frac{T_s}{T} - 1 \right) + 5.02808 \log \left( \frac{T_s}{T} \right) 
+- 1.3816 \times 10^{-7}(10^{11.344 \left( 1-\frac{T_s}{T} \right)}-1) 
++ 8.1328 \times 10^{-3}(10^{-3.49149 \left( \frac{T_s}{T}-1 \right)}
+-1) \\ + \log e_{ws}
+\end{multline}
+where : \\
+\begin{itemize}
+ \item  $ \log(x) = \frac{\ln x}{\ln 10} $. 
+ \item  $e_w$ is the saturation water vapor pressure over a plane surface of pure ordinary liquid water (hPa).
+ \item  $T$ is the absolute air temperature in Kelvin.
+ \item  $T_s$ is the steam point temperature (373.16 K).
+ \item  $e_{ws}$ is the saturation pressure of pure ordinary liquid water at steam-point temperature (at 1 atm = 1013.25 hPa).
+\end{itemize}
+
+\begin{multline}
+\log e_i = \\ -9.09718 \times \left( \frac{T_0}{T} - 1 \right) - 3.56654 \times \log \left( \frac{T_0}{T} \right) 
++ 0.876793 \times \left( 1-\frac{T_0}{T} \right) 
++ \log e_{i0}
+\end{multline}
+where : \\
+\begin{itemize}
+ \item  $ \log(x) = \frac{\ln x}{\ln 10} $. 
+ \item  $e_i$ is the saturation water vapor pressure over a plane surface of pure ordinary water ice (hPa).
+ \item  $T$ is the absolute air temperature in Kelvin (K).
+ \item  $T_0$ is the boiling point at 1 atmosphere temperature (273.16 K).
+ \item  $e^{*}_{i0}$  is the saturation pressure of pure ordinary water ice at ice-point temperature (6.1173 hPa).
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex	(revision 5166)
@@ -0,0 +1,12 @@
+The interpolation the saturated humidity depends on the temperature $T$ (in Kelvin). 
+It is set by the following equation :
+\begin{equation}
+q_{sat}(T)= \dfrac{q_s(\lfloor T \rfloor +1) - q_s(\lfloor T \rfloor).\lbrace T \rbrace + q_s(\lfloor T \rfloor)}{P}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T \rfloor $ represents the largest integer not greater than $T$. 
+ \item  $ \lbrace T \rbrace = T -\lfloor T \rfloor $ is the fractional part of $T$.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex	(revision 5166)
@@ -0,0 +1,12 @@
+The interpolation the saturated humidity on one pixel $x$  depends on the temperature $T$ (in Kelvin). 
+It is set by the following equation :
+\begin{equation}
+q_{sat}(x,T)= \dfrac{q_s(x,\lfloor T \rfloor +1) - q_s(x,\lfloor T \rfloor).\lbrace T \rbrace + q_s(x,\lfloor T \rfloor)}{P}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T \rfloor $ represents the largest integer not greater than $T$. 
+ \item  $ \lbrace T \rbrace = T -\lfloor T \rfloor $ is the fractional part of $T$.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex	(revision 5166)
@@ -0,0 +1,17 @@
+The specific humidity  $q_s$ is a function of temperature $T$. Its values are : 
+\begin{equation}
+q_s(T) = 
+\begin{cases}
+0 & \text{if} \quad T < 100K \\
+\dfrac{M_{air}}{M_{vapor}} \cdot 10^{2.07203 - 0.0032099T - \frac{2484.896}{T} + 3.56654\log{T}} & \text{if} \quad 100K \leq T < 273K \\
+\dfrac{M_{air}}{M_{vapor}} \cdot 10^{23.819 - \frac{2948.964}{T} -
+  5.028\log{T} - 29910.16\exp(-0.0699832\times T) + 25.21935\exp(-\frac{2999.924}{T}) } & \text{if} \quad 273K \leq T \leq 370K \\
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $\dfrac{M_{air}}{M_{vapor}} = \dfrac{18.02 \times 10^{-3}}{28.964 \times 10^{-3}} \simeq 0.622 $ is the ratio between the molecular weight of dry air and \\ 
+the molecular weight of water vapor.
+ \item  $\log(T) = \dfrac{\ln T}{\ln 10}$
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex	(revision 5166)
@@ -0,0 +1,18 @@
+%\documentclass{article}
+%\usepackage[english]{babel}
+%\usepackage{amsmath}
+%\begin{document}
+\begin{equation}
+f(T) = 
+\begin{cases}
+0 & \text{if} \quad T < 273K \\
+1 - \dfrac{(T_{max} - T)^2}{(T_{max} - T_{min})^2} & \text{if} \quad 273K \leq T \leq 293K \\
+1 & \text{if} \quad T > 293K
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ T_{min} = 273K$ 
+ \item  $ T_{max} = 293K$
+\end{itemize}
+%\end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+snowAlb=snowaIni+snowaDec \times \exp{\frac{-snowAge}{tsctSnowa}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+fracSnow=\frac{snow}{snow+10}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+C = [\frac{1}{\kappa} ln(\frac{z}{z0})]^2 
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex	(revision 5166)
@@ -0,0 +1,100 @@
+%
+% \documentclass[11pt]{amsart}
+% \usepackage{helvet}
+% \usepackage{geometry}    
+% \geometry{a4paper} 
+% \usepackage[parfill]{parskip}  \usepackage{graphicx}
+% \usepackage{amssymb}
+% \usepackage{epstopdf}
+% 
+% 
+% 
+% \begin{document}
+
+As is outlined in Guimberteau (2010), evaporation in ORCHIDEE is calculated as a function of evaporation potential $E_{pot}$, limited by the resistances. Evaporation potential is defined as below:
+
+ \hspace{0.5cm}    \lefteqn{E_{pot} = \frac{\rho}{r_a}(q_{sat}(T_s)-q_{air})}
+
+{\it where $q_{sat}(T_s)$ is the saturation humidity corresponding to a particular surface temperature and $q_{air}$ is the specific humidity in the atmosphere immediately above the surface.}
+
+A conventional way to describe evaporation in surface layer modelling is via the means of the resistance analogy. Below we demonstrate how the $\beta$ coefficients within ORCHIDEE may be re-written in terms of this analogy.
+
+{\bf Evaporation of water intercepted by canopy}
+
+In ORCHIDEE, $\beta_2$, the water interception resistance, is defined as:
+
+\hspace{0.5cm} \lefteqn{E=\beta_{2} E_{pot}}
+
+\hspace{0.5cm} \lefteqn{\beta_{2} = \frac{1}{1+\frac{r_{s_v}}{r_a}}}
+
+{\it where E represents the evapotranspiration, $r_{s_v}$ is the structural resistance of the canopy and $r_a$ is the aerodynamic resistance. }
+
+This can be reformulated in terms of the 'traditional' circuitry analogy, where evapotranspiration represents (in the analogy) the current and the voltage (or potential difference) is represented by the difference in humidity between the saturated surface and the atmosphere just above the ground.
+
+ \hspace{0.5cm} \lefteqn{E\left( 1+\frac{r_{s_v}}{r_a}  \right) = \frac{\rho}{r_a}(q_{sat}(T_s) - q_{air})}
+
+ \hspace{0.5cm} \lefteqn{     \overbrace{   E}^I  \overbrace{ (r_a+r_{s_v})}^R = \overbrace { \rho (q_{sat}(T_s) - q_{air})  }^V }
+
+
+\includegraphics[scale=0.45]{diffuco_schematic2.png}
+
+{\bf Figure 1:} resistance chain for the evaporation of intercepted water
+
+
+\vspace{1cm}
+
+{\bf Transpiration of the canopy}
+
+
+$\beta_3$, the canopy transpiration resistance, is defined as:
+
+
+\hspace{0.5cm} \lefteqn{E=\beta_{3} E_{pot}}
+
+\hspace{0.5cm} \lefteqn{\beta_{3} = \left(  \frac{1}{1+\frac{r_{s_v} + r_{sto_v}}{r_a}}  \right) U_{s_v} }
+
+{\it where E represents the evapotranspiration, $U_{S_v}$ is the potential for extraction from the plant roots, $r_{s_v}$ is the structural resistance of the canopy, $r_{sto_v}$ is the stomatal resistance of the surface cover and $r_a$ is the aerodynamic resistance. }
+
+so:
+
+ \hspace{0.5cm}  \lefteqn{ \frac{E}{\beta_{3}} = \frac{\rho}{r_a}(q_{sat}(T_s)-q_{air})}
+
+\hspace{0.5cm}   \lefteqn{E\left( 1+   \frac{r_{s_v}+r_{sto_v}}{r_a}   \right) U_{sv} = \frac{\rho}{r_a}(q_{sat}(T_s) - q_{air})}
+
+\hspace{0.5cm}   \lefteqn{   \overbrace {  E  }^I   \overbrace{ (r_a + (r_{s_v}+ r_{sto_v}))U_{s_v} }  ^R =   \overbrace { \rho (q_{sat}(T_s) - q_{air}   )   } ^V  }
+
+\includegraphics[scale=0.5]{diffuco_schematic1.png}
+
+{\bf Figure 2:} resistance chain for canopy transpiration
+
+
+\vspace{1cm}
+
+{\bf Evaporation of the bare soil}
+
+$\beta_4$, the bare soil evaporation resistance, is defined as:
+
+
+\hspace{0.5cm} \lefteqn{E=\beta_{4} E_{pot}}
+
+\hspace{0.5cm} \lefteqn{\beta_{4} = \left(  \frac{1}{1+\frac{r_1}{r_a}}  \right) U_{s_1} }
+
+{\it where E represents the evapotranspiration, $U_{S_1}$ is the relative humidity in equilibrium with the bare soil, $r_{1}$ is the resistance of bare soil to evaporation and $r_a$ is the aerodynamic resistance. }
+
+so we can again convert the expression to the resistance analogy:
+
+ \hspace{0.5cm}  \lefteqn{\frac{E}{\beta_{4}} = \frac{\rho}{r_a}(q_{sat}(T_s)-q_{air})}
+
+ \hspace{0.5cm} \lefteqn{E\left( 1+   \frac{r_1}{r_a}   \right) U_{s_1} = \frac{\rho}{r_a}(q_{sat}(T_s) - q_{air})}
+
+ \hspace{0.5cm} \lefteqn{   \overbrace {E}^I    \overbrace  {(r_a + r_1)U_{s_1}}^R = \overbrace {\rho (q_{sat}(T_s) - q_{air}   )} ^V }
+
+
+\includegraphics[scale=0.45]{diffuco_schematic3.png}
+
+{\bf Figure 3:} resistance chain for bare soil evaporation
+
+% 
+% 
+% 
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex	(revision 5166)
@@ -0,0 +1,122 @@
+
+\documentclass[11pt]{amsart}
+\usepackage{helvet}
+\usepackage{geometry}    
+\geometry{a4paper} 
+\usepackage[parfill]{parskip}  \usepackage{graphicx}
+\usepackage{amssymb}
+\usepackage{epstopdf}
+
+
+
+\begin{document}
+
+\renewcommand{\arraystretch}{1.5}
+
+\begin{tabular}{|c|l|r|}
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+\hline
+ $ps^{old}$ & psold & surface static energy at old timestep (J/kg) \\
+ $ps^{new}$ & psnew & surface static energy at new timestep (J/kg)\\
+ $q_s$ & qsurf & surface specific humidity (kg/kg) \\
+ $q_{s, sat}$ & qsol\_sat & saturated surface humidity (kg/kg) \\
+ $q_{air}$ & qair & lowest level specific humidity at 'old' timestep (kg/kg) \\
+ $q_{air}^{new}$ & qair\_new & lowest level specific humidity at 'new' timestep (kg/kg) \\
+ $\frac{\delta q_s^{old}}{\delta t}$ & pdqsold & derivative of saturated specific humidity at old temperature (kg/(kg s)) \\ 
+ $p_l$ & pb & lowest level air pressure (Pa) \\
+ \hline
+ $C_p^{air}$ & cp\_air & lowest level atmospheric heat capacity (J/(K kg)) \\   
+ \hline
+ $\chi_{CO_2}^{canopy}$ & ccanopy & $CO_2$ concentration in the canopy (?? ppm)  \\
+ $\bar{Ci}$ & cimean & mean intercellular ci (from STOMATE) $(\mu mole/m^2/s)$\\  
+ \hline
+ $R^{LW}_{\uparrow}$ & lwup & long-wave upwelling radiation $(W/m^2)$ \\  
+ $ R^{LW}_{\downarrow}$ & lwdown & downwelling long-wave radiation flux $(W/m^2)$ \\
+ $R^{LW}_{abs}$ & lwabs  & LW radiation absorbed by the surface $(W/m^2)$ \\ 
+ $R^{SW}_{net}$ & swnet & net shortwave radiation flux $(W/m^2)$ \\
+ $R^{net}_{sns}$ & netrad\_sns & sensitivity of net radiation $(W/m^2)$ \\
+ $R_{net}$ & netrad & net radiation at surface layer $(W/m^2)$ \\
+ \hline
+ $\Delta \theta$ & dtradia & Time step (s) \\
+ $\epsilon$ & emis & emissivity (fraction) \\
+ $\sigma$ & c\_stefan & Stefan-Boltzmann constant $(W / (m^2 K^4))$\\
+ $q_{c}$ & q\_cdrag & surface drag coefficient (m/s) \\
+ $\rho_{air}$ & rau & density of air $(kg/m^3)$ \\
+\hline
+\end{tabular}
+
+
+\begin{tabular}{|c|l|r|}
+
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+
+
+ \hline
+ 
+ $z_0$     &  z0 & Surface roughness Length (m) \\
+ roughheight  & roughheight   & Effective roughness height (m) \\
+ zlev  &  zlev & Height of first atmospheric layer (m) \\
+ veget\_max  & veget\_max & Fraction of vegetation type (-) \\
+ temp\_sol & temp\_sol &  Ground temperature (K) \\
+ temp\_air & temp\_air  &     !! Lowest level temperature (K) \\
+ qsurf  & qsurf & near surface specific air humidity (kg/kg) \\
+ qair  & qair & Lowest level specific air humidity (kg/kg) \\
+ 
+ \hline
+ 
+ veget    & veget & vegetation fraction for each type (fraction) \\
+ qsintveg & qsintveg & Water on vegetation due to interception $(kg/m^2)$ \\
+ qsintmax & qsintmax & Maximum water on vegetation $(kg/m^2)$ \\
+ rstruct  & rstruct & architectural resistance (s/m) \\
+ humrel & humrel & Soil moisture stress (within range 0 to 1 \\
+ veget  & veget & Type of vegetation (-) \\
+ veget\_max  & veget\_max &  Max. vegetation fraction (LAI to infinity) (fraction) \\
+ lai  & lai & Leaf\ area\ index $(m^2/m^2)$ \\
+ qsintveg & qsintveg & Water on vegetation due to interception $(kg/m^2)$ \\
+ 
+ \hline
+ 
+ $r_a$    & raero & aerodynamic resistance (s/m) \\
+ $r_{soil}$    & rsol & bare soil evaporation resistance (s/m) \\
+ $\delta _c$ & zdefconc & water vapour concentration deficit $(kg/m^3)$\\
+ \hline
+  
+\end{tabular}
+
+
+
+\begin{tabular}{|c|l|r|}
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+
+
+ \hline
+ $T_{air}$ & tair & air temperature (K) \\
+ $T_{dgnc}^{2m}$ & t2mdiag & diagnostic temperature at 2m above ground (K) \\  
+ $T^{2m}$ & t2m & 2m air temperature (K) \\  
+ $q^{2m}$ & q2m & 2m specific humidity (kg/kg) \\  
+ $T_S$ & temp\_sol & surface temperature (K) \\  
+ \hline
+
+ $\alpha_v $ & valpha & total $\alpha$ resistance coefficient (fraction) \\
+ $\beta_v$ & vbeta & total resistance coefficient (fraction) \\
+ $\beta_{v1}$ & vbeta1 & snow resistance (fraction) \\  
+ $\beta_{v2}$ & vbeta2 & interception resistance (fraction)\\  
+ $\beta_{v3}$ & vbeta3 & vegetation resistance (fraction)\\  
+ $\beta_{v4}$ & vbeta4 & bare soil resistance (fraction)\\
+ $\beta_{v23}$ & vbeta23 & portion of wetted foliage that will transpire (fraction)\\ 
+ $\beta_{v,CO_2}$ & vbetaco2 & vegetation resistance to $CO_2$ \\ 
+ \hline
+ $U$ & speed & lowest level wind speed (m/s) \\
+ $u$ & u & lowest level wind velocity,  Eastward component  (m/s) \\
+ $v$ & v & lowest level wind volocity, Northward component  (m/s) \\
+ \hline
+ $z_{ikt}$ & zikt & aerodynamic resistance / density of air (kg s $m^{-4}$) \\
+ $z_{ikq}$ & zikq & aerodynamic resistance / density of air (kg s $m^{-4}$)  \\
+\hline
+\end{tabular}
+
+
+\end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex	(revision 5166)
@@ -0,0 +1,15 @@
+% \documentclass{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+The integration at the canopy level is done over nlai=20 fixed levels $l$.
+
+nlai is a local constant of the diffuco module.
+
+laimax is a local constant of the diffuco\_trans\_co2 subroutine independent of the PFT equal to 12. 
+
+\begin{equation}
+{{{LAI}}(l)={{lai}}{max}\frac{e^{{0{.}{15}\cdot (l-1)}}-1}{e^{{0{.}{15}\cdot {{nlai}}}}-1}}\nonumber
+\end{equation}
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex	(revision 5166)
@@ -0,0 +1,9 @@
+% \documentclass[onecolumn,a4paper]{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+\begin{equation}
+{{{light}}=e^{{-k\cdot {{LAI}}(l)}}}\nonumber
+\end{equation}
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex	(revision 5166)
@@ -0,0 +1,17 @@
+% \documentclass{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+$Q$ surface specific humidity
+
+$Q_{sat}$ saturated surface humidity (calculated in constant\_veg:qsatcalc)
+
+$P$ surface pressure
+
+$h_r$ relative humidity of air
+
+\begin{equation}
+{h_{{r}}=\frac{Q\cdot P/{(0{.}{622}+0{.}{378}\cdot Q)}}{Q_{{{{sat}}}}\cdot P/{(0{.}{622}+0{.}{378}\cdot Q_{{{{sat}}}})}}}
+\end{equation}
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex	(revision 5166)
@@ -0,0 +1,12 @@
+% \documentclass{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+$f_w$ soil relative humidity calculated in hydrolc:hydrolc\_soil
+
+$W_{lim}$ soil water limitation factor
+\begin{equation}
+{W_{{{lim}}}={{MIN}}(2f_{{w}},1)}\nonumber
+\end{equation}
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex	(revision 5166)
@@ -0,0 +1,24 @@
+% \documentclass[onecolumn,a4paper]{article}
+% \usepackage[english]{babel}
+% \usepackage{amsmath}
+% \newcommand[1]{{\mathversion{normal}$#1$}}
+% \begin{document}
+$T_0$ (tp\_00) = 273.15 0 degree Celsius expressed in degree Kelvin defined in constantes.f90
+
+$k_T$ temperature-dependent pseudo-first-order rate constant of assimilation response to CO2
+
+\begin{equation}
+{k_{{T}}=0{.}7\cdot 0{.}{177}\cdot e^{{0{.}{069}\cdot (T_{{{{air}}}}-T_{{0}})}}\cdot {10}^{6}}\nonumber
+\end{equation}
+
+$R_T$ temperature-dependent non-photosynthetic respiration
+
+\begin{equation}
+{R_{{T}}=0{.}8\cdot {\frac{0{.}{177}\cdot e^{{0{.}{069}\cdot (T_{{{{air}}}}-T_{{0}})}}}{(1+e^{1{.}3(T_{{{{air}}}}-T_{{{max}}})}{)}}}}\nonumber
+\end{equation}
+
+\begin{equation}
+{V_{{c}}=V_{{c{max}}}\cdot 0{.}{39}\frac{0{.}{177}\cdot e^{{0{.}{069}\cdot (T_{{{{air}}}}-T_{{0}})}}}{(1+e^{0{.}3\cdot (T_{{{min}}}-T_{{{{air}}}})}{)(1+e^{0{.}3\cdot (T_{{{{air}}}}-T_{{{{opt}}}})}}{)}}W_{{lim}}}\nonumber
+\end{equation}
+
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex	(revision 5166)
@@ -0,0 +1,26 @@
+Tlim temperature limitation factor
+
+\begin{equation}
+{T_{{{lim}}}=\frac{(T_{{{{air}}}}-T_{{{min}}})\cdot (T_{{{{air}}}}-T_{{{max}}})}{(T_{{{{air}}}}-T_{{{min}}})\cdot (T_{{{{air}}}}-T_{{{max}}})-(T_{{{{air}}}}-T_{{{{opt}}}})^{{2}}}}
+\end{equation}
+Tmin, Tmax and Topt are local variables that are initialized through the assim\_param array.
+
+Kc Michaelis-Menten constant for the rubisco enzyme catalytic activity for CO2 (ppm)
+
+\begin{equation}
+{K_{{c}}={39}{.}{09}\cdot e^{{0{.}{085}\cdot (T_{{{{air}}}}-T_{{0}})}}}
+\end{equation}
+Ko Michaelis-Menten constant for the rubisco enzyme catalytic activity for O2 (ppm)
+
+\begin{equation}
+{K_{{o}}=\frac{2{.}{412}\cdot {210000}\cdot e^{{0{.}{085}\cdot (T_{{{{air}}}}-T_{{{min}}})}}}{(T_{{{air}}}{-T_{{min}}}{)}}}
+\end{equation}
+\begin{equation}
+{\Gamma ^{{?}}={42}\cdot e^{{9{.}{46}\frac{T_{{{{air}}}}-T_{{0}}-{25}}{T_{{{{air}}}}}}}}
+\end{equation}
+\begin{equation}
+{V_{{c}}=V_{{c{max}}}\cdot T_{{{lim}}}\cdot W_{{{lim}}}}
+\end{equation}
+\begin{equation}
+{V_{{j}}=V_{{j{max}}}\cdot T_{{{lim}}}\cdot W_{{{lim}}}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex	(revision 5166)
@@ -0,0 +1,6 @@
+\begin{equation}
+{V_{{c}}(l)=V_{{c}}\cdot (1-0.7\cdot (1-e^{{-k\cdot LAI(l)}}))}
+\end{equation}
+\begin{equation}
+{V_{{j}}(l)=V_{{j}}\cdot (1-0.7\cdot (1-e^{{-k\cdot LAI(l)}}))}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex	(revision 5166)
@@ -0,0 +1,36 @@
+The photosynthesis is defined by a pair of nested quadratic equations:
+
+M flux determined by the Rubisco and light limited capacities
+
+${\Phi}$ fixed equal to 0.83
+
+${\beta}$ fixed equal to 0.93
+
+M smaller root of
+
+\begin{equation}
+{\Phi \cdot M^{{2}}-M\cdot (V_{{c}}(l)+\alpha \cdot Q)+V_{{c}}(l)\cdot \alpha \cdot Q=0}
+\end{equation}
+Ci(l) (leaf\_ci) global variable declared in diffuco module
+
+W smaller root of
+
+\begin{equation}
+{\beta \cdot W^{{2}}-W\cdot (M+k_{{T}}\cdot C_{{i}}(l)\cdot {10}^{{-6}})+M\cdot k_{{T}}\cdot C_{{i}}(l)\cdot {10}^{{-6}}=0}
+\end{equation}
+${\alpha}$ quantum efficiency
+
+\begin{equation}
+{\alpha \cdot Q=0{.}{092}\cdot 2{.}3\cdot {{SWdown}}\cdot k\cdot e^{{-k\cdot {{LAI}}(l)}}}
+\end{equation}
+
+\begin{equation}
+{M=\frac{V_{{c}}(l)+\alpha \cdot Q-\sqrt{(V_{{c}}(l)+\alpha \cdot Q)^{{2}}-4\cdot \Phi \cdot V_{{c}}(l)\cdot \alpha \cdot Q}}{2\cdot \Phi }}
+\end{equation}
+
+\begin{equation}
+{W=\frac{M+k_{{T}}\cdot C_{{i}}(l){.}{10}^{{-6}}-\sqrt{(M+k_{{T}}\cdot C_{{i}}(l){.}{10}^{{-6}})^{{2}}-4\cdot \beta \cdot M\cdot k_{{T}}\cdot C_{{i}}(l){.}{10}^{{-6}}}}{2\cdot \beta }}
+\end{equation}
+\begin{equation}
+{A=W-R_{{T}}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex	(revision 5166)
@@ -0,0 +1,43 @@
+Wc rubisco-limited carboxylation rate
+
+Oi partial pressure of O2 (fixed to 210000 ppm)
+
+\begin{equation}
+{W_{{c}}=\frac{V_{{c}}(l)\cdot C_{{i}}(l)}{C_{{i}}(l)+K_{{c}}\cdot (1+O_{{i}}/{K_{{o}}})}}
+\end{equation}
+Vj potential rate of RuBP regeneration
+
+I incident photon flux
+
+${\alpha}$j quantum yield of RuBP regeneration 
+
+\begin{equation}
+{\alpha_{{j}}\cdot I=0{.}{8855}\cdot {{SW}}_{{{{down}}}}\cdot k\cdot e^{{-k\cdot {{LAI}}(l)}}}
+\end{equation}
+${\Theta}$ curvature of the quantum response (fixed equal to 0.7)
+
+\begin{equation}
+{V_{{j}}=\frac{\alpha_{{j}}\cdot I+V_{{j}}(l)-\sqrt{(\alpha_{{j}}\cdot I+V_{{j}}(l))^{{2}}-4\cdot \Theta \cdot \alpha_{{j}}\cdot I\cdot V_{{j}}(l)}}{2\cdot \Theta }}
+\end{equation}
+Wj RuBP regeneration-limited rate
+
+${\Gamma}$* CO2 compensation point (ppm)
+
+\begin{equation}
+{W_{{j}}=\frac{V_{{j}}\cdot C_{{i}}(l)}{4{.}5\cdot C_{{i}}(l)+{10}{.}5\cdot \Gamma ^{{?}}}}
+\end{equation}
+
+\begin{equation}
+{W={{MIN}}(W_{{c}},W_{{j}})}
+\end{equation}
+
+Rd dark respiration
+
+fdr fraction of dark respiration (fixed equal to 0.011)
+
+\begin{equation}
+{R_{{d}}=f_{{{{dr}}}}\cdot V_{{c}}(l)}
+\end{equation}
+\begin{equation}
+{A=W\cdot \left(1-\frac{\Gamma ^{{?}}}{C_{{i}}(l)}\right)-R_{{d}}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+{g_{{s}}(l)={{mA}}(l)\frac{h_{{r}}}{C_{{a}}}+b}
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex	(revision 5166)
@@ -0,0 +1,7 @@
+\begin{equation}
+{A=A+A(l)\cdot({{LAI}}(l+1)-{{LAI}}(l))}
+\end{equation}
+\begin{equation}
+{g_{{s}}=g_{{s}}+g_{{s}}(l)\cdot({{LAI}}(l+1)-{{LAI}}(l))}
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = U_{wind}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    zscf = \sqrt{(1 + cd |Ri_{z}|)}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+     cd_{tmp}=\frac {cd_{neut}}{1+3 c_b Ri_z zscf}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+     zscf = \frac {1}  {1+ 3 cc * cc * cd_{neut}  *\sqrt{|Ri_z| \frac{ (z_{lev}   +  roughheight) }  {z_0} }}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+     cd_{tmp} = cd_{neut} (1-3 cb* Ri_{z} * zscf)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+      q_{cdrag} = max   \left\{  cd_{tmp}, \frac{1 \times 10^{-4}}{max \left\{ U, (U_{wind})_{min} \right\} }  \right\}    
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Z_g = Z_{lev} g_0
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Z_d^\phi = \left( \frac{Z_g} {C_{p,air}} \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{V, a, surf} = T_a + \frac {Z_d^\phi} {(1 + rv_{tmp2} q_{air})(1+retv q_{air}) }
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{V, surf} = T_g (1 + retv q_{surf})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \left( {\frac{\delta u}{\delta z}} \right) ^2 = max \{ (0.1)^2, U^2  \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Ri_{z} = z_g \frac {T_{V, a, surf}-T_{V, surf}}{\left( {\frac{\delta u}{\delta z}} \right) ^2  * T_{V, a, surf}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Ri_{z} = max \{   min   \{Ri_z, 5    \}, -5  \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    cd_{neut} = \left(  \frac{  \kappa }  {\frac{LOG(zlev + roughheight)}{z_0} }               \right)^2
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    r_{a} = \frac{1}{q_{c,drag}U}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,4} \equiv  \left(  \frac{1}{1+\frac{r_1}{r_a}}  \right) U_{s_1} = \left( \frac{1}{1+ \frac {r_{soil}}{r_a}} \right) VEG
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,4} = evap_{bare, lim}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \sum_1^{nvm} (\beta_{v,2}); \  \sum_1^{nvm} (\beta_{v,3})   
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_v = 1; \ \alpha_v = 1    
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_v = \beta_{v,4} +  \sum_1^{nvm} (\beta_{v,2}) + \sum_1^{nvm} (\beta_{v,3})   
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \sum_1^{nvm} (veget); \  \sum_2^{nvm} (veget)   
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{eqnarray}
+    IF \ (q_{sat} < q_{air}) \ THEN \ (IF \ (T_a > 0) \ THEN \ toveg=TRUE, \ tosnow = FALSE ) \\
+    IF \ (q_{sat} < q_{air}) \ THEN \ (IF \ (T_a < 0) \ THEN \ toveg= FALSE, \ tosnow=TRUE )  
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{eqnarray}
+    IF \ (toveg) \ THEN: \ \beta_{v,1}=0, \ \beta_{v,4} = (veget), \ \beta_v = \beta_{v,4}, \ \alpha_v = 1 \\
+    IF \ (tosnow) \ THEN: \ \beta_{v,1}=1, \ \beta_{v,4} = 0, \ \beta_v =1, \ \alpha_v = 1       
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{eqnarray}
+    \chi^{dew, veg}= \chi^{d,v}_6(LAI)^5 - \chi^{d,v}_5(LAI)^4 + \chi^{d,v}_4(LAI)^3 
+    - \chi^{d,v}_3(LAI)^2 + \chi^{d,v}_2(LAI) + \chi^{d,v}_1
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{eqnarray}
+    \beta_{v,3} = 0; \ RH = 0     
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{eqnarray}
+    \beta_{v,2} = 0       
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    zqs_{veg}^{rap} = max \left\{ 0, \left( \frac {qs_{int}^{veg} } { qs_{int}^{max} } \right) \right\}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,2} = VEG zqs_{veg}^{rap} \left( \frac{1}{1 + U q_{c,drag} r_{sv} }   \right) \equiv VEG zqs_{veg}^{rap} \left( \frac{1}{1 + \frac{r_{sv}}{r_a} }   \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+    ziltest = \Delta t \beta_{v,2} U q_{c,drag} \rho (q_{sat}-q_{air}) \equiv \Delta t \beta_{v,2} E_{pot} 
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    z_{rapp} = \frac{qs_{int}^{veg}}{ziltest}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,23} = max \left\{  \beta_{v,2} - \beta_{v,2}z_{rapp} , 0 \right\}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,2} = \beta_{v,2} z_{rapp}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \delta _c = \rho . max\{ (q_{sat} - q_{a}), 0 \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    zqs_{veg}^{rap} = max \left\{ 0 , \frac{q_{s,int}^{veg}}{q_{s,int}^{max}}  \right\}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    r_{veg} = \left( \frac{1}{LAI} \right) \left( \frac{R_{SW}^{net} + {R}_{0}}{R_{SW}^{net}} \right) \left( \frac{a+ \lambda \delta_c}{k_0} \right) 
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v3} = VEG (1 - zqs^{rap}_{veg} RH) \frac {1} {1 + \frac {r_{veg}^{pft} (r_{veg}^{et} + r_{sv})}{r_a} }
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,3} = \beta_{v,3} + min \left\{ \beta_{v,23}, VEG zqs_{veg}^{rap} RH \frac {1} {1 + \frac{ r_{veg}^{pft} (r_{veg}^{et} + r_{sv}) }{r_a}} \right\}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex	(revision 5166)
@@ -0,0 +1,72 @@
+% 
+% \documentclass[11pt]{amsart}
+% \usepackage{helvet}
+% \usepackage{geometry}    
+% \geometry{a4paper} 
+% \usepackage[parfill]{parskip}  \usepackage{graphicx}
+% \usepackage{amssymb}
+% \usepackage{epstopdf}
+%
+%
+%
+% \begin{document}
+% 
+{\bf Introduction to the coupled energy budget scheme}
+ 
+The coupled energy balance scheme in ORCHIDEE is described most extensively in Dufresne \& Ghattas (2009) with further context in Best et al. (2004). The key principles are summarised here. 
+
+Figure 1 depicts how the surface layer model interacts with the atmospheric model. The model is depicted as running from left to right. The coefficients A, B, C and D are derived for each variable as a means to solve the diffusivity equation for the four state variables of windspeeds 'u' and 'v', temperature and specific humidity (we here concentrate on the latter two variables, denoted together in Figure 1 as 'X'). This diffusivity equation (with a counter-gradient term for the temperature and specific humidity versions) is differenced in such a way that it can be solved implicitly - i.e. the system is solved using information both from the system at the current time and in the next timestep (in an explicit scheme only information from the current time step is used).
+
+\includegraphics[scale=0.5]{iterative_diagram3.png}
+
+{\bf {Figure 1}: Simple schematic of coupling scheme}
+
+The end result is that the diffusivity equation in LMDZ is solved using an 'offset' varient of the Tri-Diagonal Matrix Algorithm. This differencing scheme is as described by Richtmyer et al. (1967). The scheme allows for terms of the equation to be solved in sequence, as depicted, starting from the top of the model. It takes place by deriving coefficients A, B, C, D for each layer in terms of the preceding, higher, layer on a 'downwards' sweep. ORCHIDEE assumes the place of the lower surface layer boundary condition, and provides the state variables for the lowest level of the atmospheric model. On the 'upwards' sweep, the state variables for each layer are calculated in terms of the respective coefficients and of the state variable from the preceding, lower layer.
+
+
+The key information is passed down from the atmospheric model to the surface model are the sensitivity coefficients $A_S, B_S, A_q$ and $B_q$ where, according to the lower boundary conditions of the atmospheric model, where the surface interaction takes place (Best et al., 2004):
+
+\begin{eqnarray}
+  S_1^{new} = A_S(H) + B_S \\
+  q_1^{new} = A_q(\lambda E) + B_q
+\end{eqnarray}
+
+$S^{new}_1$ is the lowest atmospheric model dry static energy and $q^{new}_1$ is the lowest atmospheric model specific humidity, both for the 'new' time step. The A, B, C and D coefficients (which are recalculated for every time step) are a function of the state variables from the old last time step (specific humidity and surface static energy), as well as an intermediate variable (S) that includes the diffusivity coefficient (k), the atmospheric pressure at the height (P) and a 'counter-gradient term' ($\gamma$). The B coefficient is also a function of P, S and g. As part of the differencing scheme, each coefficient A,B,C and D is also a function of the coefficient above, so they are calculated by 'working down' the column, as depicted.
+
+Now, although the coefficients A and B in equations (1) and (2) are known quantities, $S^{new}$, $q^{new}$, H and $\lambda E$ are not.
+
+In order to determine these quantities, we need to make use of a further set of assumptions:
+
+a) We assume that surface fluxes for a given timestep are written as below (shown here for the 'new' timestep):
+\begin{eqnarray}
+   H = k_1^h (S_1^{new}-S_s^{new}) \\
+   \lambda E =\beta k_1^q (q_1^{new} - q_s ^{new}) =\beta k_1^q (q_1^{new} - q_0 ^{new} (T_s^{new}))
+\end{eqnarray}
+
+These equations are implicit because they have been formulated for the 'new' timestep. $q_0^{new}$ is the saturated humidity that corresponds to the surface temperature $T_s^{new}$. We make the saturated humidity assumption: i.e. the air within cavities in the surface vegetation is completely saturated. This means that the vapour pressure of the vegetation may be calculated as the saturated vapour pressure at the vegetation temperature.
+
+b) We assume, by first-order Taylor series expansion, that:
+
+\begin{eqnarray}
+    q_0(T_s^{new}) = q_{sat}(T_s^{old}) + \frac {\delta q_{sat}} {\delta T}|_{T_t} (T^{new}_s - T^{old}_s)
+\end{eqnarray}
+
+c) We assume that the energy budget is obeyed over the timestep $\Delta t$ such that a change in the balance of fluxes for the surface layer corresponds exactly to the change in surface temperature:
+
+\begin{eqnarray}
+   T_s^{new}=T^{old}_s + \frac{\delta t}{C_0} \sum F
+\end{eqnarray}
+
+where:
+
+\begin{eqnarray}
+    \sum F = H + \lambda E + R_{LW} + R_{SW} + F_G
+\end{eqnarray}
+
+Combining this set of equations, as is conducted by Dufresne \& Ghattas (2009) results in the sequence of operations that is carried out in the 'enerbil' module, and is outlined below.
+
+%
+%
+%
+%
+% \end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex	(revision 5166)
@@ -0,0 +1,135 @@
+%
+% \documentclass[11pt]{amsart}
+% \usepackage{helvet}
+% \usepackage{geometry}    
+% \geometry{a4paper} 
+% \usepackage[parfill]{parskip}  \usepackage{graphicx}
+% \usepackage{amssymb}
+% \usepackage{epstopdf}
+%
+%
+%
+% \begin{document}
+
+\renewcommand{\arraystretch}{1.5}
+
+\begin{tabular}{|c|l|r|}
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+\hline
+ $ps^{old}$ & psold & surface static energy at old timestep (J/kg) \\
+ $ps^{new}$ & psnew & surface static energy at new timestep (J/kg)\\
+ $q_s$ & qsurf & surface specific humidity (kg/kg) \\
+ $q_{s, sat}$ & qsol\_sat & saturated surface humidity (kg/kg) \\
+ $q_{air}$ & qair & lowest level specific humidity at 'old' timestep (kg/kg) \\
+ $q_{air}^{new}$ & qair\_new & lowest level specific humidity at 'new' timestep (kg/kg) \\
+ $\frac{\delta q_s^{old}}{\delta t}$ & pdqsold & derivative of saturated specific humidity at old temperature (kg/(kg s)) \\ 
+ $p_l$ & pb & lowest level air pressure (Pa) \\
+ \hline
+ $C_p^{air}$ & cp\_air & lowest level atmospheric heat capacity (J/(K kg)) \\   
+ \hline
+ $\chi_{CO_2}^{canopy}$ & ccanopy & $CO_2$ concentration in the canopy (?? ppm)  \\
+ $\bar{Ci}$ & cimean & mean intercellular ci (from STOMATE) $(\mu mole/m^2/s)$\\  
+ \hline
+ $R^{LW}_{\uparrow}$ & lwup & long-wave upwelling radiation $(W/m^2)$ \\  
+ $ R^{LW}_{\downarrow}$ & lwdown & downwelling long-wave radiation flux $(W/m^2)$ \\
+ $R^{LW}_{abs}$ & lwabs  & LW radiation absorbed by the surface $(W/m^2)$ \\ 
+ $R^{SW}_{net}$ & swnet & net shortwave radiation flux $(W/m^2)$ \\
+ $R^{net}_{sns}$ & netrad\_sns & sensitivity of net radiation $(W/m^2)$ \\
+ $R_{net}$ & netrad & net radiation at surface layer $(W/m^2)$ \\
+ \hline
+ $\Delta \theta$ & dtradia & Time step (s) \\
+ $\epsilon$ & emis & emissivity (fraction) \\
+ $\sigma$ & c\_stefan & Stefan-Boltzmann constant $(W / (m^2 K^4))$\\
+ $q_{c}$ & q\_cdrag & surface drag coefficient (m/s) \\
+ $\rho_{air}$ & rau & density of air $(kg/m^3)$ \\
+\hline
+\end{tabular}
+
+
+\begin{tabular}{|c|l|r|}
+
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+
+\hline
+
+ $\lambda E_{evap}^0$ & chalev0 & latent heat of evaporation (J/kg) \\
+ $\lambda E_{sub}^0$ & chalsu0 & latent heat of sublimination (J/kg) \\ 
+ $\lambda E_{fsn}^0$ & chalfu0 & latent heat of fusion (J/kg) \\
+
+ $H^{old}$ & sensfl\_old & sensible heat flux at 'old' timestep $(W/m^2)$ \\ 
+ $H^{sns}$ & sensfl\_sns & sensitivity of sensible heat flux $(W/m^2)$\\
+ $H^{new}$ & fluxsens & sensible heat flux at 'new' timestep $(W/m^2)$\\
+
+ ${\lambda E}_{evap}^{old}$ & lareva\_old  & evaporation latent heat flux at old timestep $(W/m^2)$ \\
+ ${\lambda E}_{evap}^{sns}$ & lareva\_sns  & sensitivity of latent heat flux $(W/m^2)$ \\
+  ${\lambda E}_{evap}^{new}$ & fluxsens  & sensitivity of latent heat flux at 'new' time step $(W/m^2)$ \\
+
+ $\lambda E_{sub}^{old}$ & larsub\_old & sublimation latent heat flux at 'old' time step $(W/m^2)$ \\
+ $\lambda E^{sns}_{sub}$ & larsub\_sns & sensitivity of sublimination latent heat flux $(W/m^2)$ \\
+ $\lambda E_{new}^{sub}$ & fluxsubli & sens. of subn. latent heat flux at 'new' time step $(W/m^2)$ \\
+
+ $\Sigma (\lambda E^{old})$ & sum\_old & total latent heat flux at 'old' time step $(W/m^2)$\\
+
+ $\Sigma (\lambda E^{sns})$ & sum\_sns & total latent heat flux sensitivity at 'old' time step $(W/m^2)$\\
+ $E_{pot}^{air,new}$ & epot\_air & air potential energy (?? J) \\
+
+ $G$ & soilflx & sensible heat flux from soil $(W/m^2)$ \\
+
+ \hline
+
+ $E^{snow}$ & vevapsno & snow evaporation (mm/day)\\  
+ $E^{soil}$ & vevapnu & bare soil evaporation  (mm/day)\\ 
+ 
+  $(melt)_{tot}$ & tot\_melt & total melt \\  
+ $vev_{app}$ & vevapp & total of evaporation (mm/d) \\  
+ 
+
+ 
+\hline
+\end{tabular}
+
+
+
+\begin{tabular}{|c|l|r|}
+\hline
+  \bf {symbol} & \bf {variable name} & \bf {description} \\
+
+ \hline
+
+ $A_q^{orc}$ & peqAcoef & ORCHIDEE humidity coefficient 'A' \\
+ $B_q^{orc}$ & peqBcoef & ORCHIDEE humidity coefficient 'B'\\
+ $A_T^{orc}$  &  petAcoef & ORCHIDEE temperature coefficient 'A' \\
+ $B_T^{orc} $ & petBcoef & ORCHIDEE temperature coefficient 'B' \\    
+ $A_q^{lmdz}$ & ... & LMDZ humidity coefficient 'A' \\  
+ $B_T^{lmdz}$ & ... & LMDZ temperature coefficient 'A' \\  
+ $B_q^{lmdz}$ & ... & LMDZ humidity coefficient 'B' \\  
+ $B_T^{lmdz}$ & ... & LMDZ temperature coefficient 'B' \\  
+ \hline
+ $T_{air}$ & tair & air temperature (K) \\
+ $T_{dgnc}^{2m}$ & t2mdiag & diagnostic temperature at 2m above ground (K) \\  
+ $T_S$ & temp\_sol & surface temperature (K) \\  
+ \hline
+
+ $\alpha_v $ & valpha & total $\alpha$ resistance coefficient (fraction) \\
+ $\beta_v$ & vbeta & total resistance coefficient (fraction) \\
+ $\beta_{v1}$ & vbeta1 & snow resistance (fraction) \\  
+ $\beta_{v2}$ & vbeta2 & interception resistance (fraction)\\  
+ $\beta_{v3}$ & vbeta3 & vegetation resistance (fraction)\\  
+ $\beta_{v4}$ & vbeta4 & bare soil resistance (fraction)\\
+ $\beta_{v,CO_2}$ & vbetaco2 & vegetation resistance to $CO_2$ \\ 
+ \hline
+ $U$ & speed & lowest level wind speed (m/s) \\
+ $u$ & u & lowest level wind velocity,  Eastward component  (m/s) \\
+ $v$ & v & lowest level wind volocity, Northward component  (m/s) \\
+ \hline
+ $z_{ikt}$ & zikt & aerodynamic resistance / density of air (kg s $m^{-4}$) \\
+ $z_{ikq}$ & zikq & aerodynamic resistance / density of air (kg s $m^{-4}$)  \\
+\hline
+\end{tabular}
+
+%
+%
+%
+%\end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    ps^{old} = T_S C_p
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \frac{\delta q_s^{old}}{\delta t} = \delta q_s \frac{(p_l)^\kappa}{C_p^{air}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R^{LW}_{abs} = \epsilon R^{LW}_{\downarrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R_{net} = R^{LW}_{\downarrow} + S^{SW}_{net} - \epsilon \sigma T^4 (1-\epsilon) R^{LW}_{\downarrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   E^{snow} = \beta_{v1} \Delta t \rho U q_c^{drag} (q_{sol,s}^{new}- q_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   E^{soil} = (1-\beta_{v1})\beta_{v4} \Delta t \rho U q_c^{drag} (q_{sol,s}^{new} - q_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   xx = \Delta t (1-\beta_{v1}) (q_{s,sat}^{new} - q_{a}) \rho S q_c^{drag}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Interception) = xx \beta_{v2}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Transpiration) = xx \beta_{v3}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   U = max \{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Assimilation) = \beta_{v,CO_2} \Delta t \rho S q_c^{drag} (\chi_{CO_2}^{canopy} - \bar{Ci})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U=max\{U_{min}, \sqrt{u^2+v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   H=\lambda E_0^{sub}(\rho)q_c(\beta_{v,1})(q_{s,sat}^{new}-q_{air}+\lambda E_0^{evap}(\rho)q_c(1-\beta_{v,1})\beta_v(\alpha_v)q_{s,sat}^{new}-q_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \lambda E^{sub}=\lambda E_0^{sub} (\rho)q_c\beta_{v,1}(q_{s,sat}^{new}-q_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H = \rho q_c (ps^{new}- E^{pot}_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   R^{LW}_{net} = R^{LW}_{\downarrow}-R^{LW}_{\uparrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   E^{pot}_{air} = max \{0, \Delta t \rho q_c (q_{s,sat}^{new} -q_{air}) \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T_{air}= \frac{E^{pot}_{air}}{c_{p, air}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_c=|v|q_{c, drag}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R^{LW}_{\uparrow}=\epsilon \sigma T_{sol}^4+\epsilon 4 \sigma T_{sol}^3(T_{s}^{new}-T_{s})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+    R^{LW}_{\uparrow}=R^{LW}_{\uparrow}+(1-\epsilon)R^{LW}_{\downarrow}
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{rad}=\epsilon \sigma T_{s}^4 + R^{LW}_{\uparrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_{surf}=\beta_{v,1} (q_{s,sat}^{new})+(1-\beta_{v,1})\beta_v\alpha_v(q_{s,sat}^{new})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_s = max \{q_s, q_{air} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R_{net}=R^{LW}_{\downarrow}+R^{SW}_{net}-R^{LW}_{\uparrow}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    vev_{app} = \Delta t (\rho)q_c \beta_{v,1}(q_{s,sat}^{new}-q_{air})+\Delta t(\rho)q_c(1-\beta_{1,v}\beta_v(\alpha_v)q_{s,sat}^{new}-q_{air})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    (fusion) = (melt)_{tot} \frac {\lambda E_{sub}^0}{\Delta t}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{new} = T_{s}^{new} - \frac {(melt)_{tot} \lambda E_{sub}^0}{(soilcap)}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max \{ U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \Sigma E^{old} = R_{net} + H^{old} + {\lambda E}_{sub}^{old} + {\lambda E}_{evap}^{old} + G
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \Sigma E^{sns} = R^{sns} + H^{sns} + {\lambda E}_{sub}^{sns} + {\lambda E}_{evap}^{sns} + G
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \Delta \theta = \frac {\Delta t (\Sigma E^{old})} {\left( \frac {1}{C_p^{air}} (C_p^{soil} + \Delta T) (\Sigma E^{sns}) \right)}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    ps^{new} = ps^{old} + \Delta \theta
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_{s,sat}^{new} = q_{s,sat} + \left( \left( \frac{1}{C_p^{air}} \right) \left( \frac{\delta q_s^{old}}{\delta t} \right) \delta\theta \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{new} = \frac {ps^{new}}{C_p^{air}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    E_{pot}^{air,new} = z_{ikt} (H^{old} - H^{sns} \Delta \theta) + ps^{new}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+    {\lambda E} ^{evap} = ({\lambda E}_{evap}^{old} - {\lambda E} _{evap} ^{sns} \Delta \theta) + ({\lambda E}_{sub}^{old} - {\lambda E}_{sub}^{sns} \Delta \theta)
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_{air}^{new}(ji) = q_{air}(ji)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   q_{air}^{new} = z_{ikq} \frac {1} {(\lambda E^{evap}_0  (1 - \beta_{v1}) \beta_1 \alpha_v + \lambda E^{sub}_0 \beta_{v1})} {\lambda E} ^{evap} + q_{s,sat}^{new} 
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    z_{ikt}=\frac{1}{\rho_{air} U q_{c}}; \quad z_{ikq}=\frac{1}{\rho_{air} U q_{c}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H^{old} = \frac{B_T^{orc} - ps^{old}}{z_{ikt} - A_T^{orc}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \lambda E _{sub}^{old} = \lambda E_{sub}^0 \frac{B_q^{orc} - q_{s, sat}}{z_{ikq}-A_q^{orc}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \lambda E _{evap}^{old} = \lambda E_{evap}^0  \left( 1-\beta_{v1} \beta_v \left( \frac {  B_q^{orc} - \alpha_v q_{s, sat}  }{  z_{ikq} - A_q^{orc}  }  \right) \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R^{net}_{sns} = \left( \frac{1}{C_p} \right) 4 \epsilon \sigma \left( \left( \frac{1}{C_p} \right) ps_{t} ^3 \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H_{sns} = \frac{1} { \left( \frac{1}{\rho_{air} S q_{c}} - A_T^{orc} \right)}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \lambda E_{sns}^{sub} = \lambda E_{sub}^0 \beta_{v1} \frac{1}{C_p} \left( \frac{ ({\delta q_s^{t}}/{\delta t}) } {z_{ikq} - A_q^{orc} } \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \lambda E_{sns}^{evap} = \lambda E_{evap}^0 (1-\beta_{v1}) \beta_v \alpha_v \frac{1}{C_p} \left( \frac{ ({\delta q_s^{t}}/{\delta t}) } {z_{ikq} - A_q^{orc} } \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilt2mdiag1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilt2mdiag1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilt2mdiag1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{dgnc}^{2m} = T_{air} 
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex	(revision 5166)
@@ -0,0 +1,392 @@
+\documentclass{article}
+\begin{document}
+
+
+{ \bf enerbil.f90 equations }
+
+\vspace {10mm}
+{ \bf enerbil\_begin }
+
+\vspace {10mm}
+enerbilbegin1.tex
+
+\begin{equation}
+    ps^{t} = T_S C_p
+\end{equation}
+
+\vspace {10mm}
+enerbilbegin2.tex
+
+\begin{equation}
+    \frac{\delta q_s^{t}}{\delta t} = \delta q_s \frac{(p_l)^\kappa}{C_p^{air}}
+\end{equation}
+
+\vspace {10mm}
+enerbilbegin3.tex
+
+\begin{equation}
+    R^{LW}_{abs} = \epsilon R^{LW}_{\downarrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilbegin4.tex
+
+\begin{equation}
+    R_{net} = R^{LW}_{\downarrow} + S^{SW}_{net} - \epsilon \sigma T^4 (1-\epsilon) R^{LW}_{\downarrow}
+\end{equation}
+
+\vspace {10mm}
+{ \bf enerbil\_surftemp }
+
+\vspace {10mm}
+enerbilsurftemp1.tex
+
+\begin{equation}
+    U = max \{ U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp2.tex
+
+\begin{equation}
+    z_{ikt}=\frac{1}{\rho_{air} U q_{c}}; \quad z_{ikq}=\frac{1}{\rho_{air} U q_{c}}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp3.tex
+
+\begin{equation}
+    H^{t} = \frac{B_T^{orc} - ps^{t}}{z_{ikt} - A_T^{orc}}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp4.tex
+
+\begin{equation}
+    \lambda E _{sub}^{t} = \lambda E_{sub}^0 \frac{B_q^{orc} - q_{s, sat}}{z_{ikq}-A_q^{orc}}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp5.tex
+
+\begin{equation}
+    \lambda E _{evap}^{t} = \lambda E_{evap}^0  \left( 1-\beta_{v1} \beta_v \left( \frac {  B_q^{orc} - \alpha_v q_{s, sat}  }{  z_{ikq} - A_q^{orc}  }  \right) \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp6.tex
+
+\begin{equation}
+    R^{net}_{sns} = \left( \frac{1}{C_p} \right) 4 \epsilon \sigma \left( \left( \frac{1}{C_p} \right) ps_{t} ^3 \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp7.tex
+
+\begin{equation}
+    H_{sns} = \frac{1} { \left( \frac{1}{\rho_{air} S q_{c}} - A_T^{orc} \right)}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp8.tex
+
+\begin{equation}
+    \lambda E_{sns}^{sub} = \lambda E_{sub}^0 \beta_{v1} \frac{1}{C_p} \left( \frac{ ({\delta q_s^{t}}/{\delta t}) } {z_{ikq} - A_q^{orc} } \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp9.tex
+
+\begin{equation}
+    \lambda E_{sns}^{evap} = \lambda E_{evap}^0 (1-\beta_{v1}) \beta_v \alpha_v \frac{1}{C_p} \left( \frac{ ({\delta q_s^{t}}/{\delta t}) } {z_{ikq} - A_q^{orc} } \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp10.tex
+
+\begin{equation}
+    \Sigma E^{t} = R_{net} + H^{t} + {\lambda E}_{sub}^{t} + {\lambda E}_{evap}^{t} + G
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp11.tex
+
+\begin{equation}
+    \Sigma E^{sns} = R^{sns} + H^{sns} + {\lambda E}_{sub}^{sns} + {\lambda E}_{evap}^{sns} + G
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp12.tex
+
+\begin{equation}
+    \Delta \theta = \frac {\Delta t (\Sigma E^{t})} {\left( \frac {1}{C_p^{air}} (C_p^{soil} + \Delta T) (\Sigma E^{sns}) \right)}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp13.tex
+
+\begin{equation}
+    ps_{t+\Delta t} = ps_{t} + \Delta \theta
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp14.tex
+
+\begin{equation}
+    q_{s,sat}^{t+\Delta t} = q_{s,sat} + \left( \left( \frac{1}{C_p^{air}} \right) \left( \frac{\delta q_s^{t}}{\delta t} \right) \delta\theta \right)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp15.tex
+
+\begin{equation}
+    T_{s}^{t+\Delta t} = \frac {ps^{t+\Delta t}}{C_p^{air}}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp16.tex
+
+\begin{equation}
+    E_{pot}^{air,t+\Delta t} = z_{ikt} (H^{t} - H^{sns} \Delta \theta) + ps^{t+\Delta t}
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp17.tex
+
+\begin{equation}
+    {\lambda E} ^{evap} = ({\lambda E}_{evap}^{t} - {\lambda E} _{evap} ^{sns} \Delta \theta) + ({\lambda E}_{sub}^{t} - {\lambda E}_{sub}^{sns} \Delta \theta)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp18.tex
+
+\begin{equation}
+    q_{air}^{t+\Delta t}(ji) = q_{air}(ji)
+\end{equation}
+
+\vspace {10mm}
+enerbilsurftemp19.tex
+
+\begin{equation}
+   q_{air}^{t+\Delta t} = z_{ikq} \frac {1} {(\lambda E^{evap}_0  (1 - \beta_{v1}) \beta_1 \alpha_v + \lambda E^{sub}_0 \beta_{v1})} {\lambda E} ^{evap} + q_{s,sat}^{t+\Delta t} 
+\end{equation}
+
+\vspace {10mm}
+{ \bf surf\_land\_orchidee (links from LMDZ to ORCHIDEE)} 
+
+\vspace {10mm}
+surflandLMDZ1.tex
+
+\begin{equation}
+    A_T^{orc} = B_T^{lmdz} \Delta t
+\end{equation}
+
+\vspace {10mm}
+surflandLMDZ2.tex
+
+\begin{equation}
+    B_T^{orc} = A_T^{lmdz}
+\end{equation}
+
+\vspace {10mm}
+surflandLMDZ3.tex
+
+\begin{equation}
+    A_q^{orc} = B_q^{lmdz} \Delta t
+\end{equation}
+
+\vspace {10mm}
+surflandLMDZ4.tex
+
+\begin{equation}
+    B_q^{orc} = A_q^{lmdz}
+\end{equation}
+
+\vspace {10mm}
+{ \bf enerbil\_flux} 
+
+\vspace {10mm}
+enerbilflux1.tex
+
+\begin{equation}
+    U=max\{U_{min}, \sqrt{u^2+v^2} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux2.tex
+
+\begin{equation}
+    q_c=|v|q_{c, drag}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux3.tex
+
+\begin{equation}
+    R^{LW}_{\uparrow}=\epsilon \sigma T_{sol}^4+\epsilon 4 \sigma T_{sol}^3(T_{s}^{t+\Delta t}-T_{s})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux4.tex
+
+\begin{equation}
+    R^{LW}_{\uparrow}=R^{LW}_{\uparrow}+(1-\epsilon)R^{LW}_{\downarrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux5.tex
+
+\begin{equation}
+    T_{s}^{rad}=\epsilon \sigma T_{s}^4 + R^{LW}_{\uparrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux6.tex
+
+\begin{equation}
+    q_{surf}=\beta_{v,1} (q_{s,sat}^{t+\Delta t})+(1-\beta_{v,1})\beta_v\alpha_v(q_{s,sat}^{t+\Delta t})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux7.tex
+
+\begin{equation}
+    q_s = max \{q_s, q_{air} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux8.tex
+
+\begin{equation}
+    R_{net}=R^{LW}_{\downarrow}+R^{SW}_{net}-R^{LW}_{\uparrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux9.tex
+
+\begin{equation}
+    vev_{app} = dt(\rho)q_c \beta_{v,1}(q_{s,sat}^{t+\Delta t}-q_{air})+\Delta t(\rho)q_c(1-\beta_{1,v}\beta_v(\alpha_v)q_{s,sat}^{t+\Delta t}-q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux10.tex
+
+\begin{equation}
+   H=\lambda E_0^{sub}(\rho)q_c(\beta_{v,1})(q_{s,sat}^{t+\Delta t}-q_{air}+\lambda E_0^{evap}(\rho)q_c(1-\beta_{v,1})\beta_v(\alpha_v)q_{s,sat}^{t+\Delta t}-q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux11.tex
+
+\begin{equation}
+   \lambda E^{sub}=\lambda E_0^{sub} (\rho)q_c\beta_{v,1}(q_{s,sat}^{t+\Delta t}-q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux12.tex
+
+\begin{equation}
+    H = \rho q_c (ps^{t+\Delta t}- E^{pot}_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilflux13.tex
+
+\begin{equation}
+   R^{LW}_{net} = R^{LW}_{\downarrow}-R^{LW}_{\uparrow}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux14.tex
+
+\begin{equation}
+   E^{pot}_{air} = max \{0, \Delta t \rho q_c (q_{s,sat}^{t+\Delta t} -q_{air}) \}
+\end{equation}
+
+\vspace {10mm}
+enerbilflux15.tex
+
+\begin{equation}
+   T_{air}= \frac{E^{pot}_{air}}{c_{p, air}}
+\end{equation}
+
+
+
+
+
+
+
+
+
+{\bf enerbil\_evapveg.f90}
+
+\vspace {10mm}
+enerbilevapveg1.tex
+
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg2.tex
+
+\begin{equation}
+   E^{snow} = \beta_{v1} \Delta t \rho U q_c^{drag} (q_{sol,s}^{t+\Delta t}- q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg3.tex
+
+\begin{equation}
+   E^{soil} = (1-\beta_{v1})\beta_{v4} \Delta t \rho U q_c^{drag} (q_{sol,s}^{t+\Delta t} - q_{air})
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg4.tex
+
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg5.tex
+
+\begin{equation}
+   xx = \Delta t (1-\beta_{v1}) (q_{s,sat}^{t+\Delta t} - q_{a}) \rho S q_c^{drag}
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg6.tex
+
+\begin{equation}
+   (Interception) = xx \beta_{v2}
+\end{equation}
+
+\vspace {10mm}
+enerbilevapveg7.tex
+
+\begin{equation}
+   (Transpiration) = xx \beta_{v3}
+\end{equation}
+
+
+\vspace {10mm}
+enerbilevapveg8.tex
+
+\begin{equation}
+   U = max \{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
+
+
+\vspace {10mm}
+enerbilevapveg9.tex
+
+\begin{equation}
+   (Assimilation) = \beta_{v,CO_2} \Delta t \rho S q_c^{drag} (\chi_{CO_2}^{canopy} - \bar{Ci})
+\end{equation}
+
+
+
+
+
+\end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+    A_T^{orc} = B_T^{lmdz} \Delta t
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    B_T^{orc} = A_T^{lmdz}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    A_q^{orc} = B_q^{lmdz} \Delta t
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    B_q^{orc} = A_q^{lmdz}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}\label{eq:bdiff}
+W_{b_j} = \frac{\sum_j a_j W_{b_j}}{\sum_j a_j}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{eqnarray}\label(eq:drs}
+R_s & = & 0.05 R \\
+D & = & 0.95 R
+\end{eqnarray}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex	(revision 5166)
@@ -0,0 +1,10 @@
+It is slower when the top soil moisture $W_t$ is low, and accelerates above a threshold moisture $W_t^\mathrm{lim}$: 
+\begin{equation}\label{eq:dr1}
+D_t = D_t^\mathrm{min}\frac{W_t}{W_t^\mathrm{max}}, \,\, \mathrm{if} \,\, W_t < W_t^\mathrm{lim},
+\end{equation}
+\begin{equation}\label{eq:dr2}
+D_t = D_t^\mathrm{min}\frac{W_t}{W_t^\mathrm{max}} + (D_t^\mathrm{max} - D_t^\mathrm{min})\left(
+\frac{W_t \,-\, W_t^\mathrm{lim}}{W_t^\mathrm{max}\, - \,W_t^\mathrm{lim}} \right)^{\alpha_t},
+\,\, \mathrm{if}\,\,W_i \geq W_i^{lim}
+\end{equation}
+where $D_t^\mathrm{min}$, $D_t^\mathrm{max}$, and $\alpha_t$ are specific parameters.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex	(revision 5166)
@@ -0,0 +1,4 @@
+For three variables (top and bottom soil moisture, $W_t$ and $W_b$; dry soil height at the top, $h_t^d$), we describe a linear relaxation of the values $X_j$ within each soil column towards their grid-cell average $X_j$, with a timescale $\tau_h$ of one day:
+\begin{equation}\label{eq:hdiff}
+\Delta X_j = - \frac{\Delta t}{\tau_h}(X_j-\overline{X}).
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel.tex	(revision 5166)
@@ -0,0 +1,15 @@
+If only one soil layer is present, then  $h_t^d = h_b^d$, and we define: 
+\begin{equation}\label{eq:us1}
+U_s=  \exp (-c_j \, h_t^d )
+\end{equation}
+If there are two soil layers, we compute $U_s$ as the average of the values defined by the two dry soil depths $h_t^d$ and  $h_b^d$. The weights depend on $a_j^\mathrm{sat}$, which defines the "transpiring" fraction of the top soil layer:
+\begin{equation}\label{eq:us2}
+U_s= a_j^\mathrm{sat} \exp (-c_j \, h_t^d ) + (\mathrm{1}-a_j^\mathrm{sat})  \exp (-c_j \, h_b^d )
+\end{equation}
+
+The "transpiring" fraction is defined by redistributing the top layer's moisture $W_t$ in a virtual layer of depth $h_t^\mathrm{sub}$ (set to 1 mm in hydrolc), what defines a totally dry and a totally saturated fraction ($a_j^\mathrm{sat}$):
+\begin{itemize}
+\item if  $W_t > h_t^\mathrm{sub} \, \theta^\mathrm{max}$, then $a_j^\mathrm{sat}$=1, and $U_s$ depends on $h_t^d$ only (Eq. \ref{eq:us1}), % $U_s=\exp (-c_j \, h_t^d )$,
+\item if $W_t$ is very small, $a_j^\mathrm{sat}$ decreases from 1 to 0 as the top layer's moisture vanishes, and it serves to describe a smooth transition to the case where the top soil layer has vanished and $U_s$ depends on  $h_t^d = h_b^d$.
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}\label{eq:us1}
+U_s=  \exp (-c_j \, h_t^d )
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}\label{eq:us2}
+U_s= a_j^\mathrm{sat} \exp (-c_j \, h_t^d ) + (\mathrm{1}-a_j^\mathrm{sat})  \exp (-c_j \, h_b^d )
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+snowmelt=\frac{(temp\_sol\_new - tp\_00)*soilcap}{chalfu0}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+d\_age=(age-(1- \frac{age}{max\_snow\_age})*\frac{dt\_radia}{one\_day})*\exp(-\frac{precip\_snow}{snow\_trans}))-age
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+d\_age\_nobio=\frac{d\_age}{1+(\frac{tp\_00-T}{7.})^4}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex	(revision 5166)
@@ -0,0 +1,14 @@
+These calculations are only performed in the non bare soil PFTs ($j>1$), over the vegetated fraction $a_j$. 
+The maximum amount of water that can be added to the interception reservoir is:
+\begin{equation}\label{eq:interc1}
+I^\mathrm{add} = I^\mathrm{max} - [I]_\mathrm{old} - E_i \Delta t.
+\end{equation}
+The intercepted water amount $I$ is therefore updated with:
+\begin{equation}\label{eq:interc2}
+[I]_\mathrm{new} = [I]_\mathrm{old} - E_i \Delta t + \min (a_j P_L (1-f_j) \Delta t, I^\mathrm{add}),
+\end{equation}
+where $f_j$ is the fraction of rainfall that cannot be intercepted and necessarily falls to the ground.
+The throughfall $P_T$ is then calculated with:
+\begin{equation}\label{eq:interc3}
+P_T \Delta t = P_L (1-f_j) \Delta t - ([I]_\mathrm{new} - [I]_\mathrm{old}).
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex	(revision 5166)
@@ -0,0 +1,10 @@
+It non linearly increases with the height of top dry soil $h_\mathrm{dry}$, and becomes very large when $h_\mathrm{dry}$ gets close to the total soil depth, $h_\mathrm{tot}$:
+\begin{equation}\label{eq:rsol}
+r_\mathrm{soil} = r_\mathrm{soil}^\mathrm{m} \left( h_\mathrm{dry} + \frac{\mathrm{1}}{\mathrm{100}(h_\mathrm{tot}-h_\mathrm{dry})^2}  \right).
+%r_\mathrm{soil} = r_\mathrm{soil}^r_\mathrm{m}  
+\end{equation}
+The top dry soil height  $h_\mathrm{dry}$ depends on both $h_t^d$ and $h_t^d$ in the bare soil fraction. As for the soil moisture stress factor on transpiration and bare soil evaporation ($U_s$), we use $a_j^\mathrm{sat}$ to describe a smooth transition between cases when the top layer's moisture  $W_t > h_t^\mathrm{sub} \theta^\mathrm{max}$ (then $h_\mathrm{dry}=h_t^d$),  and cases when the top layer's has vanished (then  $h_\mathrm{dry}=h_t^d=h_b^d$):
+\begin{equation}\label{eq:hdry}
+h_\mathrm{dry} = a_1^\mathrm{sat} h_{t_1}^d + (\mathrm{1} - a_1^\mathrm{sat})  h_{b_1}^d.
+\end{equation}
+% hdry(:) = a_subgrd(:,1)*dss(:,1) + (un-a_subgrd(:,1))*dsp(:,1) 
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsat.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsat.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsat.tex	(revision 5166)
@@ -0,0 +1,12 @@
+We calculate the deviation of the saturated humidity with the temperature and the pressure.
+\begin{equation}
+\delta q_{sat}(T) = \frac{(q_s(\lfloor T+\frac{1}{2}\rfloor + 1) - 2.q_s(\lfloor T +\frac{1}{2} \rfloor) + q_s(\lfloor T+\frac{1}{2} \rfloor -1))(\lbrace T + \frac{1}{2}\rbrace -1 ) + q_s(\lfloor T+\frac{1}{2} \rfloor +1) - q_s(\lfloor T+\frac{1}{2} \rfloor)}{P}
+\end{equation}
+
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T + \frac{1}{2} \rfloor $ represents the largest integer not greater than $T + \frac{1}{2} $. 
+ \item  $ \lbrace T + \frac{1}{2} \rbrace = T + \frac{1}{2} -\lfloor T + \frac{1}{2} \rfloor $ is the fractional part of $T + \frac{1}{2} $.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsatcalc.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsatcalc.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/dev_qsatcalc.tex	(revision 5166)
@@ -0,0 +1,14 @@
+We calculate the deviation of the saturated humidity with the temperature and the pressure for a given pixel $x$.
+\begin{multline}
+\delta q_{sat}(x,T) = \\
+\frac{(q_s(x,\lfloor T+\frac{1}{2}\rfloor + 1) - 2.q_s(x,\lfloor T +\frac{1}{2} \rfloor) + q_s(x,\lfloor T+\frac{1}{2} \rfloor -1))(\lbrace T + \frac{1}{2}\rbrace -1 )} {P}+ 
+\\ \frac{q_s(x,\lfloor T+\frac{1}{2} \rfloor +1) - q_s(x, \lfloor T+\frac{1}{2} \rfloor)}{P}
+\end{multline}
+
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T + \frac{1}{2} \rfloor $ represents the largest integer not greater than $T + \frac{1}{2} $. 
+ \item  $ \lbrace T + \frac{1}{2} \rbrace = T + \frac{1}{2} -\lfloor T + \frac{1}{2} \rfloor $ is the fractional part of $T + \frac{1}{2} $.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/goff_gratch.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/goff_gratch.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/goff_gratch.tex	(revision 5166)
@@ -0,0 +1,30 @@
+The subroutine qsfrict\_init uses modified Goff-Gratch equations (1946). The original formulations are : \\
+\begin{multline}
+\log e_w = \\ -7.90298 \left( \frac{T_s}{T} - 1 \right) + 5.02808 \log \left( \frac{T_s}{T} \right) 
+- 1.3816 \times 10^{-7}(10^{11.344 \left( 1-\frac{T_s}{T} \right)}-1) 
++ 8.1328 \times 10^{-3}(10^{-3.49149 \left( \frac{T_s}{T}-1 \right)}
+-1) \\ + \log e_{ws}
+\end{multline}
+where : \\
+\begin{itemize}
+ \item  $ \log(x) = \frac{\ln x}{\ln 10} $. 
+ \item  $e_w$ is the saturation water vapor pressure over a plane surface of pure ordinary liquid water (hPa).
+ \item  $T$ is the absolute air temperature in Kelvin.
+ \item  $T_s$ is the steam point temperature (373.16 K).
+ \item  $e_{ws}$ is the saturation pressure of pure ordinary liquid water at steam-point temperature (at 1 atm = 1013.25 hPa).
+\end{itemize}
+
+\begin{multline}
+\log e_i = \\ -9.09718 \times \left( \frac{T_0}{T} - 1 \right) - 3.56654 \times \log \left( \frac{T_0}{T} \right) 
++ 0.876793 \times \left( 1-\frac{T_0}{T} \right) 
++ \log e_{i0}
+\end{multline}
+where : \\
+\begin{itemize}
+ \item  $ \log(x) = \frac{\ln x}{\ln 10} $. 
+ \item  $e_i$ is the saturation water vapor pressure over a plane surface of pure ordinary water ice (hPa).
+ \item  $T$ is the absolute air temperature in Kelvin (K).
+ \item  $T_0$ is the boiling point at 1 atmosphere temperature (273.16 K).
+ \item  $e^{*}_{i0}$  is the saturation pressure of pure ordinary water ice at ice-point temperature (6.1173 hPa).
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsat.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsat.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsat.tex	(revision 5166)
@@ -0,0 +1,12 @@
+The interpolation the saturated humidity depends on the temperature $T$ (in Kelvin). 
+It is set by the following equation :
+\begin{equation}
+q_{sat}(T)= \dfrac{q_s(\lfloor T \rfloor +1) - q_s(\lfloor T \rfloor).\lbrace T \rbrace + q_s(\lfloor T \rfloor)}{P}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T \rfloor $ represents the largest integer not greater than $T$. 
+ \item  $ \lbrace T \rbrace = T -\lfloor T \rfloor $ is the fractional part of $T$.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsatcalc.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsatcalc.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsatcalc.tex	(revision 5166)
@@ -0,0 +1,12 @@
+The interpolation the saturated humidity on one pixel $x$  depends on the temperature $T$ (in Kelvin). 
+It is set by the following equation :
+\begin{equation}
+q_{sat}(x,T)= \dfrac{q_s(x,\lfloor T \rfloor +1) - q_s(x,\lfloor T \rfloor).\lbrace T \rbrace + q_s(x,\lfloor T \rfloor)}{P}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ \lfloor T \rfloor $ represents the largest integer not greater than $T$. 
+ \item  $ \lbrace T \rbrace = T -\lfloor T \rfloor $ is the fractional part of $T$.
+ \item  $q_s$ is the array caclulated in the subroutine qsfrict\_init. 
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsfrict_init.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsfrict_init.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/qsfrict_init.tex	(revision 5166)
@@ -0,0 +1,17 @@
+The specific humidity  $q_s$ is a function of temperature $T$. Its values are : 
+\begin{equation}
+q_s(T) = 
+\begin{cases}
+0 & \text{if} \quad T < 100K \\
+\dfrac{M_{air}}{M_{vapor}} \cdot 10^{2.07203 - 0.0032099T - \frac{2484.896}{T} + 3.56654\log{T}} & \text{if} \quad 100K \leq T < 273K \\
+\dfrac{M_{air}}{M_{vapor}} \cdot 10^{23.819 - \frac{2948.964}{T} -
+  5.028\log{T} - 29910.16\exp(-0.0699832\times T) + 25.21935\exp(-\frac{2999.924}{T}) } & \text{if} \quad 273K \leq T \leq 370K \\
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $\dfrac{M_{air}}{M_{vapor}} = \dfrac{18.02 \times 10^{-3}}{28.964 \times 10^{-3}} \simeq 0.622 $ is the ratio between the molecular weight of dry air and \\ 
+the molecular weight of water vapor.
+ \item  $\log(T) = \dfrac{\ln T}{\ln 10}$
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/tempfunc.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/tempfunc.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/qsat_moisture/tempfunc.tex	(revision 5166)
@@ -0,0 +1,18 @@
+%\documentclass{article}
+%\usepackage[english]{babel}
+%\usepackage{amsmath}
+%\begin{document}
+\begin{equation}
+f(T) = 
+\begin{cases}
+0 & \text{if} \quad T < 273K \\
+1 - \dfrac{(T_{max} - T)^2}{(T_{max} - T_{min})^2} & \text{if} \quad 273K \leq T \leq 293K \\
+1 & \text{if} \quad T > 293K
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $ T_{min} = 273K$ 
+ \item  $ T_{max} = 293K$
+\end{itemize}
+%\end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\frac{\partial T}{\partial t}=\frac{\partial ^2 T}{\partial z^2}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+C_p\frac{\partial T}{\partial t}=K\frac{\partial ^2 T}{\partial z^2}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+D = \Bigl[\frac{4 \times (C_{sapwood} + C_{heartwood})}{WD.\pi.k_{allom2}}\Bigr]^{\frac{1}{(2+k_{allom3})}} 
+H = k_{allom2} \times D^{k_{allom3}} 
+CA =\min(k_{allom1} \times D^{k_{rp}},CA_{max})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    D = \Bigl[\frac{4 \times (C_{sapwood} + C_{heartwood})}{WD.\pi.k_{allom2}}\Bigr]^{\frac{1}{(2+k_{allom3})}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H = k_{allom2} \times D^{k_{allom3}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+    CA =\min(k_{allom1} \times D^{k_{rp}},CA_{max})
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex	(revision 5166)
@@ -0,0 +1,37 @@
+\begin{equation}
+FPC = \frac{CN \cdot IND}{FRAC} \cdot \left[ 1 - \exp \left( -1 \cdot 
+    LM_{\rm max} \cdot SLA \cdot coff \right) \right]
+\end{equation}
+where $FPC$ is foliage projective cover (``fpc\_nat'' in source code),
+$CN$ crown area (cn\_ind; m$^{2}$), $IND$ number of individuals (ind;
+m$^{-2}$), $FRAC$ total fraction occupied by natual vegetation
+(fracnat), $LM_{\rm max}$ maximum leaf mass in last year
+(lm\_lastyearmax; g C m$^{-2}$), $SLA$ specific leaf area (sla;
+m$^{2}$ (g C)$^{-1}$), and $coff$ coefficient (ext\_coeff).
+
+\begin{equation}
+  EST_{\rm tree} = EST_{clm} \left[1 - \exp \left( -5 \cdot (1 - FPC_{\rm woody}) 
+    \right) \right] \cdot (1 - FPC_{\rm woody})
+\end{equation}
+where $EST_{\rm tree}$ is maximum tree establishment rate
+(estab\_rate\_max\_tree), $EST_{clm}$ maximum tree establishment rate
+controled by climate (estab\_rate\_\\max\_climate\_tree), $FPC_{\rm
+  woody}$ total woody FPC (sumfpc\_wood).
+
+\begin{equation}
+  EST_{\rm grass} = \max \left[  \min \left[ EST_{clm}, 0.98 - FPC_{\rm sum} \right], 
+    0 \right]
+\end{equation}
+where $EST_{\rm grass}$ is maximum grass establishment rate
+(estab\_rate\_max\_grass) and $FPC_{\rm sum}$ total natural fpc
+(sumfpc).
+
+\begin{equation}
+FPC = \min \left[ 1, CN \right] \cdot IND \cdot \max \left[ 1 - \exp 
+  \left( -coff \cdot LAI \right), MIN_{\rm cover} \right]
+\end{equation}
+where $MIN_{\rm cover}$ is fraction of crown area invaded by other
+trees (min\_cover = 0.05)
+
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex	(revision 5166)
@@ -0,0 +1,6 @@
+\begin{equation}
+p(m)=e^{-\pi*\left(\frac{m}{m_e}\right)^{2}}
+\end{equation}
+
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex	(revision 5166)
@@ -0,0 +1,6 @@
+\begin{equation}
+A(s)=s*e^{(\frac{s-1}{0.45*(s-1)^{3}+2.83*(s-1)^{2}+2.96*(s-1)+1.04})}
+\end{equation}
+
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+greff=\frac{\Delta}{C_{leaf}*SLA}
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+mort_{greff}=\frac{k_{mort1}}{1+k_{mort2}*greff}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+FPC = \frac{CN \cdot IND}{FRAC} \cdot \left[ 1 - \exp \left( -1 \cdot 
+    LM_{\rm max} \cdot SLA \cdot coff \right) \right]
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+A\propto \frac{\sum X_{i}}{\sum X_{i}+\sum Y_{j}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{rpc}=\frac{1}{1-e^{-{\frac{\mathit{z_soil}\left(nbdl\right)}{\mathit{z_nitrogen}}}}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+\mathit{t_{nitrogen}}=\sum_{l=1}^\mathit{nbdl} \mathit{tsoil_{month}} \cdot \mathit{rpc} \cdot \left( e^{  -\frac{\mathit{z_{soil}(l-1)}}{\mathit{z_{nitrogen}}}  } 
+- e^{  -\frac{\mathit{z_{soil}(l)}}{\mathit{z_{nitrogen}}}  } \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{h_{nitrogen}}=\sum_{l=1}^\mathit{nbdl} \left(\mathit{soil\_hum\_month} \cdot \mathit{rpc} \cdot \left(e^{-{\frac{\mathit{z_{soil}}\left(l-1\right)}{\mathit{z_{nitrogen}}}}}-e^{-{\frac{\mathit{z_{soil}}(l)}{\mathit{z_{nitrogen}}}}}\right)\right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+\mathit{use\_reserve}=\mathit{min}\left(\mathit{biomass}\left(\mathit{carbres}\right),2 \cdot \frac{\mathit{dt}}{\mathit{tau_{leafinit}}}\cdot\frac{\mathit{lai_{happy}}}{\mathit{sla}}\right)
+
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex	(revision 5166)
@@ -0,0 +1,6 @@
+\begin{equation}
+
+
+\mathit{transloc\_leaf}=\frac{\mathit{L0}}{\mathit{L0}+\mathit{R0}}\cdot \mathit{use\_reserve}
+
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{alloc\_sap_{above}}=\mathit(alloc\_min)+\left(\mathit{alloc\_max}-{\mathit{alloc\_min}}\right)\left(1-e^{-{\frac{\mathit{age}}{\mathit{demi\_alloc}}}}  \right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex	(revision 5166)
@@ -0,0 +1,8 @@
+\begin{equation}
+\mathit{falloc_{leaf}}=\mathit{LtoLSR} \cdot \left( 1-\mathit{falloc_{fruit}} \right) \cdot \mathit{carb\_rescale}
+\mathit{falloc_{sapabove}}=\mathit{StoLSR}\cdot \mathit{alloc\_sap_{above}} \cdot \left( 1-\mathit{falloc_{fruit}} \right)\cdot \mathit{carb\_rescale}
+\mathit{falloc_{sapbelow}}=\mathit{StoLSR}\cdot \left( 1- \mathit{alloc\_sap_{above}} \right) \cdot \left( 1-\mathit{falloc_{fruit}} \right)\cdot \mathit{carb\_rescale}
+\mathit{falloc_{root}}=\mathit{RtoLSR}\cdot\left( 1-\mathit{falloc_{fruit}} \right)\cdot \mathit{carb\_rescale}
+\mathit{falloc_{carbres}}=\left( 1-\mathit{carb\_rescale}\right)\left( 1-\mathit{falloc_{fruit}} \right)
+
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex	(revision 5166)
@@ -0,0 +1,13 @@
+The SLA is calculated for each different PFT by the following equation :
+\begin{equation}
+SLA =
+\begin{cases}
+ 2.10^{-4}\times 10^{2.29 - 0.4\log(\frac{12}{a_{leaf}})} & \text{if PFT needle-leaf} \\
+ 2.10^{-4}\times 10^{2.41 - 0.38\log(\frac{12}{a_{leaf}})}
+\end{cases} %\]
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $a_{leaf}$ is a PFT-specific value for leaf longevity in days.
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex	(revision 5166)
@@ -0,0 +1,9 @@
+The SLA is calculated in Reich et al. 97 by :
+\begin{equation} 
+SLA = \exp (5.615 - 0.46 \cdot \ln (a_{leaf}))
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $a_{leaf}$ is a PFT-specific value for leaf longevity in months.
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex	(revision 5166)
@@ -0,0 +1,43 @@
+Sapling biomass for grasses : \\
+
+\begin{equation}
+\alpha_{grass} = 0.5
+\end{equation}
+
+\begin{equation}
+SAPL_{leaf}
+\begin{cases}
+\dfrac{0.1}{SLA} & \\
+\dfrac{1}{SLA} & \text{if PFT crop}
+\end{cases} %\]
+\end{equation}
+
+\begin{equation}
+SAPL_{sapabove} = 0
+\end{equation}
+
+\begin{equation}
+SAPL_{sapbelow} = 0
+\end{equation}
+
+
+\begin{equation}
+SAPL_{heartabove} = 0
+\end{equation}
+
+\begin{equation}
+SAPL_{heartbelow} = 0
+\end{equation}
+
+\begin{equation}
+SAPL_{root} = 0.1 \cdot \frac{1}{\alpha_{grass}} \cdot SAPL_{leaf} 
+\end{equation}
+
+\begin{equation}
+SAPL_{fruit} = 0.3 \cdot SAPL_{leaf} 
+\end{equation}
+
+\begin{equation}
+SAPL_{reserve} = 5 \cdot SAPL_{leaf}  
+\end{equation}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex	(revision 5166)
@@ -0,0 +1,55 @@
+Sapling biomass for trees : \\
+
+\begin{equation}
+\alpha_{tree} = 1
+\end{equation}
+
+\begin{equation}
+SAPL_{leaf} =  \left( \frac {4 \cdot k_{allom1} \cdot \left( \dfrac{4 \cdot r_{hs:s} \cdot SLA }{\pi .k_{la:sa}}\right)^{0.8} }{SLA} \right)^5
+\end{equation}
+
+\begin{equation}
+SAPL_{sapabove} = 0.5 \cdot P \cdot \frac{SAPL_{leaf}}{\left( \dfrac
+  {k_{la:sa}}{SLA} \right) } \cdot k_{allom2} \cdot \left(
+  \sqrt{4.\frac{r_{hs:s}}{\pi} \frac{SAPL_{leaf}}{ \left( \dfrac {k_{la:sa}}{SLA} \right) }} \right) ^{k_{allom3}} 
+\end{equation}
+
+\begin{equation}
+SAPL_{sapbelow} = SAPL_{sapabove}
+\end{equation}
+
+
+\begin{equation}
+SAPL_{heartabove} = 2.SAPL_{sapabove}
+\end{equation}
+
+\begin{equation}
+SAPL_{heartbelow} = 2.SAPL_{sapbelow}
+\end{equation}
+
+\begin{equation}
+SAPL_{root} = 0.1 \cdot \frac{1}{\alpha_{tree}} \cdot SAPL_{leaf} 
+\end{equation}
+
+\begin{equation}
+SAPL_{fruit} = 0.3 \cdot SAPL_{leaf} 
+\end{equation}
+
+\begin{equation}
+SAPL_{reserve} = 
+\begin{cases}
+5 \cdot SAPL_{leaf} & \text{if PFT not evergreen} \\
+0 & \text{if PFT evergreen}
+\end{cases} %\]
+\end{equation}
+
+where : \\
+\begin{itemize}
+ \item  $k_{allom1}= 100$; \quad $ k_{allom2} = 40$; \quad  $k_{allom3}= 0.5$.
+ \item  $r_{hs:s}$ is the ratio between the sum of the mass of sapwood and heartwood over sapwood.
+ \item  $k_{la:sa} = 8000 $
+ \item  $P = 200000$ is the pipe density. 
+\end{itemize}
+
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex	(revision 5166)
@@ -0,0 +1,10 @@
+Critical stem diameter for trees : beyond this diameter, the crown area no longer increases.
+\begin{equation}
+D_{max} = 0.01 .\left( \frac{k_{allom4}}{\dfrac{k_{allom2}.k_{allom3}}{100^{k_{allom3}}}} \right)^{\dfrac{1}{k_{allom3} - 1}}
+\end{equation}
+where : \\
+\begin{itemize}
+ \item  $D_{max}$ is the maximum stem diameter.
+ \item  $ k_{allom2} = 40$; \quad  $k_{allom3}= 0.5$; \quad  $k_{allom4}= 0.3$
+\end{itemize}
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   M=MAX(0.25,MIN(1,M)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=e^{0.69*(\frac{temp-303}{10})}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=MIN(1,T)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=MIN(1,T)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   DLC=1-e^{(-0.5*LAI)}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   M=-1.1*soilmoisture^2+2.4*soilmoisture-0.29
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   F=0.85-0.018*L*CN
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   k=\frac{1}{litter tau}*T*M
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dDL}{dt}=DL*(1-k)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dInput}{dt}=f*C*(1-L)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dLAI}{dt}=DL*sla*vegetmax
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+gdd_{crit}(i) =  GDD_{crit1,j} + GDD_{crit2,j} \times T_{l} + GDD_{crit3,j} \times T_{l}^{2}
+\end{equation}
+where GDD$_{crit1,2,3}$ are the PFT-dependent threshold parameters defined by the ::$pheno_crit$\%$gdd$, and $T_{l}$ is the long-term
+reference temperature (::$tlong_ref$ - calculated in ::$stomate_constants$) in degrees C. i and j are the grid cell and PFT respectively.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex	(revision 5166)
@@ -0,0 +1,7 @@
+\begin{equation}
+LM_{min}(i) = \frac{LAI_{init,min}(j)}{SLA(j)} 
+\end{equation}
+where $LM_{min}$ is the minimum leaf biomass, $LAI_{init\_min}$ is the minimum initial LAI, which is
+PFT-dependent and specified by the parameter ::pheno_crit\%lai\_initmin, which is defined in 
+::stomate\_constants. SLA, the specific leaf area, is also PFT-dependent and defined in
+::stomate\_constants. i and j are the grid cell number and PFT respectively.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+avail_{crit}(i) = min_{moi,ly}(i,j) + hum_{frac}(j) * ( max_{moi,ly}(i,j) - min_{moi,ly}(i,j))
+\end{equation}
+where $min_{moi,ly}$ and $max_{moi,ly}$ are last year's minimum and maximum moisture availability, and $hum_{frac}$ is the 
+parameter ::$pheno_crit\%hum\_frac$.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+A_{moi} = max(\, 0.1, \frac{\sum_{i=1}^{n} H_{i}e^{-z_{i}/\zeta}\Delta_{i}}{ \sum_{i=1}^{n} e^{-z_{i}/\zeta}\Delta_{i}} \,)
+\end{equation}
+where $A_{moi}$ is the plant available moisture, $H_{i}$ is the soil humidity (relative soil moisture) of the $i$-th layer, $z_{i}$ is the depth of the layer, and $\Delta$ is its thickness. $\zeta$ is the root density profile, which is 1.5m for trees and 0.3m for grasses (Krinner et al., 2005).
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex	(revision 5166)
@@ -0,0 +1,4 @@
+\begin{equation}
+gdd_{min} = \frac{603}{\exp(0.0091*NCD(i,j))} - 64. 
+\end{equation}
+where i and j are the grid cell and PFT, respectively. 
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex	(revision 5166)
@@ -0,0 +1,5 @@
+The equation to calculate tree crown area from its diameter:
+\begin{equation}
+CA=k_{allom1}*Diameter^{k_{rp}}
+\end{equation}
+Where $CA$ is tree crown area, $Diameter$ is tree diameter, $k_{allom1}$ and $k_{rp}$ are parameters.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex	(revision 5166)
@@ -0,0 +1,5 @@
+The equation to calculate tree height from its diameter:
+\begin{equation}
+Height=k_{allom2}*Diameter^{k_{allom3}}
+\end{equation}
+Where $Height$ is tree height, $Diameter$ is tree diameter, $k_{allom2}$ and $k_{allom3}$ are parameters.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{rpc}=\frac{1}{1-e^{-{\frac{\mathit{z\_soil}\left(nbdl\right)}{\mathit{rprof}}}}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{t\_root}=\sum_{l=1}^\mathit{nbdl} (\mathit{stempdiag} \cdot \mathit{rpc} \cdot \left(e^{-{\frac{\mathit{z\_soil}\left(l-1\right)}{\mathit{rprof}}}}-e^{-{\frac{\mathit{z\_soil}(l)}{\mathit{rprof}}}}\right))
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{slope}=\mathit{maint\_resp\_slope1}+\mathit{maint\_resp\_slope2}\cdot \mathit{tl}+\mathit{maint\_resp\_slope3}\cdot \mathit{tl}\cdot \mathit{tl}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{coeff\_maint}=\mathit{coeff\_maint\_zero}\cdot \left(\frac{\mathit{dt}}{\mathit{one\_day}}\right)\cdot \left(1+\mathit{slope}\cdot \mathit{t\_maint\_radia}\right)
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{resp\_maint\_leaf}=\mathit{coeff\_maint(leaf)}\cdot \mathit{leaf\_biomass}\cdot\frac{ (0.3\cdot \mathit{LAI}+1.4\cdot (1.0-e^{-0.5\cdot \mathit{LAI}}))}{\mathit{LAI}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex	(revision 5166)
@@ -0,0 +1,6 @@
+\begin{equation}
+consumption = hvc1 \times NPPleaf_{long}^{hvc2}
+\end{equation}
+
+\noindent where hvc1 and hvc2 are herbivore activity constants which are set at the beginning of this module to
+0.019 and 1.38 respectively. NPPleaf_{long} is the mean, long-term leaf NPP.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+herbivore = \frac{Tres_{green} \times NPPleaf_{long}}{consumption} 
+\end{equation}
+
+\noindent where Tres_{green} is the mean residence time of the green tissue.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+X_{l} = \frac{X_{l} \, (\tau - {\Delta}t) + X_{s} \, {\Delta}t}{\tau}
+\end{equation}
+
+\noindent where X$_{l}$ is the long-term variable (e.g. monthly temperature/moisture availability), X$_{s}$ is the short-term variable (e.g. daily temperature/moisture availability), $\Delta$t is the time step, and $\tau$ is the time constant (in days) which varies according to the length of time represented by the long-term variable (equation (3) in Krinner et al., 2005). Values for tau set are based on calibration against observations CHECK.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+moist_{avail} = \frac{moist_{avail} \times (tau_{hum} - \Delta t) + moist_{avail,daily} \times \Delta t}{tau_{hum}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+ncd_{max} = 3. * one\_year 
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+soilhum_{month} = \frac{soilhum_{month} \times (tau_{soilhum} - \Delta t) + soilhum_{daily} * \Delta t}{tau_{soilhum}}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex	(revision 5166)
@@ -0,0 +1,10 @@
+\begin{equation}
+Tl_{ref} = MAX(\, Tl_{ref-min}, \, MIN( \, Tl_{ref-max}, \, Tl \,) \,)
+\end{equation}
+
+\noindent where Tl$_{ref}$ is the long-term reference 2-meter temperature, 
+Tl$_{ref-min}$ and Tl$_{ref-max}$ are the reference minimum and maximum
+ long-term 2-meter temperature which CHECK should be set at the beginning of this 
+subroutine, and Tl is the "long-term" 2-meter reference temperature, previously
+calculated.
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+f_{active\rightarrow slow}=1-(0.85-0.68\times clay)-f_{active\rightarrow passive}.
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex	(revision 5166)
@@ -0,0 +1,13 @@
+\begin{equation}
+Flux_{pool}=
+\left\{
+  \begin{array}{ll}
+	C_{pool}\times\frac{\Delta t}{\tau_{pool}}\times\epsilon_T\times\epsilon_H & \textrm{(natural vegetation)} \\
+	C_{pool}\times\frac{\Delta t}{\tau_{pool}}\times\epsilon_T\times\epsilon_H\times 1.2 & \textrm{(C3 crops)} \\
+	C_{pool}\times\frac{\Delta t}{\tau_{pool}}\times\epsilon_T\times\epsilon_H\times 1.4 & \textrm{(C4 crops)}
+  \end{array}
+\right. \nonumber
+\end{equation}
+,where $C_{pool}$, $\Delta t$, $\tau_{pool}$, $\epsilon_T$ and $\epsilon_H$ are respectively the pool carbon
+stock, the time step, the pool turnover time, and two control coefficients
+(temperature and humidity) defined in the ::stomate\_litter module
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+Flux_{active}=Flux_{active}\cdot(1-0.75\times clay) . \nonumber
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+C_{pool} = C_{pool}-Flux_{pool}
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex	(revision 5166)
@@ -0,0 +1,3 @@
+\begin{equation}
+Resp_{soil}=\sum_{pool}(f_{pool\rightarrow atmosphere}\times Flux_{pool}).
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex	(revision 5166)
@@ -0,0 +1,9 @@
+\begin{equation}
+\left\{
+  \begin{array}{lcll}
+	C_{active}&=&C_{active}&+\sum_{pool}(f_{pool\rightarrow active}\times Flux_{pool})\\
+	C_{slow}   &=&C_{slow}&+\sum_{pool}(f_{pool\rightarrow slow}\times Flux_{pool})\\
+	C_{passive}&=&C_{passive}&+\sum_{pool}(f_{pool\rightarrow passive}\times Flux_{pool})
+  \end{array}
+\right.
+\end{equation}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+\Delta B   = B \times MIN(0.99,\frac{\Delta t}{a_c}\times (\frac{a}{a_c})^4)
+\end{equation}
+where $B$ is the biomass, $\Delta B$ is the fraction of biomass lost, $\Delta t$ is the times step (1 day)
+and $a_c$ is the critical leaf age, a PFT-dependend parameter.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+\Delta B = B \times \frac{\Delta t} {tau_leaffall}
+\end{equation}
+where $B$ is the biomass, $\Delta B$ is the fraction of biomass lost, $\Delta t$ is the times step (1 day)
+and $tau_leaffall$ is the time constant of meteorological determined turnover.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+A = A + A_{i} \cdot f_{i}
+\end{equation}
+where $A$ is the mean leaf age, $A_{i}$ is the leaf age in leaf age class $i$ and $f_{i}$
+is the fraction of leaves in that class.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex	(revision 5166)
@@ -0,0 +1,8 @@
+\begin{equation}
+moist_{c}=MIN(MAX(moist_{min}+0.5(moist_{max}-moist_{min}),moist_{Senesc}),moist_{noSenesc})
+\end{equation}
+where $moist_{c}$ is the moisture availability critical level, $moist_{min}$ and 
+$moist_{max}$ are the last years moisture availability extrema for this location. 
+$moist_{Senesc}$ is the PFT dependend critical moisture level for which there is senescence and 
+$moist_{noSenesc}$ the PFT dependend critical moisture level above which there is no humidity 
+related senescence.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex	(revision 5166)
@@ -0,0 +1,6 @@
+\begin{equation}
+T_{crit}   = a\cdot T^{2}+b\cdot T+c
+\end{equation}
+where $T_{crit}$ is the critical temperature for senescence, $T$ is 
+the long term annual mean temperature and $a$,$b$ and $c$ are PFT-dependent 
+empirical parameters.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex	(revision 5166)
@@ -0,0 +1,5 @@
+\begin{equation}
+LAI = SLA \cdot B_{leaf}
+\end{equation} 
+where LAI is the Leaf Area Index, SLA is the Specific Leaf Are and B_{leaf} is
+the leaf biomass.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex	(revision 5166)
@@ -0,0 +1,7 @@
+\begin{equation}
+f_{t} = \frac {f_{t-1}\cdot B_{leaf,t-1} + \Delta lm} {B_{leaf,t}}
+\end{equation}
+where $f_{t}$ is the new leaf fraction, $f_{t-1}$ is the old leaf fraction, $B_{leaf,t}$ is the new total leaf biomass
+and $B_{leaf,t-1}$ is the old total leaf biomass. $\Delta lm$ is the change in leaf biomass in the considered class due to 
+senescence.
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/TOOLS/codealgo.awk
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/TOOLS/codealgo.awk	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/TOOLS/codealgo.awk	(revision 5166)
@@ -0,0 +1,169 @@
+# codealgo.awk - filter of ORCHIDEE f90 files
+# command : gawk -f codealgo.awk [-d] file.f90
+# create a file.f90_preproc_codealgo filtered with algo comments inside each routine all group 
+# in the Doxygen comment just before its beginning.  
+
+#**************************************************************
+# Author: Martial.Mancip
+# Contact: Martial.Mancip__at__ipsl.jussieu.fr
+# $Revision::                                          $ Revision of last commit
+# $Author::                                            $ Author of last commit
+# $Date:: 
+# IPSL (2006)
+#  This software is governed by the CeCILL licence see libIGCM/libIGCM_CeCILL.LIC
+# Modification: 
+#
+#**************************************************************
+#==========================
+function debugprint(str) {
+  if (debug) {
+     print str  | "cat 1>&2"
+  }
+}
+function myprint(str) {
+    print str >> output_file
+}
+
+
+function flush_line() {
+    if ( nblc > 0 ) {
+	if ( inside_algo == 1 ) {
+	    myprint(" !> </ul>")
+	}
+	for ( i=1; i < nblc+1; i++ ) {
+	      myprint(line[i]) 	    
+	}
+	nblc=0
+    }
+}
+
+
+#==========================
+BEGIN {
+
+    nbarg=ARGC
+    if (ARGV[1] == "-d") {
+	debug=1
+	file=ARGV[2]
+	delete ARGV[1] 
+	nbarg--
+    } else {
+	debug=0
+	file=ARGV[1]
+    }
+    output_file=file "_preproc_codealgo"
+    if (debug) {
+	lscommand=("ls " output_file)
+	outsys=system(lscommand)
+	debugprint("output of ls : " outsys)
+	if ( outsys == 0 ) {
+	    debugprint("Already find " output_file)
+	    outsys=system("rm " output_file)
+	    debugprint("output of rm : " outsys)
+	    system("touch " output_file)
+	}
+    }
+
+# When exit statement, 'END' rule is always executed, so defined a exit_value to manage this
+    exit_value=0
+    if (nbarg != 2) {
+	debugprint("Usage: codealgo.awk [-d] file.f90")
+	debugprint("")
+	debugprint("Args:")
+	debugprint("      file.f90 = source code to be parsed")
+	debugprint("") 
+	debugprint("Options:" )
+	debugprint("       -d = debug mode")
+	debugprint("") 
+	exit_value=1
+	exit 2
+    }
+    debugprint("filter " file " in " output_file) 
+
+    # Number of previous lines commented
+    nblc=0
+    # Flag indicates inside a routine
+    routine = 0
+    routine_name = ""
+    # detect begin of algo liste
+    inside_algo=0
+
+    IGNORECASE=1
+}
+
+#==========================
+{
+  debugprint($0)
+
+  if ( match($0, "^[^!('\"]*subroutine") || match($0, "^[^!('\"]*function") ) {
+
+      debugprint("routine line.")
+
+      nblc++
+      line[nblc]=$0
+
+      # Begin of algo search
+      if ( match(line[nblc],"^[[:space:]]*end") ) {
+	  debugprint("End of the routine.")
+	  if ( routine == 0 ) {
+	      # error !
+	      debugprint("error ! End of routine has been detected but no routine was opened.")
+	      exit 1
+	  } else {
+	      if ( match(line[nblc],routine_name) ) {
+		  # here we flush the whole routine
+		  debugprint("Normal End of a routine : flush previous lines.")
+		  flush_line()
+		  routine = 0
+		  inside_algo = 0
+		  nblc = 0
+	      } else {
+		  debugprint("Error in a routine : routine_name " routine_name " doesn't match.")
+		  exit 3
+	      }
+	  }
+      } else {
+	  debugprint("Begining of a new routine.")
+
+	  if ( routine == 1 ) {
+	      if ( match(line[nblc],routine_name) ) {
+		  debugprint("routine : " routine_name " detect two times. Precompilation ? OK.")
+	      } else {
+		  # error !
+		  debugprint("error ! Already find a routine not closed.")
+		  exit 1
+	      }
+	  } else {
+	      routine_name=$2
+	      sub(/\(.*/,"",routine_name)
+	      debugprint("routine : " routine_name)
+	      routine = 1
+	  }
+      }
+
+  } else if ( routine == 1 ) {
+
+      nblc++
+      line[nblc]=$0
+
+      if (match(line[nblc], "^[[:space:]]+\\!+>*[[:space:]]+[[:digit:]]+\\.*"))
+      {
+	  debugprint("New algo line.")
+	  if ( inside_algo == 0 ) {
+	      myprint(" !> ")
+	      myprint(" !> ALGORITHM : ")
+	      myprint(" !> <ul>")
+	      debugprint("ALGORITHM.")
+	      inside_algo = 1
+	  }
+	  sub(/\!+>*/,"!> <li> ")
+	  myprint($0)
+      }
+  } else if ( routine == 0 ) {
+	  myprint($0)
+  }
+}
+
+END {
+    close(output_file)
+}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/TOOLS/codedox.awk
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/TOOLS/codedox.awk	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/TOOLS/codedox.awk	(revision 5166)
@@ -0,0 +1,366 @@
+# codedox.awk - filter of ORCHIDEE f90 files
+# command : gawk -f codedox.awk [-d] file.f90
+# create a file.f90_preproc_codedox filtered
+
+#**************************************************************
+# Author: Martial.Mancip
+# Contact: Martial.Mancip__at__ipsl.jussieu.fr
+# $Revision::                                          $ Revision of last commit
+# $Author::                                            $ Author of last commit
+# $Date:: 
+# IPSL (2006)
+#  This software is governed by the CeCILL licence see libIGCM/libIGCM_CeCILL.LIC
+# Modification: 
+#
+#**************************************************************
+#==========================
+function debugprint(str) {
+  if (debug) {
+      if ( ldebug ) { 
+	  print "-> " str  | "cat 1>&2"
+      } else {
+	  print str  | "cat 1>&2"
+      }
+  }
+}
+function myprint(str) {
+    if ( ldebug ) { 
+	print str  | "cat 1>&2"
+    } else {
+	print str >> output_file
+    }
+}
+
+
+function flush_line() {
+    if ( nblc > 0 ) {
+	debugprint("==> flush")
+	for ( i=0; i < nblc; i++ ) {
+	      myprint(line[i]) 	    
+	}
+	nblc=0
+	iblc=0
+    }
+}
+
+function code_intent(iblc) {
+    debugprint("line with intent")
+    if (match(line[iblc], "intent *\\(in\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in]",line[iblc])
+    } else if (match(line[iblc], "intent *\\(out\\)")) {
+	sub(/.*\!+>*\-*/, " !> [out]",line[iblc])
+    } else if (match(line[iblc], "intent *\\(inout\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in,out]",line[iblc])
+    } else {        
+        print "unknown intent error : " line[iblc]
+	debugprint("unknown intent error : " line[iblc])
+	exit 1
+    } 
+    if ( icont == 1 ) {
+	line[iblc]=line[iblc]  "\\n"
+    }
+    debugprint("line after Doxygen intent :" line[iblc])
+
+    sub(/\!.*/, "")
+    line[nblc]=$0
+    nblc++
+    debugprint("Only code intent :" $0)
+}
+
+function code_INTENT_ (iblc) {
+    debugprint("line with INTENT")
+    if (match(line[iblc], "INTENT *\\(in\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(out\\)")) {
+	sub(/.*\!+>*\-*/, " !> [out]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(inout\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in,out]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(IN\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(OUT\\)")) {
+	sub(/.*\!+>*\-*/, " !> [out]",line[iblc])
+    } else if (match(line[iblc], "INTENT *\\(INOUT\\)")) {
+	sub(/.*\!+>*\-*/, " !> [in,out]",line[iblc])
+    } else {	
+        print "unknown INTENT error : " line[iblc]
+	debugprint("unknown INTENT error : " line[iblc])
+	exit 1
+    } 
+    if ( icont == 1 ) {
+	line[iblc]=line[iblc]  "\\n"
+    }
+    debugprint("line after Doxygen INTENT :" line[iblc])
+
+    sub(/\!.*/, "")
+    line[nblc]=$0
+    nblc++
+    debugprint("Only code intent :" $0)
+}
+
+#==========================
+BEGIN {
+    ldebug=0
+    debug=0
+    if (ARGV[1] == "-d") {
+	debug=1
+	file=ARGV[2]
+ 	delete ARGV[1] 
+    } else if (ARGV[1] == "-dd") {
+	debug=1
+	ldebug=1
+	file=ARGV[2]
+	delete ARGV[1] 
+    } else {
+	file=ARGV[1]
+    }
+    debugprint("traitement de " file)
+
+    output_file=file "_preproc_codedox"
+    if (debug) {
+	if ( ! ldebug ) {
+	    lscommand=("ls " output_file)
+	    outsys=system(lscommand)
+	    debugprint("output of ls : " outsys)
+	    if ( outsys == 0 ) {
+		debugprint("Already find " output_file)
+		outsys=system("rm " output_file)
+		debugprint("output of rm : " outsys)
+		system("touch " output_file)
+	    }
+	}
+    }
+
+# When exit statement, 'END' rule is always executed, so defined a exit_value to manage this
+    exit_value=0
+    if ( ARGV[1] == "-h" ) {
+	debugprint("Usage: codedox.awk [-h] [-d|-dd] file.f90")
+	debugprint("")
+	debugprint("Args:")
+	debugprint("      file.f90 = source code to be parsed")
+	debugprint("") 
+	debugprint("Options:" )
+	debugprint("       -h = this usage")
+	debugprint("       -d = debug mode")
+	debugprint("       -dd = debug mode stdout")
+	debugprint("") 
+	exit_value=1
+	exit
+    }
+    # Number of previous lines commented
+    nblc=0
+
+    # Flag to point indented declaration
+    idecl=0
+    # index of first declaration comment 
+    icdecl=0
+    # Flag to point a continuation line inside a declaration
+    icont=0
+    # Number of the first line of declaration group inside line tab
+    nicont=0
+}
+
+#==========================
+{
+  debugprint($0)
+
+  # Divers modification de la ligne pour la compatibilitÃ© Doxygen
+  if (match($0, "!+")) {
+      
+      if (match($0, "!\\?")) {
+	  debugprint("Wrong comment")
+	  sub(/\!\?/, "!")
+	  debugprint("Correct wrong comment" $0)
+      } else if (match($0, "f90doc")) {
+	  debugprint("suppression de la ligne")
+	  next
+      } else if (match($0, "@call")) {
+	  debugprint("line with @call")
+	  sub(/@call/, "@see",$0)
+	  debugprint("line after correct call :" $0)
+      } else if (match($0, "@Version")) {
+          debugprint("line with @Version")
+          sub(/@Version/, "@version")
+          debugprint("line after Doxygen @version :" $0)
+      } else if (match($0, "@tex")) {
+	  match($0,"@tex([^@]+)@endtex",math)
+          debugprint("line with formula :" math[1])
+	  $0 = substr($0,1,match($0,"@tex")-1) "@htmlonly" math[1] "@endhtmlonly @latexonly" math[1] "@endlatexonly" substr($0,match($0,"@endtex")+7)
+      }
+
+      # traitement des simples cotes
+      if (match($0, "'") && ! match($0, "'.*'") ) {
+          debugprint("line with single cote")
+          sub(/'/, "''",$0)
+          debugprint("line without single cote : " $0)
+      }
+  }
+
+  if (match($0, "!+")) {
+      debugprint("line with comment")
+      
+      if ( idecl == 1 ) {
+	  debugprint("inside a decl " (match($0,"^[[:space:]]+!")) " " match($0,"!") " " icdecl ".")
+	  if ( (match($0,"^[[:space:]]+!")) && (match($0,"!") == icdecl) ) { 	
+	      line[nblc]=line[nblc-1]
+	      sub(/^[[:space:]]+\!+>*/," !>")
+	      # on Ã©crit le nouveau commentaire avant le prÃ©cÃ©dant
+	      line[nblc-1]=$0 "\\n"
+	      nblc++
+	      debugprint("continuation of declaration")
+	      next
+	  } else if ( icont == 1 ) {
+	      if (match($0,"!")) { 
+		  debugprint("continuation of declaration with &" nicont) 
+		  for ( i=nblc; i > nicont; i-- ) {
+		      line[i]=line[i-1]
+		  }
+		  nblc++
+
+		  line[nblc]=substr($0,1,icdecl-1)
+		  nblc++
+
+		  line[nicont+1]=line[nicont]
+
+		  line[nicont]=substr($0,icdecl)
+		  sub(/^\!+>*/," !>",line[nicont])
+		  line[nicont]=line[nicont] "\\n"
+		  for ( i=nicont-1; i < nblc; i++ ) {
+		      debugprint(":" i line[i])
+		  }
+	      } else {
+		  line[nblc]=$0
+		  nblc++
+		  debugprint("no comment in continuation of declaration with &") 
+	      }
+	      
+	      if ( match(line[nblc-1], "&") ) {
+		  if ( match(line[nblc-1], "&.*&") ) {
+		      icont = 1
+		      nicont=nicont+1
+		      debugprint("next line with &") 
+		  } else if ( match(line[nblc-1], "^[[:space:]]*&") ) {
+		      icont = 0
+		      nicont = 0
+		      debugprint("next line without &") 
+		  } else {
+		      icont = 1
+		      nicont=nicont+1
+		      debugprint("next line with &") 
+		  }
+	      } else {
+		  icont = 0
+		  nicont = 0
+		  debugprint(match(line[nblc-1], "^[[:space:]]+&*[^!]+&") match(line[nblc-1], "^[[:space:]]+[^!]+&[[:space:]]*!*"))
+	      }
+	      next
+	  } else {
+	      idecl=0
+	      icont = 0
+	      nicont = 0
+	      flush_line()
+	  }
+      }
+
+      iblc=nblc
+      line[nblc]=$0
+      nblc++
+
+      # commentary after a parameter documentation : need flush previous lines without Doxygen doc
+      if (match(line[iblc], "^[^!]+intent *\\(.*\\).*::")) {
+	  idecl=1
+	  icdecl=match($0,"!")
+	  if ( match(line[iblc], "[^!]*::[^!]*&") ) {
+	      icont = 1
+	      nicont=nblc
+	      debugprint("next line with &") 
+	  }
+	  code_intent(iblc)
+
+      } else if (match(line[iblc], "^[^!]+INTENT *\\(.*\\).*::")) {
+	  idecl=1
+	  icdecl=match($0,"!")
+	  if ( match(line[iblc], "[^!]*::[^!]*&") ) {
+	      icont = 1
+	      nicont=nblc
+	      debugprint("next line with &") 
+	  }
+	  code_INTENT_(iblc)
+
+      } else if (match(line[iblc], "^[^!]+::")) {
+	  debugprint("line with declaration")
+
+	  idecl=1
+	  icdecl=match($0,"!")
+	  if ( match(line[iblc], "[^!]*::[^!]*&") ) {
+	      icont = 1
+	      nicont=nblc
+	      debugprint("next line with &") 
+	  }
+
+	  sub(/.*\!+>*/, " !>",line[iblc])
+	  debugprint("line after Doxygen declaration :" line[iblc])
+
+	  sub(/\!.*/, "")
+	  debugprint("Only code declaration :" $0)
+	  line[nblc]=$0
+	  nblc++
+
+      }
+      next
+  } else if (match($0, "^[^!]*subroutine.*\\(.*") || match($0, "^[^!]*SUBROUTINE.*\\(.*") || 
+	     ( match($0, "^[^!]*subroutine ") && ! (match($0, "^[[:space:]]+end ")) ) || 
+	     ( match($0, "^[^!]*SUBROUTINE ") && ! (match($0, "^[[:space:]]+END ")) ) || 
+	     match($0, "^[^!]*function.*\\(.*") || match($0, "^[^!]*FUNCTION.*\\(.*") || 
+	     match($0, "^[^!]*module *") || match($0, "^[^!]*MODULE *") || 
+	     match($0, "^[^!]*interface *") || match($0, "^[^!]*INTERFACE *") ||
+	     match($0, "^[^!]+::")) {
+
+      debugprint("f90 declaration")
+
+      if ( idecl == 1 ) {
+	  idecl=0
+	  icont=0
+	  flush_line()
+      } 
+      if (nblc > 0 && ( match($0, "^[^!]+intent *\\(.*\\).*::") ||
+			match($0, "^[^!]+INTENT *\\(.*\\).*::") )) {
+	  if (match($0, "\\(in\\)") || match($0, "\\(IN\\)")) {
+	      sub(/.*\!+>*\-*/, " !> [in]",line[iblc])
+	  } else if (match($0, "\\(out\\)") || match($0, "\\(OUT\\)")) {
+	      sub(/.*\!+>*\-*/, " !> [out]",line[iblc])
+	  } else if (match($0, "\\(inout\\)") || match($0, "\\(INOUT\\)")) {
+	      sub(/.*\!+>*\-*/, " !> [in,out]",line[iblc])
+	  } else {	
+	      print "unknown INTENT error : " $0
+	      debugprint("unknown INTENT error : " $0)
+	      exit 1
+	  }
+      } else {
+
+	  for ( i=0; i < nblc; i++ ) {
+	      #  : ajout des commentaires Doxygen
+	      if (match(line[i], "!<")) {
+		  sub(/\^ *\!+</, " !>",line[i])
+	      } else {
+		  sub(/^ *\!\!/, " !>",line[i])
+	      }
+
+	      debugprint("traitement des lignes prÃ©cÃ©dentes : " line[i])
+	  }
+      }
+      flush_line()
+      myprint($0)
+      next
+  } else {
+      debugprint("normal line")
+
+      if ( idecl == 1 ) idecl=0
+
+      flush_line()
+      myprint($0)
+  }
+}
+
+END {
+    if ( ! ldebug ) close(output_file)
+}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/TOOLS/codeinc.awk
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/TOOLS/codeinc.awk	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/TOOLS/codeinc.awk	(revision 5166)
@@ -0,0 +1,121 @@
+# codeinc.awk - filter of ORCHIDEE f90 files
+# command : gawk -f codeinc.awk [-d] file.f90
+# create a file.f90_preproc_codeinc filtered
+
+#**************************************************************
+# Author: Martial.Mancip
+# Contact: Martial.Mancip__at__ipsl.jussieu.fr
+# $Revision::                                          $ Revision of last commit
+# $Author::                                            $ Author of last commit
+# $Date:: 
+# IPSL (2006)
+#  This software is governed by the CeCILL licence see libIGCM/libIGCM_CeCILL.LIC
+# Modification: 
+#
+#**************************************************************
+#==========================
+function debugprint(str) {
+  if (debug) {
+     print str  | "cat 1>&2"
+  }
+}
+function myprint(str) {
+    print str >> output_file
+}
+
+
+#==========================
+BEGIN {
+    debugprint("traitement de " ARGV[1])
+
+    nbarg=ARGC
+    if (ARGV[1] == "-d") {
+	debug=1
+	file=ARGV[2]
+	delete ARGV[1] 
+	nbarg--
+    } else {
+	debug=0
+	file=ARGV[1]
+    }
+    output_file=file "_preproc_codeinc"
+    if (debug) {
+	lscommand=("ls " output_file)
+	outsys=system(lscommand)
+	debugprint("output of ls : " outsys)
+	if ( outsys == 0 ) {
+	    debugprint("Already find " output_file)
+	    outsys=system("rm " output_file)
+	    debugprint("output of rm : " outsys)
+	    system("touch " output_file)
+	}
+    }
+
+# When exit statement, 'END' rule is always executed, so defined a exit_value to manage this
+    exit_value=0
+    if (nbarg != 2) {
+	debugprint("Usage: codeinc.awk [-d] file.f90")
+	debugprint("")
+	debugprint("Args:")
+	debugprint("      file.f90 = source code to be parsed")
+	debugprint("") 
+	debugprint("Options:" )
+	debugprint("       -d = debug mode")
+	debugprint("") 
+	exit_value=1
+	exit
+    }
+    codeinc=0
+    linecodeinc[1]=""
+    line[1]=""
+}
+
+#==========================
+{
+  debugprint($0)
+
+# Get information with MPI Program Information output on NEC
+  if (match($0, " *!> @codeinc *")) 
+  {
+      codeinc=1
+      nblines=0
+      Length=(match($0,"!>")-1)
+      spaces=substr($0,1,Length)
+      debugprint("Find @codeinc !" spaces Length)
+      myprint(spaces "!> @code")
+      next
+  } 
+  else if ( codeinc == 1 )
+  {
+      if (match($0, " *!> @endcodeinc *")) 
+      {
+	  codeinc=0
+	  debugprint("Find @endcodeinc !")
+	  for (i=0; i<nblines; i++) {  
+	      myprint(spaces "!> " linecodeinc[i])
+	  }
+ 	  myprint(spaces "!> @endcode")
+	  for (i=0; i<nblines; i++) {  
+	      myprint(line[i])
+	  }
+	  nblines=0
+      }
+      else
+      {
+	  line[nblines]=$0
+	  debugprint(nblines " | " line[nblines])
+	  linecodeinc[nblines]=substr(line[nblines],Length+1)
+	  debugprint(linecodeinc[nblines])
+	  nblines++
+      }
+  }
+  else
+  {
+      myprint($0)
+  }
+
+}
+
+END {
+    close(output_file)
+}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/footer.tex
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/footer.tex	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/footer.tex	(revision 5166)
@@ -0,0 +1,72 @@
+
+% \addcontentsline{toc}{chapter}{ANNEXE B : Table des notations} 
+% \markboth{\uppercase{\ Title Notations}}
+% {\uppercase{\ Notations}} \thispagestyle{empty} \input{./notation} %
+% \thispagestyle{empty} \newpage \thispagestyle{empty} \null \newpage \newpage 
+% {\pagestyle{empty}\cleardoublepage}
+
+\part{Annexes}
+
+\chapter{Index}
+\label{chap:index}
+
+\printindex
+
+\newpage
+\clearemptydoublepage
+
+\bibliographystyle{alpha}
+\bibliography{orchidee}
+\setcounter{chapter}{17}
+\addcontentsline{toc}{chapter}{Bibliography}
+\label{chap:biblio}
+
+\clearemptydoublepage
+
+This scientific documentation is the result of a huge effort led by the ORCHIDEE community,
+which reached a peak at the now famous ORCHIDEE summit, held at Saint-Lambert-Des-Bois (France), on 
+January, 19-20, 2012.
+
+Citation: To Be Defined
+
+List of Contributors:
+\begin{itemize}
+\item Bellassen Valentin, CDC Climat
+\item Cadule Patricia, IPSL
+\item Campoy AurÃ©lien, Sisyphe/UPMC
+\item Ciais Philippe, LSCE/IPSL
+\item de Noblet Nathalie, LSCE/IPSL
+\item de Weirdt Marjolein, UGent
+\item Ducharne AgnÃšs, Sisyphe/UPMC
+\item Gouttevin Isabelle, LGGE
+\item Guenet Betrand, LSCE/IPSL
+\item Guimberteau Mathieu, LOCEAN/IPSL
+\item Kato Tomomichi, LSCE/IPSL
+\item Koffi Ernest, LSCE/IPSL
+\item Kuppel Sylvain, LSCE/IPSL
+\item LathiÃšre Juliette, LSCE/IPSL
+\item Launois Thomas, LSCE/IPSL
+\item Luyssaert Sebastiaan, LSCE/IPSL
+\item MacBean Natasha, LSCE/IPSL
+\item Maignan Fabienne, LSCE/IPSL
+\item Mancip Martial, IPSL
+\item OttlÃ© Catherine, LSCE/IPSL
+\item Otto Juliane, LSCE/IPSL
+\item Peylin Philippe, LSCE/IPSL
+\item Polcher Jan, LMD/IPSL
+\item Poulter Benjamin, LSCE/IPSL
+\item Ryder James, LSCE/IPSL
+\item Saito Makoto, LSCE/IPSL
+\item Solyga Didier, LSCE/IPSL
+\item Tan Kun, LSCE/IPSL
+\item Valade Aude, LSCE/IPSL
+\item Verbecke Thomas, LSCE/IPSL
+\item Viovy Nicolas, LSCE/IPSL
+\item Vuichard Nicolas, LSCE/IPSL
+\item Wang Tao, LSCE/IPSL
+\item Yue Chao, LSCE/IPSL
+\end{itemize}
+
+
+
+\end{document}
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/header.tex.init
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/header.tex.init	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/DOC/header.tex.init	(revision 5166)
@@ -0,0 +1,252 @@
+\batchmode
+\documentclass[a4paper]{book}
+\usepackage{a4wide}
+\usepackage{makeidx}
+\usepackage[pdftex]{graphicx}
+\newcommand\textsubscript[1]{\ensuremath{{}_{\text{#1}}}}
+\usepackage{multicol}
+\usepackage{float}
+\usepackage{listings}
+\usepackage{color}
+\usepackage{ifthen}
+\usepackage[table]{xcolor}
+\usepackage{textcomp}
+\usepackage{alltt}
+\usepackage{times}
+\usepackage{ifpdf}
+\usepackage{hyperref}
+\hypersetup{pdftex,
+            pagebackref=true,
+            colorlinks=true,
+            linkcolor=blue,
+            citecolor=blue, 
+            filecolor=blue,
+            urlcolor=blue,
+            unicode,
+            pdftitle=ORCHIDEE Documentation,
+            pdfauthor=IPSL,
+            pdfsubject=Documentation,
+            pdfkeywords=ORCHIDEE Documentation Scientific Development}
+% Text styles
+\newcommand\textstyleInternetlink[1]{\textcolor[rgb]{0.0,0.0,0.5019608}{#1}}
+\newcommand\textstyleCitationHTML[1]{\textit{#1}}
+\makeatletter
+\newcommand\arraybslash{\let\\\@arraycr}
+\makeatother
+
+\usepackage[utf8]{inputenc}
+\usepackage[T1]{fontenc}
+\usepackage[english]{babel}
+%\usepackage[french]{babel}
+
+\usepackage{pifont}
+\usepackage{eurosym}
+\usepackage{amsmath}
+\usepackage{wasysym}
+\usepackage{amssymb,amsfonts,textcomp}
+\usepackage[top=2.54cm,bottom=2.54cm,left=3.175cm,right=3.175cm]{geometry}
+
+\usepackage{array}
+\usepackage{supertabular}
+\usepackage{hhline}
+% \newcommand\arraybslash{\let\\\@arraycr}
+\makeatother
+% Footnote rule
+\setlength{\skip\footins}{0.119cm}
+\renewcommand\footnoterule{\vspace*{-0.018cm}\setlength\leftskip{0pt}\setlength\rightskip{0pt plus 1fil}\noindent\textcolor{black}{\rule{0.25\columnwidth}{0.018cm}}\vspace*{0.101cm}}
+% Pages styles
+\makeatletter
+\newcommand\ps@Standard{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{}
+  \renewcommand\thepage{\arabic{page}}
+}
+\makeatother
+\pagestyle{Standard}
+\setlength\tabcolsep{1mm}
+\renewcommand\arraystretch{1.3}
+
+% Pages styles
+\makeatletter
+\newcommand\ps@Conversionvi{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionv{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversioniv{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+% \newcommand\ps@Standard{
+%   \renewcommand\@oddhead{}
+%   \renewcommand\@evenhead{}
+%   \renewcommand\@oddfoot{}
+%   \renewcommand\@evenfoot{}
+%   \renewcommand\thepage{\arabic{page}}
+% }
+\newcommand\ps@Conversioniii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\roman{page}}
+}
+\newcommand\ps@Conversionii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversioni{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\roman{page}}
+}
+\newcommand\ps@Conversionxv{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionxiv{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionxiii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionxii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionxi{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionx{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionix{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionviii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+\newcommand\ps@Conversionvii{
+  \renewcommand\@oddhead{}
+  \renewcommand\@evenhead{\@oddhead}
+  \renewcommand\@oddfoot{}
+  \renewcommand\@evenfoot{\@oddfoot}
+  \renewcommand\thepage{\arabic{page}}
+}
+
+\usepackage{doxygen}
+\lstset{language=C++,inputencoding=utf8,basicstyle=\footnotesize,breaklines=true,breakatwhitespace=true,tabsize=8,numbers=left }
+\usepackage{indentfirst}
+\makeindex
+\setcounter{tocdepth}{3}
+\renewcommand{\footrulewidth}{0.4pt}
+\hfuzz=15pt
+\setlength{\emergencystretch}{15pt}
+\hbadness=750
+\tolerance=750
+
+\usepackage{minitoc}
+\setcounter{minitocdepth}{5}
+%\renewcommand{\mtctitle}{\em Plan du chapitre}
+
+\renewcommand{\chaptermark}[1]{\markboth{#1}{}}
+\renewcommand{\sectionmark}[1]{\markright{\thesection \ #1}}
+
+% Les headers (tÃªtes de page)
+% \usepackage{fancyhdr}
+% \pagestyle{fancy}
+% \fancyhf{}
+% \fancyhead[LE,RO]{\bfseries\thepage}
+% \fancyhead[LO]{\bfseries\rightmark}
+% \fancyhead[RE]{\bfseries\leftmark}
+% \fancypagestyle{plain}
+% \fancyhead{}
+\renewcommand{\headrulewidth}{1pt}
+ 
+
+\begin{document}
+\hypersetup{pageanchor=false,citecolor=blue}
+\begin{titlepage}
+\vspace*{7cm}
+\begin{center}
+\leavevmode
+\includegraphics[scale=1]{logo_orchidee.png}
+{ \\[1ex]\large MYTAG revision MYREV}\\
+\vspace*{0.5cm}
+{\Large IPSL (Pierre Simon Laplace Institute)}\\
+\vspace*{1cm}
+{\-ORCHIDEE is the land-surface scheme of the IPSL.\\
+This scheme is the result of the coupling of the SECHIBA land-surface
+scheme, \\
+which is dedicated to the surface energy and water balances, \\
+and the carbon and vegetation model STOMATE.}\\
+\vspace*{0.5cm}
+{\Large \today}
+\end{center}
+\end{titlepage}
+
+\dominitoc
+
+\part{Table Of Contents}
+\clearemptydoublepage
+\pagenumbering{roman}
+\tableofcontents
+%\clearemptydoublepage
+
+\pagenumbering{arabic}
+\hypersetup{pageanchor=true,citecolor=blue}
+
+\part{Documentation}
+\label{part:doc}
+
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/Doxyfile_ORCHIDEE.init
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/Doxyfile_ORCHIDEE.init	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/Doxyfile_ORCHIDEE.init	(revision 5166)
@@ -0,0 +1,288 @@
+# Doxyfile 1.7.3
+
+#---------------------------------------------------------------------------
+# Project related configuration options
+#---------------------------------------------------------------------------
+DOXYFILE_ENCODING      = UTF-8
+PROJECT_NAME           = ORCHIDEE
+PROJECT_NUMBER         = "MYTAG rev MYREV"
+PROJECT_BRIEF          = "The land-surface scheme of IPSL."
+PROJECT_LOGO           = MYPATH/ORCHIDEE/DOC/logo_orchidee.png
+OUTPUT_DIRECTORY       = MYPATH/ORCHIDEE/docs
+CREATE_SUBDIRS         = YES
+OUTPUT_LANGUAGE        = English
+BRIEF_MEMBER_DESC      = YES
+REPEAT_BRIEF           = YES
+ABBREVIATE_BRIEF       =
+ALWAYS_DETAILED_SEC    = YES
+INLINE_INHERITED_MEMB  = YES
+FULL_PATH_NAMES        = YES
+STRIP_FROM_PATH        = MYPATH/modeles_doc
+STRIP_FROM_INC_PATH    = MYPATH/ORCHIDEE/DOC
+SHORT_NAMES            = NO
+JAVADOC_AUTOBRIEF      = NO
+QT_AUTOBRIEF           = NO
+MULTILINE_CPP_IS_BRIEF = NO
+INHERIT_DOCS           = YES
+SEPARATE_MEMBER_PAGES  = YES
+TAB_SIZE               = 12
+ALIASES                = 
+OPTIMIZE_OUTPUT_FOR_C  = NO
+OPTIMIZE_OUTPUT_JAVA   = NO
+OPTIMIZE_FOR_FORTRAN   = YES
+OPTIMIZE_OUTPUT_VHDL   = NO
+EXTENSION_MAPPING      =
+BUILTIN_STL_SUPPORT    = NO
+CPP_CLI_SUPPORT        = NO
+SIP_SUPPORT            = NO
+IDL_PROPERTY_SUPPORT   = NO
+DISTRIBUTE_GROUP_DOC   = YES
+SUBGROUPING            = YES
+TYPEDEF_HIDES_STRUCT   = YES
+SYMBOL_CACHE_SIZE      = 9
+#---------------------------------------------------------------------------
+# Build related configuration options
+#---------------------------------------------------------------------------
+EXTRACT_ALL            = YES
+EXTRACT_PRIVATE        = YES
+EXTRACT_STATIC         = YES
+EXTRACT_LOCAL_CLASSES  = YES
+EXTRACT_LOCAL_METHODS  = YES
+EXTRACT_ANON_NSPACES   = YES
+HIDE_UNDOC_MEMBERS     = NO
+HIDE_UNDOC_CLASSES     = NO
+HIDE_FRIEND_COMPOUNDS  = NO
+HIDE_IN_BODY_DOCS      = NO
+INTERNAL_DOCS          = YES
+CASE_SENSE_NAMES       = NO
+HIDE_SCOPE_NAMES       = YES
+SHOW_INCLUDE_FILES     = YES
+FORCE_LOCAL_INCLUDES   = YES
+INLINE_INFO            = YES
+SORT_MEMBER_DOCS       = YES
+SORT_BRIEF_DOCS        = NO
+SORT_MEMBERS_CTORS_1ST = NO
+SORT_GROUP_NAMES       = NO
+SORT_BY_SCOPE_NAME     = NO
+STRICT_PROTO_MATCHING  = NO
+GENERATE_TODOLIST      = YES
+GENERATE_TESTLIST      = YES
+GENERATE_BUGLIST       = YES
+GENERATE_DEPRECATEDLIST= YES
+ENABLED_SECTIONS       = 
+MAX_INITIALIZER_LINES  = 30
+SHOW_USED_FILES        = YES
+SHOW_DIRECTORIES       = YES
+SHOW_FILES             = YES
+SHOW_NAMESPACES        = YES
+FILE_VERSION_FILTER    = 
+LAYOUT_FILE            =
+#---------------------------------------------------------------------------
+# configuration options related to warning and progress messages
+#---------------------------------------------------------------------------
+QUIET                  = NO
+WARNINGS               = YES
+WARN_IF_UNDOCUMENTED   = YES
+WARN_IF_DOC_ERROR      = YES
+WARN_NO_PARAMDOC       = YES
+WARN_FORMAT            = "$file:$line: $text"
+WARN_LOGFILE           = doxygen.log
+#---------------------------------------------------------------------------
+# configuration options related to the input files
+#---------------------------------------------------------------------------
+INPUT                  = SRCPATH/ORCHIDEE \
+                         SRCPATH/ORCHIDEE_OL
+# \
+#                         SRCPATH/IOIPSL/src/
+INPUT_ENCODING         = UTF-8
+FILE_PATTERNS          = *.f90 \
+                         *.F90 \
+                         *.h
+RECURSIVE              = YES
+EXCLUDE                = 
+EXCLUDE_SYMLINKS       = YES
+EXCLUDE_PATTERNS       = 
+EXCLUDE_SYMBOLS        = 
+EXAMPLE_PATH           = MYPATH/ORCHIDEE/DOC
+EXAMPLE_PATTERNS       = *
+EXAMPLE_RECURSIVE      = NO
+IMAGE_PATH             = MYPATH/ORCHIDEE/DOC
+INPUT_FILTER           = 
+FILTER_PATTERNS        = 
+FILTER_SOURCE_FILES    = NO
+FILTER_SOURCE_PATTERNS =
+#---------------------------------------------------------------------------
+# configuration options related to source browsing
+#---------------------------------------------------------------------------
+SOURCE_BROWSER         = YES
+INLINE_SOURCES         = YES
+STRIP_CODE_COMMENTS    = NO
+REFERENCED_BY_RELATION = YES
+REFERENCES_RELATION    = YES
+REFERENCES_LINK_SOURCE = YES
+USE_HTAGS              = NO
+VERBATIM_HEADERS       = YES
+#---------------------------------------------------------------------------
+# configuration options related to the alphabetical class index
+#---------------------------------------------------------------------------
+ALPHABETICAL_INDEX     = YES
+COLS_IN_ALPHA_INDEX    = 5
+IGNORE_PREFIX          = 
+#---------------------------------------------------------------------------
+# configuration options related to the HTML output
+#---------------------------------------------------------------------------
+GENERATE_HTML          = YES
+HTML_OUTPUT            = html
+HTML_FILE_EXTENSION    = .html
+HTML_HEADER            = 
+# MYPATH/ORCHIDEE/DOC/header.html
+HTML_FOOTER            = 
+# MYPATH/ORCHIDEE/DOC/footer.html
+HTML_STYLESHEET        = 
+HTML_EXTRA_FILES       =
+HTML_COLORSTYLE_HUE    = 220
+HTML_COLORSTYLE_SAT    = 100
+HTML_COLORSTYLE_GAMMA  = 80
+HTML_TIMESTAMP         = YES
+HTML_ALIGN_MEMBERS     = YES
+HTML_DYNAMIC_SECTIONS  = YES
+GENERATE_DOCSET        = YES
+DOCSET_FEEDNAME        = "IPSL model"
+DOCSET_BUNDLE_ID       = fr.orchidee.ipsl.jussieu
+DOCSET_PUBLISHER_ID    = org.doxygen.Publisher
+DOCSET_PUBLISHER_NAME  = Publisher
+GENERATE_HTMLHELP      = NO
+CHM_FILE               = 
+HHC_LOCATION           = 
+GENERATE_CHI           = NO
+CHM_INDEX_ENCODING     =
+BINARY_TOC             = YES
+TOC_EXPAND             = YES
+GENERATE_QHP           = YES
+QCH_FILE               =
+QHP_NAMESPACE          = fr.orchidee.ipsl.jussieu
+QHP_VIRTUAL_FOLDER     = docs
+QHP_CUST_FILTER_NAME   =
+QHP_CUST_FILTER_ATTRS  =
+QHP_SECT_FILTER_ATTRS  =
+QHG_LOCATION           =
+GENERATE_ECLIPSEHELP   = YES
+ECLIPSE_DOC_ID         = org.doxygen.Project
+DISABLE_INDEX          = NO
+ENUM_VALUES_PER_LINE   = 4
+GENERATE_TREEVIEW      = YES
+USE_INLINE_TREES       = YES
+TREEVIEW_WIDTH         = 250
+EXT_LINKS_IN_WINDOW    = YES
+FORMULA_FONTSIZE       = 10
+FORMULA_TRANSPARENT    = YES
+USE_MATHJAX            = YES
+MATHJAX_RELPATH        = http://www.mathjax.org/mathjax
+SEARCHENGINE           = YES
+SERVER_BASED_SEARCH    = NO
+#---------------------------------------------------------------------------
+# configuration options related to the LaTeX output
+#---------------------------------------------------------------------------
+GENERATE_LATEX         = YES
+LATEX_OUTPUT           = latex
+LATEX_CMD_NAME         = latex
+MAKEINDEX_CMD_NAME     = makeindex
+COMPACT_LATEX          = NO
+EXTRA_PACKAGES         = 
+LATEX_HEADER           = MYPATH/ORCHIDEE/DOC/header.tex
+LATEX_FOOTER           = MYPATH/ORCHIDEE/DOC/footer.tex
+PDF_HYPERLINKS         = YES
+LATEX_HIDE_INDICES     = NO
+LATEX_SOURCE_CODE      = NO 
+#---------------------------------------------------------------------------
+# configuration options related to the RTF output
+#---------------------------------------------------------------------------
+GENERATE_RTF           = NO
+RTF_OUTPUT             = rtf
+COMPACT_RTF            = NO
+RTF_HYPERLINKS         = NO
+RTF_STYLESHEET_FILE    = 
+RTF_EXTENSIONS_FILE    = 
+#---------------------------------------------------------------------------
+# configuration options related to the man page output
+#---------------------------------------------------------------------------
+GENERATE_MAN           = NO
+MAN_OUTPUT             = man
+MAN_EXTENSION          = .3
+MAN_LINKS              = NO
+#---------------------------------------------------------------------------
+# configuration options related to the XML output
+#---------------------------------------------------------------------------
+GENERATE_XML           = NO
+XML_OUTPUT             = xml
+XML_SCHEMA             = 
+XML_DTD                = 
+XML_PROGRAMLISTING     = YES
+#---------------------------------------------------------------------------
+# configuration options for the AutoGen Definitions output
+#---------------------------------------------------------------------------
+GENERATE_AUTOGEN_DEF   = NO
+#---------------------------------------------------------------------------
+# configuration options related to the Perl module output
+#---------------------------------------------------------------------------
+GENERATE_PERLMOD       = NO
+PERLMOD_LATEX          = NO
+PERLMOD_PRETTY         = YES
+PERLMOD_MAKEVAR_PREFIX = 
+#---------------------------------------------------------------------------
+# Configuration options related to the preprocessor   
+#---------------------------------------------------------------------------
+ENABLE_PREPROCESSING   = YES
+MACRO_EXPANSION        = NO
+EXPAND_ONLY_PREDEF     = NO
+SEARCH_INCLUDES        = YES
+INCLUDE_PATH           = 
+INCLUDE_FILE_PATTERNS  = 
+PREDEFINED             = 
+EXPAND_AS_DEFINED      = 
+SKIP_FUNCTION_MACROS   = YES
+#---------------------------------------------------------------------------
+# Configuration::additions related to external references   
+#---------------------------------------------------------------------------
+TAGFILES               = 
+GENERATE_TAGFILE       = ORCHIDEE_tags
+ALLEXTERNALS           = NO
+EXTERNAL_GROUPS        = NO
+PERL_PATH              = /usr/bin/perl
+#---------------------------------------------------------------------------
+# Configuration options related to the dot tool   
+#---------------------------------------------------------------------------
+CLASS_DIAGRAMS         = YES
+MSCGEN_PATH            = 
+HIDE_UNDOC_RELATIONS   = NO
+HAVE_DOT               = YES
+DOT_NUM_THREADS        = 0
+DOT_FONTNAME           = Helvetica
+DOT_FONTSIZE           = 10
+DOT_FONTPATH           =
+CLASS_GRAPH            = YES
+COLLABORATION_GRAPH    = YES
+GROUP_GRAPHS           = YES
+UML_LOOK               = YES
+TEMPLATE_RELATIONS     = YES
+INCLUDE_GRAPH          = YES
+INCLUDED_BY_GRAPH      = YES
+CALL_GRAPH             = YES
+CALLER_GRAPH           = YES
+GRAPHICAL_HIERARCHY    = YES
+DIRECTORY_GRAPH        = YES
+DOT_IMAGE_FORMAT       = png
+DOT_PATH               = 
+DOTFILE_DIRS           = MYPATH/ORCHIDEE/DOC/DOT
+MSCFILE_DIRS           =
+DOT_GRAPH_MAX_NODES    = 50
+MAX_DOT_GRAPH_DEPTH    = 1000
+DOT_TRANSPARENT        = NO
+DOT_MULTI_TARGETS      = YES
+GENERATE_LEGEND        = YES
+DOT_CLEANUP            = YES
+#---------------------------------------------------------------------------
+#- ALIAS ORCHDIEE
+#---------------------------------------------------------------------------
+ALIASES += Bold{1}="<b>\1</b>"
+ALIASES += Emph{1}="<em>\1</em>"
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/ORCHIDEE_CeCILL.LIC
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/ORCHIDEE_CeCILL.LIC	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/ORCHIDEE_CeCILL.LIC	(revision 5166)
@@ -0,0 +1,40 @@
+The following licence information concerns ONLY the ORCHIDEE MODEL
+==================================================================
+
+Copyright © Centre National de la Recherche Scientifique CNRS  
+            Commissariat à l'Énergie Atomique CEA
+
+ORCHIDEE : Organizing Carbon and Hydrology In Dynamic EcosystEms. 
+
+The purpose of this software is to simulate a number of exchanges
+occurring at the interface between the continental biosphere and the
+atmosphere, as well as the state of the biosphere (soil water and
+carbon content, living biomass, fluxes of latent, sensible heat, net
+CO2 flux, .....). It includes physical, biogeochemical and chemical
+processes at varying time scales (minutes to centuries).
+
+This software is governed by the CeCILL  license under French law and
+abiding by the rules of distribution of free software.  You can  use, 
+modify and/ or redistribute the software under the terms of the CeCILL
+license as circulated by CEA, CNRS and INRIA at the following URL
+"http://www.cecill.info". 
+
+As a counterpart to the access to the source code and  rights to copy,
+modify and redistribute granted by the license, users are provided only
+with a limited warranty  and the software's author,  the holder of the
+economic rights,  and the successive licensors  have only  limited
+liability. 
+
+In this respect, the user's attention is drawn to the risks associated
+with loading,  using,  modifying and/or developing or reproducing the
+software by the user in light of its specific status of free software,
+that may mean  that it is complicated to manipulate,  and  that  also
+therefore means  that it is reserved for developers  and  experienced
+professionals having in-depth computer knowledge. Users are therefore
+encouraged to load and test the software's suitability as regards their
+requirements in conditions enabling the security of their systems and/or 
+data to be ensured and,  more generally, to use and operate it in the 
+same conditions as regards security. 
+
+The fact that you are presently reading this means that you have had
+knowledge of the CeCILL license and that you accept its terms.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/README.txt
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/README.txt	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/README.txt	(revision 5166)
@@ -0,0 +1,37 @@
+!< $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-SOM/ORCHIDEE/ $
+!< $Date: 2013-10-11 16:07:00 +0200 (Fri, 11 Oct 2013) $
+!< $Author: bertrand.guenet $
+!< $Revision: 1530 $
+!- IPSL (2006)
+!-  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+
+###########################
+#        IMPORTANT        #
+###########################
+
+
+1. To run ORCHIDEE-SOM you have to modify the file restcom.f90 (modeles/IOIPSL/src) at line 42 change max_var = XXX for max_var = 10000
+
+2. You also have to add the following lines in the orchidee.default instead of the three previous CARBON_TAU
+
+# CARBON_TAU_IACTIVE ( [days] ) :  residence times in carbon pools      {OK_STOMATE }
+CARBON_TAU_IACTIVE =  0.3
+
+# CARBON_TAU_ISLOW ([days]) :  residence times in carbon pools  {OK_STOMATE }
+CARBON_TAU_ISLOW =  1.12
+
+# CARBON_TAU_IPASSIVE ([days] ) :  residence times in carbon pools      {OK_STOMATE }
+CARBON_TAU_IPASSIVE =  461.98
+
+# PRIMING_PARAM_IACTIVE ( [-] ) :  priming parameter controlling the dependency of SOM decompostion rate to LOM      {OK_STOMATE }
+PRIMING_PARAM_IACTIVE =  493.66
+
+# PRIMING_PARAM_ISLOW ( [-] ) :  priming parameter controlling the dependency of SOM decompostion rate to LOM      {OK_STOMATE }
+PRIMING_PARAM_ISLOW =  194.03
+
+# PRIMING_PARAM_IPASSIVE ( [-] ) :  priming parameter controlling the dependency of SOM decompostion rate to LOM      {OK_STOMATE }
+PRIMING_PARAM_IPASSIVE =  136.54
+
+3. The code size is above 2GB and you must add the option -shared-intel -mcmodel=large in the util/AA_make.gdef. For 
+LSCE machines it must be added at line F_O = after the option -DCPP_PARA 
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-MPI.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-MPI.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-MPI.fcm	(revision 5166)
@@ -0,0 +1,17 @@
+%AR                  ar
+%MAKE                gmake
+%FPP                 cpp
+%COMPILER            /usr/local/bin/mpif90 
+%LINK                /usr/local/bin/mpif90 
+%BASE_FFLAGS         -c -i4 -r8 -fno-second-underscore
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -freal=nan -fstatic
+%DEBUG_FFLAGS        -g -fbounds-check -fstatic -ftrace=full
+%FPP_FLAGS           -C -P
+%FPP_DEF
+%BASE_LD             -g
+%MPI_FFLAGS          
+%MPI_LD              
+%OMP_FFLAGS          
+%OMP_LD              
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-MPI.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-MPI.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-MPI.path	(revision 5166)
@@ -0,0 +1,4 @@
+set NETCDF_LIBDIR=/usr/local/lib/NCdF/g95/lib
+set NETCDF_INCDIR=/usr/local/lib/NCdF/g95/include
+set IOIPSL_INCDIR=../../IOIPSL/src
+set IOIPSL_LIBDIR=../../../lib
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-PW6_VARGAS.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-PW6_VARGAS.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-PW6_VARGAS.fcm	(revision 5166)
@@ -0,0 +1,15 @@
+%COMPILER            xlf_r
+%LINK                mpxlf_r
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -I/usr/local/pub/FFTW/3.2/include
+%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_FFTW
+%BASE_FFLAGS         -qautodbl=dbl4 -qxlf90=autodealloc -qmaxmem=-1 -qzerosize -I/usr/local/pub/FFTW/3.2/include
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -O2 -qfullpath -qinitauto=7FBFFFFF -qfloat=nans -qflttrap=overflow:zerodivide:invalid:enable -qsigtrap
+%DEBUG_FFLAGS        -g -qfullpath -qnooptimize -qinitauto=7FBFFFFF  -qfloat=nans -qflttrap=overflow:zerodivide:invalid:enable -qsigtrap -qcheck
+%MPI_FFLAGS          -I/usr/lpp/ppe.poe/include/thread64
+%OMP_FFLAGS          -qsmp=omp
+%BASE_LD             -lessl -L/usr/local/pub/FFTW/3.2/lib -lfftw3
+%MPI_LD              
+%OMP_LD              -qsmp=omp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-PW6_VARGAS.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-PW6_VARGAS.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-PW6_VARGAS.path	(revision 5166)
@@ -0,0 +1,4 @@
+set NETCDF_LIBDIR=/usr/local/pub/NetCDF/3.6.2/lib
+set NETCDF_INCDIR=/usr/local/pub/NetCDF/3.6.2/include
+set IOIPSL_INCDIR=../../../lib
+set IOIPSL_LIBDIR=../../../lib
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-SX8_MERCURE.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-SX8_MERCURE.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-SX8_MERCURE.fcm	(revision 5166)
@@ -0,0 +1,16 @@
+%AR                  sxar
+%MAKE                make
+%COMPILER            sxmpif90
+%LINK                sxmpif90
+%BASE_FFLAGS         -P stack -dw -size_t64 -EP -R5 -float0 -Wf,"-A dbl4,-ptr byte,-pvctl res=whole loopcnt=999999 fullmsg noassume"
+%PROD_FFLAGS         -C vopt 
+%DEV_FFLAGS          -C vsafe -gv -Wf,-init stack=nan,-init heap=nan
+%DEBUG_FFLAGS        -C debug -gv -Wf,-init stack=nan,-init heap=nan
+%FPP_FLAGS           -P -traditional
+%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM _OPENMP 
+%BASE_LD             -size_t64 -lblas
+%MPI_FFLAGS          " "
+%MPI_LD              " "
+%OMP_FFLAGS          -P openmp
+%OMP_LD              -P openmp  -Wl,"-ZL 8G"
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-SX8_MERCURE.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-SX8_MERCURE.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-SX8_MERCURE.path	(revision 5166)
@@ -0,0 +1,4 @@
+set NETCDF_LIBDIR=/usr/local/SX8/soft/netcdf/lib
+set NETCDF_INCDIR=/usr/local/SX8/soft/netcdf/include
+set IOIPSL_INCDIR=$WORKDIR/IOIPSL_MPP/src
+set IOIPSL_LIBDIR=$WORKDIR/IOIPSL_MPP/src
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_ADA.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_ADA.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_ADA.fcm	(revision 5166)
@@ -0,0 +1,16 @@
+%COMPILER            mpiifort
+%LINK                mpiifort
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional -I/smplocal/pub/FFTW/3.3.3/include/
+%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_FFTW
+%BASE_FFLAGS         -integer-size 32 -real-size 64 -align all 
+%PROD_FFLAGS         -O2 -ip -fp-model strict -axAVX,SSE4.2
+%DEV_FFLAGS          -p -g -O1 -fpe0 -traceback
+%DEBUG_FFLAGS        -p -g -O0 -fpe-all=0 -traceback -ftrapuv -fp-stack-check -check all -debug
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD             -shared-intel -mcmodel=large -lmkl_intel_lp64 -lmkl_sequential -lmkl_core -lpthread -L/smplocal/pub/FFTW/3.3.3/lib -lfftw3
+%MPI_LD
+%OMP_LD              -openmp
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_ADA.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_ADA.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_ADA.path	(revision 5166)
@@ -0,0 +1,5 @@
+NETCDF_LIBDIR="${NETCDF_LDFLAGS:--L/smplocal/pub/NetCDF/4.1.3/lib -lnetcdff -lnetcdf -L/smplocal/pub/HDF5/1.8.9/seq/lib -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -lz}"
+NETCDF_INCDIR="${NETCDF_FFLAGS:--I/smplocal/pub/HDF5/1.8.9/seq/include -I/smplocal/pub/NetCDF/4.1.3/include}"
+IOIPSL_INCDIR=../../../lib
+IOIPSL_LIBDIR=../../../lib
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_CURIE.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_CURIE.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_CURIE.fcm	(revision 5166)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINK                mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_MKL
+%BASE_FFLAGS         -i4 -r8 -auto -align all -I${MKLROOT}/include
+%PROD_FFLAGS         -O3 -fp-model precise
+%DEV_FFLAGS          -p -g -O2 -traceback -fp-stack-check 
+%DEBUG_FFLAGS        -p -g -traceback -fp-stack-check -ftrapuv -check bounds
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD             -i4 -r8 -auto $MKL_LIBS
+%MPI_LD
+%OMP_LD              -openmp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_CURIE.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_CURIE.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_CURIE.path	(revision 5166)
@@ -0,0 +1,6 @@
+NETCDF_LIBDIR="$NETCDF_LIB_DIR -lnetcdff -lnetcdf"
+NETCDF_INCDIR=$NETCDF_INC_DIR
+IOIPSL_INCDIR=../../../lib
+IOIPSL_LIBDIR=../../../lib
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_TITANE.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_TITANE.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_TITANE.fcm	(revision 5166)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINK                mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_MKL
+%BASE_FFLAGS         -i4 -r8 -automatic -align all -I${MKLROOT}/include
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -p -g -O3 -traceback -fp-stack-check -ftrapuv
+%DEBUG_FFLAGS        -p -g -traceback
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD             -p -i4 -r8 -automatic $MKL_LIBS
+%MPI_LD
+%OMP_LD              -openmp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_TITANE.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_TITANE.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-X64_TITANE.path	(revision 5166)
@@ -0,0 +1,5 @@
+set NETCDF_LIBDIR=$NETCDF_LIB_DIR
+set NETCDF_INCDIR=$NETCDF_INC_DIR
+set IOIPSL_INCDIR=../../../lib
+set IOIPSL_LIBDIR=../../../lib
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-gfortran.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-gfortran.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-gfortran.fcm	(revision 5166)
@@ -0,0 +1,15 @@
+%COMPILER            gfortran
+%LINK                gfortran
+%AR                  ar
+%MAKE                make
+%FPP_FLAGS           -P -C -traditional
+%FPP_DEF             NC_DOUBLE
+%BASE_FFLAGS         -fdefault-real-8
+%PROD_FFLAGS         -O3 -funroll-all-loops
+%DEV_FFLAGS          -O
+%DEBUG_FFLAGS        -ffpe-trap=invalid,zero,overflow -fbounds-check -g3 -O0 -fstack-protector-all
+%MPI_FFLAGS
+%OMP_FFLAGS          
+%BASE_LD      
+%MPI_LD
+%OMP_LD              
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-gfortran.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-gfortran.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-gfortran.path	(revision 5166)
@@ -0,0 +1,4 @@
+NETCDF_LIBDIR=/usr/local/lib
+NETCDF_INCDIR=/usr/local/include
+IOIPSL_INCDIR=${ORCHDIR}/../../lib
+IOIPSL_LIBDIR=${ORCHDIR}/../../lib
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-ifort_LSCE.fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-ifort_LSCE.fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-ifort_LSCE.fcm	(revision 5166)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINK                mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional
+%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM FFT_MKL
+%BASE_FFLAGS         -i4 -r8 -auto -align all -I${MKLROOT}/include -fp-model precise
+%PROD_FFLAGS         -O3 
+%DEV_FFLAGS          -p -g -O2 -traceback -fp-stack-check 
+%DEBUG_FFLAGS        -p -g -traceback -fp-stack-check -ftrapuv -check bounds
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD             -i4 -r8 
+%MPI_LD
+%OMP_LD              -openmp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-ifort_LSCE.path
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-ifort_LSCE.path	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/arch/arch-ifort_LSCE.path	(revision 5166)
@@ -0,0 +1,4 @@
+NETCDF_LIBDIR="-L/usr/local/lib -lnetcdff -lnetcdf"
+NETCDF_INCDIR=/usr/local/include
+IOIPSL_INCDIR=../../../lib
+IOIPSL_LIBDIR=../../../lib
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/bld.cfg
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/bld.cfg	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/bld.cfg	(revision 5166)
@@ -0,0 +1,81 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+
+inc arch.fcm
+inc config.fcm
+
+%ROOT_PATH         $PWD
+%CONFIG_PATH       %ROOT_PATH/.config
+%SRC_PATH          %ROOT_PATH
+
+
+src::global       %SRC_PATH/src_global
+src::parallel     %SRC_PATH/src_parallel
+src::sechiba      %SRC_PATH/src_sechiba
+src::stomate      %SRC_PATH/src_stomate
+src::parameters   %SRC_PATH/src_parameters
+src::orchidee_ol  %SRC_PATH/src_driver
+src::ext_src      %EXT_SRC 
+
+bld::lib::global         orglob
+bld::lib::parallel       parallel
+bld::lib::sechiba        sechiba
+bld::lib::stomate        stomate
+bld::lib::parameters     parameters
+bld::lib::orchidee_ol    orchidee_ol
+bld::lib                 orchidee
+
+bld::target              liborglob.a libparallel.a libsechiba.a libstomate.a libparameters.a liborchidee.a
+bld::target              %EXEC
+bld::exe_dep             ext_src global parallel sechiba stomate parameters orchidee_ol 
+
+dir::root            %CONFIG_PATH
+dir::lib             %ROOT_PATH/lib
+dir::bin             %ROOT_PATH/bin
+dir::inc             %ROOT_PATH/lib
+dir::tmp             %ROOT_PATH/tmp_src
+
+#search_src           1
+
+bld::tool::fc        %COMPILER 
+bld::tool::ld        %LINK
+bld::tool::ar        %AR
+bld::tool::make      %MAKE
+bld::tool::fflags    %FFLAGS %INCDIR
+bld::tool::ldflags   %LD_FFLAGS %LIBDIR -lioipsl -lnetcdf   
+
+bld::tool::cppflags  %FPP_FLAGS %INCDIR
+bld::tool::fppflags  %FPP_FLAGS %INCDIR
+bld::tool::fppkeys   %CPP_KEY
+
+
+# Pre-process code before analysing dependencies
+bld::pp              1
+infile_ext::f90 fpp::fpp9x::source
+
+# Ignore the following dependencies
+bld::excl_dep        inc::netcdf.inc
+bld::excl_dep        use::netcdf
+bld::excl_dep        h::netcdf.inc
+bld::excl_dep        h::mpif.h
+bld::excl_dep        inc::mpif.h
+bld::excl_dep        use::ioipsl
+bld::excl_dep        USE::defprec
+bld::excl_dep        USE::calendar
+
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".inc" as an extension for CPP include files
+bld::infile_ext::inc  CPP::INCLUDE
+
+# extension for module output
+bld::outfile_ext::mod .mod
+bld::tool::SHELL   /bin/bash
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/makeorchidee_fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/makeorchidee_fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/makeorchidee_fcm	(revision 5166)
@@ -0,0 +1,358 @@
+#!/bin/bash
+
+#==============================================================================================================================\n
+#  MODULE 	: 
+# 
+#  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+#
+#  LICENCE      : IPSL (2006)
+#  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+#
+# Author: Martial.Mancip
+# Contact: josefine.ghattas_at_ipsl.jussieu.fr
+# $Revision::                                   $ Revision of last commit
+# $Author::                                     $ Author of last commit
+# $Date::
+#
+# Modification:
+#   26/04/13, P. Maugis : comments and notice
+#   18/07/13, A. Cozic  : translate in bash to fit with idris and tgcc 
+#   01/10/13, J. Ghattas : add options full, job and ext_src 
+#
+####################################################################################################
+
+####################################################################################################
+#
+# This script has several possible functions :
+#   1. Compiling ORCHIDEE
+#   2. Building of the documentation
+#
+#***************************************************************************************************
+#
+# command lines :
+#
+#   1) make_orchidee_fcm  [ -parallel  PARALLEL_TYPE ]
+#                         [ -driver ]
+#                         [  -arch ARCHitecture ]
+#                         [ -prod | -dev | -debug ]
+#
+#   2) make_orchidee_fcm  [ -doc | -doc_para ] ## actually doc_para is commented
+#                         [ -rmdoc ]
+#                         [ -doc_tree ]
+#
+
+is_parallel_opt=FALSE
+is_driver_opt=FALSE
+is_arch_opt=FALSE 
+is_compile_opt=FALSE
+default_compile_flags="%PROD_FFLAGS"
+full="" 
+job=1 
+ext_src=""
+
+export P_P=""
+export SECTIONS_PARA=""
+
+ORCHDIR=`/bin/pwd`
+fcm_path=$ORCHDIR/tools/FCM_V1.2/bin
+
+while (($# > 0))
+  do
+  case $1 in
+      "-h") cat <<fin
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+makeorchidee_fcm [Options] 
+
+[ -parallel|-p PARALLEL_TYPE ] : activate parallelization with 3 options : 
+    PARALLEL_TYPE =
+    ( mpi | MPI )  : use Message Passing Interface standard
+    ( omp | OMP )  : use OpenMP standard
+    ( mpi_omp | MPI_OMP ) : use both MPI and OpenMP
+
+[ -driver ] : compilation of ORCHIDEE driver if equal TRUE
+
+[ -arch ARCHitecture ] : if TRUE, change architecture for ARCHitecture
+
+[ -prod ] : compilation for production (all optimization)
+
+[ -dev ] : compilation for development (low optimization and -g)
+
+[ -d|-debug ] : compilation for debugging (no optmization and all debug options)
+	 
+| -full ] : activate full recompiling  
+ 
+[ -j x ] : activate parallel compiling on x task, default 1 task 
+ 
+[ -ext_src path] : path to an additional set of routines to compile with the model 
+
+[ -doc ] : generate documentation with Doxygen (exit after doc computation)
+
+[ -doc_para ] : generate documentation with Doxygen with parallelization calls
+
+[ -rmdoc ] : remove documentation directory (before generate new documentation with Doxygen ?)
+
+[ -doc_tree ] : generate tree of ORCHIDEE directories for each file
+
+fin
+    exit;;
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    "-parallel")
+        is_parallel_opt=TRUE
+        parallel=$2 ; shift ; shift ;; 
+                       
+    "-driver")
+         is_driver_opt=TRUE
+        shift ;;
+
+    "-arch")
+        is_arch_opt=TRUE
+        arch="$2" ; shift ; shift ;;
+
+    "-prod")
+        is_compile_opt=TRUE
+        compile_flags="%PROD_FFLAGS"
+        shift ;;
+
+    "-dev")
+        is_compile_opt=TRUE
+        compile_flags="%DEV_FFLAGS"
+        shift ;;
+
+    "-debug")
+        is_compile_opt=TRUE
+        compile_flags="%DEBUG_FFLAGS"
+        shift ;;
+ 
+     "-j") 
+        job="$2" ; shift ; shift ;; 
+ 
+     "-full") 
+        full='-full' 
+        shift ;; 
+ 
+      "-ext_src") 
+        ext_src=$2 ; shift ; shift ;;
+
+#    "-doc_para")
+#        setenv P_P -DCPP_PARA
+#	setenv SECTIONS_PARA "-e s&ENABLED_SECTIONS\ *= &ENABLED_SECTIONS       = CPP_PARA&g"
+#	goto doc
+
+	"-doc")
+#####################################################################################################
+
+# 2) Building the documentation:
+# ------------------------------
+# We assume to start in the ORCHIDEE directory
+#
+#****  Directory structure:
+#
+# ..                       : parent of the start dir.
+#   -- ORCHIDEE            : ($MODELPATH), start directory
+#       - src_sechiba
+#       - src_stomate
+#       + DOC
+#       + webdoc
+#   -- IOIPSL
+#       - src
+#   ++ modeles_doc         : ($SRCPATH), source files for the documentation, emptied at start, temporary
+#
+#****  gawk scripts called :
+#
+# codeinc.awk              : encaspulates code parts in Doxygen documentation
+# codedox.awk              : transforms almost all comments in Doxygen comments for documentation
+# codealgo.awk             : emphasizes main algorithm description of each routine in their Doxygen documentation
+#
+#****
+        unalias cd
+
+	export REV=`svn info | grep vision | sed -e 's&.*vision.*: \([0-9]*\)&\1&' | head -n 1`
+	export TAG=`svn info | grep URL | sed -e 's&.*URL.*: svn://forge.ipsl.jussieu.fr/orchidee/\(.*\)&\1&' | head -n 1 | xargs dirname`
+       	cd ..
+
+	\rm -rf modeles_doc
+	export MODELPATH=${PWD}
+	\mkdir modeles_doc
+	export SRCPATH=${MODELPATH}/modeles_doc
+
+	find IOIPSL/src \( -not -path '*.svn*' \
+			-a \( -name '*.f90' -o -name "*.F90" -o -name "*.h" \) \) \
+		    -exec bash -c 'mkdir -p '${SRCPATH}'/$( dirname {} ); cp -p {} '${SRCPATH}'/$( dirname {} )' \;
+
+	find ORCHIDEE \( -not -path '*.svn*' \
+			-a \( -name '*.f90' -o -name "*.F90" -o -name "*.h" \) \) \
+		    -exec bash -c 'mkdir -p '${SRCPATH}'/$( dirname {} ); cp -p {} '${SRCPATH}'/$( dirname {} )' \;
+	cd ${SRCPATH}
+	# Use standard preprocessor to suppress all preproc directives
+	\find . -name "*.f90" -exec cpp -P -C -traditional -x assembler-with-cpp ${P_P} '{}' '{}'_ \;
+	\find . -name "*.f90" -print -exec mv -f '{}'_ '{}' \;
+
+	# use codeinc script to encaspulate code parts in Doxygen documentation
+	\find . -name "*.f90" -exec gawk -f ${MODELPATH}/ORCHIDEE/DOC/TOOLS/codeinc.awk '{}' \; > /dev/null
+	\find . -name "*.f90" -print -exec mv -f '{}'_preproc_codeinc '{}' \;
+	# use codedox script to transform almost all comments in Doxygen comments for documentation (use with care !)
+	\find . -name "*.f90" -exec gawk -f ${MODELPATH}/ORCHIDEE/DOC/TOOLS/codedox.awk '{}' \; > /dev/null
+	\find . -name "*.f90" -print -exec mv -f '{}'_preproc_codedox '{}' \;
+
+	# use codealgo script to emphasize main algorithm description of each routine in their Doxygen documentation
+	\find . -name "*.f90" -exec gawk -f ${MODELPATH}/ORCHIDEE/DOC/TOOLS/codealgo.awk '{}' \; > /dev/null
+	\find . -name "*.f90" -print -exec mv -f '{}'_preproc_codealgo '{}' \;
+        cd ../ORCHIDEE
+	\rm -f ${MODELPATH}/ORCHIDEE/Doxyfile_ORCHIDEE
+	sed -e 's&MYPATH&'${MODELPATH}'&g' -e 's&SRCPATH&'${SRCPATH}'&g' \
+            -e 's&MYTAG&'${TAG}'&' -e 's&MYREV&'${REV}'&' ${SECTIONS_PARA} \
+            ${MODELPATH}/ORCHIDEE/Doxyfile_ORCHIDEE.init > ${MODELPATH}/ORCHIDEE/Doxyfile_ORCHIDEE
+	\rm -f ${MODELPATH}/ORCHIDEE/DOC/header.tex
+	sed -e "s&MYTAG&${TAG}&" -e "s&MYREV&${REV}&" \
+            ${MODELPATH}/ORCHIDEE/DOC/header.tex.init > ${MODELPATH}/ORCHIDEE/DOC/header.tex
+	ln -s /home/orchidee01/maignan/ORCHIDEE/DOC/IMAGES ${MODELPATH}/ORCHIDEE/DOC/IMAGES
+	gmake doc
+	gmake bib
+	gmake toc
+	\rm -rf ${MODELPATH}/ORCHIDEE/webdoc
+	\mv ${MODELPATH}/ORCHIDEE/docs/html ${MODELPATH}/ORCHIDEE/webdoc
+	gmake index
+	gmake toc
+	\rm -rf ${SRCPATH}
+	cp ${MODELPATH}/ORCHIDEE/docs/latex/refman.pdf ${MODELPATH}/ORCHIDEE/documentation.pdf
+	exit
+        shift ;;
+
+
+     "-rmdoc")
+	\rm -rf docs
+        shift ;;
+
+     "-doc_tree") 
+        cd ..
+	find ORCHIDEE \( -not -path '*.svn*' \
+			-a \( -name '*.f90' -o -name "*.F90" -o -name "*.h" \) \) \
+		    -exec bash -c 'mkdir -p ORCHIDEE/DOC/$( dirname {} )/$( echo $( basename {} ) | sed -e "s/\..*//" )' \;
+	cd ORCHIDEE
+        shift ;;
+
+    *)
+        echo "unknown option "$1" , exiting..."
+        exit 
+   esac
+done
+
+#####################################################################################################
+
+# 1) Compilation du code direct avec fcm
+# --------------------------------------
+# Add fcm in environement path
+export PATH=${fcm_path}:${PATH}
+
+#define architecture files
+if [[ "$is_arch_opt" == "TRUE" ]]
+ then
+  if [[ -e arch/arch-${arch}.fcm ]]
+ then
+    rm -f arch.fcm
+    ln -s arch/arch-${arch}.fcm arch.fcm
+  else
+    echo "architecture file : << arch/arch-${arch}.fcm >> is missing, exiting...."
+    exit
+  fi
+  
+  if [[ -e arch/arch-${arch}.path ]]
+ then
+    rm -f arch.path
+    ln -s arch/arch-${arch}.path arch.path
+  else
+    echo "architecture file : << arch/arch-${arch}.path >> is missing, exiting...."
+    exit
+  fi
+else
+  echo "Warning : architecture not specified, taking default file <<arch.fcm>> and <<arch.path>>" 
+  if [[ ! -e arch.fcm ]]
+ then
+    echo "architecture file : << arch.fcm >> is missing, exiting...."
+    exit
+  fi
+
+  if [[ ! -e arch.fcm ]]
+ then
+    echo "architecture file : << arch.path >> is missing, exiting...."
+    exit
+  fi
+fi
+  
+# set compiler flags
+FFLAGS="%BASE_FFLAGS"
+LD_FFLAGS="%BASE_LD"
+CPP_KEY="%FPP_DEF"
+
+# set compiler flags for optimisation
+if [[ "$is_compile_opt" == "FALSE" ]]
+ then
+  compile_flags=$default_compile_flags
+fi
+FFLAGS=${FFLAGS}" "$compile_flags
+
+# set compiler flags for parallelism
+if [[ "$is_parallel_opt" == "TRUE" ]] 
+then
+  echo $parallel 
+    if [[ "$parallel" == "mpi" ]] 
+    then 
+    FFLAGS="${FFLAGS} %MPI_FFLAGS"
+    LD_FFLAGS="%MPI_LD ${LD_FFLAGS}"
+    CPP_KEY="CPP_PARA ${CPP_KEY}"
+    elif [[ "$parallel" == "omp" ]]
+      then
+      FFLAGS="${FFLAGS} %OMP_FFLAGS"
+      LD_FFLAGS="%OMP_LD ${LD_FFLAGS}"
+      CPP_KEY="CPP_OMP CPP_PARA ${CPP_KEY}"
+      elif [[ "$parallel" == "mpi_omp" ]]
+      then
+      FFLAGS="${FFLAGS} %MPI_FFLAGS %OMP_FFLAGS"
+      LD_FFLAGS="%MPI_LD %OMP_LD ${LD_FFLAGS}"
+      CPP_KEY="CPP_OMP CPP_PARA ${CPP_KEY}"
+    fi
+fi       
+# set target
+TARGET=liborchidee.a
+if [[ "$is_driver_opt" == "TRUE" ]] 
+then
+    TARGET="liborchidee_ol.a dim2_driver.exe teststomate.exe forcesoil.exe"
+fi
+
+source ./arch.path
+
+# build config file
+config_fcm="config.fcm"
+rm -f $config_fcm
+touch $config_fcm
+
+echo "%ARCH          $arch"                             >> $config_fcm 
+echo "%FFLAGS        $FFLAGS"                           >> $config_fcm 
+echo "%CPP_KEY       $CPP_KEY"                          >> $config_fcm
+echo "%EXEC          $TARGET"                           >> $config_fcm
+echo "%LD_FFLAGS     $LD_FFLAGS"                        >> $config_fcm
+echo "%INCDIR        -I$NETCDF_INCDIR -I$IOIPSL_INCDIR" >> $config_fcm
+echo "%LIBDIR        -L$NETCDF_LIBDIR -L$IOIPSL_LIBDIR" >> $config_fcm
+echo "%EXT_SRC       $ext_src"                          >> $config_fcm 
+ 
+
+fcm build -j $job $full 
+ 
+cp lib/* ../../lib/.
+if [[ "$is_driver_opt" == "TRUE" ]] 
+then
+    cp bin/dim2_driver.exe ../../bin/orchidee_ol
+    cp bin/teststomate.exe ../../bin/teststomate
+    cp bin/forcesoil.exe ../../bin/forcesoil
+fi
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/AA_make	(revision 5166)
@@ -0,0 +1,66 @@
+#-
+#- $Id$
+#-
+MODS1 = dim2_driver.f90 \
+        weather.f90 \
+        readdim2.f90 \
+        teststomate.f90 \
+        forcesoil.f90 \
+        getprec.f90
+
+all : orchidee_ol teststomate forcesoil
+
+orchidee_ol:
+	$(M_K) m_orchidee_ol
+	@echo orchidee_ol is OK
+
+m_orchidee_ol: $(BINDIR)/orchidee_ol
+$(BINDIR)/orchidee_ol: \
+  $(SXIOIPSL_LIB) $(SXPARAM_LIB) $(SXPARALLEL_LIB) $(SXORGLOB_LIB) $(SXSTOMATE_LIB) $(SXSECHIBA_LIB) \
+  $(MODEL_LIB)(weather.o) $(MODEL_LIB)(readdim2.o) \
+  $(MODEL_LIB)(dim2_driver.o)
+	$(A_G) $(MODEL_LIB) dim2_driver.o
+	$(F_L) -o $(BINDIR)/orchidee_ol dim2_driver.o $(L_O) \
+          $(SXMODEL_LIB) $(SXSECHIBA_LIB) $(SXSTOMATE_LIB) \
+          $(SXPARALLEL_LIB) $(SXORGLOB_LIB) $(SXPARAM_LIB) $(SXIOIPSL_LIB) $(NCDF_LIB) 
+	$(RM) dim2_driver.o
+
+teststomate:
+	$(M_K) m_teststomate
+	@echo teststomate is OK
+
+m_teststomate: $(BINDIR)/teststomate
+$(BINDIR)/teststomate: \
+  $(SXIOIPSL_LIB) $(SXPARALLEL_LIB) $(SXPARAM_LIB) $(SXORGLOB_LIB) $(SXSTOMATE_LIB) $(SXSECHIBA_LIB) \
+  $(MODEL_LIB)(teststomate.o)
+	$(A_G) $(MODEL_LIB) teststomate.o
+	$(F_L) -o $(BINDIR)/teststomate teststomate.o $(L_O) \
+          $(SXMODEL_LIB) $(SXSECHIBA_LIB) $(SXSTOMATE_LIB) \
+          $(SXPARALLEL_LIB) $(SXORGLOB_LIB) $(SXPARAM_LIB) $(SXIOIPSL_LIB) $(NCDF_LIB)
+	$(RM) teststomate.o
+
+forcesoil:
+	$(M_K) m_forcesoil
+	@echo m_forcesoil is OK
+
+m_forcesoil: $(BINDIR)/forcesoil
+$(BINDIR)/forcesoil: \
+  $(SXIOIPSL_LIB) $(SXPARALLEL_LIB) $(SXPARAM_LIB) $(SXORGLOB_LIB) $(SXSTOMATE_LIB) $(SXSECHIBA_LIB) \
+  $(MODEL_LIB)(forcesoil.o)
+	$(A_G) $(MODEL_LIB) forcesoil.o
+	$(F_L) -o $(BINDIR)/forcesoil forcesoil.o $(L_O) \
+          $(SXMODEL_LIB) $(SXSECHIBA_LIB) $(SXSTOMATE_LIB) \
+          $(SXPARALLEL_LIB) $(SXORGLOB_LIB) $(SXPARAM_LIB) $(SXIOIPSL_LIB) $(NCDF_LIB)
+	$(RM) forcesoil.o
+
+libioipsl:
+	(cd ../../IOIPSL/src; $(M_K) -f Makefile)
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(%.o): %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(RM) $*.o
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/AA_make.ldef	(revision 5166)
@@ -0,0 +1,49 @@
+#-
+#- $Id$
+#-
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+MODDIR = $(LIBDIR)
+BINDIR = ../../../bin
+SCPDIR = ../../scripts
+ORDIR  = ..
+#---------------------------------------------------------------------
+MODEL_LIB = $(LIBDIR)/liborchidee.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec SXMODEL_LIB = $(LIBDIR)/libsxorchidee.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxorchidee.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxorchidee.a
+#-
+IOIPSL_LIB = $(LIBDIR)/libioipsl.a
+SXIOIPSL_LIB = $(IOIPSL_LIB)
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+ORGLOB_LIB = $(LIBDIR)/liborglob.a
+SXORGLOB_LIB = $(ORGLOB_LIB)
+#-Q- sxnec  SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-
+SECHIBA_LIB = $(LIBDIR)/libsechiba.a
+SXSECHIBA_LIB = $(SECHIBA_LIB)
+#-Q- sxnec SXSECHIBA_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- sx6nec SXSECHIBA_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- sx8brodie SXSECHIBA_LIB = $(LIBDIR)/libsxsechiba.a
+#-
+STOMATE_LIB = $(LIBDIR)/libstomate.a
+SXSTOMATE_LIB = $(STOMATE_LIB)
+#-Q- sxnec SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx6nec SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx8brodie SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/dim2_driver.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/dim2_driver.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/dim2_driver.f90	(revision 5166)
@@ -0,0 +1,1776 @@
+PROGRAM driver
+!< $HeadURL$
+!< $Date$
+!< $Author$
+!< $Revision$
+!- IPSL (2006)
+!-  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!---------------------------------------------------------------------
+!- This PROGRAM is the driver of the dim2 version of SECHIBA. It's
+!- main use is for PILPS type experiments. To run it you need to have
+!- the following software :
+!- - SECHIBA
+!- - ioipsl
+!- - netcdf
+!- - F90 compiler
+!- - tk (optional but very useful for configuring the model)
+!- Obviously also the associated Makefiles.
+!-
+!- The forcing data needs to be in netCDF format and should
+!- contain the following variables :
+!- - Incoming SW radiation
+!- - Incoming LW radiation
+!- - Precipitation
+!- - Air temperature at a reference level
+!- - Air humidity at the same level
+!- - wind at the same level
+!- - surface pressure
+!-
+!- Once you have all this and compiled the model you can configure it.
+!- Type make config and set all the values presented in the menu.
+!- This tool will create a run.def which will be used by the model.
+!- The run.def can also be edited by hand but it is more tedious.
+!- Once this run.def is created the model is ready to run.
+!---------------------------------------------------------------------
+  USE netcdf
+  USE ioipsl_para
+  USE grid
+  USE intersurf,  ONLY : intersurf_main
+  USE constantes
+  USE readdim2
+  USE mod_orchidee_para
+  USE timer
+!-
+  IMPLICIT NONE
+!-
+  INTEGER :: iim, jjm, llm
+  INTEGER :: im, jm, lm, tm, is, force_id, itest, jtest
+  REAL :: dt, dt_force, dt_rest, date0, date0_rest
+  REAL :: zlflu
+  REAL :: alpha
+!-
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+ & swdown, sinang, precip_rain, precip_snow, tair_obs, u, v, &
+ & qair_obs, pb, lwdown, &
+ & eair_obs, zlev_vec, zlevuv_vec, relax
+!- Variables which are forcings for SECHIBA
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+ & petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, &
+ & for_u, for_v, for_swnet, for_swdown, for_sinang, for_lwdown, &
+ & for_psurf, for_qair, for_tair, for_eair, &
+ & for_ccanopy, for_rau
+!!$, tmp_eair, tmp_tair, &
+!!$ & tmp_qair, tmp_pb
+!-
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+ & for_contfrac, old_zlev, old_qair, old_eair, tsol_rad, vevapp, &
+ & temp_sol_NEW, temp_sol_old, qsurf, dtdt, coastalflow, riverflow, &
+ & fluxsens, fluxlat, emis, z0
+!!$, epot_sol
+!-
+  INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: for_neighbours
+!-
+  REAL, ALLOCATABLE, DIMENSION(:,:,:) :: for_resolution
+  REAL, ALLOCATABLE, DIMENSION(:,:,:) :: soil_mc
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: litter_mc
+!-
+  REAL, ALLOCATABLE, DIMENSION(:,:,:) :: albedo
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: albedo_vis
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: albedo_nir
+!-
+  INTEGER, ALLOCATABLE, DIMENSION(:) :: kindex
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: lon, lat
+  REAL, ALLOCATABLE, DIMENSION(:)   :: tmplev
+!-
+  REAL :: old_tair
+  REAL :: atmco2
+  INTEGER :: nbindex
+  REAL :: julian, ss
+  INTEGER :: yy, mm, dd
+!-
+  LOGICAL :: relaxation
+!-
+  CHARACTER(LEN=80) :: filename, driv_restname_in, driv_restname_out
+  CHARACTER(LEN=30) :: time_str, var_name
+!-
+  INTEGER :: it, istp, istp_old, rest_id, it_force
+!-
+  INTEGER :: split, split_start, nb_spread, for_offset
+  INTEGER :: itau_dep, itau_dep_rest, itau_fin, itau_skip, itau_len
+
+  INTEGER,DIMENSION(2) :: ml
+!-
+  LOGICAL :: last_CALL, first_CALL, debug
+  LOGICAL :: no_inter, inter_lin, netrad_cons
+!-
+  ! to check variables passed to intersurf
+  INTEGER :: ik
+  INTEGER :: i,j
+  LOGICAL, PARAMETER :: longprint = .FALSE.
+
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+  & fluxsens_g,vevapp_g,old_zlev_g,old_qair_g,old_eair_g,for_rau_g, &
+  & petAcoef_g, petBcoef_g,peqAcoef_g,peqBcoef_g,albedo_g,z0_g
+  LOGICAL :: Flag
+  LOGICAL :: driver_reset_time
+
+  REAL :: fill_init
+
+  fill_init=REAL(nf90_fill_real,r_std)
+  CALL ioconf_expval(val_exp)
+!-
+! Init parallelism
+
+  CALL Init_orchidee_para   !ANNE a verifier
+  CALL init_timer
+   CALL start_timer(timer_global)
+  CALL start_timer(timer_mpi)
+ 
+! driver only for process root
+  
+!---------------------------------------------------------------------
+!-
+! set debug to have more information
+!-
+  !Config Key   = DEBUG_INFO
+  !Config Desc  = Flag for debug information
+  !Config If    = [-]
+  !Config Def   = n
+  !Config Help  = This option allows to switch on the output of debug
+  !Config         information without recompiling the code.
+  !Config Units = [FLAG] 
+!-
+  debug = .FALSE.
+  CALL getin_p('DEBUG_INFO',debug)
+!=====================================================================
+!- 1.0 This section defines the general set-up of the experiment :
+!-   - Forcing data to be used with its time step
+!-   - Restart file to be used
+!-   - The time step that will be used
+!-   - The starting date of the simulation
+!-   - Length of integration
+!-   - Basic flags for SSIPSL
+!=====================================================================
+!- 1.1 Initialize the driving variables. It essentialy gets the mode
+!-     used and the size of the driving variables.
+!=====================================================================
+  IF (debug) WRITE(numout,*) 'Reading name of the forcing file'
+!- 
+ !Config Key   = FORCING_FILE
+ !Config Desc  = Name of file containing the forcing data
+ !Config If    = [-]
+ !Config Def   = forcing_file.nc
+ !Config Help  = This is the name of the file which should be opened
+ !Config         for reading the forcing data of the dim0 model.
+ !Config         The format of the file has to be netCDF and COADS
+ !Config         compliant.
+ !Config Units = [FILE] 
+!- 
+  filename='forcing_file.nc'
+  CALL getin_p('FORCING_FILE',filename)
+!-
+  IF (debug) WRITE(numout,*) 'Opening forcing file'
+!-
+! We call flininfo to obtain the dimensions
+! of iim, jjm and others.
+! This information will allow us to allocate all the space needed.
+!-
+  CALL forcing_info &
+ &  (filename, iim, jjm, llm, tm, date0, dt_force, force_id) 
+!-
+  WRITE(numout,*) 'Out of flininfo : date0 ', date0, &
+       'iim, jjm, llm, tm',iim,jjm,llm,tm,' dt_force ',dt_force
+!-
+  CALL init_ioipsl_para
+!-
+  IF (debug) THEN
+    WRITE(numout,*) 'Allocate memory for the driver :', iim, jjm, llm
+  ENDIF
+!-
+  ALLOCATE (tmplev(llm)) 
+  ALLOCATE &
+ & (swdown(iim,jjm), sinang(iim,jjm), precip_rain(iim,jjm), precip_snow(iim,jjm), &
+ &  tair_obs(iim,jjm), u(iim,jjm), v(iim,jjm), qair_obs(iim,jjm), &
+ &  pb(iim,jjm), lwdown(iim,jjm), &
+ &  eair_obs(iim,jjm), zlev_vec(iim,jjm), zlevuv_vec(iim,jjm), relax(iim,jjm))
+!- 
+  ALLOCATE &
+ & (petAcoef(iim,jjm), peqAcoef(iim,jjm), &
+ &  petBcoef(iim,jjm), peqBcoef(iim,jjm), &
+ &  cdrag(iim,jjm), for_u(iim,jjm), for_v(iim,jjm), &
+ &  for_swnet(iim,jjm), for_swdown(iim,jjm), for_sinang(iim,jjm), for_lwdown(iim,jjm), &
+ &  for_psurf(iim,jjm), for_qair(iim,jjm), for_tair(iim,jjm), &
+ &  for_eair(iim,jjm), for_ccanopy(iim,jjm), for_rau(iim,jjm))
+!!$, &
+!!$ &  tmp_eair(iim,jjm), tmp_tair(iim,jjm), &
+!!$ &  tmp_qair(iim,jjm), tmp_pb(iim,jjm))
+!-
+  ALLOCATE &
+ & (for_contfrac(iim,jjm), for_neighbours(iim,jjm,8), for_resolution(iim,jjm,2), &
+ &  old_zlev(iim,jjm), old_qair(iim,jjm), old_eair(iim,jjm), &
+ &  tsol_rad(iim,jjm), vevapp(iim,jjm), &
+ &  temp_sol_NEW(iim,jjm), temp_sol_old(iim,jjm), &
+ &  dtdt(iim,jjm), coastalflow(iim,jjm), riverflow(iim,jjm), &
+ &  fluxsens(iim,jjm), fluxlat(iim,jjm), emis(iim,jjm), &
+ &  z0(iim,jjm), qsurf(iim,jjm),soil_mc(iim*jjm,11,3),litter_mc(iim*jjm,3))
+!!$, epot_sol(iim,jjm)
+!-
+  ALLOCATE(albedo(iim,jjm,2))
+  ALLOCATE(albedo_vis(iim,jjm),albedo_nir(iim,jjm))
+!-
+  ALLOCATE(kindex(iim*jjm))
+  ALLOCATE(lon(iim,jjm), lat(iim,jjm))
+!-- 
+  swdown(:,:) = fill_init
+  precip_rain(:,:) = 0.0
+  precip_snow(:,:) = 0.0
+  tair_obs(:,:) = 0.0
+  u(:,:) = fill_init
+  v(:,:) = fill_init
+  qair_obs(:,:) = fill_init
+  pb(:,:) = fill_init
+  lwdown(:,:) = fill_init
+  eair_obs(:,:) = fill_init
+  zlev_vec(:,:) = 0.0
+  zlevuv_vec(:,:) = 0.0
+  relax(:,:) = 0.0
+  petAcoef(:,:) = 0.0
+  peqAcoef(:,:) = 0.0
+  petBcoef(:,:) = 0.0
+  peqBcoef(:,:) = 0.0
+  cdrag(:,:) = 0.0
+  for_u(:,:) = fill_init
+  for_v(:,:) = fill_init
+  for_swnet(:,:) = fill_init
+  for_swdown(:,:) = fill_init
+  for_lwdown(:,:) = fill_init
+  for_psurf(:,:) = fill_init
+  for_qair(:,:) = fill_init
+  for_tair(:,:) = fill_init
+  for_eair(:,:) = fill_init
+  for_ccanopy(:,:) = 0.0
+  for_rau(:,:) = fill_init
+  for_contfrac(:,:) = 0.0
+  for_neighbours(:,:,:) = 0
+  for_resolution(:,:,:) = 0.0
+  soil_mc(:,:,:) = 0.0
+  litter_mc(:,:) = 0.0
+  old_zlev(:,:) = 0.0
+  old_qair(:,:) = 0.0
+  old_eair(:,:) = 0.0
+  tsol_rad(:,:) = 0.0
+  vevapp(:,:) = 0.0
+  temp_sol_NEW(:,:) = fill_init
+  temp_sol_old(:,:) = fill_init
+  dtdt(:,:) = 0.0
+  coastalflow(:,:) = 0.0
+  riverflow(:,:) = 0.0
+  fluxsens(:,:) = fill_init
+  fluxlat(:,:) = fill_init
+  emis(:,:) = 0.0
+  z0(:,:) = fill_init
+  qsurf(:,:) = 0.0
+  albedo(:,:,:) = fill_init
+  albedo_vis(:,:) = fill_init
+  albedo_nir(:,:) = fill_init
+  kindex(:) = 0
+  lon(:,:) = 0.0
+  lat(:,:) = 0.0
+!-
+! We need to know the grid.
+! Then we can initialize the restart files, and then we
+! can give read the restart files in the forcing subroutine.
+!-
+  CALL forcing_grid (iim,jjm,llm,lon,lat,init_f=.FALSE.)
+!=====================================================================
+!- 1.2 Time step to be used.
+!-     This is relative to the time step of the  forcing data
+!=====================================================================
+  IF ( .NOT. weathergen ) THEN
+     !Config Key   = SPLIT_DT
+     !Config Desc  = splits the timestep imposed by the forcing
+     !Config If    = NOT(WEATHERGEN)
+     !Config Def   = 12
+     !Config Help  = With this value the time step of the forcing
+     !Config         will be devided. In principle this can be run
+     !Config         in explicit mode but it is strongly suggested
+     !Config         to use the implicit method so that the
+     !Config         atmospheric forcing has a smooth evolution.
+     !Config Units = [-]
+!-
+     split = 12
+     CALL getin_p('SPLIT_DT', split)
+  ELSE
+     split = 1
+  ENDIF
+!-
+! The time step which is going to be used is computed
+! from the forcing time step and the user input.
+!-
+  IF (split > 0) THEN
+     dt = dt_force/split
+  ELSE
+     split = 1
+     dt = dt_force
+  ENDIF
+!=====================================================================
+!- 1.3 Initialize the restart file for the driver
+!=====================================================================
+  !Config Key   = RESTART_FILEIN
+  !Config Desc  = Name of restart to READ for initial conditions
+  !Config If    = [-]
+  !Config Def   = NONE
+  !Config Help  = This is the name of the file which will be opened
+  !Config         to extract the initial values of all prognostic
+  !Config         values of the model. This has to be a netCDF file.
+  !Config         Not truly COADS compliant. NONE will mean that
+  !Config         no restart file is to be expected.
+  !Config Units = [FILE]
+!-
+  driv_restname_in = 'NONE'
+  CALL getin_p('RESTART_FILEIN',driv_restname_in)
+  if (debug) WRITE(numout,*) 'INPUT RESTART_FILE : ',TRIM(driv_restname_in)
+!-
+  !Config Key   = RESTART_FILEOUT
+  !Config Desc  = Name of restart files to be created by the driver
+  !Config If    = [-]
+  !Config Def   = driver_rest_out.nc
+  !Config Help  = This variable give the  name for
+  !Config         the restart files. The restart software within
+  !Config         IOIPSL will add .nc if needed
+  !Config Units = [FILE]
+!-
+  driv_restname_out = 'driver_rest_out.nc'
+  CALL getin_p('RESTART_FILEOUT', driv_restname_out)
+  if (debug) WRITE(numout,*) 'OUTPUT RESTART_FILE : ',TRIM(driv_restname_out)
+!-
+! Set default values for the start and end of the simulation
+! in the forcing chronology.
+
+  CALL gather2D_mpi(lon,lon_g)
+  CALL gather2D_mpi(lat,lat_g)
+  
+!Config Key   = DRIVER_reset_time 
+!Config Desc  = Overwrite time values from the driver restart file 
+!Config If    = [-] 
+!Config Def   = FALSE 
+!Config Units = [FLAG]
+
+  driver_reset_time=.FALSE. 
+  CALL getin_p('DRIVER_reset_time', driver_reset_time) 
+  IF (debug) WRITE(numout,*) 'driver_reset_time=',driver_reset_time 
+  IF (is_root_prc) THEN
+     ! Set default values for the time variables 
+     itau_dep_rest = 0 
+     date0_rest = date0 
+     dt_rest = dt 
+   
+  IF (debug) WRITE(numout,*) & 
+     'Before driver restart file initialization : itau_dep_rest, date0_rest, dt_rest = ', & 
+     itau_dep_rest, date0_rest, dt_rest
+     CALL restini &
+          (driv_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, tmplev, & 
+          driv_restname_out, itau_dep_rest, date0_rest, dt_rest, rest_id, driver_reset_time)
+!-
+     IF (debug) WRITE(numout,*) &
+        'After driver restart file initialization : itau_dep_rest, date0_rest, dt_rest = ', & 
+        itau_dep_rest, date0_rest, dt_rest 
+          
+     IF (itau_dep_rest == 0 .OR. driver_reset_time) THEN 
+        ! Restart file did not exist or we decide to overwrite time values in it. 
+        ! Set time values to read the begining of the forcing file. 
+        itau_dep=0 
+        itau_fin=tm 
+        date0_rest = date0 
+     ELSE 
+        ! Take time values from restart file 
+        itau_dep = itau_dep_rest
+        itau_fin = itau_dep+tm
+     ENDIF
+        WRITE(numout,*) & 
+        'Restart file initialized : itau_dep, itau_fin, date0_rest, dt_rest = ', & 
+        itau_dep, itau_fin, date0_rest, dt_rest 
+     ENDIF 
+         
+        ! Communicate values from root_prc to all the others
+  CALL bcast (itau_dep_rest)
+  CALL bcast (itau_dep)
+  CALL bcast (itau_fin)
+  CALL bcast (date0_rest)
+  CALL bcast (dt_rest)
+
+!=====================================================================
+!- 1.4 Here we do the first real reading of the driving. It only
+!-     gets a few variables.
+!=====================================================================
+
+! prepares kindex table from the information obtained
+! from the forcing data and reads some initial values for
+! temperature, etc.
+!- 
+  kindex(1) = 1
+!-
+  CALL forcing_READ &
+ &  (filename, rest_id, .TRUE., .FALSE., &
+ &   0, itau_dep, 0, split, nb_spread, netrad_cons, &
+ &   date0, dt_force, iim, jjm, lon, lat, zlev_vec, zlevuv_vec, tm, &
+ &   swdown, sinang, precip_rain, precip_snow, tair_obs, &
+ &   u, v, qair_obs, pb, lwdown, for_contfrac, for_neighbours, for_resolution, &
+ &   for_swnet, eair_obs, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, for_ccanopy, &
+ &   kindex, nbindex, force_id)
+!-
+  WRITE (numout,*) ">> Number of land points =",nbindex
+  IF (nbindex == 0) THEN
+     WRITE(numout,*) "Limits : (W,E / N,S)", limit_west, limit_east, &
+          &                             limit_north, limit_south
+     CALL ipslerr_p ( 3, 'dim2_driver','number of land points error.', &
+          &         ' is zero !','stop driver')
+  ENDIF
+
+  jlandindex = (((kindex(1:nbindex)-1)/iim) + 1)
+  ilandindex = (kindex(1:nbindex) - (jlandindex(1:nbindex)-1)*iim)
+  IF (longprint) THEN
+     WRITE(numout,*) "kindex of land points : ", kindex(1:nbindex)
+     WRITE(numout,*) "index i of land points : ", ilandindex
+     WRITE(numout,*) "index j of land points : ", jlandindex 
+  ENDIF
+
+  im = iim; jm = jjm; lm = llm;
+  IF ( (iim > 1).AND.(jjm > 1) ) THEN
+    jtest = INT((kindex(INT(nbindex/2))-1)/iim)+1
+    itest = MAX( 1, kindex(INT(nbindex/2))-(jtest-1)*iim )
+  ELSE
+    jtest = 1
+    itest = 1
+  ENDIF
+  IF (debug) WRITE(numout,*) "test point in dim2_driver : ",itest,jtest
+!-
+  IF ((im /= iim) .AND. (jm /= jjm) .AND. (lm /= llm))  THEN
+    WRITE(numout,*) ' dimensions are not good. Verify FILE :'
+    WRITE(numout,*) ' filename = ',filename
+    WRITE(numout,*) ' im, jm, lm lus         = ', im, jm, lm
+    WRITE(numout,*) ' iim, jjm, llm demandes = ', iim, jjm, llm
+    STOP 'dim2_driver'
+  ENDIF  
+!=====================================================================
+!- 1.5  Configures the time-steps and other parameters 
+!-      of the run.
+!=====================================================================
+!-
+! If the time steping of the restart is different from the one
+! of the forcing we need to convert the itau_dep into the
+! chronology of the forcing. This ensures that the forcing will
+! start at the date of the restart file. Obviously the itau_fin
+! needs to be shifted as well !
+!-
+  IF ( (dt_rest /= dt_force).AND.(itau_dep > 1) ) THEN
+    itau_dep = NINT((itau_dep*dt_rest )/dt_force)
+    itau_fin = itau_dep+tm
+    if (debug) WRITE(numout,*) &
+ & 'The time steping of the restart is different from the one ',&
+ & 'of the forcing we need to convert the itau_dep into the ',&
+ & 'chronology of the forcing. This ensures that the forcing will ',&
+ & 'start at the date of the restart file. Obviously the itau_fin ',&
+ & 'needs to be shifted as well : itau_dep, itau_fin ', &
+ & itau_dep, itau_fin
+  ENDIF
+!-
+! Same things if the starting dates are not the same.
+! Everything should look as if we had only one forcing file !
+!-
+  IF (date0 /= date0_rest) THEN
+    WRITE(numout,*) 'date0_rest , date0 : ',date0_rest , date0
+    for_offset = NINT((date0_rest-date0)*one_day/dt_force)
+  ELSE
+    for_offset = 0
+  ENDIF
+  WRITE(numout,*) 'OFFSET FOR THE data read :', for_offset
+
+  CALL ioconf_startdate(date0_rest)
+!-
+  !Config Key   = TIME_SKIP
+  !Config Desc  = Time in the forcing file at which the model is started.
+  !Config If    = [-]
+  !Config Def   = 0
+  !Config Help  = This time give the point in time at which the model
+  !Config         should be started. If exists, the date of the restart file is use.
+  !Config         The FORMAT of this date can be either of the following :
+  !Config         n   : time step n within the forcing file
+  !Config         nS  : n seconds after the first time-step in the file
+  !Config         nD  : n days after the first time-step
+  !Config         nM  : n month after the first time-step (year of 365 days)
+  !Config         nY  : n years after the first time-step (year of 365 days)
+  !Config         Or combinations :
+  !Config         nYmM: n years and m month
+  !Config Units = [seconds, days, months, years]
+!-
+  itau_skip = 0
+  WRITE(time_str,'(I10)') itau_skip
+  CALL getin_p('TIME_SKIP', time_str)
+!-
+! Transform into itau
+!-
+  CALL tlen2itau (time_str, dt_force, date0, itau_skip)
+!-
+  itau_dep = itau_dep+itau_skip
+!-
+! We need to select the right position of the splited time steps.
+!-
+  istp = itau_dep*split+1
+  IF (MOD(istp-1,split) /= 0) THEN
+    split_start = MOD(istp-1,split)+1
+  ELSE
+    split_start = 1
+  ENDIF
+  istp_old = itau_dep_rest
+!!$  it_force = MAX(MOD(itau_dep,INT(one_day*one_year/dt_force)),1)+itau_skip
+!!$  WRITE(numout,*) 'itau_dep, it_force :', itau_dep, it_force
+!-
+  itau_len = itau_fin-itau_dep
+!-
+  !Config Key   = TIME_LENGTH
+  !Config Desc  = Length of the integration in time.
+  !Config If    = [-]
+  !Config Def   = DEF
+  !Config Help  = Length of integration. By default the entire length
+  !Config         of the forcing is used. The FORMAT of this date can
+  !Config         be either of the following :
+  !Config         n   : time step n within the forcing file
+  !Config         nS  : n seconds after the first time-step in the file
+  !Config         nD  : n days after the first time-step
+  !Config         nM  : n month after the first time-step (year of 365 days)
+  !Config         nY  : n years after the first time-step (year of 365 days)
+  !Config         Or combinations :
+  !Config         nYmM: n years and m month
+  !Config Units = [seconds, days, months, years]
+!-
+  WRITE(time_str,'(I10)') itau_len
+  CALL getin_p('TIME_LENGTH', time_str)
+!-
+! Transform into itau
+!-
+  CALL tlen2itau (time_str, dt_force, date0, itau_len)
+!-
+  itau_fin = itau_dep+itau_len
+!-
+  WRITE(numout,*) '>> Time origine in the forcing file :', date0
+  WRITE(numout,*) '>> Time origine in the restart file :', date0_rest
+  WRITE(numout,*) '>> Simulate starts at forcing time-step : ', itau_dep
+  WRITE(numout,*) '>> The splited time-steps start at (Sets the '
+  WRITE(numout,*) '>>  chronology for the history and restart files):',istp
+  WRITE(numout,*) '>> The time spliting starts at :', split_start
+  WRITE(numout,*) '>> Simulation ends at forcing time-step: ', itau_fin
+  WRITE(numout,*) '>> Length of the simulation is thus :', itau_len
+  WRITE(numout,*) '>> Length of the forcing data is in time-steps : ', tm
+  IF (tm < itau_len) THEN
+     CALL ipslerr_p ( 2, 'dim2_driver','Length of the simulation is greater than.', &
+ &         ' Length of the forcing data is in time-steps','verify TIME_LENGTH parameter.')
+  ENDIF
+  WRITE(numout,*) '>> Time steps : true, forcing and restart : ', dt,dt_force,dt_rest
+
+!=====================================================================
+!- 2.0 This section is going to define the details by which
+!-     the input data is going to be used to force the
+!-     land-surface scheme. The tasks are the following :
+!-   - Is the coupling going to be explicit or implicit
+!-   - Type of interpolation to be used.
+!-   - At which height are the atmospheric forcings going to be used ?
+!-   - Is a relaxation method going to be used on the forcing
+!-   - Does net radiation in the interpolated data need to be conserved
+!-   - How do we distribute precipitation.
+!=====================================================================
+  !Config Key   = RELAXATION
+  !Config Desc  = method of forcing
+  !Config If    = [-]
+  !Config Def   = n
+  !Config Help  = A method is proposed by which the first atmospheric
+  !Config         level is not directly forced by observations but
+  !Config         relaxed with a time constant towards observations.
+  !Config         For the moment the methods tends to smooth too much
+  !Config         the diurnal cycle and introduces a time shift.
+  !Config         A more sophisticated method is needed.
+  !Config Units = [FLAG]
+!-
+  relaxation = .FALSE.
+  CALL getin_p('RELAXATION', relaxation)  
+  IF ( relaxation ) THEN
+     WRITE(numout,*) 'dim2_driver : The relaxation option is temporarily disabled as it does not'
+     WRITE(numout,*) '              produce energy conservation in ORCHIDEE. If you intend to use it'
+     WRITE(numout,*) '              you should validate it.'
+     STOP 'dim2_driver'
+!- 
+     !Config Key   = RELAX_A
+     !Config Desc  = Time constant of the relaxation layer
+     !Config If    = RELAXATION
+     !Config Def   = 1.0
+     !Config Help  = The time constant associated to the atmospheric
+     !Config         conditions which are going to be computed
+     !Config         in the relaxed layer. To avoid too much
+     !Config         damping the value should be larger than 1000.
+     !Config Units = [days?]
+!-
+     alpha = 1000.0
+     CALL getin_p('RELAX_A', alpha)
+  ENDIF
+!-
+  no_inter = .TRUE.
+  inter_lin = .FALSE.
+
+  !Config Key   = NO_INTER 
+  !Config Desc  = No interpolation IF split is larger than 1
+  !Config If    = [-]
+  !Config Def   = y
+  !Config Help  = Choose IF you do not wish to interpolate linearly.
+  !Config Units = [FLAG]
+  CALL getin_p('NO_INTER', no_inter)
+
+  !Config Key   = INTER_LIN
+  !Config Desc  = Interpolation IF split is larger than 1
+  !Config If    = [-]
+  !Config Def   = n
+  !Config Help  = Choose IF you wish to interpolate linearly.
+  !Config Units = [FLAG]
+  CALL getin_p('INTER_LIN', inter_lin)
+!-
+  IF (inter_lin) THEN
+     no_inter = .FALSE.
+  ELSE
+     no_inter = .TRUE.
+  ENDIF
+!-
+  IF (split == 1) THEN
+    no_inter = .TRUE.
+    inter_lin = .FALSE.
+  ENDIF
+!-
+  !Config Key   = SPRED_PREC
+  !Config Desc  = Spread the precipitation.
+  !Config If    = [-]
+  !Config Def   = 1
+  !Config Help  = Spread the precipitation over n steps of the splited forcing 
+  !Config         time step. This ONLY applied if the forcing time step has been splited.
+  !Config         If the value indicated is greater than SPLIT_DT, SPLIT_DT is used for it.
+  !Config Units = [-]
+!-
+  nb_spread = 1
+  CALL getin_p('SPRED_PREC', nb_spread)  
+  IF (nb_spread > split) THEN
+    WRITE(numout,*) 'WARNING : nb_spread is too large it will be '
+    WRITE(numout,*) '          set to the value of split'
+    nb_spread = split
+  ELSE IF (split == 1) THEN
+    nb_spread = 1
+  ENDIF
+!-
+  IF (inter_lin) THEN
+     !Config Key   = NETRAD_CONS
+     !Config Desc  = Conserve net radiation in the forcing
+     !Config Def   = y
+     !Config If    = INTER_LIN
+     !Config Help  = When the interpolation is used the net radiation
+     !Config         provided by the forcing is not conserved anymore.
+     !Config         This should be avoided and thus this option should
+     !Config         be TRUE (y).
+     !Config         This option is not used for short-wave if the
+     !Config         time-step of the forcing is longer than an hour.
+     !Config         It does not make sense to try and reconstruct
+     !Config         a diurnal cycle and at the same time conserve the 
+     !Config         incoming solar radiation.
+     !Config Units = [FLAG]
+     !-
+     netrad_cons = .TRUE.
+     CALL getin_p('NETRAD_CONS', netrad_cons)
+  ELSE
+     netrad_cons = .FALSE.
+  ENDIF
+!=====================================================================
+!- 3.0 Finaly we can prepare all the variables before launching
+!-     the simulation !
+!=====================================================================
+! Initialize LOGICAL and the length of the integration
+!-
+  last_CALL = .FALSE.
+  first_CALL = .TRUE.
+!-
+  temp_sol_NEW(:,:) = tp_00
+!-  
+  !Config Key   = ATM_CO2
+  !Config Desc  = Value for atm CO2
+  !Config If    = [-]
+  !Config Def   = 350.
+  !Config Help  = Value to prescribe the atm CO2.
+  !Config         For pre-industrial simulations, the value is 286.2 .
+  !Config         348. for 1990 year.
+  !Config Units = [ppm]
+!-
+  atmco2=350.
+  CALL getin_p('ATM_CO2',atmco2)
+  for_ccanopy(:,:)=atmco2
+!-
+! Preparing for the implicit scheme.
+! This means loading the prognostic variables from the restart file.
+!-
+  Flag=.FALSE.
+  IF (is_root_prc) THEN
+     ALLOCATE(fluxsens_g(iim_g,jjm_g))
+     var_name= 'fluxsens'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., fluxsens_g)
+     IF (ALL(fluxsens_g(:,:) == val_exp)) THEN
+        Flag=.TRUE.
+     ELSE
+        Flag=.FALSE.
+     ENDIF
+  ELSE
+     ALLOCATE(fluxsens_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF (.NOT. Flag) THEN
+     CALL scatter2D_mpi(fluxsens_g,fluxsens)
+  ELSE
+     fluxsens(:,:) = zero
+  ENDIF
+  DEALLOCATE(fluxsens_g)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(vevapp_g(iim_g,jjm_g))
+     var_name= 'vevapp'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., vevapp_g)
+     IF (ALL(vevapp_g(:,:) == val_exp)) THEN
+        Flag=.TRUE.
+     ELSE
+        Flag=.FALSE.
+     ENDIF
+  ELSE
+     ALLOCATE(vevapp_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF (.NOT. Flag) THEN
+     CALL scatter2D_mpi(vevapp_g,vevapp)
+  ELSE
+     vevapp(:,:) = zero
+  ENDIF
+  DEALLOCATE(vevapp_g)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(old_zlev_g(iim_g,jjm_g))
+     var_name= 'zlev_old'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., old_zlev_g)
+     IF (ALL(old_zlev_g(:,:) == val_exp)) THEN
+        Flag=.TRUE.
+     ELSE
+        Flag=.FALSE.
+     ENDIF
+  ELSE
+     ALLOCATE(old_zlev_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF ( .NOT. Flag ) THEN
+     CALL scatter2D_mpi(old_zlev_g,old_zlev)
+  ELSE
+     old_zlev(:,:)=zlev_vec(:,:)
+  ENDIF
+  DEALLOCATE(old_zlev_g)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(old_qair_g(iim_g,jjm_g))
+     var_name= 'qair_old'
+     CALL restget &
+ &       (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., old_qair_g)
+    IF (ALL(old_qair_g(:,:) == val_exp)) THEN
+      Flag=.TRUE.
+    ELSE
+      Flag=.FALSE.
+    ENDIF
+  ELSE
+     ALLOCATE(old_qair_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF ( .NOT. Flag ) THEN
+     CALL scatter2D_mpi(old_qair_g,old_qair)
+  ELSE
+     old_qair(:,:) = qair_obs(:,:)
+  ENDIF
+  DEALLOCATE(old_qair_g)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(old_eair_g(iim_g,jjm_g))
+     var_name= 'eair_old'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., old_eair_g)
+    IF (ALL(old_eair_g(:,:) == val_exp)) THEN
+      Flag=.TRUE.
+    ELSE
+      Flag=.FALSE.
+    ENDIF
+  ELSE
+     ALLOCATE(old_eair_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF ( .NOT. Flag ) THEN
+     CALL scatter2D_mpi(old_eair_g,old_eair)
+  ELSE
+     DO ik=1,nbindex
+        i=ilandindex(ik)
+        j=jlandindex(ik)
+        old_eair(i,j) = cp_air * tair_obs(i,j) + cte_grav*zlev_vec(i,j)
+     ENDDO
+  ENDIF
+  DEALLOCATE(old_eair_g)
+!-
+! old density is also needed because we do not yet have the right pb
+!-
+!=> obsolète ??!! (tjrs calculé après forcing_read) 
+  IF (is_root_prc) THEN
+     ALLOCATE(for_rau_g(iim_g,jjm_g))
+     var_name= 'rau_old'
+     CALL restget &
+ &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., for_rau_g)
+    IF (ALL(for_rau_g(:,:) == val_exp)) THEN
+      Flag=.TRUE.
+    ELSE
+      Flag=.FALSE.
+    ENDIF
+  ELSE
+     ALLOCATE(for_rau_g(0,1))
+  ENDIF
+  CALL bcast(Flag)
+  IF ( .NOT. Flag ) THEN
+     CALL scatter2D_mpi(for_rau_g,for_rau)
+  ELSE
+     DO ik=1,nbindex
+        i=ilandindex(ik)
+        j=jlandindex(ik)
+        for_rau(i,j) = pb(i,j)/(cte_molr*(tair_obs(i,j)))
+     ENDDO
+  ENDIF
+  DEALLOCATE(for_rau_g)
+!-
+! For this variable the restart is extracted by SECHIBA
+!-
+  temp_sol_NEW(:,:) = tair_obs(:,:)
+!- 
+  if (.NOT. is_watchout) THEN
+!-
+!   This does not yield a correct restart in the case of relaxation
+!-
+     IF (is_root_prc) THEN
+        ALLOCATE(petAcoef_g(iim_g,jjm_g))
+        var_name= 'petAcoef'
+        CALL restget &
+ &           (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., petAcoef_g)
+        IF (ALL(petAcoef_g(:,:) == val_exp)) THEN
+           Flag=.TRUE.
+        ELSE
+           Flag=.FALSE.
+        ENDIF
+     ELSE
+        ALLOCATE(petAcoef_g(0,1))
+     ENDIF
+     CALL bcast(Flag)
+     IF ( .NOT. Flag ) THEN
+        CALL scatter2D_mpi(petAcoef_g,petAcoef)
+     ELSE
+        petAcoef(:,:) = zero
+     ENDIF
+     DEALLOCATE(petAcoef_g)
+!--
+     IF (is_root_prc) THEN
+        ALLOCATE(petBcoef_g(iim_g,jjm_g))
+        var_name= 'petBcoef'
+        CALL restget &
+ &           (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., petBcoef_g)
+        IF (ALL(petBcoef_g(:,:) == val_exp)) THEN
+           Flag=.TRUE.
+        ELSE
+           Flag=.FALSE.
+        ENDIF
+     ELSE
+        ALLOCATE(petBcoef_g(0,1))
+     ENDIF
+     CALL bcast(Flag)
+     IF ( .NOT. Flag ) THEN
+        CALL scatter2D_mpi(petBcoef_g,petBcoef)
+     ELSE
+        petBcoef(:,:) = old_eair(:,:)
+     ENDIF
+     DEALLOCATE(petBcoef_g)
+!--
+     IF (is_root_prc) THEN
+        ALLOCATE(peqAcoef_g(iim_g,jjm_g))
+        var_name= 'peqAcoef'
+        CALL restget &
+ &           (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., peqAcoef_g)
+        IF (ALL(peqAcoef_g(:,:) == val_exp)) THEN
+           Flag=.TRUE.
+        ELSE
+           Flag=.FALSE.
+        ENDIF
+     ELSE
+        ALLOCATE(peqAcoef_g(0,1))
+     ENDIF
+     CALL bcast(Flag)
+     IF ( .NOT. Flag ) THEN
+        CALL scatter2D_mpi(peqAcoef_g,peqAcoef)
+     ELSE
+        peqAcoef(:,:) = zero
+     ENDIF
+     DEALLOCATE(peqAcoef_g)
+!--
+     IF (is_root_prc) THEN
+        ALLOCATE(peqBcoef_g(iim_g,jjm_g))
+        var_name= 'peqBcoef'
+        CALL restget &
+ &           (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., peqBcoef_g)
+        IF (ALL(peqBcoef_g(:,:) == val_exp)) THEN
+           Flag=.TRUE.
+        ELSE
+           Flag=.FALSE.
+        ENDIF
+     ELSE
+        ALLOCATE(peqBcoef_g(0,1))
+     ENDIF
+     CALL bcast(Flag)
+     IF ( .NOT. Flag ) THEN
+        CALL scatter2D_mpi(peqBcoef_g,peqBcoef)
+     ELSE
+        peqBcoef(:,:) = old_qair(:,:)
+     ENDIF
+     DEALLOCATE(peqBcoef_g)
+  ENDIF
+!-
+! And other variables which need initial variables. These variables
+! will get properly initialized by ORCHIDEE when it is called for 
+! the first time.
+!-
+  albedo(:,:,:) = 0.13
+  emis(:,:) = 1.0
+  z0(:,:) = 0.1
+!--
+!=====================================================================
+!- 4.0 START THE TIME LOOP
+!=====================================================================
+
+!ANNE!  CALL init_timer   
+
+  it = itau_dep+1
+  DO WHILE ( it <= itau_fin )
+!----
+    it_force = it+for_offset
+    IF (it_force < 0) THEN
+      WRITE(numout,*) 'The day is not in the forcing file :', &
+ &               it_force, it, for_offset
+      STOP 'dim2_driver'
+    ENDIF
+!!$    IF (it_force > itau_dep+tm) THEN
+!!$       WRITE(numout,*) 'ERROR : more time-steps than data'
+!!$       WRITE(numout,*) 'it_force : ', it_force, ' itau_dep+tm : ', itau_dep+tm
+!!$      STOP 'dim2_driver'
+!!$    ENDIF 
+!---
+    is=split_start
+    DO WHILE ( is <= split )
+!-----
+      julian = itau2date(istp, date0_rest, dt)
+      CALL ju2ymds(julian, yy, mm, dd, ss)
+      IF (debug) THEN
+         WRITE(numout,*) "=============================================================="
+         WRITE(numout,"('New iteration at date : ',I4,'-',I2.2,'-',I2.2,':',F8.4)") &
+              &               yy,mm,dd,ss/3600.
+#ifdef CPP_PARA
+         IF (is_root_prc) THEN
+            WRITE(*,*) "=============================================================="
+            WRITE(*,"('New iteration at date : ',I4,'-',I2.2,'-',I2.2,':',F8.4)") &
+              &               yy,mm,dd,ss/3600.
+         ENDIF
+#endif
+      ENDIF
+!----- 
+      IF ( (it == itau_fin).AND.(is == split) ) THEN
+        last_CALL = .TRUE.
+      ENDIF
+!-----
+      IF (debug) WRITE(numout,*) 'Into forcing_read'
+!-----
+      CALL forcing_READ &
+ &      (filename, rest_id, .FALSE., last_call, &
+ &       it_force, istp, is, split, nb_spread, netrad_cons, &
+ &       date0_rest, dt_force, iim, jjm, lon, lat, zlev_vec, zlevuv_vec, tm, &
+ &       swdown, sinang, precip_rain, precip_snow, tair_obs, &
+ &       u, v, qair_obs, pb, for_lwdown, for_contfrac, for_neighbours, for_resolution, &
+ &       for_swnet, eair_obs, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, for_ccanopy, &
+ &       kindex, nbindex, force_id)
+
+!-----
+!---- SECHIBA expects surface pressure in hPa
+!-----
+      for_psurf(:,:)  = pb(:,:)/100.
+
+      IF (longprint) THEN
+         WRITE(numout,*) "dim2_driver 0 ",it_force 
+         WRITE(numout,*) ">> Index of land points =",kindex(1:nbindex)
+         WRITE(numout,*) "Lowest level wind speed North = ", &
+              & (/ ( u(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level wind speed East = ", &
+              & (/ ( v(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "z0            ; Surface roughness = ", &
+              & (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Height of first layer = ", &
+              & (/ ( zlev_vec(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level specific humidity = ", &
+              & (/ ( qair_obs(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Rain precipitation = ", &
+              & (/ ( precip_rain(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+         WRITE(numout,*) "Snow precipitation = ", &
+              & (/ ( precip_snow(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+         WRITE(numout,*) "Down-welling long-wave flux = ", &
+              & (/ ( for_lwdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Net surface short-wave flux = ", &
+              & (/ ( for_swnet(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Downwelling surface short-wave flux = ", &
+              & (/ ( swdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Air temperature in Kelvin = ", &
+              & (/ ( tair_obs(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Air potential energy = ", &
+              & (/ ( eair_obs(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "CO2 concentration in the canopy = ", &
+              & (/ ( for_ccanopy(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Coeficients A from the PBL resolution = ", &
+              & (/ ( petAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "One for T and another for q = ", &
+              & (/ ( peqAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Coeficients B from the PBL resolution = ", &
+              & (/ ( petBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "One for T and another for q = ", &
+              & (/ ( peqBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Cdrag = ", &
+              & (/ ( cdrag(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /) 
+         WRITE(numout,*) "CO2 concentration in the canopy = ", &
+              & (/ ( for_ccanopy(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /) 
+         WRITE(numout,*) "Lowest level pressure = ", &
+              & (/ ( for_psurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Geographical coordinates lon = ", &
+              & (/ (  lon(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Geographical coordinates lat = ", &
+              & (/ (  lat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Fraction of continent in the grid = ", &
+              & (/ ( for_contfrac(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+      ENDIF
+!-----
+!---- Prepare : tmp_qair, tmp_eair, tmp_tair, tmp_pb
+!---- and     : for_u, for_v, for_lwdown, for_swnet, for_swdown
+!---- All the work is done in forcing_read
+!---- We do not need the no_inter options as we will
+!---- allways interpolate
+!----- 
+      IF (debug) WRITE(numout,*) 'Prepare the atmospheric forcing'
+!----- 
+      IF (.NOT. is_watchout) THEN
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            eair_obs(i,j) = cp_air*tair_obs(i,j)+cte_grav*zlev_vec(i,j)
+            for_swnet(i,j) = (1.-(albedo(i,j,1)+albedo(i,j,2))/2.)*swdown(i,j)
+         ENDDO
+      ENDIF
+      DO ik=1,nbindex
+         i=ilandindex(ik)
+         j=jlandindex(ik)
+         for_swdown(i,j) = swdown(i,j)
+         for_sinang(i,j) = sinang(i,j)
+      ENDDO
+!----- 
+!---- Computing the buffer zone !
+!----- 
+      IF (relaxation) THEN
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_qair(i,j) = peqAcoef(i,j)*(-1.) * vevapp(i,j)*dt+peqBcoef(i,j)
+!-------
+            for_eair(i,j) = petAcoef(i,j)*(-1.) * fluxsens(i,j)+petBcoef(i,j)
+!-------
+         ENDDO
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_tair(i,j) = (for_eair(i,j) - cte_grav*zlev_vec(i,j))/cp_air
+!-------
+!!$        if (.NOT. is_watchout) &
+!!$             epot_sol(:,:) = cp_air*temp_sol_NEW(:,:)
+!-------
+         ENDDO
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_rau(i,j) = pb(i,j) / (cte_molr*for_tair(i,j))
+!-------
+            relax(i,j) = for_rau(i,j)*alpha 
+         ENDDO
+
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            zlflu = zlev_vec(i,j)/2.0*dt
+            peqAcoef(i,j) = 1.0/(zlflu+relax(i,j))
+            peqBcoef(i,j) = (relax(i,j) * qair_obs(i,j)/(zlflu+relax(i,j))) + & 
+                 & for_qair(i,j)/(1.0+relax(i,j)/zlflu)
+         ENDDO
+!-------
+!        relax(:,:) = for_rau(:,:)*alpha 
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            petAcoef(i,j) = 1.0/(zlflu+relax(i,j))
+            petBcoef(i,j) = ( relax(i,j) * eair_obs(i,j) / (zlflu+relax(i,j)) ) &
+                 & + for_eair(i,j)/(1.0+relax(i,j)/zlflu)
+         ENDDO
+      ELSE
+         for_qair(:,:) = fill_init
+         for_eair(:,:) = fill_init
+         for_tair(:,:) = fill_init
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_qair(i,j) = qair_obs(i,j)
+            for_eair(i,j) = eair_obs(i,j)
+            for_tair(i,j) = tair_obs(i,j)
+         ENDDO
+!-------
+!!$        if (.NOT. is_watchout) &
+!!$             epot_sol(:,:) =  cp_air*temp_sol_NEW(:,:)
+!-------
+         DO ik=1,nbindex
+            i=ilandindex(ik)
+            j=jlandindex(ik)
+            for_rau(i,j) = pb(i,j) / (cte_molr*for_tair(i,j))
+         ENDDO
+!-------
+         IF (.NOT. is_watchout) THEN
+           petAcoef(:,:) = 0.0
+           peqAcoef(:,:) = 0.0
+           DO ik=1,nbindex
+              i=ilandindex(ik)
+              j=jlandindex(ik)
+              petBcoef(i,j) = eair_obs(i,j)
+              peqBcoef(i,j) = qair_obs(i,j)
+           ENDDO
+        ENDIF
+      ENDIF
+!-----
+      IF (.NOT. is_watchout) &
+           cdrag(:,:)  = 0.0
+      for_ccanopy(:,:)=atmco2
+!-----
+!---- SECHIBA expects wind, temperature and humidity at the same height.
+!---- If this is not the case then we need to correct for that.
+!-----
+      DO ik=1,nbindex
+         i=ilandindex(ik) 
+         j=jlandindex(ik)
+         for_u(i,j) = u(i,j)*LOG(zlev_vec(i,j)/z0(i,j)) / &
+              LOG(zlevuv_vec(i,j)/z0(i,j)) 
+         for_v(i,j) = v(i,j)*LOG(zlev_vec(i,j)/z0(i,j)) / &
+              LOG(zlevuv_vec(i,j)/z0(i,j))
+      END DO
+            
+!-----
+!---- Prepare the other variables WITH the special CASE
+!---- of splited time steps
+!----
+!---- PRINT input value for debug
+!-----
+      IF (debug) THEN
+        WRITE(numout,*) ' >>>>>> time step it_force = ',it_force
+        WRITE(numout,*) &
+ &       ' tair, qair, eair = ', &
+ &       for_tair(itest,jtest),for_qair(itest,jtest), &
+ &       for_eair(itest,jtest)
+        WRITE(numout,*) &
+ &       ' OBS : tair, qair, eair = ', &
+ &       tair_obs(itest,jtest),qair_obs(itest,jtest), &
+ &       eair_obs(itest,jtest)
+        WRITE(numout,*) ' u et v = ',for_u(itest,jtest),for_v(itest,jtest)
+        WRITE(numout,*) ' precip rain et snow = ', &
+        & precip_rain(itest,jtest),precip_snow(itest,jtest)
+        WRITE(numout,*) ' lwdown et swnet = ', &
+        & for_lwdown(itest,jtest),for_swnet(itest,jtest)
+        WRITE(numout,*) ' petAcoef et peqAcoef = ', &
+        & petAcoef(itest,jtest), peqAcoef(itest,jtest)
+        WRITE(numout,*) ' petBcoef et peqAcoef = ', &
+        & petBcoef(itest,jtest),peqBcoef(itest,jtest)
+        WRITE(numout,*) ' zlev = ',zlev_vec(itest,jtest)
+      ENDIF
+!-----
+      IF (first_CALL) THEN
+
+        DO ik=1,nbindex
+           i=ilandindex(ik)
+           j=jlandindex(ik)
+           for_swdown(i,j) = swdown(i,j)
+           for_sinang(i,j) = sinang(i,j)
+        ENDDO
+        IF (longprint) THEN
+           WRITE(numout,*) "dim2_driver first_CALL ",it_force 
+           WRITE(numout,*) ">> Index of land points =",kindex(1:nbindex)
+           WRITE(numout,*) "Lowest level wind speed North = ", &
+             &     (/ ( for_u(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Lowest level wind speed East = ", &
+             &     (/ ( for_v(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "z0            ; Surface roughness = ", &
+             &     (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Height of first layer = ", &
+             &     (/ ( zlev_vec(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Lowest level specific humidity = ", &
+             &     (/ ( for_qair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Rain precipitation = ", &
+             &     (/ ( precip_rain(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+           WRITE(numout,*) "Snow precipitation = ", &
+             &     (/ ( precip_snow(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+           WRITE(numout,*) "Down-welling long-wave flux = ", &
+             &     (/ ( for_lwdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Net surface short-wave flux = ", &
+             &     (/ ( for_swnet(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Downwelling surface short-wave flux = ", &
+             &     (/ ( for_swdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Air temperature in Kelvin = ", &
+             &     (/ ( for_tair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Air potential energy = ", &
+             &     (/ ( for_eair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "CO2 concentration in the canopy = ", &
+             &     (/ ( for_ccanopy(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Coeficients A from the PBL resolution = ", &
+             &     (/ ( petAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "One for T and another for q = ", &
+             &     (/ ( peqAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Coeficients B from the PBL resolution = ", &
+             &     (/ ( petBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "One for T and another for q = ", &
+             &     (/ ( peqBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Cdrag = ", &
+             &     (/ ( cdrag(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Lowest level pressure = ", &
+             &     (/ ( for_psurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Geographical coordinates lon = ", &
+             &     (/ (  lon(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Geographical coordinates lat = ", &
+             &     (/ (  lat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Fraction of continent in the grid = ", &
+             &     (/ ( for_contfrac(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+        ENDIF
+!-------
+!------ CALL sechiba to initialize fields
+!------ and have some initial results: emis, albedo, z0
+!-------
+        CALL intersurf_main &
+ &        (istp_old, iim, jjm, nbindex, kindex, dt, &
+ &         first_CALL, .FALSE., lon, lat, for_contfrac, for_neighbours, for_resolution, date0_rest, &
+!       first level conditions
+ &         zlev_vec, for_u, for_v, &
+ &         for_qair, for_tair, for_eair, for_ccanopy, &
+!       Variables for the implicit coupling
+ &         cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+!       Rain, snow, radiation and surface pressure
+ &         precip_rain, precip_snow, &
+ &         for_lwdown, for_swnet, for_swdown, for_psurf, &
+!       Output : Fluxes
+ &         vevapp, fluxsens, fluxlat, coastalflow, riverflow,  &
+!       Surface temperatures and surface properties
+ &         tsol_rad, temp_sol_NEW, qsurf, albedo, emis, z0, & 
+!       VOC : radiation
+ &         for_sinang,soil_mc,litter_mc)
+
+        CALL Stop_timer(timer_global)
+        CALL Stop_timer(timer_mpi)
+        CALL Start_timer(timer_global)
+        CALL Start_timer(timer_mpi)
+        !
+        first_CALL = .FALSE.
+        !
+        ! Get Restart values for albedo and z0, 
+        ! as they modify forcing variables swnet and wind.
+!-------
+        ! albedo 
+        IF (is_root_prc) THEN
+           ALLOCATE(albedo_g(iim_g,jjm_g))
+        ELSE
+           ALLOCATE(albedo_g(0,1))
+        ENDIF
+        !
+        IF (is_root_prc) THEN
+           var_name= 'albedo_vis'
+           CALL restget &
+                &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., albedo_g)
+           IF (ALL(albedo_g(:,:) == val_exp)) THEN
+              Flag=.TRUE.
+           ELSE
+              Flag=.FALSE.
+           ENDIF
+        ENDIF
+        CALL bcast(Flag)
+        IF ( .NOT. Flag ) THEN
+           CALL scatter2D_mpi(albedo_g,albedo_vis)
+           albedo(:,:,1)=albedo_vis(:,:)
+        ELSE
+           albedo_vis(:,:)=albedo(:,:,1)
+        ENDIF
+        !
+        IF (is_root_prc) THEN
+           var_name= 'albedo_nir'
+           CALL restget &
+                &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., albedo_g)
+           IF (ALL(albedo_g(:,:) == val_exp)) THEN
+              Flag=.TRUE.
+           ELSE
+              Flag=.FALSE.
+           ENDIF
+        ENDIF
+        CALL bcast(Flag)
+        IF ( .NOT. Flag ) THEN
+           CALL scatter2D_mpi(albedo_g,albedo_nir)
+           albedo(:,:,2)=albedo_nir(:,:)
+        ELSE
+           albedo_nir(:,:)=albedo(:,:,2)
+        ENDIF
+        !
+        DEALLOCATE(albedo_g)
+        !--
+        ! z0 
+        IF (is_root_prc) THEN
+           ALLOCATE(z0_g(iim_g,jjm_g))
+           var_name= 'z0'
+           CALL restget &
+                &        (rest_id, var_name, iim_g, jjm_g, 1, istp_old, .TRUE., z0_g)
+           IF (ALL(z0_g(:,:) == val_exp)) THEN
+              Flag=.TRUE.
+           ELSE
+              Flag=.FALSE.
+           ENDIF
+        ELSE
+           ALLOCATE(z0_g(0,1))
+        ENDIF
+        CALL bcast(Flag)
+        IF (.NOT. Flag) &
+             CALL scatter2D_mpi(z0_g,z0)
+        DEALLOCATE(z0_g)
+!-------
+        DO ik=1,nbindex
+           i=ilandindex(ik)
+           j=jlandindex(ik)
+           temp_sol_old(i,j) = temp_sol_NEW(i,j)
+           for_swnet(i,j) = (1.- (albedo(i,j,1)+albedo(i,j,2))/2.)*swdown(i,j)
+           for_swdown(i,j) = swdown(i,j)
+           for_sinang(i,j) = sinang(i,j)
+        ENDDO
+!
+!     MM : z0 have been modified then we must lower the wind again
+!-----
+!---- SECHIBA expects wind, temperature and humidity at the same height.
+!---- If this is not the case then we need to correct for that.
+!-----
+        DO ik=1,nbindex 
+           i=ilandindex(ik) 
+           j=jlandindex(ik) 
+           for_u(i,j) = u(i,j) * LOG(zlev_vec(i,j)/z0(i,j)) / & 
+                LOG(zlevuv_vec(i,j)/z0(i,j)) 
+           for_v(i,j) = v(i,j) * LOG(zlev_vec(i,j)/z0(i,j)) / &
+                LOG(zlevuv_vec(i,j)/z0(i,j)) 
+        END DO
+        
+!-----
+!---- PRINT input value after first_CALL for debug
+!-----
+        IF (debug) THEN
+           WRITE(numout,*) ' >>>>>> after first_CALL = ',first_CALL
+           WRITE(numout,*) ' u et v = ',for_u(itest,jtest),for_v(itest,jtest)
+           WRITE(numout,*) ' swnet = ', for_swnet(itest,jtest)
+        ENDIF
+!-------
+        IF (longprint) THEN
+           WRITE(numout,*) "dim2_driver first_CALL outputs"
+           !       Output : Fluxes
+           WRITE(numout,*) "vevapp        ; Total of evaporation = ", &
+             &     (/ ( vevapp(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Sensible heat flux = ", &
+             &     (/ ( fluxsens(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "Latent heat flux = ", &
+             &     (/ ( fluxlat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "coastalflow   ; Diffuse flow of water into the ocean (m^3/dt) = ", &
+             &     (/ ( coastalflow(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "riverflow     ; Largest rivers flowing into the ocean (m^3/dt) = ", &
+             &     (/ ( riverflow(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           !       Surface temperatures and surface properties
+           WRITE(numout,*) "tsol_rad      ; Radiative surface temperature = ", &
+             &     (/ ( tsol_rad(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "temp_sol_new  ; New soil temperature = ", &
+             &     (/ ( temp_sol_NEW(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "qsurf         ; Surface specific humidity = ", &
+             &     (/ ( qsurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "albedoVIS = ", &
+             &     (/ ( albedo(ilandindex(ik), jlandindex(ik), 1),ik=1,nbindex ) /)
+           WRITE(numout,*) "albedoNIR = ", &
+             &     (/ ( albedo(ilandindex(ik), jlandindex(ik), 2),ik=1,nbindex ) /)
+           WRITE(numout,*) "emis          ; Emissivity = ", &
+             &     (/ ( emis(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+           WRITE(numout,*) "z0            ; Surface roughness = ", &
+             &     (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+        ENDIF
+!-------
+        IF (debug) THEN
+          WRITE(numout,*) &
+ &         ' OUT rest : z0, albedoVIS, albedoNIR, emis = ', &
+ &         z0(itest,jtest),albedo(itest,jtest,1), &
+ &                         albedo(itest,jtest,2),emis(itest,jtest)
+          WRITE(numout,*) ' OUT rest : coastal and river flow = ', &
+ &         coastalflow(itest,jtest), riverflow(itest,jtest)
+          WRITE(numout,*) ' OUT rest : tsol_rad, vevapp = ', &
+ &         tsol_rad(itest,jtest), vevapp(itest,jtest)
+          WRITE(numout,*) ' OUT rest : temp_sol_new =', &
+ &         temp_sol_NEW(itest,jtest)
+        ENDIF
+    
+!ANNE/        CALL barrier_para
+!ANNE/        CALL start_timer(timer_global)
+!ANNE/        CALL start_timer(timer_mpi)
+   
+      ENDIF
+!-----
+!---- Calling SECHIBA and doing the number crunching.
+!---- Note that for the first time step SECHIBA is called twice.
+!----
+!---- All H_2O fluxes are now in Kg/m^2s
+!-----
+      IF (longprint) THEN
+         WRITE(numout,*) "dim2_driver ",it_force 
+         WRITE(numout,*) ">> Index of land points =",kindex(1:nbindex)
+         WRITE(numout,*) "Lowest level wind speed North = ", &
+           &     (/ ( for_u(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level wind speed East = ", &
+           &     (/ ( for_v(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "z0            ; Surface roughness = ", &
+           &     (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Height of first layer = ", &
+           &     (/ ( zlev_vec(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level specific humidity = ", &
+           &     (/ ( for_qair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Rain precipitation = ", &
+           &     (/ ( precip_rain(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+         WRITE(numout,*) "Snow precipitation = ", &
+           &     (/ ( precip_snow(ilandindex(ik), jlandindex(ik))*dt,ik=1,nbindex ) /)
+         WRITE(numout,*) "Down-welling long-wave flux = ", &
+           &     (/ ( for_lwdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Net surface short-wave flux = ", &
+           &     (/ ( for_swnet(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Downwelling surface short-wave flux = ", &
+           &     (/ ( for_swdown(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Air temperature in Kelvin = ", &
+           &     (/ ( for_tair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Air potential energy = ", &
+           &     (/ ( for_eair(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "CO2 concentration in the canopy = ", &
+           &     (/ ( for_ccanopy(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Coeficients A from the PBL resolution = ", &
+           &     (/ ( petAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "One for T and another for q = ", &
+           &     (/ ( peqAcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Coeficients B from the PBL resolution = ", &
+           &     (/ ( petBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "One for T and another for q = ", &
+           &     (/ ( peqBcoef(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Cdrag = ", &
+           &     (/ ( cdrag(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Lowest level pressure = ", &
+           &     (/ ( for_psurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Geographical coordinates lon = ", &
+           &     (/ (  lon(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Geographical coordinates lat = ", &
+           &     (/ (  lat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Fraction of continent in the grid = ", &
+           &     (/ ( for_contfrac(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+      ENDIF
+      
+      CALL intersurf_main &
+ &      (istp, iim, jjm, nbindex, kindex, dt, &
+ &       first_CALL, last_CALL, lon, lat, for_contfrac, for_neighbours, for_resolution, date0_rest, &
+!     first level conditions
+ &       zlev_vec, for_u, for_v, &
+ &       for_qair, for_tair, for_eair, for_ccanopy, &
+!     Variables for the implicit coupling
+ &       cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+!     Rain, snow, radiation and surface pressure
+ &       precip_rain, precip_snow, &
+ &       for_lwdown, for_swnet, for_swdown, for_psurf, &
+!     Output : Fluxes
+ &       vevapp, fluxsens, fluxlat, coastalflow, riverflow,  &
+!     Surface temperatures and surface properties
+ &       tsol_rad, temp_sol_NEW, qsurf, albedo, emis, z0, &
+!       VOC : radiation
+ &       for_sinang,soil_mc,litter_mc)
+
+!-------
+      IF (longprint) THEN
+         WRITE(numout,*) "dim2_driver outputs"
+         !       Output : Fluxes
+         WRITE(numout,*) "vevapp        ; Total of evaporation = ", &
+           &     (/ ( vevapp(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Sensible heat flux = ", &
+           &     (/ ( fluxsens(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "Latent heat flux = ", &
+           &     (/ ( fluxlat(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "coastalflow   ; Diffuse flow of water into the ocean (m^3/dt) = ", &
+           &     (/ ( coastalflow(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "riverflow     ; Largest rivers flowing into the ocean (m^3/dt) = ", &
+           &     (/ ( riverflow(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         !       Surface temperatures and surface properties
+         WRITE(numout,*) "tsol_rad      ; Radiative surface temperature = ", &
+           &     (/ ( tsol_rad(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "temp_sol_new  ; New soil temperature = ", &
+           &     (/ ( temp_sol_NEW(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "qsurf         ; Surface specific humidity = ", &
+           &     (/ ( qsurf(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "albedoVIS = ", &
+           &     (/ ( albedo(ilandindex(ik), jlandindex(ik), 1),ik=1,nbindex ) /)
+         WRITE(numout,*) "albedoNIR = ", &
+           &     (/ ( albedo(ilandindex(ik), jlandindex(ik), 2),ik=1,nbindex ) /)
+         WRITE(numout,*) "emis          ; Emissivity = ", &
+           &     (/ ( emis(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+         WRITE(numout,*) "z0            ; Surface roughness = ", &
+           &     (/ ( z0(ilandindex(ik), jlandindex(ik)),ik=1,nbindex ) /)
+      ENDIF
+!-----
+      dtdt(:,:) = zero
+      DO ik=1,nbindex
+         i=ilandindex(ik)
+         j=jlandindex(ik)
+         dtdt(i,j) = ABS(temp_sol_NEW(i,j)-temp_sol_old(i,j))/dt
+      ENDDO
+!-----
+!---- Test if the point with the largest change has more than 5K per dt
+!-----
+      IF (MAXVAL(dtdt(:,:)) > 5./dt) THEN
+        ml = MAXLOC(dtdt)
+        CALL ju2ymds(julian, yy, mm, dd, ss)
+        WRITE(numout,"('ATT :',I5,' big temperature jumps on ', &
+ &       I4,'-',I2.2,'-',I2.2,':',F8.4)") &
+ &       COUNT(dtdt(:,:) > 5./dt),yy,mm,dd,ss/3600.
+        WRITE(numout,*) &
+ &       'Maximum change of surface temperature located at :', &
+ &       lon(ml(1),ml(2)),lat(ml(1),ml(2))
+        WRITE(numout,*) 'Coordinates in grid space: ',ml(1),ml(2)
+        WRITE(numout,*) 'Change from ',temp_sol_old(ml(1),ml(2)), &
+ &       ' to ',temp_sol_new(ml(1),ml(2)),&
+ &       'with sw_in = ',for_swnet(ml(1),ml(2))
+        old_tair = &
+ &        (old_eair(ml(1),ml(2))-cte_grav*old_zlev(ml(1),ml(2)))/cp_air
+        WRITE(numout,*) 'Air temperature change from ',old_tair, &
+ &       ' to ',for_tair(ml(1),ml(2))
+        WRITE(numout,*) 'Max of dtdt : ',dtdt(ml(1),ml(2)),' with dt = ',dt
+      ENDIF
+!-----
+      temp_sol_old(:,:) = temp_sol_NEW(:,:)
+!-----
+!---- PRINT output value for debug
+!-----
+      IF (debug) THEN
+        WRITE(numout,*) ' OUT : z0, albedoVIS, albedoNIR, emis = ', &
+ &       z0(itest,jtest),albedo(itest,jtest,1), &
+ &                       albedo(itest,jtest,2),emis(itest,jtest)
+        WRITE(numout,*) ' OUT : coastal and river flow = ',&
+ &       coastalflow(itest,jtest), riverflow(itest,jtest)
+        WRITE(numout,*) ' OUT : tsol_rad, vevapp = ', &
+ &       tsol_rad(itest,jtest), vevapp(itest,jtest)
+        WRITE(numout,*) ' OUT : temp_sol_new =', temp_sol_NEW(itest,jtest)
+      ENDIF
+!-----
+!---- Give some variables to the output package
+!---- for saving on the history tape
+!-----
+      IF (debug) WRITE(numout,*) 'history written for ', istp
+!-----
+      istp_old = istp
+      istp = istp+1
+!-----
+      old_zlev(:,:) = zlev_vec(:,:)
+      old_qair(:,:) = for_qair(:,:)
+      old_eair(:,:) = for_eair(:,:)
+!-----
+      is = is + 1
+    ENDDO
+    split_start = 1
+!!$    it_force =it_force+1
+    IF (it==itau_fin-1) THEN
+     
+     CALL Write_Load_Balance(REAL(Get_cpu_time(timer_mpi),r_std))
+
+    ENDIF
+    it = it + 1
+!!! CALL histsync
+  ENDDO
+!-
+! Archive in restart file the prognostic variables
+!-
+  IF (debug) WRITE(numout,*) 'Write the restart for the driver', istp_old
+!-
+  var_name = 'fluxsens'
+  IF (is_root_prc) THEN
+     ALLOCATE(fluxsens_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(fluxsens_g(0,1))
+  ENDIF
+  CALL gather2D_mpi(fluxsens , fluxsens_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, fluxsens_g)
+  DEALLOCATE(fluxsens_g)
+  
+  var_name = 'vevapp'
+  IF (is_root_prc) THEN
+     ALLOCATE(vevapp_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(vevapp_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( vevapp, vevapp_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, vevapp_g)
+  DEALLOCATE(vevapp_g)
+  
+  var_name = 'zlev_old'
+  IF (is_root_prc) THEN
+     ALLOCATE(old_zlev_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(old_zlev_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( old_zlev, old_zlev_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, old_zlev_g)
+  DEALLOCATE(old_zlev_g)
+  
+  var_name = 'qair_old'
+  IF (is_root_prc) THEN
+     ALLOCATE(old_qair_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(old_qair_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( old_qair, old_qair_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, old_qair_g)
+  DEALLOCATE(old_qair_g)
+  
+  var_name = 'eair_old'
+  IF (is_root_prc) THEN
+     ALLOCATE(old_eair_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(old_eair_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( old_eair, old_eair_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, old_eair_g)
+  DEALLOCATE(old_eair_g)
+  
+  var_name = 'rau_old'
+  IF (is_root_prc) THEN
+     ALLOCATE(for_rau_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(for_rau_g(0,1))
+  ENDIF
+  CALL gather2D_mpi( for_rau, for_rau_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, for_rau_g)
+  DEALLOCATE(for_rau_g)
+  
+  IF (is_root_prc) THEN
+     ALLOCATE(albedo_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(albedo_g(0,1))
+  ENDIF
+  var_name= 'albedo_vis'
+  albedo_vis(:,:)=albedo(:,:,1)
+  CALL gather2D_mpi(albedo_vis,albedo_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, albedo_g)  
+  !
+  var_name= 'albedo_nir'
+  albedo_nir(:,:)=albedo(:,:,2)
+  CALL gather2D_mpi(albedo_nir,albedo_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, albedo_g)  
+  DEALLOCATE(albedo_g)
+
+  IF (is_root_prc) THEN
+     ALLOCATE(z0_g(iim_g,jjm_g))
+  ELSE
+     ALLOCATE(z0_g(0,1))
+  ENDIF
+  var_name= 'z0'
+  CALL gather2D_mpi(z0,z0_g)
+  IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, z0_g)  
+  DEALLOCATE(z0_g)
+
+  if (.NOT. is_watchout) THEN
+     var_name = 'petAcoef'
+     IF (is_root_prc) THEN
+        ALLOCATE(petAcoef_g(iim_g,jjm_g))
+     ELSE
+        ALLOCATE(petAcoef_g(0,1))
+     ENDIF
+     CALL gather2D_mpi( petAcoef, petAcoef_g)
+     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, petAcoef_g)
+     DEALLOCATE(petAcoef_g)
+  
+     var_name = 'petBcoef'
+     IF (is_root_prc) THEN
+        ALLOCATE(petBcoef_g(iim_g,jjm_g))
+     ELSE
+        ALLOCATE(petBcoef_g(0,1))
+     ENDIF
+     CALL gather2D_mpi( petBcoef, petBcoef_g)
+     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, petBcoef_g)
+     DEALLOCATE(petBcoef_g)
+  
+     var_name = 'peqAcoef'
+     IF (is_root_prc) THEN
+        ALLOCATE(peqAcoef_g(iim_g,jjm_g))
+     ELSE
+        ALLOCATE(peqAcoef_g(0,1))
+     ENDIF
+     CALL gather2D_mpi( peqAcoef, peqAcoef_g)
+     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, peqAcoef_g)
+     DEALLOCATE(peqAcoef_g)
+  
+     var_name = 'peqBcoef'
+     IF (is_root_prc) THEN
+        ALLOCATE(peqBcoef_g(iim_g,jjm_g))
+     ELSE
+        ALLOCATE(peqBcoef_g(0,1))
+     ENDIF
+     CALL gather2D_mpi( peqBcoef, peqBcoef_g)
+     IF(is_root_prc) CALL restput (rest_id, var_name, iim_g, jjm_g, 1, istp_old, peqBcoef_g)
+     DEALLOCATE(peqBcoef_g)
+  ENDIF
+!-
+  IF (debug) WRITE(numout,*) 'Restart for the driver written'
+!=====================================================================
+!- 5.0 Closing all files
+!=====================================================================
+  CALL flinclo(force_id)
+  IF ( debug )  WRITE(numout,*) 'FLIN CLOSED'
+  CALL histclo
+  IF ( debug )   WRITE(numout,*) 'HIST CLOSED'      
+    
+  IF(is_root_prc) THEN
+     CALL restclo
+     IF ( debug )  WRITE(numout,*) 'REST CLOSED'
+     CALL getin_dump
+     IF ( debug )  WRITE(numout,*) 'GETIN CLOSED'
+  ENDIF
+
+  
+
+  WRITE(numout,*) '-------------------------------------------'
+  WRITE(numout,*) '------> CPU Time Global ',Get_cpu_Time(timer_global)
+  WRITE(numout,*) '------> CPU Time without mpi ',Get_cpu_Time(timer_mpi)
+  WRITE(numout,*) '------> Real Time Global ',Get_real_Time(timer_global)
+  WRITE(numout,*) '------> real Time without mpi ',Get_real_Time(timer_mpi)
+  WRITE(numout,*) '-------------------------------------------'
+  CALL Finalize_mpi
+!---------------
+!  CALL Write_Load_Balance(Get_cpu_time(timer_mpi))
+!  CALL finalize_para(timer_global,timer_mpi)
+
+!-
+  WRITE(numout,*) 'END of dim2_driver'
+!---------------
+END PROGRAM driver
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/forcesoil.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/forcesoil.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/forcesoil.f90	(revision 5166)
@@ -0,0 +1,1699 @@
+! =================================================================================================================================
+! PROGRAM       : forcesoil
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This subroutine runs the soilcarbon submodel using specific initial conditions 
+!! and driving variables in order to obtain soil carbon stocks closed to the steady-state values 
+!! quicker than when using the ''full'' ORCHIDEE.  
+!!	
+!!\n DESCRIPTION: None
+!! This subroutine computes the soil carbon stocks by calling the soilcarbon routine at each time step. \n
+!! The aim is to obtain soil carbon stocks closed to the steady-state values and ultimately to create  
+!! an updated stomate restart file for the stomate component. The state variables of the subsystem are the clay content 
+!! (fixed value) and the soil carbon stocks. Initial conditions for the state variables are read in an  
+!! input stomate restart file. Driving variables are Soil carbon input, Water and Temperature stresses on 
+!! Organic Matter decomposition. Driving variables are read from a specific forcing file produced by a former run of ORCHIDEE
+!! (SECHIBA+STOMATE). \n 
+!! The FORCESOIL program first consists in reading a set of input files, allocating variables and 
+!! preparing output stomate restart file. \n                                                             
+!! Then, a loop over time is performed in which the soilcarbon routine is called at each time step. \n
+!! Last, final values of the soil carbon stocks are written into the output stomate restart file. \n
+!! No flag is associated with the use of the FORCESOIL program. \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) : None    
+!!
+!! FLOWCHART    : None
+!!
+!! SVN		:
+!! $HeadURL: $ 
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ =================================================================================================================================
+
+PROGRAM forcesoil
+ 
+  USE netcdf
+  !-
+  USE defprec
+  USE constantes
+  USE constantes_soil
+  USE constantes_mtc
+  USE pft_parameters 
+  USE stomate_data
+  USE ioipsl_para
+  USE mod_orchidee_para
+  USE stomate_soilcarbon
+
+  !-
+  IMPLICIT NONE
+  !-
+  CHARACTER(LEN=80)                          :: sto_restname_in,sto_restname_out
+  INTEGER(i_std)                             :: iim,jjm                 !! Indices (unitless)
+
+  INTEGER(i_std),PARAMETER                   :: llm = 1                 !! Vertical Layers (requested by restini routine) (unitless)
+  INTEGER(i_std)                             :: kjpindex                !! Domain size (unitless)
+
+  INTEGER(i_std)                             :: itau_dep,itau_len       !! Time step read in the restart file (?) 
+                                                                        !! and number of time steps of the simulation (unitless) 
+  CHARACTER(LEN=30)                          :: time_str                !! Length of the simulation (year)
+  REAL(r_std)                                :: dt_files                !! time step between two successive itaus (?) 
+                                                                        !! (requested by restini routine) (seconds)
+  REAL(r_std)                                :: date0                   !! Time at which itau = 0 (requested by restini routine) (?)
+  INTEGER(i_std)                             :: rest_id_sto             !! ID of the input restart file (unitless)
+  CHARACTER(LEN=20), SAVE                    :: thecalendar = 'noleap'  !! Type of calendar defined in the input restart file 
+                                                                        !! (unitless)
+  !-
+  CHARACTER(LEN=100)                         :: Cforcing_name           !! Name of the forcing file (unitless)
+  INTEGER                                    :: Cforcing_id             !! ID of the forcing file (unitless)
+  INTEGER                                    :: v_id                    !! ID of the variable 'Index' stored in the forcing file 
+                                                                        !! (unitless)
+  REAL(r_std)                                :: dt_forcesoil            !! Time step at which soilcarbon routine is called (days) 
+  INTEGER                                    :: nparan                  !! Number of values stored per year in the forcing file 
+                                                                        !! (unitless)
+  INTEGER                                    :: nbyear
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE    :: indices                 !! Grid Point Index used per processor (unitless)
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE    :: indices_g               !! Grid Point Index for all processor (unitless)
+  REAL(r_std),DIMENSION(:),ALLOCATABLE       :: x_indices_g             !! Grid Point Index for all processor (unitless)
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE     :: lon, lat                !! Longitude and Latitude of each grid point defined 
+                                                                        !! in lat/lon (2D) (degrees)
+  REAL(r_std),DIMENSION(llm)                 :: lev                     !! Number of level (requested by restini routine) (unitless)
+
+
+  INTEGER                                    :: i,k,j,l,m,iatt,iv,iyear !! counters (unitless)
+  REAL(r_std)                                :: soil_depth              !! Soil depth (m)
+  CHARACTER(LEN=80)                          :: var_name
+  CHARACTER(LEN=8000)                        :: taboo_vars              !! string used for storing the name of the variables 
+                                                                        !! of the stomate restart file that are not automatically 
+                                                                        !! duplicated from input to output restart file (unitless)
+  REAL(r_std),DIMENSION(1)                   :: xtmp                    !! scalar read/written in restget/restput routines (unitless)
+  INTEGER(i_std),PARAMETER                   :: nbvarmax=800            !! maximum # of variables assumed in the stomate restart file 
+                                                                        !! (unitless)
+  INTEGER(i_std)                             :: nbvar                   !! # of variables effectively present 
+                                                                        !! in the stomate restart file (unitless)
+  CHARACTER(LEN=50),DIMENSION(nbvarmax)      :: varnames                !! list of the names of the variables stored 
+                                                                        !! in the stomate restart file (unitless)
+  INTEGER(i_std)                             :: varnbdim                !! # of dimensions of a given variable 
+                                                                        !! of the stomate restart file
+  INTEGER(i_std),PARAMETER                   :: varnbdim_max=20         !! maximal # of dimensions assumed for any variable 
+                                                                        !! of the stomate restart file 
+  INTEGER,DIMENSION(varnbdim_max)            :: vardims                 !! length of each dimension of a given variable 
+                                                                        !! of the stomate restart file
+  LOGICAL                                    :: l1d                     !! boolean : TRUE if all dimensions of a given variable 
+                                                                        !! of the stomate restart file are of length 1 (ie scalar) 
+                                                                        !! (unitless)
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE     :: var_3d                  !! matrix read/written in restget/restput routines (unitless)
+  REAL(r_std)                                :: x_tmp                   !! temporary variable used to store return value 
+                                                                        !! from nf90_get_att (unitless)
+  CHARACTER(LEN=10)  :: part_str                                        !! string suffix indicating the index of a PFT 
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)  :: soil_ph_g               !! Soil pH (0-14, pH unit)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)  :: clay_g                  !! clay fraction (nbpglo) (unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)  :: bulk_dens_g             !! soil bulk density (nbpglo) (g cm-3)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:):: soiltile_g              !! Fraction of each soil tile (0-1, unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:):: veget_max_g             !! PFT "Maximal" coverage fraction of a PFT defined in 
+                                                                        !! the input vegetation map 
+                                                                        !! @tex $(m^2 m^{-2})$ @endtex, parallel computing  
+  REAL(r_std),DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: soilcarbon_input_g  !! soil carbon input (nbpglob,npool,nvm,time) 
+                                                                        !! (\f$gC m^{-2} dt_forcesoil^{-1}\f$) 
+
+  REAL(r_std),DIMENSION(:,:,:,:),ALLOCATABLE   :: control_temp_soil_g     !! Temperature control (nbp_glo,nbdl,time) on OM decomposition 
+                                                                        !! (unitless)
+  REAL(r_std),DIMENSION(:,:,:,:),ALLOCATABLE   :: control_moist_soil_g    !! Moisture control (nbp_glo,nbdl,time) on OM decomposition 
+                                                                        !! ?? Should be defined per PFT as well (unitless)
+  REAL(r_std),DIMENSION (:,:,:), ALLOCATABLE   :: moist_soil_g          !! soil moisture content \f($m^3 \times m^3$)\f
+  REAL(r_std),DIMENSION (:,:,:,:), ALLOCATABLE :: soil_mc_g             !! soil moisture content per soil type \f($m^3 \times m^3$)\f
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: floodout_g             !! flux out of floodplains
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: wat_flux0_g          !! Water flux in the first soil layers exported for soil C calculations
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: wat_flux_g          !! Water flux in the soil layers exported for soil C calculations
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::runoff_per_soil_g     !! Runoff per soil type [mm]
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::drainage_per_soil_g   !! Drainage per soil type [mm]
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_topsoil_g     !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                        !! floodplains and from irrigation
+                                                                        !! @tex $(gC m^{-2} day{-1})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_subsoil_g     !! DOC inputs to bottom of the soil column, from returnflow
+                                                                        !! in swamps and lakes
+                                                                        !! @tex $(gC m^{-2} day{-1})$ @endtex
+  REAL(r_std),DIMENSION(:,:,:,:),ALLOCATABLE :: carbon_g                !! Soil carbon stocks (nbp_glo,ncarb,nvm) (\f$gC m^{-2}\f$)
+  REAL(r_std), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: DOC_g             !! Dissolved Organic Carbon in soil
+                                                                        !! The unit is given by m^3 of
+                                                                        !! ground @tex $(gC m{-2}) $ @endtex
+  REAL(r_std), ALLOCATABLE ::litter_above_g(:,:,:,:,:)                  !! Metabolic and structural litter, below ground
+                                                                        !! The unit is given by m^2 of
+                                                                        !! ground @tex $(gCi m{-2})$ @endtex
+  REAL(r_std), ALLOCATABLE ::litter_below_g(:,:,:,:,:,:)                !! Metabolic and structural litter, below ground
+                                                                        !! The unit is given by m^2 of
+                                                                        !! ground @tex $(gC m^{-2})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: lignin_struc_above_g !! Ratio Lignine/Carbon in structural litter for above
+                                                                        !! ground compartments (unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: lignin_struc_below_g   !! Ratio Lignine/Carbon in structural litter for below
+                                                                        !! ground compartments (unitless)
+  REAL(r_std),ALLOCATABLE :: clay(:)                                    !! clay fraction (nbp_loc) (unitless)
+  REAL(r_std),ALLOCATABLE :: soil_ph(:)                                 !! Soil pH (0-14 pH units)
+  REAL(r_std),ALLOCATABLE :: bulk_dens(:)                               !! soil bulk density (nbpglo) (g cm-3)
+  REAL(r_std),ALLOCATABLE :: soilcarbon_input(:,:,:,:,:,:)              !! soil carbon input (nbp_loc,npool,nvm,time) 
+                                                                        !! water @tex $(gC m{-2} of water)$ @endte
+  REAL(r_std),ALLOCATABLE :: control_temp_soil(:,:,:,:)                   !! Temperature control (nbp_loc,nbdl,time) on OM decomposition 
+                                                                        !! (unitless)
+  REAL(r_std),ALLOCATABLE :: control_moist_soil(:,:,:,:)                  !! Moisture control (nbp_loc,nbdl,time) on OM decomposition 
+                                                                        !! ?? Should be defined per PFT as well (unitless)
+
+  REAL(r_std),ALLOCATABLE :: carbon(:,:,:,:)                            !! Soil carbon stocks (nbp_loc,ncarb,nvm) (\f$gC m^{-2}\f$)
+  REAL(r_std), ALLOCATABLE ::litter_above(:,:,:,:,:)                    !! Metabolic and structural litter, below ground
+                                                                        !! The unit is given by m^2 of
+                                                                        !! ground @tex $(gCi m{-2})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: lignin_struc_above   !! Ratio Lignine/Carbon in structural litter for above
+                                                                        !! ground compartments (unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: lignin_struc_below   !! Ratio Lignine/Carbon in structural litter for below
+                                                                        !! ground compartments (unitless)
+  REAL(r_std),ALLOCATABLE :: veget_max(:,:)                             !! PFT "Maximal" coverage fraction of a PFT defined in 
+                                                                        !! the input vegetation map 
+                                                                        !! @tex $(m^2 m^{-2})$ @endtex  
+  REAL(r_std), ALLOCATABLE ::litter_below(:,:,:,:,:,:)                  !! Metabolic and structural litter, below ground
+                                                                        !! The unit is given by m^2 of
+                                                                        !! ground @tex $(gC m^{-2})$ @endtex
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE     :: resp_hetero_soil        !! Heterotrophic respiration (\f$gC m^{-2} dt_forcesoil^{-1}\f$) 
+                                                                        !! (requested by soilcarbon routine but not used here) 
+  REAL(r_std), DIMENSION(:,:), ALLOCATABLE   :: soilhum                 !! Daily soil humidity of each soil layer 
+                                                                        !! (unitless) 
+  REAL(r_std),DIMENSION (:,:,:), ALLOCATABLE   :: moist_soil            !! soil moisture content \f($m^3 \times m^3$)\f
+  REAL(r_std),DIMENSION (:,:,:,:), ALLOCATABLE :: soil_mc               !! soil moisture content \f($m^3 \times m^3$)\f
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: floodout               !! flux out of floodplains
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: wat_flux0            !! Water flux in the first soil layers exported for soil C calculations
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: wat_flux            !! Water flux in the soil layers exported for soil C calculations
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::runoff_per_soil       !! Runoff per soil type [mm]
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::drainage_per_soil     !! Drainage per soil type [mm]
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_topsoil       !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                        !! floodplains and from irrigation
+                                                                        !! @tex $(gC m^{-2} day{-1})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_subsoil      !! DOC inputs to bottom of the soil column, from returnflow
+                                                                        !! in swamps and lakes
+                                                                        !! @tex $(gC m^{-2} day{-1})$ @endtex
+  REAL(r_std),DIMENSION (:,:), ALLOCATABLE    :: soiltile               !! Fraction of each soil tile (0-1, unitless)
+  REAL(r_std), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: DOC               !! Dissolved Organic Carbon in soil
+                                                                        !! The unit is given by m^3 of
+                                                                        !! ground @tex $(gC m{-2}) $ @endtex
+  REAL(r_std), DIMENSION(:,:,:,:), ALLOCATABLE :: DOC_EXP               !! Dissolved Organic Carbon in soil
+                                                                        !! The unit is given by m^3 of
+                                                                        !! water @tex $(gCm {-3}) $ @endtex
+
+  INTEGER(i_std)                             :: ier,iret                !! Used for hangling errors 
+
+  CHARACTER(LEN=30) :: temp_name 
+  LOGICAL :: debug                                                      !! boolean used for printing messages
+  LOGICAL :: l_error                                                    !! boolean for memory allocation
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: matrixA               !! Carbon fluxes matrix 
+
+!_ =================================================================================================================================
+ 
+  CALL Init_orchidee_para
+  CALL init_timer
+
+!-
+! Configure the number of PFTS 
+!-
+  
+  ! 1. Read the number of PFTs
+  !
+  !Config Key   = NVM
+  !Config Desc  = number of PFTs  
+  !Config If    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = 13
+  !Config Help  = The number of vegetation types define by the user
+  !Config Units = [-]
+  CALL getin_p('NVM',nvm)
+
+  ! 2. Allocation
+  l_error = .FALSE.
+  ALLOCATE(pft_to_mtc(nvm),stat=ier)
+  l_error = l_error .OR. (ier .NE. 0)
+  IF (l_error) THEN
+     STOP 'pft_to_mtc (forcesoil only) : error in memory allocation'
+  ENDIF
+   ALLOCATE(PFT_name(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+     STOP 'PFT_name (forcesoil only) : error in memory allocation'
+   END IF
+  ! 3. Initialisation of the correspondance table
+  pft_to_mtc(:) = undef_int
+  
+  ! 4.Reading of the conrrespondance table in the .def file
+  !
+  !Config Key   = PFT_TO_MTC
+  !Config Desc  = correspondance array linking a PFT to MTC
+  !Config if    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13
+  !Config Help  =
+  !Config Units = [-]
+  CALL getin_p('PFT_TO_MTC',pft_to_mtc)
+
+  ! 4.1 if nothing is found, we use the standard configuration
+  IF(nvm == nvmc ) THEN
+     IF(pft_to_mtc(1) == undef_int) THEN
+        WRITE(numout,*) 'Note to the user : we will use ORCHIDEE to its standard configuration'
+        pft_to_mtc(:) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 /)
+     ENDIF
+  ELSE   
+     IF(pft_to_mtc(1) == undef_int) THEN
+        WRITE(numout,*)' The array PFT_TO_MTC is empty : we stop'
+     ENDIF
+  ENDIF
+  
+  ! 4.2 What happened if pft_to_mtc(j) > nvmc (if the mtc doesn't exist)?
+  DO i = 1, nvm
+     IF(pft_to_mtc(i) > nvmc) THEN
+        WRITE(numout,*) "the MTC you chose doesn't exist"
+        STOP 'we stop reading pft_to_mtc'
+     ENDIF
+  ENDDO
+  
+  ! 4.3 Check if pft_to_mtc(1) = 1 
+  IF(pft_to_mtc(1) /= 1) THEN
+     WRITE(numout,*) 'the first pft has to be the bare soil'
+     STOP 'we stop reading next values of pft_to_mtc'
+  ELSE
+     DO i = 2,nvm
+        IF(pft_to_mtc(i) == 1) THEN
+           WRITE(numout,*) 'only pft_to_mtc(1) has to be the bare soil'
+           STOP 'we stop reading pft_to_mtc'
+        ENDIF
+     ENDDO
+  ENDIF
+
+
+ PFT_name(:) = MTC_name(pft_to_mtc(:))
+  ALLOCATE(pref_soil_veg(nvm),stat=ier)
+  l_error = l_error .OR. (ier /= 0)
+  IF (l_error) THEN
+     WRITE(numout,*) ' Memory allocation error for pref_soil_veg. We stop. We need nvm words = ',nvm
+     STOP 'pft_parameters_alloc'
+  END IF
+ pref_soil_veg(:) = pref_soil_veg_mtc(pft_to_mtc(:))
+
+  !Config Key   = PFT_NAME
+  !Config Desc  = Name of a PFT
+  !Config if    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = bare ground, tropical broad-leaved evergreen, tropical
+  !broad-leaved raingreen, 
+  !Config         temperate needleleaf evergreen, temperate broad-leaved
+  !evergreen temperate broad-leaved summergreen,
+  !Config         boreal needleleaf evergreen, boreal broad-leaved
+  !summergreen, boreal needleleaf summergreen,
+  !Config         C3 grass, C4 grass, C3 agriculture, C4 agriculture    
+  !Config Help  = the user can name the new PFTs he/she introducing for new
+  !species
+  !Config Units = [-]
+  CALL getin_p('PFT_NAME',PFT_name)
+
+      DO i = 1,nvm ! Loop over # PFTs
+         !
+         WRITE(numout,*) 'the PFT',i, 'called  ', PFT_name(i),'corresponds to the MTC : ',MTC_name(pft_to_mtc(i))
+         !
+      ENDDO ! Loop over # PFTs 
+
+  
+  ! 5. Allocate and initialize natural ans is_c4
+  
+  ! 5.1 Memory allocation
+  l_error = .FALSE.
+  ALLOCATE(natural(nvm),stat=ier)
+  l_error = l_error .OR. (ier .NE. 0)
+  ALLOCATE(is_c4(nvm),stat=ier)
+
+
+
+  IF (l_error) THEN
+     STOP 'natural or is_c4 (forcesoil only) : error in memory allocation'
+  ENDIF
+
+  ! 5.2 Initialisation
+  DO i = 1, nvm
+     natural(i) = natural_mtc(pft_to_mtc(i))
+     is_c4(i) = is_c4_mtc(pft_to_mtc(i))
+  ENDDO
+
+!-
+!-
+! set debug to have more information
+!-
+  !Config Key   = DEBUG_INFO
+  !Config Desc  = Flag for debug information
+  !Config If    = 
+  !Config Def   = n
+  !Config Help  = This option allows to switch on the output of debug
+  !Config         information without recompiling the code.
+  !Config Units = [FLAG]
+!-
+  debug = .FALSE.
+  CALL getin_p('DEBUG_INFO',debug)
+  !!- 
+  !! 1. Initialisation stage
+  !! Reading a set of input files, allocating variables and preparing output restart file.     
+  !!-
+  ! Define restart file name
+  ! for reading initial conditions (sto_restname_in var) and for writting final conditions (sto_restname_out var). 
+  ! User values are used if present in the .def file.
+  ! If not present, default values (stomate_start.nc and stomate_rest_out.c) are used.
+  !-
+  IF (is_root_prc) THEN
+     sto_restname_in = 'stomate_start.nc'
+     CALL getin ('STOMATE_RESTART_FILEIN',sto_restname_in)
+     WRITE(numout,*) 'STOMATE INPUT RESTART_FILE: ',TRIM(sto_restname_in)
+     sto_restname_out = 'stomate_rest_out.nc'
+     CALL getin ('STOMATE_RESTART_FILEOUT',sto_restname_out)
+     WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out)
+     !-
+     ! Open the input file and Get some Dimension and Attributes ID's 
+     !-
+     iret = NF90_OPEN (sto_restname_in, NF90_NOWRITE, rest_id_sto)
+     iret = NF90_INQUIRE_DIMENSION (rest_id_sto,1,len=iim_g)
+     iret = NF90_INQUIRE_DIMENSION (rest_id_sto,2,len=jjm_g)
+     iret = NF90_INQ_VARID (rest_id_sto, "time", iv)
+     iret = NF90_GET_ATT (rest_id_sto, iv, 'calendar',thecalendar)
+     iret = NF90_CLOSE (rest_id_sto)
+     i=INDEX(thecalendar,ACHAR(0))
+     IF ( i > 0 ) THEN
+        thecalendar(i:20)=' '
+     ENDIF
+     !-
+     ! Allocate longitudes and latitudes
+     !-
+     ALLOCATE (lon(iim_g,jjm_g))
+     ALLOCATE (lat(iim_g,jjm_g))
+     lon(:,:) = zero
+     lat(:,:) = zero
+     lev(1)   = zero
+     !-
+     CALL restini &
+          & (sto_restname_in, iim_g, jjm_g, lon, lat, llm, lev, &
+          &  sto_restname_out, itau_dep, date0, dt_files, rest_id_sto)
+  ENDIF
+
+  CALL bcast(date0)
+  CALL bcast(thecalendar)
+  WRITE(numout,*) "calendar = ",thecalendar
+  !-
+  ! calendar
+  !-
+  CALL ioconf_calendar (thecalendar)
+  CALL ioget_calendar  (one_year,one_day)
+  CALL ioconf_startdate(date0)
+  !
+  !! For master process only
+  !
+  IF (is_root_prc) THEN
+     !-
+     ! define forcing file's name (Cforcing_name var)
+     ! User value is used if present in the .def file
+     ! If not, default (NONE) is used
+     !-
+     Cforcing_name = 'NONE'
+     CALL getin ('STOMATE_CFORCING_NAME',Cforcing_name)
+     !-
+     ! Open FORCESOIL's forcing file to read some basic info (dimensions, variable ID's)
+     ! and allocate variables.
+     !-
+     iret = NF90_OPEN (TRIM(Cforcing_name),NF90_NOWRITE,Cforcing_id)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'forcesoil', &
+             &        'Could not open file : ', &
+             &          Cforcing_name,'(Do you have forget it ?)')
+     ENDIF
+     !-
+     ! Total Domain size is stored in nbp_glo variable
+     !-
+     ier = NF90_GET_ATT (Cforcing_id,NF90_GLOBAL,'kjpindex',x_tmp)
+     nbp_glo = NINT(x_tmp)
+     !-
+     ! Number of values stored per year in the forcing file is stored in nparan var.
+     !-
+     ier = NF90_GET_ATT (Cforcing_id,NF90_GLOBAL,'nparan',x_tmp)
+     nparan = NINT(x_tmp)
+     ier = NF90_GET_ATT (Cforcing_id,NF90_GLOBAL,'nbyear',x_tmp)
+     nbyear = NINT(x_tmp)
+     !-
+     ALLOCATE (indices_g(nbp_glo))
+     ALLOCATE (clay_g(nbp_glo))
+     ALLOCATE (soil_ph_g(nbp_glo))
+     ALLOCATE (bulk_dens_g(nbp_glo))
+     ALLOCATE (soiltile_g(nbp_glo,nstm))
+     ALLOCATE (veget_max_g(nbp_glo,nvm))
+     !-
+     ALLOCATE (x_indices_g(nbp_glo),stat=ier)
+     ier = NF90_INQ_VARID (Cforcing_id,'index',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,x_indices_g)
+     indices_g(:) = NINT(x_indices_g(:))
+     WRITE(numout,*) mpi_rank,"indices globaux : ",indices_g
+     DEALLOCATE (x_indices_g)
+     !-
+     ier = NF90_INQ_VARID (Cforcing_id,'clay',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,clay_g)
+     ier = NF90_INQ_VARID (Cforcing_id,'soil_ph',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,soil_ph_g)
+     ier = NF90_INQ_VARID (Cforcing_id,'bulk_dens',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,bulk_dens_g)
+     ier = NF90_INQ_VARID (Cforcing_id,'soiltile',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,soiltile_g)
+     ier = NF90_INQ_VARID (Cforcing_id,'veget_max',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,veget_max_g)
+     !-
+     ! time step of forcesoil program (in days)
+     !-
+     dt_forcesoil = one_year / FLOAT(nparan)
+     WRITE(numout,*) 'time step (d): ',dt_forcesoil
+     WRITE(numout,*) 'nparan: ',nparan
+     WRITE(numout,*) 'nbyear: ',nbyear    
+     !-
+     ! read and write the variables in the output restart file we do not modify within the Forcesoil program
+     ! ie all variables stored in the input restart file except those stored in taboo_vars
+     !-
+     taboo_vars ='$lon$ $lat$ $lev$ $nav_lon$ $nav_lat$ $nav_lev$ $time$ $time_steps$ '// &
+          &             '$day_counter$ $dt_days$ $date$ '
+     !-
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z01_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z02_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z03_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z04_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z05_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z06_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z07_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z08_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z09_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z10_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,nvm
+        WRITE(part_str,'(I2)') m
+        IF (m < 10) part_str(1:1) = '0'
+        temp_name = '$carbon_z11_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z1_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z2_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z3_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z4_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z5_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z6_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z7_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z8_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z9_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z10_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$freedoc_z11_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z1_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z2_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z3_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z4_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z5_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z6_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z7_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z8_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z9_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z10_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     DO m = 1,npool
+        WRITE(part_str,'(I1)') m
+        temp_name = '$adsdoc_z11_'//part_str(1:LEN_TRIM(part_str))//'$'
+        taboo_vars = TRIM(taboo_vars)//' '//TRIM(temp_name)
+     ENDDO
+
+     !-
+     CALL ioget_vname(rest_id_sto, nbvar, varnames)
+     !-
+     ! read and write some special variables (1D or variables that we need)
+     !-
+     var_name = 'day_counter'
+     CALL restget (rest_id_sto, var_name, 1, 1, 1, itau_dep, .TRUE., xtmp)
+     CALL restput (rest_id_sto, var_name, 1, 1, 1, itau_dep, xtmp)
+     !-
+     var_name = 'dt_days'
+     CALL restget (rest_id_sto, var_name, 1, 1, 1, itau_dep, .TRUE., xtmp)
+     CALL restput (rest_id_sto, var_name, 1, 1, 1, itau_dep, xtmp)
+     !-
+     var_name = 'date'
+     CALL restget (rest_id_sto, var_name, 1, 1, 1, itau_dep, .TRUE., xtmp)
+     CALL restput (rest_id_sto, var_name, 1, 1, 1, itau_dep, xtmp)
+     !-
+     DO iv=1,nbvar
+        !-- check if the variable is to be written here
+        IF (INDEX(taboo_vars,'$'//TRIM(varnames(iv))//'$') == 0 ) THEN
+           !---- get variable dimensions, especially 3rd dimension
+           CALL ioget_vdim &
+                &      (rest_id_sto, varnames(iv), varnbdim_max, varnbdim, vardims)
+           l1d = ALL(vardims(1:varnbdim) == 1)
+           !---- read it
+           IF (l1d) THEN
+              CALL restget &
+                   &        (rest_id_sto, TRIM(varnames(iv)), 1, vardims(3), &
+                   &         1, itau_dep, .TRUE., xtmp)
+           ELSE
+              ALLOCATE( var_3d(nbp_glo,vardims(3)), stat=ier)
+              IF (ier /= 0) STOP 'ALLOCATION PROBLEM'
+              !----
+              CALL restget &
+                   &        (rest_id_sto, TRIM(varnames(iv)), nbp_glo, vardims(3), &
+                   &         1, itau_dep, .TRUE., var_3d, "gather", nbp_glo, indices_g)
+           ENDIF
+           !---- write it
+           IF (l1d) THEN
+              CALL restput &
+                   &        (rest_id_sto, TRIM(varnames(iv)), 1, vardims(3), &
+                   &         1, itau_dep, xtmp)
+           ELSE
+              CALL restput &
+                   &        (rest_id_sto, TRIM(varnames(iv)), nbp_glo, vardims(3), &
+                   &         1, itau_dep, var_3d, 'scatter',  nbp_glo, indices_g)
+              !----
+              DEALLOCATE(var_3d)
+           ENDIF
+        ELSE
+        ENDIF
+     ENDDO
+     !-
+     ! read soil carbon stocks values stored in the input restart file
+     !-
+     ALLOCATE(carbon_g(nbp_glo,ncarb,nvm,nbdl))
+     carbon_g(:,:,:,:) = val_exp
+     ALLOCATE(DOC_g(nbp_glo,nvm,nbdl,ndoc,npool,nelements))
+     DOC_g(:,:,:,:,:,:) = val_exp
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z01_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,1), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,1) == val_exp)) carbon_g(:,:,m,1) = zero
+    ENDDO
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z02_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,2), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,2) == val_exp)) carbon_g(:,:,m,2) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z03_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,3), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,3) == val_exp)) carbon_g(:,:,m,3) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z04_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,4), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,4) == val_exp)) carbon_g(:,:,m,4) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z05_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,5), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,5) == val_exp)) carbon_g(:,:,m,5) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z06_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,6), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,6) == val_exp)) carbon_g(:,:,m,6) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z07_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,7), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,7) == val_exp)) carbon_g(:,:,m,7) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z08_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,8), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,8) == val_exp)) carbon_g(:,:,m,8) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z09_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,9), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,9) == val_exp)) carbon_g(:,:,m,9) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z10_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,10), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,10) == val_exp)) carbon_g(:,:,m,10) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z11_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, ncarb , 1, itau_dep, &
+              &                   .TRUE., carbon_g(:,:,m,11), 'gather', nbp_glo, indices_g)
+         IF (ALL(carbon_g(:,:,m,11) == val_exp)) carbon_g(:,:,m,11) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z1_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,1,ifree,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,1,ifree,m,icarbon) == val_exp)) DOC_g(:,:,1,ifree,m,icarbon) = zero
+    ENDDO
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z2_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,2,ifree,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,2,ifree,m,icarbon) == val_exp)) DOC_g(:,:,2,ifree,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z3_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,3,ifree,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,3,ifree,m,icarbon) == val_exp)) DOC_g(:,:,3,ifree,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z4_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,4,ifree,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,4,ifree,m,icarbon) == val_exp)) DOC_g(:,:,4,ifree,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z5_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,5,ifree,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,5,ifree,m,icarbon) == val_exp)) DOC_g(:,:,5,ifree,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z6_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,6,ifree,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,6,ifree,m,icarbon) == val_exp)) DOC_g(:,:,6,ifree,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z7_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,7,ifree,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,7,ifree,m,icarbon) == val_exp)) DOC_g(:,:,7,ifree,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z8_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,8,ifree,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,8,ifree,m,icarbon) == val_exp)) DOC_g(:,:,8,ifree,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z9_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,9,ifree,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,9,ifree,m,icarbon) == val_exp)) DOC_g(:,:,9,ifree,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z10_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,10,ifree,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,10,ifree,m,icarbon) == val_exp)) DOC_g(:,:,10,ifree,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z11_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,11,ifree,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,11,ifree,m,icarbon) == val_exp)) DOC_g(:,:,11,ifree,m,icarbon) = zero
+    ENDDO
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z1_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,1,iadsorbed,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,1,iadsorbed,m,icarbon) == val_exp)) DOC_g(:,:,1,iadsorbed,m,icarbon) = zero
+    ENDDO
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z2_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,2,iadsorbed,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,2,iadsorbed,m,icarbon) == val_exp)) DOC_g(:,:,2,iadsorbed,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z3_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,3,iadsorbed,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,3,iadsorbed,m,icarbon) == val_exp)) DOC_g(:,:,3,iadsorbed,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z4_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,4,iadsorbed,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,4,iadsorbed,m,icarbon) == val_exp)) DOC_g(:,:,4,iadsorbed,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z5_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,5,iadsorbed,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,5,iadsorbed,m,icarbon) == val_exp)) DOC_g(:,:,5,iadsorbed,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z6_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,6,iadsorbed,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,6,iadsorbed,m,icarbon) == val_exp)) DOC_g(:,:,6,iadsorbed,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z7_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,7,iadsorbed,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,7,iadsorbed,m,icarbon) == val_exp)) DOC_g(:,:,7,iadsorbed,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z8_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,8,iadsorbed,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,8,iadsorbed,m,icarbon) == val_exp)) DOC_g(:,:,8,iadsorbed,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z9_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,9,iadsorbed,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,9,iadsorbed,m,icarbon) == val_exp)) DOC_g(:,:,9,iadsorbed,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z10_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,10,iadsorbed,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,10,iadsorbed,m,icarbon) == val_exp)) DOC_g(:,:,10,iadsorbed,m,icarbon) = zero
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z11_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   .TRUE., DOC_g(:,:,11,iadsorbed,m,icarbon), 'gather', nbp_glo, indices_g)
+         IF (ALL(DOC_g(:,:,11,iadsorbed,m,icarbon) == val_exp)) DOC_g(:,:,11,iadsorbed,m,icarbon) = zero
+    ENDDO
+
+     WRITE(numout,*) "date0 : ",date0, itau_dep
+     !-
+     ! Analytical spinup is set to false
+     !
+     spinup_analytic = .FALSE.
+
+     ! Length of the run (in Years)
+     ! User value is used if present in the .def file
+     ! If not, default value (10000 Years) is used
+     !-
+     WRITE(time_str,'(a)') '10000Y'
+     CALL getin('TIME_LENGTH', time_str)
+     write(numout,*) 'Number of years for carbon spinup : ',time_str
+     ! transform into itau
+     CALL tlen2itau(time_str, dt_forcesoil*one_day, date0, itau_len)
+     write(numout,*) 'Number of time steps to do: ',itau_len
+     !-
+     ! read soil carbon inputs, water and temperature stresses on OM decomposition 
+     ! into the forcing file - We read an average year.
+     !-
+     ALLOCATE(soilcarbon_input_g(nbp_glo,nvm,nbdl,npool,nelements,nparan*nbyear))
+     ALLOCATE(litter_above_g(nbp_glo,nlitt,nvm,nelements,nparan*nbyear))
+     ALLOCATE(litter_below_g(nbp_glo,nlitt,nvm,nbdl,nelements,nparan*nbyear))
+     ALLOCATE(lignin_struc_above_g(nbp_glo,nvm,nparan*nbyear))
+     ALLOCATE(lignin_struc_below_g(nbp_glo,nvm,nbdl,nparan*nbyear))
+     !-
+     ALLOCATE(control_temp_soil_g(nbp_glo,nbdl,npool*2,nparan*nbyear))
+     ALLOCATE(control_moist_soil_g(nbp_glo,nbdl,nvm,nparan*nbyear))
+     ALLOCATE(moist_soil_g(nbp_glo,nbdl,nparan*nbyear))
+     ALLOCATE(soil_mc_g(nbp_glo,nbdl,nstm,nparan*nbyear))
+     ALLOCATE(floodout_g(nbp_glo,nparan*nbyear))
+     ALLOCATE(wat_flux0_g(nbp_glo,nstm,nparan*nbyear))
+     ALLOCATE(wat_flux_g(nbp_glo,nbdl,nstm,nparan*nbyear))
+     ALLOCATE(runoff_per_soil_g(nbp_glo,nstm,nparan*nbyear))
+     ALLOCATE(drainage_per_soil_g(nbp_glo,nstm,nparan*nbyear))
+     ALLOCATE(DOC_to_topsoil_g(nbp_glo,nelements,nparan*nbyear))
+     ALLOCATE(DOC_to_subsoil_g(nbp_glo,nelements,nparan*nbyear))
+     !-
+     ier = NF90_INQ_VARID (Cforcing_id,'soilcarbon_input',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,soilcarbon_input_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'control_moist_soil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,control_moist_soil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,    'control_temp_soil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,control_temp_soil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,    'litter_above',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,litter_above_g)
+     ier = NF90_INQ_VARID (Cforcing_id,    'litter_below',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,litter_below_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'moist_soil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,moist_soil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'soil_mc',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,soil_mc_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'floodout',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,floodout_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'wat_flux0',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,wat_flux0_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'wat_flux',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,wat_flux_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'runoff_per_soil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,runoff_per_soil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'drainage_per_soil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,drainage_per_soil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'DOC_to_topsoil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,DOC_to_topsoil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,   'DOC_to_subsoil',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,DOC_to_subsoil_g)
+     ier = NF90_INQ_VARID (Cforcing_id,    'lignin_struc_above',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,lignin_struc_above_g)
+     ier = NF90_INQ_VARID (Cforcing_id,    'lignin_struc_below',v_id)
+     ier = NF90_GET_VAR   (Cforcing_id,v_id,lignin_struc_below_g)
+     !-
+     ier = NF90_CLOSE (Cforcing_id)
+     !-
+  ENDIF
+  CALL bcast(nparan)
+  CALL bcast(nbyear)
+  CALL bcast(dt_forcesoil)
+  CALL bcast(iim_g)
+  CALL bcast(jjm_g)
+  CALL bcast(nbp_glo)
+  CALL bcast(itau_dep)
+  CALL bcast(itau_len)
+  IF (.NOT. ALLOCATED(indices_g)) ALLOCATE (indices_g(nbp_glo))
+  CALL bcast(indices_g)
+ 
+  !
+  ! We must initialize data_para :
+  CALL init_orchidee_data_para_driver(nbp_glo,indices_g)
+
+  kjpindex=nbp_loc
+  jjm=jj_nb
+  iim=iim_g
+  IF (debug) WRITE(numout,*) "Local grid : ",kjpindex,iim,jjm
+
+  !---
+  !--- Create the index table
+  !---
+  !--- This job returns a LOCAL kindex.
+  !---
+  ALLOCATE (indices(kjpindex),stat=ier)
+  !
+  !! scattering to all processes in parallel mode
+  !
+  CALL scatter(indices_g,indices)
+  indices(1:kjpindex)=indices(1:kjpindex)-(jj_begin-1)*iim_g
+  IF (debug) WRITE(numout,*) mpi_rank,"indices locaux = ",indices(1:kjpindex)
+  !-
+  ! Allocation of the variables for a processor
+  !-
+  ALLOCATE(clay(kjpindex))
+  ALLOCATE(soil_ph(kjpindex))
+  ALLOCATE(bulk_dens(kjpindex))
+  ALLOCATE(soiltile(kjpindex,nstm))
+  ALLOCATE(veget_max(kjpindex,nvm))
+  ALLOCATE(soilcarbon_input(kjpindex,nvm,nbdl,npool,nelements,nparan*nbyear))
+  ALLOCATE(control_temp_soil(kjpindex,nbdl,npool*2,nparan*nbyear))
+  ALLOCATE(control_moist_soil(kjpindex,nbdl,nvm,nparan*nbyear))
+  ALLOCATE(carbon(kjpindex,ncarb,nvm,nbdl))
+  ALLOCATE(litter_above(kjpindex,nlitt,nvm,nelements,nparan*nbyear))
+  ALLOCATE(litter_below(kjpindex,nlitt,nvm,nbdl,nelements,nparan*nbyear))
+  ALLOCATE(resp_hetero_soil(kjpindex,nvm))
+  ALLOCATE(soilhum(kjpindex,nbdl))
+  ALLOCATE(moist_soil(kjpindex,nbdl,nparan*nbyear))
+  ALLOCATE(soil_mc(kjpindex,nbdl,nstm,nparan*nbyear))
+  ALLOCATE(floodout(kjpindex,nparan*nbyear))
+  ALLOCATE(wat_flux0(kjpindex,nstm,nparan*nbyear))
+  ALLOCATE(wat_flux(kjpindex,nbdl,nstm,nparan*nbyear))
+  ALLOCATE(runoff_per_soil(kjpindex,nstm,nparan*nbyear))
+  ALLOCATE(drainage_per_soil(kjpindex,nstm,nparan*nbyear))
+  ALLOCATE(DOC_to_topsoil(kjpindex,nelements,nparan*nbyear))
+  ALLOCATE(DOC_to_subsoil(kjpindex,nelements,nparan*nbyear))
+  ALLOCATE(DOC(kjpindex,nvm,nbdl,ndoc,npool,nelements))
+  ALLOCATE(DOC_EXP(kjpindex,nvm,nexp,nelements))
+  ALLOCATE(matrixA(kjpindex,nvm,nbpools,nbpools))
+  ALLOCATE(lignin_struc_above(kjpindex,nvm,nparan*nbyear))
+  ALLOCATE(lignin_struc_below(kjpindex,nvm,nbdl,nparan*nbyear))
+  DO i = 1,nbpools
+     matrixA(:,:,i,i) = un
+  ENDDO
+  iatt = 0
+  !-
+  ! Initialization of the variables for a processor
+  !-
+  CALL Scatter(clay_g,clay)
+  CALL Scatter(soil_ph_g,soil_ph)
+  CALL Scatter(bulk_dens_g,bulk_dens)
+  CALL Scatter(soiltile_g,soiltile)
+  CALL Scatter(veget_max_g,veget_max)
+          DO m =1,nvm
+             DO l=1,nbdl
+                DO i=1,npool
+  CALL Scatter(soilcarbon_input_g(:,m,l,i,:,:),soilcarbon_input(:,m,l,i,:,:))
+                ENDDO
+             ENDDO
+          ENDDO
+          DO i =1,nlitt
+             DO j=1,nvm
+  CALL Scatter(litter_above_g(:,i,j,:,:),litter_above(:,i,j,:,:))
+             ENDDO
+          ENDDO
+
+          DO i =1,nlitt
+             DO j=1,nvm
+                DO k = 1,nbdl
+  CALL Scatter(litter_below_g(:,i,j,k,:,:),litter_below(:,i,j,k,:,:))
+                ENDDO
+             ENDDO
+          ENDDO
+  CALL Scatter(control_temp_soil_g,control_temp_soil)
+  CALL Scatter(control_moist_soil_g,control_moist_soil)
+  CALL Scatter(moist_soil_g,moist_soil)
+  CALL Scatter(soil_mc_g,soil_mc)
+  CALL Scatter(floodout_g,floodout)
+  CALL Scatter(wat_flux0_g,wat_flux0)
+  CALL Scatter(wat_flux_g,wat_flux)
+  CALL Scatter(runoff_per_soil_g,runoff_per_soil)
+  CALL Scatter(drainage_per_soil_g,drainage_per_soil)
+  CALL Scatter(DOC_to_topsoil_g,DOC_to_topsoil)
+  CALL Scatter(DOC_to_subsoil_g,DOC_to_subsoil)
+          DO m =1,nvm
+             DO l=1,nbdl
+  CALL Scatter(carbon_g(:,:,m,l),carbon(:,:,m,l))  
+             ENDDO
+          ENDDO
+          DO m =1,nbdl
+             DO l=1,ndoc
+                DO i= 1,npool
+  CALL Scatter(DOC_g(:,:,m,l,i,icarbon),DOC(:,:,m,l,i,icarbon))
+                ENDDO
+             ENDDO
+          ENDDO
+          DO j=1,nvm
+  CALL Scatter(lignin_struc_above_g(:,j,:),lignin_struc_above(:,j,:))
+          ENDDO
+          DO j=1,nvm
+             DO k = 1,nbdl
+  CALL Scatter(lignin_struc_below_g(:,j,k,:),lignin_struc_below(:,j,k,:))
+             ENDDO
+          ENDDO
+!-
+! Configu
+!-
+
+  !Config Key   = FRAC_CARB_AP
+  !Config Desc  = frac carb coefficients from active pool: depends on clay content
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.004
+  !Config Help  = fraction of the active pool going to the passive pool
+  !Config Units = [-]
+  CALL getin_p('FRAC_CARB_AP',frac_carb_ap)  
+  !
+  !Config Key   = FRAC_CARB_SA
+  !Config Desc  = frac_carb_coefficients from slow pool
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.42
+  !Config Help  = fraction of the slow pool going to the active pool
+  !Config Units = [-] 
+  CALL getin_p('FRAC_CARB_SA',frac_carb_sa)
+  !
+  !Config Key   = FRAC_CARB_SP
+  !Config Desc  = frac_carb_coefficients from slow pool
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.03
+  !Config Help  = fraction of the slow pool going to the passive pool
+  !Config Units = [-] 
+  !CALL getin_p('FRAC_CARB_SP',frac_carb_sp)
+  !
+  !Config Key   = FRAC_CARB_PA
+  !Config Desc  = frac_carb_coefficients from passive pool
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.45
+  !Config Help  = fraction of the passive pool going to the passive pool
+  !Config Units = [-] 
+  CALL getin_p('FRAC_CARB_PA',frac_carb_pa)
+  !
+  !Config Key   = FRAC_CARB_PS
+  !Config Desc  = frac_carb_coefficients from passive pool
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.0
+  !Config Help  = fraction of the passive pool going to the passive pool
+  !Config Units = [-]
+  !CALL getin_p('FRAC_CARB_PS',frac_carb_ps)
+  !
+  !Config Key   = ACTIVE_TO_PASS_CLAY_FRAC
+  !Config Desc  = 
+  !Config if    = OK_STOMATE 
+  !Config Def   =  .68  
+  !Config Help  =
+  !Config Units = [-]
+  CALL getin_p('ACTIVE_TO_PASS_CLAY_FRAC',active_to_pass_clay_frac)
+!
+  !Config Key   = CARBON_TAU_IACTIVE
+  !Config Desc  = residence times in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.3
+  !Config Help  =
+  !Config Units =  [days] 
+  CALL getin_p('CARBON_TAU_IACTIVE',carbon_tau_iactive)
+  !
+  !Config Key   = CARBON_TAU_ISLOW
+  !Config Desc  = residence times in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 1.12
+  !Config Help  =
+  !Config Units = [days]
+  CALL getin_p('CARBON_TAU_ISLOW',carbon_tau_islow)
+  !
+  !Config Key   = CARBON_TAU_IPASSIVE
+  !Config Desc  = residence times in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 461.98
+  !Config Help  = residence time in the passive pool
+  !Config Units = [days] 
+  CALL getin_p('CARBON_TAU_IPASSIVE',carbon_tau_ipassive)
+  !
+  !Config Key   = PRIMING_PARAM_IACTIVE
+  !Config Desc  = priming parameter in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 493.66
+  !Config Help  =
+  !Config Units =  [-] 
+  CALL getin_p('PRIMING_PARAM_IACTIVE',priming_param_iactive)
+  !
+  !Config Key   = PRIMING_PARAM_ISLOW
+  !Config Desc  = priming parameter in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 194.03
+  !Config Help  =
+  !Config Units =  [-] 
+  CALL getin_p('PRIMING_PARAM_ISLOW',priming_param_islow)
+  !
+  !Config Key   = PRIMING_PARAM_IPASSIVE
+  !Config Desc  = priming parameter in carbon pools
+  !Config if    = OK_STOMATE 
+  !Config Def   = 136.54
+  !Config Help  =
+  !Config Units =  [-] 
+  CALL getin_p('PRIMING_PARAM_IPASSIVE',priming_param_ipassive)
+  !
+!  !Config Key   = BULK_DENSITY
+!  !Config Desc  = value of the soil bulk density 
+!  !Config if    = READ_BULK_DENSITY
+!  !Config Def   = 1.65
+!  !Config Help  =
+!  !Config Units =  [kg m-3] 
+!  CALL getin_p('BULK_DENSITY',bulk_dens)
+  !
+  !Config Key   = FLUX_TOT_COEFF
+  !Config Desc  =
+  !Config if    = OK_STOMATE 
+  !Config Def   = 1.2, 1.4,.75
+  !Config Help  =
+  !Config Units = [days]
+  CALL getin_p('FLUX_TOT_COEFF',flux_tot_coeff)
+  !
+  !Config Key   = PREF_SOIL_VEG
+  !Config Desc  = The soil tile number for each vegetation
+  !Config if    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3
+  !Config Help  = Gives the number of the soil tile on which we will
+  !Config         put each vegetation. This allows to divide the
+  !hydrological column
+  !Config Units = [-]        
+  CALL getin_p('PREF_SOIL_VEG',pref_soil_veg)
+  !
+  !Config Key   = DOC_tau_labile
+  !Config Desc  = residence time of labile DOC
+  !Config if    = OK_STOMATE 
+  !Config Def   = 3.76
+  !Config Help  = mean from Kalbitz et al., 2003 Geoderma
+  !Config Units =  [days] 
+  CALL getin_p('DOC_TAU_LABILE',DOC_tau_labile)
+  !
+  !Config Key   = DOC_tau_stable
+  !Config Desc  = residence time of stable DOC
+  !Config if    = OK_STOMATE 
+  !Config Def   = 602.41
+  !Config Help  = mean from Kalbitz et al., 2003 Geoderma
+  !Config Units =  [days] 
+  CALL getin_p('DOC_TAU_STABLE',DOC_tau_stable)
+  !
+  !!Config Key  = D_DOC
+  !Config Desc  = diffusion coefficient of DOC
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.0000004428
+  !Config Help  = from Burdige et al., 1999 in Ota et al., 2013
+  !Config Units =  [m^2 hr-1] 
+  CALL getin_p('D_DOC',D_DOC)
+  !
+  !!Config Key   = Dif
+  !Config Desc  = diffusion coefficient of POC
+  !Config if    = OK_STOMATE 
+  !Config Def   = 1E-4
+  !Config Help  = from Koven et al., 2013 BG
+  !Config Units =  [m^2 day-1] 
+  CALL getin_p('Dif',Dif)
+  !
+  !!Config Key   = CUE
+  !Config Desc  = Microbial carbon use efficiency
+  !Config if    = OK_STOMATE 
+  !Config Def   = 0.5
+  !Config Help  = Assumed value of CUE=0.5
+  !Config Units =  [-] 
+  CALL getin_p('CUE',CUE)
+
+  !!-
+  !! 2. Computational step
+  !! Loop over time - Call of soilcarbon routine at each time step 
+  !! Updated soil carbon stocks are stored into carbon variable
+  !! We only keep the last value of carbon variable (no time dimension).
+  !!-
+  iyear=1
+  DO i=1,itau_len
+     iatt = iatt+1
+     IF (iatt > nparan*nbyear) THEN
+        IF (debug) WRITE(numout,*) iyear
+        iatt = 1
+        iyear=iyear+1
+     ENDIF
+
+     ! With this version we have to use the 11 layers so we fixe
+     ! the soil depth to dpu_max/2 as it is done in intersurf.
+     soil_depth = dpu_max/2.
+
+  DO l = 1, nbdl-1
+     ! first 2.0 is dpu 
+     ! second 2.0 is average
+     diaglev(l) = soil_depth/(2**(nbdl-1) -1) * ( ( 2**(l-1) -1) + ( 2**(l) -1) ) / 2.0
+  ENDDO
+  diaglev(nbdl) = soil_depth
+
+     CALL soilcarbon &
+          &    (kjpindex, dt_forcesoil, clay, &
+          &     soilcarbon_input(:,:,:,:,:,iatt), control_temp_soil(:,:,:,iatt), control_moist_soil(:,:,:,iatt), &
+          &     carbon, resp_hetero_soil, &
+          &     matrixA,litter_above(:,:,:,:,iatt),litter_below(:,:,:,:,:,iatt),&
+          &     soilhum, DOC, moist_soil(:,:,iatt), DOC_EXP,&
+          &     lignin_struc_above(:,:,iatt), lignin_struc_below(:,:,:,iatt),&
+          &     floodout(:,iatt), runoff_per_soil(:,:,iatt), drainage_per_soil(:,:,iatt), wat_flux0(:,:,iatt), &
+          &     wat_flux(:,:,:,iatt),bulk_dens, soil_ph,veget_max, soil_mc(:,:,:,iatt), soiltile, &
+          &     DOC_to_topsoil(:,:,iatt), DOC_to_subsoil(:,:,iatt))
+  ENDDO
+  WRITE(numout,*) "End of soilcarbon LOOP."
+
+  !
+  !! Gathering of variables towards main processor in parallel mode
+  !
+          DO m =1,nvm
+             DO l=1,nbdl
+  CALL Gather(carbon(:,:,m,l),carbon_g(:,:,m,l))
+             ENDDO
+          ENDDO
+          DO m =1,nbdl
+             DO l=1,ndoc
+                DO i= 1,npool
+  CALL Gather(DOC(:,:,m,l,i,icarbon),DOC_g(:,:,m,l,i,icarbon))
+                ENDDO
+             ENDDO
+          ENDDO
+  !!-
+  !! 3. write new carbon stocks into the ouput restart file
+  !!-
+  IF (is_root_prc) THEN
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z01_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,1), 'scatter', nbp_glo, indices_g)
+    ENDDO
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z02_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,2), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z03_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,3), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z04_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,4), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z05_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,5), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z06_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,6), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z07_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,7), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z07_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,7), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z08_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,8), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z09_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,9), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z10_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,10), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z11_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, ncarb, 1, itau_dep, &
+              &                   carbon_g(:,:,m,11), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z1_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,1,ifree,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z2_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,2,ifree,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z3_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,3,ifree,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z4_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,4,ifree,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z5_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,5,ifree,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z6_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,6,ifree,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z7_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,7,ifree,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z8_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,8,ifree,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z9_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,9,ifree,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z10_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,10,ifree,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z11_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,11,ifree,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z1_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,1,iadsorbed,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z2_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,2,iadsorbed,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z3_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,3,iadsorbed,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z4_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,4,iadsorbed,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z5_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,5,iadsorbed,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z6_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,6,iadsorbed,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z7_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,7,iadsorbed,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z8_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,8,iadsorbed,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z9_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,9,iadsorbed,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z10_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,10,iadsorbed,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'adsdoc_z11_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput (rest_id_sto, var_name, nbp_glo, nvm , 1, itau_dep, &
+              &                   DOC_g(:,:,11,iadsorbed,m,icarbon), 'scatter', nbp_glo, indices_g)
+    ENDDO
+
+     !-
+     CALL getin_dump
+     CALL restclo
+  ENDIF
+#ifdef CPP_PARA
+  CALL MPI_FINALIZE(ier)
+#endif
+  WRITE(numout,*) "End of forcesoil."
+  !--------------------
+END PROGRAM forcesoil
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/getprec.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/getprec.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/getprec.f90	(revision 5166)
@@ -0,0 +1,57 @@
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+PROGRAM getprec
+!---------------------------------------------------------------------
+!- This program verifies that that the number representation
+!- between the different components of the model are compatible
+!---------------------------------------------------------------------
+  USE defprec
+!-
+  IMPLICIT NONE
+!-
+  INTEGER :: i
+  REAL    :: r
+!-
+  INTEGER :: range_int,range_real,precision_real
+!---------------------------------------------------------------------
+  range_int  = RANGE(i)
+  range_real = RANGE(r)
+  precision_real = PRECISION(r)
+!-
+  WRITE(*,*) 'The following ranges and precisions are standard'
+  WRITE(*,*) 'on this computer with your compiler options :'
+  WRITE(*,*) ' INTEGER range     :',range_int
+  WRITE(*,*) ' REAL    range     :',range_real
+  WRITE(*,*) ' REAL    precision :',precision_real
+!-
+  WRITE(*,*) 'The corresponding kinds are :'
+  WRITE(*,*) ' KIND for integer  :', &
+ & SELECTED_INT_KIND(range_int)
+  WRITE(*,*) ' KIND for real     :', &
+ & SELECTED_REAL_KIND(precision_real,range_real)
+!-
+  WRITE(*,*) 'We test if this corresponds to what is used'
+  WRITE(*,*) 'in various parts of the code :'
+!-
+! Real :
+!-
+  IF (SELECTED_REAL_KIND(precision_real,range_real) /= r_std) THEN
+    WRITE(*,*) ' REAL : ERROR, the wrong kind is specified.'
+    WRITE(*,*) ' Use the value above.'
+  ELSE
+    WRITE(*,*) ' REAL    : OK'
+  ENDIF
+!-
+! Integer :
+!-
+  IF (SELECTED_INT_KIND(range_int) /= i_std) THEN
+    WRITE(*,*) ' INTEGER : ERROR, the wrong kind is specified.'
+    WRITE(*,*) ' Use the value above.'
+  ELSE
+    WRITE(*,*) ' INTEGER : OK'
+  ENDIF
+!------------------
+END PROGRAM getprec
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/readdim2.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/readdim2.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/readdim2.f90	(revision 5166)
@@ -0,0 +1,2328 @@
+!
+MODULE readdim2
+!---------------------------------------------------------------------
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!- IPSL (2006)
+!-  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!-
+   USE ioipsl_para
+   USE weather
+   USE TIMER
+   USE constantes
+   USE solar
+   USE grid
+   USE mod_orchidee_para
+!-
+   IMPLICIT NONE
+!-
+   PRIVATE
+   PUBLIC  :: forcing_read, forcing_info, forcing_grid
+!-
+   INTEGER, SAVE                            :: iim_full, jjm_full, llm_full, ttm_full
+   INTEGER, SAVE                            :: iim_zoom, jjm_zoom
+   INTEGER, SAVE                            :: iim_g_begin,jjm_g_begin,iim_g_end,jjm_g_end
+   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:)  :: data_full, lon_full, lat_full
+   REAL, SAVE, ALLOCATABLE, DIMENSION(:)    :: lev_full
+   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: itau, i_index, j_index,j_index_g
+   INTEGER, SAVE                            :: i_test, j_test
+   LOGICAL, SAVE                            :: allow_weathergen, interpol, daily_interpol
+   LOGICAL, SAVE, PUBLIC                    :: weathergen, is_watchout
+   REAL, SAVE                               :: merid_res, zonal_res
+   LOGICAL, SAVE                            :: have_zaxis=.FALSE.
+!-
+!- Heigh controls and data 
+!- 
+   LOGICAL, SAVE                            :: zfixed, zsigma, zhybrid, zlevels, zheight 
+   LOGICAL, SAVE                            :: zsamelev_uv 
+   REAL, SAVE                               :: zlev_fixed, zlevuv_fixed 
+   REAL, SAVE                               :: zhybrid_a, zhybrid_b 
+   REAL, SAVE                               :: zhybriduv_a, zhybriduv_b 
+
+CONTAINS
+!-
+!=====================================================================
+!-
+  SUBROUTINE forcing_info(filename, iim, jjm, llm, tm, date0, dt_force,&
+       & force_id)
+
+    !---------------------------------------------------------------------
+    !
+    !- This subroutine will get all the info from the forcing file and
+    !- prepare for the zoom if needed.
+    !- It returns to the caller the sizes of the data it will receive at
+    !- the forcing_read call. This is important so that the caller can
+    !- allocate the right space.
+    !-
+    !- filename   : name of the file to be opened
+    !- iim        : size in x of the forcing data
+    !- jjm        : size in y of the forcing data
+    !- llm        : number of levels in the forcing data (not yet used)
+    !- tm         : Time dimension of the forcing
+    !- date0      : The date at which the forcing file starts (julian days)
+    !- dt_force   : time-step of the forcing file in seconds
+    !- force_id   : ID of the forcing file
+    !-
+    !- ARGUMENTS
+    !-
+    IMPLICIT NONE
+    !-
+    CHARACTER(LEN=*) :: filename
+    INTEGER          :: iim, jjm, llm, tm
+    REAL             :: date0, dt_force
+    INTEGER, INTENT(OUT) :: force_id
+    !- LOCAL
+    CHARACTER(LEN=20) :: calendar_str
+    REAL :: juld_1, juld_2
+    LOGICAL :: debug = .FALSE.
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: fcontfrac
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: qair
+    LOGICAL :: contfrac_exists=.FALSE.
+    INTEGER :: NbPoint
+    INTEGER :: i_test,j_test
+    INTEGER :: i,j,ind,ttm_part
+    INTEGER, ALLOCATABLE, DIMENSION(:)  :: index_l
+    REAL, ALLOCATABLE, DIMENSION(:,:)  :: lon, lat
+    REAL, ALLOCATABLE, DIMENSION(:)    :: lev, levuv
+
+    !-
+    CALL flininfo(filename,  iim_full, jjm_full, llm_full, ttm_full, force_id)
+    !-
+    IF ( debug ) WRITE(numout,*) 'forcing_info : Details from forcing file :', &
+         iim_full, jjm_full, llm_full, ttm_full
+    !-
+    IF ( llm_full < 1 ) THEN
+       have_zaxis = .FALSE.
+    ELSE
+       have_zaxis = .TRUE.
+    ENDIF
+    WRITE(numout,*) 'have_zaxis : ', llm_full, have_zaxis
+    !-
+    ttm_part = 2
+    ALLOCATE(itau(ttm_part))
+    ALLOCATE(data_full(iim_full, jjm_full),lon_full(iim_full, jjm_full),&
+         & lat_full(iim_full, jjm_full))
+    ALLOCATE(lev_full(llm_full))
+    ALLOCATE(fcontfrac(iim_full,jjm_full))
+    !-
+    lev_full(:) = zero
+    !-
+    dt_force=zero
+    CALL flinopen &
+         &  (filename, .FALSE., iim_full, jjm_full, llm_full, lon_full, lat_full, &
+         &   lev_full, ttm_part, itau, date0, dt_force, force_id)
+    IF ( dt_force == zero ) THEN
+       dt_force = itau(2) - itau(1) 
+       itau(:) = itau(:) / dt_force
+    ENDIF
+    !  WRITE(numout,*) "forcing_info : Forcing time step out of flinopen : ",dt_force
+    !-
+    !- What are the alowed options for the temportal interpolation
+    !-
+    !Config Key   = ALLOW_WEATHERGEN
+    !Config Desc  = Allow weather generator to create data
+    !Config If    = [-]
+    !Config Def   = n
+    !Config Help  = This flag allows the forcing-reader to generate
+    !Config         synthetic data if the data in the file is too sparse
+    !Config         and the temporal resolution would not be enough to
+    !Config         run the model.
+    !Config Units = [FLAG]
+    !-
+    allow_weathergen = .FALSE.
+    CALL getin_p('ALLOW_WEATHERGEN',allow_weathergen)
+    !-
+    !- The calendar was set by the forcing file. If no "calendar" attribute was
+    !- found then it is assumed to be gregorian, 
+    !MM => FALSE !! it is NOT assumed anything !
+    !- else it is what ever is written in this attribute.
+    !-
+    CALL ioget_calendar(calendar_str)
+    i=INDEX(calendar_str,ACHAR(0))
+    IF ( i > 0 ) THEN
+       calendar_str(i:20)=' '
+    ENDIF
+    !  WRITE(numout,*) "forcing_info : Calendar used : ",calendar_str
+    IF ( calendar_str == 'XXXX' ) THEN
+       WRITE(numout,*) "forcing_info : The calendar was not found in the forcing file."
+       IF (allow_weathergen) THEN
+          ! Then change the calendar
+          CALL ioconf_calendar("noleap") 
+       ELSE
+          WRITE(numout,*) "forcing_info : We will force it to gregorian by default."
+          CALL ioconf_calendar("gregorian") !! = 365.2425 ; "noleap" = 365.0; "360d"; "julian"=365.25
+       ENDIF
+    ENDIF
+    WRITE(numout,*) "readdim2 : Calendar used by the model : ",calendar_str
+    IF (ttm_full .GE. 2) THEN
+       juld_1 = itau2date(itau(1), date0, dt_force)
+       juld_2 = itau2date(itau(2), date0, dt_force)
+    ELSE
+       juld_1 = 0
+       juld_2 = 0
+       CALL ipslerr_p ( 3, 'forcing_info','What is that only one time step in the forcing file ?', &
+            &         ' That can not be right.','verify forcing file.')
+       STOP
+    ENDIF
+    !-
+    !- Initialize one_year / one_day
+    CALL ioget_calendar (one_year, one_day)
+    !-
+    !- What is the distance between the two first states. From this we will deduce what is
+    !- to be done.
+    weathergen = .FALSE.
+    interpol = .FALSE.
+    daily_interpol = .FALSE.
+    is_watchout = .FALSE.
+    !-
+    IF ( ABS(ABS(juld_2-juld_1)-30.) .LE. 2.) THEN
+       IF ( allow_weathergen ) THEN
+          weathergen = .TRUE.
+          WRITE(numout,*) 'Using weather generator.' 
+       ELSE
+          CALL ipslerr_p ( 3, 'forcing_info', &
+               &         'This seems to be a monthly file.', &
+               &         'We should use a weather generator with this file.', &
+               &         'This should be allowed in the run.def')
+       ENDIF
+    ELSEIF (( ABS(juld_1-juld_2) .LE. 1./4.) .OR. ( ABS(juld_1-juld_2) .EQ. 1.)) THEN
+       interpol = .TRUE.
+       WRITE(numout,*) 'We will interpolate between the forcing data time steps.' 
+       IF ( ABS(juld_1-juld_2) .EQ. 1.) THEN
+          daily_interpol = .TRUE.
+       ENDIF
+    ELSE
+       ! Using the weather generator with data other than monthly ones probably
+       ! needs some thinking.
+       WRITE(numout,*) 'The time step is not suitable:',ABS(juld_1-juld_2),' days.'
+       CALL ipslerr_p ( 3, 'forcing_info','The time step is not suitable.', &
+            &         '','We cannot do anything with these forcing data.')
+    ENDIF
+    !-
+    !- redefine the forcing time step if the weather generator is activated
+    !-
+    IF ( weathergen ) THEN
+       !Config Key   = DT_WEATHGEN
+       !Config Desc  = Calling frequency of weather generator
+       !Config If    = ALLOW_WEATHERGEN
+       !Config Def   = 1800.
+       !Config Help  = Determines how often the weather generator
+       !Config         is called (time step in s). Should be equal
+       !Config         to or larger than Sechiba's time step (say,
+       !Config         up to 6 times Sechiba's time step or so).
+       !Config Units = [seconds]
+       dt_force = 1800.
+       CALL getin_p('DT_WEATHGEN',dt_force)
+    ENDIF
+    !-
+    !- Define the zoom
+    !-
+    !Config Key   = LIMIT_WEST
+    !Config Desc  = Western limit of region
+    !Config If    = [-]
+    !Config Def   = -180.
+    !Config Help  = Western limit of the region we are 
+    !Config         interested in. Between -180 and +180 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees] 
+    !- 
+    limit_west = -180.
+    CALL getin_p('LIMIT_WEST',limit_west)
+    !-
+    !Config Key   = LIMIT_EAST
+    !Config Desc  = Eastern limit of region
+    !Config If    = [-]
+    !Config Def   = 180.
+    !Config Help  = Eastern limit of the region we are
+    !Config         interested in. Between -180 and +180 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees] 
+    !-
+    limit_east = 180.
+    CALL getin_p('LIMIT_EAST',limit_east)
+    !-
+    !Config Key   = LIMIT_NORTH
+    !Config Desc  = Northern limit of region
+    !Config If    = [-]
+    !Config Def   = 90.
+    !Config Help  = Northern limit of the region we are
+    !Config         interested in. Between +90 and -90 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees]
+    !-
+    limit_north = 90.
+    CALL getin_p('LIMIT_NORTH',limit_north)
+    !-
+    !Config Key   = LIMIT_SOUTH
+    !Config Desc  = Southern limit of region
+    !Config If    = [-]
+    !Config Def   = -90.
+    !Config Help  = Southern limit of the region we are
+    !Config         interested in. Between 90 and -90 degrees
+    !Config         The model will use the smalest regions from
+    !Config         region specified here and the one of the forcing file.
+    !Config Units = [Degrees]
+    !-
+    limit_south = -90.
+    CALL getin_p('LIMIT_SOUTH',limit_south)
+    !- 
+    !- Calculate domain size
+    !-
+    IF ( interpol ) THEN
+       !-
+       !- If we use temporal interpolation, then we cannot change the resolution (yet?)
+       !-
+       ALLOCATE(i_index(iim_full), j_index(jjm_full),j_index_g(jjm_full))
+       IF (is_root_prc) THEN
+
+          CALL domain_size (limit_west, limit_east, limit_north, limit_south,&
+               &         iim_full, jjm_full, lon_full, lat_full, iim_zoom, jjm_zoom,&
+               &         i_index, j_index_g)
+
+          j_index(:)=j_index_g(:)
+
+          ALLOCATE(qair(iim_full,jjm_full))
+          CALL flinget (force_id,'Qair',iim_full, jjm_full, 1, ttm_full,  1, 1, data_full)
+          CALL forcing_zoom(data_full, qair)
+
+          CALL flinquery_var(force_id, 'contfrac', contfrac_exists)
+          IF ( contfrac_exists ) THEN
+             WRITE(numout,*) "contfrac exist in the forcing file."
+             CALL flinget (force_id,'contfrac',iim_full, jjm_full, 1, ttm_full,  1, 1, data_full)
+             CALL forcing_zoom(data_full, fcontfrac)
+             WRITE(numout,*) "fcontfrac min/max :",MINVAL(fcontfrac(1:iim_zoom,1:jjm_zoom)),MAXVAL(fcontfrac(1:iim_zoom,1:jjm_zoom))
+          ELSE
+             fcontfrac(:,:)=1.
+          ENDIF
+
+
+          DO i=1,iim_zoom
+             DO j=1,jjm_zoom
+                IF ( fcontfrac(i,j) <= EPSILON(1.) ) THEN
+                   qair(i,j) = 999999.
+                ENDIF
+             ENDDO
+          ENDDO
+
+          ALLOCATE(index_l(iim_zoom*jjm_zoom))
+          !- In this point is returning the global NbPoint with the global index
+          CALL forcing_landind(iim_zoom,jjm_zoom,qair,.TRUE.,NbPoint,index_l,i_test,j_test)
+          ! 
+          ! Work out the vertical layers to be used 
+          ! 
+          CALL forcing_vertical(force_id) 
+       ELSE
+          ALLOCATE(index_l(1))
+       ENDIF
+
+       ! Initiate global grid and parallelism
+       CALL bcast(iim_zoom)
+       CALL bcast(jjm_zoom)
+       CALL bcast(NbPoint)
+       CALL set_grid_glo(iim_zoom,jjm_zoom,NbPoint)
+       CALL allocate_grid_glo
+       !
+       !- global index index_g is the index_l of root proc 
+       IF (is_root_prc) index_g(:)=index_l(1:NbPoint)
+
+       DEALLOCATE(index_l)
+
+       ! 
+       ! Distribute to all processors the information on the forcing 
+       ! 
+       CALL bcast(index_g)
+       CALL Init_orchidee_data_para_driver(nbp_glo,index_g)
+       CALL init_ioipsl_para
+!     CALL Init_writeField_p
+
+       CALL bcast(jjm_zoom)
+       CALL bcast(i_index)
+       CALL bcast(j_index_g)
+       CALL bcast(zfixed) 
+       CALL bcast(zsigma) 
+       CALL bcast(zhybrid) 
+       CALL bcast(zlevels) 
+       CALL bcast(zheight) 
+       CALL bcast(zsamelev_uv) 
+       CALL bcast(zlev_fixed) 
+       CALL bcast(zlevuv_fixed) 
+       CALL bcast(zhybrid_a) 
+       CALL bcast(zhybrid_b) 
+       CALL bcast(zhybriduv_a)  
+       CALL bcast(zhybriduv_b) 
+       ind=0
+       DO j=1,jjm_zoom
+          IF ( (j >= jj_begin) .AND. (j <= jj_end) ) THEN
+             ind=ind+1
+             j_index(ind)=j_index_g(j)
+          ENDIF
+       ENDDO
+
+       jjm_zoom=jj_nb
+       iim_zoom=iim_g
+
+       !-
+       !- If we use the weather generator, then we read zonal and meridional resolutions
+       !- This should be unified one day...
+       !-
+    ELSEIF ( weathergen ) THEN
+       !-
+       !Config Key   = MERID_RES
+       !Config Desc  = North-South Resolution
+       !Config Def   = 2.
+       !Config If    = ALLOW_WEATHERGEN
+       !Config Help  = North-South Resolution of the region we are
+       !Config         interested in. 
+       !Config Units = [Degrees]
+       !-
+       merid_res = 2.
+       CALL getin_p('MERID_RES',merid_res)
+       !-
+       !Config Key   = ZONAL_RES
+       !Config Desc  = East-West Resolution
+       !Config Def   = 2.
+       !Config If    = ALLOW_WEATHERGEN
+       !Config Help  = East-West Resolution of the region we are
+       !Config         interested in. In degrees
+       !Config Units = [Degrees] 
+       !-
+       zonal_res = 2.
+       CALL getin_p('ZONAL_RES',zonal_res)
+       !-
+       !- Number of time steps is meaningless in this case
+       !-
+       !    ttm_full = HUGE( ttm_full )
+       !MM Number (realistic) of time steps for half hour dt
+       ttm_full = NINT(one_year * 86400. / dt_force)
+       !-
+       IF (is_root_prc) THEN
+
+          !- In this point is returning the global NbPoint with the global index
+          CALL weathgen_domain_size (limit_west,limit_east,limit_north,limit_south, &
+               zonal_res,merid_res,iim_zoom,jjm_zoom)
+          ALLOCATE(index_l(iim_zoom*jjm_zoom))
+       ENDIF
+       CALL bcast(iim_zoom)
+       CALL bcast(jjm_zoom)
+
+       ALLOCATE(lon(iim_zoom,jjm_zoom))
+       ALLOCATE(lat(iim_zoom,jjm_zoom))
+       ALLOCATE(lev(llm_full),levuv(llm_full))
+       
+       ! We need lon and lat now for weathgen_init
+       CALL forcing_grid (iim_zoom,jjm_zoom,llm_full,lon,lat,init_f=.TRUE.)
+       CALL forcing_vertical(-1) 
+
+       IF (is_root_prc) THEN
+          CALL weathgen_init &
+               &        (filename,dt_force,force_id,iim_zoom,jjm_zoom, &
+               &         zonal_res,merid_res,lon,lat,index_l,NbPoint)
+!!$,&
+!!$               &         i_index,j_index_g)
+       ELSE
+          ALLOCATE(index_l(1))
+          index_l(1)=1
+       ENDIF
+
+       CALL bcast(NbPoint)
+       CALL set_grid_glo(iim_zoom,jjm_zoom,NbPoint)
+       CALL allocate_grid_glo
+
+       !
+       !- global index index_g is the index_l of root proc 
+       IF (is_root_prc) index_g(:)=index_l(1:NbPoint)
+
+       DEALLOCATE(index_l)
+
+     CALL bcast(index_g)
+     CALL Init_orchidee_data_para_driver(nbp_glo,index_g)
+     CALL init_ioipsl_para
+!     CALL Init_writeField_p
+     CALL bcast(jjm_zoom)
+!!$       CALL bcast(i_index)
+!!$       CALL bcast(j_index_g)
+
+!!$       ind=0
+!!$       DO j=1,jjm_zoom
+!!$          IF ( (j >= jj_begin) .AND. (j <= jj_end) ) THEN
+!!$             ind=ind+1
+!!$             j_index(ind)=j_index_g(j)
+!!$          ENDIF
+!!$       ENDDO
+
+       jjm_zoom=jj_nb
+       iim_zoom=iim_g
+       !
+       CALL weathgen_read_file(force_id,iim_zoom,jjm_zoom)
+
+       !-
+    ELSE
+       !-
+       STOP 'ERROR: Neither interpolation nor weather generator is specified.'
+       !-
+    ENDIF
+    !-
+    !- Transfer the right information to the caller
+    !-
+    iim = iim_zoom
+    jjm = jjm_zoom
+    llm = 1
+    tm = ttm_full
+    !-
+    IF ( debug ) WRITE(numout,*) 'forcing_info : end : ', iim,jjm, llm,tm
+    !-
+  END SUBROUTINE forcing_info
+!-
+!-
+!=====================================================================
+SUBROUTINE forcing_read &
+  & (filename, rest_id, lrstread, lrstwrite, &
+  &  itauin, istp, itau_split, split, nb_spread, netrad_cons, date0,   &
+  &  dt_force, iim, jjm, lon, lat, zlev, zlevuv, ttm, &
+  &  swdown, sinang, precip, snowf, tair, u, v, qair, pb, lwdown, &
+  &  fcontfrac, fneighbours, fresolution, &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+  &  kindex, nbindex, force_id)
+!---------------------------------------------------------------------
+!- filename   : name of the file to be opened
+!- rest_id    : ID of restart file
+!- lrstread   : read restart file?
+!- lrstwrite  : write restart file?
+!- itauin     : time step for which we need the data
+!- istp       : time step for restart file
+!- itau_split : Where are we within the splitting
+!-              of the time-steps of the forcing files
+!-              (it decides IF we READ or not)
+!- split      : The number of time steps we do
+!-              between two time-steps of the forcing
+!- nb_spread  : Over how many time steps do we spread the precipitation
+!- netrad_cons: flag that decides if net radiation should be conserved.
+!- date0      : The date at which the forcing file starts (julian days)
+!- dt_force   : time-step of the forcing file in seconds
+!- iim        : Size of the grid in x
+!- jjm        : size of the grid in y
+!- lon        : Longitudes
+!- lat        : Latitudes
+!- zlev       : First Levels if it exists (ie if watchout file)
+!- zlevuv     : First Levels of the wind (equal precedent, if it exists)
+!- ttm        : number of time steps in all in the forcing file
+!- swdown     : Downward solar radiation (W/m^2)
+!- sinang
+!- precip     : Precipitation (Rainfall) (kg/m^2s)
+!- snowf      : Snowfall (kg/m^2s)
+!- tair       : 1st level (2m ? in off-line) air temperature (K)
+!- u and v    : 1st level (2m/10m ? in off-line) (in theory !) wind speed (m/s)
+!- qair       : 1st level (2m ? in off-line) humidity (kg/kg)
+!- pb         : Surface pressure (Pa)
+!- lwdown     : Downward long wave radiation (W/m^2)
+!- fcontfrac  : Continental fraction (no unit)
+!- fneighbours: land neighbours
+!- fresolution: resolution in x and y dimensions for each points
+!-
+!- From a WATCHOUT file :
+!- SWnet      : Net surface short-wave flux
+!- Eair       : Air potential energy
+!- petAcoef   : Coeficients A from the PBL resolution for T
+!- peqAcoef   : Coeficients A from the PBL resolution for q
+!- petBcoef   : Coeficients B from the PBL resolution for T
+!- peqBcoef   : Coeficients B from the PBL resolution for q
+!- cdrag      : Surface drag
+!- ccanopy    : CO2 concentration in the canopy
+!-
+!- kindex     : Index of all land-points in the data
+!-              (used for the gathering)
+!- nbindex    : Number of land points
+!- force_id   : FLINCOM file id.
+!-              It is used to close the file at the end of the run.
+!-
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   CHARACTER(LEN=*) :: filename
+   INTEGER, INTENT(IN) :: force_id
+   INTEGER, INTENT(INOUT) :: nbindex
+   INTEGER :: rest_id
+   LOGICAL :: lrstread, lrstwrite
+   INTEGER :: itauin, istp, itau_split, split, nb_spread
+   LOGICAL :: netrad_cons
+   REAL    :: date0, dt_force
+   INTEGER :: iim, jjm, ttm
+   REAL,DIMENSION(iim,jjm) :: lon, lat, zlev, zlevuv, &
+  & swdown, sinang, precip, snowf, tair, u, v, qair, pb, lwdown, &
+  & fcontfrac
+   REAL,DIMENSION(iim,jjm,2) :: fresolution
+   INTEGER,DIMENSION(iim,jjm,8) :: fneighbours
+   ! for watchout files
+   REAL,DIMENSION(iim,jjm) :: &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy
+   INTEGER,DIMENSION(iim*jjm), INTENT(INOUT) :: kindex
+!-
+   INTEGER :: ik,i,j
+!
+   IF ( interpol ) THEN
+!-
+     CALL forcing_read_interpol &
+         (filename, itauin, itau_split, split, nb_spread, netrad_cons, date0,   &
+          dt_force, iim, jjm, lon, lat, zlev, zlevuv, ttm, &
+          swdown, sinang, precip, snowf, tair, u, v, qair, pb, lwdown, &
+          fcontfrac, fneighbours, fresolution, &
+          SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+          kindex, nbindex, force_id)
+!-
+   ELSEIF ( weathergen ) THEN
+!-
+      IF (lrstread) THEN
+         fcontfrac(:,:) = 1.0
+         WRITE(numout,*) 'contfrac : ', MINVAL(fcontfrac), MAXVAL(fcontfrac)
+      ENDIF
+
+      IF ( (itauin == 0).AND.(itau_split == 0) ) THEN
+         CALL weathgen_main (istp, istp, filename, force_id, iim, jjm, 1, &
+              rest_id, lrstread, lrstwrite, &
+              limit_west, limit_east, limit_north, limit_south, &
+              zonal_res, merid_res, lon, lat, date0, dt_force, &
+              kindex, nbindex, &
+              swdown, precip, snowf, tair, u, v, qair, pb, lwdown)
+      ELSE
+         CALL weathgen_main (itauin, istp, filename, force_id, iim, jjm, 1, &
+              rest_id, lrstread, lrstwrite, &
+              limit_west, limit_east, limit_north, limit_south, &
+              zonal_res, merid_res, lon, lat, date0, dt_force, &
+              kindex, nbindex, &
+              swdown, precip, snowf, tair, u, v, qair, pb, lwdown)
+      ENDIF
+!-
+      IF ( (itauin == 0).AND.(itau_split == 0) ) THEN
+         !---
+         !--- Allocate grid stuff
+         !---
+         CALL init_grid ( nbindex )
+         !---
+         !--- Compute
+         !---
+         CALL grid_stuff(nbp_glo, iim_g, jjm_g, lon_g, lat_g, kindex)
+         !CALL grid_stuff (nbindex, iim, jjm, lon, lat, kindex)
+         DO ik=1,nbindex
+         
+            j = ((kindex(ik)-1)/iim) + 1
+            i = (kindex(ik) - (j-1)*iim)
+            !-
+            !- Store variable to help describe the grid
+            !- once the points are gathered.
+            !-
+            fneighbours(i,j,:) = neighbours(ik,:)
+            !
+            fresolution(i,j,:) = resolution(ik,:)
+         ENDDO
+      ENDIF
+   ELSE
+!-
+     STOP 'ERROR: Neither interpolation nor weather generator is specified.'
+!-
+   ENDIF
+!-
+   IF (.NOT. is_watchout) THEN
+      ! We have to compute Potential air energy
+      WHERE(tair(:,:) < val_exp) 
+         eair(:,:) = cp_air*tair(:,:)+cte_grav*zlev(:,:)
+      ENDWHERE
+   ENDIF
+!-
+!
+!-------------------------
+END SUBROUTINE forcing_read
+!=====================================================================
+!-
+!-
+!=====================================================================
+SUBROUTINE forcing_read_interpol &
+  & (filename, itauin, itau_split, split, nb_spread, netrad_cons, date0,   &
+  &  dt_force, iim, jjm, lon, lat, zlev, zlevuv, ttm, swdown, sinang, rainf, snowf, tair, &
+  &  u, v, qair, pb, lwdown, &
+  &  fcontfrac, fneighbours, fresolution, &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+  &  kindex, nbindex, force_id)
+!---------------------------------------------------------------------
+!- filename   : name of the file to be opened
+!- itauin     : time step for which we need the data
+!- itau_split : Where are we within the splitting
+!-              of the time-steps of the forcing files
+!-              (it decides IF we READ or not)
+!- split      : The number of time steps we do
+!-              between two time-steps of the forcing
+!- nb_spread  : Over how many time steps do we spread the precipitation
+!- netrad_cons: flag that decides if net radiation should be conserved.
+!- date0      : The date at which the forcing file starts (julian days)
+!- dt_force   : time-step of the forcing file in seconds
+!- iim        : Size of the grid in x
+!- jjm        : size of the grid in y
+!- lon        : Longitudes
+!- lat        : Latitudes
+!- zlev       : First Levels if it exists (ie if watchout file)
+!- zlevuv     : First Levels of the wind (equal precedent, if it exists)
+!- ttm        : number of time steps in all in the forcing file
+!- swdown     : Downward solar radiation (W/m^2)
+!- sinang
+!- rainf      : Rainfall (kg/m^2s)
+!- snowf      : Snowfall (kg/m^2s)
+!- tair       : 2m air temperature (K)
+!- u and v    : 2m (in theory !) wind speed (m/s)
+!- qair       : 2m humidity (kg/kg)
+!- pb         : Surface pressure (Pa)
+!- lwdown     : Downward long wave radiation (W/m^2)
+!- fcontfrac  : Continental fraction (no unit)
+!- fneighbours: land neighbours
+!- fresolution: resolution in x and y dimensions for each points
+!-
+!- From a WATCHOUT file :
+!- SWnet      : Net surface short-wave flux
+!- Eair       : Air potential energy
+!- petAcoef   : Coeficients A from the PBL resolution for T
+!- peqAcoef   : Coeficients A from the PBL resolution for q
+!- petBcoef   : Coeficients B from the PBL resolution for T
+!- peqBcoef   : Coeficients B from the PBL resolution for q
+!- cdrag      : Surface drag
+!- ccanopy    : CO2 concentration in the canopy
+!- 
+!- kindex     : Index of all land-points in the data
+!-              (used for the gathering)
+!- nbindex    : Number of land points
+!- force_id   : FLINCOM file id.
+!-              It is used to close the file at the end of the run.
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER,PARAMETER :: lm=1
+!-
+!- Input variables
+!-
+   CHARACTER(LEN=*) :: filename
+   INTEGER :: itauin, itau_split, split, nb_spread
+   LOGICAL :: netrad_cons
+   REAL    :: date0, dt_force
+   INTEGER :: iim, jjm, ttm
+   REAL,DIMENSION(:,:),INTENT(IN) :: lon, lat   !- LOCAL data array (size=iim,jjm)
+   INTEGER, INTENT(IN) :: force_id
+!-
+!- Output variables
+!-
+   REAL,DIMENSION(:,:),INTENT(OUT) :: zlev, zlevuv, &  !- LOCAL data array (size=iim,jjm)
+  &  swdown, sinang, rainf, snowf, tair, u, v, qair, pb, lwdown, &
+  &  fcontfrac
+   REAL,DIMENSION(:,:,:),INTENT(OUT) :: fresolution    !- LOCAL data array (size=iim,jjm,2)
+   INTEGER,DIMENSION(:,:,:),INTENT(OUT) :: fneighbours !- LOCAL data array (size=iim,jjm,8)
+   ! for watchout files
+   REAL,DIMENSION(:,:),INTENT(OUT) :: &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy
+   INTEGER,DIMENSION(:),INTENT(INOUT) :: kindex    !- LOCAL index of the map
+   INTEGER, INTENT(INOUT) :: nbindex
+!-
+!- Local variables
+!-
+   INTEGER, SAVE :: last_read=0
+   INTEGER, SAVE :: itau_read, itau_read_nm1=0, itau_read_n=0
+   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:) :: &
+  &  zlev_nm1, zlevuv_nm1, swdown_nm1, rainf_nm1, snowf_nm1, tair_nm1, u_nm1, v_nm1, qair_nm1, & 
+  &  pb_nm1, lwdown_nm1, & 
+  &  zlev_n, zlevuv_n, swdown_n, rainf_n, snowf_n, tair_n, u_n, v_n, qair_n, &
+  &  pb_n, lwdown_n, mean_sinang
+
+   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:) :: &
+  &  startday_n, startday_nm1, daylength_n, daylength_nm1, tmax_n, tmax_nm1, tmin_nm1, tmin_nm2, tmin_n,   &
+  &  qsatta, qsattmin_n, qsattmin_nm1, qmin_n, qmin_nm1, qmax_n, qmax_nm1, qsa
+   REAL,SAVE    :: hour
+
+!  just for grid stuff if the forcing file is a watchout file
+   REAL, ALLOCATABLE, DIMENSION(:,:) :: tmpdata
+   ! variables to be read in watchout files
+   REAL,SAVE,ALLOCATABLE,DIMENSION(:,:) :: &
+  &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+  &  SWnet_n, Eair_n, petAcoef_n, peqAcoef_n, petBcoef_n, peqBcoef_n, cdrag_n, ccanopy_n
+   REAL, SAVE :: julian_for ! Date of the forcing to be read
+   REAL :: julian, ss, rw
+!jur, 
+   REAL, SAVE :: julian0    ! First day of this year
+   INTEGER :: yy, mm, dd, is, i, j, ik
+!  if Wind_N and Wind_E are in the file (and not just Wind)
+   LOGICAL, SAVE :: wind_N_exists=.FALSE.
+   LOGICAL       :: wind_E_exists=.FALSE.
+   LOGICAL, SAVE :: contfrac_exists=.FALSE.
+   LOGICAL, SAVE :: neighbours_exists=.FALSE.
+   LOGICAL, SAVE :: initialized = .FALSE.
+   LOGICAL :: check=.FALSE.
+!  to bypass FPE problem on integer convertion with missing_value heigher than precision
+   INTEGER, PARAMETER                         :: undef_int = 999999999
+!---------------------------------------------------------------------
+   IF (check) THEN
+     WRITE(numout,*) &
+    &  " FORCING READ : itau_read, itau_split : ",itauin,itau_split
+   ENDIF
+!-
+!!$   itau_read = itauin
+   itau_read = MOD((itauin-1),ttm)+1
+!-
+!- This part initializes the reading of the forcing. As you can see
+!- we only go through here if both time steps are zero.
+!- 
+   IF ( (itau_read == 0).AND.(itau_split == 0) ) THEN
+!-
+!- Tests on forcing file type
+     CALL flinquery_var(force_id, 'Wind_N', wind_N_exists)
+     IF ( wind_N_exists ) THEN
+        CALL flinquery_var(force_id, 'Wind_E', wind_E_exists)
+        IF ( .NOT. wind_E_exists ) THEN
+           CALL ipslerr_p(3,'forcing_read_interpol', &
+   &             'Variable Wind_E does not exist in forcing file', &
+   &             'But variable Wind_N exists.','Please, rename Wind_N to Wind;') 
+        ENDIF
+     ENDIF
+     CALL flinquery_var(force_id, 'levels', is_watchout)
+     IF ( is_watchout ) THEN
+        WRITE(numout,*) "Read a Watchout File."
+     ENDIF
+     CALL flinquery_var(force_id, 'contfrac', contfrac_exists)
+!-
+     IF (check) WRITE(numout,*) 'ALLOCATE all the memory needed'
+!-
+     ALLOCATE &
+    &  (swdown_nm1(iim,jjm), rainf_nm1(iim,jjm), snowf_nm1(iim,jjm), &
+    &   tair_nm1(iim,jjm), u_nm1(iim,jjm), v_nm1(iim,jjm), qair_nm1(iim,jjm), &
+    &   pb_nm1(iim,jjm), lwdown_nm1(iim,jjm))
+     ALLOCATE &
+    &  (swdown_n(iim,jjm), rainf_n(iim,jjm), snowf_n(iim,jjm), &
+    &   tair_n(iim,jjm), u_n(iim,jjm), v_n(iim,jjm), qair_n(iim,jjm), &
+    &   pb_n(iim,jjm), lwdown_n(iim,jjm))
+
+     IF(daily_interpol) THEN
+        ALLOCATE &
+       &  (startday_n(iim,jjm), startday_nm1(iim,jjm), daylength_n(iim,jjm), &
+       &   daylength_nm1(iim,jjm), tmax_n(iim,jjm), tmax_nm1(iim,jjm), tmin_n(iim,jjm), &
+       &   tmin_nm1(iim,jjm), tmin_nm2(iim,jjm), qsatta(iim,jjm), qsattmin_n(iim,jjm), qsattmin_nm1(iim,jjm), &
+       &   qmin_n(iim,jjm), qmin_nm1(iim,jjm), qmax_n(iim,jjm), qmax_nm1(iim,jjm), qsa(iim,jjm) )
+     ENDIF
+
+
+     ALLOCATE &
+    &  (zlev_nm1(iim,jjm), zlev_n(iim,jjm), zlevuv_nm1(iim,jjm), zlevuv_n(iim,jjm), &
+    &   SWnet_nm1(iim,jjm), Eair_nm1(iim,jjm), cdrag_nm1(iim,jjm), ccanopy_nm1(iim,jjm), &
+    &   petAcoef_nm1(iim,jjm), peqAcoef_nm1(iim,jjm), petBcoef_nm1(iim,jjm), peqBcoef_nm1(iim,jjm), &
+    &   SWnet_n(iim,jjm), Eair_n(iim,jjm), cdrag_n(iim,jjm), ccanopy_n(iim,jjm), &
+    &   petAcoef_n(iim,jjm), peqAcoef_n(iim,jjm), petBcoef_n(iim,jjm), peqBcoef_n(iim,jjm))
+     ALLOCATE &
+    &  (mean_sinang(iim,jjm))
+!-
+     IF (check) WRITE(numout,*) 'Memory ALLOCATED'
+!-
+!- We need for the driver surface air temperature and humidity before the
+!- the loop starts. Thus we read it here.
+!-     
+     CALL forcing_just_read (iim, jjm, zlev, zlevuv, ttm, 1, 1, &
+          &  swdown, rainf, snowf, tair, &
+          &  u, v, qair, pb, lwdown, &
+          &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+          &  force_id, wind_N_exists, check)
+!----
+
+!-- First in case it's not a watchout file
+     IF ( .NOT. is_watchout ) THEN
+        IF ( contfrac_exists ) THEN
+           WRITE(numout,*) "contfrac exist in the forcing file."
+           CALL flinget (force_id,'contfrac',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+           CALL forcing_zoom(data_full, fcontfrac)
+           WRITE(numout,*) "fcontfrac min/max :",MINVAL(fcontfrac(1:iim_zoom,jjm_zoom)),MAXVAL(fcontfrac(1:iim_zoom,jjm_zoom))
+           !
+           ! We need to make sure that when we gather the points we pick all
+           ! the points where contfrac is above 0. Thus we prepare tair for
+           ! subroutine forcing_landind
+           !
+           DO i=1,iim
+              DO j=1,jjm
+                 IF ( j==1 .AND. i<ii_begin) fcontfrac(i,j)=0.     ! bande de recouvrement du scatter2D 
+                 IF ( j==jjm .AND. i>ii_end) fcontfrac(i,j)=0.     ! => on mets les données qu'on veut pas du noeud à missing_value
+                 IF ( fcontfrac(i,j) <= EPSILON(1.) ) THEN
+                    tair(i,j) = 999999.
+                 ENDIF
+              ENDDO
+           ENDDO
+        ELSE
+           fcontfrac(:,:) = 1.0
+        ENDIF
+        !---
+        !--- Create the index table
+        !---
+        !--- This job return a LOCAL kindex
+        CALL forcing_landind(iim, jjm, tair, check, nbindex, kindex, i_test, j_test)
+#ifdef CPP_PARA
+        ! We keep previous function forcing_landind, only to get a valid (i_test,j_test) 
+        ! Force nbindex points for parallel computation
+        nbindex=nbp_loc
+        CALL scatter(index_g,kindex(1:nbindex))
+        kindex(1:nbindex)=kindex(1:nbindex)-(jj_begin-1)*iim_g
+#endif
+        ik=MAX(nbindex/2,1)
+        j_test = (((kindex(ik)-1)/iim) + 1)
+        i_test = (kindex(ik) - (j_test-1)*iim)
+        IF (check) THEN
+           WRITE(numout,*) 'New test point is : ', i_test, j_test
+        ENDIF
+        !---
+        !--- Allocate grid stuff
+        !---
+        CALL init_grid ( nbindex )
+        !---
+        !--- All grid variables
+        !---
+        CALL grid_stuff(nbp_glo, iim_g, jjm_g, lon_g, lat_g, kindex)
+        DO ik=1,nbindex
+           !
+           j = ((kindex(ik)-1)/iim) + 1
+           i = (kindex(ik) - (j-1)*iim)
+           !-
+           !- Store variable to help describe the grid
+           !- once the points are gathered.
+              !-
+           fneighbours(i,j,:) = neighbours(ik,:)
+           !
+           fresolution(i,j,:) = resolution(ik,:)
+        ENDDO
+     ELSE
+!-- Second, in case it is a watchout file
+        ALLOCATE (tmpdata(iim,jjm))
+        tmpdata(:,:) = 0.0
+!--
+        IF ( .NOT. contfrac_exists ) THEN
+           CALL ipslerr_p (3,'forcing_read_interpol', &
+ &          'Could get contfrac variable in a watchout file :',TRIM(filename), &
+ &          '(Problem with file ?)')
+        ENDIF
+        CALL flinget (force_id,'contfrac',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, fcontfrac)
+        !
+        ! We need to make sure that when we gather the points we pick all
+        ! the points where contfrac is above 0. Thus we prepare tair for
+        ! subroutine forcing_landind
+        !
+        DO i=1,iim
+           DO j=1,jjm
+	      IF ( j==1 .AND. i<ii_begin) fcontfrac(i,j)=0.
+	      IF ( j==jjm .AND. i>ii_end) fcontfrac(i,j)=0.
+              IF ( fcontfrac(i,j) <= EPSILON(1.) ) THEN
+                 tair(i,j) = 999999.
+              ENDIF
+           ENDDO
+        ENDDO
+        !---
+        !--- Create the index table
+        !---
+        !--- This job return a LOCAL kindex
+        CALL forcing_landind(iim, jjm, tair, check, nbindex, kindex, i_test, j_test)
+#ifdef CPP_PARA
+        ! We keep previous function forcing_landind, only to get a valid (i_test,j_test) 
+        ! Force nbindex points for parallel computation
+        nbindex=nbp_loc
+        CALL scatter(index_g,kindex)
+        kindex(:)=kindex(:)-offset
+!        kindex(:)=kindex(:)-(jj_begin-1)*iim_g
+#endif
+        ik=MAX(nbindex/2,1)
+        j_test = (((kindex(ik)-1)/iim) + 1)
+        i_test = (kindex(ik) - (j_test-1)*iim)
+        IF (check) THEN
+           WRITE(numout,*) 'New test point is : ', i_test, j_test
+        ENDIF
+        !---
+        !--- Allocate grid stuff
+        !---
+        CALL init_grid ( nbindex )
+        neighbours(:,:) = -1
+        resolution(:,:) = 0.
+        min_resol(:) = 1.e6
+        max_resol(:) = -1.
+        !---
+        !--- All grid variables
+        !---
+        !-
+        !- Get variables to help describe the grid
+        CALL flinquery_var(force_id, 'neighboursNN', neighbours_exists)
+        IF ( .NOT. neighbours_exists ) THEN
+           CALL ipslerr_p (3,'forcing_read_interpol', &
+ &          'Could get neighbours in a watchout file :',TRIM(filename), &
+ &          '(Problem with file ?)')
+        ELSE
+           WRITE(numout,*) "Watchout file contains neighbours and resolutions."
+        ENDIF
+        !
+        fneighbours(:,:,:) = undef_int
+        !
+        !- once the points are gathered.
+        CALL flinget (force_id,'neighboursNN',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,1) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget (force_id,'neighboursNE',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,2) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget (force_id,'neighboursEE',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,3) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget (force_id,'neighboursSE',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,4) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget (force_id,'neighboursSS',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,5) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget (force_id,'neighboursSW',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,6) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget (force_id,'neighboursWW',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,7) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        CALL flinget (force_id,'neighboursNW',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        WHERE(tmpdata(:,:) < undef_int)
+           fneighbours(:,:,8) = NINT(tmpdata(:,:))
+        ENDWHERE
+        !
+        ! now, resolution of the grid
+        CALL flinget (force_id,'resolutionX',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        fresolution(:,:,1) = tmpdata(:,:)
+        !
+        CALL flinget (force_id,'resolutionY',iim_full, jjm_full, llm_full, ttm,  1, 1, data_full)
+        CALL forcing_zoom(data_full, tmpdata)
+        fresolution(:,:,2) = tmpdata(:,:)
+        !
+        DO ik=1,nbindex
+           !
+           j = ((kindex(ik)-1)/iim) + 1
+           i = (kindex(ik) - (j-1)*iim)
+           !-
+           !- Store variable to help describe the grid
+           !- once the points are gathered.
+           !-
+           neighbours(ik,:) = fneighbours(i,j,:)  
+           !
+           resolution(ik,:) = fresolution(i,j,:)
+           !
+        
+        ENDDO
+        CALL gather(neighbours,neighbours_g)
+        CALL gather(resolution,resolution_g)
+        min_resol(1) = MINVAL(resolution(:,1))
+        min_resol(2) = MAXVAL(resolution(:,2))
+        max_resol(1) = MAXVAL(resolution(:,1))
+        max_resol(2) = MAXVAL(resolution(:,2))
+        !
+        area(:) = resolution(:,1)*resolution(:,2)
+        CALL gather(area,area_g)
+!--
+        DEALLOCATE (tmpdata)
+     ENDIF
+     WRITE(numout,*) 'contfrac : ', MINVAL(fcontfrac), MAXVAL(fcontfrac)
+!---
+   ENDIF
+!---
+   IF (check) THEN
+      WRITE(numout,*) &
+           & 'The dates : ',itau_read,itau_split,itau_read_nm1,itau_read_n
+   ENDIF
+!---
+!--- Here we do the work in case only interpolation is needed.
+!---
+   IF ( initialized .AND. interpol ) THEN
+!---
+      IF ( daily_interpol ) THEN
+
+         IF (split > 1) THEN
+            IF ( itau_split <= (split/2.) ) THEN
+               rw = REAL(itau_split+split/2.)/split
+            ELSE 
+               rw = REAL(itau_split-split/2.)/split
+            ENDIF
+         ELSE
+            rw = 1.
+         ENDIF
+
+         IF ((last_read == 0) .OR. ( rw==(1./split)) ) THEN
+   !---
+   !-----   Start or Restart
+            IF (last_read == 0) THEN
+               ! Case of a restart or a shift in the forcing file.
+               IF (itau_read > 1) THEN
+                  itau_read_nm1=itau_read-1
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tmin_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists, check)
+                  CALL forcing_just_read_tmax (iim, jjm, ttm, itau_read_nm1, itau_read_nm1, tmax_nm1, force_id )
+               ! Case of a simple start.
+               ELSE 
+                  itau_read_nm1 = un
+                  WRITE(numout,*) "we will use the forcing of the first day to initialize "
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tmin_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists, check)
+                  CALL forcing_just_read_tmax (iim, jjm, ttm, itau_read_nm1, itau_read_nm1, tmax_nm1, force_id )
+               ENDIF
+               tmin_nm2(:,:)=tmin_nm1(:,:)
+               IF ( dt_force .GT. 3600. ) THEN
+                  mean_sinang(:,:) = 0.0
+                  daylength_n(:,:) = 0.
+                  DO is=1,split
+                     !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+                     julian = julian_for+((is-0.5)/split)*dt_force/one_day
+      !!$               julian = julian_for+(FLOAT(is)/split)*dt_force/one_day
+                     CALL solarang (julian, julian0, iim, jjm, lon*0, lat, sinang)
+                     mean_sinang(:,:) = mean_sinang(:,:)+sinang(:,:)
+                     WHERE( sinang(:,:) > 0. ) 
+                        daylength_n(:,:)=daylength_n(:,:)+1./split*24
+                     ENDWHERE
+                  ENDDO
+                  mean_sinang(:,:) = mean_sinang(:,:)/split
+                  daylength_nm1(:,:)=daylength_n(:,:)
+      !            WRITE(*,*) "mean_sinang =",MAXVAL(mean_sinang)
+               ENDIF
+            ELSE
+   !-----   Normal mode : copy old step
+               swdown_nm1(:,:) = swdown_n(:,:)
+               rainf_nm1(:,:) = rainf_n(:,:)
+               snowf_nm1(:,:)  = snowf_n(:,:) 
+               tair_nm1(:,:)   = tair_n(:,:)
+               u_nm1(:,:)      = u_n(:,:)
+               v_nm1(:,:)      = v_n(:,:)
+               qair_nm1(:,:)   = qair_n(:,:)
+               pb_nm1(:,:)     = pb_n(:,:)
+               lwdown_nm1(:,:) = lwdown_n(:,:)
+               tmin_nm2(:,:)   = tmin_nm1(:,:)
+               tmin_nm1(:,:)   = tmin_n(:,:)
+               tmax_nm1(:,:)   = tmax_n(:,:)
+
+               IF (is_watchout) THEN
+                  zlev_nm1(:,:)   = zlev_n(:,:)
+                  zlevuv_nm1(:,:) = zlevuv_n(:,:)
+                  ! Net surface short-wave flux
+                  SWnet_nm1(:,:) = SWnet_n(:,:)
+                  ! Air potential energy
+                  Eair_nm1(:,:)   = Eair_n(:,:)
+                  ! Coeficients A from the PBL resolution for T
+                  petAcoef_nm1(:,:) = petAcoef_n(:,:)
+                  ! Coeficients A from the PBL resolution for q
+                  peqAcoef_nm1(:,:) = peqAcoef_n(:,:)
+                  ! Coeficients B from the PBL resolution for T
+                  petBcoef_nm1(:,:) = petBcoef_n(:,:)
+                  ! Coeficients B from the PBL resolution for q
+                  peqBcoef_nm1(:,:) = peqBcoef_n(:,:)
+                  ! Surface drag
+                  cdrag_nm1(:,:) = cdrag_n(:,:)
+                  ! CO2 concentration in the canopy
+                  ccanopy_nm1(:,:) = ccanopy_n(:,:)
+               ENDIF
+               itau_read_nm1 = itau_read_n
+            ENDIF
+   !-----
+   !-----
+            IF(last_read==0)THEN
+               itau_read_n = itau_read
+            ELSE
+               itau_read_n = itau_read+1
+            ENDIF
+
+            IF (itau_read_n > ttm) THEN
+               WRITE(numout,*) 'WARNING --WARNING --WARNING --WARNING '
+               WRITE(numout,*) &
+                    &  'WARNING : We are going back to the start of the file'
+               itau_read_n =1
+            ENDIF
+            IF (check) THEN
+               WRITE(numout,*) &
+                    & 'The dates 2 : ',itau_read,itau_split,itau_read_nm1,itau_read_n
+            ENDIF
+   !-----
+   !----- Get a reduced julian day !
+   !----- This is needed because we lack the precision on 32 bit machines.
+   !-----
+            IF ( dt_force .GT. 3600. ) THEN
+               julian_for = itau2date(itau_read-1, date0, dt_force)
+               CALL ju2ymds (julian_for, yy, mm, dd, ss)
+   
+               ! first day of this year
+               CALL ymds2ju (yy,1,1,0.0, julian0)
+   !-----
+               IF (check) THEN
+                  WRITE(numout,*) 'Forcing for Julian day ',julian_for,'is read'
+                  WRITE(numout,*) 'Date for this day ',yy,' / ',mm,' / ',dd,"  ",ss
+               ENDIF
+            ENDIF
+   !-----
+            CALL forcing_just_read (iim, jjm, zlev_n, zlevuv_n, ttm, itau_read_n, itau_read_n, &
+                 &  swdown_n, rainf_n, snowf_n, tmin_n, &
+                 &  u_n, v_n, qair_n, pb_n, lwdown_n, &
+                 &  SWnet_n, Eair_n, petAcoef_n, peqAcoef_n, petBcoef_n, peqBcoef_n, cdrag_n, ccanopy_n, &
+                 &  force_id, wind_N_exists, check)
+            CALL forcing_just_read_tmax (iim, jjm, ttm, itau_read_n, itau_read_n, tmax_n, force_id )
+
+   !---
+            last_read = itau_read_n
+   !-----
+   !----- Compute mean solar angle for the comming period
+   !-----
+            IF (check) WRITE(numout,*) 'Going into  solarang', split, one_day
+   !-----
+
+   !-----
+         ENDIF
+   !---
+        IF ( itau_split == 1. ) THEN  
+            IF ( dt_force .GT. 3600. ) THEN
+               mean_sinang(:,:) = 0.0
+               daylength_nm1(:,:)=daylength_n(:,:)
+               daylength_n(:,:) = 0.
+               DO is=1,split
+                  !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+                  julian = julian_for+((is-0.5)/split)*dt_force/one_day
+   !!$               julian = julian_for+(FLOAT(is)/split)*dt_force/one_day
+                  CALL solarang (julian, julian0, iim, jjm, lon*0, lat, sinang)
+                  mean_sinang(:,:) = mean_sinang(:,:)+sinang(:,:)
+                  WHERE( sinang(:,:) > 0. ) 
+                     daylength_n(:,:)=daylength_n(:,:)+1./split*24
+                  ENDWHERE
+               ENDDO
+               mean_sinang(:,:) = mean_sinang(:,:)/split
+   !            WRITE(*,*) "mean_sinang =",MAXVAL(mean_sinang)
+            ENDIF
+         ENDIF
+ 
+   !--- Do the interpolation
+         IF (check) WRITE(numout,*) 'Doing the interpolation between time steps'
+   !---
+
+         IF (check) WRITE(numout,*) 'Coeff of interpollation : ',rw
+   !---
+
+         pb(:,:) = (pb_n(:,:)-pb_nm1(:,:))*rw + pb_nm1(:,:)
+         u(:,:)  = (u_n(:,:)-u_nm1(:,:))*rw + u_nm1(:,:)
+         v(:,:)  = (v_n(:,:)-v_nm1(:,:))*rw + v_nm1(:,:)
+
+   !--- Take care of the height of the vertical levels 
+         zlev(:,:) = (zlev_n(:,:)-zlev_nm1(:,:))*rw + zlev_nm1(:,:) 
+         zlevuv(:,:) = (zlevuv_n(:,:)-zlevuv_nm1(:,:))*rw + zlevuv_nm1(:,:) 
+
+         hour=REAL(itau_split)/split*24
+         startday_n(:,:)=12.-daylength_n(:,:)/2.
+         startday_nm1(:,:)=12.-daylength_nm1(:,:)/2.
+
+         WHERE ( ( hour >= startday_n(:,:) ) .AND. ( hour > 12) .AND. ( hour <= 14) )
+            tair(:,:)=(tmax_nm1(:,:)-tmin_nm1(:,:))/2 * ( sin(pi/(14-startday_n(:,:))*(hour-0.5* &
+           &    (14.-startday_n(:,:))-startday_n(:,:))) )+ (tmax_nm1(:,:)+tmin_nm1(:,:))/2.
+         ELSEWHERE( ( hour >= startday_n(:,:) ) .AND. ( hour <= 12) )
+            tair(:,:)=(tmax_n(:,:)-tmin_n(:,:))/2 * ( sin(pi/(14-startday_n(:,:))*(hour-0.5* &
+           &    (14.-startday_n(:,:))-startday_n(:,:))) )+ (tmax_n(:,:)+tmin_n(:,:))/2.
+         ELSEWHERE ( hour < startday_n(:,:) )
+            tair(:,:)=(tmax_nm1(:,:)-tmin_n(:,:))/2.*sin(pi/(24.-14.+startday_nm1(:,:) )* &
+           &    (hour + 24.+0.5*(24.-14.+startday_nm1(:,:) )-14.))+(tmax_nm1(:,:)+tmin_n(:,:))/2.
+         ELSEWHERE
+            tair(:,:)=(tmax_nm1(:,:)-tmin_n(:,:))/2.*sin(pi/(24.-14.+startday_n(:,:))*(hour+0.5* &
+           &    (24.-14.+startday_n(:,:))-14.))+(tmax_nm1(:,:)+tmin_n(:,:))/2.
+         ENDWHERE
+
+         CALL weathgen_qsat_2d (iim,jjm,tmin_n,pb,qsattmin_n)
+         CALL weathgen_qsat_2d (iim,jjm,tmin_nm1,pb,qsattmin_nm1)
+         CALL weathgen_qsat_2d (iim,jjm,tair,pb,qsatta)
+
+         !---
+         qmin_nm1(:,:) = MIN(qair_nm1(:,:),0.99*qsattmin_nm1(:,:))
+         qmin_n(:,:) = MIN(qair_n(:,:),0.99*qsattmin_n(:,:))
+         qmax_nm1(:,:) = (qair_nm1(:,:)-qmin_nm1(:,:)) + qair_nm1(:,:)
+         qmax_n(:,:) = (qair_n(:,:)-qmin_n(:,:)) + qair_n(:,:)
+
+         qsa(:,:)  = 0.99*qsatta(:,:)
+
+
+         WHERE ( ( hour >= startday_n(:,:) ) .AND. ( hour > 12) .AND. ( hour <= 14) )
+            qair(:,:)=MIN(qsa(:,:),(qmax_nm1(:,:)-qmin_nm1(:,:))/2 * ( sin(pi/(14-startday_n(:,:))*(hour-0.5* &
+           &    (14.-startday_n(:,:))-startday_n(:,:))) )+ (qmax_nm1(:,:)+qmin_nm1(:,:))/2.)
+         ELSEWHERE( ( hour >= startday_n(:,:) ) .AND. ( hour <= 12) )
+            qair(:,:)=MIN(qsa(:,:),(qmax_n(:,:)-qmin_n(:,:))/2 * ( sin(pi/(14-startday_n(:,:))*(hour-0.5* &
+           &    (14.-startday_n(:,:))-startday_n(:,:))) )+ (qmax_n(:,:)+qmin_n(:,:))/2.)
+         ELSEWHERE ( hour < startday_n(:,:) )
+            qair(:,:)=MIN(qsa(:,:),(qmax_nm1(:,:)-qmin_n(:,:))/2.*sin(pi/(24.-14.+startday_nm1(:,:) )* &
+           &    (hour + 24.+0.5*(24.-14.+startday_nm1(:,:) )-14.))+(qmax_nm1(:,:)+qmin_n(:,:))/2.)
+         ELSEWHERE
+            qair(:,:)=MIN(qsa(:,:),(qmax_nm1(:,:)-qmin_n(:,:))/2.*sin(pi/(24.-14.+startday_n(:,:))*(hour+0.5* &
+           &    (24.-14.+startday_n(:,:))-14.))+(qmax_nm1(:,:)+qmin_n(:,:))/2.)
+         ENDWHERE
+
+         IF (is_watchout) THEN
+            SWnet(:,:) = (SWnet_n(:,:)-SWnet_nm1(:,:))*rw + SWnet_nm1(:,:)
+            Eair(:,:) = (Eair_n(:,:)-Eair_nm1(:,:))*rw + Eair_nm1(:,:)
+            petAcoef(:,:) = (petAcoef_n(:,:)-petAcoef_nm1(:,:))*rw + petAcoef_nm1(:,:)
+            peqAcoef(:,:) = (peqAcoef_n(:,:)-peqAcoef_nm1(:,:))*rw + peqAcoef_nm1(:,:)
+            petBcoef(:,:) = (petBcoef_n(:,:)-petBcoef_nm1(:,:))*rw + petBcoef_nm1(:,:)
+            peqBcoef(:,:) = (peqBcoef_n(:,:)-peqBcoef_nm1(:,:))*rw + peqBcoef_nm1(:,:)
+            cdrag(:,:) = (cdrag_n(:,:)-cdrag_nm1(:,:))*rw + cdrag_nm1(:,:)
+            ccanopy(:,:) = (ccanopy_n(:,:)-ccanopy_nm1(:,:))*rw + ccanopy_nm1(:,:)
+         ENDIF
+   !---
+   !--- Here we need to allow for an option
+   !--- where radiative energy is conserved
+   !---
+         IF ( netrad_cons ) THEN
+            lwdown(:,:) = lwdown_n(:,:)
+         ELSE
+            lwdown(:,:) = (lwdown_n(:,:)-lwdown_nm1(:,:))*rw + lwdown_nm1(:,:)
+         ENDIF
+   !---
+   !--- For the solar radiation we decompose the mean value
+   !--- using the zenith angle of the sun if the time step in the forcing data is 
+   !---- more than an hour. Else we use the standard linera interpolation
+   !----
+         IF (check) WRITE(numout,*) 'Ready to deal with the solar radiation'
+   !----
+         IF ( dt_force .GT. 3600. ) THEN
+   !---
+            IF ( netrad_cons ) THEN
+               WRITE(numout,*) 'Solar radiation can not be conserved with a timestep of ', dt_force
+            ENDIF
+   !---
+            !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+            julian = julian_for + (itau_split-0.5)/split*dt_force/one_day
+   !!$         julian = julian_for + rw*dt_force/one_day
+            IF (check) THEN
+               WRITE(numout,'(a,f20.10,2I3)') &
+                    &  'JULIAN BEFORE SOLARANG : ',julian,itau_split,split
+            ENDIF
+   !---
+            CALL solarang(julian, julian0, iim, jjm, lon*0, lat, sinang)
+   !---
+            
+            WHERE ((mean_sinang(:,:) > 0.) .AND. (hour <= 12 ))
+               swdown(:,:) = swdown_n(:,:) *sinang(:,:)/mean_sinang(:,:)
+            ELSEWHERE ((mean_sinang(:,:) > 0.) .AND. (hour > 12 ))
+               swdown(:,:) = swdown_nm1(:,:) *sinang(:,:)/mean_sinang(:,:)
+            ELSEWHERE
+               swdown(:,:) = 0.0
+            END WHERE
+   !---
+            WHERE (swdown(:,:) > 2000. )
+               swdown(:,:) = 2000.
+            END WHERE
+   !---
+         ELSE
+   !---
+            IF ( netrad_cons ) THEN
+               swdown(:,:) = swdown_n(:,:)
+            ELSE
+               swdown(:,:) = (swdown_n(:,:)-swdown_nm1(:,:))*rw + swdown_nm1(:,:)
+            ENDIF
+   !---
+         ENDIF
+   !---
+         IF (check) THEN
+            WRITE(numout,*) '__ Forcing read at ',itau_split,' :',i_test, j_test
+            WRITE(numout,*) 'SWdown  : ',swdown_nm1(i_test, j_test), &
+                 &           ' < ', swdown(i_test, j_test), ' < ', swdown_n(i_test, j_test)
+            IF (is_watchout) THEN
+               WRITE(numout,*) 'SWnet  : ',swnet_nm1(i_test, j_test), &
+                    &           ' < ', swnet(i_test, j_test), ' < ', swnet_n(i_test, j_test)
+               WRITE(numout,*) 'levels  :',zlev_nm1(i_test, j_test), &
+                    &           ' < ', zlev(i_test, j_test), ' < ', zlev_n(i_test, j_test)
+               WRITE(numout,*) 'EAIR  :',Eair_nm1(i_test, j_test), &
+                    &           ' < ', eair(i_test, j_test), ' < ', Eair_n(i_test, j_test)
+            ENDIF
+            WRITE(numout,*) 'TAIR  :',tair_nm1(i_test, j_test), &
+                 &           ' < ', tair(i_test, j_test), ' < ', tair_n(i_test, j_test)
+            WRITE(numout,*) 'QAIR  :',qair_nm1(i_test, j_test), &
+                 &           ' < ', qair(i_test, j_test), ' < ', qair_n(i_test, j_test)
+            WRITE(numout,*) 'U  :',u_nm1(i_test, j_test), &
+                 &           ' < ', u(i_test, j_test), ' < ', u_n(i_test, j_test)
+            WRITE(numout,*) 'V  :',v_nm1(i_test, j_test), &
+                 &           ' < ', v(i_test, j_test), ' < ', v_n(i_test, j_test)
+         ENDIF
+   !---
+   !--- For precip we suppose that the rain
+   !--- is the sum over the next 6 hours
+   !---
+         WHERE ((itau_split <= nb_spread).AND.(hour<=12).AND.(tair(:,:)>=273.15)) 
+            rainf(:,:) = rainf_n(:,:) *(split/nb_spread)
+            snowf(:,:) = 0.0
+         ELSEWHERE ((itau_split <= nb_spread).AND.(hour<=12).AND.(tair(:,:)<273.15)) 
+            snowf(:,:) = rainf_n(:,:) *(split/nb_spread)
+            rainf(:,:) = 0.0
+         ELSEWHERE ((itau_split <= nb_spread).AND.(hour>12).AND.(tair(:,:)>=273.15)) 
+            rainf(:,:) = rainf_nm1(:,:) *(split/nb_spread)
+            snowf(:,:) = 0.0
+         ELSEWHERE ((itau_split <= nb_spread).AND.(hour>12).AND.(tair(:,:)<273.15)) 
+            snowf(:,:) = rainf_nm1(:,:) *(split/nb_spread)
+            rainf(:,:) = 0.0
+         ELSEWHERE
+            snowf(:,:) = 0.0
+            rainf(:,:) = 0.0
+         ENDWHERE
+
+         IF (check) THEN
+            WRITE(numout,*) '__ Forcing read at ',itau_split,' :'
+            WRITE(numout,*) 'Rainf  : ',rainf_nm1(i_test, j_test), &
+                 &           ' < ', rainf(i_test, j_test), ' < ', rainf_n(i_test, j_test)
+            WRITE(numout,*) 'Snowf  : ',snowf_nm1(i_test, j_test), &
+                 &           ' < ', snowf(i_test, j_test), ' < ', snowf_n(i_test, j_test)
+         ENDIF
+   !---
+
+
+      ELSE
+
+         IF (itau_read /= last_read) THEN
+   !---
+   !-----   Start or Restart
+            IF (itau_read_n == 0) THEN
+               ! Case of a restart or a shift in the forcing file.
+               IF (itau_read > 1) THEN
+                  itau_read_nm1=itau_read-1
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tair_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists, check)
+               ! Case of a simple start.
+               ELSE IF (dt_force*ttm > one_day-1. ) THEN
+                  ! if the forcing file contains at least 24 hours, 
+                  ! we will use the last forcing step of the first day
+                  ! as initiale condition to prevent first shift off reading.
+                  itau_read_nm1 = NINT (one_day/dt_force)
+                  WRITE(numout,*) "the forcing file contains 24 hours :",dt_force*ttm,one_day-1.
+                  WRITE(numout,*) "we will use the last forcing step of the first day : itau_read_nm1 ",itau_read_nm1
+                  CALL forcing_just_read (iim, jjm, zlev_nm1, zlevuv_nm1, ttm, itau_read_nm1, itau_read_nm1, &
+                       &  swdown_nm1, rainf_nm1, snowf_nm1, tair_nm1, &
+                       &  u_nm1, v_nm1, qair_nm1, pb_nm1, lwdown_nm1, &
+                       &  SWnet_nm1, Eair_nm1, petAcoef_nm1, peqAcoef_nm1, petBcoef_nm1, peqBcoef_nm1, cdrag_nm1, ccanopy_nm1, &
+                       &  force_id, wind_N_exists, check)
+               ELSE
+                  ! if the forcing file contains less than 24 hours, 
+                  ! just say error !
+                  CALL ipslerr_p(3,'forcing_read_interpol', &
+      &             'The forcing file contains less than 24 hours !', &
+      &             'We can''t intialize interpolation with such a file.','') 
+               ENDIF
+            ELSE
+   !-----   Normal mode : copy old step
+               swdown_nm1(:,:) = swdown_n(:,:)
+               rainf_nm1(:,:) = rainf_n(:,:)
+               snowf_nm1(:,:)  = snowf_n(:,:) 
+               tair_nm1(:,:)   = tair_n(:,:)
+               u_nm1(:,:)      = u_n(:,:)
+               v_nm1(:,:)      = v_n(:,:)
+               qair_nm1(:,:)   = qair_n(:,:)
+               pb_nm1(:,:)     = pb_n(:,:)
+               lwdown_nm1(:,:) = lwdown_n(:,:)
+               IF (is_watchout) THEN
+                  zlev_nm1(:,:)   = zlev_n(:,:)
+                  ! Net surface short-wave flux
+                  SWnet_nm1(:,:) = SWnet_n(:,:)
+                  ! Air potential energy
+                  Eair_nm1(:,:)   = Eair_n(:,:)
+                  ! Coeficients A from the PBL resolution for T
+                  petAcoef_nm1(:,:) = petAcoef_n(:,:)
+                  ! Coeficients A from the PBL resolution for q
+                  peqAcoef_nm1(:,:) = peqAcoef_n(:,:)
+                  ! Coeficients B from the PBL resolution for T
+                  petBcoef_nm1(:,:) = petBcoef_n(:,:)
+                  ! Coeficients B from the PBL resolution for q
+                  peqBcoef_nm1(:,:) = peqBcoef_n(:,:)
+                  ! Surface drag
+                  cdrag_nm1(:,:) = cdrag_n(:,:)
+                  ! CO2 concentration in the canopy
+                  ccanopy_nm1(:,:) = ccanopy_n(:,:)
+               ENDIF
+               itau_read_nm1 = itau_read_n
+            ENDIF
+   !-----
+            itau_read_n = itau_read
+            IF (itau_read_n > ttm) THEN
+               WRITE(numout,*) 'WARNING --WARNING --WARNING --WARNING '
+               WRITE(numout,*) &
+                    &  'WARNING : We are going back to the start of the file'
+               itau_read_n =1
+            ENDIF
+            IF (check) THEN
+               WRITE(numout,*) &
+                    & 'The dates 2 : ',itau_read,itau_split,itau_read_nm1,itau_read_n
+            ENDIF
+   !-----
+   !----- Get a reduced julian day !
+   !----- This is needed because we lack the precision on 32 bit machines.
+   !-----
+            IF ( dt_force .GT. 3600. ) THEN
+               julian_for = itau2date(itau_read-1, date0, dt_force)
+               CALL ju2ymds (julian_for, yy, mm, dd, ss)
+   
+               ! first day of this year
+               CALL ymds2ju (yy,1,1,0.0, julian0)
+   !-----
+               IF (check) THEN
+                  WRITE(numout,*) 'Forcing for Julian day ',julian_for,'is read'
+                  WRITE(numout,*) 'Date for this day ',yy,' / ',mm,' / ',dd,"  ",ss
+               ENDIF
+            ENDIF
+   !-----
+            CALL forcing_just_read (iim, jjm, zlev_n, zlevuv_n, ttm, itau_read_n, itau_read_n, &
+                 &  swdown_n, rainf_n, snowf_n, tair_n, &
+                 &  u_n, v_n, qair_n, pb_n, lwdown_n, &
+                 &  SWnet_n, Eair_n, petAcoef_n, peqAcoef_n, petBcoef_n, peqBcoef_n, cdrag_n, ccanopy_n, &
+                 &  force_id, wind_N_exists, check)
+   !---
+            last_read = itau_read_n
+   !-----
+   !----- Compute mean solar angle for the comming period
+   !-----
+            IF (check) WRITE(numout,*) 'Going into  solarang', split, one_day
+   !-----
+            IF ( dt_force .GT. 3600. ) THEN
+               mean_sinang(:,:) = 0.0
+               DO is=1,split
+                  !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+                  julian = julian_for+((is-0.5)/split)*dt_force/one_day
+   !!$               julian = julian_for+(FLOAT(is)/split)*dt_force/one_day
+                  CALL solarang (julian, julian0, iim, jjm, lon, lat, sinang)
+                  mean_sinang(:,:) = mean_sinang(:,:)+sinang(:,:)
+               ENDDO
+               mean_sinang(:,:) = mean_sinang(:,:)/split
+   !            WRITE(*,*) "mean_sinang =",MAXVAL(mean_sinang)
+            ENDIF
+   !-----
+         ENDIF
+   !---
+   !--- Do the interpolation
+         IF (check) WRITE(numout,*) 'Doing the interpolation between time steps'
+   !---
+         IF (split > 1) THEN
+            rw = REAL(itau_split)/split
+         ELSE
+            rw = 1.
+         ENDIF
+         IF (check) WRITE(numout,*) 'Coeff of interpollation : ',rw
+   !---
+         qair(:,:) = (qair_n(:,:)-qair_nm1(:,:))*rw + qair_nm1(:,:)
+         tair(:,:) = (tair_n(:,:)-tair_nm1(:,:))*rw + tair_nm1(:,:)
+         pb(:,:) = (pb_n(:,:)-pb_nm1(:,:))*rw + pb_nm1(:,:)
+         u(:,:)  = (u_n(:,:)-u_nm1(:,:))*rw + u_nm1(:,:)
+         v(:,:)  = (v_n(:,:)-v_nm1(:,:))*rw + v_nm1(:,:)
+         IF (is_watchout) THEN
+            zlev(:,:) = (zlev_n(:,:)-zlev_nm1(:,:))*rw + zlev_nm1(:,:)
+            zlevuv(:,:) = zlev(:,:)
+            SWnet(:,:) = (SWnet_n(:,:)-SWnet_nm1(:,:))*rw + SWnet_nm1(:,:)
+            Eair(:,:) = (Eair_n(:,:)-Eair_nm1(:,:))*rw + Eair_nm1(:,:)
+            petAcoef(:,:) = (petAcoef_n(:,:)-petAcoef_nm1(:,:))*rw + petAcoef_nm1(:,:)
+            peqAcoef(:,:) = (peqAcoef_n(:,:)-peqAcoef_nm1(:,:))*rw + peqAcoef_nm1(:,:)
+            petBcoef(:,:) = (petBcoef_n(:,:)-petBcoef_nm1(:,:))*rw + petBcoef_nm1(:,:)
+            peqBcoef(:,:) = (peqBcoef_n(:,:)-peqBcoef_nm1(:,:))*rw + peqBcoef_nm1(:,:)
+            cdrag(:,:) = (cdrag_n(:,:)-cdrag_nm1(:,:))*rw + cdrag_nm1(:,:)
+            ccanopy(:,:) = (ccanopy_n(:,:)-ccanopy_nm1(:,:))*rw + ccanopy_nm1(:,:)
+         ENDIF
+   !---
+   !--- Here we need to allow for an option
+   !--- where radiative energy is conserved
+   !---
+         IF ( netrad_cons ) THEN
+            lwdown(:,:) = lwdown_n(:,:)
+         ELSE
+            lwdown(:,:) = (lwdown_n(:,:)-lwdown_nm1(:,:))*rw + lwdown_nm1(:,:)
+         ENDIF
+   !---
+   !--- For the solar radiation we decompose the mean value
+   !--- using the zenith angle of the sun if the time step in the forcing data is 
+   !---- more than an hour. Else we use the standard linera interpolation
+   !----
+         IF (check) WRITE(numout,*) 'Ready to deal with the solar radiation'
+   !----
+         IF ( dt_force .GT. 3600. ) THEN
+   !---
+            IF ( netrad_cons ) THEN
+               WRITE(numout,*) 'Solar radiation can not be conserved with a timestep of ', dt_force
+            ENDIF
+   !---
+            !MM we compute mean SWdown between t and t+Dt then I take t+Dt/2. 
+            julian = julian_for + (itau_split-0.5)/split*dt_force/one_day
+   !!$         julian = julian_for + rw*dt_force/one_day
+            IF (check) THEN
+               WRITE(numout,'(a,f20.10,2I3)') &
+                    &  'JULIAN BEFORE SOLARANG : ',julian,itau_split,split
+            ENDIF
+   !---
+            CALL solarang(julian, julian0, iim, jjm, lon, lat, sinang)
+   !---
+            WHERE (mean_sinang(:,:) > 0.)
+               swdown(:,:) = swdown_n(:,:) *sinang(:,:)/mean_sinang(:,:)
+            ELSEWHERE
+               swdown(:,:) = 0.0
+            END WHERE
+   !---
+            WHERE (swdown(:,:) > 2000. )
+               swdown(:,:) = 2000.
+            END WHERE
+   !---
+         ELSE
+   !---
+            IF ( netrad_cons ) THEN
+               swdown(:,:) = swdown_n(:,:)
+            ELSE
+               swdown(:,:) = (swdown_n(:,:)-swdown_nm1(:,:))*rw + swdown_nm1(:,:)
+            ENDIF
+   !---
+         ENDIF
+   !---
+         IF (check) THEN
+            WRITE(numout,*) '__ Forcing read at ',itau_split,' :',i_test, j_test
+            WRITE(numout,*) 'SWdown  : ',swdown_nm1(i_test, j_test), &
+                 &           ' < ', swdown(i_test, j_test), ' < ', swdown_n(i_test, j_test)
+            IF (is_watchout) THEN
+               WRITE(numout,*) 'SWnet  : ',swnet_nm1(i_test, j_test), &
+                    &           ' < ', swnet(i_test, j_test), ' < ', swnet_n(i_test, j_test)
+               WRITE(numout,*) 'levels  :',zlev_nm1(i_test, j_test), &
+                    &           ' < ', zlev(i_test, j_test), ' < ', zlev_n(i_test, j_test)
+               WRITE(numout,*) 'EAIR  :',Eair_nm1(i_test, j_test), &
+                    &           ' < ', eair(i_test, j_test), ' < ', Eair_n(i_test, j_test)
+            ENDIF
+            WRITE(numout,*) 'TAIR  :',tair_nm1(i_test, j_test), &
+                 &           ' < ', tair(i_test, j_test), ' < ', tair_n(i_test, j_test)
+            WRITE(numout,*) 'QAIR  :',qair_nm1(i_test, j_test), &
+                 &           ' < ', qair(i_test, j_test), ' < ', qair_n(i_test, j_test)
+            WRITE(numout,*) 'U  :',u_nm1(i_test, j_test), &
+                 &           ' < ', u(i_test, j_test), ' < ', u_n(i_test, j_test)
+            WRITE(numout,*) 'V  :',v_nm1(i_test, j_test), &
+                 &           ' < ', v(i_test, j_test), ' < ', v_n(i_test, j_test)
+         ENDIF
+   !---
+   !--- For precip we suppose that the rain
+   !--- is the sum over the next 6 hours
+   !---
+         IF (itau_split <= nb_spread) THEN
+            rainf(:,:) = rainf_n(:,:)*(split/nb_spread)
+            snowf(:,:) = snowf_n(:,:)*(split/nb_spread)
+         ELSE
+            rainf(:,:) = 0.0
+            snowf(:,:) = 0.0
+         ENDIF
+         IF (check) THEN
+            WRITE(numout,*) '__ Forcing read at ',itau_split,' :'
+            WRITE(numout,*) 'Rainf  : ',rainf_nm1(i_test, j_test), &
+                 &           ' < ', rainf(i_test, j_test), ' < ', rainf_n(i_test, j_test)
+            WRITE(numout,*) 'Snowf  : ',snowf_nm1(i_test, j_test), &
+                 &           ' < ', snowf(i_test, j_test), ' < ', snowf_n(i_test, j_test)
+         ENDIF
+   !---
+      ENDIF ! (daily_interpol)
+   ENDIF
+!---
+!--- Here we might put the call to the weather generator ... one day.
+!--- Pour le moment, le branchement entre interpolation et generateur de temps 
+!--- est fait au-dessus.
+!---
+!-   IF ( initialized .AND. weathergen ) THEN
+!-      ....
+!-   ENDIF
+!---
+!--- At this point the code should be initialized. If not we have a problem !
+!---
+   IF ( (itau_read == 0).AND.(itau_split == 0) ) THEN
+!---
+      initialized = .TRUE.
+!---
+   ELSE
+      IF ( .NOT. initialized ) THEN
+         WRITE(numout,*) 'Why is the code forcing_read not initialized ?'
+         WRITE(numout,*) 'Have you called it with both time-steps set to zero ?'
+         STOP
+      ENDIF
+   ENDIF
+!
+!-------------------------
+END SUBROUTINE forcing_read_interpol
+!=====================================================================
+!-
+!=====================================================================
+SUBROUTINE forcing_just_read &
+  & (iim, jjm, zlev, zlev_uv, ttm, itb, ite, &
+  &  swdown, rainf, snowf, tair, &
+  &  u, v, qair, pb, lwdown, &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy, &
+  &  force_id, wind_N_exists, check)
+!---------------------------------------------------------------------
+!- iim        : Size of the grid in x
+!- jjm        : size of the grid in y
+!- zlev       : height of the varibales T and Q 
+!- zlev_uv    : height of the varibales U and V 
+!- ttm        : number of time steps in all in the forcing file
+!- itb, ite   : index of respectively begin and end of read for each variable
+!- swdown     : Downward solar radiation (W/m^2)
+!- rainf      : Rainfall (kg/m^2s)
+!- snowf      : Snowfall (kg/m^2s)
+!- tair       : 2m air temperature (K)
+!- u and v    : 2m (in theory !) wind speed (m/s)
+!- qair       : 2m humidity (kg/kg)
+!- pb         : Surface pressure (Pa)
+!- lwdown     : Downward long wave radiation (W/m^2)
+!-
+!- From a WATCHOUT file :
+!- SWnet      : Net surface short-wave flux
+!- Eair       : Air potential energy
+!- petAcoef   : Coeficients A from the PBL resolution for T
+!- peqAcoef   : Coeficients A from the PBL resolution for q
+!- petBcoef   : Coeficients B from the PBL resolution for T
+!- peqBcoef   : Coeficients B from the PBL resolution for q
+!- cdrag      : Surface drag
+!- ccanopy    : CO2 concentration in the canopy
+!- force_id   : FLINCOM file id.
+!-              It is used to close the file at the end of the run.
+!- wind_N_exists : if Wind_N and Wind_E are in the file (and not just Wind)
+!- check      : Prompt for reading
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER, INTENT(in) :: iim, jjm, ttm
+   INTEGER, INTENT(in) :: itb, ite
+   REAL, DIMENSION(iim,jjm), INTENT(out) ::  zlev, zlev_uv, &
+  &  swdown, rainf, snowf, tair, u, v, qair, pb, lwdown
+   ! for watchout files
+   REAL, DIMENSION(iim,jjm), INTENT(out) :: &
+  &  SWnet, Eair, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy
+   INTEGER, INTENT(in) :: force_id
+!  if Wind_N and Wind_E are in the file (and not just Wind)
+   LOGICAL, INTENT(in) :: wind_N_exists
+   LOGICAL :: check
+   INTEGER :: i, j 
+   REAL :: rau 
+
+!-
+!---------------------------------------------------------------------
+   IF ( daily_interpol ) THEN
+      CALL flinget (force_id,'Tmin'  , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, tair)
+      CALL flinget (force_id,'precip' , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, rainf)
+   ELSE
+      CALL flinget (force_id,'Tair'  , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, tair)
+      CALL flinget (force_id,'Snowf' , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, snowf)
+      CALL flinget (force_id,'Rainf' , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, rainf)
+   ENDIF
+
+
+   CALL flinget (force_id,'SWdown', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, swdown)
+   CALL flinget (force_id,'LWdown', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, lwdown)
+
+!SZ FLUXNET input file correction
+!  rainf=rainf/1800.
+!MM Rainf and not Snowf ?
+   CALL flinget (force_id,'PSurf' , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, pb)
+   CALL flinget (force_id,'Qair'  , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, qair)
+!---
+   IF ( wind_N_exists ) THEN
+      CALL flinget (force_id,'Wind_N', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, u)
+      CALL flinget (force_id,'Wind_E', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, v)
+   ELSE
+      CALL flinget (force_id,'Wind',   iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, u)
+      v=0.0
+   ENDIF
+
+!- 
+!- Deal with the height of the atmospheric forcing varibles 
+!- 
+!---- 
+   IF ( zheight ) THEN 
+      zlev(:,:) = zlev_fixed 
+   ELSE IF ( zsigma .OR. zhybrid ) THEN 
+      DO i=1,iim 
+         DO j=1,jjm 
+            IF ( tair(i,j) < val_exp ) THEN 
+               rau = pb(i,j)/(cte_molr*tair(i,j)) 
+ 	  	 
+               zlev(i,j) =  (pb(i,j) - (zhybrid_a + zhybrid_b*pb(i,j)))/(rau * cte_grav) 
+            ELSE 
+               zlev(i,j) = 0.0 
+            ENDIF
+         ENDDO
+      ENDDO
+   ELSE IF ( zlevels ) THEN 
+      CALL flinget (force_id,'Levels', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full) 
+      CALL forcing_zoom(data_full, zlev) 
+   ELSE 
+      CALL ipslerr(3, 'forcing_just_read','No case for the vertical levels was specified.', & 
+           &         'We cannot determine the height for T and Q.','stop readdim2') 
+   ENDIF
+   
+   IF ( zsamelev_uv ) THEN 
+      zlev_uv(:,:) = zlev(:,:) 
+   ELSE 
+      IF ( zheight ) THEN 
+         zlev_uv(:,:) = zlevuv_fixed 
+      ELSE IF ( zsigma .OR. zhybrid ) THEN 
+         DO i=1,iim 
+            DO j=1,jjm 
+               IF ( tair(i,j) < val_exp ) THEN 
+                  rau = pb(i,j)/(cte_molr*tair(i,j)) 
+                  
+                  zlev_uv(i,j) =  (pb(i,j) - (zhybriduv_a + zhybriduv_b*pb(i,j)))/(rau * cte_grav) 
+               ELSE 
+                  zlev_uv(i,j) = 0.0 
+               ENDIF
+            ENDDO
+         ENDDO
+      ELSE IF ( zlevels ) THEN 
+         CALL flinget (force_id,'Levels_uv', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full) 
+         CALL forcing_zoom(data_full, zlev_uv) 
+      ELSE 
+         CALL ipslerr(3, 'forcing_just_read','No case for the vertical levels was specified.', & 
+              &         'We cannot determine the height for U and V.','stop readdim2') 
+      ENDIF
+   ENDIF
+   !----
+   IF ( is_watchout ) THEN
+      CALL flinget (force_id,'levels', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, zlev)
+      ! 
+      ! If we are in WATHCOUT it means T,Q are at the same height as U,V 
+      ! 
+      zlev_uv(:,:) = zlev(:,:) 
+      ! Net surface short-wave flux
+      CALL flinget (force_id,'SWnet', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, SWnet)
+      ! Air potential energy
+      CALL flinget (force_id,'Eair', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, Eair)
+      ! Coeficients A from the PBL resolution for T
+      CALL flinget (force_id,'petAcoef', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, petAcoef)
+      ! Coeficients A from the PBL resolution for q
+      CALL flinget (force_id,'peqAcoef', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, peqAcoef)
+      ! Coeficients B from the PBL resolution for T
+      CALL flinget (force_id,'petBcoef', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, petBcoef)
+      ! Coeficients B from the PBL resolution for q
+      CALL flinget (force_id,'peqBcoef', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, peqBcoef)
+      ! Surface drag
+      CALL flinget (force_id,'cdrag', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, cdrag)
+      ! CO2 concentration in the canopy
+      CALL flinget (force_id,'ccanopy', iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+      CALL forcing_zoom(data_full, ccanopy)
+   ENDIF
+!
+!----
+     IF (check) WRITE(numout,*) 'Variables have been extracted between ',itb,' and ',ite,' iterations of the forcing file.'
+!-------------------------
+END SUBROUTINE forcing_just_read
+!=====================================================================
+
+!-
+SUBROUTINE forcing_just_read_tmax &
+  & (iim, jjm, ttm, itb, ite, tmax, force_id )
+!---------------------------------------------------------------------
+!- iim        : Size of the grid in x
+!- jjm        : size of the grid in y
+!- ttm        : number of time steps in all in the forcing file
+!- itb, ite   : index of respectively begin and end of read for each variable
+!- tmax       : 2m air temperature (K)
+!- force_id   : FLINCOM file id.
+!-              It is used to close the file at the end of the run.
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER, INTENT(in) :: iim, jjm, ttm
+   INTEGER, INTENT(in) :: itb, ite
+   REAL, DIMENSION(iim,jjm), INTENT(out) ::  tmax
+   INTEGER, INTENT(in) :: force_id
+!-
+!---------------------------------------------------------------------
+   CALL flinget (force_id,'Tmax'  , iim_full, jjm_full, llm_full, ttm, itb, ite, data_full)
+   CALL forcing_zoom(data_full, tmax)
+!-------------------------
+END SUBROUTINE forcing_just_read_tmax
+!=====================================================================
+
+!-
+SUBROUTINE forcing_landind(iim, jjm, tair, check, nbindex, kindex, i_test, j_test)
+!---
+!--- This subroutine finds the indices of the land points over which the land
+!--- surface scheme is going to run.
+!---
+  IMPLICIT NONE
+!-
+!- ARGUMENTS
+!-
+  INTEGER, INTENT(IN) :: iim, jjm
+  REAL, INTENT(IN)    :: tair(iim,jjm)
+  INTEGER, INTENT(OUT) :: i_test, j_test, nbindex
+  INTEGER, INTENT(OUT) :: kindex(iim*jjm)
+  LOGICAL :: check
+!-
+!- LOCAL
+  INTEGER :: i, j, ig
+!-
+!-
+  ig = 0
+  i_test = 0
+  j_test = 0
+!---
+  IF (MINVAL(tair(:,:)) < 100.) THEN
+!----- In this case the 2m temperature is in Celsius
+     DO j=1,jjm
+        DO i=1,iim
+           IF (tair(i,j) < 100.) THEN
+              ig = ig+1
+              kindex(ig) = (j-1)*iim+i
+              !
+              !  Here we find at random a land-point on which we can do
+              !  some printouts for test.
+              !
+              IF (ig .GT. (iim*jjm)/2 .AND. i_test .LT. 1) THEN
+                 i_test = i
+                 j_test = j
+                 IF (check) THEN
+                    WRITE(numout,*) 'The test point chosen for output is : ', i_test, j_test
+                 ENDIF
+              ENDIF
+           ENDIF
+        ENDDO
+     ENDDO
+  ELSE 
+!----- 2m temperature is in Kelvin
+     DO j=1,jjm
+        DO i=1,iim
+           IF (tair(i,j) < 500.) THEN
+              ig = ig+1
+              kindex(ig) = (j-1)*iim+i
+              !
+              !  Here we find at random a land-point on which we can do
+              !  some printouts for test.
+              !
+              IF (ig .GT. (iim*jjm)/2 .AND. i_test .LT. 1) THEN
+                 i_test = i
+                 j_test = j
+                 IF (check) THEN
+                    WRITE(numout,*) 'The test point chosen for output is : ', i_test, j_test
+                 ENDIF
+              ENDIF
+           ENDIF
+        ENDDO
+     ENDDO
+  ENDIF
+!---
+  nbindex = ig
+!---
+END SUBROUTINE forcing_landind
+!-
+!=====================================================================
+!-
+SUBROUTINE forcing_grid(iim,jjm,llm,lon,lat,init_f)
+!-
+!- This subroutine calculates the longitudes and latitudes of the model grid.
+!-   
+  IMPLICIT NONE
+!-
+  INTEGER, INTENT(in)                   :: iim, jjm, llm
+  LOGICAL, INTENT(in)                   :: init_f
+  REAL, DIMENSION(iim,jjm), INTENT(out) :: lon, lat
+!-
+  INTEGER :: i,j
+!-
+  LOGICAL :: debug = .FALSE.
+!-
+!- Should be unified one day
+!-
+  IF ( debug ) WRITE(numout,*) 'forcing_grid : options : ', weathergen, interpol
+!-
+  IF ( weathergen ) THEN
+     IF (init_f) THEN
+        DO i = 1, iim
+           lon(i,:) = limit_west + merid_res/2. + &
+                FLOAT(i-1)*(limit_east-limit_west)/FLOAT(iim)
+        ENDDO
+        !-
+        DO j = 1, jjm
+           lat(:,j) = limit_north - zonal_res/2. - &
+                FLOAT(j-1)*(limit_north-limit_south)/FLOAT(jjm)
+        ENDDO
+     ELSE
+        IF (is_root_prc) THEN
+           DO i = 1, iim_g
+              lon_g(i,:) = limit_west + merid_res/2. + &
+                   FLOAT(i-1)*(limit_east-limit_west)/FLOAT(iim_g)
+           ENDDO
+           !-
+           DO j = 1, jjm_g
+              lat_g(:,j) = limit_north - zonal_res/2. - &
+                   FLOAT(j-1)*(limit_north-limit_south)/FLOAT(jjm_g)
+           ENDDO
+        ELSE
+           ALLOCATE(lon_g(iim_g, jjm_g), lat_g(iim_g, jjm_g))
+        ENDIF
+        CALL bcast(lon_g)
+        CALL bcast(lat_g)
+        lon=lon_g(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank))
+        lat=lat_g(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank))
+     ENDIF
+!-
+  ELSEIF ( interpol ) THEN
+!-
+    CALL forcing_zoom(lon_full, lon)
+    IF ( debug ) WRITE(numout,*) 'forcing_grid : out of zoom on lon'
+    CALL forcing_zoom(lat_full, lat)
+    IF ( debug ) WRITE(numout,*) 'forcing_grid : out of zoom on lat'
+ 
+ ELSE 
+    
+    STOP 'Neither weather generator nor temporal interpolation is specified.' 
+    
+ ENDIF
+ 
+ IF ( debug ) WRITE(numout,*) 'forcing_grid : ended'
+ 
+END SUBROUTINE forcing_grid
+!-
+!=====================================================================
+!-
+SUBROUTINE forcing_zoom(x_f, x_z)
+!-
+!- This subroutine takes the slab of data over which we wish to run the model.
+!-   
+  IMPLICIT NONE
+!-
+  REAL, INTENT(IN) :: x_f(iim_full, jjm_full)
+  REAL, INTENT(OUT) :: x_z(iim_zoom, jjm_zoom)
+!-
+  INTEGER :: i,j
+!-
+  DO i=1,iim_zoom
+     DO j=1,jjm_zoom
+        x_z(i,j) = x_f(i_index(i),j_index(j))
+     ENDDO
+  ENDDO
+!-
+END SUBROUTINE forcing_zoom
+
+!-
+!=====================================================================
+!-
+
+SUBROUTINE forcing_vertical(force_id)
+!
+!- This subroutine explores the forcing file to decide what information is available
+!- on the vertical coordinate.
+!
+  INTEGER, INTENT(IN) :: force_id
+  !
+  LOGICAL :: var_exists, vara_exists, varb_exists, varuv_exists
+  LOGICAL :: foundvar
+  LOGICAL :: levlegacy
+
+  !
+  !- Set all the defaults
+  !
+  zfixed=.FALSE.
+  zsigma=.FALSE.
+  zhybrid=.FALSE.
+  zlevels=.FALSE.
+  zheight=.FALSE.
+  zsamelev_uv = .TRUE.
+  levlegacy = .FALSE.
+  !
+  foundvar = .FALSE.
+  !
+  !- We have a forcing file to explore so let us see if we find any of the conventions
+  !- which allow us to find the height of T,Q,U and V.
+  !
+  IF ( force_id > 0 ) THEN
+     !
+     ! Case for sigma levels
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'Sigma', var_exists)
+        CALL flinquery_var(force_id, 'Sigma_uv', varuv_exists)
+        IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zsigma = .TRUE.
+           IF ( varuv_exists ) zsamelev_uv = .FALSE.
+        ENDIF
+     ENDIF
+     !
+     ! Case for Hybrid levels
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'HybSigA', vara_exists)
+        IF ( vara_exists ) THEN
+           CALL flinquery_var(force_id, 'HybSigB', varb_exists)
+           IF ( varb_exists ) THEN
+              var_exists=.TRUE.
+           ELSE
+              CALL ipslerr ( 3, 'forcing_vertical','Missing the B coefficient for', &
+                   &         'Hybrid vertical levels for T and Q','stop readdim2')
+           ENDIF
+        ENDIF
+        CALL flinquery_var(force_id, 'HybSigA_uv', vara_exists)
+        IF ( vara_exists ) THEN
+           CALL flinquery_var(force_id, 'HybSigB_uv', varb_exists)
+           IF ( varb_exists ) THEN
+              varuv_exists=.TRUE.
+           ELSE
+              CALL ipslerr ( 3, 'forcing_vertical','Missing the B coefficient for', &
+                   &         'Hybrid vertical levels for U and V','stop readdim2')
+           ENDIF
+        ENDIF
+        IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zhybrid = .TRUE.
+           IF ( varuv_exists ) zsamelev_uv = .FALSE.
+        ENDIF
+     ENDIF
+     !
+     ! Case for levels (i.e. a 2d time varying field with the height in meters)
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'Levels', var_exists)
+        CALL flinquery_var(force_id, 'Levels_uv', varuv_exists)
+        IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zlevels = .TRUE.
+           IF ( varuv_exists ) zsamelev_uv = .FALSE.
+        ENDIF
+     ENDIF
+     !
+     ! Case where a fixed height is provided in meters
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'Height_Lev1', var_exists)
+        CALL flinquery_var(force_id, 'Height_Levuv', varuv_exists)
+       IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zheight = .TRUE.
+           IF ( varuv_exists ) zsamelev_uv = .FALSE.
+        ENDIF
+     ENDIF
+     !
+     ! Case where a fixed height is provided in meters in the lev variable
+     !
+     IF ( .NOT. foundvar ) THEN
+        CALL flinquery_var(force_id, 'lev', var_exists)
+        IF ( var_exists ) THEN
+           foundvar = .TRUE.
+           zheight = .TRUE.
+           levlegacy = .TRUE.
+        ENDIF
+     ENDIF
+     !
+  ENDIF
+  !
+  ! We found forcing variables so we need to extract the values if we are dealing with constant values (i.e. all
+  ! except the case zlevels
+  !
+  IF ( foundvar .AND. .NOT. zlevels ) THEN
+     !
+     IF ( zheight ) THEN
+        !
+        ! Constant height
+        !
+        IF ( levlegacy ) THEN
+           CALL flinget (force_id,'lev',1, 1, 1, 1,  1, 1, zlev_fixed)
+        ELSE
+           CALL flinget (force_id,'Height_Lev1',1, 1, 1, 1,  1, 1, zlev_fixed)
+           IF ( .NOT. zsamelev_uv ) THEN
+              CALL flinget (force_id,'Height_Levuv',1, 1, 1, 1,  1, 1, zlevuv_fixed)
+           ENDIF
+        ENDIF
+        WRITE(numout,*) "forcing_vertical : case ZLEV : Read from forcing file :", zlev_fixed, zlevuv_fixed
+        !
+     ELSE IF ( zsigma .OR. zhybrid ) THEN
+        !
+        ! Sigma or hybrid levels
+        !
+        IF ( zsigma ) THEN
+           CALL flinget (force_id,'Sigma',1, 1, 1, 1,  1, 1, zhybrid_b)
+           zhybrid_a = zero
+           IF ( .NOT. zsamelev_uv ) THEN
+              CALL flinget (force_id,'Sigma_uv',1, 1, 1, 1,  1, 1, zhybriduv_b)
+              zhybriduv_a = zero
+           ENDIF
+        ELSE
+           CALL flinget (force_id,'HybSigB',1, 1, 1, 1,  1, 1, zhybrid_b)
+           CALL flinget (force_id,'HybSigA',1, 1, 1, 1,  1, 1, zhybrid_a)
+           IF ( .NOT. zsamelev_uv ) THEN
+              CALL flinget (force_id,'HybSigB_uv',1, 1, 1, 1,  1, 1, zhybriduv_b)
+              CALL flinget (force_id,'HybSigA_uv',1, 1, 1, 1,  1, 1, zhybriduv_a)
+           ENDIF
+        ENDIF
+        WRITE(numout,*) "forcing_vertical : case Pressure coordinates : "
+        WRITE(numout,*) "Read from forcing file :", zhybrid_b, zhybrid_a, zhybriduv_b, zhybriduv_a
+     ELSE
+        !
+        ! Why are we here ???
+        !
+        CALL ipslerr ( 3, 'forcing_vertical','What is the option used to describe the height of', &
+             &         'the atmospheric forcing ?','Please check your forcing file.')
+     ENDIF
+  ENDIF
+  !
+  !- We have no forcing file to explore or we did not find anything. So revert back to the run.def and
+  !- read what has been specified by the user.
+  !
+  IF ( force_id < 0 .OR. .NOT. foundvar ) THEN
+     !
+     !-
+     !Config  Key  = HEIGHT_LEV1
+     !Config  Desc = Height at which T and Q are given
+     !Config  Def  = 2.0
+     !Config  Help = The atmospheric variables (temperature and specific
+     !Config         humidity) are measured at a specific level.
+     !Config         The height of this level is needed to compute
+     !Config         correctly the turbulent transfer coefficients.
+     !Config         Look at the description of the forcing
+     !Config         DATA for the correct value.
+     !-
+     zlev_fixed = 2.0
+     CALL getin('HEIGHT_LEV1', zlev_fixed)
+     !-
+     !Config  Key  = HEIGHT_LEVW
+     !Config  Desc = Height at which the wind is given
+     !Config  Def  = 10.0
+     !Config  Help = The height at which wind is needed to compute
+     !Config         correctly the turbulent transfer coefficients.
+     !-
+     zlevuv_fixed = 10.0
+     CALL getin('HEIGHT_LEVW', zlevuv_fixed)
+
+     zheight = .TRUE.
+
+     IF ( ABS(zlevuv_fixed-zlev_fixed) > EPSILON(zlev_fixed)) THEN
+        zsamelev_uv = .FALSE.
+     ENDIF
+
+     CALL ipslerr ( 2, 'forcing_vertical','The height of the atmospheric forcing variables', &
+          &         'was not found in the netCDF file.','Thus the values in run.def were used ... or their defaults.')
+  ENDIF
+
+END SUBROUTINE forcing_vertical
+
+!-
+!=====================================================================
+!-
+
+SUBROUTINE domain_size (limit_west, limit_east, limit_north, limit_south, &
+     &  iim_f, jjm_f, lon, lat, iim, jjm, iind, jind)
+  
+  IMPLICIT NONE
+  !
+  ! ARGUMENTS
+  !
+  REAL, INTENT(inout)  :: limit_west,limit_east,limit_north,limit_south
+  INTEGER, INTENT(in)  :: iim_f, jjm_f
+  REAL, INTENT(in)     :: lon(iim_f, jjm_f), lat(iim_f, jjm_f)
+  INTEGER, INTENT(out) :: iim,jjm
+  INTEGER, INTENT(out) :: iind(iim_f), jind(jjm_f)
+  !
+  ! LOCAL
+  !
+  INTEGER :: i, j
+  REAL :: lolo
+  LOGICAL :: over_dateline = .FALSE.
+  !
+  !
+  IF ( ( ABS(limit_east) .GT. 180. ) .OR. &
+       ( ABS(limit_west) .GT. 180. ) ) THEN
+     WRITE(numout,*) 'Limites Ouest, Est: ',limit_west,limit_east
+     CALL ipslerr_p (3,'domain_size', &
+ &        'Longitudes problem.','In run.def file :', &
+ &        'limit_east > 180. or limit_west > 180.')
+  ENDIF
+  !
+  IF ( limit_west .GT. limit_east ) over_dateline = .TRUE.
+  !
+  IF ( ( limit_south .LT. -90. ) .OR. &
+       ( limit_north .GT. 90. ) .OR. &
+       ( limit_south .GE. limit_north ) ) THEN
+     WRITE(numout,*) 'Limites Nord, Sud: ',limit_north,limit_south
+     CALL ipslerr_p (3,'domain_size', &
+ &        'Latitudes problem.','In run.def file :', &
+ &        'limit_south < -90. or limit_north > 90. or limit_south >= limit_north')
+  ENDIF
+  !
+  ! Here we assume that the grid of the forcing data is regular. Else we would have
+  ! to do more work to find the index table.
+  !
+  iim = 0
+  DO i=1,iim_f
+     !
+     lolo =  lon(i,1)
+     IF ( lon(i,1) .GT. 180. ) lolo =  lon(i,1) - 360.
+     IF ( lon(i,1) .LT. -180. ) lolo =  lon(i,1) + 360.
+     !
+     IF (lon(i,1) < limit_west) iim_g_begin = i+1
+     IF (lon(i,1) < limit_east) iim_g_end = i
+     !
+     IF ( over_dateline ) THEN
+        IF ( lolo .LE. limit_west .OR. lolo .GE. limit_east ) THEN
+           iim = iim + 1
+           iind(iim) = i
+        ENDIF
+     ELSE
+        IF ( lolo .GE. limit_west .AND. lolo .LE. limit_east ) THEN
+           iim = iim + 1
+           iind(iim) = i
+        ENDIF
+     ENDIF
+     !
+  ENDDO
+  !
+  jjm = 0
+  DO j=1,jjm_f
+     IF (lat(1,j) > limit_north) jjm_g_begin = j+1
+     IF (lat(1,j) > limit_south) jjm_g_end = j
+     !
+     IF ( lat(1,j) .GE. limit_south .AND. lat(1,j) .LE. limit_north) THEN
+        jjm = jjm + 1
+        jind(jjm) = j
+     ENDIF
+  ENDDO
+  !
+  WRITE(numout,*) 'Domain zoom size: iim, jjm = ', iim, jjm
+  END SUBROUTINE domain_size
+
+!------------------
+END MODULE readdim2
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/teststomate.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/teststomate.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/teststomate.f90	(revision 5166)
@@ -0,0 +1,1204 @@
+! =================================================================================================================================
+! PROGRAM       : teststomate
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This program runs the STOMATE submodel using specific initial conditions 
+!! and driving variables in order to obtain the state variables of STOMATE closed to the steady-state values  
+!! quicker than when using the 'full' ORCHIDEE. 
+!!                                        
+!! \n DESCRIPTION (functional, design, flags): 
+!! It integrates STOMATE for a given number of years using a specific forcing file.       
+!! The initial GPP from this forcing is scaled in agreement with the updated calculated LAI in STOMATE 
+!! Nothing is done for soil moisture which should actually evolve with the vegetation.            
+!! - 1. It first reads a set of parameters, allocates variables and initializes them.
+!! - 2. Then, a section on the set up of the STOMATE history file
+!! - 3. A first call to slowproc subroutine in order to initialize SECHIBA variables
+!! - 4. A loop over time in which slowproc is called at each time step
+!! - 5. A restart file is written
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S)     : None
+!!
+!! SVN              :   
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+PROGRAM teststomate
+
+  ! modules used;
+
+  USE netcdf
+  USE defprec
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE stomate_data
+  USE ioipsl_para
+  USE mod_orchidee_para
+  use tools_para
+  USE grid
+  USE slowproc
+  USE stomate
+  USE intersurf, ONLY: stom_define_history, stom_ipcc_define_history, intsurf_time, l_first_intersurf, check_time, impose_param
+!  USE parallel
+
+  IMPLICIT NONE
+
+  !! 0. Variable and parameter declaration
+
+  INTEGER(i_std)                            :: kjpij,kjpindex                       !! # of total/land points
+  REAL(r_std)                               :: dtradia,dt_force                     !! time step of sechiba and stomate components 
+                                                                                    !! read into the forcing file [second] 
+ 
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE   :: indices                              !! index over land points
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE   :: indexveg
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: soiltile, veget_x                    !! texture and fraction of vegetation type 
+                                                                                    !! (accounts for LAI dynamic) 
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: totfrac_nobio                        !! Total fraction of ice+lakes+cities etc. in 
+                                                                                    !! the mesh 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: frac_nobio                           !! Fraction of ice, lakes, cities etc. in the 
+                                                                                    !! mesh 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: veget_max_x                          !! Fraction of vegetation type
+  INTEGER(i_std), DIMENSION(:),ALLOCATABLE  :: njsc
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: lai_x                                !! Leaf Area Index as calculated in STOMATE 
+                                                                                    !! [m2/m2] 
+  REAL(r_std),DIMENSION (:,:,:), ALLOCATABLE:: frac_age_x                           !! Age efficacity from STOMATE for isoprene 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: veget_force_x                        !! Fraction of vegetation of PFTs in each grid 
+                                                                                    !! cell (read in the forcinng file) [-] 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: veget_max_force_x                    !! fraction of maximum vegetation of PFTs in 
+                                                                                    !! each grid cell (read in the forcinng file) 
+                                                                                    !! [-] 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: lai_force_x                          !! Leaf Area Index as read in the forcing file 
+                                                                                    !! [m2/m2] 
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: reinf_slope
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: t2m,t2m_min,temp_sol                 !! 2 m air temperature, min. 2 m air temp. 
+                                                                                    !! during forcing time step and Surface 
+                                                                                    !! temperature [K] 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: soiltemp,soilhum                     !!  Soil temperature and Relative soil moisture
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: humrel_x
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: litterhum                            !! Litter humidity
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: precip_rain,precip_snow              !! Rainfall, Snowfall
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: gpp_x                                !! GPP (gC/(m**2 of total ground)/time step)
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: deadleaf_cover                       !! fraction of soil covered by dead leaves
+  REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE  :: assim_param_x                        !! min/max/opt temperature for photosynthesis 
+                                                                                    !! and vcmax/vjmax parameters 
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: height_x                             !! height (m)
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: qsintmax_x                           !! Maximum water on vegetation for interception
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: co2_flux                             !! CO2 flux in gC/m**2 of ground/second
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: fco2_lu                              !! Land Cover Change CO2 flux (gC/m**2 of 
+                                                                                    !! average ground/s) 
+    REAL(r_std),DIMENSION (:,:,:),ALLOCATABLE:: soil_mc                             !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE  :: litter_mc                           !! litter moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (:),ALLOCATABLE    :: floodout                            !! flux out of floodplains
+    REAL(r_std),DIMENSION (:),ALLOCATABLE    :: runoff                              !! Complete runoff
+    REAL(r_std),DIMENSION (:),ALLOCATABLE    :: drainage                            !! Drainage
+    REAL(r_std),DIMENSION (:),ALLOCATABLE    :: wat_flux0                           !! Water flux in the first soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE  :: wat_flux                            !! Water flux in the soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE  :: runoff_per_soil                     !! Runoff per soil type
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE  :: drainage_per_soil                   !! Drainage per soil type
+  INTEGER(i_std),DIMENSION(:),ALLOCATABLE   :: indices_g                            !! Vector of indeces of land points
+  REAL(r_std),DIMENSION(:),ALLOCATABLE      :: x_indices_g                          !! Vector of indeces of land points
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: x_neighbours_g                       !! Indeces of neighbours for each land point
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: DOC_EXP_agg_d                                 !! DOC exports, diffrenet paths (nexp), in  
+                                                                                    !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex  
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)  :: DOC_to_topsoil                       !! Sum of DOC fluxes from irrirgation and reinfiltration 
+                                                                                    !! @tex $(g m^{-2})$ @endtex                                           
+!$OMP THREADPRIVATE(DOC_to_topsoil)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)  :: DOC_to_subsoil                       !! DOC fluxes from returnflow in lakes and swamps 
+                                                                                    !! @tex $(g m^{-2})$ @endtex                                           
+!$OMP THREADPRIVATE(DOC_to_subsoil)                       
+
+  INTEGER                                   :: ier,iret                             !! Return value of functions used to catch 
+                                                                                    !! errors 
+  INTEGER                                   :: ncfid                                !! Id of the restart file of SECHIBA used in 
+                                                                                    !! input 
+  CHARACTER(LEN=20),SAVE                    :: thecalendar='noleap'                 !! Type of calendar used
+  LOGICAL                                   :: a_er                                 !! Flag used to check errors when allocating
+  CHARACTER(LEN=80) :: &                                                            !! Name of the restart files used for
+ &  dri_restname_in,dri_restname_out, &                                             !! the driver in/out
+ &  sec_restname_in,sec_restname_out, &                                             !! the sechiba component in/out
+ &  sto_restname_in,sto_restname_out, &                                             !! the stomate component in/out
+ &  stom_histname, stom_ipcc_histname                                               !! Name of the history files for stomate 
+                                                                                    !! (standard and ippc format) 
+  INTEGER(i_std)                            :: iim,jjm,llm                          !! # of lon,lat and time-step in the restart 
+                                                                                    !! files 
+  REAL, ALLOCATABLE, DIMENSION(:,:)         :: lon, lat                             !! Arrays of Longitude and latitude (iim,jjm) 
+                                                                                    !! dimension for each processor 
+  REAL, ALLOCATABLE, DIMENSION(:)           :: lev                                  !! height level (required by the restini 
+                                                                                    !! interface) 
+  LOGICAL                                   :: rectilinear                          !! Is the grid rectilinear
+  REAL, ALLOCATABLE, DIMENSION(:)           :: lon_rect, lat_rect                   !! Vectors of Longitude and latitude (iim or 
+                                                                                    !! jjm) dimension used in case of a 
+                                                                                    !! rectilinear grid 
+  REAL(r_std)                               :: dt                                   !! Time step of sechiba component read in the 
+                                                                                    !! restart file [seconds] 
+  INTEGER(i_std)                            :: itau_dep,itau_fin,itau               !! First, last and current time step of SECHIBA 
+                                                                                    !! component 
+  INTEGER(i_std)                            :: itau_len,itau_step                   !! Total length of the simulation and length 
+                                                                                    !! between 2 calls of slowproc (expreseed in 
+                                                                                    !! time steps of SECHIBA component) 
+  REAL(r_std)                               :: date0                                !! Initial date
+  INTEGER(i_std)                            :: rest_id_sec,rest_id_sto              !! ID's of the restart files for the SECHIBA 
+                                                                                    !! and STOMATE components 
+  INTEGER(i_std)                            :: hist_id_sec,hist_id_sec2             !! ID's of the history files of SECHIBA 
+                                                                                    !! component (required by the interface of 
+                                                                                    !! slowproc but not used) 
+  INTEGER(i_std)                            :: hist_id_stom,hist_id_stom_IPCC       !! ID's of the history files of STOMATE 
+                                                                                    !! component 
+  CHARACTER(LEN=30)                         :: time_str                             !! String used for reading the length of 
+                                                                                    !! simulation in the .def file 
+  REAL(r_std)                               :: dt_slow_                             !! 
+  REAL                                      :: hist_days_stom,hist_days_stom_ipcc   !! Time frequency at which variables are 
+                                                                                    !! written in the history file for the STOMATE 
+                                                                                    !! component (standard and ipcc format) [day] 
+  REAL                                      :: hist_dt_stom,hist_dt_stom_ipcc       !! Time frequency at which variables are 
+                                                                                    !! written in the history file for the STOMATE 
+                                                                                    !! component (standard and ipcc format) 
+                                                                                    !! [second] 
+  REAL(r_std), ALLOCATABLE, DIMENSION(:)    :: hist_PFTaxis                         !! Vector with PFT indeces used as axis in the 
+                                                                                    !! history file 
+  REAL(r_std), ALLOCATABLE, DIMENSION(:)    :: hist_solaxaxis                       !! Vector with soil layers used as axis in the 
+                                                                                    !! history file
+  REAL(r_std),DIMENSION(10)                 :: hist_pool_10axis                     !! Vector with 10-year indeces used as axis in 
+                                                                                    !! the history file (for land-use change) 
+  REAL(r_std),DIMENSION(100)                :: hist_pool_100axis                    !! Vector with 100-year indeces used as axis in 
+                                                                                    !! the history file (for land-use change) 
+  REAL(r_std),DIMENSION(11)                 :: hist_pool_11axis                     !! Vector with 11-year indeces used as axis in 
+                                                                                    !! the history file (for land-use change) 
+  REAL(r_std),DIMENSION(101)                :: hist_pool_101axis                    !! Vector with 101-year indeces used as axis in 
+                                                                                    !! the history file (for land-use change) 
+  INTEGER                                   :: hist_PFTaxis_id,hist_IPCC_PFTaxis_id !! Id of the axis for PFT in the standard/IPCC 
+                                                                                    !! format 
+  INTEGER                                   :: hist_solax_id                        !! Id of the axis for soil layer in the standard 
+                                                                                    !! format
+  INTEGER                                   :: hori_id 
+  INTEGER                                   :: hist_pool_10axis_id                  !! Id of the axis for 10-year vector
+  INTEGER                                   :: hist_pool_100axis_id                 !! Id of the axis for the 100-year vector
+  INTEGER                                   :: hist_pool_11axis_id                  !! Id of the axis for the 11-year vector
+  INTEGER                                   :: hist_pool_101axis_id                 !! Id of the axis for the 101-year vector
+  INTEGER(i_std)                            :: i,j,iv                               !! used as counters
+  LOGICAL                                   :: ldrestart_read,ldrestart_write       !! Flags to activate reading/writing of the 
+                                                                                    !! restart file 
+  LOGICAL                                   :: l1d                                  !! Are vector elements 1-dimension size ?
+  INTEGER(i_std),PARAMETER                  :: nbvarmax=200                         !! Maximum number of variables assumed in the 
+                                                                                    !! restart file of SECHIBA component used as 
+                                                                                    !! input 
+  INTEGER(i_std)                            :: nbvar                                !! Number of variables present in the restart 
+                                                                                    !! file of SECHIBA component used as input 
+  CHARACTER(LEN=50),DIMENSION(nbvarmax)     :: varnames                             !! Name of the variables present in the restart 
+                                                                                    !! file of SECHIBA component used as input 
+  INTEGER(i_std)                            :: varnbdim                             !! Number of dimensions of a variable 
+                                                                                    !! varnames(i) 
+  INTEGER(i_std),PARAMETER                  :: varnbdim_max=20                      !! Maximum number of dimensions of a variable 
+                                                                                    !! varnames(i) 
+  INTEGER,DIMENSION(varnbdim_max)           :: vardims
+  CHARACTER(LEN=200)                        :: taboo_vars
+  REAL(r_std),DIMENSION(1)                  :: xtmp
+  INTEGER                                   :: nsfm,nsft
+  INTEGER                                   :: iisf,iiisf
+  INTEGER(i_std)                            :: max_totsize,totsize_1step
+  INTEGER(i_std)                            :: totsize_tmp  
+  INTEGER                                   :: vid
+  CHARACTER(LEN=100)                        :: forcing_name
+  REAL                                      :: x
+
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: var_3d
+  REAL(r_std)                               :: var_1d(1)
+
+!-
+  REAL(r_std)                               :: time_sec,time_step_sec
+  REAL(r_std)                               :: time_dri,time_step_dri
+  REAL(r_std),DIMENSION(1)                  :: r1d
+  REAL(r_std)                               :: julian,djulian
+
+  INTEGER(i_std)                            :: ji,jv,l
+
+  LOGICAL :: debug
+
+!---------------------------------------------------------------------
+
+  !-
+  ! 1. Reading parameters, Allocating variables and Initializations
+  !-
+
+  CALL Init_orchidee_para
+!ANNE  CALL init_para(.FALSE.)
+  CALL init_timer
+
+  IF (is_root_prc) THEN
+     !-
+     ! open STOMATE's forcing file to read some basic info
+     !-
+     forcing_name = 'stomate_forcing.nc'
+     CALL getin ('STOMATE_FORCING_NAME',forcing_name)
+     iret = NF90_OPEN (TRIM(forcing_name),NF90_NOWRITE,forcing_id)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'teststomate', &
+             &        'Could not open file : ', &
+             &          forcing_name,'(Do you have forget it ?)')
+     ENDIF
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'dtradia',dtradia)
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'dt_slow',dt_force)
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'nsft',x)
+     nsft = NINT(x)
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'kjpij',x)
+     kjpij = NINT(x)
+     ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'kjpindex',x)
+     nbp_glo = NINT(x)
+  ENDIF
+
+  CALL bcast(dtradia)
+  CALL bcast(dt_force)
+  CALL bcast(nsft)
+  CALL bcast(nbp_glo)
+  !-
+  write(numout,*) 'ATTENTION',dtradia,dt_force
+  !-
+  ! read info about land points
+  !-
+  IF (is_root_prc) THEN
+     a_er=.FALSE.
+     ALLOCATE (indices_g(nbp_glo),stat=ier)
+     a_er = a_er .OR. (ier.NE.0)
+     IF (a_er) THEN
+        CALL ipslerr (3,'teststomate', &
+             &        'PROBLEM WITH ALLOCATION', &
+             &        'for local variables 1','')
+     ENDIF
+     !
+     ALLOCATE (x_indices_g(nbp_glo),stat=ier)
+     a_er = a_er .OR. (ier.NE.0)
+     IF (a_er) THEN
+        CALL ipslerr (3,'teststomate', &
+             &        'PROBLEM WITH ALLOCATION', &
+             &        'for global variables 1','')
+     ENDIF
+     ier = NF90_INQ_VARID (forcing_id,'index',vid)
+     IF (ier .NE. 0) THEN
+        CALL ipslerr (3,'teststomate', &
+             &        'PROBLEM WITH ALLOCATION', &
+             &        'for global variables 1','')
+     ENDIF
+     ier = NF90_GET_VAR   (forcing_id,vid,x_indices_g)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'teststomate', &
+             &        'PROBLEM WITH variable "index" in file ', &
+             &        forcing_name,'(check this file)')
+     ENDIF
+     indices_g(:) = NINT(x_indices_g(:))
+     DEALLOCATE (x_indices_g)
+  ELSE
+     ALLOCATE (indices_g(0))
+  ENDIF
+
+!---------------------------------------------------------------------
+!-
+! set debug to have more information
+!-
+  !Config Key   = DEBUG_INFO
+  !Config Desc  = Flag for debug information
+  !Config If    = [-]
+  !Config Def   = n
+  !Config Help  = This option allows to switch on the output of debug
+  !Config         information without recompiling the code.
+  !Config Units = [FLAG]
+!-
+  debug = .FALSE.
+  CALL getin_p('DEBUG_INFO',debug)
+  !
+  !Config Key   = LONGPRINT
+  !Config Desc  = ORCHIDEE will print more messages
+  !Config If    = [-]
+  !Config Def   = n
+  !Config Help  = This flag permits to print more debug messages in the run.
+  !Config Units = [FLAG]
+  !
+  long_print = .FALSE.
+  CALL getin_p('LONGPRINT',long_print)
+  !-
+  ! activate CO2, STOMATE, but not sechiba
+  !-
+  control%river_routing = .FALSE.
+  control%hydrol_cwrr = .FALSE.
+  control%ok_sechiba = .FALSE.
+  !
+  control%stomate_watchout = .TRUE.
+  control%ok_co2 = .TRUE.
+  control%ok_stomate = .TRUE.
+  !-
+  ! is DGVM activated?
+  !-
+  control%ok_dgvm = .FALSE.
+  CALL getin_p('STOMATE_OK_DGVM',control%ok_dgvm)
+  WRITE(numout,*) 'LPJ is activated: ',control%ok_dgvm
+
+!-
+! Configuration
+!-
+  ! 1. Number of PFTs defined by the user
+
+  !Config Key   = NVM
+  !Config Desc  = number of PFTs  
+  !Config If    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = 13
+  !Config Help  = The number of vegetation types define by the user
+  !Config Units = [-]
+  !
+  CALL getin_p('NVM',nvm)
+  WRITE(numout,*)'the number of pfts is : ', nvm
+
+  ! 2. Should we read the parameters in the run.def file ?
+  
+  !Config Key   = IMPOSE_PARAM
+  !Config Desc  = Do you impose the values of the parameters?
+  !Config if    = OK_SECHIBA or OK_STOMATE
+  !Config Def   = y
+  !Config Help  = This flag can deactivate the reading of some parameters.
+  !Config         Useful if you want to use the standard values without commenting the run.def
+  !Config Units = [FLAG]
+  !
+  CALL getin_p('IMPOSE_PARAM',impose_param)
+
+  ! 3. Allocate and intialize the pft parameters
+
+  CALL pft_parameters_main(control)
+
+  ! 4. Activation sub-models of ORCHIDEE
+
+  CALL activate_sub_models(control)
+
+  ! 5. Vegetation configuration (impose_veg, land_use, lcchange...previously in slowproc)
+
+  CALL veget_config
+
+  ! 6. Read the parameters in the run.def file
+
+  IF (impose_param) THEN
+     CALL config_pft_parameters
+     CALL config_stomate_pft_parameters
+     CALL config_co2_parameters
+     CALL config_stomate_parameters
+  ENDIF
+  !-
+  IF (control%ok_dgvm) THEN
+     IF ( impose_param ) THEN
+        CALL config_dgvm_parameters
+     ENDIF
+  ENDIF
+!-
+  !-
+  ! restart files
+  !-
+  IF (is_root_prc) THEN
+     ! Sechiba's restart files
+     sec_restname_in = 'sechiba_start.nc'
+     CALL getin('SECHIBA_restart_in',sec_restname_in)
+     WRITE(numout,*) 'SECHIBA INPUT RESTART_FILE: ',TRIM(sec_restname_in)
+     IF ( TRIM(sec_restname_in) .EQ. 'NONE' ) THEN
+        STOP 'Need a restart file for Sechiba'
+     ENDIF
+     sec_restname_out = 'sechiba_rest_out.nc'
+     CALL getin('SECHIBA_rest_out',sec_restname_out)
+     WRITE(numout,*) 'SECHIBA OUTPUT RESTART_FILE: ',TRIM(sec_restname_out)
+     ! Stomate's restart files
+     sto_restname_in = 'stomate_start.nc'
+     CALL getin('STOMATE_RESTART_FILEIN',sto_restname_in)
+     WRITE(numout,*) 'STOMATE INPUT RESTART_FILE: ',TRIM(sto_restname_in)
+     sto_restname_out = 'stomate_rest_out.nc'
+     CALL getin('STOMATE_RESTART_FILEOUT',sto_restname_out)
+     WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out)
+
+     !-
+     ! We need to know iim, jjm.
+     ! Get them from the restart files themselves.
+     !-
+     iret = NF90_OPEN (sec_restname_in,NF90_NOWRITE,ncfid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr (3,'teststomate', &
+             &        'Could not open file : ', &
+             &          sec_restname_in,'(Do you have forget it ?)')
+     ENDIF
+     iret = NF90_INQUIRE_DIMENSION (ncfid,1,len=iim_g)
+     iret = NF90_INQUIRE_DIMENSION (ncfid,2,len=jjm_g)
+     iret = NF90_INQ_VARID (ncfid, "time", iv)
+     iret = NF90_GET_ATT (ncfid, iv, 'calendar',thecalendar)
+     iret = NF90_CLOSE (ncfid)
+     i=INDEX(thecalendar,ACHAR(0))
+     IF ( i > 0 ) THEN
+        thecalendar(i:20)=' '
+     ENDIF
+  ENDIF
+  CALL bcast(iim_g)
+  CALL bcast(jjm_g)
+  CALL bcast(thecalendar)
+  !-
+  ! calendar
+  !-
+  CALL ioconf_calendar (thecalendar)
+  CALL ioget_calendar  (one_year,one_day)
+  !
+  ! Parallelization :
+  !
+!  CALL init_data_para(iim_g,jjm_g,nbp_glo,indices_g)
+  call init_orchidee_data_para_driver(nbp_glo, indices_g)
+  kjpindex=nbp_loc
+  jjm=jj_nb
+  iim=iim_g
+  kjpij=iim*jjm
+  IF (debug) WRITE(numout,*) "Local grid : ",kjpindex,iim,jjm
+  !-
+  !-
+  ! read info about grids
+  !-
+  !-
+  llm=1
+  ALLOCATE(lev(llm))
+  IF (is_root_prc) THEN
+     !-
+     ier = NF90_INQ_VARID (forcing_id,'lalo',vid)
+     ier = NF90_GET_VAR   (forcing_id,vid,lalo_g)
+     !-
+     ALLOCATE (x_neighbours_g(nbp_glo,8),stat=ier)
+     ier = NF90_INQ_VARID (forcing_id,'neighbours',vid)
+     ier = NF90_GET_VAR   (forcing_id,vid,x_neighbours_g)
+     neighbours_g(:,:) = NINT(x_neighbours_g(:,:))
+     DEALLOCATE (x_neighbours_g)
+     !-
+     ier = NF90_INQ_VARID (forcing_id,'resolution',vid)
+     ier = NF90_GET_VAR   (forcing_id,vid,resolution_g)
+     !-
+     ier = NF90_INQ_VARID (forcing_id,'contfrac',vid)
+     ier = NF90_GET_VAR   (forcing_id,vid,contfrac_g)
+
+     lon_g(:,:) = zero
+     lat_g(:,:) = zero
+     lev(1)   = zero
+     !-
+     CALL restini &
+          & (sec_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
+          &  sec_restname_out, itau_dep, date0, dt, rest_id_sec)
+     !-
+     IF ( dt .NE. dtradia ) THEN
+        WRITE(numout,*) 'dt',dt
+        WRITE(numout,*) 'dtradia',dtradia
+        CALL ipslerr (3,'teststomate', &
+             &        'PROBLEM with time steps.', &
+             &          sec_restname_in,'(dt .NE. dtradia)')
+     ENDIF
+     !-
+     CALL restini &
+          & (sto_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
+          &  sto_restname_out, itau_dep, date0, dt, rest_id_sto)
+     !-
+     IF ( dt .NE. dtradia ) THEN
+        WRITE(numout,*) 'dt',dt
+        WRITE(numout,*) 'dtradia',dtradia
+        CALL ipslerr (3,'teststomate', &
+             &        'PROBLEM with time steps.', &
+             &          sto_restname_in,'(dt .NE. dtradia)')
+     ENDIF
+  ENDIF
+  CALL bcast(rest_id_sec)
+  CALL bcast(rest_id_sto)
+  CALL bcast(itau_dep)
+  CALL bcast(date0)
+  CALL bcast(dt)
+  CALL bcast(lev)
+  !---
+  !--- Create the index table
+  !---
+  !--- This job return a LOCAL kindex
+  !---
+  ALLOCATE (indices(kjpindex),stat=ier)
+  IF (debug .AND. is_root_prc) WRITE(numout,*) "indices_g = ",indices_g(1:nbp_glo)
+  CALL scatter(indices_g,indices)
+  indices(1:kjpindex)=indices(1:kjpindex)-(jj_begin-1)*iim_g
+  IF (debug) WRITE(numout,*) "indices = ",indices(1:kjpindex)
+
+  !---
+  !--- initialize global grid
+  !---
+  CALL init_grid( kjpindex ) 
+  CALL grid_stuff (nbp_glo, iim_g, jjm_g, lon_g, lat_g, indices_g)
+
+  !---
+  !--- initialize local grid
+  !---
+  jlandindex = (((indices(1:kjpindex)-1)/iim) + 1)
+  if (debug) WRITE(numout,*) "jlandindex = ",jlandindex(1:kjpindex)
+  ilandindex = (indices(1:kjpindex) - (jlandindex(1:kjpindex)-1)*iim)
+  IF (debug) WRITE(numout,*) "ilandindex = ",ilandindex(1:kjpindex)
+  ALLOCATE(lon(iim,jjm))
+  ALLOCATE(lat(iim,jjm))
+  lon=zero
+  lat=zero
+  CALL scatter2D_mpi(lon_g,lon)
+  CALL scatter2D_mpi(lat_g,lat)
+
+  DO ji=1,kjpindex
+
+     j = jlandindex(ji)
+     i = ilandindex(ji)
+
+     !- Create the internal coordinate table
+!-
+     lalo(ji,1) = lat(i,j)
+     lalo(ji,2) = lon(i,j)
+  ENDDO
+  CALL scatter(neighbours_g,neighbours)
+  CALL scatter(resolution_g,resolution)
+  CALL scatter(contfrac_g,contfrac)
+  CALL scatter(area_g,area)
+  !-
+  !- Check if we have by any chance a rectilinear grid. This would allow us to 
+  !- simplify the output files.
+  !
+  rectilinear = .FALSE.
+  IF (is_root_prc) THEN
+     IF ( ALL(lon_g(:,:) == SPREAD(lon_g(:,1), 2, SIZE(lon_g,2))) .AND. &
+       & ALL(lat_g(:,:) == SPREAD(lat_g(1,:), 1, SIZE(lat_g,1))) ) THEN
+        rectilinear = .TRUE.
+     ENDIF
+  ENDIF
+  CALL bcast(rectilinear)
+  IF (rectilinear) THEN
+     ALLOCATE(lon_rect(iim),stat=ier)
+     IF (ier .NE. 0) THEN
+        WRITE (numout,*) ' error in lon_rect allocation. We stop. We need iim words = ',iim
+        STOP 'intersurf_history'
+     ENDIF
+     ALLOCATE(lat_rect(jjm),stat=ier)
+     IF (ier .NE. 0) THEN
+        WRITE (numout,*) ' error in lat_rect allocation. We stop. We need jjm words = ',jjm
+        STOP 'intersurf_history'
+     ENDIF
+     lon_rect(:) = lon(:,1)
+     lat_rect(:) = lat(1,:)
+  ENDIF
+  !-
+  ! allocate arrays
+  !-
+  !
+  a_er = .FALSE.
+  ALLOCATE (hist_PFTaxis(nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (hist_solaxaxis(nbdl),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (indexveg(kjpindex*nvm), stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (soiltile(kjpindex,nstm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (veget_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (totfrac_nobio(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (frac_nobio(kjpindex,nnobio),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (veget_max_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (lai_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (veget_force_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (veget_max_force_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (njsc(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (lai_force_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (reinf_slope(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (t2m(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (t2m_min(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (temp_sol(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (soiltemp(kjpindex,nbdl),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (soilhum(kjpindex,nbdl),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (humrel_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (litterhum(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (precip_rain(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (precip_snow(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (gpp_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (deadleaf_cover(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (assim_param_x(kjpindex,nvm,npco2),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (height_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (qsintmax_x(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (co2_flux(kjpindex,nvm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (floodout(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (drainage(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (runoff(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (drainage_per_soil(kjpindex,nstm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (runoff_per_soil(kjpindex,nstm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (DOC_EXP_agg_d(kjpindex,nexp),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)  
+  ALLOCATE (DOC_to_topsoil(kjpindex,nelements),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)    
+  ALLOCATE (DOC_to_subsoil(kjpindex,nelements),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)    
+  ALLOCATE (wat_flux0(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (wat_flux(kjpindex,nbdl),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (soil_mc(kjpindex,nbdl,nstm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (litter_mc(kjpindex,nstm),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (fco2_lu(kjpindex),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  ALLOCATE (frac_age_x(kjpindex,nvm,nleafages),stat=ier)
+  a_er = a_er .OR. (ier.NE.0)
+  IF (a_er) THEN
+     CALL ipslerr (3,'teststomate', &
+          &        'PROBLEM WITH ALLOCATION', &
+          &        'for local variables 1','')
+  ENDIF
+  !
+  ! prepare forcing
+  ! forcing file of STOMATE is read by block 
+  ! in order to minimize the reading frequency
+  ! Here is done the calculation of the number 
+  ! of time steps we load in memory 
+  !
+  max_totsize = 50
+  CALL getin_p ('STOMATE_FORCING_MEMSIZE',max_totsize)
+  max_totsize = max_totsize * 1000000
+
+  totsize_1step = SIZE(soiltile(:,3))*KIND(soiltile(:,3)) + &
+       SIZE(humrel_x)*KIND(humrel_x) + &
+       SIZE(litterhum)*KIND(litterhum) + &
+       SIZE(t2m)*KIND(t2m) + &
+       SIZE(t2m_min)*KIND(t2m_min) + &
+       SIZE(temp_sol)*KIND(temp_sol) + &
+       SIZE(soiltemp)*KIND(soiltemp) + &
+       SIZE(soilhum)*KIND(soilhum) + &
+       SIZE(precip_rain)*KIND(precip_rain) + &
+       SIZE(precip_snow)*KIND(precip_snow) + &
+       SIZE(gpp_x)*KIND(gpp_x) + &
+       SIZE(veget_force_x)*KIND(veget_force_x) + &
+       SIZE(veget_max_force_x)*KIND(veget_max_force_x) + &
+       SIZE(lai_force_x)*KIND(lai_force_x)
+  CALL reduce_sum(totsize_1step,totsize_tmp)
+  CALL bcast(totsize_tmp)
+  totsize_1step=totsize_tmp 
+
+  ! check for consistency of the total number of forcing steps
+  IF ( nsft .NE. INT(one_year/(dt_force/one_day)) ) THEN
+     CALL ipslerr_p (3,'teststomate', &
+          &        'stomate: error with total number of forcing steps', &
+          &        'nsft','teststomate computation different with forcing file value.')
+  ENDIF
+  ! number of forcing steps in memory
+  nsfm = MIN(nsft, &
+       &       MAX(1,NINT( REAL(max_totsize,r_std) &
+       &                  /REAL(totsize_1step,r_std))))
+  !-
+  WRITE(numout,*) 'Offline forcing of Stomate:'
+  WRITE(numout,*) '  Total number of forcing steps:',nsft
+  WRITE(numout,*) '  Number of forcing steps in memory:',nsfm
+  !-
+  ! init_forcing defined into stomate.f90
+  ! allocate and set to zero driving variables of STOMATE
+  ! ie variables that are read in the forcing file
+  !-
+  CALL init_forcing(kjpindex,nsfm,nsft)
+  !-
+  ! ensure that we read all new forcing states
+  iisf = nsfm
+  ! initialize the table that contains the indices
+  ! of the forcing states that will be in memory
+  isf(:) = (/ (i,i=1,nsfm) /)
+
+  nf_written(:) = .FALSE.
+  nf_written(isf(:)) = .TRUE.
+
+  !-
+  ! a time step for STOMATE corresponds to itau_step timesteps in SECHIBA
+  !-
+  itau_step = NINT(dt_force/dtradia)
+  IF (debug) WRITE(numout,*) "dtradia, dt_rest, dt_force, itau_step",dtradia, dt, dt_force, itau_step
+  !
+  CALL ioconf_startdate(date0)
+  CALL intsurf_time( itau_dep, date0, dtradia )
+  !-
+  ! Length of integration
+  !-
+  WRITE(time_str,'(a)') '1Y'
+  CALL getin_p ('TIME_LENGTH', time_str)
+  ! transform into itau
+  CALL tlen2itau(time_str, dt, date0, itau_len)
+  ! itau_len*dtradia must be a multiple of dt_force
+  itau_len = NINT( MAX(1.,FLOAT(NINT(itau_len*dtradia/dt_force))) &
+       &                *dt_force/dtradia)
+  !-
+  itau_fin = itau_dep+itau_len
+  !-
+  ! 2. set up STOMATE history file
+  !-
+  !Config Key   = STOMATE_OUTPUT_FILE
+  !Config Desc  = Name of file in which STOMATE's output is going to be written
+  !Config If    = 
+  !Config Def   = stomate_history.nc
+  !Config Help  = This file is going to be created by the model
+  !Config         and will contain the output from the model.
+  !Config         This file is a truly COADS compliant netCDF file.
+  !Config         It will be generated by the hist software from
+  !Config         the IOIPSL package.
+  !Config Units = FILE
+  !-
+  stom_histname='stomate_history.nc'
+  CALL getin_p ('STOMATE_OUTPUT_FILE', stom_histname)
+  WRITE(numout,*) 'STOMATE_OUTPUT_FILE', TRIM(stom_histname)
+  !-
+  !Config Key   = STOMATE_HIST_DT
+  !Config Desc  = STOMATE history time step 
+  !Config If    = 
+  !Config Def   = 10.
+  !Config Help  = Time step of the STOMATE history file
+  !Config Units = days [d]
+  !-
+  hist_days_stom = 10.
+  CALL getin_p ('STOMATE_HIST_DT', hist_days_stom)
+  IF ( hist_days_stom == -1. ) THEN
+     hist_dt_stom = -1.
+     WRITE(numout,*) 'output frequency for STOMATE history file (d): one month.'
+  ELSE
+     hist_dt_stom = NINT( hist_days_stom ) * one_day
+     WRITE(numout,*) 'output frequency for STOMATE history file (d): ', &
+             hist_dt_stom/one_day
+  ENDIF
+  !-
+  !- initialize
+  WRITE(numout,*) "before histbeg : ",date0,dt
+  IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+     CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+          &     itau_dep, date0, dt, hori_id, hist_id_stom, domain_id=orch_domain_id)
+#else
+     CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+          &     itau_dep, date0, dt, hori_id, hist_id_stom)
+#endif
+  ELSE
+#ifdef CPP_PARA
+     CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+          &     itau_dep, date0, dt, hori_id, hist_id_stom, domain_id=orch_domain_id)
+#else
+     CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+          &     itau_dep, date0, dt, hori_id, hist_id_stom)
+#endif
+  ENDIF
+  !- define PFT axis
+  hist_PFTaxis = (/ ( REAL(i,r_std), i=1,nvm ) /)
+  hist_solaxaxis = (/ ( REAL(i,r_std), i=1,nbdl ) /)
+  !- declare this axis
+  CALL histvert (hist_id_stom, 'PFT', 'Plant functional type', &
+       & '1', nvm, hist_PFTaxis, hist_PFTaxis_id)
+  CALL histvert (hist_id_stom, 'z', 'Soil layer', &
+       & '1', nbdl, hist_solaxaxis, hist_solax_id)
+!- define Pool_10 axis
+   hist_pool_10axis = (/ ( REAL(i,r_std), i=1,10 ) /)
+!- declare this axis
+  CALL histvert (hist_id_stom, 'P10', 'Pool 10 years', &
+       & '1', 10, hist_pool_10axis, hist_pool_10axis_id)
+
+!- define Pool_100 axis
+   hist_pool_100axis = (/ ( REAL(i,r_std), i=1,100 ) /)
+!- declare this axis
+  CALL histvert (hist_id_stom, 'P100', 'Pool 100 years', &
+       & '1', 100, hist_pool_100axis, hist_pool_100axis_id)
+
+!- define Pool_11 axis
+   hist_pool_11axis = (/ ( REAL(i,r_std), i=1,11 ) /)
+!- declare this axis
+  CALL histvert (hist_id_stom, 'P11', 'Pool 10 years + 1', &
+       & '1', 11, hist_pool_11axis, hist_pool_11axis_id)
+
+!- define Pool_101 axis
+   hist_pool_101axis = (/ ( REAL(i,r_std), i=1,101 ) /)
+!- declare this axis
+  CALL histvert (hist_id_stom, 'P101', 'Pool 100 years + 1', &
+       & '1', 101, hist_pool_101axis, hist_pool_101axis_id)
+
+  !- define STOMATE history file
+  CALL stom_define_history (hist_id_stom, nvm, iim, jjm, &
+       & dt, hist_dt_stom, hori_id, hist_PFTaxis_id, &
+ & hist_pool_10axis_id, hist_pool_100axis_id, &
+ & hist_pool_11axis_id, hist_pool_101axis_id, hist_solax_id)
+
+  !- end definition
+  CALL histend(hist_id_stom)
+  !-
+  !-
+  ! STOMATE IPCC OUTPUTS IS ACTIVATED
+  !-
+  !Config Key   = STOMATE_IPCC_OUTPUT_FILE
+  !Config Desc  = Name of file in which STOMATE's output is going to be written
+  !Config If    = 
+  !Config Def   = stomate_ipcc_history.nc
+  !Config Help  = This file is going to be created by the model
+  !Config         and will contain the output from the model.
+  !Config         This file is a truly COADS compliant netCDF file.
+  !Config         It will be generated by the hist software from
+  !Config         the IOIPSL package.
+  !Config Units = FILE
+  !-
+  stom_ipcc_histname='stomate_ipcc_history.nc'
+  CALL getin_p('STOMATE_IPCC_OUTPUT_FILE', stom_ipcc_histname)       
+  WRITE(numout,*) 'STOMATE_IPCC_OUTPUT_FILE', TRIM(stom_ipcc_histname)
+  !-
+  !Config Key   = STOMATE_IPCC_HIST_DT
+  !Config Desc  = STOMATE IPCC history time step 
+  !Config If    = 
+  !Config Def   = 0.
+  !Config Help  = Time step of the STOMATE IPCC history file
+  !Config Units = days [d]
+  !-
+  hist_days_stom_ipcc = zero
+  CALL getin_p('STOMATE_IPCC_HIST_DT', hist_days_stom_ipcc)       
+  IF ( hist_days_stom_ipcc == moins_un ) THEN
+     hist_dt_stom_ipcc = moins_un
+     WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): one month.'
+  ELSE
+     hist_dt_stom_ipcc = NINT( hist_days_stom_ipcc ) * one_day
+     WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): ', &
+          hist_dt_stom_ipcc/one_day
+  ENDIF
+
+  ! test consistency between STOMATE_IPCC_HIST_DT and DT_SLOW parameters
+  dt_slow_ = one_day
+  CALL getin_p('DT_SLOW', dt_slow_)
+  IF ( hist_days_stom_ipcc > zero ) THEN
+     IF (dt_slow_ > hist_dt_stom_ipcc) THEN
+        WRITE(numout,*) "DT_SLOW = ",dt_slow_,"  , STOMATE_IPCC_HIST_DT = ",hist_dt_stom_ipcc
+        CALL ipslerr_p (3,'intsurf_history', &
+             &          'Problem with DT_SLOW > STOMATE_IPCC_HIST_DT','', &
+             &          '(must be less or equal)')
+     ENDIF
+  ENDIF
+
+  IF ( hist_dt_stom_ipcc == 0 ) THEN
+     hist_id_stom_ipcc = -1
+  ELSE
+     !-
+     !- initialize
+     IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+        CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
+#else
+        CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc)
+#endif
+     ELSE
+#ifdef CPP_PARA
+        CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
+#else
+        CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+             &     itau_dep, date0, dt, hori_id, hist_id_stom_ipcc)
+#endif
+     ENDIF
+     !- declare this axis
+     CALL histvert (hist_id_stom_IPCC, 'PFT', 'Plant functional type', &
+          & '1', nvm, hist_PFTaxis, hist_IPCC_PFTaxis_id)
+
+     !- define STOMATE history file
+     CALL stom_IPCC_define_history (hist_id_stom_IPCC, nvm, iim, jjm, &
+          & dt, hist_dt_stom_ipcc, hori_id, hist_IPCC_PFTaxis_id)
+
+     !- end definition
+     CALL histend(hist_id_stom_IPCC)
+
+  ENDIF
+  !
+  CALL histwrite_p(hist_id_stom, 'Areas',  itau_dep+itau_step, area, kjpindex, indices)
+  IF ( hist_id_stom_IPCC > 0 ) THEN
+     CALL histwrite_p(hist_id_stom_IPCC, 'Areas',  itau_dep+itau_step, area, kjpindex, indices)
+  ENDIF
+  !
+  hist_id_sec = -1
+  hist_id_sec2 = -1
+  !-
+  ! 3. first call of slowproc to initialize variables
+  !-
+  itau = itau_dep
+  !  
+  DO ji=1,kjpindex
+     DO jv=1,nvm
+        indexveg((jv-1)*kjpindex + ji) = indices(ji) + (jv-1)*kjpij
+     ENDDO
+  ENDDO
+  !-
+  !
+  !Config key   = HYDROL_CWRR
+  !Config Desc  = Allows to switch on the multilayer hydrology of CWRR
+  !Config If    = OK_SECHIBA
+  !Config Def   = n
+  !Config Help  = This flag allows the user to decide if the vertical
+  !Config         hydrology should be treated using the multi-layer 
+  !Config         diffusion scheme adapted from CWRR by Patricia de Rosnay.
+  !Config         by default the Choisnel hydrology is used.
+  !Config Units = [FLAG]
+  CALL getin_p ("HYDROL_SOIL_DEPTH", dpu_max)
+  !
+  !MM Problem here with dpu which depends on soil type           
+  DO l = 1, nbdl-1
+     ! first 2.0 is dpu 
+     ! second 2.0 is average
+     diaglev(l) = dpu_max/(2**(nbdl-1) -1) * ( ( 2**(l-1) -1) + ( 2**(l) -1) ) / 2.0
+  ENDDO
+  diaglev(nbdl) = dpu_max
+  !
+!-
+! Read the parameters in the "*.def" files
+!-
+  !
+  !Config Key   = CLAYFRACTION_DEFAULT
+  !Config Desc  = 
+  !Config If    = OK_SECHIBA 
+  !Config Def   = 0.2 
+  !Config Help  = 
+  !Config Units = [-]
+  CALL getin_p('CLAYFRACTION_DEFAULT',clayfraction_default)
+  !
+  !Config Key   = MIN_VEGFRAC 
+  !Config Desc  = Minimal fraction of mesh a vegetation type can occupy 
+  !Config If    = OK_SECHIBA 
+  !Config Def   = 0.001 
+  !Config Help  = 
+  !Config Units = [-]
+  CALL getin_p('MIN_VEGFRAC',min_vegfrac)
+  !
+  !Config Key   = STEMPDIAG_BID 
+  !Config Desc  = only needed for an initial LAI if there is no restart file
+  !Config If    = OK_SECHIBA 
+  !Config Def   = 280.
+  !Config Help  = 
+  !Config Units = [K]
+  CALL getin_p('STEMPDIAG_BID',stempdiag_bid)
+  !
+!-
+  CALL ioget_expval(val_exp)
+  ldrestart_read = .TRUE.
+  ldrestart_write = .FALSE.
+  !-
+  ! read some variables we need from SECHIBA's restart file
+  !-
+  CALL slowproc_main &
+ &  (itau, kjpij, kjpindex, dt_force, date0, &
+ &   ldrestart_read, ldrestart_write, .FALSE., .TRUE., &
+ &   indices, indexveg, lalo, neighbours, resolution, contfrac, soiltile, reinf_slope, &
+ &   t2m, t2m_min, temp_sol, soiltemp, &
+ &   humrel_x, soilhum, litterhum, precip_rain, precip_snow, gpp_x, &
+ &   deadleaf_cover, assim_param_x, lai_x, frac_age_x, height_x, veget_x, &
+ &   frac_nobio, njsc, veget_max_x, totfrac_nobio, qsintmax_x, &
+ &   rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu,soil_mc, &
+ &   litter_mc,floodout, runoff, drainage, wat_flux0, wat_flux,&
+ &   drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, DOC_to_topsoil, DOC_to_subsoil)
+  ! correct date
+
+
+  day_counter = one_day - dt_force
+  date=1
+  IF (debug) check_time=.TRUE.
+  CALL intsurf_time( itau_dep+itau_step, date0, dtradia )
+  l_first_intersurf=.FALSE.
+  !-
+  ! 4. Time loop
+  !â»
+  DO itau = itau_dep+itau_step,itau_fin,itau_step
+    !
+    CALL intsurf_time( itau, date0, dtradia )
+    !-
+    ! next forcing state
+    iisf = iisf+1
+    IF (debug) WRITE(numout,*) "itau,iisf : ",itau,iisf
+    !---
+    IF (iisf .GT. nsfm) THEN
+!-----
+!---- we have to read new forcing states from the file
+!-----
+!---- determine blocks of forcing states that are contiguous in memory
+!-----
+        CALL forcing_read(forcing_id,nsfm)
+
+!--------------------------
+
+!-----
+!---- determine which forcing states must be read next time
+!-----
+      isf(1) = isf(nsfm)+1
+      IF ( isf(1) .GT. nsft ) isf(1) = 1
+        DO iiisf = 2, nsfm
+           isf(iiisf) = isf(iiisf-1)+1
+           IF ( isf(iiisf) .GT. nsft ) isf(iiisf) = 1
+        ENDDO
+        nf_written(isf(:)) = .TRUE.
+!---- start again at first forcing state
+        iisf = 1
+     ENDIF
+     humrel_x(:,:) = humrel_daily_fm(:,:,iisf)
+     litterhum(:) = litterhum_daily_fm(:,iisf)
+     t2m(:) = t2m_daily_fm(:,iisf)
+     t2m_min(:) = t2m_min_daily_fm(:,iisf)
+     temp_sol(:) = tsurf_daily_fm(:,iisf)
+     soiltemp(:,:) = tsoil_daily_fm(:,:,iisf)
+     soilhum(:,:) = soilhum_daily_fm(:,:,iisf)
+     precip_rain(:) = precip_fm(:,iisf)
+     gpp_x(:,:) = gpp_daily_fm(:,:,iisf)
+     veget_force_x(:,:) = veget_fm(:,:,iisf)
+     veget_max_force_x(:,:) = veget_max_fm(:,:,iisf)
+     lai_force_x(:,:) = lai_fm(:,:,iisf)
+     WHERE ( t2m(:) .LT. ZeroCelsius )
+        precip_snow(:) = precip_rain(:)
+        precip_rain(:) = zero
+     ELSEWHERE
+        precip_snow(:) = zero
+     ENDWHERE
+!---
+!-- scale GPP to new lai and veget_max
+!---
+     WHERE ( lai_x(:,:) .EQ. zero ) gpp_x(:,:) = zero
+!-- scale GPP to new LAI
+     WHERE (lai_force_x(:,:) .GT. zero )
+        gpp_x(:,:) = gpp_x(:,:)*ATAN(2.*lai_x(:,:)) &
+ &                           /ATAN( 2.*MAX(lai_force_x(:,:),0.01))
+    ENDWHERE
+    !- scale GPP to new veget_max
+    WHERE (veget_max_force_x(:,:) .GT. zero )
+        gpp_x(:,:) = gpp_x(:,:)*veget_max_x(:,:)/veget_max_force_x(:,:)
+    ENDWHERE
+    !-
+    !- number crunching
+    !-
+     ldrestart_read = .FALSE.
+     ldrestart_write = .FALSE.
+     CALL slowproc_main &
+ &    (itau, kjpij, kjpindex, dt_force, date0, &
+ &     ldrestart_read, ldrestart_write, .FALSE., .TRUE., &
+ &     indices, indexveg, lalo, neighbours, resolution, contfrac, soiltile, reinf_slope, &
+ &     t2m, t2m_min, temp_sol, soiltemp, &
+ &     humrel_x, soilhum, litterhum, precip_rain, precip_snow, gpp_x, &
+ &     deadleaf_cover, assim_param_x, lai_x, frac_age_x, height_x, veget_x, &
+ &     frac_nobio, njsc, veget_max_x, totfrac_nobio, qsintmax_x, &
+ &     rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu,soil_mc, &
+ &     litter_mc,floodout, runoff, drainage, wat_flux0, wat_flux,&
+ &     drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, DOC_to_topsoil, DOC_to_subsoil)
+     day_counter = one_day - dt_force
+  ENDDO ! end of the time loop
+
+
+!-
+! 5. write restart files
+!-
+  IF (is_root_prc) THEN
+! first, read and write variables that are not managed otherwise
+     taboo_vars = &
+          &  '$lat$ $lon$ $lev$ $veget_year$ '// &
+          &  '$height$ $day_counter$ $veget$ $veget_max$ $frac_nobio$ '// &
+          &  '$lai$ $soiltile_frac$ $clay_frac$ '// &
+          &  '$nav_lon$ $nav_lat$ $nav_lev$ $time$ $time_steps$'
+!-
+     CALL ioget_vname(rest_id_sec, nbvar, varnames)
+!-
+     DO iv = 1, nbvar
+!-- check if the variable is to be written here
+        IF (INDEX( taboo_vars,'$'//TRIM(varnames(iv))//'$') .EQ. 0 ) THEN
+           IF (debug) WRITE(numout,*) "restart var : ",TRIM(varnames(iv)),itau_dep,itau_fin
+
+!---- get variable dimensions, especially 3rd dimension
+           CALL ioget_vdim &
+                &      (rest_id_sec, varnames(iv), varnbdim_max, varnbdim, vardims)
+           l1d = ALL(vardims(1:varnbdim) .EQ. 1)
+!---- read it
+           IF (l1d) THEN
+              CALL restget (rest_id_sec,TRIM(varnames(iv)), &
+                   1,1,1,itau_dep,.TRUE.,var_1d)
+           ELSE
+              ALLOCATE(var_3d(nbp_glo,vardims(3)),stat=ier)
+              IF (ier .NE. 0) STOP 'ALLOCATION PROBLEM'
+              CALL restget (rest_id_sec,TRIM(varnames(iv)), &
+                   nbp_glo,vardims(3),1,itau_dep,.TRUE.,var_3d, &
+                   "gather",nbp_glo,indices_g)
+           ENDIF
+!---- write it
+           IF (l1d) THEN
+              CALL restput (rest_id_sec,TRIM(varnames(iv)), &
+                   1,1,1,itau_fin,var_1d)
+           ELSE
+              CALL restput (rest_id_sec,TRIM(varnames(iv)), &
+                   nbp_glo,vardims(3),1,itau_fin,var_3d, &
+                   'scatter',nbp_glo,indices_g)
+              DEALLOCATE (var_3d)
+           ENDIF
+        ENDIF
+     ENDDO
+  ENDIF
+  CALL barrier_para()
+
+! call slowproc to write restart files
+  ldrestart_read = .FALSE.
+  ldrestart_write = .TRUE.
+!-
+  IF (debug) WRITE(numout,*) "Call slowproc for restart."
+  CALL slowproc_main &
+ &  (itau_fin, kjpij, kjpindex, dt_force, date0, &
+ &   ldrestart_read, ldrestart_write, .FALSE., .TRUE., &
+ &   indices, indexveg, lalo, neighbours, resolution, contfrac, soiltile, reinf_slope, &
+ &   t2m, t2m_min, temp_sol, soiltemp, &
+ &   humrel_x, soilhum, litterhum, precip_rain, precip_snow, gpp_x, &
+ &   deadleaf_cover, assim_param_x, lai_x, frac_age_x, height_x, veget_x, &
+ &   frac_nobio, njsc, veget_max_x, totfrac_nobio, qsintmax_x, &
+ &   rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu,soil_mc, &
+ &   litter_mc,floodout, runoff, drainage, wat_flux0, wat_flux,&
+ &   drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, DOC_to_topsoil, DOC_to_subsoil)
+!-
+! close files
+!-
+  IF (is_root_prc) THEN
+     CALL restclo
+     IF ( debug )  WRITE(numout,*) 'REST CLOSED'
+  ENDIF
+  CALL histclo
+
+  IF (is_root_prc) &
+       ier = NF90_CLOSE (forcing_id)
+
+  IF (is_root_prc) THEN
+     CALL getin_dump()
+  ENDIF
+#ifdef CPP_PARA
+  CALL MPI_FINALIZE(ier)
+#endif
+  WRITE(numout,*) "End of teststomate."
+
+!---------------
+END PROGRAM teststomate
+!
+!===
+!
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/weather.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/weather.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_driver/weather.f90	(revision 5166)
@@ -0,0 +1,4004 @@
+! =================================================================================================================================
+! MODULE       : weather
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module simulates weather.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE weather
+
+  USE netcdf
+!-
+  USE defprec
+  USE ioipsl_para
+  USE constantes
+  USE mod_orchidee_para
+
+  USE solar
+  USE grid, ONLY : year,month,day,sec
+!-
+  IMPLICIT NONE
+!-
+  PRIVATE
+  PUBLIC weathgen_main, weathgen_domain_size, weathgen_init, weathgen_read_file, weathgen_qsat_2d
+!
+! Only for root proc
+  INTEGER, SAVE                              :: iim_file, jjm_file, llm_file, ttm_file !(unitless)
+  INTEGER,DIMENSION(:,:),SAVE,ALLOCATABLE    :: ncorr !(unitless)
+  INTEGER,DIMENSION(:,:,:),SAVE,ALLOCATABLE  :: icorr,jcorr !(unitless)
+  INTEGER,SAVE                               :: i_cut, n_agg !(unitless)
+
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xinwet   !! climatological wet days + anomaly @tex $(days.month^{-1})$ @endtex
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xinprec  !! climatological precipition + anomaly @tex $(mm.day^{-1})$ @endtex
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xint     !! climatological temp + anomaly (C)
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xinq     !! climatological relative humidity + anomaly (0-1, unitless)
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xinwind  !! climatological wind speed + anomaly @tex $(m.s^{-1})$ @endtex
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xincld   !! climatological cloudiness + anomaly (0-1, unitless)
+  REAL,DIMENSION(:,:),SAVE,ALLOCATABLE :: xintrng  !! climatological temp range + anomaly (C)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: xintopo  !! topography (m)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: lat_land !! latitudes of land points (unitless)
+!-
+! daily values
+!-
+  REAL,SAVE :: julian_last
+  INTEGER,DIMENSION(:),SAVE,ALLOCATABLE :: iwet    !! flag for wet day / dry day (0-1, unitless)
+!-
+! today's values (m0 means "minus 0")
+!-
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: psurfm0  !! surface pressure today(Pa)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: cloudm0  !! cloud fraction today (0-1, unitless)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: tmaxm0   !! maximum daily temperature today (K)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: tminm0   !! minimum daily temperature today (K)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: qdm0     !! daily average specific humidity today (kg_h2o/kg_air)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: udm0     !! daily average wind speed today  @tex $(m.s^{-1})$ @endtex
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: precipm0 !! daily precitation today @tex $(mm.day^{-1})$ @endtex
+!-
+! yesterday's values (m1 means "minus 1")
+!-
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: psurfm1  !! surface pressure yesterday (Pa)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: cloudm1  !! cloud fraction yesterday (0-1, unitless)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: tmaxm1   !! maximum daily temperature yesterday (K)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: tminm1   !! minimum daily temperature yesterday (K)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: qdm1     !! daily average specific humidity yesterday (kg_h2o/kg_air)
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: udm1     !! daily average wind speed  yesterday  @tex $(m.s^{-1})$ @endtex 
+  REAL,DIMENSION(:),SAVE,ALLOCATABLE   :: precipm1 !! daily precitation  yesterday @tex $(mm.day^{-1})$ @endtex 
+!-
+! other
+!-
+  INTEGER,SAVE                  :: ipprec        !! statistical (0) or prescribed (1) daily values
+
+  LOGICAL,SAVE                  :: precip_exact  !! respect monthly precipitation
+  INTEGER,DIMENSION(31,12),SAVE :: jour_precip
+
+
+  INTEGER,PARAMETER      :: seedsize_max = 300  !! max size of random seed
+  LOGICAL,SAVE           :: dump_weather
+  CHARACTER(LEN=20),SAVE :: dump_weather_file
+  LOGICAL,SAVE           :: gathered
+  INTEGER,SAVE           :: dump_id
+
+!
+  REAL,PARAMETER         :: zero_t=273.15   !! Absolute zero
+! 
+  REAL,PARAMETER :: pir = pi/180.
+  REAL,PARAMETER :: rair = 287.
+!-
+  INTEGER,PARAMETER :: nmon = 12  !! Number of months
+
+!
+  CHARACTER(LEN=3),DIMENSION(12) :: cal = &             !! Months of the year (unitless)
+ &  (/ 'JAN','FEB','MAR','APR','MAY','JUN', &
+ &     'JUL','AUG','SEP','OCT','NOV','DEC' /)
+  INTEGER,DIMENSION(12),SAVE :: ndaypm = &              !! Number of days per month (noleap year) (unitless)
+ &  (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
+  INTEGER,SAVE :: soldownid, rainfid, snowfid, lwradid, &
+ &                tairid, qairid,  psolid, uid, vid, &
+ &                time_id, timestp_id
+!-
+  INTEGER,SAVE :: n_rtp = nf90_real4      !! Parameters for NETCDF 
+!- 
+  INTEGER  :: ALLOC_ERR                   !! Flag for dynamic allocations 
+!-
+  CHARACTER(LEN=20),SAVE :: calendar_str   !! Calendar type
+!-
+  INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: kindex_w  !! Land points index
+  INTEGER, SAVE                            :: nbindex_w  !! Land points index
+!-
+  INTEGER, PARAMETER :: termcol = 100     !! Plot of projection file => grid, number of column on terminal
+!80
+  CONTAINS
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : daily
+!!
+!>\BRIEF          This routine generates daily weather conditions from monthly-mean
+!! climatic parameters.
+!!
+!! DESCRIPTION  :  Specifically, this routine generates daily values of 
+!!                 - daily total precipitation \n
+!!                 - daily maximum temperature \n
+!!                 - daily minimum temperature \n
+!!                 - daily average cloud cover \n
+!!                 - daily average relative humidity \n
+!!                 - daily average wind speed \n
+!!                 In order to generate daily weather conditions, the model uses
+!!                 a series of 'weather generator' approaches,
+!!                 which generate random combinations of weather conditions
+!!                 based upon the climatological conditions in general. \n
+!!                 This weather generator is based upon the so-called Richardson
+!!                 weather generator. \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::psurf, ::cloud, ::tmax, ::tmin, ::qd, ::ud, ::precip 
+!!
+!! REFERENCE(S) :
+!! -  Geng, S., F.W.T. Penning de Vries, and L. Supit, 1985:  A simple
+!! method for generating rainfall data, Agricultural and Forest
+!! Meteorology, 36, 363-376.
+!! -  Richardson, C. W. and Wright, D. A., 1984: WGEN: A model for
+!! generating daily weather variables: U. S. Department of
+!! Agriculture, Agricultural Research Service. 
+!! - Richardson, C., 1981: Stochastic simulation of daily
+!! precipitation, temperature, and solar radiation. Water Resources
+!! Research 17, 182-190. 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE daily &
+ &  (npoi, imonth, iday, cloud, tmax, tmin, precip, qd, ud, psurf)
+
+!-
+! in & out: global variables
+!-
+
+! INTEGER,INTENT(INOUT):: iwet(npoi) !! wet day / dry day flag!*
+!-
+
+  !! 0. Parameters and variables declaration
+
+  REAL,PARAMETER :: rair = 287.     !! Molecular weight of one mole of dry air @tex $(g.mol{-1})$ @endtex
+  REAL,PARAMETER :: grav = 9.81     !! Acceleration of the gravity @tex $(m.s^{-2})$ @endtex
+  REAL,PARAMETER :: pi = 3.1415927  !! pi
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN) :: npoi         !! total number of land points
+  INTEGER,INTENT(IN) :: imonth, iday
+
+  !! 0.2 Output variables
+
+  REAL,INTENT(OUT) :: psurf(npoi)   !! surface pressure (Pa)
+  REAL,INTENT(OUT) :: cloud(npoi)   !! cloud fraction (0-1, unitless)
+  REAL,INTENT(OUT) :: tmax(npoi)    !! maximum daily temperature (K)
+  REAL,INTENT(OUT) :: tmin(npoi)    !! minimum daily temperature (K)
+  REAL,INTENT(OUT) :: qd(npoi)      !! daily average specific humidity (kg_h2o/kg_air)
+  REAL,INTENT(OUT) :: ud(npoi)      !! daily average wind speed  @tex $(m.s^{-1})$ @endtex
+  REAL,INTENT(OUT) :: precip(npoi)  !! daily precitation @tex $(mm.day^{-1})$ @endtex
+
+  !! 0.4 Local variables
+
+  REAL :: td(npoi)                                 !! daily average temperature (K)
+  REAL,allocatable,save,dimension(:,:) ::  xstore  !! weather generator 'memory' matrix
+  REAL :: ee(3), r(3), rr(npoi,3)
+  REAL :: alpha(npoi), rndnum, pwd, pww
+  REAL :: beta(npoi)
+  REAL :: pwet(npoi)
+  REAL :: rwork
+  REAL :: omcloud, omqd, omtmax
+  REAL :: cloudm, cloudw, cloudd
+  REAL :: cloude(npoi), clouds(npoi)
+  REAL :: tmaxd, tmaxw, tmaxm
+  REAL :: tminm
+  REAL :: tmins(npoi), tmaxs(npoi)
+  REAL :: tmine(npoi), tmaxe(npoi)
+  REAL :: qdm(npoi),qdd(npoi),qde(npoi),qdw(npoi),qdup(npoi),qdlow(npoi)
+  INTEGER :: i,j,k
+  REAL :: amn,b1,b2,b3,eud,rn,rn1,rn2,rn3,rn4,s1,s2,s12,x1,y, z(npoi)
+  REAL :: aa(npoi),ab(npoi),tr1(npoi), tr2(npoi)
+  REAL :: tdm,trngm,tdum
+  REAL :: qsattd(npoi)
+  INTEGER :: it1w, it2w
+  REAL :: dt
+  REAL :: rainpwd(npoi)
+  INTEGER :: not_ok(npoi)
+  INTEGER :: count_not_ok,count_not_ok_g
+  LOGICAL,SAVE :: firstcall = .TRUE.
+  INTEGER,save :: npoi0
+  REAL :: xx
+  REAL, DIMENSION(3,3) :: a,b              !! define autocorrelation matrices for Richardson generator
+                                           !!
+                                           !! note that this matrix should be based upon a statistical
+                                           !! analysis of regional weather patterns
+                                           !!
+                                           !! for global simulations, we use 'nominal' values
+
+  LOGICAL :: Warning_aa_ab(npoi), Warning_iwet(npoi) !! Warnings
+!---------------------------------------------------------------------
+!-
+! initial setup for daily climate calculations
+!-
+  a(1,:) = (/ 0.600,  0.500,  0.005 /)
+  a(2,:) = (/ 0.010,  0.250,  0.005 /)
+  a(3,:) = (/ 0.020,  0.125,  0.250 /)
+!-
+  b(1,:) = (/ 0.500,  0.250, -0.250 /)
+  b(2,:) = (/ 0.000,  0.500,  0.250 /)
+  b(3,:) = (/ 0.000,  0.000,  0.500 /)
+!-
+! GK240100
+  IF (firstcall) THEN
+    firstcall = .FALSE.
+    ALLOC_ERR=-1
+    ALLOCATE(xstore(npoi,3), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of xstore : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    xstore(:,:) = zero
+    npoi0 = npoi
+  ELSE IF (npoi /= npoi0) THEN
+    WRITE(numout,*) 'Domain size old, new: ',npoi0,npoi
+    STOP 'WG Daily: Problem: Domain has changed since last call'
+  ENDIF
+!-
+! define working variables
+!-
+  rwork = (cte_grav/rair/0.0065)
+!-
+! 'omega' parameters used to calculate differences in expected
+! climatic parameters on wet and dry days
+!
+! following logic of weather generator used in the EPIC crop model
+!
+! omcloud -- cloud cover
+! omqd    -- humidity
+! omtmax  -- maximum temperature
+!-
+  omcloud = 0.90    ! originally 0.90
+  omqd    = 0.50    ! originally 0.50
+  omtmax  = 0.75    ! originally 0.75
+!-
+! calculate weighting factors used in interpolating climatological
+! monthly-mean input values to daily-mean values
+!-
+! this is a simple linear interpolation technique that takes into
+! account the length of each month
+!-
+  IF (ipprec == 0) THEN
+    IF (REAL(iday) < REAL(ndaypm(imonth)+1)/2.0) then
+      it1w = imonth-1
+      it2w = imonth
+      dt   = (REAL(iday)-0.5)/ndaypm(imonth)+0.5
+    ELSE
+      it1w = imonth
+      it2w = imonth+1
+      dt   = (REAL(iday)-0.5)/ndaypm(imonth)-0.5
+    ENDIF
+    if (it1w <  1)  it1w = 12
+    if (it2w > 12)  it2w = 1
+  ELSE
+     dt = -1.
+     it1w = -1
+     it2w = -1
+  ENDIF
+!-
+  IF (ipprec == 0) THEN
+!---
+!-- use weather generator to create daily statistics
+!---
+! (1) determine if today will rain or not
+!---
+!-- calculate monthly-average probability of rainy day
+!---
+    DO i=1,npoi
+      pwet(i) = xinwet(i,imonth)/ndaypm(imonth)
+    ENDDO
+!---
+    IF (.NOT.precip_exact) THEN
+!-----
+!---- (1.1) following Geng et al.
+!-----
+      IF (is_root_prc) THEN
+         CALL random_number (rndnum)
+      ENDIF
+      CALL bcast(rndnum)
+!-----
+      DO i=1,npoi
+        IF (xinprec(i,imonth) > 1.e-6) THEN
+!---------
+!-------- implement simple first-order Markov-chain precipitation
+!-------- generator logic based on Geng et al. (1986),
+!-------- Richardson and Wright (1984), and Richardson (1981)
+!---------
+!-------- basically, this allows for the probability of today being
+!-------- a wet day (a day with measureable precipitation)
+!-------- to be a function of what yesterday was (wet or dry)
+!---------
+!-------- the logic here is that it is more likely that a wet day
+!-------- will follow another wet day -- allowing
+!-------- for 'storm events' to persist
+!---------
+!-------- estimate the probability of a wet day after a dry day
+!---------
+          pwd = 0.75*pwet(i)
+!---------
+!-------- estimate the probability of a wet day after a wet day
+!---------
+          pww = 0.25+pwd
+!---------
+!-------- decide if today is a wet day or a dry day
+!-------- using a random number
+!---------
+!-------- call random_number(rndnum) ! done before
+!---------
+          IF (iwet(i) == 0) then
+            IF (rndnum <= pwd) iwet(i) = 1
+          ELSE
+            IF (rndnum > pww) iwet(i) = 0
+          ENDIF
+        ELSE
+          iwet(i) = 0
+        ENDIF
+      ENDDO
+    ELSE
+!-----
+!---- (1.2) preserving the monthly number of precip days
+!----       and monthly precip
+!-----
+      DO i=1,npoi
+        IF (ABS(xinwet(i,imonth)) < 32.) THEN
+          IF (xinprec(i,imonth) > 1.e-6) THEN
+            IF (   jour_precip(iday,imonth) &
+ &              <= NINT(MAX(1.,xinwet(i,imonth))) ) THEN
+              iwet(i) = 1
+            ELSE
+              iwet(i) = 0
+            ENDIF
+          ELSE
+           iwet(i) = 0
+          ENDIF
+        ENDIF
+      ENDDO
+    ENDIF
+!---
+!-- (2) determine today's precipitation amount
+!---
+    IF (.not.precip_exact) THEN
+       Warning_aa_ab(:)=.FALSE.
+       Warning_iwet(:)=.FALSE.
+!-----
+!---- (2.1) following Geng et al.
+!-----
+      aa(:) = zero
+      ab(:) = zero
+      tr2(:)= zero
+      tr1(:)= zero
+      beta(:) = un
+      DO i=1,npoi
+!-------
+!------ initialize daily precipitation to zero
+!-------
+        precip(i) = zero
+!-------
+        IF (xinprec(i,imonth) > 1.e-6) THEN
+!---------
+!-------- if it is going to rain today
+!---------
+          IF (iwet(i) == 1) THEN
+!-----------
+!---------- calculate average rainfall per wet day
+!-----------
+            rainpwd(i) = xinprec(i,imonth) &
+ &                      *ndaypm(imonth)/MAX(0.1,xinwet(i,imonth))
+!-----------
+!---------- randomly select a daily rainfall amount
+!---------- from a probability density function of rainfall
+!----------
+!---------- method i --
+!-----------
+!---------- use the following technique from Geng et al. and Richardson
+!---------- to distribute rainfall probabilities
+!-----------
+!---------- pick a random rainfall amount
+!---------- from a two-parameter gamma function distribution function
+!-----------
+!---------- estimate two parameters for gamma function
+!---------- (following Geng et al.)
+!-----------
+            beta(i) = MAX(1.0,-2.16+1.83*rainpwd(i))
+            alpha(i) = rainpwd(i)/beta(i)
+!-----------
+!---------- determine daily precipitation amount
+!---------- from gamma distribution function
+!---------- (following WGEN code of Richardson and Wright (1984))
+!-----------
+            IF (ABS(1.-alpha(i)) < 1.e-6) THEN
+              alpha(i) = 1.e-6*(alpha(i)/ABS(alpha(i)))
+            ENDIF
+            aa(i) = 1.0/alpha(i)
+            ab(i) = 1.0/(1.0-alpha(i))
+!-----------
+            IF ( (ABS(aa(i)) < 1.e-6) .OR. (ABS(ab(i)) < 1.e-6) ) THEN
+               Warning_aa_ab(:)=.TRUE.
+            ENDIF
+            tr1(i) = exp(-18.42/aa(i))
+            tr2(i) = exp(-18.42/ab(i))
+          ENDIF
+        ELSE
+          IF (iwet(i) == 1) THEN
+            Warning_iwet(i)=.TRUE.
+          ENDIF
+        ENDIF
+      ENDDO
+
+      DO i=1,npoi
+         IF ( Warning_aa_ab(i) ) THEN
+            WRITE(numout,*) ' ATTENTION, aa ou ab:'
+            WRITE(numout,*) ' aa, ab = ',aa(i),ab(i)
+            WRITE(numout,*) '   alpha, rainpwd, beta =', &
+ &                       alpha(i),rainpwd(i),beta(i)
+         ENDIF
+         IF ( Warning_iwet(i) ) THEN
+            WRITE(numout,*) ' ATTENTION, iwet = 1 alors que xinprec = 0)'
+            WRITE(numout,*) '   xinprec, iwet = ',xinprec(i,imonth),iwet(i)
+          ENDIF
+      ENDDO
+!-----
+      where ( iwet(:) == 1 )
+        not_ok(:) = 1
+      elsewhere
+        not_ok(:) = 0
+      endwhere
+!-----
+      count_not_ok_g=0
+      count_not_ok=SUM(not_ok(:))
+      CALL reduce_sum(count_not_ok,count_not_ok_g)
+      CALL bcast(count_not_ok_g)
+!-
+      z(:) = zero
+      DO WHILE (count_not_ok_g > 0)
+        IF (is_root_prc) THEN
+        CALL random_number (rn1)
+        CALL random_number (rn2)
+        ENDIF
+        CALL bcast(rn1)
+        CALL bcast(rn2)
+
+        DO i=1,npoi
+          IF ((iwet(i) == 1).AND.(not_ok(i) == 1)) then
+            IF ( (rn1-tr1(i)) <= zero ) THEN
+              s1 = zero
+            ELSE
+              s1 = rn1**aa(i)
+            ENDIF
+!-----------
+            IF ((rn2-tr2(i)) <= zero) THEN
+              s2 = zero
+            ELSE
+              s2 = rn2**ab(i)
+            ENDIF
+!-----------
+            s12 = s1+s2
+            IF ((s12-1.0) <= zero) THEN
+              z(i) = s1/s12
+              not_ok(i) = 0
+            ENDIF
+          ENDIF
+        ENDDO
+
+        count_not_ok_g=0
+        count_not_ok=SUM(not_ok(:))
+        CALL reduce_sum(count_not_ok,count_not_ok_g)
+        CALL bcast(count_not_ok_g)
+      ENDDO
+!-----
+      IF (is_root_prc) THEN
+         CALL random_number (rn3)
+      ENDIF
+      CALL bcast(rn3)
+!      WRITE(*,*) mpi_rank,"rn3=",rn3
+!-----
+      DO i=1,npoi
+        IF (iwet(i) == 1) then
+          precip(i) = -z(i)*log(rn3)*beta(i)
+        ENDIF
+      ENDDO
+!-----
+!---- method ii --
+!-----
+!---- here we use a one-parameter Weibull distribution function
+!---- following the analysis of Selker and Haith (1990)
+!-----
+!---- Selker, J.S. and D.A. Haith, 1990: Development and testing
+!---- of single- parameter precipitation distributions,
+!---- Water Resources Research, 11, 2733-2740.
+!-----
+!---- this technique seems to have a significant advantage over other
+!---- means of generating rainfall distribution functions
+!-----
+!---- by calibrating the Weibull function to U.S. precipitation records,
+!---- Selker and Haith were able to establish the following relationship
+!-----
+!---- the cumulative probability of rainfall intensity x is given as:
+!-----
+!---- f(x) = 1.0-exp(-(1.191 x / rainpwd)**0.75)
+!-----
+!---- where x       : rainfall intensity
+!----       rainpwd : rainfall per wet day
+!-----
+!---- using transformation method, take uniform deviate and convert
+!---- it to a random number weighted by the following Weibull function
+!-----
+!----    call random_number(rndnum)
+!-----
+!----    precip(i) = rainpwd / 1.191*(-log(1.0-rndnum))**1.333333
+!-----
+!---- bound daily precipitation to "REAListic" range
+!-----
+      DO i=1,npoi
+        IF (iwet(i) == 1) THEN
+!---------
+!-------- lower end is determined by definition of a 'wet day'
+!-------- (at least 0.25 mm of total precipitation)
+!---------
+!-------- upper end is to prevent ibis from blowing up
+!---------
+          precip(i) = MAX(precip(i),  0.25) ! min =   0.25 mm/day
+          precip(i) = MIN(precip(i),150.00) ! max = 150.00 mm/day
+        ENDIF
+      ENDDO
+    ELSE
+!-----
+!---- (2.2) preserving the monthly number of precip days
+!----       and monthly precip
+!-----
+      DO i=1,npoi
+!-------
+!------ Correction Nathalie. C'est abs(xinwet) < 32 qu'il faut tester
+!------ et non pas abs(xinprec(i,imonth)) < 32.
+!-------
+!------ IF ( (iwet(i) == 1).and.(abs(xinprec(i,imonth)) < 32.) ) THEN
+        IF ( (iwet(i) == 1).and.(abs(xinwet(i,imonth)) < 32.) ) THEN
+          precip(i) = xinprec(i,imonth)*REAL(ndaypm(imonth)) &
+ &                   /REAL(NINT(MAX(1.,xinwet(i,imonth))))
+        ELSE
+          precip(i) = zero
+        ENDIF
+      ENDDO
+    ENDIF
+!---
+!-- (3) estimate expected minimum and maximum temperatures
+!---
+    DO i=1,npoi
+!-----
+!---- first determine the expected maximum and minimum temperatures
+!---- (from climatological means) for this day of the year
+!-----
+!---- mean daily mean temperature (K)
+      tdm = xint(i,it1w)+dt*(xint(i,it2w)-xint(i,it1w))+zero_t
+!---- mean daily temperature range (K)
+      trngm = xintrng(i,it1w)+dt*(xintrng(i,it2w)-xintrng(i,it1w))
+!---- mean minimum and maximum temperatures
+      tmaxm = tdm+0.56*trngm
+      tminm = tdm-0.44*trngm
+!-----
+!---- modify maximum temperatures for wet and dry days
+!-----
+      IF (pwet(i) /= zero) THEN
+        tmaxd = tmaxm+pwet(i)*omtmax*trngm
+        tmaxw = tmaxd-        omtmax*trngm
+      ELSE
+        tmaxd = tmaxm
+        tmaxw = tmaxm
+      ENDIF
+!-----
+!---- set the 'expected' maximum and minimum temperatures for today
+!-----
+!---- note that the expected minimum temperatures are the same for
+!---- both wet and dry days
+!-----
+      if (iwet(i) == 0)  tmaxe(i) = tmaxd
+      if (iwet(i) == 1)  tmaxe(i) = tmaxw
+!-----
+      tmine(i) = tminm
+!-----
+!---- estimate variability in minimum and maximum temperatures
+!-----
+!---- tmaxs : standard deviation in maximum temperature (K)
+!---- tmins : standard deviation in minimum temperature (K)
+!-----
+!---- Regression is based on analysis of 2-m air temperature data
+!---- from the NCEP/NCAR reanalysis (1958-1997) for 294 land points
+!---- over central North America
+!---- (24N-52N, 130W-60W, 0.5-degree resolution):
+!---- Daily max and min temperatures were calculated for each
+!---- land point from daily mean temperature and temperature range.
+!---- Anomalies were calculated
+!---- by subtracting similar max and min temperatures calculated from
+!---- monthly mean temperature and range (interpolated to daily).
+!---- The 40 years of anomalies were then binned by month
+!---- and the standard deviation calculated for each month.
+!---- The 294 x 12 standard deviations were then regressed
+!---- against the 3528 long-term monthly mean temperatures.
+!-----
+!---- note: the values are bound to be greater than 1.0 K
+!----       (at the very least they must be bound
+!----        so they don't go below zero)
+!-----
+      tmaxs(i) = MAX(1.0,-0.0713*(tdm-zero_t)+4.89)
+      tmins(i) = MAX(1.0,-0.1280*(tdm-zero_t)+5.73)
+    ENDDO
+!---
+!-- (4) estimate expected cloud cover
+!---
+!---
+!-- the formulation of dry and wet cloud cover has been
+!-- derived from the weather generator used in the epic crop model
+!---
+    DO i=1,npoi
+!-----
+!---- cloudm : mean cloud cover for today
+!---- cloudd : dry day cloud cover
+!---- cloudw : dry day cloud cover
+!---- cloude : expected cloud cover today
+!-----
+!---- mean cloud cover (%)
+!-----
+      cloudm = xincld(i,it1w)+dt*(xincld(i,it2w)-xincld(i,it1w))
+!-----
+!---- convert from percent to fraction
+!-----
+      cloudm = cloudm/100.0
+!-----
+!---- adjust cloud cover depending on dry day / rainy day
+!---- following logic of the EPIC weather generator code
+!-----
+      IF (pwet(i) /= zero) THEN
+        cloudd = (cloudm-pwet(i)*omcloud)/(un-pwet(i)*omcloud)
+        cloudd = MIN(un,MAX(zero,cloudd))
+        cloudw = (cloudm-(un-pwet(i))*cloudd)/pwet(i)
+      ELSE
+        cloudd = cloudm
+        cloudw = cloudm
+      ENDIF
+      IF (iwet(i) == 0)  cloude(i) = cloudd
+      IF (iwet(i) == 1)  cloude(i) = cloudw
+!-----
+!---- estimate variability in cloud cover for wet and dry days
+!---- following numbers proposed by Richardson
+!-----
+!---- clouds : standard deviation of cloud fraction
+!-----
+      IF (iwet(i) == 0)  clouds(i) = 0.24*cloude(i)
+      IF (iwet(i) == 1)  clouds(i) = 0.48*cloude(i)
+    ENDDO
+!---
+! (5) determine today's temperatures and cloud cover using
+!     first-order serial autoregressive technique
+!---
+!-- use the Richardson (1981) weather generator approach to simulate the
+!-- daily values of minimum / maximum temperature and cloud cover
+!---
+!-- following the implementation of the Richardson WGEN weather
+!-- generator used in the EPIC crop model
+!---
+!-- this approach uses a multivariate generator, which assumes that the
+!-- perturbation of minimum / maximum temperature and cloud cover are
+!-- normally distributed and that the serial correlation of each
+!-- variable may be described by a first-order autoregressive model
+!---
+!-- generate standard deviates for weather generator
+!---
+    DO j=1,3
+      ee(j) = 9999.
+      DO WHILE (ee(j) > 2.5)
+        IF (is_root_prc) THEN
+           CALL random_number (rn1)
+           CALL random_number (rn2)
+        ENDIF
+        CALL bcast(rn1)
+        CALL bcast(rn2)
+        ee(j) = SQRT(-2.0*LOG(rn1))*COS(6.283185*rn2)
+      ENDDO
+    ENDDO
+!---
+!-- zero out vectors
+!---
+    r(1:3)  = zero
+    rr(1:npoi,1:3) = zero
+!---
+!-- update working vectors
+!---
+    do j=1,3
+      do k=1,3
+        r(j) = r(j)+b(j,k)*ee(j)
+      enddo
+    enddo
+!---
+    do j=1,3
+      do k=1,3
+        do i=1,npoi
+          rr(i,j) = rr(i,j)+a(j,k)*xstore(i,k)
+        enddo
+      enddo
+    enddo
+!---
+!-- solve for x() perturbation vector and save current vector
+!-- into the xim1() storage vector (saved for each point)
+!---
+    do j=1,3
+      do i=1,npoi
+        xstore(i,j) = r(j)+rr(i,j)
+      enddo
+    enddo
+!---
+!-- determine today's minimum and maximum temperature
+!--
+    do i=1,npoi
+      tmax(i) = tmaxe(i)+tmaxs(i)*xstore(i,1)
+      tmin(i) = tmine(i)+tmins(i)*xstore(i,2)
+!-----
+!---- if tmin > tmax, then switch the two around
+!-----
+      if (tmin(i) > tmax(i)) then
+        tdum    = tmax(i)
+        tmax(i) = tmin(i)
+        tmin(i) = tdum
+      ENDIF
+!---- daily average temperature
+      td(i) = 0.44*tmax(i)+0.56*tmin(i)
+!---- determine today's cloud cover
+      cloud(i) = cloude(i)+clouds(i)*xstore(i,3)
+!---- constrain cloud cover to be between 0 and 100%
+      cloud(i) = MAX(zero,MIN(un,cloud(i)))
+    enddo
+!---
+!-- (6) estimate today's surface atmospheric pressure
+!---
+    do i=1,npoi
+!-----
+!---- simply a function of the daily average temperature
+!---- and topographic height -- nothing fancy here
+!-----
+      psurf(i) = 101325.0*(td(i)/(td(i)+0.0065*xintopo(i)))**rwork
+    enddo
+!---
+!-- (7) estimate today's relative humidity
+!---
+    IF (is_root_prc) THEN
+       CALL random_number (rn)
+    ENDIF
+    CALL bcast(rn)
+!---
+    CALL weathgen_qsat (npoi,td,psurf,qsattd)
+!---
+    do i=1,npoi
+!-----
+!---- the formulation of dry and wet relative humidities has been
+!---- derived from the weather generator used in the epic crop model
+!-----
+!---- qdm : mean relative humidity
+!---- qdd : dry day relative humidity
+!---- qdw : rainy day relative humidity
+!---- qde : expected relative humidity (based on wet/dry decision)
+!-----
+!---- mean relative humidity (%)
+      qdm(i) = xinq(i,it1w)+dt*(xinq(i,it2w)-xinq(i,it1w))
+!---- convert from percent to fraction
+      qdm(i) = qdm(i)/100.0
+!-----
+!---- adjust humidity depending on dry day / rainy day
+!---- following logic of the EPIC weather generator code
+!-----
+      if (pwet(i) /= zero) then
+        qdd(i) = (qdm(i)-pwet(i)*omqd)/(un-pwet(i)*omqd)
+        if (qdd(i) < 0.2) then
+          qdd(i) = 0.2
+          if (qdd(i) > qdm(i)) qdm(i) = qdd(i)
+        ENDIF
+        qdd(i) = MIN(un,qdd(i))
+        qdw(i) = (qdm(i)-(un-pwet(i))*qdd(i))/pwet(i)
+      ELSE
+        qdd(i) = qdm(i)
+        qdw(i) = qdm(i)
+      ENDIF
+!-----
+      if (iwet(i) == 0)  qde(i) = qdd(i)
+      if (iwet(i) == 1)  qde(i) = qdw(i)
+!-----
+!---- estimate lower and upper bounds of humidity distribution function
+!---- following logic of the EPIC weather generator code
+!-----
+      xx = exp(qde(i))
+      qdup(i)  = qde(i)+(un-qde(i))*xx/euler
+      qdlow(i) = qde(i)*(un-1./xx)
+!-----
+!---- randomlly select humidity from triangular distribution function
+!---- following logic of the EPIC weather generator code
+!-----
+!---- call random_number(rn) ! GK done before
+!-----
+      y  = 2.0/(qdup(i)-qdlow(i))
+!-----
+      b3 = qde(i)-qdlow(i)
+      b2 = qdup(i)-qde(i)
+      b1 = rn/y
+!-----
+      x1 = y*b3/2.0
+!-----
+      if (rn > x1) then
+        qd(i) = qdup(i)-sqrt (b2*b2-2.0*b2*(b1-0.5*b3))
+      ELSE
+        qd(i) = qdlow(i)+sqrt (2.0*b1*b3)
+      ENDIF
+!-----
+!---- adjust daily humidity to conserve monthly mean values
+!-----
+!---- note that this adjustment sometimes gives rise to humidity
+!---- values greater than 1.0 -- which is corrected below
+!-----
+      amn = (qdup(i)+qde(i)+qdlow(i))/3.0
+      qd(i) = qd(i)*qde(i)/amn
+!-----
+!---- constrain daily average relative humidity
+!-----
+      qd(i) = MAX(0.30,MIN(qd(i),0.99))
+!-----
+!---- convert from relative humidity to specific humidity at
+!---- daily mean temperature
+!-----
+      qd(i) = qd(i)*qsattd(i)
+    enddo
+!---
+!-- (8) estimate today's daily average wind speed
+!---
+    IF (is_root_prc) THEN
+        CALL random_number (rn4)
+    ENDIF
+    CALL bcast(rn4)
+
+    DO i=1,npoi
+!-----
+!---- first estimate the expected daily average wind speed (from monthly
+!---- means)
+!-----
+      eud = xinwind(i,it1w)+dt*(xinwind(i,it2w)-xinwind(i,it1w))
+!-----
+!---- following logic of the EPIC weather generator
+!---- select random wind speed following this equation
+!-----
+!---- call random_number(rn4)
+!-----
+      ud(i) = 1.13989*eud*(-log(rn4))**0.30
+!---- constrain daily wind speeds to be between 2.5 and 10.0 m/sec
+      ud(i) = MAX(2.5,MIN(ud(i),10.0))
+    ENDDO
+  ELSE
+!---
+!-- use REAL daily climate data
+!---
+    DO i=1,npoi
+!-----
+!---- use basic daily climate data, converting units
+!-----
+!---- daily total precipitation
+      precip(i) = xinprec(i,imonth)
+!---- daily average temperatures
+      td(i) = xint(i,imonth)+zero_t
+      trngm = MIN(44.0,xintrng(i,imonth))
+!-----
+      tmax(i) = td(i)+0.56*trngm
+      tmin(i) = td(i)-0.44*trngm
+!---- daily average cloud cover
+      cloud(i) = xincld(i,imonth)*0.01
+!---- daily average specific humidity
+      qd(i) = xinq(i,imonth)
+!---- daily average wind speed
+      ud(i) = xinwind(i,imonth)
+!-----
+!---- compute surface atmospheric pressure
+!-----
+      psurf(i) = 101325.0*(td(i)/(td(i)+0.0065*xintopo(i)))**rwork
+    ENDDO
+  ENDIF
+!-------------------
+END SUBROUTINE daily
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : diurnal
+!!
+!>\BRIEF          This routine interpolates values from the!* 
+!! subroutine daily into instantaneous values for simulating a diurnal cycle.
+!!
+!! DESCRIPTION  :  
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):  ::fira, ::solad, ::ua, ::ta, ::qa, ::raina, ::snowa, ::rh.
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE diurnal &
+& (npoi, nband, time, jday, plens, startp, endp, latitude, &
+&  cloud, tmax, tmin, precip, qd, ud, psurf, &
+&  fira, solad, solai, ua, ta, qa, raina, snowa, rh)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Parameter and variables declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN) :: npoi    !! number of grid points (unitless)
+  INTEGER,INTENT(IN) :: nband   !! number of visible bands (unitless)
+  REAL,INTENT(IN) :: time
+  INTEGER, INTENT(IN) :: jday
+  REAL,INTENT(IN) :: plens,startp,endp
+  REAL,INTENT(IN) :: latitude(npoi)   !! latitude in degrees
+  REAL,INTENT(IN) :: cloud(npoi)      !! cloud fraction (0-1, unitless)
+  REAL,INTENT(IN) :: tmax(npoi)       !! maximum daily temperature (K)
+  REAL,INTENT(IN) :: tmin(npoi)       !! maximum daily temperature (K)
+  REAL,INTENT(IN) :: precip(npoi)     !! daily precitation @tex $(mm.day^{-1})$ @endtex 
+  REAL,INTENT(IN) :: qd(npoi)         !! daily average specific humidity (kg_h2o/kg_air)
+  REAL,INTENT(IN) :: ud(npoi)         !! daily average wind speed @tex $(m.s^{-1})$ @endtex 
+  REAL,INTENT(IN) :: psurf(npoi)      !! surface pressure (Pa)
+
+  !! 0.2 Output variables
+
+  REAL,INTENT(OUT) :: fira(npoi)          !! incoming ir flux  @tex $(W.m^{-2})$ @endtex
+  REAL,INTENT(OUT) :: solad(npoi,nband)   !! direct downward solar flux @tex $(W.m^{-2})$ @endtex
+  REAL,INTENT(OUT) :: solai(npoi,nband)   !! diffuse downward solar flux @tex $(W.m^{-2})$ @endtex
+  REAL,INTENT(OUT) :: ua(npoi)            !! wind speed @tex $(m.s^{-1})$ @endtex 
+  REAL,INTENT(OUT) :: ta(npoi)            !! air temperature (K)
+  REAL,INTENT(OUT) :: qa(npoi)            !! specific humidity (kg_h2o/kg_air)
+  REAL,INTENT(OUT) :: raina(npoi)         !! rainfall rate @tex $(mm.day^{-1})$ @endtex 
+  REAL,INTENT(OUT) :: snowa(npoi)         !! snowfall rate @tex $(mm.day^{-1})$ @endtex 
+  REAL,INTENT(OUT) :: rh(npoi)            !! relative humidity (0-1, unitless)
+
+  !! 0.4 Local variables
+
+  REAL,SAVE      :: step
+  REAL :: xl,so,xllp,xee,xse
+  REAL :: xlam,dlamm,anm,ranm,ranv,anv,tls,rlam
+  REAL :: sd,cd,deltar,delta,Dis_ST,ddt
+!-
+  REAL :: coszen(npoi)                      !! cosine of solar zenith angle
+  REAL :: rtime
+  REAL :: sw,frac,gamma,qmin,qmax,qsa,emb,ea,ec,dtair,dtcloud,rn
+  REAL :: trans(npoi), fdiffuse(npoi), qsatta(npoi), qsattmin(npoi)
+  INTEGER :: i,ib
+  INTEGER,SAVE :: npoi0
+  LOGICAL,SAVE :: firstcall = .TRUE.
+
+!---------------------------------------------------------------------
+! GK240100
+  IF (firstcall) THEN
+    firstcall = .FALSE.
+    npoi0 = npoi
+  ELSE IF (npoi /= npoi0) THEN
+    WRITE(numout,*) 'Domain size old, new: ',npoi0,npoi
+    STOP 'WG Diurnal: Problem: Domain has changed since last call'
+  ENDIF
+
+! calculate time in hours
+  rtime = time/3600.0
+
+  CALL downward_solar_flux(npoi,latitude,calendar_str,REAL(jday),rtime,cloud,nband,solad,solai)
+!-
+! temperature calculations
+!-
+!---
+!-- assign hourly temperatures using tmax and tmin
+!-- following Environmental Biophysics, by Campbell and Norman, p.23
+!---
+!-- this function fits a fourier series to the diurnal temperature cycle
+!-- note that the maximum temperature occurs at 2:00 pm local solar time
+!---
+!-- note that the daily mean value of gamma is 0.44,
+!-- so td = 0.44*tmax+0.56*tmin,  instead of
+!--    td = 0.50*tmax+0.50*tmin
+!---
+  gamma = 0.44-0.46*SIN(    pi/12.0*rtime+0.9) &
+              +0.11*SIN(2.0*pi/12.0*rtime+0.9)
+  DO i=1,npoi
+    ta(i) = tmax(i)*gamma+tmin(i)*(1.0-gamma)
+  ENDDO
+!-
+! humidity calculations
+!-
+  CALL weathgen_qsat (npoi,tmin,psurf,qsattmin)
+  CALL weathgen_qsat (npoi,ta,psurf,qsatta)
+!-
+  DO i=1,npoi
+!---
+!-- adjust specific humidity against daily minimum temperatures
+!---
+!-- To do this, qa is written as an approximate sine function
+!-- (same as ta) to preserve the daily mean specific humidity,
+!-- while also preventing rh from exceeding 99% at night
+!---
+!-- Note that the daily mean RH is *not* preserved, and therefore the
+!-- output RH will be slightly different from what was read in.
+!---
+!-- first adjust so that maximum RH cannot exceed 99% at night
+!---
+    qmin = MIN(qd(i),0.99*qsattmin(i))
+    qmax = (qd(i)-0.56*qmin)/0.44
+!---
+!-- if needed, adjust again to 99% at other times of the day (in which
+!-- case the daily mean *specific* humidity is also not preserved)
+!---
+    qsa  = 0.99*qsatta(i)
+!---
+!-- calculate the hourly specific humidity, using the above adjustments
+!---
+    qa(i) = MIN(qsa,qmax*gamma+qmin*(1.0-gamma))
+!---
+!-- calculate the hourly relative humidity
+!--
+    rh(i) = 100.*qa(i)/qsatta(i)
+  ENDDO
+!-
+! wind speed calculations
+!-
+  IF (is_root_prc) THEN
+     CALL random_number (rn)
+  ENDIF
+  CALL bcast(rn)
+!-
+  DO i=1,npoi
+!---
+!-- following logic of the EPIC weather generator
+!-- select random wind speed following this equation
+!---
+!-- call random_number(rn) ! done before
+!---
+    ua(i) = 1.13989*ud(i)*(-log(rn))**0.30
+!---
+!-- fix wind speeds to always be above 2.5 m/sec and below 10.0 m/sec
+!---
+    ua(i) = MAX(2.5,MIN(10.0,ua(i)))
+  ENDDO
+!-
+! ir flux calculations
+!-
+  DO i=1,npoi
+!---
+!-- clear-sky emissivity as a function of water vapor pressure
+!-- and atmospheric temperature
+!---
+!-- calculate the ir emissivity of the clear sky
+!-- using equation from idso (1981) water resources res., 17, 295-304
+!---
+    emb = 0.01*(psurf(i)*qa(i)/(0.622+qa(i)))
+    ea  = 0.70+5.95e-5*emb*EXP(1500.0/ta(i))
+!---
+!-- assign the ir emissivity of clouds
+!-- (assume they are ~black in the ir)
+!---
+    ec = 0.950
+!---
+!-- assign the temperature difference of emissions (air+cloud) from
+!-- the surface air temperature
+!---
+    dtair   = zero
+    dtcloud = zero
+!---
+!-- total downward ir is equal to the sum of:
+!---
+!-- (1) clear sky contribution to downward ir radiation flux
+!-- (2) cloud contribution to downward ir radiation flux
+!---
+    fira(i) = (1.-cloud(i))*ea*c_stefan*(ta(i)-dtair)**4 &
+ &           +cloud(i)*ec*c_stefan*(ta(i)-dtcloud)**4
+  ENDDO
+!-
+! snow and rain calculations
+!-
+  DO i=1,npoi
+!---
+!-- reset snow and rain to zero
+!---
+    snowa(i) = zero
+    raina(i) = zero
+!---
+!-- if precipitation event then calculate
+!---
+    IF (time >= startp .and. time < endp) then
+!-----
+!---- for rain / snow partitioning, make it all rain if
+!---- ta > 2.5 C and all snow if ta <= 2.5 C
+!-----
+!---- reference:
+!-----
+!---- Auer, A. H., 1974: The rain versus snow threshold temperatures,
+!---- Weatherwise, 27, 67.
+!-----
+      IF (ta(i)-273.15 > 2.5) then
+        raina(i) = precip(i)/plens
+      ELSE
+        snowa(i) = precip(i)/plens
+      ENDIF
+    ENDIF
+  ENDDO
+!---------------------
+END SUBROUTINE diurnal
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_main
+!!
+!>\BRIEF        This subroutine manages the calls to the different subroutines of the weather module. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::tair, ::pb, ::qair, ::swdown, ::rainf, ::snowf, ::u, ::v, ::lwdown
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_main &
+& (itau, istp, filename, force_id, iim, jjm, nband, &
+&  rest_id, lrstread, lrstwrite, &
+&  limit_west, limit_east, limit_north, limit_south, &
+&  zonal_res, merid_res, lon, lat, date0, dt_force, &
+&  kindex, nbindex, &
+&  swdown, rainf, snowf, tair, u, v, qair, pb, lwdown)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                  :: itau,istp
+  CHARACTER(LEN=*),INTENT(IN)         :: filename
+  INTEGER,INTENT(IN)                  :: force_id
+  INTEGER,INTENT(IN)                  :: iim,jjm
+  INTEGER,INTENT(IN)                  :: nband
+  INTEGER,INTENT(IN)                  :: rest_id
+  LOGICAL,INTENT(IN)                  :: lrstread, lrstwrite
+  REAL,INTENT(IN)                     :: limit_west,limit_east
+  REAL,INTENT(IN)                     :: limit_north,limit_south
+  REAL,INTENT(IN)                     :: zonal_res,merid_res
+  REAL,INTENT(IN)                     :: date0,dt_force
+  REAL,DIMENSION(iim,jjm),INTENT(IN)  :: lon,lat  !! longitude, latitude
+
+  !! 0.2 Output variables 
+
+  REAL,DIMENSION(iim,jjm),INTENT(OUT) :: &
+ &  tair,pb,qair,swdown,rainf,snowf, u,v,lwdown
+
+  !! 0.3 Mofified variables
+
+  INTEGER,INTENT(INOUT)                    :: nbindex
+  INTEGER,DIMENSION(iim*jjm),INTENT(INOUT) :: kindex
+
+  !! 0.4 Local variables
+
+  REAL, ALLOCATABLE, DIMENSION(:,:) :: &
+ &  tair_g,pb_g,qair_g,swdown_g,rainf_g,snowf_g, u_g,v_g,lwdown_g
+  REAL,DIMENSION(nbindex) :: &
+ &  tairl,pbl,qairl,swdownl,rainfl,snowfl, ul,vl,lwdownl
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  IF (lrstread) THEN
+    CALL weathgen_begin ( &
+     & dt_force,itau, date0, &
+     & rest_id,iim,jjm, &
+     & lon,lat,tair,pb,qair,kindex,nbindex)
+        RETURN
+  ELSE
+    CALL weathgen_get &
+ &   (itau, date0, dt_force, nbindex, nband, lat_land, &
+ &    swdownl, rainfl, snowfl, tairl, ul, vl, qairl, pbl, lwdownl)
+
+    tair(:,:)=val_exp
+    qair(:,:)=val_exp
+    pb(:,:)=val_exp
+    DO ij=1,nbindex
+       j = (((kindex(ij)-1)/iim) + 1)
+       i = (kindex(ij) - (j-1)*iim)
+       !
+       swdown(i,j)=swdownl(ij)
+       rainf(i,j)=rainfl(ij)
+       snowf(i,j)=snowfl(ij)
+       tair(i,j)=tairl(ij)
+       u(i,j)=ul(ij)
+       v(i,j)=vl(ij)
+       qair(i,j)=qairl(ij)
+       pb(i,j)=pbl(ij)
+       lwdown(i,j)=lwdownl(ij)
+    ENDDO
+!---
+    IF (dump_weather) THEN
+      ALLOCATE(tair_g(iim_g,jjm_g))
+      ALLOCATE(pb_g(iim_g,jjm_g))
+      ALLOCATE(qair_g(iim_g,jjm_g))
+      ALLOCATE(swdown_g(iim_g,jjm_g))
+      ALLOCATE(rainf_g(iim_g,jjm_g))
+      ALLOCATE(snowf_g(iim_g,jjm_g))
+      ALLOCATE(u_g(iim_g,jjm_g))
+      ALLOCATE(v_g(iim_g,jjm_g))
+      ALLOCATE(lwdown_g(iim_g,jjm_g))
+
+      CALL gather2D_mpi(tair, tair_g)
+      CALL gather2D_mpi(pb, pb_g)
+      CALL gather2D_mpi(qair, qair_g)
+      CALL gather2D_mpi(swdown, swdown_g)
+      CALL gather2D_mpi(rainf, rainf_g)
+      CALL gather2D_mpi(snowf, snowf_g)
+      CALL gather2D_mpi(u, u_g)
+      CALL gather2D_mpi(v, v_g)
+      CALL gather2D_mpi(lwdown, lwdown_g)
+      IF (is_root_prc) THEN
+         CALL weathgen_dump &
+ &           (itau, dt_force, iim_g, jjm_g, nbp_glo, index_g, lrstwrite, &
+ &            swdown_g, rainf_g, snowf_g, tair_g, u_g, v_g, qair_g, pb_g, lwdown_g)
+      ENDIF
+    ENDIF
+!---
+    IF (lrstwrite) THEN
+      CALL weathgen_restwrite (rest_id,istp,iim,jjm,nbindex,kindex)
+    ENDIF
+  ENDIF
+!---------------------------
+END SUBROUTINE weathgen_main
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_init 
+!!
+!>\BRIEF         This subroutine initializes weather variables.
+!!
+!! DESCRIPTION  : None 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):  ::kindex, ::nbindex
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_init &
+     & (filename,dt_force,force_id,iim,jjm, &
+     &  zonal_res,merid_res,lon,lat,kindex,nbindex)
+!!$,iind,jind)
+  !---------------------------------------------------------------------
+  IMPLICIT NONE
+  !-
+
+  !! 0. Variables and parameters declaration
+
+  REAL,PARAMETER  :: fcrit = .5       !! Minimum land fraction on original grid
+
+  !! 0.1 Input variables
+
+  CHARACTER(LEN=*),INTENT(IN)         :: filename
+  REAL,INTENT(IN)                     :: dt_force
+  INTEGER,INTENT(IN)                  :: iim, jjm
+  REAL,INTENT(IN)                     :: zonal_res,merid_res
+  REAL,DIMENSION(iim,jjm),INTENT(IN)  :: lon,lat
+
+  !! 0.2 Output variables  
+
+  INTEGER,INTENT(OUT)                 :: nbindex
+  INTEGER,DIMENSION(iim*jjm),INTENT(OUT)  :: kindex
+!!$  INTEGER,DIMENSION(iim),INTENT(OUT) :: iind
+!!$  INTEGER,DIMENSION(jjm),INTENT(OUT) :: jind
+
+  !! 0.3 Modified variables 
+
+  INTEGER,INTENT(INOUT)               :: force_id
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(:),ALLOCATABLE         :: lon_file, lon_temp
+  REAL,DIMENSION(:,:),ALLOCATABLE       :: nav_lon, nav_lat
+  REAL,DIMENSION(:),ALLOCATABLE         :: lat_file, lat_temp
+  REAL,DIMENSION(:,:),ALLOCATABLE       :: lsm_file
+  REAL     :: xextent_file, yextent_file, xres_file, yres_file
+  INTEGER  :: i, j, plotstep
+  REAL,DIMENSION(iim,jjm)               :: mask
+  CHARACTER(LEN=1),DIMENSION(0:1)       :: maskchar
+  CHARACTER(LEN=30)                     :: var_name
+  REAL     :: x_cut
+  REAL,DIMENSION(iim) :: tmp_lon
+  REAL,DIMENSION(jjm) :: tmp_lat
+
+!_ ================================================================================================================================
+
+  !-
+  ! 0. messages, initialisations
+  !-
+  WRITE(numout,*) &
+       &  'weathgen_init: Minimum land fraction on original grid =',fcrit
+  CALL ioget_calendar(calendar_str)
+  !-
+  ! 1. on lit les longitudes et latitudes de la grille de depart
+  !    ainsi que le masque terre-ocean
+  !-
+  CALL flinclo(force_id)
+  CALL flininfo (filename,iim_file,jjm_file,llm_file,ttm_file,force_id)
+  !-
+  ALLOC_ERR=-1
+  ALLOCATE(nav_lon(iim_file,jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of nav_lon : ",ALLOC_ERR
+     STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(nav_lat(iim_file,jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of nav_lat : ",ALLOC_ERR
+     STOP 
+  ENDIF
+  !-
+  var_name='nav_lon'
+  CALL flinget (force_id,var_name,iim_file,jjm_file,0,0,1,1,nav_lon)
+  var_name='nav_lat'
+  CALL flinget (force_id,var_name,iim_file,jjm_file,0,0,1,1,nav_lat)
+  !-
+
+  ALLOC_ERR=-1
+  ALLOCATE(lon_file(iim_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of lon_file : ",ALLOC_ERR
+     STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(lat_file(jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of lat_file : ",ALLOC_ERR
+     STOP 
+  ENDIF
+  !-
+  DO i=1,iim_file
+     lon_file(i) = nav_lon(i,1)
+  ENDDO
+  DO j=1,jjm_file
+     lat_file(j) = nav_lat(1,j)
+  ENDDO
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(lsm_file(iim_file,jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of lsm_file : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+  var_name='lsmera'
+  CALL flinget (force_id,var_name,iim_file,jjm_file,0,0,1,1,lsm_file)
+!-
+! 2. La resolution du modele ne doit pas etre superieure
+!    a celle de la grille de depart
+!-
+  xextent_file = lon_file(iim_file)-lon_file(1)
+  yextent_file = lat_file(1)-lat_file(jjm_file)
+  xres_file = xextent_file/REAL(iim_file-1)
+  yres_file = yextent_file/REAL(jjm_file-1)
+!-
+  IF (xres_file > zonal_res) THEN
+    WRITE(numout,*) 'Zonal resolution of model grid too fine.'
+    WRITE(numout,*) 'Resolution of original data (deg): ', xres_file
+    STOP
+  ENDIF
+!-
+  IF (yres_file > merid_res) THEN
+    WRITE(numout,*) 'Meridional resolution of model grid too fine.'
+    WRITE(numout,*) 'Resolution of original data (deg): ', yres_file
+    STOP
+  ENDIF
+!-
+! 3. On verifie la coherence des coordonnees de depart et d'arrivee.
+!    Sinon, il faut deplacer une partie du monde (rien que ca).
+!-
+  i_cut = 0
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(lon_temp(iim_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of lon_temp : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(lat_temp(jjm_file), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of lat_temp : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+  IF (lon(iim,1) > lon_file(iim_file)) THEN
+!-- A l'Est de la region d'interet, il n'y a pas de donnees
+!-- le bout a l'Ouest de la region d'interet est deplace de 360 deg
+!-- vers l'Est
+    x_cut = lon(1,1)
+    DO i=1,iim_file
+      IF (lon_file(i) < x_cut) i_cut = i
+    ENDDO
+    IF ((i_cut < 1).OR.(i_cut >= iim_file)) THEN
+        STOP 'Cannot find longitude for domain shift'
+    ENDIF
+!---
+    lon_temp(1:iim_file-i_cut-1) = lon_file(i_cut:iim_file)
+    lon_temp(iim_file-i_cut:iim_file) = lon_file(1:i_cut+1)+360.
+    lon_file(:) = lon_temp(:)
+  ELSEIF (lon(1,1) < lon_file(1)) THEN
+!-- A l'Ouest de la region d'interet, il n'y a pas de donnees
+!-- le bout a l'Est de la region d'interet est deplace de 360 deg
+!-- vers l'Ouest
+    x_cut = lon(iim,1)
+    DO i=1,iim_file
+      IF (lon_file(i) < x_cut) i_cut = i
+    ENDDO
+    IF ( ( i_cut < 1 ) .OR. ( i_cut >= iim_file ) ) THEN
+        STOP 'Cannot find longitude for domain shift'
+    ENDIF
+!---
+    lon_temp(1:iim_file-i_cut-1) = lon_file(i_cut:iim_file) -360.
+    lon_temp(iim_file-i_cut:iim_file) = lon_file(1:i_cut+1)
+    lon_file(:) = lon_temp(:)
+  ENDIF
+!-
+  DEALLOCATE (lon_temp)
+  DEALLOCATE (lat_temp)
+!-
+  IF (    (lon(1,1) < lon_file(1)) &
+ &    .OR.(     (lon(iim,1) > lon_file(iim_file)) &
+ &         .AND.(lon(iim,1) > lon_file(1)+360.) ) ) THEN
+    WRITE(numout,*) lon(:,1)
+    WRITE(numout,*)
+    WRITE(numout,*) lon_file(:)
+    STOP 'weathgen_init: cannot find coherent x-coordinates'
+  ENDIF
+!-
+  IF (i_cut /= 0) THEN
+    CALL shift_field (iim_file,jjm_file,i_cut,lsm_file)
+  ENDIF
+!-
+! 4. Verification
+!-
+  WRITE(numout,*)
+  WRITE(numout,*) 'Input File: (Shifted) Global Land-Sea Mask'
+  WRITE(numout,*)
+  maskchar(0) = '-'
+  maskchar(1) = 'X'
+  plotstep = INT(REAL(iim_file-1)/termcol)+1
+  DO j=1,jjm_file,plotstep
+    DO i=1,iim_file,plotstep
+      WRITE(numout,'(a1,$)') maskchar(NINT(lsm_file(i,j)))
+    ENDDO
+    WRITE(numout,*)
+  ENDDO
+  WRITE(numout,*)
+!-
+! 5. Prepare interpolation from fine grid land points to model grid
+!-
+! 5.1 how many grid points of the original grid fall into one grid
+!     box of the model grid?
+!-
+  n_agg = NINT((zonal_res/xres_file*merid_res/yres_file )+1.)
+!-
+! au diable l'avarice !
+!-
+  n_agg = n_agg*2
+!-
+! 5.2 Allocate arrays where we store information about which
+!     (and how many) points on the original grid fall
+!     into which box on the model grid
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(ncorr(iim,jjm), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of ncorr : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(icorr(iim,jjm,n_agg), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of icorr : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(jcorr(iim,jjm,n_agg), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of jcorr : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+! 6. Land-Ocean Mask on model grid
+!-
+  tmp_lon = lon(:,1)
+  tmp_lat = lat(1,:)
+
+  CALL mask_c_o &
+ &  (iim_file, jjm_file, lon_file, lat_file, lsm_file, fcrit, &
+ &   iim, jjm, zonal_res, merid_res, n_agg, tmp_lon, tmp_lat, &
+! &   iim, jjm, zonal_res, merid_res, n_agg, lon(:,1), lat(1,:), &
+ &   mask, ncorr, icorr, jcorr)
+!-
+  WRITE(numout,*) 'Land-Sea Mask on Model Grid'
+  WRITE(numout,*)
+  plotstep = INT(REAL(iim-1)/termcol)+1
+  DO j=1,jjm,plotstep
+    DO i=1,iim,plotstep
+      WRITE(numout,'(a1,$)') maskchar(NINT(mask(i,j)))
+    ENDDO
+    WRITE(numout,*)
+  ENDDO
+  WRITE(numout,*)
+!-
+! 7. kindex table.
+!-
+  nbindex = 0
+  DO j=1,jjm
+    DO i=1,iim
+      IF (NINT(mask(i,j)) == 1) THEN
+        nbindex = nbindex+1
+        kindex(nbindex) = (j-1)*iim+i
+      ENDIF
+    ENDDO
+  ENDDO
+  nbindex_w = nbindex
+  ALLOC_ERR=-1
+  ALLOCATE(kindex_w(nbindex_w), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of kindex_w : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  kindex_w(:)=kindex(1:nbindex)
+!-
+  IF ( nbindex == 0 ) THEN
+    WRITE(numout,*) 'Sorry, you are in the middle of the ocean. Check your coordinates.'
+    STOP 
+  ELSE
+    WRITE(numout,*) 'Number of continental points: ',nbindex
+  ENDIF
+
+!-
+! 10. clean up
+!-
+  DEALLOCATE (lon_file)
+  DEALLOCATE (lat_file)
+  DEALLOCATE (lsm_file)
+
+END SUBROUTINE weathgen_init
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_read_file
+!!
+!>\BRIEF         This subroutine allocates variables and reads files.  
+!!
+!! DESCRIPTION  :  
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_read_file &
+     & (force_id,iim,jjm)
+  !---------------------------------------------------------------------
+  IMPLICIT NONE
+  !-
+
+  !! 0. Variables and parameters declaration
+
+  REAL,PARAMETER  :: fcrit = .5
+
+  !! 0.1 Input variables 
+
+  INTEGER,INTENT(IN)                  :: force_id
+  INTEGER,INTENT(IN)                  :: iim, jjm
+
+  !! 0.4 Local variables
+
+  CHARACTER(LEN=30)               :: var_name
+
+  INTEGER,DIMENSION(iim*jjm)  :: kindex
+  INTEGER                     :: nbindex
+
+  REAL,DIMENSION(iim*jjm)     :: xchamp
+  REAL,DIMENSION(iim*jjm,nmon)  :: xchampm
+
+!_ ================================================================================================================================
+
+  kindex(:)=0
+
+#ifdef CPP_PARA
+  nbindex=nbp_loc
+  CALL scatter(index_g,kindex)
+  kindex(1:nbindex)=kindex(1:nbindex)-(jj_begin-1)*iim_g
+#else
+  ! Copy saved land points index
+  nbindex = nbindex_w
+  kindex(1:nbindex_w) = kindex_w(:)
+#endif
+
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(lat_land(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of lat_land : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+!-
+! 8 topography
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xintopo(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xintopo : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+  var_name='altitude'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,1,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchamp)
+  xintopo(:)=xchamp(kindex(1:nbindex))
+!-
+! 9. Allocate and read the monthly fields
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xinwet(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xinwet : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='prs'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xinwet(:,:)=xchampm(kindex(1:nbindex),:)
+  !-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xinprec(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xinprec : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='prm'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xinprec(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+  
+  ALLOC_ERR=-1
+  ALLOCATE(xint(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xint : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='t2m'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xint(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xinq(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xinq : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='r2m'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xinq(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xinwind(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xinwind : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='uv10m'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                     iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xinwind(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xincld(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xincld : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='tc'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                       iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xincld(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xintrng(nbindex,nmon), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xintrng : ",ALLOC_ERR
+    STOP 
+  ENDIF
+  var_name='t2a'
+  CALL weather_read (force_id,var_name,iim_file,jjm_file,nmon,i_cut, &
+                       iim,jjm,n_agg,ncorr,icorr,jcorr,xchampm)
+  xintrng(:,:)=xchampm(kindex(1:nbindex),:)
+!-
+! 10. clean up
+!-
+  IF (is_root_prc) THEN
+     DEALLOCATE (ncorr)
+     DEALLOCATE (icorr)
+     DEALLOCATE (jcorr)
+  ENDIF
+
+!-
+! 12. Allocate space for daily mean values
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(iwet(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of iwet : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(psurfm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of psurfm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(cloudm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of cloudm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(tmaxm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of tmaxm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(tminm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of tminm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(qdm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of qdm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(udm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of udm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(precipm0(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of precipm0 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(psurfm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of psurfm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(cloudm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of cloudm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(tmaxm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of tmaxm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(tminm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of tminm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(qdm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of qdm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(udm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of udm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(precipm1(nbindex), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of precipm1 : ",ALLOC_ERR
+    STOP 
+  ENDIF
+END SUBROUTINE weathgen_read_file
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_begin
+!!
+!>\BRIEF         This subroutines initializes variables or reads restart values. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::nbindex, ::tair, ::pb, ::qair, ::kindex
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_begin ( &
+     & dt_force,itau, date0, &
+     & rest_id,iim,jjm, &
+     & lon,lat,tair,pb,qair,kindex,nbindex)
+  !---------------------------------------------------------------------
+  IMPLICIT NONE
+
+  !-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN)                     :: dt_force, date0
+  INTEGER,INTENT(IN)                  :: itau
+  INTEGER,INTENT(IN)                  :: rest_id
+  INTEGER,INTENT(IN)                  :: iim, jjm
+  REAL,DIMENSION(iim,jjm),INTENT(IN)  :: lon,lat
+
+  !! 0.2 Output variables 
+
+  INTEGER,INTENT(OUT)                     :: nbindex
+  INTEGER,DIMENSION(iim*jjm),INTENT(OUT)  :: kindex
+  REAL,DIMENSION(iim,jjm),INTENT(OUT)     :: tair,pb,qair
+
+  !! 0.4 Local variables
+
+  INTEGER  :: i, j, ij
+  REAL     :: val_exp
+  REAL,DIMENSION(iim*jjm)               :: xchamp
+  REAL,DIMENSION(iim_g*jjm_g)           :: xchamp_g
+  CHARACTER(LEN=30)                     :: var_name
+  REAL,DIMENSION(1)                     :: jullasttab
+  REAL,DIMENSION(seedsize_max)          :: seed_in_file
+  INTEGER,DIMENSION(:), ALLOCATABLE     :: seed_in_proc
+  INTEGER  :: seedsize, iret
+  INTEGER  :: nlonid, nlatid, nlonid1, nlatid1, tdimid1, varid
+  INTEGER  :: ndim, dims(4)
+  CHARACTER(LEN=30) :: assoc
+  CHARACTER(LEN=70) :: str70
+  CHARACTER(LEN=80) :: stamp
+  INTEGER  :: yy_b, mm_b, dd_b, hh, mm
+  REAL     :: ss
+  CHARACTER(LEN=10) :: today, att
+  INTEGER  :: nlandid1, nlandid, nlevid, nlevid1
+  REAL     :: lev_max, lev_min
+  REAL     :: height_lev1
+  INTEGER  :: imois
+  REAL     :: xx, td
+
+!_ ================================================================================================================================
+
+  kindex(:)=0
+
+#ifdef CPP_PARA
+  nbindex=nbp_loc
+  CALL scatter(index_g,kindex)
+  kindex(1:nbindex)=kindex(1:nbindex)-(jj_begin-1)*iim_g
+#else
+  ! Copy saved land points index
+  nbindex = nbindex_w
+  kindex(1:nbindex_w) = kindex_w(:)
+#endif
+!-
+! 13. Prescribed or statistical values?
+!-
+  !Config Key   = IPPREC
+  !Config Desc  = Use prescribed values
+  !Config If    = ALLOW_WEATHERGEN
+  !Config Def   = 0
+  !Config Help  = If this is set to 1, the weather generator
+  !Config         uses the monthly mean values for daily means.
+  !Config         If it is set to 0, the weather generator
+  !Config         uses statistical relationships to derive daily
+  !Config         values from monthly means.
+  !Config Units = [-] 
+  ipprec = 0
+  CALL getin_p ('IPPREC',ipprec)
+  WRITE(numout,*) 'IPPREC: ',ipprec
+!-
+! 14. Do we want exact monthly precipitations even with ipprec=0 ?
+!-
+  !Config Key   = WEATHGEN_PRECIP_EXACT
+  !Config Desc  = Exact monthly precipitation
+  !Config If    = ALLOW_WEATHERGEN
+  !Config Def   = n
+  !Config Help  = If this is set to y, the weather generator
+  !Config         will generate pseudo-random precipitations
+  !Config         whose monthly mean is exactly the prescribed one.
+  !Config         In this case, the daily precipitation (for rainy
+  !Config         days) is constant (that is, some days have 0 precip,
+  !Config         the other days have precip=Precip_month/n_precip,
+  !Config         where n_precip is the prescribed number of rainy days
+  !Config         per month).
+  !Config Units = [FLAG]
+  precip_exact = .FALSE.
+  CALL getin_p ('WEATHGEN_PRECIP_EXACT',precip_exact)
+  WRITE(numout,*) 'PRECIP_EXACT: ',precip_exact
+
+!-
+! 15. Read restart file
+!-
+  CALL ioget_expval (val_exp)
+!-
+  var_name= 'julian'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id,var_name,1,1,1,itau,.TRUE.,jullasttab)
+     IF (jullasttab(1) == val_exp) THEN
+        jullasttab(1) = itau2date(itau-1, date0, dt_force)
+     ENDIF
+  ENDIF
+  CALL bcast(jullasttab)
+  julian_last = jullasttab(1)
+!-
+  var_name= 'seed'
+  IF (is_root_prc) &
+       CALL restget (rest_id,var_name,seedsize_max, &
+ &              1,1,itau,.TRUE.,seed_in_file)
+  CALL bcast(seed_in_file)
+  IF (ALL(seed_in_file(:) == val_exp)) THEN
+!---
+!-- there is no need to reinitialize the random number generator as
+!-- this does not seem to be a restart
+!---
+    CONTINUE
+  ELSE
+!---
+!-- reinitialize the random number generator
+!---
+     IF (is_root_prc) &
+          CALL RANDOM_SEED( SIZE = seedsize )
+     CALL bcast(seedsize)
+     IF (seedsize > seedsize_max) THEN
+        STOP 'weathgen_begin: increase seedsize_max'
+     ENDIF
+  
+     IF (precip_exact) THEN
+!---
+!-- preparer un tableau utilise pour determiner s'il pleut ou pas
+!-- (en fct. du nombre de jours de pluie par mois).
+!---
+        IF (is_root_prc) THEN
+           DO imois=1,12
+              CALL permute (ndaypm(imois),jour_precip(:,imois))
+           ENDDO
+        ENDIF
+       CALL bcast(jour_precip)
+    ENDIF
+
+    ALLOC_ERR=-1
+    ALLOCATE(seed_in_proc(seedsize), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of seed_in_proc : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    seed_in_proc(1:seedsize) = NINT( seed_in_file(1:seedsize) )
+    CALL RANDOM_SEED (PUT = seed_in_proc)
+    DEALLOCATE( seed_in_proc )
+ ENDIF
+!-
+  var_name= 'iwet'
+  IF (is_root_prc) THEN
+    CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+    IF (ALL(xchamp_g(:) == val_exp)) THEN
+      xchamp_g(:) = zero
+    ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  iwet(:) = NINT(xchamp(kindex(1:nbindex)))
+!-
+  var_name= 'psurfm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 100000.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  psurfm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'cloudm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = .5
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  cloudm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'tmaxm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 285.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  tmaxm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'tminm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 275.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  tminm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'qdm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 1.E-03
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  qdm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'udm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 2.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  udm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'precipm0'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 1.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  precipm0(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'psurfm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 100000.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  psurfm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'cloudm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = .5
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  cloudm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'tmaxm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 285.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  tmaxm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'tminm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 275.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  tminm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'qdm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 1.E-03
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  qdm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'udm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 2.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  udm1(:) = xchamp(kindex(1:nbindex))
+!-
+  var_name= 'precipm1'
+  IF (is_root_prc) THEN
+     CALL restget (rest_id, var_name, iim_g, jjm_g, 1, itau, .TRUE., xchamp_g)
+     IF (ALL(xchamp_g(:) == val_exp)) THEN
+        xchamp_g(:) = 1.
+     ENDIF
+  ENDIF
+  CALL scatter2D_mpi(xchamp_g,xchamp)
+  precipm1(:) = xchamp(kindex(1:nbindex))
+
+!-
+! 16. We still need instantaneous tair, qair, and the surface pressure
+!     We take daily mean values read from the restart file
+!-
+!!$  tair(:,:)=280.
+!!$  qair(:,:)=1.E-03
+!!$  pb(:,:)=101325
+  tair(:,:)=val_exp
+  qair(:,:)=val_exp
+  pb(:,:)=val_exp
+  xx = cte_grav/rair/0.0065
+  DO ij=1,nbindex
+     j = ((kindex(ij)-1)/iim) + 1
+     i = kindex(ij) - (j-1)*iim
+     
+     lat_land(ij) = lat(i,j)
+     
+     td =  (tmaxm0(ij)+tminm0(ij))/2.
+     tair(i,j) = td
+     qair(i,j) = qdm1(ij)
+     pb(i,j) = 101325.*(td/(td+0.0065*xintopo(ij)))**xx
+  ENDDO
+!-
+! 17. We can write a forcing file for Orchidee
+!     from this weather Generator run.
+!-
+  !Config Key   = DUMP_WEATHER
+  !Config Desc  = Write weather from generator into a forcing file
+  !Config If    = ALLOW_WEATHERGEN  
+  !Config Def   = n
+  !Config Help  = This flag makes the weather generator dump its
+  !Config         generated weather into a forcing file which can
+  !Config         then be used to get the same forcing on different
+  !Config         machines. This only works correctly if there is
+  !Config         a restart file (otherwise the forcing at the first
+  !Config         time step is slightly wrong).
+  !Config Units = [FLAG]
+  dump_weather = .FALSE.
+  CALL getin_p ('DUMP_WEATHER',dump_weather)
+!-
+  IF (dump_weather .AND. is_root_prc) THEN
+!---
+!-- Initialize the file
+!---
+     !Config Key   = DUMP_WEATHER_FILE
+     !Config Desc  = Name of the file that contains the weather from generator
+     !Config If    = DUMP_WEATHER
+     !Config Def   = weather_dump.nc
+     !Config Help  =
+     !Config Units = [FILE]
+    dump_weather_file = 'weather_dump.nc'
+    CALL getin ('DUMP_WEATHER_FILE',dump_weather_file)
+!---
+    !Config Key   = DUMP_WEATHER_GATHERED
+    !Config Desc  = Dump weather data on gathered grid
+    !Config If    = DUMP_WEATHER
+    !Config Def   = y
+    !Config Help  = If 'y', the weather data are gathered for all land points.
+    !Config Units = [FLAG]
+    gathered = .TRUE.
+    CALL getin ('DUMP_WEATHER_GATHERED',gathered)
+!---
+    iret = NF90_CREATE (TRIM(dump_weather_file),NF90_CLOBBER,dump_id)
+!---
+!-- Dimensions
+!---
+    iret = NF90_DEF_DIM (dump_id,'x',iim_g,nlonid1)
+    iret = NF90_DEF_DIM (dump_id,'y',jjm_g,nlatid1)
+    iret = NF90_DEF_DIM (dump_id,'z',  1,nlevid1)
+!---
+    IF (gathered) THEN
+      iret = NF90_DEF_DIM (dump_id,'land',nbp_glo,nlandid1)
+    ENDIF
+    iret = NF90_DEF_DIM (dump_id,'tstep',NF90_UNLIMITED,tdimid1)
+!---
+!-- Coordinate variables
+!---
+    dims(1:2) = (/ nlonid1, nlatid1 /)
+!---
+    iret = NF90_DEF_VAR (dump_id,'nav_lon',n_rtp,dims(1:2),nlonid)
+    iret = NF90_PUT_ATT (dump_id,nlonid,'units',"degrees_east")
+    iret = NF90_PUT_ATT (dump_id,nlonid,'valid_min',MINVAL(lon_g))
+    iret = NF90_PUT_ATT (dump_id,nlonid,'valid_max',MAXVAL(lon_g))
+    iret = NF90_PUT_ATT (dump_id,nlonid,'long_name',"Longitude")
+!---
+    iret = NF90_DEF_VAR (dump_id,'nav_lat',n_rtp,dims(1:2),nlatid)
+    iret = NF90_PUT_ATT (dump_id,nlatid,'units',"degrees_north")
+    iret = NF90_PUT_ATT (dump_id,nlatid,'valid_min',MINVAL(lat_g))
+    iret = NF90_PUT_ATT (dump_id,nlatid,'valid_max',MAXVAL(lat_g))
+    iret = NF90_PUT_ATT (dump_id,nlatid,'long_name',"Latitude")
+!---
+    height_lev1 = 10.
+    !Config Key   = HEIGHT_LEV1
+    !Config Desc  = 
+    !Config If    = DUMP_WEATHER
+    !Config Def   = 10.
+    !Config Help  = 
+    !Config Units = [m]
+    CALL getin ('HEIGHT_LEV1',height_lev1)
+    lev_min = height_lev1
+    lev_max = height_lev1
+!---
+    iret = NF90_DEF_VAR (dump_id,'level',n_rtp,(/ nlevid1 /),nlevid)
+    iret = NF90_PUT_ATT (dump_id,nlevid,'units',"m")
+    iret = NF90_PUT_ATT (dump_id,nlevid,'valid_min',lev_min)
+    iret = NF90_PUT_ATT (dump_id,nlevid,'valid_max',lev_max)
+    iret = NF90_PUT_ATT (dump_id,nlevid,'long_name',"Vertical levels")
+!---
+    IF (gathered) THEN
+      iret = NF90_DEF_VAR (dump_id,'land',NF90_INT,(/ nlandid1 /),nlandid)
+      iret = NF90_PUT_ATT (dump_id,nlandid,'compress',"y x")
+    ENDIF
+!---
+!-- Store the time axes.
+!---
+    iret = NF90_DEF_VAR (dump_id,'time',n_rtp,tdimid1,time_id)
+
+    yy_b=0
+    mm_b=1
+    dd_b=1
+    hh=00
+    mm=00
+    ss=0.
+
+    WRITE (str70,7000) yy_b, mm_b, dd_b, hh, mm, INT(ss)
+    iret = NF90_PUT_ATT (dump_id,time_id,'units',TRIM(str70))
+    iret = NF90_PUT_ATT (dump_id,time_id,'calendar',TRIM(calendar_str))
+    iret = NF90_PUT_ATT (dump_id,time_id,'title','Time')
+    iret = NF90_PUT_ATT (dump_id,time_id,'long_name','Time axis')
+    WRITE(str70,7001) yy_b, cal(mm_b), dd_b, hh, mm, INT(ss)
+    iret = NF90_PUT_ATT (dump_id,time_id,'time_origin',TRIM(str70))
+!---
+!-- Time steps
+!---
+    iret = NF90_DEF_VAR (dump_id,'timestp',NF90_INT,tdimid1,timestp_id)
+    WRITE(str70,7002) yy_b, mm_b, dd_b, hh, mm, INT(ss)
+    iret = NF90_PUT_ATT (dump_id,timestp_id,'units',TRIM(str70))
+    iret = NF90_PUT_ATT (dump_id,timestp_id,'title','Time steps')
+    iret = NF90_PUT_ATT (dump_id,timestp_id,'tstep_sec',dt_force)
+    iret = NF90_PUT_ATT &
+ &           (dump_id,timestp_id,'long_name','Time step axis')
+    WRITE(str70,7001) yy_b, cal(mm_b), dd_b, hh, mm, INT(ss)
+    iret = NF90_PUT_ATT (dump_id,timestp_id,'time_origin',TRIM(str70))
+!---
+7000 FORMAT('seconds since ',I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)
+7001 FORMAT(' ',I4.4,'-',A3,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)
+7002 FORMAT('timesteps since ', I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)
+!---
+!-- The variables in the file are declared and their attributes
+!-- written.
+!---
+    IF (gathered) THEN
+      ndim = 2
+      dims(1:2) = (/ nlandid1, tdimid1 /)
+      assoc = 'time (nav_lat nav_lon)'
+    ELSE
+      ndim = 3
+      dims(1:3) = (/ nlonid1, nlatid1, tdimid1 /)
+      assoc = 'time nav_lat nav_lon'
+    ENDIF
+!---
+    iret = NF90_DEF_VAR (dump_id,'SWdown',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','W/m^2')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Surface incident shortwave radiation')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    soldownid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Rainf',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','kg/m^2s')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Rainfall rate')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    rainfid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Snowf',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','kg/m^2s')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Snowfall rate')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    snowfid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'LWdown',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','W/m^2')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Surface incident longwave radiation')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    lwradid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'PSurf',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','Pa')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Surface pressure')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    psolid = varid
+!---
+!-- 3D Variables to be written
+!---
+    IF (gathered) THEN
+      ndim = 3
+      dims(1:3) = (/ nlandid1, nlevid1, tdimid1 /)
+      assoc = 'time level (nav_lat nav_lon)'
+    ELSE
+      ndim = 4
+      dims(1:4) = (/ nlonid1, nlatid1, nlevid1, tdimid1 /)
+      assoc = 'time level nav_lat nav_lon'
+    ENDIF
+!---
+    iret = NF90_DEF_VAR (dump_id,'Tair',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TZYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','K')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Near surface air temperature')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    tairid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Qair',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TZYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','kg/kg')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Near surface specific humidity')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    qairid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Wind_N',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TZYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','m/s')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Near surface northward wind component')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    uid = varid
+!---
+    iret = NF90_DEF_VAR (dump_id,'Wind_E',n_rtp,dims(1:ndim),varid)
+    iret = NF90_PUT_ATT (dump_id,varid,'axis','TZYX')
+    iret = NF90_PUT_ATT (dump_id,varid,'units','m/s')
+    iret = NF90_PUT_ATT (dump_id,varid,'long_name', &
+ &                       'Near surface eastward wind component')
+    iret = NF90_PUT_ATT (dump_id,varid,'associate',TRIM(assoc))
+    iret = NF90_PUT_ATT (dump_id,varid,'missing_value',undef_sechiba)
+    vid = varid
+!---
+!-- Global attributes
+!---
+    CALL DATE_AND_TIME (today, att)
+    stamp = "WG, date: "//TRIM(today)//" at "//TRIM(att)
+    iret = NF90_PUT_ATT (dump_id,NF90_GLOBAL,'Conventions',"GDT 1.2")
+    iret = NF90_PUT_ATT (dump_id,NF90_GLOBAL,'file_name', &
+ &                       TRIM(dump_weather_file))
+    iret = NF90_PUT_ATT (dump_id,NF90_GLOBAL,'production',TRIM(stamp))
+!---
+!-- Finish the definition phase
+!---
+    iret = NF90_ENDDEF (dump_id)
+!---
+!--    Write coordinates
+!---
+    iret = NF90_PUT_VAR (dump_id,nlonid,lon_g)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(numout,*) iret
+       CALL ipslerr_p (3,'weathgen_begin', &
+ &          'Could not put variable nav_lon in the file : ', &
+ &          TRIM(dump_weather_file),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_VAR (dump_id,nlatid,lat_g)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(numout,*) iret
+       CALL ipslerr_p (3,'weathgen_begin', &
+ &          'Could not put variable nav_lat in the file : ', &
+ &          TRIM(dump_weather_file),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_VAR (dump_id,nlevid,height_lev1)
+    IF (iret /= NF90_NOERR) THEN
+       WRITE(numout,*) iret
+       CALL ipslerr_p (3,'weathgen_begin', &
+ &          'Could not put variable level in the file : ', &
+ &          TRIM(dump_weather_file),'(Solution ?)')
+    ENDIF
+!---
+    IF (gathered) THEN
+       iret = NF90_PUT_VAR (dump_id,nlandid,index_g(1:nbp_glo))
+       IF (iret /= NF90_NOERR) THEN
+          WRITE(numout,*) iret
+          CALL ipslerr_p (3,'weathgen_begin', &
+ &          'Could not put variable land in the file : ', &
+ &          TRIM(dump_weather_file),'(Solution ?)')
+       ENDIF
+    ENDIF
+!---
+ ENDIF ! dump_weather
+!-----------------------------
+END SUBROUTINE weathgen_begin
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_get
+!!
+!>\BRIEF        This subroutine initializes forcing values. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::swdown, ::raina, ::snowa, ::tair, ::u, ::v, ::qair, ::psurf, ::lwdown
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_get &
+& (itau, date0, dt_force, nbindex, nband, lat, &
+&  swdown, raina, snowa, tair, u, v, qair, psurf, lwdown)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)               :: itau      !! number of time step
+  REAL,INTENT(IN)                  :: date0     !! date when itau was 0
+  REAL,INTENT(IN)                  :: dt_force  !! time step (s)
+  INTEGER,INTENT(IN)               :: nbindex   !! number of land points
+  INTEGER,INTENT(IN)               :: nband     !! number of visible bands
+  REAL,DIMENSION(nbindex),INTENT(IN)  :: lat    !! latitude (deg)
+
+  !! 0.2 Output variables  
+
+  REAL,DIMENSION(nbindex,nband),INTENT(OUT) :: swdown        !! Downward solar radiation @tex $(W.m^{-2})$ @endtex
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: raina, snowa  !! precipitations @tex $(mm.day^{-1})$ @endtex 
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: tair          !! air temperature (K)
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: u,v           !! wind speed @tex $(m.s^{-1})$ @endtex
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: qair          !! air humidity @tex $(kg_h2o.kg_air^{-1})$ @endtex
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: psurf         !! Surface pressure (Pa)
+  REAL,DIMENSION(nbindex),INTENT(OUT)       :: lwdown        !! Downward long wave radiation @tex $(W.m^{-2})$ @endtex
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(nbindex)        :: cloud, tmax, tmin, precipd, qd, ud
+  REAL,DIMENSION(nbindex)        :: rh
+  REAL,DIMENSION(nbindex,nband)  :: solai, solad
+  REAL                        :: julian, jur
+  REAL                        :: x
+  INTEGER                     :: yy, mm, dd
+  REAL                        :: ss, plens, time
+
+!_ ================================================================================================================================
+
+!-
+! 1. get a reduced julian day
+!-
+  julian = itau2date(itau-1, date0, dt_force)
+!SZ, test: solar noon at 12 o'clock!
+!  julian = itau2date(itau, date0, dt_force)
+  CALL ju2ymds (julian, yy, mm, dd, ss)
+  CALL ymds2ju (yy,1,1,0.0, jur)
+  julian = julian-jur
+  CALL ju2ymds (julian, yy, mm, dd, ss)
+!-
+! 2. daily values
+!-
+  IF (INT(julian_last) /= INT(julian)) THEN
+!-- today's values become yesterday's values
+    cloudm1(:) = cloudm0(:)
+    tmaxm1(:) = tmaxm0(:)
+    tminm1(:) = tminm0(:)
+    precipm1(:) = precipm0(:)
+    qdm1(:) = qdm0(:)
+    udm1(:) = udm0(:)
+    psurfm1(:) = psurfm0(:)
+!-- we have to get new daily values
+!!$    WRITE(*,*) mpi_rank, "weathgen_get : date ",yy, mm, dd, ss
+!!$    WRITE(*,*) mpi_rank, "weathgen_get : grid date ",year, month, day, sec
+    CALL daily (nbindex, mm, dd, cloudm0, tmaxm0, tminm0, &
+ &              precipm0, qdm0, udm0, psurfm0)
+  ENDIF
+!-
+! 3. interpolate daily values
+!    (otherwise we get ugly temperature jumps at midnight)
+!-
+  x = (julian-INT(julian))
+!-
+  cloud(:) = (1.-x)*cloudm1(:)+x*cloudm0(:)
+  tmax(:) = (1.-x)*tmaxm1(:)+x*tmaxm0(:)
+  tmin(:) = (1.-x)*tminm1(:)+x*tminm0(:)
+  precipd(:) = (1.-x)*precipm1(:)+x*precipm0(:)
+  qd(:) = (1.-x)*qdm1(:)+x*qdm0(:)
+  ud(:) = (1.-x)*udm1(:)+x*udm0(:)
+  psurf(:) = (1.-x)*psurfm1(:)+x*psurfm0(:)
+!-
+! 4. read instantaneous values
+!-
+  plens = one_day/dt_force
+  time = (julian-REAL(INT(julian)))*one_day
+!-
+  CALL diurnal (nbindex, nband, time, NINT(julian), plens, 0., one_day, &
+ &              lat, cloud, tmax, tmin, precipd, qd, ud, psurf, &
+ &              lwdown, solad, solai, u, tair, qair, raina, snowa, rh)
+!-
+  raina(:) = raina(:)/dt_force
+  snowa(:) = snowa(:)/dt_force
+!-
+  swdown(:,:) = solad(:,:)+solai(:,:)
+!-
+  v(:) = zero
+!-
+! 5. Store date
+!-
+  julian_last = julian
+!--------------------------
+END SUBROUTINE weathgen_get
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_restwrite
+!!
+!>\BRIEF         This subroutine writes data in the restart file.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_restwrite (rest_id,itau,iim,jjm,nbindex,kindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)  :: rest_id,itau,iim,jjm,nbindex
+  INTEGER,DIMENSION(iim*jjm),INTENT(IN) :: kindex
+
+  !! 0.4 Local variables
+
+  CHARACTER(LEN=30)                 :: var_name
+  INTEGER                           :: i,j,ij
+  REAL,DIMENSION(1)                 :: jullasttab
+  REAL,DIMENSION(seedsize_max)      :: seed_in_file
+  INTEGER,DIMENSION(:),ALLOCATABLE  :: seed_in_proc
+  INTEGER                           :: seedsize
+  REAL                              :: rndnum
+  REAL,DIMENSION(iim*jjm)           :: xchamp
+  REAL,DIMENSION(iim_g*jjm_g)       :: xchamp_g
+
+!_ ================================================================================================================================
+
+  var_name= 'julian'
+  jullasttab(:) = julian_last
+  IF (is_root_prc) CALL restput (rest_id, var_name, 1, 1, 1, itau, jullasttab)
+!-
+  IF (is_root_prc) THEN
+     CALL RANDOM_SEED( SIZE = seedsize )
+     IF (seedsize > seedsize_max) THEN
+        STOP 'weathgen_restwrite: increase seedsize_max'
+     ENDIF
+  ENDIF
+  CALL bcast(seedsize)
+
+  IF (is_root_prc) THEN
+     ALLOC_ERR=-1
+     ALLOCATE(seed_in_proc(seedsize), STAT=ALLOC_ERR)
+     IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of seed_in_proc : ",ALLOC_ERR
+        STOP 
+     ENDIF
+!-
+     CALL RANDOM_SEED (GET = seed_in_proc)
+!-
+     seed_in_file(1:seedsize) = REAL(seed_in_proc(1:seedsize))
+!-
+! fill in the seed up to seedsize_max
+! (useful in the case we restart on
+!  a machine with a longer seed vector:
+!  we do not want a degenerated seed)
+!-
+     DO i=seedsize+1,seedsize_max
+        CALL RANDOM_NUMBER( rndnum )
+        seed_in_file(i) = 100000.*rndnum
+     ENDDO
+  ENDIF
+  CALL bcast (seed_in_file)
+!-
+  IF (is_root_prc) THEN
+     DEALLOCATE( seed_in_proc )
+!-
+     var_name= 'seed'
+     CALL restput (rest_id,var_name,seedsize_max,1,1,itau,seed_in_file)
+  ENDIF
+!-
+
+  xchamp(:) = val_exp
+  
+!!$  DO j=1,jjm
+!!$    DO i=1,iim
+!!$      ij = (j-1)*iim+i
+!!$      xchamp(i,j) = REAL(iwet(ij))
+!!$    ENDDO
+!!$  ENDDO
+  DO ij=1,nbindex
+     xchamp(kindex(ij)) = REAL(iwet(ij))
+  ENDDO
+  var_name= 'iwet'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = psurfm0(ij)
+  ENDDO
+  var_name= 'psurfm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = cloudm0(ij)
+  ENDDO
+  var_name= 'cloudm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = tmaxm0(ij)
+  ENDDO
+  var_name= 'tmaxm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = tminm0(ij)
+  ENDDO
+  var_name= 'tminm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = qdm0(ij)
+  ENDDO
+  var_name= 'qdm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = udm0(ij)
+  ENDDO
+  var_name= 'udm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = precipm0(ij)
+  ENDDO
+  var_name= 'precipm0'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = psurfm1(ij)
+  ENDDO
+  var_name= 'psurfm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = cloudm1(ij)
+  ENDDO
+  var_name= 'cloudm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = tmaxm1(ij)
+  ENDDO
+  var_name= 'tmaxm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = tminm1(ij)
+  ENDDO
+  var_name= 'tminm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = qdm1(ij)
+  ENDDO
+  var_name= 'qdm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = udm1(ij)
+  ENDDO
+  var_name= 'udm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!-
+  DO ij=1,nbindex
+    xchamp(kindex(ij)) = precipm1(ij)
+  ENDDO
+  var_name= 'precipm1'
+  CALL gather2D_mpi(xchamp,xchamp_g)
+  IF (is_root_prc) THEN
+     CALL restput (rest_id, var_name, iim_g, jjm_g, 1, itau, xchamp_g)
+  ENDIF
+!--------------------------------
+END SUBROUTINE weathgen_restwrite
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_data
+!!
+!>\BRIEF         This subroutine reads data from an netcdf file. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::champout
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weather_read &
+& (force_id,nomvar,iim_file,jjm_file,n3,i_cut, &
+&  iim,jjm,n_agg,ncorr,icorr,jcorr,champout)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+  
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                          :: force_id
+  CHARACTER(LEN=*),INTENT(IN)                 :: nomvar
+  INTEGER,INTENT(IN)                          :: iim_file,jjm_file
+  INTEGER,INTENT(IN)                          :: n3
+  INTEGER,INTENT(IN)                          :: i_cut
+  INTEGER,INTENT(IN)                          :: iim,jjm
+  INTEGER,INTENT(IN)                          :: n_agg
+  INTEGER,DIMENSION(:,:),INTENT(IN)           :: ncorr
+  INTEGER,DIMENSION(:,:,:),INTENT(IN)         :: icorr,jcorr
+
+  !! 0.2 Output variables 
+
+  REAL,DIMENSION(iim*jjm,n3),INTENT(OUT)      :: champout
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(iim_file,jjm_file,n3)        :: champ_file
+  REAL,ALLOCATABLE,DIMENSION(:,:)             :: champout_g
+  INTEGER                                     :: i,j,ij,l,m
+
+!_ ================================================================================================================================
+
+  WRITE(numout,*) 'Lecture ',TRIM(nomvar)
+!-
+  IF (is_root_prc) THEN
+     ALLOCATE(champout_g(iim_g*jjm_g,n3))
+     IF ( n3 == 1 ) THEN
+        CALL flinget (force_id,nomvar(1:LEN_TRIM(nomvar)), &
+             &                iim_file, jjm_file, 0, 0,  1, 1, champ_file)
+     ELSE
+        DO l=1,n3
+           CALL flinget &
+                &      (force_id,nomvar(1:LEN_TRIM(nomvar)), &
+                &       iim_file, jjm_file, 0, n3,  l, l, champ_file(:,:,l))
+        ENDDO
+     ENDIF
+     ! shift if necessary
+     IF (i_cut /= 0) THEN
+        DO l=1,n3
+           CALL shift_field (iim_file,jjm_file,i_cut,champ_file(:,:,l))
+        ENDDO
+     ENDIF
+     ! interpolate onto the model grid
+     DO l=1,n3
+        DO j=1,jjm_g
+           DO i=1,iim_g
+              ij = i+(j-1)*iim_g
+              champout_g(ij,l) = zero
+              DO m=1,ncorr(i,j)
+                 champout_g(ij,l) = champout_g(ij,l) &
+        &                        +champ_file(icorr(i,j,m),jcorr(i,j,m),l)
+              ENDDO
+              champout_g(ij,l) = champout_g(ij,l)/REAL(ncorr(i,j))
+           ENDDO
+        ENDDO
+     ENDDO
+!$     DO l=1,n3
+!$        DO j=1,jjm_g
+!$           WRITE(numout,*) j,(/ ( champout_g((j-1)*iim_g+i,l), i=1,iim_g ) /)
+!$        ENDDO
+!$     ENDDO
+  ELSE
+     ALLOCATE(champout_g(1,1))
+  ENDIF
+!!$  CALL scatter2D(champout_g,champout)
+#ifndef CPP_PARA
+  champout(:,:)=champout_g(:,:)
+#else
+  CALL orch_scatter2D_mpi_rgen(champout_g,champout,n3)
+#endif
+
+!$  DO l=1,n3
+!$     DO j=1,jjm
+!$        WRITE(numout,*) j,(/ ( champout((j-1)*iim_g+i,l), i=1,iim_g ) /)
+!$     ENDDO
+!$  ENDDO
+  !----------------------------
+END SUBROUTINE weather_read
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_dump
+!!
+!>\BRIEF        This subroutine "dumps" data before writing an netcdf file.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_dump &
+& (itau, dt_force, iim, jjm, nbindex, kindex, lrstwrite, &
+&  swdown, rainf, snowf, tair, u, v, qair, pb, lwdown )
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                     :: itau
+  REAL,INTENT(IN)                        :: dt_force
+  INTEGER,INTENT(IN)                     :: iim,jjm
+  INTEGER,INTENT(IN)                     :: nbindex
+  LOGICAL,INTENT(IN)                     :: lrstwrite
+  INTEGER,DIMENSION(iim*jjm),INTENT(IN)  :: kindex
+  REAL,DIMENSION(iim*jjm),INTENT(IN)     :: &
+ &  swdown, rainf, snowf, tair, u, v, qair, pb, lwdown
+
+  !! 0.4 Local variables
+
+  INTEGER                 :: iret,ndim
+  INTEGER,DIMENSION(4)    :: corner,edges
+  REAL,DIMENSION(iim*jjm) :: var_gather
+
+!_ ================================================================================================================================
+
+!-
+! time dimension
+!-
+  iret = NF90_PUT_VAR (dump_id,timestp_id,(/ REAL(itau) /), &
+ &                     start=(/ itau /),count=(/ 1 /))
+  iret = NF90_PUT_VAR (dump_id,time_id,(/ REAL(itau)*dt_force /), &
+ &                     start=(/ itau /),count=(/ 1 /))
+!-
+! 2D variables: pas de dimension verticale
+!-
+  IF (gathered) THEN
+    ndim = 2
+    corner(1:2) = (/ 1, itau /)
+    edges(1:2) = (/ nbindex, 1 /)
+  ELSE
+    ndim = 3
+    corner(1:3) = (/ 1, 1, itau /)
+    edges(1:3) = (/ iim, jjm, 1 /)
+  ENDIF
+!-
+  CALL gather_weather (iim*jjm,nbindex,kindex,swdown, var_gather)
+  iret = NF90_PUT_VAR (dump_id,soldownid, var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,rainf,  var_gather)
+  iret = NF90_PUT_VAR (dump_id,rainfid,   var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,snowf,  var_gather)
+  iret = NF90_PUT_VAR (dump_id,snowfid,   var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,pb,     var_gather)
+  iret = NF90_PUT_VAR (dump_id,psolid,    var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,lwdown, var_gather)
+  iret = NF90_PUT_VAR (dump_id,lwradid,   var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+!-
+! 3D variables
+!-
+  IF (gathered) THEN
+    ndim = 3
+    corner(1:3) = (/ 1, 1, itau /)
+    edges(1:3) = (/ nbindex, 1, 1 /)
+  ELSE
+    ndim = 4
+    corner(1:4) = (/ 1, 1, 1, itau /)
+    edges(1:4) = (/ iim, jjm, 1, 1 /)
+  ENDIF
+!-
+  CALL gather_weather (iim*jjm,nbindex,kindex,u,    var_gather)
+  iret = NF90_PUT_VAR (dump_id,uid,    var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,v,    var_gather)
+  iret = NF90_PUT_VAR (dump_id,vid,    var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,tair, var_gather)
+  iret = NF90_PUT_VAR (dump_id,tairid, var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+  CALL gather_weather (iim*jjm,nbindex,kindex,qair, var_gather)
+  iret = NF90_PUT_VAR (dump_id,qairid, var_gather, &
+ &         start=corner(1:ndim), count=edges(1:ndim))
+!-
+  IF (lrstwrite) THEN
+    iret = NF90_CLOSE (dump_id)
+  ENDIF
+!---------------------------
+END SUBROUTINE weathgen_dump
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gather_weather
+!!
+!>\BRIEF        This subroutine determines which points are not in the computational domain and
+!! creates a mask for these points. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::var_out
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE gather_weather (iimjjm, nbindex, kindex, var_in, var_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                     :: iimjjm,nbindex
+  INTEGER,DIMENSION(iimjjm),INTENT(IN)   :: kindex
+  REAL,DIMENSION(iimjjm),INTENT(IN)      :: var_in
+
+  !! 0.2 Output variables  
+
+  REAL,DIMENSION(iimjjm),INTENT(OUT)     :: var_out
+
+  !! 0.4 Local variables
+
+  INTEGER                                :: i
+  LOGICAL,SAVE                           :: firstcall = .TRUE.
+  INTEGER,SAVE                           :: nb_outside
+  INTEGER,ALLOCATABLE,SAVE,DIMENSION(:)  :: outside
+
+!_ ================================================================================================================================
+
+  IF (firstcall) THEN
+!---
+!-- determine which points are not in the computational domain and
+!-- create a mask for these points
+!---
+    firstcall = .FALSE.
+  
+    ALLOC_ERR=-1
+    ALLOCATE(outside(iimjjm), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of outside : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    outside(:) = zero
+    nb_outside = 0
+    DO i=1,iimjjm
+      IF ( ALL( kindex(:) /= i ) ) THEN
+        nb_outside = nb_outside+1
+        outside(nb_outside) = i
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+  IF ( gathered ) THEN
+    DO i=1,nbindex
+      var_out(i) = var_in(kindex(i))
+    ENDDO
+  ELSE
+    var_out(:) = var_in(:)
+    DO i=1,nb_outside
+      var_out(outside(i)) = undef_sechiba
+    ENDDO
+  ENDIF
+!--------------------
+END SUBROUTINE gather_weather
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : shift_shield
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::champ
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE shift_field (im,jm,i_cut,champ)
+!---------------------------------------------------------------------
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)                  :: im,jm,i_cut
+
+  !! 0.3 Modified variables
+
+  REAL,DIMENSION(im,jm),INTENT(INOUT) :: champ
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(im,jm)               :: champ_temp
+
+!_ ================================================================================================================================
+
+  IF ( (i_cut >= 1).AND.(i_cut <= im) ) THEN
+    champ_temp(1:im-i_cut-1,:) = champ(i_cut:im,:)
+    champ_temp(im-i_cut:im,:)  = champ(1:i_cut+1,:)
+    champ(:,:) = champ_temp(:,:)
+  ENDIF
+!-------------------------
+END SUBROUTINE shift_field
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_domain_size
+!!
+!>\BRIEF        This subroutine determines the size of the domain.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::iim, ::jjm, ::limit_west, ::limit_east, ::limit_north, ::limit_south
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_domain_size &
+& (limit_west,limit_east,limit_north,limit_south, &
+&  zonal_res,merid_res,iim,jjm)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN)     :: zonal_res,merid_res
+
+  !! 0.2 Output variables 
+
+  INTEGER,INTENT(OUT) :: iim,jjm
+
+  !! 0.3 Modified variables
+
+  REAL,INTENT(INOUT)  :: limit_west,limit_east,limit_north,limit_south
+
+!_ ================================================================================================================================
+
+  IF (limit_west > limit_east)  limit_east = limit_east+360.
+!-
+  IF (    (limit_west >= limit_east) &
+ &    .OR.(limit_east > 360.) &
+ &    .OR.(limit_west < -180.) &
+ &    .OR.(limit_east-limit_west > 360.) ) THEN
+    WRITE(numout,*) 'PROBLEME longitudes.'
+    WRITE(numout,*) 'Limites Ouest, Est: ',limit_west,limit_east
+    STOP
+  ENDIF
+!-
+  IF (    (limit_south < -90.) &
+ &    .OR.(limit_north > 90.) &
+ &    .OR.(limit_south >= limit_north ) ) THEN
+    WRITE(numout,*) 'PROBLEME latitudes.'
+    WRITE(numout,*) 'Limites Nord, Sud: ',limit_north,limit_south
+    STOP
+  ENDIF
+!-
+  IF (    (zonal_res <= 0. ) &
+ &    .OR.(zonal_res > limit_east-limit_west) ) THEN
+    WRITE(numout,*) 'PROBLEME resolution zonale.'
+    WRITE(numout,*) 'Limites Ouest, Est, Resolution: ', &
+ &             limit_west,limit_east,zonal_res
+    STOP
+  ENDIF
+!-
+  IF (    (merid_res <= 0.) &
+ &    .OR.(merid_res > limit_north-limit_south) ) THEN
+    WRITE(numout,*) 'PROBLEME resolution meridionale.'
+    WRITE(numout,*) 'Limites Nord, Sud, Resolution: ', &
+ &             limit_north,limit_south,merid_res
+    STOP
+  ENDIF
+!-
+  iim = NINT(MAX((limit_east-limit_west)/zonal_res,1.))
+  jjm = NINT(MAX((limit_north-limit_south)/merid_res,1.))
+!-
+  WRITE(numout,*) 'Domain size: iim, jjm = ', iim, jjm
+!----------------------------------
+END SUBROUTINE weathgen_domain_size
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! FUNCTION     : tsat1 
+!!
+!>\BRIEF         This function computes the saturated temperature for vapor. 
+!!
+!! DESCRIPTION :  functions tsatl,tsati are used below so that Lowe's
+!!                polyomial for liquid is used if t gt 273.16, or for ice if
+!!                t lt 273.16. also impose range of validity for Lowe's polys.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : tsat
+!!
+!! REFERENCE(S) : 
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+FUNCTION tsatl (t) RESULT (tsat)
+
+  !! 0. Variables and parameters declaration
+  
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN) :: t
+
+  !! 0.2 Result
+  REAL            :: tsat
+
+!_ ================================================================================================================================
+
+  tsat = MIN(100.,MAX(t-zero_t,zero))
+!-----------------
+END FUNCTION tsatl
+!-
+!===
+!-
+!! ================================================================================================================================
+!! FUNCTION     : tsati 
+!!
+!>\BRIEF         This function computes the saturated temperature for ice. 
+!!
+!! DESCRIPTION :  functions tsatl,tsati are used below so that Lowe's
+!!                polyomial for liquid is used if t gt 273.16, or for ice if
+!!                t lt 273.16. also impose range of validity for Lowe's polys.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : tsat
+!!
+!! REFERENCE(S) : 
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+FUNCTION tsati (t) RESULT (tsat)
+
+  !! 0. Variables and parameters declaration
+  
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN) :: t
+
+  !! 0.2 Result
+  REAL            :: tsat
+
+!_ ================================================================================================================================
+
+  tsat = MAX(-60.,MIN(t-zero_t,zero))
+
+!-----------------
+END FUNCTION tsati
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! FUNCTION     : esat
+!!
+!>\BRIEF         This function computes specific humidity with the polynomials of Lowe.
+!!
+!! DESCRIPTION : The function esat is svp in n/m**2, with t in deg k.
+!!               (100 * lowe's poly since 1 mb = 100 n/m**2.). \n
+!!               Polynomials for svp(t), d(svp)/dt over water and ice 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : esatout
+!!
+!! REFERENCE(S) : 
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+FUNCTION esat (t) RESULT (esatout)
+
+  !! 0. Variables and parameters declaration
+
+  REAL,PARAMETER :: &                                                    !! polynomials for svp(t), d(svp)/dt over water and ice are from
+ & asat0 = 6.1078000,    asat1 = 4.4365185e-1, asat2 = 1.4289458e-2, &   !! lowe(1977),jam,16,101-103.
+ & asat3 = 2.6506485e-4, asat4 = 3.0312404e-6, asat5 = 2.0340809e-8, &
+ & asat6 = 6.1368209e-11, &
+ & bsat0 = 6.1091780,    bsat1 = 5.0346990e-1, bsat2 = 1.8860134e-2, &
+ & bsat3 = 4.1762237e-4, bsat4 = 5.8247203e-6, bsat5 = 4.8388032e-8, &
+ & bsat6 = 1.8388269e-10
+
+  !! 0.1 Input variables
+
+  REAL,INTENT(IN) :: t
+
+  !! 0.2 Result
+
+  REAL             :: esatout
+
+  !! 0.4 Local variables
+
+  REAL             :: x
+
+!_ ================================================================================================================================
+
+  IF (t >= zero_t) THEN
+    x = asat0
+  ELSE
+    x = bsat0
+  ENDIF
+!-
+  esatout = 100.* &
+    ( x &
+     +tsatl(t)*(asat1+tsatl(t)*(asat2+tsatl(t)*(asat3 &
+     +tsatl(t)*(asat4+tsatl(t)*(asat5+tsatl(t)* asat6))))) &
+     +tsati(t)*(bsat1+tsati(t)*(bsat2+tsati(t)*(bsat3 &
+     +tsati(t)*(bsat4+tsati(t)*(bsat5+tsati(t)* bsat6)))))  )
+!----------------
+END FUNCTION esat
+!-
+!===
+!-
+! ================================================================================================================================
+!! FUNCTION     : qsat
+!!
+!>\BRIEF         This function computes the saturation specific humidity. 
+!!
+!! DESCRIPTION :  statement function qsat is saturation specific humidity,
+!! with svp e and ambient pressure p in n/m**2. impose an upper
+!! limit of 1 to avoid spurious values for very high svp
+!! and/or small p
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : qsatout
+!!
+!! REFERENCE(S) : 
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+FUNCTION qsat (e,p) RESULT (qsatout)
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  REAL, INTENT(IN) :: e,p
+
+  !! 0.2 Result
+  REAL             :: qsatout
+
+!_ ================================================================================================================================
+
+  qsatout = 0.622*e/MAX(p-(1.0-0.622)*e,0.622*e)
+!----------------
+END FUNCTION qsat
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_qsat
+!!
+!>\BRIEF        This subroutine calculates the saturation vapor pressure with the polynomials of Lowe. 
+!!
+!! DESCRIPTION  : Vectorized version of functions esat and qsat.
+!!                statement function esat is svp in n/m**2, with t in deg K.\n
+!!               (100 * lowe's poly since 1 mb = 100 n/m**2.)\n
+!!               Polynomials for svp(t), d(svp)/dt over water 
+!!               and ice are from Lowe(1977),jam,16,101-103 \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::qsat
+!!
+!! REFERENCE(S) :
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation 
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_qsat (npoi,t,p,qsat)
+
+
+  !! 0. Variables and parameters declaration
+
+ !-
+ ! polynomials for svp(t), d(svp)/dt over water and ice
+ ! are from lowe(1977),ja
+  REAL,PARAMETER :: &
+ & asat0 = 6.1078000,    asat1 = 4.4365185e-1, asat2 = 1.4289458e-2, &   !! polynomials for svp(t), d(svp)/dt over water and ice
+ & asat3 = 2.6506485e-4, asat4 = 3.0312404e-6, asat5 = 2.0340809e-8, &
+ & asat6 = 6.1368209e-11, &
+ & bsat0 = 6.1091780,    bsat1 = 5.0346990e-1, bsat2 = 1.8860134e-2, &
+ & bsat3 = 4.1762237e-4, bsat4 = 5.8247203e-6, bsat5 = 4.8388032e-8, &
+ & bsat6 = 1.8388269e-10
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN)              :: npoi
+  REAL,DIMENSION(npoi),INTENT(IN) :: t,p
+
+  !! 0.2 Output variables 
+
+  REAL,DIMENSION(npoi),INTENT(OUT):: qsat
+
+  !! 0.4 Local variables
+
+  REAL,DIMENSION(npoi) :: x, tl, ti, e
+
+!_ ================================================================================================================================
+
+  WHERE (t(:) > zero_t)
+    x(:) = asat0
+  ELSEWHERE
+    x(:) = bsat0
+  ENDWHERE
+!-
+  tl(:) = MIN(100.,MAX(t(:)-zero_t,zero))
+  ti(:) = MAX(-60.,MIN(t(:)-zero_t,zero))
+!-
+  e(:) =  100.* &
+    ( x(:) &
+     +tl(:)*(asat1+tl(:)*(asat2+tl(:)*(asat3 &
+     +tl(:)*(asat4+tl(:)*(asat5+tl(:)* asat6))))) &
+     +ti(:)*(bsat1+ti(:)*(bsat2+ti(:)*(bsat3 &
+     +ti(:)*(bsat4+ti(:)*(bsat5+ti(:)* bsat6)))))  )
+!-
+  qsat(:) = 0.622*e(:)/MAX(p(:)-(1.0-0.622)*e(:),0.622*e(:))
+!---------------------------
+END SUBROUTINE weathgen_qsat
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : weathgen_qsat_2d
+!!
+!>\BRIEF        This subroutine calculates the saturation vapor pressure with the polynomials of Lowe. 
+!!
+!! DESCRIPTION  : Vectorized version of functions esat and qsat.
+!!                statement function esat is svp in n/m**2, with t in deg K.\n
+!!               (100 * lowe's poly since 1 mb = 100 n/m**2.)\n
+!!               Polynomials for svp(t), d(svp)/dt over water 
+!!               and ice are from Lowe(1977),jam,16,101-103 \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::qsat
+!!
+!! REFERENCE(S) :
+!! - Lowe PR, 1977, An Approximating Polynomial for the Computation of Saturation 
+!! Vapor Pressure, Journal of Applied Meteorology.16,101-103.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE weathgen_qsat_2d (iim,jjm,t,p,qsat)
+
+  !! 0. Parameters and variable declaration
+
+  !! 0.1 Input variables
+
+  INTEGER, INTENT(IN) :: iim
+  INTEGER, INTENT(IN) :: jjm
+  REAL,DIMENSION(iim,jjm),INTENT(IN)  :: t,p
+
+   !! 0.2 Output variables
+   REAL,DIMENSION(iim,jjm),INTENT(OUT) :: qsat
+
+   !! 0.4 Local variables
+
+   REAL,DIMENSION(iim,jjm) :: x, tl, ti, e
+
+  REAL,PARAMETER :: &
+ & asat0 = 6.1078000,    asat1 = 4.4365185e-1, asat2 = 1.4289458e-2, &
+ & asat3 = 2.6506485e-4, asat4 = 3.0312404e-6, asat5 = 2.0340809e-8, &
+ & asat6 = 6.1368209e-11, &
+ & bsat0 = 6.1091780,    bsat1 = 5.0346990e-1, bsat2 = 1.8860134e-2, &
+ & bsat3 = 4.1762237e-4, bsat4 = 5.8247203e-6, bsat5 = 4.8388032e-8, &
+ & bsat6 = 1.8388269e-10
+
+!_ ================================================================================================================================
+
+  WHERE (t(:,:) > zero_t)
+    x(:,:) = asat0
+  ELSEWHERE
+    x(:,:) = bsat0
+  ENDWHERE
+!-
+  tl(:,:) = MIN(100.,MAX(t(:,:)-zero_t,0.))
+  ti(:,:) = MAX(-60.,MIN(t(:,:)-zero_t,0.))
+!-
+  e(:,:) =  100.* &
+    ( x(:,:) &
+     +tl(:,:)*(asat1+tl(:,:)*(asat2+tl(:,:)*(asat3 &
+     +tl(:,:)*(asat4+tl(:,:)*(asat5+tl(:,:)* asat6))))) &
+     +ti(:,:)*(bsat1+ti(:,:)*(bsat2+ti(:,:)*(bsat3 &
+     +ti(:,:)*(bsat4+ti(:,:)*(bsat5+ti(:,:)* bsat6)))))  )
+!-
+  qsat(:,:) = 0.622*e(:,:)/MAX(p(:,:)-(1.0-0.622)*e(:,:),0.622*e(:,:))
+!---------------------------
+END SUBROUTINE weathgen_qsat_2d
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : mask_c_o 
+!!
+!>\BRIEF        This subroutine computes a field which indicated if the point is terrestrial or oceanic.
+!!
+!! DESCRIPTION  : From a mask field, we make an indicator mask Earth/ocean. Earth : 1 ; ocean : 0.
+!!
+!! RECENT CHANGE(S): z.x.li,01/04/1994 : creation of the subroutine 
+!!
+!! MAIN OUTPUT VARIABLE(S): ::mask, ::ncorr, ::icorr
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE mask_c_o &
+& (imdep, jmdep, xdata, ydata, mask_in, fcrit, &
+&  imar, jmar, zonal_res, merid_res, n_agg, x, y, mask, &
+&  ncorr, icorr, jcorr)
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER :: imdep,jmdep
+  REAL :: xdata(imdep),ydata(jmdep)
+  REAL :: mask_in(imdep,jmdep)
+  REAL :: fcrit
+  INTEGER :: imar,jmar
+  REAL :: zonal_res,merid_res
+  INTEGER :: n_agg
+  REAL :: x(imar),y(jmar)
+
+  !! 0.2 Output variables 
+
+  REAL, INTENT(OUT) :: mask(imar,jmar)
+  INTEGER :: ncorr(imar,jmar)
+  INTEGER,DIMENSION(imar,jmar,n_agg) :: icorr,jcorr
+
+  !! 0.4 Local variables 
+
+  INTEGER i, j, ii, jj
+  REAL a(imar),b(imar),c(jmar),d(jmar)
+  INTEGER num_tot(imar,jmar), num_oce(imar,jmar)
+  REAL,ALLOCATABLE :: distans(:)
+  INTEGER ij_proche(1),i_proche,j_proche
+!-
+  INTEGER,DIMENSION(imar,jmar) :: ncorr_oce , ncorr_land
+  INTEGER,DIMENSION(imar,jmar,n_agg) :: &
+ &  icorr_oce, jcorr_oce , icorr_land, jcorr_land
+!-
+  INTEGER imdepp
+  REAL,ALLOCATABLE :: xdatap(:)
+  REAL,ALLOCATABLE :: mask_inp(:,:)
+  LOGICAL :: extend
+
+!_ ================================================================================================================================
+
+  ncorr(:,:) = 0
+  icorr(:,:,:) = -1; jcorr(:,:,:) = -1
+  ncorr_land(:,:) = 0
+  icorr_land(:,:,:) = -1; jcorr_land(:,:,:) = -1
+  ncorr_oce(:,:) = 0
+  icorr_oce(:,:,:) = -1; jcorr_oce(:,:,:) = -1
+! do we have to extend the domain (-x...-x+360)?
+  IF ( xdata(1)+360.-xdata(imdep) > 0.01 ) THEN
+    extend = .TRUE.
+    imdepp = imdep+1
+  ELSE
+    extend = .FALSE.
+    imdepp = imdep
+  ENDIF
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(xdatap(imdepp), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of xdatap : ",ALLOC_ERR
+    STOP 
+  ENDIF
+
+  ALLOC_ERR=-1
+  ALLOCATE(mask_inp(imdepp,jmdep), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of mask_inp : ",ALLOC_ERR
+    STOP 
+  ENDIF
+!-
+  xdatap(1:imdep) = xdata(1:imdep)
+  mask_inp(1:imdep,:) = mask_in(1:imdep,:)
+!-
+  IF (extend) THEN
+    xdatap(imdepp) = xdatap(1)+360.
+    mask_inp(imdepp,:) = mask_inp(1,:)
+  ENDIF
+!-
+
+  ALLOC_ERR=-1
+  ALLOCATE(distans(imdepp*jmdep), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+    WRITE(numout,*) "ERROR IN ALLOCATION of distans : ",ALLOC_ERR
+    STOP 
+  ENDIF
+! Definition des limites des boites de la grille d'arrivee.
+  IF (imar > 1) THEN
+    a(1) = x(1)-(x(2)-x(1))/2.0
+    b(1) = (x(1)+x(2))/2.0
+    DO i=2,imar-1
+      a(i) = b(i-1)
+      b(i) = (x(i)+x(i+1))/2.0
+    ENDDO
+    a(imar) = b(imar-1)
+    b(imar) = x(imar)+(x(imar)-x(imar-1))/2.0
+  ELSE
+    a(1) = x(1)-zonal_res/2.
+    b(1) = x(1)+zonal_res/2.
+  ENDIF
+!-
+  IF (jmar > 1) THEN
+    c(1) = y(1)-(y(2)-y(1))/2.0
+    d(1) = (y(1)+y(2))/2.0
+    DO j=2,jmar-1
+      c(j) = d(j-1)
+      d(j) = (y(j)+y(j+1))/2.0
+    ENDDO
+    c(jmar) = d(jmar-1)
+    d(jmar) = y(jmar)+(y(jmar)-y(jmar-1))/2.0
+  ELSE
+    c(1) = y(1)-merid_res/2.
+    d(1) = y(1)+merid_res/2.
+  ENDIF
+!-
+  num_oce(1:imar,1:jmar) = 0
+  num_tot(1:imar,1:jmar) = 0
+!-
+!  .....  Modif  P. Le Van ( 23/08/95 )  ....
+!-
+  DO ii=1,imar
+    DO jj=1,jmar
+      DO i=1,imdepp
+        IF (    (     (xdatap(i)-a(ii) >= 1.e-5) &
+ &               .AND.(xdatap(i)-b(ii) <= 1.e-5) ) &
+ &          .OR.(     (xdatap(i)-a(ii) <= 1.e-5) &
+ &               .AND.(xdatap(i)-b(ii) >= 1.e-5) ) ) THEN
+          DO j=1,jmdep
+            IF (    (     (ydata(j)-c(jj) >= 1.e-5) &
+ &                   .AND.(ydata(j)-d(jj) <= 1.e-5) ) &
+ &              .OR.(     (ydata(j)-c(jj) <= 1.e-5) &
+ &                   .AND.(ydata(j)-d(jj) >= 1.e-5) ) ) THEN
+              num_tot(ii,jj) = num_tot(ii,jj)+1
+              IF (mask_inp(i,j) < 0.5) THEN
+                num_oce(ii,jj) = num_oce(ii,jj)+1
+!-------------- on a trouve un point oceanique. On le memorise.
+                ncorr_oce(ii,jj) = ncorr_oce(ii,jj)+1
+                IF ((i == imdepp).AND.extend) THEN
+                  icorr_oce(ii,jj,ncorr_oce(ii,jj)) = 1
+                ELSE
+                  icorr_oce(ii,jj,ncorr_oce(ii,jj)) = i
+                ENDIF
+                jcorr_oce(ii,jj,ncorr_oce(ii,jj)) = j
+              ELSE
+!-------------- on a trouve un point continental. On le memorise.
+                ncorr_land(ii,jj) = ncorr_land(ii,jj)+1
+                IF ((i == imdepp).AND.extend) THEN
+                  icorr_land(ii,jj,ncorr_land(ii,jj)) = 1
+                ELSE
+                  icorr_land(ii,jj,ncorr_land(ii,jj)) = i
+                ENDIF
+                jcorr_land(ii,jj,ncorr_land(ii,jj)) = j
+              ENDIF
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  DO i=1,imar
+    DO j=1,jmar
+      IF (num_tot(i,j) > 0) THEN
+        IF (    (     (num_oce(i,j) == 0) &
+ &               .AND.(num_tot(i,j) > 0) ) &
+ &          .OR.(     (num_oce(i,j) > 0) &
+ &               .AND.(   REAL(num_oce(i,j)) &
+ &                     <= REAL(num_tot(i,j))*(1.-fcrit) ) ) ) THEN
+          mask(i,j) = un
+          ncorr(i,j) = ncorr_land(i,j)
+          icorr(i,j,:) = icorr_land(i,j,:)
+          jcorr(i,j,:) = jcorr_land(i,j,:)
+        ELSE
+          mask(i,j) = zero
+          ncorr(i,j) = ncorr_oce(i,j)
+          icorr(i,j,:) = icorr_oce(i,j,:)
+          jcorr(i,j,:) = jcorr_oce(i,j,:)
+        ENDIF
+      ELSE
+        CALL dist_sphe(x(i),y(j),xdatap,ydata,imdepp,jmdep,distans)
+        ij_proche(:) = MINLOC(distans)
+        j_proche = (ij_proche(1)-1)/imdepp+1
+        i_proche = ij_proche(1)-(j_proche-1)*imdepp
+        mask(i,j) = mask_inp(i_proche,j_proche)
+        IF ( (i_proche == imdepp).AND.extend)  i_proche=1
+        ncorr(i,j) = 1
+        icorr(i,j,1) = i_proche
+        jcorr(i,j,1) = j_proche
+      ENDIF
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE mask_c_o
+!-
+!===
+!-
+!! ================================================================================================================================
+!! SUBROUTINE   : dist_sphe
+!!
+!>\BRIEF        This subroutine computes the minimum distance between two points on Earth
+!! according the great circle. \n
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): Laurent Li, 30/12/1996 : creation of this subroutine
+!!
+!! MAIN OUTPUT VARIABLE(S): ::distance
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE dist_sphe (rf_lon,rf_lat,rlon,rlat,im,jm,distance)
+
+  !! 0. Variables and parameters declaration
+
+  !! 0.1 Input variables
+
+  INTEGER :: im, jm    !! dimensions
+  REAL    :: rf_lon       !! longitude of the referenced point (degrees)
+  REAL    :: rf_lat       !! latitude of the referenced point (degrees)
+  REAL    :: rlon(im), rlat(jm) !! longitude and latitude of points
+
+  !! 0.2 Output variables
+
+  REAL :: distance(im,jm) !! distances in meters (m)
+
+  !! 0.4 Local variables
+
+  REAL :: rlon1, rlat1
+  REAL :: rlon2, rlat2
+  REAL :: dist
+  REAL :: pa, pb, p
+  INTEGER :: i,j
+
+!_ ================================================================================================================================
+
+  DO j=1,jm
+    DO i=1,im
+      rlon1=rf_lon
+      rlat1=rf_lat
+      rlon2=rlon(i)
+      rlat2=rlat(j)
+      pa = pi/2.0-rlat1*pir ! dist. entre pole n et point a
+      pb = pi/2.0-rlat2*pir ! dist. entre pole n et point b
+!-----
+      p = (rlon1-rlon2)*pir ! angle entre a et b (leurs meridiens)
+!-----
+      dist = ACOS( COS(pa)*COS(pb)+SIN(pa)*SIN(pb)*COS(p))
+      dist = R_Earth*dist      
+      distance(i,j) = dist
+    ENDDO
+  ENDDO
+!-----------------------
+END SUBROUTINE dist_sphe
+!-
+!===
+!-
+
+!! ================================================================================================================================
+!! SUBROUTINE   : permute
+!!
+!>\BRIEF         This subroutine initializes an array of size n by random integers between 1 and n.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::ordre
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE permute (n,ordre)
+!---------------------------------------------------------------------
+
+  !! 0. Variables and parameters declaration 
+
+  !! 0.1 Input variables
+
+  INTEGER,INTENT(IN) :: n   !! size of the array
+
+  !! 0.2 Output variables 
+
+  INTEGER,DIMENSION(n),INTENT(OUT) :: ordre
+
+  !! 0.4 Local variables
+
+  INTEGER,DIMENSION(n) :: restant
+  INTEGER :: ipique, i, n_rest
+  REAL    :: rndnum
+
+!_ ================================================================================================================================
+
+  n_rest = n
+  restant(:) = (/ (i, i=1,n) /)
+!-
+  DO i=1,n
+    CALL random_number (rndnum)
+    ipique = INT(rndnum*n_rest)+1
+    ordre(i) = restant(ipique)
+    restant(ipique:n_rest-1) = restant(ipique+1:n_rest)
+    n_rest = n_rest-1
+  ENDDO
+!---------------------
+END SUBROUTINE permute
+!-
+!===
+!-----------------
+END MODULE weather
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/AA_make	(revision 5166)
@@ -0,0 +1,69 @@
+#-
+#- $Id$
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec  SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+MODS1 = grid.f90           \
+        solar.f90          \
+	interpol_help.f90  \
+	gauss_jordan_method.f90  
+
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libparallel
+	$(M_K) libparameters
+	$(M_K) m_all
+	@echo orglob is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+libparameters:
+	(cd ../src_parameters; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o) : %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+
+config : 
+	$(BINDIR)/Fparser -name ORGLOB $(MODS1)
+	echo 'Configuration of ORGLOB done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(grid.o): \
+  $(PARAM_LIB)(constantes.o)
+
+$(MODEL_LIB)(interpol_help.o): \
+  $(PARAM_LIB)(constantes.o)
+
+$(MODEL_LIB)(gauss_jordan_method.o): \
+  $(PARAM_LIB)(constantes.o)
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/AA_make.ldef	(revision 5166)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a ORGLOB
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/liborglob.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxorglob.a
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/gauss_jordan_method.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/gauss_jordan_method.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/gauss_jordan_method.f90	(revision 5166)
@@ -0,0 +1,297 @@
+! =================================================================================================================================
+! MODULE       : matrix_resolution
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         This module solves a linear system using the Gauss-Jordan elimination method. It also calculates relative errors
+!! globally and for the passive pools.        
+!! 
+!!
+!!\n DESCRIPTION:  This module solves a linear system AX = B with the Gauss Jordan elimination method
+!!                 (chosen because the system has no particular properties). \n
+!!                 The code has originally picked up in Numerical recipes in Fortran 90. \n
+!!                 We simplified the code in our case because we solve a basic (7,7) matrix for each point and each pft
+!!                 (so we have npts*nvm*(7,7) systems to solve each time we call this routine). \n
+!!                 We also calculate relative for biomass and passive carbon pools in order to test the threshold error. \n
+!!
+!! RECENT CHANGE(S): Didier Solyga - add subroutine for calculating relative error for passive pool.
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision:  $
+!! \n
+!_ ================================================================================================================================
+
+MODULE matrix_resolution
+
+  ! modules used 
+
+  USE ioipsl ! for precision
+  USE constantes
+
+  IMPLICIT NONE
+
+  CONTAINS
+    
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gauss-jordan_method 
+!!
+!>\BRIEF          This subroutine resolves a linear system by the Gauss-Jordan method.
+!! (inversion of the system - complexity O(n^3)) .
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): vector_b contains the solution of the system.
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+    SUBROUTINE gauss_jordan_method(n,matrix_a,vector_b)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration    
+
+      !! 0.1 Input variables 
+ 
+      INTEGER(i_std), INTENT(in) :: n  !! size of the system (1-N, unitless)
+
+      !! 0.3 Modified variables
+
+      REAL(r_std), DIMENSION(n,n), INTENT(inout) :: matrix_a   !! Matrix A of the linear system A.X = B
+      REAL(r_std), DIMENSION(n), INTENT(inout)   :: vector_b   !! Vector B in the linear system A.X = B
+      
+      !! 0.4 Local Variables
+
+      INTEGER(r_std) :: i,col,row,j,k,ii,jj        !! index (uniltess)
+      INTEGER(i_std), DIMENSION(n) :: index_pivot  !! vector containing the pivot index
+      INTEGER(i_std), DIMENSION(n) :: index_col    !! vector containing the columns index
+      INTEGER(i_std), DIMENSION(n) :: index_row    !! vector containing the rows index
+      REAL(r_std) :: pivot_max,inv_pivot,temp      !! temporary variables
+      
+!_ ================================================================================================================================
+      
+      !! Initialization
+      index_pivot(:) = 0
+      
+      !! Search the pivot (strategy of full pivoting)
+      !! We search the greatest pivot (in order to reduce errors)
+      DO i = 1,n     
+         pivot_max = 0.
+         DO  j = 1,n
+            IF(index_pivot(j) /= 1) THEN
+               DO k = 1,n
+                  IF(index_pivot(k) .EQ. 0) THEN
+                     IF(ABS(matrix_a(j,k)) .GE. pivot_max) THEN  
+                        pivot_max = ABS(matrix_a(j,k))           
+                        row = j
+                        col = k
+                     ENDIF
+                  ENDIF
+               ENDDO
+            ENDIF
+         ENDDO
+         index_pivot(col)=index_pivot(col) + 1
+
+         !! We exchange the rows and the lines if needed
+         IF(row /= col) THEN
+            DO j = 1,n
+               temp = matrix_a(row,j)
+               matrix_a(row,j) = matrix_a(col,j)
+               matrix_a(col,j) = temp
+            ENDDO
+            temp = vector_b(row)
+            vector_b(row) = vector_b(col)
+            vector_b(col) = temp
+         ENDIF
+         index_row(i) = row
+         index_col(i) = col
+         IF(matrix_a(col,col) .EQ. 0.) STOP 'the matrix A is not inversible'
+         inv_pivot = 1./matrix_a(col,col)
+         DO j = 1,n
+            matrix_a(col,j) = matrix_a(col,j) * inv_pivot 
+         ENDDO
+         vector_b(col) = vector_b(col) * inv_pivot
+         DO ii = 1,n
+            IF(ii /= col) THEN
+               temp = matrix_a(ii,col)
+               matrix_a(ii,col) = 0.
+               DO jj = 1,n
+                  matrix_a(ii,jj) = matrix_a(ii,jj) - matrix_a(col,jj)*temp
+               ENDDO
+               vector_b(ii) = vector_b(ii) - vector_b(col)*temp
+            ENDIF
+         ENDDO
+      ENDDO
+      
+      DO j = n,1,-1
+         IF(index_row(j) /= index_col(j)) THEN
+            DO i = 1,n
+               temp = matrix_a(i,index_row(j))
+               matrix_a(i,index_row(j)) = matrix_a(i,index_col(j)) 
+               matrix_a(i,index_col(j)) = temp
+          ENDDO
+       ENDIF
+    ENDDO
+    
+    
+  END SUBROUTINE gauss_jordan_method
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : error_L1_passive
+!!
+!>\BRIEF          This subroutine calculates relative errors of a vector by taking the relative error for the passive pool.
+!!
+!! DESCRIPTION  : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): flag is to true if the maximum relative error is less than a threshold chosen by the user.
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE error_L1_passive(npts,nb_veget, nb_pools, current_value, previous_value, veget_max, criterion, flag)
+  
+    IMPLICIT NONE
+
+    !! 0. Parameters and variables declaration
+    
+    !! 0.1 Input variables    
+    
+    INTEGER(i_std), INTENT(in) :: npts                                             !! Number of continental grid cells (unitless)
+    INTEGER(i_std), INTENT(in) :: nb_veget                                         !! Number of vegetation types (2-N, unitless)
+    INTEGER(i_std), INTENT(in) :: nb_pools                                         !! Number of carbon pools (unitless)
+    REAL(r_std), DIMENSION(npts,nb_veget,nb_pools), INTENT(in) :: current_value    !! Previous values of carbon pools obtained
+                                                                                   !! by matrix resolution (gC.m^{-2})
+    REAL(r_std), DIMENSION(npts,nb_veget,nb_pools), INTENT(in) :: previous_value   !! Current values of carbon pools  obtained
+                                                                                   !! by matrix resolution (gC.m^{-2})   
+    REAL(r_std), DIMENSION(npts,nb_veget), INTENT(in) :: veget_max                 !! Fraction of vegetation (0-1, uniless)
+    REAL(r_std), INTENT(in) :: criterion                                           !! Threshold for the relativ error (0-1, unitless) 
+    
+    !! 0.2 Output variables
+    
+    LOGICAL, DIMENSION(npts), INTENT(out) :: flag   !! Logical array used only inside this subroutine (true/false)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std) :: j                                      !! Index (unitless)
+    REAL(r_std), DIMENSION(npts) :: previous_passive_stock   !! Previous value of total passive carbon (gC) 
+    REAL(r_std), DIMENSION(npts) :: current_passive_stock    !! Current value of total passive carbon (gC)
+    REAL(r_std), DIMENSION(npts) :: error_global             !! Temporary arrays containing the relative error for each grid cell 
+                                                             !! (unitless)         
+    REAL(r_std), DIMENSION(npts) :: temp_diff                !! Working array storing difference values between previous_passive_stock
+                                                             !! and current_passive_stock (gC)
+
+!_ ================================================================================================================================
+
+    !! Initialize flag and error_global
+    flag(:) = .FALSE.
+    error_global(:) = zero
+
+    !! Calculation previous_passive_stock
+    previous_passive_stock(:) = zero
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z1)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z2)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z3)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z4)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z5)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z6)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z7)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z8)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z9)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z10)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       previous_passive_stock(:) = previous_passive_stock(:) + previous_value(:,j,ipassive_pool_z11)*veget_max(:,j)
+    ENDDO
+
+    !! Calculation current_passive_stock
+    current_passive_stock(:) = zero
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z1)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z2)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z3)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z4)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z5)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z6)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z7)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z8)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z9)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z10)*veget_max(:,j)
+    ENDDO
+    DO j = 1, nb_veget
+       current_passive_stock(:) = current_passive_stock(:) + current_value(:,j,ipassive_pool_z11)*veget_max(:,j)
+    ENDDO
+    
+    !! We calculate for the error for the passive pool for each pixel
+    temp_diff(:) = zero
+    temp_diff(:) =  current_passive_stock(:) - previous_passive_stock(:) 
+    WHERE ( previous_passive_stock(:) >  min_stomate )
+       error_global(:) = 100.*ABS(temp_diff(:))/previous_passive_stock(:) 
+    ELSEWHERE
+       error_global(:) = ABS(temp_diff(:))
+    ENDWHERE
+
+    !! if the criterion is reached, we can mark the point 
+    WHERE (error_global(:) <= criterion)
+       flag = .TRUE.
+    ENDWHERE
+       
+  END SUBROUTINE error_L1_passive       
+
+
+END MODULE matrix_resolution
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/grid.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/grid.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/grid.f90	(revision 5166)
@@ -0,0 +1,566 @@
+
+!! This module define variables for the grid to gathered points.
+!!
+!! @call sechiba_main
+!! @Version : $Revision$, $Date$
+!! 
+!< $HeadURL$
+!< $Date$
+!< $Author$
+!< $Revision$
+!!
+!! @author Marie-Alice Foujols, Jan Polcher and Martial Mancip
+!! 
+!!
+!f90doc MODULEgrid
+MODULE grid
+
+  USE defprec
+  USE constantes
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  !
+  ! PARAMETERS
+  ! default resolution (m)
+  REAL(r_std), PARAMETER :: default_resolution = 250000.
+  !
+  ! VARIABLES
+  !
+  ! Global map or not.
+  ! There is little change that if iim <=2 and jjm <= 2 that we have global grid.
+  ! Furthermore using the second line allows to avoid pole problems for global grids
+  LOGICAL, SAVE                                      :: global = .TRUE.
+!$OMP THREADPRIVATE(global)
+  !
+  !-
+  !- Variable to help describe the grid
+  !- once the points are gathered.
+  !-
+  !! Limits of the domain
+  REAL(r_std), SAVE                                   :: limit_west, limit_east, &
+       &                                                limit_north, limit_south
+!$OMP THREADPRIVATE(limit_west, limit_east, limit_north, limit_south)
+  !-
+  !! Geographical coordinates
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:), SAVE     :: lalo
+!$OMP THREADPRIVATE(lalo)
+  !! index  of land points
+  INTEGER, ALLOCATABLE, DIMENSION (:), SAVE          :: ilandindex,jlandindex
+!$OMP THREADPRIVATE(ilandindex, jlandindex)
+  !- 
+  !! Fraction of continents.
+  REAL(r_std), ALLOCATABLE, DIMENSION (:), SAVE       :: contfrac
+!$OMP THREADPRIVATE(contfrac)
+  !
+  ! indices of the 4 neighbours of each grid point (1=N, 2=E, 3=S, 4=W)
+  !   a zero or negative index means that this neighbour is not a land point
+  INTEGER(i_std), ALLOCATABLE, DIMENSION (:,:), SAVE :: neighbours
+!$OMP THREADPRIVATE(neighbours)
+  !
+  ! resolution at each grid point in m (1=E-W, 2=N-S)
+  ! (size in x an y of the grid)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:), SAVE     :: resolution
+!$OMP THREADPRIVATE(resolution)
+  REAL(r_std), DIMENSION(2), SAVE :: min_resol,max_resol
+!$OMP THREADPRIVATE(min_resol, max_resol)
+  REAL(r_std), ALLOCATABLE, DIMENSION (:), SAVE     :: area
+!$OMP THREADPRIVATE(area)
+  !
+  !
+  ! Get the direction of the grid
+  !
+  CHARACTER(LEN=2), DIMENSION(2), SAVE, PRIVATE      :: grid_dir
+!$OMP THREADPRIVATE(grid_dir)
+  !
+  ! Rose gives the geographical direction for the various index increments
+  ! The following corespondences exist
+  !                       WE&NS  WE&SN and so on !
+  ! rose(1) = i+0 & j-1    NN     SS
+  ! rose(2) = i+1 & j-1    NE     SE
+  ! rose(3) = i+1 & j+0    EE     EE
+  ! rose(4) = i+1 & j+1    SE     NE
+  ! rose(5) = i+0 & j+1    SS     NN
+  ! rose(6) = i-1 & j+1    SW     NW
+  ! rose(7) = i-1 & j+0    WW     WW
+  ! rose(8) = i-1 & j-1    NW     SW
+  INTEGER(i_std), DIMENSION(8), SAVE, PRIVATE        :: rose
+!$OMP THREADPRIVATE(rose)
+  !
+  ! The calendar
+  CHARACTER(LEN=20), SAVE         :: calendar_str
+!$OMP THREADPRIVATE(calendar_str)
+  !
+  ! The date
+  REAL(r_std), SAVE                     :: in_julian
+!$OMP THREADPRIVATE(in_julian)
+  ! Diff with day 0
+  REAL(r_std), SAVE                     :: julian_diff
+!$OMP THREADPRIVATE(julian_diff)
+  !
+  INTEGER(i_std), SAVE                  :: year, month, day
+!$OMP THREADPRIVATE(year, month, day)
+  REAL(r_std), SAVE                     :: sec
+!$OMP THREADPRIVATE(sec)
+  !
+  ! month_len (d)
+  INTEGER(i_std), SAVE                  :: month_len
+!$OMP THREADPRIVATE(month_len)
+  !
+  ! year length (d)
+  INTEGER(i_std), SAVE            :: year_length=0
+!$OMP THREADPRIVATE(year_length)
+  !
+  ! Ration between calendar year in days (ie 360d or 365d ...) to gregorian year length 
+  REAL(r_std), SAVE :: year_spread
+!$OMP THREADPRIVATE(year_spread)
+  !
+CONTAINS
+  !
+  !f90doc CONTAINS
+  ! 
+  !
+  SUBROUTINE init_grid ( npts )
+    !
+    ! 0 interface
+    !
+    IMPLICIT NONE
+    !
+    ! 0.1 input  !
+    
+    ! Domain size
+    INTEGER(i_std), INTENT(in)                                 :: npts !! Number of local continental points 
+    !
+    !  Create the internal coordinate table
+    !
+    IF ( (.NOT.ALLOCATED(lalo))) THEN
+       ALLOCATE(lalo(npts,2))
+       lalo(:,:) = val_exp
+    ENDIF
+    !-
+    !- Store variable to help describe the grid
+    !- once the points are gathered.
+    !-
+    IF ( (.NOT.ALLOCATED(neighbours))) THEN
+       ALLOCATE(neighbours(npts,8))
+       neighbours(:,:) = -999999
+    ENDIF
+    IF ( (.NOT.ALLOCATED(resolution))) THEN
+       ALLOCATE(resolution(npts,2))
+       resolution(:,:) = val_exp
+    ENDIF
+    IF ( (.NOT.ALLOCATED(area))) THEN
+       ALLOCATE(area(npts))
+       area(:) = val_exp
+    ENDIF
+    !
+    !- Store the fraction of the continents only once so that the user
+    !- does not change them afterwards.
+    !
+    IF ( (.NOT.ALLOCATED(contfrac))) THEN
+       ALLOCATE(contfrac(npts))
+       contfrac(:) = val_exp
+    ENDIF
+    !
+    ! Allocation of index coordinates
+    IF (.NOT. ALLOCATED(ilandindex)) THEN
+       ALLOCATE(ilandindex(npts),jlandindex(npts))
+       ilandindex(:) = -10000000
+       jlandindex(:) = -10000000
+    ENDIF
+    !
+  END SUBROUTINE init_grid
+
+  SUBROUTINE grid_stuff (npts_glo, iim, jjm, grid_lon, grid_lat, kindex)
+    !
+    ! 0 interface
+    !
+    IMPLICIT NONE
+    !
+    ! 0.1 input  !
+    
+    ! Domain size
+    INTEGER(i_std), INTENT(in)                                 :: npts_glo
+    ! Size of cartesian grid
+    INTEGER(i_std), INTENT(in)                                 :: iim, jjm
+    ! Longitudes on cartesian grid
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(in)                 :: grid_lon
+    ! Latitudes on cartesian grid
+    REAL(r_std), DIMENSION(iim,jjm), INTENT(in)                 :: grid_lat
+    ! Index of land point on 2D map (in local position)
+    INTEGER(i_std), DIMENSION(:), INTENT(in)                :: kindex    
+    !
+    ! 0.3 local
+    !
+    ! Index of land point on 2D map (in global position)
+    INTEGER, ALLOCATABLE, DIMENSION (:)                        :: index_p
+    !
+    ! which STOMATE point corresponds to the given point on the cartesian grid
+    INTEGER(i_std), DIMENSION(iim,jjm)                   :: correspondance
+    ! cosine of the latitude
+    REAL(r_std)                                           :: coslat
+    ! number of points where default resolution is used
+    INTEGER(i_std)                                       :: ndefault_lon, ndefault_lat
+    ! Indices
+    INTEGER(i_std)                                       :: i,ip,jp, imm1, imp1, imm1l, imp1l, ii
+    !
+    INTEGER(i_std), SAVE                           :: bavard=2
+!$OMP THREADPRIVATE(bavard)
+    
+    ! =========================================================================
+    
+    IF ( bavard .GE. 4 ) WRITE(numout,*) 'Entering grid_stuff'
+
+    ! default resolution
+    IF ( bavard .GT. 1 ) WRITE(numout,*) 'grid stuff: default resolution (m): ',default_resolution
+    !
+    !-
+    IF (is_root_prc) THEN
+       ! Check if we have a global map or not.
+       ! There is little change that if iim <=2 and jjm <= 2 that we have global grid.
+       ! Furthermore using the second line allows to avoid pole problems for global grids
+       IF (iim <= 2 .OR. jjm <= 2) THEN
+          global = .FALSE.
+       ELSE
+          ! We assume here that the longitude is in increasing order and in degrees.
+          IF ( grid_lon(iim,2)-grid_lon(1,2) >= 360. - (grid_lon(2,2)-grid_lon(1,2)) ) THEN
+             global = .TRUE.
+          ELSE
+             global = .FALSE.
+          ENDIF
+       ENDIF
+       !
+       ! Get the direction of the grid
+       !
+       IF ( iim > 1 ) THEN
+          IF ( grid_lon(1,1) <= grid_lon(2,1) ) THEN
+             grid_dir(1) = 'WE'
+          ELSE
+             grid_dir(1) = 'EW'
+          ENDIF
+       ELSE
+          grid_dir(1) = 'WE'
+       ENDIF
+       !
+       IF ( jjm > 1 ) THEN
+          IF ( grid_lat(1,1) >= grid_lat(1,2) ) THEN
+             grid_dir(2) = 'NS'
+          ELSE
+             grid_dir(2) = 'SN'
+          ENDIF
+       ELSE
+          grid_dir(2) = 'NS'
+       ENDIF
+       !
+       !! WRITE(numout,*) 'Longitude direction :', grid_dir(1)
+       !! WRITE(numout,*) 'Latitude  direction :', grid_dir(2)
+       !
+       ndefault_lon = 0
+       ndefault_lat = 0
+       ! initialize output
+       neighbours_g(:,:) = -1
+       resolution_g(:,:) = zero
+       min_resol(:) = 1.e6
+       max_resol(:) = moins_un
+       
+       correspondance(:,:) = -1
+       DO i = 1, npts_glo          
+          !
+          ! 1 find numbers of the latitude and longitude of each point
+          !
+          
+          ! index of latitude
+          jp = INT( (index_g(i)-1) /iim ) + 1
+          
+          ! index of longitude
+          ip = index_g(i) - ( jp-1 ) * iim
+          !
+          !correspondance(ip,jp) = kindex(i)
+          !
+          correspondance(ip,jp) = i
+
+       ENDDO
+  
+       !
+       ! Get the "wind rose" for the various orientation of the grid
+       !
+       IF ( grid_dir(1) .EQ. 'WE' .AND.  grid_dir(2) .EQ. 'NS' ) THEN
+          rose(1) = 1
+          rose(2) = 2
+          rose(3) = 3
+          rose(4) = 4
+          rose(5) = 5
+          rose(6) = 6
+          rose(7) = 7
+          rose(8) = 8
+       ELSE IF ( grid_dir(1) .EQ. 'EW' .AND.  grid_dir(2) .EQ. 'NS' ) THEN
+          rose(1) = 1
+          rose(2) = 8
+          rose(3) = 7
+          rose(4) = 6
+          rose(5) = 5
+          rose(6) = 4
+          rose(7) = 3
+          rose(8) = 2
+       ELSE IF ( grid_dir(1) .EQ. 'WE' .AND.  grid_dir(2) .EQ. 'SN' ) THEN
+          rose(1) = 5
+          rose(2) = 4
+          rose(3) = 3
+          rose(4) = 2
+          rose(5) = 1
+          rose(6) = 8
+          rose(7) = 7
+          rose(8) = 6
+       ELSE IF ( grid_dir(1) .EQ. 'EW' .AND.  grid_dir(2) .EQ. 'SN' ) THEN
+          rose(1) = 5
+          rose(2) = 6
+          rose(3) = 7
+          rose(4) = 8
+          rose(5) = 1
+          rose(6) = 2
+          rose(7) = 3
+          rose(8) = 4
+       ELSE
+          WRITE(numout,*) 'We can not be here'
+          STOP 'grid_stuff'
+       ENDIF
+
+       DO i = 1, npts_glo
+
+          ! index of latitude
+          jp = INT( (index_g(i)-1) /iim ) + 1
+          
+          ! index of longitude
+          ip = index_g(i) - ( jp-1 ) * iim
+          
+          !
+          ! 2 resolution
+          !
+          
+          !
+          ! 2.1 longitude
+          !
+          
+          ! prevent infinite resolution at the pole
+          coslat = MAX( COS( grid_lat(ip,jp) * pi/180. ), mincos )     
+          IF ( iim .GT. 1 ) THEN
+             
+             IF ( ip .EQ. 1 ) THEN
+                resolution_g(i,1) = &
+                     ABS( grid_lon(ip+1,jp) - grid_lon(ip,jp) ) * &
+                     pi/180. * R_Earth * coslat
+             ELSEIF ( ip .EQ. iim ) THEN
+                resolution_g(i,1) = &
+                     ABS( grid_lon(ip,jp) - grid_lon(ip-1,jp) ) * &
+                     pi/180. * R_Earth * coslat
+             ELSE
+                resolution_g(i,1) = &
+                     ABS( grid_lon(ip+1,jp) - grid_lon(ip-1,jp) )/2. *&
+                     pi/180. * R_Earth * coslat
+             ENDIF
+             
+          ELSE
+             
+             resolution_g(i,1) = default_resolution
+             
+             ndefault_lon = ndefault_lon + 1
+
+          ENDIF
+
+          !
+          ! 2.2 latitude
+          !
+          
+          IF ( jjm .GT. 1 ) THEN
+
+             IF ( jp .EQ. 1 ) THEN
+                resolution_g(i,2) = &
+                     ABS( grid_lat(ip,jp) - grid_lat(ip,jp+1) ) * &
+                     pi/180. * R_Earth
+             ELSEIF ( jp .EQ. jjm ) THEN
+                resolution_g(i,2) = &
+                     ABS( grid_lat(ip,jp-1) - grid_lat(ip,jp) ) * &
+                     pi/180. * R_Earth
+             ELSE
+                resolution_g(i,2) = &
+                     ABS( grid_lat(ip,jp-1) - grid_lat(ip,jp+1) )/2. *&
+                     pi/180. * R_Earth
+             ENDIF
+             
+          ELSE
+             
+             resolution_g(i,2) = default_resolution
+             
+             ndefault_lat = ndefault_lat + 1
+             
+          ENDIF
+          min_resol(1) = MIN(resolution_g(i,1),min_resol(1))
+          min_resol(2) = MIN(resolution_g(i,2),min_resol(2))
+          max_resol(1) = MAX(resolution_g(i,1),max_resol(1))
+          max_resol(2) = MAX(resolution_g(i,2),max_resol(2))
+
+          area_g(i) = resolution_g(i,1)*resolution_g(i,2)
+
+          !
+          ! 3 find neighbours 
+          !     
+          imm1 = 0
+          IF ( ip .GT. 1 ) THEN
+             imm1 = ip - 1
+          ELSEIF ( global ) THEN
+             imm1 = iim
+          ENDIF
+          
+          imp1 = 0
+          IF ( ip .LT. iim ) THEN
+             imp1 = ip + 1
+          ELSEIF ( global ) THEN
+             imp1 = 1
+          ENDIF
+          !
+          ! East and West
+          !
+          IF ( imp1 > 0 ) THEN
+             neighbours_g(i,rose(3)) = correspondance(imp1,jp)
+          ELSE
+             neighbours_g(i,rose(3)) = -1
+          ENDIF
+          IF ( imm1 > 0 ) THEN
+             neighbours_g(i,rose(7)) = correspondance(imm1,jp)
+          ELSE
+             neighbours_g(i,rose(7)) = -1
+          ENDIF
+          !
+          ! North
+          !
+          IF ( jp .GT. 1 ) THEN
+
+             neighbours_g(i,rose(1)) = correspondance(ip,jp-1)
+             IF ( imp1 > 0 ) THEN
+                neighbours_g(i,rose(2)) = correspondance(imp1,jp-1)
+             ELSE
+                neighbours_g(i,rose(2)) = -1
+             ENDIF
+             IF ( imm1 > 0 ) THEN
+                neighbours_g(i,rose(8)) = correspondance(imm1,jp-1)
+             ELSE
+                neighbours_g(i,rose(8)) = -1
+             ENDIF
+
+          ELSE
+             IF ( global ) THEN
+                
+                ! special treatment for the pole if we are really in a 2d grid
+                
+                IF ( ( iim .GT. 1 ) .AND. ( jjm .GT. 1 ) ) THEN
+                   !
+                   ii = MOD(ip+iim/2-1,iim)+1
+                   imm1l = ii - 1
+                   IF ( imm1l .LT. 1 ) imm1l = iim
+                   imp1l = ii + 1
+                   IF ( imp1l .GT. iim ) imp1l = 1
+                   !
+                   IF ( ABS( ( grid_lat(ip,jp) ) - 90. ) .LT. min_sechiba ) THEN
+                      ! the grid point sits exactly on the pole. The neighbour is situated
+                   ! at a lower latitude.
+                      neighbours_g(i,rose(1)) = correspondance( ii, jp+1 )
+                      neighbours_g(i,rose(2)) = correspondance( imm1l, jp+1 )
+                      neighbours_g(i,rose(8)) = correspondance( imp1l, jp+1 )
+                   ELSE
+                      ! look across the North Pole
+                      neighbours_g(i,rose(1)) = correspondance( ii, jp )
+                      neighbours_g(i,rose(2)) = correspondance( imm1l, jp )
+                      neighbours_g(i,rose(8)) = correspondance( imp1l, jp )
+                   ENDIF
+                ENDIF
+
+             ELSE
+
+                neighbours_g(i,rose(1)) = -1
+                neighbours_g(i,rose(2)) = -1
+                neighbours_g(i,rose(8)) = -1
+                
+             ENDIF
+
+          ENDIF
+          
+          ! South
+          IF ( jp .LT. jjm ) THEN
+
+             neighbours_g(i,rose(5)) = correspondance(ip,jp+1)
+             IF ( imp1 > 0 ) THEN
+                neighbours_g(i,rose(4)) = correspondance(imp1,jp+1)
+             ELSE
+                neighbours_g(i,rose(4)) = -1
+             ENDIF
+             IF ( imm1 > 0 ) THEN
+                neighbours_g(i,rose(6)) = correspondance(imm1,jp+1)
+             ELSE
+                neighbours_g(i,rose(6)) = -1
+             ENDIF
+
+          ELSE
+             
+             IF ( global ) THEN
+
+                ! special treatment for the pole if we are really in a 2d grid
+                
+                IF ( ( iim .GT. 1 ) .AND. ( jjm .GT. 1 ) ) THEN
+                   !
+                   ii = MOD(ip+iim/2-1,iim)+1
+                   imm1l = ii - 1
+                   IF ( imm1l .LT. 1 ) imm1l = iim
+                   imp1l = ii + 1
+                   IF ( imp1l .GT. iim ) imp1l = 1
+                   !
+                   IF ( ( ABS( grid_lat(ip,jp) ) - 90. ) .LT. min_sechiba ) THEN
+                      ! the grid point sits exactly on the pole. The neighbour is situated
+                      ! at a lower latitude.
+                      neighbours_g(i,rose(5)) = correspondance( ii, jp-1 )
+                      neighbours_g(i,rose(4)) = correspondance( imm1l, jp-1 )
+                      neighbours_g(i,rose(6)) = correspondance( imp1l, jp-1 )
+                   ELSE
+                      ! look across the South Pole
+                      neighbours_g(i,rose(5)) = correspondance( ii, jp )
+                      neighbours_g(i,rose(4)) = correspondance( imm1l, jp )
+                      neighbours_g(i,rose(6)) = correspondance( imp1l, jp )
+                   ENDIF
+                ENDIF
+
+             ELSE
+                
+                neighbours_g(i,rose(5)) = -1
+                neighbours_g(i,rose(4)) = -1
+                neighbours_g(i,rose(6)) = -1
+                
+             ENDIF
+          ENDIF
+
+       ENDDO
+
+       IF ( bavard .GT. 1 ) THEN
+          WRITE(numout,*) '  > Total number of points: ',npts_glo
+          WRITE(numout,*) '  > Using default zonal resolution at',ndefault_lon,' points.'
+          WRITE(numout,*) '  > Using default meridional resolution at',ndefault_lat,' points.'
+       ENDIF
+       !
+    ENDIF ! (root_prc)
+
+    CALL scatter(neighbours_g,neighbours)
+    CALL scatter(resolution_g,resolution)
+    CALL scatter(area_g,area)
+    CALL bcast(min_resol)
+    CALL bcast(max_resol)
+    IF ( bavard .EQ. 5 ) THEN
+       WRITE(numout,*) '  > resolution  = ',resolution
+       WRITE(numout,*) '  > rose = ',rose
+       WRITE(numout,*) '  > neighbours  = ',neighbours
+    ENDIF
+    IF ( bavard .GT. 1 ) WRITE(numout,*) 'Leaving grid_stuff'
+    
+  END SUBROUTINE grid_stuff
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+END MODULE grid
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/interpol_help.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/interpol_help.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/interpol_help.f90	(revision 5166)
@@ -0,0 +1,848 @@
+!
+! Aggregation routines. These routines allow to interpolate from the finer grid on which the 
+! surface parameter is available to the coarser one of the model.
+!
+! The routines work for the fine data on a regular lat/lon grid. This grid can come in as either
+! a rank2 array or a vector. Two procedure exist which require slightly different input fields.
+!
+!
+!< $HeadURL$
+!< $Date$
+!< $Author$
+!< $Revision$
+!
+!
+MODULE interpol_help
+
+  ! Modules used :
+
+  USE constantes
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC aggregate, aggregate_p
+  !
+  INTERFACE aggregate
+     MODULE PROCEDURE aggregate_2d, aggregate_vec
+  END INTERFACE
+  !
+  INTERFACE aggregate_p
+     MODULE PROCEDURE aggregate_2d_p, aggregate_vec_p
+  END INTERFACE
+  !
+  LOGICAL, PARAMETER                              :: check_grid=.FALSE.
+  !
+CONTAINS
+  !
+  ! This routing will get for each point of the coarse grid the
+  ! indexes of the finer grid and the area of overlap. 
+  ! This routine is designed for a fine grid which is regular in lat/lon.
+  !
+  SUBROUTINE aggregate_2d (nbpt, lalo, neighbours, resolution, contfrac, &
+       &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+       &                incmax, indinc, areaoverlap, ok)
+
+    USE grid, ONLY : global
+
+    !
+    ! INPUT
+    ! 
+    INTEGER(i_std), INTENT(in)   :: nbpt                 ! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)       :: lalo(nbpt,2)         ! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)   :: neighbours(nbpt,8)   ! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std), INTENT(in)       :: resolution(nbpt,2)   ! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)       ! Fraction of land in each grid box.
+    INTEGER(i_std), INTENT(in)   :: iml, jml             ! Size of the finer grid
+    REAL(r_std), INTENT(in)       :: lon_rel(iml, jml)    ! Longitudes for the finer grid
+    REAL(r_std), INTENT(in)       :: lat_rel(iml, jml)    ! Latitudes for the finer grid
+    INTEGER(i_std), INTENT(in)   :: mask(iml, jml)       ! Mask which retains only the significative points
+                                                         ! of the fine grid.
+    CHARACTER(LEN=*), INTENT(in) :: callsign             ! Allows to specify which variable is beeing treated
+    INTEGER(i_std), INTENT(in)    :: incmax              ! Maximum point of the fine grid we can store.
+    !
+    ! Output
+    !
+    INTEGER(i_std), INTENT(out)  :: indinc(nbpt,incmax,2)
+    REAL(r_std), INTENT(out)      :: areaoverlap(nbpt,incmax)
+    LOGICAL, OPTIONAL, INTENT(out)      :: ok            ! return code
+    !
+    ! Local Variables
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_ful, lon_ful
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: loup_rel, lolow_rel, laup_rel, lalow_rel
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: searchind
+    REAL(r_std) :: lon_up, lon_low, lat_up, lat_low
+    REAL(r_std) :: coslat, ax, ay, sgn, lonrel, lolowrel, louprel
+    INTEGER(i_std) :: fopt, fopt_max, ip, jp, ib, i, itmp, iprog, nbind
+    REAL(r_std) :: domain_minlon,domain_maxlon,domain_minlat,domain_maxlat
+    INTEGER(i_std) :: minLon(1), maxLon(1)
+
+    INTEGER                  :: ALLOC_ERR
+    LOGICAL :: err_fopt
+    err_fopt = .FALSE.
+    !
+    ! Some inital assignmens
+    !
+    areaoverlap(:,:) = moins_un
+    indinc(:,:,:) = zero
+    !
+    ALLOC_ERR=-1
+    ALLOCATE (laup_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of laup_rel : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE (loup_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of loup_rel : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE (lalow_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lalow_rel : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE (lolow_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lolow_rel : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE (lat_ful(iml+2,jml+2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lat_ful : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE (lon_ful(iml+2,jml+2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lon_ful : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE (searchind(iml*jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of searchbind : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    IF (PRESENT(ok)) ok = .TRUE.
+    !
+    !    Duplicate the border assuming we have a global grid going from west to east
+    !
+    lon_ful(2:iml+1,2:jml+1) = lon_rel(1:iml,1:jml)
+    lat_ful(2:iml+1,2:jml+1) = lat_rel(1:iml,1:jml)
+    !
+    IF ( lon_rel(iml,1) .LT. lon_ful(2,2)) THEN
+       lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)
+       lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
+    ELSE
+       lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)-360
+       lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
+    ENDIF
+
+    IF ( lon_rel(1,1) .GT. lon_ful(iml+1,2)) THEN
+       lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)
+       lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
+    ELSE
+       lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)+360
+       lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
+    ENDIF
+    !
+    sgn = lat_rel(1,1)/ABS(lat_rel(1,1))
+    lat_ful(2:iml+1,1) = sgn*180 - lat_rel(1:iml,1)
+    sgn = lat_rel(1,jml)/ABS(lat_rel(1,jml))
+    lat_ful(2:iml+1,jml+2) = sgn*180 - lat_rel(1:iml,jml)
+    lat_ful(1,1) = lat_ful(iml+1,1)
+    lat_ful(iml+2,1) = lat_ful(2,1)
+    lat_ful(1,jml+2) = lat_ful(iml+1,jml+2)
+    lat_ful(iml+2,jml+2) = lat_ful(2,jml+2)
+    !
+    ! Add the longitude lines to the top and bottom
+    !
+    lon_ful(:,1) = lon_ful(:,2) 
+    lon_ful(:,jml+2) = lon_ful(:,jml+1) 
+    !
+    !  Get the upper and lower limits of each grid box
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          loup_rel(ip,jp) =MAX(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)),&
+               & 0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
+          lolow_rel(ip,jp) =MIN(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)),&
+               & 0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
+          laup_rel(ip,jp) =MAX(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)),&
+               & 0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
+          lalow_rel(ip,jp) =MIN(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)),&
+               & 0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
+          !
+       ENDDO
+    ENDDO
+    IF (check_grid) THEN
+       WRITE(numout,*) "================================"
+       WRITE(numout,*) "interpol_aggregate_2d : "
+       WRITE(numout,*) "lalo(:,1) :",lalo(:,1)
+       WRITE(numout,*) "lalo(:,2) :",lalo(:,2)
+       WRITE(numout,*) "Map meshes : "
+       WRITE(numout,*) "lat read(1,:) :",lat_rel(1,:)
+       WRITE(numout,*) "lat_ful(1,:) :",lat_ful(1,:)
+       WRITE(numout,*) "lat_ful(2,:) :",lat_ful(2,:)
+       WRITE(numout,*) "lalow_rel(1,:) :",lalow_rel(1,:)
+       WRITE(numout,*) "laup_rel(1,:) :",laup_rel(1,:)
+       WRITE(numout,*) "================================"
+       WRITE(numout,*) "lon read(:,1) :",lon_rel(:,1)
+       WRITE(numout,*) "lon_ful(:,1) :",lon_ful(:,1)
+       WRITE(numout,*) "lon_ful(:,2) :",lon_ful(:,2)
+       WRITE(numout,*) "lolow_rel(:,1) :",lolow_rel(:,1)
+       WRITE(numout,*) "loup_rel(:,1) :",loup_rel(:,1)
+       WRITE(numout,*) "================================"
+    ENDIF
+    !
+    !
+    !  To speedup calculations we will get the limits of the domain of the 
+    !  coarse grid and select all the points of the fine grid which are potentialy
+    !  in this domain.
+    !
+    !
+    minLon = MINLOC(lalo(1:nbpt,2))
+    coslat = MAX(COS(lalo(minLon(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    domain_minlon = lalo(minLon(1),2) - resolution(minLon(1),1)/(2.0*coslat)
+    maxLon = MAXLOC(lalo(1:nbpt,2))
+    coslat = MAX(COS(lalo(maxLon(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    domain_maxlon = lalo(maxLon(1),2) + resolution(maxLon(1),1)/(2.0*coslat)
+    !
+    coslat = pi/180. * R_Earth
+    domain_minlat = MINVAL(lalo(1:nbpt,1)) - resolution(maxLon(1),2)/(2.0*coslat)
+    domain_maxlat = MAXVAL(lalo(1:nbpt,1)) + resolution(maxLon(1),2)/(2.0*coslat)
+    !
+    IF (check_grid) THEN
+       WRITE(numout,*) "indices min/max of longitude :",minLon,maxLon, &
+            & "; longitude min/max : ",lalo(minLon,1),lalo(maxLon,1)
+       WRITE(numout,*) "Domain for coarse grid :"
+       WRITE(numout,*) '(',domain_minlat,',',domain_minlon,')',&
+   &                   '(',domain_maxlat,',',domain_maxlon,')'
+       WRITE(numout,*) "================================"
+    ENDIF
+    !
+    ! we list a first approximation of all point we will need to 
+    ! scan to fill our coarse grid.
+    !
+    IF ( global ) THEN
+       ! Here we do the entire globe
+       WRITE(numout,*) 'In aggregate_p : do interpolation to global model domain'
+       nbind=0
+       DO ip=1,iml
+          DO jp=1,jml
+             IF (mask(ip,jp) == 1 ) THEN
+                nbind = nbind + 1
+                searchind(nbind,1) = ip
+                searchind(nbind,2) = jp
+             ENDIF
+          ENDDO
+       ENDDO
+       !
+    ELSE
+       ! Now we get a limited number of points
+       WRITE(numout,*) 'In aggregate_p : do interpolation to regional model domain'
+       nbind=0
+       DO ip=1,iml
+          DO jp=1,jml
+             IF ( loup_rel(ip,jp) >= domain_minlon .AND. lolow_rel(ip,jp) <= domain_maxlon .AND.&
+               &  laup_rel(ip,jp) >= domain_minlat .AND. lalow_rel(ip,jp) <= domain_maxlat ) THEN
+                IF (mask(ip,jp) == 1 ) THEN
+                   nbind = nbind + 1
+                   searchind(nbind,1) = ip
+                   searchind(nbind,2) = jp
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+    !
+    WRITE(numout,*) 'We will work with ', nbind, ' points of the fine grid'
+    !
+    WRITE(numout,*) 'Aggregate_2d : ', callsign
+#ifdef INTERPOL_ADVANCE
+    WRITE(numout,'(2a40)')'0%--------------------------------------', &
+         & '------------------------------------100%'
+#endif
+    !
+    !   Now we take each grid point and find out which values from the forcing we need to average
+    !
+    fopt_max = -1
+    DO ib =1, nbpt
+       !
+       !   Give a progress meter
+       !
+#ifdef INTERPOL_ADVANCE
+       iprog = NINT(REAL(ib,r_std)/REAL(nbpt,r_std)*79.) - NINT(REAL(ib-1,r_std)/REAL(nbpt,r_std)*79.)
+       IF ( iprog .NE. 0 ) THEN
+          WRITE(numout,'(a1,$)') 'x'
+       ENDIF
+#endif
+       !
+       !  We find the 4 limits of the grid-box. As we transform the resolution of the model
+       !  into longitudes and latitudes we do not have the problem of periodicity.
+       !  coslat is a help variable here !
+       !
+       coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+       !
+       lon_up = lalo(ib,2) + resolution(ib,1)/(2.0*coslat) 
+       lon_low =lalo(ib,2) - resolution(ib,1)/(2.0*coslat) 
+       !
+       coslat = pi/180. * R_Earth
+       !
+       lat_up =lalo(ib,1) + resolution(ib,2)/(2.0*coslat) 
+       lat_low =lalo(ib,1) - resolution(ib,2)/(2.0*coslat) 
+       !
+       !  Find the grid boxes from the data that go into the model's boxes
+       !  We still work as if we had a regular grid ! Well it needs to be localy regular so
+       !  so that the longitude at the latitude of the last found point is close to the one 
+       !  of the next point.
+       !
+       fopt = zero
+       !
+       DO i=1,nbind
+          !
+          ip = searchind(i,1)
+          jp = searchind(i,2)
+          !
+          !  Either the center of the data grid point is in the interval of the model grid or
+          !  the East and West limits of the data grid point are on either sides of the border of
+          !  the data grid.
+          !
+          !  To do that correctly we have to check if the grid box sits on the date-line.
+          !
+          IF ( lon_low < -180.0 ) THEN
+             ! -179 -> -179
+             ! 179 -> -181
+             lonrel = MOD( lon_rel(ip,jp) - 360.0, 360.0)
+             lolowrel = MOD( lolow_rel(ip,jp) - 360.0, 360.0)
+             louprel = MOD( loup_rel(ip,jp) - 360.0, 360.0)
+             !
+          ELSE IF ( lon_up > 180.0 ) THEN
+             ! -179 -> 181
+             !  179 -> 179
+             lonrel = MOD( lon_rel(ip,jp) + 360., 360.0)
+             lolowrel = MOD( lolow_rel(ip,jp) + 360., 360.0)
+             louprel = MOD( loup_rel(ip,jp) + 360., 360.0)
+          ELSE
+             lonrel = lon_rel(ip,jp)
+             lolowrel = lolow_rel(ip,jp)
+             louprel = loup_rel(ip,jp)
+          ENDIF
+          !
+          !
+          !
+          IF ( lonrel > lon_low .AND. lonrel < lon_up .OR. &
+               & lolowrel < lon_low .AND.  louprel > lon_low .OR. &
+               & lolowrel < lon_up  .AND.  louprel > lon_up ) THEN
+             !
+             ! Now that we have the longitude let us find the latitude
+             !
+             IF ( lat_rel(ip,jp) > lat_low .AND. lat_rel(ip,jp) < lat_up .OR. &
+                  & lalow_rel(ip,jp) < lat_low .AND. laup_rel(ip,jp) > lat_low .OR.&
+                  & lalow_rel(ip,jp) < lat_up .AND. laup_rel(ip,jp) > lat_up) THEN
+                   !
+                fopt = fopt + 1
+                IF ( fopt > incmax) THEN
+                   err_fopt=.TRUE.
+                   EXIT
+                ELSE
+                   !
+                   ! If we sit on the date line we need to do the same transformations as above.
+                   ! 
+                   IF ( lon_low < -180.0 ) THEN
+                      lolowrel = MOD( lolow_rel(ip,jp) - 360.0, 360.0)
+                      louprel = MOD( loup_rel(ip,jp) - 360.0, 360.0)
+                      !
+                   ELSE IF ( lon_up > 180.0 ) THEN
+                      lolowrel = MOD( lolow_rel(ip,jp) + 360., 360.0)
+                      louprel = MOD( loup_rel(ip,jp) + 360., 360.0)
+                   ELSE
+                      lolowrel = lolow_rel(ip,jp)
+                      louprel = loup_rel(ip,jp)
+                   ENDIF
+                   !
+                   ! Get the area of the fine grid in the model grid
+                   !
+                   coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )
+                   ax = (MIN(lon_up,louprel)-MAX(lon_low, lolowrel))*pi/180. * R_Earth * coslat
+                   ay = (MIN(lat_up, laup_rel(ip,jp))-MAX(lat_low,lalow_rel(ip,jp)))*pi/180. * R_Earth
+                   !
+                   areaoverlap(ib, fopt) = ax*ay
+                   indinc(ib, fopt, 1) = ip
+                   indinc(ib, fopt, 2) = jp
+                   !
+                   ! If this point was 100% within the grid then we can de-select it from our
+                   ! list as it can not be in another mesh of the coarse grid.
+                   !
+                   IF ( louprel < lon_up .AND. lolowrel > lon_low .AND. &
+                     &  laup_rel(ip,jp) < lat_up .AND. lalow_rel(ip,jp) > lat_low ) THEN
+                      searchind(i,1) = 0
+                      searchind(i,2) = 0
+                   ENDIF
+                   !
+                ENDIF
+             ENDIF       ! IF lat
+          ENDIF          ! IF lon
+       ENDDO
+
+       IF (err_fopt) THEN
+          WRITE(numout,*) 'Working on variable :', callsign
+          WRITE(numout,*) 'Reached value ', fopt,' for fopt on point', ib, lalo(ib,2), lalo(ib,1)
+          CALL ipslerr_p(2,'aggregate_2d', &
+               'Working on variable :'//callsign, &
+               'Reached incmax value for fopt.',&
+               'Please increase incmax in subroutine calling aggregate')                   
+          IF (PRESENT(ok)) THEN
+             ok = .FALSE.
+             RETURN
+          ELSE
+             STOP "aggregate_2d"
+          ENDIF
+       ENDIF
+       fopt_max = MAX ( fopt, fopt_max )
+       !
+       ! De-select the marked points
+       !
+       itmp = nbind
+       nbind = 0
+       DO i=1,itmp
+          IF ( searchind(i,1) > 0 .AND. searchind(i,2) > 0 ) THEN
+             nbind = nbind + 1
+             searchind(nbind,1) = searchind(i,1)
+             searchind(nbind,2) = searchind(i,2)
+          ENDIF
+       ENDDO
+       !
+    ENDDO
+    !
+    DO ib=1,nbpt
+       DO fopt=1,incmax
+          IF (( indinc(ib,fopt,1) == 0 .AND. indinc(ib,fopt,2) > 0) .OR.&
+               & ( indinc(ib,fopt,2) == 0 .AND. indinc(ib,fopt,1) > 0) ) THEN
+             WRITE(*,*) "aggregate_2d PROBLEM : point =",ib, fopt," Indicies = ", &
+                  & indinc(ib,fopt,1), indinc(ib,fopt,2), areaoverlap(ib,fopt)
+          ENDIF
+       ENDDO
+    ENDDO
+
+
+    WRITE(numout,*) ""
+    WRITE(numout,*) "aggregate_2D nbvmax = ",incmax, "max used = ",fopt_max
+    !
+    ! Do some memory management.
+    !
+    DEALLOCATE (laup_rel)
+    DEALLOCATE (loup_rel)
+    DEALLOCATE (lalow_rel)
+    DEALLOCATE (lolow_rel)
+    DEALLOCATE (lat_ful)
+    DEALLOCATE (lon_ful)
+    DEALLOCATE (searchind)
+    !
+    ! Close the progress meter
+    !
+    WRITE(numout,*) '    '
+    !
+  END SUBROUTINE aggregate_2d
+
+  !
+  ! This routing will get for each point of the coarse grid the
+  ! indexes of the finer grid and the area of overlap. 
+  ! This routine is designed for a fine grid which is regular in meters along lat lon axes.
+  !
+  SUBROUTINE aggregate_vec (nbpt, lalo, neighbours, resolution, contfrac, &
+       &                iml, lon_rel, lat_rel, resol_lon, resol_lat, callsign, &
+       &                incmax, indinc, areaoverlap, ok)
+    !
+    ! INPUT
+    ! 
+    INTEGER(i_std), INTENT(in)   :: nbpt                 ! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)       :: lalo(nbpt,2)         ! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)   :: neighbours(nbpt,8)   ! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std), INTENT(in)       :: resolution(nbpt,2)   ! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)       ! Fraction of land in each grid box.
+    INTEGER(i_std), INTENT(in)   :: iml                  ! Size of the finer grid
+    REAL(r_std), INTENT(in)       :: lon_rel(iml)         ! Longitudes for the finer grid
+    REAL(r_std), INTENT(in)       :: lat_rel(iml)         ! Latitudes for the finer grid
+    REAL(r_std), INTENT(in)       :: resol_lon, resol_lat ! Resolution in meters of the fine grid
+    CHARACTER(LEN=*), INTENT(in) :: callsign             ! Allows to specify which variable is beeing treated
+    INTEGER(i_std), INTENT(in)    :: incmax              ! Maximum point of the fine grid we can store.
+    !
+    ! Output
+    !
+    INTEGER(i_std), INTENT(out)  :: indinc(nbpt,incmax)
+    REAL(r_std), INTENT(out)      :: areaoverlap(nbpt,incmax)
+    LOGICAL, OPTIONAL, INTENT(out)      :: ok            ! return code
+    !
+    ! Local Variables
+    !
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: searchind
+    REAL(r_std) :: lon_up, lon_low, lat_up, lat_low
+    REAL(r_std) :: coslat, ax, ay, lonrel, lolowrel, louprel
+    REAL(r_std) :: latrel, lauprel, lalowrel
+    INTEGER(i_std), DIMENSION(nbpt) :: fopt
+    INTEGER(i_std) :: fopt_max, not_found_fopt
+    INTEGER(i_std) :: ip, ib, i, j, itmp, iprog, nbind, pp, ipp
+    REAL(r_std) :: domain_minlon,domain_maxlon,domain_minlat,domain_maxlat
+    REAL(r_std) :: minlon, minlat, mini
+    INTEGER(i_std) :: ff(1), incp
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: fine_ind
+    INTEGER(i_std) :: pos_pnt(5)
+    INTEGER                  :: ALLOC_ERR
+    !
+    LOGICAL :: err_fopt
+    err_fopt = .FALSE.
+    !
+    ! Some inital assignmens
+    !
+    areaoverlap(:,:) = moins_un
+    indinc(:,:) = zero
+    !
+    ALLOC_ERR=-1
+    ALLOCATE (searchind(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of searchbind : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    IF (PRESENT(ok)) ok = .TRUE.
+    !
+    !  To speedup calculations we will get the limits of the domain of the 
+    !  coarse grid and select all the points of the fine grid which are potentialy
+    !  in this domain.
+    !
+    !
+    ff = MINLOC(lalo(:,2))
+    coslat = MAX(COS(lalo(ff(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    domain_minlon = lalo(ff(1),2) - resolution(ff(1),1)/(2.0*coslat)
+    ff = MAXLOC(lalo(:,2))
+    coslat = MAX(COS(lalo(ff(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    domain_maxlon = lalo(ff(1),2) + resolution(ff(1),1)/(2.0*coslat)
+    !
+    coslat = pi/180. * R_Earth
+    domain_minlat = MINVAL(lalo(:,1)) - resolution(ff(1),2)/(2.0*coslat)
+    domain_maxlat = MAXVAL(lalo(:,1)) + resolution(ff(1),2)/(2.0*coslat)
+    !
+    ! Find appropriate resolution for index table
+    !
+    ff=MINLOC(resolution(:,1))
+    coslat = MAX(COS(lalo(ff(1),1) * pi/180. ), mincos )*pi/180. * R_Earth
+    minlon=resolution(ff(1),1)/(2.0*coslat)
+    ff=MINLOC(resolution(:,2))
+    coslat = pi/180. * R_Earth
+    minlat=resolution(ff(1),2)/(2.0*coslat)
+    mini=MIN(minlon, minlat)
+    !
+    ! This interpolation only works if the model grid is coarser than the data grid
+    !
+    IF (MINVAL(resolution(:,1)) < resol_lon .OR. MINVAL(resolution(:,2)) < resol_lat) THEN
+       WRITE(numout,*) " === WARNING == "
+       WRITE(numout,*) "Resolution minima of the model (lon, lat) : ", &
+            & MINVAL(resolution(:,1)), MINVAL(resolution(:,2))
+       WRITE(numout,*) "Resolution of the file to be interpolated (fine grid) : ", resol_lon, resol_lat
+       WRITE(numout,*) "This interpolation assumes that we aggregate from a fine grid to a coarser grid"
+       WRITE(numout,*) "In the data submitted it apears that the model is runing on a finer grid than the data"
+    ENDIF
+    !
+    incp = 10
+    IF (mini < 0.1) THEN
+       incp=100
+    ELSE IF (mini < 0.01) THEN
+       incp = 1000
+    ENDIF
+    !
+    ! Allocate the needed memory for fine_ind
+    !
+    ALLOC_ERR=-1
+    ALLOCATE (fine_ind(NINT(domain_minlon*incp)-2:NINT(domain_maxlon*incp)+2, &
+         & NINT(domain_minlat*incp)-2:NINT(domain_maxlat*incp)+2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "aggregate_vec : ERROR IN ALLOCATION of fine_ind : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    ! Generate a quick access table for the coarse grid
+    !
+    fine_ind(:,:) = zero
+    !
+    DO ib=1,nbpt
+       coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+       !
+       lon_up = lalo(ib,2) + resolution(ib,1)/(2.0*coslat) 
+       lon_low =lalo(ib,2) - resolution(ib,1)/(2.0*coslat) 
+       !
+       coslat = pi/180. * R_Earth
+       !
+       lat_up =lalo(ib,1) + resolution(ib,2)/(2.0*coslat) 
+       lat_low =lalo(ib,1) - resolution(ib,2)/(2.0*coslat) 
+       !
+       fine_ind(NINT(lon_low*incp):NINT(lon_up*incp),NINT(lat_low*incp):NINT(lat_up*incp))=ib
+       !
+    ENDDO
+    !
+    WRITE(numout,*) 'Domaine LON range : ', domain_minlon, domain_maxlon
+    WRITE(numout,*) 'Domaine LAT range : ', domain_minlat, domain_maxlat
+    !
+    ! we list a first approximation of all point we will need to 
+    ! scan to fill our coarse grid.
+    !
+    IF ( domain_minlon <= -179.5 .AND. domain_maxlon >= 179.5 .AND. &
+      &  domain_minlat <= -89.5  .AND. domain_maxlat >= 89.5 ) THEN
+       ! Here we do the entire globe
+       nbind=0
+       DO ip=1,iml
+          nbind = nbind + 1
+          searchind(nbind) = ip
+       ENDDO
+       !
+    ELSE
+       ! Now we get a limited number of points
+       nbind=0
+       DO ip=1,iml
+          ! Compute the limits of the meshes of the fine grid
+          coslat = MAX(COS(lat_rel(ip) * pi/180. ), mincos )*pi/180. * R_Earth
+          louprel = MIN(lon_rel(ip) + resol_lon/(2.0*coslat), 180.)
+          lolowrel = MAX(lon_rel(ip) - resol_lon/(2.0*coslat), -180.)
+          coslat = pi/180. * R_Earth
+          lauprel = MIN(lat_rel(ip) + resol_lat/(2.0*coslat), 90.)
+          lalowrel = MAX(lat_rel(ip) - resol_lat/(2.0*coslat), -90.)
+          !
+          IF ( louprel >= domain_minlon .AND. lolowrel <= domain_maxlon .AND.&
+            &  lauprel >= domain_minlat .AND. lalowrel <= domain_maxlat ) THEN
+             nbind = nbind + 1
+             searchind(nbind) = ip
+          ENDIF
+       ENDDO
+    ENDIF
+    !
+    WRITE(numout,*) 'We will work with ', nbind, ' points of the fine grid and ', nbpt, 'for the coarse grid'
+    !
+    WRITE(numout,*) 'Aggregate_vec : ', callsign
+    !
+    !   Now we take each grid point and find out which values from the forcing we need to average
+    !
+    fopt(:) = zero
+    fopt_max = -1
+    !
+    !
+    !
+    loopnbind : DO i=1,nbind
+       !
+       !
+       ip = searchind(i)
+       !
+       !  Either the center of the data grid point is in the interval of the model grid or
+       !  the East and West limits of the data grid point are on either sides of the border of
+       !  the data grid.
+       !
+       lonrel = lon_rel(ip)
+       coslat = MAX(COS(lat_rel(ip) * pi/180. ), mincos )*pi/180. * R_Earth
+       louprel = MIN(lon_rel(ip) + resol_lon/(2.0*coslat), domain_maxlon)
+       lolowrel = MAX(lon_rel(ip) - resol_lon/(2.0*coslat), domain_minlon)
+       !
+       latrel = lat_rel(ip)
+       coslat = pi/180. * R_Earth
+       lauprel = MIN(lat_rel(ip) + resol_lat/(2.0*coslat), domain_maxlat)
+       lalowrel = MAX(lat_rel(ip) - resol_lat/(2.0*coslat), domain_minlat)
+       !
+       !
+       pos_pnt(:) = zero
+       ipp = zero
+       pp = fine_ind(NINT(lonrel*incp),NINT(latrel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       pp = fine_ind(NINT(louprel*incp),NINT(lauprel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       pp = fine_ind(NINT(louprel*incp),NINT(lalowrel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       pp = fine_ind(NINT(lolowrel*incp),NINT(lauprel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       pp = fine_ind(NINT(lolowrel*incp),NINT(lalowrel*incp))
+       !
+       IF (COUNT(pos_pnt(:) == pp) == zero ) THEN 
+          pos_pnt(ipp+1) = pp
+          ipp = ipp + 1
+       ENDIF
+       !
+       !
+       IF ( ipp > zero ) THEN
+          !
+          DO pp=1,ipp
+             ib = pos_pnt(pp)
+             !
+             !  We find the 4 limits of the grid-box. As we transform the resolution of the model
+             !  into longitudes and latitudes we do not have the problem of periodicity.
+             !  coslat is a help variable here !
+             !
+             coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+             !
+             lon_up = lalo(ib,2) + resolution(ib,1)/(2.0*coslat) 
+             lon_low =lalo(ib,2) - resolution(ib,1)/(2.0*coslat) 
+             !
+             coslat = pi/180. * R_Earth
+             !
+             lat_up =lalo(ib,1) + resolution(ib,2)/(2.0*coslat) 
+             lat_low =lalo(ib,1) - resolution(ib,2)/(2.0*coslat) 
+             !
+             IF ( lonrel > lon_low .AND. lonrel < lon_up .OR. &
+                  & lolowrel < lon_low .AND.  louprel > lon_low .OR. &
+                  & lolowrel < lon_up  .AND.  louprel > lon_up ) THEN
+                !
+                ! Now that we have the longitude let us find the latitude
+                !             
+                IF ( latrel > lat_low .AND. latrel < lat_up .OR. &
+                     & lalowrel < lat_low .AND. lauprel > lat_low .OR.&
+                     & lalowrel < lat_up .AND. lauprel > lat_up) THEN
+                   !
+                   fopt(ib) = fopt(ib) + 1
+                   fopt_max = MAX ( fopt(ib), fopt_max )
+                   !
+                   IF ( fopt(ib) > incmax) THEN
+                      err_fopt=.TRUE.
+                      EXIT loopnbind
+                   ELSE
+                      !
+                      ! Get the area of the fine grid in the model grid
+                      !
+                      coslat = MAX( COS( lat_rel(ip) * pi/180. ), mincos )
+                      ax = (MIN(lon_up,louprel)-MAX(lon_low,lolowrel))*pi/180. * R_Earth * coslat
+                      ay = (MIN(lat_up,lauprel)-MAX(lat_low,lalowrel))*pi/180. * R_Earth
+                      !
+                      areaoverlap(ib, fopt(ib)) = ax*ay
+                      indinc(ib, fopt(ib)) = ip
+                      !
+                   ENDIF
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDIF
+    ENDDO loopnbind
+    !
+    IF (err_fopt) THEN
+       WRITE(numout,*) 'Reached value ', fopt(ib),' for fopt on point', ib
+       CALL ipslerr_p(2,'aggregate_vec (nbpt < nbind)', &
+            'Working on variable :'//callsign, &
+            'Reached incmax value for fopt.',&
+            'Please increase incmax in subroutine calling aggregate')
+       IF (PRESENT(ok)) THEN
+          ok = .FALSE.
+          RETURN
+       ELSE
+          STOP "aggregate_vec"
+       ENDIF
+    ENDIF
+    !
+    WRITE(numout,*) 
+    not_found_fopt = COUNT(fopt(:) .EQ. zero)
+    WRITE(numout,*) "aggregate_vec : ",not_found_fopt, &
+         & "did not find any corresponding data in the input file."
+    WRITE(numout,*) "aggregate_vec : This is ", not_found_fopt/FLOAT(nbpt)*100., &
+         & " % of the grid"
+    WRITE(numout,*) "aggregate_vec : nbvmax = ",incmax, "max used = ",fopt_max
+    !
+    ! Do some memory management.
+    !
+    DEALLOCATE (searchind)
+    DEALLOCATE (fine_ind)
+    !
+    ! Close the progress meter
+    !
+    WRITE(numout,*) '    '
+    !
+  END SUBROUTINE aggregate_vec
+!
+!
+
+  SUBROUTINE aggregate_vec_p(nbpt, lalo, neighbours, resolution, contfrac,          &
+       &                 iml, lon_ful, lat_ful, resol_lon, resol_lat, callsign, &
+       &                 nbvmax, sub_index, sub_area, ok)
+    
+    IMPLICIT NONE
+    
+    INTEGER(i_std), INTENT(in)   :: nbpt                 
+    REAL(r_std), INTENT(in)       :: lalo(nbpt,2)        
+    INTEGER(i_std), INTENT(in)   :: neighbours(nbpt,8)   
+    REAL(r_std), INTENT(in)       :: resolution(nbpt,2)   
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)       
+    INTEGER(i_std), INTENT(in)   :: iml                 
+    REAL(r_std), INTENT(in)       :: lon_ful(iml)         
+    REAL(r_std), INTENT(in)       :: lat_ful(iml)         
+    REAL(r_std), INTENT(in)       :: resol_lon, resol_lat 
+    CHARACTER(LEN=*), INTENT(in) :: callsign             
+    INTEGER(i_std), INTENT(in)   :: nbvmax             
+    INTEGER(i_std), INTENT(out)  :: sub_index(nbpt,nbvmax)
+    REAL(r_std), INTENT(out)      :: sub_area(nbpt,nbvmax) 
+    LOGICAL, OPTIONAL, INTENT(out)      :: ok            ! return code
+
+    INTEGER(i_std)  :: sub_index_g(nbp_glo,nbvmax)
+    REAL(r_std)       :: sub_area_g(nbp_glo,nbvmax)
+        
+    IF (is_root_prc) CALL aggregate(nbp_glo, lalo_g, neighbours_g, resolution_g, contfrac_g, &
+   &                                  iml, lon_ful, lat_ful, resol_lon, resol_lat, callsign,   &
+   &                                  nbvmax, sub_index_g, sub_area_g, ok)
+
+    CALL BCAST(ok)
+    CALL scatter(sub_index_g,sub_index)
+    CALL scatter(sub_area_g,sub_area)
+   
+   
+  END SUBROUTINE aggregate_vec_p
+
+  SUBROUTINE aggregate_2d_p(nbpt, lalo, neighbours, resolution, contfrac,          &
+       &                 iml, jml, lon_ful, lat_ful, mask, callsign, &
+       &                 nbvmax, sub_index, sub_area, ok)
+    
+    IMPLICIT NONE
+    
+    INTEGER(i_std), INTENT(in)   :: nbpt                 
+    REAL(r_std), INTENT(in)       :: lalo(nbpt,2)        
+    INTEGER(i_std), INTENT(in)   :: neighbours(nbpt,8)   
+    REAL(r_std), INTENT(in)       :: resolution(nbpt,2)   
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)       
+    INTEGER(i_std), INTENT(in)   :: iml,jml                 
+    REAL(r_std), INTENT(in)       :: lon_ful(iml,jml)         
+    REAL(r_std), INTENT(in)       :: lat_ful(iml,jml)         
+    INTEGER(i_std), INTENT(in)   :: mask(iml, jml)
+    CHARACTER(LEN=*), INTENT(in) :: callsign             
+    INTEGER(i_std), INTENT(in)   :: nbvmax             
+    INTEGER(i_std), INTENT(out)  :: sub_index(nbpt,nbvmax,2)
+    REAL(r_std), INTENT(out)      :: sub_area(nbpt,nbvmax) 
+    LOGICAL, OPTIONAL, INTENT(out)      :: ok            ! return code
+
+    INTEGER(i_std)   :: sub_index_g(nbp_glo,nbvmax,2)
+    REAL(r_std)       :: sub_area_g(nbp_glo,nbvmax)
+    
+    IF (is_root_prc) CALL aggregate_2d(nbp_glo, lalo_g, neighbours_g, resolution_g, contfrac_g, &
+   &                                  iml, jml, lon_ful, lat_ful, mask, callsign,   &
+   &                                  nbvmax, sub_index_g, sub_area_g, ok)
+    CALL BCAST(ok)
+    CALL scatter(sub_index_g,sub_index)
+    CALL scatter(sub_area_g,sub_area)
+   
+  END SUBROUTINE aggregate_2d_p
+!
+END MODULE interpol_help
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/solar.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/solar.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_global/solar.f90	(revision 5166)
@@ -0,0 +1,600 @@
+! =================================================================================================================================
+! MODULE       : solar
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module define solar 
+!!
+!!\n DESCRIPTION: 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE solar
+
+  USE defprec
+  USE constantes
+  USE ioipsl_para 
+
+  IMPLICIT NONE
+
+
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : solarang
+!!
+!>\BRIEF         This subroutine computes the solar angle according to the method used by GSWP and developed by J.C. Morill.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::csang
+!!
+!! REFERENCE(S) : See for further details :
+!! http://www.atmo.arizona.edu/~morrill/swrad.html
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE solarang (julian, julian0, iim, jjm, lon, lat, csang)
+
+    USE calendar
+
+    IMPLICIT NONE
+
+    !! 0. Parameters and variables declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                      :: iim, jjm        !!
+    REAL, INTENT(in)                         :: julian          !!
+    REAL, INTENT(in)                         :: julian0         !!
+    REAL, DIMENSION(iim,jjm), INTENT(in)     :: lon, lat        !!
+
+    !! 0.2 Output variables
+
+    REAL, DIMENSION(iim,jjm), INTENT(out)    :: csang           !!
+
+    !! 0.4 Local variables
+
+    REAL                                     :: gamma           !!
+    REAL                                     :: dec             !!
+    REAL                                     :: decd            !!
+    REAL                                     :: et              !!
+    REAL                                     :: gmt             !!
+    REAL                                     :: le              !!
+    REAL                                     :: ls              !!
+    REAL                                     :: lcorr           !!
+    REAL                                     :: latime          !!
+    REAL                                     :: omega           !!
+    REAL                                     :: omegad          !!
+    REAL                                     :: llatd, llat     !!
+    INTEGER                                  :: igmt            !!
+    INTEGER                                  :: ilon, ilat      !!
+    INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: zone            !!
+!$OMP THREADPRIVATE(zone)
+    REAL, SAVE, ALLOCATABLE, DIMENSION(:)    :: lhour           !!
+!$OMP THREADPRIVATE(lhour)
+    !
+    LOGICAL                                  :: check = .FALSE. !!
+!$OMP THREADPRIVATE(check)
+
+!_ ================================================================================================================================
+
+    IF (check) WRITE(numout,*) 'We get the right calendar information'
+    !-
+    !- 1) Day angle gamma
+    !-
+    !   gamma = 2.*pi*MOD(julian,one_year)/one_year
+    gamma = 2.*pi*(julian-julian0)/one_year
+    !-
+    !- 2) Solar declination (assumed constant for a 24 hour period)  page 7
+    !-    in radians
+    !-
+    IF (check) WRITE(numout,*) 'Solar declination'
+    !
+    dec = ( 0.006918-0.399912*COS(gamma)+0.070257*SIN(gamma) &
+         &       -0.006758*COS(2*gamma)+0.000907*SIN(2*gamma)      &
+         &       -0.002697*COS(3*gamma)+0.00148*SIN(3*gamma))
+    decd = dec*(180/pi)
+    !-
+    !- maximum error 0.0006 rad (<3'), leads to error
+    !- of less than 1/2 degree in zenith angle
+    !-
+    IF (check) WRITE(numout,*) 'Equation of time'
+    !- 3)  Equation of time  page 11
+    !-
+    et = ( 0.000075+0.001868*COS(gamma)-0.032077*SIN(gamma)&
+         &      -0.014615*COS(2*gamma)-0.04089*SIN(2*gamma))*229.18
+    !-
+    !- Get the time zones for the current time
+    !-
+    gmt = 24.*(julian-INT(julian))
+    IF (.NOT.ALLOCATED(zone))  ALLOCATE(zone(iim))
+    IF (.NOT.ALLOCATED(lhour)) ALLOCATE(lhour(iim))
+    !-
+    !igmt = NINT(gmt)
+    IF (check) WRITE(numout,*) 'Get time zone'
+    CALL time_zone(gmt, iim, jjm, lon, zone, lhour)
+    !-
+    !- Start a loop through the grid
+    !-
+    IF (check) WRITE(numout,*) 'Start a loop through the grid'
+    DO ilon=1,iim
+       !---
+       !--- 4) Local apparent time  page 13
+       !---
+       !--- ls     standard longitude (nearest 15 degree meridian)
+       !--- le     local longtitude
+       !--- lhour  local standard time
+       !--- latime local apparent time
+       !--- lcorr  longitudunal correction (minutes)
+       !---
+       le = lon(ilon,1)
+       ls = ((zone(ilon)-1)*15)-180.
+       lcorr = 4.*(ls-le)*(-1)
+       latime = lhour(ilon)+lcorr/60.+et/60.
+       IF (latime <  0.) latime = latime+24
+       IF (latime > 24.) latime = latime-24
+       !---
+       !--- 5) Hour angle omega  page 15
+       !---
+       !--- hour angle is zero at noon, positive in the morning
+       !--- It ranges from 180 to -180
+       !---
+       !--- omegad is omega in degrees, omega is in radians
+       !---
+       omegad = (latime-12.)*(-15.)
+       omega  = omegad*pi/180.
+       !---
+       DO ilat=1,jjm
+          !-----
+          !----- 6)  Zenith angle  page 15
+          !-----
+          !----- csang cosine of zenith angle (radians)
+          !----- llatd =  local latitude in degrees
+          !----- llat  =  local latitude in radians
+          !-----
+          llatd = lat(1,ilat)
+          llat  = llatd*pi/180.
+          csang(ilon,ilat) = &
+               &  MAX(zero,SIN(dec)*SIN(llat)+COS(dec)*COS(llat)*COS(omega))
+       ENDDO
+    ENDDO
+    !----------------------
+  END SUBROUTINE solarang
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : time_zone
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::zone, ::lhour
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE time_zone (gmt, iim, jjm, lon, zone, lhour)
+
+    IMPLICIT NONE
+
+    !! 0. Parameters and variables declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                   :: iim, jjm        !!
+    REAL, DIMENSION(iim,jjm), INTENT(in)  :: lon             !!
+    REAL, INTENT(in)                      :: gmt             !!
+
+    !! 0.2 Output variables
+
+    INTEGER, DIMENSION(iim), INTENT(out)  :: zone            !!
+    REAL, DIMENSION(iim), INTENT(out)     :: lhour           !!
+
+    !! 0.4 Local variables
+
+    INTEGER                               :: deg             !!
+    !!??   REAL :: deg
+    INTEGER                               :: i, ilon, change !! Indices
+
+!_ ================================================================================================================================
+
+    DO ilon=1,iim
+       !---
+       !--- Convert longitude index to longtitude in degrees
+       !---
+       deg = lon(ilon,1)
+       !---
+       !--- Determine into which time zone (15 degree interval) the
+       !--- longitude falls.
+       !---
+       DO i=1,25
+          IF (deg < (-187.5+(15*i))) THEN
+             zone(ilon) = i
+             IF (zone(ilon) == 25)   zone(ilon) = 1
+             EXIT
+          ENDIF
+       ENDDO
+       !---
+       !--- Calculate change (in number of hours) from GMT time to
+       !--- local hour.  Change will be negative for zones < 13 and
+       !--- positive for zones > 13.
+       !---
+       !--- There is also a correction for lhour < 0 and lhour > 23
+       !--- to lhour between 0 and 23.
+       !---
+       IF (zone(ilon) < 13) THEN
+          change = zone(ilon)-13
+          lhour(ilon) = gmt+change
+       ENDIF
+       !---
+       IF (zone(ilon) == 13) THEN
+          lhour(ilon) = gmt
+       ENDIF
+       !---
+       IF (zone(ilon) > 13) THEN
+          change = zone(ilon)-13
+          lhour(ilon) = gmt+change
+       ENDIF
+       IF (lhour(ilon) <  0) lhour(ilon) = lhour(ilon)+24
+       IF (lhour(ilon) >= 24) lhour(ilon) = lhour(ilon)-24
+       !---
+    ENDDO
+    !-----------------------
+  END SUBROUTINE time_zone
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : downward_solar_flux
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::solad, ::solai
+!!
+!! REFERENCE(S) :See for further details :
+!! http://www.atmo.arizona.edu/~morrill/swrad.html
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE downward_solar_flux (npoi,latitude,calendar_str,jday,rtime,cloud,nband,solad,solai)
+
+    IMPLICIT NONE
+
+    !! 0. Parameter and variables declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER, INTENT(in)                      :: npoi               !! number of grid points (unitless)
+    REAL, DIMENSION(npoi), INTENT(in)        :: latitude           !! latitude in degrees
+    CHARACTER(LEN=20),INTENT(in)             :: calendar_str       !! Calendar type
+    REAL, INTENT(in)                         :: jday
+    REAL,INTENT(in)                          :: rtime
+    REAL, DIMENSION(npoi), INTENT(in)        :: cloud              !! cloud fraction (0-1, unitless)
+    INTEGER,INTENT(in)                       :: nband              !! number of visible bands (unitless)
+
+    !! 0.2 Output variables
+
+    REAL, DIMENSION(npoi,nband), INTENT(out) :: solad              !! direct downward solar flux 
+                                                                   !! @tex $(W.m^{-2})$ @endtex
+    REAL, DIMENSION(npoi,nband), INTENT(out) :: solai              !! diffuse downward solar flux 
+                                                                   !! @tex $(W.m^{-2})$ @endtex
+
+    !! 0.4 Local variables
+
+    ! Parametres orbitaux:
+
+    REAL, SAVE                               :: ecc                !! Eccentricity
+!$OMP THREADPRIVATE(ecc)
+    REAL, SAVE                               :: perh               !! Longitude of perihelie
+!$OMP THREADPRIVATE(perh)
+    REAL, SAVE                               :: xob                !! obliquity
+!$OMP THREADPRIVATE(xob)
+    REAL, PARAMETER                          :: pir = pi/180.      !!
+    REAL, SAVE                               :: step               !!
+!$OMP THREADPRIVATE(step)
+    REAL                                     :: xl                 !!
+    REAL                                     :: so                 !!
+    REAL                                     :: xllp               !!
+    REAL                                     :: xee                !!
+    REAL                                     :: xse                !!  
+    REAL                                     :: xlam               !!
+    REAL                                     :: dlamm              !!
+    REAL                                     :: anm                !!
+    REAL                                     :: ranm               !!
+    REAL                                     :: ranv               !!
+    REAL                                     :: anv                !!
+    REAL                                     :: tls                !!
+    REAL                                     :: rlam               !!
+    REAL                                     :: sd                 !!
+    REAL                                     :: cd                 !!
+    REAL                                     :: deltar             !!
+    REAL                                     :: delta              !!
+    REAL                                     :: Dis_ST             !!  
+    REAL                                     :: ddt                !!
+    REAL                                     :: orbit              !!
+    REAL                                     :: angle              !!
+    REAL                                     :: xdecl              !!
+    REAL                                     :: xlat               !!
+    REAL, DIMENSION(npoi)                    :: trans              !!
+    REAL, DIMENSION(npoi)                    :: fdiffuse           !!
+    REAL, DIMENSION(npoi)                    :: coszen             !! cosine of solar zenith angle
+    REAL                                     :: sw                 !!
+    REAL                                     :: frac               !!
+    INTEGER                                  :: i,ib               !!
+    LOGICAL, SAVE                            :: firstcall = .TRUE. !!
+!$OMP THREADPRIVATE(firstcall)
+
+!_ ================================================================================================================================
+    
+    IF (firstcall) THEN
+       IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN  
+          step = 1.0
+       ELSE
+          step = one_year/365.2425
+       ENDIF
+       !-
+       ! Read Orbital Parameters
+       !-
+
+       !Config Key   = ECCENTRICITY
+       !Config Desc  = Use prescribed values
+       !Config If    = ALLOW_WEATHERGEN
+       !Config Def   = 0.016724
+       !Config Help  =
+       !Config Units = [-]
+       ecc = 0.016724
+       CALL getin_p ('ECCENTRICITY',ecc)
+       WRITE(numout,*) 'ECCENTRICITY: ',ecc
+       !
+       !Config Key  = PERIHELIE
+       !Config Desc = Use prescribed values
+       !Config If   = ALLOW_WEATHERGEN
+       !Config Def  = 102.04
+       !Config Help  =
+       !Config Units = [-]
+       perh = 102.04
+       CALL getin_p ('PERIHELIE',perh)
+       WRITE(numout,*) 'PERIHELIE: ',perh
+       !
+       !Config Key  = OBLIQUITY
+       !Config Desc = Use prescribed values
+       !Config If   = ALLOW_WEATHERGEN
+       !Config Def  = 23.446
+       !Config Help  =
+       !Config Units = [Degrees]
+       xob = 23.446
+       CALL getin_p ('OBLIQUITY',xob)
+       WRITE(numout,*) 'OBLIQUITY: ',xob
+
+       firstcall = .FALSE.
+    ENDIF
+
+    !-
+    ! calendar and orbital calculations
+    !-
+
+    !-
+    ! calculate the earth's orbital angle (around the sun) in radians
+    orbit = 2.0*pi*jday/365.2425
+    !-
+    ! calculate the solar hour angle in radians
+    angle = 2.0*pi*(rtime-12.0)/24.0
+    !-
+    ! calculate the current solar declination angle
+    ! ref: global physical climatology, hartmann, appendix a
+    !
+    ! xdecl = 0.006918 &
+    !        -0.399912*cos(orbit) &
+    !        +0.070257*sin(orbit) &
+    !        -0.006758*cos(2.0*orbit) &
+    !        +0.000907*sin(2.0*orbit) &
+    !        -0.002697*cos(3.0*orbit) &
+    !        +0.001480*sin(3.0*orbit)
+    !
+    ! calculate the effective solar constant,
+    ! including effects of eccentricity
+    ! ref: global physical climatology, hartmann, appendix a
+    !
+    ! sw = 1370.*( 1.000110 &
+    !             +0.034221*cos(orbit) &
+    !             +0.001280*sin(orbit) &
+    !             +0.000719*cos(2.0*orbit) &
+    !             +0.000077*sin(2.0*orbit))
+    !
+    ! correction Marie-France Loutre
+    !
+    !    orbital parameters
+    !
+    !    ecc = 0.016724
+    !    perh = 102.04
+    !    xob = 23.446
+    !-
+    xl = perh+180.0
+    ! so : sinus of obliquity
+    so = sin(xob*pir)
+    !-
+    xllp = xl*pir
+    xee  = ecc*ecc
+    xse  = sqrt(1.0d0-xee)
+    ! xlam : true long. sun for mean long. = 0
+    xlam = (ecc/2.0+ecc*xee/8.0d0)*(1.0+xse)*sin(xllp)-xee/4.0 &
+         &      *(0.5+xse)*sin(2.0*xllp)+ecc*xee/8.0*(1.0/3.0+xse) &
+         &      *sin(3.0*xllp)
+    xlam  =2.0d0*xlam/pir
+    ! dlamm : mean long. sun for ma-ja
+    dlamm =xlam+(INT(jday)-79)*step
+    anm   = dlamm-xl
+    ranm  = anm*pir
+    xee   = xee*ecc
+    ! ranv : anomalie vraie    (radian)
+    ranv = ranm+(2.0*ecc-xee/4.0)*sin(ranm)+5.0/4.0*ecc*ecc &
+         &      *sin(2.0*ranm)+13.0/12.0*xee*sin(3.0*ranm)
+    ! anv  : anomalie vraie    (degrees)
+    anv  = ranv/pir
+    ! tls  : longitude vraie   (degrees)
+    tls  = anv+xl
+    ! rlam : longitude vraie   (radian)
+    rlam = tls*pir
+    ! sd and cd: cosinus and sinus of solar declination angle (delta)
+    ! sinus delta = sin (obl)*sin(lambda) with lambda = real longitude
+    ! (Phd. thesis of Marie-France Loutre, ASTR-UCL, Belgium, 1993)
+    sd    = so*sin(rlam)
+    cd    = sqrt(1.0d0-sd*sd)
+    ! delta : Solar Declination (degrees, angle sun at equator)
+    deltar = atan(sd/cd)
+    delta  = deltar/pir
+    !-
+    ! Eccentricity Effect
+    !-
+    Dis_ST  =(1.0-ecc*ecc)/(1.0+ecc*cos(ranv))
+    ! ddt :    1 / normalized earth's sun distance
+    ddt = 1.0/Dis_ST
+    !-
+    ! Insolation normal to the atmosphere (W/m2)
+    !-
+    sw  = ddt *ddt *1370.d0
+    !-
+    xdecl = deltar
+    !-
+    ! solar calculations
+    !-
+    do i=1,npoi
+       !---
+       !-- calculate the latitude in radians
+       !---
+       xlat = latitude(i)*pi/180.0
+       !---
+       !-- calculate the cosine of the solar zenith angle
+       !---
+       coszen(i) = MAX(0.0, (sin(xlat)*sin(xdecl) &
+            &                      + cos(xlat)*cos(xdecl)*cos(angle)))
+       !---
+       !-- calculate the solar transmission through the atmosphere
+       !-- using simple linear function of tranmission and cloud cover
+       !---
+       !-- note that the 'cloud cover' data is typically obtained from
+       !-- sunshine hours -- not direct cloud observations
+       !---
+       !-- where, cloud cover = 1 - sunshine fraction
+       !---
+       !-- different authors present different values for the slope and
+       !-- intercept terms of this equation
+       !---
+       !-- Friend, A: Parameterization of a global daily weather generator
+       !-- for terrestrial ecosystem and biogeochemical modelling,
+       !-- Ecological Modelling
+       !---
+       !-- Spitters et al., 1986: Separating the diffuse and direct component
+       !-- of global radiation and its implications for modeling canopy
+       !-- photosynthesis, Part I: Components of incoming radiation,
+       !-- Agricultural and Forest Meteorology, 38, 217-229.
+       !---
+       !-- A. Friend       : trans = 0.251+0.509*(1.0-cloud(i))
+       !-- Spitters et al. : trans = 0.200+0.560*(1.0-cloud(i))
+       !---
+       !-- we are using the values from A. Friend
+       !---
+       trans(i) = 0.251+0.509*(1.0-cloud(i))
+       !---
+       !-- calculate the fraction of indirect (diffuse) solar radiation
+       !-- based upon the cloud cover
+       !---
+       !-- note that these relationships typically are measured for either
+       !-- monthly or daily timescales, and may not be exactly appropriate
+       !-- for hourly calculations -- however, in ibis, cloud cover is fixed
+       !-- through the entire day so it may not make much difference
+       !---
+       !-- method i --
+       !---
+       !-- we use a simple empirical relationships
+       !-- from Nikolov and Zeller (1992)
+       !---
+       !-- Nikolov, N. and K.F. Zeller, 1992:  A solar radiation algorithm
+       !-- for ecosystem dynamics models, Ecological Modelling, 61, 149-168.
+       !---
+       fdiffuse(i) = 1.0045+trans(i)*( 0.0435+trans(i) &
+            &                                 *(-3.5227+trans(i)*2.6313))
+       !---
+       IF (trans(i) > 0.75) fdiffuse(i) = 0.166
+       !---
+       !-- method ii --
+       !---
+       !-- another method was suggested by Spitters et al. (1986) based on
+       !-- long-term data from the Netherlands
+       !--
+       !-- Spitters et al., 1986: Separating the diffuse and direct component
+       !-- of global radiation and its implications for modeling canopy
+       !-- photosynthesis, Part I: Components of incoming radiation,
+       !-- Agricultural and Forest Meteorology, 38, 217-229.
+       !---
+       !--       if ((trans == 0.00).and.(trans < 0.07)) then
+       !--         fdiffuse = 1.0
+       !--       else if ((trans >= 0.07).and.(trans < 0.35)) then
+       !--         fdiffuse = 1.0-2.3*(trans-0.07)**2
+       !--       else if ((trans >= 0.35).and.(trans < 0.75)) then
+       !--         fdiffuse = 1.33-1.46*trans
+       !--       ELSE
+       !--         fdiffuse = 0.23
+       !--       endif
+       !---
+    ENDDO
+    !-----------------------
+    !-
+    ! do for each waveband
+    !-
+    DO ib=1,nband
+       !---
+       !-- calculate the fraction in each waveband
+       !---
+       !-- GK010200
+       IF (nband == 2) then
+          frac = 0.46+0.08*REAL(ib-1)
+       ELSE
+          frac = 1./REAL(nband)
+       ENDIF
+       !---
+       DO i=1,npoi
+          !-----
+          !---- calculate the direct and indirect solar radiation
+          !-----
+          solad(i,ib) = sw*coszen(i)*frac*trans(i)*(1.-fdiffuse(i))
+          solai(i,ib) = sw*coszen(i)*frac*trans(i)*fdiffuse(i)
+       ENDDO
+    ENDDO
+
+
+  END SUBROUTINE downward_solar_flux
+
+ 
+END MODULE solar
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/AA_make	(revision 5166)
@@ -0,0 +1,129 @@
+#-
+#- $Id$
+#-
+MODS1 = mod_orchidee_mpi_data.F90 \
+	mod_orchidee_omp_data.F90 \
+	timer.f90 \
+        mod_orchidee_mpi_transfert.F90 \
+        mod_orchidee_omp_transfert.F90 \
+        mod_orchidee_transfert_para.F90 \
+        mod_orchidee_para.F90 \
+	tools_para.f90 \
+	ioipsl_para.f90 \
+	orch_write_field.f90 \
+	write_field.f90 \
+	orch_write_field_p.f90 \
+	write_field_p.f90 \
+	parallel.f90
+
+FILTERf90=$(filter %.f90,$(MODS1))
+FILTERF90=$(filter %.F90,$(MODS1))
+OBJSMODS1=$(FILTERf90:.f90=.o) $(FILTERF90:.F90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) m_all
+	@echo parallel is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+#-Q- intel m_all: WORK_MOD $(MODEL_LIB)($(OBJSMODS1))
+
+$(MODEL_LIB)(%.o) : %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+#-Q- intel
+#-Q- intel WORK_MOD :
+#-Q- intel 	$(RM) work.pcl
+#-Q- intel 	@echo "work.pc" > work.pcl
+#-Q- intel 	@echo "../src_parameters/work.pc" >> work.pcl
+#-Q- intel 	@echo "../src_stomate/work.pc" >> work.pcl
+#-Q- intel 	@echo "../../IOIPSL/src/work.pc" >> work.pcl
+
+$(MODEL_LIB)(%.o) : %.F90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.F90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+
+config : 
+	$(BINDIR)/Fparser -name PARALLEL $(MODS1)
+	echo 'Configuration of PARALLEL done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(mpi_dummy.o):
+
+$(MODEL_LIB)(mod_orchidee_mpi_data.o):
+
+$(MODEL_LIB)(mod_orchidee_omp_data.o):
+
+$(MODEL_LIB)(timer.o): \
+    $(MODEL_LIB)(mod_orchidee_mpi_data.o)
+
+$(MODEL_LIB)(orch_write_field.o):
+
+$(MODEL_LIB)(write_field_p.o): \
+  $(MODEL_LIB)(orch_write_field.o)
+
+$(MODEL_LIB)(mod_orchidee_mpi_transfert.o): \
+  $(MODEL_LIB)(mod_orchidee_mpi_data.o) \
+  $(MODEL_LIB)(timer.o)
+
+$(MODEL_LIB)(mod_orchidee_omp_transfert.o): \
+  $(MODEL_LIB)(mod_orchidee_omp_data.o)
+
+$(MODEL_LIB)(mod_orchidee_transfert_para.o): \
+  $(MODEL_LIB)(mod_orchidee_mpi_transfert.o) \
+  $(MODEL_LIB)(mod_orchidee_omp_transfert.o)
+
+$(MODEL_LIB)(mod_orchidee_para.o): \
+  $(MODEL_LIB)(mod_orchidee_mpi_transfert.o) \
+  $(MODEL_LIB)(mod_orchidee_omp_transfert.o)
+
+$(MODEL_LIB)(ioipsl_para.o): \
+  $(MODEL_LIB)(mod_orchidee_transfert_para.o) \
+  $(MODEL_LIB)(mod_orchidee_para.o)
+
+$(MODEL_LIB)(tools_para.o): \
+  $(MODEL_LIB)(timer.o) \
+  $(MODEL_LIB)(mod_orchidee_mpi_data.o)
+
+$(MODEL_LIB)(orch_write_field_p.o): \
+  $(MODEL_LIB)(mod_orchidee_para.o)
+
+$(MODEL_LIB)(write_field_p.o): \
+  $(MODEL_LIB)(orch_write_field_p.o)
+
+$(MODEL_LIB)(parallel.o): \
+  $(MODEL_LIB)(mod_orchidee_para.o) \
+  $(MODEL_LIB)(ioipsl_para.o) 
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/AA_make.ldef	(revision 5166)
@@ -0,0 +1,20 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a PARALLEL
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+ORDIR  = ..
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/libparallel.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxparallel.a
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/ioipsl_para.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/ioipsl_para.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/ioipsl_para.f90	(revision 5166)
@@ -0,0 +1,655 @@
+! Overlap of IOIPSL functions for specific parallel use in ORCHIDEE.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE ioipsl_para
+  USE ioipsl
+  USE mod_orchidee_para
+!-
+  IMPLICIT NONE
+
+  INTEGER, SAVE :: orch_domain_id 
+!-
+   INTEGER :: orch_ipslout=6, orch_ilv_cur=0, orch_ilv_max=0
+!$OMP THREADPRIVATE( orch_ipslout, orch_ilv_cur, orch_ilv_max )
+
+!-
+!-
+#include "src_parallel.h"
+!-
+  INTERFACE getin_p
+    MODULE PROCEDURE getin_p_c,getin_p_c1,   &
+         getin_p_i,getin_p_i1,getin_p_i2,&
+         getin_p_r,getin_p_r1,getin_p_r2,&
+         getin_p_l,getin_p_l1,getin_p_l2
+  END INTERFACE
+!-
+  INTERFACE restput_p
+     MODULE PROCEDURE &
+          restput_p_r3d, restput_p_r2d, restput_p_r1d, &
+          restput_p_opp_r2d, restput_p_opp_r1d
+  END INTERFACE
+!-
+  INTERFACE restget_p
+     MODULE PROCEDURE &
+          restget_p_r3d, restget_p_r2d, restget_p_r1d, &
+          restget_p_opp_r2d, restget_p_opp_r1d
+  END INTERFACE
+
+
+  INTERFACE histwrite_p
+     MODULE PROCEDURE &
+     histwrite_r1d_p,histwrite_r2d_p,histwrite_r3d_p     
+  END INTERFACE
+
+CONTAINS
+
+
+
+  SUBROUTINE Init_ioipsl_para
+
+    USE mod_orchidee_mpi_data
+    USE mod_orchidee_omp_data
+    IMPLICIT NONE
+    
+    INTEGER,DIMENSION(2) :: ddid
+    INTEGER,DIMENSION(2) :: dsg
+    INTEGER,DIMENSION(2) :: dsl
+    INTEGER,DIMENSION(2) :: dpf
+    INTEGER,DIMENSION(2) :: dpl
+    INTEGER,DIMENSION(2) :: dhs
+    INTEGER,DIMENSION(2) :: dhe 
+
+    IF (is_omp_root) THEN
+      ddid=(/ 1,2 /)
+      dsg=(/ iim_g, jjm_g /)
+      dsl=(/ iim_g, jj_nb /)
+      dpf=(/ 1,jj_begin /)
+      dpl=(/ iim_g, jj_end /)
+      dhs=(/ ii_begin-1,0 /)
+      if (mpi_rank==mpi_size-1) then
+        dhe=(/0,0/)
+      else
+         dhe=(/ iim_g-ii_end,0 /)  
+      endif
+    
+      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
+                        'APPLE',orch_domain_id)
+     ENDIF
+     
+  END SUBROUTINE Init_ioipsl_para
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!   Definition de ioconf_setatt_p      !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE ioconf_setatt_p (attname,attvalue)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*), INTENT(in) :: attname,attvalue
+!---------------------------------------------------------------------
+
+  IF (is_root_prc) THEN 
+     CALL ioconf_setatt(attname,attvalue)
+  ENDIF
+
+END SUBROUTINE ioconf_setatt_p
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!   Definition de parallel ipslerr functions    !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!===
+SUBROUTINE ipslnlf_p (new_number,old_number)
+!!--------------------------------------------------------------------
+!! The "ipslnlf" routine allows to know and modify
+!! the current logical number for the messages.
+!!
+!! SUBROUTINE ipslnlf (new_number,old_number)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_number : new logical number of the file
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_number : current logical number of the file
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(IN)  :: new_number
+  INTEGER,OPTIONAL,INTENT(OUT) :: old_number
+!---------------------------------------------------------------------
+  IF (PRESENT(old_number)) THEN
+#ifndef CPP_OMP
+    CALL ipslnlf(old_number=orch_ipslout)
+#endif
+    old_number = orch_ipslout
+  ENDIF
+  IF (PRESENT(new_number)) THEN
+    orch_ipslout = new_number
+#ifndef CPP_OMP
+    CALL ipslnlf(new_number=orch_ipslout)
+#endif
+  ENDIF
+!---------------------
+END SUBROUTINE ipslnlf_p
+!===
+SUBROUTINE ipslerr_p (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!! The "ipslerr_p" routine
+!! allows to handle the messages to the user.
+!!
+!! parallel version of IOIPSL ipslerr
+!!
+!! INPUT
+!!
+!! plev   : Category of message to be reported to the user
+!!          1 = Note to the user
+!!          2 = Warning to the user
+!!          3 = Fatal error
+!! pcname : Name of subroutine which has called ipslerr
+!! pstr1   
+!! pstr2  : Strings containing the explanations to the user
+!! pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     orch_ilv_cur = plev
+     orch_ilv_max = MAX(orch_ilv_max,plev)
+     WRITE(orch_ipslout,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(orch_ipslout,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
+   ENDIF
+   IF (plev == 3) THEN
+     WRITE(orch_ipslout,'("Fatal error from ORCHIDEE. STOP in ipslerr_p with code")')
+#ifdef CPP_PARA
+    CALL MPI_ABORT(plev)
+#endif     
+    STOP 'Fatal error from ORCHIDEE'
+   ENDIF
+!---------------------
+END SUBROUTINE ipslerr_p
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!   Definition des getin -> bcast      !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaines de caracteres -- !!
+  
+  SUBROUTINE getin_p_c(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    CHARACTER(LEN=*),INTENT(INOUT) :: VarOut    
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_c  
+
+
+  SUBROUTINE getin_p_c1(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    CHARACTER(LEN=*),INTENT(INOUT) :: VarOut(:)    
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_c1 
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE getin_p_i(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    INTEGER,INTENT(INOUT) :: VarOut    
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_i
+
+  SUBROUTINE getin_p_i1(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    INTEGER,INTENT(INOUT) :: VarOut(:)
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_i1
+
+  SUBROUTINE getin_p_i2(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    INTEGER,INTENT(INOUT) :: VarOut(:,:)
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_i2
+
+!! -- Les flottants -- !!
+  
+  SUBROUTINE getin_p_r(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    REAL,INTENT(INOUT) :: VarOut
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_r
+
+  SUBROUTINE getin_p_r1(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    REAL,INTENT(INOUT) :: VarOut(:)
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_r1
+
+  SUBROUTINE getin_p_r2(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    REAL,INTENT(INOUT) :: VarOut(:,:)
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_r2
+
+!! -- Les Booleens -- !!
+  
+  SUBROUTINE getin_p_l(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    LOGICAL,INTENT(INOUT) :: VarOut
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_l
+
+  SUBROUTINE getin_p_l1(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    LOGICAL,INTENT(INOUT) :: VarOut(:)
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_l1
+
+  SUBROUTINE getin_p_l2(VarIn,VarOut)
+    IMPLICIT NONE    
+    CHARACTER(LEN=*),INTENT(IN) :: VarIn
+    LOGICAL,INTENT(INOUT) :: VarOut(:,:)
+
+    IF (is_root_prc) CALL getin(VarIn,VarOut)
+    CALL bcast(VarOut)
+  END SUBROUTINE getin_p_l2
+!-
+!-----------------------------
+!-----------------------------
+!-----------------------------
+!-
+  SUBROUTINE restget_p_opp_r1d &
+  (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+   var, MY_OPERATOR, nbindex, ijndex)
+! DO NOT USE THIS FUNCTION WITH NON GRID VARIABLE !
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL def_beha
+    REAL :: var(:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+       ALLOCATE( temp_g(1) )
+    ENDIF
+        
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+            temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_opp_r1d
+!-
+!===
+!-
+  SUBROUTINE restget_p_opp_r2d &
+  (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+   var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+    !-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL def_beha
+    REAL :: var(:,:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+      ALLOCATE( temp_g(1,1) )
+    ENDIF
+
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+            temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_opp_r2d
+!-
+!===
+!-
+  SUBROUTINE restget_p_r1d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+! DO NOT USE THIS FUNCTION WITH NON GRID VARIABLE !
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL :: def_beha
+    REAL :: var(:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+       ALLOCATE( temp_g(1) )
+    ENDIF
+
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_r1d
+!-
+!===
+!-
+  SUBROUTINE restget_p_r2d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL :: def_beha
+    REAL :: var(:,:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+       ALLOCATE( temp_g(1,1) )
+    ENDIF
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_r2d
+!-
+!===
+!-
+  SUBROUTINE restget_p_r3d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    LOGICAL def_beha
+    REAL :: var(:,:,:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
+
+    IF (is_root_prc) THEN 
+       ALLOCATE( temp_g(iim,jjm,llm) )
+    ELSE 
+       ALLOCATE( temp_g(1,1,1) )
+    ENDIF
+    
+    IF (is_root_prc) THEN 
+       CALL restget &
+            (fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
+    ENDIF
+    CALL scatter(temp_g,var)
+    DEALLOCATE(temp_g)
+  END SUBROUTINE restget_p_r3d
+!-
+!-----------------------------
+!-----------------------------
+!-
+  SUBROUTINE restput_p_opp_r1d &
+  (fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
+
+    IF (is_root_prc) THEN 
+      ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+      ALLOCATE ( temp_g(1) )
+    ENDIF
+    
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput &
+            (fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_opp_r1d
+!-
+!===
+!-
+  SUBROUTINE restput_p_opp_r2d &
+  (fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:,:)
+    CHARACTER(LEN=*) :: MY_OPERATOR
+    INTEGER :: nbindex, ijndex(nbindex)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+      ALLOCATE( temp_g(1,1) )
+    ENDIF
+          
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput &
+            (fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_opp_r2d
+!-
+!===
+!-
+  SUBROUTINE restput_p_r1d (fid,vname_q,iim,jjm,llm,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:)
+    !-----------------------------
+    REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim*jjm*llm) )
+    ELSE
+      ALLOCATE( temp_g(1) )
+    ENDIF
+    
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_r1d
+!-
+!===
+!-
+  SUBROUTINE restput_p_r2d (fid,vname_q,iim,jjm,llm,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:,:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim,jjm) )
+    ELSE
+      ALLOCATE( temp_g(1,1) )
+    ENDIF
+    
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_r2d
+!-
+!===
+!-
+  SUBROUTINE restput_p_r3d (fid,vname_q,iim,jjm,llm,itau,var)
+    IMPLICIT NONE
+!-
+    INTEGER :: fid
+    CHARACTER(LEN=*) :: vname_q
+    INTEGER :: iim, jjm, llm, itau
+    REAL :: var(:,:,:)
+    !-------------------------
+    REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
+
+    IF (is_root_prc) THEN
+      ALLOCATE( temp_g(iim,jjm,llm) )
+    ELSE
+      ALLOCATE( temp_g(iim,jjm,llm) )
+    ENDIF
+    
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+    ENDIF
+    DEALLOCATE( temp_g )
+          
+  END SUBROUTINE restput_p_r3d
+
+
+  SUBROUTINE histwrite_r1d_p(pfileid,pvarname,pitau,pdata,nbindex,nindex)
+    IMPLICIT NONE
+!-
+    INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex)
+    REAL,DIMENSION(:),INTENT(IN) :: pdata
+    CHARACTER(LEN=*),INTENT(IN) :: pvarname
+    
+    REAL,DIMENSION(nbp_mpi)    :: pdata_mpi
+    
+    IF (pfileid > 0) THEN 
+       ! Continue only if the file is initilalized
+       CALL gather_omp(pdata,pdata_mpi)
+       IF (is_omp_root) THEN
+          CALL histwrite(pfileid,pvarname,pitau,pdata_mpi,nbp_mpi,kindex_mpi) 
+       ENDIF
+    END IF
+      
+  END SUBROUTINE histwrite_r1d_p
+  
+
+  SUBROUTINE histwrite_r2d_p(pfileid,pvarname,pitau,pdata,nbindex,nindex)
+    IMPLICIT NONE
+!-
+    INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex)
+    REAL,DIMENSION(:,:),INTENT(IN) :: pdata
+    CHARACTER(LEN=*),INTENT(IN) :: pvarname
+
+    IF (pfileid > 0) THEN 
+       ! Continue only if the file is initilalized
+       CALL body(size(pdata,2),nindex)
+    END IF
+
+  CONTAINS 
+
+    SUBROUTINE body(dim,nindex)
+    INTEGER :: dim
+    INTEGER :: nindex(nbp_omp,dim)
+    
+    INTEGER :: nindex_mpi(nbp_mpi,dim)
+    REAL    :: pdata_mpi(nbp_mpi,dim)
+    
+      CALL gather_omp(pdata,pdata_mpi)
+      CALL gather_omp(nindex,nindex_mpi)
+    
+      IF (is_omp_root) THEN
+       CALL histwrite(pfileid,pvarname,pitau,pdata_mpi,nbp_mpi*dim,reshape(nindex_mpi,(/nbp_mpi*dim/)))
+      ENDIF
+    END SUBROUTINE body
+       
+  END SUBROUTINE histwrite_r2d_p
+
+  
+  SUBROUTINE histwrite_r3d_p(pfileid,pvarname,pitau,pdata,nbindex,nindex)
+    IMPLICIT NONE
+!-
+    INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex)
+    REAL,DIMENSION(:,:,:),INTENT(IN) :: pdata
+    CHARACTER(LEN=*),INTENT(IN) :: pvarname
+  
+    STOP 'histwrite_r3d_p !!!'
+    
+  END SUBROUTINE histwrite_r3d_p
+
+
+END MODULE ioipsl_para
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_mpi_data.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_mpi_data.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_mpi_data.F90	(revision 5166)
@@ -0,0 +1,431 @@
+! Definition and allocation of parallel datas for MPI.
+! Initialization of parallel or sequentiel IOs.
+! Definition of Load Balancing functions.
+
+!-
+!- $Header: $
+!- 
+
+MODULE mod_orchidee_mpi_data
+
+!-
+  USE defprec
+  USE ioipsl
+
+  IMPLICIT NONE
+
+!-
+#include "src_parallel.h"
+!-
+!-
+! Unit for output messages
+  INTEGER(i_std), SAVE :: numout = 6
+!$OMP THREADPRIVATE(numout)
+
+  INTEGER,SAVE :: mpi_size                                            !! Number of parallel processes
+  INTEGER,SAVE :: mpi_rank                                            !! my rank num
+  INTEGER,SAVE :: mpi_rank_root                                       !! rank of MPI root
+  LOGICAL,SAVE :: is_mpi_root                                         !! Only MPI root proc is true
+  LOGICAL,SAVE :: is_ok_mpi                                           
+
+  INTEGER(i_std),SAVE              :: nbp_mpi                         !! number of local continental points in each mpi group
+  INTEGER(i_std),SAVE              :: nbp_glo                         !! number of global continental points
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_mpi_para
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_mpi_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_mpi_para_end 
+
+  INTEGER,SAVE :: nbp_mpi_begin
+  INTEGER,SAVE :: nbp_mpi_end
+  
+
+  INTEGER(i_std),SAVE              :: iim_g                           !! Dimension of global fields for longitude
+  INTEGER(i_std),SAVE              :: jjm_g                           !! Dimension of global fields for latitude
+  ! i x j 2D points (not land points) index
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_nb           ! Number of 2D points for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_begin        ! First 2D point for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ij_para_end          ! Last 2D point for each mpi_rank block
+  ! i 2D index 
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_begin        ! First i index of 2D point for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: ii_para_end          ! Last i index of 2D point for each mpi_rank block
+  ! j 2D index
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_nb           ! Number of complete j lines for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_begin        ! First j index of 2D point for each mpi_rank block
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: jj_para_end          ! Last j index of 2D point for each mpi_rank block
+  
+  INTEGER,SAVE :: ii_begin
+  INTEGER,SAVE :: ii_end
+  INTEGER,SAVE :: jj_begin
+  INTEGER,SAVE :: jj_end
+  INTEGER,SAVE :: jj_nb
+  INTEGER,SAVE :: ij_begin
+  INTEGER,SAVE :: ij_end
+  INTEGER,SAVE :: ij_nb
+
+  INTEGER,SAVE :: MPI_COMM_ORCH
+  INTEGER,SAVE :: MPI_REAL_ORCH
+  INTEGER,SAVE :: MPI_INT_ORCH
+  LOGICAL, SAVE :: cpl_lmdz
+  
+  INTEGER,SAVE,ALLOCATABLE :: kindex_mpi (:)
+  INTEGER,SAVE             :: offset_mpi
+
+CONTAINS
+ 
+  SUBROUTINE Init_orchidee_mpi(communicator)
+  IMPLICIT NONE
+  INTEGER, OPTIONAL, INTENT(in) :: communicator
+  INTEGER :: COMM
+  INTEGER :: ierr
+    
+#ifdef CPP_PARA
+  INCLUDE 'mpif.h'
+
+
+    IF ( PRESENT(communicator) ) THEN
+       COMM=communicator
+    ELSE
+       CALL MPI_INIT(ierr)
+       COMM=MPI_COMM_WORLD
+    ENDIF
+
+    CALL MPI_COMM_SIZE(COMM,mpi_size,ierr)
+    CALL MPI_COMM_RANK(COMM,mpi_rank,ierr)
+    is_ok_mpi=.TRUE.
+
+#else
+    mpi_rank=0
+    mpi_size=1
+    is_ok_mpi=.FALSE.
+#endif
+    
+    mpi_rank_root=0
+
+    IF (mpi_rank==mpi_rank_root) THEN 
+      is_mpi_root=.TRUE.
+    ELSE
+      is_mpi_root=.FALSE.
+    ENDIF
+  
+    CALL Init_const_mpi(COMM)
+      
+  END SUBROUTINE Init_orchidee_mpi
+
+
+
+  SUBROUTINE Init_orchidee_mpi_data(arg_nbp_mpi,arg_kindex_mpi,arg_offset_mpi,COMM)
+
+  IMPLICIT NONE
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+    INTEGER, INTENT(IN) :: arg_nbp_mpi
+    INTEGER, INTENT(IN) :: arg_kindex_mpi(arg_nbp_mpi)
+    INTEGER, INTENT(IN) :: arg_offset_mpi
+    INTEGER, INTENT(IN) :: COMM
+
+    INTEGER :: i
+  
+#ifdef CPP_PARA
+    INTEGER :: ierr
+    is_ok_mpi=.TRUE.
+#else
+    is_ok_mpi=.FALSE.
+#endif
+
+    CALL init_const_mpi(COMM)
+
+    IF (is_ok_mpi) THEN    
+#ifdef CPP_PARA
+      CALL MPI_COMM_SIZE(MPI_COMM_ORCH,mpi_size,ierr)    
+      CALL MPI_COMM_RANK(MPI_COMM_ORCH,mpi_rank,ierr)
+#endif
+    ELSE
+      mpi_size=1
+      mpi_rank=0
+    ENDIF   
+    
+    IF (mpi_rank == 0) THEN
+      mpi_rank_root = 0
+      is_mpi_root = .true.
+    ENDIF
+    
+    ALLOCATE(nbp_mpi_para(0:mpi_size-1))
+    ALLOCATE(nbp_mpi_para_begin(0:mpi_size-1))
+    ALLOCATE(nbp_mpi_para_end(0:mpi_size-1))    
+    ALLOCATE(jj_para_nb(0:mpi_size-1))
+    ALLOCATE(jj_para_begin(0:mpi_size-1))
+    ALLOCATE(jj_para_end(0:mpi_size-1))
+    ALLOCATE(ii_para_begin(0:mpi_size-1))
+    ALLOCATE(ii_para_end(0:mpi_size-1))    
+    ALLOCATE(ij_para_nb(0:mpi_size-1))
+    ALLOCATE(ij_para_begin(0:mpi_size-1))
+    ALLOCATE(ij_para_end(0:mpi_size-1))
+    
+
+    nbp_mpi=arg_nbp_mpi
+    ALLOCATE(kindex_mpi(nbp_mpi))
+    kindex_mpi(:)=arg_kindex_mpi(:)
+    
+    offset_mpi=arg_offset_mpi
+    
+    IF (is_ok_mpi) THEN
+#ifdef CPP_PARA
+      CALL MPI_AllGather(nbp_mpi,1,MPI_INT_ORCH,nbp_mpi_para,1,MPI_INT_ORCH,MPI_COMM_ORCH,ierr)
+#endif
+    ELSE
+      nbp_mpi_para(0)=nbp_mpi
+    ENDIF
+    
+    nbp_mpi_para_begin(0)=1
+    nbp_mpi_para_end(0)=nbp_mpi_para(0)
+    DO i=1,mpi_size-1
+      nbp_mpi_para_begin(i)=nbp_mpi_para_end(i-1)+1
+      nbp_mpi_para_end(i)=nbp_mpi_para_begin(i)+nbp_mpi_para(i)-1
+    ENDDO
+    nbp_mpi_begin=nbp_mpi_para_begin(mpi_rank)
+    nbp_mpi_end=nbp_mpi_para_end(mpi_rank)
+    
+    
+    IF (mpi_rank==mpi_size-1) THEN
+      ij_end=iim_g*jjm_g
+    ELSE
+      ij_end=kindex_mpi(nbp_mpi)+offset_mpi
+    ENDIF
+
+    IF (is_ok_mpi) THEN    
+#ifdef CPP_PARA    
+      CALL MPI_Allgather(ij_end,1,MPI_INT_ORCH,ij_para_end,1,MPI_INT_ORCH,MPI_COMM_ORCH,ierr)
+#endif
+    ELSE
+      ij_para_end(0)=ij_end
+    ENDIF
+    
+    ij_para_begin(0)=1
+    ij_para_nb(0)=ij_para_end(0)-ij_para_begin(0)+1
+    
+    DO i=1,mpi_size-1
+      ij_para_begin(i)=ij_para_end(i-1)+1
+      ij_para_nb(i)=ij_para_end(i)-ij_para_begin(i)+1
+    ENDDO
+    
+    DO i=0,mpi_size-1
+      jj_para_begin(i)=(ij_para_begin(i)-1)/iim_g + 1
+      jj_para_end(i)=(ij_para_end(i)-1)/iim_g + 1
+      jj_para_nb(i)=jj_para_end(i)-jj_para_begin(i)+1
+          
+      ii_para_begin(i)=MOD(ij_para_begin(i)-1,iim_g)+1
+      ii_para_end(i)=MOD(ij_para_end(i)-1,iim_g)+1
+    ENDDO
+
+   
+    ij_nb=ij_para_nb(mpi_rank)
+    ij_begin=ij_para_begin(mpi_rank)
+    ij_end=ij_para_end(mpi_rank)
+        
+    jj_nb=jj_para_nb(mpi_rank)
+    jj_begin=jj_para_begin(mpi_rank)
+    jj_end=jj_para_end(mpi_rank)
+    
+    ii_begin=ii_para_begin(mpi_rank)
+    ii_end=ii_para_end(mpi_rank)
+        
+      
+    CALL print_mpi_data
+  
+    
+  END SUBROUTINE Init_orchidee_mpi_data
+  
+  SUBROUTINE init_const_mpi(COMM)
+
+  IMPLICIT NONE
+    INTEGER :: COMM
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+    
+    MPI_COMM_ORCH=COMM
+    
+    IF (i_std==i_4) THEN
+       MPI_INT_ORCH=MPI_INTEGER4
+    ELSEIF (i_std==i_8) THEN
+       MPI_INT_ORCH=MPI_INTEGER8
+    ELSE
+       MPI_INT_ORCH=MPI_INTEGER
+    ENDIF
+         
+    IF (r_std==r_4) THEN
+       MPI_REAL_ORCH=MPI_REAL4
+    ELSEIF (r_std==r_8) THEN
+       MPI_REAL_ORCH=MPI_REAL8
+    ELSE
+       MPI_REAL_ORCH=MPI_REAL
+    ENDIF
+#endif
+
+  END SUBROUTINE init_const_mpi
+
+  SUBROUTINE Finalize_mpi
+
+  IMPLICIT NONE
+#ifdef CPP_PARA
+  include 'mpif.h'  
+  INTEGER :: ierr
+
+  CALL MPI_FINALIZE(ierr)
+#endif
+   
+  END SUBROUTINE Finalize_mpi
+  
+  SUBROUTINE print_mpi_data
+
+  IMPLICIT NONE
+    
+    WRITE(numout,*) '==== MPI DOMAIN ===='
+    WRITE(numout,*) '     ----------     '
+    WRITE(numout,*) 'mpi_size',mpi_size
+    WRITE(numout,*) 'mpi_rank',mpi_rank
+    WRITE(numout,*) 'is_mpi_root',is_mpi_root
+    WRITE(numout,*) 'mpi_rank_root',mpi_rank_root
+
+    WRITE(numout,*) 'nbp_mpi_begin=',nbp_mpi_begin
+    WRITE(numout,*) 'nbp_mpi_end  =',nbp_mpi_end
+    WRITE(numout,*) 'nbp_mpi=',nbp_mpi
+          
+    WRITE(numout,*) 'ij_begin=',ij_begin
+    WRITE(numout,*) 'ij_end=',ij_end
+    WRITE(numout,*) 'ij_nb=',ij_nb
+    WRITE(numout,*) 'jj_begin=',jj_begin
+    WRITE(numout,*) 'jj_end=',jj_end
+    WRITE(numout,*) 'jj_nb=',jj_nb	
+    WRITE(numout,*) 'ii_begin=',ii_begin
+    WRITE(numout,*) 'ii_end=',ii_end
+    
+    WRITE(numout,*) 'offset_mpi',offset_mpi
+    WRITE(numout,*) 'nbp_mpi_para_begin=',nbp_mpi_para_begin
+    WRITE(numout,*) 'nbp_mpi_para_end  =',nbp_mpi_para_end
+    WRITE(numout,*) 'nbp_mpi_para=',nbp_mpi_para
+          
+    WRITE(numout,*) 'ij_para_begin=',ij_para_begin
+    WRITE(numout,*) 'ij_para_end=',ij_para_end
+    WRITE(numout,*) 'ij_para_nb=',ij_para_nb
+    WRITE(numout,*) 'jj_para_begin=',jj_para_begin
+    WRITE(numout,*) 'jj_para_end=',jj_para_end
+    WRITE(numout,*) 'jj_para_nb=',jj_para_nb	
+    WRITE(numout,*) 'ii_para_begin=',ii_para_begin
+    WRITE(numout,*) 'ii_para_end=',ii_para_end
+  
+  END SUBROUTINE print_mpi_data
+  
+ SUBROUTINE Read_Load_balance(NbPoints,Nbpoints_loc)
+
+    IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: NbPoints
+    INTEGER,INTENT(OUT) :: Nbpoints_loc(0:mpi_size-1)
+    INTEGER :: i,s
+    INTEGER :: ierr
+    
+#ifdef CPP_PARA
+    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
+    INTEGER :: j
+    INTEGER :: unit_number=10
+#endif   
+
+#ifdef CPP_PARA
+    OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='old',FORM='formatted',IOSTAT=ierr) 
+#else
+    ierr=1
+#endif   
+    Nbpoints_loc(:) = 0
+
+    s=0
+#ifdef CPP_PARA  
+    IF (ierr==0) THEN
+       i=0
+       !- Reading for any balancing file (even with a bad structure)
+       DO WHILE (i < mpi_size .AND. ierr == 0) 
+          READ (unit_number,*,IOSTAT=ierr) j,Nbpoints_loc(i)
+          s=s+Nbpoints_loc(i)
+          i=i+1
+       ENDDO
+       CLOSE(unit_number)
+    ENDIF
+#endif   
+    
+    !- Correction of bad balancing file (or an empty file) => same nb of points for each procs
+    IF (ierr/=0 .OR. s/=Nbpoints) THEN
+       DO i=0,mpi_size-1
+          Nbpoints_loc(i)=Nbpoints/mpi_size
+          IF (MOD(Nbpoints,mpi_size) > i) Nbpoints_loc(i)=Nbpoints_loc(i)+1
+       ENDDO
+    ENDIF
+    
+  END SUBROUTINE Read_Load_balance
+  
+  SUBROUTINE Write_Load_balance(times)
+    IMPLICIT NONE
+    REAL,INTENT(IN) :: times
+  
+    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
+    INTEGER :: unit_number=10
+    INTEGER :: i,ierr
+    REAL :: All_Times(0:mpi_size-1)
+    REAL :: average
+    REAL :: efficiency
+    INTEGER :: dp,S
+    INTEGER :: New_nbpoints(0:mpi_size-1)
+    
+    WRITE(numout,*) 'time',times
+
+    IF (is_ok_mpi) THEN
+#ifdef CPP_PARA
+      CALL MPI_GATHER(times,1,MPI_REAL_ORCH,All_times,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+#endif
+    ELSE
+      All_times(:)=times
+    ENDIF
+    
+    IF (is_mpi_root) WRITE(numout,*) 'ALL_times',All_times
+
+    IF (is_mpi_root) THEN
+     
+       OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='replace',FORM='formatted',IOSTAT=ierr)
+       
+       average=sum(All_times(:))/mpi_size
+       DO i=0,mpi_size-1
+          efficiency=All_times(i)/nbp_mpi_para(i)
+          New_nbpoints(i)=Nbp_mpi_para(i)-(All_times(i)-average)/efficiency
+       ENDDO
+       
+       S=sum(new_nbpoints(:))
+       dp=nbp_glo-S
+       
+       IF ( dp > 0 ) THEN
+          DO WHILE ( dp > 0 )
+             New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))+1
+             dp=dp-1
+          ENDDO
+       ELSE
+          dp=-dp
+          DO WHILE ( dp > 0 )
+             New_nbpoints(MOD(dp,mpi_size))=New_nbpoints(MOD(dp,mpi_size))-1
+             dp=dp-1
+          ENDDO
+       ENDIF
+       
+
+       ! If this algorithm diverge, we use previous repartition.
+       IF ( ANY(New_nbpoints(:) .LE. 0) ) THEN
+          New_nbpoints(:)=Nbp_mpi_para(:)
+       ENDIF
+       
+       DO i=0,mpi_size-1
+          WRITE(Unit_number,*) i,New_nbpoints(i)
+       ENDDO
+       CLOSE(Unit_number)
+    ENDIF
+
+  END SUBROUTINE Write_Load_Balance
+  
+END MODULE mod_orchidee_mpi_data
+
+#include "mpi_dummy.h"
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_mpi_transfert.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_mpi_transfert.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_mpi_transfert.F90	(revision 5166)
@@ -0,0 +1,2945 @@
+! Low level MPI parallel communication encapsulations for ORCHIDEE.
+
+!-
+!- $Header: $
+!-
+
+MODULE mod_orchidee_mpi_transfert
+  !-
+  USE defprec
+  USE mod_orchidee_mpi_data
+  USE timer
+  !-
+  IMPLICIT NONE
+  !-
+#include "src_parallel.h"
+  !-
+
+  INTERFACE bcast_mpi
+     MODULE PROCEDURE bcast_mpi_c, bcast_mpi_c1,                           &
+          bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
+          bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
+          bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
+  END INTERFACE
+
+  INTERFACE scatter_mpi
+     MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3, &
+          scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, &
+          scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3
+  END INTERFACE
+
+  INTERFACE gather_mpi_s
+     MODULE PROCEDURE gather_mpi_is, &
+          gather_mpi_rs, &
+          gather_mpi_ls
+  END INTERFACE
+
+  INTERFACE gather_mpi
+     MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3, &
+          gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, &
+          gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3  
+  END INTERFACE
+
+  INTERFACE scatter2D_mpi
+     MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
+          scatter2D_mpi_r0,scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
+          scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
+  END INTERFACE
+
+  INTERFACE gather2D_mpi
+     MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
+          gather2D_mpi_r0,gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
+          gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
+  END INTERFACE
+
+  INTERFACE reduce_sum_mpi
+     MODULE PROCEDURE reduce_sum_mpi_i,reduce_sum_mpi_i1,reduce_sum_mpi_i2,reduce_sum_mpi_i3,reduce_sum_mpi_i4, &
+          reduce_sum_mpi_r,reduce_sum_mpi_r1,reduce_sum_mpi_r2,reduce_sum_mpi_r3,reduce_sum_mpi_r4
+  END INTERFACE
+
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_mpi_c(var)
+    IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=len(Var)),DIMENSION(1) :: Var1
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_mpi_root) &
+         Var1(1)=Var
+    CALL orch_bcast_mpi_cgen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_mpi_c
+
+  SUBROUTINE bcast_mpi_c1(var)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_cgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_c1
+
+
+  !! -- Les entiers -- !!
+
+  SUBROUTINE bcast_mpi_i(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var
+    INTEGER(i_std),DIMENSION(1) :: Var1
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_mpi_root) &
+         Var1(1)=Var
+    CALL orch_bcast_mpi_igen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_mpi_i
+
+  SUBROUTINE bcast_mpi_i1(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var(:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_i1
+
+  SUBROUTINE bcast_mpi_i2(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var(:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_i2
+
+  SUBROUTINE bcast_mpi_i3(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var(:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_i3
+
+  SUBROUTINE bcast_mpi_i4(var)
+    IMPLICIT NONE
+    INTEGER(i_std),INTENT(INOUT) :: Var(:,:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_i4
+
+
+  !! -- Les reels -- !!
+
+  SUBROUTINE bcast_mpi_r(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var
+    REAL(r_std),DIMENSION(1) :: Var1
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_mpi_root) &
+         Var1(1)=Var
+    CALL orch_bcast_mpi_rgen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_mpi_r
+
+  SUBROUTINE bcast_mpi_r1(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var(:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_r1
+
+  SUBROUTINE bcast_mpi_r2(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var(:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_r2
+
+  SUBROUTINE bcast_mpi_r3(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var(:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_r3
+
+  SUBROUTINE bcast_mpi_r4(var)
+    IMPLICIT NONE
+    REAL(r_std),INTENT(INOUT) :: Var(:,:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_r4
+
+  !! -- Les booleans -- !!
+
+  SUBROUTINE bcast_mpi_l(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL,DIMENSION(1) :: Var1
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_mpi_root) &
+         Var1(1)=Var
+    CALL orch_bcast_mpi_lgen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_mpi_l
+
+  SUBROUTINE bcast_mpi_l1(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_l1
+
+  SUBROUTINE bcast_mpi_l2(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_l2
+
+  SUBROUTINE bcast_mpi_l3(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_l3
+
+  SUBROUTINE bcast_mpi_l4(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL orch_bcast_mpi_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_mpi_l4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(nbp_glo) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi) :: VarOut
+
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_i
+
+  SUBROUTINE scatter_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_i1
+
+  SUBROUTINE scatter_mpi_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else    
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_i2
+
+  SUBROUTINE scatter_mpi_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else    
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_igen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_mpi_igen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_i3
+
+
+  SUBROUTINE scatter_mpi_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,1)
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_r
+
+  SUBROUTINE scatter_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_r1
+
+  SUBROUTINE scatter_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter_mpi_r2
+
+  SUBROUTINE scatter_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_rgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_mpi_rgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_r3
+
+
+  SUBROUTINE scatter_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,1)
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l
+
+  SUBROUTINE scatter_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l1
+
+  SUBROUTINE scatter_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l2
+
+  SUBROUTINE scatter_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    IF (is_mpi_root) THEN
+       CALL orch_scatter_mpi_lgen(VarIn,Varout,SIZE(VarIn,1),SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter_mpi_lgen(dummy,Varout,1,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather_mpi_is(VarIn, VarOut)
+    USE mod_orchidee_mpi_data
+    USE timer
+
+    IMPLICIT NONE
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER(i_std),INTENT(IN) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std) :: nb,i,index_para,rank
+    INTEGER(i_std) :: ierr
+    LOGICAL :: flag=.FALSE.
+    LOGICAL, PARAMETER :: check=.FALSE.
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn
+    RETURN
+#else
+
+    IF (timer_state(timer_mpi)==running) THEN
+      flag=.TRUE.
+    ELSE
+      flag=.FALSE.
+    ENDIF
+    
+    IF (flag) CALL suspend_timer(timer_mpi)
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_is VarIn=",VarIn    
+
+#ifdef CPP_PARA
+    CALL MPI_GATHER(VarIn,1,MPI_INT_ORCH,VarOut,1,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+#endif
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_is VarOut=",VarOut
+    IF (flag) CALL resume_timer(timer_mpi)
+#endif
+  END SUBROUTINE gather_mpi_is
+
+  SUBROUTINE gather_mpi_rs(VarIn, VarOut)
+    USE mod_orchidee_mpi_data
+    USE timer
+
+    IMPLICIT NONE
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    REAL(r_std),INTENT(IN) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std) :: nb,i,index_para,rank
+    INTEGER(i_std) :: ierr
+    LOGICAL :: flag=.FALSE.
+    LOGICAL, PARAMETER :: check=.FALSE.
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn
+    RETURN
+#else
+
+    IF (timer_state(timer_mpi)==running) THEN
+      flag=.TRUE.
+    ELSE
+      flag=.FALSE.
+    ENDIF
+    
+    IF (flag) CALL suspend_timer(timer_mpi)
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_rs VarIn=",VarIn    
+
+#ifdef CPP_PARA
+    CALL MPI_GATHER(VarIn,1,MPI_REAL_ORCH,VarOut,1,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+#endif
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_rs VarOut=",VarOut
+
+    IF (flag) CALL resume_timer(timer_mpi)
+#endif
+  END SUBROUTINE gather_mpi_rs
+
+  SUBROUTINE gather_mpi_ls(VarIn, VarOut)
+    USE mod_orchidee_mpi_data
+    USE timer
+
+    IMPLICIT NONE
+
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    LOGICAL,INTENT(IN) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std) :: nb,i,index_para,rank
+    INTEGER(i_std) :: ierr
+    LOGICAL :: flag=.FALSE.
+    LOGICAL, PARAMETER :: check=.FALSE.
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn
+    RETURN
+#else
+
+    IF (timer_state(timer_mpi)==running) THEN
+      flag=.TRUE.
+    ELSE
+      flag=.FALSE.
+    ENDIF
+    
+    IF (flag) CALL suspend_timer(timer_mpi)
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_ls VarIn=",VarIn    
+
+#ifdef CPP_PARA
+    CALL MPI_GATHER(VarIn,1,MPI_LOGICAL,VarOut,1,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr)
+#endif
+
+    IF (check) &
+         WRITE(numout,*) "gather_mpi_ls VarOut=",VarOut
+    IF (flag) CALL resume_timer(timer_mpi)
+#endif
+  END SUBROUTINE gather_mpi_ls
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i1
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_igen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather_mpi_igen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_i3
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_mpi_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r1
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_r3
+
+!!!!! --> Les booleen
+
+  SUBROUTINE gather_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,1)      
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarIn,2)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2))
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l1
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l2
+
+!!!!!
+
+  SUBROUTINE gather_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1),SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter2D_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
+    ELSE
+       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,1)
+    ENDIF
+
+
+#endif
+  END SUBROUTINE scatter2D_mpi_i
+
+  SUBROUTINE scatter2D_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_i1
+
+  SUBROUTINE scatter2D_mpi_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+
+#endif
+  END SUBROUTINE scatter2D_mpi_i2
+
+  SUBROUTINE scatter2D_mpi_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_igen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+       CALL orch_scatter2D_mpi_igen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_i3
+
+
+  SUBROUTINE scatter2D_mpi_r0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1),1)
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1)      
+    ENDIF
+
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r0
+
+  SUBROUTINE scatter2D_mpi_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(INOUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r
+
+  SUBROUTINE scatter2D_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r1
+
+  SUBROUTINE scatter2D_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r2
+
+  SUBROUTINE scatter2D_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:)  :: VarIn
+    REAL(r_std),INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_rgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+       CALL orch_scatter2D_mpi_rgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_r3
+
+
+  SUBROUTINE scatter2D_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),1)
+    ELSE
+       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_l
+
+  SUBROUTINE scatter2D_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(INOUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,SIZE(VarOut,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3))
+    ELSE
+       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_l1
+
+  SUBROUTINE scatter2D_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_l2
+
+  SUBROUTINE scatter2D_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:)  :: VarIn
+    LOGICAL,INTENT(INOUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    LOGICAL,DIMENSION(1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_scatter2D_mpi_lgen(VarIn,VarOut,SIZE(VarIn,1)*SIZE(VarIn,2),SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+       CALL orch_scatter2D_mpi_lgen(dummy,VarOut,1,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_mpi_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather2D_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
+    ELSE
+       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_i
+
+  SUBROUTINE gather2D_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_i1
+
+  SUBROUTINE gather2D_mpi_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_i2
+
+  SUBROUTINE gather2D_mpi_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_igen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+       CALL orch_gather2D_mpi_igen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_i3
+
+
+  SUBROUTINE gather2D_mpi_r0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1),1)
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r0
+
+  SUBROUTINE gather2D_mpi_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r
+
+  SUBROUTINE gather2D_mpi_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r1
+
+  SUBROUTINE gather2D_mpi_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r2
+
+  SUBROUTINE gather2D_mpi_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_rgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+       CALL orch_gather2D_mpi_rgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_r3
+
+
+  SUBROUTINE gather2D_mpi_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),1)
+    ELSE
+       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_l
+
+  SUBROUTINE gather2D_mpi_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,SIZE(VarIn,3)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3))
+    ELSE
+       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_l1
+
+  SUBROUTINE gather2D_mpi_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_l2
+
+  SUBROUTINE gather2D_mpi_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL,DIMENSION(1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5)) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_gather2D_mpi_lgen(VarIn,VarOut,SIZE(VarOut,1)*SIZE(VarOut,2),SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+       CALL orch_gather2D_mpi_lgen(VarIn,dummy,1,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_mpi_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_mpi_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN)  :: VarIn
+    INTEGER(i_std),INTENT(OUT) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: Var1
+    INTEGER(i_std),DIMENSION(1) :: Var2
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut=VarIn
+    RETURN
+#else
+    Var1(1)=VarIn
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(Var1,Var2,1)
+       VarOut=Var2(1)
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(Var1,dummy,1)
+       VarOut=VarIn
+    ENDIF
+#endif
+  END SUBROUTINE reduce_sum_mpi_i
+
+  SUBROUTINE reduce_sum_mpi_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_i1
+
+  SUBROUTINE reduce_sum_mpi_i2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_i2
+
+  SUBROUTINE reduce_sum_mpi_i3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_i3
+
+  SUBROUTINE reduce_sum_mpi_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER(i_std),INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER(i_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    INTEGER(i_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_i4
+
+
+  SUBROUTINE reduce_sum_mpi_r(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN)  :: VarIn
+    REAL(r_std),INTENT(OUT) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: Var1
+    REAL(r_std),DIMENSION(1) :: Var2
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut=VarIn
+    RETURN
+#else
+
+    Var1(1)=VarIn
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(Var1,Var2,1)
+       VarOut=Var2(1)
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(Var1,dummy,1)
+       VarOut=VarIn
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r
+
+  SUBROUTINE reduce_sum_mpi_r1(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r1
+
+  SUBROUTINE reduce_sum_mpi_r2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r2
+
+  SUBROUTINE reduce_sum_mpi_r3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r3
+
+  SUBROUTINE reduce_sum_mpi_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL(r_std),INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL(r_std),INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL(r_std),DIMENSION(1) :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_mpi_root) THEN
+       CALL orch_reduce_sum_mpi_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+       CALL orch_reduce_sum_mpi_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+
+#endif
+  END SUBROUTINE reduce_sum_mpi_r4
+
+
+END MODULE mod_orchidee_mpi_transfert
+
+#ifdef CPP_PARA
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE orch_bcast_mpi_cgen(var,nb)
+  USE mod_orchidee_mpi_data
+  USE timer
+
+  IMPLICIT NONE
+
+  CHARACTER(LEN=*),DIMENSION(nb),INTENT(INOUT) :: Var
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+  
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+  
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_cgen before bcast Var",Var    
+  IF (flag) CALL suspend_timer(timer_mpi)
+  CALL MPI_BCAST(Var,nb*LEN(Var(1)),MPI_CHARACTER,mpi_rank_root,MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_cgen after bcast Var",Var
+
+END SUBROUTINE orch_bcast_mpi_cgen
+
+SUBROUTINE orch_bcast_mpi_igen(var,nb)
+  USE mod_orchidee_mpi_data
+  USE timer
+  IMPLICIT NONE
+
+  INTEGER(i_std),DIMENSION(nb),INTENT(INOUT) :: Var
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_igen before bcast Var",Var
+  CALL MPI_BCAST(Var,nb,MPI_INT_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_igen after bcast Var",Var    
+
+END SUBROUTINE orch_bcast_mpi_igen
+
+SUBROUTINE orch_bcast_mpi_rgen(var,nb)
+  USE mod_orchidee_mpi_data
+  USE timer
+
+  IMPLICIT NONE
+
+  REAL(r_std),DIMENSION(nb),INTENT(INOUT) :: Var
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_rgen before bcast Var",Var
+  IF (flag) CALL suspend_timer(timer_mpi)
+  CALL MPI_BCAST(Var,nb,MPI_REAL_ORCH,mpi_rank_root,MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_rgen after bcast Var",Var
+
+END SUBROUTINE orch_bcast_mpi_rgen
+
+SUBROUTINE orch_bcast_mpi_lgen(var,nb)
+  USE mod_orchidee_mpi_data
+  USE timer
+
+  IMPLICIT NONE
+
+  LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_lgen before bcast Var",Var
+  IF (flag) CALL suspend_timer(timer_mpi)
+  CALL MPI_BCAST(Var,nb,MPI_LOGICAL,mpi_rank_root,MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_bcast_mpi_lgen after bcast Var",Var
+
+END SUBROUTINE orch_bcast_mpi_lgen
+
+
+SUBROUTINE orch_scatter_mpi_igen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_mpi_data
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: nbp
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
+  INTEGER(i_std),INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  INTEGER(i_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_Para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_Para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter_mpi_igen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter_mpi_igen VarTmp",VarTmp
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INT_ORCH,VarOut,nbp_mpi*dimsize,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter_mpi_igen VarOut",VarOut
+
+END SUBROUTINE orch_scatter_mpi_igen
+
+SUBROUTINE orch_scatter_mpi_rgen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_mpi_data
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  REAL(r_std),INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
+  REAL(r_std),INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  REAL(r_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter_mpi_rgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter_mpi_rgen VarTmp",VarTmp
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_ORCH,VarOut,nbp_mpi*dimsize,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter_mpi_rgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter_mpi_rgen
+
+SUBROUTINE orch_scatter_mpi_lgen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_mpi_data
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  LOGICAL,INTENT(IN),DIMENSION(nbp,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp(Index_para:Index_para+nb-1)=VarIn(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter_mpi_lgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter_mpi_lgen VarTmp",VarTmp
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,nbp_mpi*dimsize,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter_mpi_lgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter_mpi_lgen
+
+SUBROUTINE orch_gather_mpi_igen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_mpi_data
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  INTEGER(i_std),INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  INTEGER(i_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  INTEGER(i_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+
+  ENDIF
+
+  CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_INT_ORCH,VarTmp,counts,displs,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        DO i=1,dimsize
+           VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_igen VarOut=",VarOut
+  IF (flag) CALL resume_timer(timer_mpi)
+
+END SUBROUTINE orch_gather_mpi_igen
+
+SUBROUTINE orch_gather_mpi_rgen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_mpi_data
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  REAL(r_std),INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  REAL(r_std),INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  REAL(r_std),DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_rgen VarIn=",VarIn    
+  CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_REAL_ORCH,VarTmp,counts,displs,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_rgen dimsize,VarTmp=",dimsize,VarTmp
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        DO i=1,dimsize
+           VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_rgen VarOut=",VarOut
+  IF (flag) CALL resume_timer(timer_mpi)
+
+END SUBROUTINE orch_gather_mpi_rgen
+
+SUBROUTINE orch_gather_mpi_lgen(VarIn, VarOut, nbp, dimsize)
+  USE mod_orchidee_mpi_data
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp
+  LOGICAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1) :: counts
+  LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
+
+  INTEGER(i_std) :: nb,i,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_lgen VarIn=",VarIn    
+  CALL MPI_GATHERV(VarIn,nbp_mpi*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_lgen dimsize,VarTmp=",dimsize,VarTmp
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=nbp_mpi_para(rank)
+        DO i=1,dimsize
+           VarOut(nbp_mpi_para_begin(rank):nbp_mpi_para_end(rank),i)=VarTmp(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+  IF (check) &
+       WRITE(numout,*) "orch_gather_mpi_lgen VarOut=",VarOut
+  IF (flag) CALL resume_timer(timer_mpi)
+
+END SUBROUTINE orch_gather_mpi_lgen
+
+
+SUBROUTINE orch_scatter2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_mpi_data, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  INTEGER(i_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
+  INTEGER(i_std),INTENT(OUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: counts
+  INTEGER(i_std),DIMENSION(dimsize*iim*jjm)   :: VarTmp1
+  INTEGER(i_std),DIMENSION(ij_nb,dimsize)     :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter2D_mpi_igen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp1",VarTmp1
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_INT_ORCH,VarTmp2,ij_nb*dimsize,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_igen VarTmp2",VarTmp2
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
+     ENDDO
+  ENDDO
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_igen VarOut",VarOut
+
+END SUBROUTINE orch_scatter2D_mpi_igen
+
+SUBROUTINE orch_scatter2D_mpi_rgen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_mpi_data, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  REAL(r_std),INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
+  REAL(r_std),INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: counts
+  REAL(r_std),DIMENSION(dimsize*iim*jjm)   :: VarTmp1
+  REAL(r_std),DIMENSION(ij_nb,dimsize)     :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter2D_mpi_rgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp1",VarTmp1
+     ENDIF
+  ENDIF
+  nb=ij_nb*dimsize
+  IF (check) &
+       WRITE(numout,*) "ij_nb*dimsize",ij_nb*dimsize
+
+  CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_REAL_ORCH,VarTmp2,nb,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_rgen VarTmp2",VarTmp2
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
+     ENDDO
+  ENDDO
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_rgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter2D_mpi_rgen
+
+SUBROUTINE orch_scatter2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_mpi_data, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  LOGICAL,INTENT(IN),DIMENSION(nbp2D,dimsize) :: VarIn
+  LOGICAL,INTENT(INOUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)      :: counts
+  LOGICAL,DIMENSION(dimsize*iim*jjm)   :: VarTmp1
+  LOGICAL,DIMENSION(ij_nb,dimsize)     :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+           VarTmp1(Index_para:Index_para+nb-1)=VarIn(ij_para_begin(rank):ij_para_end(rank),i)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+     IF (check) THEN
+        WRITE(numout,*) "orch_scatter2D_mpi_lgen VarIn",VarIn
+        WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp1",VarTmp1
+     ENDIF
+  ENDIF
+
+  CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_LOGICAL,VarTmp2,ij_nb*dimsize,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_lgen VarTmp2",VarTmp2
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarOut(ij+ii_begin-1,i)=VarTmp2(ij,i)
+     ENDDO
+  ENDDO
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_scatter2D_mpi_lgen VarOut",VarOut
+
+END SUBROUTINE orch_scatter2D_mpi_lgen
+
+
+SUBROUTINE orch_gather2D_mpi_igen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_mpi_data, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  INTEGER(i_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize)  :: VarIn
+  INTEGER(i_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: counts
+  INTEGER(i_std),DIMENSION(ij_nb,dimsize)   :: VarTmp1
+  INTEGER(i_std),DIMENSION(dimsize*iim*jjm) :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL,PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather2D_mpi_igen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+  ENDIF
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
+     ENDDO
+  ENDDO
+
+  IF (check) THEN
+     WRITE(numout,*) "orch_gather2D_mpi_igen VarIn=",VarIn    
+     WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp1=",VarTmp1
+  ENDIF
+  CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_INT_ORCH,VarTmp2,counts,displs,   &
+       MPI_INT_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_igen VarTmp2=",VarTmp2
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        DO i=1,dimsize
+           VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_igen VarOut=",VarOut
+
+END SUBROUTINE orch_gather2D_mpi_igen
+
+SUBROUTINE orch_gather2D_mpi_rgen(VarIn, VarOut, nbp2D,dimsize)
+  USE mod_orchidee_mpi_data, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  REAL(r_std),INTENT(IN),DIMENSION(iim*jj_nb,dimsize)  :: VarIn
+  REAL(r_std),INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: counts
+  REAL(r_std),DIMENSION(ij_nb,dimsize)   :: VarTmp1
+  REAL(r_std),DIMENSION(dimsize*iim*jjm) :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL,PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather2D_mpi_rgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
+     ENDDO
+  ENDDO
+
+  IF (check) THEN
+     WRITE(numout,*) "orch_gather2D_mpi_rgen VarIn=",VarIn    
+     WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp1=",VarTmp1
+  ENDIF
+  CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_REAL_ORCH,VarTmp2,counts,displs,   &
+       MPI_REAL_ORCH,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_rgen VarTmp2=",VarTmp2
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        DO i=1,dimsize
+           VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_rgen VarOut=",VarOut
+
+END SUBROUTINE orch_gather2D_mpi_rgen
+
+SUBROUTINE orch_gather2D_mpi_lgen(VarIn, VarOut, nbp2D, dimsize)
+  USE mod_orchidee_mpi_data, iim=>iim_g,jjm=>jjm_g
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),INTENT(IN) :: dimsize
+  INTEGER(i_std),INTENT(IN) :: nbp2D
+  LOGICAL,INTENT(IN),DIMENSION(iim*jj_nb,dimsize)  :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp2D,dimsize) :: VarOut
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: displs
+  INTEGER(i_std),DIMENSION(0:mpi_size-1)    :: counts
+  LOGICAL,DIMENSION(ij_nb,dimsize)   :: VarTmp1
+  LOGICAL,DIMENSION(dimsize*iim*jjm) :: VarTmp2
+
+  INTEGER(i_std) :: nb,i,ij,index_para,rank
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL,PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        displs(rank)=Index_para-1
+        counts(rank)=nb*dimsize
+	Index_para=Index_para+nb*dimsize
+     ENDDO
+     IF (check) &
+          WRITE(numout,*) "orch_gather2D_mpi_lgen nbp_mpi_para, displs, counts,Index_Para-1",nbp_mpi_para, displs, counts,Index_Para-1
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,ij_nb
+        VarTmp1(ij,i)=VarIn(ij+ii_begin-1,i)
+     ENDDO
+  ENDDO
+
+  IF (check) THEN
+     WRITE(numout,*) "orch_gather2D_mpi_lgen VarIn=",VarIn    
+     WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp1=",VarTmp1
+  ENDIF
+  CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_LOGICAL,VarTmp2,counts,displs,   &
+       MPI_LOGICAL,mpi_rank_root, MPI_COMM_ORCH,ierr)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_lgen VarTmp2=",VarTmp2
+
+  IF (is_mpi_root) THEN
+     Index_para=1
+     DO rank=0,mpi_size-1
+        nb=ij_para_nb(rank)
+        DO i=1,dimsize
+           VarOut(ij_para_begin(rank):ij_para_end(rank),i)=VarTmp2(Index_para:Index_para+nb-1)
+           Index_para=Index_para+nb
+        ENDDO
+     ENDDO
+  ENDIF
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_gather2D_mpi_lgen VarOut=",VarOut
+
+END SUBROUTINE orch_gather2D_mpi_lgen
+
+SUBROUTINE orch_reduce_sum_mpi_igen(VarIn,VarOut,nb)
+  USE mod_orchidee_mpi_data
+  USE timer
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),DIMENSION(nb),INTENT(IN) :: VarIn
+  INTEGER(i_std),DIMENSION(nb),INTENT(OUT) :: VarOut    
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_reduce_sum_mpi_igen VarIn",VarIn
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INT_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr)
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_reduce_sum_mpi_igen VarOut",VarOut
+
+END SUBROUTINE orch_reduce_sum_mpi_igen
+
+SUBROUTINE orch_reduce_sum_mpi_rgen(VarIn,VarOut,nb)
+  USE mod_orchidee_mpi_data
+  USE timer
+
+  IMPLICIT NONE
+
+  REAL(r_std),DIMENSION(nb),INTENT(IN) :: VarIn
+  REAL(r_std),DIMENSION(nb),INTENT(OUT) :: VarOut    
+  INTEGER(i_std),INTENT(IN) :: nb
+
+  INCLUDE 'mpif.h'
+
+  INTEGER(i_std) :: ierr
+  LOGICAL :: flag=.FALSE.
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF (timer_state(timer_mpi)==running) THEN
+     flag=.TRUE.
+  ELSE
+     flag=.FALSE.
+  ENDIF
+
+  IF (check) &
+       WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarIn",VarIn
+  IF (flag) CALL suspend_timer(timer_mpi)
+
+  CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_ORCH,MPI_SUM,mpi_rank_root,MPI_COMM_ORCH,ierr)
+
+  IF (flag) CALL resume_timer(timer_mpi)
+  IF (check) &
+       WRITE(numout,*) "orch_reduce_sum_mpi_rgen VarOut",VarOut
+
+END SUBROUTINE orch_reduce_sum_mpi_rgen
+
+#endif
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_omp_data.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_omp_data.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_omp_data.F90	(revision 5166)
@@ -0,0 +1,334 @@
+! Definition and allocation of parallel datas for OpenMP.
+
+!-
+!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/Attic/mod_orchidee_omp_data.F90,v 1.1.2.3 2008/11/05 10:08:25 ssipsl Exp $
+!- 
+
+MODULE mod_orchidee_omp_data
+
+!-
+  USE defprec
+  USE ioipsl
+
+  IMPLICIT NONE
+
+  ! Check all OpenMP transferts in ORCHIDEE : use this flag to debug synchronism with OpenMP 
+  LOGICAL, PARAMETER :: check_all_transfert=.FALSE.
+
+
+  INTEGER(i_std),SAVE :: omp_size
+  INTEGER(i_std),SAVE :: omp_rank
+  LOGICAL,SAVE :: is_omp_root
+  LOGICAL,SAVE :: is_ok_omp
+!$OMP  THREADPRIVATE(omp_rank,is_omp_root)
+  
+  INTEGER(i_std),SAVE,DIMENSION(:),ALLOCATABLE :: nbp_omp_para_nb
+  INTEGER(i_std),SAVE,DIMENSION(:),ALLOCATABLE :: nbp_omp_para_begin
+  INTEGER(i_std),SAVE,DIMENSION(:),ALLOCATABLE :: nbp_omp_para_end    
+  
+  INTEGER(i_std),SAVE :: nbp_omp
+  INTEGER(i_std),SAVE :: nbp_omp_begin
+  INTEGER(i_std),SAVE :: nbp_omp_end
+  INTEGER(i_std),SAVE :: offset_omp
+!$OMP  THREADPRIVATE(nbp_omp,nbp_omp_begin,nbp_omp_end,offset_omp)
+
+  ! Flag for each OMP process for ORCHIDEE to verify synchronization if function Synchro_Omp is used
+  LOGICAL,SAVE,ALLOCATABLE :: proc_synchro_omp(:)
+
+  INTEGER, SAVE :: numout_omp = -1
+!$OMP  THREADPRIVATE(numout_omp)
+
+  ! For debugging OpenMP processes : id of OMP function for each task.
+  ! If one task is not in the same function, we can see it.
+  INTEGER(i_std),SAVE,ALLOCATABLE,DIMENSION(:) :: omp_function
+  ! It is not SHARED.
+  ! List of values :
+  CHARACTER(LEN=28), PARAMETER :: omp_fct_name(-1:72) = (/ &
+           "Initialization              ", &
+           "Synchro_Omp                 ", &
+           "check_buffer_i              ", &
+           "check_buffer_r              ", &
+           "check_buffer_l              ", &
+           "bcast_omp_c                 ", &
+           "bcast_omp_i                 ", &
+           "bcast_omp_i1                ", &
+           "bcast_omp_i2                ", &
+           "bcast_omp_i3                ", &
+           "bcast_omp_i4                ", &
+           "bcast_omp_r                 ", &
+           "bcast_omp_r1                ", &
+           "bcast_omp_r2                ", &
+           "bcast_omp_r3                ", &
+           "bcast_omp_r4                ", &
+           "bcast_omp_l                 ", &
+           "bcast_omp_l1                ", &
+           "bcast_omp_l2                ", &
+           "bcast_omp_l3                ", &
+           "bcast_omp_l4                ", &
+           "scatter_omp_i               ", &
+           "scatter_omp_i1              ", &
+           "scatter_omp_i2              ", &
+           "scatter_omp_i3              ", &
+           "scatter_omp_r               ", &
+           "scatter_omp_r1              ", &
+           "scatter_omp_r2              ", &
+           "scatter_omp_r3              ", &
+           "scatter_omp_l               ", &
+           "scatter_omp_l1              ", &
+           "scatter_omp_l2              ", &
+           "scatter_omp_l3              ", &
+           "gather_omp_i0               ", &
+           "gather_omp_i                ", &
+           "gather_omp_i1               ", &
+           "gather_omp_i2               ", &
+           "gather_omp_i3               ", &
+           "gather_omp_r0               ", &
+           "gather_omp_r                ", &
+           "gather_omp_r1               ", &
+           "gather_omp_r2               ", &
+           "gather_omp_r3               ", &
+           "gather_omp_l0               ", &
+           "gather_omp_l                ", &
+           "gather_omp_l1               ", &
+           "gather_omp_l2               ", &
+           "gather_omp_l3               ", &
+           "reduce_sum_omp_i            ", &
+           "reduce_sum_omp_i1           ", &
+           "reduce_sum_omp_i2           ", &
+           "reduce_sum_omp_i3           ", &
+           "reduce_sum_omp_i4           ", &
+           "reduce_sum_omp_r            ", &
+           "reduce_sum_omp_r1           ", &
+           "reduce_sum_omp_r2           ", &
+           "reduce_sum_omp_r3           ", &
+           "reduce_sum_omp_r4           ", &
+           "orch_bcast_omp_cgen         ", &
+           "orch_bcast_omp_igen         ", &
+           "orch_bcast_omp_rgen         ", &
+           "orch_bcast_omp_lgen         ", &
+           "orch_scatter_omp_igen       ", &
+           "orch_scatter_omp_rgen       ", &
+           "orch_scatter_omp_lgen       ", &
+           "orch_gather_omp_simple_igen ", &
+           "orch_gather_omp_igen        ", &
+           "orch_gather_omp_simple_rgen ", &
+           "orch_gather_omp_rgen        ", &
+           "orch_gather_omp_simple_lgen ", &
+           "orch_gather_omp_lgen        ", &
+           "orch_reduce_sum_omp_igen    ", &
+           "orch_reduce_sum_omp_rgen    ", &
+           "check_buffer_c              " /)
+
+  ! Previous value for own omp_function
+  INTEGER, SAVE :: omp_previous
+!$OMP  THREADPRIVATE(omp_previous)
+
+CONTAINS
+
+    SUBROUTINE barrier2_omp()
+
+    IMPLICIT NONE
+
+!$OMP BARRIER
+!$OMP BARRIER
+
+  END SUBROUTINE barrier2_omp
+
+
+
+  
+  SUBROUTINE Init_orchidee_omp
+  IMPLICIT NONE
+  
+#ifdef CPP_OMP
+    IF (is_omp_root) THEN
+        is_ok_omp=.TRUE.
+    ENDIF
+#else    
+    is_ok_omp=.FALSE.
+#endif
+
+
+    IF (is_ok_omp) THEN
+      STOP 'Open MP is not yet implemented for driver'
+    ELSE
+      omp_size=1
+      omp_rank=0
+      is_omp_root=.TRUE.
+    ENDIF
+
+  END SUBROUTINE Init_orchidee_omp
+
+  SUBROUTINE Init_numout_omp(numout)
+    INTEGER, INTENT(in) :: numout
+    numout_omp=numout
+  END SUBROUTINE Init_numout_omp
+
+
+  SUBROUTINE Init_orchidee_omp_data(arg_omp_size,arg_omp_rank,arg_nbp_omp,arg_offset_omp)
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: arg_omp_size
+    INTEGER, INTENT(IN) :: arg_omp_rank
+    INTEGER, INTENT(IN) :: arg_nbp_omp
+    INTEGER, INTENT(IN) :: arg_offset_omp
+    
+    INTEGER    :: i
+    
+    
+    IF (arg_omp_rank==0) THEN
+      is_omp_root=.TRUE.
+    ELSE
+      is_omp_root=.FALSE.
+    ENDIF
+    
+#ifdef CPP_OMP
+    IF (is_omp_root) THEN
+        is_ok_omp=.TRUE.
+    ENDIF
+#else    
+    is_ok_omp=.FALSE.
+#endif
+
+    IF (is_omp_root) omp_size=arg_omp_size
+
+    CALL barrier2_omp()
+
+     omp_rank=arg_omp_rank
+    
+    IF (is_omp_root) THEN 
+      ALLOCATE(nbp_omp_para_nb(0:omp_size-1))
+      ALLOCATE(nbp_omp_para_begin(0:omp_size-1))
+      ALLOCATE(nbp_omp_para_end(0:omp_size-1))
+    ENDIF
+    
+    CALL barrier2_omp()
+    nbp_omp_para_nb(omp_rank)=arg_nbp_omp
+    CALL barrier2_omp()
+    
+    IF (is_omp_root) THEN
+
+      nbp_omp_para_begin(0)=1
+      nbp_omp_para_end(0)=nbp_omp_para_nb(0)
+
+      DO i=1,omp_size-1
+        nbp_omp_para_begin(i)=nbp_omp_para_end(i-1)+1
+        nbp_omp_para_end(i)=nbp_omp_para_begin(i)+nbp_omp_para_nb(i)-1
+      ENDDO
+
+    ENDIF
+
+    CALL barrier2_omp()
+     
+    nbp_omp=nbp_omp_para_nb(omp_rank)
+    nbp_omp_begin=nbp_omp_para_begin(omp_rank)
+    nbp_omp_end=nbp_omp_para_end(omp_rank)
+    
+    offset_omp=arg_offset_omp          
+    CALL Print_omp_data
+    
+    CALL Init_synchro_omp()
+    
+  END SUBROUTINE Init_orchidee_omp_data
+
+  SUBROUTINE print_omp_data
+  IMPLICIT NONE
+
+!$OMP CRITICAL  
+  PRINT *,'--------> ORCHIDEE TASK ',omp_rank
+  PRINT *,'omp_size =',omp_size
+  PRINT *,'omp_rank =',omp_rank
+  PRINT *,'is_omp_root =',is_omp_root
+  PRINT *,'offset_omp',offset_omp
+  PRINT *,'nbp_omp_para_nb =',nbp_omp_para_nb
+  PRINT *,'nbp_omp_para_begin =',nbp_omp_para_begin
+  PRINT *,'nbp_omp_para_end =',nbp_omp_para_end    
+  PRINT *,'nbp_omp =',nbp_omp
+  PRINT *,'nbp_omp_begin =',nbp_omp_begin
+  PRINT *,'nbp_omp_end =',nbp_omp_end    
+!$OMP END CRITICAL
+
+  END SUBROUTINE print_omp_data
+
+  SUBROUTINE Init_synchro_omp
+  IMPLICIT NONE
+    
+    IF (is_omp_root) THEN
+      ALLOCATE(proc_synchro_omp(0:omp_size-1))
+      proc_synchro_omp(:)=.FALSE.
+
+      IF ( check_all_transfert ) THEN
+         ALLOCATE(omp_function(0:omp_size-1))
+         omp_function(:)=-1
+      ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+  END SUBROUTINE Init_Synchro_omp
+  
+  SUBROUTINE Synchro_omp
+  IMPLICIT NONE
+    INTEGER iter
+    LOGICAL, PARAMETER :: check=.TRUE.
+    INTEGER, PARAMETER :: iter_max=1
+    INTEGER, PARAMETER :: print_iter=1
+
+    proc_synchro_omp(omp_rank)=.TRUE.
+    CALL barrier2_omp()
+
+    iter=0
+    DO WHILE (.NOT. ALL(proc_synchro_omp))
+       iter=iter+1
+       IF ( mod(iter,print_iter) == 0 ) THEN
+          IF (numout_omp > 0) THEN
+             WRITE(numout_omp,*) "ORCHIDEE SYNCHRO OMP : iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
+          ELSE
+             WRITE(*,*) "ORCHIDEE SYNCHRO OMP : iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
+          ENDIF
+       ENDIF
+       IF (check) THEN
+          IF (iter > iter_max) THEN
+             IF (numout_omp > 0) THEN
+                WRITE(numout_omp,*) "TOO MUCH WAIT in Synchro_Omp !! iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
+                WRITE(numout_omp,*) "We stop here"
+                WRITE(numout_omp,*) "omp_function : ",omp_function(:)
+             ELSE
+                WRITE(*,*) "TOO MUCH WAIT in Synchro_Omp !! iter ",iter," rank ",omp_rank," wait for ",proc_synchro_omp
+                WRITE(*,*) "We stop here"
+                WRITE(*,*) "omp_function : ",omp_function(:)
+             ENDIF
+#ifdef CPP_PARA
+             CALL MPI_ABORT(4)
+#endif     
+             STOP 'Fatal error from ORCHIDEE : Synchro_Omp failed'
+          ENDIF
+       ENDIF
+    CALL barrier2_omp()
+    ENDDO
+    CALL barrier2_omp()
+    proc_synchro_omp(omp_rank)=.FALSE.
+    CALL barrier2_omp()
+
+   END SUBROUTINE Synchro_omp
+
+   SUBROUTINE print_omp_function ()
+
+     IF ( check_all_transfert ) THEN
+        CALL barrier2_omp()
+        IF (numout_omp > 0) THEN
+           WRITE(numout_omp,*) omp_rank,&
+                " : ",omp_fct_name(omp_previous),'->',omp_fct_name(omp_function(omp_rank))
+           IF (MINVAL(omp_function(:)).LT.MAXVAL(omp_function(:))) &
+                WRITE(numout_omp,*) "!!! OMP ERROR : NO MORE SYNCHRO  !!!  ",omp_function(:)
+        ELSE
+           WRITE(*,*) omp_rank,&
+                " : ",omp_fct_name(omp_previous),'->',omp_fct_name(omp_function(omp_rank))
+           IF (MINVAL(omp_function(:)).LT.MAXVAL(omp_function(:))) &
+                WRITE(*,*) "!!! OMP ERROR : NO MORE SYNCHRO  !!!  ",omp_function(:)
+        ENDIF
+        CALL barrier2_omp()
+     ENDIF
+
+  END SUBROUTINE print_omp_function
+
+
+END MODULE mod_orchidee_omp_data
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_omp_transfert.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_omp_transfert.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_omp_transfert.F90	(revision 5166)
@@ -0,0 +1,2113 @@
+! Low level OpenMP parallel communication encapsulations for ORCHIDEE.
+
+!-
+!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/Attic/mod_orchidee_omp_transfert.F90,v 1.1.2.2 2008/08/29 14:01:40 ssipsl Exp $
+!-
+
+MODULE mod_orchidee_omp_transfert
+  !-
+  USE mod_orchidee_omp_data
+  USE ioipsl
+  !-
+  IMPLICIT NONE
+
+  PRIVATE
+  
+#ifdef CPP_OMP
+  ! Check OpenMP buffer sizes increase.
+  LOGICAL, PARAMETER :: check_size = .FALSE.
+
+  INTEGER,PARAMETER :: grow_factor=1.5
+  INTEGER,PARAMETER :: size_min=1024
+  PUBLIC size_min
+
+  INTEGER(i_std),SAVE,ALLOCATABLE,DIMENSION(:) :: omp_ibuffer
+  INTEGER,SAVE                            :: size_i=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: omp_lbuffer
+  INTEGER,SAVE                            :: size_l=0
+  REAL(r_std),SAVE,ALLOCATABLE,DIMENSION(:) :: omp_rbuffer
+  INTEGER,SAVE                            :: size_r=0
+  CHARACTER(len=size_min), SAVE,ALLOCATABLE,DIMENSION(:) :: omp_cbuffer
+  INTEGER,SAVE                            :: size_c=0
+
+#endif
+
+  INTERFACE bcast_omp
+     MODULE PROCEDURE bcast_omp_c, bcast_omp_c1,                                       &
+          bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
+          bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, &
+          bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
+  END INTERFACE
+
+  INTERFACE scatter_omp
+     MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, &
+          scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
+          scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
+  END INTERFACE
+
+
+  INTERFACE gather_omp
+     MODULE PROCEDURE gather_omp_i0,gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, &
+          gather_omp_r0,gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, &
+          gather_omp_l0,gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3  
+  END INTERFACE
+
+
+  INTERFACE reduce_sum_omp
+     MODULE PROCEDURE reduce_sum_omp_i,reduce_sum_omp_i1,reduce_sum_omp_i2,reduce_sum_omp_i3,reduce_sum_omp_i4, &
+          reduce_sum_omp_r,reduce_sum_omp_r1,reduce_sum_omp_r2,reduce_sum_omp_r3,reduce_sum_omp_r4
+  END INTERFACE
+
+  PUBLIC  bcast_omp,scatter_omp,gather_omp,reduce_sum_omp
+
+CONTAINS
+
+  SUBROUTINE check_buffer_c(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 72 
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+    IF (is_omp_root) THEN
+       IF (buff_size>size_c) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for strings : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for strings : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_cbuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_cbuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_cbuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_cbuffer)) DEALLOCATE(omp_cbuffer)
+          size_c=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_c
+             ELSE
+               WRITE(*,*) size_c
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_cbuffer(size_c))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_c
+
+  SUBROUTINE check_buffer_i(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 1 
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+
+    IF (is_omp_root) THEN
+       IF (buff_size>size_i) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for integers : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for integers : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_ibuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_ibuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_ibuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_ibuffer)) DEALLOCATE(omp_ibuffer)
+          size_i=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_i
+             ELSE
+               WRITE(*,*) size_i
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_ibuffer(size_i))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_i
+  
+  SUBROUTINE check_buffer_r(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 2
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+
+    IF (is_omp_root) THEN
+       IF (buff_size>size_r) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for reals : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for reals : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_rbuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_rbuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_rbuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_rbuffer)) DEALLOCATE(omp_rbuffer)
+          size_r=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_r
+             ELSE
+               WRITE(*,*) size_r
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_rbuffer(size_r))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_r
+  
+  SUBROUTINE check_buffer_l(buff_size)
+    IMPLICIT NONE
+    INTEGER :: buff_size
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 3
+      CALL print_omp_function()
+    ENDIF
+#ifdef CPP_OMP
+    CALL barrier2_omp()
+
+    IF (is_omp_root) THEN
+       IF (buff_size>size_l) THEN
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) "ORCHIDEE OMP; buffer for logicals : old_size, new_size"
+             ELSE
+               WRITE(*,*) "ORCHIDEE OMP; buffer for logicals : old_size, new_size"
+             ENDIF
+             IF (ALLOCATED(omp_lbuffer)) THEN
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) SIZE(omp_lbuffer)
+                ELSE
+                  WRITE(*,*) SIZE(omp_lbuffer)
+                ENDIF
+             ELSE
+                IF (numout_omp > 0) THEN
+                  WRITE(numout_omp,*) 0
+                ELSE
+                  WRITE(*,*) 0
+                ENDIF
+             ENDIF
+          ENDIF
+          IF (ALLOCATED(omp_lbuffer)) DEALLOCATE(omp_lbuffer)
+          size_l=MAX(size_min,INT(grow_factor*buff_size))
+          IF ( check_size ) THEN
+             IF (numout_omp > 0) THEN
+               WRITE(numout_omp,*) size_l
+             ELSE
+               WRITE(*,*) size_l
+             ENDIF
+          ENDIF
+          ALLOCATE(omp_lbuffer(size_l))
+       ENDIF
+    ENDIF
+    CALL barrier2_omp()
+
+#endif
+
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE check_buffer_l
+    
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_omp_c(Var)
+    IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    CHARACTER(LEN=len(Var)),DIMENSION(1) :: Var1
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 4
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var1(1)=Var
+    CALL check_buffer_c(1)
+    CALL orch_bcast_omp_cgen(Var1,1,omp_cbuffer)
+    Var=Var1(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_c
+
+  SUBROUTINE bcast_omp_c1(Var)
+    IMPLICIT NONE
+    CHARACTER(LEN=*),DIMENSION(:),INTENT(INOUT) :: Var
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 4
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_c(size(Var))
+    CALL orch_bcast_omp_cgen(Var,size(Var),omp_cbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_c1
+
+  !! -- Les entiers -- !!
+
+  SUBROUTINE bcast_omp_i(var1)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var1
+
+    INTEGER,DIMENSION(1) :: Var
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 5
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var(1)=Var1
+    CALL check_buffer_i(1)
+    CALL orch_bcast_omp_igen(Var,1,omp_ibuffer)
+    Var1=Var(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i
+
+  SUBROUTINE bcast_omp_i1(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 6
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i1
+
+  SUBROUTINE bcast_omp_i2(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 7
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i2
+
+  SUBROUTINE bcast_omp_i3(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 8
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i3
+
+  SUBROUTINE bcast_omp_i4(var)
+    IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)= 9
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_i(size(Var))
+    CALL orch_bcast_omp_igen(Var,SIZE(Var),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_i4
+
+
+  !! -- Les reels -- !!
+
+  SUBROUTINE bcast_omp_r(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+    REAL,DIMENSION(1) :: Var1
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=10
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var1(1)=Var
+    CALL check_buffer_r(1)
+    CALL orch_bcast_omp_rgen(Var1,1,omp_rbuffer)
+    Var=Var1(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r
+
+  SUBROUTINE bcast_omp_r1(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=11
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r1
+
+  SUBROUTINE bcast_omp_r2(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=12
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r2
+
+  SUBROUTINE bcast_omp_r3(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=13
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r3
+
+  SUBROUTINE bcast_omp_r4(var)
+    IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=14
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_r(size(Var))
+    CALL orch_bcast_omp_rgen(Var,SIZE(Var),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_r4
+
+  !! -- Les booleans -- !!
+
+  SUBROUTINE bcast_omp_l(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+
+    LOGICAL,DIMENSION(1) :: Var1
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=15
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    IF (is_omp_root) &
+         Var1(1)=Var
+    CALL check_buffer_l(1)
+    CALL orch_bcast_omp_lgen(Var1,1,omp_lbuffer)
+    Var=Var1(1)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l
+
+  SUBROUTINE bcast_omp_l1(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=16
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l1
+
+  SUBROUTINE bcast_omp_l2(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=17
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l2
+
+  SUBROUTINE bcast_omp_l3(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=18
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l3
+
+  SUBROUTINE bcast_omp_l4(var)
+    IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=19
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    RETURN
+#else
+    CALL check_buffer_l(size(Var))
+    CALL orch_bcast_omp_lgen(Var,SIZE(Var),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE bcast_omp_l4
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_omp_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=20
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i
+
+  SUBROUTINE scatter_omp_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=21
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i1
+
+  SUBROUTINE scatter_omp_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=22
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else    
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i2
+
+  SUBROUTINE scatter_omp_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=23
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else    
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_scatter_omp_igen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_i3
+
+
+  SUBROUTINE scatter_omp_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=24
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r
+
+  SUBROUTINE scatter_omp_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=25
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r1
+
+  SUBROUTINE scatter_omp_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=26
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r2
+
+  SUBROUTINE scatter_omp_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=27
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_scatter_omp_rgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_r3
+
+
+  SUBROUTINE scatter_omp_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=28
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,1,omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l
+
+  SUBROUTINE scatter_omp_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=29
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l1
+
+  SUBROUTINE scatter_omp_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=30
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3),omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l2
+
+  SUBROUTINE scatter_omp_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=31
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarIn))   
+    CALL orch_scatter_omp_lgen(VarIn,Varout,SIZE(VarOut,2)*SIZE(VarOut,3)*SIZE(VarOut,4),omp_lbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE scatter_omp_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather_omp_i0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN)               :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=32
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_simple_igen(VarIn,Varout,omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i0
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_omp_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=33
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i
+
+
+  SUBROUTINE gather_omp_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=34
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i1
+
+
+  SUBROUTINE gather_omp_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=35
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i2
+
+
+  SUBROUTINE gather_omp_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=36
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarOut))   
+    CALL orch_gather_omp_igen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_ibuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_i3
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_omp_r0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN)               :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=37
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_simple_rgen(VarIn,Varout,omp_rbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r0
+
+  SUBROUTINE gather_omp_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=38
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r
+
+
+  SUBROUTINE gather_omp_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=39
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r1
+
+
+  SUBROUTINE gather_omp_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=40
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r2
+
+
+  SUBROUTINE gather_omp_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=41
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarOut))   
+    CALL orch_gather_omp_rgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_rbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_r3
+
+!!!!! --> Les booleen
+
+  SUBROUTINE gather_omp_l0(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN)               :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=42
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_simple_lgen(VarIn,Varout,omp_lbuffer)
+#endif
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l0
+
+  SUBROUTINE gather_omp_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=43
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,1,omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l
+
+
+  SUBROUTINE gather_omp_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=44
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l1
+
+
+  SUBROUTINE gather_omp_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=45
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l2
+
+
+  SUBROUTINE gather_omp_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=46
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_l(size(VarOut))   
+    CALL orch_gather_omp_lgen(VarIn,Varout,SIZE(VarIn,2)*SIZE(VarIn,3)*SIZE(VarIn,4),omp_lbuffer)
+#endif    
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE gather_omp_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_omp_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=47
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut=VarIn
+    RETURN
+#else
+    CALL check_buffer_i(1)   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,1,omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i
+
+  SUBROUTINE reduce_sum_omp_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=48
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif   
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i1
+
+  SUBROUTINE reduce_sum_omp_i2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=49
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i2
+
+  SUBROUTINE reduce_sum_omp_i3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=50
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i3
+
+  SUBROUTINE reduce_sum_omp_i4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=51
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_i(size(VarIn))   
+    CALL orch_reduce_sum_omp_igen(VarIn,Varout,SIZE(VarIn),omp_ibuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_i4
+
+
+  SUBROUTINE reduce_sum_omp_r(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=52
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut=VarIn
+    RETURN
+#else
+    CALL check_buffer_r(1)   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,1,omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r
+
+  SUBROUTINE reduce_sum_omp_r1(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=53
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif   
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r1
+
+  SUBROUTINE reduce_sum_omp_r2(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=54
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r2
+
+  SUBROUTINE reduce_sum_omp_r3(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=55
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r3
+
+  SUBROUTINE reduce_sum_omp_r4(VarIn, VarOut)
+    IMPLICIT NONE
+
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    IF ( check_all_transfert ) THEN
+      omp_previous=omp_function(omp_rank)
+      omp_function(omp_rank)=56
+      CALL print_omp_function()
+    ENDIF
+#ifndef CPP_OMP
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    CALL check_buffer_r(size(VarIn))   
+    CALL orch_reduce_sum_omp_rgen(VarIn,Varout,SIZE(VarIn),omp_rbuffer)
+#endif  
+    IF ( check_all_transfert ) &
+        omp_function(omp_rank)=omp_previous
+  END SUBROUTINE reduce_sum_omp_r4
+
+END MODULE mod_orchidee_omp_transfert
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+#ifdef CPP_OMP
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! DEFINITION DES FONCTIONS DE TRANSFERT GENERIQUES !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SUBROUTINE orch_bcast_omp_cgen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+  USE mod_orchidee_omp_transfert, ONLY : size_min
+
+  IMPLICIT NONE
+  INTEGER,INTENT(IN)              :: Nb 
+  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Var
+  CHARACTER(LEN=*),DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER :: i
+  LOGICAL, PARAMETER :: check=.FALSE.
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=57
+    CALL print_omp_function()
+  ENDIF
+
+  IF (check) THEN
+     IF (numout_omp > 0) THEN
+        WRITE(numout_omp,*) "orch_bcast_omp_cgen before bcast Var",Var
+     ELSE
+        WRITE(*,*) "orch_bcast_omp_cgen before bcast Var",Var
+     ENDIF
+  ENDIF
+
+  IF (is_omp_root) THEN
+     IF ( len(Var) > size_min ) &
+          CALL ipslerr (3,'orch_bcast_omp_cgen', &
+          &          'Error with omp_cbuffer.', 'len(Var) > size_min', &
+          &          '(Increase size_min in mod_orchidee_omp_transfert.)')
+     DO i=1,Nb
+        Buff(i)=TRIM(Var(i))
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+  CALL barrier2_omp()
+      
+  IF (check) THEN
+     IF (numout_omp > 0) THEN
+        WRITE(numout_omp,*) "orch_bcast_omp_cgen after bcast Var",Var
+     ELSE
+        WRITE(*,*) "orch_bcast_omp_cgen after bcast Var",Var
+     ENDIF
+  ENDIF
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_cgen
+
+
+
+SUBROUTINE orch_bcast_omp_igen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Var
+  INTEGER,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER,INTENT(IN) :: Nb  
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=58
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,Nb
+        Buff(i)=Var(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_igen
+
+
+
+SUBROUTINE orch_bcast_omp_rgen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  REAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+  REAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER,INTENT(IN) :: Nb
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=59
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,Nb
+        Buff(i)=Var(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_rgen
+
+
+
+SUBROUTINE orch_bcast_omp_lgen(Var,Nb,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Var
+  LOGICAL,DIMENSION(Nb),INTENT(INOUT) :: Buff
+  INTEGER,INTENT(IN) :: Nb
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=60
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,Nb
+        Buff(i)=Var(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,Nb
+     Var(i)=Buff(i)
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_bcast_omp_lgen
+
+
+
+SUBROUTINE orch_scatter_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+  USE mod_orchidee_mpi_data, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=61
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_omp_igen
+
+
+SUBROUTINE orch_scatter_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_mpi_data, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=62
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_omp_rgen
+
+
+SUBROUTINE orch_scatter_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_mpi_data, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  LOGICAL,INTENT(IN),DIMENSION(nbp_mpi,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp_omp,dimsize) :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=63
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           Buff(ij,i)=VarIn(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        VarOut(ij,i)=Buff(nbp_omp_begin-1+ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_scatter_omp_lgen
+
+
+
+SUBROUTINE orch_gather_omp_simple_igen(VarIn,VarOut,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN)                            :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
+
+  Buff(omp_rank)=VarIn
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=64
+    CALL print_omp_function()
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_simple_igen
+
+SUBROUTINE orch_gather_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_mpi_data, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=65
+    CALL print_omp_function()
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           VarOut(ij,i)=Buff(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_igen
+
+
+SUBROUTINE orch_gather_omp_simple_rgen(VarIn,VarOut,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  REAL,INTENT(IN)                            :: VarIn
+  REAL,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=66
+    CALL print_omp_function()
+  ENDIF
+
+  Buff(omp_rank)=VarIn
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_simple_rgen
+
+
+SUBROUTINE orch_gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_mpi_data, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=67
+    CALL print_omp_function()
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           VarOut(ij,i)=Buff(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_rgen
+
+
+SUBROUTINE orch_gather_omp_simple_lgen(VarIn,VarOut,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  LOGICAL,INTENT(IN)                            :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(0:omp_size-1)   :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(0:omp_size-1) :: Buff
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=68
+    CALL print_omp_function()
+  ENDIF
+
+  Buff(omp_rank)=VarIn
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     VarOut(0:omp_size-1)=Buff(0:omp_size-1)
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_simple_lgen
+
+
+SUBROUTINE orch_gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  USE mod_orchidee_mpi_data, ONLY : nbp_mpi 
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  LOGICAL,INTENT(IN),DIMENSION(nbp_omp,dimsize) :: VarIn
+  LOGICAL,INTENT(OUT),DIMENSION(nbp_mpi,dimsize) :: VarOut
+  LOGICAL,INTENT(INOUT),DIMENSION(nbp_mpi,dimsize) :: Buff
+
+  INTEGER :: i,ij
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=69
+    CALL print_omp_function()
+  ENDIF
+
+  DO i=1,dimsize
+     DO ij=1,nbp_omp
+        Buff(nbp_omp_begin-1+ij,i)=VarIn(ij,i)
+     ENDDO
+  ENDDO
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        DO ij=1,nbp_mpi
+           VarOut(ij,i)=Buff(ij,i)
+        ENDDO
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_gather_omp_lgen
+
+
+
+SUBROUTINE orch_reduce_sum_omp_igen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
+  INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+  INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=70
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) Buff(:)=0
+
+  CALL barrier2_omp()
+
+!$OMP CRITICAL     
+  DO i=1,dimsize
+     Buff(i)=Buff(i)+VarIn(i)
+  ENDDO
+!$OMP END CRITICAL
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        VarOut(i)=Buff(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_reduce_sum_omp_igen
+
+
+SUBROUTINE orch_reduce_sum_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_orchidee_omp_data
+
+  IMPLICIT NONE
+
+  INTEGER,INTENT(IN) :: dimsize
+  REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
+  REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
+  REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
+
+  INTEGER :: i
+
+  IF ( check_all_transfert ) THEN
+    omp_previous=omp_function(omp_rank)
+    omp_function(omp_rank)=71
+    CALL print_omp_function()
+  ENDIF
+
+  IF (is_omp_root) Buff(:)=0
+
+  CALL barrier2_omp()
+
+!$OMP CRITICAL     
+  DO i=1,dimsize
+     Buff(i)=Buff(i)+VarIn(i)
+  ENDDO
+!$OMP END CRITICAL
+
+  CALL barrier2_omp()
+
+  IF (is_omp_root) THEN
+     DO i=1,dimsize
+        VarOut(i)=Buff(i)
+     ENDDO
+  ENDIF
+
+  CALL barrier2_omp()
+
+  IF ( check_all_transfert ) &
+      omp_function(omp_rank)=omp_previous
+END SUBROUTINE orch_reduce_sum_omp_rgen
+
+#endif
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_para.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_para.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_para.F90	(revision 5166)
@@ -0,0 +1,287 @@
+! Initialization of parallel for MPI and OpenMP.
+
+!-
+!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/Attic/mod_orchidee_para.F90,v 1.1.2.4 2008/11/05 10:14:05 ssipsl Exp $
+!- 
+
+MODULE mod_orchidee_para
+
+  USE mod_orchidee_mpi_data
+  USE mod_orchidee_omp_data
+  USE mod_orchidee_transfert_para
+  
+  INTEGER,SAVE :: nbp_loc                                             !! number of local continental points
+!$OMP THREADPRIVATE(nbp_loc)
+  INTEGER,SAVE :: offset
+!$OMP THREADPRIVATE(offset)
+
+  LOGICAL,SAVE :: is_root_prc = .FALSE.                               !! Only root proc for MPI and OpenMP is true
+!$OMP THREADPRIVATE(is_root_prc)
+
+  !! Global array used by stomate and sechiba
+  !-
+  !! index of land points on the 2D map
+  INTEGER(i_std),ALLOCATABLE,DIMENSION(:),SAVE   :: index_g
+  !-
+  !! indices of the 4 neighbours of each grid point (1=N, 2=E, 3=S, 4=W)
+  INTEGER(i_std),ALLOCATABLE,DIMENSION(:,:),SAVE :: neighbours_g
+  !-
+  !! resolution at each grid point in m (1=E-W, 2=N-S)
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:),SAVE    :: resolution_g 
+  REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE    :: area_g 
+  !-
+  !! Geographical coordinates
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:),SAVE    :: lalo_g
+  ! Global grid, for all process
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:), SAVE     :: lon_g, lat_g, zlev_g
+  !-
+  !! Fraction of continents
+  REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE      :: contfrac_g  
+  
+  
+CONTAINS
+    
+  SUBROUTINE Init_orchidee_para(communicator)
+    IMPLICIT NONE
+    INTEGER,OPTIONAL,INTENT(in) :: communicator	
+
+    CALL Init_orchidee_omp
+
+
+    IF ( PRESENT(communicator) ) THEN
+       CALL Init_orchidee_mpi(communicator)
+    ELSE
+       CALL Init_orchidee_mpi
+    ENDIF
+
+
+    IF (is_mpi_root .AND. is_omp_root) THEN
+       is_root_prc=.TRUE.
+    ELSE
+       is_root_prc=.FALSE.
+    ENDIF
+  END SUBROUTINE Init_orchidee_para
+    
+  
+  SUBROUTINE Init_orchidee_data_para_driver(nbp,kindex_glo)
+
+    IMPLICIT NONE
+    INTEGER,INTENT(IN) :: nbp
+    INTEGER,INTENT(IN) :: kindex_glo(nbp)
+      
+    INTEGER :: first_point
+    INTEGER :: last_point
+    INTEGER :: nbp_loc
+    INTEGER :: nbp_loc_para(0:mpi_size-1)
+    INTEGER,ALLOCATABLE :: kindex_loc(:)
+    INTEGER :: offset
+    INTEGER :: i
+    
+      
+    last_point=0
+    
+    CALL read_load_balance(nbp,nbp_loc_para)    
+    
+    DO i=0,mpi_rank
+       nbp_loc=nbp_loc_para(i)
+       First_point=last_point+1
+       Last_point=last_point+nbp_loc
+    ENDDO
+      
+    ALLOCATE(kindex_loc(nbp_loc))
+    DO i=1,nbp_loc
+       kindex_loc(i)=kindex_glo(i+First_Point-1)
+    ENDDO
+    
+    IF (mpi_rank==0) THEN
+       offset=0
+    ELSE
+       offset=kindex_glo(First_point-1)-MOD(kindex_glo(First_point-1),iim_g)
+    ENDIF
+    
+    kindex_loc(:)=kindex_loc(:)-offset
+    
+    CALL Init_orchidee_data_para(nbp_loc,kindex_loc,offset,omp_size,omp_rank,MPI_COMM_ORCH)
+    CALL Set_stdout_file('out_orchidee')
+    CALL ipslnlf(new_number=numout)
+    !    
+  END SUBROUTINE Init_orchidee_data_para_driver
+    
+  
+  SUBROUTINE Init_orchidee_data_para(nbp,kindex,arg_offset,arg_omp_size,arg_omp_rank,COMM)
+
+    IMPLICIT NONE
+    INTEGER,INTENT(IN)     :: nbp
+    INTEGER,INTENT(IN)     :: kindex(nbp)
+    INTEGER,INTENT(IN)     :: arg_offset
+    INTEGER,INTENT(IN)     :: arg_omp_size
+    INTEGER,INTENT(IN)     :: arg_omp_rank
+    INTEGER,INTENT(IN)     :: COMM
+    
+    INTEGER,SAVE              :: arg_nbp_mpi
+    INTEGER,ALLOCATABLE,SAVE  :: kindex_mpi(:)
+    
+    offset=arg_offset 
+    CALL init_orchidee_omp_data(arg_omp_size,arg_omp_rank,nbp,offset)
+    
+    IF (is_omp_root) THEN
+       arg_nbp_mpi=SUM(nbp_omp_para_nb(:))
+       ALLOCATE(kindex_mpi(arg_nbp_mpi))
+    ENDIF
+
+    CALL barrier2_omp()
+    kindex_mpi(nbp_omp_begin:nbp_omp_end)=kindex(:)+offset
+    CALL barrier2_omp()
+      
+    IF (is_omp_root) THEN      
+       kindex_mpi(:)=kindex_mpi(:)-offset
+       CALL init_orchidee_mpi_data(arg_nbp_mpi,kindex_mpi,offset,COMM)
+       nbp_glo=SUM(nbp_mpi_para(:))
+    ENDIF
+    CALL barrier2_omp()
+
+    nbp_loc=nbp
+    
+    IF (is_mpi_root .AND. is_omp_root) THEN
+       is_root_prc=.TRUE.
+    ELSE
+       is_root_prc=.FALSE.
+    ENDIF
+    
+    CALL Test_orchidee_para
+    
+  END SUBROUTINE Init_orchidee_data_para
+
+  SUBROUTINE set_grid_glo(arg_nbp_lon,arg_nbp_lat,arg_nbp_glo)
+    IMPLICIT NONE
+
+    INTEGER(i_std), INTENT(IN) :: arg_nbp_lon
+    INTEGER(i_std), INTENT(IN) :: arg_nbp_lat
+    INTEGER(i_std), INTENT(IN),OPTIONAL :: arg_nbp_glo
+    iim_g=arg_nbp_lon
+    jjm_g=arg_nbp_lat
+    IF (PRESENT(arg_nbp_glo)) nbp_glo=arg_nbp_glo
+  END SUBROUTINE set_grid_glo
+  
+  SUBROUTINE Allocate_grid_glo
+    IMPLICIT NONE
+  
+    ALLOCATE(resolution_g(nbp_glo,2),area_g(nbp_glo),lalo_g(nbp_glo,2), &
+         &   neighbours_g(nbp_glo,8),contfrac_g(nbp_glo),index_g(nbp_glo))
+    ALLOCATE(lon_g(iim_g, jjm_g), lat_g(iim_g, jjm_g), zlev_g(iim_g, jjm_g))
+  
+  END SUBROUTINE Allocate_grid_glo
+  
+    
+  SUBROUTINE Set_stdout_file(filename)
+
+    IMPLICIT NONE
+
+    CHARACTER(len=*), INTENT(IN) :: filename
+    CHARACTER(len=255) :: fileout
+    CHARACTER(len=4)  :: num_mpi
+    CHARACTER(len=4)  :: num_omp
+    INTEGER,PARAMETER :: base_numout=100
+    INTEGER           :: ierr
+
+    IF (is_ok_mpi) THEN
+       WRITE(num_mpi,'(I4.4)') mpi_rank
+    ENDIF
+    
+    IF (is_ok_omp) THEN
+       WRITE(num_omp,'(I4.4)') omp_rank
+    ENDIF
+    
+     
+    IF (is_ok_mpi .AND. is_ok_omp) THEN
+       fileout=TRIM(filename)//'_'//num_mpi//'.'//num_omp
+       numout=base_numout+omp_rank
+    ELSE IF (is_ok_mpi .AND. (.NOT. is_ok_omp)) THEN
+       fileout=TRIM(filename)//'_'//num_mpi
+       numout=base_numout
+    ELSE IF ((.NOT. is_ok_mpi) .AND. is_ok_omp) THEN
+       fileout=TRIM(filename)//'_'//num_omp
+       numout=base_numout+omp_rank
+    ELSE
+       fileout=TRIM(filename)
+       numout=base_numout
+    ENDIF
+!$OMP CRITICAL  
+    WRITE(*,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
+!$OMP END CRITICAL
+    
+    OPEN(UNIT=numout,FILE=TRIM(fileout),ACTION='write',STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
+    IF (ierr /= 0) THEN
+#ifdef CPP_PARA
+       CALL MPI_FINALIZE(ierr)
+#endif
+       WRITE(*,*) "In Set_stdout_file : Erreur can't open file ", filename
+       STOP 1
+    ENDIF
+ 
+!$OMP CRITICAL  
+    WRITE(numout,*) "Set_stdout_file (rank ",mpi_rank,omp_rank,"), id output :",numout
+!$OMP END CRITICAL
+
+    CALL Init_numout_omp(numout)
+
+  END SUBROUTINE Set_stdout_file
+      
+      
+  SUBROUTINE Test_orchidee_para
+
+    IMPLICIT NONE
+
+    INTEGER,PARAMETER :: dimsize=3
+    REAL :: Array(nbp_loc,dimsize)
+    REAL :: Array_glo(nbp_glo,dimsize)
+    REAL :: Array_glo_tmp(nbp_glo,dimsize)
+    REAL :: Array2D_loc(iim_g,jj_nb)
+    REAL :: Array2D_glo(iim_g,jjm_g)
+    REAL :: sum1,sum2,sum3
+    
+    INTEGER :: i,j
+    
+    DO j=1,dimsize
+       DO i=1,nbp_loc
+          Array(i,j)=10*j+omp_rank+i*1000
+       ENDDO
+    ENDDO
+      
+    CALL gather(Array,Array_glo)
+    CALL bcast(Array_glo)
+    CALL scatter(Array_glo,array)
+    CALL gather(array,array_glo_tmp)
+    CALL bcast(array_glo_tmp)    
+    WRITE(*,*) "Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",SUM(array_glo-array_glo_tmp)
+
+    sum1=SUM(array)
+    CALL reduce_sum(sum1,sum2)
+    CALL bcast(sum2)
+    sum3=SUM(array_glo)
+    WRITE(*,*) "Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum2
+    
+    IF (is_omp_root) THEN
+       DO j=1,jjm_g
+          DO i=1,iim_g
+             Array2D_glo(i,j)=(j-1)*iim_g+i
+          ENDDO
+       ENDDO
+        
+       array2D_loc(:,:)=0
+       CALL scatter2D_mpi(array2D_glo,array2D_loc)
+       array2D_glo(:,:)=0
+       CALL gather2D_mpi(array2D_loc,array2D_glo)
+       CALL bcast_mpi(array2D_glo)
+       sum1=SUM(array2D_glo)
+       sum2=SUM(array2D_loc)
+       CALL reduce_sum_mpi(sum2,sum3)
+       CALL bcast_mpi(sum3)
+       
+       WRITE(*,*) "Test parallelism (rank ",mpi_rank,omp_rank,"), Sould be 0 :",sum3-sum1
+    ENDIF
+    CALL barrier2_omp()
+
+  END SUBROUTINE  Test_orchidee_para
+  
+END MODULE mod_orchidee_para
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_transfert_para.F90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_transfert_para.F90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mod_orchidee_transfert_para.F90	(revision 5166)
@@ -0,0 +1,848 @@
+! High level MPI/OpenMP parallel communication encapsulations for ORCHIDEE.
+
+!-
+!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/Attic/mod_orchidee_transfert_para.F90,v 1.1.2.2 2008/08/29 14:01:40 ssipsl Exp $
+!-
+
+MODULE mod_orchidee_transfert_para
+
+  USE mod_orchidee_mpi_transfert
+  USE mod_orchidee_omp_transfert 
+
+
+
+  INTERFACE bcast
+    MODULE PROCEDURE bcast_c, bcast_c1,                           &
+                     bcast_i,bcast_i1,bcast_i2,bcast_i3,bcast_i4, &
+                     bcast_r,bcast_r1,bcast_r2,bcast_r3,bcast_r4, &
+		     bcast_l,bcast_l1,bcast_l2,bcast_l3,bcast_l4
+  END INTERFACE
+
+  INTERFACE scatter
+    MODULE PROCEDURE scatter_i,scatter_i1,scatter_i2,scatter_i3, &
+                     scatter_r,scatter_r1,scatter_r2,scatter_r3, &
+		     scatter_l,scatter_l1,scatter_l2,scatter_l3
+  END INTERFACE
+
+  
+  INTERFACE gather
+    MODULE PROCEDURE gather_i,gather_i1,gather_i2,gather_i3, &
+                     gather_r,gather_r1,gather_r2,gather_r3, &
+		     gather_l,gather_l1,gather_l2,gather_l3  
+  END INTERFACE
+  
+
+  INTERFACE reduce_sum
+    MODULE PROCEDURE reduce_sum_i,reduce_sum_i1,reduce_sum_i2,reduce_sum_i3,reduce_sum_i4, &
+                     reduce_sum_r,reduce_sum_r1,reduce_sum_r2,reduce_sum_r3,reduce_sum_r4
+  END INTERFACE 
+
+   
+CONTAINS
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Broadcast --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! -- Les chaine de charactère -- !!
+
+  SUBROUTINE bcast_c(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_c
+
+  SUBROUTINE bcast_c1(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var(:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_c1
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_i(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i
+
+  SUBROUTINE bcast_i1(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i1
+
+
+  SUBROUTINE bcast_i2(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i2
+
+
+  SUBROUTINE bcast_i3(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i3
+
+
+  SUBROUTINE bcast_i4(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_i4
+
+ 
+!! -- Les reels -- !!
+  
+  SUBROUTINE bcast_r(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r
+
+  SUBROUTINE bcast_r1(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r1
+
+
+  SUBROUTINE bcast_r2(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r2
+
+
+  SUBROUTINE bcast_r3(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r3
+
+
+  SUBROUTINE bcast_r4(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_r4 
+
+
+!! -- Les booleens -- !!
+  
+  SUBROUTINE bcast_l(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l
+
+  SUBROUTINE bcast_l1(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l1
+
+
+  SUBROUTINE bcast_l2(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l2
+
+
+  SUBROUTINE bcast_l3(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l3
+
+
+  SUBROUTINE bcast_l4(var)
+  USE mod_orchidee_omp_data
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+    
+    IF (is_omp_root) CALL bcast_mpi(Var)
+
+    CALL bcast_omp(Var)
+    
+  END SUBROUTINE bcast_l4
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_i(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    INTEGER,DIMENSION(nbp_mpi) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i
+
+
+  SUBROUTINE scatter_i1(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i1
+
+
+  SUBROUTINE scatter_i2(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_i2
+
+
+  SUBROUTINE scatter_i3(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    INTEGER,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_i3
+
+
+  SUBROUTINE scatter_r(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r
+
+
+  SUBROUTINE scatter_r1(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r1
+
+
+  SUBROUTINE scatter_r2(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_r2
+
+
+  SUBROUTINE scatter_r3(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    REAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_r3
+  
+  
+
+  SUBROUTINE scatter_l(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi) :: Var_tmp
+    
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l
+
+
+  SUBROUTINE scatter_l1(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l1
+
+
+  SUBROUTINE scatter_l2(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,Varout)
+    
+  END SUBROUTINE scatter_l2
+
+
+  SUBROUTINE scatter_l3(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+    LOGICAL,DIMENSION(nbp_mpi,SIZE(Varout,2),SIZE(Varout,3),SIZE(Varout,4)) :: Var_tmp
+
+    
+    IF (is_omp_root) CALL scatter_mpi(VarIn,Var_tmp)
+    CALL scatter_omp(Var_tmp,VarOut)
+    
+  END SUBROUTINE scatter_l3
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ 
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_i(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
+  
+  END SUBROUTINE gather_i
+
+
+  SUBROUTINE gather_i1(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,Varout)
+
+  
+  END SUBROUTINE gather_i1
+
+
+  SUBROUTINE gather_i2(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_i2
+
+
+  SUBROUTINE gather_i3(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+
+  
+  END SUBROUTINE gather_i3
+
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_r(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+ 
+  END SUBROUTINE gather_r
+
+
+  SUBROUTINE gather_r1(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+
+  
+  END SUBROUTINE gather_r1
+
+
+  SUBROUTINE gather_r2(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_r2
+
+
+  SUBROUTINE gather_r3(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_r3
+
+
+!!!!! --> Les booleens
+
+  SUBROUTINE gather_l(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l
+
+
+  SUBROUTINE gather_l1(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l1
+
+
+  SUBROUTINE gather_l2(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l2
+
+
+  SUBROUTINE gather_l3(VarIn, VarOut)
+    USE mod_orchidee_mpi_data, ONLY : nbp_mpi
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    LOGICAL, DIMENSION(nbp_mpi,SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4)) :: Var_tmp
+    
+    CALL gather_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL gather_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE gather_l3
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! Les entiers
+
+  SUBROUTINE reduce_sum_i(VarIn, VarOut)
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    
+    INTEGER             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_i  
+
+
+  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_i1  
+
+
+  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+
+  END SUBROUTINE reduce_sum_i2  
+  
+
+  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_i3  
+
+
+  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    INTEGER,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_i4  
+
+
+! Les reels
+
+  SUBROUTINE reduce_sum_r(VarIn, VarOut)
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    
+    REAL             :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r  
+
+
+  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn))   :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r1  
+
+
+  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2)) :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r2  
+  
+
+  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r3  
+
+
+  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
+    USE mod_orchidee_omp_data
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+    REAL,DIMENSION(SIZE(VarIn,1),SIZE(VarIn,2),SIZE(VarIn,3),SIZE(VarIn,4))  :: Var_tmp
+           
+    CALL reduce_sum_omp(VarIn,Var_tmp)
+    
+    IF (is_omp_root) CALL reduce_sum_mpi(Var_tmp,VarOut)
+  
+  END SUBROUTINE reduce_sum_r4  
+
+   
+END MODULE mod_orchidee_transfert_para
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mpi_dummy.h
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mpi_dummy.h	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/mpi_dummy.h	(revision 5166)
@@ -0,0 +1,60 @@
+! Overlapp of MPI functions not present in some MPI implementations.
+
+!-
+!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/mpi_dummy.h,v 1.2 2007/06/12 08:04:26 ssipsl Exp $
+!-
+#ifdef MPI_SECOND__
+
+SUBROUTINE MPI_NULL_COPY_FN
+END SUBROUTINE MPI_NULL_COPY_FN
+
+SUBROUTINE MPI_NULL_DELETE_FN
+END SUBROUTINE MPI_NULL_DELETE_FN
+
+SUBROUTINE MPI_COMM_NULL_COPY_FN
+END SUBROUTINE MPI_COMM_NULL_COPY_FN
+
+SUBROUTINE MPI_COMM_NULL_DELETE_FN
+END SUBROUTINE MPI_COMM_NULL_DELETE_FN
+
+SUBROUTINE MPI_TYPE_NULL_COPY_FN
+END SUBROUTINE MPI_TYPE_NULL_COPY_FN
+
+SUBROUTINE MPI_TYPE_NULL_DELETE_FN
+END SUBROUTINE MPI_TYPE_NULL_DELETE_FN
+
+SUBROUTINE MPI_WIN_NULL_COPY_FN
+END SUBROUTINE MPI_WIN_NULL_COPY_FN
+
+SUBROUTINE MPI_WIN_NULL_DELETE_FN
+END SUBROUTINE MPI_WIN_NULL_DELETE_FN
+
+SUBROUTINE MPI_DUP_FN
+END SUBROUTINE MPI_DUP_FN
+
+SUBROUTINE MPI_COMM_DUP_FN
+END SUBROUTINE MPI_COMM_DUP_FN
+
+SUBROUTINE MPI_TYPE_DUP_FN
+END SUBROUTINE MPI_TYPE_DUP_FN
+
+SUBROUTINE MPI_WIN_DUP_FN
+END SUBROUTINE MPI_WIN_DUP_FN
+
+FUNCTION MPI_WTIME () RESULT (R)
+  DOUBLE PRECISION R
+END FUNCTION MPI_WTIME
+
+FUNCTION MPI_WTICK () RESULT (R)
+  DOUBLE PRECISION :: R
+END FUNCTION MPI_WTICK
+
+FUNCTION PMPI_WTIME () RESULT (R)
+  DOUBLE PRECISION R
+END FUNCTION PMPI_WTIME
+
+FUNCTION PMPI_WTICK () RESULT (R)
+  DOUBLE PRECISION R
+END FUNCTION PMPI_WTICK
+
+#endif
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/orch_write_field.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/orch_write_field.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/orch_write_field.f90	(revision 5166)
@@ -0,0 +1,282 @@
+! Yann Meurdesoif functions for sequentiel tests.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+module orch_Write_Field
+  
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  integer, parameter :: MaxWriteField = 100
+  integer, dimension(MaxWriteField),save :: FieldId
+  integer, dimension(MaxWriteField),save :: FieldVarId
+  integer, dimension(MaxWriteField),save :: FieldIndex
+  character(len=255), dimension(MaxWriteField) ::  FieldName
+  
+  integer, save,dimension(:), allocatable :: Index_Write_Field
+  integer,save :: iim
+  integer,save :: jjm
+  integer,save :: NbPoint
+  real, parameter :: undef_var=0.
+  
+  integer,save :: NbField = 0
+  
+  interface WriteField
+    module procedure WriteField_4d,WriteField_3d,WriteField_2d,WriteField_1d
+  end interface WriteField
+ 
+  interface WriteFieldI
+    module procedure WriteFieldI_3d,WriteFieldI_2d,WriteFieldI_1d
+  end interface WriteFieldI
+
+  private :: iim,jjm,NbPoint 
+  contains
+  
+    subroutine Init_WriteField(iim0,jjm0,NbPoint0,Index0)
+    implicit none
+      integer,intent(in) :: iim0
+      integer,intent(in) :: jjm0
+      integer,intent(in) :: NbPoint0
+      integer,intent(in) :: Index0(NbPoint0)
+    
+      iim=iim0
+      jjm=jjm0
+      Nbpoint=Nbpoint0
+      ALLOCATE(Index_Write_Field(NbPoint))
+      Index_Write_Field(:)=Index0(:)
+    end subroutine Init_WriteField
+    
+    function GetFieldIndex(name)
+    implicit none
+      integer          :: GetFieldindex
+      character(len=*) :: name
+    
+      character(len=255) :: TrueName
+      integer            :: i
+       
+      
+      TrueName=TRIM(ADJUSTL(name))
+    
+      GetFieldIndex=-1
+      do i=1,NbField
+        if (TrueName==FieldName(i)) then
+          GetFieldIndex=i
+          exit
+        endif
+      enddo
+    end function GetFieldIndex
+
+    subroutine WriteFieldI_3d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:,:) :: Field 
+      integer, dimension(3) :: Dim
+      integer,dimension(4) :: Dim_tmp
+      integer :: i
+      
+      real, allocatable, dimension(:,:,:) :: Field_tmp 
+      
+      Dim=shape(Field)
+      allocate(Field_tmp(iim*jjm,Dim(2),dim(3)))
+      field_tmp(:,:,:)=undef_var
+      
+      do i=1,NbPoint
+        field_tmp(Index_Write_Field(i),:,:)=Field(i,:,:)
+      enddo
+      
+      Dim_tmp(1)=iim
+      Dim_tmp(2)=jjm
+      Dim_tmp(3)=dim(2)
+      Dim_tmp(4)=dim(3)
+      call WriteField_gen(name,Field_tmp,4,Dim_tmp)  
+  
+      deallocate(Field_tmp)
+    end subroutine WriteFieldI_3d
+
+    subroutine WriteFieldI_2d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:) :: Field 
+      integer, dimension(2) :: Dim
+      integer,dimension(3) :: Dim_tmp
+      integer :: i
+      
+      real, allocatable, dimension(:,:) :: Field_tmp 
+      
+      Dim=shape(Field)
+      allocate(Field_tmp(iim*jjm,Dim(2)))
+      field_tmp(:,:)=undef_var
+      
+      do i=1,NbPoint
+        field_tmp(Index_Write_Field(i),:)=Field(i,:)
+      enddo
+      
+      Dim_tmp(1)=iim
+      Dim_tmp(2)=jjm
+      Dim_tmp(3)=dim(2)
+
+      call WriteField_gen(name,Field_tmp,3,Dim_tmp)  
+  
+      deallocate(Field_tmp)
+    end subroutine WriteFieldI_2d
+
+    subroutine WriteFieldI_1d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:) :: Field 
+      integer, dimension(1) :: Dim
+      integer,dimension(2) :: Dim_tmp
+      integer :: i
+      
+      real, allocatable, dimension(:) :: Field_tmp 
+      
+      Dim=shape(Field)
+      allocate(Field_tmp(iim*jjm))
+      field_tmp(:)=undef_var
+      
+      do i=1,NbPoint
+        field_tmp(Index_Write_Field(i))=Field(i)
+      enddo
+      
+      Dim_tmp(1)=iim
+      Dim_tmp(2)=jjm
+
+      call WriteField_gen(name,Field_tmp,2,Dim_tmp)  
+  
+      deallocate(Field_tmp)
+    end subroutine WriteFieldI_1d
+        
+    subroutine WriteField_4d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:,:,:) :: Field 
+      integer, dimension(4) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,4,Dim)  
+  
+    end subroutine WriteField_4d
+     
+    subroutine WriteField_3d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:,:) :: Field 
+      integer, dimension(3) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,3,Dim)  
+  
+    end subroutine WriteField_3d
+    
+    subroutine WriteField_2d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:,:) :: Field 
+      integer, dimension(2) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,2,Dim)  
+  
+    end subroutine WriteField_2d
+    
+    subroutine WriteField_1d(name,Field)
+    implicit none
+      character(len=*) :: name
+      real, dimension(:) :: Field 
+      integer, dimension(1) :: Dim
+      
+      Dim=shape(Field)
+      call WriteField_gen(name,Field,1,Dim)  
+  
+    end subroutine WriteField_1d
+        
+    subroutine CreateNewField(name,NbDim,DimSize)
+    USE ioipsl
+    implicit none
+    include 'netcdf.inc'  
+      character(len=*) :: name
+      integer :: NbDim
+      integer :: DimSize(NbDim)
+      integer :: TabDim(NbDim+1)
+      integer :: status
+      
+      
+      NbField=NbField+1
+      FieldName(NbField)=TRIM(ADJUSTL(name))
+      FieldIndex(NbField)=1
+      
+      WRITE(numout,*) 'CREATE_NEW_FIELD ',name,NbDim,DimSize
+      CALL flush(6)
+      status = NF_CREATE(TRIM(ADJUSTL(name))//'.nc', NF_CLOBBER, FieldId(NbField))
+      if (NbDim>=1) status = NF_DEF_DIM(FieldId(NbField),'I',DimSize(1),TabDim(1))
+      if (NbDim>=2) status = NF_DEF_DIM(FieldId(NbField),'J',DimSize(2),TabDim(2))
+      if (NbDim>=3) status = NF_DEF_DIM(FieldId(NbField),'K',DimSize(3),TabDim(3))
+      if (NbDim>=4) status = NF_DEF_DIM(FieldId(NbField),'L',DimSize(4),TabDim(4))
+      status = NF_DEF_DIM(FieldId(NbField),'iter',NF_UNLIMITED,TabDim(NbDim+1))
+      status = NF_DEF_VAR(FieldId(NbField),FieldName(NbField),NF_DOUBLE,NbDim+1,TabDim,FieldVarId(NbField))
+      status = NF_ENDDEF(FieldId(NbField))
+
+    end subroutine CreateNewField
+    
+  function int2str(int)
+    implicit none
+    integer, parameter :: MaxLen=10
+    integer,intent(in) :: int
+    character(len=MaxLen) :: int2str
+    logical :: flag
+    integer :: i
+    flag=.true.
+    
+    i=int
+    
+    int2str=''
+    do while (flag)
+      int2str=CHAR(MOD(i,10)+48)//int2str
+      i=i/10
+      if (i==0) flag=.false.
+    enddo
+  end function int2str
+
+
+end module Orch_Write_Field
+
+    subroutine WriteField_gen(name,Field,NbDim,DimSize)
+    use orch_write_field
+    implicit none
+    include 'netcdf.inc'
+      character(len=*) :: name
+      integer :: NbDim
+      integer,dimension(NbDim) :: DimSize
+      real,dimension(*) :: Field
+      
+      integer :: status
+      integer :: ind
+      integer :: start(NbDim+1)
+      integer :: count(NbDim+1)
+      integer :: i
+           
+      Ind=GetFieldIndex(name)
+      if (Ind==-1) then
+        call CreateNewField(name,NbDim,DimSize)
+	Ind=GetFieldIndex(name)
+      else
+        FieldIndex(Ind)=FieldIndex(Ind)+1
+      endif
+      
+      do i=1,NbDim
+        start(i)=1
+        count(i)=DimSize(i)
+      enddo
+      start(NbDim+1)=FieldIndex(Ind)
+      count(NbDim+1)=1
+
+      status = NF_PUT_VARA_DOUBLE(FieldId(Ind),FieldVarId(Ind),start,count,Field)
+      status = NF_SYNC(FieldId(Ind))
+      
+    end subroutine WriteField_gen
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/orch_write_field_p.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/orch_write_field_p.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/orch_write_field_p.f90	(revision 5166)
@@ -0,0 +1,156 @@
+! Yann Meurdesoif functions for parallel tests.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE Orch_Write_field_p
+  
+  interface WriteField_p
+    module procedure WriteField_4d_p,WriteField_3d_p,WriteField_2d_p
+  end interface WriteField_p
+ 
+  interface WriteFieldI_p
+    module procedure WriteFieldI_3d_p,WriteFieldI_2d_p,WriteFieldI_1d_p
+  end interface WriteFieldI_p  
+  
+  
+CONTAINS
+
+  SUBROUTINE init_WriteField_p
+  USE mod_orchidee_para
+  USE Write_Field, only : Init_WriteField
+  IMPLICIT NONE
+    IF (is_root_prc) CALL Init_WriteField(iim_g,jjm_g,nbp_glo,index_g)
+    
+  END SUBROUTINE init_WriteField_p
+
+  SUBROUTINE WriteField_4d_p(name,Field)
+    USE mod_orchidee_para
+    USE Write_field, only : WriteField
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:,:,:) :: Field 
+      INTEGER, DIMENSION(4) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: Field_g
+      
+      Dim=shape(Field)
+      
+      ALLOCATE(Field_g(iim_g,jjm_g,Dim(3),Dim(4)))
+      CALL Gather2D_mpi(Field,Field_g)
+
+      IF (is_root_prc) CALL WriteField(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteField_4d_p
+    
+  SUBROUTINE WriteField_3d_p(name,Field)
+    USE mod_orchidee_para
+    USE Write_field, only : WriteField
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:,:) :: Field 
+      INTEGER, DIMENSION(3) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: Field_g
+      
+      
+      Dim=shape(Field)
+      
+      ALLOCATE(Field_g(iim_g,jjm_g,Dim(3)))
+      CALL Gather2D_mpi(Field,Field_g)
+
+      IF (is_root_prc) CALL WriteField(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteField_3d_p
+
+  SUBROUTINE WriteField_2d_p(name,Field)
+    USE mod_orchidee_para
+    USE Write_field, only : WriteField
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:) :: Field 
+      INTEGER, DIMENSION(2) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: Field_g
+      
+      
+      Dim=shape(Field)
+      
+      ALLOCATE(Field_g(iim_g,jjm_g))
+      CALL Gather2D_mpi(Field,Field_g)
+
+      IF (is_root_prc) CALL WriteField_gen(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteField_2d_p
+
+  SUBROUTINE WriteFieldI_3d_p(name,Field)
+    USE mod_orchidee_para
+    USE Write_field, only : WriteFieldI
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:,:) :: Field 
+      INTEGER, DIMENSION(3) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: Field_g
+      
+      
+      Dim=shape(Field)
+      
+      ALLOCATE(Field_g(nbp_glo,Dim(2),Dim(3)))
+      CALL gather(Field,Field_g)
+      
+      IF (is_root_prc) CALL WriteFieldI(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteFieldI_3d_p
+
+  SUBROUTINE WriteFieldI_2d_p(name,Field)
+    USE mod_orchidee_para
+    USE Write_field, only : WriteFieldI
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:,:) :: Field 
+      INTEGER, DIMENSION(2) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: Field_g
+      
+      
+      Dim=shape(Field)
+      
+      ALLOCATE(Field_g(nbp_glo,Dim(2)))
+      CALL gather(Field,Field_g)
+      
+      IF (is_root_prc) CALL WriteFieldI(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteFieldI_2d_p    
+
+  SUBROUTINE WriteFieldI_1d_p(name,Field)
+    USE mod_orchidee_para
+    USE Write_field, only : WriteFieldI
+    IMPLICIT NONE
+      CHARACTER(len=*) :: name
+      REAL, DIMENSION(:) :: Field 
+      INTEGER, DIMENSION(1) :: Dim
+      
+      REAL, ALLOCATABLE, DIMENSION(:) :: Field_g
+      
+      
+      Dim=shape(Field)
+      
+      ALLOCATE(Field_g(nbp_glo))
+      CALL gather(Field,Field_g)
+      
+      IF (is_root_prc) CALL WriteFieldI(name,Field_g)  
+      
+      DEALLOCATE(Field_g)
+  END SUBROUTINE WriteFieldI_1d_p    
+    
+END MODULE Orch_Write_field_p
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/src_parallel.h
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/src_parallel.h	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/src_parallel.h	(revision 5166)
@@ -0,0 +1,646 @@
+! Redefinition of MPI function if not second underscore in MPI library.
+! One must use -DMPI_SECOND__ in precompilation to activate those definitions.
+
+!-
+!- $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parallel/src_parallel.h,v 1.3 2009/06/24 10:15:00 ssipsl Exp $
+!-
+
+#ifdef MPI_SECOND__
+
+#define MPI_BARRIER MPI_BARRIER_
+#define MPI_FINALIZE MPI_FINALIZE_
+#define MPI_COMM_SIZE MPI_COMM_SIZE_
+#define MPI_INIT MPI_INIT_
+#define MPI_COMM_RANK MPI_COMM_RANK_
+#define MPI_GATHER MPI_GATHER_
+#define MPI_GATHERV MPI_GATHERV_
+#define MPI_BCAST MPI_BCAST_
+#define MPI_SCATTERV MPI_SCATTERV_
+#define MPI_REDUCE MPI_REDUCE_
+
+#endif
+
+#ifdef NF_SECOND__
+
+
+#define nf_get_varm_double nf_get_varm_double_
+#define nf_get_vara_text nf_get_vara_text_
+#define nf_get_vara_real nf_get_vara_real_
+#define nf_get_varm_int1 nf_get_varm_int1_
+#define nf_get_varm_int2 nf_get_varm_int2_
+#define nf_get_varm_text nf_get_varm_text_
+#define nf_get_varm_real nf_get_varm_real_
+#define nf_get_vars_int1 nf_get_vars_int1_
+#define nf_get_vars_int nf_get_vars_int_
+#define nf_get_vars_double nf_get_vars_double_
+#define nf_get_vars_text nf_get_vars_text_
+#define nf_inq_att nf_inq_att_
+#define nf_inq_attid nf_inq_attid_
+#define nf_inq_atttype nf_inq_atttype_
+#define nf_inq_attname nf_inq_attname_
+#define nf_inq_attlen nf_inq_attlen_
+#define nf_inq nf_inq_
+#define nf_inq_dim nf_inq_dim_
+#define nf_inq_dimlen nf_inq_dimlen_
+#define nf_inq_dimid nf_inq_dimid_
+#define nf_inq_libvers nf_inq_libvers_
+#define nf_inq_format nf_inq_format_
+#define nf_inq_natts nf_inq_natts_
+#define nf_inq_dimname nf_inq_dimname_
+#define nf_inq_base_pe nf_inq_base_pe_
+#define nf_get_vars_real nf_get_vars_real_
+#define nf_inq_nvars nf_inq_nvars_
+#define nf_inq_ndims nf_inq_ndims_
+#define nf_get_vars_int2 nf_get_vars_int2_
+#define nf_inq_var nf_inq_var_
+#define nf_inq_vardimid nf_inq_vardimid_
+#define nf_inq_varid nf_inq_varid_
+#define nf_inq_varnatts nf_inq_varnatts_
+#define nf_inq_varndims nf_inq_varndims_
+#define nf_inq_vartype nf_inq_vartype_
+#define nf_inq_varname nf_inq_varname_
+#define nf_issyserr nf_issyserr_
+#define nf_put_att_double nf_put_att_double_
+#define nf_open nf_open_
+#define nf_put_att_int1 nf_put_att_int1_
+#define nf_put_att_int nf_put_att_int_
+#define nf_put_att_text nf_put_att_text_
+#define nf_put_att_real nf_put_att_real_
+#define nf_put_att_int2 nf_put_att_int2_
+#define nf_inq_unlimdim nf_inq_unlimdim_
+#define nf_get_varm_int nf_get_varm_int_
+#define nf_put_var1_int nf_put_var1_int_
+#define nf_put_var1_int2 nf_put_var1_int2_
+#define nf_put_var1_int1 nf_put_var1_int1_
+#define nf_put_var1_text nf_put_var1_text_
+#define nf_put_var_int nf_put_var_int_
+#define nf_put_var_double nf_put_var_double_
+#define nf_put_var1_real nf_put_var1_real_
+#define nf_put_var_real nf_put_var_real_
+#define nf_put_vara_int2 nf_put_vara_int2_
+#define nf_put_vara_int1 nf_put_vara_int1_
+#define nf_put_vara_int nf_put_vara_int_
+#define nf_put_vara_double nf_put_vara_double_
+#define nf_put_vara_text nf_put_vara_text_
+#define nf_put_varm_int1 nf_put_varm_int1_
+#define nf_put_varm_int2 nf_put_varm_int2_
+#define nf_put_varm_int nf_put_varm_int_
+#define nf_put_varm_double nf_put_varm_double_
+#define nf_put_varm_real nf_put_varm_real_
+#define nf_put_vara_real nf_put_vara_real_
+#define nf_put_var_text nf_put_var_text_
+#define nf_put_var_int2 nf_put_var_int2_
+#define nf_put_var_int1 nf_put_var_int1_
+#define nf_put_vars_double nf_put_vars_double_
+#define nf_put_varm_text nf_put_varm_text_
+#define nf_put_var1_double nf_put_var1_double_
+#define nf_put_vars_int1 nf_put_vars_int1_
+#define nf_put_vars_int2 nf_put_vars_int2_
+#define nf_put_vars_text nf_put_vars_text_
+#define nf_put_vars_real nf_put_vars_real_
+#define nf_rename_att nf_rename_att_
+#define nf_set_base_pe nf_set_base_pe_
+#define nf_rename_var nf_rename_var_
+#define nf_rename_dim nf_rename_dim_
+#define nf_redef nf_redef_
+#define nf_sync nf_sync_
+#define nf_strerror nf_strerror_
+#define nf_set_fill nf_set_fill_
+#define nf_set_default_format nf_set_default_format_
+#define nf_put_vars_int nf_put_vars_int_
+#define nf_get_var_int2 nf_get_var_int2_
+#define nf__create_mp nf__create_mp_
+#define nf__open nf__open_
+#define nf__open_mp nf__open_mp_
+#define nf__enddef nf__enddef_
+#define nf_abort nf_abort_
+#define nf__create nf__create_
+#define nf_copy_att nf_copy_att_
+#define nf_create nf_create_
+#define nf_def_dim nf_def_dim_
+#define nf_copy_var nf_copy_var_
+#define nf_close nf_close_
+#define nf_del_att nf_del_att_
+#define nf_delete nf_delete_
+#define nf_def_var nf_def_var_
+#define nf_enddef nf_enddef_
+#define nf_get_att_real nf_get_att_real_
+#define nf_get_att_double nf_get_att_double_
+#define nf_get_att_int nf_get_att_int_
+#define nf_get_att_int2 nf_get_att_int2_
+#define nf_get_att_int1 nf_get_att_int1_
+#define nf_get_att_text nf_get_att_text_
+#define nf_get_var1_int nf_get_var1_int_
+#define nf_get_var1_int1 nf_get_var1_int1_
+#define nf_get_var1_text nf_get_var1_text_
+#define nf_get_var1_real nf_get_var1_real_
+#define nf_get_var1_int2 nf_get_var1_int2_
+#define nf_get_var1_double nf_get_var1_double_
+#define nf_get_var_int nf_get_var_int_
+#define nf_get_var_int2 nf_get_var_int2_
+#define nf_get_var_real nf_get_var_real_
+#define nf_get_var_int1 nf_get_var_int1_
+#define nf_get_var_text nf_get_var_text_
+#define nf_get_vara_int1 nf_get_vara_int1_
+#define nf_get_vara_int nf_get_vara_int_
+#define nf_get_vara_int2 nf_get_vara_int2_
+#define nf_get_vara_double nf_get_vara_double_
+#define nf_get_var_double nf_get_var_double_
+#define nf_get_varm_int nf_get_varm_int_
+#define nf_get_varm_double nf_get_varm_double_
+#define nf_get_varm_int2 nf_get_varm_int2_
+#define nf_get_vars_double nf_get_vars_double_
+#define nf_get_varm_text nf_get_varm_text_
+#define nf_get_varm_real nf_get_varm_real_
+#define nf_get_varm_int1 nf_get_varm_int1_
+#define nf_get_vara_text nf_get_vara_text_
+#define nf_get_vars_text nf_get_vars_text_
+#define nf_get_vars_real nf_get_vars_real_
+#define nf_get_vars_int2 nf_get_vars_int2_
+#define nf_get_vars_int1 nf_get_vars_int1_
+#define nf_inq_att nf_inq_att_
+#define nf_inq_attid nf_inq_attid_
+#define nf_inq nf_inq_
+#define nf_inq_atttype nf_inq_atttype_
+#define nf_inq_attname nf_inq_attname_
+#define nf_inq_dimlen nf_inq_dimlen_
+#define nf_inq_dimid nf_inq_dimid_
+#define nf_inq_libvers nf_inq_libvers_
+#define nf_inq_format nf_inq_format_
+#define nf_inq_dimname nf_inq_dimname_
+#define nf_inq_dim nf_inq_dim_
+#define nf_inq_base_pe nf_inq_base_pe_
+#define nf_inq_ndims nf_inq_ndims_
+#define nf_inq_unlimdim nf_inq_unlimdim_
+#define nf_inq_nvars nf_inq_nvars_
+#define nf_inq_var nf_inq_var_
+#define nf_inq_natts nf_inq_natts_
+#define nf_inq_varid nf_inq_varid_
+#define nf_inq_varname nf_inq_varname_
+#define nf_inq_varnatts nf_inq_varnatts_
+#define nf_inq_vardimid nf_inq_vardimid_
+#define nf_inq_attlen nf_inq_attlen_
+#define nf_get_vars_int nf_get_vars_int_
+#define nf_get_vara_real nf_get_vara_real_
+#define nf_inq_vartype nf_inq_vartype_
+#define nf_issyserr nf_issyserr_
+#define nf_open nf_open_
+#define nf_put_att_int1 nf_put_att_int1_
+#define nf_put_att_int2 nf_put_att_int2_
+#define nf_put_att_text nf_put_att_text_
+#define nf_put_var1_int nf_put_var1_int_
+#define nf_put_var1_int1 nf_put_var1_int1_
+#define nf_put_var1_double nf_put_var1_double_
+#define nf_put_var1_int2 nf_put_var1_int2_
+#define nf_put_var1_real nf_put_var1_real_
+#define nf_put_att_real nf_put_att_real_
+#define nf_put_var1_text nf_put_var1_text_
+#define nf_put_att_int nf_put_att_int_
+#define nf_put_att_double nf_put_att_double_
+#define nf_put_var_double nf_put_var_double_
+#define nf_put_var_int2 nf_put_var_int2_
+#define nf_put_var_int1 nf_put_var_int1_
+#define nf_put_var_real nf_put_var_real_
+#define nf_put_var_int nf_put_var_int_
+#define nf_inq_varndims nf_inq_varndims_
+#define nf_put_vara_int1 nf_put_vara_int1_
+#define nf_put_vara_text nf_put_vara_text_
+#define nf_put_vara_real nf_put_vara_real_
+#define nf_put_varm_int nf_put_varm_int_
+#define nf_put_varm_double nf_put_varm_double_
+#define nf_put_vara_int2 nf_put_vara_int2_
+#define nf_put_varm_int1 nf_put_varm_int1_
+#define nf_put_varm_real nf_put_varm_real_
+#define nf_put_varm_text nf_put_varm_text_
+#define nf_put_vars_int1 nf_put_vars_int1_
+#define nf_put_vars_int nf_put_vars_int_
+#define nf_put_vars_real nf_put_vars_real_
+#define nf_put_vars_int2 nf_put_vars_int2_
+#define nf_put_vars_text nf_put_vars_text_
+#define nf_put_vars_double nf_put_vars_double_
+#define nf_put_varm_int2 nf_put_varm_int2_
+#define nf_rename_dim nf_rename_dim_
+#define nf_rename_att nf_rename_att_
+#define nf_redef nf_redef_
+#define nf_set_base_pe nf_set_base_pe_
+#define nf_set_default_format nf_set_default_format_
+#define nf_rename_var nf_rename_var_
+#define nf_put_vara_int nf_put_vara_int_
+#define nf_strerror nf_strerror_
+#define nf_set_fill nf_set_fill_
+#define nf_put_var_text nf_put_var_text_
+        
+#define NF_GET_VARM_DOUBLE NF_GET_VARM_DOUBLE_
+#define NF_GET_VARA_TEXT NF_GET_VARA_TEXT_
+#define NF_GET_VARA_REAL NF_GET_VARA_REAL_
+#define NF_GET_VARM_INT1 NF_GET_VARM_INT1_
+#define NF_GET_VARM_INT2 NF_GET_VARM_INT2_
+#define NF_GET_VARM_TEXT NF_GET_VARM_TEXT_
+#define NF_GET_VARM_REAL NF_GET_VARM_REAL_
+#define NF_GET_VARS_INT1 NF_GET_VARS_INT1_
+#define NF_GET_VARS_INT NF_GET_VARS_INT_
+#define NF_GET_VARS_DOUBLE NF_GET_VARS_DOUBLE_
+#define NF_GET_VARS_TEXT NF_GET_VARS_TEXT_
+#define NF_INQ_ATT NF_INQ_ATT_
+#define NF_INQ_ATTID NF_INQ_ATTID_
+#define NF_INQ_ATTTYPE NF_INQ_ATTTYPE_
+#define NF_INQ_ATTNAME NF_INQ_ATTNAME_
+#define NF_INQ_ATTLEN NF_INQ_ATTLEN_
+#define NF_INQ NF_INQ_
+#define NF_INQ_DIM NF_INQ_DIM_
+#define NF_INQ_DIMLEN NF_INQ_DIMLEN_
+#define NF_INQ_DIMID NF_INQ_DIMID_
+#define NF_INQ_LIBVERS NF_INQ_LIBVERS_
+#define NF_INQ_FORMAT NF_INQ_FORMAT_
+#define NF_INQ_NATTS NF_INQ_NATTS_
+#define NF_INQ_DIMNAME NF_INQ_DIMNAME_
+#define NF_INQ_BASE_PE NF_INQ_BASE_PE_
+#define NF_GET_VARS_REAL NF_GET_VARS_REAL_
+#define NF_INQ_NVARS NF_INQ_NVARS_
+#define NF_INQ_NDIMS NF_INQ_NDIMS_
+#define NF_GET_VARS_INT2 NF_GET_VARS_INT2_
+#define NF_INQ_VAR NF_INQ_VAR_
+#define NF_INQ_VARDIMID NF_INQ_VARDIMID_
+#define NF_INQ_VARID NF_INQ_VARID_
+#define NF_INQ_VARNATTS NF_INQ_VARNATTS_
+#define NF_INQ_VARNDIMS NF_INQ_VARNDIMS_
+#define NF_INQ_VARTYPE NF_INQ_VARTYPE_
+#define NF_INQ_VARNAME NF_INQ_VARNAME_
+#define NF_ISSYSERR NF_ISSYSERR_
+#define NF_PUT_ATT_DOUBLE NF_PUT_ATT_DOUBLE_
+#define NF_OPEN NF_OPEN_
+#define NF_PUT_ATT_INT1 NF_PUT_ATT_INT1_
+#define NF_PUT_ATT_INT NF_PUT_ATT_INT_
+#define NF_PUT_ATT_TEXT NF_PUT_ATT_TEXT_
+#define NF_PUT_ATT_REAL NF_PUT_ATT_REAL_
+#define NF_PUT_ATT_INT2 NF_PUT_ATT_INT2_
+#define NF_INQ_UNLIMDIM NF_INQ_UNLIMDIM_
+#define NF_GET_VARM_INT NF_GET_VARM_INT_
+#define NF_PUT_VAR1_INT NF_PUT_VAR1_INT_
+#define NF_PUT_VAR1_INT2 NF_PUT_VAR1_INT2_
+#define NF_PUT_VAR1_INT1 NF_PUT_VAR1_INT1_
+#define NF_PUT_VAR1_TEXT NF_PUT_VAR1_TEXT_
+#define NF_PUT_VAR_INT NF_PUT_VAR_INT_
+#define NF_PUT_VAR_DOUBLE NF_PUT_VAR_DOUBLE_
+#define NF_PUT_VAR1_REAL NF_PUT_VAR1_REAL_
+#define NF_PUT_VAR_REAL NF_PUT_VAR_REAL_
+#define NF_PUT_VARA_INT2 NF_PUT_VARA_INT2_
+#define NF_PUT_VARA_INT1 NF_PUT_VARA_INT1_
+#define NF_PUT_VARA_INT NF_PUT_VARA_INT_
+#define NF_PUT_VARA_DOUBLE NF_PUT_VARA_DOUBLE_
+#define NF_PUT_VARA_TEXT NF_PUT_VARA_TEXT_
+#define NF_PUT_VARM_INT1 NF_PUT_VARM_INT1_
+#define NF_PUT_VARM_INT2 NF_PUT_VARM_INT2_
+#define NF_PUT_VARM_INT NF_PUT_VARM_INT_
+#define NF_PUT_VARM_DOUBLE NF_PUT_VARM_DOUBLE_
+#define NF_PUT_VARM_REAL NF_PUT_VARM_REAL_
+#define NF_PUT_VARA_REAL NF_PUT_VARA_REAL_
+#define NF_PUT_VAR_TEXT NF_PUT_VAR_TEXT_
+#define NF_PUT_VAR_INT2 NF_PUT_VAR_INT2_
+#define NF_PUT_VAR_INT1 NF_PUT_VAR_INT1_
+#define NF_PUT_VARS_DOUBLE NF_PUT_VARS_DOUBLE_
+#define NF_PUT_VARM_TEXT NF_PUT_VARM_TEXT_
+#define NF_PUT_VAR1_DOUBLE NF_PUT_VAR1_DOUBLE_
+#define NF_PUT_VARS_INT1 NF_PUT_VARS_INT1_
+#define NF_PUT_VARS_INT2 NF_PUT_VARS_INT2_
+#define NF_PUT_VARS_TEXT NF_PUT_VARS_TEXT_
+#define NF_PUT_VARS_REAL NF_PUT_VARS_REAL_
+#define NF_RENAME_ATT NF_RENAME_ATT_
+#define NF_SET_BASE_PE NF_SET_BASE_PE_
+#define NF_RENAME_VAR NF_RENAME_VAR_
+#define NF_RENAME_DIM NF_RENAME_DIM_
+#define NF_REDEF NF_REDEF_
+#define NF_SYNC NF_SYNC_
+#define NF_STRERROR NF_STRERROR_
+#define NF_SET_FILL NF_SET_FILL_
+#define NF_SET_DEFAULT_FORMAT NF_SET_DEFAULT_FORMAT_
+#define NF_PUT_VARS_INT NF_PUT_VARS_INT_
+#define NF_GET_VAR_INT2 NF_GET_VAR_INT2_
+#define NF__CREATE_MP NF__CREATE_MP_
+#define NF__OPEN NF__OPEN_
+#define NF__OPEN_MP NF__OPEN_MP_
+#define NF__ENDDEF NF__ENDDEF_
+#define NF_ABORT NF_ABORT_
+#define NF__CREATE NF__CREATE_
+#define NF_COPY_ATT NF_COPY_ATT_
+#define NF_CREATE NF_CREATE_
+#define NF_DEF_DIM NF_DEF_DIM_
+#define NF_COPY_VAR NF_COPY_VAR_
+#define NF_CLOSE NF_CLOSE_
+#define NF_DEL_ATT NF_DEL_ATT_
+#define NF_DELETE NF_DELETE_
+#define NF_DEF_VAR NF_DEF_VAR_
+#define NF_ENDDEF NF_ENDDEF_
+#define NF_GET_ATT_REAL NF_GET_ATT_REAL_
+#define NF_GET_ATT_DOUBLE NF_GET_ATT_DOUBLE_
+#define NF_GET_ATT_INT NF_GET_ATT_INT_
+#define NF_GET_ATT_INT2 NF_GET_ATT_INT2_
+#define NF_GET_ATT_INT1 NF_GET_ATT_INT1_
+#define NF_GET_ATT_TEXT NF_GET_ATT_TEXT_
+#define NF_GET_VAR1_INT NF_GET_VAR1_INT_
+#define NF_GET_VAR1_INT1 NF_GET_VAR1_INT1_
+#define NF_GET_VAR1_TEXT NF_GET_VAR1_TEXT_
+#define NF_GET_VAR1_REAL NF_GET_VAR1_REAL_
+#define NF_GET_VAR1_INT2 NF_GET_VAR1_INT2_
+#define NF_GET_VAR1_DOUBLE NF_GET_VAR1_DOUBLE_
+#define NF_GET_VAR_INT NF_GET_VAR_INT_
+#define NF_GET_VAR_INT2 NF_GET_VAR_INT2_
+#define NF_GET_VAR_REAL NF_GET_VAR_REAL_
+#define NF_GET_VAR_INT1 NF_GET_VAR_INT1_
+#define NF_GET_VAR_TEXT NF_GET_VAR_TEXT_
+#define NF_GET_VARA_INT1 NF_GET_VARA_INT1_
+#define NF_GET_VARA_INT NF_GET_VARA_INT_
+#define NF_GET_VARA_INT2 NF_GET_VARA_INT2_
+#define NF_GET_VARA_DOUBLE NF_GET_VARA_DOUBLE_
+#define NF_GET_VAR_DOUBLE NF_GET_VAR_DOUBLE_
+#define NF_GET_VARM_INT NF_GET_VARM_INT_
+#define NF_GET_VARM_DOUBLE NF_GET_VARM_DOUBLE_
+#define NF_GET_VARM_INT2 NF_GET_VARM_INT2_
+#define NF_GET_VARS_DOUBLE NF_GET_VARS_DOUBLE_
+#define NF_GET_VARM_TEXT NF_GET_VARM_TEXT_
+#define NF_GET_VARM_REAL NF_GET_VARM_REAL_
+#define NF_GET_VARM_INT1 NF_GET_VARM_INT1_
+#define NF_GET_VARA_TEXT NF_GET_VARA_TEXT_
+#define NF_GET_VARS_TEXT NF_GET_VARS_TEXT_
+#define NF_GET_VARS_REAL NF_GET_VARS_REAL_
+#define NF_GET_VARS_INT2 NF_GET_VARS_INT2_
+#define NF_GET_VARS_INT1 NF_GET_VARS_INT1_
+#define NF_INQ_ATT NF_INQ_ATT_
+#define NF_INQ_ATTID NF_INQ_ATTID_
+#define NF_INQ NF_INQ_
+#define NF_INQ_ATTTYPE NF_INQ_ATTTYPE_
+#define NF_INQ_ATTNAME NF_INQ_ATTNAME_
+#define NF_INQ_DIMLEN NF_INQ_DIMLEN_
+#define NF_INQ_DIMID NF_INQ_DIMID_
+#define NF_INQ_LIBVERS NF_INQ_LIBVERS_
+#define NF_INQ_FORMAT NF_INQ_FORMAT_
+#define NF_INQ_DIMNAME NF_INQ_DIMNAME_
+#define NF_INQ_DIM NF_INQ_DIM_
+#define NF_INQ_BASE_PE NF_INQ_BASE_PE_
+#define NF_INQ_NDIMS NF_INQ_NDIMS_
+#define NF_INQ_UNLIMDIM NF_INQ_UNLIMDIM_
+#define NF_INQ_NVARS NF_INQ_NVARS_
+#define NF_INQ_VAR NF_INQ_VAR_
+#define NF_INQ_NATTS NF_INQ_NATTS_
+#define NF_INQ_VARID NF_INQ_VARID_
+#define NF_INQ_VARNAME NF_INQ_VARNAME_
+#define NF_INQ_VARNATTS NF_INQ_VARNATTS_
+#define NF_INQ_VARDIMID NF_INQ_VARDIMID_
+#define NF_INQ_ATTLEN NF_INQ_ATTLEN_
+#define NF_GET_VARS_INT NF_GET_VARS_INT_
+#define NF_GET_VARA_REAL NF_GET_VARA_REAL_
+#define NF_INQ_VARTYPE NF_INQ_VARTYPE_
+#define NF_ISSYSERR NF_ISSYSERR_
+#define NF_OPEN NF_OPEN_
+#define NF_PUT_ATT_INT1 NF_PUT_ATT_INT1_
+#define NF_PUT_ATT_INT2 NF_PUT_ATT_INT2_
+#define NF_PUT_ATT_TEXT NF_PUT_ATT_TEXT_
+#define NF_PUT_VAR1_INT NF_PUT_VAR1_INT_
+#define NF_PUT_VAR1_INT1 NF_PUT_VAR1_INT1_
+#define NF_PUT_VAR1_DOUBLE NF_PUT_VAR1_DOUBLE_
+#define NF_PUT_VAR1_INT2 NF_PUT_VAR1_INT2_
+#define NF_PUT_VAR1_REAL NF_PUT_VAR1_REAL_
+#define NF_PUT_ATT_REAL NF_PUT_ATT_REAL_
+#define NF_PUT_VAR1_TEXT NF_PUT_VAR1_TEXT_
+#define NF_PUT_ATT_INT NF_PUT_ATT_INT_
+#define NF_PUT_ATT_DOUBLE NF_PUT_ATT_DOUBLE_
+#define NF_PUT_VAR_DOUBLE NF_PUT_VAR_DOUBLE_
+#define NF_PUT_VAR_INT2 NF_PUT_VAR_INT2_
+#define NF_PUT_VAR_INT1 NF_PUT_VAR_INT1_
+#define NF_PUT_VAR_REAL NF_PUT_VAR_REAL_
+#define NF_PUT_VAR_INT NF_PUT_VAR_INT_
+#define NF_INQ_VARNDIMS NF_INQ_VARNDIMS_
+#define NF_PUT_VARA_INT1 NF_PUT_VARA_INT1_
+#define NF_PUT_VARA_TEXT NF_PUT_VARA_TEXT_
+#define NF_PUT_VARA_REAL NF_PUT_VARA_REAL_
+#define NF_PUT_VARM_INT NF_PUT_VARM_INT_
+#define NF_PUT_VARM_DOUBLE NF_PUT_VARM_DOUBLE_
+#define NF_PUT_VARA_INT2 NF_PUT_VARA_INT2_
+#define NF_PUT_VARM_INT1 NF_PUT_VARM_INT1_
+#define NF_PUT_VARM_REAL NF_PUT_VARM_REAL_
+#define NF_PUT_VARM_TEXT NF_PUT_VARM_TEXT_
+#define NF_PUT_VARS_INT1 NF_PUT_VARS_INT1_
+#define NF_PUT_VARS_INT NF_PUT_VARS_INT_
+#define NF_PUT_VARS_REAL NF_PUT_VARS_REAL_
+#define NF_PUT_VARS_INT2 NF_PUT_VARS_INT2_
+#define NF_PUT_VARS_TEXT NF_PUT_VARS_TEXT_
+#define NF_PUT_VARS_DOUBLE NF_PUT_VARS_DOUBLE_
+#define NF_PUT_VARM_INT2 NF_PUT_VARM_INT2_
+#define NF_RENAME_DIM NF_RENAME_DIM_
+#define NF_RENAME_ATT NF_RENAME_ATT_
+#define NF_REDEF NF_REDEF_
+#define NF_SET_BASE_PE NF_SET_BASE_PE_
+#define NF_SET_DEFAULT_FORMAT NF_SET_DEFAULT_FORMAT_
+#define NF_RENAME_VAR NF_RENAME_VAR_
+#define NF_PUT_VARA_INT NF_PUT_VARA_INT_
+#define NF_STRERROR NF_STRERROR_
+#define NF_SET_FILL NF_SET_FILL_
+#define NF_PUT_VAR_TEXT NF_PUT_VAR_TEXT_
+
+#endif
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/timer.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/timer.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/timer.f90	(revision 5166)
@@ -0,0 +1,178 @@
+! Timer functions to calculate MPI use speed up.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE timer
+
+  USE mod_orchidee_mpi_data
+!  USE data_para
+  
+  INTEGER, PARAMETER :: nb_timer=2
+  INTEGER, PARAMETER :: timer_global=1
+  INTEGER, PARAMETER :: timer_mpi=2
+  INTEGER, PARAMETER :: stopped = 1
+  INTEGER, PARAMETER :: running = 2
+  INTEGER, PARAMETER :: suspended = 3
+  
+  DOUBLE PRECISION, DIMENSION(nb_timer),SAVE :: cpu_timer
+  DOUBLE PRECISION, DIMENSION(nb_timer),SAVE :: real_timer
+  INTEGER, DIMENSION(nb_timer),SAVE :: timer_state
+  DOUBLE PRECISION, DIMENSION(nb_timer),SAVE :: last_cpu_time
+  INTEGER, DIMENSION(nb_timer),SAVE :: last_real_time
+  
+  
+  
+  
+  CONTAINS
+  
+  SUBROUTINE init_timer
+  IMPLICIT NONE
+    
+    cpu_timer(:)=0.
+    real_timer(:)=0.
+    timer_state(:)=stopped
+    last_cpu_time(:)=0.
+    last_real_time(:)=0
+    
+  END SUBROUTINE init_timer
+  
+  
+  SUBROUTINE start_timer(no_timer)
+  IMPLICIT NONE
+     INTEGER :: no_timer
+     DOUBLE PRECISION :: x
+     
+     IF (timer_state(no_timer)/=stopped) THEN
+       STOP 'start_timer :: timer is already running or suspended'
+     ELSE
+        timer_state(no_timer)=running
+     ENDIF
+      
+     cpu_timer(no_timer)=0. 
+     real_timer(no_timer)=0.
+     x=Diff_real_time(no_timer)
+     x=Diff_cpu_time(no_timer)
+     
+  END SUBROUTINE start_timer
+  
+  
+  
+  SUBROUTINE stop_timer(no_timer)
+  IMPLICIT NONE
+    INTEGER :: no_timer
+    
+     IF (timer_state(no_timer)==running) THEN
+        CALL suspend_timer(no_timer)
+     ELSE IF (timer_state(no_timer)==stopped) THEN
+       WRITE(numout,*) 'stop_timer :: timer is already stopped'
+     ENDIF
+
+     timer_state(no_timer)=stopped
+
+  END SUBROUTINE stop_timer
+  
+  
+  
+  SUBROUTINE resume_timer(no_timer)
+  IMPLICIT NONE
+    INTEGER :: no_timer
+    DOUBLE PRECISION :: x
+     IF (timer_state(no_timer)/=suspended) THEN
+       STOP 'resume_timer :: timer is not suspended'
+     ELSE
+        timer_state(no_timer)=running
+     ENDIF
+  
+     x=Diff_cpu_time(no_timer)
+     x=Diff_real_time(no_timer)  
+  
+  END SUBROUTINE resume_timer
+  
+  
+  
+  SUBROUTINE suspend_timer(no_timer)
+  
+    IMPLICIT NONE
+    INTEGER :: no_timer
+    
+     IF (timer_state(no_timer)/=running) THEN
+       STOP 'suspend_timer :: timer is not running'
+     ELSE
+        timer_state(no_timer)=suspended
+     ENDIF
+  
+     cpu_timer(no_timer)=cpu_timer(no_timer)+Diff_cpu_time(no_timer)
+     real_timer(no_timer)=real_timer(no_timer)+Diff_real_time(no_timer)
+  
+  END SUBROUTINE suspend_timer
+  
+  
+  FUNCTION diff_real_time(no_timer)
+  IMPLICIT NONE
+    INTEGER :: no_timer
+    DOUBLE PRECISION :: Diff_real_Time
+    integer :: Last_Count,count,count_rate,count_max
+    
+    Last_Count=Last_real_time(no_timer)
+    
+    call system_clock(count,count_rate,count_max)
+    if (Count>=Last_Count) then
+      Diff_real_time=(1.*(Count-last_Count))/count_rate
+    else
+      Diff_real_time=(1.*(Count-last_Count+Count_max))/count_rate
+    endif
+    Last_real_time(no_timer)=Count 
+    
+  END FUNCTION diff_real_time
+  
+  function Diff_Cpu_Time(no_timer)
+  implicit none
+    INTEGER :: no_timer
+    DOUBLE PRECISION :: Diff_Cpu_Time
+    DOUBLE PRECISION :: Last_Count,Count
+    
+    Last_Count=Last_cpu_time(no_timer)
+    
+    call cpu_time(Count)
+    Diff_Cpu_Time=Count-Last_Count
+    Last_cpu_time(no_timer)=Count 
+    
+  end function Diff_Cpu_Time
+  
+  FUNCTION Get_cpu_time(no_timer)
+  IMPLICIT NONE
+  INTEGER :: no_timer
+  DOUBLE PRECISION :: Get_cpu_time
+  
+    IF (timer_state(no_timer)==running) THEN
+      CALL suspend_timer(no_timer)
+      Get_cpu_time=cpu_timer(no_timer)
+      CALL resume_timer(no_timer)
+    ELSE
+      Get_cpu_time=cpu_timer(no_timer)
+    ENDIF
+    
+  END FUNCTION Get_cpu_time
+  
+  FUNCTION Get_real_time(no_timer)
+  IMPLICIT NONE
+  INTEGER :: no_timer
+  DOUBLE PRECISION :: Get_real_time
+  
+    IF (timer_state(no_timer)==running) THEN
+      CALL suspend_timer(no_timer)
+      Get_real_time=real_timer(no_timer)
+      CALL resume_timer(no_timer)
+    ELSE
+      Get_real_time=real_timer(no_timer)
+    ENDIF
+  
+  END FUNCTION Get_real_time
+  
+END MODULE Timer
+  
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/tools_para.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/tools_para.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/tools_para.f90	(revision 5166)
@@ -0,0 +1,56 @@
+! Parallel tools : Barrier and Finalize.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE tools_para
+!-
+  USE ioipsl
+  USE defprec
+  USE timer
+!  USE data_para
+  use mod_orchidee_mpi_data
+!-
+#include "src_parallel.h"
+!-
+CONTAINS
+  SUBROUTINE stop_mpi()
+#ifdef CPP_PARA
+    CALL MPI_COMM_FREE(MPI_COMM_ORCH,ierr)
+    CALL MPI_FINALIZE(ierr)
+#endif
+    CALL ipslerr(3,'STOP_MPI','MPI has been stopped in ORCHIDEE.',&
+ &                 "Don't know the reason","Please verify output.")
+  ENd subroutine stop_mpi
+
+  SUBROUTINE barrier_para()
+#ifdef CPP_PARA
+    CALL MPI_BARRIER(MPI_COMM_ORCH,ierr)
+#endif
+  END SUBROUTINE barrier_para
+
+  SUBROUTINE finalize_para(timer_global,timer_mpi)
+    INTEGER, INTENT(IN) :: timer_global, timer_mpi
+    DOUBLE PRECISION :: cpu_time_mpi
+
+    cpu_time_mpi = Get_cpu_time(timer_mpi)
+    WRITE(numout,*) '*********************************************************'
+    WRITE(numout,*) ' TEMPS GLOBAL   ---> REAL TIME :',Get_real_time(timer_global)
+    WRITE(numout,*) ' TEMPS GLOBAL   ---> CPU TIME  :',Get_cpu_time(timer_global)
+    WRITE(numout,*) ' TEMPS HORS MPI ---> REAL TIME :',Get_real_time(timer_mpi)
+    WRITE(numout,*) ' TEMPS HORS MPI ---> CPU TIME  :',cpu_time_mpi
+    WRITE(numout,*) '*********************************************************' 
+    WRITE(numout,*) 'END OF RUN.'
+
+    CALL Write_Load_Balance(REAL(cpu_time_mpi, r_std))
+#ifdef CPP_PARA
+!    CALL MPI_COMM_FREE(MPI_COMM_ORCH,ierr)
+    CALL MPI_FINALIZE(ierr)
+#endif
+  END SUBROUTINE finalize_para
+
+END MODULE tools_para
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/write_field.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/write_field.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/write_field.f90	(revision 5166)
@@ -0,0 +1,12 @@
+! Yann Meurdesoif module for sequentiel tests.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE Write_Field
+  USE Orch_Write_Field
+END MODULE Write_Field
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/write_field_p.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/write_field_p.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parallel/write_field_p.f90	(revision 5166)
@@ -0,0 +1,12 @@
+! Yann Meurdesoif module for parallel tests.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE Write_field_p
+  USE Orch_Write_Field_p
+END MODULE Write_field_p
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/AA_make	(revision 5166)
@@ -0,0 +1,82 @@
+#-
+#- $Id$
+#-
+IOIPSL_LIB = $(LIBDIR)/libioipsl.a
+SXIOIPSL_LIB = $(IOIPSL_LIB)
+#-Q- sxnec SXIOIPSL_LIB = $(LIBDIR)/libsxioipsl.a
+#-Q- sx6nec SXIOIPSL_LIB = $(LIBDIR)/libsxioipsl.a
+#-Q- eshpux SXIOIPSL_LIB = $(LIBDIR)/libsxioipsl.a
+#-Q- sx8brodie SXIOIPSL_LIB = $(LIBDIR)/libsxioipsl.a
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec  SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+MODS1 = constantes.f90 \
+	constantes_var.f90   \
+	constantes_soil.f90   \
+	constantes_soil_var.f90   \
+	constantes_mtc.f90   \
+	pft_parameters.f90 \
+	pft_parameters_var.f90 
+#
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libioipsl
+	$(M_K) libparallel
+	$(M_K) m_all
+	@echo parameter is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+
+libioipsl:
+	(cd ../../IOIPSL/src; $(M_K) -f Makefile)
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o): %.f90
+	$(F_C) $(F_O) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+
+config:
+	$(BINDIR)/Fparser -name PARAMETERS  $(MODS1)
+	echo 'Configuration of PARAMETERS done'
+ 
+clean:
+	$(RM) $(MODEL_LIB)
+ 
+$(MODEL_LIB)(pft_parameters.o): \
+  $(MODEL_LIB)(pft_parameters_var.o) \
+  $(MODEL_LIB)(constantes_mtc.o)
+$(MODEL_LIB)(constantes_soil.o): \
+  $(MODEL_LIB)(constantes_soil_var.o) \
+  $(MODEL_LIB)(constantes.o)
+$(MODEL_LIB)(constantes.o): \
+  $(MODEL_LIB)(constantes_var.o) \
+  $(PARALLEL_LIB) \
+  $(IOIPSL_LIB)
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/AA_make.ldef	(revision 5166)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a PARAMETER
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/libparameters.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxparameters.a
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes.f90	(revision 5166)
@@ -0,0 +1,2298 @@
+! =================================================================================================================================
+! MODULE       : constantes
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        "constantes" module contains subroutines to initialize most of the exernalized parameters. This module
+!!              also make a use to the module constantes_var where the parameters are declared.
+!!
+!!\n DESCRIPTION: This module contains subroutines to initialize most of the exernalized parameters. This module
+!!                also make a use to the module constantes_var where the parameters are declared.\n
+!!                This module can be used to acces the subroutines and the constantes. The constantes declarations
+!!                can also be used seperatly with "USE constantes_var".
+!!
+!! RECENT CHANGE(S): Didier Solyga : This module contains now all the externalized parameters of ORCHIDEE 
+!!                   listed by modules which are not pft-dependent  
+!!                   Josefine Ghattas 2013 : The declaration part has been extracted and moved to module constates_var
+!!
+!! REFERENCE(S)	: 
+!! - Louis, Jean-Francois (1979), A parametric model of vertical eddy fluxes in the atmosphere. 
+!! Boundary Layer Meteorology, 187-202.
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes
+
+  USE constantes_var
+  USE defprec
+  USE ioipsl_para, ONLY : getin_p, ipslerr_p
+  USE mod_orchidee_para, ONLY : numout
+
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : activate_sub_models
+!!
+!>\BRIEF         This subroutine reads the flags in the configuration file to
+!! activate some sub-models like routing, irrigation, fire, herbivory, ...  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE activate_sub_models(active_flags)
+
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+     !! 0.1 Input variables
+
+     TYPE(control_type), INTENT(in) :: active_flags     !! What parts of the code are activated ?
+
+     !! 0.4 Local variables
+
+     LOGICAL, SAVE ::  first_call = .TRUE.             !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+
+     IF (first_call) THEN 
+           
+        IF (active_flags%ok_stomate) THEN
+
+           !Config Key   = HERBIVORES
+           !Config Desc  = herbivores allowed?
+           !Config If    = OK_STOMATE 
+           !Config Def   = n
+           !Config Help  = With this variable, you can determine
+           !Config         if herbivores are activated
+           !Config Units = [FLAG]
+           CALL getin_p('HERBIVORES', ok_herbivores)
+           !
+           !Config Key   = TREAT_EXPANSION
+           !Config Desc  = treat expansion of PFTs across a grid cell?
+           !Config If    = OK_STOMATE 
+           !Config Def   = n
+           !Config Help  = With this variable, you can determine
+           !Config         whether we treat expansion of PFTs across a
+           !Config         grid cell.
+           !Config Units = [FLAG]
+           CALL getin_p('TREAT_EXPANSION', treat_expansion)
+           !
+           !Config Key   = LPJ_GAP_CONST_MORT
+           !Config Desc  = prescribe mortality if not using DGVM?
+           !Config If    = OK_STOMATE
+           !Config Def   = y
+           !Config Help  = set to TRUE if constant mortality is to be activated
+           !Config         ignored if DGVM=true!
+           !Config Units = [FLAG]
+           CALL getin_p('LPJ_GAP_CONST_MORT', lpj_gap_const_mort)
+           !
+           !Config Key   = HARVEST_AGRI
+           !Config Desc  = Harvest model for agricultural PFTs.
+           !Config If    = OK_STOMATE 
+           !Config Def   = y
+           !Config Help  = Compute harvest above ground biomass for agriculture.
+           !Config         Change daily turnover.
+           !Config Units = [FLAG]
+           CALL getin_p('HARVEST_AGRI', harvest_agri)
+           !
+           !Config Key   = FIRE_DISABLE
+           !Config Desc  = no fire allowed
+           !Config If    = OK_STOMATE 
+           !Config Def   = n
+           !Config Help  = With this variable, you can allow or not
+           !Config         the estimation of CO2 lost by fire
+           !Config Units = [FLAG]
+           CALL getin_p('FIRE_DISABLE', disable_fire)
+           !
+           !Config Key   = SPINUP_ANALYTIC
+           !Config Desc  = Activation of the analytic resolution of the spinup.
+           !Config If    = OK_STOMATE
+           !Config Def   = y
+           !Config Help  = Activate this option if you want to solve the spinup by the Gauss-Jordan method.
+           !Config Units = BOOLEAN    
+           CALL getin_p('SPINUP_ANALYTIC',spinup_analytic)
+           !
+           !Config Key   = MOIST_FUNC_MOYANO 
+           !Config Desc  = Activation the calculation of moisture control
+           !function on soil C decomposition based on Moyano et al., 2012 BG 
+           !Config If    = OK_STOMATE
+           !Config Def   = n 
+           !Config Help  = Activate this option if you want to calculate
+           !moisture control function on soil C decomposition based on Moyano et
+           !al., 2012 BG
+           !Config Units = BOOLEAN    
+           CALL getin_p('MOIST_FUNC_MOYANO',moist_func_Moyano)
+
+        ENDIF
+
+        !
+        ! Check consistency (see later)
+        !
+!!$        IF(.NOT.(ok_routing) .AND. (doirrigation .OR. dofloodplains)) THEN
+!!$           CALL ipslerr_p(2,'activate_sub_models', &
+!!$               &     'Problem :you tried to activate the irrigation and floodplains without activating the routing',&
+!!$               &     'Are you sure ?', &
+!!$               &     '(check your parameters).')
+!!$        ENDIF
+       
+!!$        IF(.NOT.(ok_stomate) .AND. (ok_herbivores .OR. treat_expansion .OR. lpj_gap_const_mort &
+!!$            & .OR. harvest_agri .OR. disable_fire)) THEN
+!!$          CALL ipslerr_p(2,'activate_sub_models', &
+!!$               &     'Problem : try to activate the following options : herbivory, treat_expansion, fire,',&
+!!$               &     'harvest_agri and constant mortality without stomate activated.',&
+!!$               &     '(check your parameters).')
+!!$        ENDIF
+            
+        first_call =.FALSE.
+
+     ENDIF
+
+   END SUBROUTINE activate_sub_models
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : veget_config
+!!
+!>\BRIEF         This subroutine reads the flags controlling the configuration for
+!! the vegetation : impose_veg, veget_mpa, lai_map, etc...       
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE veget_config
+
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+     !! 0.4 Local variables  
+
+     LOGICAL, SAVE ::  first_call = .TRUE.        !! To keep first call trace (true/false)  
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+     
+     IF (first_call) THEN 
+
+        !Config Key   = AGRICULTURE
+        !Config Desc  = agriculture allowed?
+        !Config If    = OK_SECHIBA or OK_STOMATE
+        !Config Def   = y
+        !Config Help  = With this variable, you can determine
+        !Config         whether agriculture is allowed
+        !Config Units = [FLAG]
+        CALL getin_p('AGRICULTURE', agriculture)
+        !
+        !Config Key   = IMPOSE_VEG
+        !Config Desc  = Should the vegetation be prescribed ?
+        !Config If    = OK_SECHIBA or OK_STOMATE
+        !Config Def   = n
+        !Config Help  = This flag allows the user to impose a vegetation distribution
+        !Config         and its characteristics. It is espacially interesting for 0D
+        !Config         simulations. On the globe it does not make too much sense as
+        !Config         it imposes the same vegetation everywhere
+        !Config Units = [FLAG]
+        CALL getin_p('IMPOSE_VEG', impveg)
+
+        IF (impveg) THEN
+           !Config Key   = IMPOSE_SOILT
+           !Config Desc  = Should the soil type be prescribed ?
+           !Config Def   = n
+           !Config If    = IMPOSE_VEG
+           !Config Help  = This flag allows the user to impose a soil type distribution.
+           !Config         It is espacially interesting for 0D
+           !Config         simulations. On the globe it does not make too much sense as
+           !Config         it imposes the same soil everywhere
+           !Config Units = [FLAG]
+           CALL getin_p('IMPOSE_SOILT', impsoilt)     
+        ENDIF
+
+        !Config Key   = LAI_MAP
+        !Config Desc  = Read the LAI map
+        !Config If    = OK_SECHIBA or OK_STOMATE
+        !Config Def   = n
+        !Config Help  = It is possible to read a 12 month LAI map which will
+        !Config         then be interpolated to daily values as needed.
+        !Config Units = [FLAG]
+        CALL getin_p('LAI_MAP',read_lai)
+
+        IF(read_lai) THEN
+           !Config Key   = SLOWPROC_LAI_OLD_INTERPOL
+           !Config Desc  = Flag to use old "interpolation" of LAI
+           !Config If    = LAI_MAP
+           !Config Def   = n
+           !Config Help  = If you want to recover the old (ie orchidee_1_2 branch) 
+           !Config         "interpolation" of LAI map.
+           !Config Units = [FLAG]
+           CALL getin_p('SLOWPROC_LAI_OLD_INTERPOL',old_lai)
+        ENDIF
+ 
+        !Config Key   = LAND_USE
+        !Config Desc  = Read a land_use vegetation map
+        !Config If    = OK_SECHIBA or OK_STOMATE
+        !Config Def   = y
+        !Config Help  = pft values are needed, max time axis is 293
+        !Config Units = [FLAG]
+        CALL getin_p('LAND_USE',land_use)
+
+        IF(land_use) THEN
+           !Config Key   = VEGET_REINIT
+           !Config Desc  = booleen to indicate that a new LAND USE file will be used.
+           !Config If    = LAND_USE
+           !Config Def   = y
+           !Config Help  = The parameter is used to bypass veget_year count 
+           !Config         and reinitialize it with VEGET_YEAR parameter.
+           !Config         Then it is possible to change LAND USE file.
+           !Config Units = [FLAG] 
+           CALL getin_p('VEGET_REINIT', veget_reinit)
+           !
+           !Config Key   = LAND_COVER_CHANGE
+           !Config Desc  = treat land use modifications
+           !Config If    = LAND_USE
+           !Config Def   = n
+           !Config Help  = With this variable, you can use a Land Use map
+           !Config         to simulate anthropic modifications such as 
+           !Config         deforestation.
+           !Config Units = [FLAG] 
+           CALL getin_p('LAND_COVER_CHANGE', lcchange)
+           !
+           !Config Key   = VEGET_YEAR
+           !Config Desc  = Year of the land_use vegetation map to be read
+           !Config If    = LAND_USE
+           !Config Def   = 1
+           !Config Help  = First year for landuse vegetation (2D map by pft).
+           !Config         If VEGET_YEAR is set to 0, this means there is no time axis.
+           !Config Units = [FLAG] 
+           CALL getin_p('VEGET_YEAR', veget_year_orig)
+        ENDIF
+
+        IF(.NOT. impveg .AND. .NOT. land_use) THEN
+           !Config Key   = SLOWPROC_VEGET_OLD_INTERPOL
+           !Config Desc  = Flag to use old "interpolation" of vegetation map.
+           !Config If    = NOT(IMPOSE_VEG) and NOT(LAND_USE)
+           !Config Def   = n
+           !Config Help  = If you want to recover the old (ie orchidee_1_2 branch) 
+           !Config         "interpolation" of vegetation map.
+           !Config Units = [FLAG] 
+           CALL getin_p('SLOWPROC_VEGET_OLD_INTERPOL',old_veget)
+         ENDIF  
+
+         !
+         ! Check consistency
+         !
+         ! 1. You have to activate agriculture and land_use
+         IF ( .NOT. agriculture .AND. land_use ) THEN 
+            CALL ipslerr_p(2,'veget_config', &
+                 &     'Problem with agriculture desactivated and Land Use activated.',&
+                 &     'Are you sure ?', &
+                 &     '(check your parameters).')
+         ENDIF
+
+
+        first_call = .FALSE.
+
+     ENDIF
+
+!!$        ! DS : Add warning in case of a wrong configuration (need to be discussed)
+!!$        ! 2. 
+!!$        IF (.NOT.(read_lai) .AND. old_lai) THEN
+!!$           CALL ipslerr_p(2,'veget_config', &
+!!$               &     'Problem with lai_map desactivated and old_lai activated.',&
+!!$               &     'Are you sure ?', &
+!!$               &     '(check your parameters).')
+!!$        ENDIF
+!!$    
+!!$        ! 3.
+!!$        IF ((impveg .OR. land_use) .AND. old_veget) THEN
+!!$           CALL ipslerr_p(2,'veget_config', &
+!!$                &     'Problem : try to use the old interpolation with a land use map or in impose_veg.',&
+!!$                &     'Are you sure ?', &
+!!$                &     '(check your parameters).')
+!!$        ENDIF
+!!$
+!!$        ! 4.
+!!$        IF ( .NOT.(impveg) .AND. impsoilt) THEN
+!!$           CALL ipslerr_p(2,'veget_config', &
+!!$               &     'Problem : try to activate impose_soilt without activating impose_veg.',&
+!!$               &     'Are you sure ?', &
+!!$               &     '(check your parameters).')
+!!$        ENDIF
+!!$
+!!$        ! 5.
+!!$        IF (.NOT.(land_use) .AND. (veget_reinit)) THEN
+!!$           CALL ipslerr_p(2,'veget_config', &
+!!$                &     'Problem : try to use a land_use map without activating land_use.',&
+!!$                &     'Are you sure ?', &
+!!$                &     '(check your parameters).')        
+!!$        ENDIF
+!!$
+!!$        ! 6.
+!!$        IF (.NOT.(land_use) .AND. lcchange) THEN
+!!$           CALL ipslerr_p(2,'veget_config', &
+!!$                &     'Problem : lcchange is activated without activating land_use.',&
+!!$                &     'Are you sure ?', &
+!!$                &     '(check your parameters).')        
+!!$        ENDIF
+           
+   END SUBROUTINE veget_config
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : veget_config
+!!
+!>\BRIEF         This subroutine reads in the configuration file the imposed values of the parameters for all SECHIBA modules.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE config_sechiba_parameters
+
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+     !! 0.4 Local variables
+     
+     LOGICAL, SAVE ::  first_call = .TRUE.    !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+     
+     IF(first_call) THEN 
+        
+        ! Global : parameters used by many modules
+        !
+        !Config Key   = MAXMASS_GLACIER
+        !Config Desc  = The maximum mass of a glacier
+        !Config If    = OK_SECHIBA or HYDROL_CWRR
+        !Config Def   = 3000.
+        !Config Help  = 
+        !Config Units = [kg/m^2]  
+        CALL getin_p('MAXMASS_GLACIER',maxmass_glacier)
+        !
+        !Config Key   = SNOWCRI
+        !Config Desc  = Sets the amount above which only sublimation occures 
+        !Config If    = OK_SECHIBA or HYDROL_CWRR
+        !Config Def   = 1.5
+        !Config Help  = 
+        !Config Units = [kg/m^2]  
+        CALL getin_p('SNOWCRI',snowcri)
+        !
+        !! Initialization of sneige
+        sneige = snowcri/mille
+        !
+        !Config Key   = MIN_WIND
+        !Config Desc  = Minimum wind speed
+        !Config If    = OK_SECHIBA
+        !Config Def   = 0.1
+        !Config Help  = 
+        !Config Units = [m/s]
+        CALL getin_p('MIN_WIND',min_wind)
+        !
+        !Config Key   = MAX_SNOW_AGE
+        !Config Desc  = Maximum period of snow aging 
+        !Config If    = OK_SECHIBA
+        !Config Def   = 50.
+        !Config Help  = 
+        !Config Units = [days?]
+        CALL getin_p('MAX_SNOW_AGE',max_snow_age)
+        !
+        !Config Key   = SNOW_TRANS
+        !Config Desc  = Transformation time constant for snow
+        !Config If    = OK_SECHIBA
+        !Config Def   = 0.3
+        !Config Help  = 
+        !Config Units = [m]   
+        CALL getin_p('SNOW_TRANS',snow_trans)
+ 
+        !-
+        ! condveg
+        !-
+        !
+        !Config Key   = Z0_OVER_HEIGHT
+        !Config Desc  = to get z0 from height 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 1/16.
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('Z0_OVER_HEIGHT',z0_over_height)
+        !
+        !Config Key   = HEIGHT_DISPLACEMENT
+        !Config Desc  = Magic number which relates the height to the displacement height.
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.75
+        !Config Help  = 
+        !Config Units = [m]  
+        CALL getin_p('HEIGHT_DISPLACEMENT',height_displacement)
+        !
+        !Config Key   = Z0_BARE
+        !Config Desc  = bare soil roughness length
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.01 
+        !Config Help  = 
+        !Config Units = [m]   
+        CALL getin_p('Z0_BARE',z0_bare)
+        !
+        !Config Key   = Z0_ICE
+        !Config Desc  = ice roughness length
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.001
+        !Config Help  = 
+        !Config Units = [m]   
+        CALL getin_p('Z0_ICE',z0_ice)
+        !
+        !Config Key   = TCST_SNOWA
+        !Config Desc  = Time constant of the albedo decay of snow
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 5.0 
+        !Config Help  = 
+        !Config Units = [days]
+        CALL getin_p('TCST_SNOWA',tcst_snowa)
+        !
+        !Config Key   = SNOWCRI_ALB
+        !Config Desc  = Critical value for computation of snow albedo
+        !Config If    = OK_SECHIBA
+        !Config Def   = 10. 
+        !Config Help  = 
+        !Config Units = [kg/m^2]  
+        CALL getin_p('SNOWCRI_ALB',snowcri_alb)
+        !
+        !
+        !Config Key   = VIS_DRY
+        !Config Desc  = The correspondance table for the soil color numbers and their albedo 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.27
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('VIS_DRY',vis_dry)
+        !
+        !Config Key   = NIR_DRY
+        !Config Desc  = The correspondance table for the soil color numbers and their albedo 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.48, 0.44, 0.40, 0.36, 0.32, 0.28, 0.24, 0.20, 0.55
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('NIR_DRY',nir_dry)
+        !
+        !Config Key   = VIS_WET 
+        !Config Desc  = The correspondance table for the soil color numbers and their albedo
+        !Config If    = OK_SECHIBA  
+        !Config Def   = 0.12, 0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.15
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('VIS_WET',vis_wet)
+        !
+        !Config Key   = NIR_WET
+        !Config Desc  = The correspondance table for the soil color numbers and their albedo 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.31
+        !Config Help  = 
+        !Config Units = [-]    
+        CALL getin_p('NIR_WET',nir_wet)
+        !
+        !Config Key   = ALBSOIL_VIS
+        !Config Desc  = 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.18, 0.16, 0.16, 0.15, 0.12, 0.105, 0.09, 0.075, 0.25
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('ALBSOIL_VIS',albsoil_vis)
+        !
+        !Config Key   = ALBSOIL_NIR 
+        !Config Desc  = 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.36, 0.34, 0.34, 0.33, 0.30, 0.25, 0.20, 0.15, 0.45
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('ALBSOIL_NIR',albsoil_nir)
+        !-
+        !
+        !Config Key   = ALB_DEADLEAF 
+        !Config Desc  = albedo of dead leaves, VIS+NIR 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.12, 0.35
+        !Config Help  = 
+        !Config Units = [-]     
+        CALL getin_p('ALB_DEADLEAF',alb_deadleaf)
+        !
+        !Config Key   = ALB_ICE
+        !Config Desc  = albedo of ice, VIS+NIR
+        !Config If    = OK_SECHIBA
+        !Config Def   = 0.60, 0.20
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('ALB_ICE',alb_ice)
+        !
+        ! Get the fixed snow albedo if needed
+        !
+        !Config Key   = CONDVEG_SNOWA
+        !Config Desc  = The snow albedo used by SECHIBA
+        !Config Def   = 1.E+20
+        !Config if    = OK_SECHIBA
+        !Config Help  = This option allows the user to impose a snow albedo.
+        !Config         Default behaviour is to use the model of snow albedo
+        !Config         developed by Chalita (1993).
+        !Config Units = [-]
+        CALL getin_p('CONDVEG_SNOWA',fixed_snow_albedo)
+        !
+        !Config Key   = ALB_BARE_MODEL
+        !Config Desc  = Switch bare soil albedo dependent (if TRUE) on soil wetness
+        !Config Def   = n
+        !Config if    = OK_SECHIBA
+        !Config Help  = If TRUE, the model for bare soil albedo is the old formulation.
+        !Config         Then it depend on the soil dry or wetness. If FALSE, it is the 
+        !Config         new computation that is taken, it is the mean of soil albedo.
+        !Config Units = [FLAG]
+        CALL getin_p('ALB_BARE_MODEL',alb_bare_model)
+        !
+        !Config Key   = Z0CDRAG_AVE
+        !Config Desc  = Average method for z0
+        !Config Def   = y
+        !Config if    = OK_SECHIBA
+        !Config Help  = If this flag is set to true (y) then the neutral Cdrag
+        !Config         is averaged instead of the log(z0). This should be
+        !Config         the prefered option. We still wish to keep the other
+        !Config         option so we can come back if needed. If this is
+        !Config         desired then one should set Z0CDRAG_AVE=n
+        !Config Units = [FLAG]
+        CALL getin_p('Z0CDRAG_AVE',z0cdrag_ave)
+        !
+        !Config Key   = IMPOSE_AZE
+        !Config Desc  = Should the surface parameters be prescribed
+        !Config Def   = n
+        !Config if    = OK_SECHIBA
+        !Config Help  = This flag allows the user to impose the surface parameters
+        !Config         (Albedo Roughness and Emissivity). It is espacially interesting for 0D
+        !Config         simulations. On the globe it does not make too much sense as
+        !Config         it imposes the same vegetation everywhere
+        !Config Units = [FLAG]
+        CALL getin_p('IMPOSE_AZE',impaze)
+        !
+        IF(impaze) THEN
+           !
+           !Config Key   = CONDVEG_Z0
+           !Config Desc  = Surface roughness
+           !Config Def   = 0.15
+           !Config If    = IMPOSE_AZE
+           !Config Help  = Surface rougness to be used on the point if a 0-dim version
+           !Config         of SECHIBA is used. Look at the description of the forcing  
+           !Config         data for the correct value.
+           !Config Units = [m]
+           CALL getin_p('CONDVEG_Z0', z0_scal)  
+           !
+           !Config Key   = ROUGHHEIGHT
+           !Config Desc  = Height to be added to the height of the first level
+           !Config Def   = 0.0
+           !Config If    = IMPOSE_AZE
+           !Config Help  = ORCHIDEE assumes that the atmospheric level height is counted
+           !Config         from the zero wind level. Thus to take into account the roughness
+           !Config         of tall vegetation we need to correct this by a certain fraction
+           !Config         of the vegetation height. This is called the roughness height in
+           !Config         ORCHIDEE talk.
+           !Config Units = [m] 
+           CALL getin_p('ROUGHHEIGHT', roughheight_scal)
+           ! 
+           !Config Key   = CONDVEG_ALBVIS
+           !Config Desc  = SW visible albedo for the surface
+           !Config Def   = 0.25
+           !Config If    = IMPOSE_AZE
+           !Config Help  = Surface albedo in visible wavelengths to be used 
+           !Config         on the point if a 0-dim version of SECHIBA is used. 
+           !Config         Look at the description of the forcing data for 
+           !Config         the correct value.
+           !Config Units = [-]
+           CALL getin_p('CONDVEG_ALBVIS', albedo_scal(ivis))
+           !
+           !Config Key   = CONDVEG_ALBNIR
+           !Config Desc  = SW near infrared albedo for the surface
+           !Config Def   = 0.25
+           !Config If    = IMPOSE_AZE
+           !Config Help  = Surface albedo in near infrared wavelengths to be used 
+           !Config         on the point if a 0-dim version of SECHIBA is used. 
+           !Config         Look at the description of the forcing data for 
+           !Config         the correct value.
+           !Config Units = [-]  
+           CALL getin_p('CONDVEG_ALBNIR', albedo_scal(inir))
+           !
+           !Config Key   = CONDVEG_EMIS
+           !Config Desc  = Emissivity of the surface for LW radiation
+           !Config Def   = 1.0
+           !Config If    = IMPOSE_AZE
+           !Config Help  = The surface emissivity used for compution the LE emission
+           !Config         of the surface in a 0-dim version. Values range between 
+           !Config         0.97 and 1.. The GCM uses 0.98.
+           !Config Units = [-] 
+           CALL getin_p('CONDVEG_EMIS', emis_scal)
+        ENDIF
+        !
+        !-
+        ! diffuco 
+        !-
+        !
+        !Config Key   = NLAI
+        !Config Desc  = Number of LAI levels
+        !Config If    = OK_SECHIBA
+        !Config Def   = 20
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('NLAI',nlai)
+        !
+        !Config Key   = LAIMAX
+        !Config Desc  = Maximum LAI
+        !Config If    = OK_SECHIBA
+        !Config Def   = 
+        !Config Help  = 
+        !Config Units = [m^2/m^2]   
+        CALL getin_p('LAIMAX',laimax)
+        !
+        !Config Key   = XC4_1 
+        !Config Desc  = Factor in the first Collatz equation for C4 plants 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.83
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('XC4_1',xc4_1)
+        !
+        !Config Key   = XC4_2
+        !Config Desc  = Factor in the second Collatz equation for C4 plants
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.93
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('XC4_2',xc4_2)
+        !
+        !Config Key   = DEW_VEG_POLY_COEFF
+        !Config Desc  = coefficients of the polynome of degree 5 for the dew
+        !Config If    = OK_SECHIBA
+        !Config Def   = 0.887773, 0.205673, 0.110112, 0.014843, 0.000824, 0.000017 
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('DEW_VEG_POLY_COEFF',dew_veg_poly_coeff)
+        !-
+        ! slowproc
+        !-
+        !
+        !Config Key   = CLAYFRACTION_DEFAULT
+        !Config Desc  = default fraction of clay
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.2 
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('CLAYFRACTION_DEFAULT',clayfraction_default)
+        !
+        !Config Key   = SILTFRACTION_DEFAULT
+        !Config Desc  = default fraction of silt
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.4 
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('SILTFRACTION_DEFAULT',siltfraction_default)
+        !
+        !Config Key   = SANDFRACTION_DEFAULT
+        !Config Desc  = default fraction of sand
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.4 
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('SANDFRACTION_DEFAULT',sandfraction_default)
+
+        !
+        !Config Key   = MIN_VEGFRAC 
+        !Config Desc  = Minimal fraction of mesh a vegetation type can occupy 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.001 
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('MIN_VEGFRAC',min_vegfrac)
+        !
+        !Config Key   = STEMPDIAG_BID 
+        !Config Desc  = only needed for an initial LAI if there is no restart file
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 280.
+        !Config Help  = 
+        !Config Units = [K]
+        CALL getin_p('STEMPDIAG_BID',stempdiag_bid)
+        !
+        first_call =.FALSE.
+        
+     ENDIF
+     
+   END SUBROUTINE config_sechiba_parameters
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_co2_parameters 
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters 
+!! needed when OK_CO2 is set to true. (ie : when the photosynthesis is activated) 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE config_co2_parameters
+     
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+     !! 0.4 Local variables
+     
+     LOGICAL, SAVE ::  first_call = .TRUE.      !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+     
+     IF(first_call) THEN
+        
+        !
+        !Config Key   = LAI_LEVEL_DEPTH
+        !Config Desc  = 
+        !Config If    = OK_CO2
+        !Config Def   = 0.15
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('LAI_LEVEL_DEPTH',lai_level_depth)
+        !
+        !Config Key   = X1_COEF
+        !Config Desc  = Multiplicative factor in the equation defining kt 
+        !Config If    = OK_CO2
+        !Config Def   = 0.177
+        !Config Help  = Multiplicative factor for calculating the pseudo first order rate constant 
+        !Config         of assimilation response to co2 kt
+        !Config Units = [-]  
+        CALL getin_p('X1_COEF',x1_coef)
+        !
+        !Config Key   = X1_Q10
+        !Config Desc  = Exponential factor in the equation defining kt
+        !Config If    = OK_CO2
+        !Config Def   = 0.069
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('X1_Q10',x1_Q10)
+        !
+        !Config Key   = QUANTUM_YIELD
+        !Config Desc  = 
+        !Config If    = OK_CO2
+        !Config Def   = 0.092 
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('QUANTUM_YIELD',quantum_yield)
+        !
+        !Config Key   = KT_COEF
+        !Config Desc  = Multiplicative factor in the equation defining kt
+        !Config If    = OK_CO2
+        !Config Def   = 0.7 
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('KT_COEF',kt_coef)
+        !
+        !Config Key   = KC_COEF
+        !Config Desc  = Multiplicative factor for calculating Kc
+        !Config If    = OK_CO2
+        !Config Def   = 39.09 
+        !Config Help  = Multiplicative factor for calculating the Michaelis-Menten
+        !Config         coefficient Kc  
+        !Config Units = [-]  
+        CALL getin_p('KC_COEF',kc_coef)
+        !
+        !Config Key   = KO_Q10 
+        !Config Desc  = Exponential factor for calculating Kc and Ko 
+        !Config If    = OK_CO2 
+        !Config Def   = 0.085 
+        !Config Help  = Exponential factor for calculating the Michaelis-Menten coefficients
+        !Config         Kc and Ko 
+        !Config Units = [-]  
+        CALL getin_p('KO_Q10',Ko_Q10)
+        !
+        !Config Key   = OA
+        !Config Desc  = Intercellular concentration of O2
+        !Config If    = OK_CO2
+        !Config Def   = 210000. 
+        !Config Help  = 
+        !Config Units = [ppm]  
+        CALL getin_p('OA',Oa)
+        !
+        !Config Key   = KO_COEF
+        !Config Desc  = Multiplicative factor for calculating Ko
+        !Config If    = OK_CO2
+        !Config Def   = 2.412 
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('KO_COEF',Ko_coef)
+        !
+        !Config Key   = CP_0
+        !Config Desc  = Multiplicative factor for calculating the CO2 compensation point
+        !Config If    = OK_CO2
+        !Config Def   = 42. 
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('CP_0',CP_0)
+        !
+        !Config Key   = CP_TEMP_COEF
+        !Config Desc  = Exponential factor for calculating the CO2 compensation point
+        !Config If    = OK_CO2
+        !Config Def   = 9.46
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('CP_TEMP_COEF',cp_temp_coef)
+        !
+        !Config Key   = CP_TEMP_REF
+        !Config Desc  = Reference temperature for the CO2 compensation point CP
+        !Config If    = OK_CO2
+        !Config Def   = 25.
+        !Config Help  = 
+        !Config Units = [C]  
+        CALL getin_p('CP_TEMP_REF',cp_temp_ref)
+        !
+        !Config Key   = RT_COEF
+        !Config Desc  = 
+        !Config If    = OK_CO2
+        !Config Def   = 0.8, 1.3
+        !Config Help  = 
+        !Config Units = [-]   
+        CALL getin_p('RT_COEF',rt_coef)
+        !
+        !Config Key   = VC_COEF
+        !Config Desc  = 
+        !Config If    = OK_CO2
+        !Config Def   = 0.39, 0.3 
+        !Config Help  = 
+        !Config Units = [-]  
+        CALL getin_p('VC_COEF',vc_coef)
+        
+        first_call =.FALSE.
+        
+     ENDIF
+     
+   END SUBROUTINE config_co2_parameters
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_stomate_parameters 
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters 
+!! needed when stomate is activated (ie : when OK_STOMATE is set to true).
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE config_stomate_parameters
+     
+    IMPLICIT NONE
+    
+    !! 0. Variables and parameters declaration
+
+    !! 0.4 Local variables   
+
+    LOGICAL, SAVE ::  first_call = .TRUE.  !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+    
+    IF(first_call) THEN
+       !-
+       ! constraints_parameters
+       !-
+       !
+       !Config Key   = TOO_LONG 
+       !Config Desc  = longest sustainable time without regeneration (vernalization)
+       !Config If    = OK_STOMATE
+       !Config Def   = 5.
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TOO_LONG',too_long)
+
+       !-
+       ! fire parameters
+       !-
+       !
+       !Config Key   = TAU_FIRE 
+       !Config Desc  = Time scale for memory of the fire index (days). Validated for one year in the DGVM. 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 30.
+       !Config Help  = 
+       !Config Units = [days]    
+       CALL getin_p('TAU_FIRE',tau_fire)
+       !
+       !Config Key   = LITTER_CRIT
+       !Config Desc  = Critical litter quantity for fire
+       !Config If    = OK_STOMATE 
+       !Config Def   = 200.
+       !Config Help  = 
+       !Config Units = [gC/m^2]  
+       CALL getin_p('LITTER_CRIT',litter_crit)
+       !
+       !Config Key   = FIRE_RESIST_STRUCT
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('FIRE_RESIST_STRUCT',fire_resist_struct)
+       !
+       !
+       !Config Key   = CO2FRAC
+       !Config Desc  = What fraction of a burned plant compartment goes into the atmosphere
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.95, 0.95, 0., 0.3, 0., 0., 0.95, 0.95
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('CO2FRAC',co2frac)
+       !
+       !Config Key   = BCFRAC_COEFF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3, 1.3, 88.2 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('BCFRAC_COEFF',bcfrac_coeff)
+       !
+       !Config Key   = FIREFRAC_COEFF 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.45, 0.8, 0.6, 0.13
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('FIREFRAC_COEFF',firefrac_coeff)
+
+       !-
+       ! gap parameters (+ lpj_const_mort)
+       !-
+       !
+       !Config Key   = AVAILABILITY_FACT 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.1
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('AVAILABILITY_FACT', availability_fact)  
+       !
+       !Config Key   = REF_GREFF
+       !Config Desc  = Asymptotic maximum mortality rate
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.035
+       !Config Help  = Set asymptotic maximum mortality rate from Sitch 2003
+       !Config         (they use 0.01) (year^{-1})
+       !Config Units = [1/year]  
+       CALL getin_p('REF_GREFF',ref_greff)
+       !-
+       ! allocation parameters
+       !-
+       !
+       !Config Key   = OK_MINRES
+       !Config Desc  = Do we try to reach a minimum reservoir even if we are severely stressed?
+       !Config If    = OK_STOMATE 
+       !Config Def   = y
+       !Config Help  = 
+       !Config Units = [FLAG]
+       CALL getin_p('OK_MINRES',ok_minres)
+       !
+       !Config Key   = TAU_LEAFINIT
+       !Config Desc  = time to attain the initial foliage using the carbohydrate reserve 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 10.
+       !Config Help  = 
+       !Config Units = [days]  
+       CALL getin_p('TAU_LEAFINIT', tau_leafinit)
+       !
+       !Config Key   = RESERVE_TIME_TREE 
+       !Config Desc  = maximum time during which reserve is used (trees) 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 30.
+       !Config Help  = 
+       !Config Units = [days]    
+       CALL getin_p('RESERVE_TIME_TREE',reserve_time_tree)
+       !
+       !Config Key   = RESERVE_TIME_GRASS 
+       !Config Desc  = maximum time during which reserve is used (grasses) 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20. 
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('RESERVE_TIME_GRASS',reserve_time_grass)
+       !
+       !Config Key   = R0
+       !Config Desc  = Standard root allocation 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('R0',R0)
+       !
+       !Config Key   = S0 
+       !Config Desc  = Standard sapwood allocation 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('S0',S0)
+       !
+       !Config Key   = F_FRUIT
+       !Config Desc  = Standard fruit allocation
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.1 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('F_FRUIT',f_fruit)
+       !
+       !Config Key   = ALLOC_SAP_ABOVE_GRASS 
+       !Config Desc  = fraction of sapwood allocation above ground 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.0 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('ALLOC_SAP_ABOVE_GRASS',alloc_sap_above_grass)
+       !
+       !Config Key   = MIN_LTOLSR 
+       !Config Desc  = extrema of leaf allocation fraction 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.2
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MIN_LTOLSR',min_LtoLSR)
+       !
+       !Config Key   = MAX_LTOLSR
+       !Config Desc  = extrema of leaf allocation fraction
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MAX_LTOLSR',max_LtoLSR)
+       !
+       !Config Key   = Z_NITROGEN
+       !Config Desc  = scaling depth for nitrogen limitation 
+       !Config If    = OK_STOMATE
+       !Config Def   = 0.2 
+       !Config Help  =
+       !Config Units = [m]  
+       CALL getin_p('Z_NITROGEN',z_nitrogen)
+       !
+       !Config Key   = LAI_MAX_TO_HAPPY
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('LAI_MAX_TO_HAPPY',lai_max_to_happy)
+       !
+       !Config Key   = NLIM_TREF 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 25. 
+       !Config Help  = 
+       !Config Units = [C]  
+       CALL getin_p('NLIM_TREF',Nlim_tref) 
+  
+       !-
+       ! data parameters
+       !-
+       !
+       !Config Key   = PIPE_TUNE1
+       !Config Desc  = crown area = pipe_tune1. stem diameter**(1.6) (Reinicke's theory)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 100.0
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('PIPE_TUNE1',pipe_tune1)
+       !
+       !Config Key   = PIPE_TUNE2 
+       !Config Desc  = height=pipe_tune2 * diameter**pipe_tune3
+       !Config If    = OK_STOMATE 
+       !Config Def   = 40.0 
+       !Config Help  = 
+       !Config Units = [-]      
+       CALL getin_p('PIPE_TUNE2',pipe_tune2) 
+        !
+       !Config Key   = PIPE_TUNE3
+       !Config Desc  = height=pipe_tune2 * diameter**pipe_tune3
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('PIPE_TUNE3',pipe_tune3)
+       !
+       !Config Key   = PIPE_TUNE4
+       !Config Desc  = needed for stem diameter
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('PIPE_TUNE4',pipe_tune4)
+       !
+       !Config Key   = PIPE_DENSITY 
+       !Config Desc  = Density
+       !Config If    = OK_STOMATE 
+       !Config Def   = 2.e5 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('PIPE_DENSITY',pipe_density)
+       !
+       !Config Key   = PIPE_K1 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 8.e3 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('PIPE_K1',pipe_k1)
+       !
+       !Config Key   = PIPE_TUNE_EXP_COEFF 
+       !Config Desc  = pipe tune exponential coeff 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.6 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('PIPE_TUNE_EXP_COEFF',pipe_tune_exp_coeff)
+       !
+       !
+       !Config Key   = PRECIP_CRIT 
+       !Config Desc  = minimum precip
+       !Config If    = OK_STOMATE 
+       !Config Def   = 100.
+       !Config Help  = 
+       !Config Units = [mm/year]  
+       CALL getin_p('PRECIP_CRIT',precip_crit)
+       !
+       !Config Key   = GDD_CRIT_ESTAB
+       !Config Desc  = minimum gdd for establishment of saplings
+       !Config If    = OK_STOMATE 
+       !Config Def   = 150. 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('GDD_CRIT_ESTAB',gdd_crit_estab)
+        !
+       !Config Key   = FPC_CRIT
+       !Config Desc  = critical fpc, needed for light competition and establishment
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.95
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('FPC_CRIT',fpc_crit)
+       !
+       !Config Key   = ALPHA_GRASS
+       !Config Desc  = sapling characteristics : alpha's
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('ALPHA_GRASS',alpha_grass)
+       !
+       !Config Key   = ALPHA_TREE
+       !Config Desc  = sapling characteristics : alpha's 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('ALPHA_TREE',alpha_tree)
+       !-
+       !
+       !Config Key   = MASS_RATIO_HEART_SAP
+       !Config Desc  = mass ratio (heartwood+sapwood)/sapwood
+       !Config If    = OK_STOMATE 
+       !Config Def   = 3.
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MASS_RATIO_HEART_SAP',mass_ratio_heart_sap)
+       !
+       !Config Key   = FRAC_GROWTHRESP
+       !Config Desc  = fraction of GPP which is lost as growth respiration
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.28
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('FRAC_GROWTHRESP',frac_growthresp)
+       !
+       !Config Key   = TAU_HUM_MONTH
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20. 
+       !Config Help  = 
+       !Config Units = [days]  
+       CALL getin_p('TAU_HUM_MONTH',tau_hum_month)
+       !
+       !Config Key   = TAU_HUM_WEEK
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 7.
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TAU_HUM_WEEK',tau_hum_week)
+       !
+       !Config Key   = TAU_T2M_MONTH
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20.
+       !Config Help  = 
+       !Config Units = [days]     
+       CALL getin_p('TAU_T2M_MONTH',tau_t2m_month)
+       !
+       !Config Key   = TAU_T2M_WEEK
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 7.
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TAU_T2M_WEEK',tau_t2m_week)
+       !
+       !Config Key   = TAU_TSOIL_MONTH 
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20. 
+       !Config Help  = 
+       !Config Units = [days]     
+       CALL getin_p('TAU_TSOIL_MONTH',tau_tsoil_month)
+       !
+       !Config Key   = TAU_SOILHUM_MONTH
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20. 
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TAU_SOILHUM_MONTH',tau_soilhum_month)
+       !
+       !Config Key   = TAU_GPP_WEEK 
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 7. 
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TAU_GPP_WEEK',tau_gpp_week)
+       !
+       !Config Key   = TAU_GDD
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 40. 
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TAU_GDD',tau_gdd)
+       !
+       !Config Key   = TAU_NGD
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 50.
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('TAU_NGD',tau_ngd)
+       !
+       !Config Key   = COEFF_TAU_LONGTERM
+       !Config Desc  = time scales for phenology and other processes
+       !Config If    = OK_STOMATE 
+       !Config Def   = 3. 
+       !Config Help  = 
+       !Config Units = [days]   
+       CALL getin_p('COEFF_TAU_LONGTERM',coeff_tau_longterm)
+       !-
+       !
+       !Config Key   = BM_SAPL_CARBRES 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 5. 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('BM_SAPL_CARBRES',bm_sapl_carbres)
+       !
+       !Config Key   = BM_SAPL_SAPABOVE
+       !Config Desc  = 
+       !Config If    = OK_STOMATE
+       !Config Def   = 0.5 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('BM_SAPL_SAPABOVE',bm_sapl_sapabove)
+       !
+       !Config Key   = BM_SAPL_HEARTABOVE 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 2.
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('BM_SAPL_HEARTABOVE',bm_sapl_heartabove)
+       !
+       !Config Key   = BM_SAPL_HEARTBELOW 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 2. 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('BM_SAPL_HEARTBELOW',bm_sapl_heartbelow)
+       !
+       !Config Key   = INIT_SAPL_MASS_LEAF_NAT
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.1 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('INIT_SAPL_MASS_LEAF_NAT',init_sapl_mass_leaf_nat)
+       !
+       !Config Key   = INIT_SAPL_MASS_LEAF_AGRI
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1. 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('INIT_SAPL_MASS_LEAF_AGRI',init_sapl_mass_leaf_agri)
+       !
+       !Config Key   = INIT_SAPL_MASS_CARBRES
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 5. 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('INIT_SAPL_MASS_CARBRES',init_sapl_mass_carbres)
+       !
+       !Config Key   = INIT_SAPL_MASS_ROOT
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.1 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('INIT_SAPL_MASS_ROOT',init_sapl_mass_root)
+       !
+       !Config Key   = INIT_SAPL_MASS_FRUIT
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3 
+       !Config Help  = 
+       !Config Units = [-]    
+       CALL getin_p('INIT_SAPL_MASS_FRUIT',init_sapl_mass_fruit)
+       !
+       !Config Key   = CN_SAPL_INIT 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('CN_SAPL_INIT',cn_sapl_init)
+       !
+       !Config Key   = MIGRATE_TREE 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 10000.
+       !Config Help  = 
+       !Config Units = [m/year]   
+       CALL getin_p('MIGRATE_TREE',migrate_tree)
+       !
+       !Config Key   = MIGRATE_GRASS
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 10000.
+       !Config Help  = 
+       !Config Units = [m/year]   
+       CALL getin_p('MIGRATE_GRASS',migrate_grass)
+       !
+       !Config Key   = LAI_INITMIN_TREE
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3
+       !Config Help  = 
+       !Config Units = [m^2/m^2]  
+       CALL getin_p('LAI_INITMIN_TREE',lai_initmin_tree)
+       !
+       !Config Key   = LAI_INITMIN_GRASS 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.1
+       !Config Help  = 
+       !Config Units = [m^2/m^2]    
+       CALL getin_p('LAI_INITMIN_GRASS',lai_initmin_grass)
+       !
+       !Config Key   = DIA_COEFF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 4., 0.5
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('DIA_COEFF',dia_coeff)
+       !
+       !Config Key   = MAXDIA_COEFF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 100., 0.01 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MAXDIA_COEFF',maxdia_coeff)
+       !
+       !Config Key   = BM_SAPL_LEAF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 4., 4., 0.8, 5. 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('BM_SAPL_LEAF',bm_sapl_leaf)
+
+       !-
+       ! litter parameters
+       !-
+       !
+       !Config Key   = METABOLIC_REF_FRAC
+       !Config Desc  =
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.85  
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('METABOLIC_REF_FRAC',metabolic_ref_frac)
+       !
+       !Config Key   = Z_DECOMP
+       !Config Desc  = scaling depth for soil activity
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.2
+       !Config Help  = 
+       !Config Units = [m]   
+       CALL getin_p('Z_DECOMP',z_decomp)
+       !
+       !Config Key   = CN
+       !Config Desc  = C/N ratio
+       !Config If    = OK_STOMATE 
+       !Config Def   = 40., 40., 40., 40., 40., 40., 40., 40.
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('CN',CN)
+       !
+       !Config Key   = LC 
+       !Config Desc  = Lignine/C ratio of the different plant parts
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.22, 0.35, 0.35, 0.35, 0.35, 0.22, 0.22, 0.22
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('LC',LC)
+       !
+       !Config Key   = FRAC_SOIL_STRUCT_AA
+       !Config Desc  = frac_soil(istructural,iactive,iabove)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.55
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('FRAC_SOIL_STRUCT_AA',frac_soil_struct_aa)
+       !
+       !Config Key   = FRAC_SOIL_STRUCT_A 
+       !Config Desc  = frac_soil(istructural,iactive,ibelow)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.45
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('FRAC_SOIL_STRUCT_AB',frac_soil_struct_ab)
+       !
+       !Config Key   = FRAC_SOIL_STRUCT_SA
+       !Config Desc  = frac_soil(istructural,islow,iabove)
+       !Config If    = OK_STOMATE
+       !Config Def   = 0.7  
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('FRAC_SOIL_STRUCT_SA',frac_soil_struct_sa)
+       !
+       !Config Key   = FRAC_SOIL_STRUCT_SB
+       !Config Desc  = frac_soil(istructural,islow,ibelow) 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.7  
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('FRAC_SOIL_STRUCT_SB',frac_soil_struct_sb)
+       !
+       !Config Key   = FRAC_SOIL_METAB_AA 
+       !Config Desc  = frac_soil(imetabolic,iactive,iabove) 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.45 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('FRAC_SOIL_METAB_AA',frac_soil_metab_aa)
+       !
+       !Config Key   = FRAC_SOIL_METAB_AB 
+       !Config Desc  = frac_soil(imetabolic,iactive,ibelow)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.45  
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('FRAC_SOIL_METAB_AB',frac_soil_metab_ab)
+       !
+       !
+       !Config Key   = METABOLIC_LN_RATIO
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.018  
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('METABOLIC_LN_RATIO',metabolic_LN_ratio) 
+       !
+       !Config Key   = TAU_METABOLIC
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.066
+       !Config Help  = 
+       !Config Units = [days] 
+       CALL getin_p('TAU_METABOLIC',tau_metabolic)
+       !
+       !Config Key   = TAU_STRUCT 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.245 
+       !Config Help  = 
+       !Config Units = [days]
+       CALL getin_p('TAU_STRUCT',tau_struct)
+       !
+       !Config Key   = SOIL_Q10
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.69 (=ln2)
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('SOIL_Q10',soil_Q10)
+       !
+       !Config Key   = a_term_Q10_soil
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 11.049
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('a_term_Q10_soil',a_term_Q10_soil)
+       !
+       !Config Key   = b_term_Q10_soil
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 35.003
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('b_term_Q10_soil',b_term_Q10_soil)
+       !
+       !Config Key   = TSOIL_REF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 30. 
+       !Config Help  = 
+       !Config Units = [C]   
+       CALL getin_p('TSOIL_REF',tsoil_ref)
+       !
+       !Config Key   = LITTER_STRUCT_COEF 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 3. 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('LITTER_STRUCT_COEF',litter_struct_coef)
+       !
+       !Config Key   = MOIST_COEFF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.1, 2.4, 0.29
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MOIST_COEFF',moist_coeff)
+       !
+       !!Config Key   = Dif
+       !Config Desc  = diffusion coefficient of POC
+       !Config if    = OK_STOMATE 
+       !Config Def   = 1.E-4
+       !Config Help  = from Koven et al. 2013 BG
+       !Config Units =  [m^2 day-1] 
+       CALL getin_p('Dif',Dif)
+       !
+       !!Config Key   = z_litter
+       !Config Desc  = Thickness of the above ground litter layer
+       !Config if    = OK_STOMATE 
+       !Config Def   = 10
+       !Config Help  = Assumed value
+       !Config Units =  [mm] 
+       CALL getin_p('z_litter',z_litter)
+
+       !-
+       ! lpj parameters
+       !-
+       !
+       !Config Key   = FRAC_TURNOVER_DAILY 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.55
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('FRAC_TURNOVER_DAILY',frac_turnover_daily)   
+
+       !-
+       ! npp parameters
+       !-
+       !
+       !Config Key   = TAX_MAX
+       !Config Desc  = maximum fraction of allocatable biomass used for maintenance respiration
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.8
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('TAX_MAX',tax_max) 
+
+       !-
+       ! phenology parameters
+       !-
+       !
+       !Config Key   = ALWAYS_INIT
+       !Config Desc  = take carbon from atmosphere if carbohydrate reserve too small? 
+       !Config If    = OK_STOMATE 
+       !Config Def   = n 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('ALWAYS_INIT',always_init)
+       !
+       !Config Key   = MIN_GROWTHINIT_TIME 
+       !Config Desc  = minimum time since last beginning of a growing season
+       !Config If    = OK_STOMATE 
+       !Config Def   = 300. 
+       !Config Help  = 
+       !Config Units = [days]  
+       CALL getin_p('MIN_GROWTHINIT_TIME',min_growthinit_time)
+       !
+       !Config Key   = MOIAVAIL_ALWAYS_TREE
+       !Config Desc  = moisture availability above which moisture tendency doesn't matter 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.0 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MOIAVAIL_ALWAYS_TREE',moiavail_always_tree)
+       !
+       !Config Key   = MOIAVAIL_ALWAYS_GRASS 
+       !Config Desc  = moisture availability above which moisture tendency doesn't matter
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.6 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('MOIAVAIL_ALWAYS_GRASS',moiavail_always_grass)
+       !
+       !Config Key   = T_ALWAYS_ADD
+       !Config Desc  = monthly temp. above which temp. tendency doesn't matter 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 10.
+       !Config Help  = 
+       !Config Units = [C]    
+       CALL getin_p('T_ALWAYS_ADD',t_always_add)
+       !
+       !
+       !Config Key   = GDDNCD_REF 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 603. 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('GDDNCD_REF',gddncd_ref)
+       !
+       !Config Key   = GDDNCD_CURVE
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.0091 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('GDDNCD_CURVE',gddncd_curve)
+       !
+       !Config Key   = GDDNCD_OFFSET
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 64. 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('GDDNCD_OFFSET',gddncd_offset)
+       !-
+       ! prescribe parameters
+       !-
+       !
+       !Config Key   = BM_SAPL_RESCALE 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 40. 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('BM_SAPL_RESCALE',bm_sapl_rescale)
+
+       !-
+       ! respiration parameters
+       !-
+       !
+       !Config Key   = MAINT_RESP_MIN_VMAX
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('MAINT_RESP_MIN_VMAX',maint_resp_min_vmax)  
+       !
+       !Config Key   = MAINT_RESP_COEFF 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.4 
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('MAINT_RESP_COEFF',maint_resp_coeff)
+
+       !-
+       ! soilcarbon parameters 
+       !-
+       !
+       !Config Key   = FRAC_CARB_AP
+       !Config Desc  = frac carb coefficients from active pool: depends on clay content
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.004
+       !Config Help  = fraction of the active pool going into the passive pool
+       !Config Units = [-]
+       CALL getin_p('FRAC_CARB_AP',frac_carb_ap)  
+       !
+       !Config Key   = FRAC_CARB_SA
+       !Config Desc  = frac_carb_coefficients from slow pool
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.42
+       !Config Help  = fraction of the slow pool going into the active pool
+       !Config Units = [-]
+       CALL getin_p('FRAC_CARB_SA',frac_carb_sa)
+       !
+       !Config Key   = FRAC_CARB_SP
+       !Config Desc  = frac_carb_coefficients from slow pool
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.03
+       !Config Help  = fraction of the slow pool going into the passive pool
+       !Config Units = [-] 
+       !CALL getin_p('FRAC_CARB_SP',frac_carb_sp)
+       !
+       !Config Key   = FRAC_CARB_PA
+       !Config Desc  = frac_carb_coefficients from passive pool
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.45
+       !Config Help  = fraction of the passive pool going into the active pool
+       !Config Units = [-]
+       CALL getin_p('FRAC_CARB_PA',frac_carb_pa)
+       !
+       !Config Key   = FRAC_CARB_PS
+       !Config Desc  = frac_carb_coefficients from passive pool
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.0
+       !Config Help  = fraction of the passive pool going into the slow pool
+       !Config Units = [-]
+       !CALL getin_p('FRAC_CARB_PS',frac_carb_ps)
+       !
+       !Config Key   = ACTIVE_TO_PASS_CLAY_FRAC
+       !Config Desc  = 
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.68  
+       !Config Help  =
+       !Config Units = [-] 
+       CALL getin_p('ACTIVE_TO_PASS_CLAY_FRAC',active_to_pass_clay_frac)
+       !
+       !Config Key   = CARBON_TAU_IACTIVE
+       !Config Desc  = residence times in carbon pools
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.149
+       !Config Help  =
+       !Config Units =  [days] 
+       CALL getin_p('CARBON_TAU_IACTIVE',carbon_tau_iactive)
+       !
+       !Config Key   = CARBON_TAU_ISLOW
+       !Config Desc  = residence times in carbon pools
+       !Config if    = OK_STOMATE 
+       !Config Def   = 5.48
+       !Config Help  =
+       !Config Units = [days]
+       CALL getin_p('CARBON_TAU_ISLOW',carbon_tau_islow)
+       !
+       !Config Key   = CARBON_TAU_IPASSIVE
+       !Config Desc  = residence times in carbon pools
+       !Config if    = OK_STOMATE 
+       !Config Def   = 241.
+       !Config Help  = residence time in the passive pool
+       !Config Units = [days] 
+       CALL getin_p('CARBON_TAU_IPASSIVE',carbon_tau_ipassive)
+       !
+       !Config Key   = PRIMING_PARAM_IACTIVE
+       !Config Desc  = priming parameter in carbon pools
+       !Config if    = OK_STOMATE 
+       !Config Def   = 493.66
+       !Config Help  =
+       !Config Units =  [-] 
+       CALL getin_p('PRIMING_PARAM_IACTIVE',priming_param_iactive)
+       !
+       !Config Key   = PRIMING_PARAM_ISLOW
+       !Config Desc  = priming parameter in carbon pools
+       !Config if    = OK_STOMATE 
+       !Config Def   = 194.03
+       !Config Help  =
+       !Config Units =  [-] 
+       CALL getin_p('PRIMING_PARAM_ISLOW',priming_param_islow)
+       !
+       !Config Key   = PRIMING_PARAM_IPASSIVE
+       !Config Desc  = priming parameter in carbon pools
+       !Config if    = OK_STOMATE 
+       !Config Def   = 136.54
+       !Config Help  =
+       !Config Units =  [-] 
+       CALL getin_p('PRIMING_PARAM_IPASSIVE',priming_param_ipassive)
+       !
+       !Config Key   = DOC_tau_labile
+       !Config Desc  = residence time of labile DOC
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.3
+       !Config Help  = tuning
+       !Config Units =  [days] 
+       CALL getin_p('DOC_TAU_LABILE',DOC_tau_labile)
+       IF (DOC_tau_labile .LT. un) THEN
+       WRITE(numout,*) "A residence time < one day is incompatible with forcesoil"
+       WRITE(numout,*) "Please correct"
+       STOP
+       ENDIF
+       !
+       !Config Key   = DOC_tau_stable
+       !Config Desc  = residence time of stable DOC
+       !Config if    = OK_STOMATE 
+       !Config Def   = 60.3
+       !Config Help  = tuning
+       !Config Units =  [days] 
+       CALL getin_p('DOC_TAU_STABLE',DOC_tau_stable)
+       !
+       !!Config Key  = D_DOC
+       !Config Desc  = diffusion coefficient of DOC
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.0000004428
+       !Config Help  = from Burdige et al., 1999 in Ota et al., 2013
+       !Config Units =  [m^2 hr-1] 
+       CALL getin_p('D_DOC',D_DOC)
+       !
+       !!Config Key  = red_factor
+       !Config Desc  = parameter to reduce the DOC flux due to water flux
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.5
+       !Config Help  = Pure tunning
+       !Config Units =  [-] 
+       CALL getin_p('RED_FACTOR',red_factor)
+       !
+       !!Config Key  = m_ads
+       !Config Desc  = partition coefficient for adsorption of DOC
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.45
+       !Config Help  = Mean from Kothawalla et al., 2008 and Kaiser et al., 1996
+       !Config Units =  [-] 
+       CALL getin_p('m_ads',m_ads)
+       !
+       !!Config Key  = b_ads
+       !Config Desc  = desorption coefficient for adsorption of DOC
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.17
+       !Config Help  = Mean from Kothawalla et al., 2008 and Kaiser et al., 1996
+       !Config Units =  [mg C g soil-1] 
+       CALL getin_p('b_ads',b_ads)
+       !
+       !!Config Key  = kd_ads
+       !Config Desc  = distribution coefficient in the mineral soil
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.00805
+       !Config Help  = Median from Moore et al., 1992
+       !Config Units =  [m3 water kg soil-1] 
+       CALL getin_p('kd_ads',kd_ads)
+       !
+       !!Config Key   = CUE
+       !Config Desc  = Microbial carbon use efficiency
+       !Config if    = OK_STOMATE 
+       !Config Def   = 0.5
+       !Config Help  = Assumed value of CUE=0.5
+       !Config Units =  [-] 
+       CALL getin_p('CUE',CUE)
+       !
+       !Config Key   = BULK_DENSITY
+       !Config Desc  = value of the soil bulk density 
+       !Config if    = IMPOSE_VEG and IMPOSE_SOIL
+       !Config Def   = 1.65
+       !Config Help  =
+       !Config Units =  [g cm-3] 
+       CALL getin_p('BULK_DENSITY',bulk_density_default)
+       !
+       !Config Key   = SOIL_PH
+       !Config Desc  = pH of the soil (0-dim mode)
+       !Config Def   = 7.0
+       !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+       !Config Help  = Determines the soil pH in the grid box.
+       !Config Units = [pH units] 
+       CALL getin_p('soil_ph',soil_ph_default)
+       !
+       !Config Key   = FLUX_TOT_COEFF
+       !Config Desc  =
+       !Config if    = OK_STOMATE 
+       !Config Def   = 1.2, 1.4,.75
+       !Config Help  =
+       !Config Units = [days] 
+       CALL getin_p('FLUX_TOT_COEFF',flux_tot_coeff)
+
+       !-
+       ! turnover parameters
+       !-
+       !
+       !Config Key   = NEW_TURNOVER_TIME_REF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20. 
+       !Config Help  = 
+       !Config Units = [days]  
+       CALL getin_p('NEW_TURNOVER_TIME_REF',new_turnover_time_ref)
+       !
+       !Config Key   = DT_TURNOVER_TIME 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 10.
+       !Config Help  = 
+       !Config Units = [days]  
+       CALL getin_p('DT_TURNOVER_TIME',dt_turnover_time)
+       !
+       !Config Key   = LEAF_AGE_CRIT_TREF
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20. 
+       !Config Help  = 
+       !Config Units = [days]  
+       CALL getin_p('LEAF_AGE_CRIT_TREF',leaf_age_crit_tref)
+       !
+       !Config Key   = LEAF_AGE_CRIT_COEFF 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.5, 0.75, 10. 
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('LEAF_AGE_CRIT_COEFF',leaf_age_crit_coeff)
+
+       !-
+       ! vmax parameters
+       !-
+       !
+       !Config Key   = VMAX_OFFSET 
+       !Config Desc  = offset (minimum relative vcmax)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.3
+       !Config Help  = offset (minimum vcmax/vmax_opt)
+       !Config Units = [-]  
+       CALL getin_p('VMAX_OFFSET',vmax_offset)
+       !
+       !Config Key   = LEAFAGE_FIRSTMAX
+       !Config Desc  = leaf age at which vmax attains vcmax_opt (in fraction of critical leaf age)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.03 
+       !Config Help  = relative leaf age at which vmax attains vcmax_opt
+       !Config Units = [-] 
+       CALL getin_p('LEAFAGE_FIRSTMAX',leafage_firstmax)
+       !
+       !Config Key   = LEAFAGE_LASTMAX 
+       !Config Desc  = leaf age at which vmax falls below vcmax_opt (in fraction of critical leaf age) 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5 
+       !Config Help  = relative leaf age at which vmax falls below vcmax_opt
+       !Config Units = [-]  
+       CALL getin_p('LEAFAGE_LASTMAX',leafage_lastmax)
+       !
+       !Config Key   = LEAFAGE_OLD 
+       !Config Desc  = leaf age at which vmax attains its minimum (in fraction of critical leaf age)
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.
+       !Config Help  = relative leaf age at which vmax attains its minimum
+       !Config Units = [-]  
+       CALL getin_p('LEAFAGE_OLD',leafage_old)
+
+       !-
+       ! season parameters
+       !-
+       !
+       !Config Key   = GPPFRAC_DORMANCE 
+       !Config Desc  = rapport maximal GPP/GGP_max pour dormance
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.2 
+       !Config Help  = 
+       !Config Units = [-]
+       CALL getin_p('GPPFRAC_DORMANCE',gppfrac_dormance)
+       !
+       !Config Key   = TAU_CLIMATOLOGY
+       !Config Desc  = tau for "climatologic variables 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 20
+       !Config Help  = 
+       !Config Units = [days]
+       CALL getin_p('TAU_CLIMATOLOGY',tau_climatology)
+       !
+       !Config Key   = HVC1 
+       !Config Desc  = parameters for herbivore activity
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.019
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('HVC1',hvc1)
+       !
+       !Config Key   = HVC2 
+       !Config Desc  = parameters for herbivore activity 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 1.38
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('HVC2',hvc2)
+       !
+       !Config Key   = LEAF_FRAC_HVC
+       !Config Desc  = parameters for herbivore activity 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.33
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('LEAF_FRAC_HVC',leaf_frac_hvc)
+       !
+       !Config Key   = TLONG_REF_MAX
+       !Config Desc  = maximum reference long term temperature 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 303.1
+       !Config Help  = 
+       !Config Units = [K]  
+       CALL getin_p('TLONG_REF_MAX',tlong_ref_max)
+       !
+       !Config Key   = TLONG_REF_MIN 
+       !Config Desc  = minimum reference long term temperature 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 253.1
+       !Config Help  = 
+       !Config Units = [K]  
+       CALL getin_p('TLONG_REF_MIN',tlong_ref_min)
+       !
+       !Config Key   = NCD_MAX_YEAR
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 3. 
+       !Config Help  = NCD : Number of Chilling Days
+       !Config Units = [days]
+       CALL getin_p('NCD_MAX_YEAR',ncd_max_year)
+       !
+       !Config Key   = GDD_THRESHOLD 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 5. 
+       !Config Help  = GDD : Growing-Degree-Day
+       !Config Units = [days] 
+       CALL getin_p('GDD_THRESHOLD',gdd_threshold)
+       !
+       !Config Key   = GREEN_AGE_EVER 
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 2. 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('GREEN_AGE_EVER',green_age_ever)
+       !
+       !Config Key   = GREEN_AGE_DEC
+       !Config Desc  = 
+       !Config If    = OK_STOMATE 
+       !Config Def   = 0.5 
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('GREEN_AGE_DEC',green_age_dec)
+       
+       first_call = .FALSE.
+       
+    ENDIF
+    
+  END SUBROUTINE config_stomate_parameters
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_dgvm_parameters 
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters 
+!! needed when the DGVM model is activated (ie : when ok_dgvm is set to true).
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE config_dgvm_parameters   
+    
+    IMPLICIT NONE
+    
+    !! 0. Variables and parameters declaration
+
+    !! 0.4 Local variables
+
+    LOGICAL, SAVE ::  first_call = .TRUE.         !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================    
+
+    IF(first_call) THEN
+  
+       !-
+       ! establish parameters
+       !-
+       !
+       !Config Key   = ESTAB_MAX_TREE
+       !Config Desc  = Maximum tree establishment rate 
+       !Config If    = OK_DGVM
+       !Config Def   = 0.12 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('ESTAB_MAX_TREE',estab_max_tree)
+       !
+       !Config Key   = ESTAB_MAX_GRASS
+       !Config Desc  = Maximum grass establishment rate
+       !Config If    = OK_DGVM
+       !Config Def   = 0.12 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('ESTAB_MAX_GRASS',estab_max_grass)
+       !
+       !Config Key   = ESTABLISH_SCAL_FACT
+       !Config Desc  = 
+       !Config If    = OK_DGVM 
+       !Config Def   = 5.
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('ESTABLISH_SCAL_FACT',establish_scal_fact)
+       !
+       !Config Key   = MAX_TREE_COVERAGE 
+       !Config Desc  = 
+       !Config If    = OK_DGVM 
+       !Config Def   = 0.98
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('MAX_TREE_COVERAGE',max_tree_coverage)
+       !
+       !Config Key   = IND_0_ESTAB
+       !Config Desc  = 
+       !Config If    = OK_DGVM 
+       !Config Def   = 0.2
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('IND_0_ESTAB',ind_0_estab)
+
+       !-
+       ! light parameters
+       !-
+       !
+       !Config Key   = ANNUAL_INCREASE
+       !Config Desc  = for diagnosis of fpc increase, compare today's fpc to last year's maximum (T) or to fpc of last time step (F)?
+       !Config If    = OK_DGVM
+       !Config Def   = y
+       !Config Help  = 
+       !Config Units = [FLAG]
+       CALL getin_p('ANNUAL_INCREASE',annual_increase)
+       !
+       !Config Key   = MIN_COVER 
+       !Config Desc  = For trees, minimum fraction of crown area occupied 
+       !Config If    = OK_DGVM
+       !Config Def   = 0.05 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('MIN_COVER',min_cover)
+
+       !-
+       ! pftinout parameters
+       !
+       !Config Key   = IND_0 
+       !Config Desc  = initial density of individuals
+       !Config If    = OK_DGVM
+       !Config Def   = 0.02 
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('IND_0',ind_0)
+       !
+       !Config Key   = MIN_AVAIL
+       !Config Desc  = minimum availability
+       !Config If    = OK_DGVM
+       !Config Def   = 0.01
+       !Config Help  = 
+       !Config Units = [-]  
+       CALL getin_p('MIN_AVAIL',min_avail)
+       !
+       !Config Key   = RIP_TIME_MIN
+       !Config Desc  = 
+       !Config If    = OK_DGVM
+       !Config Def   = 1.25 
+       !Config Help  = 
+       !Config Units = [year]  
+       CALL getin_p('RIP_TIME_MIN',RIP_time_min)
+       !
+       !Config Key   = NPP_LONGTERM_INIT
+       !Config Desc  = 
+       !Config If    = OK_DGVM
+       !Config Def   = 10.
+       !Config Help  = 
+       !Config Units = [gC/m^2/year]
+       CALL getin_p('NPP_LONGTERM_INIT',npp_longterm_init)
+       !
+       !Config Key   = EVERYWHERE_INIT
+       !Config Desc  = 
+       !Config If    = OK_DGVM
+       !Config Def   = 0.05 
+       !Config Help  = 
+       !Config Units = [-] 
+       CALL getin_p('EVERYWHERE_INIT',everywhere_init)
+       
+       first_call = .FALSE.
+       
+    ENDIF
+    
+    
+  END SUBROUTINE config_dgvm_parameters
+
+
+END MODULE constantes
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes_mtc.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes_mtc.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes_mtc.f90	(revision 5166)
@@ -0,0 +1,556 @@
+! =================================================================================================================================
+! MODULE       : constantes_mtc
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         This module contains the standard values of the parameters for the 13 metaclasses of vegetation used by ORCHIDEE.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): Didier Solyga : replace default values for humscte at 2 meters soil depth by default values for humcste
+!!                   at 4 meters (used for the CMIP simulations). The standard values for 2 meters soil depth are :
+!!                   REAL(r_std), PARAMETER, DIMENSION(nvmc) :: humcste_mtc  =  &
+!!                   & (/ 5.0,   0.8,   0.8,   1.0,   0.8,   0.8,   1.0,  &
+!!                   &    1.0,   0.8,   4.0,   4.0,   4.0,   4.0  /)
+!!
+!! REFERENCE(S)	: 
+!! - Kuppel, S. (2012): Doctoral Thesis, Assimilation de mesures de flux turbulents d'eau et de carbone dans un modÃšle de la biosphÃšre 
+!! continentale 
+!! - Wohlfahrt, G., M. Bahn, E. Haubner, I. Horak, W. Michaeler, K.Rottmar, U. Tappeiner, and A. Cemusca, 1999: Inter-specific 
+!! variation of the biochemical limitation to photosynthesis and related leaf traits of 30 species from mountain grassland 
+!! ecosystems under different land use. Plant Cell Environ., 22, 12811296.
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_mtc
+
+  USE defprec
+  USE constantes
+
+  IMPLICIT NONE
+
+  !
+  ! METACLASSES CHARACTERISTICS
+  !
+
+  INTEGER(i_std), PARAMETER :: nvmc = 13                         !! Number of MTCS fixed in the code (unitless)
+
+  CHARACTER(len=34), PARAMETER, DIMENSION(nvmc) :: MTC_name = &  !! description of the MTC (unitless)
+  & (/ 'bare ground                       ', &          !  1
+  &    'tropical  broad-leaved evergreen  ', &          !  2
+  &    'tropical  broad-leaved raingreen  ', &          !  3
+  &    'temperate needleleaf   evergreen  ', &          !  4
+  &    'temperate broad-leaved evergreen  ', &          !  5
+  &    'temperate broad-leaved summergreen', &          !  6
+  &    'boreal    needleleaf   evergreen  ', &          !  7
+  &    'boreal    broad-leaved summergreen', &          !  8
+  &    'boreal    needleleaf   summergreen', &          !  9
+  &    '          C3           grass      ', &          ! 10
+  &    '          C4           grass      ', &          ! 11
+  &    '          C3           agriculture', &          ! 12
+  &    '          C4           agriculture'  /)         ! 13
+
+
+  !
+  ! VEGETATION STRUCTURE
+  !
+  INTEGER(i_std),PARAMETER, DIMENSION(nvmc) :: leaf_tab_mtc  =  &                 !! leaf type (1-4, unitless)
+  & (/  4,   1,   1,   2,   1,   1,   2,   &                                      !! 1=broad leaved tree, 2=needle leaved tree
+  &     1,   2,   3,   3,   3,   3   /)                                           !! 3=grass 4=bare ground
+
+  CHARACTER(len=6), PARAMETER, DIMENSION(nvmc) :: pheno_model_mtc  =  &  !! which phenology model is used? (tabulated) 
+  & (/  'none  ',   'none  ',   'moi   ',   'none  ',   'none  ',  &
+  &     'ncdgdd',   'none  ',   'ncdgdd',   'ngd   ',   'moigdd',  &
+  &     'moigdd',   'moigdd',   'moigdd'  /) 
+
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: is_tropical_mtc  =  &                       !! Is PFT tropical ? (true/false)
+  & (/ .FALSE.,   .TRUE.,    .TRUE.,    .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,  &
+  &    .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE. /)    
+
+  CHARACTER(LEN=5), PARAMETER, DIMENSION(nvmc) :: type_of_lai_mtc  =  &  !! Type of behaviour of the LAI evolution algorithm
+  & (/ 'inter', 'inter', 'inter', 'inter', 'inter',  &                   !! for each vegetation type. (unitless)
+  &    'inter', 'inter', 'inter', 'inter', 'inter',  &                   !! Value of type_of_lai : mean or interp
+  &    'inter', 'inter', 'inter' /)
+
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: natural_mtc =  &                         !! natural?  (true/false)
+  & (/ .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,    .TRUE.,   .TRUE.,  &
+  &    .TRUE.,   .TRUE.,   .TRUE.,   .TRUE.,   .FALSE.,   .FALSE.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: veget_ori_fixed_mtc  =  &  !! Value for veget_ori for tests in
+  & (/ 0.2,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                !! 0-dim simulations (0-1, unitless)
+  &    0.0,   0.0,   0.8,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: llaimax_mtc  =  &          !! laimax for maximum
+  & (/ 0.0,   8.0,   8.0,   4.0,   4.5,   4.5,   4.0,  &                !! See also type of lai interpolation
+  &    4.5,   4.0,   2.0,   2.0,   2.0,   2.0  /)                       !! @tex $(m^2.m^{-2})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: llaimin_mtc  = &           !! laimin for minimum lai
+  & (/ 0.0,   8.0,   0.0,   4.0,   4.5,   0.0,   4.0,  &                !! See also type of lai interpolation (m^2.m^{-2})
+  &    0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)                       !! @tex $(m^2.m^{-2})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: height_presc_mtc  =  &     !! prescribed height of vegetation (m)
+  & (/  0.0,   30.0,   30.0,   20.0,   20.0,   20.0,   15.0,  &         !! Value for height_presc : one for each vegetation type
+  &    15.0,   15.0,    0.5,    0.6,    1.0,    1.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: rveg_mtc  =  &             !! Potentiometer to set vegetation resistance (unitless)
+  & (/ 1.0,   1.0,   1.0,   1.0,   1.0,   1.0,   1.0,  &                !! Nathalie on March 28th, 2006 - from Fred Hourdin,
+  &    1.0,   1.0,   1.0,   1.0,   1.0,   1.0   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: sla_mtc  =  &                       !! specif leaf area @tex $(m^2.gC^{-1})$ @endtex
+  & (/ 1.5E-2,   1.53E-2,   2.6E-2,   9.26E-3,     2E-2,   2.6E-2,   9.26E-3,  &
+  &    2.6E-2,    1.9E-2,   2.6E-2,    2.6E-2,   2.6E-2,   2.6E-2  /) 
+
+
+  !
+  ! EVAPOTRANSPIRATION (sechiba)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: rstruct_const_mtc  =  &  !! Structural resistance.
+  & (/ 0.0,   25.0,   25.0,   25.0,   25.0,   25.0,   25.0,  &        !! @tex $(s.m^{-1})$ @endtex
+  &   25.0,   25.0,    2.5,    2.0,    2.0,    2.0   /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: kzero_mtc  =  &                  !! A vegetation dependent constant used in the 
+  & (/    0.0,   12.E-5,   12.E-5,   12.E-5,   12.E-5,   25.E-5,   12.E-5,  & !! calculation  of the surface resistance. 
+  &    25.E-5,   25.E-5,   30.E-5,   30.E-5,   30.E-5,   30.E-5  /)           !! @tex $(kg.m^2.s^{-1})$ @endtex
+
+
+  !
+  ! WATER (sechiba)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: wmax_veg_mtc  =  &        !! Volumetric available soil water capacity in each PFT
+  & (/ 150.0,   150.0,   150.0,   150.0,   150.0,   150.0,   150.0,  & !! @tex $(kg.m^{-3} of soil)$ @endtex
+  &    150.0,   150.0,   150.0,   150.0,   150.0,   150.0  /)         
+                                                                      
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: humcste_mtc  =  &         !! Root profile description for the different 
+  & (/ 5.0,   0.4,   0.4,   1.0,   0.8,   0.8,   1.0,  &               !! vegetations types. @tex $(m^{-1})$ @endtex
+  &    1.0,   0.8,   4.0,   1.0,   4.0,   1.0  /)                      !! These are the factor in the exponential which gets       
+                                                                       !! the root density as a function of depth
+                                                                       !! Values for dpu_max = 4.0  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: humcste_cwrr  =  &        !! Root profile description for the different
+  & (/ 5.0,   0.8,   0.8,   1.0,   0.8,   0.8,   1.0,  &               !! vegetations types.  @tex $(m^{-1})$ @endtex
+  &    1.0,   0.8,   4.0,   4.0,   4.0,   4.0  /)                      !! These are the factor in the exponential which gets       
+                                                                       !! the root density as a function of depth
+                                                                       !! Values for dpu_max = 2.0
+                                                                       !! (used by using 11 layers hydrology) 
+
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: throughfall_by_mtc  =  &  !! Fraction of rain intercepted by the canopy
+  & (/ 30.0,   30.0,   30.0,   30.0,   30.0,   30.0,   30.0,  &        !! (0-100, unitless)
+  &    30.0,   30.0,   30.0,   30.0,   30.0,   30.0  /)
+
+
+  !
+  ! ALBEDO (sechiba)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: snowa_ini_mtc  =  &     !! Initial snow albedo value for each vegetation type
+  & (/ 0.35,    0.0,    0.0,   0.14,   0.14,   0.14,   0.14,  &      !! as it will be used in condveg_snow (unitless)
+  &    0.14,   0.14,   0.18,   0.18,   0.18,   0.18  /)              !! Source : Values are from the Thesis of S. Chalita (1992)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: snowa_dec_mtc  =  &     !! Decay rate of snow albedo value for each vegetation type
+  & (/ 0.45,    0.0,    0.0,   0.06,   0.06,   0.11,   0.06,  &      !! as it will be used in condveg_snow (unitless)
+  &    0.11,   0.11,   0.52,   0.52,   0.52,   0.52  /)              !! Source : Values are from the Thesis of S. Chalita (1992)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alb_leaf_vis_mtc  =  &  !! leaf albedo of vegetation type, visible albedo 
+  & (/ 0.00,   0.04,   0.06,   0.06,   0.06,   0.06,   0.06,  &      !! (unitless)
+  &    0.06,   0.06,   0.10,   0.10,   0.10,   0.10  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alb_leaf_nir_mtc  =  &  !! leaf albedo of vegetation type, near infrared albedo
+  & (/ 0.00,   0.20,   0.22,   0.22,   0.22,   0.22,   0.22,  &      !! (unitless)
+  &    0.22,   0.22,   0.30,   0.30,   0.30,   0.30  /)
+
+
+  !
+  ! SOIL - VEGETATION
+  !
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: pref_soil_veg_mtc  =  &       !! The soil tile number for each vegetation
+  & (/ 1,   2,   2,   2,   2,   2,   2,  &                                    
+  &    2,   2,   3,   3,   3,   3  /)                                         
+
+
+  !
+  ! PHOTOSYNTHESIS
+  !
+  !-
+  ! 1 .CO2
+  !-
+  LOGICAL, PARAMETER, DIMENSION(nvmc) :: is_c4_mtc  =  &                            !! flag for C4 vegetation types (true/false)
+  & (/ .FALSE.,  .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,   .FALSE.,  &
+  &    .FALSE.,  .FALSE.,   .FALSE.,   .TRUE.,    .FALSE.,   .TRUE.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: gsslope_mtc  =  &       !! Slope of the gs/A relation (Ball & al.) (unitless)
+  & (/ 0.0,   9.0,   9.0,   9.0,   9.0,   9.0,   9.0,  & 
+  &    9.0,   9.0,   9.0,   3.0,   9.0,   3.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: gsoffset_mtc  =  &      !! intercept of the gs/A relation (Ball & al.)(unitless)
+  & (/  0.0,   0.01,   0.01,   0.01,   0.01,   0.01,   0.01,  &
+  &    0.01,   0.01,   0.01,   0.03,   0.01,   0.03  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: vcmax_fix_mtc  =  &     !! values used for vcmax when STOMATE is not
+  & (/  0.0,   40.0,   50.0,   30.0,   35.0,   40.0,   30.0,  &      !! activated @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+  &    40.0,   35.0,   60.0,   60.0,   70.0,   70.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: vjmax_fix_mtc  =  &     !! values used for vjmax when STOMATE is no
+  & (/  0.0,   80.0,   100.0,    60.0,    70.0,    80.0,   60.0,  &  !! activated @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex 
+  &    80.0,   70.0,   120.0,   120.0,   140.0,   140.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: co2_tmin_fix_mtc  =  &  !! values used for photosynthesis tmin 
+  & (/ 0.0,    2.0,    2.0,   -4.0,   -3.0,   -2.0,   -4.0,  &       !! when STOMATE is not activated (C)
+  &   -4.0,   -4.0,   -5.0,    6.0,   -5.0,    6.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: co2_topt_fix_mtc  =  &  !! values used for photosynthesis tpopt
+  & (/  0.0,   27.5,   27.5,   17.5,   25.0,   20.0,   17.5,  &      !! when STOMATE is not activated (C)
+  &    17.5,   17.5,   20.0,   32.5,   20.0,   32.5  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: co2_tmax_fix_mtc  =  &  !! values used for photosynthesis tmax 
+  & (/  0.0,   55.0,   55.0,   38.0,   48.0,   38.0,   38.0,  &      !! when STOMATE is not activated (C)
+  &    38.0,   38.0,   45.0,   55.0,   45.0,   55.0  /)
+  !-
+  ! 2 .Stomate
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ext_coeff_mtc  =  &     !! extinction coefficient of the Monsi&Saeki
+  & (/ 0.5,   0.5,   0.5,   0.5,   0.5,   0.5,   0.5,  &             !! relationship (1953) (unitless)
+  &    0.5,   0.5,   0.5,   0.5,   0.5,   0.5  /)
+
+! vcmax_opt_mtc is modified for phase 2 of the TRENDY project (07/2013), according to
+! the results of the CAMELEON and CARBONES projects (S. Kuppel, 2012).
+! Mainly, the Boreal Broad-leaved Summergreen mtc becomes less productive than the
+! Boreal Needleleaf Evergreen mtc, which will also improve the DGVM results.
+! Crops are brought back to a more productive level.
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: vcmax_opt_mtc  =  &     !! Maximum rate of carboxylation
+!  & (/ undef,   65.0,    65.0,    35.0,   45.0,   55.0,   35.0,  &   !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+!  &     45.0,   35.0,    70.0,    70.0,   70.0,   70.0  /)
+  & (/ undef,   65.0,    65.0,    35.0,   45.0,   55.0,   33.0,  &   !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+  &     30.0,   35.0,    70.0,    70.0,  100.0,  100.0  /)
+
+! We now impose the relationship vjmax_opt_mtc = 2*vcmax_opt_mtc to be sure that 
+! vjmax_opt_mtc is modified according to vcmax_opt_mtc (Wohlfahrt et al., 1999).
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: vjmax_opt_mtc  =  &       !! Maximum rate of RUbp regeneration
+  & 2*vcmax_opt_mtc
+!  & (/  undef,   130.0,   130.0,    70.0,    80.0,   110.0,   70.0,  & !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+!  &      90.0,    70.0,   160.0,   160.0,   200.0,   200.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tphoto_min_a_mtc  =  &  !! minimum photosynthesis temperature, 
+  & (/  undef,   0.0,      0.0,   0.0,   0.0,   0.0,   0.0,  &       !! constant a of ax^2+bx+c (deg C), tabulated
+  &       0.0,   0.0,   0.0025,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tphoto_min_b_mtc  =  &  !! minimum photosynthesis temperature, 
+  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &          !! constant b of ax^2+bx+c (deg C), tabulated
+  &       0.0,   0.0,   0.1,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tphoto_min_c_mtc  =  &  !! minimum photosynthesis temperature, 
+  & (/  undef,    2.0,     2.0,   -4.0,   -3.0,   -2.0,   -4.0,  &   !! constant b of ax^2+bx+c (deg C), tabulated
+  &      -4.0,   -4.0,   -3.25,   13.0,   -5.0,   13.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tphoto_opt_a_mtc  =  &  !! optimum photosynthesis temperature,
+  & (/  undef,   0.0,      0.0,   0.0,   0.0,   0.0,   0.0,  &       !! constant a of ax^2+bx+c (deg C), tabulated
+  &       0.0,   0.0,   0.0025,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std),  PARAMETER, DIMENSION(nvmc) :: tphoto_opt_b_mtc  =  & !! optimum photosynthesis temperature, 
+  & (/  undef,   0.0,    0.0,   0.0,   0.0,   0.0,   0.0,  &         !! constant b of ax^2+bx+c (deg C), tabulated
+  &       0.0,   0.0,   0.25,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tphoto_opt_c_mtc  =  &  !! optimum photosynthesis temperature, 
+  & (/  undef,   37.0,    37.0,   25.0,   32.0,   26.0,   25.0,  &   !! constant c of ax^2+bx+c (deg C), tabulated
+  &      25.0,   25.0,   27.25,   36.0,   30.0,   36.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tphoto_max_a_mtc  =  &  !! maximum photosynthesis temperature,
+  & (/  undef,   0.0,       0.0,   0.0,   0.0,   0.0,   0.0,  &      !! constant a of ax^2+bx+c (deg C), tabulated
+  &       0.0,   0.0,   0.00375,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tphoto_max_b_mtc  =  &  !! maximum photosynthesis temperature, 
+  & (/  undef,   0.0,    0.0,   0.0,   0.0,   0.0,   0.0,  &         !! constant b of ax^2+bx+c (deg C), tabulated
+  &       0.0,   0.0,   0.35,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tphoto_max_c_mtc  =  &  !! maximum photosynthesis temperature,
+  & (/  undef,   55.0,     55.0,   38.0,   48.0,   38.0,   38.0,  &  !! constant c of ax^2+bx+c (deg C), tabulated
+  &      38.0,   38.0,   41.125,   55.0,   45.0,   55.0  /)
+
+
+  !
+  ! RESPIRATION (stomate)
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: maint_resp_slope_c_mtc  =  &  !! slope of maintenance respiration coefficient (1/K),
+  & (/  undef,   0.12,   0.12,   0.16,   0.16,   0.16,   0.16,  &          !! constant c of aT^2+bT+c, tabulated
+  &      0.16,   0.16,   0.16,   0.12,   0.16,   0.12  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: maint_resp_slope_b_mtc  =  &  !! slope of maintenance respiration coefficient (1/K),
+  & (/  undef,   0.0,        0.0,   0.0,        0.0,   0.0,   0.0,  &      !! constant b of aT^2+bT+c, tabulated
+  &       0.0,   0.0,   -0.00133,   0.0,   -0.00133,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: maint_resp_slope_a_mtc  =  &  !! slope of maintenance respiration coefficient (1/K),
+  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                !! constant a of aT^2+bT+c, tabulated
+  &       0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_leaf_mtc  =   &                  !! maintenance respiration coefficient
+  & (/   undef,   2.35E-3,   2.62E-3,   1.01E-3,   2.35E-3,   2.62E-3,   1.01E-3,  &  !! at 0 deg C,for leaves, tabulated, 
+  &    2.62E-3,   2.05E-3,   2.62E-3,   2.62E-3,   2.62E-3,   2.62E-3  /)             !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_sapabove_mtc =  &                !! maintenance respiration coefficient 
+  & (/   undef,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,  &  !! at 0 deg C, for sapwood above,
+  &    1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4  /)             !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_sapbelow_mtc  =  &               !! maintenance respiration coefficient
+  & (/   undef,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,  &  !! at 0 deg C, for sapwood below, 
+  &    1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4  /)             !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_heartabove_mtc  =  &             !! maintenance respiration coefficient
+  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                           !! at 0 deg C, for heartwood above,
+  &       0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)                                  !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_heartbelow_mtc  =  &             !! maintenance respiration coefficient
+  & (/  undef,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  &                           !! at 0 deg C, for heartwood below, 
+  &       0.0,   0.0,   0.0,   0.0,   0.0,   0.0  /)                                  !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_root_mtc  =  &                   !! maintenance respiration coefficient
+  & (/   undef,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,  &  !! at 0 deg C, for roots, tabulated,
+  &    1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3,   1.67E-3  /)             !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_fruit_mtc  =  &                  !! maintenance respiration coefficient
+  & (/   undef,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,  &  !! at 0 deg C, for fruits, tabulated,
+  &    1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4  /)             !!  @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: cm_zero_carbres_mtc  =  &                !! maintenance respiration coefficient
+  & (/   undef,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,  &  !! at 0 deg C, for carbohydrate reserve,
+  &    1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4,   1.19E-4  /)             !! tabulated, @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+
+
+  !
+  ! FIRE (stomate)
+  !
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: flam_mtc  =  &         !! flamability: critical fraction of water 
+  & (/  undef,   0.15,   0.25,   0.25,   0.25,   0.25,   0.25,  &  !! holding capacity (0-1, unitless)
+  &      0.25,   0.25,   0.25,   0.25,   0.35,   0.35  /)
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: resist_mtc  =  &       !! fire resistance (0-1, unitless)
+  & (/ undef,   0.95,   0.90,   0.12,   0.50,   0.12,   0.12,  &
+  &    0.12,    0.12,    0.0,    0.0,    0.0,    0.0 /) 
+
+
+  !
+  ! FLUX - LUC
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_1_mtc  =  &   !! Coeff of biomass export for the year
+  & (/  undef,   0.597,   0.597,   0.597,   0.597,   0.597,   0.597,  &   !! (0-1, unitless)
+  &     0.597,   0.597,   0.597,   0.597,   0.597,   0.597  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_10_mtc  =  &  !! Coeff of biomass export for the decade 
+  & (/  undef,   0.403,   0.403,   0.299,   0.299,   0.299,   0.299,  &   !! (0-1, unitless)
+  &     0.299,   0.299,   0.299,   0.403,   0.299,   0.403  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: coeff_lcchange_100_mtc  =  & !! Coeff of biomass export for the century
+  & (/  undef,     0.0,     0.0,   0.104,   0.104,   0.104,   0.104,  &   !! (0-1, unitless)
+  &     0.104,   0.104,   0.104,     0.0,   0.104,     0.0  /)
+
+
+  !
+  ! PHENOLOGY
+  !
+  !-
+  ! 1. Stomate
+  !-
+  REAL(r_std), PARAMETER, DIMENSION (nvmc) :: lai_max_mtc  =  &          !! maximum LAI, PFT-specific 
+  & (/ undef,   7.0,   7.0,   5.0,   5.0,   5.0,   4.5,  &               !! @tex $(m^2.m^{-2})$ @endtex
+  &      4.5,   3.0,   2.5,   2.5,   5.0,   5.0  /)
+
+  INTEGER(i_std), PARAMETER, DIMENSION(nvmc) :: pheno_type_mtc  =  &     !! type of phenology (0-4, unitless)
+  & (/  0,   1,   3,   1,   1,   2,   1,  &                              !! 0=bare ground 1=evergreen,  2=summergreen, 
+  &     2,   2,   4,   4,   2,   3  /)                                   !! 3=raingreen,  4=perennial
+  !-
+  ! 2. Leaf Onset
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_gdd_crit_c_mtc  =  &    !! critical gdd, tabulated (C),
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &    !! constant c of aT^2+bT+c
+  &     undef,   undef,   320.0,   400.0,   320.0,   700.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_gdd_crit_b_mtc  =  &    !! critical gdd, tabulated (C),
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &    !! constant b of aT^2+bT+c
+  &     undef,   undef,    6.25,     0.0,    6.25,     0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: pheno_gdd_crit_a_mtc  =  &    !! critical gdd, tabulated (C),
+  & (/  undef,   undef,     undef,   undef,   undef,   undef,   undef,  &  !! constant a of aT^2+bT+c
+  &     undef,   undef,   0.03125,     0.0,  0.0315,   0.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ngd_crit_mtc  =  &            !! critical ngd, tabulated. 
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &    !! Threshold -5 degrees (days)
+  &     undef,    17.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ncdgdd_temp_mtc  =  &         !! critical temperature for the ncd vs. gdd 
+  & (/  undef,   undef,   undef,   undef,   undef,     5.0,   undef,  &    !! function in phenology (C)
+  &       0.0,   undef,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: hum_frac_mtc  =  &            !! critical humidity (relative to min/max) 
+  & (/  undef,   undef,   0.5,   undef,   undef,   undef,   undef, &       !! for phenology (unitless)
+  &     undef,   undef,   0.5,     0.5,     0.5,     0.5  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: hum_min_time_mtc  =  &        !! minimum time elapsed since
+  & (/  undef,   undef,   50.0,   undef,   undef,   undef,   undef,  &     !! moisture minimum (days)
+  &     undef,   undef,   35.0,    35.0,    75.0,    75.0  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_sap_mtc  =  &             !! time (days)  
+  & (/  undef,   730.0,   730.0,   730.0,   730.0,   730.0,   730.0,  &
+  &     730.0,   730.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tau_fruit_mtc  =  &           !! fruit lifetime (days)
+  & (/  undef,  90.0,    90.0,    90.0,    90.0,   90.0,   90.0,  &
+  &      90.0,  90.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: ecureuil_mtc  =  &            !! fraction of primary leaf and root allocation
+  & (/  undef,   0.0,   1.0,   0.0,   0.0,   1.0,   0.0,  &                !! put into reserve (0-1, unitless)
+  &       1.0,   1.0,   1.0,   1.0,   1.0,   1.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alloc_min_mtc  =  &           !! NEW - allocation above/below = f(age) 
+  & (/  undef,   0.2,     0.2,     0.2,     0.2,    0.2,   0.2,  &         !! - 30/01/04 NV/JO/PF
+  &       0.2,   0.2,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: alloc_max_mtc  =  &           !! NEW - allocation above/below = f(age) 
+  & (/  undef,   0.8,     0.8,     0.8,     0.8,    0.8,   0.8,  &         !! - 30/01/04 NV/JO/PF
+  &       0.8,   0.8,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: demi_alloc_mtc  =  &          !! NEW - allocation above/below = f(age) 
+  & (/  undef,   5.0,     5.0,     5.0,     5.0,    5.0,   5.0,  &         !! - 30/01/04 NV/JO/PF
+  &       5.0,   5.0,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaflife_mtc  =  &            !! leaf longevity, tabulated (??units??)
+  & (/  undef,   0.5,   2.0,   0.33,   1.0,   2.0,   0.33,  &
+  &       2.0,   2.0,   2.0,   2.0,    2.0,   2.0  /)
+  !-
+  ! 3. Senescence
+  !-
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leaffall_mtc  =  &             !! length of death of leaves, tabulated (days)
+  & (/  undef,   undef,   10.0,   undef,   undef,   10.0,   undef,  &
+  &      10.0,    10.0,   10.0,    10.0,    10.0,   10.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: leafagecrit_mtc  =  &          !! critical leaf age, tabulated (days)
+  & (/  undef,   730.0,   180.0,   910.0,   730.0,   180.0,   910.0,  &
+  &     180.0,   180.0,   120.0,   120.0,    90.0,    90.0  /)
+
+  CHARACTER(LEN=6), PARAMETER, DIMENSION(nvmc) :: senescence_type_mtc  =  & !! type of senescence, tabulated (unitless)
+  & (/  'none  ',  'none  ',   'dry   ',  'none  ',  'none  ',  &
+  &     'cold  ',  'none  ',   'cold  ',  'cold  ',  'mixed ',  &
+  &     'mixed ',  'mixed ',   'mixed '            /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_hum_mtc  =  &       !! critical relative moisture availability
+  & (/  undef,   undef,   0.3,   undef,   undef,   undef,   undef,  &       !! for senescence (0-1, unitless)
+  &     undef,   undef,   0.2,     0.2,     0.3,     0.2  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: nosenescence_hum_mtc  =  &     !! relative moisture availability above which 
+  & (/  undef,   undef,   0.8,   undef,   undef,   undef,   undef,  &       !! there is no humidity-related senescence
+  &     undef,   undef,   0.3,     0.3,     0.3,     0.3  /)                !! (0-1, unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: max_turnover_time_mtc  =  &    !! maximum turnover time for grasses (days)
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &
+  &     undef,   undef,    80.0,    80.0,    80.0,    80.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: min_turnover_time_mtc  =  &    !! minimum turnover time for grasses (days)
+  & (/  undef,   undef,   undef,   undef,   undef,   undef,   undef,  &
+  &     undef,   undef,    10.0,    10.0,    10.0,    10.0  /)
+ 
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: min_leaf_age_for_senescence_mtc  =  &  !! minimum leaf age to allow 
+  & (/  undef,   undef,   90.0,   undef,   undef,   90.0,   undef,  &               !! senescence g (days)
+  &      60.0,    60.0,   30.0,    30.0,    30.0,   30.0  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_temp_c_mtc  =  &    !! critical temperature for senescence (C)
+  & (/  undef,   undef,    undef,   undef,   undef,   12.0,   undef,  &     !! constant c of aT^2+bT+c, tabulated
+  &       7.0,     2.0,   -1.375,     5.0,    5.0,    10.0  /)              !! (unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_temp_b_mtc  =  &    !! critical temperature for senescence (C), 
+  & (/  undef,   undef,   undef,   undef,   undef,   0.0,   undef,  &       !! constant b of aT^2+bT+c, tabulated
+  &       0.0,     0.0,     0.1,     0.0,     0.0,   0.0  /)                !! (unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: senescence_temp_a_mtc  =  &    !! critical temperature for senescence (C), 
+  & (/  undef,   undef,     undef,   undef,   undef,   0.0,   undef,  &     !! constant a of aT^2+bT+c, tabulated
+  &       0.0,     0.0,   0.00375,     0.0,     0.0,   0.0  /)              !! (unitless)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: gdd_senescence_mtc  =  &       !! minimum gdd to allow senescence of crops (days)
+  & (/  undef,   undef,    undef,   undef,     undef,    undef,    undef,  &
+  &     undef,   undef,    undef,   undef,      950.,    4000.  /)
+
+
+  !
+  ! DGVM
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: residence_time_mtc  =  &    !! residence time of trees (years)
+  & (/  undef,   30.0,   30.0,   40.0,   40.0,   40.0,   80.0,  &
+  &      80.0,   80.0,    0.0,    0.0,    0.0,    0.0  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tmin_crit_mtc  =  &
+  & (/  undef,     0.0,     0.0,   -30.0,   -14.0,   -30.0,   -45.0,  &  !! critical tmin, tabulated (C)
+  &     -45.0,   undef,   undef,   undef,   undef,   undef  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: tcm_crit_mtc  =  &
+  & (/  undef,   undef,   undef,     5.0,    15.5,    15.5,   -8.0,  &   !! critical tcm, tabulated (C)
+  &      -8.0,    -8.0,   undef,   undef,   undef,   undef  /)
+
+
+
+  !
+  ! Biogenic Volatile Organic Compounds
+  !
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_isoprene_mtc = &     !! Isoprene emission factor 
+  & (/  0.,    24.,   24.,    8.,   16.,   45.,   8.,  &                    !!
+  &     8.,     8.,   16.,   24.,    5.,    5.  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_monoterpene_mtc = &  !! Monoterpene emission factor
+  & (/   0.,   0.8,    0.8,   2.4,    1.2,    0.8,    2.4,  &               !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    2.4,    2.4,    0.8,   1.2,    0.2,     0.2  /)
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_ORVOC_mtc = &        !! ORVOC emissions factor 
+  &  (/  0.,    1.5,    1.5,    1.5,    1.5,   1.5,    1.5,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &     1.5,    1.5,    1.5,    1.5,    1.5,   1.5  /) 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_OVOC_mtc = &         !! OVOC emissions factor 
+  &  (/  0.,    1.5,    1.5,    1.5,    1.5,   1.5,    1.5,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &     1.5,    1.5,    1.5,    1.5,    1.5,   1.5  /)
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_MBO_mtc = &          !! MBO emissions factor
+  & (/  0.,    0.,    0.,    20.0,    0.,    0.,    0.,  &                  !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &     0.,    0.,    0.,       0.,   0.,    0.  /)  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_methanol_mtc = &     !! Methanol emissions factor 
+  & (/  0.,    0.6,   0.6,   1.8,   0.9,   0.6,   1.8,  &                   !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    1.8,    1.8,   0.6,   0.9,    2.,     2.  /)  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_acetone_mtc = &      !! Acetone emissions factor
+  & (/  0.,   0.29,   0.29,   0.87,   0.43,   0.29,   0.87,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.87,   0.87,   0.29,   0.43,   0.07,   0.07  /)
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_acetal_mtc = &       !! Acetaldehyde emissions factor 
+  & (/  0.,   0.1,    0.1,     0.3,    0.15,   0.1,   0.3,   0.3,   &       !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    0.3,   0.1,   0.15,   0.025,   0.025  /)  
+  
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_formal_mtc = &       !! Formaldehyde emissions factor
+  & (/  0.,   0.07,   0.07,   0.2,     0.1,    0.07,   0.2,  &              !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &    0.2,    0.2,   0.07,   0.1,   0.017,   0.017  /)  
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_acetic_mtc = &       !! Acetic Acid emissions factor
+  & (/   0.,   0.002,   0.002,   0.006,   0.003,     0.002,   0.006,   &    !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.006,   0.006,   0.002,   0.003,   0.0005,   0.0005  /)  
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: em_factor_formic_mtc = &       !! Formic Acid emissions factor
+  & (/  0.,   0.01,   0.01,   0.03,     0.015,     0.01,   0.03,  &         !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+  &   0.03,   0.03,   0.01,   0.015,   0.0025,   0.0025  /)  
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: em_factor_no_wet_mtc = &        !! NOx emissions factor soil emissions and exponential
+  & (/  0.,   2.6,   0.06,   0.03,   0.03,   0.03,   0.03,  &               !! dependancy factor for wet soils
+  &  0.03,   0.03,   0.36,   0.36,   0.36,   0.36  /)                       !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+
+  REAL(r_std),PARAMETER, DIMENSION(nvmc) :: em_factor_no_dry_mtc = &        !! NOx emissions factor soil emissions and exponential
+  & (/  0.,   8.60,   0.40,   0.22,   0.22,   0.22,   0.22,  &              !! dependancy factor for dry soils
+  &   0.22,   0.22,   2.65,   2.65,   2.65,   2.65  /)                      !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex 
+
+  REAL(r_std), PARAMETER, DIMENSION(nvmc) :: Larch_mtc = &                  !! Larcher 1991 SAI/LAI ratio (unitless)
+  & (/   0.,   0.015,   0.015,   0.003,   0.005,   0.005,   0.003,  &
+  &   0.005,   0.003,   0.005,   0.005,   0.008,   0.008  /)  
+
+
+
+END MODULE constantes_mtc
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes_soil.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes_soil.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes_soil.f90	(revision 5166)
@@ -0,0 +1,314 @@
+! =================================================================================================================================
+! MODULE 	: constantes_soil
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "constantes_soil" module contains subroutine to initialize the parameters related to soil and hydrology.
+!!
+!!\n DESCRIPTION : "constantes_soil" module contains subroutine to initialize the parameters related to soil and hydrology.
+!!                 This module alos USE constates_soil and can therfor be used to acces the subroutines and the constantes.
+!!                 The constantes declarations can also be used seperatly with "USE constantes_soil_var".
+!!
+!! RECENT CHANGE(S): 
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_soil
+
+  USE constantes_soil_var
+  USE constantes
+  USE ioipsl_para 
+
+  IMPLICIT NONE
+
+CONTAINS
+
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : config_soil_parameters
+!!
+!>\BRIEF        This subroutine reads in the configuration file all the parameters related to soil and hydrology. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+   SUBROUTINE config_soil_parameters(active_flags)
+     
+     USE ioipsl
+
+     IMPLICIT NONE
+
+     !! 0. Variables and parameters declaration
+
+     !! 0.1 Input variables
+
+     TYPE(control_type), INTENT(in) :: active_flags            !! What parts of the code are activated ? (true/false)  
+
+    !! 0.4 Local variables 
+
+     INTEGER(i_std), PARAMETER      :: error_level = 3         !! Switch to 2 to turn fatal errors into warnings.(1-3, unitless)
+     LOGICAL, SAVE                  :: first_call = .TRUE.     !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+     
+     IF ( first_call ) THEN
+        
+        !Config Key   = DRY_SOIL_HEAT_CAPACITY
+        !Config Desc  = Dry soil Heat capacity of soils
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 1.80e+6
+        !Config Help  = Values taken from : PIELKE,'MESOSCALE METEOROLOGICAL MODELING',P.384.
+        !Config Units = [J.m^{-3}.K^{-1}] 
+        CALL getin_p("DRY_SOIL_HEAT_CAPACITY",so_capa_dry)
+        
+        !! Check parameter value (correct range)
+        IF ( so_capa_dry <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                &     "Wrong parameter value for DRY_SOIL_HEAT_CAPACITY.", &
+                &     "This parameter should be positive. ", &
+                &     "Please, check parameter value in run.def. ")
+        END IF
+        
+
+        !Config Key   = DRY_SOIL_HEAT_COND
+        !Config Desc  = Dry soil Thermal Conductivity of soils
+        !Config If    = OK_SECHIBA
+        !Config Def   = 0.40 
+        !Config Help  = Values taken from : PIELKE,'MESOSCALE METEOROLOGICAL MODELING',P.384.
+        !Config Units = [W.m^{-2}.K^{-1}] 
+        CALL getin_p("DRY_SOIL_HEAT_COND",so_cond_dry)
+
+        !! Check parameter value (correct range)
+        IF ( so_cond_dry <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                &     "Wrong parameter value for DRY_SOIL_HEAT_COND.", &
+                &     "This parameter should be positive. ", &
+                &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        !Config Key   = WET_SOIL_HEAT_CAPACITY
+        !Config Desc  = Wet soil Heat capacity of soils 
+        !Config If    = OK_SECHIBA
+        !Config Def   = 3.03e+6
+        !Config Help  = 
+        !Config Units = [J.m^{-3}.K^{-1}]
+        CALL getin_p("WET_SOIL_HEAT_CAPACITY",so_capa_wet)
+
+        !! Check parameter value (correct range)
+        IF ( so_capa_wet <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+               &     "Wrong parameter value for WET_SOIL_HEAT_CAPACITY.", &
+               &     "This parameter should be positive. ", &
+               &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        !Config Key   = WET_SOIL_HEAT_COND
+        !Config Desc  = Wet soil Thermal Conductivity of soils
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 1.89 
+        !Config Help  = 
+        !Config Units = [W.m^{-2}.K^{-1}]
+        CALL getin_p("WET_SOIL_HEAT_COND",so_cond_wet)
+
+        !! Check parameter value (correct range)
+        IF ( so_cond_wet <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+               &     "Wrong parameter value for WET_SOIL_HEAT_COND.", &
+               &     "This parameter should be positive. ", &
+               &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        !Config Key   = SNOW_HEAT_COND
+        !Config Desc  = Thermal Conductivity of snow
+        !Config If    = OK_SECHIBA  
+        !Config Def   = 0.3
+        !Config Help  = 
+        !Config Units = [W.m^{-2}.K^{-1}]
+        CALL getin_p("SNOW_HEAT_COND",sn_cond)
+
+        !! Check
+        IF ( sn_cond <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+               &     "Wrong parameter value for SNOW_HEAT_COND.", &
+               &     "This parameter should be positive. ", &
+               &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        !Config Key   = SNOW_DENSITY
+        !Config Desc  = Snow density for the soil thermodynamics 
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 330.0
+        !Config Help  = 
+        !Config Units = [-] 
+        CALL getin_p("SNOW_DENSITY",sn_dens)
+        
+        !! Check parameter value (correct range)
+        IF ( sn_dens <= zero ) THEN
+          CALL ipslerr_p(error_level, "config_soil_parameters.", &
+               &     "Wrong parameter value for SNOW_DENSITY.", &
+               &     "This parameter should be positive. ", &
+               &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        !! Calculation of snow capacity
+        !! If sn_dens is redefined by the user, sn_capa needs to be reset
+        sn_capa = 2100.0_r_std*sn_dens
+
+
+        !Config Key   = NOBIO_WATER_CAPAC_VOLUMETRI
+        !Config Desc  = 
+        !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR)
+        !Config Def   = 150.
+        !Config Help  = 
+        !Config Units = [s/m^2]
+        CALL getin_p('NOBIO_WATER_CAPAC_VOLUMETRI',mx_eau_nobio)
+
+       !! Check parameter value (correct range)
+        IF ( mx_eau_nobio <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+               &     "Wrong parameter value for NOBIO_WATER_CAPAC_VOLUMETRI.", &
+               &     "This parameter should be positive. ", &
+               &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        !Config Key   = SECHIBA_QSINT 
+        !Config Desc  = Interception reservoir coefficient
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.1
+        !Config Help  = Transforms leaf area index into size of interception reservoir
+        !Config         for slowproc_derivvar or stomate
+        !Config Units = [m]
+        CALL getin_p('SECHIBA_QSINT',qsintcst)
+
+        !! Check parameter value (correct range)
+        IF ( qsintcst <= zero ) THEN
+           CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                &     "Wrong parameter value for SECHIBA_QSINT.", &
+                &     "This parameter should be positive. ", &
+                &     "Please, check parameter value in run.def. ")
+        END IF
+
+
+        IF ( .NOT.(active_flags%hydrol_cwrr) ) THEN
+           
+           !Config Key   = CHOISNEL_DIFF_MIN
+           !Config Desc  = Diffusion constant for the slow regime
+           !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR)
+           !Config Def   = 0.001
+           !Config Help  = 
+           !Config Units = [kg/m^2/dt]
+           CALL getin_p('CHOISNEL_DIFF_MIN',min_drain)
+
+           !! Check parameter value (correct range)
+           IF ( min_drain <= zero ) THEN
+              CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                   &     "Wrong parameter value for CHOISNEL_DIFF_MIN.", &
+                   &     "This parameter should be positive. ", &
+                   &     "Please, check parameter value in run.def. ")
+            END IF
+
+
+           !Config Key   = CHOISNEL_DIFF_MAX
+           !Config Desc  = Diffusion constant for the fast regime
+           !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR)
+           !Config Def   = 0.1
+           !Config Help  = 
+           !Config Units = [kg/m^2/dt]
+           CALL getin_p('CHOISNEL_DIFF_MAX',max_drain)
+
+           !! Check parameter value (correct range)
+           IF (  ( max_drain <= zero ) .OR. ( max_drain <= min_drain ) ) THEN
+              CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                   &     "Wrong parameter value for CHOISNEL_DIFF_MAX.", &
+                   &     "This parameter should be positive or greater than CHOISNEL_DIFF_MIN.", &
+                   &     "Please, check parameter value in run.def. ")
+           END IF
+
+
+           !Config Key   = CHOISNEL_DIFF_EXP
+           !Config Desc  = The exponential in the diffusion law
+           !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR)
+           !Config Def   = 1.5
+           !Config Help  = 
+           !Config Units = [-]
+           CALL getin_p('CHOISNEL_DIFF_EXP',exp_drain)
+           
+           !! Check parameter value (correct range)
+           IF ( exp_drain <= zero ) THEN
+              CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                   &     "Wrong parameter value for CHOISNEL_DIFF_EXP.", &
+                   &     "This parameter should be positive. ", &
+                   &     "Please, check parameter value in run.def. ")
+           END IF
+
+
+           !Config Key   = CHOISNEL_RSOL_CSTE
+           !Config Desc  = Constant in the computation of resistance for bare  soil evaporation 
+           !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR)
+           !Config Def   = 33.E3
+           !Config Help  = 
+           !Config Units = [s/m^2]
+           CALL getin_p('CHOISNEL_RSOL_CSTE',rsol_cste)
+
+           !! Check parameter value (correct range)
+           IF ( rsol_cste <= zero ) THEN
+              CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                   &     "Wrong parameter value for CHOISNEL_RSOL_CSTE.", &
+                   &     "This parameter should be positive. ", &
+                   &     "Please, check parameter value in run.def. ")
+           END IF
+
+
+           !Config Key   = HCRIT_LITTER
+           !Config Desc  = Scaling depth for litter humidity
+           !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR) 
+           !Config Def   = 0.08 
+           !Config Help  = 
+           !Config Units = [m]
+           CALL getin_p('HCRIT_LITTER',hcrit_litter)
+
+           !! Check parameter value (correct range)
+           IF ( hcrit_litter <= zero ) THEN
+              CALL ipslerr_p(error_level, "config_soil_parameters.", &
+                   &     "Wrong parameter value for HCRIT_LITTER.", &
+                   &     "This parameter should be positive. ", &
+                   &     "Please, check parameter value in run.def. ")
+           END IF
+
+
+        END IF
+
+        first_call =.FALSE.
+        
+     ENDIF
+     
+   END SUBROUTINE config_soil_parameters
+   
+
+END MODULE constantes_soil
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes_soil_var.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes_soil_var.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes_soil_var.f90	(revision 5166)
@@ -0,0 +1,257 @@
+! =================================================================================================================================
+! MODULE 	: constantes_soil_var
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "constantes_soil_var" module contains the parameters related to soil and hydrology.
+!!
+!!\n DESCRIPTION : The non saturated hydraulic properties are defined from the  
+!!                 formulations of van Genuchten (1980) and Mualem (1976), combined as  
+!!                 explained in d'Orgeval (2006). \n
+!!                 The related parameters for three main  
+!!                 soil textures (coarse, medium and fine) come from Carsel and Parrish  
+!!                 (1988).
+!!
+!! RECENT CHANGE(S): Sonke Zaehle changed hcrit_litter value according to Shilong Piao from 0.03 to 0.08, 080806
+!!
+!! REFERENCE(S)	:
+!!- Roger A.Pielke, (2002), Mesoscale meteorological modeling, Academic Press Inc. 
+!!- Polcher, J., Laval, K., DÃŒmenil, L., Lean, J., et Rowntree, P. R. (1996).
+!! Comparing three land surface schemes used in general circulation models. Journal of Hydrology, 180(1-4), 373--394.
+!!- Ducharne, A., Laval, K., et Polcher, J. (1998). Sensitivity of the hydrological cycle
+!! to the parametrization of soil hydrology in a GCM. Climate Dynamics, 14, 307--327. 
+!!- Rosnay, P. de et Polcher, J. (1999). Modelling root water uptake in a complex land surface
+!! scheme coupled to a GCM. Hydrol. Earth Syst. Sci., 2(2/3), 239--255.
+!!- d'Orgeval, T. et Polcher, J. (2008). Impacts of precipitation events and land-use changes
+!! on West African river discharges during the years 1951--2000. Climate Dynamics, 31(2), 249--262. 
+!!- Carsel, R. and Parrish, R.: Developing joint probability distributions of soil water
+!! retention characteristics, Water Resour. Res.,24, 755â769, 1988.
+!!- Mualem Y (1976) A new model for predicting the hydraulic conductivity  
+!! of unsaturated porous media. Water Resources Research 12(3):513-522
+!!- Van Genuchten M (1980) A closed-form equation for predicting the  
+!! hydraulic conductivity of unsaturated soils. Soil Sci Soc Am J, 44(5):892-898
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_soil_var
+
+  USE defprec
+
+  IMPLICIT NONE
+
+
+  LOGICAL, SAVE             :: check_waterbal=.TRUE.    !! The check the water balance (true/false)
+!$OMP THREADPRIVATE(check_waterbal)
+
+  !! Dimensioning parameters
+
+  INTEGER(i_std), PARAMETER :: ngrnd=7                  !! Number of soil level (unitless)
+  INTEGER(i_std), PARAMETER :: nbdl=11                  !! Number of diagnostic levels in the soil
+                                                        !! To compare hydrologic variables with tag 1.6 and lower,
+                                                        !! set nbdl to 6 : INTEGER(i_std), PARAMETER :: nbdl = 6
+                                                        !! (unitless)
+  INTEGER(i_std), PARAMETER :: nslm=11                  !! Number of levels in CWRR (unitless)
+
+  REAL(r_std), SAVE         :: dpu_max = 4.0_r_std      !! Maximum depth of soil reservoir. (m)
+                                                        !! This is the default value for Choisnel used for the AR5
+                                                        !! simulations. If CWRR is activated, dpu_max is set to 2
+                                                        !! in intsurf_config.
+!$OMP THREADPRIVATE(dpu_max)
+
+  !! Number of soil classes
+
+  INTEGER(i_std), PARAMETER :: ntext=3                  !! Number of soil textures (Silt, Sand, Clay)
+  INTEGER(i_std), PARAMETER :: nstm=3                   !! Number of soil tiles (unitless)
+  CHARACTER(LEN=30)         :: soil_classif             !! Type of classification used for the map of soil types.
+                                                        !! It must be consistent with soil file given by 
+                                                        !! SOILCLASS_FILE parameter.
+  INTEGER(i_std), PARAMETER :: nscm_fao=3               !! For FAO Classification (unitless)
+  INTEGER(i_std), PARAMETER :: nscm_usda=12             !! For USDA Classification (unitless)
+  INTEGER(i_std), SAVE      :: nscm=nscm_fao            !! Default value for nscm
+!$OMP THREADPRIVATE(nscm)
+
+  !! Parameters for soil thermodynamics
+
+  REAL(r_std), SAVE :: so_capa_dry = 1.80e+6            !! Dry soil Heat capacity of soils 
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex 
+!$OMP THREADPRIVATE(so_capa_dry)
+  REAL(r_std), SAVE :: so_cond_dry = 0.40               !! Dry soil Thermal Conductivity of soils
+                                                        !! @tex $(W.m^{-2}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(so_cond_dry)
+  REAL(r_std), SAVE :: so_capa_wet = 3.03e+6            !! Wet soil Heat capacity of soils 
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(so_capa_wet)
+  REAL(r_std), SAVE :: so_cond_wet = 1.89               !! Wet soil Thermal Conductivity of soils 
+                                                        !! @tex $(W.m^{-2}.K^{-1})$ @endtex 
+!$OMP THREADPRIVATE(so_cond_wet)
+  REAL(r_std), SAVE :: sn_cond = 0.3                    !! Thermal Conductivity of snow 
+                                                        !! @tex $(W.m^{-2}.K^{-1})$ @endtex  
+!$OMP THREADPRIVATE(sn_cond)
+  REAL(r_std), SAVE :: sn_dens = 330.0                  !! Snow density for the soil thermodynamics
+                                                        !! (unitless)
+!$OMP THREADPRIVATE(sn_dens)
+  REAL(r_std), SAVE :: sn_capa                          !! Heat capacity for snow 
+                                                        !! @tex $(J.m^{-3}.K^{-1})$ @endtex
+!$OMP THREADPRIVATE(sn_capa)
+
+
+  !! Specific parameters for the Choisnel hydrology
+
+  REAL(r_std), SAVE :: min_drain = 0.001                !! Diffusion constant for the slow regime
+                                                        !! (This is for the diffusion between reservoirs)
+                                                        !! @tex $(kg.m^{-2}.dt^{-1})$ @endtex
+!$OMP THREADPRIVATE(min_drain)
+  REAL(r_std), SAVE :: max_drain = 0.1                  !! Diffusion constant for the fast regime 
+                                                        !! @tex $(kg.m^{-2}.dt^{-1})$ @endtex
+!$OMP THREADPRIVATE(max_drain)
+  REAL(r_std), SAVE :: exp_drain = 1.5                  !! The exponential in the diffusion law (unitless)
+!$OMP THREADPRIVATE(exp_drain)
+  REAL(r_std), SAVE :: qsintcst = 0.1                   !! Transforms leaf area index into size of interception reservoir
+                                                        !! (unitless)
+!$OMP THREADPRIVATE(qsintcst)
+  REAL(r_std), SAVE :: mx_eau_nobio = 150.              !! Volumetric available soil water capacity in nobio fractions
+                                                        !! @tex $(kg.m^{-3} of soil)$ @endtex
+!$OMP THREADPRIVATE(mx_eau_nobio)
+  REAL(r_std), SAVE :: rsol_cste = 33.E3                !! Constant in the computation of resistance for bare soil evaporation
+                                                        !! @tex $(s.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(rsol_cste)
+  REAL(r_std), SAVE :: hcrit_litter=0.08_r_std          !! Scaling depth for litter humidity (m)
+!$OMP THREADPRIVATE(hcrit_litter)
+
+
+  !! Parameters specific for the CWRR hydrology.
+
+  !!  1. Parameters for FAO Classification
+
+  !! Parameters for soil type distribution
+
+  REAL(r_std),DIMENSION(nscm_fao),SAVE :: soilclass_default_fao = &   !! Default soil texture distribution for fao :
+ & (/ 0.28, 0.52, 0.20 /)                                             !! in the following order : COARSE, MEDIUM, FINE (unitless)
+!$OMP THREADPRIVATE(soilclass_default_fao)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: nvan_fao = &            !! Van genuchten coefficient n
+ & (/ 1.89_r_std, 1.56_r_std, 1.31_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: avan_fao = &            !! Van genuchten coefficient a (mm^{-1}) 
+  & (/ 0.0075_r_std, 0.0036_r_std, 0.0019_r_std /) 
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mcr_fao = &             !! Residual soil water content
+ & (/ 0.065_r_std, 0.078_r_std, 0.095_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mcs_fao = &             !! Saturated soil water content
+ & (/ 0.41_r_std, 0.43_r_std, 0.41_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: ks_fao = &              !! Hydraulic conductivity Saturation (mm/d)
+ & (/ 1060.8_r_std, 249.6_r_std, 62.4_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: pcent_fao = &           !! Fraction of saturated volumetric soil moisture 
+ & (/ 0.5_r_std, 0.5_r_std, 0.5_r_std /)                               !! above which transpir is max (0-1, unitless)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: free_drain_max_fao = &  !! Max value of the permeability coeff at 
+ & (/ 1.0_r_std, 1.0_r_std, 1.0_r_std /)                               !! the bottom of the soil
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mcf_fao = &             !! Volumetric water content field capacity
+ & (/ 0.32_r_std, 0.32_r_std, 0.32_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mcw_fao = &             !! Volumetric water content Wilting pt
+ & (/ 0.10_r_std, 0.10_r_std, 0.10_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mc_awet_fao = &         !! Vol. wat. cont. above which albedo is cst
+ & (/ 0.25_r_std, 0.25_r_std, 0.25_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_fao) :: mc_adry_fao = &         !! Vol. wat. cont. below which albedo is cst
+ & (/ 0.1_r_std, 0.1_r_std, 0.1_r_std /)
+
+
+  !!  2. Parameters for USDA Classification
+
+  !! Parameters for soil type distribution :
+  !! Sand, Loamy Sand, Sandy Loam, Silt Loam, Silt, Loam, Sandy Clay Loam, Silty Clay Loam, Clay Loam, Sandy Clay, Silty Clay, Clay
+
+  REAL(r_std),DIMENSION(nscm_usda),SAVE :: soilclass_default_usda = &    !! Default soil texture distribution in the following order :
+ & (/ 0.28, 0.52, 0.20, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 /)   !!    sand, loam and clay ??? OR COARSE, MEDIUM, FINE???
+!$OMP THREADPRIVATE(soilclass_default_usda)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: nvan_usda = &            !! Van genuchten coefficient n
+ & (/ 2.68_r_std, 2.28_r_std, 1.89_r_std, 1.41_r_std, &
+ &    1.37_r_std, 1.56_r_std, 1.48_r_std, 1.23_r_std, &
+ &    1.31_r_std, 1.23_r_std, 1.09_r_std, 1.09_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: avan_usda = &            !! Van genuchten coefficient a (mm^{-1})
+ & (/ 0.0145_r_std, 0.0124_r_std, 0.0075_r_std, 0.0020_r_std, &
+ &    0.0016_r_std, 0.0036_r_std, 0.0059_r_std, 0.0010_r_std, &
+ &    0.0019_r_std, 0.0027_r_std, 0.0005_r_std, 0.0008_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mcr_usda = &             !! Residual soil water content
+ & (/ 0.045_r_std, 0.057_r_std, 0.065_r_std, 0.067_r_std, &
+ &    0.034_r_std, 0.078_r_std, 0.100_r_std, 0.089_r_std, &
+ &    0.095_r_std, 0.100_r_std, 0.070_r_std, 0.068_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mcs_usda = &             !! Saturated soil water content
+ & (/ 0.43_r_std, 0.41_r_std, 0.41_r_std, 0.45_r_std, &
+ &    0.46_r_std, 0.43_r_std, 0.39_r_std, 0.43_r_std, &
+ &    0.41_r_std, 0.38_r_std, 0.36_r_std, 0.38_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: ks_usda = &              !! Hydraulic conductivity Saturation (mm/d)
+ & (/ 7128.0_r_std, 3501.6_r_std, 1060.8_r_std, 108.0_r_std, &
+ &    60.0_r_std, 249.6_r_std, 314.4_r_std, 16.8_r_std, &
+ &    62.4_r_std, 28.8_r_std, 4.8_r_std, 48.0_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: pcent_usda = &           !! Soil moisture above which transpir is max
+ & (/ 0.5_r_std, 0.5_r_std, 0.5_r_std, 0.5_r_std, &
+ &    0.5_r_std, 0.5_r_std, 0.5_r_std, 0.5_r_std, &
+ &    0.5_r_std, 0.5_r_std, 0.5_r_std, 0.5_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: free_drain_max_usda = &  !! Max value of the permeability coeff at 
+ & (/ 1.0_r_std, 1.0_r_std, 1.0_r_std, 1.0_r_std, &                      !! the bottom of the soil
+ &    1.0_r_std, 1.0_r_std, 1.0_r_std, 1.0_r_std, &
+ &    1.0_r_std, 1.0_r_std, 1.0_r_std, 1.0_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mcf_usda = &             !! Volumetric water content field capacity
+ & (/ 0.32_r_std, 0.32_r_std, 0.32_r_std, 0.32_r_std, &
+ &    0.32_r_std, 0.32_r_std, 0.32_r_std, 0.32_r_std, &
+ &    0.32_r_std, 0.32_r_std, 0.32_r_std, 0.32_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mcw_usda = &             !! Volumetric water content Wilting pt
+ & (/ 0.10_r_std, 0.10_r_std, 0.10_r_std, 0.10_r_std, &
+ &    0.10_r_std, 0.10_r_std, 0.10_r_std, 0.10_r_std, &
+ &    0.10_r_std, 0.10_r_std, 0.10_r_std, 0.10_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mc_awet_usda = &         !! Vol. wat. cont. above which albedo is cst
+ & (/ 0.25_r_std, 0.25_r_std, 0.25_r_std, 0.25_r_std, &
+ &    0.25_r_std, 0.25_r_std, 0.25_r_std, 0.25_r_std, &
+ &    0.25_r_std, 0.25_r_std, 0.25_r_std, 0.25_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nscm_usda) :: mc_adry_usda = &         !! Vol. wat. cont. below which albedo is cst
+ & (/ 0.1_r_std, 0.1_r_std, 0.1_r_std, 0.1_r_std, &
+ &    0.1_r_std, 0.1_r_std, 0.1_r_std, 0.1_r_std, &
+ &    0.1_r_std, 0.1_r_std, 0.1_r_std, 0.1_r_std /)
+
+
+  !! Parameters for the numerical scheme used by CWRR
+
+  INTEGER(i_std), PARAMETER :: imin = 1                                 !! CWRR linearisation (unitless)
+  INTEGER(i_std), PARAMETER :: nbint = 50                               !! Number of interval for CWRR (unitless)
+  INTEGER(i_std), PARAMETER :: imax = nbint+1                           !! Number of points for CWRR (unitless)
+  REAL(r_std), PARAMETER    :: w_time = 1.0_r_std                       !! Time weighting for discretisation (unitless)
+
+
+  !! Diagnostic variables
+
+  REAL(r_std),DIMENSION(nbdl),SAVE :: diaglev                           !! The lower limit of the layer on which soil moisture
+                                                                        !! (relative) and temperature are going to be diagnosed.
+                                                                        !! These variables are made for transfering the information
+                                                                        !! to the biogeophyical processes modelled in STOMATE. 
+                                                                        !! (unitless)
+!$OMP THREADPRIVATE(diaglev)
+
+
+END MODULE Constantes_soil_var
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes_var.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes_var.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/constantes_var.f90	(revision 5166)
@@ -0,0 +1,1331 @@
+! =================================================================================================================================
+! MODULE       : constantes_var
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        constantes_var module contains most constantes like pi, Earth radius, etc...
+!!              and all externalized parameters except pft-dependent constants.
+!!
+!!\n DESCRIPTION: This module contains most constantes and the externalized parameters of ORCHIDEE which 
+!!                are not pft-dependent.\n
+!!                In this module, you can set the flag diag_qsat in order to detect the pixel where the
+!!                temperature is out of range (look qsatcalc and dev_qsatcalc in qsat_moisture.f90).\n
+!!                The Earth radius is approximated by the Equatorial radius.The Earth's equatorial radius a,
+!!                or semi-major axis, is the distance from its center to the equator and equals 6,378.1370 km.
+!!                The equatorial radius is often used to compare Earth with other planets.\n
+!!                The meridional mean is well approximated by the semicubic mean of the two axe yielding 
+!!                6367.4491 km or less accurately by the quadratic mean of the two axes about 6,367.454 km
+!!                or even just the mean of the two axes about 6,367.445 km.\n
+!!                This module is already USE in module constantes. Therefor no need to USE it seperatly except
+!!                if the subroutines in module constantes are not needed.\n
+!!                
+!! RECENT CHANGE(S):
+!!
+!! REFERENCE(S)	: 
+!! - Louis, Jean-Francois (1979), A parametric model of vertical eddy fluxes in the atmosphere. 
+!! Boundary Layer Meteorology, 187-202.
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_var
+
+  USE defprec
+
+  IMPLICIT NONE
+!-
+
+                         !-----------------------!
+                         !  ORCHIDEE CONSTANTS   !
+                         !-----------------------!
+
+  !
+  ! FLAGS 
+  !
+  TYPE control_type
+    LOGICAL :: river_routing      !! activate river routing (true/false)
+    LOGICAL :: hydrol_cwrr        !! activate 11 layers hydrolgy model (true/false)
+    LOGICAL :: do_floodplains
+    LOGICAL :: do_irrigation
+    LOGICAL :: ok_sechiba         !! activate physic of the model (true/false)
+    LOGICAL :: ok_co2             !! activate photosynthesis (true/false)
+    LOGICAL :: ok_stomate         !! activate carbon cycle (true/false)
+    LOGICAL :: ok_dgvm            !! activate dynamic vegetation (true/false)
+    LOGICAL :: stomate_watchout   !! activate the creation of restart files for STOMATE even if STOMATE is not activated (true/false)
+    LOGICAL :: ok_pheno           !! activate the calculation of lai using stomate rather than a prescription (true/false)
+    LOGICAL :: do_land_use
+    LOGICAL :: ok_inca            !! activate biogenic volatile organic coumpounds ? (true/false)
+    LOGICAL :: ok_leafage         !! activate leafage? (true/false)
+    LOGICAL :: ok_radcanopy       !! use canopy radiative transfer model (true/false)
+    LOGICAL :: ok_multilayer      !! use canopy radiative transfer model with multi-layers (true/false)
+    LOGICAL :: ok_pulse_NOx       !! calculate NOx emissions with pulse (true/false)
+    LOGICAL :: ok_bbgfertil_NOx   !! calculate NOx emissions with bbg fertilizing effect (true/false)
+    LOGICAL :: ok_cropsfertil_NOx !! calculate NOx emissions with fertilizers use (true/false)
+    LOGICAL :: ld_doc             !! activate the debug comments for the DOC module (true/false)
+  END TYPE control_type
+
+  !-
+  TYPE(control_type), SAVE :: control  !! Flags that (de)activate parts of the model
+!$OMP THREADPRIVATE(control)
+  LOGICAL, SAVE :: OFF_LINE_MODE = .FALSE.  !! ORCHIDEE detects if it is coupled with a GCM or 
+                                            !! just use with one driver in OFF-LINE. (true/false)
+!$OMP THREADPRIVATE(OFF_LINE_MODE)
+  CHARACTER(LEN=80), SAVE     :: restname_in       = 'NONE'                 !! Input Restart files name for Sechiba component  
+!$OMP THREADPRIVATE(restname_in)
+  CHARACTER(LEN=80), SAVE     :: restname_out      = 'sechiba_rest_out.nc'  !! Output Restart files name for Sechiba component
+!$OMP THREADPRIVATE(restname_out)
+  CHARACTER(LEN=80), SAVE     :: stom_restname_in  = 'NONE'                 !! Input Restart files name for Stomate component
+!$OMP THREADPRIVATE(stom_restname_in)
+  CHARACTER(LEN=80), SAVE     :: stom_restname_out = 'stomate_rest_out.nc'  !! Output Restart files name for Stomate component
+!$OMP THREADPRIVATE(stom_restname_out)
+
+  !
+  ! TIME
+  !
+  REAL(r_std), SAVE :: one_day  !! One day in seconds (s)
+!$OMP THREADPRIVATE(one_day)
+  REAL(r_std), SAVE :: one_year !! One year in seconds (s)
+!$OMP THREADPRIVATE(one_year)
+  REAL(r_std), PARAMETER :: one_hour = 3600.0  !! One hour in seconds (s)
+!$OMP THREADPRIVATE(one_hour)
+
+  !
+  ! SPECIAL VALUES 
+  !
+  INTEGER(i_std), PARAMETER :: undef_int = 999999999     !! undef integer for integer arrays (unitless)
+  !-
+  REAL(r_std), SAVE :: val_exp = 999999.                 !! Specific value if no restart value  (unitless)
+!$OMP THREADPRIVATE(val_exp)
+  REAL(r_std), PARAMETER :: undef = -9999.               !! Special value for stomate (unitless)
+  !-
+  REAL(r_std), PARAMETER :: min_sechiba = 1.E-8_r_std    !! Epsilon to detect a near zero floating point (unitless)
+  REAL(r_std), PARAMETER :: undef_sechiba = 1.E+20_r_std !! The undef value used in SECHIBA (unitless)
+  !-
+  REAL(r_std), PARAMETER :: min_stomate = 1.E-8_r_std    !! Epsilon to detect a near zero floating point (unitless)
+  REAL(r_std), PARAMETER :: large_value = 1.E33_r_std    !! some large value (for stomate) (unitless)
+
+
+  !
+  !  DIMENSIONING AND INDICES PARAMETERS  
+  !
+  INTEGER(i_std), PARAMETER :: ibare_sechiba = 1 !! Index for bare soil in Sechiba (unitless)
+  INTEGER(i_std), PARAMETER :: ivis = 1          !! index for albedo in visible range (unitless)
+  INTEGER(i_std), PARAMETER :: inir = 2          !! index for albeod i near-infrared range (unitless) 
+  INTEGER(i_std), PARAMETER :: nnobio = 1        !! Number of other surface types: land ice (lakes,cities, ...) (unitless)
+  INTEGER(i_std), PARAMETER :: iice = 1          !! Index for land ice (see nnobio) (unitless)
+  !-
+  !! Soil
+  INTEGER(i_std), PARAMETER :: classnb = 9       !! Levels of soil colour classification (unitless)
+  !-
+  INTEGER(i_std), PARAMETER :: nleafages = 4     !! leaf age discretisation ( 1 = no discretisation )(unitless)
+  !-
+  !! litter fractions: indices (unitless)
+  INTEGER(i_std), PARAMETER :: ileaf = 1         !! Index for leaf compartment (unitless)
+  INTEGER(i_std), PARAMETER :: isapabove = 2     !! Index for sapwood above compartment (unitless)
+  INTEGER(i_std), PARAMETER :: isapbelow = 3     !! Index for sapwood below compartment (unitless)
+  INTEGER(i_std), PARAMETER :: iheartabove = 4   !! Index for heartwood above compartment (unitless)
+  INTEGER(i_std), PARAMETER :: iheartbelow = 5   !! Index for heartwood below compartment (unitless)
+  INTEGER(i_std), PARAMETER :: iroot = 6         !! Index for roots compartment (unitless)
+  INTEGER(i_std), PARAMETER :: ifruit = 7        !! Index for fruits compartment (unitless)
+  INTEGER(i_std), PARAMETER :: icarbres = 8      !! Index for reserve compartment (unitless)
+  INTEGER(i_std), PARAMETER :: nparts = 8        !! Number of biomass compartments (unitless)
+  !-
+  !! indices for assimilation parameters 
+  INTEGER(i_std), PARAMETER :: itmin = 1         !! Index for minimum photosynthesis temperature (assimilation parameters) (unitless)
+  INTEGER(i_std), PARAMETER :: itopt = 2         !! Index for optimal photosynthesis temperature (assimilation parameters) (unitless)
+  INTEGER(i_std), PARAMETER :: itmax = 3         !! Index for maxmimum photosynthesis temperature (assimilation parameters) (unitless)
+  INTEGER(i_std), PARAMETER :: ivcmax = 4        !! Index for vcmax (assimilation parameters) (unitless)
+  INTEGER(i_std), PARAMETER :: ivjmax = 5        !! Index for vjmax (assimilation parameters) (unitless)
+  INTEGER(i_std), PARAMETER :: npco2 = 5         !! Number of assimilation parameters (unitless)
+  !-
+  !! trees and litter: indices for the parts of heart-
+  !! and sapwood above and below the ground 
+  INTEGER(i_std), PARAMETER :: iabove = 1       !! Index for above part (unitless)
+  INTEGER(i_std), PARAMETER :: ibelow = 2       !! Index for below part (unitless)
+  INTEGER(i_std), PARAMETER :: nlevs = 2        !! Number of levels for trees and litter (unitless)
+  !-
+  !! litter: indices for metabolic and structural part
+  INTEGER(i_std), PARAMETER :: imetabolic = 1   !! Index for metabolic litter (unitless)
+  INTEGER(i_std), PARAMETER :: istructural = 2  !! Index for structural litter (unitless)
+  INTEGER(i_std), PARAMETER :: nlitt = 2        !! Number of levels for litter compartments (unitless)
+  !-
+  !! carbon pools: indices
+  INTEGER(i_std), PARAMETER :: iactive = 1      !! Index for active carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: islow = 2        !! Index for slow carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive = 3     !! Index for passive carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: ncarb = 3        !! Number of soil carbon pools (unitless)
+  !-
+  !! DOC pools: indices
+  INTEGER(i_std), PARAMETER :: ifree = 1        !! Index for free soil dissolved organic carbon (unitless)
+  INTEGER(i_std), PARAMETER :: iadsorbed = 2    !! Index for adsorbed soil dissolved organic carbon (unitless)
+  INTEGER(i_std), PARAMETER :: ndoc = 2         !! Number of soil dissolved organic carbon pools (unitless)
+  !-
+  !! DOC exportation pathways indices
+  INTEGER(i_std), PARAMETER :: irunoff = 1      !! Index for runoff (unitless)
+  INTEGER(i_std), PARAMETER :: iflooded = 2     !! Index for flooding (unitless)
+  INTEGER(i_std), PARAMETER :: idrainage = 3    !! Index for drainage (unitless)
+  INTEGER(i_std), PARAMETER :: nexp = 3         !! Number of DOC export pathways (unitless)
+  !-
+  !! carbon pools: indices
+  INTEGER(i_std), PARAMETER :: imetabo = 1      !! Index for aboveground metabolic litter pool(unitless)
+  INTEGER(i_std), PARAMETER :: istrabo = 2      !! Index for aboveground structural litter pool(unitless)
+  INTEGER(i_std), PARAMETER :: imetbel = 3      !! Index for belowground metabolic litter pool(unitless)
+  INTEGER(i_std), PARAMETER :: istrbel = 4      !! Index for belowground structural litter  pool(unitless)
+  INTEGER(i_std), PARAMETER :: iact = 5         !! Index for active carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: islo = 6         !! Index for slow carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: ipas = 7         !! Index for passive carbon pool (unitless)
+  INTEGER(i_std), PARAMETER :: npool = 7        !! Number of soil carbon pools (unitless)
+  !
+  !! carbon pools: indices
+  INTEGER(i_std), PARAMETER :: ico2 = 1         !! Index for CO2 (unitless)
+  INTEGER(i_std), PARAMETER :: io2 = 2          !! Index for O2 (unitless)
+  INTEGER(i_std), PARAMETER :: ich4 = 3         !! Index for CH4 (unitless)
+  INTEGER(i_std), PARAMETER :: ngaz = 3         !! Number of gaz in soil (unitless)
+  !-
+  !! For isotopes and nitrogen
+  INTEGER(i_std), PARAMETER :: nelements = 1    !! Number of isotopes considered
+  INTEGER(i_std), PARAMETER :: icarbon = 1      !! Index for carbon 
+  !
+  !! Indices for check mass balance
+  INTEGER(i_std), PARAMETER :: nmbcomp=5
+  INTEGER(i_std), PARAMETER :: iatm2land=1
+  INTEGER(i_std), PARAMETER :: iland2atm=2
+  INTEGER(i_std), PARAMETER :: ilat2out=3
+  INTEGER(i_std), PARAMETER :: ilat2in=4
+  INTEGER(i_std), PARAMETER :: ipoolchange=5
+  !
+  !! Indices used for analytical spin-up
+  INTEGER(i_std), PARAMETER :: nbpools = 211                     !! Total number of carbon pools (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_above = 1            !! Index for structural litter above (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z1 = 2         !! Index for structural litter below at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z2 = 3         !! Index for structural litter below at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z3 = 4         !! Index for structural litter below at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z4 = 5         !! Index for structural litter below at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z5 = 6         !! Index for structural litter below at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z6 = 7         !! Index for structural litter below at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z7 = 8         !! Index for structural litter below at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z8 = 9         !! Index for structural litter below at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z9 = 10        !! Index for structural litter below at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z10 = 11       !! Index for structural litter below at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: istructural_below_z11 = 12       !! Index for structural litter below at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_above = 13            !! Index for metabolic litter above (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z1 = 14         !! Index for metabolic litter below at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z2 = 15         !! Index for metabolic litter below at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z3 = 16         !! Index for metabolic litter below at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z4 = 17         !! Index for metabolic litter below at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z5 = 18         !! Index for metabolic litter below at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z6 = 19         !! Index for metabolic litter below at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z7 = 20         !! Index for metabolic litter below at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z8 = 21         !! Index for metabolic litter below at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z9 = 22         !! Index for metabolic litter below at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z10 = 23        !! Index for metabolic litter below at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: imetabolic_below_z11 = 24        !! Index for metabolic litter below at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z1 = 25             !! Index for active carbon pool at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z2 = 26             !! Index for active carbon pool at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z3 = 27             !! Index for active carbon pool at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z4 = 28             !! Index for active carbon pool at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z5 = 29             !! Index for active carbon pool at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z6 = 30             !! Index for active carbon pool at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z7 = 31             !! Index for active carbon pool at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z8 = 32             !! Index for active carbon pool at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z9 = 33             !! Index for active carbon pool at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z10 = 34            !! Index for active carbon pool at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iactive_pool_z11 = 35            !! Index for active carbon pool at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z1   = 36             !! Index for slow carbon pool at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z2   = 37             !! Index for slow carbon pool at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z3   = 38             !! Index for slow carbon pool at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z4   = 39             !! Index for slow carbon pool at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z5   = 40             !! Index for slow carbon pool at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z6   = 41             !! Index for slow carbon pool at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z7   = 42             !! Index for slow carbon pool at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z8   = 43             !! Index for slow carbon pool at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z9   = 44             !! Index for slow carbon pool at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z10   = 45            !! Index for slow carbon pool at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: islow_pool_z11   = 46            !! Index for slow carbon pool at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z1 = 47            !! Index for passive carbon pool at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z2 = 48            !! Index for passive carbon pool at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z3 = 49            !! Index for passive carbon pool at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z4 = 50            !! Index for passive carbon pool at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z5 = 51            !! Index for passive carbon pool at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z6 = 52            !! Index for passive carbon pool at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z7 = 53            !! Index for passive carbon pool at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z8 = 54            !! Index for passive carbon pool at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z9 = 55            !! Index for passive carbon pool at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z10 = 56           !! Index for passive carbon pool at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ipassive_pool_z11 = 57           !! Index for passive carbon pool at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_metabo = 58            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_metabo = 59            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_metabo = 60            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_metabo = 61            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_metabo = 62            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_metabo = 63            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_metabo = 64            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_metabo = 65            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_metabo = 66            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_metabo = 67           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_metabo = 68           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_metabo = 69             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_metabo = 70             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_metabo = 71             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_metabo = 72             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_metabo = 73             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_metabo = 74             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_metabo = 75             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_metabo = 76             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_metabo = 77             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_metabo = 78            !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_metabo = 79            !! Index for adsorbed DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_strabo = 80            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_strabo = 81            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_strabo = 82            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_strabo = 83            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_strabo = 84            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_strabo = 85            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_strabo = 86            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_strabo = 87            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_strabo = 88            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_strabo = 89           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_strabo = 90           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_strabo = 91             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_strabo = 92             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_strabo = 93             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_strabo = 94             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_strabo = 95             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_strabo = 96             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_strabo = 97             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_strabo = 98             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_strabo = 99             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_strabo = 100           !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_strabo = 101           !! Index for adsorbed DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_metbel = 102            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_metbel = 103            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_metbel = 104            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_metbel = 105            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_metbel = 106            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_metbel = 107            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_metbel = 108            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_metbel = 109            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_metbel = 110            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_metbel = 111           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_metbel = 112           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_metbel = 113             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_metbel = 114             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_metbel = 115             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_metbel = 116             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_metbel = 117             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_metbel = 118             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_metbel = 119             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_metbel = 120             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_metbel = 121             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_metbel = 122           !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_metbel = 123           !! Index for adsorbed DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_strbel = 124            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_strbel = 125            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_strbel = 126            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_strbel = 127            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_strbel = 128            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_strbel = 129            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_strbel = 130            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_strbel = 131            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_strbel = 132            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_strbel = 133           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_strbel = 134           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_strbel = 135             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_strbel = 136             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_strbel = 137             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_strbel = 138             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_strbel = 139             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_strbel = 140             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_strbel = 141             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_strbel = 142             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_strbel = 143             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_strbel = 144           !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_strbel = 145           !! Index for adsorbed DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_act = 146            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_act = 147            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_act = 148            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_act = 149            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_act = 150            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_act = 151            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_act = 152            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_act = 153            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_act = 154            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_act = 155           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_act = 156           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_act = 157             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_act = 158             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_act = 159             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_act = 160             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_act = 161             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_act = 162             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_act = 163             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_act = 164             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_act = 165             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_act = 166           !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_act = 167           !! Index for adsorbed DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_slo = 168            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_slo = 169            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_slo = 170            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_slo = 171            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_slo = 172            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_slo = 173            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_slo = 174            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_slo = 175            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_slo = 176            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_slo = 177           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_slo = 178           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_slo = 179             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_slo = 180             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_slo = 181             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_slo = 182             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_slo = 183             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_slo = 184             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_slo = 185             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_slo = 186             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_slo = 187             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_slo = 188           !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_slo = 189           !! Index for adsorbed DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z1_pas = 190            !! Index for free DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z2_pas = 191            !! Index for free DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z3_pas = 192            !! Index for free DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z4_pas = 193            !! Index for free DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z5_pas = 194            !! Index for free DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z6_pas = 195            !! Index for free DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z7_pas = 196            !! Index for free DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z8_pas = 197            !! Index for free DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z9_pas = 198            !! Index for free DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z10_pas = 199           !! Index for free DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: ifreedoc_pool_z11_pas = 200           !! Index for free DOC at 11th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z1_pas = 201             !! Index for adsorbed DOC at 1st layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z2_pas = 202             !! Index for adsorbed DOC at 2nd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z3_pas = 203             !! Index for adsorbed DOC at 3rd layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z4_pas = 204             !! Index for adsorbed DOC at 4th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z5_pas = 205             !! Index for adsorbed DOC at 5th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z6_pas = 206             !! Index for adsorbed DOC at 6th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z7_pas = 207             !! Index for adsorbed DOC at 7th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z8_pas = 208             !! Index for adsorbed DOC at 8th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z9_pas = 209             !! Index for adsorbed DOC at 9th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z10_pas = 210           !! Index for adsorbed DOC at 10th layer (unitless)
+  INTEGER(i_std), PARAMETER :: iadsdoc_pool_z11_pas = 211           !! Index for adsorbed DOC at 11th layer (unitless)
+
+  !! For the routing of C and CO2 outgassing
+  !! Indices used for matter transport with water flows
+  INTEGER(i_std), PARAMETER :: ih2o = 1        !! index for water (unitless)
+  INTEGER(i_std), PARAMETER :: idoc = 2        !! index for dissolved organic carbon (unitless)
+  INTEGER(i_std), PARAMETER :: ico2aq = 3      !! index for free dissolved carbon dioxide (unitless)
+  INTEGER(i_std), PARAMETER :: ico2ev = 4      !! index for evaded carbon dioxide (unitless)  
+  INTEGER(i_std), PARAMETER :: nflow = 4       !! number of compounds transported with water flows (unitless)
+  !! Indices used to distinguish different aquatic systems
+  INTEGER(i_std), PARAMETER :: ifastr = 1       !! index for fast reservoir (unitless)
+  INTEGER(i_std), PARAMETER :: islowr = 2       !! index for slow reservoir (unitless)  
+  INTEGER(i_std), PARAMETER :: istreamr = 3     !! index for stream reservoir (unitless)  
+  INTEGER(i_std), PARAMETER :: ifloodr = 4      !! index for flood reservoir (unitless) 
+  INTEGER(i_std), PARAMETER :: ipondr = 5       !! index for pond reservoir (unitless)  
+  INTEGER(i_std), PARAMETER :: naqsys = 5      !! number of aquatic systems considered (unitless) 
+
+  !
+  ! NUMERICAL AND PHYSICS CONSTANTS
+  !
+  !
+
+  !-
+  ! 1. Mathematical and numerical constants
+  !-
+  REAL(r_std), PARAMETER :: pi = 3.141592653589793238   !! pi souce : http://mathworld.wolfram.com/Pi.html (unitless)
+  REAL(r_std), PARAMETER :: euler = 2.71828182845904523 !! e source : http://mathworld.wolfram.com/e.html (unitless)
+  REAL(r_std), PARAMETER :: zero = 0._r_std             !! Numerical constant set to 0 (unitless)
+  REAL(r_std), PARAMETER :: undemi = 0.5_r_std          !! Numerical constant set to 1/2 (unitless)
+  REAL(r_std), PARAMETER :: un = 1._r_std               !! Numerical constant set to 1 (unitless)
+  REAL(r_std), PARAMETER :: moins_un = -1._r_std        !! Numerical constant set to -1 (unitless)
+  REAL(r_std), PARAMETER :: deux = 2._r_std             !! Numerical constant set to 2 (unitless)
+  REAL(r_std), PARAMETER :: trois = 3._r_std            !! Numerical constant set to 3 (unitless)
+  REAL(r_std), PARAMETER :: quatre = 4._r_std           !! Numerical constant set to 4 (unitless)
+  REAL(r_std), PARAMETER :: cinq = 5._r_std             !![DISPENSABLE] Numerical constant set to 5 (unitless)
+  REAL(r_std), PARAMETER :: six = 6._r_std              !![DISPENSABLE] Numerical constant set to 6 (unitless)
+  REAL(r_std), PARAMETER :: huit = 8._r_std             !! Numerical constant set to 8 (unitless)
+  REAL(r_std), PARAMETER :: dix = 10._r_std             !! Numerical constant set to 100 (unitless) 
+  REAL(r_std), PARAMETER :: cent = 100._r_std           !! Numerical constant set to 100 (unitless)
+  REAL(r_std), PARAMETER :: mille = 1000._r_std         !! Numerical constant set to 1000 (unitless)
+
+  !-
+  ! 2 . Physics
+  !-
+  REAL(r_std), PARAMETER :: R_Earth = 6378000.              !! radius of the Earth : Earth radius ~= Equatorial radius (m)
+  REAL(r_std), PARAMETER :: mincos  = 0.0001                !! Minimum cosine value used for interpolation (unitless) 
+  REAL(r_std), PARAMETER :: pb_std = 1013.                  !! standard pressure (hPa)
+  REAL(r_std), PARAMETER :: ZeroCelsius = 273.15            !! Freezing point (K)
+  REAL(r_std), PARAMETER :: tp_00 = 273.15                  !! 0 degre Celsius in degre Kelvin (K)
+  REAL(r_std), PARAMETER :: chalsu0 = 2.8345E06             !! Latent heat of sublimation (J.kg^{-1})
+  REAL(r_std), PARAMETER :: chalev0 = 2.5008E06             !! Latent heat of evaporation (J.kg^{-1}) 
+  REAL(r_std), PARAMETER :: chalfu0 = chalsu0-chalev0       !! Latent heat of fusion (J.kg^{-1}) 
+  REAL(r_std), PARAMETER :: c_stefan = 5.6697E-8            !! Stefan-Boltzman constant (W.m^{-2}.K^{-4})
+  REAL(r_std), PARAMETER :: cp_air = 1004.675               !! Specific heat of dry air (J.kg^{-1}.K^{-1}) 
+  REAL(r_std), PARAMETER :: cte_molr = 287.05               !! Specific constant of dry air (kg.mol^{-1}) 
+  REAL(r_std), PARAMETER :: kappa = cte_molr/cp_air         !! Kappa : ratio between specific constant and specific heat 
+                                                            !! of dry air (unitless)
+  REAL(r_std), PARAMETER :: msmlr_air = 28.964E-03          !! Molecular weight of dry air (kg.mol^{-1})
+  REAL(r_std), PARAMETER :: msmlr_h2o = 18.02E-03           !! Molecular weight of water vapor (kg.mol^{-1}) 
+  REAL(r_std), PARAMETER :: cp_h2o = &                      !! Specific heat of water vapor (J.kg^{-1}.K^{-1}) 
+       & cp_air*(quatre*msmlr_air)/( 3.5_r_std*msmlr_h2o) 
+  REAL(r_std), PARAMETER :: cte_molr_h2o = cte_molr/quatre  !! Specific constant of water vapor (J.kg^{-1}.K^{-1}) 
+  REAL(r_std), PARAMETER :: retv = msmlr_air/msmlr_h2o-un   !! Ratio between molecular weight of dry air and water 
+                                                            !! vapor minus 1(unitless)  
+  REAL(r_std), PARAMETER :: rvtmp2 = cp_h2o/cp_air-un       !! Ratio between specific heat of water vapor and dry air
+                                                            !! minus 1 (unitless)
+  REAL(r_std), PARAMETER :: cepdu2 = (0.1_r_std)**2         !! Squared wind shear (m^2.s^{-2}) 
+  REAL(r_std), PARAMETER :: ct_karman = 0.35_r_std          !! Van Karmann Constant (unitless)
+  REAL(r_std), PARAMETER :: cte_grav = 9.80665_r_std        !! Acceleration of the gravity (m.s^{-2})
+  REAL(r_std), PARAMETER :: pa_par_hpa = 100._r_std         !! Transform pascal into hectopascal (unitless)
+  REAL(r_std), PARAMETER :: R = 8.314                       !! Ideal gas constant (J.mol^{-1}.K^{-1})
+  REAL(r_std), PARAMETER :: Sct = 1370.                     !! Solar constant (W.m^{-2}) 
+
+
+  !-
+  ! 3. Climatic constants
+  !-
+  !! Constantes of the Louis scheme 
+  REAL(r_std), PARAMETER :: cb = 5._r_std         !! Constant of the Louis scheme (unitless);
+                                                  !! reference to Louis (1979)
+  REAL(r_std), PARAMETER :: cc = 5._r_std         !! Constant of the Louis scheme (unitless);
+                                                  !! reference to Louis (1979)
+  REAL(r_std), PARAMETER :: cd = 5._r_std         !! Constant of the Louis scheme (unitless);
+                                                  !! reference to Louis (1979)
+  !-
+  REAL(r_std), PARAMETER :: rayt_cste = 125.      !! Constant in the computation of surface resistance (W.m^{-2})
+  REAL(r_std), PARAMETER :: defc_plus = 23.E-3    !! Constant in the computation of surface resistance (K.W^{-1})
+  REAL(r_std), PARAMETER :: defc_mult = 1.5       !! Constant in the computation of surface resistance (K.W^{-1})
+
+  !-
+  ! 4. Soil thermodynamics constants
+  !-
+  ! Look at constantes_soil.f90
+
+
+  !
+  ! OPTIONAL PARTS OF THE MODEL
+  !
+  LOGICAL, SAVE     :: long_print = .false.       !! To set for more printing
+!$OMP THREADPRIVATE(long_print)
+  LOGICAL,PARAMETER :: diag_qsat = .TRUE.         !! One of the most frequent problems is a temperature out of range
+                                                  !! we provide here a way to catch that in the calling procedure. 
+                                                  !! (from Jan Polcher)(true/false) 
+  LOGICAL, SAVE     :: almaoutput                 !! Selects the type of output for the model.(true/false)
+                                                  !! Value is read from run.def in intersurf_history
+!$OMP THREADPRIVATE(almaoutput)
+
+  !
+  ! DIVERSE
+  !
+  CHARACTER(LEN=100), SAVE :: stomate_forcing_name='NONE'  !! NV080800 Name of STOMATE forcing file (unitless)
+                                                           ! Compatibility with Nicolas Viovy driver.
+!$OMP THREADPRIVATE(stomate_forcing_name)
+  CHARACTER(LEN=100), SAVE :: stomate_Cforcing_name='NONE' !! NV080800 Name of soil forcing file (unitless)
+                                                           ! Compatibility with Nicolas Viovy driver.
+!$OMP THREADPRIVATE(stomate_Cforcing_name)
+  INTEGER(i_std), SAVE :: forcing_id                 !! Index of the forcing file (unitless)
+!$OMP THREADPRIVATE(forcing_id)
+
+
+
+
+                         !------------------------!
+                         !  SECHIBA PARAMETERS    !
+                         !------------------------!
+ 
+
+  !
+  ! GLOBAL PARAMETERS   
+  !
+  REAL(r_std), SAVE :: min_wind = 0.1      !! The minimum wind (m.s^{-1})
+!$OMP THREADPRIVATE(min_wind)
+  REAL(r_std), SAVE :: snowcri = 1.5       !! Sets the amount above which only sublimation occures (kg.m^{-2})
+!$OMP THREADPRIVATE(snowcri)
+
+
+  !
+  ! FLAGS ACTIVATING SUB-MODELS
+  !
+  LOGICAL, SAVE :: treat_expansion = .FALSE.   !! Do we treat PFT expansion across a grid point after introduction? (true/false)
+!$OMP THREADPRIVATE(treat_expansion)
+  LOGICAL, SAVE :: ok_herbivores = .FALSE.     !! flag to activate herbivores (true/false)
+!$OMP THREADPRIVATE(ok_herbivores)
+  LOGICAL, SAVE :: harvest_agri = .TRUE.       !! flag to harvest aboveground biomass from agricultural PFTs)(true/false)
+!$OMP THREADPRIVATE(harvest_agri)
+  LOGICAL, SAVE :: lpj_gap_const_mort = .TRUE. !! constant moratlity (true/false)
+!$OMP THREADPRIVATE(lpj_gap_const_mort)
+  LOGICAL, SAVE :: disable_fire = .FALSE.      !! flag that disable fire (true/false)
+!$OMP THREADPRIVATE(disable_fire)
+  LOGICAL, SAVE :: spinup_analytic = .FALSE.   !! Flag to activate analytical resolution for spinup (true/false)
+!$OMP THREADPRIVATE(spinup_analytic)
+  LOGICAL, SAVE :: moist_func_Moyano = .FALSE. !! Flag to activate the calculation of moisture control function on soil C decomposition based on Moyano et al., 2012 BG (true/false)
+!$OMP THREADPRIVATE(moist_func_Moyano)
+  !
+  ! CONFIGURATION VEGETATION
+  !
+  LOGICAL, SAVE :: agriculture = .TRUE.    !! allow agricultural PFTs (true/false)
+!$OMP THREADPRIVATE(agriculture)
+  LOGICAL, SAVE :: impveg = .FALSE.        !! Impose vegetation ? (true/false)
+!$OMP THREADPRIVATE(impveg)
+  LOGICAL, SAVE :: impsoilt = .FALSE.      !! Impose soil ? (true/false)
+!$OMP THREADPRIVATE(impsoilt)
+  LOGICAL, SAVE :: lcchange = .FALSE.      !! Land cover change flag (true/false)
+!$OMP THREADPRIVATE(lcchange)
+  LOGICAL, SAVE :: read_lai = .FALSE.      !! Flag to read a map of LAI if STOMATE is not activated (true/false)
+!$OMP THREADPRIVATE(read_lai)
+  LOGICAL, SAVE :: old_lai = .FALSE.       !! Flag for the old LAI map interpolation (SHOULD BE DROPED ??)(true/false)
+!$OMP THREADPRIVATE(old_lai)
+  LOGICAL, SAVE :: old_veget = .FALSE.     !! Flag to use the old vegetation Map interpolation (SHOULD BE DROPED ?)(true/false)
+!$OMP THREADPRIVATE(old_veget)
+  LOGICAL, SAVE :: land_use = .TRUE.       !! flag to account or not for Land Use  (true/false)
+!$OMP THREADPRIVATE(land_use)
+  LOGICAL, SAVE :: veget_reinit = .TRUE.   !! To change LAND USE file in a run. (true/false)
+!$OMP THREADPRIVATE(veget_reinit)
+
+  !
+  ! PARAMETERS USED BY BOTH HYDROLOGY MODELS
+  !
+  REAL(r_std), SAVE :: max_snow_age = 50._r_std !! Maximum period of snow aging (days)
+!$OMP THREADPRIVATE(max_snow_age)
+  REAL(r_std), SAVE :: snow_trans = 0.3_r_std   !! Transformation time constant for snow (m)
+!$OMP THREADPRIVATE(snow_trans)
+  REAL(r_std), SAVE :: sneige                   !! Lower limit of snow amount (kg.m^{-2})
+!$OMP THREADPRIVATE(sneige)
+  REAL(r_std), SAVE :: maxmass_glacier = 3000.  !! The maximum mass of a glacier (kg.m^{-2})
+!$OMP THREADPRIVATE(maxmass_glacier)
+
+ 
+  !
+  ! BVOC : Biogenic activity  for each age class
+  !
+  REAL(r_std), SAVE, DIMENSION(nleafages) :: iso_activity = (/0.5, 1.5, 1.5, 0.5/)     !! Biogenic activity for each 
+                                                                                       !! age class : isoprene (unitless)
+!$OMP THREADPRIVATE(iso_activity)
+  REAL(r_std), SAVE, DIMENSION(nleafages) :: methanol_activity = (/1., 1., 0.5, 0.5/)  !! Biogenic activity for each
+                                                                                       !! age class : methanol (unnitless)
+!$OMP THREADPRIVATE(methanol_activity)
+
+  !
+  ! condveg.f90
+  !
+
+  ! 1. Scalar
+
+  ! 1.1 Flags used inside the module
+
+  LOGICAL, SAVE :: alb_bare_model = .FALSE. !! Switch for choosing values of bare soil 
+                                            !! albedo (see header of subroutine)
+                                            !! (true/false)
+!$OMP THREADPRIVATE(alb_bare_model)
+  LOGICAL, SAVE :: impaze = .FALSE.         !! Switch for choosing surface parameters
+                                            !! (see header of subroutine).  
+                                            !! (true/false)
+!$OMP THREADPRIVATE(impaze)
+  LOGICAL, SAVE :: z0cdrag_ave = .TRUE.     !! Chooses between two methods to calculate the 
+                                            !! grid average of the roughness (see header of subroutine)   
+                                            !! (true/false)
+!$OMP THREADPRIVATE(z0cdrag_ave)
+  ! 1.2 Others 
+
+  REAL(r_std), SAVE :: z0_over_height = un/16.           !! Factor to calculate roughness height from 
+                                                         !! vegetation height (unitless)   
+!$OMP THREADPRIVATE(z0_over_height)
+  REAL(r_std), SAVE :: height_displacement = 0.75        !! Factor to calculate the zero-plane displacement
+                                                         !! height from vegetation height (m)
+!$OMP THREADPRIVATE(height_displacement)
+  REAL(r_std), SAVE :: z0_bare = 0.01                    !! bare soil roughness length (m)
+!$OMP THREADPRIVATE(z0_bare)
+  REAL(r_std), SAVE :: z0_ice = 0.001                    !! ice roughness length (m)
+!$OMP THREADPRIVATE(z0_ice)
+  REAL(r_std), SAVE :: tcst_snowa = 5.0                  !! Time constant of the albedo decay of snow (days)
+!$OMP THREADPRIVATE(tcst_snowa)
+  REAL(r_std), SAVE :: snowcri_alb = 10.                 !! Critical value for computation of snow albedo (kg.m^{-2})
+!$OMP THREADPRIVATE(snowcri_alb)
+  REAL(r_std), SAVE :: fixed_snow_albedo = undef_sechiba !! To choose a fixed snow albedo value (unitless)
+!$OMP THREADPRIVATE(fixed_snow_albedo)
+  REAL(r_std), SAVE :: z0_scal = 0.15                    !! Surface roughness height imposed (m)
+!$OMP THREADPRIVATE(z0_scal)
+  REAL(r_std), SAVE :: roughheight_scal = zero           !! Effective roughness Height depending on zero-plane 
+                                                         !! displacement height (m) (imposed)
+!$OMP THREADPRIVATE(roughheight_scal)
+  REAL(r_std), SAVE :: emis_scal = 1.0                   !! Surface emissivity imposed (unitless)
+!$OMP THREADPRIVATE(emis_scal)
+  ! 2. Arrays
+
+  REAL(r_std), SAVE, DIMENSION(2) :: alb_deadleaf = (/ .12, .35/)    !! albedo of dead leaves, VIS+NIR (unitless)
+!$OMP THREADPRIVATE(alb_deadleaf)
+  REAL(r_std), SAVE, DIMENSION(2) :: alb_ice = (/ .60, .20/)         !! albedo of ice, VIS+NIR (unitless)
+!$OMP THREADPRIVATE(alb_ice)
+  REAL(r_std), SAVE, DIMENSION(2) :: albedo_scal = (/ 0.25, 0.25 /)  !! Albedo values for visible and near-infrared 
+                                                                     !! used imposed (unitless) 
+!$OMP THREADPRIVATE(albedo_scal)
+  REAL(r_std) , SAVE, DIMENSION(classnb) :: vis_dry = (/0.24,&
+       &0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.27/)  !! Soil albedo values to soil colour classification:
+                                                          !! dry soil albedo values in visible range
+!$OMP THREADPRIVATE(vis_dry)
+  REAL(r_std), SAVE, DIMENSION(classnb) :: nir_dry = (/0.48,&
+       &0.44, 0.40, 0.36, 0.32, 0.28, 0.24, 0.20, 0.55/)  !! Soil albedo values to soil colour classification:
+                                                          !! dry soil albedo values in near-infrared range 
+!$OMP THREADPRIVATE(nir_dry)
+  REAL(r_std), SAVE, DIMENSION(classnb) :: vis_wet = (/0.12,&
+       &0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.15/)  !! Soil albedo values to soil colour classification:
+                                                          !! wet soil albedo values in visible range 
+!$OMP THREADPRIVATE(vis_wet)
+  REAL(r_std), SAVE, DIMENSION(classnb) :: nir_wet = (/0.24,&
+       &0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.31/)  !! Soil albedo values to soil colour classification:
+                                                          !! wet soil albedo values in near-infrared range
+!$OMP THREADPRIVATE(nir_wet)
+  REAL(r_std), SAVE, DIMENSION(classnb) :: albsoil_vis = (/ &
+       &0.18, 0.16, 0.16, 0.15, 0.12, 0.105, 0.09, 0.075, 0.25/)   !! Soil albedo values to soil colour classification:
+                                                                   !! Averaged of wet and dry soil albedo values
+                                                                   !! in visible and near-infrared range
+!$OMP THREADPRIVATE(albsoil_vis) 
+  REAL(r_std), SAVE, DIMENSION(classnb) :: albsoil_nir = (/ &
+       &0.36, 0.34, 0.34, 0.33, 0.30, 0.25, 0.20, 0.15, 0.45/)  !! Soil albedo values to soil colour classification:
+                                                                !! Averaged of wet and dry soil albedo values
+                                                                !! in visible and near-infrared range
+!$OMP THREADPRIVATE(albsoil_nir)
+
+  !
+  ! diffuco.f90
+  !
+
+  ! 0. Constants
+
+  REAL(r_std), PARAMETER :: Tetens_1 = 0.622         !! Ratio between molecular weight of water vapor and molecular weight  
+                                                     !! of dry air (unitless)
+  REAL(r_std), PARAMETER :: Tetens_2 = 0.378         !!
+  REAL(r_std), PARAMETER :: std_ci_frac = 0.667      !!
+  REAL(r_std), PARAMETER :: alpha_j = 0.8855         !! Quantum yield of RuBP regeneration 
+  REAL(r_std), PARAMETER :: curve_assim = 0.7        !! Curvature of the quantum response (unitless)
+  REAL(r_std), PARAMETER :: WJ_coeff1 = 4.5          !! First coefficient for calculating the generation-limited rate RuBP (unitless)
+  REAL(r_std), PARAMETER :: WJ_coeff2 = 10.5         !! Second coefficient for calculating the generation-limited rate RuBP (unitless)
+  REAL(r_std), PARAMETER :: Vc_to_Rd_ratio = 0.011   !!
+  REAL(r_std), PARAMETER :: O2toCO2_stoechio = 1.6   !! Ratio of water vapor diffusivity to the CO2 diffusivity (unitless)
+  REAL(r_std), PARAMETER :: mmol_to_m_1 = 0.0244     !!
+  REAL(r_std), PARAMETER :: RG_to_PAR = 0.5          !!
+  REAL(r_std), PARAMETER :: W_to_mmol = 4.6          !! W_to_mmol * RG_to_PAR = 2.3
+
+  ! 1. Scalar
+
+  INTEGER(i_std), SAVE :: nlai = 20             !! Number of LAI levels (unitless)
+!$OMP THREADPRIVATE(nlai)
+  LOGICAL, SAVE :: ldq_cdrag_from_gcm = .FALSE. !! Set to .TRUE. if you want q_cdrag coming from GCM
+!$OMP THREADPRIVATE(ldq_cdrag_from_gcm)
+  REAL(r_std), SAVE :: laimax = 12.             !! Maximal LAI used for splitting LAI into N layers (m^2.m^{-2})
+!$OMP THREADPRIVATE(laimax)
+  REAL(r_std), SAVE :: xc4_1 = 0.83             !! Factor in the first Collatz equation for C4 plants (unitless)
+!$OMP THREADPRIVATE(xc4_1)
+  REAL(r_std), SAVE :: xc4_2 = 0.93             !! Factor in the second Collatz equation for C4 plants (unitless)
+!$OMP THREADPRIVATE(xc4_2)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: lai_level_depth = 0.15  !!
+!$OMP THREADPRIVATE(lai_level_depth)
+  REAL(r_std), SAVE :: x1_coef =  0.177        !! Multiplicative factor for calculating the pseudo first order rate constant 
+                                               !! of assimilation response to co2 kt (unitless)
+!$OMP THREADPRIVATE(x1_coef)
+  REAL(r_std), SAVE :: x1_Q10 =  0.069         !! Exponential factor in the equation defining kt (unitless)
+!$OMP THREADPRIVATE(x1_Q10)
+  REAL(r_std), SAVE :: quantum_yield =  0.092  !!
+!$OMP THREADPRIVATE(quantum_yield)
+  REAL(r_std), SAVE :: kt_coef = 0.7           !! Multiplicative factor in the equation defining kt (unitless)
+!$OMP THREADPRIVATE(kt_coef)
+  REAL(r_std), SAVE :: kc_coef = 39.09         !! Multiplicative factor for calculating the Michaelis-Menten 
+                                               !! coefficient Kc (unitless)
+!$OMP THREADPRIVATE(kc_coef)
+  REAL(r_std), SAVE :: Ko_Q10 = 0.085          !! Exponential factor for calculating the Michaelis-Menten coefficients 
+                                               !! Kc and Ko (unitless)
+!$OMP THREADPRIVATE(Ko_Q10)
+  REAL(r_std), SAVE :: Oa = 210000.            !! Intercellular concentration of O2 (ppm)
+!$OMP THREADPRIVATE(Oa)
+  REAL(r_std), SAVE :: Ko_coef =  2.412        !! Multiplicative factor for calculating the Michaelis-Menten coefficient Ko (unitless)
+!$OMP THREADPRIVATE(Ko_coef)
+  REAL(r_std), SAVE :: CP_0 = 42.              !! Multiplicative factor for calculating the CO2 compensation point CP (unitless)
+!$OMP THREADPRIVATE(CP_0)
+  REAL(r_std), SAVE :: CP_temp_coef = 9.46     !! Exponential factor for calculating the CO2 compensation point CP (unitless)
+!$OMP THREADPRIVATE(CP_temp_coef)
+  REAL(r_std), SAVE :: CP_temp_ref = 25.       !! Reference temperature for the CO2 compensation point CP (C)
+!$OMP THREADPRIVATE(CP_temp_ref)
+  !
+  REAL(r_std), SAVE, DIMENSION(2) :: rt_coef = (/ 0.8, 1.3 /)    !! 
+!$OMP THREADPRIVATE(rt_coef)
+  REAL(r_std), SAVE, DIMENSION(2) :: vc_coef = (/ 0.39, 0.3 /)   !!
+!$OMP THREADPRIVATE(vc_coef)
+  !
+  REAL(r_std), SAVE, DIMENSION(6) :: dew_veg_poly_coeff = &            !! coefficients of the 5 degree polynomomial used
+  & (/ 0.887773, 0.205673, 0.110112, 0.014843,  0.000824,  0.000017 /) !! in the equation of coeff_dew_veg
+!$OMP THREADPRIVATE(dew_veg_poly_coeff)
+
+  !
+  ! slowproc.f90 
+  !
+
+  ! 1. Scalar
+
+  INTEGER(i_std), SAVE :: veget_year_orig = 0        !!  first year for landuse (number)
+!$OMP THREADPRIVATE(veget_year_orig)
+  REAL(r_std), SAVE :: clayfraction_default = 0.2    !! Default value for clay fraction (0-1, unitless)
+!$OMP THREADPRIVATE(clayfraction_default)
+  REAL(r_std), SAVE :: siltfraction_default = 0.4    !! Default value for silt fraction (0-1, unitless)
+!$OMP THREADPRIVATE(siltfraction_default)
+  REAL(r_std), SAVE :: sandfraction_default = 0.4    !! Default value for sand fraction (0-1, unitless)
+!$OMP THREADPRIVATE(sandfraction_default)
+  REAL(r_std), SAVE :: min_vegfrac = 0.001           !! Minimal fraction of mesh a vegetation type can occupy (0-1, unitless)
+!$OMP THREADPRIVATE(min_vegfrac)
+  REAL(r_std), SAVE :: frac_nobio_fixed_test_1 = 0.0 !! Value for frac_nobio for tests in 0-dim simulations (0-1, unitless)
+!$OMP THREADPRIVATE(frac_nobio_fixed_test_1)
+  
+  REAL(r_std), SAVE :: stempdiag_bid = 280.          !! only needed for an initial LAI if there is no restart file
+!$OMP THREADPRIVATE(stempdiag_bid)
+
+  ! routing.f90
+  ! 
+
+  ! 1. Constants
+  REAL(r_std), PARAMETER :: msmlr_C = 12.011E-03     !! Molecular weight of C (kg.mol^{-1})
+
+                           !-----------------------------!
+                           !  STOMATE AND LPJ PARAMETERS !
+                           !-----------------------------!
+
+
+  !
+  ! lpj_constraints.f90
+  !
+  
+  ! 1. Scalar
+
+  REAL(r_std), SAVE  :: too_long = 5.      !! longest sustainable time without 
+                                           !! regeneration (vernalization) (years)
+!$OMP THREADPRIVATE(too_long)
+
+
+  !
+  ! lpj_establish.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: estab_max_tree = 0.12   !! Maximum tree establishment rate (0-1, unitless)
+!$OMP THREADPRIVATE(estab_max_tree)
+  REAL(r_std), SAVE :: estab_max_grass = 0.12  !! Maximum grass establishment rate (0-1, unitless)
+!$OMP THREADPRIVATE(estab_max_grass)
+  
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: establish_scal_fact = 5.  !!
+!$OMP THREADPRIVATE(establish_scal_fact)
+  REAL(r_std), SAVE :: max_tree_coverage = 0.98  !! (0-1, unitless)
+!$OMP THREADPRIVATE(max_tree_coverage)
+  REAL(r_std), SAVE :: ind_0_estab = 0.2         !! = ind_0 * 10.
+!$OMP THREADPRIVATE(ind_0_estab)
+
+
+  !
+  ! lpj_fire.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: tau_fire = 30.           !! Time scale for memory of the fire index (days).
+!$OMP THREADPRIVATE(tau_fire)
+  REAL(r_std), SAVE :: litter_crit = 200.       !! Critical litter quantity for fire
+                                                !! below which iginitions extinguish 
+                                                !! @tex $(gC m^{-2})$ @endtex
+!$OMP THREADPRIVATE(litter_crit)
+  REAL(r_std), SAVE :: fire_resist_struct = 0.5 !!
+!$OMP THREADPRIVATE(fire_resist_struct)
+  ! 2. Arrays
+
+  REAL(r_std), SAVE, DIMENSION(nparts) :: co2frac = &    !! The fraction of the different biomass 
+       & (/ .95, .95, 0., 0.3, 0., 0., .95, .95 /)       !! compartments emitted to the atmosphere 
+!$OMP THREADPRIVATE(co2frac)                                                         !! when burned (unitless, 0-1)  
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE, DIMENSION(3) :: bcfrac_coeff = (/ .3,  1.3,  88.2 /)         !! (unitless)
+!$OMP THREADPRIVATE(bcfrac_coeff)
+  REAL(r_std), SAVE, DIMENSION(4) :: firefrac_coeff = (/ 0.45, 0.8, 0.6, 0.13 /)  !! (unitless)
+!$OMP THREADPRIVATE(firefrac_coeff)
+
+  !
+  ! lpj_gap.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: ref_greff = 0.035         !! Asymptotic maximum mortality rate
+                                                 !! @tex $(year^{-1})$ @endtex
+!$OMP THREADPRIVATE(ref_greff)
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: availability_fact = 0.1   !!
+!$OMP THREADPRIVATE(availability_fact)
+
+  !               
+  ! lpj_light.f90 
+  !              
+
+  ! 1. Scalar
+  
+  LOGICAL, SAVE :: annual_increase = .TRUE. !! for diagnosis of fpc increase, compare today's fpc to last year's maximum (T) or
+                                            !! to fpc of last time step (F)? (true/false)
+!$OMP THREADPRIVATE(annual_increase)
+  REAL(r_std), SAVE :: min_cover = 0.05     !! For trees, minimum fraction of crown area occupied
+                                            !! (due to its branches etc.) (0-1, unitless)
+                                            !! This means that only a small fraction of its crown area
+                                            !! can be invaded by other trees.
+!$OMP THREADPRIVATE(min_cover)
+  !
+  ! lpj_pftinout.f90 
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: min_avail = 0.01         !! minimum availability
+!$OMP THREADPRIVATE(min_avail)
+  REAL(r_std), SAVE :: ind_0 = 0.02             !! initial density of individuals
+!$OMP THREADPRIVATE(ind_0)
+  ! 3. Coefficients of equations
+  
+  REAL(r_std), SAVE :: RIP_time_min = 1.25      !! test whether the PFT has been eliminated lately (years)
+!$OMP THREADPRIVATE(RIP_time_min)
+  REAL(r_std), SAVE :: npp_longterm_init = 10.  !! Initialisation value for npp_longterm (gC.m^{-2}.year^{-1})
+!$OMP THREADPRIVATE(npp_longterm_init)
+  REAL(r_std), SAVE :: everywhere_init = 0.05   !!
+!$OMP THREADPRIVATE(everywhere_init)
+
+
+  !
+  ! stomate_alloc.f90
+  !
+
+  ! 0. Constants
+
+  REAL(r_std), PARAMETER :: max_possible_lai = 10. !! (m^2.m^{-2})
+  REAL(r_std), PARAMETER :: Nlim_Q10 = 10.         !!
+
+  ! 1. Scalar
+
+  LOGICAL, SAVE :: ok_minres = .TRUE.              !! [DISPENSABLE] Do we try to reach a minimum reservoir even if
+                                                   !! we are severely stressed? (true/false)
+!$OMP THREADPRIVATE(ok_minres)
+  REAL(r_std), SAVE :: tau_leafinit = 10.          !! Time required to develop a minimal LAI
+                                                   !! using the carbohydrate reserve (days)
+!$OMP THREADPRIVATE(tau_leafinit)
+  REAL(r_std), SAVE :: reserve_time_tree = 30.     !! Maximum number of days during which
+                                                   !! carbohydrate reserve may be used for 
+                                                   !! trees (days)
+!$OMP THREADPRIVATE(reserve_time_tree)
+  REAL(r_std), SAVE :: reserve_time_grass = 20.    !! Maximum number of days during which
+                                                   !! carbohydrate reserve may be used for 
+                                                   !! grasses (days)
+!$OMP THREADPRIVATE(reserve_time_grass)
+
+  REAL(r_std), SAVE :: R0 = 0.3                    !! Default root allocation (0-1, unitless)
+!$OMP THREADPRIVATE(R0)
+  REAL(r_std), SAVE :: S0 = 0.3                    !! Default sapwood allocation (0-1, unitless)
+!$OMP THREADPRIVATE(S0)
+  REAL(r_std), SAVE :: L0                          !! Default leaf allocation (0-1, unitless)
+!$OMP THREADPRIVATE(L0)
+  REAL(r_std), SAVE :: f_fruit = 0.1               !! Default fruit allocation (0-1, unitless)
+!$OMP THREADPRIVATE(f_fruit)
+  REAL(r_std), SAVE :: alloc_sap_above_grass = 1.0 !! fraction of sapwood allocation above ground
+                                                   !! for grass (0-1, unitless)
+!$OMP THREADPRIVATE(alloc_sap_above_grass)
+  REAL(r_std), SAVE :: min_LtoLSR = 0.2            !! Prescribed lower bounds for leaf 
+                                                   !! allocation (0-1, unitless)
+!$OMP THREADPRIVATE(min_LtoLSR)
+  REAL(r_std), SAVE :: max_LtoLSR = 0.5            !! Prescribed upper bounds for leaf 
+                                                   !! allocation (0-1, unitless)
+!$OMP THREADPRIVATE(max_LtoLSR)
+  REAL(r_std), SAVE :: z_nitrogen = 0.2            !! Curvature of the root profile (m)
+!$OMP THREADPRIVATE(z_nitrogen)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: lai_max_to_happy = 0.5      !!
+!$OMP THREADPRIVATE(lai_max_to_happy)
+  REAL(r_std), SAVE :: Nlim_tref = 25.             !! (C)
+!$OMP THREADPRIVATE(Nlim_tref)
+
+
+  !
+  ! stomate_data.f90 
+  !
+
+  ! 1. Scalar 
+
+  ! 1.1 Parameters for the pipe model
+
+  REAL(r_std), SAVE :: pipe_tune1 = 100.0        !! crown area = pipe_tune1. stem diameter**(1.6) (Reinicke's theory) (unitless)
+!$OMP THREADPRIVATE(pipe_tune1)
+  REAL(r_std), SAVE :: pipe_tune2 = 40.0         !! height=pipe_tune2 * diameter**pipe_tune3 (unitless)
+!$OMP THREADPRIVATE(pipe_tune2)
+  REAL(r_std), SAVE :: pipe_tune3 = 0.5          !! height=pipe_tune2 * diameter**pipe_tune3 (unitless)
+!$OMP THREADPRIVATE(pipe_tune3)
+  REAL(r_std), SAVE :: pipe_tune4 = 0.3          !! needed for stem diameter (unitless)
+!$OMP THREADPRIVATE(pipe_tune4)
+  REAL(r_std), SAVE :: pipe_density = 2.e5       !! Density
+!$OMP THREADPRIVATE(pipe_density)
+  REAL(r_std), SAVE :: pipe_k1 = 8.e3            !! one more SAVE
+!$OMP THREADPRIVATE(pipe_k1)
+  REAL(r_std), SAVE :: pipe_tune_exp_coeff = 1.6 !! pipe tune exponential coeff (unitless)
+!$OMP THREADPRIVATE(pipe_tune_exp_coeff)
+
+  ! 1.2 climatic parameters 
+
+  REAL(r_std), SAVE :: precip_crit = 100.        !! minimum precip, in (mm/year)
+!$OMP THREADPRIVATE(precip_crit)
+  REAL(r_std), SAVE :: gdd_crit_estab = 150.     !! minimum gdd for establishment of saplings
+!$OMP THREADPRIVATE(gdd_crit_estab)
+  REAL(r_std), SAVE :: fpc_crit = 0.95           !! critical fpc, needed for light competition and establishment (0-1, unitless)
+!$OMP THREADPRIVATE(fpc_crit)
+
+  ! 1.3 sapling characteristics
+
+  REAL(r_std), SAVE :: alpha_grass = 0.5         !! alpha coefficient for grasses (unitless)
+!$OMP THREADPRIVATE(alpha_grass)
+  REAL(r_std), SAVE :: alpha_tree = 1.           !! alpha coefficient for trees (unitless)
+!$OMP THREADPRIVATE(alpha_tree)
+  REAL(r_std), SAVE :: mass_ratio_heart_sap = 3. !! mass ratio (heartwood+sapwood)/sapwood (unitless)
+!$OMP THREADPRIVATE(mass_ratio_heart_sap)
+  REAL(r_std), SAVE :: frac_growthresp = 0.28    !! fraction of GPP which is lost as growth respiration (0-1, unitless)
+!$OMP THREADPRIVATE(frac_growthresp)
+
+  ! 1.4  time scales for phenology and other processes (in days)
+
+  REAL(r_std), SAVE :: tau_hum_month = 20.        !! (days)       
+!$OMP THREADPRIVATE(tau_hum_month)
+  REAL(r_std), SAVE :: tau_hum_week = 7.          !! (days)  
+!$OMP THREADPRIVATE(tau_hum_week)
+  REAL(r_std), SAVE :: tau_t2m_month = 20.        !! (days)      
+!$OMP THREADPRIVATE(tau_t2m_month)
+  REAL(r_std), SAVE :: tau_t2m_week = 7.          !! (days)  
+!$OMP THREADPRIVATE(tau_t2m_week)
+  REAL(r_std), SAVE :: tau_tsoil_month = 20.      !! (days)     
+!$OMP THREADPRIVATE(tau_tsoil_month)
+  REAL(r_std), SAVE :: tau_soilhum_month = 20.    !! (days)     
+!$OMP THREADPRIVATE(tau_soilhum_month)
+  REAL(r_std), SAVE :: tau_gpp_week = 7.          !! (days)  
+!$OMP THREADPRIVATE(tau_gpp_week)
+  REAL(r_std), SAVE :: tau_gdd = 40.              !! (days)  
+!$OMP THREADPRIVATE(tau_gdd)
+  REAL(r_std), SAVE :: tau_ngd = 50.              !! (days)  
+!$OMP THREADPRIVATE(tau_ngd)
+  REAL(r_std), SAVE :: coeff_tau_longterm = 3.    !! (unitless)
+!$OMP THREADPRIVATE(coeff_tau_longterm)
+  REAL(r_std), SAVE :: tau_longterm               !! (days)  
+!$OMP THREADPRIVATE(tau_longterm)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: bm_sapl_carbres = 5.             !!
+!$OMP THREADPRIVATE(bm_sapl_carbres)
+  REAL(r_std), SAVE :: bm_sapl_sapabove = 0.5           !!
+!$OMP THREADPRIVATE(bm_sapl_sapabove)
+  REAL(r_std), SAVE :: bm_sapl_heartabove = 2.          !!
+!$OMP THREADPRIVATE(bm_sapl_heartabove)
+  REAL(r_std), SAVE :: bm_sapl_heartbelow = 2.          !!
+!$OMP THREADPRIVATE(bm_sapl_heartbelow)
+  REAL(r_std), SAVE :: init_sapl_mass_leaf_nat = 0.1    !!
+!$OMP THREADPRIVATE(init_sapl_mass_leaf_nat)
+  REAL(r_std), SAVE :: init_sapl_mass_leaf_agri = 1.    !!
+!$OMP THREADPRIVATE(init_sapl_mass_leaf_agri)
+  REAL(r_std), SAVE :: init_sapl_mass_carbres = 5.      !!
+!$OMP THREADPRIVATE(init_sapl_mass_carbres)
+  REAL(r_std), SAVE :: init_sapl_mass_root = 0.1        !!
+!$OMP THREADPRIVATE(init_sapl_mass_root)
+  REAL(r_std), SAVE :: init_sapl_mass_fruit = 0.3       !!  
+!$OMP THREADPRIVATE(init_sapl_mass_fruit)
+  REAL(r_std), SAVE :: cn_sapl_init = 0.5               !!
+!$OMP THREADPRIVATE(cn_sapl_init)
+  REAL(r_std), SAVE :: migrate_tree = 10.*1.E3          !!
+!$OMP THREADPRIVATE(migrate_tree)
+  REAL(r_std), SAVE :: migrate_grass = 10.*1.E3         !!
+!$OMP THREADPRIVATE(migrate_grass)
+  REAL(r_std), SAVE :: lai_initmin_tree = 0.3           !!
+!$OMP THREADPRIVATE(lai_initmin_tree)
+  REAL(r_std), SAVE :: lai_initmin_grass = 0.1          !!
+!$OMP THREADPRIVATE(lai_initmin_grass)
+  REAL(r_std), SAVE, DIMENSION(2) :: dia_coeff = (/ 4., 0.5 /)            !!
+!$OMP THREADPRIVATE(dia_coeff)
+  REAL(r_std), SAVE, DIMENSION(2) :: maxdia_coeff =(/ 100., 0.01/)        !!
+!$OMP THREADPRIVATE(maxdia_coeff)
+  REAL(r_std), SAVE, DIMENSION(4) :: bm_sapl_leaf = (/ 4., 4., 0.8, 5./)  !!
+!$OMP THREADPRIVATE(bm_sapl_leaf)
+
+
+
+  !
+  ! stomate_litter.f90 
+  !
+
+  ! 0. Constants
+
+  REAL(r_std), PARAMETER :: Q10 = 10.               !!
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: z_decomp = 0.2               !!  Maximum depth for soil decomposer's activity (m)
+!$OMP THREADPRIVATE(z_decomp)
+
+  ! 2. Arrays
+
+  REAL(r_std), SAVE :: frac_soil_struct_aa = 0.45   !! corresponding to frac_soil(istructural,iactive,iabove) 
+!$OMP THREADPRIVATE(frac_soil_struct_aa)
+  REAL(r_std), SAVE :: frac_soil_struct_ab = 0.45   !! corresponding to frac_soil(istructural,iactive,ibelow)
+!$OMP THREADPRIVATE(frac_soil_struct_ab)
+  REAL(r_std), SAVE :: frac_soil_struct_sa = 0.7    !! corresponding to frac_soil(istructural,islow,iabove)
+!$OMP THREADPRIVATE(frac_soil_struct_sa)
+  REAL(r_std), SAVE :: frac_soil_struct_sb = 0.7    !! corresponding to frac_soil(istructural,islow,ibelow)
+!$OMP THREADPRIVATE(frac_soil_struct_sb)
+  REAL(r_std), SAVE :: frac_soil_metab_aa = 0.45    !! corresponding to frac_soil(imetabolic,iactive,iabove)
+!$OMP THREADPRIVATE(frac_soil_metab_aa)
+  REAL(r_std), SAVE :: frac_soil_metab_ab = 0.45    !! corresponding to frac_soil(imetabolic,iactive,ibelow)
+!$OMP THREADPRIVATE(frac_soil_metab_ab)
+  REAL(r_std), SAVE, DIMENSION(nparts) :: CN = &    !! C/N ratio of each plant pool (0-100, unitless)
+       & (/ 40., 40., 40., 40., 40., 40., 40., 40. /) 
+!$OMP THREADPRIVATE(CN)
+  REAL(r_std), SAVE, DIMENSION(nparts) :: LC = &    !! Lignin/C ratio of different plant parts (0,22-0,35, unitless)
+       & (/ 0.22, 0.35, 0.35, 0.35, 0.35, 0.22, 0.22, 0.22 /)
+!$OMP THREADPRIVATE(LC)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: metabolic_ref_frac = 0.85    !! used by litter and soilcarbon (0-1, unitless)
+!$OMP THREADPRIVATE(metabolic_ref_frac)
+  REAL(r_std), SAVE :: metabolic_LN_ratio = 0.018   !! (0-1, unitless)   
+!$OMP THREADPRIVATE(metabolic_LN_ratio)
+  REAL(r_std), SAVE :: tau_metabolic = 0.066        !!
+!$OMP THREADPRIVATE(tau_metabolic)
+  REAL(r_std), SAVE :: tau_struct = 0.245           !!
+!$OMP THREADPRIVATE(tau_struct)
+  REAL(r_std), SAVE :: soil_Q10 = 0.69              !!= ln 2
+!$OMP THREADPRIVATE(soil_Q10)
+  REAL(r_std), SAVE :: a_term_Q10_soil = 11.049     !! used for Q10 calculation in soils
+!$OMP THREADPRIVATE(a_term_Q10_soil)
+  REAL(r_std), SAVE :: b_term_Q10_soil = 35.003     !! used for Q10 calculation in soils
+!$OMP THREADPRIVATE(b_term_Q10_soil)
+  REAL(r_std), SAVE :: tsoil_ref = 30.              !!
+!$OMP THREADPRIVATE(tsoil_ref)
+  REAL(r_std), SAVE :: litter_struct_coef = 3.      !! 
+!$OMP THREADPRIVATE(litter_struct_coef)
+  REAL(r_std), SAVE, DIMENSION(3) :: moist_coeff = (/ 1.1,  2.4,  0.29 /) !!
+!$OMP THREADPRIVATE(moist_coeff)
+  REAL(r_std), SAVE :: Dif = 1.E-4   !! diffusion coeficient for POC (m2 year-1) coming from Koven et al., 2013 BG.
+!$OMP THREADPRIVATE(Dif)
+ REAL(r_std), SAVE :: z_litter = 10.   !! Thickness of the above ground litter layer
+!$OMP THREADPRIVATE(z_litter)
+
+
+
+  !
+  ! stomate_lpj.f90
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: frac_turnover_daily = 0.55  !! (0-1, unitless)
+!$OMP THREADPRIVATE(frac_turnover_daily)
+
+
+  !
+  ! stomate_npp.f90 
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: tax_max = 0.8 !! Maximum fraction of allocatable biomass used 
+                                     !! for maintenance respiration (0-1, unitless)
+!$OMP THREADPRIVATE(tax_max)
+
+
+  !
+  ! stomate_phenology.f90
+  !
+
+  ! 1. Scalar
+
+  LOGICAL, SAVE :: always_init = .FALSE.           !! take carbon from atmosphere if carbohydrate reserve too small? (true/false)
+!$OMP THREADPRIVATE(always_init)
+  REAL(r_std), SAVE :: min_growthinit_time = 300.  !! minimum time since last beginning of a growing season (days)
+!$OMP THREADPRIVATE(min_growthinit_time)
+  REAL(r_std), SAVE :: moiavail_always_tree = 1.0  !! moisture monthly availability above which moisture tendency doesn't matter
+                                                   !!  - for trees (0-1, unitless)
+!$OMP THREADPRIVATE(moiavail_always_tree)
+  REAL(r_std), SAVE :: moiavail_always_grass = 0.6 !! moisture monthly availability above which moisture tendency doesn't matter
+                                                   !! - for grass (0-1, unitless)
+!$OMP THREADPRIVATE(moiavail_always_grass)
+  REAL(r_std), SAVE :: t_always                    !! monthly temp. above which temp. tendency doesn't matter
+!$OMP THREADPRIVATE(t_always)
+  REAL(r_std), SAVE :: t_always_add = 10.          !! monthly temp. above which temp. tendency doesn't matter (C)
+!$OMP THREADPRIVATE(t_always_add)
+
+  ! 3. Coefficients of equations
+  
+  REAL(r_std), SAVE :: gddncd_ref = 603.           !!
+!$OMP THREADPRIVATE(gddncd_ref)
+  REAL(r_std), SAVE :: gddncd_curve = 0.0091       !!
+!$OMP THREADPRIVATE(gddncd_curve)
+  REAL(r_std), SAVE :: gddncd_offset = 64.         !!
+!$OMP THREADPRIVATE(gddncd_offset)
+
+
+  !
+  ! stomate_prescribe.f90
+  !
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: bm_sapl_rescale = 40.       !!
+!$OMP THREADPRIVATE(bm_sapl_rescale)
+
+
+  !
+  ! stomate_resp.f90
+  !
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: maint_resp_min_vmax = 0.3   !!
+!$OMP THREADPRIVATE(maint_resp_min_vmax)
+  REAL(r_std), SAVE :: maint_resp_coeff = 1.4      !!
+!$OMP THREADPRIVATE(maint_resp_coeff)
+
+
+  !
+  ! stomate_soilcarbon.f90 
+  !
+
+  ! 2. Arrays 
+
+  ! 2.1 frac_carb_coefficients
+
+  REAL(r_std), SAVE :: frac_carb_ap = 0.004  !! from active pool: depends on clay content  (0-1, unitless)
+                                             !! corresponding to frac_carb(:,iactive,ipassive)
+!$OMP THREADPRIVATE(frac_carb_ap)
+  REAL(r_std), SAVE :: frac_carb_sa = 0.93   !! from slow pool (0-1, unitless)
+                                             !! corresponding to frac_carb(:,islow,iactive)
+!$OMP THREADPRIVATE(frac_carb_sa)
+  REAL(r_std), SAVE :: frac_carb_pa = 1.0   !! from passive pool (0-1, unitless)
+                                             !! corresponding to frac_carb(:,ipassive,iactive)
+!$OMP THREADPRIVATE(frac_carb_pa)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: active_to_pass_clay_frac = 0.68  !! (0-1, unitless)
+!$OMP THREADPRIVATE(active_to_pass_clay_frac)
+  !! residence times in carbon pools (days)
+  REAL(r_std), SAVE :: carbon_tau_iactive = 0.3   !! residence times in active pool (days)
+!$OMP THREADPRIVATE(carbon_tau_iactive)
+  REAL(r_std), SAVE :: carbon_tau_islow = 1.12      !! residence times in slow pool (days)
+!$OMP THREADPRIVATE(carbon_tau_islow)
+  REAL(r_std), SAVE :: carbon_tau_ipassive = 461.98   !! residence times in passive pool (days)
+!$OMP THREADPRIVATE(carbon_tau_ipassive)
+  !! priming parameter (-)
+  REAL(r_std), SAVE :: priming_param_iactive = 493.66   !! priming parameter for the active pool (-)
+!$OMP THREADPRIVATE(priming_param_iactive)
+  REAL(r_std), SAVE :: priming_param_islow = 194.03   !! priming parameter for the slow pool (-)
+!$OMP THREADPRIVATE(priming_param_islow)
+  REAL(r_std), SAVE :: priming_param_ipassive = 136.54   !! priming parameter for the passive pool (-)
+!$OMP THREADPRIVATE(priming_param_ipassvie)
+  REAL(r_std), SAVE :: DOC_tau_labile = 1.3   !! residence times of labile DOC (days) tuning
+!$OMP THREADPRIVATE(DOC_tau_labile)
+  REAL(r_std), SAVE :: DOC_tau_stable = 60.4   !! residence times of labile DOC (days) tuning 
+!$OMP THREADPRIVATE(DOC_tau_stable)
+ REAL(r_std), SAVE :: D_DOC = 0.0000004428   !! diffusion coeficient for DOC (m2 hr-1) coming from Burdige et al., 1999 in Ota et al., 2013
+!$OMP THREADPRIVATE(D_DOC)
+ REAL(r_std), SAVE :: red_factor = 1.  !! A parameter to reduce the DOC flux due to water flux in the soil column. Pure tunning set to 1 so no 
+                                       !! effect by default.
+!$OMP THREADPRIVATE(red_factor)
+ REAL(r_std), SAVE :: m_ads = 0.3   !! partition coeficient for adsorption of DOC (-) from Neff and Asner, 2001
+!$OMP THREADPRIVATE(m_ads)
+ REAL(r_std), SAVE :: b_ads = 0.15    !! desorption coeficient for adsorption of DOC (mg C g soil-1) from Neff and Asner, 2001
+!$OMP THREADPRIVATE(b_ads)
+REAL(r_std), SAVE :: kd_ads = 0.00805    !! distribution coefficient for adsorption of DOC (m3 water kg soil-1) from Moore et al., 1992
+!$OMP THREADPRIVATE(kd_ads)
+ REAL(r_std), SAVE :: CUE = 0.5   !! Microbial carbon use efficiency(unitless, 0-1) Assumed value
+!$OMP THREADPRIVATE(CUE)
+  REAL(r_std), SAVE :: bulk_density_default = 1.65   !! soil bulk density (kg m-3)
+!$OMP THREADPRIVATE(bulk_density)
+  REAL(r_std), SAVE, DIMENSION(3) :: flux_tot_coeff = (/ 1.2, 1.4, .75/)
+!$OMP THREADPRIVATE(flux_tot_coeff)
+  REAL(r_std), SAVE :: soil_ph_default = 7.0   !! soil pH (pH units)
+!$OMP THREADPRIVATE(soil_ph)
+
+  !
+  ! stomate_turnover.f90
+  !
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: new_turnover_time_ref = 20. !!(days)
+!$OMP THREADPRIVATE(new_turnover_time_ref)
+  REAL(r_std), SAVE :: dt_turnover_time = 10.      !!(days)
+!$OMP THREADPRIVATE(dt_turnover_time)
+  REAL(r_std), SAVE :: leaf_age_crit_tref = 20.    !! (C)
+!$OMP THREADPRIVATE(leaf_age_crit_tref)
+  REAL(r_std), SAVE, DIMENSION(3) :: leaf_age_crit_coeff = (/ 1.5, 0.75, 10./) !! (unitless)
+!$OMP THREADPRIVATE(leaf_age_crit_coeff)
+
+
+  !
+  ! stomate_vmax.f90
+  !
+ 
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: vmax_offset = 0.3        !! minimum leaf efficiency (unitless)
+!$OMP THREADPRIVATE(vmax_offset)
+  REAL(r_std), SAVE :: leafage_firstmax = 0.03  !! relative leaf age at which efficiency
+                                                !! reaches 1 (unitless)
+!$OMP THREADPRIVATE(leafage_firstmax)
+  REAL(r_std), SAVE :: leafage_lastmax = 0.5    !! relative leaf age at which efficiency
+                                                !! falls below 1 (unitless)
+!$OMP THREADPRIVATE(leafage_lastmax)
+  REAL(r_std), SAVE :: leafage_old = 1.         !! relative leaf age at which efficiency
+                                                !! reaches its minimum (vmax_offset) 
+                                                !! (unitless)
+!$OMP THREADPRIVATE(leafage_old)
+  !
+  ! stomate_season.f90 
+  !
+
+  ! 1. Scalar
+
+  REAL(r_std), SAVE :: gppfrac_dormance = 0.2  !! report maximal GPP/GGP_max for dormance (0-1, unitless)
+!$OMP THREADPRIVATE(gppfrac_dormance)
+  REAL(r_std), SAVE :: tau_climatology = 20.   !! tau for "climatologic variables (years)
+!$OMP THREADPRIVATE(tau_climatology)
+  REAL(r_std), SAVE :: hvc1 = 0.019            !! parameters for herbivore activity (unitless)
+!$OMP THREADPRIVATE(hvc1)
+  REAL(r_std), SAVE :: hvc2 = 1.38             !! parameters for herbivore activity (unitless)
+!$OMP THREADPRIVATE(hvc2)
+  REAL(r_std), SAVE :: leaf_frac_hvc = 0.33    !! leaf fraction (0-1, unitless)
+!$OMP THREADPRIVATE(leaf_frac_hvc)
+  REAL(r_std), SAVE :: tlong_ref_max = 303.1   !! maximum reference long term temperature (K)
+!$OMP THREADPRIVATE(tlong_ref_max)
+  REAL(r_std), SAVE :: tlong_ref_min = 253.1   !! minimum reference long term temperature (K)
+!$OMP THREADPRIVATE(tlong_ref_min)
+
+  ! 3. Coefficients of equations
+
+  REAL(r_std), SAVE :: ncd_max_year = 3.
+!$OMP THREADPRIVATE(ncd_max_year)
+  REAL(r_std), SAVE :: gdd_threshold = 5.
+!$OMP THREADPRIVATE(gdd_threshold)
+  REAL(r_std), SAVE :: green_age_ever = 2.
+!$OMP THREADPRIVATE(green_age_ever)
+  REAL(r_std), SAVE :: green_age_dec = 0.5
+!$OMP THREADPRIVATE(green_age_dec)
+
+END MODULE constantes_var
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/pft_parameters.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/pft_parameters.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/pft_parameters.f90	(revision 5166)
@@ -0,0 +1,2591 @@
+! =================================================================================================================================
+! MODULE       : pft_parameters
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module initializes all the pft parameters in function of the
+!!              number of vegetation types and of the values chosen by the user.
+!!
+!!\n DESCRIPTION:  This module allocates and initializes the pft parameters in function of the number of pfts
+!!                 and the values of the parameters. \n
+!!                 The number of PFTs is read in intersurf.f90 (subroutine intsurf_config). \n
+!!                 Then we can initialize the parameters. \n
+!!                 This module is the result of the merge of constantes_co2, constantes_veg, stomate_constants.\n
+!!
+!! RECENT CHANGE(S): Josefine Ghattas 2013 : The declaration part has been extracted and moved to module pft_parameters_var
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE pft_parameters
+
+  USE pft_parameters_var
+  USE constantes_mtc
+  USE constantes
+  USE ioipsl
+  USE ioipsl_para 
+  USE defprec
+  
+  IMPLICIT NONE
+
+CONTAINS
+ !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_main
+!!
+!>\BRIEF          This subroutine initializes all the pft parameters in function of the
+!! number of vegetation types chosen by the user.
+!!
+!! DESCRIPTION  : This subroutine is called after the reading of the number of PFTS and the options 
+!!                activated by the user in the configuration files. (structure active_flags) \n
+!!                The allocation is done just before reading the correspondence table  between PFTs and MTCs
+!!                defined by the user in the configuration file.\n
+!!                With the correspondence table, the subroutine can initialize the pft parameters in function
+!!                of the flags activated (ok_sechiba, ok_stomate, ok_co2, routing, new_hydrol...) in order to
+!!                optimize the memory allocation. \n
+!!                If the number of PFTs and pft_to_mtc are not found, the standard configuration will be used
+!!                (13 PFTs, PFT = MTC). \n 
+!!                Some restrictions : the pft 1 can only be the bare soil and it is unique. \n
+!!                Algorithm : Build new PFT from 13 generic-PFT or meta-classes.
+!!                1. Read the number of PFTs in "run.def". If nothing is found, it is assumed that the user intend to use 
+!!                   the standard of PFTs (13).
+!!                2. Read the index vector in "run.def". The index vector associates one PFT to one meta-classe (or generic PFT).
+!!                   When the association is done, the PFT defined by the user inherited the default values from the meta classe.
+!!                   If nothing is found, it is assumed to use the standard index vector (PFT = MTC).
+!!                3. Check consistency
+!!                4. Memory allocation and initialization.
+!!                5. The parameters are read in the configuration file in intsurf_config (intersurf module).
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE pft_parameters_main(active_flags)
+
+   IMPLICIT NONE
+
+   !! 0. Variables and parameters declaration
+
+   !! 0.1 Input variables 
+
+   TYPE(control_type),INTENT(in) :: active_flags   !! What parts of the code are activated ? (true/false)
+   
+   !! 0.4 Local variables  
+
+   INTEGER(i_std) :: j                             !! Index (unitless)
+
+!_ ================================================================================================================================ 
+   
+   !
+   ! PFT global
+   !
+
+   IF(l_first_pft_parameters) THEN
+
+      !! 1. First time step
+      IF(long_print) THEN
+         WRITE(numout,*) 'l_first_pft_parameters :we read the parameters from the def files'
+      ENDIF
+
+      IF ( active_flags%hydrol_cwrr ) THEN
+         
+         !! 2.1 Read the flag ok_throughfall_by_pft to know if 
+         !!      we have to use the parameter throughfall_by_pft
+
+         !Config Key   = OK_THROUGHFALL_PFT
+         !Config Desc  = Activate use of PERCENT_THROUGHFALL_PFT
+         !Config If    = HYDROL_CWRR
+         !Config Def   = FALSE
+         !Config Help  = If NOT OFF_LINE_MODE it is always TRUE (coupled with a GCM)
+         !Config Units = [FLAG]
+         IF ( .NOT. OFF_LINE_MODE ) ok_throughfall_by_pft = .TRUE.
+         CALL getin_p('OK_THROUGHFALL_PFT',ok_throughfall_by_pft)   
+
+      END IF
+   
+      !! 2.2 Memory allocation for the pfts-parameters
+      CALL pft_parameters_alloc(active_flags)
+
+      !! 3. Correspondance table 
+      
+      !! 3.1 Initialisation of the correspondance table
+      !! Initialisation of the correspondance table
+      IF (nvm == nvmc) THEN
+         WRITE(numout,*) 'Message to the user : we will use ORCHIDEE to its standard configuration' 
+         pft_to_mtc = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 /)
+      ELSE
+         pft_to_mtc(:) = undef_int
+      ENDIF !(nvm  == nvmc)
+      
+      !! 3.2 Reading of the conrrespondance table in the .def file
+      !
+      !Config Key   = PFT_TO_MTC
+      !Config Desc  = correspondance array linking a PFT to MTC
+      !Config if    = OK_SECHIBA or OK_STOMATE
+      !Config Def   = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('PFT_TO_MTC',pft_to_mtc)
+      
+      !! 3.3 If the user want to use the standard configuration, he needn't to fill the correspondance array
+      !!     If the configuration is wrong, send a error message to the user.
+      IF(nvm /= nvmc ) THEN
+         !
+         IF(pft_to_mtc(1) == undef_int) THEN
+            STOP ' The array PFT_TO_MTC is empty : we stop'
+         ENDIF !(pft_to_mtc(1) == undef_int)
+         !
+      ENDIF !(nvm /= nvmc )
+
+      !! 3.4 Some error messages
+
+      !! 3.4.1 What happened if pft_to_mtc(j) > nvmc or pft_to_mtc(j) <=0 (if the mtc doesn't exist)?
+       DO j = 1, nvm ! Loop over # PFTs  
+          !
+          IF( (pft_to_mtc(j) > nvmc) .OR. (pft_to_mtc(j) <= 0) ) THEN
+             WRITE(numout,*) 'the metaclass chosen does not exist'
+             STOP 'we stop reading pft_to_mtc'
+          ENDIF !( (pft_to_mtc(j) > nvmc) .OR. (pft_to_mtc(j) <= 0) )
+          !
+       ENDDO  ! Loop over # PFTs  
+
+
+       !! 3.4.2 Check if pft_to_mtc(1) = 1 
+       IF(pft_to_mtc(1) /= 1) THEN
+          !
+          WRITE(numout,*) 'the first pft has to be the bare soil'
+          STOP 'we stop reading next values of pft_to_mtc'
+          !
+       ELSE
+          !
+          DO j = 2,nvm ! Loop over # PFTs different from bare soil
+             !
+             IF(pft_to_mtc(j) == 1) THEN
+                WRITE(numout,*) 'only pft_to_mtc(1) has to be the bare soil'
+                STOP 'we stop reading pft_to_mtc'
+             ENDIF ! (pft_to_mtc(j) == 1)
+             !
+          ENDDO ! Loop over # PFTs different from bare soil
+          !
+       ENDIF !(pft_to_mtc(1) /= 1)
+      
+
+      !! 4.Initialisation of the pfts-parameters
+      CALL pft_parameters_init(active_flags)
+
+      !! 5. Useful data
+
+      !! 5.1 Read the name of the PFTs given by the user
+      !
+      !Config Key   = PFT_NAME
+      !Config Desc  = Name of a PFT
+      !Config if    = OK_SECHIBA or OK_STOMATE
+      !Config Def   = bare ground, tropical broad-leaved evergreen, tropical broad-leaved raingreen, 
+      !Config         temperate needleleaf evergreen, temperate broad-leaved evergreen temperate broad-leaved summergreen,
+      !Config         boreal needleleaf evergreen, boreal broad-leaved summergreen, boreal needleleaf summergreen,
+      !Config         C3 grass, C4 grass, C3 agriculture, C4 agriculture    
+      !Config Help  = the user can name the new PFTs he/she introducing for new species
+      !Config Units = [-]
+      CALL getin_p('PFT_NAME',pft_name)
+
+      !! 5.2 A useful message to the user: correspondance between the number of the pft
+      !! and the name of the associated mtc 
+      DO j = 1,nvm ! Loop over # PFTs
+         !
+         WRITE(numout,*) 'the PFT',j, 'called  ', PFT_name(j),'corresponds to the MTC : ',MTC_name(pft_to_mtc(j))
+         !
+      ENDDO ! Loop over # PFTs
+
+
+      !! 6. End message
+      IF(long_print) THEN
+         WRITE(numout,*) 'pft_parameters_done'
+      ENDIF
+
+      !! 8. Reset flag
+      l_first_pft_parameters = .FALSE.
+
+   ELSE 
+
+      RETURN
+
+   ENDIF !(l_first_pft_parameters)
+
+ END SUBROUTINE pft_parameters_main
+ !
+ !=
+ !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_init 
+!!
+!>\BRIEF          This subroutine initializes all the pft parameters by the default values
+!! of the corresponding metaclasse. 
+!!
+!! DESCRIPTION  : This subroutine is called after the reading of the number of PFTS and the correspondence
+!!                table defined by the user in the configuration files. \n
+!!                With the correspondence table, the subroutine can search the default values for the parameter
+!!                even if the PFTs are classified in a random order (except bare soil). \n
+!!                With the correspondence table, the subroutine can initialize the pft parameters in function
+!!                of the flags activated (ok_sechiba, ok_stomate, ok_co2, routing, new_hydrol...).\n
+!!
+!! RECENT CHANGE(S): Didier Solyga : Simplified PFT loops : use vector notation. 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE pft_parameters_init(active_flags)
+  
+   IMPLICIT NONE
+   
+   !! 0. Variables and parameters declaration
+
+   !! 0.1 Input variables
+   
+   TYPE(control_type),INTENT(in) :: active_flags  !! What parts of the code are activated ? (true/false)
+
+   !! 0.4 Local variables
+
+   INTEGER(i_std)                :: jv            !! Index (unitless) 
+!_ ================================================================================================================================ 
+
+   !
+   ! 1. Correspondance between the PFTs values and thes MTCs values 
+   !
+ 
+
+   ! 1.1 For parameters used anytime
+   
+   PFT_name(:) = MTC_name(pft_to_mtc(:))
+   !
+   ! Vegetation structure 
+   !
+   veget_ori_fixed_test_1(:) = veget_ori_fixed_mtc(pft_to_mtc(:))
+   llaimax(:) = llaimax_mtc(pft_to_mtc(:))
+   llaimin(:) = llaimin_mtc(pft_to_mtc(:))
+   height_presc(:) = height_presc_mtc(pft_to_mtc(:))
+   type_of_lai(:) = type_of_lai_mtc(pft_to_mtc(:))
+   natural(:) = natural_mtc(pft_to_mtc(:))
+   !
+   ! Water - sechiba
+   !
+   If (active_flags%hydrol_cwrr ) THEN
+      humcste(:) = humcste_cwrr(pft_to_mtc(:)) ! values for 2m soil depth
+   ELSE
+      humcste(:) = humcste_mtc(pft_to_mtc(:))  ! values for 4m soil depth 
+   END IF
+   !
+   ! Soil - vegetation
+   !
+   pref_soil_veg(:) = pref_soil_veg_mtc(pft_to_mtc(:))
+   !
+   ! Photosynthesis
+   !
+   is_c4(:) = is_c4_mtc(pft_to_mtc(:))
+   gsslope(:) = gsslope_mtc(pft_to_mtc(:))
+   gsoffset(:) = gsoffset_mtc(pft_to_mtc(:))
+   vcmax_fix(:) = vcmax_fix_mtc(pft_to_mtc(:))
+   vjmax_fix(:) = vjmax_fix_mtc(pft_to_mtc(:))
+   co2_tmin_fix(:) = co2_tmin_fix_mtc(pft_to_mtc(:))
+   co2_topt_fix(:) = co2_topt_fix_mtc(pft_to_mtc(:))
+   co2_tmax_fix(:) = co2_tmax_fix_mtc(pft_to_mtc(:))
+   ext_coeff(:) = ext_coeff_mtc(pft_to_mtc(:))
+   !
+   !! Define labels from physiologic characteristics 
+   !
+   leaf_tab(:) = leaf_tab_mtc(pft_to_mtc(:)) 
+   pheno_model(:) = pheno_model_mtc(pft_to_mtc(:))   
+   !
+   is_tree(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( leaf_tab(jv) <= 2 ) is_tree(jv) = .TRUE.
+   END DO
+      !
+   is_deciduous(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( is_tree(jv) .AND. (pheno_model(jv) /= "none") ) is_deciduous(jv) = .TRUE.
+   END DO
+   !
+   is_evergreen(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( is_tree(jv) .AND. (pheno_model(jv) == "none") ) is_evergreen(jv) = .TRUE.
+   END DO
+   !
+   is_needleleaf(:) = .FALSE.
+   DO jv = 1,nvm
+      IF ( leaf_tab(jv) == 2 ) is_needleleaf(jv) = .TRUE.
+   END DO
+
+
+   ! 1.2 For sechiba parameters
+
+   IF (active_flags%ok_sechiba) THEN
+      !
+      ! Vegetation structure - sechiba
+      !
+      rveg_pft(:) = rveg_mtc(pft_to_mtc(:))
+      !
+      ! Evapotranspiration -  sechiba
+      !
+      rstruct_const(:) = rstruct_const_mtc(pft_to_mtc(:))
+      kzero(:) = kzero_mtc(pft_to_mtc(:))
+      !
+      ! Water - sechiba
+      !
+      wmax_veg(:) = wmax_veg_mtc(pft_to_mtc(:))
+      IF ( .NOT.(active_flags%hydrol_cwrr) .OR.  (active_flags%hydrol_cwrr .AND. ok_throughfall_by_pft) ) THEN
+         throughfall_by_pft(:) = throughfall_by_mtc(pft_to_mtc(:))
+      ENDIF
+      !
+      ! Albedo - sechiba
+      !
+      snowa_ini(:) = snowa_ini_mtc(pft_to_mtc(:))
+      snowa_dec(:) = snowa_dec_mtc(pft_to_mtc(:)) 
+      alb_leaf_vis(:) = alb_leaf_vis_mtc(pft_to_mtc(:))  
+      alb_leaf_nir(:) = alb_leaf_nir_mtc(pft_to_mtc(:))
+      !-
+   ENDIF !(active_flags%ok_sechiba)
+
+   ! 1.3 For BVOC parameters
+   
+   IF (active_flags%ok_inca) THEN
+      !
+      ! Biogenic Volatile Organic Compounds
+      !
+      em_factor_isoprene(:) = em_factor_isoprene_mtc(pft_to_mtc(:))
+      em_factor_monoterpene(:) = em_factor_monoterpene_mtc(pft_to_mtc(:))
+      em_factor_ORVOC(:) = em_factor_ORVOC_mtc(pft_to_mtc(:)) 
+      em_factor_OVOC(:) = em_factor_OVOC_mtc(pft_to_mtc(:))
+      em_factor_MBO(:) = em_factor_MBO_mtc(pft_to_mtc(:))
+      em_factor_methanol(:) = em_factor_methanol_mtc(pft_to_mtc(:))
+      em_factor_acetone(:) = em_factor_acetone_mtc(pft_to_mtc(:)) 
+      em_factor_acetal(:) = em_factor_acetal_mtc(pft_to_mtc(:))
+      em_factor_formal(:) = em_factor_formal_mtc(pft_to_mtc(:))
+      em_factor_acetic(:) = em_factor_acetic_mtc(pft_to_mtc(:))
+      em_factor_formic(:) = em_factor_formic_mtc(pft_to_mtc(:))
+      em_factor_no_wet(:) = em_factor_no_wet_mtc(pft_to_mtc(:))
+      em_factor_no_dry(:) = em_factor_no_dry_mtc(pft_to_mtc(:))
+      Larch(:) = Larch_mtc(pft_to_mtc(:)) 
+      !-
+   ENDIF !(active_flags%ok_inca)
+
+   ! 1.4 For stomate parameters
+
+   IF (active_flags%ok_stomate) THEN
+      !
+      ! Vegetation structure - stomate
+      !
+      sla(:) = sla_mtc(pft_to_mtc(:))
+      !
+      ! Photosynthesis
+      !
+      vcmax_opt(:) = vcmax_opt_mtc(pft_to_mtc(:))
+      vjmax_opt(:) = vjmax_opt_mtc(pft_to_mtc(:)) 
+      tphoto_min_a(:) = tphoto_min_a_mtc(pft_to_mtc(:)) 
+      tphoto_min_b(:) = tphoto_min_b_mtc(pft_to_mtc(:))
+      tphoto_min_c(:) = tphoto_min_c_mtc(pft_to_mtc(:))
+      tphoto_opt_a(:) = tphoto_opt_a_mtc(pft_to_mtc(:))
+      tphoto_opt_b(:) = tphoto_opt_b_mtc(pft_to_mtc(:))
+      tphoto_opt_c(:) = tphoto_opt_c_mtc(pft_to_mtc(:))
+      tphoto_max_a(:) = tphoto_max_a_mtc(pft_to_mtc(:))
+      tphoto_max_b(:) = tphoto_max_b_mtc(pft_to_mtc(:))
+      tphoto_max_c(:) = tphoto_max_c_mtc(pft_to_mtc(:))
+      !
+      ! Respiration - stomate
+      !
+      maint_resp_slope_c(:) = maint_resp_slope_c_mtc(pft_to_mtc(:))               
+      maint_resp_slope_b(:) = maint_resp_slope_b_mtc(pft_to_mtc(:))
+      maint_resp_slope_a(:) = maint_resp_slope_a_mtc(pft_to_mtc(:))
+      cm_zero_leaf(:) = cm_zero_leaf_mtc(pft_to_mtc(:))
+      cm_zero_sapabove(:) = cm_zero_sapabove_mtc(pft_to_mtc(:))
+      cm_zero_sapbelow(:) = cm_zero_sapbelow_mtc(pft_to_mtc(:)) 
+      cm_zero_heartabove(:) = cm_zero_heartabove_mtc(pft_to_mtc(:)) 
+      cm_zero_heartbelow(:) = cm_zero_heartbelow_mtc(pft_to_mtc(:))
+      cm_zero_root(:) = cm_zero_root_mtc(pft_to_mtc(:))
+      cm_zero_fruit(:) = cm_zero_fruit_mtc(pft_to_mtc(:))
+      cm_zero_carbres(:) = cm_zero_carbres_mtc(pft_to_mtc(:))
+      !
+      ! Fire - stomate
+      !
+      flam(:) = flam_mtc(pft_to_mtc(:))
+      resist(:) = resist_mtc(pft_to_mtc(:))
+      !
+      ! Flux - LUC
+      !
+      coeff_lcchange_1(:) = coeff_lcchange_1_mtc(pft_to_mtc(:))
+      coeff_lcchange_10(:) = coeff_lcchange_10_mtc(pft_to_mtc(:))
+      coeff_lcchange_100(:) = coeff_lcchange_100_mtc(pft_to_mtc(:))
+      !
+      ! Phenology
+      !
+      !
+      ! 1. Stomate
+      !
+      lai_max(:) = lai_max_mtc(pft_to_mtc(:))
+      pheno_type(:) = pheno_type_mtc(pft_to_mtc(:))
+      !
+      ! 2. Leaf Onset
+      !
+      pheno_gdd_crit_c(:) = pheno_gdd_crit_c_mtc(pft_to_mtc(:))
+      pheno_gdd_crit_b(:) = pheno_gdd_crit_b_mtc(pft_to_mtc(:))         
+      pheno_gdd_crit_a(:) = pheno_gdd_crit_a_mtc(pft_to_mtc(:))
+      ngd_crit(:) =  ngd_crit_mtc(pft_to_mtc(:))
+      ncdgdd_temp(:) = ncdgdd_temp_mtc(pft_to_mtc(:)) 
+      hum_frac(:) = hum_frac_mtc(pft_to_mtc(:))
+      hum_min_time(:) = hum_min_time_mtc(pft_to_mtc(:))
+      tau_sap(:) = tau_sap_mtc(pft_to_mtc(:))
+      tau_fruit(:) = tau_fruit_mtc(pft_to_mtc(:))
+      ecureuil(:) = ecureuil_mtc(pft_to_mtc(:))
+      alloc_min(:) = alloc_min_mtc(pft_to_mtc(:))
+      alloc_max(:) = alloc_max_mtc(pft_to_mtc(:))
+      demi_alloc(:) = demi_alloc_mtc(pft_to_mtc(:))
+      leaflife_tab(:) = leaflife_mtc(pft_to_mtc(:))
+      !
+      ! 3. Senescence
+      !
+      leaffall(:) = leaffall_mtc(pft_to_mtc(:))
+      leafagecrit(:) = leafagecrit_mtc(pft_to_mtc(:))
+      senescence_type(:) = senescence_type_mtc(pft_to_mtc(:)) 
+      senescence_hum(:) = senescence_hum_mtc(pft_to_mtc(:)) 
+      nosenescence_hum(:) = nosenescence_hum_mtc(pft_to_mtc(:)) 
+      max_turnover_time(:) = max_turnover_time_mtc(pft_to_mtc(:))
+      min_turnover_time(:) = min_turnover_time_mtc(pft_to_mtc(:))
+      min_leaf_age_for_senescence(:) = min_leaf_age_for_senescence_mtc(pft_to_mtc(:))
+      senescence_temp_c(:) = senescence_temp_c_mtc(pft_to_mtc(:))
+      senescence_temp_b(:) = senescence_temp_b_mtc(pft_to_mtc(:))
+      senescence_temp_a(:) = senescence_temp_a_mtc(pft_to_mtc(:))
+      gdd_senescence(:) = gdd_senescence_mtc(pft_to_mtc(:))
+      !
+      ! DGVM
+      !
+      residence_time(:) = residence_time_mtc(pft_to_mtc(:))
+      tmin_crit(:) = tmin_crit_mtc(pft_to_mtc(:))
+      tcm_crit(:) = tcm_crit_mtc(pft_to_mtc(:))
+      !-
+   ENDIF !(active_flags%ok_stomate)
+
+ END SUBROUTINE pft_parameters_init
+ !
+ !=
+ !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_alloc
+!!
+!>\BRIEF         This subroutine allocates memory needed for the PFT parameters 
+!! in function  of the flags activated.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE pft_parameters_alloc(active_flags)
+
+   IMPLICIT NONE
+
+   !! 0. Variables and parameters declaration
+
+   !! 0.1 Input variables 
+   
+   TYPE(control_type),INTENT(in) :: active_flags  !! What parts of the code are activated ? (true/false)
+
+   !! 0.4 Local variables
+   
+   LOGICAL :: l_error                             !! Diagnostic boolean for error allocation (true/false) 
+   INTEGER :: ier                                 !! Return value for memory allocation (0-N, unitless)
+
+!_ ================================================================================================================================
+
+
+   !
+   ! 1. Parameters used anytime
+   !
+
+   l_error = .FALSE.
+
+   ALLOCATE(pft_to_mtc(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for pft_to_mtc. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(PFT_name(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for PFT_name. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(height_presc(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for height_presc. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_tree(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_tree. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(natural(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for natural. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_c4(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_c4. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(gsslope(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for gsslope. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(gsoffset(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for gsoffset. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(humcste(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for humcste. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(ext_coeff(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for ext_coeff. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(veget_ori_fixed_test_1(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for veget_ori_fixed_test_1. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(llaimax(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for llaimax. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(llaimin(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for llaimin. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(type_of_lai(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for type_of_lai. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(vcmax_fix(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for vcmax_fix. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(vjmax_fix(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for vjmax_fix. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(co2_tmin_fix(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for co2_tmin_fix. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(co2_topt_fix(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for co2_topt_fix. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(co2_tmax_fix(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for co2_tmax_fix. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(pref_soil_veg(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for pref_soil_veg. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(leaf_tab(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for leaf_tab. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(pheno_model(nvm),stat=ier)
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for pheno_model. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+      
+   ALLOCATE(is_deciduous(nvm),stat=ier) 
+   l_error = l_error .OR. (ier /= 0) 
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_deciduous. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_evergreen(nvm),stat=ier) 
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_evergreen. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_needleleaf(nvm),stat=ier)  
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_needleleaf. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+   ALLOCATE(is_tropical(nvm),stat=ier)   
+   l_error = l_error .OR. (ier /= 0)
+   IF (l_error) THEN
+      WRITE(numout,*) ' Memory allocation error for is_tropical. We stop. We need nvm words = ',nvm
+      STOP 'pft_parameters_alloc'
+   END IF
+
+
+   !
+   ! 2. Parameters used if ok_sechiba only
+   !
+   IF ( active_flags%ok_sechiba ) THEN
+
+      l_error = .FALSE.
+
+      ALLOCATE(rstruct_const(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for rstruct_const. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(kzero(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for kzero. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(rveg_pft(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for rveg_pft. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(wmax_veg(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for wmax_veg. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      IF ( .NOT.(active_flags%hydrol_cwrr) .OR. (active_flags%hydrol_cwrr .AND. ok_throughfall_by_pft) ) THEN
+         ALLOCATE(throughfall_by_pft(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for throughfall_by_pft. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+      END IF
+
+      ALLOCATE(snowa_ini(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for snowa_ini. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(snowa_dec(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for snowa_dec. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(alb_leaf_vis(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alb_leaf_vis. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(alb_leaf_nir(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alb_leaf_nir. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      IF( active_flags%ok_inca ) THEN
+         
+         l_error = .FALSE.
+         
+         ALLOCATE(em_factor_isoprene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_isoprene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_monoterpene(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_monoterpene. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_ORVOC(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_ORVOC. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_OVOC(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)       
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_OVOC. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_MBO(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_MBO. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_methanol(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_methanol. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_acetone(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_acetone. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_acetal(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_acetal. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_formal(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_formal. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_acetic(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)       
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_acetic. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_formic(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_formic. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_no_wet(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_no_wet. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(em_factor_no_dry(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0)       
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for em_factor_no_dry. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+         ALLOCATE(Larch(nvm),stat=ier)
+         l_error = l_error .OR. (ier /= 0) 
+         IF (l_error) THEN
+            WRITE(numout,*) ' Memory allocation error for Larch. We stop. We need nvm words = ',nvm
+            STOP 'pft_parameters_alloc'
+         END IF
+
+      ENDIF ! (active_flags%ok_inca) 
+
+   ENDIF !(active_flags%ok_sechiba)
+
+   !
+   ! 3. Parameters used if ok_stomate only
+   !
+   IF ( active_flags%ok_stomate ) THEN
+
+      l_error = .FALSE.
+
+      ALLOCATE(sla(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for sla. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(vcmax_opt(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for vcmax_opt. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(vjmax_opt(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for vjmax_opt. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tphoto_min_a(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tphoto_min_a. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tphoto_min_b(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tphoto_min_b. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tphoto_min_c(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tphoto_min_c. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tphoto_opt_a(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tphoto_opt_a. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tphoto_opt_b(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tphoto_opt_b. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tphoto_opt_c(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tphoto_opt_c. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tphoto_max_a(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tphoto_max_a. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tphoto_max_b(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tphoto_max_b. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tphoto_max_c(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tphoto_max_c. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_gdd_crit_c(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit_c. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_gdd_crit_b(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit_b. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_gdd_crit_a(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit_a. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_gdd_crit(nvm,3),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_gdd_crit. We stop. We need nvm words = ',nvm*3
+         STOP 'pft_parameters_alloc'
+      END IF
+      pheno_gdd_crit(:,:) = zero
+
+      ALLOCATE(ngd_crit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for ngd_crit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(ncdgdd_temp(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for ncdgdd_temp. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(hum_frac(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for hum_frac. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(hum_min_time(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for hum_min_time. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tau_sap(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tau_sap. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tau_fruit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tau_fruit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(ecureuil(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for ecureuil. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(alloc_min(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alloc_min. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(alloc_max(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for alloc_max. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(demi_alloc(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(maint_resp_slope(nvm,3),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maint_resp_slope. We stop. We need nvm*3 words = ',nvm*3
+         STOP 'pft_parameters_alloc'
+      END IF
+      maint_resp_slope(:,:) = zero
+
+      ALLOCATE(maint_resp_slope_c(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maint_resp_slope_c. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(maint_resp_slope_b(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maint_resp_slope_b. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(maint_resp_slope_a(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maint_resp_slope_a. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_maint_zero(nvm,nparts),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_maint_zero. We stop. We need nvm*nparts words = ',nvm*nparts
+         STOP 'pft_parameters_alloc'
+      END IF
+      coeff_maint_zero(:,:) = zero
+
+      ALLOCATE(cm_zero_leaf(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_leaf. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_sapabove(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_sapabove. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_sapbelow(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_sapbelow. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_heartabove(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_heartabove. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_heartbelow(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_heartbelow. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_root(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_root. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_fruit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_fruit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cm_zero_carbres(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cm_zero_carbres. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(flam(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(resist(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for resist. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_lcchange_1(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_lcchange_1. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_lcchange_10(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_lcchange_10. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(coeff_lcchange_100(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for coeff_lcchange_100. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(lai_max(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for lai_max. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(pheno_type(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for pheno_type. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leaffall(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leaffall. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leafagecrit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leafagecrit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_type(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_hum(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_hum. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(nosenescence_hum(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for nosenescence_hum. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(max_turnover_time(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for max_turnover_time. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(min_turnover_time(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for min_turnover_time. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(min_leaf_age_for_senescence(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for min_leaf_age_for_senescence. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_temp_c(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_temp_c. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_temp_b(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_temp_b. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_temp_a(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_temp_a. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(senescence_temp(nvm,3),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for senescence_temp. We stop. We need nvm*3 words = ',nvm*3
+         STOP 'pft_parameters_alloc'
+      END IF
+      senescence_temp(:,:) = zero
+
+      ALLOCATE(gdd_senescence(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for gdd_senescence. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(residence_time(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for residence_time. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tmin_crit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tmin_crit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(tcm_crit(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for tcm_crit. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(lai_initmin(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for . We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(bm_sapl(nvm,nparts,nelements),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for bm_sapl. We stop. We need nvm*nparts*nelements words = ',& 
+              &  nvm*nparts*nelements
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(migrate(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for migrate. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(maxdia(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for maxdia. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(cn_sapl(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for cn_sapl. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leaf_timecst(nvm),stat=ier)
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leaf_timecst. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+      ALLOCATE(leaflife_tab(nvm),stat=ier)   
+      l_error = l_error .OR. (ier /= 0)
+      IF (l_error) THEN
+         WRITE(numout,*) ' Memory allocation error for leaflife_tab. We stop. We need nvm words = ',nvm
+         STOP 'pft_parameters_alloc'
+      END IF
+
+   ENDIF ! (active_flags%ok_stomate)
+
+ END SUBROUTINE pft_parameters_alloc
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_pft_parameters 
+!!
+!>\BRIEF          This subroutine will read the imposed values for the global pft
+!! parameters (sechiba + stomate). It is not called if IMPOSE_PARAM is set to NO.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE config_pft_parameters
+   
+   IMPLICIT NONE
+
+   !! 0. Variables and parameters declaration
+  
+   !! 0.4 Local variable
+
+   LOGICAL, SAVE  :: first_call = .TRUE.  !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+   INTEGER(i_std) :: jv                   !! Index (untiless)
+
+!_ ================================================================================================================================ 
+
+   IF (first_call) THEN
+
+      !
+      ! Vegetation structure
+      !
+
+      !Config Key   = LEAF_TAB
+      !Config Desc  = leaf type : 1=broad leaved tree, 2=needle leaved tree, 3=grass 4=bare ground
+      !Config if    = OK_STOMATE
+      !Config Def   = 4, 1, 1, 2, 1, 1, 2, 1, 2, 3, 3, 3, 3 
+      !Config Help  = 
+      !Config Units = [-] 
+      CALL getin_p('LEAF_TAB',leaf_tab)
+      
+      !Config Key   = PHENO_MODEL
+      !Config Desc  = which phenology model is used? (tabulated) 
+      !Config if    = OK_STOMATE
+      !Config Def   = none, none, moi, none, none, ncdgdd, none, ncdgdd, ngd, moigdd, moigdd, moigdd, moigdd
+      !Config Help  =
+      !Config Units = [-] 
+      CALL getin_p('PHENO_MODEL',pheno_model)
+      
+      !! Redefine the values for is_tree, is_deciduous, is_needleleaf, is_evergreen if values have been modified
+      !! in run.def
+
+      is_tree(:) = .FALSE.
+      DO jv = 1,nvm
+         IF ( leaf_tab(jv) <= 2 ) is_tree(jv) = .TRUE.
+      END DO
+      !
+      is_deciduous(:) = .FALSE.
+      DO jv = 1,nvm
+         IF ( is_tree(jv) .AND. (pheno_model(jv) /= "none") ) is_deciduous(jv) = .TRUE.
+      END DO
+      !
+      is_evergreen(:) = .FALSE.
+      DO jv = 1,nvm
+         IF ( is_tree(jv) .AND. (pheno_model(jv) == "none") ) is_evergreen(jv) = .TRUE.
+      END DO
+      !
+      is_needleleaf(:) = .FALSE.
+      DO jv = 1,nvm
+         IF ( leaf_tab(jv) == 2 ) is_needleleaf(jv) = .TRUE.
+      END DO
+
+
+      !Config Key   = SECHIBA_LAI
+      !Config Desc  = laimax for maximum lai(see also type of lai interpolation)
+      !Config if    = OK_SECHIBA or IMPOSE_VEG
+      !Config Def   = 0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2.
+      !Config Help  = Maximum values of lai used for interpolation of the lai map
+      !Config Units = [m^2/m^2]
+      CALL getin_p('SECHIBA_LAI',llaimax)
+
+      !Config Key   = LLAIMIN
+      !Config Desc  = laimin for minimum lai(see also type of lai interpolation)
+      !Config if    = OK_SECHIBA or IMPOSE_VEG
+      !Config Def   = 0., 8., 0., 4., 4.5, 0., 4., 0., 0., 0., 0., 0., 0.
+      !Config Help  = Minimum values of lai used for interpolation of the lai map
+      !Config Units = [m^2/m^2]
+      CALL getin_p('LLAIMIN',llaimin)
+
+      !Config Key   = SLOWPROC_HEIGHT
+      !Config Desc  = prescribed height of vegetation 
+      !Config if    = OK_SECHIBA
+      !Config Def   = 0., 30., 30., 20., 20., 20., 15., 15., 15., .5, .6, 1., 1.
+      !Config Help  =
+      !Config Units = [m] 
+      CALL getin_p('SLOWPROC_HEIGHT',height_presc)
+
+      !Config Key   = TYPE_OF_LAI
+      !Config Desc  = Type of behaviour of the LAI evolution algorithm 
+      !Config if    = OK_SECHIBA
+      !Config Def   = inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter, inter
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('TYPE_OF_LAI',type_of_lai)
+
+      !Config Key   = NATURAL
+      !Config Desc  = natural? 
+      !Config if    = OK_SECHIBA, OK_STOMATE
+      !Config Def   = y, y, y, y, y, y, y, y, y, y, y, n, n 
+      !Config Help  =
+      !Config Units = [BOOLEAN]
+      CALL getin_p('NATURAL',natural)
+
+      
+      !
+      ! Photosynthesis
+      !
+
+      !Config Key   = IS_C4
+      !Config Desc  = flag for C4 vegetation types
+      !Config if    = OK_SECHIBA or OK_STOMATE
+      !Config Def   = n, n, n, n, n, n, n, n, n, n, n, y, n, y
+      !Config Help  =
+      !Config Units = [BOOLEAN]
+      CALL getin_p('IS_C4',is_c4)
+
+      !Config Key   = GSSLOPE
+      !Config Desc  = Slope of the gs/A relation (Ball & al.)
+      !Config if    = OK_CO2
+      !Config Def   = 0., 9., 9., 9., 9., 9., 9., 9., 9., 9., 3., 9., 3.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('GSSLOPE',gsslope)
+
+      !Config Key   = GSOFFSET
+      !Config Desc  = intercept of the gs/A relation (Ball & al.)
+      !Config if    = OK_CO2 or OK_STOMATE
+      !Config Def   = 0.0, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.03, 0.01, 0.03
+      !Config Help  =
+      !Config Units = [-] 
+      CALL getin_p('GSOFFSET',gsoffset)
+
+      !Config Key   = VCMAX_FIX
+      !Config Desc  = values used for vcmax when STOMATE is not activated
+      !Config if    = OK_SECHIBA and NOT(OK_STOMATE)
+      !Config Def   = 0., 40., 50., 30., 35., 40.,30., 40., 35., 60., 60., 70., 70.
+      !Config Help  =
+      !Config Units = [micromol/m^2/s] 
+      CALL getin_p('VCMAX_FIX',vcmax_fix)
+
+      !Config Key   = VJMAX_FIX
+      !Config Desc  = values used for vjmax when STOMATE is not activated
+      !Config if    = OK_SECHIBA and NOT(OK_STOMATE)
+      !Config Def   = 0., 80., 100., 60., 70., 80.,  60., 80., 70., 120., 120., 140., 140.
+      !Config Help  =
+      !Config Units = [micromol/m^2/s]
+      CALL getin_p('VJMAX_FIX',vjmax_fix)
+
+      !Config Key   = CO2_TMIN_FIX
+      !Config Desc  = values used for photosynthesis tmin when STOMATE is not activated
+      !Config if    = OK_SECHIBA and NOT(OK_STOMATE)
+      !Config Def   = 0.,  2.,  2., -4., -3., -2., -4., -4., -4., -5.,  6., -5.,  6.
+      !Config Help  =
+      !Config Units = [C] 
+      CALL getin_p('CO2_TMIN_FIX',co2_tmin_fix)
+
+      !Config Key   = CO2_TOPT_FIX 
+      !Config Desc  = values used for photosynthesis topt when STOMATE is not activated 
+      !Config if    = OK_SECHIBA and NOT(OK_STOMATE)
+      !Config Def   = 0., 27.5, 27.5, 17.5, 25., 20.,17.5, 17.5, 17.5, 20.,  32.5, 20.,  32.5
+      !Config Help  =
+      !Config Units = [C]
+      CALL getin_p('CO2_TOPT_FIX',co2_topt_fix)
+
+      !Config Key   = CO2_TMAX_FIX
+      !Config Desc  = values used for photosynthesis tmax when STOMATE is not activated 
+      !Config if    = OK_SECHIBA and NOT(OK_STOMATE)
+      !Config Def   = 0., 55., 55., 38., 48., 38.,38., 38., 38., 45., 55., 45., 55.
+      !Config Help  =
+      !Config Units = [C]
+      CALL getin_p('CO2_TMAX_FIX',co2_tmax_fix)
+
+      !Config Key   = EXT_COEFF
+      !Config Desc  = extinction coefficient of the Monsi&Seaki relationship (1953)
+      !Config if    = OK_SECHIBA or OK_STOMATE
+      !Config Def   = .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('EXT_COEFF',ext_coeff)
+     
+      !
+      ! Water-hydrology - sechiba
+      !
+
+      !Config Key   = HYDROL_HUMCSTE
+      !Config Desc  = Root profile
+      !Config Def   = 5., .4, .4, 1., .8, .8, 1., 1., .8, 4., 1., 4., 1. 
+      !Config if    = OK_SECHIBA
+      !Config Help  = Default values were defined for 4 meters soil depth.
+      !Config         For 2 meters soil depth, you may use those ones :
+      !Config         5., .8, .8, 1., .8, .8, 1., 1., .8, 4., 4., 4., 4.
+      !Config Units = [m]
+      CALL getin_p('HYDROL_HUMCSTE',humcste)
+
+      !
+      ! Soil - vegetation
+      !
+
+      !Config Key   = PREF_SOIL_VEG
+      !Config Desc  = The soil tile number for each vegetation
+      !Config if    = OK_SECHIBA or OK_STOMATE
+      !Config Def   = 1, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3
+      !Config Help  = Gives the number of the soil tile on which we will
+      !Config         put each vegetation. This allows to divide the hydrological column
+      !Config Units = [-]        
+      CALL getin_p('PREF_SOIL_VEG',pref_soil_veg)
+
+      first_call = .FALSE.
+
+   ENDIF !(first_call)
+
+ END SUBROUTINE config_pft_parameters
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_sechiba_pft_parameters
+!!
+!>\BRIEF        This subroutine will read the imposed values for the sechiba pft
+!! parameters. It is not called if IMPOSE_PARAM is set to NO. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE config_sechiba_pft_parameters(active_flags)
+
+   IMPLICIT NONE
+  
+   !! 0. Variables and parameters declaration
+
+   !! 0.1 Input variables
+
+   TYPE(control_type), INTENT(in) :: active_flags     !! What parts of the code are activated ?
+
+   !! 0.4 Local variable
+
+   LOGICAL, SAVE ::  first_call = .TRUE.   !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================ 
+
+   IF (first_call) THEN
+
+      !
+      ! Evapotranspiration -  sechiba
+      !
+      
+      !Config Key   = RSTRUCT_CONST
+      !Config Desc  = Structural resistance 
+      !Config if    = OK_SECHIBA
+      !Config Def   = 0.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0,  2.5,  2.0,  2.0,  2.0
+      !Config Help  =
+      !Config Units = [s/m]
+      CALL getin_p('RSTRUCT_CONST',rstruct_const)
+      
+      !Config Key   = KZERO
+      !Config Desc  = A vegetation dependent constant used in the calculation of the surface resistance.
+      !Config if    = OK_SECHIBA
+      !Config Def   = 0.0, 12.E-5, 12.E-5, 12.e-5, 12.e-5, 25.e-5, 12.e-5,25.e-5, 25.e-5, 30.e-5, 30.e-5, 30.e-5, 30.e-5 
+      !Config Help  =
+      !Config Units = [kg/m^2/s]
+      CALL getin_p('KZERO',kzero)
+      
+      !Config Key   = RVEG_PFT
+      !Config Desc  = Artificial parameter to increase or decrease canopy resistance.
+      !Config if    = OK_SECHIBA
+      !Config Def   = 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1.
+      !Config Help  = This parameter is set by PFT.
+      !Config Units = [-]
+      CALL getin_p('RVEG_PFT',rveg_pft)    
+      
+      !
+      ! Water-hydrology - sechiba
+      !
+
+      !Config Key   = WMAX_VEG
+      !Config Desc  = Maximum field capacity for each of the vegetations (Temporary): max quantity of water
+      !Config if    = OK_SECHIBA
+      !Config Def   = 150., 150., 150., 150., 150., 150., 150.,150., 150., 150., 150., 150., 150.
+      !Config Help  =
+      !Config Units = [kg/m^3]
+      CALL getin_p('WMAX_VEG',wmax_veg)
+      !
+      IF ( .NOT.(active_flags%hydrol_cwrr) .OR. (active_flags%hydrol_cwrr .AND. ok_throughfall_by_pft) ) THEN
+         !Config Key   = PERCENT_THROUGHFALL_PFT
+         !Config Desc  = Percent by PFT of precip that is not intercepted by the canopy
+         !Config if    = OK_SECHIBA OR HYDROL_CWRR
+         !Config Def   = 30. 30. 30. 30. 30. 30. 30. 30. 30. 30. 30. 30. 30.
+         !Config Help  = During one rainfall event, PERCENT_THROUGHFALL_PFT% of the incident rainfall
+         !Config         will get directly to the ground without being intercepted, for each PFT.
+         !Config Units = [%]
+         CALL getin_p('PERCENT_THROUGHFALL_PFT',throughfall_by_pft)
+         throughfall_by_pft(:) = throughfall_by_pft(:) / 100. 
+      END IF
+      
+      !
+      ! Albedo - sechiba
+      !
+
+      !Config Key   = SNOWA_INI
+      !Config Desc  = Initial snow albedo value for each vegetation type as it will be used in condveg_snow
+      !Config if    = OK_SECHIBA
+      !Config Def   = 0.35, 0., 0., 0.14, 0.14, 0.14, 0.14, 0.14, 0.14, 0.18, 0.18, 0.18, 0.18
+      !Config Help  = Values are from the Thesis of S. Chalita (1992)
+      !Config Units = [-]
+      CALL getin_p('SNOWA_INI',snowa_ini)
+
+      !Config Key   = SNOWA_DEC
+      !Config Desc  = Decay rate of snow albedo value for each vegetation type as it will be used in condveg_snow
+      !Config if    = OK_SECHIBA
+      !Config Def   = 0.45, 0.,  0., 0.06, 0.06, 0.11, 0.06, 0.11, 0.11, 0.52,0.52, 0.52, 0.52
+      !Config Help  = Values are from the Thesis of S. Chalita (1992)
+      !Config Units = [-]
+      CALL getin_p('SNOWA_DEC',snowa_dec)
+
+      !Config Key   = ALB_LEAF_VIS
+      !Config Desc  = leaf albedo of vegetation type, visible albedo
+      !Config if    = OK_SECHIBA
+      !Config Def   = .00, .04, .06, .06, .06,.06, .06, .06, .06, .10, .10, .10, .10
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('ALB_LEAF_VIS',alb_leaf_vis)
+
+      !Config Key   = ALB_LEAF_NIR
+      !Config Desc  = leaf albedo of vegetation type, near infrared albedo
+      !Config if    = OK_SECHIBA
+      !Config Def   = .00, .20, .22, .22, .22,.22, .22, .22, .22, .30, .30, .30, .30 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('ALB_LEAF_NIR',alb_leaf_nir)
+      
+      IF ( active_flags%ok_inca ) THEN
+         !
+         ! BVOC
+         !
+
+         !Config Key   = ISO_ACTIVITY
+         !Config Desc  = Biogenic activity for each age class : isoprene
+         !Config if    = DIFFUCO_OK_INCA
+         !Config Def   = 0.5, 1.5, 1.5, 0.5
+         !Config Help  =
+         !Config Units = [-]
+         CALL getin_p('ISO_ACTIVITY',iso_activity)
+
+         !Config Key   = METHANOL_ACTIVITY
+         !Config Desc  = Isoprene emission factor for each age class : methanol
+         !Config if    = DIFFUCO_OK_INCA
+         !Config Def   = 1., 1., 0.5, 0.5
+         !Config Help  =
+         !Config Units = [-]
+         CALL getin_p('METHANOL_ACTIVITY',methanol_activity)
+
+         !Config Key   = EM_FACTOR_ISOPRENE
+         !Config Desc  = Isoprene emission factor
+         !Config if    = DIFFUCO_OK_INCA
+         !Config Def   = 0., 24., 24., 8., 16., 45., 8., 8., 8., 16., 24., 5., 5.
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_ISOPRENE',em_factor_isoprene)
+
+         !Config Key   = EM_FACTOR_MONOTERPENE
+         !Config Desc  = Monoterpene emission factor 
+         !Config if    = DIFFUCO_OK_INCA 
+         !Config Def   = 0., 0.8, 0.8, 2.4, 1.2, 0.8, 2.4, 2.4, 2.4, 0.8, 1.2, 0.2, 0.2
+         !Config Help  =
+         !Config Units = [ugC/g/h] 
+         CALL getin_p('EM_FACTOR_MONOTERPENE',em_factor_monoterpene)
+
+         !Config Key   = EM_FACTOR_ORVOC
+         !Config Desc  = ORVOC emissions factor 
+         !Config if    = DIFFUCO_OK_INCA 
+         !Config Def   = 0., 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5
+         !Config Help  =
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_ORVOC',em_factor_ORVOC)
+
+         !Config Key   = EM_FACTOR_OVOC
+         !Config Desc  = OVOC emissions factor
+         !Config if    = DIFFUCO_OK_INCA
+         !Config Def   = 0., 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5
+         !Config Help  =
+         !Config Units = [ugC/g/h]        
+         CALL getin_p('EM_FACTOR_OVOC',em_factor_OVOC)
+
+         !Config Key   = EM_FACTOR_MBO
+         !Config Desc  = MBO emissions factor 
+         !Config if    = DIFFUCO_OK_INCA 
+         !Config Def   = 0., 0., 0., 20.0, 0., 0., 0., 0., 0., 0., 0., 0., 0.
+         !Config Help  =
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_MBO',em_factor_MBO)
+
+         !Config Key   = EM_FACTOR_METHANOL
+         !Config Desc  = Methanol emissions factor 
+         !Config if    = DIFFUCO_OK_INCA 
+         !Config Def   = 0., 0.6, 0.6, 1.8, 0.9, 0.6, 1.8, 1.8, 1.8, 0.6, 0.9, 2., 2.
+         !Config Help  =
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_METHANOL',em_factor_methanol)
+
+         !Config Key   = EM_FACTOR_ACETONE
+         !Config Desc  = Acetone emissions factor
+         !Config if    = DIFFUCO_OK_INCA 
+         !Config Def   = 0., 0.29, 0.29, 0.87, 0.43, 0.29, 0.87, 0.87, 0.87, 0.29, 0.43, 0.07, 0.07 
+         !Config Help  =
+         !Config Units = [ugC/g/h]     
+         CALL getin_p('EM_FACTOR_ACETONE',em_factor_acetone)
+
+         !Config Key   = EM_FACTOR_ACETAL
+         !Config Desc  = Acetaldehyde emissions factor 
+         !Config if    = DIFFUCO_OK_INCA
+         !Config Def   = 0., 0.1, 0.1, 0.3, 0.15, 0.1, 0.3, 0.3, 0.3, 0.1, 0.15, 0.025, 0.025
+         !Config Help  =
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_ACETAL',em_factor_acetal)
+
+         !Config Key   = EM_FACTOR_FORMAL
+         !Config Desc  = Formaldehyde emissions factor
+         !Config if    = DIFFUCO_OK_INCA 
+         !Config Def   = 0., 0.07, 0.07, 0.2, 0.1, 0.07, 0.2, 0.2, 0.2, 0.07, 0.1, 0.017, 0.017
+         !Config Help  = 
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_FORMAL',em_factor_formal)
+
+         !Config Key   = EM_FACTOR_ACETIC
+         !Config Desc  = Acetic Acid emissions factor
+         !Config if    = DIFFUCO_OK_INCA 
+         !Config Def   = 0., 0.002, 0.002, 0.006, 0.003, 0.002, 0.006, 0.006, 0.006, 0.002, 0.003, 0.0005, 0.0005
+         !Config Help  =
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_ACETIC',em_factor_acetic)
+
+         !Config Key   = EM_FACTOR_FORMIC
+         !Config Desc  = Formic Acid emissions factor
+         !Config if    = DIFFUCO_OK_INCA
+         !Config Def   = 0., 0.01, 0.01, 0.03, 0.015, 0.01, 0.03, 0.03, 0.03, 0.01, 0.015, 0.0025, 0.0025 
+         !Config Help  =
+         !Config Units = [ugC/g/h]  
+         CALL getin_p('EM_FACTOR_FORMIC',em_factor_formic)
+
+         !Config Key   = EM_FACTOR_NO_WET
+         !Config Desc  = NOx emissions factor wet soil emissions and exponential dependancy factor 
+         !Config if    = DIFFUCO_OK_INCA
+         !Config Def   = 0., 2.6, 0.06, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.36, 0.36, 0.36, 0.36
+         !Config Help  =
+         !Config Units = [ngN/m^2/s]
+         CALL getin_p('EM_FACTOR_NO_WET',em_factor_no_wet)
+
+         !Config Key   = EM_FACTOR_NO_DRY
+         !Config Desc  = NOx emissions factor dry soil emissions and exponential dependancy factor 
+         !Config if    = DIFFUCO_OK_INCA
+         !Config Def   = 0., 8.60, 0.40, 0.22, 0.22, 0.22, 0.22, 0.22, 0.22, 2.65, 2.65, 2.65, 2.65
+         !Config Help  =
+         !Config Units = [ngN/m^2/s] 
+         CALL getin_p('EM_FACTOR_NO_DRY',em_factor_no_dry)
+
+         !Config Key   = LARCH
+         !Config Desc  = Larcher 1991 SAI/LAI ratio
+         !Config if    = DIFFUCO_OK_INCA 
+         !Config Def   = 0., 0.015, 0.015, 0.003, 0.005, 0.005, 0.003, 0.005, 0.003, 0.005, 0.005, 0.008, 0.008
+         !Config Help  =
+         !Config Units = [-]  
+         CALL getin_p('LARCH',Larch)
+         
+      ENDIF ! (active_flags%ok_inca)
+
+      first_call = .FALSE.
+
+   ENDIF !(first_call)
+
+ END SUBROUTINE config_sechiba_pft_parameters
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : config_stomate_pft_parameters 
+!!
+!>\BRIEF         This subroutine will read the imposed values for the stomate pft
+!! parameters. It is not called if IMPOSE_PARAM is set to NO.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE config_stomate_pft_parameters
+
+   IMPLICIT NONE
+   
+   !! 0. Variables and parameters declaration
+
+   !! 0.4 Local variable
+
+   LOGICAL, SAVE ::  first_call = .TRUE.   !! To keep first call trace (true/false)
+!$OMP THREADPRIVATE(first_call)
+
+!_ ================================================================================================================================
+
+   IF (first_call) THEN
+      
+      !
+      ! Vegetation structure
+      !
+
+      !Config Key   = SLA
+      !Config Desc  = specif leaf area 
+      !Config if    = OK_STOMATE
+      !Config Def   = 1.5E-2, 1.53E-2, 2.6E-2, 9.26E-3, 2E-2, 2.6E-2, 9.26E-3, 2.6E-2, 1.9E-2, 2.6E-2, 2.6E-2, 2.6E-2, 2.6E-2
+      !Config Help  =
+      !Config Units = [m^2/gC]
+      CALL getin_p('SLA',sla)
+
+      !
+      ! Photosynthesis
+      !
+
+      !Config Key   = VCMAX_OPT
+      !Config Desc  = Maximum rate of carboxylation
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 65., 65., 35., 45., 55., 35., 45., 35., 70., 70., 70., 70.
+      !Config Help  =
+      !Config Units = [micromol/m^2/s]
+      CALL getin_p('VCMAX_OPT',vcmax_opt)
+
+      !Config Key   = VJMAX_OPT
+      !Config Desc  = Maximum rate of RUbp regeneration
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 130., 130., 70., 80., 110., 70., 90., 70., 160., 160., 200., 200.
+      !Config Help  =
+      !Config Units = [micromol/m^2/s]
+      CALL getin_p('VJMAX_OPT',vjmax_opt)
+
+      !Config Key   = TPHOTO_MIN_A
+      !Config Desc  = minimum photosynthesis temperature, constant a of ax^2+bx+c (deg C), tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef,  0., 0., 0., 0., 0., 0.,  0., 0.,  0.0025, 0., 0., 0. 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('TPHOTO_MIN_A',tphoto_min_a)
+
+      !Config Key   = TPHOTO_MIN_B
+      !Config Desc  = minimum photosynthesis temperature, constant b of ax^2+bx+c (deg C), tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef,  0.,  0., 0., 0., 0., 0., 0., 0., 0.1, 0.,0.,0.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('TPHOTO_MIN_B',tphoto_min_b)
+
+      !Config Key   = TPHOTO_MIN_C
+      !Config Desc  = minimum photosynthesis temperature, constant c of ax^2+bx+c (deg C), tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef,  2., 2., -4., -3.,-2.,-4., -4., -4., -3.25, 13.,-5.,13.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('TPHOTO_MIN_C',tphoto_min_c)
+
+      !Config Key   = TPHOTO_OPT_A
+      !Config Desc  = optimum photosynthesis temperature, constant a of ax^2+bx+c (deg C), tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0., 0., 0., 0., 0., 0., 0., 0., 0.0025, 0., 0., 0. 
+      !Config Help  = 
+      !Config Units = [-]
+      CALL getin_p('TPHOTO_OPT_A',tphoto_opt_a)
+
+      !Config Key   = TPHOTO_OPT_B
+      !Config Desc  = optimum photosynthesis temperature, constant b of ax^2+bx+c (deg C), tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0., 0., 0., 0., 0., 0., 0., 0., 0.25, 0., 0., 0.  
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('TPHOTO_OPT_B',tphoto_opt_b)
+
+      !Config Key   = TPHOTO_OPT_C
+      !Config Desc  = optimum photosynthesis temperature, constant c of ax^2+bx+c (deg C), tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 37., 37., 25., 32., 26., 25., 25., 25., 27.25, 36., 30., 36.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('TPHOTO_OPT_C',tphoto_opt_c)
+
+      !Config Key   = TPHOTO_MAX_A
+      !Config Desc  = maximum photosynthesis temperature, constant a of ax^2+bx+c (deg C), tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef,  0., 0., 0., 0., 0., 0., 0., 0., 0.00375, 0., 0., 0.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('TPHOTO_MAX_A',tphoto_max_a)
+
+      !Config Key   = TPHOTO_MAX_B
+      !Config Desc  = maximum photosynthesis temperature, constant b of ax^2+bx+c (deg C), tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0., 0., 0., 0., 0., 0., 0., 0.,0.35, 0., 0., 0.   
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('TPHOTO_MAX_B',tphoto_max_b)
+
+      !Config Key   = TPHOTO_MAX_C
+      !Config Desc  = maximum photosynthesis temperature, constant c of ax^2+bx+c (deg C), tabulated 
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 55., 55.,38., 48.,38.,38., 38., 38., 41.125, 55., 45., 55.  
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('TPHOTO_MAX_C',tphoto_max_c)
+
+      !
+      ! Respiration - stomate
+      !
+
+      !Config Key   = MAINT_RESP_SLOPE_C
+      !Config Desc  = slope of maintenance respiration coefficient (1/K), constant c of aT^2+bT+c , tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .12, .12, .16, .16, .16, .16, .16, .16, .16, .12, .16, .12 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('MAINT_RESP_SLOPE_C',maint_resp_slope_c) 
+
+      !Config Key   = MAINT_RESP_SLOPE_B
+      !Config Desc  = slope of maintenance respiration coefficient (1/K), constant b of aT^2+bT+c , tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .0, .0, .0, .0, .0, .0, .0, .0, -.00133, .0, -.00133, .0 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('MAINT_RESP_SLOPE_B',maint_resp_slope_b)
+
+      !Config Key   = MAINT_RESP_SLOPE_A
+      !Config Desc  = slope of maintenance respiration coefficient (1/K), constant a of aT^2+bT+c , tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0    
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('MAINT_RESP_SLOPE_A',maint_resp_slope_a)
+
+      !Config Key   = CM_ZERO_LEAF
+      !Config Desc  = maintenance respiration coefficient at 0 deg C, for leaves, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 2.35E-3, 2.62E-3, 1.01E-3, 2.35E-3, 2.62E-3, 1.01E-3,2.62E-3, 2.05E-3, 2.62E-3, 2.62E-3, 2.62E-3, 2.62E-3
+      !Config Help  =
+      !Config Units = [g/g/day]
+      CALL getin_p('CM_ZERO_LEAF',cm_zero_leaf)
+
+      !Config Key   = CM_ZERO_SAPABOVE
+      !Config Desc  = maintenance respiration coefficient at 0 deg C,for sapwood above, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4
+      !Config Help  =
+      !Config Units = [g/g/day]
+      CALL getin_p('CM_ZERO_SAPABOVE',cm_zero_sapabove)
+
+      !Config Key   = CM_ZERO_SAPBELOW
+      !Config Desc  = maintenance respiration coefficient at 0 deg C, for sapwood below, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4 
+      !Config Help  =
+      !Config Units = [g/g/day]
+      CALL getin_p('CM_ZERO_SAPBELOW',cm_zero_sapbelow)
+
+      !Config Key   = CM_ZERO_HEARTABOVE
+      !Config Desc  = maintenance respiration coefficient at 0 deg C, for heartwood above, tabulated
+      !Config if    = OK_STOMATE 
+      !Config Def   = undef, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. 
+      !Config Help  =
+      !Config Units = [g/g/day]
+      CALL getin_p('CM_ZERO_HEARTABOVE',cm_zero_heartabove)
+
+      !Config Key   = CM_ZERO_HEARTBELOW
+      !Config Desc  = maintenance respiration coefficient at 0 deg C,for heartwood below, tabulated
+      !Config if    = OK_STOMATE 
+      !Config Def   = undef, 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. 
+      !Config Help  =
+      !Config Units = [g/g/day] 
+      CALL getin_p('CM_ZERO_HEARTBELOW',cm_zero_heartbelow)
+
+      !Config Key   = CM_ZERO_ROOT
+      !Config Desc  = maintenance respiration coefficient at 0 deg C, for roots, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef,1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3,1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3, 1.67E-3
+      !Config Help  =
+      !Config Units = [g/g/day] 
+      CALL getin_p('CM_ZERO_ROOT',cm_zero_root)
+
+      !Config Key   = CM_ZERO_FRUIT
+      !Config Desc  = maintenance respiration coefficient at 0 deg C, for fruits, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4,1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4    
+      !Config Help  =
+      !Config Units = [g/g/day] 
+      CALL getin_p('CM_ZERO_FRUIT',cm_zero_fruit)
+
+      !Config Key   = CM_ZERO_CARBRES
+      !Config Desc  = maintenance respiration coefficient at 0 deg C, for carbohydrate reserve, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4,1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4, 1.19E-4
+      !Config Help  =
+      !Config Units = [g/g/day] 
+      CALL getin_p('CM_ZERO_CARBRES',cm_zero_carbres)
+      
+      !
+      ! Fire - stomate
+      !
+
+      !Config Key   = FLAM
+      !Config Desc  = flamability: critical fraction of water holding capacity
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .15, .25, .25, .25, .25, .25, .25, .25, .25, .25, .35, .35
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('FLAM',flam)
+
+      !Config Key   = RESIST
+      !Config Desc  = fire resistance
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .95, .90, .12, .50, .12, .12, .12, .12, .0, .0, .0, .0 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('RESIST',resist)
+     
+      !
+      ! Flux - LUC
+      !
+
+      !Config Key   = COEFF_LCCHANGE_1
+      !Config Desc  = Coeff of biomass export for the year
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597, 0.597 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('COEFF_LCCHANGE_1',coeff_lcchange_1)
+
+      !Config Key   = COEFF_LCCHANGE_10
+      !Config Desc  = Coeff of biomass export for the decade
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0.403, 0.403, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.299, 0.403, 0.299, 0.403
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('COEFF_LCCHANGE_10',coeff_lcchange_10)
+
+      !Config Key   = COEFF_LCCHANGE_100
+      !Config Desc  = Coeff of biomass export for the century
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0., 0., 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0.104, 0., 0.104, 0.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('COEFF_LCCHANGE_100',coeff_lcchange_100)
+      
+      !
+      ! Phenology
+      !
+
+      !Config Key   = LAI_MAX
+      !Config Desc  = maximum LAI, PFT-specific
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 7., 7., 5., 5., 5., 4.5, 4.5, 3.0, 2.5, 2.5, 5.,5. 
+      !Config Help  =
+      !Config Units = [m^2/m^2]
+      CALL getin_p('LAI_MAX',lai_max)
+
+      !Config Key   = PHENO_TYPE
+      !Config Desc  = type of phenology, 0=bare ground 1=evergreen,  2=summergreen,  3=raingreen,  4=perennial
+      !Config if    = OK_STOMATE
+      !Config Def   = 0, 1, 3, 1, 1, 2, 1, 2, 2, 4, 4, 2, 3
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('PHENO_TYPE',pheno_type)
+
+      !
+      ! Phenology : Leaf Onset
+      !
+
+      !Config Key   = PHENO_GDD_CRIT_C
+      !Config Desc  = critical gdd, tabulated (C), constant c of aT^2+bT+c
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 270., 400., 125., 400.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('PHENO_GDD_CRIT_C',pheno_gdd_crit_c)
+
+      !Config Key   = PHENO_GDD_CRIT_B
+      !Config Desc  = critical gdd, tabulated (C), constant b of aT^2+bT+c
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef,undef, undef, 6.25, 0., 0., 0.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('PHENO_GDD_CRIT_B',pheno_gdd_crit_b)
+
+      !Config Key   = PHENO_GDD_CRIT_A
+      !Config Desc  = critical gdd, tabulated (C), constant a of aT^2+bT+c
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 0.03125,  0., 0., 0.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('PHENO_GDD_CRIT_A',pheno_gdd_crit_a)
+
+      !Config Key   = NGD_CRIT
+      !Config Desc  = critical ngd, tabulated. Threshold -5 degrees
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, 0., undef, undef, undef, undef, undef
+      !Config Help  = NGD : Number of Growing Days.
+      !Config Units = [days]
+      CALL getin_p('NGD_CRIT',ngd_crit)
+
+      !Config Key   = NCDGDD_TEMP
+      !Config Desc  = critical temperature for the ncd vs. gdd function in phenology
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, 5., undef, 0., undef, undef, undef, undef, undef
+      !Config Help  =
+      !Config Units = [C] 
+      CALL getin_p('NCDGDD_TEMP',ncdgdd_temp)
+
+      !Config Key   = HUM_FRAC
+      !Config Desc  = critical humidity (relative to min/max) for phenology
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, .5, undef, undef, undef, undef, undef,  undef, .5, .5, .5,.5     
+      !Config Help  =
+      !Config Units = [%]
+      CALL getin_p('HUM_FRAC',hum_frac)
+
+      !Config Key   = HUM_MIN_TIME
+      !Config Desc  = minimum time elapsed since moisture minimum
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, 50., undef, undef, undef, undef, undef, undef, 35., 35., 75., 75.
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('HUM_MIN_TIME',hum_min_time)
+
+      !Config Key   = TAU_SAP
+      !Config Desc  = sapwood -> heartwood conversion time
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 730., 730., 730., 730., 730., 730., 730., 730., undef, undef, undef, undef
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('TAU_SAP',tau_sap)
+
+      !Config Key   = TAU_FRUIT
+      !Config Desc  = fruit lifetime
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 90., 90., 90., 90., 90., 90., 90., 90., undef, undef, undef, undef
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('TAU_FRUIT',tau_fruit)
+
+      !Config Key   = ECUREUIL
+      !Config Desc  = fraction of primary leaf and root allocation put into reserve
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .0, 1., .0, .0, 1., .0, 1., 1., 1., 1., 1., 1.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('ECUREUIL',ecureuil)
+
+      !Config Key   = ALLOC_MIN
+      !Config Desc  = minimum allocation above/below = f(age) - 30/01/04 NV/JO/PF
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, undef, undef, undef, undef 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('ALLOC_MIN',alloc_min)
+
+      !Config Key   = ALLOC_MAX
+      !Config Desc  = maximum allocation above/below = f(age) - 30/01/04 NV/JO/PF
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, undef, undef, undef, undef
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('ALLOC_MAX',alloc_max)
+
+      !Config Key   = DEMI_ALLOC 
+      !Config Desc  = mean allocation above/below = f(age) - 30/01/04 NV/JO/PF
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 5., 5., 5., 5., 5., 5., 5., 5., undef, undef, undef, undef
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('DEMI_ALLOC',demi_alloc)
+
+      !Config Key   = LEAFLIFE_TAB
+      !Config Desc  = leaf longevity
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, .5, 2., .33, 1., 2., .33, 2., 2., 2., 2., 2., 2. 
+      !Config Help  =
+      !Config Units = [years]
+      CALL getin_p('LEAFLIFE_TAB',leaflife_tab)
+
+      !
+      ! Phenology : Senescence
+      !
+      !
+      !Config Key   = LEAFFALL
+      !Config Desc  = length of death of leaves, tabulated 
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, 10., undef, undef, 10., undef, 10., 10., 10., 10., 10., 10. 
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('LEAFFALL',leaffall)
+
+      !Config Key   = LEAFAGECRIT
+      !Config Desc  = critical leaf age, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, 730., 180., 910., 730., 180., 910., 180., 180., 120., 120., 90., 90.  
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('LEAFAGECRIT',leafagecrit) 
+
+      !Config Key   = SENESCENCE_TYPE
+      !Config Desc  = type of senescence, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = none, none, dry, none, none, cold, none, cold, cold, mixed, mixed, mixed, mixed 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('SENESCENCE_TYPE',senescence_type) 
+
+      !Config Key   = SENESCENCE_HUM
+      !Config Desc  = critical relative moisture availability for senescence
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, .3, undef, undef, undef, undef, undef, undef, .2, .2, .3, .2 
+      !Config Help  =
+      !Config Units = [-] 
+      CALL getin_p('SENESCENCE_HUM',senescence_hum)
+
+      !Config Key   = NOSENESCENCE_HUM
+      !Config Desc  = relative moisture availability above which there is no humidity-related senescence
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, .8, undef, undef, undef, undef, undef, undef, .3, .3, .3, .3 
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('NOSENESCENCE_HUM',nosenescence_hum) 
+
+      !Config Key   = MAX_TURNOVER_TIME
+      !Config Desc  = maximum turnover time for grasse
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef,  80.,  80., 80., 80. 
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('MAX_TURNOVER_TIME',max_turnover_time)
+
+      !Config Key   = MIN_TURNOVER_TIME
+      !Config Desc  = minimum turnover time for grasse 
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, 10., 10., 10., 10. 
+      !Config Help  =
+      !Config Units = [days]
+      CALL getin_p('MIN_TURNOVER_TIME',min_turnover_time)
+
+      !Config Key   = MIN_LEAF_AGE_FOR_SENESCENCE
+      !Config Desc  = minimum leaf age to allow senescence g
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, 90., undef, undef, 90., undef, 60., 60., 30., 30., 30., 30.
+      !Config Help  =
+      !Config Units = [days] 
+      CALL getin_p('MIN_LEAF_AGE_FOR_SENESCENCE',min_leaf_age_for_senescence)
+
+      !Config Key   = SENESCENCE_TEMP_C
+      !Config Desc  = critical temperature for senescence (C), constant c of aT^2+bT+c, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, 12., undef, 7., 2., -1.375, 5., 5., 10.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('SENESCENCE_TEMP_C',senescence_temp_c)
+
+      !Config Key   = SENESCENCE_TEMP_B
+      !Config Desc  = critical temperature for senescence (C), constant b of aT^2+bT+c ,tabulated
+      !Config if    = OK_STOMATE 
+      !Config Def   = undef, undef, undef, undef, undef, 0., undef, 0., 0., .1, 0., 0., 0.
+      !Config Help  =
+      !Config Units = [-]
+      CALL getin_p('SENESCENCE_TEMP_B',senescence_temp_b)
+
+      !Config Key   = SENESCENCE_TEMP_A
+      !Config Desc  = critical temperature for senescence (C), constant a of aT^2+bT+c , tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, 0., undef, 0., 0.,.00375, 0., 0., 0. 
+      !Config Help  =
+      !Config Units = [-] 
+      CALL getin_p('SENESCENCE_TEMP_A',senescence_temp_a)
+
+      !Config Key   = GDD_SENESCENCE
+      !Config Desc  = minimum gdd to allow senescence of crops  
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, 950., 4000.
+      !Config Help  =
+      !Config Units = [days] 
+      CALL getin_p("GDD_SENESCENCE", gdd_senescence)
+
+      
+      !
+      ! DGVM
+      !
+
+      !Config Key   = RESIDENCE_TIME
+      !Config Desc  = residence time of trees
+      !Config if    = OK_DGVM and NOT(LPJ_GAP_CONST_MORT)
+      !Config Def   = undef, 30.0, 30.0, 40.0, 40.0, 40.0, 80.0, 80.0, 80.0, 0.0, 0.0, 0.0, 0.0 
+      !Config Help  =
+      !Config Units = [years]
+      CALL getin_p('RESIDENCE_TIME',residence_time)
+
+      !Config Key   = TMIN_CRIT
+      !Config Desc  = critical tmin, tabulated
+      !Config if    = OK_STOMATE
+      !Config Def   = undef,  0.0, 0.0, -30.0, -14.0, -30.0, -45.0, -45.0, undef, undef, undef, undef, undef
+      !Config Help  = 
+      !Config Units = [C]
+      CALL getin_p('TMIN_CRIT',tmin_crit)
+
+      !Config Key   = TCM_CRIT
+      !Config Desc  = critical tcm, tabulated 
+      !Config if    = OK_STOMATE
+      !Config Def   = undef, undef, undef, 5.0, 15.5, 15.5, -8.0, -8.0, -8.0, undef, undef, undef, undef
+      !Config Help  =
+      !Config Units = [C]
+      CALL getin_p('TCM_CRIT',tcm_crit)
+      
+      first_call = .FALSE.
+       
+   ENDIF !(first_call)
+  
+ END SUBROUTINE config_stomate_pft_parameters
+!
+!=
+!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pft_parameters_clear
+!!
+!>\BRIEF         This subroutine deallocates memory at the end of the simulation. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE pft_parameters_clear
+   
+   l_first_pft_parameters = .TRUE.
+   
+   IF (ALLOCATED(pft_to_mtc)) DEALLOCATE(pft_to_mtc)
+   IF (ALLOCATED(PFT_name)) DEALLOCATE(PFT_name)
+   IF (ALLOCATED(veget_ori_fixed_test_1)) DEALLOCATE(veget_ori_fixed_test_1)   
+   IF (ALLOCATED(llaimax)) DEALLOCATE(llaimax)
+   IF (ALLOCATED(llaimin)) DEALLOCATE(llaimin)
+   IF (ALLOCATED(height_presc)) DEALLOCATE(height_presc)   
+   IF (ALLOCATED(type_of_lai)) DEALLOCATE(type_of_lai)
+   IF (ALLOCATED(is_tree)) DEALLOCATE(is_tree)
+   IF (ALLOCATED(natural)) DEALLOCATE(natural)
+   IF (ALLOCATED(is_deciduous)) DEALLOCATE(is_deciduous)
+   IF (ALLOCATED(is_evergreen)) DEALLOCATE(is_evergreen)
+   IF (ALLOCATED(is_needleleaf)) DEALLOCATE(is_needleleaf)
+   IF (ALLOCATED(is_tropical)) DEALLOCATE(is_tropical)
+   IF (ALLOCATED(humcste)) DEALLOCATE(humcste)
+   IF (ALLOCATED(pref_soil_veg)) DEALLOCATE(pref_soil_veg)
+   IF (ALLOCATED(is_c4)) DEALLOCATE(is_c4)  
+   IF (ALLOCATED(gsslope)) DEALLOCATE(gsslope)
+   IF (ALLOCATED(gsoffset)) DEALLOCATE(gsoffset)
+   IF (ALLOCATED(vcmax_fix)) DEALLOCATE(vcmax_fix)
+   IF (ALLOCATED(vjmax_fix)) DEALLOCATE(vjmax_fix)
+   IF (ALLOCATED(co2_tmin_fix)) DEALLOCATE(co2_tmin_fix)
+   IF (ALLOCATED(co2_topt_fix)) DEALLOCATE(co2_topt_fix)
+   IF (ALLOCATED(co2_tmax_fix)) DEALLOCATE(co2_tmax_fix) 
+   IF (ALLOCATED(ext_coeff)) DEALLOCATE(ext_coeff)
+   IF (ALLOCATED(rveg_pft)) DEALLOCATE(rveg_pft)
+   IF (ALLOCATED(rstruct_const)) DEALLOCATE(rstruct_const)
+   IF (ALLOCATED(kzero)) DEALLOCATE(kzero)
+   IF (ALLOCATED(wmax_veg)) DEALLOCATE(wmax_veg)
+   IF (ALLOCATED(throughfall_by_pft)) DEALLOCATE(throughfall_by_pft)
+   IF (ALLOCATED(snowa_ini)) DEALLOCATE(snowa_ini)
+   IF (ALLOCATED(snowa_dec)) DEALLOCATE(snowa_dec)
+   IF (ALLOCATED(alb_leaf_vis)) DEALLOCATE(alb_leaf_vis)
+   IF (ALLOCATED(alb_leaf_nir)) DEALLOCATE(alb_leaf_nir)   
+   IF (ALLOCATED(em_factor_isoprene)) DEALLOCATE(em_factor_isoprene)
+   IF (ALLOCATED(em_factor_monoterpene)) DEALLOCATE(em_factor_monoterpene)
+   IF (ALLOCATED(em_factor_ORVOC)) DEALLOCATE(em_factor_ORVOC)
+   IF (ALLOCATED(em_factor_OVOC)) DEALLOCATE(em_factor_OVOC)
+   IF (ALLOCATED(em_factor_MBO)) DEALLOCATE(em_factor_MBO)
+   IF (ALLOCATED(em_factor_methanol)) DEALLOCATE(em_factor_methanol)
+   IF (ALLOCATED(em_factor_acetone)) DEALLOCATE(em_factor_acetone)
+   IF (ALLOCATED(em_factor_acetal)) DEALLOCATE(em_factor_acetal)
+   IF (ALLOCATED(em_factor_formal)) DEALLOCATE(em_factor_formal)
+   IF (ALLOCATED(em_factor_acetic)) DEALLOCATE(em_factor_acetic)
+   IF (ALLOCATED(em_factor_formic)) DEALLOCATE(em_factor_formic)
+   IF (ALLOCATED(em_factor_no_wet)) DEALLOCATE(em_factor_no_wet)
+   IF (ALLOCATED(em_factor_no_dry)) DEALLOCATE(em_factor_no_dry)
+   IF (ALLOCATED(Larch)) DEALLOCATE(Larch)
+   IF (ALLOCATED(leaf_tab)) DEALLOCATE(leaf_tab)
+   IF (ALLOCATED(sla)) DEALLOCATE(sla)
+   IF (ALLOCATED(vcmax_opt)) DEALLOCATE(vcmax_opt)
+   IF (ALLOCATED(vjmax_opt)) DEALLOCATE(vjmax_opt)
+   IF (ALLOCATED(tphoto_min_a)) DEALLOCATE(tphoto_min_a)
+   IF (ALLOCATED(tphoto_min_b)) DEALLOCATE(tphoto_min_b)
+   IF (ALLOCATED(tphoto_min_c)) DEALLOCATE(tphoto_min_c)
+   IF (ALLOCATED(tphoto_opt_a)) DEALLOCATE(tphoto_opt_a)
+   IF (ALLOCATED(tphoto_opt_b)) DEALLOCATE(tphoto_opt_b)
+   IF (ALLOCATED(tphoto_opt_c)) DEALLOCATE(tphoto_opt_c)
+   IF (ALLOCATED(tphoto_max_a)) DEALLOCATE(tphoto_max_a)
+   IF (ALLOCATED(tphoto_max_b)) DEALLOCATE(tphoto_max_b)
+   IF (ALLOCATED(tphoto_max_c)) DEALLOCATE(tphoto_max_c)
+   IF (ALLOCATED(maint_resp_slope)) DEALLOCATE(maint_resp_slope)
+   IF (ALLOCATED(maint_resp_slope_c)) DEALLOCATE(maint_resp_slope_c)
+   IF (ALLOCATED(maint_resp_slope_b)) DEALLOCATE(maint_resp_slope_b)
+   IF (ALLOCATED(maint_resp_slope_a)) DEALLOCATE(maint_resp_slope_a)
+   IF (ALLOCATED(coeff_maint_zero)) DEALLOCATE(coeff_maint_zero)
+   IF (ALLOCATED(cm_zero_leaf)) DEALLOCATE(cm_zero_leaf)
+   IF (ALLOCATED(cm_zero_sapabove)) DEALLOCATE(cm_zero_sapabove)
+   IF (ALLOCATED(cm_zero_sapbelow)) DEALLOCATE(cm_zero_sapbelow)
+   IF (ALLOCATED(cm_zero_heartabove)) DEALLOCATE(cm_zero_heartabove)
+   IF (ALLOCATED(cm_zero_heartbelow)) DEALLOCATE(cm_zero_heartbelow)
+   IF (ALLOCATED(cm_zero_root)) DEALLOCATE(cm_zero_root)
+   IF (ALLOCATED(cm_zero_fruit)) DEALLOCATE(cm_zero_fruit)
+   IF (ALLOCATED(cm_zero_carbres)) DEALLOCATE(cm_zero_carbres)
+   IF (ALLOCATED(flam)) DEALLOCATE(flam)
+   IF (ALLOCATED(resist)) DEALLOCATE(resist)
+   IF (ALLOCATED(coeff_lcchange_1)) DEALLOCATE(coeff_lcchange_1)
+   IF (ALLOCATED(coeff_lcchange_10)) DEALLOCATE(coeff_lcchange_10)
+   IF (ALLOCATED(coeff_lcchange_100)) DEALLOCATE(coeff_lcchange_100)
+   IF (ALLOCATED(lai_max)) DEALLOCATE(lai_max)
+   IF (ALLOCATED(pheno_model)) DEALLOCATE(pheno_model)
+   IF (ALLOCATED(pheno_type)) DEALLOCATE(pheno_type)
+   IF (ALLOCATED(pheno_gdd_crit_c)) DEALLOCATE(pheno_gdd_crit_c)
+   IF (ALLOCATED(pheno_gdd_crit_b)) DEALLOCATE(pheno_gdd_crit_b)
+   IF (ALLOCATED(pheno_gdd_crit_a)) DEALLOCATE(pheno_gdd_crit_a)
+   IF (ALLOCATED(pheno_gdd_crit)) DEALLOCATE(pheno_gdd_crit)
+   IF (ALLOCATED(ngd_crit)) DEALLOCATE(ngd_crit)
+   IF (ALLOCATED(ncdgdd_temp)) DEALLOCATE(ncdgdd_temp)
+   IF (ALLOCATED(hum_frac)) DEALLOCATE(hum_frac)
+   IF (ALLOCATED(hum_min_time)) DEALLOCATE(hum_min_time)
+   IF (ALLOCATED(tau_sap)) DEALLOCATE(tau_sap)
+   IF (ALLOCATED(tau_fruit)) DEALLOCATE(tau_fruit)
+   IF (ALLOCATED(ecureuil)) DEALLOCATE(ecureuil)
+   IF (ALLOCATED(alloc_min)) DEALLOCATE(alloc_min)
+   IF (ALLOCATED(alloc_max)) DEALLOCATE(alloc_max)
+   IF (ALLOCATED(demi_alloc)) DEALLOCATE(demi_alloc)
+   IF (ALLOCATED(leaflife_tab)) DEALLOCATE(leaflife_tab)
+   IF (ALLOCATED(leaffall)) DEALLOCATE(leaffall)
+   IF (ALLOCATED(leafagecrit)) DEALLOCATE(leafagecrit)
+   IF (ALLOCATED(senescence_type)) DEALLOCATE(senescence_type)
+   IF (ALLOCATED(senescence_hum)) DEALLOCATE(senescence_hum)
+   IF (ALLOCATED(nosenescence_hum)) DEALLOCATE(nosenescence_hum)
+   IF (ALLOCATED(max_turnover_time)) DEALLOCATE(max_turnover_time)
+   IF (ALLOCATED(min_turnover_time)) DEALLOCATE(min_turnover_time)
+   IF (ALLOCATED(min_leaf_age_for_senescence)) DEALLOCATE(min_leaf_age_for_senescence)
+   IF (ALLOCATED(senescence_temp_c)) DEALLOCATE(senescence_temp_c)
+   IF (ALLOCATED(senescence_temp_b)) DEALLOCATE(senescence_temp_b)
+   IF (ALLOCATED(senescence_temp_a)) DEALLOCATE(senescence_temp_a)
+   IF (ALLOCATED(senescence_temp)) DEALLOCATE(senescence_temp)
+   IF (ALLOCATED(gdd_senescence)) DEALLOCATE(gdd_senescence)
+   IF (ALLOCATED(residence_time)) DEALLOCATE(residence_time)
+   IF (ALLOCATED(tmin_crit)) DEALLOCATE(tmin_crit)
+   IF (ALLOCATED(tcm_crit)) DEALLOCATE(tcm_crit)
+   IF (ALLOCATED(lai_initmin)) DEALLOCATE(lai_initmin)
+   IF (ALLOCATED(bm_sapl)) DEALLOCATE(bm_sapl)
+   IF (ALLOCATED(migrate)) DEALLOCATE(migrate)
+   IF (ALLOCATED(maxdia)) DEALLOCATE(maxdia)
+   IF (ALLOCATED(cn_sapl)) DEALLOCATE(cn_sapl)
+   IF (ALLOCATED(leaf_timecst)) DEALLOCATE(leaf_timecst)
+   
+ END SUBROUTINE pft_parameters_clear
+
+END MODULE pft_parameters
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/pft_parameters_var.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/pft_parameters_var.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_parameters/pft_parameters_var.f90	(revision 5166)
@@ -0,0 +1,568 @@
+! =================================================================================================================================
+! MODULE       : pft_parameters_var
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module contains the variables in function of plant funtional type (pft).
+!!
+!!\n DESCRIPTION: This module contains the declarations for the externalized variables in function of the 
+!!                plant foncional type(pft). \n
+!!                The module is already USE in module pft_parameters. Therefor no need to USE it seperatly except
+!!                if the subroutines in module pft_parameters are not needed.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE pft_parameters_var
+
+  USE defprec
+  
+  IMPLICIT NONE
+
+
+  !
+  ! PFT GLOBAL
+  !
+  INTEGER(i_std), SAVE :: nvm = 13                               !! Number of vegetation types (2-N, unitless)
+!$OMP THREADPRIVATE(nvm)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pft_to_mtc  !! Table of conversion : we associate one pft to one metaclass 
+                                                                 !! (1-13, unitless)
+!$OMP THREADPRIVATE(pft_to_mtc)
+
+  CHARACTER(LEN=34), ALLOCATABLE, SAVE, DIMENSION(:) :: PFT_name !! Description of the PFT (unitless)
+!$OMP THREADPRIVATE(PFT_name)
+
+  LOGICAL, SAVE   :: l_first_pft_parameters = .TRUE.             !! To keep first call trace of the module (true/false)
+!$OMP THREADPRIVATE(l_first_pft_parameters)
+  LOGICAL, SAVE   :: ok_throughfall_by_pft = .FALSE.             !! Flag to use the parameter PERCENT_THROUGHFALL_PFT (true/false) 
+!$OMP THREADPRIVATE(ok_throughfall_by_pft)
+
+
+  !
+  ! VEGETATION STRUCTURE
+  !
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaf_tab       !! leaf type (1-4, unitless)
+                                                                    !! 1=broad leaved tree, 2=needle leaved tree, 
+                                                                    !! 3=grass 4=bare ground 
+!$OMP THREADPRIVATE(leaf_tab)
+
+  CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_model  !! which phenology model is used? (tabulated) (unitless)
+!$OMP THREADPRIVATE(pheno_model)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_tree               !! Is the vegetation type a tree ? (true/false)
+!$OMP THREADPRIVATE(is_tree)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_deciduous          !! Is PFT deciduous ? (true/false)
+!$OMP THREADPRIVATE(is_deciduous)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_evergreen          !! Is PFT evegreen ? (true/false)
+!$OMP THREADPRIVATE(is_evergreen)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_needleleaf         !! Is PFT needleleaf ? (true/false)
+!$OMP THREADPRIVATE(is_needleleaf)
+ 
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_tropical           !! Is PFT tropical ? (true/false)
+!$OMP THREADPRIVATE(is_tropical)
+
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: natural               !! natural? (true/false)
+!$OMP THREADPRIVATE(natural)
+
+  CHARACTER(len=5), ALLOCATABLE, SAVE, DIMENSION(:) :: type_of_lai  !! Type of behaviour of the LAI evolution algorithm 
+                                                                    !! for each vegetation type.
+                                                                    !! Value of type_of_lai, one for each vegetation type :
+                                                                    !! mean or interp
+!$OMP THREADPRIVATE(type_of_lai)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: veget_ori_fixed_test_1 !! Value for veget_ori for tests in 0-dim simulations 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(veget_ori_fixed_test_1)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: llaimax                !! laimax for maximum lai see also type of lai 
+                                                                         !! interpolation
+                                                                         !! @tex $(m^2.m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(llaimax)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: llaimin                !! laimin for minimum lai see also type of lai 
+                                                                         !! interpolation 
+                                                                         !! @tex $(m^2.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(llaimin)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: height_presc           !! prescribed height of vegetation.(m)
+                                                                         !! Value for height_presc : one for each vegetation type
+!$OMP THREADPRIVATE(height_presc)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) ::  rveg_pft              !! Potentiometer to set vegetation resistance (unitless)
+                                                                         !! Nathalie on March 28th, 2006 - from Fred Hourdin,
+!$OMP THREADPRIVATE(rveg_pft)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: sla                    !! specif leaf area @tex $(m^2.gC^{-1})$ @endtex 
+!$OMP THREADPRIVATE(sla)
+
+  !
+  ! EVAPOTRANSPIRATION (sechiba)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: rstruct_const          !! Structural resistance. 
+                                                                         !! Value for rstruct_const : one for each vegetation type
+                                                                         !! @tex $(s.m^{-1})$ @endtex
+!$OMP THREADPRIVATE(rstruct_const)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: kzero                  !! A vegetation dependent constant used in the calculation
+                                                                         !! of the surface resistance. 
+                                                                         !! Value for kzero one for each vegetation type
+                                                                         !! @tex $(kg.m^2.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(kzero)
+
+  !
+  ! WATER (sechiba)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: wmax_veg  !! Volumetric available soil water capacity in each PFT
+                                                            !! @tex $(kg.m^{-3} of soil)$ @endtex
+!$OMP THREADPRIVATE(wmax_veg)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: humcste   !! Root profile description for the different vegetation types.
+                                                            !! These are the factor in the exponential which gets
+                                                            !! the root density as a function of depth 
+                                                            !! @tex $(m^{-1})$ @endtex
+!$OMP THREADPRIVATE(humcste)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: throughfall_by_pft !! Fraction of rain intercepted by the canopy (0-100, unitless)
+!$OMP THREADPRIVATE(throughfall_by_pft)
+
+  !
+  ! ALBEDO (sechiba)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_ini     !! Initial snow albedo value for each vegetation type
+                                                                !! as it will be used in condveg_snow (unitless)
+                                                                !! Source : Values are from the Thesis of S. Chalita (1992)
+!$OMP THREADPRIVATE(snowa_ini)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: snowa_dec     !! Decay rate of snow albedo value for each vegetation type
+                                                                !! as it will be used in condveg_snow (unitless)
+                                                                !! Source : Values are from the Thesis of S. Chalita (1992)
+!$OMP THREADPRIVATE(snowa_dec)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alb_leaf_vis  !! leaf albedo of vegetation type, visible albedo (unitless)
+!$OMP THREADPRIVATE(alb_leaf_vis)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alb_leaf_nir  !! leaf albedo of vegetation type, near infrared albedo (unitless)
+!$OMP THREADPRIVATE(alb_leaf_nir)
+
+  !
+  ! SOIL - VEGETATION
+  !
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pref_soil_veg      !! Table which contains the correlation between the soil
+                                                                        !! types and vegetation type. Two modes exist :
+                                                                        !! 1) pref_soil_veg = 0 then we have an equidistribution
+                                                                        !!    of vegetation on soil types
+                                                                        !! 2) Else for each pft the prefered soil type is given :
+                                                                        !!    1=sand, 2=loan, 3=clay
+                                                                        !! This variable is initialized in slowproc.(1-3, unitless)
+!$OMP THREADPRIVATE(pref_soil_veg)
+
+  !
+  ! PHOTOSYNTHESIS
+  !
+  !-
+  ! 1. CO2
+  !-
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:) :: is_c4             !! flag for C4 vegetation types (true/false)
+!$OMP THREADPRIVATE(is_c4)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gsslope       !! Slope of the gs/A relation (Ball & al.) (unitless)
+!$OMP THREADPRIVATE(gsslope)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gsoffset      !! intercept of the gs/A relation (Ball & al.) 
+!$OMP THREADPRIVATE(gsoffset)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: vcmax_fix     !! values used for vcmax when STOMATE is not activated
+                                                                !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(vcmax_fix)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: vjmax_fix     !! values used for vjmax when STOMATE is not activated 
+                                                                !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(vjmax_fix)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: co2_tmin_fix  !! values used for photosynthesis tmin when STOMATE 
+                                                                !! is not activated (C)
+!$OMP THREADPRIVATE(co2_tmin_fix)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: co2_topt_fix  !! values used for photosynthesis topt when STOMATE 
+                                                                !! is not activated (C)
+!$OMP THREADPRIVATE(co2_topt_fix)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: co2_tmax_fix  !! values used for photosynthesis tmax when STOMATE 
+                                                                !! is not activated (C)
+!$OMP THREADPRIVATE(co2_tmax_fix)
+
+  !-
+  ! 2. Stomate
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ext_coeff     !! extinction coefficient of the Monsi&Saeki relationship (1953)
+                                                                !! (unitless)
+!$OMP THREADPRIVATE(ext_coeff)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: vcmax_opt     !! Maximum rate of carboxylation
+                                                                !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(vcmax_opt)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: vjmax_opt     !! Maximum rate of RUbp regeneration 
+                                                                !! @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(vjmax_opt)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_min_a  !! minimum photosynthesis temperature, 
+                                                                !! constant a of ax^2+bx+c (deg C),tabulated (unitless)
+!$OMP THREADPRIVATE(tphoto_min_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_min_b  !! minimum photosynthesis temperature, 
+                                                                !! constant b of ax^2+bx+c (deg C),tabulated (unitless)
+!$OMP THREADPRIVATE(tphoto_min_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_min_c  !! minimum photosynthesis temperature, 
+                                                                !! constant c of ax^2+bx+c (deg C),tabulated (unitless)
+!$OMP THREADPRIVATE(tphoto_min_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_opt_a  !! optimum photosynthesis temperature, 
+                                                                !! constant a of ax^2+bx+c (deg C),tabulated (unitless)
+!$OMP THREADPRIVATE(tphoto_opt_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_opt_b  !! optimum photosynthesis temperature,
+                                                                !! constant b of ax^2+bx+c (deg C),tabulated (unitless)
+!$OMP THREADPRIVATE(tphoto_opt_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_opt_c  !! optimum photosynthesis temperature, 
+                                                                !! constant c of ax^2+bx+c (deg C),tabulated (unitless)
+!$OMP THREADPRIVATE(tphoto_opt_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_max_a  !! maximum photosynthesis temperature, 
+                                                                !! constant a of ax^2+bx+c (deg C), tabulated (unitless)
+!$OMP THREADPRIVATE(tphoto_max_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_max_b  !! maximum photosynthesis temperature, 
+                                                                !! constant b of ax^2+bx+c (deg C), tabulated (unitless)
+!$OMP THREADPRIVATE(tphoto_max_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tphoto_max_c  !! maximum photosynthesis temperature, 
+                                                                !! constant c of ax^2+bx+c (deg C), tabulated (unitless)
+!$OMP THREADPRIVATE(tphoto_max_c)
+
+
+  !
+  ! RESPIRATION (stomate)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: maint_resp_slope  !! slope of maintenance respiration coefficient 
+                                                                      !! (1/K, 1/K^2, 1/K^3), used in the code
+!$OMP THREADPRIVATE(maint_resp_slope)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_c  !! slope of maintenance respiration coefficient (1/K),
+                                                                      !! constant c of aT^2+bT+c , tabulated
+!$OMP THREADPRIVATE(maint_resp_slope_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_b  !! slope of maintenance respiration coefficient (1/K), 
+                                                                      !! constant b of aT^2+bT+c , tabulated
+!$OMP THREADPRIVATE(maint_resp_slope_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maint_resp_slope_a  !! slope of maintenance respiration coefficient (1/K), 
+                                                                      !! constant a of aT^2+bT+c , tabulated
+!$OMP THREADPRIVATE(maint_resp_slope_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: coeff_maint_zero  !! maintenance respiration coefficient at 0 deg C, 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(coeff_maint_zero)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_leaf        !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for leaves, tabulated 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_leaf)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_sapabove    !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for sapwood above, tabulated
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_sapabove)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_sapbelow    !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for sapwood below, tabulated 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_sapbelow)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_heartabove  !! maintenance respiration coefficient at 0 deg C
+                                                                      !! for heartwood above, tabulated 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_heartabove)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_heartbelow  !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for heartwood below, tabulated 
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_heartbelow)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_root        !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for roots, tabulated
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_root)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_fruit       !! maintenance respiration coefficient  at 0 deg C,
+                                                                      !! for fruits, tabulated
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_fruit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cm_zero_carbres     !! maintenance respiration coefficient at 0 deg C,
+                                                                      !! for carbohydrate reserve, tabulated
+                                                                      !! @tex $(gC.gC^{-1}.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(cm_zero_carbres)
+
+ 
+  !
+  ! FIRE (stomate)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: flam              !! flamability : critical fraction of water holding 
+                                                                    !! capacity (0-1, unitless)
+!$OMP THREADPRIVATE(flam)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: resist            !! fire resistance (0-1, unitless)
+!$OMP THREADPRIVATE(resist)
+
+
+  !
+  ! FLUX - LUC (Land Use Change)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_1   !! Coeff of biomass export for the year (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_1)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_10  !! Coeff of biomass export for the decade (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_10)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: coeff_lcchange_100 !! Coeff of biomass export for the century (unitless)
+!$OMP THREADPRIVATE(coeff_lcchange_100)
+ 
+ 
+  !
+  ! PHENOLOGY
+  !
+  !-
+  ! 1. Stomate
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_max           !! maximum LAI, PFT-specific @tex $(m^2.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(lai_max)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_type     !! type of phenology (0-4, unitless)
+                                                                    !! 0=bare ground 1=evergreen,  2=summergreen, 
+                                                                    !! 3=raingreen,  4=perennial
+                                                                    !! For the moment, the bare ground phenotype is not managed, 
+                                                                    !! so it is considered as "evergreen"
+!$OMP THREADPRIVATE(pheno_type)
+
+  !-
+  ! 2. Leaf Onset
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: pheno_gdd_crit   !! critical gdd,tabulated (C), used in the code
+!$OMP THREADPRIVATE(pheno_gdd_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_c   !! critical gdd,tabulated (C), 
+                                                                     !! constant c of aT^2+bT+c (unitless)
+!$OMP THREADPRIVATE(pheno_gdd_crit_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_b   !! critical gdd,tabulated (C), 
+                                                                     !! constant b of aT^2+bT+c (unitless)
+!$OMP THREADPRIVATE(pheno_gdd_crit_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pheno_gdd_crit_a   !! critical gdd,tabulated (C), 
+                                                                     !! constant a of aT^2+bT+c (unitless)
+!$OMP THREADPRIVATE(pheno_gdd_crit_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ngd_crit           !! critical ngd,tabulated. Threshold -5 degrees (days)
+!$OMP THREADPRIVATE(ngd_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ncdgdd_temp        !! critical temperature for the ncd vs. gdd function
+                                                                     !! in phenology (C)
+!$OMP THREADPRIVATE(ncdgdd_temp)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: hum_frac           !! critical humidity (relative to min/max) for phenology
+                                                                     !! (0-1, unitless)
+!$OMP THREADPRIVATE(hum_frac)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: hum_min_time       !! minimum time elapsed since moisture minimum (days)
+!$OMP THREADPRIVATE(hum_min_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_sap            !! sapwood -> heartwood conversion time (days)
+!$OMP THREADPRIVATE(tau_sap)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tau_fruit          !! fruit lifetime (days)
+!$OMP THREADPRIVATE(tau_fruit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: ecureuil           !! fraction of primary leaf and root allocation put
+                                                                     !! into reserve (0-1, unitless)
+!$OMP THREADPRIVATE(ecureuil)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alloc_min          !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+!$OMP THREADPRIVATE(alloc_min)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: alloc_max          !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+!$OMP THREADPRIVATE(alloc_max)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: demi_alloc         !! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+!$OMP THREADPRIVATE(demi_alloc)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaflife_tab       !! leaf longevity, tabulated (??units??)
+!$OMP THREADPRIVATE(leaflife_tab)
+
+  !-
+  ! 3. Senescence
+  !-
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaffall              !! length of death of leaves,tabulated (days)
+!$OMP THREADPRIVATE(leaffall)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leafagecrit           !! critical leaf age,tabulated (days)
+!$OMP THREADPRIVATE(leafagecrit)
+
+  CHARACTER(len=6), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_type  !! type of senescence,tabulated (unitless)
+                                                                        !! List of avaible types of senescence :
+                                                                        !! 'cold  ', 'dry   ', 'mixed ', 'none  '
+!$OMP THREADPRIVATE(senescence_type)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_hum        !! critical relative moisture availability for senescence
+                                                                        !! (0-1, unitless)
+!$OMP THREADPRIVATE(senescence_hum)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: nosenescence_hum      !! relative moisture availability above which there is
+                                                                        !! no humidity-related senescence (0-1, unitless)
+!$OMP THREADPRIVATE(nosenescence_hum)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: max_turnover_time     !! maximum turnover time for grasses (days)
+!$OMP THREADPRIVATE(max_turnover_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: min_turnover_time     !! minimum turnover time for grasses (days)
+!$OMP THREADPRIVATE(min_turnover_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: min_leaf_age_for_senescence  !! minimum leaf age to allow senescence g (days)
+!$OMP THREADPRIVATE(min_leaf_age_for_senescence)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: senescence_temp     !! critical temperature for senescence (C),
+                                                                        !! used in the code
+!$OMP THREADPRIVATE(senescence_temp)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_c     !! critical temperature for senescence (C), 
+                                                                        !! constant c of aT^2+bT+c , tabulated (unitless)
+!$OMP THREADPRIVATE(senescence_temp_c)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_b     !! critical temperature for senescence (C), 
+                                                                        !! constant b of aT^2+bT+c , tabulated (unitless)
+!$OMP THREADPRIVATE(senescence_temp_b)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: senescence_temp_a     !! critical temperature for senescence (C),
+                                                                        !! constant a of aT^2+bT+c , tabulated (unitless)
+!$OMP THREADPRIVATE(senescence_temp_a)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: gdd_senescence        !! minimum gdd to allow senescence of crops (days)
+!$OMP THREADPRIVATE(gdd_senescence)
+
+  !
+  ! DGVM
+  !
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: residence_time        !! residence time of trees (y) 
+!$OMP THREADPRIVATE(residence_time)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmin_crit             !! critical tmin, tabulated (C)
+!$OMP THREADPRIVATE(tmin_crit)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tcm_crit              !! critical tcm, tabulated (C)
+!$OMP THREADPRIVATE(tcm_crit)
+
+  !
+  ! Biogenic Volatile Organic Compounds
+  !
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_isoprene       !! Isoprene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_isoprene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_monoterpene    !! Monoterpene emission factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_monoterpene)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_ORVOC          !! ORVOC emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_ORVOC)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_OVOC           !! OVOC emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_OVOC)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_MBO            !! MBO emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_MBO)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_methanol       !! Methanol emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_methanol)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetone        !! Acetone emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_acetone)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetal         !! Acetaldehyde emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_acetal)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_formal         !! Formaldehyde emissions factor
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_formal)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_acetic         !! Acetic Acid emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_acetic)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_formic         !! Formic Acid emissions factor 
+                                                                           !! @tex $(\mu gC.g^{-1}.h^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_formic)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_no_wet         !! NOx emissions factor soil emissions and 
+                                                                           !! exponential dependancy factor for wet soils
+                                                                           !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_no_wet)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: em_factor_no_dry         !! NOx emissions factor soil emissions and
+                                                                           !! exponential dependancy factor for dry soils
+                                                                           !! @tex $(ngN.m^{-2}.s^{-1})$ @endtex
+!$OMP THREADPRIVATE(em_factor_no_dry)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: Larch                    !! Larcher 1991 SAI/LAI ratio (unitless)
+!$OMP THREADPRIVATE(Larch)
+
+  !
+  ! INTERNAL PARAMETERS USED IN STOMATE_DATA
+  !
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: lai_initmin   !! Initial lai for trees/grass 
+                                                                !! @tex $(m^2.m^{-2})$ @endtex
+!$OMP THREADPRIVATE(lai_initmin)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bm_sapl   !! sapling biomass @tex $(gC.ind^{-1})$ @endtex
+!$OMP THREADPRIVATE(bm_sapl)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: migrate       !! migration speed @tex $(m.year^{-1})$ @endtex
+!$OMP THREADPRIVATE(migrate)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: maxdia        !! maximum stem diameter from which on crown area no longer 
+                                                                !! increases (m)
+!$OMP THREADPRIVATE(maxdia)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: cn_sapl       !! crown of tree when sapling  @tex $(m^2$)$ @endtex
+!$OMP THREADPRIVATE(cn_sapl)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: leaf_timecst  !! time constant for leaf age discretisation (days)
+!$OMP THREADPRIVATE(leaf_timecst)
+
+
+END MODULE pft_parameters_var
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/AA_make	(revision 5166)
@@ -0,0 +1,175 @@
+#-
+#- $Id$
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec  SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec  SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+ORGLOB_LIB = $(LIBDIR)/liborglob.a
+SXORGLOB_LIB = $(ORGLOB_LIB)
+#-Q- sxnec  SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- eshpux SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-
+STOMATE_LIB = $(LIBDIR)/libstomate.a
+SXSTOMATE_LIB = $(STOMATE_LIB)
+#-Q- sxnec  SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx6nec SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- eshpux SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx8brodie SXSTOMATE_LIB = $(LIBDIR)/libsxstomate.a
+#-
+MODS1 =              \
+  qsat_moisture.f90 \
+  sechiba_io_p.f90   \
+  sechiba_io.f90     \
+  watchout.f90       \
+  slowproc.f90       \
+  diffuco.f90        \
+  condveg.f90        \
+  enerbil.f90        \
+  hydrol.f90         \
+  hydrolc.f90        \
+  thermosoil.f90     \
+  routing.f90        \
+  sechiba.f90        \
+  intersurf.f90 
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libparallel
+	$(M_K) libparameters
+	$(M_K) liborglob
+	$(M_K) libstomate
+	$(M_K) m_all
+	@echo sechiba is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+#-Q- intel m_all: WORK_MOD $(MODEL_LIB)($(OBJSMODS1))
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+libparameters:
+	(cd ../src_parameters; $(M_K) -f Makefile)
+
+liborglob:
+	(cd ../src_global; $(M_K) -f Makefile)
+
+libstomate:
+	(cd ../src_stomate; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o) : %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+#-Q- intel
+#-Q- intel WORK_MOD :
+#-Q- intel 	$(RM) work.pcl
+#-Q- intel 	@echo "work.pc" > work.pcl
+#-Q- intel 	@echo "../src_parameters/work.pc" >> work.pcl
+#-Q- intel 	@echo "../src_stomate/work.pc" >> work.pcl
+#-Q- intel 	@echo "../../IOIPSL/src/work.pc" >> work.pcl
+
+config : 
+	$(BINDIR)/Fparser -name SECHIBA $(MODS1)
+	echo 'Configuration of SECHIBA done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(sechiba.o):          \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(sechiba_io_p.o)    \
+  $(MODEL_LIB)(sechiba_io.o)      \
+  $(MODEL_LIB)(diffuco.o)         \
+  $(MODEL_LIB)(condveg.o)         \
+  $(MODEL_LIB)(enerbil.o)         \
+  $(MODEL_LIB)(hydrolc.o)         \
+  $(MODEL_LIB)(hydrol.o)          \
+  $(MODEL_LIB)(thermosoil.o)      \
+  $(MODEL_LIB)(slowproc.o)        \
+  $(MODEL_LIB)(routing.o)
+ 
+$(MODEL_LIB)(sechiba_io_p.o): \
+  $(PARAM_LIB)(constantes.o)  \
+  $(PARALLEL_LIB)(mod_orchidee_para.o)
+
+$(MODEL_LIB)(sechiba_io.o): \
+  $(MODEL_LIB)(sechiba_io_p.o) \
+  $(PARAM_LIB)(constantes.o)
+
+$(MODEL_LIB)(watchout.o): \
+  $(ORGLOB_LIB)(grid.o)
+
+$(MODEL_LIB)(hydrol.o):           \
+  $(PARAM_LIB)(constantes.o)  \
+  $(MODEL_LIB)(sechiba_io.o)      \
+  $(ORGLOB_LIB)(grid.o)
+
+$(MODEL_LIB)(hydrolc.o):          \
+  $(PARAM_LIB)(constantes.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(slowproc.o):         \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(STOMATE_LIB)(stomate.o)       \
+  $(MODEL_LIB)(sechiba_io.o)      \
+  $(ORGLOB_LIB)(interpol_help.o)
+
+$(MODEL_LIB)(diffuco.o):          \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(qsat_moisture.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(enerbil.o):          \
+  $(PARAM_LIB)(constantes.o)      \
+  $(MODEL_LIB)(qsat_moisture.o)   \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(condveg.o):          \
+  $(PARAM_LIB)(constantes.o)  \
+  $(ORGLOB_LIB)(interpol_help.o)
+
+$(MODEL_LIB)(thermosoil.o): \
+  $(PARAM_LIB)(constantes.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(routing.o):          \
+  $(PARAM_LIB)(constantes.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(intersurf.o):   \
+  $(PARAM_LIB)(constantes.o)  \
+  $(ORGLOB_LIB)(grid.o)      \
+  $(MODEL_LIB)(watchout.o)   \
+  $(MODEL_LIB)(sechiba.o)
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/AA_make.ldef	(revision 5166)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a SECHIBA
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/libsechiba.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxsechiba.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxsechiba.a
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/condveg.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/condveg.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/condveg.f90	(revision 5166)
@@ -0,0 +1,1578 @@
+! ===============================================================================================================================
+! MODULE       : condveg
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Initialise, compute and update the surface parameters emissivity,
+!! roughness and albedo. 
+!!
+!! \n DESCRIPTION : The module uses 3 settings to control its flow:\n
+!! 1. :: z0cdrag_ave to choose between two methods to calculate the grid average of 
+!!    the roughness height. If set to true: the grid average is calculated by the drag coefficients 
+!!    per PFT. If set to false: the grid average is calculated by the logarithm of the 
+!!    roughness height per PFT.\n
+!! 2. :: impaze for choosing surface parameters. If set to false, the values for the 
+!!    soil albedo, emissivity and roughness height are set to default values which are read from 
+!!    the run.def. If set to true, the user imposes its own values, fixed for the grid point. This is useful if one performs site simulations, however, 
+!!    it is not recommended to do so for spatialized simulations.
+!!     roughheight_scal imposes the roughness height in (m) , 
+!!	same for emis_scal (in %), albedo_scal (in %), zo_scal (in m)                       
+!!     Note that these values are only used if 'impaze' is true.\n
+!! 3. :: alb_bare_model for choosing values of bare soil albedo. If set to TRUE bare 
+!!    soil albedo depends on soil wetness. If set to FALSE bare soil albedo is the mean 
+!!    values of wet and dry soil albedos.\n
+!!   The surface fluxes are calculated between two levels: the atmospheric level reference and the effective roughness height 
+!! defined as the difference between the mean height of the vegetation and the displacement height (zero wind 
+!!    level). Over bare soils, the zero wind level is equal to the soil roughness. Over vegetation, the zero wind level
+!!    is increased by the displacement height
+!!    which depends on the height of the vegetation. For a grid point composed of different types of vegetation, 
+!! an effective surface roughness has to be calculated
+
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCES(S)    : None
+!!
+!! SVN              :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE condveg
+  !
+  USE ioipsl
+  !
+  ! modules used :
+  USE constantes
+  USE pft_parameters
+  USE interpol_help
+  USE mod_orchidee_para
+  USE ioipsl_para 
+
+  USE slowproc
+
+  IMPLICIT NONE
+
+  ! public routines :
+  ! condveg_main only
+  PRIVATE
+  PUBLIC :: condveg_main,condveg_clear 
+
+  !
+  ! variables used inside condveg module : declaration and initialisation
+  !
+  LOGICAL, SAVE                     :: l_first_condveg=.TRUE.           !! To keep first call's trace
+!$OMP THREADPRIVATE(l_first_condveg)
+  REAL(r_std), ALLOCATABLE, SAVE    :: soilalb_dry(:,:)                 !! Albedo values for the dry bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_dry)
+  REAL(r_std), ALLOCATABLE, SAVE    :: soilalb_wet(:,:)                 !! Albedo values for the wet bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_wet)
+  REAL(r_std), ALLOCATABLE, SAVE    :: soilalb_moy(:,:)                 !! Albedo values for the mean bare soil (unitless)
+!$OMP THREADPRIVATE(soilalb_moy)
+  REAL(r_std), ALLOCATABLE, SAVE    :: alb_bare(:,:)                    !! Mean bare soil albedo for visible and near-infrared 
+                                                                        !! range (unitless) 
+!$OMP THREADPRIVATE(alb_bare)
+  REAL(r_std), ALLOCATABLE, SAVE    :: alb_veget(:,:)                   !! Mean vegetation albedo for visible and 
+                                                                        !! near-infrared range (unitless) 
+!$OMP THREADPRIVATE(alb_veget)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: albedo_snow         !! Mean snow albedo over visible and near-infrared 
+                                                                        !! range (unitless) 
+!$OMP THREADPRIVATE(albedo_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)  :: albedo_glob         !! Mean surface albedo over visible and 
+                                                                        !! near-infrared range (unitless)
+!$OMP THREADPRIVATE(albedo_glob)
+CONTAINS
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_main
+!!
+!>\BRIEF        Calls the subroutines to initialise the variables, update the variables
+!! and write out data and restart files. 
+!!
+!!
+!! MAIN OUTPUT VARIABLE(S):  emis (emissivity), albedo (albedo of 
+!! vegetative PFTs in visible and near-infrared range), z0 (surface roughness height),
+!! roughheight (grid effective roughness height), soil type (fraction of soil types) 
+!! 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!!
+!! REVISION(S)  : None
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index,&
+       & lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, &
+       & zlev, snow, snow_age, snow_nobio, snow_nobio_age, &
+       & drysoil_frac, height,  emis, albedo, z0, roughheight, rest_id, hist_id, hist2_id)
+
+     !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables  
+
+    INTEGER(i_std), INTENT(in)                       :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                       :: kjpindex         !! Domain size
+    INTEGER(i_std),INTENT (in)                       :: rest_id          !! _Restart_ file identifier
+    INTEGER(i_std),INTENT (in)                       :: hist_id          !! _History_ file identifier
+    INTEGER(i_std), OPTIONAL, INTENT (in)            :: hist2_id          !! _History_ file 2 identifier
+    REAL(r_std), INTENT (in)                         :: dtradia          !! Time step in seconds
+    LOGICAL, INTENT(in)                             :: ldrestart_read   !! Logical for restart file to read
+    LOGICAL, INTENT(in)                             :: ldrestart_write  !! Logical for restart file to write
+    ! input fields
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index            !! Indeces of the points on the map
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)  :: lalo             !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,8), INTENT(in):: neighbours       !! neighoring grid points if land
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)  :: resolution       !! size in x an y of the grid (m)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)    :: contfrac         ! Fraction of land in each grid box.
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: veget            !! Fraction of vegetation types
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: veget_max        !! Fraction of vegetation type
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio    !! Fraction of continental ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: totfrac_nobio    !! total fraction of continental ice+lakes+...
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)    :: zlev             !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow             !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow_age         !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio    !! Snow mass [Kg/m^2] on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: snow_nobio_age   !! Snow age on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: drysoil_frac     !! Fraction of visibly Dry soil(between 0 and 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: height           !! Vegetation Height (m)
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: emis             !! Emissivity
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out) :: albedo           !! Albedo, vis(1) and nir(2)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: z0               !! Roughness
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)   :: roughheight      !! Effective height for roughness
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables   
+
+    CHARACTER(LEN=80)                               :: var_name         !! To store variables names for I/O
+!_ ================================================================================================================================
+  
+    !! 1. Call subroutines to start initialisation
+   
+    ! Is TRUE if condveg is called the first time
+    IF (l_first_condveg) THEN
+       ! Document what the programm is doing
+        IF (long_print) WRITE (numout,*) ' l_first_condveg : call condveg_init '
+
+        ! Call the subroutine 'condveg_init' to allocate local array
+        CALL condveg_init (kjit, ldrestart_read, kjpindex, index, veget, &
+                           lalo, neighbours, resolution, contfrac, rest_id)
+
+        ! Call the subroutine 'condveg_var_init' to initialise local array
+        ! Reads in map for soil albedo
+         CALL condveg_var_init (ldrestart_read, kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, &
+             & drysoil_frac, zlev, height,  emis, albedo, z0, roughheight)
+
+         ! Call subroutine 'condveg snow'
+         CALL condveg_snow (ldrestart_read, kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, &
+             snow, snow_age, snow_nobio, snow_nobio_age, albedo, albedo_snow, albedo_glob)
+
+        RETURN
+
+    ENDIF
+
+    !! 2. Call subroutines to update fields
+
+    ! Call the routine 'condveg_var_update' to update the fields of albedo, emissivity and roughness
+    CALL condveg_var_update (ldrestart_read, kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, &
+         & drysoil_frac, zlev, height,  emis, albedo, z0, roughheight)
+
+    ! Update snow parameters by calling subroutine 'condveg_snow'
+    CALL condveg_snow (ldrestart_read, kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, &
+         snow, snow_age, snow_nobio, snow_nobio_age, albedo, albedo_snow, albedo_glob)
+
+    !! 3. Call subroutines to write restart files and data
+
+    ! To write restart files for soil albedo variables
+    IF (ldrestart_write) THEN
+       !
+       var_name = 'soilalbedo_dry'
+       CALL restput_p (rest_id, var_name, nbp_glo, 2, 1, kjit, soilalb_dry, 'scatter',  nbp_glo, index_g)
+       !
+       var_name = 'soilalbedo_wet'
+       CALL restput_p (rest_id, var_name, nbp_glo, 2, 1, kjit, soilalb_wet, 'scatter',  nbp_glo, index_g)
+       !
+       var_name = 'soilalbedo_moy'
+       CALL restput_p (rest_id, var_name, nbp_glo, 2, 1, kjit, soilalb_moy, 'scatter',  nbp_glo, index_g)
+       !
+       RETURN
+       !
+    ENDIF
+
+    ! If this logical flag is set to true, the model
+    ! will output all its data according to the ALMA 
+    ! convention. 
+    ! To facilitate the exchange of forcing data for land-surface schemes and the results produced by these schemes, 
+    ! ALMA (Assistance for Land-surface Modelling activities) proposes to establish standards. 
+    ! http://www.lmd.jussieu.fr/~polcher/ALMA/
+    IF ( almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'Albedo', kjit, albedo_glob, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SAlbedo', kjit, albedo_snow, kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'Albedo', kjit, albedo_glob, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SAlbedo', kjit, albedo_snow, kjpindex, index)
+       ENDIF
+    ELSE
+       CALL histwrite_p(hist_id, 'soilalb_vis', kjit, alb_bare(:,1), kjpindex, index)
+       CALL histwrite_p(hist_id, 'soilalb_nir', kjit, alb_bare(:,2), kjpindex, index)
+       CALL histwrite_p(hist_id, 'vegalb_vis',  kjit, alb_veget(:,1), kjpindex, index)
+       CALL histwrite_p(hist_id, 'vegalb_nir',  kjit, alb_veget(:,2), kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'soilalb_vis', kjit, alb_bare(:,1), kjpindex, index)
+          CALL histwrite_p(hist2_id, 'soilalb_nir', kjit, alb_bare(:,2), kjpindex, index)
+          CALL histwrite_p(hist2_id, 'vegalb_vis',  kjit, alb_veget(:,1), kjpindex, index)
+          CALL histwrite_p(hist2_id, 'vegalb_nir',  kjit, alb_veget(:,2), kjpindex, index)
+       ENDIF
+    ENDIF
+
+    IF (long_print) WRITE (numout,*)' condveg_main done '
+
+  END SUBROUTINE condveg_main
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_init
+!!
+!>\BRIEF        Dynamic allocation of the variables, the dimensions of the 
+!! variables are determined by user-specified settings.
+!!
+!! DESCRIPTION  : The domain size (:: kjpindex) is used to allocate the correct 
+!! dimensions to all variables in condveg.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output 
+!! variables. However, the routine allocates memory and builds new indexing 
+!! variables for later use.
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    :  None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_init  (kjit, ldrestart_read, kjpindex, index, veget, &
+                            lalo, neighbours, resolution, contfrac, rest_id)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1. Input variables  
+
+    INTEGER(i_std), INTENT(in)                       :: kjit             !! Time step number (unitless)          
+    LOGICAL, INTENT(in)                              :: ldrestart_read   !! For restart file to read (unitless)
+    INTEGER(i_std), INTENT(in)                       :: kjpindex         !! Domain size - Number of land pixels  (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index            !! Index for the points on the map (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in):: veget            !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                         !! (m^2 m^{-2}) 
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)  :: lalo             !! Geographical coordinates (degree)
+    INTEGER(i_std),DIMENSION (kjpindex,8), INTENT(in):: neighbours       !! Neighbouring land grid cell
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)  :: resolution       !! Size of grid in x and y direction (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)     :: contfrac         !! Fraction of land in each grid box 
+    INTEGER(i_std), INTENT(in)                       :: rest_id          !! Restart file identifier 
+
+    !! 0.2. Output variables
+
+    !! 0.3 Modified variables          
+  
+    !! 0.4 Local variables
+ 
+    INTEGER(i_std)                                  :: ji               !! Index
+    INTEGER(i_std)                                  :: ier              !! Check errors in memory allocation
+    CHARACTER(LEN=80)                               :: var_name         !! To store variables names for I/O 
+
+!_ ================================================================================================================================
+  
+    !! 1. Choice of calculation of snow albedo and soil albedo
+
+    ! Is TRUE if condveg is called the first time
+    IF (l_first_condveg) THEN 
+       !       
+       l_first_condveg=.FALSE.
+
+    !! 2. Allocate all albedo variables
+       
+       ! Dry soil albedo
+       ALLOCATE (soilalb_dry(kjpindex,2),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in soilalb_dry allocation. We stop.We need kjpindex*2 words = ',kjpindex*2
+          STOP 'condveg_init'
+       END IF
+       soilalb_dry(:,:) = val_exp
+
+       ! Wet soil albedo
+       ALLOCATE (soilalb_wet(kjpindex,2),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in soilalb_wet allocation. We stop.We need kjpindex*2 words = ',kjpindex*2
+          STOP 'condveg_init'
+       END IF
+       soilalb_wet(:,:) = val_exp
+
+       ! Mean soil albedo
+       ALLOCATE (soilalb_moy(kjpindex,2),stat=ier)
+        IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in soilalb_moy allocation. We stop.We need kjpindex*2 words = ',kjpindex*2
+          STOP 'condveg_init'
+        END IF
+       soilalb_moy(:,:) = val_exp
+
+       ! Snow albedo of vegetative PFTs
+       ALLOCATE (albedo_snow(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in albedo_snow allocation. We stop.We need kjpindex words = ',kjpindex
+          STOP 'condveg_init'
+       END IF
+       
+       ! Mean vegetation albedo over visible and near-infrared range 
+       ALLOCATE (albedo_glob(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in albedo_glob allocation. We stop.We need kjpindex words = ',kjpindex
+          STOP 'condveg_init'
+       END IF
+       
+       ! Mean bare soil albedo
+       ALLOCATE (alb_bare(kjpindex,2),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in alb_bare allocation. We stop.We need kjpindex*2 words = ',kjpindex*2
+          STOP 'condveg_init'
+       END IF
+       alb_bare(:,:) = val_exp
+
+       ! Mean vegetation albedo
+       ALLOCATE (alb_veget(kjpindex,2),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in alb_veget allocation. We stop.We need kjpindex*2 words = ',kjpindex*2
+          STOP 'condveg_init'
+       END IF
+       alb_veget(:,:) = val_exp
+
+       
+    !! 3. Initialise bare soil albedo
+       
+       ! dry soil albedo
+       var_name= 'soilalbedo_dry'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Dry bare soil albedo')
+       CALL restget_p (rest_id, var_name, nbp_glo, 2, 1, kjit, .TRUE., soilalb_dry, "gather", nbp_glo, index_g)
+
+       ! wet soil albedo
+       var_name= 'soilalbedo_wet'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Wet bare soil albedo')
+       CALL restget_p (rest_id, var_name, nbp_glo, 2, 1, kjit, .TRUE., soilalb_wet, "gather", nbp_glo, index_g)
+
+       ! mean soil aledo
+       var_name= 'soilalbedo_moy'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Mean bare soil albedo')
+       CALL restget_p (rest_id, var_name, nbp_glo, 2, 1, kjit, .TRUE., soilalb_moy, "gather", nbp_glo, index_g)
+       
+       ! check if we have real values and not only missing values
+       IF ( MINVAL(soilalb_wet) .EQ. MAXVAL(soilalb_wet) .AND. MAXVAL(soilalb_wet) .EQ. val_exp .OR.&
+            & MINVAL(soilalb_dry) .EQ. MAXVAL(soilalb_dry) .AND. MAXVAL(soilalb_dry) .EQ. val_exp .OR.&
+            & MINVAL(soilalb_moy) .EQ. MAXVAL(soilalb_moy) .AND. MAXVAL(soilalb_moy) .EQ. val_exp) THEN
+          CALL condveg_soilalb(kjpindex, lalo, neighbours, resolution, contfrac, soilalb_dry,soilalb_wet)
+          WRITE(numout,*) '---> val_exp ', val_exp
+          WRITE(numout,*) '---> ALBEDO_wet VIS:', MINVAL(soilalb_wet(:,ivis)), MAXVAL(soilalb_wet(:,ivis))
+          WRITE(numout,*) '---> ALBEDO_wet NIR:', MINVAL(soilalb_wet(:,inir)), MAXVAL(soilalb_wet(:,inir))
+          WRITE(numout,*) '---> ALBEDO_dry VIS:', MINVAL(soilalb_dry(:,ivis)), MAXVAL(soilalb_dry(:,ivis))
+          WRITE(numout,*) '---> ALBEDO_dry NIR:', MINVAL(soilalb_dry(:,inir)), MAXVAL(soilalb_dry(:,inir))
+          WRITE(numout,*) '---> ALBEDO_moy VIS:', MINVAL(soilalb_moy(:,ivis)), MAXVAL(soilalb_moy(:,ivis))
+          WRITE(numout,*) '---> ALBEDO_moy NIR:', MINVAL(soilalb_moy(:,inir)), MAXVAL(soilalb_moy(:,inir))
+       ENDIF
+       
+    ELSE 
+       WRITE (numout,*) ' l_first_condveg false . we stop '
+       STOP 'condveg_init'
+    ENDIF
+
+    IF (long_print) WRITE (numout,*) ' condveg_init done '
+
+  END SUBROUTINE condveg_init
+
+!! ==============================================================================================================================
+!! SUBROUTINE 	: condveg_clear
+!!
+!>\BRIEF        Deallocate albedo variables
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_clear  ()
+
+      l_first_condveg=.TRUE.
+       
+      ! Dry soil albedo
+       IF (ALLOCATED (soilalb_dry)) DEALLOCATE (soilalb_dry)
+       ! Wet soil albedo
+       IF (ALLOCATED(soilalb_wet))  DEALLOCATE (soilalb_wet)
+       ! Mean soil albedo
+       IF (ALLOCATED(soilalb_moy))  DEALLOCATE (soilalb_moy)
+       ! Mean snow albedo
+       IF (ALLOCATED(albedo_snow))  DEALLOCATE (albedo_snow)
+       ! Mean albedo
+       IF (ALLOCATED(albedo_glob))  DEALLOCATE (albedo_glob)
+       ! Mean albedo of bare soil
+       IF (ALLOCATED(alb_bare))  DEALLOCATE (alb_bare)
+       ! Mean vegetation albedo
+       IF (ALLOCATED(alb_veget))  DEALLOCATE (alb_veget)
+
+  END SUBROUTINE condveg_clear
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_var_init
+!!
+!>\BRIEF        Initialisation of local array and calculation of emissivity,
+!! albedo and roughness height.
+!!
+!! DESCRIPTION : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_var_init  (ldrestart_read, kjpindex, veget, veget_max, frac_nobio, totfrac_nobio,&
+       & drysoil_frac, zlev, height,  emis, albedo, z0, roughheight)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex         !! Domain size - Number of land pixels  (unitless)  
+    LOGICAL, INTENT(in)                                 :: ldrestart_read   !! For restart file to read (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: veget            !!  PFT coverage fraction of a PFT (= ind*cn_ind)
+                                                                            !! (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: veget_max        !! PFT "Maximal" coverage fraction of a PFT 
+                                                                            !! (= ind*cn_ind) (m^2/m^{-2})  
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio       !! Fraction of non-vegetative surfaces, i.e. 
+                                                                            !! continental ice, lakes, etc. (unitless)  
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: totfrac_nobio    !! Total fraction of non-vegetative surfaces, i.e. 
+                                                                            !! continental ice, lakes, etc. (unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: drysoil_frac     !! Fraction of dry soil in visible range (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: zlev             !! Height of first layer (m)   
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: height           !! Vegetation height (m)
+ 
+    !! 0.2 Output varialbes
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: emis             !! Surface emissivity (unitless) 
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out)    :: albedo           !! Albedo of vegetative PFTs in visible and 
+                                                                            !! near-infrared range   
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: z0               !! Soil roughness height (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: roughheight      !!  Grid effective roughness height (m)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ier              !! Check errors 
+    INTEGER(i_std)                                      :: jv               !! Index
+
+!_ ================================================================================================================================   
+
+    !! 1. Choice of parameter setting
+    
+    ! This switch is for choosing surface parameters.
+    ! If it is set to true, the values for the soil roughness, emissivity
+    ! and albedo are set to default values which are read in from the run.def.
+    ! This is useful if one performs a single site simulations, 
+    ! it is not recommended to do so for global simulations.
+    
+
+   !! 2. Calculate emissivity
+
+    ! If TRUE read in default values for emissivity
+
+    IF ( impaze ) THEN
+       !
+       emis(:) = emis_scal
+       !
+    ! If FALSE set emissivity to 1.
+    ELSE
+       emis_scal = un
+       emis(:) = emis_scal
+    ENDIF
+
+    !! 3. Calculate albedo
+
+    ! If TRUE read in default values for albedo
+    IF ( impaze ) THEN
+       !
+       albedo(:,ivis) = albedo_scal(ivis)
+       albedo(:,inir) = albedo_scal(inir)
+       !
+    ELSE
+
+       CALL condveg_albcalc (kjpindex,veget,drysoil_frac,albedo)
+ 
+    ENDIF
+
+    !! 4. Calculate roughness height
+    
+    ! Chooses between two methods to calculate the grid average of the roughness.
+    ! If set to true:  The grid average is calculated by averaging the drag coefficients over PFT.
+    ! If set to false: The grid average is calculated by averaging the logarithm of the roughness length per PFT.
+
+    !  TRUE read in default values for roughness height
+    IF ( impaze ) THEN
+      
+      z0(:) = z0_scal
+      roughheight(:) = roughheight_scal
+
+    ! If FALSE calculate roughness height
+    ELSE
+
+       IF ( z0cdrag_ave ) THEN
+          CALL condveg_z0cdrag(kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, zlev, &
+               &               height, z0, roughheight)
+       ELSE
+          CALL condveg_z0logz(kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, height, &
+               &              z0, roughheight)
+       ENDIF
+
+    ENDIF
+
+    IF (long_print) WRITE (numout,*) ' condveg_var_init done '
+
+  END SUBROUTINE condveg_var_init
+
+  
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_var_update
+!!
+!>\BRIEF        Update emissivity, albedo and roughness height.
+!!
+!! DESCRIPTION  : None
+!!
+!! MAIN OUTPUT VARIABLE(S): \n
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_var_update  (ldrestart_read, kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, &
+       & drysoil_frac, zlev, height,  emis, albedo, z0, roughheight)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex         !! Domain size - Number of land pixels  (unitless) 
+    LOGICAL, INTENT(in)                                 :: ldrestart_read   !! For restart file to read (unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: veget            !! PFT coverage fraction of a PFT (= ind*cn_ind)
+                                                                            !! (m^2 m^{-2})  
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: veget_max        !! PFT "Maximal" coverage fraction of a PFT 
+                                                                            !! (= ind*cn_ind) (m^2 m^{-2})  
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio       !! Fraction of non-vegetative surfaces, i.e. 
+                                                                            !! continental ice, lakes, etc. (unitless)  
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: totfrac_nobio    !! Total fraction of non-vegetative surfaces, i.e. 
+                                                                            !! continental ice, lakes, etc. (unitless)   
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: drysoil_frac     !! Fraction of dry soil in visible range (unitless)   
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: zlev             !! Height of first layer (m)       
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: height           !! Vegetation height (m)         
+
+    !! 0.2 Output variables   
+       
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: emis             !! Emissivity (unitless)            
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out)    :: albedo           !! Albedo of vegetative PFTs in visible and 
+                                                                            !! near-infrared range  
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: z0               !! Roughness height (m)              
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: roughheight      !! Grid effective roughness height (m)     
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jv           !! Indeces
+!_ ================================================================================================================================
+
+    !! 1. Calculate emissivity
+    
+    emis(:) = emis_scal
+    
+    !! 2. Calculate albedo
+    
+    ! If TRUE read in prescribed values for albedo
+    IF ( impaze ) THEN
+
+       albedo(:,ivis) = albedo_scal(ivis)
+       albedo(:,inir) = albedo_scal(inir)
+
+    ! If FALSE calculate albedo from ORCHIDEE default values
+    ELSE
+
+       CALL condveg_albcalc (kjpindex,veget,drysoil_frac,albedo)
+
+    ENDIF
+    
+    !! 3. Calculate roughness height
+    
+    ! If TRUE read in prescribed values for roughness height
+    IF ( impaze ) THEN
+
+       DO ji = 1, kjpindex
+         z0(ji) = z0_scal
+         roughheight(ji) = roughheight_scal
+      ENDDO
+
+    ! Calculate roughness height
+    ELSE
+     
+       IF ( z0cdrag_ave ) THEN
+          CALL condveg_z0cdrag (kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, zlev, height, &
+               &                z0, roughheight)
+       ELSE
+          CALL condveg_z0logz (kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, height, &
+               &               z0, roughheight)
+       ENDIF
+     
+    ENDIF
+
+    IF (long_print) WRITE (numout,*) ' condveg_var_update done '
+
+  END SUBROUTINE condveg_var_update
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE   : condveg_snow
+!!
+!>\BRIEF        Calcuating snow albedo and snow cover fraction, which are then used to 
+!! update the gridbox surface albedo following Chalita and Treut (1994).
+!!
+!! DESCRIPTION  : The snow albedo scheme presented below belongs to prognostic albedo 
+!! category, i.e. the snow albedo value at a time step depends on the snow albedo value 
+!! at the previous time step.
+!!
+!! First, the following formula (described in Chalita and Treut 1994) is used to describe 
+!! the change in snow albedo with snow age on each PFT and each non-vegetative surfaces, 
+!! i.e. continental ice, lakes, etc.: \n 
+!! \latexonly 
+!! \input{SnowAlbedo.tex}
+!! \endlatexonly
+!! \n
+!! Where snowAge is snow age, tcstSnowa is a critical aging time (tcstSnowa=5 days)
+!! snowaIni and snowaIni+snowaDec corresponds to albedos measured for aged and
+!! fresh snow respectively, and their values for each PFT and each non-vegetative surfaces 
+!! is precribed in in constantes_veg.f90.\n
+!! In order to estimate gridbox snow albedo, snow albedo values for each PFT and 
+!! each  non-vegetative surfaces with a grid box are weightedly summed up by their 
+!! respective fractions.\n
+!! Secondly, the snow cover fraction is computed as:
+!! \latexonly 
+!! \input{SnowFraction.tex}
+!! \endlatexonly
+!! \n
+!! Where fracSnow is the fraction of snow on total vegetative or total non-vegetative
+!! surfaces, snow is snow mass (kg/m^2) on total vegetated or total nobio surfaces.\n 
+!! Finally, the surface albedo is then updated as the weighted sum of fracSnow, total
+!! vegetated fraction, total nobio fraction, gridbox snow albedo, and previous
+!! time step surface albedo.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: albedo; surface albedo. :: albedo_snow; snow
+!! albedo
+!!
+!! REFERENCE(S) :  
+!! Chalita, S. and H Le Treut (1994), The albedo of temperate and boreal forest and 
+!!  the Northern Hemisphere climate: a sensitivity experiment using the LMD GCM,
+!!  Climate Dynamics, 10 231-240.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_snow  (ldrestart_read, kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, &
+                            snow, snow_age, snow_nobio, snow_nobio_age, albedo, albedo_snow, albedo_glob)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex        !! Domain size - Number of land pixels  (unitless)
+    LOGICAL, INTENT(in)                                 :: ldrestart_read  !! Logical for _restart_ file to read (true/false)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget           !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                           !! (m^2 m^{-2})   
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: veget_max
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio      !! Fraction of non-vegetative surfaces, i.e. 
+                                                                           !! continental ice, lakes, etc. (unitless)     
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: totfrac_nobio   !! Total fraction of non-vegetative surfaces, i.e. 
+                                                                           !! continental ice, lakes, etc. (unitless)   
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: snow            !! Snow mass in vegetation (kg m^{-2})           
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio      !! Snow mass on continental ice, lakes, etc. (kg m^{-2})      
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: snow_age        !! Snow age (days)        
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio_age  !! Snow age on continental ice, lakes, etc. (days)    
+
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (inout)  :: albedo          !! Albedo (unitless ratio)          
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: albedo_snow     !! Snow albedo (unitless ratio)     
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: albedo_glob     !! Mean albedo (unitless ratio)     
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+ 
+    INTEGER(i_std)                                      :: ji, jv, jb      !! indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: frac_snow_veg   !! Fraction of snow on vegetation (unitless ratio)
+    REAL(r_std), DIMENSION(kjpindex,nnobio)             :: frac_snow_nobio !! Fraction of snow on continental ice, lakes, etc. 
+                                                                           !! (unitless ratio)
+    REAL(r_std), DIMENSION(kjpindex)                    :: snowa_veg       !! Albedo of snow covered area on vegetation
+                                                                           !! (unitless ratio)
+    REAL(r_std), DIMENSION(kjpindex,nnobio)             :: snowa_nobio     !! Albedo of snow covered area on continental ice, 
+                                                                           !! lakes, etc. (unitless ratio)     
+    REAL(r_std), DIMENSION(kjpindex)                    :: fraction_veg    !! Total vegetation fraction (unitless ratio)
+    REAL(r_std), DIMENSION(kjpindex)                    :: agefunc_veg     !! Age dependency of snow albedo on vegetation 
+                                                                           !! (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nnobio)             :: agefunc_nobio   !! Age dependency of snow albedo on ice, 
+                                                                           !! lakes, .. (unitless)
+    REAL(r_std)                                         :: alb_nobio       !! Albedo of continental ice, lakes, etc. 
+                                                                           !!(unitless ratio)
+!_ ================================================================================================================================
+
+    !! 1.Reset output variable (::albedo_snow ::albedo_glob) 
+
+    DO ji = 1, kjpindex
+     albedo_snow(ji) = zero
+     albedo_glob(ji) = zero
+    ENDDO
+
+    !! 2. Calculate snow albedos on both total vegetated and total nobio surfaces
+ 
+    ! The snow albedo could be either prescribed (in condveg_init.f90) or 
+    !  calculated following Chalita and Treut (1994).
+    ! Check if the precribed value fixed_snow_albedo exists
+    IF (ABS(fixed_snow_albedo - undef_sechiba) .GT. EPSILON(undef_sechiba)) THEN
+      snowa_veg(:) = fixed_snow_albedo
+      snowa_nobio(:,:) = fixed_snow_albedo
+    ELSE ! calculated following Chalita and Treut (1994)
+      
+      !! 2.1 Calculate age dependence
+
+      ! On vegetated surfaces
+      DO ji = 1, kjpindex
+        agefunc_veg(ji) = EXP(-snow_age(ji)/tcst_snowa)
+      ENDDO
+
+      ! On non-vegtative surfaces
+      DO jv = 1, nnobio ! Loop over # nobio types
+        DO ji = 1, kjpindex
+          agefunc_nobio(ji,jv) = EXP(-snow_nobio_age(ji,jv)/tcst_snowa)
+        ENDDO
+      ENDDO
+
+      !! 2.1 Calculate snow albedo 
+
+      ! For  vegetated surfaces
+      fraction_veg(:) = un - totfrac_nobio(:)
+      snowa_veg(:) = zero
+      IF (control%ok_dgvm) THEN
+         DO ji = 1, kjpindex
+            IF ( fraction_veg(ji) .GT. min_sechiba ) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+               snowa_veg(ji) = snowa_veg(ji) + &
+                    tot_bare_soil(ji)/fraction_veg(ji) * ( snowa_ini(1)+snowa_dec(1)*agefunc_veg(ji) )
+            ENDIF
+         ENDDO
+
+         DO jv = 2, nvm
+            DO ji = 1, kjpindex
+               IF ( fraction_veg(ji) .GT. min_sechiba ) THEN
+                  snowa_veg(ji) = snowa_veg(ji) + &
+                       veget(ji,jv)/fraction_veg(ji) * ( snowa_ini(jv)+snowa_dec(jv)*agefunc_veg(ji) )
+               ENDIF
+            ENDDO
+         ENDDO
+      ELSE
+         DO jv = 1, nvm
+            DO ji = 1, kjpindex
+               IF ( fraction_veg(ji) .GT. min_sechiba ) THEN
+                  snowa_veg(ji) = snowa_veg(ji) + &
+                       veget_max(ji,jv)/fraction_veg(ji) * ( snowa_ini(jv)+snowa_dec(jv)*agefunc_veg(ji) )
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDIF
+      !
+      ! snow albedo on other surfaces
+      !
+      DO jv = 1, nnobio
+        DO ji = 1, kjpindex
+          snowa_nobio(ji,jv) = ( snowa_ini(1) + snowa_dec(1) * agefunc_nobio(ji,jv) ) 
+        ENDDO
+      ENDDO
+    ENDIF
+ 
+    !! 3. Calculate snow cover fraction for both total vegetated and total non-vegtative surfaces.\n
+
+    frac_snow_veg(:) = MIN(MAX(snow(:),zero)/(MAX(snow(:),zero)+snowcri_alb),un)
+    DO jv = 1, nnobio
+      frac_snow_nobio(:,jv) = MIN(MAX(snow_nobio(:,jv),zero)/(MAX(snow_nobio(:,jv),zero)+snowcri_alb),un)
+    ENDDO
+
+
+    !! 4. Update surface albedo
+    
+    ! Update surface albedo using the weighted sum of previous time step surface albedo,
+    ! total vegetated fraction, total nobio fraction, snow cover fraction (both vegetated and 
+    ! non-vegetative surfaces), and snow albedo (both vegetated and non-vegetative surfaces). 
+    ! Although both visible and near-infrared surface albedo are presented, their calculations 
+    ! are the same.
+    DO jb = 1, 2
+     
+      albedo(:,jb) = ( fraction_veg(:) ) * &
+                         ( (un-frac_snow_veg(:)) * albedo(:,jb) + &
+                           ( frac_snow_veg(:)  ) * snowa_veg(:)    )
+      albedo_snow(:) =  albedo_snow(:) + (fraction_veg(:)) * (frac_snow_veg(:)) * snowa_veg(:)
+      !
+      DO jv = 1, nnobio ! Loop over # nobio surfaces
+        ! 
+        IF ( jv .EQ. iice ) THEN
+          alb_nobio = alb_ice(jb)
+        ELSE
+          WRITE(numout,*) 'jv=',jv
+          STOP 'DO NOT KNOW ALBEDO OF THIS SURFACE TYPE'
+        ENDIF
+        !
+        albedo(:,jb) = albedo(:,jb) + &
+                       ( frac_nobio(:,jv) ) * &
+                         ( (un-frac_snow_nobio(:,jv)) * alb_nobio + &
+                           ( frac_snow_nobio(:,jv)  ) * snowa_nobio(:,jv)   )
+        albedo_snow(:) = albedo_snow(:) + &
+                         ( frac_nobio(:,jv) ) * ( frac_snow_nobio(:,jv) ) * &
+                           snowa_nobio(:,jv)
+        albedo_glob(:) = albedo_glob(:) + albedo(:,jb)
+    
+      ENDDO
+    
+    END DO
+    
+    DO ji = 1, kjpindex
+      albedo_snow(ji) = (albedo_snow(ji))/2.
+      albedo_glob(ji) = (albedo_glob(ji))/2.
+    ENDDO
+    
+    IF (long_print) WRITE (numout,*) ' condveg_snow done '
+
+  END SUBROUTINE condveg_snow
+  
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_soilalb
+!!
+!>\BRIEF        This subroutine calculates the albedo of soil (without snow).
+!!
+!! DESCRIPTION  This subroutine reads the soil colour maps in 1 x 1 deg resolution 
+!! from the Henderson-Sellers & Wilson database. These values are interpolated to 
+!! the model's resolution and transformed into 
+!! dry and wet albedos.\n
+!!
+!! If the soil albedo is calculated without the dependence of soil moisture, the
+!! soil colour values are transformed into mean soil albedo values.\n 
+!!
+!! The calculations follow the assumption that the grid of the data is regular and 
+!! it covers the globe. The calculation for the model grid are based on the borders 
+!! of the grid of the resolution.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):    soilalb_dry for visible and near-infrared range,
+!!                             soilalb_wet for visible and near-infrared range, 
+!!                             soilalb_moy for visible and near-infrared range 
+!!
+!! REFERENCE(S) : 
+!! -Wilson, M.F., and A. Henderson-Sellers, 1985: A global archive of land cover and
+!!  soils data for use in general circulation climate models. J. Clim., 5, 119-143.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE condveg_soilalb(nbpt, lalo, neighbours, resolution, contfrac, soilalb_dry,soilalb_wet)
+  
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                    :: nbpt                  !! Number of points for which the data needs to be 
+                                                                           !! interpolated (unitless)             
+    REAL(r_std), INTENT(in)                       :: lalo(nbpt,2)          !! Vector of latitude and longitudes (degree)        
+    INTEGER(i_std), INTENT(in)                    :: neighbours(nbpt,8)    !! Vector of neighbours for each grid point 
+                                                                           !! (1=N, 2=E, 3=S, 4=W)  
+    REAL(r_std), INTENT(in)                       :: resolution(nbpt,2)    !! The size of each grid cell in X and Y (km)
+    REAL(r_std), INTENT(in)                       :: contfrac(nbpt)        !! Fraction of land in each grid cell (unitless)   
+    REAL(r_std), INTENT(inout)                    :: soilalb_dry(nbpt,2)   !! Albedo of the dry bare soil (unitless)
+    REAL(r_std), INTENT(inout)                    :: soilalb_wet(nbpt,2)   !! Albedo of the wet dry soil (unitless)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                :: nbvmax                !! nbvmax for interpolation (unitless). It is the 
+                                                                           !! dimension of the variables in which we store the list
+                                                                           !! of points of the source grid which fit into one grid 
+                                                                           !! box of the target. 
+    CHARACTER(LEN=80)                             :: filename              !! Filename of soil colour map
+    INTEGER(i_std)                                :: iml, jml, lml, &
+                      &tml, fid, ib, ip, jp, fopt, ilf, lastjp, nbexp      !! Indices
+    REAL(r_std)                                   :: lev(1), date, dt      !! Help variables to read in file data
+    INTEGER(i_std)                                :: itau(1)               !! Help variables to read in file data
+    REAL(r_std)                                   :: sgn                   !! Help variable to compute average bare soil albedo 
+    REAL(r_std)                                   :: coslat                !! [DISPENSABLE]
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lat_rel               !! Help variable to read file data and allocate memory
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lon_rel               !! Help variable to read file data and allocate memory
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: soilcol               !! Help variable to read file data and allocate memory
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: sub_area              !! Help variable to read file data and allocate memory
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sub_index             !! Help variable to read file data and allocate memory
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: mask                  !! Help variable to read file data and allocate memory
+    CHARACTER(LEN=30)                             :: callsign              !! Help variable to read file data and allocate memory
+    LOGICAL                                       :: ok_interpol = .FALSE. !! Optional return of aggregate_2d
+    INTEGER                                       :: ALLOC_ERR             !! Help varialbe to count allocation error
+!_ ================================================================================================================================
+  
+  !! 1. Open file and allocate memory
+
+  ! Open file with soil colours 
+
+  !Config Key   = SOILALB_FILE
+  !Config Desc  = Name of file from which the bare soil albedo
+  !Config Def   = soils_param.nc
+  !Config If    = NOT(IMPOSE_AZE)
+  !Config Help  = The name of the file to be opened to read the soil types from 
+  !Config         which we derive then the bare soil albedos. This file is 1x1 
+  !Config         deg and based on the soil colors defined by Wilson and Henderson-Seller.
+  !Config Units = [FILE]
+  !
+  filename = 'soils_param.nc'
+  CALL getin_p('SOILALB_FILE',filename)
+  
+  ! Read data from file
+  IF (is_root_prc) CALL flininfo(filename,iml, jml, lml, tml, fid)
+  CALL bcast(iml)
+  CALL bcast(jml)
+  CALL bcast(lml)
+  CALL bcast(tml)
+
+  ! Allocate memory for latitudes
+  ALLOC_ERR=-1
+  ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of lat_rel : ",ALLOC_ERR
+     STOP 
+  ENDIF
+
+  ! Allcoate memory for longitude
+  ALLOC_ERR=-1
+  ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of lon_rel : ",ALLOC_ERR
+     STOP 
+  ENDIF
+
+  ! Allocate memory for mask
+  ALLOC_ERR=-1
+  ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
+     STOP 
+  ENDIF
+
+  ! Allocate memory for soil data
+  ALLOC_ERR=-1
+  ALLOCATE(soilcol(iml,jml), STAT=ALLOC_ERR)
+  IF (ALLOC_ERR/=0) THEN
+     WRITE(numout,*) "ERROR IN ALLOCATION of soiltext : ",ALLOC_ERR
+     STOP 
+  ENDIF
+  
+  ! Set values
+  IF (is_root_prc) CALL flinopen(filename, .FALSE., iml, jml, lml, lon_rel, lat_rel, lev, tml, itau, date, dt, fid)
+  CALL bcast(lon_rel)
+  CALL bcast(lat_rel)
+  CALL bcast(lev)
+  CALL bcast(itau)
+  CALL bcast(date)
+  CALL bcast(dt)
+  
+  IF (is_root_prc) CALL flinget(fid, 'soilcolor', iml, jml, lml, tml, 1, 1, soilcol)
+  CALL bcast(soilcol)
+  
+  IF (is_root_prc) CALL flinclo(fid)
+  
+  ! Create mask with values of soil colour
+  mask(:,:) = zero
+  DO ip=1,iml
+     DO jp=1,jml
+        IF (soilcol(ip,jp) > min_sechiba) THEN
+           mask(ip,jp) = un
+        ENDIF
+     ENDDO
+  ENDDO
+  
+  ! Set nbvmax to 200 for interpolation
+  ! This number is the dimension of the variables in which we store 
+  ! the list of points of the source grid which fit into one grid box of the target. 
+  nbvmax = 200
+  
+  callsign = 'Soil color map'
+  
+  ! Start with interpolation
+  DO WHILE ( .NOT. ok_interpol )
+     WRITE(numout,*) "Projection arrays for ",callsign," : "
+     WRITE(numout,*) "nbvmax = ",nbvmax
+     
+     ALLOC_ERR=-1
+     ALLOCATE(sub_area(nbpt,nbvmax), STAT=ALLOC_ERR)
+     IF (ALLOC_ERR/=0) THEN
+         WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+        STOP 
+     ENDIF
+     sub_area(:,:)=zero
+     ALLOC_ERR=-1
+     ALLOCATE(sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+     IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+        STOP 
+     ENDIF
+     sub_index(:,:,:)=0
+     
+     CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+          &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+          &                nbvmax, sub_index, sub_area, ok_interpol)
+     
+     IF ( .NOT. ok_interpol ) THEN
+        DEALLOCATE(sub_area)
+        DEALLOCATE(sub_index)
+     ENDIF
+     
+     nbvmax = nbvmax * 2
+  ENDDO
+  
+  ! Check how many points with soil information are found
+  nbexp = 0
+
+  soilalb_dry(:,:) = zero
+  soilalb_wet(:,:) = zero
+  soilalb_moy(:,:) = zero
+
+  DO ib=1,nbpt ! Loop over domain size
+
+     fopt =  COUNT(sub_area(ib,:) > zero)
+
+     !! 3. Compute the average bare soil albedo parameters
+     
+     IF ( fopt .EQ. 0) THEN      ! If no points were interpolated
+        nbexp = nbexp + 1
+        soilalb_dry(ib,ivis) = (SUM(vis_dry)/classnb + SUM(vis_wet)/classnb)/deux
+        soilalb_dry(ib,inir) = (SUM(nir_dry)/classnb + SUM(nir_wet)/classnb)/deux
+        soilalb_wet(ib,ivis) = (SUM(vis_dry)/classnb + SUM(vis_wet)/classnb)/deux
+        soilalb_wet(ib,inir) = (SUM(nir_dry)/classnb + SUM(nir_wet)/classnb)/deux
+        soilalb_moy(ib,ivis) = SUM(albsoil_vis)/classnb
+        soilalb_moy(ib,inir) = SUM(albsoil_nir)/classnb
+     ELSE
+        sgn = zero
+
+        DO ilf = 1,fopt         ! If points were interpolated
+           
+           ip = sub_index(ib,ilf,1)
+           jp = sub_index(ib,ilf,2)
+           
+           ! Weighted albedo values by interpolation area
+           IF ( NINT(soilcol(ip,jp)) .LE. classnb) THEN
+              soilalb_dry(ib,ivis) = soilalb_dry(ib,ivis) + vis_dry(NINT(soilcol(ip,jp))) * sub_area(ib,ilf)
+              soilalb_dry(ib,inir) = soilalb_dry(ib,inir) + nir_dry(NINT(soilcol(ip,jp))) * sub_area(ib,ilf)
+              soilalb_wet(ib,ivis) = soilalb_wet(ib,ivis) + vis_wet(NINT(soilcol(ip,jp))) * sub_area(ib,ilf)
+              soilalb_wet(ib,inir) = soilalb_wet(ib,inir) + nir_wet(NINT(soilcol(ip,jp))) * sub_area(ib,ilf)
+              soilalb_moy(ib,ivis) = soilalb_moy(ib,ivis) + albsoil_vis(NINT(soilcol(ip,jp))) * sub_area(ib,ilf)
+              soilalb_moy(ib,inir) = soilalb_moy(ib,inir) + albsoil_nir(NINT(soilcol(ip,jp))) * sub_area(ib,ilf)
+              sgn = sgn + sub_area(ib,ilf)
+           ELSE
+              WRITE(numout,*) 'The file contains a soil color class which is incompatible with this program'
+              STOP
+           ENDIF
+           
+        ENDDO
+
+        ! Normalize the surface
+        IF ( sgn .LT. min_sechiba) THEN
+           nbexp = nbexp + 1
+           soilalb_dry(ib,ivis) = (SUM(vis_dry)/classnb + SUM(vis_wet)/classnb)/deux
+           soilalb_dry(ib,inir) = (SUM(nir_dry)/classnb + SUM(nir_wet)/classnb)/deux
+           soilalb_wet(ib,ivis) = (SUM(vis_dry)/classnb + SUM(vis_wet)/classnb)/deux
+           soilalb_wet(ib,inir) = (SUM(nir_dry)/classnb + SUM(nir_wet)/classnb)/deux
+           soilalb_moy(ib,ivis) = SUM(albsoil_vis)/classnb
+           soilalb_moy(ib,inir) = SUM(albsoil_nir)/classnb
+        ELSE
+           soilalb_dry(ib,ivis) = soilalb_dry(ib,ivis)/sgn
+           soilalb_dry(ib,inir) = soilalb_dry(ib,inir)/sgn
+           soilalb_wet(ib,ivis) = soilalb_wet(ib,ivis)/sgn
+           soilalb_wet(ib,inir) = soilalb_wet(ib,inir)/sgn
+           soilalb_moy(ib,ivis) = soilalb_moy(ib,ivis)/sgn
+           soilalb_moy(ib,inir) = soilalb_moy(ib,inir)/sgn           
+        ENDIF
+
+     ENDIF
+
+  ENDDO
+
+  IF ( nbexp .GT. 0 ) THEN
+     WRITE(numout,*) 'CONDVEG_soilalb : The interpolation of the bare soil albedo had ', nbexp
+     WRITE(numout,*) 'CONDVEG_soilalb : points without data. This are either coastal points or'
+     WRITE(numout,*) 'CONDVEG_soilalb : ice covered land.'
+     WRITE(numout,*) 'CONDVEG_soilalb : The problem was solved by using the average of all soils'
+     WRITE(numout,*) 'CONDVEG_soilalb : in dry and wet conditions'
+  ENDIF
+
+  DEALLOCATE (lat_rel)
+  DEALLOCATE (lon_rel)
+  DEALLOCATE (mask)
+  DEALLOCATE (sub_index)
+  DEALLOCATE (sub_area)
+  DEALLOCATE (soilcol)
+
+  RETURN
+
+  END SUBROUTINE condveg_soilalb
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_z0logz
+!!
+!>\BRIEF        Computation of grid average of roughness height by averaging  the 
+!! logarithm of the roughness height of each grid box components fracbio and fracnobio.
+!!
+!! DESCRIPTION  : Calculates mean roughness height
+!!  over the grid cell. The mean roughness height is derived from the vegetation 
+!! height which is scaled by the roughness parameter. The sum of the logarithm of the 
+!! roughness times the fraction per grid cell gives the average roughness height per 
+!! grid cell for the vegetative PFTs. The roughness height for the non-vegetative PFTs 
+!! is calculated in a second step. \n
+!!
+!! To compute the fluxes,  
+!! the difference between the height of the vegetation and the zero plane displacement height
+!! is needed and called roughheight .\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): roughness height (z0), grid effective roughness height (roughheight)
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_z0logz (kjpindex, veget, veget_max, frac_nobio, totfrac_nobio, height, &
+       &                     z0, roughheight)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                          :: kjpindex      !! Domain size - Number of land pixels  (unitless) 
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: veget         !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                         !! (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: veget_max     !! PFT "Maximal" coverage fraction of a PFT 
+                                                                         !! (= ind*cn_ind) (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nnobio), INTENT(in) :: frac_nobio    !! Fraction of non-vegetative surfaces, 
+                                                                         !! i.e. continental ice, lakes, etc. (unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: totfrac_nobio !! Total fraction of non-vegetative surfaces, 
+                                                                         !! i.e. continental ice, lakes, etc. (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: height        !! Vegetation height (m)
+    
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: z0            !! Soil roughness height (m) 
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: roughheight   !! Grid effective roughness height (m) 
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                      :: jv            !! Loop index over PFTs (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: sumveg        !! Fraction of bare soil (unitless) 
+    REAL(r_std), DIMENSION(kjpindex)                    :: ave_height    !! Average vegetation height (m)
+    REAL(r_std), DIMENSION(kjpindex)                    :: d_veg         !! PFT coverage of vegetative PFTs 
+                                                                         !! (= ind*cn_ind) (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)                    :: zhdispl       !! Zero plane displacement height (m)
+    REAL(r_std)                                         :: z0_nobio      !! Roughness of non-vegetative fraction (m),  
+                                                                         !! i.e. continental ice, lakes, etc. 
+!_ ================================================================================================================================
+    
+    !! 1. Preliminary calculation
+
+    ! Calculate the roughness (m) of bare soil, z0_bare
+    ! taken from constantes_veg.f90    
+    z0(:) = tot_bare_soil(:) * LOG(z0_bare)
+
+    ! Define fraction of bare soil
+    sumveg(:) = tot_bare_soil(:)
+
+    ! Set average vegetation height to zero
+    ave_height(:) = zero
+
+    !! 2. Calculate the mean roughness length 
+    
+    ! Calculate the mean roughness height of
+    ! vegetative PFTs over the grid cell
+    DO jv = 2, nvm !Loop over # vegetative PFTs
+
+       ! In the case of forest, use parameter veget_max because 
+       ! tree trunks influence the roughness even when there are no leaves
+       IF ( is_tree(jv) ) THEN
+          d_veg(:) = veget_max(:,jv)
+       ELSE
+
+          ! In the case of grass, use parameter veget because grasses 
+          ! only influence the roughness during the growing season
+          d_veg(:) = veget(:,jv)
+       ENDIF
+       
+       ! Calculate the average roughness over the grid cell:
+       ! The roughness for vegetative PFTs is calculated by
+       ! the vegetation height per PFT multiplied by the roughness 
+       ! parameter 'z0_over_height= 1/16'. If this scaled value is 
+       ! lower than 0.01 than the value for the roughness length 
+       ! of bare soil (0.01) is used. The sum of the logarithm of 
+       ! the roughness times the fraction per grid cell gives the 
+       ! logarithm of roughness length per grid cell for the vegetative
+       ! PFTs.
+       z0(:) = z0(:) + d_veg(:) * &
+            LOG( MAX(height(:,jv)*z0_over_height,z0_bare) )
+       ! Sum of bare soil and fraction vegetated fraction 
+       sumveg(:) = sumveg(:) + d_veg(:)
+
+       ! Weighted height of vegetation with maximal cover fraction
+       ave_height(:) = ave_height(:) + veget_max(:,jv)*height(:,jv)
+       
+    ENDDO !Loop over # vegetative PFTs
+    
+    !! 3. Calculate the mean roughness length of non-vegetative surfaces \n
+
+    ! Search for pixels with vegetated part to normalise 
+    ! roughness length
+    WHERE ( sumveg(:) > zero ) z0(:) = z0(:) / sumveg(:)
+    
+    ! Calculate fraction of roughness for vegetated part 
+    z0(:) = (un - totfrac_nobio(:)) * z0(:)
+    
+    DO jv = 1, nnobio ! Loop over # of non-vegative surfaces
+    
+       ! Set rougness for ice 
+       IF ( jv .EQ. iice ) THEN
+          z0_nobio = z0_ice
+       ELSE
+          WRITE(numout,*) 'jv=',jv
+          STOP 'DO NOT KNOW ROUGHNESS OF THIS SURFACE TYPE'
+       ENDIF
+       
+       ! Sum of vegetative roughness length and non-vegetative
+       ! roughness length
+       z0(:) = z0(:) + frac_nobio(:,jv) * LOG(z0_nobio)
+    
+    ENDDO ! loop over # of non-vegative surfaces
+    
+    !! 4. Calculate the zero plane displacement height and effective roughness length
+
+    !  Take the exponential of the roughness length 
+    z0(:) = EXP( z0(:) )
+
+    ! Compute the zero plane displacement height which
+    ! is an equivalent height of the vegetation for the absorption of momentum
+    zhdispl(:) = ave_height(:) * height_displacement
+
+    ! Then we compute what we call the grid effective roughness height.
+    ! This is the height over which the roughness acts. It combines the
+    ! zero plane displacement height and the vegetation height.  This 
+    ! effective value is the difference between the height of the 
+    ! vegetation and the zero plane displacement height.
+    roughheight(:) = ave_height(:) - zhdispl(:)
+
+  END SUBROUTINE condveg_z0logz
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_z0cdrag
+!!
+!>\BRIEF        Computation of grid average of roughness length by calculating 
+!! the drag coefficient.
+!!
+!! DESCRIPTION  : This routine calculates the mean roughness height and mean 
+!! effective roughness height over the grid cell. The mean roughness height (z0) 
+!! is computed by averaging the drag coefficients  \n
+!!
+!! \latexonly 
+!! \input{z0cdrag1.tex}
+!! \endlatexonly
+!! \n 
+!!
+!! where C is the drag coefficient at the height of the vegetation, kappa is the 
+!! von Karman constant, z (Ztmp) is the height at which the fluxes are estimated and z0 the roughness height. 
+!! The reference level for z needs to be high enough above the canopy to avoid 
+!! singularities of the LOG. This height is set to  minimum 10m above ground. 
+!! The drag coefficient increases with roughness height to represent the greater 
+!! turbulence generated by rougher surfaces. 
+!! The roughenss height is obtained by the inversion of the drag coefficient equation.\n
+!!
+!! The roughness height for the non-vegetative surfaces is calculated in a second step. 
+!! In order to calculate the transfer coefficients the 
+!! effective roughness height is calculated. This effective value is the difference
+!! between the height of the vegetation and the zero plane displacement height.\nn
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S):  :: roughness height(z0) and grid effective roughness height(roughheight)
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_z0cdrag (kjpindex,veget,veget_max,frac_nobio,totfrac_nobio,zlev, height, &
+       &                      z0, roughheight)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+   
+    INTEGER(i_std), INTENT(in)                          :: kjpindex      !! Domain size - Number of land pixels  (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: veget         !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                         !! (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: veget_max     !! PFT "Maximal" coverage fraction of a PFT 
+                                                                         !! (= ind*cn_ind) (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nnobio), INTENT(in) :: frac_nobio    !! Fraction of non-vegetative surfaces, 
+                                                                         !! i.e. continental ice, lakes, etc. (unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: totfrac_nobio !! Total fraction of non-vegetative surfaces, 
+                                                                         !! i.e. continental ice, lakes, etc. (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: zlev          !! Height of first layer (m)           
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: height        !! Vegetation height (m)    
+    
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: z0            !! Roughness height (m)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)       :: roughheight   !! Grid effective roughness height (m) 
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: jv            !! Loop index over PFTs (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: sumveg        !! Fraction of bare soil (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: ztmp          !! Max height of the atmospheric level (m)
+    REAL(r_std), DIMENSION(kjpindex)                    :: ave_height    !! Average vegetation height (m)
+    REAL(r_std), DIMENSION(kjpindex)                    :: d_veg         !! PFT coverage of vegetative PFTs 
+                                                                         !! (= ind*cn_ind) (m^2 m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)                    :: zhdispl       !! Zero plane displacement height (m)
+    REAL(r_std)                                         :: z0_nobio      !! Roughness height of non-vegetative fraction (m),  
+                                                                         !! i.e. continental ice, lakes, etc. 
+!_ ================================================================================================================================
+    
+    !! 1. Preliminary calculation
+
+    ! Set maximal height of first layer
+    ztmp(:) = MAX(10., zlev(:))
+
+    ! Calculate roughness for non-vegetative surfaces
+    ! with the von Karman constant 
+    z0(:) = tot_bare_soil(:) * (ct_karman/LOG(ztmp(:)/z0_bare))**2
+
+    ! Fraction of bare soil
+    sumveg(:) = tot_bare_soil(:)
+
+    ! Set average vegetation height to zero
+    ave_height(:) = zero
+    
+    !! 2. Calculate the mean roughness height 
+    
+    ! Calculate the mean roughness height of
+    ! vegetative PFTs over the grid cell
+    DO jv = 2, nvm
+
+       ! In the case of forest, use parameter veget_max because 
+       ! tree trunks influence the roughness even when there are no leaves
+       IF ( is_tree(jv) ) THEN
+          ! In the case of grass, use parameter veget because grasses 
+          ! only influence the roughness during the growing season
+          d_veg(:) = veget_max(:,jv)
+       ELSE
+          ! grasses only have an influence if they are really there!
+          d_veg(:) = veget(:,jv)
+       ENDIF
+       
+       ! Calculate the average roughness over the grid cell:
+       ! The unitless drag coefficient is per vegetative PFT
+       ! calculated by use of the von Karman constant, the height 
+       ! of the first layer and the roughness. The roughness
+       ! is calculated as the vegetation height  per PFT 
+       ! multiplied by the roughness  parameter 'z0_over_height= 1/16'. 
+       ! If this scaled value is lower than 0.01 then the value for 
+       ! the roughness of bare soil (0.01) is used. 
+       ! The sum over all PFTs gives the average roughness 
+       ! per grid cell for the vegetative PFTs.
+       z0(:) = z0(:) + d_veg(:) * (ct_karman/LOG(ztmp(:)/MAX(height(:,jv)*z0_over_height,z0_bare)))**2
+
+       ! Sum of bare soil and fraction vegetated fraction
+       sumveg(:) = sumveg(:) + d_veg(:)
+       
+       ! Weigh height of vegetation with maximal cover fraction
+       ave_height(:) = ave_height(:) + veget_max(:,jv)*height(:,jv)
+       
+    ENDDO
+    
+    !! 3. Calculate the mean roughness height of vegetative PFTs over the grid cell
+    
+    !  Search for pixels with vegetated part to normalise 
+    !  roughness height
+    WHERE ( sumveg(:) .GT. zero ) z0(:) = z0(:) / sumveg(:)
+
+    ! Calculate fraction of roughness for vegetated part 
+    z0(:) = (un - totfrac_nobio(:)) * z0(:)
+
+    DO jv = 1, nnobio ! Loop over # of non-vegative surfaces
+
+       ! Set rougness for ice
+       IF ( jv .EQ. iice ) THEN
+          z0_nobio = z0_ice
+       ELSE
+          WRITE(numout,*) 'jv=',jv
+          STOP 'DO NOT KNOW ROUGHNESS OF THIS SURFACE TYPE'
+       ENDIF
+       
+       ! Sum of vegetative roughness length and non-vegetative
+       ! roughness length
+       z0(:) = z0(:) + frac_nobio(:,jv) * (ct_karman/LOG(ztmp(:)/z0_nobio))**2
+       
+    ENDDO ! Loop over # of non-vegative surfaces
+    
+    !! 4. Calculate the zero plane displacement height and effective roughness length
+
+    !  Take the exponential of the roughness 
+    z0(:) = ztmp(:) / EXP(ct_karman/SQRT(z0(:)))
+
+    ! Compute the zero plane displacement height which
+    ! is an equivalent height for the absorption of momentum
+    zhdispl(:) = ave_height(:) * height_displacement
+
+    ! In order to calculate the fluxes we compute what we call the grid effective roughness height.
+    ! This is the height over which the roughness acts. It combines the
+    ! zero plane displacement height and the vegetation height.
+    roughheight(:) = ave_height(:) - zhdispl(:)
+
+  END SUBROUTINE condveg_z0cdrag
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : condveg_albcalc
+!!
+!>\BRIEF        This subroutine calculates the albedo without snow.
+!!
+!! DESCRIPTION  : The albedo is calculated for both the visible and near-infrared 
+!! domain. First the mean albedo of the bare soil is calculated. Two options exist: 
+!! either the soil albedo depends on soil wetness (drysoil_frac variable), or the soil albedo 
+!! is set to a mean soil albedo value.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): albedo 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE condveg_albcalc (kjpindex,veget,drysoil_frac,albedo)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT(in)                       :: kjpindex       !! Domain size - Number of land pixels  (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: veget          !! PFT coverage fraction of a PFT (= ind*cn_ind) 
+                                                                       !! (m^2 m^{-2})        
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)     :: drysoil_frac   !! Fraction of  dry soil (unitless) 
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out) :: albedo         !! Albedo for visible and near-infrared range 
+                                                                       !! (unitless)   
+ 
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+ 
+!    REAL(r_std),DIMENSION (kjpindex)                 :: alb_bare       !! Soil albedo for visible and near-infrared range 
+                                                                       !! (unitless) 
+    REAL(r_std),DIMENSION (nvm,2)                    :: alb_leaf_tmp   !! Variable for albedo values for all PFTs and 
+                                                                       !! spectral domains (unitless) 
+    INTEGER(i_std)                                   :: ks             !! Index for visible and near-infraread range
+    INTEGER(i_std)                                   :: jv             !! Index for vegetative PFTs
+!_ ================================================================================================================================
+    
+ !! 1. Preliminary calculation
+
+    ! Assign values of leaf albedo for visible and near-infrared range
+    ! to local variable (constantes_veg.f90)
+    alb_leaf_tmp(:,ivis) = alb_leaf_vis(:)
+    alb_leaf_tmp(:,inir) = alb_leaf_nir(:)
+
+ !! 2. Calculation and assignment of soil albedo
+
+    DO ks = 1, 2! Loop over # of spectra
+
+       ! If 'alb_bare_model' is set to TRUE,  the soil albedo calculation depends on soil moisture
+       ! If 'alb_bare_model' is set to FALSE, the mean soil albedo is used without the dependance on soil moisture
+       ! see subroutine 'conveg_soilalb'
+       IF ( alb_bare_model ) THEN
+          alb_bare(:,ks) = soilalb_wet(:,ks) + drysoil_frac(:) * (soilalb_dry(:,ks) -  soilalb_wet(:,ks))
+       ELSE
+          alb_bare(:,ks) = soilalb_moy(:,ks)
+       ENDIF
+
+       ! Soil albedo is weighed by fraction of bare soil          
+       albedo(:,ks) = tot_bare_soil(:) * alb_bare(:,ks)
+
+!! 3. Calculation of mean albedo of over the grid cell 
+  
+       ! Calculation of mean albedo of over the grid cell and
+       !    mean albedo of only vegetative PFTs over the grid cell
+       alb_veget(:,ks) = zero
+
+       DO jv = 2, nvm  ! Loop over # of PFTs
+
+          ! Mean albedo of grid cell for visible and near-infrared range
+          albedo(:,ks) = albedo(:,ks) + veget(:,jv)*alb_leaf_tmp(jv,ks)
+
+          ! Mean albedo of vegetation for visible and near-infrared range
+          alb_veget(:,ks) = alb_veget(:,ks) + veget(:,jv)*alb_leaf_tmp(jv,ks)
+       ENDDO ! Loop over # of PFTs
+
+    ENDDO
+
+  END SUBROUTINE condveg_albcalc
+
+END MODULE condveg
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/diffuco.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/diffuco.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/diffuco.f90	(revision 5166)
@@ -0,0 +1,4163 @@
+! ================================================================================================================================
+!  MODULE       : diffuco
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF   This module calculates the limiting coefficients, both aerodynamic
+!! and hydrological, for the turbulent heat fluxes.
+!!
+!!\n DESCRIPTION: The aerodynamic resistance R_a is used to limit
+!! the transport of fluxes from the surface layer of vegetation to the point in the atmosphere at which
+!! interaction with the LMDZ atmospheric circulation model takes place. The aerodynamic resistance is
+!! calculated either within the module r_aerod (if the surface drag coefficient is provided by the LMDZ, and 
+!! if the flag 'ldq_cdrag_from_gcm' is set to TRUE) or r_aero (if the surface drag coefficient must be calculated).\n
+!!
+!! Within ORCHIDEE, evapotranspiration is a function of the Evaporation Potential, but is modulated by a
+!! series of resistances (canopy and aerodynamic) of the surface layer, here represented by beta.\n
+!!
+!! DESCRIPTION	:
+!! \latexonly 
+!!     \input{diffuco_intro.tex}
+!! \endlatexonly
+!! \n
+!!
+!! This module calculates the beta for several different scenarios: 
+!! - diffuco_snow calculates the beta coefficient for sublimation by snow, 
+!! - diffuco_inter calculates the beta coefficient for interception loss by each type of vegetation, 
+!! - diffuco_bare calculates the beta coefficient for bare soil, 
+!! - diffuco_trans or diffuco_trans_co2 both calculate the beta coefficient for transpiration for each type
+!!   of vegetation. Those routines differ by the formulation used to calculate the canopy resistance (Jarvis in 
+!!   diffuco_trans, Farqhar in diffuco_trans_co2)
+!! - diffuco_inca calculates the beta coefficient for emissions of biogenic compounds \n
+!!
+!! Finally, the module diffuco_comb computes the combined $\alpha$ and $\beta$ coefficients for use 
+!! elsewhere in the module. \n
+
+!! RECENT CHANGE(S): Nathalie le 28 mars 2006 - sur proposition de Fred Hourdin, ajout
+!! d'un potentiometre pour regler la resistance de la vegetation (rveg is now in pft_parameters)
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE diffuco
+
+  ! modules used :
+  USE constantes
+  USE qsat_moisture
+  USE sechiba_io
+  USE ioipsl
+  USE pft_parameters
+  USE grid
+  USE ioipsl_para 
+  USE slowproc
+
+  IMPLICIT NONE
+
+  ! public routines :
+  ! diffuco_main only
+  PRIVATE
+  PUBLIC :: diffuco_main,diffuco_clear
+
+  !
+  ! variables used inside diffuco module : declaration and initialisation
+  !
+  LOGICAL, SAVE                                      :: l_first_diffuco = .TRUE.  !! Initialisation has to be done one time
+!$OMP THREADPRIVATE(l_first_diffuco)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: leaf_ci                   !! intercellular CO2 concentration (ppm)
+!$OMP THREADPRIVATE(leaf_ci)
+!  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: rstruct                   !! architectural resistance (s m^{-1})
+!!$OMP THREADPRIVATE(rstruct)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: raero                     !! Aerodynamic resistance (s m^{-1})
+!$OMP THREADPRIVATE(raero)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: qsatt                     !! Surface saturated humidity (kg kg^{-1})
+!$OMP THREADPRIVATE(qsatt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: wind                      !! Wind module (m s^{-1})
+!$OMP THREADPRIVATE(wind)
+
+  ! variables used inside diffuco_inca module 
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)     :: ok_siesta        !! Flag for controlling post-pulse period (true/false)
+!$OMP THREADPRIVATE(ok_siesta)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)     :: allow_pulse      !! Flag for controlling pulse period (true/false)
+!$OMP THREADPRIVATE(allow_pulse)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pulse            !! Pulse fonction 
+!$OMP THREADPRIVATE(pulse)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pulseday         !! Counter for pulse period
+!$OMP THREADPRIVATE(pulseday)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: siestaday        !! Counter for post-pulse period
+!$OMP THREADPRIVATE(siestaday)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: pulselim         !! Pulse period length
+!$OMP THREADPRIVATE(pulselim)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: siestalim        !! Post-pulse period length
+!$OMP THREADPRIVATE(siestalim)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: area2            !! Grid cell area (m^2)
+!$OMP THREADPRIVATE(area2)
+  REAL(r_std), SAVE                            :: nbre_precip 
+!$OMP THREADPRIVATE(nbre_precip)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: flx_co2_bbg_year !! CO2 emissions from bbg, 
+                                                                   !! read in a file (kgC.m^{-2}.year^{-1})
+!$OMP THREADPRIVATE(flx_co2_bbg_year)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: N_qt_WRICE_year  !! N fertilizers on wetland rice,
+                                                                   !! read in a file expressed in kgN/year/grid cell
+!$OMP THREADPRIVATE(N_qt_WRICE_year)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: N_qt_OTHER_year  !! N fertilizers on other crops and grasses,
+                                                                   !! read in a file expressed in kgN/year/grid cell
+!$OMP THREADPRIVATE(N_qt_OTHER_year)
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : diffuco_main
+!!
+!>\BRIEF	 The root subroutine for the module, which calls all other required
+!! subroutines.
+!! 
+!! DESCRIPTION   : 
+
+!! This is the root subroutine for the module. Following
+!! initialisation (if required) and preparation of the restart file, the module first of all calculates
+!! the surface drag coefficient (via a call to diffuco_aero), using available parameters to determine
+!! the stability of air in the surface layer by calculating the Richardson Nubmber. If a value for the 
+!! surface drag coefficient is passed down from the atmospheric model and and if the flag 'ldq_cdrag_from_gcm' 
+!! is set to TRUE, then the subroutine diffuco_aerod is called instead. This calculates the aerodynamic coefficient. \n
+!!
+!! Following this, an estimation of the saturated humidity at the surface is made (via a call
+!! to qsatcalc in the module qsat_moisture). Following this the beta coefficients for sublimation (via 
+!! diffuco_snow), interception (diffuco_inter), bare soil (diffuco_bare), and transpiration (via 
+!! diffuco_trans_co2 if co2 is considered, diffuco_trans otherwise) are calculated in sequence. Finally 
+!! the alpha and beta coefficients are combined (diffuco_comb). \n
+!!
+!! The surface drag coefficient is calculated for use within the module enerbil. It is required to to
+!! calculate the aerodynamic coefficient for every flux. \n
+!!
+!! The various beta coefficients are used within the module enerbil for modifying the rate of evaporation, 
+!! as appropriate for the surface. As explained in Chapter 2 of Guimberteau (2010), that module (enerbil) 
+!! calculates the rate of evaporation essentially according to the expression $E = /beta E_{pot}$, where
+!! E is the total evaporation and $E_{pot}$ the evaporation potential. If $\beta = 1$, there would be
+!! essentially no resistance to evaporation, whereas should $\beta = 0$, there would be no evaporation and
+!! the surface layer would be subject to some very stong hydrological stress. \n
+!!
+!! ATTENTION ::valpha [DISPOSABLE] is not used anymore ! Its value is always 1.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): humrel, q_cdrag, vbeta, valpha, vbeta1, vbeta4,
+!! vbetaco2, vbeta2, vbeta3, rveget, cimean   
+!!
+!! REFERENCE(S) :				        
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273.
+!! - de Rosnay, P, 1999. ReprÃ©sentation des interactions sol-plante-atmosphÃšre dans le modÃšle de circulation gÃ©nÃ©rale
+!! du LMD, 1999. PhD Thesis, UniversitÃ© Paris 6, available (25/01/12): 
+!! http://www.ecmwf.int/staff/patricia_de_rosnay/publications.html#8
+!! - Ducharne, A, 1997. Le cycle de l'eau: modÃ©lisation de l'hydrologie continentale, Ã©tude de ses interactions avec 
+!! le climat, PhD Thesis, UniversitÃ© Paris 6
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available (25/01/12):
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!! - LathiÃšre, J, 2005. Evolution des Ã©missions de composÃ©s organiques et azotÃ©s par la biosphÃšre continentale dans le 
+!! modÃšle LMDz-INCA-ORCHIDEE, UniversitÃ© Paris 6
+!!
+!! FLOWCHART	:
+!! \latexonly 
+!!     \includegraphics[scale=0.5]{diffuco_main_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+
+! Main routine for *diffuco* module.
+! - called only one time for initialisation
+! - called every time step for calculations (also the first time step)
+! - called one more time at last time step for writing _restart_ file
+!
+! The following processes are calculated:
+! - call diffuco_aero for aerodynamic transfer coeficient
+! - call diffuco_snow for partial beta coefficient: sublimation
+! - call diffuco_inter for partial beta coefficient: interception for each type of vegetation
+! - call diffuco_bare for partial beta coefficient: bare soil
+! - call diffuco_trans for partial beta coefficient: transpiration for each type of vegetation, using Jarvis formula
+! - call diffuco_trans_co2 for partial beta coefficient: transpiration for each type of vegetation, using Farqhar's formula
+! - call diffuco_comb for alpha and beta coefficient
+! - call diffuco_inca for alpha and beta coefficients for biogenic emissions
+  SUBROUTINE diffuco_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexveg, indexlai, u, v, &
+! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul Rveget
+!     & zlev, z0, roughheight, temp_sol, temp_air, rau, q_cdrag, qsurf, qair, pb, &
+     & zlev, z0, roughheight, temp_sol, temp_air, rau, q_cdrag, qsurf, qair, q2m, t2m, pb, &
+     & rsol, evap_bare_lim, evapot, evapot_corr, snow, flood_frac, flood_res, frac_nobio, snow_nobio, totfrac_nobio, &
+     & swnet, swdown, sinang, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, &
+     & vbeta , valpha, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, vbetaco2, rveget, rstruct, cimean, &
+     & lalo, neighbours, resolution, ptnlev1, precip_rain, frac_age, &
+     & rest_id, hist_id, hist2_id)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number (-) 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),INTENT (in)                         :: rest_id          !! _Restart_ file identifier (-)
+    INTEGER(i_std),INTENT (in)                         :: hist_id          !! _History_ file identifier (-)
+    INTEGER(i_std),INTENT (in)                         :: hist2_id         !! _History_ file 2 identifier (-)
+    REAL(r_std), INTENT (in)                           :: dtradia          !! Time step (s)
+    LOGICAL, INTENT(in)                                :: ldrestart_read   !! Logical for restart file to read (-)
+    LOGICAL, INTENT(in)                                :: ldrestart_write  !! Logical for restart file to write (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: index          !! Indeces of the points on the map (-)
+    INTEGER(i_std),DIMENSION (kjpindex*(nlai+1)), INTENT (in) :: indexlai  !! Indeces of the points on the 3D map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in) :: indexveg       !! Indeces of the points on the 3D map (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: u                !! Eastward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: v                !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: zlev             !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: z0               !! Surface roughness Length (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: roughheight      !! Effective height for roughness (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_sol         !! Skin temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_air         !! Lowest level temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: rau              !! Air Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: qsurf            !! Near surface air specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: qair             !! Lowest level air specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: q2m              !! 2m air specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: t2m              !! 2m air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: snow             !! Snow mass (kg)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: flood_frac       !! Fraction of floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: flood_res        !! Reservoir in floodplains (estimation to avoid over-evaporation)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: pb               !! Surface level pressure (Pa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: rsol             !! Bare soil evaporation resistance (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evap_bare_lim    !! Limit to the bare soil evaporation when the 
+                                                                           !! 11-layer hydrology is used (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot           !! Soil Potential Evaporation (mm day^{-1}) 
+                                                                           !! NdN This variable does not seem to be used at 
+                                                                           !! all in diffuco
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot_corr      !! Soil Potential Evaporation
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio     !! Fraction of ice,lakes,cities,... (-)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio     !! Snow on ice,lakes,cities,... (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: totfrac_nobio    !! Total fraction of ice+lakes+cities+... (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swnet            !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swdown           !! Down-welling surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: sinang           !! Sinus of Solar Angle (as computed in read_dim2)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: ccanopy          !! CO2 concentration inside the canopy (ppm)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget            !! Fraction of vegetation type (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max        !! Max. fraction of vegetation type (LAI->infty)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: lai              !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintveg         !! Water on vegetation due to interception (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintmax         !! Maximum water on vegetation for interception 
+                                                                           !! (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2), INTENT (in) :: assim_param !! min+max+opt temps, vcmax, vjmax
+                                                                           !! for photosynthesis (K ??)
+    REAL(r_std),DIMENSION (kjpindex,2),   INTENT (in)  :: lalo               !! Geographical coordinates
+    INTEGER(i_std),DIMENSION (kjpindex,8),INTENT (in)  :: neighbours         !! Vector of neighbours for each 
+                                                                             !! grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)     :: resolution         !! The size in km of each grid-box in X and Y
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: ptnlev1            !! 1st level of soil temperature (Kelvin)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_rain        !! Rain precipitation expressed in mm/tstep
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT (in)  :: frac_age !! Age efficiency for isoprene emissions (from STOMATE)
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta            !! Total beta coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: valpha           !! Total alpha coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta1           !! Beta for sublimation (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta4           !! Beta for bare soil evaporation (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta5           !! Beta for floodplains
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbetaco2         !! STOMATE: Beta for CO2 assimilation (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta2           !! Beta for interception loss (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta3           !! Beta for transpiration (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta3pot        !! Beta for potential transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: rveget           !! Stomatal resistance for the whole canopy (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: rstruct          !! Structural resistance for the vegetation
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: cimean           !! STOMATE: mean intercellular ci (\mumole m^{-2} s^{-1}) 
+
+    !! 0.3 Modified variables
+ 
+    REAL(r_std),DIMENSION (kjpindex, nvm), INTENT (inout) :: humrel        !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: q_cdrag       !! Product of drag coefficient and wind speed (m s^{-1})
+
+    !! 0.4 Local variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm)               :: vbeta23          !! Beta for fraction of wetted foliage that will
+                                                                           !! transpire once intercepted water has evaporated (-)
+    INTEGER(i_std)                                    :: ilai
+    CHARACTER(LEN=4)                                  :: laistring
+    CHARACTER(LEN=80)                                 :: var_name                  !! To store variables names for I/O
+
+    ! Biogenic emissions
+    REAL(r_std),DIMENSION(kjpindex)          :: PAR                !! Photosynthetic active radiation, half of swdown
+                                                                   !! @tex ($\mu mol photons. m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: PARsun             !! PAR received by sun leaves
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: PARsh              !! PAR received by shaded leaves 
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: laisun             !! Leaf area index of Sun leaves (m^2.m^{-2})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: laish              !! Leaf area index of Shaded leaves (m^2.m^{-2}) 
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_iso            !! Biogenic isoprene emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_mono           !! Biogenic monoterpene emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_ORVOC          !! Biogenic ORVOC emission - (kgC.m^{-2}.s^{-1}) 
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_MBO            !! Biogenic MBO emission -
+                                                                   !! MethylButanOl (kgC.m^{-2}.s^{-1})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_methanol       !! Biogenic methanol emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_acetone        !! Biogenic acetone emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_acetal         !! Biogenic Acetaldehyde emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_formal         !! Biogenic Formaldehyde emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_acetic         !! Biogenic Acetic Acid emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_formic         !! Biogenic Formic Acid emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_no_soil        !! Biogenic NO emission by soil (kgC.m^{-2}.s^{-1})               
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_no             !! Biogenic net NO emission (kgC.m^{-2}.s^{-1})                 
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: CRF                !! Canopy reduction factor for net NO flux calculation    
+    REAL(r_std),DIMENSION(kjpindex,nvm)      :: flx_fertil_no      !! Biogenic NO emission due to N-fertilisation 
+                                                                   !! (kgC.m^{-2}.s^{-1})
+    REAL(r_std),DIMENSION(kjpindex)          :: Fdf                !! Diffuse Fraction of the radiation (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex,nlai+1)   :: PARsuntab          !! PAR received by sun leaves 
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nlai+1)   :: PARshtab           !! PAR received by shaded leaves 
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex)          :: PARdf              !! Diffuse PAR
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex)          :: PARdr              !! Direct PAR 
+                                                                   !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex)          :: Trans              !! Atmospheric Transmissivity (unitless)
+
+    REAL(r_std),DIMENSION(kjpindex)          :: julian_diff_2d     !!
+    REAL(r_std),DIMENSION(kjpindex)          :: year_length_2d     !!
+
+!_ ================================================================================================================================
+    
+  !! 1. Perform initialisation, if required
+    
+    IF (l_first_diffuco) THEN
+
+        !Config Key   = CDRAG_FROM_GCM
+        !Config Desc  = Keep cdrag coefficient from gcm.
+        !Config If    = OK_SECHIBA
+        !Config Def   = y
+        !Config Help  = Set to .TRUE. if you want q_cdrag coming from GCM (if q_cdrag on initialization is non zero).
+        !Config         Keep cdrag coefficient from gcm for latent and sensible heat fluxes.
+        !Config Units = [FLAG]
+        IF ( ABS(MAXVAL(q_cdrag)) .LE. EPSILON(q_cdrag)) THEN
+           ldq_cdrag_from_gcm = .FALSE.
+        ELSE
+           ldq_cdrag_from_gcm = .TRUE.
+        ENDIF
+        
+        !?? q_cdrag is always 0 on initialization ??
+        CALL getin_p('CDRAG_from_GCM', ldq_cdrag_from_gcm)
+        
+        WRITE(numout,*) "ldq_cdrag_from_gcm = ",ldq_cdrag_from_gcm
+
+        IF (long_print) WRITE (numout,*) ' call diffuco_init '
+
+        ! If cdrag is 
+        CALL diffuco_init(kjit, ldrestart_read, kjpindex, index, rest_id, q_cdrag, rstruct)
+
+        WRITE(numout,*) "control%ok_inca:",control%ok_inca
+        IF ( control%ok_inca ) CALL diffuco_inca_init(kjpindex, lalo, neighbours, resolution, dtradia)
+
+        RETURN
+
+    ENDIF
+    
+  !! 2. Prepare the restart file for the next simulation
+
+    IF (ldrestart_write) THEN
+
+        IF (long_print) WRITE (numout,*) ' we have to complete restart file with DIFFUCO variables '
+
+        var_name= 'rstruct'
+	CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, rstruct, 'scatter',  nbp_glo, index_g)
+  
+        var_name= 'raero'
+	CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, raero, 'scatter',  nbp_glo, index_g)
+
+        var_name= 'qsatt'
+	CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, qsatt, 'scatter',  nbp_glo, index_g)
+  
+        ! the following variable is written only if CO2 was calculated
+        IF ( control%ok_co2 ) THEN
+
+          DO ilai = 1, nlai
+  
+            ! variable name is somewhat complicated as ioipsl does not allow 3d variables for the moment...
+            write(laistring,'(i4)') ilai
+            laistring=ADJUSTL(laistring)
+            var_name='leaf_ci_'//laistring(1:LEN_TRIM(laistring))
+  
+            CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, leaf_ci(:,:,ilai), 'scatter',  nbp_glo, index_g)
+  
+          ENDDO
+
+        ENDIF
+  
+        IF (.NOT.ldq_cdrag_from_gcm) THEN
+           var_name= 'cdrag'
+           CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, q_cdrag, 'scatter',  nbp_glo, index_g)
+        ENDIF
+  
+      RETURN
+  
+    END IF
+    
+    wind(:) = SQRT (u(:)*u(:) + v(:)*v(:))
+
+    
+  !! 3. Calculate the different coefficients
+
+    IF (.NOT.ldq_cdrag_from_gcm) THEN
+        ! Case 3a)
+       CALL diffuco_aero (kjpindex, kjit, u, v, zlev, z0, roughheight, temp_sol, temp_air, &
+            &             qsurf, qair, q_cdrag)
+    ENDIF
+
+    ! Case 3b)
+    CALL diffuco_raerod (kjpindex, u, v, q_cdrag, raero)
+
+  !! 4. Make an estimation of the saturated humidity at the surface
+
+    CALL qsatcalc (kjpindex, temp_sol, pb, qsatt)
+
+  !! 5. Calculate the beta coefficient for sublimation
+  
+    CALL diffuco_snow (kjpindex, dtradia, qair, qsatt, rau, u, v, q_cdrag, &
+         & snow, frac_nobio, totfrac_nobio, snow_nobio, vbeta1)
+
+
+    CALL diffuco_flood (kjpindex, dtradia, qair, qsatt, rau, u, v, q_cdrag, evapot, evapot_corr, &
+         & flood_frac, flood_res, vbeta5)
+
+  !! 6. Calculate the beta coefficient for interception
+
+    ! Correction Nathalie - Juin 2006 - introduction d'un terme vbeta23
+    !CALL diffuco_inter (kjpindex, dtradia, qair, qsatt, rau, u, v, q_cdrag, veget, &
+    !   & qsintveg, qsintmax, rstruct, vbeta2) 
+    CALL diffuco_inter (kjpindex, dtradia, qair, qsatt, rau, u, v, q_cdrag, veget, &
+       & qsintveg, qsintmax, rstruct, vbeta2, vbeta23) 
+
+
+  !! 8. Calculate the beta coefficient for transpiration
+
+    IF ( control%ok_co2 ) THEN
+
+      ! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul Rveget
+      ! Correction Nathalie - Juin 2006 - introduction d'un terme vbeta23
+      !CALL diffuco_trans_co2 (kjpindex, dtradia, swdown, temp_air, pb, qair, rau, u, v, q_cdrag, humrel, &
+      !                        assim_param, ccanopy, &
+      !                        veget, veget_max, lai, qsintveg, qsintmax, vbeta3, rveget, rstruct, cimean, vbetaco2)
+ 
+      ! case 8a)
+      CALL diffuco_trans_co2 (kjpindex, dtradia, swdown, temp_air, pb, qair, q2m, t2m, rau, u, v, q_cdrag, humrel, &
+                              assim_param, ccanopy, &
+                              veget, veget_max, lai, qsintveg, qsintmax, vbeta3, vbeta3pot, &
+                              rveget, rstruct, cimean, vbetaco2, vbeta23)
+
+    ELSE
+
+      ! Correction Nathalie - Juin 2006 - introduction d'un terme vbeta23
+      !CALL diffuco_trans (kjpindex, dtradia, swnet, temp_air, pb, qair, rau, u, v, q_cdrag, humrel, &
+      !                    veget, veget_max, lai, qsintveg, qsintmax, vbeta3, rveget, rstruct, cimean, vbetaco2)
+      
+      ! case 8b) 
+      CALL diffuco_trans (kjpindex, dtradia, swnet, temp_air, pb, qair, rau, u, v, q_cdrag, humrel, &
+           & veget, veget_max, lai, qsintveg, qsintmax, vbeta3, vbeta3pot, rveget, rstruct, cimean, &
+           & vbetaco2, vbeta23)
+
+    ENDIF
+
+
+    !
+    !biogenic emissions
+    !
+    IF ( control%ok_inca ) THEN
+       CALL diffuco_inca (kjpindex, dtradia, swdown, sinang, temp_air, temp_sol, ptnlev1, precip_rain, humrel, &
+                        veget_max, lai, frac_age, &
+                        lalo, &
+                        PAR, PARsun, PARsh, laisun, laish, &
+                        flx_iso, flx_mono, flx_ORVOC, flx_MBO, flx_methanol, flx_acetone, flx_acetal, &
+                        flx_formal, flx_acetic, flx_formic, &
+                        flx_no_soil, flx_no,CRF, flx_fertil_no, Fdf, PARsuntab, PARshtab, PARdf, PARdr, Trans)
+    ENDIF
+    !
+    ! combination of coefficient : alpha and beta coefficient
+    ! beta coefficient for bare soil
+    !
+
+    CALL diffuco_bare (kjpindex, dtradia, u, v, q_cdrag, rsol, evap_bare_lim, evapot, humrel, &
+         veget, veget_max, vbeta2, vbeta3, vbeta4) 
+
+  !! 9. Combine the alpha and beta coefficients
+
+    ! Ajout qsintmax dans les arguments de la routine.... Nathalie / le 13-03-2006
+    CALL diffuco_comb (kjpindex, dtradia, humrel, rau, u, v, q_cdrag, pb, qair, temp_sol, temp_air, snow, &
+       & veget, lai, vbeta1, vbeta2, vbeta3, vbeta4, valpha, vbeta, qsintmax)    
+
+    julian_diff_2d(:) = julian_diff
+    year_length_2d(:) = year_length
+
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'raero', kjit, raero, kjpindex, index)
+       ! Ajouts Nathalie - novembre 2006
+       CALL histwrite_p(hist_id, 'cdrag', kjit, q_cdrag, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Wind', kjit, wind, kjpindex, index)
+       ! Fin ajouts Nathalie
+       CALL histwrite_p(hist_id, 'qsatt', kjit, qsatt, kjpindex, index)
+
+       IF ( control%ok_inca ) THEN
+          CALL histwrite_p(hist_id, 'PAR', kjit, PAR, kjpindex, index)
+          IF ( control%ok_radcanopy ) THEN
+             CALL histwrite_p(hist_id, 'PARsun', kjit, PARsun, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist_id, 'PARsh', kjit, PARsh, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist_id, 'laisun', kjit, laisun, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist_id, 'laish', kjit, laish, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist_id, 'Fdf', kjit, Fdf, kjpindex, index)
+             IF (control%ok_multilayer) THEN 
+                CALL histwrite_p(hist_id, 'PARsuntab', kjit, PARsuntab, kjpindex*(nlai+1), indexlai)
+                CALL histwrite_p(hist_id, 'PARshtab', kjit, PARshtab, kjpindex*(nlai+1), indexlai)
+             ENDIF
+             CALL histwrite_p(hist_id, 'Sinang', kjit, Sinang, kjpindex, index)
+             CALL histwrite_p(hist_id, 'PARdf', kjit, PARdf, kjpindex, index)
+             CALL histwrite_p(hist_id, 'PARdr', kjit, PARdr, kjpindex, index)
+             CALL histwrite_p(hist_id, 'Trans', kjit, Trans, kjpindex, index)
+             CALL histwrite_p(hist_id, 'Day', kjit, julian_diff_2d,kjpindex,index)
+             CALL histwrite_p(hist_id, 'Year_length', kjit, year_length_2d,kjpindex,index)
+
+          END IF
+          CALL histwrite_p(hist_id, 'flx_fertil_no', kjit, flx_fertil_no, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'CRF', kjit, CRF, kjpindex*nvm, indexveg)
+          IF ( control%ok_bbgfertil_Nox ) THEN
+             CALL histwrite_p(hist_id, 'flx_co2_bbg_year', 1, flx_co2_bbg_year, kjpindex, index)
+          ENDIF
+          IF ( control%ok_cropsfertil_Nox ) THEN
+             CALL histwrite_p(hist_id, 'N_qt_WRICE_year', 1, N_qt_WRICE_year, kjpindex, index)
+             CALL histwrite_p(hist_id, 'N_qt_OTHER_year', 1, N_qt_OTHER_year, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist_id, 'ptnlev1', kjit, ptnlev1, kjpindex, index)
+          CALL histwrite_p(hist_id, 'flx_iso', kjit, flx_iso, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'flx_mono', kjit, flx_mono, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'flx_ORVOC', kjit, flx_ORVOC, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'flx_MBO', kjit, flx_MBO, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'flx_methanol', kjit, flx_methanol, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'flx_acetone', kjit, flx_acetone, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'flx_acetal', kjit, flx_acetal, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'flx_formal', kjit, flx_formal, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'flx_acetic', kjit, flx_acetic, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'flx_formic', kjit, flx_formic, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'flx_no_soil', kjit, flx_no_soil, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'flx_no', kjit, flx_no, kjpindex*nvm, indexveg)
+       END IF
+
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'raero', kjit, raero, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'cdrag', kjit, q_cdrag, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Wind', kjit, wind, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'qsatt', kjit, qsatt, kjpindex, index)
+
+          IF ( control%ok_inca ) THEN
+             CALL histwrite_p(hist2_id, 'PAR', kjit, PAR, kjpindex, index)
+             IF ( control%ok_radcanopy ) THEN
+                CALL histwrite_p(hist2_id, 'PARsun', kjit, PARsun, kjpindex*nvm, indexveg)
+                CALL histwrite_p(hist2_id, 'PARsh', kjit, PARsh, kjpindex*nvm, indexveg)
+                CALL histwrite_p(hist2_id, 'laisun', kjit, laisun, kjpindex*nvm, indexveg)
+                CALL histwrite_p(hist2_id, 'laish', kjit, laish, kjpindex*nvm, indexveg)
+             ENDIF
+             CALL histwrite_p(hist2_id, 'flx_fertil_no', kjit, flx_fertil_no, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'CRF', kjit, CRF, kjpindex*nvm, indexveg)
+             IF ( control%ok_bbgfertil_Nox ) THEN
+                CALL histwrite_p(hist2_id, 'flx_co2_bbg_year', 1, flx_co2_bbg_year, kjpindex, index)
+             ENDIF
+             IF ( control%ok_cropsfertil_Nox ) THEN
+                CALL histwrite_p(hist2_id, 'N_qt_WRICE_year', 1, N_qt_WRICE_year, kjpindex, index)
+                CALL histwrite_p(hist2_id, 'N_qt_OTHER_year', 1, N_qt_OTHER_year, kjpindex, index)
+             ENDIF
+             CALL histwrite_p(hist2_id, 'ptnlev1', kjit, ptnlev1, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'flx_iso', kjit, flx_iso, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'flx_mono', kjit, flx_mono, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'flx_ORVOC', kjit, flx_ORVOC, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'flx_MBO', kjit, flx_MBO, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'flx_methanol', kjit, flx_methanol, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'flx_acetone', kjit, flx_acetone, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'flx_acetal', kjit, flx_acetal, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'flx_formal', kjit, flx_formal, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'flx_acetic', kjit, flx_acetic, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'flx_formic', kjit, flx_formic, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'flx_no_soil', kjit, flx_no_soil, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'flx_no', kjit, flx_no, kjpindex*nvm, indexveg)
+          ENDIF
+       ENDIF
+    ELSE
+
+    ENDIF
+   
+    IF (long_print) WRITE (numout,*) ' diffuco_main done '
+
+  END SUBROUTINE diffuco_main
+
+
+!! ================================================================================================================================
+!! SUBROUTINE		 			: diffuco_init
+!!
+!>\BRIEF					Dynamic allocation algorithm for local arrays 
+!!
+!! DESCRIPTION				        : Housekeeping module to allocate local arrays
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S)	                : q_cdrag
+!!
+!! REFERENCE(S)				        : None
+!!
+!! FLOWCHART                                    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_init(kjit, ldrestart_read, kjpindex, index, rest_id, q_cdrag, rstruct)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                       :: kjit               !! Time step number  (-)
+    LOGICAL,INTENT (in)                               :: ldrestart_read     !! Logical for restart file to read (-)
+    INTEGER(i_std), INTENT (in)                       :: kjpindex           !! Domain size (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)  :: index              !! Indeces of the points on the map (-)
+    INTEGER(i_std), INTENT (in)                       :: rest_id            !! _Restart_ file identifier (-)
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: rstruct           !! STOMATE: architectural resistance
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)  :: q_cdrag            !! Product of Surface drag and wind speed (m s^{-1})
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                    :: ier, jv
+    INTEGER(i_std)                                    :: ilai
+    CHARACTER(LEN=4)                                  :: laistring
+    REAL(r_std),DIMENSION (kjpindex)                  :: temp
+    CHARACTER(LEN=80)                                 :: var_name            !! To store variables names for I/O
+!_ ================================================================================================================================
+    
+  !! 1. Initialisation
+    
+    IF (l_first_diffuco) THEN 
+        l_first_diffuco=.FALSE.
+    ELSE 
+        WRITE (numout,*) ' l_first_diffuco false . we stop '
+        STOP 'diffuco_init'
+    ENDIF
+
+    ! allocate only if CO2 is calculated
+    IF ( control%ok_co2 ) THEN
+
+      ALLOCATE (leaf_ci(kjpindex,nvm,nlai),stat=ier)
+      IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in leaf_ci allocation. We stop. We need kjpindex*nvm*nlai words = ',&
+            kjpindex*nvm*nlai
+          STOP 'diffuco_init'
+      END IF
+
+    ENDIF
+
+    ALLOCATE (raero(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in raero allocation. We stop. We need kjpindex x nvm words = ', kjpindex
+        STOP 'diffuco_init'
+    END IF
+
+    ALLOCATE (qsatt(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in qsatt allocation. We stop. We need kjpindex x nvm words = ', kjpindex
+        STOP 'diffuco_init'
+    END IF
+
+    ALLOCATE (wind(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in wind allocation. We stop. We need kjpindex x nvm words = ', kjpindex
+        STOP 'diffuco_init'
+    END IF
+
+    IF (ldrestart_read) THEN
+
+        IF (long_print) WRITE (numout,*) ' we have to read a restart file for DIFFUCO variables'
+
+        var_name='rstruct'
+        CALL ioconf_setatt_p('UNITS', 's/m')
+        CALL ioconf_setatt_p('LONG_NAME','Structural resistance')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., rstruct, "gather", nbp_glo, index_g)
+        
+        IF ( MINVAL(rstruct) .EQ. MAXVAL(rstruct) .AND.  MAXVAL(rstruct) .EQ. val_exp ) THEN
+        
+           DO jv = 1, nvm
+              rstruct(:,jv) = rstruct_const(jv)
+           ENDDO
+
+        ENDIF
+
+        var_name='raero' ;
+        CALL ioconf_setatt_p('UNITS', 's/m')
+        CALL ioconf_setatt_p('LONG_NAME','Aerodynamic resistance')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., temp, "gather", nbp_glo, index_g)
+        IF (MINVAL(temp) < MAXVAL(temp) .OR. MAXVAL(temp) .NE. val_exp) THEN
+           raero(:) = temp(:)
+        ENDIF
+       
+        var_name='qsatt' ;
+        CALL ioconf_setatt_p('UNITS', 'g/g')
+        CALL ioconf_setatt_p('LONG_NAME','Surface saturated humidity')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., temp, "gather", nbp_glo, index_g)
+        IF (MINVAL(temp) < MAXVAL(temp) .OR. MAXVAL(temp) .NE. val_exp) THEN
+           qsatt(:) = temp(:)
+        ENDIF
+        
+        ! the following variable is read only if CO2 is calculated
+        IF ( control%ok_co2 ) THEN
+
+           CALL ioconf_setatt_p('UNITS', 'ppm')
+           CALL ioconf_setatt_p('LONG_NAME','Leaf CO2')
+
+           DO ilai = 1, nlai
+
+              ! variable name is somewhat complicated as ioipsl does not allow 3d variables for the moment...
+              write(laistring,'(i4)') ilai
+              laistring=ADJUSTL(laistring)
+              var_name='leaf_ci_'//laistring(1:LEN_TRIM(laistring))
+              
+              CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE.,leaf_ci(:,:,ilai), "gather", nbp_glo, index_g)
+              
+           ENDDO
+           
+           !Config Key   = DIFFUCO_LEAFCI
+           !Config Desc  = Initial leaf CO2 level if not found in restart
+           !Config If    = OK_SECHIBA
+           !Config Def   = 233.
+           !Config Help  = The initial value of leaf_ci if its value is not found
+           !Config         in the restart file. This should only be used if the model is
+           !Config         started without a restart file.
+           !Config Units = [ppm]
+           CALL setvar_p (leaf_ci, val_exp,'DIFFUCO_LEAFCI', 233._r_std)
+        ENDIF
+        
+        IF (.NOT.ldq_cdrag_from_gcm) THEN
+           var_name= 'cdrag'
+           CALL ioconf_setatt_p('LONG_NAME','Drag coefficient for LE and SH')
+           CALL ioconf_setatt_p('UNITS', '-')
+           CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., temp, "gather", nbp_glo, index_g)
+           IF (MINVAL(temp) < MAXVAL(temp) .OR. MAXVAL(temp) .NE. val_exp) THEN
+              q_cdrag(:) = temp(:)
+           ENDIF
+        ENDIF
+        
+    ENDIF
+
+    WRITE(numout,*) 'DANS DIFFUCO_INIT , RVEG_PFT=',rveg_pft
+
+    IF (long_print) WRITE (numout,*) ' diffuco_init done '
+
+  END SUBROUTINE diffuco_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : diffuco_inca_init
+!!
+!>\BRIEF         This subroutine initializes diffuco_inca-related state variables
+!!
+!! DESCRIPTION  : Some of the variables and flags used in diffuco_inca are allocated and initialised here.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_inca_init(kjpindex, lalo, neighbours, resolution, dtradia)
+    
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (unitless) 
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT (in)    :: lalo             !! Geographical coordinates
+    INTEGER(i_std), DIMENSION(kjpindex,8), INTENT (in) :: neighbours       !! Vector of neighbours for each 
+                                                                           !! grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)     :: resolution       !! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT(in)                            :: dtradia          !! Time step in seconds
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    LOGICAL                             :: allow_weathergen, density
+    CHARACTER(LEN=80)                   :: filename, filename2, fieldname
+    INTEGER(i_std)                      :: iml, jml, lml, tml, force_id
+    INTEGER(i_std)                      :: ier
+
+!_ ================================================================================================================================
+
+    ALLOCATE (pulse(kjpindex),stat=ier)
+    IF (ier /= 0) THEN
+       WRITE (numout,*) ' error in pulse allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'diffuco_inca_init'
+    END IF
+    pulse(:) = un
+
+    ! If we acount for NOx pulse emissions
+    IF (control%ok_pulse_NOx) THEN
+
+       ALLOCATE (ok_siesta(kjpindex),stat=ier)
+       IF (ier /= 0) THEN
+          WRITE (numout,*) ' error in ok_siesta allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'diffuco_inca_init'
+       END IF
+       ok_siesta(:) = .FALSE.
+
+       ALLOCATE (allow_pulse(kjpindex),stat=ier)
+       IF (ier /= 0) THEN
+          WRITE (numout,*) ' error in allow_pulse allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'diffuco_inca_init'
+       END IF
+       allow_pulse(:) = .FALSE.
+
+       ALLOCATE (pulseday(kjpindex),stat=ier)
+       IF (ier /= 0) THEN
+          WRITE (numout,*) ' error in pulseday allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'diffuco_inca_init'
+       END IF
+       pulseday(:) = zero
+
+       ALLOCATE (siestaday(kjpindex),stat=ier)
+       IF (ier /=0 ) THEN
+          WRITE (numout,*) ' error in siestaday allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'diffuco_inca_init'
+       END IF
+       siestaday(:) = zero
+
+       ALLOCATE (pulselim(kjpindex),stat=ier)
+       IF (ier /= 0) THEN
+          WRITE (numout,*) ' error in pulselim allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'diffuco_inca_init'
+       END IF
+       pulselim(:) = zero
+
+       ALLOCATE (siestalim(kjpindex),stat=ier)
+       IF (ier /= 0) THEN
+          WRITE (numout,*) ' error in siestalim allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'diffuco_inca_init'
+       END IF
+       siestalim(:) = zero
+
+    END IF ! (control%ok_pulse_NOx) 
+
+    ! If we acount for NOx emissions by N-fertilizers
+    IF (control%ok_cropsfertil_NOx) THEN
+
+       ALLOCATE (area2(kjpindex),stat=ier)
+       IF (ier /= 0) THEN
+          WRITE (numout,*) ' error in area2 allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'diffuco_inca_init'
+       END IF
+       area2(:) = resolution(:,1)*resolution(:,2) 
+
+       ALLOCATE (N_qt_WRICE_year(kjpindex),stat=ier)  !! N fertilizers on wetland rice, read in file 
+       IF (ier /= 0) THEN
+          WRITE (numout,*) ' error in N_qt_WRICE_year allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'diffuco_inca_init'
+       END IF
+       N_qt_WRICE_year(:) = zero
+    
+       ALLOCATE (N_qt_OTHER_year(kjpindex),stat=ier)  !! N fertilizers on other crops and grasses, read in file 
+       IF (ier /= 0) THEN
+          WRITE (numout,*) ' error in N_qt_OTHER_year allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'diffuco_inca_init'
+       END IF
+       N_qt_OTHER_year(:) = zero
+
+       WRITE (numout,*) ' *********************** Interpolating N fertilizers files for NOx emissions... '
+       filename = 'orchidee_fertilizer_1995.nc'
+       filename2= 'N_FERTIL_FILE'
+       density  = .FALSE. 
+       fieldname= 'N_qt_WRICE_year'
+       CALL diffuco_inca_read (kjpindex, lalo, neighbours, resolution, N_qt_WRICE_year, filename, filename2, fieldname, density)
+       fieldname= 'N_qt_OTHER_year'
+       CALL diffuco_inca_read (kjpindex, lalo, neighbours, resolution, N_qt_OTHER_year, filename, filename2, fieldname, density)
+    END IF
+
+    ! If we acount for NOx emissions due to Biomass Burning
+    IF (control%ok_bbgfertil_NOx) THEN
+
+       ALLOCATE (flx_co2_bbg_year(kjpindex),stat=ier) !! CO2 emissions from bbg, read in file 
+       IF (ier /= 0) THEN
+          WRITE (numout,*) ' error in flx_co2_bbg_year allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'diffuco_inca_init'
+       END IF
+       flx_co2_bbg_year(:) = zero    
+
+       WRITE (numout,*) ' *********************** Interpolating CO2 bbg files for NOx emissions... '
+       filename = 'orchidee_bbg_clim.nc'
+       filename2= 'CO2_BBG_FILE'
+       fieldname= 'flx_co2_bbg_year'
+       density  = .TRUE.
+       CALL diffuco_inca_read (kjpindex, lalo, neighbours, resolution, flx_co2_bbg_year,filename,filename2,fieldname,density)
+    END IF
+
+    IF ( OFF_LINE_MODE ) THEN
+
+       !-
+       !- What are the alowed options for the temportal interpolation
+       !-
+       !Config Key   = ALLOW_WEATHERGEN
+       !Config Desc  = Allow weather generator to create data
+       !Config If    = 
+       !Config Def   = n
+       !Config Help  = This flag allows the forcing-reader to generate
+       !Config         synthetic data if the data in the file is too sparse
+       !Config         and the temporal resolution would not be enough to
+       !Config         run the model.
+       !Config Units = [FLAG]
+       !-
+       allow_weathergen = .FALSE.
+       CALL getin_p('ALLOW_WEATHERGEN',allow_weathergen)
+       
+       !-
+       !Config Key   = FORCING_FILE
+       !Config Desc  = Name of file containing the forcing data
+       !Config If    = [-]
+       !Config Def   = forcing_file.nc
+       !Config Help  = This is the name of the file which should be opened
+       !Config         for reading the forcing data of the dim0 model.
+       !Config         The format of the file has to be netCDF and COADS
+       !Config         compliant.
+       !Config Units = [FILE] 
+       !-  
+       filename='forcing_file.nc'
+       ! Filename should be parameterized
+       ! To Be Updated
+       CALL getin_p('FORCING_FILE',filename)
+       CALL flininfo(filename,iml, jml, lml, tml, force_id)   
+       WRITE(*,*) 'Number of data per year in forcing file :', tml 
+       CALL flinclo(force_id)
+       WRITE(*,*) 'Forcing file closed in INCA'
+       
+       
+       IF ( allow_weathergen ) THEN
+          WRITE(*,*) '**INCA: Using weather generator, careful to precip division for NOx '
+          nbre_precip = un
+          WRITE(*,*) 'Division pour les precip, NOx:', nbre_precip
+       ELSE
+          WRITE(*,*) 'DTRADIA :', dtradia 
+          nbre_precip = (one_day/dtradia)/(tml/365.)
+          WRITE(*,*) 'Division pour les precip, NOx:', nbre_precip
+       END IF
+
+    ELSE ! (in coupled mode)
+
+       nbre_precip = un
+       
+    END IF  ! (OFF_LINE_MODE)
+
+       
+  END SUBROUTINE diffuco_inca_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE		 			: diffuco_clear
+!!
+!>\BRIEF					Housekeeping module to deallocate the variables
+!! leaf_ci, rstruct and raero
+!!
+!! DESCRIPTION				        : Housekeeping module to deallocate the variables
+!! leaf_ci, rstruct and raero
+!!
+!! RECENT CHANGE(S)                             : None
+!!
+!! MAIN OUTPUT VARIABLE(S)	                : None
+!!
+!! REFERENCE(S)				        : None
+!!
+!! FLOWCHART                                    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_clear()
+
+    l_first_diffuco=.TRUE.
+
+    IF (ALLOCATED (leaf_ci)) DEALLOCATE (leaf_ci)
+    IF (ALLOCATED (raero)) DEALLOCATE (raero)
+
+  END SUBROUTINE diffuco_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	: diffuco_aero
+!!
+!>\BRIEF	This module first calculates the surface drag 
+!! coefficient, for cases in which the surface drag coefficient is NOT provided by the coupled 
+!! atmospheric model LMDZ or when the flag ldq_cdrag_from_gcm is set to FALSE 
+!!
+!! DESCRIPTION	: Computes the surface drag coefficient, for cases 
+!! in which it is NOT provided by the coupled atmospheric model LMDZ. The module first uses the 
+!! meteorolgical input to calculate the Richardson Number, which is an indicator of atmospheric 
+!! stability in the surface layer. The formulation used to find this surface drag coefficient is 
+!! dependent on the stability determined. \n
+!!
+!! Designation of wind speed
+!! \latexonly 
+!!     \input{diffucoaero1.tex}
+!! \endlatexonly
+!!
+!! Calculation of geopotential. This is the definition of Geopotential height (e.g. Jacobson 
+!! eqn.4.47, 2005). (required for calculation of the Richardson Number)
+!! \latexonly 
+!!     \input{diffucoaero2.tex}
+!! \endlatexonly
+!! 
+!! \latexonly 
+!!     \input{diffucoaero3.tex}
+!! \endlatexonly
+!!
+!! Calculation of the virtual air temperature at the surface (required for calculation
+!! of the Richardson Number)
+!! \latexonly 
+!!     \input{diffucoaero4.tex}
+!! \endlatexonly
+!!
+!! Calculation of the virtual surface temperature (required for calculation of th
+!! Richardson Number)
+!! \latexonly 
+!!     \input{diffucoaero5.tex}
+!! \endlatexonly
+!!
+!! Calculation of the squared wind shear (required for calculation of the Richardson
+!! Number)
+!! \latexonly 
+!!     \input{diffucoaero6.tex}
+!! \endlatexonly
+!! 
+!! Calculation of the Richardson Number. The Richardson Number is defined as the ratio 
+!! of potential to kinetic energy, or, in the context of atmospheric science, of the
+!! generation of energy by wind shear against consumption
+!! by static stability and is an indicator of flow stability (i.e. for when laminar flow 
+!! becomes turbulent and vise versa). It is approximated using the expression below:
+!! \latexonly 
+!!     \input{diffucoaero7.tex}
+!! \endlatexonly
+!!
+!! The Richardson Number hence calculated is subject to a minimum value:
+!! \latexonly 
+!!     \input{diffucoaero8.tex}
+!! \endlatexonly
+!! 
+!! Computing the drag coefficient. We add the add the height of the vegetation to the 
+!! level height to take into account that the level 'seen' by the vegetation is actually 
+!! the top of the vegetation. Then we we can subtract the displacement height.
+!! \latexonly 
+!!     \input{diffucoaero9.tex}
+!! \endlatexonly
+!! 
+!! For the stable case (i.e $R_i$ $\geq$ 0)
+!! \latexonly 
+!!     \input{diffucoaero10.tex}
+!! \endlatexonly
+!!
+!! \latexonly 
+!!     \input{diffucoaero11.tex}
+!! \endlatexonly
+!!          
+!! For the unstable case (i.e. $R_i$ < 0)
+!! \latexonly 
+!!     \input{diffucoaero12.tex}
+!! \endlatexonly
+!!
+!! \latexonly 
+!!     \input{diffucoaero13.tex}
+!! \endlatexonly
+!!               
+!! If the Drag Coefficient becomes too small than the surface may uncouple from the atmosphere.
+!! To prevent this, a minimum limit to the drag coefficient is defined as:
+!!
+!! \latexonly 
+!!     \input{diffucoaero14.tex}
+!! \endlatexonly
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): q_cdrag
+!!
+!! REFERENCE(S)	: 
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!! - Jacobson M.Z., Fundamentals of Atmospheric Modeling (2nd Edition), published Cambridge 
+!! University Press, ISBN 0-521-54865-9
+!!
+!! FLOWCHART	:
+!! \latexonly 
+!!     \includegraphics[scale=0.5]{diffuco_aero_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_aero (kjpindex, kjit, u, v, zlev, z0, roughheight, temp_sol, temp_air, &
+       &                   qsurf, qair, q_cdrag)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex, kjit   !! Domain size
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: u                !! Eastward Lowest level wind speed (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: v                !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: zlev             !! Height of first atmospheric layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: z0               !! Surface roughness Length (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: roughheight      !! Effective roughness height (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: temp_sol         !! Ground temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: temp_air         !! Lowest level temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: qsurf            !! near surface specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: qair             !! Lowest level specific air humidity (kg kg^{-1})
+
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)    :: q_cdrag          !! Product of Surface drag coefficient and wind speed 
+                                                                            !! (m s^{-1})
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jv
+    REAL(r_std)                                         :: speed, zg, zdphi, ztvd, ztvs, zdu2
+    REAL(r_std)                                         :: zri, cd_neut, zscf, cd_tmp
+!_ ================================================================================================================================
+
+  !! 1. Initialisation
+
+    ! test if we have to work with q_cdrag or to calcul it
+    DO ji=1,kjpindex
+       
+       !! 1a).1 Designation of wind speed
+       !! \latexonly 
+       !!     \input{diffucoaero1.tex}
+       !! \endlatexonly
+       speed = wind(ji)
+    
+       !! 1a).2 Calculation of geopotentiel
+       !! This is the definition of Geopotential height (e.g. Jacobson eqn.4.47, 2005). (required
+       !! for calculation of the Richardson Number)
+       !! \latexonly 
+       !!     \input{diffucoaero2.tex}
+       !! \endlatexonly
+       zg = zlev(ji) * cte_grav
+      
+       !! \latexonly 
+       !!     \input{diffucoaero3.tex}
+       !! \endlatexonly
+       zdphi = zg/cp_air
+       
+       !! 1a).3 Calculation of the virtual air temperature at the surface 
+       !! required for calculation of the Richardson Number
+       !! \latexonly 
+       !!     \input{diffucoaero4.tex}
+       !! \endlatexonly
+       ztvd = (temp_air(ji) + zdphi / (un + rvtmp2 * qair(ji))) * (un + retv * qair(ji)) 
+       
+       !! 1a).4 Calculation of the virtual surface temperature 
+       !! required for calculation of the Richardson Number
+       !! \latexonly 
+       !!     \input{diffucoaero5.tex}
+       !! \endlatexonly
+       ztvs = temp_sol(ji) * (un + retv * qsurf(ji))
+     
+       !! 1a).5 Calculation of the squared wind shear 
+       !! required for calculation of the Richardson Number
+       !! \latexonly 
+       !!     \input{diffucoaero6.tex}
+       !! \endlatexonly
+       zdu2 = MAX(cepdu2,speed**2)
+       
+       !! 1a).6 Calculation of the Richardson Number
+       !!  The Richardson Number is defined as the ratio of potential to kinetic energy, or, in the 
+       !!  context of atmospheric science, of the generation of energy by wind shear against consumption
+       !!  by static stability and is an indicator of flow stability (i.e. for when laminar flow 
+       !!  becomes turbulent and vise versa).\n
+       !!  It is approximated using the expression below:
+       !!  \latexonly 
+       !!     \input{diffucoaero7.tex}
+       !! \endlatexonly
+       zri = zg * (ztvd - ztvs) / (zdu2 * ztvd)
+      
+       !! The Richardson Number hence calculated is subject to a minimum value:
+       !! \latexonly 
+       !!     \input{diffucoaero8.tex}
+       !! \endlatexonly       
+       zri = MAX(MIN(zri,5.),-5.)
+       
+       !! 1a).7 Computing the drag coefficient
+       !!  We add the add the height of the vegetation to the level height to take into account
+       !!  that the level 'seen' by the vegetation is actually the top of the vegetation. Then we 
+       !!  we can subtract the displacement height.
+       !! \latexonly 
+       !!     \input{diffucoaero9.tex}
+       !! \endlatexonly
+       cd_neut = (ct_karman / LOG( (zlev(ji) + roughheight(ji)) / z0(ji) )) ** 2 
+       
+       !! 1a).7.1 - for the stable case (i.e $R_i$ $\geq$ 0)
+       IF (zri .GE. zero) THEN
+          
+          !! \latexonly 
+          !!     \input{diffucoaero10.tex}
+          !! \endlatexonly
+          zscf = SQRT(un + cd * ABS(zri))
+         
+          !! \latexonly 
+          !!     \input{diffucoaero11.tex}
+          !! \endlatexonly          
+          cd_tmp=cd_neut/(un + trois * cb * zri * zscf)
+       ELSE
+          
+          !! 1a).7.2 - for the unstable case (i.e. $R_i$ < 0)
+          !! \latexonly 
+          !!     \input{diffucoaero12.tex}
+          !! \endlatexonly
+          zscf = un / (un + trois * cb * cc * cd_neut * SQRT(ABS(zri) * &
+               & ((zlev(ji) + roughheight(ji)) / z0(ji))))
+          
+          !! \latexonly 
+          !!     \input{diffucoaero13.tex}
+          !! \endlatexonly               
+          cd_tmp=cd_neut * (un - trois * cb * zri * zscf)
+       ENDIF
+       
+       !! If the Drag Coefficient becomes too small than the surface may uncouple from the atmosphere.
+       !! To prevent this, a minimum limit to the drag coefficient is defined as:
+       
+       !! \latexonly 
+       !!     \input{diffucoaero14.tex}
+       !! \endlatexonly
+       !!
+       q_cdrag(ji) = MAX(cd_tmp, 1.e-4/MAX(speed,min_wind))
+
+       ! In some situations it might be useful to give an upper limit on the cdrag as well. 
+       ! The line here should then be uncommented.
+      !q_cdrag(ji) = MIN(q_cdrag(ji), 0.5/MAX(speed,min_wind))
+
+    END DO
+
+    IF (long_print) WRITE (numout,*) ' not ldqcdrag_from_gcm : diffuco_aero done '
+
+  END SUBROUTINE diffuco_aero
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : diffuco_snow
+!!
+!>\BRIEF         This subroutine computes the beta coefficient for snow sublimation.
+!!
+!! DESCRIPTION   : This routine computes beta coefficient for snow sublimation, which
+!! integrates the snow on both vegetation and other surface types (e.g. ice, lakes,
+!! cities etc.) \n
+!!
+!! A critical depth of snow (snowcri) is defined to calculate the fraction of each grid-cell
+!! that is covered with snow (snow/snowcri) while the remaining part is snow-free.
+!! We also carry out a first calculation of sublimation (subtest) to lower down the beta
+!! coefficient if necessary (if subtest > snow). This is a predictor-corrector test. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vbeta1 
+!!
+!! REFERENCE(S) :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp. 248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+SUBROUTINE diffuco_snow (kjpindex, dtradia, qair, qsatt, rau, u, v,q_cdrag, &
+       & snow, frac_nobio, totfrac_nobio, snow_nobio, vbeta1)
+
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT(in)                           :: kjpindex       !! Domain size (-)
+    REAL(r_std), INTENT (in)                             :: dtradia        !! Time step in seconds (s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qair           !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qsatt          !! Surface saturated humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau            !! Air density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u              !! Eastward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v              !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag        !! Product of surface drag coefficient and wind speed (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: snow           !! Snow mass (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio     !! Fraction of ice, lakes, cities etc. (-)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio     !! Snow on ice, lakes, cities etc. (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: totfrac_nobio  !! Total fraction of ice, lakes, cities etc. (-)
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vbeta1         !! Beta for sublimation (dimensionless ratio) 
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    REAL(r_std)                                          :: subtest        !! Sublimation for test (kg m^{-2})
+    REAL(r_std)                                          :: zrapp          !! Modified factor (ratio)
+    REAL(r_std)                                          :: speed          !! Wind speed (m s^{-1})
+    REAL(r_std)                                          :: vbeta1_add     !! Beta for sublimation (ratio)
+    INTEGER(i_std)                                       :: ji, jv         !! Indices (-)
+!_ ================================================================================================================================
+
+  !! 1. Calculate beta coefficient for snow sublimation on the vegetation\n
+
+    DO ji=1,kjpindex  ! Loop over # pixels - domain size
+
+       ! Fraction of mesh that can sublimate snow
+       vbeta1(ji) = (un - totfrac_nobio(ji)) * MAX( MIN(snow(ji)/snowcri,un),zero)
+
+       ! Limitation of sublimation in case of snow amounts smaller than the atmospheric demand. 
+       speed = MAX(min_wind, wind(ji))
+
+       subtest = dtradia * vbeta1(ji) * speed * q_cdrag(ji) * rau(ji) * &
+               & ( qsatt(ji) - qair(ji) )
+
+       IF ( subtest .GT. zero ) THEN
+          zrapp = snow(ji) / subtest
+          IF ( zrapp .LT. un ) THEN
+             vbeta1(ji) = vbeta1(ji) * zrapp
+          ENDIF
+       ENDIF
+
+    END DO ! Loop over # pixels - domain size
+
+  !! 2. Add the beta coefficients calculated from other surfaces types (snow on ice,lakes, cities...)
+
+    DO jv = 1, nnobio ! Loop over # other surface types
+!!$      !
+!!$      IF ( jv .EQ. iice ) THEN
+!!$        !
+!!$        !  Land ice is of course a particular case
+!!$        !
+!!$        DO ji=1,kjpindex
+!!$          vbeta1(ji) = vbeta1(ji) + frac_nobio(ji,jv)
+!!$        ENDDO
+!!$        !
+!!$      ELSE
+        !
+        DO ji=1,kjpindex ! Loop over # pixels - domain size
+
+           vbeta1_add = frac_nobio(ji,jv) * MAX(MIN(snow_nobio(ji,jv)/snowcri,un), zero)
+
+           ! Limitation of sublimation in case of snow amounts smaller than
+           ! the atmospheric demand. 
+           speed = MAX(min_wind, wind(ji))
+            
+            !!     Limitation of sublimation by the snow accumulated on the ground 
+            !!     A first approximation is obtained with the old values of
+            !!     qair and qsol_sat: function of temp-sol and pb. (see call of qsatcalc)
+           subtest = dtradia * vbeta1_add * speed * q_cdrag(ji) * rau(ji) * &
+                & ( qsatt(ji) - qair(ji) )
+
+           IF ( subtest .GT. zero ) THEN
+              zrapp = snow_nobio(ji,jv) / subtest
+              IF ( zrapp .LT. un ) THEN
+                 vbeta1_add = vbeta1_add * zrapp
+              ENDIF
+           ENDIF
+
+           vbeta1(ji) = vbeta1(ji) + vbeta1_add
+
+        ENDDO ! Loop over # pixels - domain size
+
+!!$      ENDIF
+      
+    ENDDO ! Loop over # other surface types
+
+    IF (long_print) WRITE (numout,*) ' diffuco_snow done '
+
+  END SUBROUTINE diffuco_snow
+
+
+!! ================================================================================================================================
+!! SUBROUTINE		 			: diffuco_flood 
+!!
+!>\BRIEF				       	This routine computes partial beta coefficient : floodplains
+!!
+!! DESCRIPTION				        : 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S)	                : vbeta5
+!!
+!! REFERENCE(S)				        : None
+!!
+!! FLOWCHART                                    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_flood (kjpindex, dtradia, qair, qsatt, rau, u, v, q_cdrag, evapot, evapot_corr, &
+       & flood_frac, flood_res, vbeta5)
+
+    ! interface description
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex   !! Domain size
+    REAL(r_std), INTENT (in)                                 :: dtradia    !! Time step in seconds
+    ! input fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair       !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qsatt      !! Surface saturated humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau        !! Density
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u          !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v          !! Lowest level wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag    !! Surface drag
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: flood_res  !! water mass in flood reservoir
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: flood_frac !! fraction of floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: evapot     !! Potential evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: evapot_corr!! Potential evaporation2
+    ! output fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: vbeta5     !! Beta for floodplains
+
+    ! local declaration
+    REAL(r_std)                                              :: subtest, zrapp, speed
+    INTEGER(i_std)                                           :: ji, jv
+
+!_ ================================================================================================================================
+    !
+    ! beta coefficient for sublimation for floodplains
+    !
+    DO ji=1,kjpindex
+       !
+       IF (evapot(ji) .GT. min_sechiba) THEN
+          vbeta5(ji) = flood_frac(ji) *evapot_corr(ji)/evapot(ji)
+       ELSE
+          vbeta5(ji) = flood_frac(ji)
+       ENDIF
+       !
+       ! -- Limitation of evaporation in case of water amounts smaller than
+       !    the atmospheric demand. 
+       
+       !
+       speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+       !
+       subtest = dtradia * vbeta5(ji) * speed * q_cdrag(ji) * rau(ji) * &
+               & ( qsatt(ji) - qair(ji) )
+       !  
+       IF ( subtest .GT. zero ) THEN
+          zrapp = flood_res(ji) / subtest
+          IF ( zrapp .LT. un ) THEN
+             vbeta5(ji) = vbeta5(ji) * zrapp
+          ENDIF
+       ENDIF
+       !
+    END DO
+
+    IF (long_print) WRITE (numout,*) ' diffuco_flood done '
+
+  END SUBROUTINE diffuco_flood
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : diffuco_inter
+!!
+!>\BRIEF	 This routine computes the partial beta coefficient
+!! for the interception for each type of vegetation
+!!
+!! DESCRIPTION   : We first calculate the dry and wet parts of each PFT (wet part = qsintveg/qsintmax).
+!! The former is submitted to transpiration only (vbeta3 coefficient, calculated in 
+!! diffuco_trans or diffuco_trans_co2), while the latter is first submitted to interception loss 
+!! (vbeta2 coefficient) and then to transpiration once all the intercepted water has been evaporated 
+!! (vbeta23 coefficient). Interception loss is also submitted to a predictor-corrector test, 
+!! as for snow sublimation. \n
+!!
+!! \latexonly 
+!!     \input{diffucointer1.tex}
+!! \endlatexonly
+!! Calculate the wet fraction of vegetation as  the ration between the intercepted water and the maximum water 
+!! on the vegetation. This ratio defines the wet portion of vegetation that will be submitted to interception loss.
+!!
+!! \latexonly 
+!!     \input{diffucointer2.tex}
+!! \endlatexonly
+!!
+!! Calculation of $\beta_3$, the canopy transpiration resistance
+!! \latexonly 
+!!     \input{diffucointer3.tex}
+!! \endlatexonly            
+!! 
+!! We here determine the limitation of interception loss by the water stored on the leaf. 
+!! A first approximation of interception loss is obtained using the old values of
+!! qair and qsol_sat, which are functions of temp-sol and pb. (see call of 'qsatcalc')
+!! \latexonly 
+!!     \input{diffucointer4.tex}
+!! \endlatexonly
+!!
+!! \latexonly
+!!     \input{diffucointer5.tex}
+!! \endlatexonly
+!!
+!! \latexonly 
+!!     \input{diffucointer6.tex}
+!! \endlatexonly
+!!
+!! Once the whole water stored on foliage has evaporated, transpiration can take place on the fraction
+!! 'zqsvegrap'.
+!! \latexonly 
+!!     \input{diffucointer7.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vbeta2, ::vbeta23
+!!
+!! REFERENCE(S) :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp. 248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!! - Perrier, A, 1975. Etude physique de l'Ã©vaporation dans les conditions naturelles. Annales 
+!! Agronomiques, 26(1-18): pp. 105-123, pp. 229-243
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_inter (kjpindex, dtradia, qair, qsatt, rau, u, v, q_cdrag, veget, &
+     & qsintveg, qsintmax, rstruct, vbeta2, vbeta23)
+   
+  !! 0 Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                           :: kjpindex   !! Domain size (-)
+    REAL(r_std), INTENT (in)                             :: dtradia    !! Time step (s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qair       !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qsatt      !! Surface saturated humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau        !! Air Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u          !! Eastward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v          !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag    !! Product of Surface drag coefficient and wind 
+                                                                       !! speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget      !! vegetation fraction for each type (fraction)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintveg   !! Water on vegetation due to interception (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintmax   !! Maximum water on vegetation (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: rstruct    !! architectural resistance (s m^{-1})
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vbeta2     !! Beta for interception loss (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vbeta23    !! Beta for fraction of wetted foliage that will 
+                                                                       !! transpire (-)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                       :: ji, jv                               !! (-), (-)
+    REAL(r_std)                                          :: zqsvegrap, ziltest, zrapp, speed     !!
+!_ ================================================================================================================================
+
+  !! 1. Initialize
+
+    vbeta2(:,:) = zero
+    vbeta23(:,:) = zero
+   
+  !! 2. The beta coefficient for interception by vegetation. 
+    
+    DO jv = 2,nvm
+
+      DO ji=1,kjpindex
+
+         IF (veget(ji,jv) .GT. min_sechiba .AND. qsintveg(ji,jv) .GT. zero ) THEN
+
+            zqsvegrap = zero
+            IF (qsintmax(ji,jv) .GT. min_sechiba ) THEN
+
+            !! \latexonly 
+            !!     \input{diffucointer1.tex}
+            !! \endlatexonly
+            !!
+            !! We calculate the wet fraction of vegetation as  the ration between the intercepted water and the maximum water 
+            !! on the vegetation. This ratio defines the wet portion of vegetation that will be submitted to interception loss.
+            !!
+                zqsvegrap = MAX(zero, qsintveg(ji,jv) / qsintmax(ji,jv))
+            END IF
+
+            !! \latexonly 
+            !!     \input{diffucointer2.tex}
+            !! \endlatexonly
+            speed = MAX(min_wind, wind(ji))
+
+            !! Calculation of $\beta_3$, the canopy transpiration resistance
+            !! \latexonly 
+            !!     \input{diffucointer3.tex}
+            !! \endlatexonly
+            vbeta2(ji,jv) = veget(ji,jv) * zqsvegrap * (un / (un + speed * q_cdrag(ji) * rstruct(ji,jv)))
+            
+            !! We here determine the limitation of interception loss by the water stored on the leaf. 
+            !! A first approximation of interception loss is obtained using the old values of
+            !! qair and qsol_sat, which are functions of temp-sol and pb. (see call of 'qsatcalc')
+            !! \latexonly 
+            !!     \input{diffucointer4.tex}
+            !! \endlatexonly
+            ziltest = dtradia * vbeta2(ji,jv) * speed * q_cdrag(ji) * rau(ji) * &
+               & ( qsatt(ji) - qair(ji) )
+
+            IF ( ziltest .GT. zero ) THEN
+
+                !! \latexonly 
+                !!     \input{diffucointer5.tex}
+                !! \endlatexonly
+                zrapp = qsintveg(ji,jv) / ziltest
+                IF ( zrapp .LT. un ) THEN
+                   
+                    !! \latexonly 
+                    !!     \input{diffucointer6.tex}
+                    !! \endlatexonly
+                    !!
+		    !! Once the whole water stored on foliage has evaporated, transpiration can take place on the fraction
+                    !! 'zqsvegrap'.
+                    vbeta23(ji,jv) = MAX(vbeta2(ji,jv) - vbeta2(ji,jv) * zrapp, zero)
+                    
+                    !! \latexonly 
+                    !!     \input{diffucointer7.tex}
+                    !! \endlatexonly
+                    vbeta2(ji,jv) = vbeta2(ji,jv) * zrapp
+                ENDIF
+            ENDIF
+        END IF
+!        ! Autre formulation possible pour l'evaporation permettant une transpiration sur tout le feuillage
+!        !commenter si formulation Nathalie sinon Tristan
+!        speed = MAX(min_wind, wind(ji))
+!        
+!        vbeta23(ji,jv) = MAX(zero, veget(ji,jv) * (un / (un + speed * q_cdrag(ji) * rstruct(ji,jv))) - vbeta2(ji,jv))
+
+      END DO
+
+    END DO
+
+    IF (long_print) WRITE (numout,*) ' diffuco_inter done '
+
+  END SUBROUTINE diffuco_inter
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE      : diffuco_bare
+!!
+!>\BRIEF	   This routine computes the partial beta coefficient corresponding to
+!! bare soil
+!!
+!! DESCRIPTION	   : Bare soil evaporation is either limited by a soil resistance 
+!! (rsol) that is calculated in hydrolc.f90, when Choisnel hydrology is used or 
+!! submitted to a maximum possible flow (evap_bare_lim) if the 11-layer hydrology is used.\n
+!! 
+!! Calculation of wind speed
+!! \latexonly 
+!!     \input{diffucobare1.tex}
+!! \endlatexonly
+!!             
+!! The calculation of $\beta_4$
+!! \latexonly 
+!!     \input{diffucobare2.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vbeta4
+!!
+!! REFERENCE(S)	 :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_bare (kjpindex, dtradia, u, v, q_cdrag, rsol, evap_bare_lim, evapot, humrel, &
+       & veget, veget_max, vbeta2, vbeta3, vbeta4)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: kjpindex       !! Domain size (-)
+    REAL(r_std), INTENT (in)                           :: dtradia        !! Time step (s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: u              !! Eastward Lowest level wind speed (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: v              !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: q_cdrag        !! Product of Surface drag coefficient and wind speed 
+                                                                         !! (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: rsol           !! resistance for bare soil evaporation  (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evap_bare_lim  !! limiting factor for bare soil evaporation when the 
+                                                                         !! 11-layer hydrology is used (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot         !! Soil Potential Evaporation (??mm day^{-1}??) 
+                                                                         !! NdN Variable that does not seem to be used at 
+                                                                         !! all in diffuco!!
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: humrel         !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget          !! Type of vegetation fraction (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max      !! Type of vegetation max fraction
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vbeta2         !! Beta for Interception 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vbeta3         !! Beta for Transpiration 
+
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: vbeta4         !! Beta for bare soil evaporation (-)
+    
+    !! 0.3 Modified variables
+        
+    !! 0.4 Local variables
+    REAL(r_std)                                    :: humveg_prod
+
+    INTEGER(i_std)                                     :: ji, jv
+    REAL(r_std)                                        :: speed          !! Surface wind speed (m s^{-1})
+!_ ================================================================================================================================
+
+  !! 1. Calculation of the soil resistance and the beta (beta_4) for bare soil
+
+    IF ( .NOT. control%hydrol_cwrr ) THEN
+       DO ji = 1, kjpindex
+          
+          vbeta4(ji) = zero
+          !     
+          ! 1.   Soil resistance and beta for bare soil
+          !      note: tot_bare_soil contains the fraction of bare soil
+          !            see slowproc module
+          !
+          speed = MAX(min_wind, wind(ji))
+          !
+          humveg_prod = tot_bare_soil(ji) * humrel(ji,1)
+          !
+          DO jv = 2, nvm
+             humveg_prod = humveg_prod + veget(ji,jv) * humrel(ji,jv)
+          ENDDO
+            
+             !! \latexonly 
+             !!     \input{diffucobare1.tex}
+             !! \endlatexonly
+          IF (tot_bare_soil(ji) .GE. min_sechiba) THEN
+             
+             ! Correction Nathalie de Noblet - le 27 Mars 2006
+             ! Selon recommandation de Frederic Hourdin: supprimer humrel dans formulation vbeta4
+             !vbeta4(ji) = tot_bare_soil(ji) *humrel(ji,1)* (un / (un + speed * q_cdrag(ji) * rsol(ji)))
+             ! Nathalie - le 28 mars 2006 - vbeta4 n'etait pas calcule en fonction de
+             ! rsol mais de rsol_cste * hdry! Dans ce cas inutile de calculer rsol(ji)!!
+             vbeta4(ji) = tot_bare_soil(ji) * (un / (un + speed * q_cdrag(ji) * rsol(ji)))
+             
+          ENDIF
+          !Commenter la ligne ci-dessous si calcul Nathalie sinon Tristan
+!          vbeta4(ji) = MIN(humveg_prod * (un / (un + speed * q_cdrag(ji) * rsol(ji))), &
+!               & un - SUM(vbeta2(ji,:)+vbeta3(ji,:)))
+          
+       END DO
+    ELSE
+       DO ji = 1, kjpindex
+
+          ! The limitation by 1-beta2-beta3 is due to the fact that evaporation under vegetation is possible
+          !! \latexonly 
+          !!     \input{diffucobare3.tex}
+          !! \endlatexonly
+          vbeta4(ji) = MIN(evap_bare_lim(ji), un - SUM(vbeta2(ji,:)+vbeta3(ji,:)))
+       END DO
+    ENDIF
+    
+    IF (long_print) WRITE (numout,*) ' diffuco_bare done '
+    
+  END SUBROUTINE diffuco_bare
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	: diffuco_trans 
+!!
+!>\BRIEF        This routine computes the partial beta coefficient 
+!! corresponding to transpiration for each vegetation type.
+!!
+!! DESCRIPTION  : Beta coefficients for transpiration are calculated 
+!! here using Jarvis formulation for stomatal resistance and
+!! the structural resistance to represent the vertical gradient of 
+!! transpiration within the canopy. \n
+!!
+!! The Jarvis formulation as used here is derived by Lohanner et al. (1980) from Jarvis (1976). This formulation is
+!! semi-empirical: \n
+!!
+!! \latexonly 
+!!     \input{diffucotrans4.tex}
+!! \endlatexonly
+!! \n
+!!            
+!! where in this expression LAI is the single sided Leaf Area Index, R_{new}^{SW} the net shortwave radiation,
+!! R_{SO} the half light saturation factor, \delta c the water vapour concentration deficit, and a, k_0 and \lambda
+!! are all parameters that are derived from extensive measurement of surface layer vegetation. \n
+!!
+!! Structural resistance (or architectural resistance) is a function of vegetation type and is assigned based on the
+!! particular Plant Functional Type (PFT) in question. The range of values for the structural resistance are listed
+!! in the module 'pft_parameters', and are described in de Noblet-DucoudrÃ© et al (1993). \n
+!!
+!! vbetaco2 is here set to zero as this way to compute canopy resistances is only used 
+!! without STOMATE, and there is therefore no photosynthesis. \n
+!!
+!! Moisture concentration at the leaf level.
+!! \latexonly 
+!!     \input{diffucotrans1.tex}
+!! \endlatexonly
+!!   
+!! Calulation of the beta coefficient for vegetation transpiration, beta_3.
+!! \latexonly 
+!!     \input{diffucotrans2.tex}
+!! \endlatexonly
+!! \latexonly             
+!!     \input{diffucotrans3.tex}
+!! \endlatexonly
+!!
+!! \latexonly 
+!!     \input{diffucotrans4.tex}
+!! \endlatexonly            
+!!
+!! This is the formulation for beta_3.
+!! \latexonly 
+!!     \input{diffucotrans5.tex}
+!! \endlatexonly
+!!
+!! \latexonly 
+!!     \input{diffucotrans6.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vbeta3, ::rveget, ::cimean and ::vbetaco2
+!!
+!! REFERENCE(S) :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!! - Jarvis, PG, 1976. The interpretation of the variations in leaf water potential and stomatal
+!! conductance found in canopies in the fields. Philosophical Transactions of the Royal Society of
+!! London, Series B, 273, pp. 593-610
+!! - Lohammer T, Larsson S, Linder S & Falk SO, 1980. Simulation models of gaseous exchange in Scotch
+!! pine. Structure and function of Northern Coniferous Forest, Ecological Bulletin, 32, pp. 505-523
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_trans (kjpindex, dtradia, swnet, temp_air, pb, qair, rau, u, v, q_cdrag, humrel, &
+                            veget, veget_max, lai, qsintveg, qsintmax, vbeta3, vbeta3pot, rveget, rstruct, &
+                            cimean, vbetaco2, vbeta23)  
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                         :: kjpindex   !! Domain size (-)
+    REAL(r_std), INTENT (in)                           :: dtradia    !! Time step (s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swnet      !! Short wave net flux at surface (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_air   !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: pb         !! Lowest level pressure (Pa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: qair       !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: rau        !! Air Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: u          !! Eastward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: v          !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: q_cdrag    !! Product of Surface drag coefficient and wind speed 
+                                                                     !! (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: humrel     !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget      !! Type of vegetation (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max  !! Max. vegetation fraction (LAI->infty) (fraction)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: lai        !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintveg   !! Water on vegetation due to interception (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintmax   !! Maximum water on vegetation (kg m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: rstruct    !! Structural resistance (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vbeta23    !! Beta for wetted foliage fraction that will transpire (-)
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta3     !! Beta for Transpiration (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbeta3pot  !! Beta for Potential Transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: rveget     !! Stomatal resistance of the whole canopy (s m^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: cimean     !! STOMATE: mean intercellular ci (see enerbil) 
+                                                                     !! (\mumole m^{-2} s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vbetaco2   !! STOMATE: Beta for CO2 (-)
+
+    !! 0.3 Modified variables
+  
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ji, jv
+    REAL(r_std)                                        :: speed
+    REAL(r_std), DIMENSION(kjpindex)                   :: zdefconc, zqsvegrap
+    REAL(r_std), DIMENSION(kjpindex)                   :: qsatt
+    REAL(r_std),DIMENSION (kjpindex,nvm)               :: rveget_min           !! Minimal Surface resistance of vegetation
+!_ ================================================================================================================================
+
+
+  !! 1.  Moisture concentration at the leaf level.
+    
+    CALL qsatcalc (kjpindex, temp_air, pb, qsatt)
+    
+    !! \latexonly 
+    !!     \input{diffucotrans1.tex}
+    !! \endlatexonly
+    zdefconc(:) = rau(:) * MAX( qsatt(:) - qair(:), zero )
+
+   
+  !! 2. Calulation of the beta coefficient for vegetation transpiration, beta_3.
+
+    rveget(:,:) = undef_sechiba
+    rveget_min(:,:) = undef_sechiba
+    vbeta3(:,:) = zero
+    vbeta3pot(:,:) = zero
+
+    DO jv = 2,nvm
+
+      zqsvegrap(:) = zero
+
+      DO ji = 1, kjpindex
+
+         !! \latexonly 
+         !!     \input{diffucotrans2.tex}
+         !! \endlatexonly
+         speed = MAX(min_wind, wind(ji))
+
+         IF (qsintmax(ji,jv) .GT. min_sechiba) THEN
+        
+            !! \latexonly 
+            !!     \input{diffucotrans3.tex}
+            !! \endlatexonly
+            zqsvegrap(ji) = MAX(zero, qsintveg(ji,jv) / qsintmax(ji,jv))
+         ENDIF
+         
+         IF ( ( veget(ji,jv)*lai(ji,jv) .GT. min_sechiba ) .AND. &
+              ( kzero(jv) .GT. min_sechiba ) .AND. &
+              ( swnet(ji) .GT. min_sechiba ) ) THEN
+
+            !! \latexonly 
+            !!     \input{diffucotrans4.tex}
+            !! \endlatexonly            
+            rveget(ji,jv) = (( swnet(ji) + rayt_cste ) / swnet(ji) ) &
+                 * ((defc_plus + (defc_mult * zdefconc(ji) )) / kzero(jv)) * (un / lai(ji,jv))
+
+            rveget_min(ji,jv) = (defc_plus / kzero(jv)) * (un / lai(ji,jv))
+
+            ! Corrections Nathalie - le 28 mars 2006 - sur conseils Fred Hourdin
+            ! Introduction d'un potentiometre (rveg_pft) pour regler la somme rveg+rstruct
+            ! vbeta3(ji,jv) = veget(ji,jv) * (un - zqsvegrap(ji)) * humrel(ji,jv) * &
+            !     (un / (un + speed * q_cdrag(ji) * (rveget(ji,jv) + rstruct(ji,jv))))
+            
+            !! This is the formulation for $beta_3$.
+            !! \latexonly 
+            !!     \input{diffucotrans5.tex}
+            !! \endlatexonly
+            vbeta3(ji,jv) = veget(ji,jv) * (un - zqsvegrap(ji)) * humrel(ji,jv) * &
+                 (un / (un + speed * q_cdrag(ji) * (rveg_pft(jv)*(rveget(ji,jv) + rstruct(ji,jv)))))
+            
+            ! Fin ajout Nathalie
+            ! Ajout Nathalie - Juin 2006
+
+            !! \latexonly 
+            !!     \input{diffucotrans6.tex}
+            !! \endlatexonly
+            vbeta3(ji,jv) = vbeta3(ji,jv) + MIN( vbeta23(ji,jv), &
+                 veget(ji,jv) * zqsvegrap(ji) * humrel(ji,jv) * &
+                 (un / (un + speed * q_cdrag(ji) * (rveg_pft(jv)*(rveget(ji,jv) + rstruct(ji,jv))))))
+            ! Fin ajout Nathalie
+            ! Autre possibilite permettant la transpiration sur toute la canopee
+            !Commenter si formulation Nathalie sinon Tristan
+!            vbeta3(ji,jv) = MAX(zero, MIN(vbeta23(ji,jv), &
+!                 & veget_max(ji,jv) * humrel(ji,jv) / &
+!                 & (un + speed * q_cdrag(ji) * (rveg_pft(jv)*(rveget(ji,jv) + rstruct(ji,jv))))))
+
+           ! vbeta3pot for computation of potential transpiration (needed for irrigation)
+            vbeta3pot(ji,jv) = &
+                 &  MAX(zero, veget_max(ji,jv) / &
+                 & (un + speed * q_cdrag(ji) * (rveg_pft(jv)*(rveget_min(ji,jv) + rstruct(ji,jv)))))
+         ENDIF
+
+      ENDDO
+
+    ENDDO
+
+    ! STOMATE
+    cimean(:,:) = zero
+    vbetaco2(:,:) = zero
+
+    IF (long_print) WRITE (numout,*) ' diffuco_trans done '
+
+  END SUBROUTINE diffuco_trans
+
+
+!! ==============================================================================================================================
+!! SUBROUTINE   : diffuco_trans_co2
+!!
+!>\BRIEF        This subroutine computes carbon assimilation and stomatal 
+!! conductance, following respectively Farqhuar et al. (1980) and Ball et al. (1987).
+!!
+!! DESCRIPTION  :\n
+!! *** General:\n 
+!! The equations are different depending on the photosynthesis mode (C3 versus C4).\n 
+!! Assimilation and conductance are computed over 20 levels of LAI and then 
+!! integrated at the canopy level.\n 
+!! This routine also computes partial beta coefficient: transpiration for each 
+!! type of vegetation.\n
+!! There is a main loop on the PFTs, then inner loops on the points where 
+!! assimilation has to be calculated.\n
+!! This subroutine is called by diffuco_main only if photosynthesis is activated
+!! for sechiba (flag STOMATE_OK_CO2=TRUE), otherwise diffuco_trans is called.\n
+!! This subroutine is called at each sechiba time step by sechiba_main.\n
+!! *** Details:
+!! - Integration at the canopy level\n
+!! \latexonly
+!! \input{diffuco_trans_co2_1.1.tex}
+!! \endlatexonly
+!! - Light''s extinction \n
+!! The available light follows a simple Beer extinction law. 
+!! The extinction coefficients (ext_coef) are PFT-dependant constants and are defined in constant_co2.f90.\n
+!! \latexonly
+!! \input{diffuco_trans_co2_1.2.tex}
+!! \endlatexonly
+!! - Estimation of relative humidity of air (for calculation of the stomatal conductance)\n
+!! \latexonly
+!! \input{diffuco_trans_co2_1.3.tex}
+!! \endlatexonly
+!! - Calculation of the water limitation factor\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.1.tex}
+!! \endlatexonly
+!! - Calculation of temperature dependent parameters for C4 plants\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.2.tex}
+!! \endlatexonly
+!! - Calculation of temperature dependent parameters for C3 plants\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.3.tex}
+!! \endlatexonly
+!! - Vmax scaling\n 
+!! Vmax is scaled into the canopy due to reduction of nitrogen 
+!! (Johnson and Thornley,1984).\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.4.1.tex}
+!! \endlatexonly
+!! - Assimilation for C4 plants (Collatz et al., 1992)\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.4.2.tex}
+!! \endlatexonly         
+!! - Assimilation for C3 plants (Farqhuar et al., 1980)\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.4.3.tex}
+!! \endlatexonly
+!! - Estimation of the stomatal conductance (Ball et al., 1987)\n
+!! \latexonly
+!! \input{diffuco_trans_co2_2.4.4.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): N. de Noblet          2006/06
+!!                - addition of q2m and t2m as input parameters for the 
+!!                calculation of Rveget
+!!                - introduction of vbeta23
+!!
+!! MAIN OUTPUT VARIABLE(S): beta coefficients, resistances, CO2 intercellular 
+!! concentration
+!!
+!! REFERENCE(S) :
+!! - Ball, J., T. Woodrow, and J. Berry (1987), A model predicting stomatal 
+!! conductance and its contribution to the control of photosynthesis under 
+!! different environmental conditions, Prog. Photosynthesis, 4, 221â 224.
+!! - Collatz, G., M. Ribas-Carbo, and J. Berry (1992), Coupled photosynthesis 
+!! stomatal conductance model for leaves of C4 plants, Aust. J. Plant Physiol.,
+!! 19, 519â538.
+!! - Farquhar, G., S. von Caemmener, and J. Berry (1980), A biochemical model of 
+!! photosynthesis CO2 fixation in leaves of C3 species, Planta, 149, 78â90.
+!! - Johnson, I. R., and J. Thornley (1984), A model of instantaneous and daily
+!! canopy photosynthesis, J Theor. Biol., 107, 531 545
+!! - McMurtrie, R.E., Rook, D.A. and Kelliher, F.M., 1990. Modelling the yield of Pinus radiata on a
+!! site limited by water and nitrogen. For. Ecol. Manage., 30: 381-413
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE diffuco_trans_co2 (kjpindex, dtradia, swdown, temp_air, pb, qair, q2m, t2m, rau, u, v, q_cdrag, humrel, &
+                                assim_param, ccanopy, &
+                                veget, veget_max, lai, qsintveg, qsintmax, vbeta3, vbeta3pot, rveget, rstruct, &
+                                cimean, vbetaco2, vbeta23)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: kjpindex         !! Domain size (unitless)
+    REAL(r_std), INTENT (in)                                 :: dtradia          !! Time step (s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swdown           !! Downwelling short wave flux 
+                                                                                 !! @tex ($W m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_air         !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb               !! Lowest level pressure (Pa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair             !! Lowest level specific humidity 
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+! N. de Noblet - 2006/06 - addition of q2m and t2m
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q2m              !! 2m specific humidity 
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+! In off-line mode q2m and qair are the same.
+! In off-line mode t2m and temp_air are the same.
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: t2m              !! 2m air temperature (K)
+! N. de Noblet - 2006/06 - addition of q2m and t2m
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau              !! air density @tex ($kg m^{-3}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u                !! Lowest level wind speed 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v                !! Lowest level wind speed 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag          !! Surface drag 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2), INTENT (in)  :: assim_param      !! min+max+opt temps (K), vcmax, vjmax for 
+                                                                                 !! photosynthesis 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: ccanopy          !! CO2 concentration inside the canopy (ppm) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: humrel           !! Soil moisture stress (0-1,unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: veget            !! Coverage fraction of vegetation for each PFT 
+                                                                                 !! depending on LAI (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: veget_max        !! Maximum vegetation fraction of each PFT inside 
+                                                                                 !! the grid box (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: lai              !! Leaf area index @tex ($m^2 m^{-2}$) @endtex
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: qsintveg         !! Water on vegetation due to interception 
+                                                                                 !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: qsintmax         !! Maximum water on vegetation
+                                                                                 !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: vbeta23          !! Beta for fraction of wetted foliage that will 
+                                                                                 !! transpire (unitless) 
+    !
+    !! 0.2 Output variables
+    !
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: vbeta3           !! Beta for Transpiration (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: vbeta3pot        !! Beta for Potential Transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: rveget           !! stomatal resistance of vegetation 
+                                                                                 !! @tex ($s m^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: rstruct          !! structural resistance @tex ($s m^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: cimean           !! mean intercellular CO2 concentration 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: vbetaco2         !! beta for CO2 transfer (unitless)
+
+    !
+    !! 0.3 Modified variables
+    !
+ 
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: vcmax                               !! maximum rate of carboxylation 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: vjmax                               !! maximum rate of Rubisco regeneration 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: tmin                                !! minimum temperature for photosynthesis (K)
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: topt                                !! optimal temperature for photosynthesis (K)
+    REAL(r_std),DIMENSION (kjpindex,nvm)  :: tmax                                !! maximum temperature for photosynthesis (K)
+    INTEGER(i_std)                        :: ji, jv, jl                          !! indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: leaf_ci_lowest                      !! intercellular CO2 concentration at the lowest 
+                                                                                 !! LAI level (ppm) 
+    INTEGER(i_std), DIMENSION(kjpindex)   :: ilai                                !! counter for loops on LAI levels (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: zqsvegrap                           !! relative water quantity in the water 
+                                                                                 !! interception reservoir (0-1,unitless) 
+    REAL(r_std)                           :: speed                               !! wind speed @tex ($m s^{-1}$) @endtex
+    ! Assimilation
+    LOGICAL, DIMENSION(kjpindex)          :: assimilate                          !! where assimilation is to be calculated 
+                                                                                 !! (unitless) 
+    LOGICAL, DIMENSION(kjpindex)          :: calculate                           !! where assimilation is to be calculated for 
+                                                                                 !! in the PFTs loop (unitless) 
+    INTEGER(i_std)                        :: nic,inic,icinic                     !! counter/indices (unitless)
+    INTEGER(i_std), DIMENSION(kjpindex)   :: index_calc                          !! index (unitless)
+    INTEGER(i_std)                        :: nia,inia,nina,inina,iainia          !! counter/indices (unitless)
+    INTEGER(i_std), DIMENSION(kjpindex)   :: index_assi,index_non_assi           !! indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: vc2                                 !! rate of carboxylation (at a specific LAI level) 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(kjpindex)      :: vj2                                 !! rate of Rubisco regeneration (at a specific LAI 
+                                                                                 !! level) @tex ($\mu mol m^{-2} s^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(kjpindex)      :: assimi                              !! assimilation (at a specific LAI level) 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std)                           :: x_1,x_2,x_3,x_4,x_5,x_6             !! terms of second order polynomials
+                                                                                 !! (temporary variables)
+    REAL(r_std), DIMENSION(kjpindex)      :: gstop                               !! stomatal conductance at topmost level 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: gs                                  !! stomatal conductance 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: Kc                                  !! Michaelis-Menten constant for the rubisco 
+                                                                                 !! enzyme catalytic activity for CO2 (ppm) 
+    REAL(r_std), DIMENSION(kjpindex)      :: Ko                                  !! Michaelis-Menten constant for the rubisco 
+                                                                                 !! enzyme catalytic activity for O2 (ppm) 
+    REAL(r_std), DIMENSION(kjpindex)      :: CP                                  !! CO2 compensation point (ppm)
+    REAL(r_std), DIMENSION(kjpindex)      :: vc                                  !! rate of carboxylation 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: vj                                  !! rate of Rubisco regeneration 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: kt                                  !! temperature-dependent pseudo-first-order rate 
+                                                                                 !! constant of assimilation response to CO2 (C4) 
+                                                                                 !! (??) 
+    REAL(r_std), DIMENSION(kjpindex)      :: rt                                  !! temperature-dependent non-photosynthetic 
+                                                                                 !! respiration (C4) @tex ($\mu mol $) @endtex ?? 
+    REAL(r_std), DIMENSION(kjpindex)      :: air_relhum                          !! air relative humidity at 2m 
+                                                                                 !! @tex ($kg kg^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: water_lim                           !! water limitation factor (0-1,unitless)
+    REAL(r_std), DIMENSION(kjpindex)      :: temp_lim                            !! temperature limitation factor (0-1,unitles)
+    REAL(r_std), DIMENSION(kjpindex)      :: gstot                               !! total stomatal conductance 
+                                                                                 !! @tex ($m s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: assimtot                            !! total assimilation 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: leaf_gs_top                         !! leaf stomatal conductance at topmost level 
+                                                                                 !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nlai+1)        :: laitab                              !! tabulated LAI steps @tex ($m^2 m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)      :: qsatt                               !! surface saturated humidity at 2m (??) 
+                                                                                 !! @tex ($g g^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nvm,nlai)      :: light                               !! fraction of light that gets through upper LAI 
+                                                                                 !! levels (0-1,unitless) 
+    REAL(r_std), DIMENSION(kjpindex)      :: ci_gs                               !! intermediate calculus variable 
+                                                                                 !! for vectorization
+    REAL(r_std)                           :: cresist                             !! coefficient for resistances (??)
+
+! @defgroup Photosynthesis Photosynthesis
+! @{   
+    ! 1. Preliminary calculations\n
+    REAL(r_std),DIMENSION (kjpindex,nvm)           :: rveget_min                 !! Minimal Surface resistance of vegetation
+
+!_ ================================================================================================================================
+
+    !
+    ! 1.1 Calculate LAI steps\n
+    ! The integration at the canopy level is done over nlai fixed levels.
+    !! \latexonly
+    !! \input{diffuco_trans_co2_1.1.tex}
+    !! \endlatexonly
+! @}
+! @codeinc
+    DO jl = 1, nlai+1
+      laitab(jl) = laimax*(EXP(lai_level_depth*REAL(jl-1,r_std))-1.)/(EXP(lai_level_depth*REAL(nlai,r_std))-un)
+    ENDDO
+! @endcodeinc
+
+! @addtogroup Photosynthesis
+! @{   
+    !
+    ! 1.2 Calculate light fraction for each LAI step\n
+    ! The available light follows a simple Beer extinction law. 
+    ! The extinction coefficients (ext_coef) are PFT-dependant constants and are defined in constant_co2.f90.
+    !! \latexonly
+    !! \input{diffuco_trans_co2_1.2.tex}
+    !! \endlatexonly
+! @}
+! @codeinc
+    DO jl = 1, nlai
+      DO jv = 1, nvm
+        light(jv,jl) = exp( -ext_coeff(jv)*laitab(jl) )
+      ENDDO
+    ENDDO 
+! @endcodeinc
+    !
+    ! Photosynthesis parameters
+    !
+    ! temperatures in K
+    !
+    tmin(:,:) = assim_param(:,:,itmin)
+    tmax(:,:) = assim_param(:,:,itmax)
+    topt(:,:) = assim_param(:,:,itopt)
+    !
+    vcmax(:,:) = assim_param(:,:,ivcmax)
+    vjmax(:,:) = assim_param(:,:,ivjmax)
+
+! @addtogroup Photosynthesis
+! @{   
+    !
+    ! 1.3 Estimate relative humidity of air (for calculation of the stomatal conductance).\n
+    !! \latexonly
+    !! \input{diffuco_trans_co2_1.3.tex}
+    !! \endlatexonly
+! @}
+    !
+! N. de Noblet - 2006/06 - We use q2m/t2m instead of qair.
+!    CALL qsatcalc (kjpindex, temp_air, pb, qsatt)
+!    air_relhum(:) = &
+!      ( qair(:) * pb(:) / (0.622+qair(:)*0.378) ) / &
+!      ( qsatt(:)*pb(:) / (0.622+qsatt(:)*0.378 ) )
+! @codeinc
+    CALL qsatcalc (kjpindex, t2m, pb, qsatt)
+    air_relhum(:) = &
+      ( q2m(:) * pb(:) / (Tetens_1+q2m(:)* Tetens_2) ) / &
+      ( qsatt(:)*pb(:) / (Tetens_1+qsatt(:)*Tetens_2 ) )
+! @endcodeinc
+! N. de Noblet - 2006/06 
+    !
+    !
+    ! 2. beta coefficient for vegetation transpiration
+    !
+    rstruct(:,1) = rstruct_const(1)
+    rveget(:,:) = undef_sechiba
+    rveget_min(:,:) = undef_sechiba
+    !
+    vbeta3(:,:) = zero
+    vbeta3pot(:,:) = zero
+    vbetaco2(:,:) = zero
+    !
+    cimean(:,1) = ccanopy(:)
+    !
+    ! @addtogroup Photosynthesis
+    ! @{   
+    ! 2. Loop over vegetation types\n
+    ! @} 
+    !
+    DO jv = 2,nvm
+      !
+      ! @addtogroup Photosynthesis
+      ! @{   
+      !
+      ! 2.1 Initializations\n
+      !! \latexonly
+      !! \input{diffuco_trans_co2_2.1.tex}
+      !! \endlatexonly
+      ! @}      
+      !
+      ! beta coefficient for vegetation transpiration
+      !
+      rstruct(:,jv) = rstruct_const(jv)
+      cimean(:,jv) = ccanopy(:)
+      !
+      !! mask that contains points where there is photosynthesis
+      !! For the sake of vectorisation [DISPENSABLE], computations are done only for convenient points.
+      !! nia is the number of points where the assimilation is calculated and nina the number of points where photosynthesis is not
+      !! calculated (based on criteria on minimum or maximum values on LAI, vegetation fraction, shortwave incoming radiation, 
+      !! temperature and relative humidity).
+      !! For the points where assimilation is not calculated, variables are initialized to specific values. 
+      !! The assimilate(kjpindex) array contains the logical value (TRUE/FALSE) relative to this photosynthesis calculation.
+      !! The index_assi(kjpindex) array indexes the nia points with assimilation, whereas the index_no_assi(kjpindex) array indexes
+      !! the nina points with no assimilation.
+      nia=0
+      nina=0
+      !
+      DO ji=1,kjpindex
+        !
+        IF ( ( lai(ji,jv) .GT. 0.01 ) .AND. &
+              ( veget_max(ji,jv) .GT. min_sechiba ) ) THEN
+
+          IF ( ( veget(ji,jv) .GT. min_sechiba ) .AND. &
+               ( swdown(ji) .GT. min_sechiba ) .AND. &
+               ( temp_air(ji) .GT. tmin(ji,jv) ) .AND. &
+               ( temp_air(ji) .LT. tmax(ji,jv) ) .AND. &
+               ( humrel(ji,jv) .GT. min_sechiba )       ) THEN
+             !
+             assimilate(ji) = .TRUE.
+             nia=nia+1
+             index_assi(nia)=ji
+             !
+          ELSE
+             !
+             assimilate(ji) = .FALSE.
+             nina=nina+1
+             index_non_assi(nina)=ji
+             !
+          ENDIF
+        ELSE
+          !
+          assimilate(ji) = .FALSE.
+          nina=nina+1
+          index_non_assi(nina)=ji
+          !
+        ENDIF
+        !
+      ENDDO
+      !
+      gstot(:) = zero
+      assimtot(:) = zero
+      !
+      zqsvegrap(:) = zero
+      WHERE (qsintmax(:,jv) .GT. min_sechiba)
+      !! relative water quantity in the water interception reservoir
+          zqsvegrap(:) = MAX(zero, qsintveg(:,jv) / qsintmax(:,jv))
+      ENDWHERE
+      !
+      !! Calculates the water limitation factor.
+      WHERE ( assimilate(:) )
+        water_lim(:) = MIN( 2.*humrel(:,jv), un )
+      ENDWHERE
+      ! give a default value of ci for all pixel that do not assimilate
+      DO jl=1,nlai
+         DO inina=1,nina
+            leaf_ci(index_non_assi(inina),jv,jl) = ccanopy(index_non_assi(inina)) * std_ci_frac
+         ENDDO
+      ENDDO
+      !
+      ilai(:) = 1
+      !
+      ! Here is calculated photosynthesis (Farqhuar et al., 1980)
+      ! and stomatal conductance (Ball et al., 1987)
+      !
+      ! Calculates temperature dependent parameters.
+      !
+      IF ( is_c4(jv) )  THEN
+        !
+        ! @addtogroup Photosynthesis
+        ! @{   
+        !
+        ! 2.2 Calculates temperature dependent parameters for C4 plants.\n
+        !! \latexonly
+        !! \input{diffuco_trans_co2_2.2.tex}
+        !! \endlatexonly
+        ! @}           
+        !
+        IF (nia .GT. 0) then
+          DO inia=1,nia
+            !
+            ! @codeinc
+            x_1 = x1_coef * EXP( x1_Q10*(temp_air(index_assi(inia))-tp_00) ) 
+
+            ! = 2.0**(((temp_air(index_assi(inia))-tp_00)-25.0)/10.0)
+            !
+            kt(index_assi(inia)) = kt_coef * x_1 * 1.e6
+            rt(index_assi(inia)) = rt_coef(1)* x_1 / &
+              ( un + EXP(rt_coef(2)*(temp_air(index_assi(inia))-tmax(index_assi(inia),jv))) )
+            !
+            vc(index_assi(inia)) = vcmax(index_assi(inia),jv) & 
+                * vc_coef(1) * x_1 * water_lim(index_assi(inia)) / &
+!                 * 0.39 * x_1  / &
+                ( (un+EXP(vc_coef(2)*(tmin(index_assi(inia),jv)-temp_air(index_assi(inia))))) &
+                * (un+EXP(vc_coef(2)*(temp_air(index_assi(inia))-topt(index_assi(inia),jv)))) )
+            ! @endcodeinc
+            !
+          ENDDO
+        ENDIF
+        !
+        IF (nina .GT. 0) then
+          ! For the points where assimilation is not calculated, variables are initialized to specific values. 
+          DO inina=1,nina
+            kt(index_non_assi(inina)) = zero
+            rt(index_non_assi(inina)) = zero
+            vc(index_non_assi(inina)) = zero
+           ENDDO
+        ENDIF
+        !
+      ELSE
+        !
+        ! @addtogroup Photosynthesis
+        ! @{   
+        !
+        ! 2.3 Calculates temperature dependent parameters for C3 plants.\n
+        !! \latexonly
+        !! \input{diffuco_trans_co2_2.3.tex}
+        !! \endlatexonly
+        ! @}           
+        !
+        IF (nia .GT. 0) then
+          !
+          DO inia=1,nia
+            !
+            ! @codeinc
+            temp_lim(index_assi(inia)) = &
+              (temp_air(index_assi(inia))-tmin(index_assi(inia),jv)) * &
+              (temp_air(index_assi(inia))-tmax(index_assi(inia),jv))
+            temp_lim(index_assi(inia)) = temp_lim(index_assi(inia)) / &
+              (temp_lim(index_assi(inia))-(temp_air(index_assi(inia))-&
+               topt(index_assi(inia),jv))**2)
+            !
+            Kc(index_assi(inia)) = kc_coef * EXP(Ko_Q10*(temp_air(index_assi(inia))-tp_00))
+            !
+            Ko(index_assi(inia)) = Ko_coef * Oa &
+                * EXP(Ko_Q10*(temp_air(index_assi(inia))-tmin(index_assi(inia),jv))) / &
+                  (temp_air(index_assi(inia))-tmin(index_assi(inia),jv))
+            !
+            CP(index_assi(inia)) = CP_0 * EXP( CP_temp_coef *(temp_air(index_assi(inia))-tp_00 - CP_temp_ref)/&
+                                                           temp_air(index_assi(inia)) )
+            !
+            vc(index_assi(inia)) = vcmax(index_assi(inia),jv) * &
+               temp_lim(index_assi(inia)) * water_lim(index_assi(inia))
+!               temp_lim(index_assi(inia)) 
+            vj(index_assi(inia)) = vjmax(index_assi(inia),jv) * &
+               temp_lim(index_assi(inia)) * water_lim(index_assi(inia))
+!                temp_lim(index_assi(inia))
+            ! @endcodeinc
+            !
+          ENDDO
+          !
+        ENDIF
+        !
+        IF (nina .GT. 0) then
+          ! For the points where assimilation is not calculated, variables are initialized to specific values. 
+          DO inina=1,nina
+            temp_lim(index_non_assi(inina)) = zero
+            Kc(index_non_assi(inina)) = zero
+            Ko(index_non_assi(inina)) = zero
+            CP(index_non_assi(inina)) = zero
+            !
+            vc(index_non_assi(inina)) = zero
+            vj(index_non_assi(inina)) = zero
+          ENDDO
+        ENDIF
+      ENDIF      ! C3/C4
+      !
+      ! @addtogroup Photosynthesis
+      ! @{   
+      !
+      ! 2.4 Loop over LAI discretized levels to estimate assimilation and conductance\n
+      ! @}           
+      !
+      !! The calculate(kjpindex) array is of type logical to indicate wether we have to sum over this LAI fixed level (the LAI of
+      !! the point for the PFT is lower or equal to the LAI level value). The number of such points is incremented in nic and the 
+      !! corresponding point is indexed in the index_calc array.
+      DO jl = 1, nlai
+        !
+        nic=0
+        calculate(:) = .FALSE.
+        !
+        IF (nia .GT. 0) then
+          DO inia=1,nia
+            calculate(index_assi(inia)) = (laitab(jl) .LE. lai(index_assi(inia),jv) )
+            IF ( calculate(index_assi(inia)) ) THEN
+              nic=nic+1
+              index_calc(nic)=index_assi(inia)
+            ENDIF
+          ENDDO
+        ENDIF
+        !
+        ! @addtogroup Photosynthesis
+        ! @{   
+        !
+        ! 2.4.1 Vmax is scaled into the canopy due to reduction of nitrogen 
+        !! (Johnson and Thornley,1984).\n
+        !! \latexonly
+        !! \input{diffuco_trans_co2_2.4.1.tex}
+        !! \endlatexonly
+        ! @}           
+        !
+        x_1 = ( un - .7_r_std * ( un - light(jv,jl) ) )
+        !
+        IF ( nic .GT. 0 ) THEN
+          DO inic=1,nic
+            ! @codeinc
+            vc2(index_calc(inic)) = vc(index_calc(inic)) * x_1
+            vj2(index_calc(inic)) = vj(index_calc(inic)) * x_1
+            ! @endcodeinc
+          ENDDO
+        ENDIF
+        !
+        IF ( is_c4(jv) )  THEN
+          !
+          ! @addtogroup Photosynthesis
+          ! @{   
+          !
+          ! 2.4.2 Assimilation for C4 plants (Collatz et al., 1992)\n
+          !! \latexonly
+          !! \input{diffuco_trans_co2_2.4.2.tex}
+          !! \endlatexonly
+          ! @}           
+          !
+          DO ji = 1, kjpindex
+            assimi(ji) = zero
+          ENDDO
+          !
+          IF (nic .GT. 0) THEN
+             DO inic=1,nic
+              ! @codeinc
+              ! W_to_mmol * RG_to_PAR = 2.3
+              !
+              x_1 = - ( vc2(index_calc(inic)) + quantum_yield * W_to_mmol * RG_to_PAR* swdown(index_calc(inic)) * &
+                    ext_coeff(jv) * light(jv,jl) )
+              x_2 = vc2(index_calc(inic)) * quantum_yield *W_to_mmol * RG_to_PAR * swdown(index_calc(inic)) * &
+                    ext_coeff(jv) * light(jv,jl) 
+              x_3 = ( -x_1 - sqrt( x_1*x_1 - 4.0 * xc4_1 * x_2 ) ) / (2.0*xc4_1)
+              x_4 = - ( x_3 + kt(index_calc(inic)) * leaf_ci(index_calc(inic),jv,jl) * &
+                    1.0e-6 )
+              x_5 = x_3 * kt(index_calc(inic)) * leaf_ci(index_calc(inic),jv,jl) * 1.0e-6
+              assimi(index_calc(inic)) = ( -x_4 - sqrt( x_4*x_4 - 4. * xc4_2 * x_5 ) ) / (2.*xc4_2)
+              assimi(index_calc(inic)) = assimi(index_calc(inic)) - &
+                                                      rt(index_calc(inic))
+              ! @endcodeinc
+            ENDDO
+          ENDIF
+        ELSE
+          !
+          ! @addtogroup Photosynthesis
+          ! @{   
+          !
+          ! 2.4.3 Assimilation for C3 plants (Farqhuar et al., 1980)\n
+          !! \latexonly
+          !! \input{diffuco_trans_co2_2.4.3.tex}
+          !! \endlatexonly
+          ! @}           
+          !
+          DO ji = 1, kjpindex
+            assimi(ji) = zero
+          ENDDO
+          !
+          IF (nic .GT. 0) THEN
+            DO inic=1,nic
+              ! @codeinc
+              x_1 = vc2(index_calc(inic)) * leaf_ci(index_calc(inic),jv,jl) / &
+                    ( leaf_ci(index_calc(inic),jv,jl) + Kc(index_calc(inic)) * &
+                    ( un + Oa / Ko(index_calc(inic)) ) )
+
+              ! The value alpha_j = 0.8855 is equal to 0.385*4.6/2.
+              ! The value 0.385 comes from MacMutrie et al. (1990), to calculate J based on the equation:
+	      ! theta*J^2 - (0.385*theta+Jmax)*J+O.385*theta*Jmax=0 equation that comes
+              ! from Farqhuar and Wong (1984).
+              ! For C4 plants PAR is calculated from SWdown by dividing by 2 and multiplying by
+              ! by 4.6 to convert from W/m^2 to micromol/s/m^2.
+              x_2 = alpha_j*swdown(index_calc(inic))*ext_coeff(jv)*light(jv,jl)
+
+              x_3 = x_2 + vj2(index_calc(inic))
+              x_4 = ( x_3 - sqrt( x_3*x_3 - (quatre*curve_assim*x_2*vj2(index_calc(inic))) ) ) / &
+                    (deux*curve_assim)
+              x_5 = x_4 * leaf_ci(index_calc(inic),jv,jl) / &
+                    ( WJ_coeff1 *  leaf_ci(index_calc(inic),jv,jl) + &
+                     WJ_coeff2 *CP(index_calc(inic)) ) 
+              x_6 = MIN( x_1, x_5 )
+              assimi(index_calc(inic)) = x_6 * ( un  - CP(index_calc(inic))/&
+                 leaf_ci(index_calc(inic),jv,jl) ) - Vc_to_Rd_ratio * vc2(index_calc(inic))
+              ! @endcodeinc
+            ENDDO
+          ENDIF
+        ENDIF
+        !
+        IF (nic .GT. 0) THEN
+          !
+          DO inic=1,nic
+            !
+            ! @addtogroup Photosynthesis
+            ! @{   
+            !
+            !! 2.4.4 Estimatation of the stomatal conductance (Ball et al., 1987).\n
+            !! \latexonly
+            !! \input{diffuco_trans_co2_2.4.4.tex}
+            !! \endlatexonly
+            ! @}           
+            !
+            icinic=index_calc(inic)
+!            gs(icinic) = water_lim(icinic) * &
+            gs(icinic) = &
+                 ( gsslope(jv) * assimi(icinic) * &
+                 air_relhum(icinic) / ccanopy(icinic) ) &
+                  + gsoffset(jv)
+            gs(icinic) = MAX( gs(icinic), gsoffset(jv) )
+          ENDDO
+          !
+          DO inic=1,nic
+            icinic=index_calc(inic)
+            !
+            ! the new ci is calculated with
+            ! dci/dt=(ccanopy-ci)*gs/1.6-A
+            ! ci=ci+((ccanopy(icinic)-ci)*gs/1.6-&
+            !    assimi(icinic))*dtradia
+            ! we verify that ci is not out of possible values
+            !
+            ci_gs(icinic) = MIN( ccanopy(icinic), MAX( CP(icinic), &
+                   ( ccanopy(icinic) - O2toCO2_stoechio * assimi(icinic) / &
+                     gs(icinic) ) ) ) - leaf_ci(icinic,jv,jl)
+          ENDDO
+          DO inic=1,nic
+            icinic=index_calc(inic)
+            !to avoid some problem of numerical stability, the leaf_ci is bufferized
+            !! [DISPENSABLE] This trick makes the code uncomprehensible:
+            !! ci_gs = (Ca - 1.6*A)/gs -leaf_ci
+            !! leaf_ci = leaf_ci + ci_gs/6. = leaf_ci + ((Ca - 1.6*A)/gs - leaf_ci)/6. = leaf_ci*5/6. + (Ca - 1.6*A)/gs*1/6.
+            leaf_ci(icinic,jv,jl) = leaf_ci(icinic,jv,jl) + ci_gs(icinic)/6.
+          ENDDO
+          !
+          DO inic=1,nic
+            icinic=index_calc(inic)
+            !
+            ! this might be the last level for which Ci is calculated. Store it for 
+            ! initialization of the remaining levels of the Ci array.
+            !
+            leaf_ci_lowest(icinic) = leaf_ci(icinic,jv,jl)
+          ENDDO
+          !
+          DO inic=1,nic
+            icinic=index_calc(inic)
+            !
+            ! @addtogroup Photosynthesis
+            ! @{   
+            !
+            !! 2.4.5 Integration at the canopy level\n
+            !! \latexonly
+            !! \input{diffuco_trans_co2_2.4.5.tex}
+            !! \endlatexonly
+            ! @}           
+            ! total assimilation and conductance
+            assimtot(icinic) = assimtot(icinic) + &
+              assimi(icinic) * (laitab(jl+1)-laitab(jl))
+            gstot(icinic) = gstot(icinic) + &
+              gs(icinic) * (laitab(jl+1)-laitab(jl))
+            !
+            ilai(icinic) = jl
+            !
+          ENDDO
+          !
+        ENDIF
+        !
+        ! keep stomatal conductance of topmost level
+        !
+        IF ( jl .EQ. 1 ) THEN
+          !
+          leaf_gs_top(:) = zero
+          !
+          IF ( nic .GT. 0 ) then
+            DO inic=1,nic
+              leaf_gs_top(index_calc(inic)) = gs(index_calc(inic))
+             ENDDO
+          ENDIF
+          !
+        ENDIF
+        !
+        IF (nia .GT. 0) THEN
+          !
+          DO inia=1,nia
+            !
+            IF ( .NOT. calculate(index_assi(inia)) ) THEN
+              !
+              !   a) for plants that are doing photosynthesis, but whose LAI is lower
+              !      than the present LAI step, initialize it to the Ci of the lowest
+              !      canopy level
+              !
+              leaf_ci(index_assi(inia),jv,jl) = leaf_ci_lowest(index_assi(inia))
+              !
+            ENDIF
+            !
+          ENDDO
+          !
+        ENDIF
+        !
+      ENDDO  ! loop over LAI steps
+      !
+      !! 2.5 Calculate resistances
+      !
+      IF (nia .GT. 0) THEN
+        !
+        DO inia=1,nia
+          !
+          iainia=index_assi(inia)
+          !
+          ! conversion from mmol/m^2/s to m/s
+          !
+          gstot(iainia) =  mmol_to_m_1 *(temp_air(iainia)/tp_00)*&
+             (pb_std/pb(iainia))*gstot(iainia)
+          gstop(iainia) =  mmol_to_m_1 * (temp_air(iainia)/tp_00)*&
+             (pb_std/pb(iainia))*leaf_gs_top(iainia)*&
+              laitab(ilai(iainia)+1)
+          !
+          rveget(iainia,jv) = un/gstop(iainia)
+          rveget_min(iainia,jv) = (defc_plus / kzero(jv)) * (un / lai(iainia,jv))
+
+          !
+        ENDDO
+        !
+        DO inia=1,nia
+          !
+          iainia=index_assi(inia)
+          !
+          ! rstruct is the difference between rtot (=1./gstot) and rveget
+          !
+          ! Correction Nathalie - le 27 Mars 2006 - Interdire a rstruct d'etre negatif
+          !rstruct(iainia,jv) = un/gstot(iainia) - &
+          !     rveget(iainia,jv)
+          rstruct(iainia,jv) = MAX( un/gstot(iainia) - &
+               rveget(iainia,jv), min_sechiba)
+          !
+        ENDDO
+        !
+        DO inia=1,nia
+          !
+          iainia=index_assi(inia)
+          !
+          !! wind is a global variable of the diffuco module.
+          speed = MAX(min_wind, wind(index_assi(inia)))
+          !
+          ! beta for transpiration
+          !
+          ! Corrections Nathalie - 28 March 2006 - on advices of Fred Hourdin
+          !! Introduction of a potentiometer rveg_pft to settle the rveg+rstruct sum problem in the coupled mode.
+          !! rveg_pft=1 in the offline mode. rveg_pft is a global variable declared in the diffuco module.
+          !vbeta3(iainia,jv) = veget_max(iainia,jv) * &
+          !  (un - zqsvegrap(iainia)) * &
+          !  (un / (un + speed * q_cdrag(iainia) * (rveget(iainia,jv) + &
+          !   rstruct(iainia,jv))))
+          !! Global resistance of the canopy to evaporation
+          cresist=(un / (un + speed * q_cdrag(iainia) * &
+               (rveg_pft(jv)*(rveget(iainia,jv) + rstruct(iainia,jv)))))
+
+
+          vbeta3(iainia,jv) = veget_max(iainia,jv) * &
+            (un - zqsvegrap(iainia)) * cresist + &
+!!$          ! Addition Nathalie - June 2006
+!!$          vbeta3(iainia,jv) = vbeta3(iainia,jv) + &
+             ! Corrections Nathalie - 09 November 2009 : veget => veget_max
+!               MIN( vbeta23(iainia,jv), veget(iainia,jv) * &
+               MIN( vbeta23(iainia,jv), veget_max(iainia,jv) * &
+!               zqsvegrap(iainia) * humrel(iainia,jv) * &
+               zqsvegrap(iainia) * cresist )
+          ! Fin ajout Nathalie
+
+          ! vbeta3pot for computation of potential transpiration (needed for irrigation)
+          vbeta3pot(iainia,jv) = MAX(zero, veget_max(iainia,jv) * cresist)
+          !
+          ! beta for assimilation. The difference is that surface 
+          ! covered by rain (un - zqsvegrap(iainia)) is not taken into account
+          ! The factor 1.6 is conversion for H2O to CO2 conductance.
+          ! vbetaco2(iainia,jv) = veget_max(iainia,jv) * &
+          !   (un / (un + q_cdrag(iainia) * &
+          !   (rveget(iainia,jv))))/1.6
+          !
+
+          !! Global resistance of the canopy to CO2 transfer
+          vbetaco2(iainia,jv) = veget_max(iainia,jv) * &
+             (un / (un + speed * q_cdrag(iainia) * &
+             (rveget(iainia,jv) + rstruct(iainia,jv)))) / O2toCO2_stoechio
+          !
+          ! cimean is the "mean ci" calculated in such a way that assimilation 
+          ! calculated in enerbil is equivalent to assimtot
+          !
+          cimean(iainia,jv) = ccanopy(iainia) - &
+             assimtot(iainia) / &
+             ( vbetaco2(iainia,jv)/veget_max(iainia,jv) * &
+             rau(iainia) * speed * q_cdrag(iainia))
+          !
+        ENDDO
+        !
+      ENDIF
+      !
+    END DO         ! loop over vegetation types
+    !
+
+    IF (long_print) WRITE (numout,*) ' diffuco_trans_co2 done '
+
+
+END SUBROUTINE diffuco_trans_co2
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	   : diffuco_comb
+!!
+!>\BRIEF           This routine combines the previous partial beta 
+!! coefficients and calculates the total alpha and complete beta coefficients.
+!!
+!! DESCRIPTION	   : Those integrated coefficients are used to calculate (in enerbil.f90) the total evapotranspiration 
+!! from the grid-cell. \n
+!!
+!! In the case that air is more humid than surface, dew deposition can occur (negative latent heat flux). 
+!! In this instance, for temperature above zero, all of the beta coefficients are set to 0, except for 
+!! interception (vbeta2) and bare soil (vbeta4 with zero soil resistance). The amount of water that is 
+!! intercepted by leaves is calculated based on the value of LAI of the surface. In the case of freezing 
+!! temperatures, water is added to the snow reservoir, and so vbeta4 and vbeta2 are set to 0, and the 
+!! total vbeta and valpha is set to 1.\n
+!!
+!! \latexonly 
+!!     \input{diffucocomb1.tex}
+!! \endlatexonly
+!!
+!! The beta and alpha coefficients are initially set to 1.
+!! \latexonly 
+!!     \input{diffucocomb2.tex}
+!! \endlatexonly
+!!
+!! If snow is lower than the critical value:
+!! \latexonly 
+!!     \input{diffucocomb3.tex}
+!! \endlatexonly
+!! If in the presence of dew:
+!! \latexonly 
+!!     \input{diffucocomb4.tex}
+!! \endlatexonly
+!!
+!! Determine where the water goes (soil, vegetation, or snow)
+!! when air moisture exceeds saturation.
+!! \latexonly 
+!!     \input{diffucocomb5.tex}
+!! \endlatexonly
+!!
+!! If it is not freezing dew is put into the interception reservoir and onto the bare soil. If it is freezing, 
+!! water is put into the snow reservoir. 
+!! Now modify valpha and vbetas where necessary: for soil and snow
+!! \latexonly 
+!!     \input{diffucocomb6.tex}
+!! \endlatexonly
+!!
+!! and for vegetation
+!! \latexonly 
+!!     \input{diffucocomb7.tex}
+!! \endlatexonly
+!!
+!! Then compute part of dew that can be intercepted by leafs.
+!!
+!! There will be no transpiration when air moisture is too high, under any circumstance
+!! \latexonly 
+!!     \input{diffucocomb8.tex}
+!! \endlatexonly
+!!
+!! There will also be no interception loss on bare soil, under any circumstance.
+!! \latexonly 
+!!     \input{diffucocomb9.tex}
+!! \endlatexonly
+!!
+!! The flowchart details the 'decision tree' which underlies the module. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): vbeta1, vbeta4, humrel, vbeta2, vbeta3, valpha, vbeta
+!!
+!! REFERENCE(S) :
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!!
+!! FLOWCHART    :
+!! \latexonly 
+!!     \includegraphics[scale=0.25]{diffuco_comb_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_comb (kjpindex, dtradia, humrel, rau, u, v, q_cdrag, pb, qair, temp_sol, temp_air, &
+       & snow, veget, lai, vbeta1, vbeta2, vbeta3 , vbeta4, valpha, vbeta, qsintmax)    
+    
+    ! Ajout qsintmax dans les arguments de la routine Nathalie / le 13-03-2006
+
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                           :: kjpindex   !! Domain size (-)
+    REAL(r_std), INTENT (in)                             :: dtradia    !! Time step (s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau        !! Air Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u          !! Eastward Lowest level wind speed (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v          !! Nortward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag    !! Product of Surface drag coefficient and wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: pb         !! Lowest level pressure (Pa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qair       !! Lowest level specific air humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: temp_sol   !! Skin temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: temp_air   !! Lower air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: snow       !! Snow mass (kg)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget      !! Fraction of vegetation type (fraction)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: lai        !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: qsintmax   !! Maximum water on vegetation (kg m^{-2})
+
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: valpha     !! Total Alpha coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vbeta      !! Total beta coefficient (-)
+
+    !! 0.3 Modified variables 
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: vbeta1     !! Beta for sublimation (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: vbeta4     !! Beta for Bare soil evaporation (-) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: humrel     !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: vbeta2     !! Beta for interception loss (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: vbeta3     !! Beta for Transpiration (-)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                       :: ji, jv
+    REAL(r_std)                                          :: zevtest, zsoil_moist, zrapp
+    REAL(r_std), DIMENSION(kjpindex)                     :: vbeta2sum, vbeta3sum
+!!    REAL(r_std), DIMENSION(kjpindex)                     :: vegetsum, vegetsum2
+    REAL(r_std), DIMENSION(kjpindex)                     :: qsatt
+    LOGICAL, DIMENSION(kjpindex)                         :: toveg, tosnow
+    REAL(r_std)                                          :: coeff_dew_veg
+!_ ================================================================================================================================
+    
+    !! \latexonly 
+    !!     \input{diffucocomb1.tex}
+    !! \endlatexonly
+    vbeta2sum(:) = zero
+    vbeta3sum(:) = zero
+    DO jv = 1, nvm
+      vbeta2sum(:) = vbeta2sum(:) + vbeta2(:,jv)
+      vbeta3sum(:) = vbeta3sum(:) + vbeta3(:,jv)
+    ENDDO 
+
+  !! 1. The beta and alpha coefficients are initially set to 1.
+     
+    !! \latexonly 
+    !!     \input{diffucocomb2.tex}
+    !! \endlatexonly
+    vbeta(:) = un
+    valpha(:) = un
+
+    
+  !! 2. if snow is lower than the critical value:
+    
+    !! \latexonly 
+    !!     \input{diffucocomb3.tex}
+    !! \endlatexonly
+    DO ji = 1, kjpindex
+
+      IF  (snow(ji) .LT. snowcri) THEN
+
+          vbeta(ji) = vbeta4(ji) + vbeta2sum(ji) + vbeta3sum(ji)
+
+          IF (vbeta(ji) .LT. min_sechiba) THEN
+             vbeta(ji) = zero
+          END IF
+
+      END IF
+
+    ENDDO
+
+    
+  !! 3 If we are in presence of dew:
+     
+    CALL qsatcalc (kjpindex, temp_sol, pb, qsatt)
+
+    
+    !! 9.3.1 Determine where the water goes 
+    !! Determine where the water goes (soil, vegetation, or snow)
+    !! when air moisture exceeds saturation.
+    !! \latexonly 
+    !!     \input{diffucocomb5.tex}
+    !! \endlatexonly
+    toveg(:) = .FALSE.
+    tosnow(:) = .FALSE.
+    DO ji = 1, kjpindex
+      IF ( qsatt(ji) .LT. qair(ji) ) THEN
+          IF (temp_air(ji) .GT. tp_00) THEN
+
+              !! 9.3.1.1  If it is not freezing, 
+              !! If it is not freezing dew is put into the 
+              !! interception reservoir and onto the bare soil.
+              toveg(ji) = .TRUE.
+          ELSE
+
+              !! 9.3.1.2  If it is freezing, 
+              !! If it is freezing water is put into the 
+              !! snow reservoir.
+              tosnow(ji) = .TRUE.
+          ENDIF
+      ENDIF
+    END DO
+
+
+    !! 9.3.1.3 Now modify valpha and vbetas where necessary.
+    
+    !! 9.3.1.3.1 Soil and snow (2d)
+    !! \latexonly 
+    !!     \input{diffucocomb6.tex}
+    !! \endlatexonly
+    DO ji = 1, kjpindex
+      IF ( toveg(ji) ) THEN
+        vbeta1(ji) = zero
+        vbeta4(ji) = tot_bare_soil(ji)
+        ! Correction Nathalie - le 13-03-2006: le vbeta ne sera calcule qu'une fois tous les vbeta2 redefinis
+        !vbeta(ji) = vegetsum(ji)
+        vbeta(ji) = vbeta4(ji)
+        valpha(ji) = un
+      ENDIF
+      IF ( tosnow(ji) ) THEN
+        vbeta1(ji) = un
+        vbeta4(ji) = zero
+        vbeta(ji) = un
+        valpha(ji) = un
+      ENDIF
+    ENDDO
+
+    !! 9.3.1.3.2 Vegetation (3d)
+    !! \latexonly 
+    !!     \input{diffucocomb7.tex}
+    !! \endlatexonly
+    DO jv = 1, nvm
+      
+      DO ji = 1, kjpindex
+        
+        ! Correction Nathalie - 13-03-2006 / si qsintmax=0, vbeta2=0
+        IF ( toveg(ji) ) THEN
+           IF (qsintmax(ji,jv) .GT. min_sechiba) THEN
+              
+              ! Compute part of dew that can be intercepted by leafs.
+              IF ( lai(ji,jv) .GT. min_sechiba) THEN
+                IF (lai(ji,jv) .GT. 1.5) THEN
+                   coeff_dew_veg= &
+                         &   dew_veg_poly_coeff(6)*lai(ji,jv)**5 &
+                         & - dew_veg_poly_coeff(5)*lai(ji,jv)**4 &
+                         & + dew_veg_poly_coeff(4)*lai(ji,jv)**3 &
+                         & - dew_veg_poly_coeff(3)*lai(ji,jv)**2 &
+                         & + dew_veg_poly_coeff(2)*lai(ji,jv) &
+                         & + dew_veg_poly_coeff(1)
+                 ELSE
+                    coeff_dew_veg=un
+                 ENDIF
+              ELSE
+                 coeff_dew_veg=zero
+              ENDIF
+              IF (jv .EQ. 1) THEN
+                 vbeta2(ji,jv) = coeff_dew_veg*tot_bare_soil(ji)
+              ELSE
+                 vbeta2(ji,jv) = coeff_dew_veg*veget(ji,jv)
+             !vbeta2(ji,jv) = veget(ji,jv)
+              ENDIF
+           ELSE
+              vbeta2(ji,jv) = zero
+           ENDIF
+           vbeta(ji) = vbeta(ji) + vbeta2(ji,jv)
+        ENDIF
+        IF ( tosnow(ji) ) vbeta2(ji,jv) = zero
+        
+      ENDDO
+      
+    ENDDO
+
+    !! 9.3.2a  There will be no transpiration when air moisture is too high, under any circumstance
+    !! \latexonly 
+    !!     \input{diffucocomb8.tex}
+    !! \endlatexonly
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+        IF ( qsatt(ji) .LT. qair(ji) ) THEN
+          vbeta3(ji,jv) = zero
+          humrel(ji,jv) = zero
+        ENDIF
+      ENDDO
+    ENDDO
+
+    
+    !! 9.3.2b  There will also be no interception loss on bare soil, under any circumstance.
+    !! \latexonly 
+    !!     \input{diffucocomb9.tex}
+    !! \endlatexonly
+    DO ji = 1, kjpindex
+       IF ( qsatt(ji) .LT. qair(ji) ) THEN
+          vbeta2(ji,1) = zero
+       ENDIF
+    ENDDO
+
+    IF (long_print) WRITE (numout,*) ' diffuco_comb done '
+
+  END SUBROUTINE diffuco_comb
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	: diffuco_raerod
+!!
+!>\BRIEF	Computes the aerodynamic resistance, for cases in which the
+!! surface drag coefficient is provided by the coupled atmospheric model LMDZ and  when the flag
+!! 'ldq_cdrag_from_gcm' is set to TRUE
+!!
+!! DESCRIPTION	: Simply computes the aerodynamic resistance, for cases in which the
+!! surface drag coefficient is provided by the coupled atmospheric model LMDZ. If the surface drag coefficient
+!! is not provided by the LMDZ or signalled by the flag 'ldq_cdrag_from_gcm' set to FALSE, then the subroutine
+!! diffuco_aero is called instead of this one.
+!!
+!! Calculation of the aerodynamic resistance, for diganostic purposes. First calculate wind speed:
+!! \latexonly 
+!!     \input{diffucoaerod1.tex}
+!! \endlatexonly       
+!!
+!! next calculate ::raero
+!! \latexonly 
+!!     \input{diffucoaerod2.tex}
+!! \endlatexonly
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::raero
+!!
+!! REFERENCE(S)	:
+!! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp.248-273
+!! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influence de l'irrigation
+!! sur le cycle de l'eau, PhD Thesis, available from:
+!! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+!!
+!! FLOWCHART    :  None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_raerod (kjpindex, u, v, q_cdrag, raero)
+    
+    IMPLICIT NONE
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                     :: kjpindex     !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: u            !! Eastward Lowest level wind velocity (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: v            !! Northward Lowest level wind velocity (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: q_cdrag      !! Product of Surface drag coefficient and wind speed (m s^{-1})
+    
+    !! 0.2 Output variables 
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: raero        !! Aerodynamic resistance (s m^{-1})
+     
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                 :: ji           !! (-)
+    REAL(r_std)                                    :: speed        !! (m s^{-1})
+!_ ================================================================================================================================
+   
+  !! 1. Simple calculation of the aerodynamic resistance, for diganostic purposes.
+
+    DO ji=1,kjpindex
+
+       !! \latexonly 
+       !!     \input{diffucoaerod1.tex}
+       !! \endlatexonly       
+       speed = MAX(min_wind, wind(ji))
+
+       !! \latexonly 
+       !!     \input{diffucoaerod2.tex}
+       !! \endlatexonly
+       raero(ji) = un / (q_cdrag(ji)*speed)
+       
+    ENDDO
+  
+  END SUBROUTINE diffuco_raerod
+
+!! ================================================================================================================================
+!! SUBROUTINE   : diffuco_ok_inca
+!!
+!>\BRIEF         This subroutine computes biogenic emissions of reactive compounds, that is of
+!!               VOCs (volatile organic compounds) from vegetation and NOx (nitrogen oxides) from soils.
+!!               Calculation are mostly based on the works by Guenther et al. (1995) and Yienger and Levy (1995).\n 
+!!
+!! DESCRIPTION  : Biogenic VOC emissions from vegetation are based on the parameterisations developped by
+!!                Guenther et al. (1995). Biogenic VOCs considered here are: isoprene, monoterpenes, OVOC and ORVOC 
+!!                as bulked emissions, methanol, acetone, acetaldehyde, formaldehyde, acetic acid, formic acid
+!!                as single emissions.\n
+!!                For every biogenic VOCs an emission factor (EF), depending on the PFT considered, is used.\n
+!!                Isoprene emissions depend on temperature and radiation. A partition between sunlit and shaded
+!!                leaves is taken into account and either one (if ok_multilayer = FALSE) or several layers
+!!                (if ok_multilayer = TRUE) in the canopy can be used.\n
+!!                When radiation extinction is considered, the canopy radiative transfer model takes into 
+!!                account light extinction through canopy, calculating first need diffuse and direct radiation
+!!                based on Andrew Friend 2001 radiative model and Spitters et al. 1986. The calculation of lai, 
+!!                parscat, parsh and parsun, laisun and laishabsed based on Guenther et al.(JGR, 1995) and Norman (1982).\n
+!!                Emissions for other BVOCs (monoterpenes, OVOC, ORVOC and other single compounds such as
+!!                methanol, acetone...) depend only on temperature.\n   
+!!                The impact of leaf age, using an emission activity prescribed for each of the 4 leaf age
+!!                classes can also be considered for isoprene and methanol emissions when ok_leafage = TRUE.\n
+!!                NOx emissions from soils are based on Yienger and Levy (1995) and depend on soil moisture
+!!                and temperature and PFT. The pulse effect, related to significant rain occuring after severe
+!!                drought can also be considered (ok_pulse_NOx = TRUE), as well as the increase in emissions related to
+!!                biomass buring (ok_bbgfertil_NOx = TRUE) or use of fertilizers (ok_cropsfertil_NOx = TRUE). 
+!!                A net NO flux is eventually calculated taking into account loss by deposition on the surface, using
+!!                a Canopy Reduction Factor (CRF) based on stomatal and leaf area.\n 
+!!                This subroutine is called by diffuco_main only if biogenic emissions are activated
+!!                for sechiba (flag DIFFUCO_OK_INCA=TRUE).\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: PAR, :: PARsun, :: PARsh, :: laisun, :: laish,
+!!                          :: flx_iso, :: flx_mono, :: flx_ORVOC, :: flx_MBO,
+!!                          :: flx_methanol, :: flx_acetone, :: flx_acetal, :: flx_formal,
+!!                          :: flx_acetic, :: flx_formic, :: flx_no_soil, :: flx_no,
+!!                          :: CRF, :: flx_fertil_no, :: Trans, :: Fdf,
+!!                          :: PARdf, :: PARdr, :: PARsuntab, :: PARshtab
+!!
+!! REFERENCE(S) :
+!! - Andrew Friend (2001), Modelling canopy CO2 fluxes: are 'big-leaf' simplifications justified? 
+!! Global Ecology and Biogeography, 10, 6, 603-619, doi: 10.1046/j.1466-822x.2001.00268.x 
+!! - Spitters, C.J.T, Toussaint, H.A.J.M, Groudriaan, J. (1986), Separating the diffuse and direct
+!! component of global radiation and its implications for modeling canopy photosynthesis, Agricultural
+!! and Forest Meteorology, 38, 1-3, 217-229, doi:10.1016/0168-1923(86)90060-2
+!! - Norman JM (1982) Simulation of microclimates. In: Hatfield JL, Thomason IJ (eds)
+!!  Biometeorology in integrated pest management. Academic, New York, pp 65â99
+!! - Guenther, A., Hewitt, C. N., Erickson, D., Fall, R., Geron, C., Graedel, T., Harley, P.,
+!! Klinger, L., Lerdau, M., McKay, W. A., Pierce, T., Scholes, B., Steinbrecher, R., Tallamraju,
+!! R., Taylor, J. et Zimmerman, P. (1995), A global model of natural volatile organic compound
+!! emissions, J. Geophys. Res., 100, 8873-8892.
+!! - MacDonald, R. et Fall, R. (1993), Detection of substantial emissions of methanol from
+!! plants to the atmosphere, Atmos. Environ., 27A, 1709-1713.
+!! - Guenther, A., Geron, C., Pierce, T., Lamb, B., Harley, P. et Fall, R. (2000), Natural emissions
+!! of non-methane volatile organic compounds, carbon monoxide, and oxides of nitrogen from
+!! North America, Atmos. Environ., 34, 2205-2230.
+!! - Yienger, J. J. et Levy II, H. (1995), Empirical model of global soil-biogenic NOx emissions,
+!! J. Geophys. Res., 100, 11,447-11,464.
+!! - Lathiere, J., D.A. Hauglustaine, A. Friend, N. De Noblet-Ducoudre, N. Viovy, and
+!!  G. Folberth (2006), Impact of climate variability and land use changes on global biogenic volatile 
+!! organic compound emissions, Atmospheric Chemistry and Physics, 6, 2129-2146. 
+!! - Lathiere, J., D.A. Hauglustaine, N. De Noblet-Ducoudre, G. Krinner et G.A. Folberth (2005),
+!! Past and future changes in biogenic volatile organic compound emissions simulated with a global
+!! dynamic vegetation model, Geophysical Research Letters, 32, doi: 10.1029/2005GL024164.
+!! - Lathiere, J. (2005), Evolution des emissions de composes organiques et azotes par la biosphere
+!!  continentale dans le modele LMDz-INCA-ORCHIDEE, These de doctorat, Universite Paris VI.
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_inca (kjpindex, dtradia, swdown, sinang, temp_air, temp_sol, ptnlev1, precip_rain, humrel, &
+                        veget_max, lai, frac_age, &
+                        lalo, &
+                        PAR, PARsun, PARsh, laisun, laish, &
+                        flx_iso, flx_mono, flx_ORVOC, flx_MBO, flx_methanol, flx_acetone, flx_acetal, &
+                        flx_formal, flx_acetic, flx_formic, &
+                        flx_no_soil, flx_no,CRF, flx_fertil_no, Fdf, PARsuntab, PARshtab, PARdf, PARdr, Trans)
+
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex         !! Domain size - terrestrial pixels only (unitless)
+    REAL(r_std), INTENT(in)                                    :: dtradia          !! Time step (seconds)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: swdown           !! Down-welling surface short-wave flux 
+                                                                                   !! (W.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: sinang           !! Sinus of Solar Angle 
+                                                                                   !! (as computed in read_dim2) (unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: temp_air         !! Air temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: temp_sol         !! Skin temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: ptnlev1          !! 1st level of soil temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: precip_rain      !! Rain precipitation !!?? init
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)           :: humrel           !! Soil moisture stress (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)           :: veget_max        !! Max. vegetation fraction (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)           :: lai              !! Leaf area index (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm,nleafages), INTENT(in) :: frac_age         !! Age efficacity from STOMATE for iso 
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT(in)             :: lalo             !! Geographical coordinates for pixels (degrees)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)        :: PAR              !! Photosynthetic active radiation, half of swdown
+                                                                             !! @tex ($\mu mol photons. m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: PARsun           !! PAR received by sun leaves 
+                                                                             !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: PARsh            !! PAR received by shaded leaves 
+                                                                             !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: laisun           !! Leaf area index of Sun leaves 
+                                                                             !! (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: laish            !! Leaf area index of Shaded leaves
+                                                                             !! (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: flx_iso          !! Biogenic isoprene emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: flx_mono         !! Biogenic monoterpene emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: flx_ORVOC        !! Biogenic ORVOC emission - 
+                                                                             !! Other Reactive Volatil Organic Components 
+                                                                             !! (kgC.m^{-2}.s^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: flx_MBO          !! Biogenic MBO emission 
+                                                                             !! MethylButanOl (kgC.m^{-2}.s^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: flx_methanol     !! Biogenic methanol emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: flx_acetone      !! Biogenic acetone emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: flx_acetal       !! Biogenic Acetaldehyde emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: flx_formal       !! Biogenic Formaldehyde emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: flx_acetic       !! Biogenic Acetic Acid emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: flx_formic       !! Biogenic Formic Acid emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: flx_no_soil      !! Biogenic NO emission by soil (kgC.m^{-2}.s^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: flx_no           !! Biogenic total NO emission (kgC.m^{-2}.s^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)    :: CRF              !! Canopy reduction factor 
+                                                                             !! for net NO flux calculation 
+   REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)     :: flx_fertil_no    !! Biogenic NO emission due to N-fertilisation 
+                                                                             !! (kgC.m^{-2}.s^{-1})
+    !!Canopy radiative transfer model
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)         :: Trans           !! Atmospheric Transmissivity (unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)         :: Fdf             !! Diffuse Fraction of the radiation (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)         :: PARdf           !! Diffuse PAR
+                                                                             !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)         :: PARdr           !! Direct PAR 
+                                                                             !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    !! for multilayer canopy model for iso flux
+    REAL(r_std), DIMENSION(kjpindex,nlai+1), INTENT(out)  :: PARsuntab       !! PAR received by sun leaves 
+                                                                             !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nlai+1), INTENT(out)  :: PARshtab        !! PAR received by shaded leaves 
+                                                                             !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables 
+
+    INTEGER(i_std)                             :: ji, jv, jf, jl    !! Indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: fol_dens          !! foliar density (gDM.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)           :: tleaf             !! Foliar temperature (K)
+    REAL(r_std), DIMENSION(kjpindex)           :: t_no              !! Temperature used for soil NO emissions (C)
+    REAL(r_std), DIMENSION(kjpindex)           :: exp_1             !! First exponential used in the calculation of 
+                                                                    !! isoprene dependancy to Temperature 
+    REAL(r_std), DIMENSION(kjpindex)           :: exp_2             !! Second exponential used in the calculation of 
+                                                                    !! Isoprene dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_iso            !! Isoprene dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Cl_iso            !! Isoprene dependancy to Light 
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_mono           !! Monoterpene dependancy to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Ct_MBO            !! MBO dependance to Temperature
+    REAL(r_std), DIMENSION(kjpindex)           :: Cl_MBO            !! MBO dependance to Light
+    REAL(r_std), DIMENSION(kjpindex)           :: Xvar              !! Parameter used in the calculation 
+                                                                    !! of MBO dependance to Temperature
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: flx_OVOC          !! Biogenic OVOC emission - 
+                                                                    !! Other Volatil Organic Components (kgC.m^{-2}.s^{-1})
+    !!Canopy radiative transfer model
+    REAL(r_std)                                :: day               !! Day of The Year
+    REAL(r_std), DIMENSION(kjpindex)           :: So                !! Maximum radiation at the Earth surface (W.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex)           :: Rfrac             !! Parameter in the regression of diffuse 
+                                                                    !! share on transmission
+    REAL(r_std), DIMENSION(kjpindex)           :: Kfrac             !! Parameter in the regression of diffuse 
+                                                                    !! share on transmission
+    REAL(r_std), DIMENSION(kjpindex)           :: swdf              !! Sw diffuse radiation (W.m^{-2}) 
+    REAL(r_std), DIMENSION(kjpindex)           :: swdr              !! Sw direct radiation (W.m^{-2}) 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: PARscat           !! Scatter PAR @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Clsun_iso         !! Isoprene dependance to light for sun leaves 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Clsh_iso          !! Isoprene dependance to light for shaded leaves
+    !! for multilayer canopy model for iso flux
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: PARscattab        !! Scatter PAR @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nlai+1)             :: laitab            !! LAI per layer (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: laisuntab         !! LAI of sun leaves per layer (m^2.m^{-2})
+    REAL(r_std), DIMENSION(kjpindex,nlai+1)    :: laishtab          !! LAI of shaded leaves per layer 
+                                                                    !! (m^2.m^{-2})
+    REAL(r_std)                                :: Clsun_iso_tab     !! Isoprene dependance to light 
+                                                                    !! for sun leaves and per layer 
+    REAL(r_std)                                :: Clsh_iso_tab      !! Isoprene dependance to light 
+                                                                    !! for shaded leaves and per layer
+    !!Leaf age
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Eff_age_iso       !! Isoprene emission dependance to Leaf Age 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Eff_age_meth      !! Methanol emission dependance to Leaf Age 
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: Eff_age_VOC       !! Other VOC emission dependance to Leaf Age 
+    !!BBG and Fertilizers for NOx soil emission
+    REAL(r_std), DIMENSION(kjpindex)           :: veget_max_nowoody !! sum of veget_max for non-woody PFT
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: N_qt_WRICE_pft    !! N fertiliser on RICE 
+                                                                    !! (kgN per year per grid cell)
+    REAL(r_std), DIMENSION(kjpindex,nvm)       :: N_qt_OTHER_pft    !! N fertiliser on other veg 
+                                                                    !! (kgN per year per grid cell)
+
+
+    !! 0.5 Parameters values
+
+    REAL(r_std), PARAMETER :: CT1 = 95000.0       !! Empirical coeffcient (see Guenther .et. al, 1995, eq(10)) (J.mol^{-1})
+    REAL(r_std), PARAMETER :: CT2 = 230000.0      !! Empirical coefficient (see Guenther .et. al, 1995, eq(10)) (J.mol^{-1})
+    REAL(r_std), PARAMETER :: TS = 303.0          !! Leaf temperature at standard condition
+                                                  !! (see Guenther .et. al, 1995, eq(10)) (K)
+    REAL(r_std), PARAMETER :: TM = 314.0          !! Leaf temperature (see Guenther .et. al, 1995, eq(10)) (K)
+
+    REAL(r_std), PARAMETER :: alpha_ = 0.0027     !! Empirical coeffcient (see Guenther .et. al, 1995, eq(9)) (unitless)
+    REAL(r_std), PARAMETER :: CL1 = 1.066         !! Empirical coeffcient (see Guenther .et. al, 1995, eq(9)) (unitless)
+    REAL(r_std), PARAMETER :: beta = 0.09         !! Empirical coeffcient (see Guenther .et. al, 1995, eq(11)) (K^{-1})
+    REAL(r_std), PARAMETER :: lai_threshold = 11. !! Lai threshold for the calculation of scattered radiation
+                                                  !! based on Guenther .et. al (1995) (m^2.m^{-2})
+
+!_ ================================================================================================================================
+
+    !! 1. Canopy radiative transfer model
+
+    !! Canopy radiative transfer model: takes into account light extinction through canopy
+    !! First need to calculate diffuse and direct radiation
+    !! Based on Andrew Friend radiative model (Global Ecology & Biogeography, 2001)
+    !! And Spitters et al. (Agricultural and Forest Meteorology, 1986)
+
+    IF ( control%ok_radcanopy ) THEN
+
+       DO ji = 1, kjpindex
+          IF (sinang(ji) .GT. zero) THEN
+             day = julian_diff
+             !! 1.1 Extra-terrestrial solar irradiance at a plan parallel to Earh's surface
+             So(ji) = Sct*( un + 0.033*COS(360.*pi/180.*day/365.))*sinang(ji)
+             !! 1.2 Atmospheric transmissivity
+             Trans(ji) = swdown(ji)/So(ji)
+             !! 1.3 Empirical calculation of fraction diffuse from transmission based on Spitters et al. (1986)
+             Rfrac(ji) = 0.847 - 1.61*sinang(ji) + 1.04*(sinang(ji)**2.)
+             Kfrac(ji) = (1.47 - Rfrac(ji)*Rfrac(ji))/1.66      
+             IF (Trans(ji) .LE. 0.22) THEN
+                Fdf(ji) = un
+             ELSE IF (Trans(ji) .LE. 0.35) THEN
+                Fdf(ji) = un - 6.4*((Trans(ji) - 0.22)**2.) 
+             ELSE IF (Trans(ji) .LE. Kfrac(ji)) THEN
+                Fdf(ji) = 1.47 - 1.66*Trans(ji)
+             ELSE
+                Fdf(ji) = Rfrac(ji)
+             END IF
+             !! 1.4 Direct and diffuse sw radiation in W.m^{-2}
+             swdf(ji) = swdown(ji)*Fdf(ji)
+             swdr(ji) = swdown(ji)*(un-Fdf(ji))
+          ELSE
+             swdf(ji) = zero
+             swdr(ji) = zero
+          END IF
+
+          !! 1.5 PAR diffuse and direct in umol/m^2/s
+          PARdf(ji) = swdf(ji) * W_to_mmol * RG_to_PAR
+          PARdr(ji) = swdr(ji) * W_to_mmol * RG_to_PAR 
+       END DO
+
+       !! 1.6 Calculation of lai, parscat, parsh and parsun, laisun and laish !!?? define the terms
+       !! Based on Guenther et al. (JGR, 1995) and Norman (1982)
+       ! One-layer canopy model or multi-layer canopy model
+       IF (control%ok_multilayer) THEN 
+
+
+          ! Calculation PER LAYER
+          DO jl = 1, nlai+1
+             laitab(jl) = laimax*(EXP(lai_level_depth*REAL(jl-1,r_std)) - un)/(EXP(lai_level_depth*REAL(nlai,r_std)) - un)
+
+             DO ji = 1, kjpindex
+                IF (laitab(jl) .LE. lai_threshold) THEN
+                   PARscattab(ji,jl) = 0.07*PARdr(ji)*(1.1 - 0.1*laitab(jl))*exp(-sinang(ji))
+                ELSE
+                   PARscattab(ji,jl) = zero
+                END IF
+
+                IF (sinang(ji) .NE. zero ) THEN
+                   PARshtab(ji,jl) = PARdf(ji)*exp(-0.5*((laitab(jl))**0.7)) + PARscattab(ji,jl)
+                   PARsuntab(ji,jl) = PARdr(ji)*COS(60.*pi/180.)/sinang(ji) + PARshtab(ji,jl)
+                ELSE
+                   PARshtab(ji,jl) = PARdf(ji)*exp(-0.5*(laitab(jl)**0.7)) + PARscattab(ji,jl)
+                   PARsuntab(ji,jl) = zero 
+                END IF
+                IF (ABS(ACOS(sinang(ji))) .LT. pi/2. .AND. sinang(ji) .NE. zero) THEN 
+                   ! calculation corrected for multi-layer canopy model from Friend (2001)
+                   laisuntab(ji,jl) = laitab(jl)*exp(-0.5*laitab(jl)) 
+                   laishtab(ji,jl) = laitab(jl) - laisuntab(ji,jl)
+                ELSE
+                   laisuntab(ji,jl) = zero
+                   laishtab(ji,jl) = laitab(jl)
+                END IF
+             END DO
+          END DO
+       ELSE
+          ! Calculation FOR one layer
+          DO jv = 1, nvm
+             DO ji = 1, kjpindex
+                IF (lai(ji,jv) .LE. lai_threshold) THEN
+                   PARscat(ji,jv) = 0.07*PARdr(ji)*(1.1 - 0.1*lai(ji,jv))*exp(-sinang(ji))
+                ELSE
+                   PARscat(ji,jv) = zero
+                END IF
+
+                IF (sinang(ji) .NE. zero ) THEN
+                   PARsh(ji,jv) = PARdf(ji)*exp(-0.5*((lai(ji,jv))**0.7)) + PARscat(ji,jv)
+                   PARsun(ji,jv) = PARdr(ji)*COS(60.*pi/180.)/sinang(ji) + PARsh(ji,jv)
+                ELSE
+                   PARsh(ji,jv) = PARdf(ji)*exp(-0.5*(lai(ji,jv)**0.7)) + PARscat(ji,jv)
+                   PARsun(ji,jv) = zero 
+                END IF
+                IF (ABS(ACOS(sinang(ji))) .LT. pi/2. .AND. sinang(ji) .NE. zero) THEN 
+                   ! calculation as in Lathiere (2005) = with correction removing lai in Guenther (1995)
+                   laisun(ji,jv) = (un - exp(-0.5*lai(ji,jv)/(sinang(ji))))*sinang(ji)/COS(60.*pi/180.)
+                   laish(ji,jv) = lai(ji,jv) - laisun(ji,jv)
+                ELSE
+                   laisun(ji,jv) = zero
+                   laish(ji,jv) = lai(ji,jv)
+                END IF
+             END DO
+          END DO
+       ENDIF
+    END IF
+
+
+    !! 2. Calculation of non-PFT dependant parameters used for VOC emissions
+    DO ji = 1, kjpindex ! (loop over # pixels)
+       !! 2.1 Calculation of Tleaf (based on Lathiere, 2005)
+       IF ((temp_sol(ji) - temp_air(ji)) .GT. 2) THEN
+          tleaf(ji) = temp_air(ji) + 2
+       ELSE IF ((temp_sol(ji) - temp_air(ji)) .LT. -2) THEN
+          tleaf(ji) = temp_air(ji) - 2
+       ELSE
+          tleaf(ji) = temp_sol(ji)
+       END IF
+
+       !! 2.2 Isoprene emission dependency - with no PARsun/PARshaded partitioning - Guenther et al. (1995) and Lathiere (2005)
+       !> @codeinc $$?? ecrire les equation en latex ? 
+       exp_1(ji) = exp( (CT1 * ( tleaf(ji) - TS )) / (R*TS*tleaf(ji)) )
+       exp_2(ji) = exp( (CT2 *( tleaf(ji) - TM )) / (R*TS*tleaf(ji)) )
+       PAR(ji)   = swdown(ji) * W_to_mmol * RG_to_PAR        ! from W/m^2 to umol photons/m^2/s and half of sw for PAR
+       Ct_iso(ji)    = exp_1(ji)/(un + exp_2(ji))            ! temperature dependance  
+       Cl_iso(ji)    = alpha_*CL1*PAR(ji)/sqrt(un + (alpha_**2) * (PAR(ji)**2) ) ! light dependance
+       !> @endcodeinc
+       !! 2.3 Monoterpene emission dependency to Temperature
+       !> @codeinc
+       Ct_mono(ji) = exp(beta*(tleaf(ji) - TS))
+       !> @endcodeinc
+       !! 2.4 MBO biogenic emissions dependency, only from PFT7 and PFT4 for location of vegetation emitter
+       ! but in fact MBO fluxes only in America (ponderosa and lodgepole pines only found in these areas)
+       !> @codeinc
+       Xvar(ji) = ((un/312.3) - (un/tleaf(ji)))/R
+       !> @endcodeinc
+       !! 2.4.1 temperature dependency
+       !> @codeinc
+       Ct_MBO(ji)    = (1.52*209000.0*exp(67000.0*Xvar(ji)))/(209000.0 - 67000.0*(un - exp(209000.0*Xvar(ji))))
+       !> @endcodeinc
+       !! 2.4.2 light dependency
+       Cl_MBO(ji)    = (0.0011*1.44*PAR(ji))/(sqrt(un + (0.0011**2)*(PAR(ji)**2)))
+       !! 2.5 NO biogenic emissions given in ngN/m^2/s, emission factor in ngN/m^2/s too
+       !! calculation of temperature used for NO soil emissions
+       t_no(ji) = ptnlev1(ji) - ZeroCelsius  !!temp must be in celsius to calculate no emissions
+       !! 2.6 calculation of non-woody veget_max fraction
+       IF (control%ok_cropsfertil_NOx) THEN
+          veget_max_nowoody(ji) = zero
+          DO jv = 1,nvm
+             IF ( (jv /= ibare_sechiba) .AND. .NOT.(is_tree(jv)) ) THEN
+                veget_max_nowoody(ji) = veget_max_nowoody(ji) + veget_max(ji,jv)
+             ENDIF
+          ENDDO
+       END IF
+    END DO ! (loop over # pixels)
+
+    !! 3. Calculation of PFT dependant parameters and
+    ! Calculation of VOC emissions flux
+
+    Eff_age_iso(:,:) = zero
+    Eff_age_meth(:,:) = zero
+
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          ! 6-Calculation of Leaf Age Function (Lathiere 2005)
+          IF ( control%ok_leafage ) THEN
+             DO jf = 1, nleafages
+                !> @codeinc
+                Eff_age_iso(ji,jv) = Eff_age_iso(ji,jv) + frac_age(ji,jv,jf)*iso_activity(jf)
+                Eff_age_meth(ji,jv) = Eff_age_meth(ji,jv) + frac_age(ji,jv,jf)*methanol_activity(jf)
+                !> @endcodeinc 
+             END DO
+             !> @codeinc
+             Eff_age_VOC(ji,jv) = un
+             !> @endcodeinc
+          ELSE
+             Eff_age_iso(ji,jv) = un
+             Eff_age_meth(ji,jv) = un
+             Eff_age_VOC(ji,jv) = un
+          END IF
+          !! 5. Calculation of foliar density
+          IF ( sla(jv) .eq. zero ) THEN
+             fol_dens(ji,jv) = zero
+          ELSE
+             ! 2 factor for conversion from gC to gDM
+             fol_dens(ji,jv) = 2 * lai(ji,jv)/sla(jv)
+          ENDIF
+          !! 6. Calculation of VOC emissions from vegetation
+          IF ( control%ok_radcanopy ) THEN
+             ! if multi-layer canopy model
+             IF (control%ok_multilayer) THEN 
+                flx_iso(ji,jv) = zero
+                laisun(ji,jv) = zero
+                laish(ji,jv) = zero
+                ! loop over the NLAI canopy layers
+                DO jl = 1, nlai
+                   IF ((laitab(jl) .LE. lai(ji,jv)).AND.(lai(ji,jv).NE.zero)) THEN
+                      !sunlit vegetation 
+                      Clsun_iso_tab   = alpha_*CL1*PARsuntab(ji,jl)/sqrt(un + (alpha_**2) * (PARsuntab(ji,jl)**2) )
+                      ! shaded vegetation
+                      Clsh_iso_tab    = alpha_*CL1*PARshtab(ji,jl)/sqrt(un + (alpha_**2) * (PARshtab(ji,jl)**2) ) 
+
+                      !                  flx_iso(ji,jv) = flx_iso(ji,jv) + ((laisuntab(ji,jl+1)-laisuntab(ji,jl))*Clsun_iso_tab+ &
+                      !                       & (laishtab(ji,jl+1)-laishtab(ji,jl))*Clsh_iso_tab)* &
+                      !                       & fol_dens(ji,jv)*Ct_iso(ji)*em_factor_isoprene(jv)* &
+                      !                       & Eff_age_iso(ji,jv)*1e-9/one_hour
+                      !
+                      flx_iso(ji,jv) = flx_iso(ji,jv) + ((laisuntab(ji,jl+1) - laisuntab(ji,jl))*Clsun_iso_tab+ &
+                           & (laishtab(ji,jl+1) - laishtab(ji,jl))*Clsh_iso_tab)* &
+                           & fol_dens(ji,jv)/lai(ji,jv)*Ct_iso(ji)*em_factor_isoprene(jv)* &
+                           & Eff_age_iso(ji,jv)*1e-9/one_hour
+
+                      laisun(ji,jv) = laisuntab(ji,jl)
+                      laish(ji,jv)  = laishtab(ji,jl)
+                   END IF
+                END DO
+                ! if mono-layer canopy model
+             ELSE
+                !sunlit vegetation 
+                Clsun_iso(ji,jv)   = alpha_*CL1*PARsun(ji,jv)/sqrt(un + (alpha_**2) * (PARsun(ji,jv)**2) )
+                ! shaded vegetation      
+                Clsh_iso(ji,jv)    = alpha_*CL1*PARsh(ji,jv)/sqrt(un + (alpha_**2) * (PARsh(ji,jv)**2) )       
+                IF (lai(ji,jv) .NE. zero) THEN
+                   flx_iso(ji,jv) = (laisun(ji,jv)*Clsun_iso(ji,jv) + laish(ji,jv)*Clsh_iso(ji,jv))* &
+                        & fol_dens(ji,jv)/lai(ji,jv)*Ct_iso(ji)*em_factor_isoprene(jv)* &
+                        & Eff_age_iso(ji,jv)*1e-9/one_hour
+                ELSE
+                   ! 
+                   flx_iso(ji,jv) = zero
+                END IF
+             END IF
+             ! if no light extinction due to vegetation  
+          ELSE
+             !! Isoprene emissions - general equation
+             !> @codeinc
+             flx_iso(ji,jv) = fol_dens(ji,jv)*Ct_iso(ji)*Cl_iso(ji)*Eff_age_iso(ji,jv)*em_factor_isoprene(jv)*1e-9/one_hour
+             !> @endcodeinc
+          END IF
+          !! 6.2 Calculation of monoterpene biogenic emissions
+          !> @codeinc
+          flx_mono(ji,jv) = fol_dens(ji,jv)*em_factor_monoterpene(jv)*Ct_mono(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          !> @endcodeinc
+          !! 6.3 Calculation of ORVOC biogenic emissions
+          !! Other Reactive Volatile Organic Compounds
+          !> @codeinc
+          flx_ORVOC(ji,jv) = fol_dens(ji,jv)*em_factor_ORVOC(jv)*Ct_mono(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          !> @endcodeinc
+          !! 6.4 Calculation of OVOC biogenic emissions
+          !! Other Volatile Organic Compounds
+          flx_OVOC(ji,jv) = fol_dens(ji,jv)*em_factor_OVOC(jv)*Ct_mono(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          !! 6.5 Calculation of MBO biogenic emissions
+          !! 2-Methyl-3-Buten-2-ol 
+          IF(lalo(ji,1) .GE. 20. .AND. lalo(ji,2) .LE. -100) THEN
+             flx_MBO(ji,jv) = fol_dens(ji,jv)*em_factor_MBO(jv)*Ct_MBO(ji)*Cl_MBO(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          ELSE
+             flx_MBO(ji,jv) = zero
+          END IF
+          !! 6.6 Calculation of methanol biogenic emissions
+          flx_methanol(ji,jv) = fol_dens(ji,jv)*em_factor_methanol(jv)*Ct_mono(ji)*Eff_age_meth(ji,jv)*1e-9/one_hour
+          !! 6.7 Calculation of acetone biogenic emissions
+          flx_acetone(ji,jv) = fol_dens(ji,jv)*em_factor_acetone(jv)*Ct_mono(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          !! 6.8 Calculation of acetaldehyde biogenic emissions
+          flx_acetal(ji,jv) = fol_dens(ji,jv)*em_factor_acetal(jv)*Ct_mono(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          !! 6.9 Calculation of formaldehyde biogenic emissions
+          flx_formal(ji,jv) = fol_dens(ji,jv)*em_factor_formal(jv)*Ct_mono(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          !! 6.10 Calculation of acetic acid biogenic emissions
+          flx_acetic(ji,jv) = fol_dens(ji,jv)*em_factor_acetic(jv)*Ct_mono(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+          !! 6.11 Calculation of formic acid biogenic emissions
+          flx_formic(ji,jv) = fol_dens(ji,jv)*em_factor_formic(jv)*Ct_mono(ji)*Eff_age_VOC(ji,jv)*1e-9/one_hour
+       END DO
+
+    END DO
+
+
+    !! 7. Calculation of NOx emissions from soils
+    ! Based on Yienger & Levy (1995) and Lathiere (2005, chapter 3)
+    DO ji = 1, kjpindex
+       !! 7.1 Precipitation-related pulse function
+       IF (control%ok_pulse_NOx) THEN
+          ! if we are during a period where pulses are not allowed
+          IF (ok_siesta(ji)) THEN
+             ! if this period is not over 
+             IF (FLOOR(siestaday(ji)) .LE. siestalim(ji)) THEN
+                siestaday(ji) = siestaday(ji) + (dtradia/one_day)
+                ! if this period is over
+             ELSE
+                ok_siesta(ji) = .FALSE.
+                siestaday(ji) = zero
+             END IF
+          END IF
+          ! if we are during a period where pulses are allowed
+          IF ((.NOT. ok_siesta(ji)) .AND. (.NOT. allow_pulse(ji))) THEN
+             IF (humrel(ji,1) .LT. 0.15) THEN
+                ! if precip exceeds 1 mm/day over one time step => a pulse occurs
+                IF(precip_rain(ji)/nbre_precip .GE. un/(one_day/dtradia)) THEN
+                   ! if precip is up to 5 mm/day => pulse length is 3 days
+                   IF (precip_rain(ji)/nbre_precip .LT. 5./(one_day/dtradia)) THEN
+                      pulselim(ji) = 3.
+                      ! if precip is up to 15 mm/day => pulse length is 7 days
+                   ELSE IF (precip_rain(ji)/nbre_precip .LT. 15./(one_day/dtradia)) THEN
+                      pulselim(ji) = 7.
+                      ! if precip is upper than 15 mm/day => pulse length is 14 days
+                   ELSE IF (precip_rain(ji)/nbre_precip .GE. 15./(one_day/dtradia)) THEN
+                      pulselim(ji) = 14.
+                   END IF
+                   allow_pulse(ji)=.TRUE.
+                   pulseday(ji) = un
+                END IF
+             END IF
+          END IF
+          ! if we were during a pulse period
+          IF (allow_pulse(ji)) THEN
+             ! if we are still during the pulse period
+             ! 16/06/2010 We assume a (pulselim-1) days for the pulse length (NVui+Jlath)
+             IF(FLOOR(pulseday(ji)) .LT. pulselim(ji)) THEN
+                ! calculation of the pulse function
+                IF (pulselim(ji).EQ.3) THEN
+                   pulse(ji) = 11.19*exp(-0.805*pulseday(ji))
+                ELSE IF (pulselim(ji).EQ.7) THEN
+                   pulse(ji) = 14.68*exp(-0.384*pulseday(ji))
+                ELSE IF (pulselim(ji).EQ.14) THEN 
+                   pulse(ji) = 18.46*exp(-0.208*pulseday(ji))
+                END IF
+                pulseday(ji) = pulseday(ji) + (dtradia/one_day)
+                ! if the pulse period is over
+             ELSE
+                ! pulse function is set to 1 
+                pulse(ji) = un
+                allow_pulse(ji) = .FALSE.
+                siestaday(ji) = un
+                siestalim(ji) = pulselim(ji)
+                ok_siesta(ji) = .TRUE. 
+             END IF
+          END IF
+          ! no precipitation-related pulse function
+       ELSE
+          pulse(ji) = un
+       END IF
+    END DO
+
+    !! 7.2 Calculation of NO basal emissions including pulse effect
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          !Tropical forests
+          IF ( is_tropical(jv) .AND. is_evergreen(jv) ) THEN
+             ! Wet soils
+             IF (humrel(ji,1) .GT. 0.3) THEN
+                flx_no_soil(ji,jv) = 2.6*pulse(ji)
+                ! Dry soils
+             ELSE
+                flx_no_soil(ji,jv) = 8.6*pulse(ji)
+             END IF
+             !Else If agricultural lands OR Wet soils
+          ELSE IF ( ( .NOT.(natural(jv)) ) .OR. ( humrel(ji,1) .GT. 0.3 ) ) THEN
+             ! Calculation of NO emissions depending of Temperature
+             IF (t_no(ji) .LT. zero) THEN
+                flx_no_soil(ji,jv) = zero
+             ELSE IF (t_no(ji) .LE. 10.) THEN
+                flx_no_soil(ji,jv) = 0.28*em_factor_no_wet(jv)*t_no(ji)*pulse(ji)
+             ELSE IF (t_no(ji) .LE. 30.) THEN
+                flx_no_soil(ji,jv) = em_factor_no_wet(jv)*exp(0.103*t_no(ji))*pulse(ji)
+             ELSE
+                flx_no_soil(ji,jv) = 21.97*em_factor_no_wet(jv)*pulse(ji)
+             END IF
+             !Else if Temp negative
+          ELSE IF (t_no(ji) .LT. zero) THEN
+             flx_no_soil(ji,jv) = zero
+             !Else if Temp <= 30
+          ELSE IF (t_no(ji) .LE. 30.) THEN
+             flx_no_soil(ji,jv) = (em_factor_no_dry(jv)*t_no(ji))/30.*pulse(ji)
+          ELSE
+             flx_no_soil(ji,jv) = em_factor_no_dry(jv)*pulse(ji)
+          END IF
+
+          !! 7.3 IF ACTIVATED (ok_bbgfertil_NOx = TRUE) calculation of NOx soil emission increase due to biomass burning
+          ! Calculation of Biomass-Burning-induced NOx emissions (Lathiere, 2005)
+          ! => NOx emissions 3-fold increase
+          IF (control%ok_bbgfertil_NOx) THEN
+             IF ( natural(jv) ) THEN
+                ! North Tropical zone from May to June
+                IF ((lalo(ji,1) .LE. 30. .AND. lalo(ji,1) .GE. zero).AND. &
+                     (day .GE. 121. .AND. day .LE. 181).AND.(flx_co2_bbg_year(ji) .GT. 0.1)) THEN
+                   flx_no_soil(ji,jv) = flx_no_soil(ji,jv)*3.
+                   ! South Tropical zone from November to December
+                ELSE IF ((lalo(ji,1) .GE. -30. .AND. lalo(ji,1) .LT. zero).AND.(day .GE. 305.).AND. & 
+                        (flx_co2_bbg_year(ji) .GT. 0.1)) THEN
+                   flx_no_soil(ji,jv) = flx_no_soil(ji,jv)*3.
+                END IF
+             END IF
+          END IF
+
+          !! 7.4 IF ACTIVATED (ok_cropsfertil_NOx = TRUE) calculation of NOx soil emission increase due to fertilizer use 
+          ! Calculation of N-fertiliser-induced NOx emissions
+          flx_fertil_no(ji,jv) = zero
+          IF (control%ok_cropsfertil_NOx) THEN
+             IF (veget_max_nowoody(ji) .NE. zero) THEN
+                ! Non-agricultural lands
+                IF ( (jv == ibare_sechiba) .OR. is_tree(jv) ) THEN
+                   N_qt_WRICE_pft(ji,jv) = zero
+                   N_qt_OTHER_pft(ji,jv) = zero
+                ! Grasslands or Croplands
+                ELSE
+                   N_qt_WRICE_pft(ji,jv) = N_qt_WRICE_year(ji)*veget_max(ji,jv)/veget_max_nowoody(ji)
+                   N_qt_OTHER_pft(ji,jv) = N_qt_OTHER_year(ji)*veget_max(ji,jv)/veget_max_nowoody(ji)
+                END IF
+             ELSE
+                N_qt_WRICE_pft(ji,jv) = zero
+                N_qt_OTHER_pft(ji,jv) = zero
+             END IF
+
+             ! North temperate regions from May to August
+             ! OR South Temperate regions from November to February
+             IF (((lalo(ji,1) .GT. 30.) .AND. (day .GE. 121. .AND. day .LE. 243.).AND.(veget_max(ji,jv) .NE. zero)) .OR. & 
+             &  ((lalo(ji,1) .LT. -30.) .AND. (day .GE. 305. .OR. day .LE. 59.) .AND.(veget_max(ji,jv) .NE. zero))) THEN
+                ! 1e12 for conversion from kg to Ng
+                ! 1/(365/12*24*60*60*4) for conversion from year to seconds corrected for 4 months of emissions
+                flx_fertil_no(ji,jv) = (N_qt_WRICE_pft(ji,jv)*(1/30.)+N_qt_OTHER_pft(ji,jv))*(2.5/100.) &
+                     & *1e12/(365*24*60*60*4/12)/(area2(ji)*veget_max(ji,jv))
+                ! OR Tropical regions all the year
+             ELSE IF ((lalo(ji,1) .GE. -30.).AND.(lalo(ji,1) .LE. 30.).AND.(veget_max(ji,jv) .NE. zero)) THEN
+                flx_fertil_no(ji,jv) = (N_qt_WRICE_pft(ji,jv)*(1/30.)+N_qt_OTHER_pft(ji,jv))*(2.5/100.) &
+                     & *1e12/(365*24*60*60)/(area2(ji)*veget_max(ji,jv))
+             END IF
+             flx_no_soil(ji,jv) = flx_no_soil(ji,jv) + flx_fertil_no(ji,jv)
+          END IF
+
+          !! 7.5 Calculation of net NO flux above soil accounting for surface deposition, 
+          !! based on the Canopy Reduction Factor (CRF), calculated using Leaf Area and Stomatal Area
+          !kc=cuticle absorptivity = 0.24m^2/m^2
+          !ks=stomatal absorptivity = 8.75m^2/m^2
+          !Larch=Larcher SAI/LAI ratio given in Larcher 1991
+          !> @codeinc
+          CRF(ji,jv) = (exp(-8.75*Larch(jv)*lai(ji,jv)) + exp(-0.24*lai(ji,jv)))/2.
+          flx_no(ji,jv) = flx_no_soil(ji,jv)*CRF(ji,jv)
+          !> @endcodeinc
+       END DO
+    END DO
+    IF (long_print) WRITE(numout,*) 'OK diffuco inca'
+
+
+  END SUBROUTINE diffuco_inca
+
+!! ================================================================================================================================
+!! SUBROUTINE   : diffuco_inca_read
+!!
+!>\BRIEF         This subroutine will read and interpolate the data set of CO2 emissions from biomass burning.\n
+!!
+!! DESCRIPTION  :  This subroutine will interpolate the 1 x 1 deg based data set of CO2 emissions from biomass burning
+!!                 expresssed in kgC/m^2 per year (=> density = TRUE), N fertiliser amount expressed in kgN per year and
+!!                 per grid cell (=> density = FALSE) to the resolution of the model.\ n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: data_year
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!_ ================================================================================================================================
+
+  SUBROUTINE diffuco_inca_read (nbpt, lalo, neighbours, resolution, data_year, filename, filename2, fieldname, density)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)       :: nbpt                !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)          :: lalo(nbpt,2)        !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)       :: neighbours(nbpt,8)  !! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std), INTENT(in)          :: resolution(nbpt,2)  !! The size in m of each grid-box in X and Y 
+    CHARACTER(LEN=80), INTENT(in)    :: filename2
+    CHARACTER(LEN=80), INTENT(in)    :: fieldname
+    LOGICAL, INTENT(in)              :: density
+
+    !! 0.2 Output variables
+
+    REAL(r_std), INTENT(out)          :: data_year(:)       !! data per year (climatology) per unit area 
+
+    !! 0.3 Modified variables
+
+    CHARACTER(LEN=80), INTENT(inout)  :: filename
+
+
+    !! 0.4 Local variables 
+
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, ilf, lastjp, nbexp
+    REAL(r_std) :: lev(1), date, dt, coslat
+    REAL(r_std) :: lon_up, lon_low, lat_up, lat_low
+    INTEGER(i_std) :: itau(1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_rel, lon_rel, lat_ful, lon_ful
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: data_year_file
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: loup_rel, lolow_rel, laup_rel, lalow_rel
+    REAL(r_std) :: area2                                     !! total area of the final grid box 
+    REAL(r_std) :: data_grid                                 !! emissions for the final grid point before being 
+                                                             !! ponderated by area2
+    REAL(r_std) :: data_global                               !! global emissions to check
+    REAL(r_std) :: ax, ay, sgn, surp, ax_file, ay_file
+    REAL(r_std) :: lonrel, louprel, lolowrel
+
+!_ ================================================================================================================================
+
+    !
+    CALL getin_p(filename2,filename)
+    !
+    CALL flininfo(filename,iml, jml, lml, tml, fid)
+    !
+    !
+    ALLOCATE (lat_rel(iml,jml))
+    ALLOCATE (lon_rel(iml,jml))
+    ALLOCATE (laup_rel(iml,jml))
+    ALLOCATE (loup_rel(iml,jml))
+    ALLOCATE (lalow_rel(iml,jml))
+    ALLOCATE (lolow_rel(iml,jml))
+    ALLOCATE (lat_ful(iml+2,jml+2))
+    ALLOCATE (lon_ful(iml+2,jml+2))
+    ALLOCATE (data_year_file(iml,jml))
+    !
+    CALL flinopen(filename, .FALSE., iml, jml, lml, lon_rel, lat_rel, lev, tml, itau, date, dt, fid)
+    !
+    CALL flinget(fid, fieldname, iml, jml, lml, tml, 1, 1, data_year_file)
+    !
+    CALL flinclo(fid)
+    !
+    !
+    WRITE(*,*) 'lon_rel : ', MAXVAL(lon_rel), MINVAL(lon_rel)
+    WRITE(*,*) 'lat_rel : ', MAXVAL(lat_rel), MINVAL(lat_rel)
+    WRITE(*,*) 'data_year_file min,max: ', MINVAL(data_year_file, MASK=data_year_file .GT. 0), &
+         &                      MAXVAL(data_year_file, MASK=data_year_file .LT. undef_sechiba)
+    !
+    nbexp = 0
+    !
+    !    Duplicate the border assuming we have a global grid going from west to east
+    !
+    lon_ful(2:iml+1,2:jml+1) = lon_rel(1:iml,1:jml)
+    lat_ful(2:iml+1,2:jml+1) = lat_rel(1:iml,1:jml)
+    !
+    IF ( lon_rel(iml,1) .LT. lon_ful(2,2)) THEN
+       lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)
+       lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
+    ELSE
+       lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)-360
+       lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
+    ENDIF
+
+    IF ( lon_rel(1,1) .GT. lon_ful(iml+1,2)) THEN
+       lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)
+       lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
+    ELSE
+       lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)+360
+       lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
+    ENDIF
+    !
+    sgn = lat_rel(1,1)/ABS(lat_rel(1,1))
+    lat_ful(2:iml+1,1) = sgn*180 - lat_rel(1:iml,1)
+    sgn = lat_rel(1,jml)/ABS(lat_rel(1,jml))
+    lat_ful(2:iml+1,jml+2) = sgn*180 - lat_rel(1:iml,jml)
+    lat_ful(1,1) = lat_ful(iml+1,1)
+    lat_ful(iml+2,1) = lat_ful(2,1)
+    lat_ful(1,jml+2) = lat_ful(iml+1,jml+2)
+    lat_ful(iml+2,jml+2) = lat_ful(2,jml+2)
+    !
+    ! Add the longitude lines to the top and bottom
+    !
+    lon_ful(:,1) = lon_ful(:,2)
+    lon_ful(:,jml+2) = lon_ful(:,jml+1)
+    !
+    !  Get the upper and lower limits of each grid box
+    !
+    DO ip = 1,iml
+       DO jp = 1,jml
+          loup_rel(ip,jp) =MAX(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)), 0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
+          lolow_rel(ip,jp) =MIN(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)), 0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
+          laup_rel(ip,jp) =MAX(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)), 0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
+          lalow_rel(ip,jp) =MIN(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)), 0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
+       ENDDO
+    ENDDO
+    !
+    !   Now we take each grid point and find out which values from the forcing we need to average
+    !
+    DO ib =1, nbpt
+       !
+       !  We find the 4 limits of the grid-box. As we transform the resolution of the model
+       !  into longitudes and latitudes we do not have the problem of periodicity.
+       ! coslat is a help variable here !
+       !
+       coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+       !
+       lon_up = lalo(ib,2)+ resolution(ib,1)/(2.0*coslat)
+       lon_low =lalo(ib,2) - resolution(ib,1)/(2.0*coslat)
+       !
+       coslat = pi/180. * R_Earth
+       !
+       lat_up =lalo(ib,1)+resolution(ib,2)/(2.0*coslat)
+       lat_low =lalo(ib,1)-resolution(ib,2)/(2.0*coslat)
+       !
+       !
+       !  Find the grid boxes from the data that go into the model's boxes
+       !  We still work as if we had a regular grid ! Well it needs to be localy regular so
+       !  so that the longitude at the latitude of the last found point is close to the one of the next point.
+       !
+       lastjp = 1
+       data_grid = zero
+       area2 = zero
+
+       DO ip = 1,iml
+          !
+          !  Either the center of the data grid point is in the interval of the model grid or
+          !  the East and West limits of the data grid point are on either sides of the border of
+          !  the data grid.
+          !
+          !
+          !  We find the 4 limits of the grid-box. As we transform the resolution of the model
+          !  into longitudes and latitudes we do not have the problem of periodicity.
+          ! coslat is a help variable here !
+          !
+          !
+          !  To do that correctly we have to check if the grid box sits on the date-line.
+          !
+          IF ( lon_low < -180.0 ) THEN
+             lonrel = MOD( lon_rel(ip,lastjp) - 360.0, 360.0)
+             lolowrel = MOD( lolow_rel(ip,lastjp) - 360.0, 360.0)
+             louprel = MOD( loup_rel(ip,lastjp) - 360.0, 360.0)
+             !
+          ELSE IF ( lon_up > 180.0 ) THEN
+             lonrel = MOD( 360. - lon_rel(ip,lastjp), 360.0)
+             lolowrel = MOD( 360. - lolow_rel(ip,lastjp), 360.0)
+             louprel = MOD( 360. - loup_rel(ip,lastjp), 360.0)
+          ELSE
+             lonrel = lon_rel(ip,lastjp)
+             lolowrel = lolow_rel(ip,lastjp)
+             louprel = loup_rel(ip,lastjp)
+          ENDIF
+          !
+          !
+          !
+          IF ( lonrel > lon_low .AND. lonrel < lon_up .OR. &
+               & lolowrel < lon_low .AND.  louprel > lon_low .OR. &
+               & lolowrel < lon_up  .AND.  louprel > lon_up ) THEN
+             ! 
+             DO jp = 1, jml
+                !
+                ! Now that we have the longitude let us find the latitude
+                !
+                IF ( lat_rel(ip,jp) > lat_low .AND. lat_rel(ip,jp) < lat_up .OR. &
+                     & lalow_rel(ip,jp) < lat_low .AND. laup_rel(ip,jp) > lat_low .OR.&
+                     & lalow_rel(ip,jp) < lat_up .AND. laup_rel(ip,jp) > lat_up) THEN
+                   !
+                   lastjp = jp
+                   !
+                   ! Mising values in the file are assumed to be 1e20
+                   !
+                   IF ( lon_low < -180.0 ) THEN
+                      lolowrel = MOD( lolow_rel(ip,jp) - 360.0, 360.0)
+                      louprel = MOD( loup_rel(ip,jp) - 360.0, 360.0)
+                      !
+                   ELSE IF ( lon_up > 180.0 ) THEN
+                      lolowrel = MOD( 360. - lolow_rel(ip,jp), 360.0)
+                      louprel = MOD( 360. - loup_rel(ip,jp), 360.0)
+                   ELSE
+                      lolowrel = lolow_rel(ip,jp)
+                      louprel = loup_rel(ip,jp)
+                   ENDIF
+                   !
+                   ! Get the area of the fine grid in the model grid
+                   !
+                   coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )
+                   ax = (MIN(lon_up,louprel)-MAX(lon_low, lolowrel))*pi/180. * R_Earth * coslat
+                   ay = (MIN(lat_up, laup_rel(ip,jp))-MAX(lat_low,lalow_rel(ip,jp)))*pi/180. * R_Earth
+                   !!to calculate the surface of the initial grid box, ie data one
+                   ax_file = (louprel-lolowrel)*pi/180. * R_Earth * coslat
+                   ay_file = (laup_rel(ip,jp)-lalow_rel(ip,jp))*pi/180. * R_Earth
+                   !
+                   IF (data_year_file(ip,jp) .LT. undef_sechiba-un) THEN
+                      IF(density) THEN
+                         data_grid = data_grid + ax*ay*data_year_file(ip,jp)
+                      ELSE
+                         data_grid = data_grid + ax*ay*(data_year_file(ip,jp)/(ax_file*ay_file))
+                      ENDIF
+                      area2 = area2 + ax*ay
+                   ENDIF
+                   !
+                ENDIF
+                !
+                !
+             ENDDO
+             !
+          ENDIF
+          !
+       ENDDO
+       !
+       ! Put the total data_year areas in the output variables
+       !
+       IF(density) THEN
+          data_year(ib) = data_grid/area2 
+       ELSE
+          data_year(ib) = data_grid
+       ENDIF
+
+
+       IF ( data_year(ib) < 0 ) THEN
+          WRITE(*,*) 'We have a problem here : ', data_year(ib)
+          WRITE(*,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+          WRITE(*,*) area2
+          STOP
+       ENDIF
+       !
+       !!Accumulates emissions (in Kg/year) per grid box to calculate global emissions
+       data_global = data_global + data_grid
+    ENDDO
+    !
+    WRITE(*,*) 'RESULT data_year : ', MINVAL(data_year), MAXVAL(data_year)
+    WRITE(*,*) 'RESULT Global data emissions : ', data_global 
+    !
+
+  END SUBROUTINE diffuco_inca_read
+
+
+END MODULE diffuco
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/enerbil.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/enerbil.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/enerbil.f90	(revision 5166)
@@ -0,0 +1,1886 @@
+!  ==============================================================================================================================
+!  MODULE		 			: enerbil
+!
+!  CONTACT		 			: orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE	 			        : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF					This module computes the energy balance on 
+!! continental surfaces. The module contains the following subroutines: enerbil_main, enerbil_init,
+!! enerbil_clear, enerbil_var_init, enerbil_begin, enerbil_surftemp, enerbil_flux, enerbil_evapveg,
+!! enerbil_fusion and enerbil_t2mdiag
+!!
+!!\n DESCRIPTION                                : 
+!! \n
+!! \latexonly 
+!!     \input{enerbil_intro2.tex}
+!! \endlatexonly
+!!
+!! IMPORTANT NOTE: The coefficients A and B are defined differently than those in the referenced 
+!! literature and from those in the code and documentation of the atmospheric model LMDZ. For the
+!! avoidance of doubt, the coefficients as described here always refer to the ORCHIDEE coefficients, 
+!! and are denoted as such (with the marker: ORC). The re-definition of the coefficients takes place 
+!! within LMDZ before they are passed to ORCHIDEE. The following sequence of expressions is to be 
+!! found within the LMDZ module 'surf_land_orchidee':\n
+!!
+!! \latexonly 
+!!     \input{surflandLMDZ1.tex}
+!!     \input{surflandLMDZ2.tex}
+!!     \input{surflandLMDZ3.tex}
+!!     \input{surflandLMDZ4.tex}
+!! \endlatexonly
+!! \n
+!!
+!! \latexonly 
+!!     \input{enerbil_symbols.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S)                             : None
+!!
+!! REFERENCE(S)	                                : None 
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE enerbil
+
+  ! routines called : restput, restget
+  !
+  ! modules used
+  USE ioipsl
+  USE ioipsl_para 
+  USE constantes
+  USE pft_parameters
+  USE qsat_moisture
+  USE sechiba_io
+
+  ! USE write_field_p, only : WriteFieldI_p  
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: enerbil_main, enerbil_fusion,enerbil_clear
+
+  ! variables used inside enerbil module : declaration and initialisation
+ 
+  LOGICAL, SAVE                              :: l_first_enerbil=.TRUE.  !! Initialisation has to be done one time
+!$OMP THREADPRIVATE(l_first_enerbil)
+  ! one dimension array allocated, computed and used in enerbil module exclusively
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: psold         !! Old surface dry static energy (J kg^{-1})
+!$OMP THREADPRIVATE(psold)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsol_sat      !! Saturated specific humudity for old temperature (kg kg^{-1})
+!$OMP THREADPRIVATE(qsol_sat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pdqsold       !! Deriv. of saturated specific humidity at old temp
+                                                                 !! (kg (kg s)^{-1})
+!$OMP THREADPRIVATE(pdqsold)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: psnew         !! New surface static energy (J kg^{-1})
+!$OMP THREADPRIVATE(psnew)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsol_sat_new  !! New saturated surface air moisture (kg kg^{-1})
+!$OMP THREADPRIVATE(qsol_sat_new)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: netrad        !! Net radiation (W m^{-2})
+!$OMP THREADPRIVATE(netrad)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwabs         !! LW radiation absorbed by the surface (W m^{-2})
+!$OMP THREADPRIVATE(lwabs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwup          !! Long-wave up radiation (W m^{-2})
+!$OMP THREADPRIVATE(lwup)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwnet         !! Net Long-wave radiation (W m^{-2})
+!$OMP THREADPRIVATE(lwnet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: fluxsubli     !! Energy of sublimation (mm day^{-1})
+!$OMP THREADPRIVATE(fluxsubli)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsat_air      !! Air saturated specific humidity (kg kg^{-1})
+!$OMP THREADPRIVATE(qsat_air)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tair          !! Air temperature (K)
+!$OMP THREADPRIVATE(tair)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: q_sol_pot               !! Potential surface humidity
+!$OMP THREADPRIVATE(q_sol_pot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: temp_sol_pot            !! Potential surface temperature (unstressed)
+!$OMP THREADPRIVATE(temp_sol_pot)
+  
+  CONTAINS  
+    
+   
+  !!  ===========================================================================================================================
+  !! SUBROUTINE		 		    : enerbil_main
+  !!
+  !!
+  !>\BRIEF				    Calls each part of the energy budget calculation in sequence 
+  !!
+  !! DESCRIPTION			    : 
+  !! This is the main routine for the 'enerbil' module. It is called
+  !! once during the initialisation of ORCHIDEE, and then once for each time step. It is called a final
+  !! time at the culmination of the last time step, for the writing of a restart file.\n
+  !!
+  !! The algorithm first calls 'enerbil_begin' for initialisation, followed by 'enerbil_surftemp' to
+  !! calculate the surface static energy and the saturated surface humidity for the new time step.
+  !! Next is the module 'enerbil_flux' which calculates the new surface temperature, the net radiation in
+  !! the surface layer, the total evaporation and the latent and sensible heat fluxes. Finally comes
+  !! 'enerbil_evapveg', which calculates the evaporation and transpiration from the vegetation.\n
+
+  !! \n
+  !!
+  !! RECENT CHANGE(S): None
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	: evapot, evapot_corr, temp_sol, qsurf, fluxsens, fluxlat, tsol_rad,
+  !! vevapp, gpp, temp_sol_new, vevapnu, vevapsno, transpir, vevapwet, t2mdiag
+  !!
+  !! REFERENCE(S)		:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available (22/12/11):
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf 
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers\n
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART			:
+  !! \latexonly 
+  !!     \includegraphics[scale=0.5]{enerbil_main_flowchart.png}
+  !! \endlatexonly
+  !! \n
+  !_ ==============================================================================================================================
+   
+  SUBROUTINE enerbil_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, &
+       & index, indexveg, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef, &
+       & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, &
+       & vbetaco2, cimean, ccanopy, emis, soilflx, soilcap, q_cdrag, humrel, fluxsens, fluxlat, &
+       & vevapp, transpir, transpot, gpp, vevapnu, vevapwet, vevapsno, vevapflo, t2mdiag, temp_sol, tsol_rad, &
+       & temp_sol_new, qsurf, evapot, evapot_corr, rest_id, hist_id, hist2_id ) 
+
+    !! 0 Variable and parameter description
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                           :: kjit             !! Time step number (-)
+    INTEGER(i_std), INTENT(in)                           :: kjpindex         !! Domain size (-)
+    INTEGER(i_std),INTENT (in)                           :: rest_id,hist_id  !! _Restart_ file and _history_ file identifier (-)
+    INTEGER(i_std),INTENT (in)                           :: hist2_id         !! _history_ file 2 identifier (-)
+    REAL(r_std), INTENT (in)                             :: dtradia          !! Time (s)
+    LOGICAL, INTENT(in)                                  :: ldrestart_read   !! Logical for _restart_ file to read (-)
+    LOGICAL, INTENT(in)                                  :: ldrestart_write  !! Logical for _restart_ file to write (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: index            !! Indeces of the points on the map (-)
+    INTEGER(i_std),DIMENSION(kjpindex*nvm), INTENT(in)   :: indexveg         !! Indeces of the points on the 3D map
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: zlev             !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: lwdown           !! Down-welling long-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: swnet            !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: epot_air         !! Air potential energy (?? J)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: temp_air         !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: u                !! Eastward Lowest level wind speed  (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: v                !! Northward Lowest level wind speed (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: petAcoef         !! PetAcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: petBcoef         !! PetBcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: qair             !! Lowest level specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: peqAcoef         !! PeqAcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: peqBcoef         !! PeqBcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: pb               !! Lowest level pressure (Pa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: rau              !! Air density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: vbeta            !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: valpha           !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: vbeta1           !! Snow resistance (-) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: vbeta4           !! Bare soil resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: vbeta5           !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: emis             !! Emissivity (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: soilflx          !! Soil flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: soilcap          !! Soil calorific capacity (J K^{-1])
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: q_cdrag          !! Surface drag (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: ccanopy          !! CO_2 concentration in the canopy (ppm)
+    REAL(r_std),DIMENSION (kjpindex, nvm), INTENT (in)   :: humrel           !! Soil moisture stress (within range 0 to 1)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vbeta2           !! Interception resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vbeta3           !! Vegetation resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vbeta3pot        !! Vegetation resistance for potential transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: vbetaco2         !! Vegetation resistance to CO2 (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: cimean           !! mean intercellular ci (from STOMATE) 
+                                                                             !! (\mu mole m^{-2} s^{-1})
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vevapnu          !! Bare soil evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vevapsno         !! Snow evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: vevapflo         !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: transpir         !! Transpiration (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: transpot         !! Potential transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vevapwet         !! Interception (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: t2mdiag          !! Diagnostic temperature at 2m above ground (K)
+    
+    !! 0.3 Modified variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: evapot           !! Soil Potential Evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: evapot_corr      !! Soil Potential Evaporation Correction (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: temp_sol         !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: qsurf            !! Surface specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: fluxsens         !! Sensible heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: fluxlat          !! Latent heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: tsol_rad         !! Tsol_rad (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: vevapp           !! Total of evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: gpp              !! Assimilation ((gC m^{-2}), total area)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: temp_sol_new     !! New soil temperature (K)
+    
+    !! 0.4 Local variables
+    REAL(r_std),DIMENSION (kjpindex)                     :: epot_air_new, qair_new
+    CHARACTER(LEN=80)                                    :: var_name                !! To store variables names for I/O
+
+!_ ================================================================================================================================
+    
+    !! 1. Run the initialisation routines 
+    
+    IF (l_first_enerbil) THEN
+
+        IF (long_print) WRITE (numout,*) ' l_first_enerbil : call enerbil_init '
+        CALL enerbil_init (kjit, ldrestart_read, kjpindex, index, rest_id, qair, temp_sol, temp_sol_new,  &
+             &             qsurf, tsol_rad, vevapp, fluxsens, fluxlat, gpp, evapot, evapot_corr)
+
+        CALL enerbil_var_init (kjpindex, temp_air, t2mdiag)
+
+        RETURN 
+
+    ENDIF
+
+    
+    !! 2. Prepare a restart file for the next simulation
+    
+    IF (ldrestart_write) THEN
+
+        IF (long_print) WRITE (numout,*) ' we have to complete restart file with ENERBIL variables '
+
+        var_name= 'temp_sol'  
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit,  temp_sol, 'scatter',  nbp_glo, index_g)
+
+        var_name= 'qsurf'  
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit,  qsurf, 'scatter',  nbp_glo, index_g)
+
+        var_name= 'evapot'  
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit,  evapot, 'scatter',  nbp_glo, index_g)
+
+        var_name= 'evapot_corr'  
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit,  evapot_corr, 'scatter',  nbp_glo, index_g)
+
+        var_name= 'tsolrad'
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit,  tsol_rad, 'scatter',  nbp_glo, index_g)
+
+        var_name= 'evapora'
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit,  vevapp, 'scatter',  nbp_glo, index_g)
+
+        var_name= 'fluxlat'
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit,  fluxlat, 'scatter',  nbp_glo, index_g)
+
+        var_name= 'fluxsens'
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit,  fluxsens, 'scatter',  nbp_glo, index_g)
+
+        var_name= 'tempsolpot'
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit, temp_sol_pot, 'scatter',  nbp_glo, index_g)
+
+        var_name= 'qsolpot'
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit, q_sol_pot, 'scatter',  nbp_glo, index_g)
+
+        IF ( control%stomate_watchout .OR. control%ok_co2 ) THEN
+
+          ! The gpp could in principle be recalculated at the beginning of the run.
+          ! However, we would need several variables that are not stored in the restart files.
+          var_name= 'gpp'
+          CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, gpp, 'scatter',  nbp_glo, index_g)
+
+        ENDIF
+
+        RETURN 
+
+    END IF
+
+    
+    !! 3. Computes some initialisation variables
+ 
+    !  Computes some initialisation variables psold (the old surface static energy), qsol_sat
+    ! (the saturated surface humidity) and pdqsold (the derivative of the saturated surface humidity,
+    ! calculated with respect to the surface temperature at the 'old' timestep)
+    CALL enerbil_begin (kjpindex, temp_sol, lwdown, swnet, pb, psold, qsol_sat, pdqsold, netrad, emis)
+
+    
+    !! 4. Computes psnew (the surface static energy at the 'new' timestep) 
+    
+    ! Computes psnew (the surface static energy at the 'new' timestep), qsol_sat_new (the surface
+    ! saturated humidity at the 'new' timestep), temp_sol_new (the surface temperature at the 'new'
+    ! timestep), qair_new (the lowest atmospheric humidity at the 'new' timestep) and epot_air_new
+    ! (the lowest atmospheric evaporation potential at the 'new' timestep)
+    CALL enerbil_surftemp (kjpindex, dtradia, zlev, emis, &
+       & epot_air, petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, rau, u, v, q_cdrag, vbeta,&
+       & valpha, vbeta1, vbeta5, soilcap, lwdown, swnet, psnew, qsol_sat_new, temp_sol_new, &
+       & qair_new, epot_air_new)
+
+    ! 2.1 computes surface temperature and humidity for a saturated surface
+    !
+    CALL enerbil_pottemp (kjpindex, dtradia, zlev, emis, &
+       & epot_air, petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, rau, u, v, q_cdrag, vbeta,&
+       & valpha, vbeta1, vbeta5, soilcap, lwdown, swnet, q_sol_pot, temp_sol_pot)
+
+
+    !! 5. Diagnoses components of the energy budget
+    
+    ! Diagnoses lwup (upwards long wave radiation), lwnet (net long wave radiation), tsol_rad (radiative
+    ! ground temperature), netrad (net radiation), qsurf (surface humidity), vevapp (total evaporation),
+    ! evapot (evaporation potential), evapot_corr (evaporation potential correction factor), 
+    ! fluxlat (latent heat flux), fluxsubli (sublimination heat flux) and fluxsens (sensible heat flux).
+
+    CALL enerbil_flux (kjpindex, dtradia, emis, temp_sol, rau, u, v, q_cdrag, vbeta, valpha, vbeta1, vbeta5, &
+       & qair_new, epot_air_new, psnew, qsurf, &
+       & fluxsens , fluxlat , fluxsubli, vevapp, temp_sol_new, lwdown, swnet, &
+       & lwup, lwnet, pb, tsol_rad, netrad, evapot, evapot_corr)
+
+
+    !! 6. Diagnoses the values for evaporation and transpiration 
+    
+    ! Diagnoses the values for evaporation and transpiration: vevapsno (snow evaporation), vevapnu 
+    ! (bare soil evaporation), transpir (transpiration), gpp (assimilation) and vevapwet (interception)
+    CALL enerbil_evapveg (kjpindex, dtradia, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, vbetaco2, &
+       & cimean, ccanopy, rau, u, v, q_cdrag, qair_new, humrel, vevapsno, vevapnu , vevapflo, vevapwet, &
+       & transpir, transpot, gpp, evapot)
+
+    
+    !! 7. Assigns a temperature 2 metres above the ground 
+
+    ! Assigns a temperature 2 metres above the ground. The output variable - t2mdiag, is used just for
+    ! diagnostic purposes, for now.
+    CALL enerbil_t2mdiag (kjpindex, temp_air, t2mdiag)
+
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'netrad', kjit, netrad, kjpindex, index)
+       CALL histwrite_p(hist_id, 'evapot', kjit, evapot, kjpindex, index)
+       CALL histwrite_p(hist_id, 'evapot_corr', kjit, evapot_corr, kjpindex, index)
+       CALL histwrite_p(hist_id, 'lwdown', kjit, lwabs,  kjpindex, index)
+       CALL histwrite_p(hist_id, 'lwnet',  kjit, lwnet,  kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'netrad', kjit, netrad, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'evapot', kjit, evapot, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'evapot_corr', kjit, evapot_corr, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'lwdown', kjit, lwabs,  kjpindex, index)
+          CALL histwrite_p(hist2_id, 'lwnet',  kjit, lwnet,  kjpindex, index)
+       ENDIF
+    ELSE
+       CALL histwrite_p(hist_id, 'LWnet', kjit, lwnet, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Qv', kjit, fluxsubli, kjpindex, index)
+       CALL histwrite_p(hist_id, 'PotEvap', kjit, evapot_corr, kjpindex, index)
+       CALL histwrite_p(hist_id, 'PotEvapOld', kjit, evapot, kjpindex, index)
+       CALL histwrite_p(hist_id, 'PotSurfT', kjit, temp_sol_pot, kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'LWnet', kjit, lwnet, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qv', kjit, fluxsubli, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'PotEvap', kjit, evapot_corr, kjpindex, index)
+       ENDIF
+    ENDIF
+
+    IF (long_print) WRITE (numout,*) ' enerbil_main Done '
+
+  END SUBROUTINE enerbil_main
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : enerbil_init
+  !!
+  !>\BRIEF			            Performs dynamic allocation for local arrays, and retrieves
+  !! previous data from restart file (if the switch is set to do so)
+  !!
+  !! DESCRIPTION			    : The purpose of this module is, firstly, to allocate space
+  !! in memory for key variables within the 'enerbil' module. The second task is to retrieve previous data
+  !! from the restart file, if the 'ldrestart-read' flag is set.
+  !!
+  !! RECENT CHANGE(S)			    : None
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	            : temp_sol, temp_sol_new, qsurf, tsol_rad, vevapp, fluxsens,
+  !! fluxlat, gpp, evapot, evapot_corr
+  !!
+  !! REFERENCE(S)			    : None
+  !! 
+  !! FLOWCHART                              : None
+  !! \n
+  !_ ==============================================================================================================================
+  
+  SUBROUTINE enerbil_init (kjit, ldrestart_read, kjpindex, index, rest_id, qair, temp_sol, temp_sol_new, &
+       &                   qsurf, tsol_rad, vevapp, fluxsens, fluxlat, gpp, evapot, evapot_corr)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+  
+    INTEGER(i_std), INTENT (in)                              :: kjit               !! Time step number (-) 
+    LOGICAL ,INTENT (in)                                     :: ldrestart_read     !! Logical for _restart_ file to read (-)
+    INTEGER(i_std), INTENT (in)                              :: kjpindex           !! Domain size (-)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: index              !! Indeces of the points on the map (-)
+    INTEGER(i_std), INTENT (in)                              :: rest_id            !! _Restart_ file identifier (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair               !! Lowest level specific humidity (kg kg^{-1})
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: temp_sol           !! Ground temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: temp_sol_new       !! New ground temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qsurf              !! Near surface specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: tsol_rad           !! Tsol_rad (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: vevapp             !! Total of evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxsens           !! Sensible heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxlat            !! Latent heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: gpp                !! Assimilation, (gC m^{-2}, total area)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: evapot             !! Soil Potential Evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: evapot_corr        !! Soil Potential Evaporation Correction 
+                                                                                   !! (mm day^{-1})
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ier
+    CHARACTER(LEN=80)                                        :: var_name            !! To store variables names for I/O
+
+!_ ================================================================================================================================
+
+  !! 1 Initialisation of variables
+ 
+    !! Initialisation of variables psold (old surface static energy), qsol_sat (saturated surface air moisture), pdqsold
+    !! (derivative of satured specific humidity at the old temperature), psnew (new surface static energy), qsol_sat_new
+    !! (new saturated surface air moisture), netrad (net radiation), lwabs (long wave absolute radiation), lwup (long wave
+    !! (upwelling radiation), lwnet (long wave net radiation), fluxsubli (sublimination flux), qsat_air (saturated air humidity)
+    !! and tair (air temperature).
+    IF (l_first_enerbil) THEN 
+        l_first_enerbil=.FALSE.
+    ELSE 
+        WRITE (numout,*) ' l_first_enerbil false . we stop '
+        STOP 'enerbil_init'
+    ENDIF
+
+    ALLOCATE (psold(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in psold allocation. We stop.We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+    ALLOCATE (qsol_sat(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in qsol_sat allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+    ALLOCATE (pdqsold(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in pdqsold allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+    ALLOCATE (psnew(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in psnew allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+    ALLOCATE (qsol_sat_new(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in qsol_sat_new allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+    ALLOCATE (netrad(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in netrad allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+    ALLOCATE (lwabs(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in lwabs allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+    ALLOCATE (lwup(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in lwup allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+    ALLOCATE (lwnet(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in lwnet allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+    ALLOCATE (fluxsubli(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in fluxsubli allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+    ALLOCATE (qsat_air(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in qsat_air allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+    ALLOCATE (tair(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in tair allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+
+    ALLOCATE (q_sol_pot(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in q_sol_pot allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+    ALLOCATE (temp_sol_pot(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in temp_sol_pot allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'enerbil_init'
+    END IF
+
+
+  !! 2. Open restart input file and read data from the restart input file
+
+    !! Open restart input file done by enerbil_init and read data from the restart input file
+    !! that corresponds to processes within the 'enerbil' module (if the 'ldrestart_read' flag is set).\n
+    !! The variables read are: temp_sol (surface temperature), qsurf (near surface specific humidity),
+    !! evapot (soil potential evaporation), evapot_corr (corrected soil potential evaporation), tsolrad
+    !! (radiative surface temperature), evapora (evaporation), fluxlat (latent heat flux), fluxsens
+    !! (sensible heat flux), gpp (gross primary productivity) and temp_sol_new (new surface temperature).
+    IF (ldrestart_read) THEN
+
+        IF (long_print) WRITE (numout,*) ' we have to read a restart file for ENERBIL variables'
+
+        var_name='temp_sol'
+        CALL ioconf_setatt_p('UNITS', 'K')
+        CALL ioconf_setatt_p('LONG_NAME','Surface temperature')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., temp_sol, "gather", nbp_glo, index_g)
+
+        IF ( MINVAL(temp_sol) < 0. .OR. MAXVAL(temp_sol) > 500.) THEN
+           WRITE(numout, *) "Big problem with surface temperature at restart : ",  MINVAL(temp_sol), MAXVAL(temp_sol)
+           WHERE ( temp_sol < 0.) temp_sol = 280.
+        ENDIF
+
+        !
+        !Config Key   = ENERBIL_TSURF
+        !Config Desc  = Initial temperature if not found in restart
+        !Config If    = OK_SECHIBA
+        !Config Def   = 280.
+        !Config Help  = The initial value of surface temperature if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = Kelvin [K]
+        CALL setvar_p (temp_sol, val_exp,'ENERBIL_TSURF', 280._r_std)
+        
+        var_name= 'qsurf'
+        CALL ioconf_setatt_p('UNITS', 'g/g')
+        CALL ioconf_setatt_p('LONG_NAME','near surface specific humidity')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., qsurf, "gather", nbp_glo, index_g)
+        IF ( ALL( qsurf(:) .EQ. val_exp ) ) THEN 
+           qsurf(:) = qair(:)
+        ENDIF
+        
+        var_name= 'evapot'
+        CALL ioconf_setatt_p('UNITS', 'mm day^{-1}')
+        CALL ioconf_setatt_p('LONG_NAME','Soil Potential Evaporation')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., evapot, "gather", nbp_glo, index_g)
+        CALL setvar_p (evapot, val_exp, 'ENERBIL_EVAPOT', zero)
+        
+        var_name= 'evapot_corr'
+        CALL ioconf_setatt_p('UNITS', 'mm day^{-1}')
+        CALL ioconf_setatt_p('LONG_NAME','Corrected Soil Potential Evaporation')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., evapot_corr, "gather", nbp_glo, index_g)
+        
+        !Config Key   = ENERBIL_EVAPOT
+        !Config Desc  = Initial Soil Potential Evaporation
+        !Config If    = OK_SECHIBA       
+        !Config Def   = 0.0
+        !Config Help  = The initial value of soil potential evaporation if its value 
+        !Config         is not found in the restart file. This should only be used if
+        !Config         the model is started without a restart file. 
+        !Config Units = 
+        CALL setvar_p (evapot_corr, val_exp, 'ENERBIL_EVAPOT', zero)
+                
+        var_name= 'tsolrad'
+        CALL ioconf_setatt_p('UNITS', 'K')
+        CALL ioconf_setatt_p('LONG_NAME','Radiative surface temperature')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tsol_rad, "gather", nbp_glo, index_g)
+        IF ( ALL( tsol_rad(:) .EQ. val_exp ) ) THEN 
+           tsol_rad(:) = temp_sol(:)
+        ENDIF
+        
+        !! 1.3 Set the fluxes so that we have something reasonable and not NaN on some machines
+        var_name= 'evapora'
+        CALL ioconf_setatt_p('UNITS', 'Kg/m^2/dt')
+        CALL ioconf_setatt_p('LONG_NAME','Evaporation')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., vevapp, "gather", nbp_glo, index_g)
+        IF ( ALL( vevapp(:) .EQ. val_exp ) ) THEN 
+           vevapp(:) = zero
+        ENDIF
+        
+        var_name= 'fluxlat'
+        CALL ioconf_setatt_p('UNITS', 'W/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Latent heat flux')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., fluxlat, "gather", nbp_glo, index_g)
+        IF ( ALL( fluxlat(:) .EQ. val_exp ) ) THEN 
+           fluxlat(:) = zero
+        ENDIF
+        
+        var_name= 'fluxsens'
+        CALL ioconf_setatt_p('UNITS', 'W/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Sensible heat flux')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., fluxsens, "gather", nbp_glo, index_g)
+        IF ( ALL( fluxsens(:) .EQ. val_exp ) ) THEN 
+           fluxsens(:) = zero
+        ENDIF
+        
+        var_name= 'tempsolpot'
+        CALL ioconf_setatt_p('UNITS', 'K')
+        CALL ioconf_setatt_p('LONG_NAME','Potential surface temperature')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., temp_sol_pot, "gather", nbp_glo, index_g)
+        IF ( ALL( temp_sol_pot(:) .EQ. val_exp ) ) THEN 
+           temp_sol_pot = temp_sol
+        ENDIF
+        !
+        var_name= 'qsolpot'
+        CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Potential saturated surface humidity')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., q_sol_pot, "gather", nbp_glo, index_g)
+        IF ( ALL( q_sol_pot(:) .EQ. val_exp ) ) THEN 
+           q_sol_pot = qsurf
+        ENDIF
+
+        !
+        ! If we are with STOMATE
+        IF ( control%stomate_watchout .OR. control%ok_co2 ) THEN
+
+          ! The gpp could in principle be recalculated at the beginning of the run.
+          ! However, we would need several variables that are not stored in the restart files.
+          var_name= 'gpp'
+          CALL ioconf_setatt_p('UNITS', 'gC/m**2/time step')
+          CALL ioconf_setatt_p('LONG_NAME','Gross primary productivity')
+          CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., gpp, "gather", nbp_glo, index_g)
+
+          IF ( ALL( gpp(:,:) .EQ. val_exp ) ) THEN
+             gpp(:,:) = zero
+          ENDIF
+
+        ENDIF
+
+        ! initialises temp_sol_new saved in thermosoil
+        var_name='temp_sol_new'
+        CALL ioconf_setatt_p('UNITS', 'K')
+        CALL ioconf_setatt_p('LONG_NAME','New Surface temperature')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., temp_sol_new, "gather", nbp_glo, index_g)
+        IF ( ALL( temp_sol_new(:) .EQ. val_exp ) ) THEN
+           ! Variables not found in restart file.
+           temp_sol_new(:) = temp_sol(:)
+        ENDIF
+        
+    ELSE
+
+       ! initialises temp_sol_new 
+       temp_sol_new(:) = temp_sol(:)
+    ENDIF
+
+    IF (long_print) WRITE (numout,*) ' enerbil_init done '
+
+  END SUBROUTINE enerbil_init
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 		    : enerbil_clear
+  !!
+  !>\BRIEF				    Routine deallocates clear output variables if already allocated.
+  !!
+  !! DESCRIPTION			    : This is a 'housekeeping' routine that deallocates the key output
+  !! variables, if they have already been allocated. The variables that are deallocated are psold,
+  !! qsol_sat, pdqsold, psnew, qsol_sat_new, netrad, lwabs, lwup, lwnet, fluxsubli, qsat_air, tair
+  !!
+  !! RECENT CHANGE(S)			    : None
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	            : None
+  !!
+  !! REFERENCES				    : None
+  !! 
+  !! FLOWCHART                              : None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_clear ()
+    l_first_enerbil=.TRUE.
+    IF ( ALLOCATED (psold)) DEALLOCATE (psold)
+    IF ( ALLOCATED (qsol_sat)) DEALLOCATE (qsol_sat)
+    IF ( ALLOCATED (pdqsold)) DEALLOCATE (pdqsold)
+    IF ( ALLOCATED (psnew)) DEALLOCATE (psnew)
+    IF ( ALLOCATED (qsol_sat_new)) DEALLOCATE (qsol_sat_new)
+    IF ( ALLOCATED (netrad)) DEALLOCATE (netrad)
+    IF ( ALLOCATED (lwabs)) DEALLOCATE (lwabs)
+    IF ( ALLOCATED (lwup)) DEALLOCATE (lwup)
+    IF ( ALLOCATED (lwnet)) DEALLOCATE (lwnet)
+    IF ( ALLOCATED (fluxsubli)) DEALLOCATE (fluxsubli)
+    IF ( ALLOCATED (qsat_air)) DEALLOCATE (qsat_air)
+    IF ( ALLOCATED (tair)) DEALLOCATE (tair)
+    IF ( ALLOCATED (q_sol_pot)) DEALLOCATE (q_sol_pot)
+    IF ( ALLOCATED (temp_sol_pot)) DEALLOCATE (temp_sol_pot)
+   
+   ! ??open restart input file done by enerbil_init
+   ! and read data from restart input file for ENERBIL process??
+ 
+  END SUBROUTINE enerbil_clear
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_var_init
+  !!
+  !>\BRIEF					Housekeeping routine that calls enerbil_t2mdiag.
+  !!
+  !! DESCRIPTION				: Housekeeping routine that calls the 2 metre temperature
+  !! diagnostic subroutine 'enerbil_2tmdiag'.
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	                : t2mdiag
+  !!
+  !! REFERENCE(S)				: None
+  !!
+  !! FLOWCHART                                  : None
+  !! \n
+  !_ ==============================================================================================================================
+ 
+  SUBROUTINE enerbil_var_init (kjpindex, temp_air, t2mdiag)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex       !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_air       !! Air temperature (K)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Output fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: t2mdiag        !! Temperature at 2 metres above ground(K)
+!_ ================================================================================================================================
+
+    CALL enerbil_t2mdiag (kjpindex, temp_air, t2mdiag)
+
+    IF (long_print) WRITE (numout,*) ' enerbil_var_init done '
+
+  END SUBROUTINE enerbil_var_init
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_begin
+  !!
+  !>\BRIEF					Preliminary variables required for the calculation of
+  !! the energy budget are derived.
+  !!
+  !! DESCRIPTION				: This routines computes preliminary variables required
+  !! for the calculation of the energy budget: the old surface static energy (psold), the surface saturation
+  !! humidity (qsol_sat), the derivative of satured specific humidity at the old temperature (pdqsold) 
+  !! and the net radiation (netrad).
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	                : psold, qsol_sat, pdqsold, netrad
+  !!
+  !! REFERENCE(S)				:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers\n
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART  : None                     
+  !! \n
+  !_ ==============================================================================================================================
+  
+  SUBROUTINE enerbil_begin (kjpindex, temp_sol, lwdown, swnet, pb, psold, qsol_sat, pdqsold, netrad, emis)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_sol         !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: lwdown           !! Down-welling long-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: swnet            !! Net surface short-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: pb               !! Lowest level pressure (Pa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: emis             !! Emissivity (-)
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: psold            !! Old surface dry static energy (J kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: qsol_sat	   !! Saturated specific humudity for old temperature 
+                                                                           !! (kg kg^{-1})    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: pdqsold	   !! Derivative of satured specific humidity at the old 
+                                                                           !! temperature (kg (kg s)^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: netrad           !! Net radiation (W m^{-2})
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ji
+    REAL(r_std), DIMENSION(kjpindex)                   :: dev_qsol
+    REAL(r_std), PARAMETER                             :: missing = 999998.
+!_ ================================================================================================================================
+  
+  !! 1. Computes psold (the surface static energy for the old timestep)
+   
+    !! We here define the surface static energy for the 'old' timestep, in terms of the surface
+    !! temperature and heat capacity.
+    !! \latexonly 
+    !!     \input{enerbilbegin1.tex}
+    !! \endlatexonly
+    psold(:) = temp_sol(:)*cp_air
+    
+  !! 2. Computes qsol_sat (the surface saturated humidity).
+ 
+    !! We call the routine 'qsatcalc' from within the module 'src_parameters/constantes_veg'.
+    CALL qsatcalc (kjpindex, temp_sol, pb, qsol_sat)
+
+    IF ( diag_qsat ) THEN
+      IF ( ANY(ABS(qsol_sat(:)) .GT. missing) ) THEN
+        DO ji = 1, kjpindex
+          IF ( ABS(qsol_sat(ji)) .GT. missing) THEN
+            WRITE(numout,*) 'ERROR on ji = ', ji
+            WRITE(numout,*) 'temp_sol(ji),  pb(ji) :', temp_sol(ji),  pb(ji)
+            CALL ipslerr_p (3,'enerbil_begin', &
+ &           'qsol too high ','','')
+          ENDIF
+        ENDDO
+      ENDIF
+    ENDIF
+    
+  !! 3. Computes pdqsold 
+    
+    !! Computes pdqsold (the derivative of the saturated humidity with respect to temperature
+    !! analysed at the surface temperature at the 'old' timestep.
+    !! We call the routine 'dev_qsatcalc' from within the module 'src_parameters/constantes_veg'.
+    CALL dev_qsatcalc (kjpindex, temp_sol, pb, dev_qsol)
+    
+    DO ji = 1, kjpindex
+    
+    !! \latexonly 
+    !!     \input{enerbilbegin2.tex}
+    !! \endlatexonly
+      pdqsold(ji) = dev_qsol(ji) * ( pb(ji)**kappa ) / cp_air
+    ENDDO
+
+    IF ( diag_qsat ) THEN
+      IF ( ANY(ABS( pdqsold(:)) .GT. missing) ) THEN
+        DO ji = 1, kjpindex
+          IF ( ABS( pdqsold(ji)) .GT. missing ) THEN
+            WRITE(numout,*) 'ERROR on ji = ', ji
+            WRITE(numout,*) 'temp_sol(ji),  pb(ji) :', temp_sol(ji),  pb(ji)
+            CALL ipslerr_p (3,'enerbil_begin', &
+ &           'pdqsold too high ','','')
+          ENDIF
+        ENDDO
+      ENDIF
+    ENDIF
+
+  !! 4. Computes the net radiation and the absorbed LW radiation absorbed at the surface. 
+
+    !! Long wave radiation absorbed by the surface is the product of emissivity and downwelling LW radiation    
+    !! \latexonly 
+    !!     \input{enerbilbegin3.tex}
+    !! \endlatexonly
+    lwabs(:) = emis(:) * lwdown(:)
+
+    !! Net radiation is calculated as:
+    !! \latexonly 
+    !!     \input{enerbilbegin4.tex}
+    !! \endlatexonly
+    netrad(:) = lwdown(:) + swnet (:) - (emis(:) * c_stefan * temp_sol(:)**4 + (un - emis(:)) * lwdown(:)) 
+    !
+    IF (long_print) WRITE (numout,*) ' enerbil_begin done '
+
+  END SUBROUTINE enerbil_begin
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_surftemp
+  !!
+  !>\BRIEF					This routine computes the new surface static energy
+  !! (psnew) and the saturated humidity at the surface (qsol_sat_new). 
+  !!
+  !! DESCRIPTION				: This is the key part of the enerbil module, for which
+  !! the energy budget in the surface layer is solved and changes over the model timestep 'dtradia' are
+  !! quantified for the surface static energy, surface temperature, surface humidity, the 'air' (or lowest
+  !! level atmospheric model) temperature, the 'air' (or lowest level atmospheric model) humidity, 
+  !! according to the method that is laid out by Dufresne \& Ghattas (2009) and Shultz et al. (2001).
+  !!
+  !! It computes the energy balance at the surface with an implicit scheme, that is connected to the 
+  !! Richtmyer and Morton algorithm of the PBL. By computing the surface temperature and surface humidity 
+  !! the routine also implicitly estimates the various fluxes which balance in order to give the new 
+  !! temperature. Thus once the surface temperature has been obtained all the fluxes need to be diagnosed. 
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	: psnew, qsol_sat_new, temp_sol_new, qair_new, epot_air_new
+  !!
+  !! REFERENCE(S)					:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available (22/12/11):
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pd 
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART    : None
+  !!
+  !_ ==============================================================================================================================  
+  
+
+  SUBROUTINE enerbil_surftemp (kjpindex, dtradia, zlev, emis, epot_air, &
+     & petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, rau, u, v, q_cdrag, vbeta,&
+     & valpha, vbeta1, vbeta5, soilcap, lwdown, swnet, psnew, qsol_sat_new, temp_sol_new, &
+     & qair_new, epot_air_new) 
+
+
+    !! 0. Variable and parameter declaration 
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size (-)
+    REAL(r_std), INTENT(in)                                  :: dtradia       !! Time step (s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: zlev          !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: emis          !! Emissivity (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air      !! Air potential energy (?? J)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef      !! PetAcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef      !! PetBcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair          !! Lowest level specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef      !! PeqAcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef      !! PeqBcoef (see note)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilflx       !! Soil flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau           !! Air density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u, v          !! Wind velocity by directional components 
+                                                                              !! u (Eastwards) and v (Northwards) (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag       !! Surface drag (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta         !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: valpha        !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta1        !! Snow resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta5        !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilcap       !! Soil calorific capacity (J K^{-1])
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown        !! Down-welling long-wave flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet         !! Net surface short-wave flux (W m^{-2})
+ 
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: psnew         !! New surface static energy (J kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qsol_sat_new  !! New saturated surface air moisture (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: temp_sol_new  !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qair_new      !! New air moisture (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: epot_air_new  !! New air temperature (K)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                   :: ji
+    REAL(r_std),DIMENSION (kjpindex) :: zicp
+    REAL(r_std)                      :: fevap
+    REAL(r_std)                      :: sensfl_old, larsub_old, lareva_old, dtheta, sum_old, sum_sns
+    REAL(r_std)                      :: zikt, zikq, netrad_sns, sensfl_sns, larsub_sns, lareva_sns
+    REAL(r_std)                      :: speed
+!_ ================================================================================================================================
+    
+    zicp = un / cp_air
+    
+    DO ji=1,kjpindex
+     
+     
+    !! 1. Derivation of auxiliary variables
+      
+      !! \latexonly 
+      !!     \input{enerbilsurftemp1.tex}
+      !! \endlatexonly
+      speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+      !
+      !! \latexonly 
+      !!     \input{enerbilsurftemp2.tex}
+      !! \endlatexonly
+      zikt = 1/(rau(ji) * speed * q_cdrag(ji))
+      zikq = 1/(rau(ji) * speed * q_cdrag(ji))
+      
+    !! 2. Computation of fluxes for the old surface conditions
+     
+      !! As a reference, we first calculate the sensible and latent heat for the 'old' timestep.
+ 
+      !! 2.1 Sensible heat for the 'old' timestep
+      !! This is equation (64) of (Dufresne & Ghattas, 2009), rewritten in terms of H_old. We make the 
+      !! approximation that (P_r/P)^{kappa}=1 and convert the A and B coefficients to the ORCHIDEE
+      !! format (see introductory note, above). Also, the equation here is in terms of surface static
+      !! energy, which is defined as per section 3.1, above.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp3.tex}
+      !! \endlatexonly
+      sensfl_old = (petBcoef(ji) -  psold(ji)) / (zikt -  petAcoef(ji))
+      !! 2.2 Latent heat for the 'old' timestep
+      !! This is equation (70) of (Dufresne & Ghattas, 2009), rewritten in terms of {\lambda E}_{old}.
+      !! Again we convert the A and B coefficients from the LMDZ format to the ORCHIDEE format.\n
+      !! There are two forms of the equation - first for the latent heat as a result of sublimination
+      !! processes and then as a result of evaporative processes:
+      !! \latexonly 
+      !!     \input{enerbilsurftemp4.tex}
+      !! \endlatexonly
+      larsub_old = chalsu0 * vbeta1(ji) * (un - vbeta5(ji)) * (peqBcoef(ji) -  qsol_sat(ji)) / (zikq - peqAcoef(ji))
+
+      !! \latexonly 
+      !!     \input{enerbilsurftemp5.tex}
+      !! \endlatexonly
+      lareva_old = chalev0 * (un - vbeta1(ji)) * (un - vbeta5(ji)) * vbeta(ji) * &
+           & (peqBcoef(ji) -  valpha(ji) * qsol_sat(ji)) / (zikq - peqAcoef(ji)) &
+           & + chalev0 * vbeta5(ji) * (peqBcoef(ji) -  qsol_sat(ji)) / (zikq - peqAcoef(ji))
+      
+    !! 3. Calculation of sensitivity terms
+     
+      !! We here calculate the sensitivity for the different fluxes to changes in dtheta, which is the
+      !! change in the surface static energy over the model time step (dtradia).
+      
+      !! 3.1 Net radiation sensitivity
+      !! This is an explicit-implicit representation of the Stefan-Boltzmann law - the explicit terms 
+      !! are ${ps}_{old}^3$, and it is completed when multiplied by dtheta (defined above).
+      !! \latexonly 
+      !!     \input{enerbilsurftemp6.tex}
+      !! \endlatexonly
+      netrad_sns = zicp(ji) * quatre * emis(ji) * c_stefan * ((zicp(ji) * psold(ji))**3)
+      
+      !! 3.2 Sensible heat flux sensitivity
+      !! This is the temperature sensitivity term N_1^h derived in equation (66) of (Dufresne & Ghattas, 2009),
+      !! where we again assume that (P_r/P)^{kappa}=1, convert the A and B coefficients to the ORCHIDEE format,
+      !! and rewrite in terms of surface static energy, rather than temperature (see section 3.1, above).
+      !! \latexonly 
+      !!     \input{enerbilsurftemp7.tex}
+      !! \endlatexonly
+      sensfl_sns = un / (zikt -  petAcoef(ji))
+      !! 3.3 Latent heat flux sensitivity 
+      !! This is the humidity sensitivity term N_1^q derived in equation (72) of (Dufresne & Ghattas, 2009), where
+      !! the A and B coefficients are written in the ORCHIDEE format.
+      !! larsub_sns is the latent heat sensitivity for sublimination. The coefficient vbeta1 is the evaporation
+      !! coefficient. It represents the relationship between the real and potential evaporation. It is derived
+      !! in the module 'src_sechiba/diffuco_snow'.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp8.tex}
+      !! \endlatexonly
+      larsub_sns = chalsu0 * vbeta1(ji) * (un - vbeta5(ji)) * zicp(ji) * pdqsold(ji) / (zikq - peqAcoef(ji))
+
+      !! lareva_sns is the latent heat sensitivity for evaporation. vbeta1 (src_sechiba/diffuco_snow), 
+      !! vbeta (src_sechiba/diffuco_comb) and valpha (src_sechiba/diffuco_comb) are the evaporation
+      !! coefficients.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp9.tex}
+      !! \endlatexonly
+      lareva_sns = chalev0 * ((un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) * valpha(ji) + vbeta5(ji)) * &
+           & zicp(ji) * pdqsold(ji) / (zikq - peqAcoef(ji))
+      
+    !! 4. Solution of the energy balance
+      
+      !! 4.1 We calculate the total flux for the 'old' timestep.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp10.tex}
+      !! \endlatexonly
+      sum_old = netrad(ji) + sensfl_old + larsub_old + lareva_old + soilflx(ji)
+     
+      !! 4.2 We calculate the total sensitivity dtheta (the change in the
+      !! surface static energy over the timestep.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp11.tex}
+      !! \endlatexonly
+      sum_sns = netrad_sns + sensfl_sns + larsub_sns + lareva_sns
+    
+      !! 4.3 Calculation of dtheta (change in surface static energy over the
+      !! timestep.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp12.tex}
+      !! \endlatexonly
+      dtheta = dtradia * sum_old / (zicp(ji) * soilcap(ji) + dtradia * sum_sns)
+      
+      !! 4.4 Determination of state variables for the 'new' timestep
+      !! No we have dtheta, we can determine the surface static energy that
+      !! corresponds to the 'new' timestep.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp13.tex}
+      !! \endlatexonly
+      psnew(ji) =  psold(ji) + dtheta
+      
+      !! The new surface saturated humidity can be calculated by equation (69)
+      !! of (Dufresne & Ghattas, 2009), in which we substitute dtheta for the
+      !! change between old and new temperature using the relationship from 3.1,
+      !! above.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp14.tex}
+      !! \endlatexonly
+      qsol_sat_new(ji) = qsol_sat(ji) + zicp(ji) * pdqsold(ji) * dtheta
+      
+      !! The new surface temperature is determined from the new surface static temperature,
+      !! again by using the relationship in section 3.1.
+      !! \latexonly 
+      !!     \input{enerbilsurftemp15.tex}
+      !! \endlatexonly
+      temp_sol_new(ji) = psnew(ji) / cp_air
+      
+      !! 4.5 Calculation of new evaporation potential and new evaporation latent heat
+      !! flux (???)
+      !! \latexonly 
+      !!     \input{enerbilsurftemp16.tex}
+      !! \endlatexonly
+      epot_air_new(ji) = zikt * (sensfl_old - sensfl_sns * dtheta) + psnew(ji)
+      
+      !! \latexonly 
+      !!     \input{enerbilsurftemp17.tex}
+      !! \endlatexonly
+      fevap = (lareva_old - lareva_sns * dtheta) + (larsub_old - larsub_sns * dtheta)
+
+      IF ( ABS(fevap) < EPSILON(un) ) THEN
+        
+        !! \latexonly 
+        !!     \input{enerbilsurftemp18.tex}
+        !! \endlatexonly
+        qair_new(ji) = qair(ji)
+      ELSE
+        !! \latexonly 
+        !!     \input{enerbilsurftemp19.tex}
+        !! \endlatexonly     
+        qair_new(ji) = zikq * un / ( chalsu0 *  vbeta1(ji) * (un - vbeta5(ji)) + &
+           & chalev0 * ((un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) * valpha(ji) + vbeta5(ji)) ) &
+           & * fevap + qsol_sat_new(ji)
+      ENDIF
+      
+    ENDDO
+
+    IF (long_print) WRITE (numout,*) ' enerbil_surftemp done '
+
+  END SUBROUTINE enerbil_surftemp
+
+
+ !! =============================================================================================================================
+ !! SUBROUTINE		 			: enerbil_pottemp
+ !!
+ !>\BRIEF		This subroutine computes the surface temperature and humidity should the surface been unstressed	
+ !!
+ !! DESCRIPTION				: 
+ !!
+ !! MAIN OUTPUT VARIABLE(S)	: 
+ !!
+ !! REFERENCE(S)		:
+ !!
+ !! FLOWCHART    : None
+ !!
+ !_ ==============================================================================================================================  
+
+  SUBROUTINE enerbil_pottemp (kjpindex, dtradia, zlev, emis, epot_air, &
+     & petAcoef, petBcoef, qair, peqAcoef, peqBcoef, soilflx, rau, u, v, q_cdrag, vbeta,&
+     & valpha, vbeta1, vbeta5, soilcap, lwdown, swnet, q_sol_pot, temp_sol_pot) 
+
+    ! interface 
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size
+    REAL(r_std), INTENT(in)                                  :: dtradia       !! Time step in seconds
+    ! input fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: zlev          !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: emis          !! Emissivity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air      !! Air potential energy
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef      !! PetAcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef      !! PetBcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair          !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef      !! PeqAcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef      !! PeqBcoef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilflx       !! Soil flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau           !! Density
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u, v          !! Wind
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag       !!
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta         !! Resistance coefficient
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: valpha        !! Resistance coefficient
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta1        !! Snow resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta5        !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilcap       !! Soil calorific capacity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown        !! Down-welling long-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet         !! Net surface short-wave flux
+    ! output fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: q_sol_pot     !! Potential surface air moisture
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: temp_sol_pot  !! Potential soil temperature
+
+
+    ! local declaration
+    INTEGER(i_std)                  :: ji
+    REAL(r_std),DIMENSION (kjpindex) :: zicp
+    REAL(r_std)                      :: fevap
+    REAL(r_std)                      :: sensfl_old, larsub_old, lareva_old, dtheta, sum_old, sum_sns
+    REAL(r_std)                      :: zikt, zikq, netrad_sns, sensfl_sns, larsub_sns, lareva_sns
+    REAL(r_std)                      :: speed
+
+!_ ==============================================================================================================================
+
+    zicp = un / cp_air
+    !
+    DO ji=1,kjpindex
+
+       dtheta = zero
+       fevap = zero
+
+       temp_sol_pot(ji) = temp_sol_pot(ji) + dtheta
+
+       q_sol_pot(ji) = q_sol_pot(ji) + fevap
+
+    ENDDO
+
+  END SUBROUTINE enerbil_pottemp
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_flux
+  !!
+  !>\BRIEF					Computes the new soil temperature, net radiation and
+  !! latent and sensible heat flux for the new time step.
+  !!
+  !! DESCRIPTION				: This routine diagnoses, based on the new soil temperature, 
+  !! the net radiation, the total evaporation, the latent heat flux, the sensible heat flux and the 
+  !! sublimination flux. It also diagnoses the potential evaporation used for the fluxes (evapot) and the potential
+  !! as defined by Penman & Monteith (Monteith, 1965) based on the correction term developed by Chris 
+  !! Milly (1992). This Penman-Monteith formulation is required for the estimation of bare soil evaporation 
+  !! when the 11 layer CWRR moisture scheme is used for the soil hydrology.
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	: qsurf, fluxsens, fluxlat, fluxsubli, vevapp, lwup, lwnet,
+  !! tsol_rad, netrad, evapot, evapot_corr
+  !!
+  !! REFERENCE(S)					:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available (22/12/11):
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+  !! - Monteith, JL, 1965. Evaporation and Environment, paper presented at Symposium of the Society
+  !! for Experimental Biology
+  !! - Monteith & Unsworth, 2008. Principles of Environmental Physics (third edition), published Elsevier
+  !! ISBN 978-0-12-505103-3
+  !! - Milly, P. C. D., 1992: Potential Evaporation and Soil Moisture in General Circulation Models. 
+  !! Journal of Climate, 5, pp. 209â226.
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART					: None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_flux (kjpindex, dtradia, emis, temp_sol, rau, u, v, q_cdrag, vbeta, valpha, vbeta1, vbeta5, &
+       & qair, epot_air, psnew, qsurf, fluxsens, fluxlat, fluxsubli, vevapp, temp_sol_new, &
+       & lwdown, swnet, lwup, lwnet, pb, tsol_rad, netrad, evapot, evapot_corr)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size (-)
+    REAL(r_std), INTENT(in)                                  :: dtradia       !! Time step (s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: emis          !! Emissivity (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol      !! Surface temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: rau           !! Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u,v           !! Wind velocity in components u and v (m s^{-1}) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q_cdrag       !! Surface drag (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta         !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: valpha        !! Resistance coefficient (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta1        !! Snow resistance  (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: vbeta5        !! Flood resistance 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair          !! Lowest level specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air      !! Air potential energy (J)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: psnew         !! New surface static energy (J kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol_new  !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb            !! Lowest level pressure (Pa)
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qsurf         !! Surface specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxsens      !! Sensible heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxlat       !! Latent heat flux (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxsubli     !! Energy of sublimation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: vevapp        !! Total of evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown        !! Downward long wave radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet         !! Net short wave radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: lwup          !! Long-wave up radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: lwnet         !! Long-wave net radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: tsol_rad      !! Radiative surface temperature (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: netrad        !! Net radiation (W m^{-2})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: evapot        !! Soil Potential Evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: evapot_corr   !! Soil Potential Evaporation Correction 
+                                                                              !! (?? mm day^{-1})
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                               :: ji
+    REAL(r_std),DIMENSION (kjpindex)        		         :: grad_qsat
+    REAL(r_std)                               		         :: correction
+    REAL(r_std)                                			 :: speed              !! Speed (m s^{-1}), 
+    REAL(r_std)                                			 :: qc          !! Surface drag coefficient (??)
+    LOGICAL,DIMENSION (kjpindex)            		         :: warning_correction
+!_ ================================================================================================================================
+    
+    DO ji=1,kjpindex
+      
+    !! 1. Determination of 'housekeeping' variables
+      
+      !! The horizontal wind speed is calculated from the velocities along each axis using Pythagorus' theorem. 
+      !! \latexonly 
+      !!     \input{enerbilflux1.tex}
+      !! \endlatexonly
+      speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+      
+      !! From definition, the surface drag coefficient is defined:
+      !! \latexonly 
+      !!     \input{enerbilflux2.tex}
+      !! \endlatexonly
+      qc = speed * q_cdrag(ji)
+    
+    !! 2. Calculation of the net upward flux of longwave radiation
+      
+      !! We first of all calculate the radiation as a result of the Stefan-Boltzmann equation,
+      !! which is the sum of the calculated values at the surface temperature  at the 'old' 
+      !! temperature and the value that corresponds to the difference between the old temperature
+      !! and the temperature at the 'new' timestep.
+      !! \latexonly 
+      !!     \input{enerbilflux3.tex}
+      !! \endlatexonly
+      lwup(ji) = emis(ji) * c_stefan * temp_sol(ji)**4 + &
+           &     quatre * emis(ji) * c_stefan * temp_sol(ji)**3 * &
+           &     (temp_sol_new(ji) - temp_sol(ji))      
+      
+      !! We then add to this value that from the reflected longwave radiation:
+      !! \latexonly 
+      !!     \input{enerbilflux4.tex}
+      !! \endlatexonly
+      lwup(ji) = lwup(ji)  +  (un - emis(ji)) * lwdown(ji)
+      
+      ! tsol_rad(ji) =  (lwup(ji)/ (emis(ji) * c_stefan)) **(1./quatre)
+      !  Need to check the equations
+      
+      !! The radiative surface temperature is calculated according to the Stefan-Boltzmann relation:
+      !! \latexonly 
+      !!     \input{enerbilflux5.tex}
+      !! \endlatexonly      
+      tsol_rad(ji) = emis(ji) * c_stefan * temp_sol(ji)**4 + lwup(ji)
+     
+      !! qsurf (the surface specific humidity) is a simple diagnostic which will be used by the 
+      !! GCM to compute the dependence of of the surface layer stability on moisture.
+      !! \latexonly 
+      !!     \input{enerbilflux6.tex}
+      !! \endlatexonly
+      qsurf(ji) = (vbeta1(ji) * (un - vbeta5(ji)) + vbeta5(ji)) * qsol_sat_new(ji) + &
+           & (un - vbeta1(ji))*(un - vbeta5(ji)) * vbeta(ji) * valpha(ji) * qsol_sat_new(ji)
+      
+      !! \latexonly 
+      !!     \input{enerbilflux7.tex}
+      !! \endlatexonly
+      qsurf(ji) = MAX(qsurf(ji), qair(ji))
+      
+      !! Net downward radiation is the sum of the down-welling less the up-welling long wave flux, plus
+      !! the short wave radiation.
+      !! \latexonly 
+      !!     \emissivity absorbed lw radiationinput{enerbilflux8.tex}
+      !! \endlatexonly
+      netrad(ji) = lwdown(ji) + swnet(ji) - lwup(ji) 
+      
+      !! 'vevapp' is the sum of the total evaporative processes (snow plus non-snow processes).
+      !! \latexonly 
+      !!     \input{enerbilflux9.tex}
+      !! \endlatexonly
+      vevapp(ji) = dtradia * rau(ji) * qc * (vbeta1(ji) * (un - vbeta5(ji)) + vbeta5(ji)) * &
+           & (qsol_sat_new(ji) - qair(ji)) + &
+           &  dtradia * rau(ji) * qc * (un - vbeta1(ji))*(un-vbeta5(ji)) * vbeta(ji) * &
+           & (valpha(ji) * qsol_sat_new(ji) - qair(ji))
+      
+      !! The total latent heat flux is the sum of the snow plus non-snow processes.
+      !! \latexonly 
+      !!     \input{enerbilflux10.tex}
+      !! \endlatexonly
+      fluxlat(ji) = chalsu0 * rau(ji) * qc * vbeta1(ji) * (un - vbeta5(ji)) * &
+           & (qsol_sat_new(ji) - qair(ji)) + &
+           &  chalev0 * rau(ji) * qc * vbeta5(ji) *&
+           & (qsol_sat_new(ji) - qair(ji)) + &
+           &  chalev0 * rau(ji) * qc * (un - vbeta1(ji)) * (un - vbeta5(ji)) * vbeta(ji) * &
+           & (valpha(ji) * qsol_sat_new(ji) - qair(ji))
+      
+      !! The sublimination flux concerns is calculated using vbeta1, the snow resistance.
+      !! \latexonly 
+      !!     \input{enerbilflux11.tex}
+      !! \endlatexonly
+      fluxsubli(ji) = chalsu0 * rau(ji) * qc * vbeta1(ji) * (un - vbeta5(ji)) * &
+           & (qsol_sat_new(ji) - qair(ji)) 
+      
+      !! The sensible heat flux is a factor of the difference between the new surface static energy
+      !! and the potential energy of air.
+      !! \latexonly 
+      !!     \input{enerbilflux12.tex}
+      !! \endlatexonly
+      fluxsens(ji) =  rau(ji) * qc * (psnew(ji) - epot_air(ji))
+      
+      !! This is the net longwave downwards radiation.
+      !! \latexonly 
+      !!     \input{enerbilflux13.tex}
+      !! \endlatexonly
+      lwnet(ji) = lwdown(ji) - lwup(ji)
+      
+      !! Diagnoses the potential evaporation used for the fluxes (evapot)
+      !! \latexonly 
+      !!     \input{enerbilflux14.tex}
+      !! \endlatexonly  
+      evapot(ji) =  MAX(zero, dtradia * rau(ji) * qc * (qsol_sat_new(ji) - qair(ji)))
+     
+      !! From definition we can say:
+      !! \latexonly 
+      !!     \input{enerbilflux15.tex}
+      !! \endlatexonly 
+      tair(ji)  =  epot_air(ji) / cp_air
+
+     ENDDO 
+
+  !! 3. Define qsat_air with the subroutine src_parameter:
+
+    CALL qsatcalc(kjpindex, tair, pb, qsat_air)
+
+    CALL dev_qsatcalc(kjpindex, tair, pb, grad_qsat)
+
+  ! grad_qsat(:)= (qsol_sat_new(:)- qsat_air(:)) / ((psnew(:) - epot_air(:)) / cp_air) ! * dtradia
+    !- Penser a sortir evapot en meme temps qu'evapot_corr tdo.
+
+    warning_correction(:)=.FALSE.
+    DO ji=1,kjpindex
+      
+      !! \latexonly 
+      !!     \input{enerbilflux16.tex}
+      !! \endlatexonly 
+      speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+      
+      !! \latexonly 
+      !!     \input{enerbilflux17.tex}
+      !! \endlatexonly 
+      qc = speed * q_cdrag(ji)
+       
+      !! Derive the potential as defined by Penman & Monteith (Monteith, 1965) based on the correction 
+      !! term developed by Chris Milly (1992).
+       IF ((evapot(ji) .GT. zero) .AND. ((psnew(ji) - epot_air(ji)) .NE. zero )) THEN
+          !
+          !! \latexonly 
+          !!     \input{enerbilflux18.tex}
+          !! \endlatexonly 
+          correction =  (quatre * emis(ji) * c_stefan * tair(ji)**3 + rau(ji) * qc * cp_air + &
+               &                  chalev0 * rau(ji) * qc * grad_qsat(ji) * vevapp(ji) / evapot(ji) )
+          
+          !! \latexonly 
+          !!     \input{enerbilflux19.tex}
+          !! \endlatexonly 
+          IF (ABS(correction) .GT. min_sechiba) THEN
+             correction = chalev0 * rau(ji) * qc * grad_qsat(ji) * (un - vevapp(ji)/evapot(ji)) / correction
+          ELSE
+             warning_correction(ji)=.TRUE.
+          ENDIF
+       ELSE
+          correction = zero
+       ENDIF
+       correction = MAX (zero, correction)
+      
+      !! \latexonly 
+      !!     \input{enerbilflux20.tex}
+      !! \endlatexonly 
+       evapot_corr(ji) = evapot(ji) / (un + correction)
+       
+    ENDDO
+    IF ( ANY(warning_correction) ) THEN
+       DO ji=1,kjpindex
+          IF ( warning_correction(ji) ) THEN
+             WRITE(numout,*) ji,"Denominateur de la correction de milly nul! Aucune correction appliquee"
+          ENDIF
+       ENDDO
+    ENDIF
+    IF (long_print) WRITE (numout,*) ' enerbil_flux done '
+
+  END SUBROUTINE enerbil_flux
+
+
+  !!  ===========================================================================================================================
+  !! SUBROUTINE		 			: enerbil_evapveg
+  !!
+  !>\BRIEF					Splits total evaporation loss into individual process
+  !! components and calculates the assimilation.
+  !!
+  !! DESCRIPTION				: Based on the estimation of the fluxes in enerbil_flux, 
+  !! this routine splits the total evaporation into transpiration interception loss from vegetation, 
+  !! bare soil evaporation and snow sublimation. It then calculates the assimilation.
+  !!
+  !! MAIN OUTPUT VARIABLE(S)	                : vevapsno, vevapnu, transpir, gpp, vevapwet
+  !!
+  !! REFERENCE(S)					:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available (22/12/11): 
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663. 
+  !!
+  !! FLOWCHART   : None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_evapveg (kjpindex, dtradia, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, vbetaco2, &
+     & cimean, ccanopy, rau, u, v, q_cdrag, qair, humrel, vevapsno, vevapnu , vevapflo, vevapwet, &
+     & transpir, transpot, gpp, evapot)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjpindex          !! Domain size (-)
+    REAL(r_std), INTENT(in)                             :: dtradia           !! Time step (s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: vbeta1            !! Snow resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: vbeta4            !! Bare soil resistance (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: vbeta5            !! Floodplains resistance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: rau               !! Density (kg m^{-3})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: u, v              !! Wind velocity in directions u and v (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: q_cdrag           !! Surface drag (m s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: qair              !! Lowest level specific humidity (kg kg^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: ccanopy           !! CO2 concentration in the canopy (ppm)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: evapot            !! Soil Potential Evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex, nvm), INTENT (in)  :: humrel            !! Soil moisture stress (within range 0 to 1)
+!!$ DS 15022011 humrel was used in a previous version of Orchidee, developped by Nathalie. Need to be discussed if it should be introduce again             
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbeta2            !! Interception resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbeta3            !! Vegetation resistance (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbeta3pot         !! Vegetation resistance for potential transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: vbetaco2          !! Vegetation resistance to CO2 (-)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: cimean            !! STOMATE: mean intercellular ci \mu mole m^{-2} s^{-1}
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: vevapsno          !! Snow evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: vevapnu           !! Bare soil evaporation (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: vevapflo         !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: transpir          !! Transpiration (mm day^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: transpot          !! Potential Transpiration
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: gpp               !! Assimilation (gC m^{-2}, total area)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: vevapwet          !! Interception (mm day^{-1})
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jv
+    REAL(r_std), DIMENSION(kjpindex)                    :: xx
+    REAL(r_std), DIMENSION(kjpindex)                    :: vbeta2sum, vbeta3sum
+    REAL(r_std)                                    	:: speed	     !! Speed (m s^{-1})
+!_ ==============================================================================================================================
+    ! initialisation: utile pour calculer l'evaporation des floodplains dans lesquelles il y a de la vegetation
+    vbeta2sum(:) = 0.
+    vbeta3sum(:) = 0.
+    DO jv = 1, nvm
+      vbeta2sum(:) = vbeta2sum(:) + vbeta2(:,jv)
+      vbeta3sum(:) = vbeta3sum(:) + vbeta3(:,jv)
+    ENDDO 
+    
+    !! 1. Compute vevapsno (evaporation from snow) and vevapnu (bare soil evaporation)
+
+    DO ji=1,kjpindex 
+
+      !! \latexonly 
+      !!     \input{enerbilevapveg1.tex}
+      !! \endlatexonly
+      speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+
+      
+      !! 1.1 Snow sublimation
+      !! \latexonly 
+      !!     \input{enerbilevapveg2.tex}
+      !! \endlatexonly
+      vevapsno(ji) = (un - vbeta5(ji)) * vbeta1(ji) * dtradia * rau(ji) * speed * q_cdrag(ji) * (qsol_sat_new(ji) - qair(ji))
+
+      !! 1.2 Bare soil evaporation
+      !! \latexonly 
+      !!     \input{enerbilevapveg3.tex}
+      !! \endlatexonly
+      vevapnu(ji) = (un - vbeta1(ji)) * (un-vbeta5(ji)) * vbeta4(ji) * dtradia * rau(ji) * speed * q_cdrag(ji) &
+         & * (qsol_sat_new(ji) - qair(ji))
+
+      !
+      ! 1.3 floodplains evaporation - transpiration et interception prioritaires dans les floodplains
+      !
+      vevapflo(ji) = vbeta5(ji) * (1 - vbeta2sum(ji) - vbeta3sum(ji)) &
+           & * dtradia * rau(ji) * speed * q_cdrag(ji) * (qsol_sat_new(ji) - qair(ji))
+
+    END DO
+
+    !! 2. Compute transpir (transpiration) and vevapwet (interception)
+  
+    !! Preliminaries
+    DO ji = 1, kjpindex
+       
+       !! \latexonly 
+       !!     \input{enerbilevapveg4.tex}
+       !! \endlatexonly
+       speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+       
+       !! \latexonly 
+       !!     \input{enerbilevapveg5.tex}
+       !! \endlatexonly
+       xx(ji) = dtradia * (un-vbeta1(ji)) * (qsol_sat_new(ji)-qair(ji)) * rau(ji) * speed * q_cdrag(ji)
+     
+    ENDDO
+    
+    DO jv=1,nvm 
+      DO ji=1,kjpindex 
+        
+        !! 2.1 Calculate interception loss
+        !! \latexonly 
+        !!     \input{enerbilevapveg6.tex}
+        !! \endlatexonly
+        vevapwet(ji,jv) = xx(ji) * vbeta2(ji,jv)
+        ! 
+        !! 2.2 Calculate transpiration
+        !! \latexonly 
+        !!     \input{enerbilevapveg7.tex}
+        !! \endlatexonly
+        transpir (ji,jv) = xx(ji) * vbeta3(ji,jv)
+
+        transpot(ji,jv) = xx(ji) * vbeta3pot(ji,jv)
+
+      END DO
+    END DO
+
+    
+    !! 3. STOMATE: Calculate gpp (assimilation)
+
+    IF ( control%ok_co2 ) THEN
+
+      DO jv = 1, nvm
+         DO ji = 1, kjpindex
+             !
+             !! \latexonly 
+             !!     \input{enerbilevapveg8.tex}
+             !! \endlatexonly
+             speed = MAX(min_wind, SQRT (u(ji)*u(ji) + v(ji)*v(ji)))
+             !
+             !! \latexonly 
+             !!     \input{enerbilevapveg9.tex}
+             !! \endlatexonly
+             gpp(ji,jv) = vbetaco2(ji,jv) * dtradia * rau(ji) * speed * q_cdrag(ji) * &
+                    (ccanopy(ji) - cimean(ji,jv)) * 12.e-6
+        ENDDO
+      ENDDO
+
+    ELSEIF ( control%stomate_watchout ) THEN
+
+      gpp(:,:) = zero
+
+    ENDIF
+
+    IF (long_print) WRITE (numout,*) ' enerbil_evapveg done '
+
+  END SUBROUTINE enerbil_evapveg
+
+ 
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_fusion
+  !!
+  !>\BRIEF					Computes new soil temperature due to
+  !! ice and snow melt. 
+  !!
+  !! DESCRIPTION				: This routine computes new soil temperature due to
+  !! ice and snow melt. It is the second part of main routine for enerbil module, and is called every
+  !! time step. 
+  !!
+  !! MAIN OUTPUT VARIABLE(S)			: temp_sol_new, fusion
+  !!
+  !! REFERENCE(S)				:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ. Technical note, available (22/12/11):
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau. PhD Thesis, available (22/12/11):
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART  : None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_fusion (kjpindex, dtradia, tot_melt, soilcap, temp_sol_new, fusion )
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex       !! Domain size (-)
+    REAL(r_std), INTENT(in)                                  :: dtradia        !! Time step (s)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: tot_melt       !! Total melt (??)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: soilcap        !! Soil heat capacity (J K^{-1])
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fusion         !! Fusion (??)
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: temp_sol_new   !! New soil temperature (K)
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                	     :: ji	       !! (-)
+  !_ ==============================================================================================================================
+    
+    !! Initialisation
+    IF (long_print) WRITE (numout,*) ' enerbil_fusion start ', MINVAL(soilcap), MINLOC(soilcap),&
+         & MAXVAL(soilcap), MAXLOC(soilcap)
+    
+    !! 1. Calculate new soil temperature due to ice and snow melt
+   
+    DO ji=1,kjpindex 
+      
+      !! \latexonly 
+      !!     \input{enerbilfusion1.tex}
+      !! \endlatexonly
+      fusion(ji) = tot_melt(ji) * chalfu0 / dtradia
+      
+      !! \latexonly 
+      !!     \input{enerbilfusion2.tex}
+      !! \endlatexonly
+      temp_sol_new(ji) = temp_sol_new(ji) - ((tot_melt(ji) * chalfu0) / soilcap(ji))
+
+    END DO
+
+    IF (long_print) WRITE (numout,*) ' enerbil_fusion done '
+
+  END SUBROUTINE enerbil_fusion
+
+
+  !!  =============================================================================================================================
+  !! SUBROUTINE		 			: enerbil_t2mdiag
+  !!
+  !> BRIEF					This routine diagnoses the air temperature at 2
+  !! metres above ground.
+  !!
+  !! DESCRIPTION				: The 2 metre above ground air temperature is currently
+  !! set to be the same as the general air temperaturem, as the surface model currently simulates the 
+  !! above ground atmosphere as a uniform box (and the lowest layer of the LMDZ atmospheric model).
+  !!
+  !! MAIN OUTPUT VARIABLE(S)			: t2mdiag
+  !!
+  !! REFERENCE(S)				:
+  !! - Best, MJ, Beljaars, A, Polcher, J & Viterbo, P, 2004. A proposed structure for coupling tiled
+  !! surfaces with the planetary boundary layer. Journal of Hydrometeorology, 5, pp.1271-1278
+  !! - de Noblet-DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+  !! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+  !! Circulation Model. Journal of Climate, 6, pp.248-273
+  !! - Dufresne, J-L & Ghattas, J, 2009. Description du schÃ©ma de la couche limite turbulente et la
+  !! interface avec la surface planetaire dans LMDZ, Technical note, available from:
+  !! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques/ressources/pbl_surface.pdf
+  !! - Guimberteau, M, 2010. ModÃ©lisation de l'hydrologie continentale et influences de l'irrigation
+  !! sur le cycle de l'eau, PhD Thesis, available from:
+  !! http://www.sisyphe.upmc.fr/~guimberteau/docs/manuscrit_these.pdf
+  !! - Polcher, J. McAvaney, B, Viterbo, P, Gaertner, MA, Hahmann, A, Mahfouf, J-F, Noilhan, J
+  !! Phillips, TJ, Pitman, AJ, Schlosser, CA, Schulz, J-P, Timbal, B, Verseghy, D &
+  !! Xue, Y, 1998. A proposal for a general interface between land surface schemes and
+  !! general circulation models. Global and Planetary Change, 19, pp.261-276
+  !! - Richtmeyer, RD, Morton, KW, 1967. Difference Methods for Initial-Value Problems.
+  !! Interscience Publishers\n
+  !! - Schulz, Jan-Peter, Lydia DÃŒmenil, Jan Polcher, 2001: On the Land SurfaceâAtmosphere 
+  !! Coupling and Its Impact in a Single-Column Atmospheric Model. J. Appl. Meteor., 40, 642â663.
+  !!
+  !! FLOWCHART  : None
+  !! \n
+  !_ ==============================================================================================================================
+
+  SUBROUTINE enerbil_t2mdiag (kjpindex, temp_air, t2mdiag)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         		:: kjpindex       !! Domain size (-)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      		:: temp_air       !! Air temperature (K)
+    
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)    		:: t2mdiag        !! 2-metre temperature (K)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+  !_ ==============================================================================================================================
+
+    !! The 2 metre air temperature is assumed to be the same of the value of temp_air - the atmospheric air
+    !! temperature, which also taken as the temperature at the lowest level of the LMDZ. 't2mdiag' is just
+    !! a value used for diagnostic purposes, admd it is no applied amywhere else.
+    !! \latexonly 
+ 	!!     \input{enerbilt2mdiag1.tex}
+    !! \endlatexonly
+    t2mdiag(:) = temp_air(:)
+
+    IF (long_print) WRITE (numout,*) ' enerbil_t2mdiag done '
+
+  END SUBROUTINE enerbil_t2mdiag
+
+
+
+END MODULE enerbil
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/hydrol.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/hydrol.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/hydrol.f90	(revision 5166)
@@ -0,0 +1,6017 @@
+! =================================================================================================================================
+! MODULE        : hydrol
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module computes the soil moisture processes on continental points. 
+!!
+!!\n DESCRIPTION : contains hydrol_init, hydrol_var_init, hydrol_waterbal, hydrol_alma,
+!!                 hydrol_snow, hydrol_vegupd, hydrol_canop, hydrol_flood, hydrol_soil.
+!!                 The assumption in this module is that very high vertical resolution is
+!!                 needed in order to properly resolve the vertical diffusion of water in
+!!                 the soils. Furthermore we have taken into account the sub-grid variability
+!!                 of soil properties and vegetation cover by allowing the co-existence of
+!!                 different soil moisture columns in the same grid box.
+!!                 This routine was originaly developed by Patricia deRosnay.
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) : None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE hydrol
+
+  USE ioipsl
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE sechiba_io
+  USE slowproc
+  USE grid
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: hydrol_main,hydrol_clear 
+
+  !
+  ! variables used inside hydrol module : declaration and initialisation
+  !
+  LOGICAL, SAVE                                   :: l_first_hydrol=.TRUE.   !! Initialisation has to be done one time
+!$OMP THREADPRIVATE(l_first_hydrol)
+  LOGICAL, SAVE                                   :: l_second_hydrol=.TRUE.  !! Initialisation has to be done one time
+!$OMP THREADPRIVATE(l_second_hydrol)
+  !
+  LOGICAL, SAVE                                   :: check_cwrr=.FALSE.      !! The check the water balance
+!$OMP THREADPRIVATE(check_cwrr)
+  LOGICAL, SAVE                                   :: doponds=.FALSE.         !! Reinfiltration param.
+!$OMP THREADPRIVATE(doponds)
+  !
+  CHARACTER(LEN=80) , SAVE                        :: var_name                !! To store variables names for I/O
+!$OMP THREADPRIVATE(var_name)
+  !
+  REAL(r_std), PARAMETER                          :: allowed_err =  2.0E-8_r_std
+  REAL(r_std), PARAMETER                          :: EPS1 = EPSILON(un)      !! A small number
+  ! one dimension array allocated, computed, saved and got in hydrol module
+  ! Values per soil type
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: nvan                !! Van Genuchten coeficients n
+!$OMP THREADPRIVATE(nvan)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: avan                !! Van Genuchten coeficients a
+!$OMP THREADPRIVATE(avan)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcr                 !! Residual humidity [m3/m3]
+!$OMP THREADPRIVATE(mcr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcs                 !! Saturation humidity [m3/m3]
+!$OMP THREADPRIVATE(mcs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: ks                  !! Hydraulic conductivity Saturation for each soil type 
+                                                                         !! [mm/day] 
+!$OMP THREADPRIVATE(ks)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: pcent               !! Fraction of saturated volumetric soil moisture above 
+                                                                         !! which transpir is max 
+!$OMP THREADPRIVATE(pcent)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: free_drain_max      !! Max value of the permeability coeff at the bottom of 
+                                                                         !! the soil [mm/day] 
+!$OMP THREADPRIVATE(free_drain_max)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcf                 !! Field capacity [m3/m3]
+!$OMP THREADPRIVATE(mcf)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mcw                 !! Wilting point [m3/m3]
+!$OMP THREADPRIVATE(mcw)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mc_awet             !! Vol. wat. cont. above which albedo is cst [m3/m3]
+!$OMP THREADPRIVATE(mc_awet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mc_adry             !! Vol. wat. cont. below which albedo is cst [m3/m3]
+!$OMP THREADPRIVATE(mc_adry)
+
+  ! Values per grid point
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_water_beg    !! Total amount of water at start of time step
+!$OMP THREADPRIVATE(tot_water_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_water_end    !! Total amount of water at end of time step
+!$OMP THREADPRIVATE(tot_water_end)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_flux         !! Total water flux
+!$OMP THREADPRIVATE(tot_flux)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watveg_beg   !! Total amount of water on vegetation at start of time 
+                                                                         !! step 
+!$OMP THREADPRIVATE(tot_watveg_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watveg_end   !! Total amount of water on vegetation at end of time step
+!$OMP THREADPRIVATE(tot_watveg_end)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watsoil_beg  !! Total amount of water in the soil at start of time step
+!$OMP THREADPRIVATE(tot_watsoil_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watsoil_end  !! Total amount of water in the soil at end of time step
+!$OMP THREADPRIVATE(tot_watsoil_end)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: snow_beg         !! Total amount of snow at start of time step
+!$OMP THREADPRIVATE(snow_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: snow_end         !! Total amount of snow at end of time step
+!$OMP THREADPRIVATE(snow_end)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: delsoilmoist     !! Change in soil moisture
+!$OMP THREADPRIVATE(delsoilmoist)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: delintercept     !! Change in interception storage
+!$OMP THREADPRIVATE(delintercept)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: delswe           !! Change in SWE
+!$OMP THREADPRIVATE(delswe)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: swi              !! Soil Wetness Index
+!$OMP THREADPRIVATE(swi)
+
+  ! array allocated, computed, saved and got in hydrol module
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_veget       !! zero/one when veget fraction is zero/higher
+!$OMP THREADPRIVATE(mask_veget)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_soiltile    !! zero/one where soil tile is zero/higher 
+!$OMP THREADPRIVATE(mask_soiltile)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: humrelv          !! humrel for each soil type
+!$OMP THREADPRIVATE(humrelv)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: vegstressv       !! vegstress for each soil type  
+!$OMP THREADPRIVATE(vegstressv)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:):: us               !! relative humidity 
+!$OMP THREADPRIVATE(us)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: precisol         !! Eau tombee sur le sol
+!$OMP THREADPRIVATE(precisol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: precisol_ns      !! Eau tombee sur le sol par type de sol
+!$OMP THREADPRIVATE(precisol_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: ae_ns            !! Evaporation du sol nu par type de sol
+!$OMP THREADPRIVATE(ae_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: evap_bare_lim_ns !! limitation of bare soil evaporation on each soil column 
+                                                                         !! (used to deconvoluate vevapnu) 
+!$OMP THREADPRIVATE(evap_bare_lim_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: free_drain_coef  !! Coefficient for free drainage at bottom
+!$OMP THREADPRIVATE(free_drain_coef)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_bare_ns     !! evaporating bare soil fraction per tile
+!$OMP THREADPRIVATE(frac_bare_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: rootsink         !! stress racinaire par niveau et type de sol
+!$OMP THREADPRIVATE(rootsink)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: subsnowveg       !! Sublimation of snow on vegetation
+!$OMP THREADPRIVATE(subsnowveg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: subsnownobio     !! Sublimation of snow on other surface types (ice, lakes, 
+                                                                         !! ...) 
+!$OMP THREADPRIVATE(subsnownobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: snowmelt         !! Quantite de neige fondue
+!$OMP THREADPRIVATE(snowmelt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: icemelt          !! Quantite de glace fondue
+!$OMP THREADPRIVATE(icemelt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: subsinksoil      !! Excess of sublimation as a sink for the soil
+!$OMP THREADPRIVATE(subsinksoil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: vegtot           !! Total  vegetation (veget_max)
+!$OMP THREADPRIVATE(vegtot)
+  ! The last vegetation map which was used to distribute the reservoirs
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: resdist          !! Distribution of reservoirs
+!$OMP THREADPRIVATE(resdist)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: mx_eau_var       !!
+!$OMP THREADPRIVATE(mx_eau_var)
+
+  ! arrays used by cwrr scheme
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: nroot            !! nvm * nstm * nslm
+!$OMP THREADPRIVATE(nroot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: kfact_root       !! kjpindex * nslm * nstm
+!$OMP THREADPRIVATE(kfact_root)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: kfact            !! nslm * nscm
+!$OMP THREADPRIVATE(kfact)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: zz               !! nslm+1 * nstm
+!$OMP THREADPRIVATE(zz)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: dz               !! nslm+1 * nstm
+!$OMP THREADPRIVATE(dz)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: mc_lin           !! imin:imax * nscm
+!$OMP THREADPRIVATE(mc_lin)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: k_lin            !! imin:imax * nslm * nscm
+!$OMP THREADPRIVATE(k_lin)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: d_lin            !! imin:imax * nslm * nscm
+!$OMP THREADPRIVATE(d_lin)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: a_lin            !! imin:imax * nslm * nscm
+!$OMP THREADPRIVATE(a_lin)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: b_lin            !! imin:imax * nslm * nscm
+!$OMP THREADPRIVATE(b_lin)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: humtot           !! (:) Total Soil Moisture, Kg/m2
+!$OMP THREADPRIVATE(humtot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: flux             !! (:)
+!$OMP THREADPRIVATE(flux)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:)          :: resolv           !! (:)
+!$OMP THREADPRIVATE(resolv)
+
+!! linarization coefficients of hydraulic conductivity K
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: k                !! (:,nslm)
+!$OMP THREADPRIVATE(k)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: a                !! (:,nslm)
+!$OMP THREADPRIVATE(a)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: b                !!
+!$OMP THREADPRIVATE(b)
+!! linarization coefficients of hydraulic diffusivity D
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: d                !!
+!$OMP THREADPRIVATE(d)
+!! matrix coefficients
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: e                !!
+!$OMP THREADPRIVATE(e)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: f                !!
+!$OMP THREADPRIVATE(f)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: g1               !!
+!$OMP THREADPRIVATE(g1)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: ep               !!
+!$OMP THREADPRIVATE(ep)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: fp               !!
+!$OMP THREADPRIVATE(fp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: gp               !!
+!$OMP THREADPRIVATE(gp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: rhs              !!
+!$OMP THREADPRIVATE(rhs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: srhs             !!
+!$OMP THREADPRIVATE(srhs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: gam              !!
+!$OMP THREADPRIVATE(gam)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: water2infilt     !! Water to be infiltrated
+!$OMP THREADPRIVATE(water2infilt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc              !! (:,nstm) Total moisture content (mm)
+!$OMP THREADPRIVATE(tmc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmcr             !! (nstm) Total moisture constent at residual (mm)
+!$OMP THREADPRIVATE(tmcr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmcs             !! (nstm) Total moisture constent at saturation (mm)
+!$OMP THREADPRIVATE(tmcs)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter       !! (:,nstm) Total moisture in the litter by soil type
+!$OMP THREADPRIVATE(tmc_litter)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tmc_litt_mea     !! Total moisture in the litter over the grid
+!$OMP THREADPRIVATE(tmc_litt_mea)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_wilt  !! (:,nstm) Moisture of litter at wilt pt
+!$OMP THREADPRIVATE(tmc_litter_wilt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_field !! (:,nstm) Moisture of litter at field cap.
+!$OMP THREADPRIVATE(tmc_litter_field)
+!!! A CHANGER DANS TOUT HYDROL: tmc_litter_res et sat ne devraient pas dependre de ji - tdo
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_res   !! (:,nstm) Moisture of litter at residual moisture.
+!$OMP THREADPRIVATE(tmc_litter_res)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_sat   !! (:,nstm) Moisture of litter at saturatiion
+!$OMP THREADPRIVATE(tmc_litter_sat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_awet  !! (:,nstm) Moisture of litter at mc_awet
+!$OMP THREADPRIVATE(tmc_litter_awet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_adry  !! (:,nstm) Moisture of litter at mc_dry
+!$OMP THREADPRIVATE(tmc_litter_adry)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tmc_litt_wet_mea !! Total moisture in the litter over the grid below which 
+                                                                         !! albedo is fixed 
+!$OMP THREADPRIVATE(tmc_litt_wet_mea)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tmc_litt_dry_mea !! Total moisture in the litter over the grid above which 
+                                                                         !! albedo is fixed 
+!$OMP THREADPRIVATE(tmc_litt_dry_mea)
+  LOGICAL, SAVE                                      :: tmc_init_updated = .FALSE. !! Flag allowing to determine if tmc is initialized.
+!$OMP THREADPRIVATE(tmc_init_updated)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: v1               !! (:)
+!$OMP THREADPRIVATE(v1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: qflux00          !! flux at the top of the soil column
+!$OMP THREADPRIVATE(qflux00)
+
+  !! par type de sol :
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: ru_ns            !! ruissellement
+!$OMP THREADPRIVATE(ru_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: dr_ns            !! drainage
+!$OMP THREADPRIVATE(dr_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tr_ns            !! transpiration 
+!$OMP THREADPRIVATE(tr_ns)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: cvs_over_veg     !! (:,nvm,nstm) old value of corr_veg_soil/veget_max kept 
+                                                                         !! from diag to next split 
+!$OMP THREADPRIVATE(cvs_over_veg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: corr_veg_soil    !! (:,nvm,nstm) percentage of each veg. type on each soil 
+                                                                         !! of each grid point 
+!$OMP THREADPRIVATE(corr_veg_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: mc               !! (:,nslm,nstm) \f($m^3 \times m^3$)\f
+!$OMP THREADPRIVATE(mc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: soilmoist        !! (:,nslm)
+!$OMP THREADPRIVATE(soilmoist)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: soil_wet         !! soil wetness
+!$OMP THREADPRIVATE(soil_wet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: soil_wet_litter  !! soil wetness of the litter
+!$OMP THREADPRIVATE(soil_wet_litter)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: qflux            !! fluxes between the soil layers
+!$OMP THREADPRIVATE(qflux)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: tmat             !!
+!$OMP THREADPRIVATE(tmat)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: stmat            !!
+!$OMP THREADPRIVATE(stmat)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_main
+!!
+!>\BRIEF         
+!!
+!! DESCRIPTION :
+!! - called only one time for initialisation
+!! - called every time step
+!! - called one more time at last time step for writing _restart_ file
+!!
+!! - Choose between initialisation/Restart time/Time Step
+!! - 1 Do initialisation ==> hydrol_init
+!! - X if check_waterbal ==> hydrol_waterbal
+!! - 2 prepares restart file for the next simulation
+!! - 3 shared time step
+!! - 3.1 computes snow  ==> hydrol_snow
+!! - 3.2 computes vegetations reservoirs  ==> hydrol_vegupd
+!! - 3.3 computes canopy  ==> hydrol_canop
+!! - 3.4 computes surface reservoir  ==> hydrol_flood
+!! - 3.5 computes soil hydrologie ==> hydrol_soil
+!! - X if check_waterbal ==> hydrol_waterbal
+!! - 4 write out file  ==> hydrol_alma/histwrite(*)
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, &
+       & index, indexveg, indexsoil, indexlayer, control_in, &
+       & temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max, njsc, &
+       & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age,  &
+       & tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, &
+       & humrel, vegstress, drysoil_frac, evapot, evapot_penm, evap_bare_lim, flood_frac, flood_res, &
+       & shumdiag, k_litt, litterhumdiag, soilcap, soiltile, reinf_slope, rest_id, hist_id, hist2_id,soil_mc, &
+       & litter_mc,wat_flux0, wat_flux, drainage_per_soil, runoff_per_soil)
+
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+  
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                         :: kjit             !! Time step number 
+    INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size
+    INTEGER(i_std),INTENT (in)                         :: rest_id,hist_id  !! _Restart_ file and _history_ file identifier
+    INTEGER(i_std),INTENT (in)                         :: hist2_id         !! _history_ file 2 identifier
+    REAL(r_std), INTENT (in)                           :: dtradia          !! Time step in seconds
+    LOGICAL, INTENT(in)                                :: ldrestart_read   !! Logical for _restart_ file to read
+    LOGICAL, INTENT(in)                                :: ldrestart_write  !! Logical for _restart_ file to write
+    ! input fields
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index            !! Indeces of the points on the map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in):: indexveg        !! Indeces of the points on the 3D map for veg
+    INTEGER(i_std),DIMENSION (kjpindex*nstm), INTENT (in):: indexsoil      !! Indeces of the points on the 3D map for soil
+    INTEGER(i_std),DIMENSION (kjpindex*nslm), INTENT (in):: indexlayer     !! Indeces of the points on the 3D map for soil layers
+    TYPE(control_type), INTENT (in)                    :: control_in       !! Flags that (de)activate parts of the model
+    !
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_rain      !! Rain precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_snow      !! Snow precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: returnflow       !! Routed water which comes back into the soil (from the 
+                                                                           !! bottom) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: reinfiltration   !! Routed water which comes back into the soil (at the 
+                                                                           !! top) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: irrigation       !! Water from irrigation returning to soil moisture  
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: temp_sol_new     !! New soil temperature
+
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio     !! Fraction of ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: totfrac_nobio    !! Total fraction of ice+lakes+...
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: soilcap          !! Soil capacity
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile         !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vevapwet         !! Interception loss
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget            !! Fraction of vegetation type           
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max        !! Max. fraction of vegetation type (LAI -> infty)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintmax         !! Maximum water on vegetation for interception
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: transpir         !! Transpiration
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: reinf_slope      !! Slope coef
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot           !! Soil Potential Evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot_penm      !! Soil Potential Evaporation Correction
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: flood_frac       !! flood fraction
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: humrel           !! Relative humidity
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress        !! Veg. moisture stress (only for vegetation growth)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: drysoil_frac     !! function of litter wetness
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out):: shumdiag         !! relative soil moisture
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: k_litt           !! litter approximate conductivity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: litterhumdiag    !! litter humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: tot_melt         !! Total melt    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: qsintveg         !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)      :: evap_bare_lim    !! Limitation factor for bare soil evaporation
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(out)  :: soil_mc    !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out)       :: litter_mc  !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out)       :: wat_flux0  !! Water flux in the first soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(out)  :: wat_flux   !! Water flux in the soil layers exported for soil C calculations
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)      :: runoff_per_soil  !! runoff for each soil type[mm]
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)      :: drainage_per_soil!! drainage for each soil type [mm]
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: vevapnu          !! Bare soil evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: vevapsno         !! Snow evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: vevapflo         !! Floodplain evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: flood_res        !! flood reservoir estimate
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: snow             !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)   :: snow_age         !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio  !! Water balance on ice, lakes, .. [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio_age !! Snow age on ice, lakes, ...
+    !! We consider that any water on the ice is snow and we only peforme a water balance to have consistency.
+    !! The water balance is limite to + or - 10^6 so that accumulation is not endless
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: floodout       !! flux out of floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: runoff         !! Complete runoff
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: drainage       !! Drainage
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: jst, jsl
+    REAL(r_std),DIMENSION (kjpindex)                   :: soilwet          !! A temporary diagnostic of soil wetness
+    REAL(r_std),DIMENSION (kjpindex)                   :: snowdepth        !! Depth of snow layer
+    REAL(r_std),DIMENSION (kjpindex)                   :: njsc_tmp         !! Temporary REAL value for njsc to write it
+
+!_ ================================================================================================================================
+
+    !!_hydrol_main
+    !
+    !! Choose between initialisation/Restart time/Time Step
+    !! 1 Do initialisation ==>hydrol_init
+    !
+    IF (l_first_hydrol) THEN
+
+       IF (long_print) WRITE (numout,*) ' l_first_hydrol : call hydrol_init '
+
+       CALL hydrol_init (kjit, ldrestart_read, kjpindex, index, rest_id, veget_max, soiltile, humrel,&
+            & vegstress, snow, snow_age, snow_nobio, snow_nobio_age, qsintveg) 
+       CALL hydrol_var_init (kjpindex, veget, veget_max, soiltile, njsc, mx_eau_var, shumdiag, k_litt, &
+            & litterhumdiag, drysoil_frac, evap_bare_lim,qsintveg) 
+
+       ! If we check the water balance we first save the total amount of water
+    !! X if check_waterbal ==> hydrol_waterbal
+       IF (check_waterbal) THEN
+          CALL hydrol_waterbal(kjpindex, index, .TRUE., dtradia, veget_max, &
+               & totfrac_nobio, qsintveg, snow, snow_nobio,&
+               & precip_rain, precip_snow, returnflow, reinfiltration, irrigation, tot_melt, &
+               & vevapwet, transpir, vevapnu, vevapsno, vevapflo, floodout, runoff,drainage)
+       ENDIF
+       !
+       IF (almaoutput) THEN
+          CALL hydrol_alma(kjpindex, index, .TRUE., qsintveg, snow, snow_nobio, soilwet)
+       ENDIF
+
+       RETURN
+
+    ENDIF
+
+    !
+    !! 2 prepares restart file for the next simulation
+    !
+    IF (ldrestart_write) THEN
+
+       IF (long_print) WRITE (numout,*) ' we have to complete restart file with HYDROLOGIC variables '
+
+       DO jst=1,nstm
+          ! var_name= "mc_1" ... "mc_3"
+          WRITE (var_name,"('moistc_',i1)") jst
+          CALL restput_p(rest_id, var_name, nbp_glo,  nslm, 1, kjit, mc(:,:,jst), 'scatter',  nbp_glo, index_g)
+       END DO
+       !
+       DO jst=1,nstm
+          DO jsl=1,nslm
+             ! var_name= "us_1_01" ... "us_3_11"
+             WRITE (var_name,"('us_',i1,'_',i2.2)") jst,jsl
+             CALL restput_p(rest_id, var_name, nbp_glo,nvm, 1,kjit,us(:,:,jst,jsl),'scatter',nbp_glo,index_g)
+          END DO
+       END DO
+       !
+       var_name= 'free_drain_coef'  
+       CALL restput_p(rest_id, var_name, nbp_glo,   nstm, 1, kjit,  free_drain_coef, 'scatter',  nbp_glo, index_g)
+       !
+       var_name= 'water2infilt'  
+       CALL restput_p(rest_id, var_name, nbp_glo,   nstm, 1, kjit,  water2infilt, 'scatter',  nbp_glo, index_g)
+       !
+       var_name= 'ae_ns'  
+       CALL restput_p(rest_id, var_name, nbp_glo,   nstm, 1, kjit,  ae_ns, 'scatter',  nbp_glo, index_g)
+       !
+       var_name= 'vegstress'
+       CALL restput_p(rest_id, var_name, nbp_glo,   nvm, 1, kjit,  vegstress, 'scatter',  nbp_glo, index_g)
+       !
+       var_name= 'snow'    
+       CALL restput_p(rest_id, var_name, nbp_glo,   1, 1, kjit,  snow, 'scatter',  nbp_glo, index_g)
+       !
+       var_name= 'snow_age'
+       CALL restput_p(rest_id, var_name, nbp_glo,   1, 1, kjit,  snow_age, 'scatter',  nbp_glo, index_g)
+       !
+       var_name= 'snow_nobio'    
+       CALL restput_p(rest_id, var_name, nbp_glo,   nnobio, 1, kjit,  snow_nobio, 'scatter', nbp_glo, index_g)
+       !
+       var_name= 'snow_nobio_age'
+       CALL restput_p(rest_id, var_name, nbp_glo,   nnobio, 1, kjit,  snow_nobio_age, 'scatter', nbp_glo, index_g)
+       !
+       var_name= 'qsintveg'
+       CALL restput_p(rest_id, var_name, nbp_glo, nvm, 1, kjit,  qsintveg, 'scatter',  nbp_glo, index_g)
+       !
+       var_name= 'resdist'
+       CALL restput_p(rest_id, var_name, nbp_glo, nstm, 1, kjit,  resdist, 'scatter',  nbp_glo, index_g)       
+       !
+       DO jst=1,nstm
+          ! var_name= "cvs_over_veg_1" ... "cvs_over_veg_3"
+          WRITE (var_name,"('cvs_over_veg_',i1)") jst
+          CALL restput_p(rest_id, var_name, nbp_glo,  nvm, 1, kjit, cvs_over_veg(:,:,jst), 'scatter',  nbp_glo, index_g)
+       END DO
+       !
+       IF ( check_waterbal ) THEN
+          var_name= 'tot_water_beg'
+          CALL restput_p(rest_id, var_name, nbp_glo,   1, 1, kjit,  tot_water_end, 'scatter', nbp_glo, index_g)
+       ENDIF
+       !
+       RETURN
+       !
+    END IF
+
+    !
+    !!__3 shared time step
+    !
+    IF (long_print) WRITE (numout,*) 'hydrol pas de temps = ',dtradia
+
+    ! 
+    !! 3.1 computes snow  ==>hydrol_snow
+    CALL hydrol_snow(kjpindex, dtradia, precip_rain, precip_snow, temp_sol_new, soilcap, &
+         & frac_nobio, totfrac_nobio, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age, &
+         & tot_melt, snowdepth)
+
+    !
+    !! 3.2 computes vegetations reservoirs  ==>hydrol_vegupd
+    CALL hydrol_vegupd(kjpindex, veget, veget_max, soiltile, qsintveg,resdist)
+
+    !
+    !! 3.3 computes canopy  ==>hydrol_canop
+    CALL hydrol_canop(kjpindex, precip_rain, vevapwet, veget_max, veget, qsintmax, qsintveg,precisol,tot_melt)
+
+    !
+    !!___3.4 computes surface reservoir  ==>hydrol_flood
+    CALL hydrol_flood(kjpindex, dtradia, vevapflo, flood_frac, flood_res, floodout)
+
+    !
+    !! 3.5 computes soil hydrologie ==>hydrol_soil
+    CALL hydrol_soil(kjpindex, dtradia, veget_max, soiltile, njsc, reinf_slope,  &
+         & transpir, vevapnu, evapot, evapot_penm, runoff, drainage, returnflow, reinfiltration, irrigation, &
+         & tot_melt,evap_bare_lim, shumdiag, k_litt, litterhumdiag, humrel, vegstress, drysoil_frac,soil_mc, &
+         & litter_mc,wat_flux0, wat_flux, drainage_per_soil, runoff_per_soil)
+
+    ! If we check the water balance we end with the comparison of total water change and fluxes
+    !! X if check_waterbal ==> hydrol_waterbal
+    IF (check_waterbal) THEN
+       CALL hydrol_waterbal(kjpindex, index, .FALSE., dtradia, veget_max, totfrac_nobio, &
+            & qsintveg, snow,snow_nobio, precip_rain, precip_snow, returnflow, reinfiltration, &
+            & irrigation, tot_melt, vevapwet, transpir, vevapnu, vevapsno, vevapflo, floodout, runoff, drainage)
+    ENDIF
+
+    !! 4 write out file  ==> hydrol_alma/histwrite(*)
+    !
+    ! If we use the ALMA standards
+    IF (almaoutput) THEN
+       CALL hydrol_alma(kjpindex, index, .FALSE., qsintveg, snow, snow_nobio, soilwet)
+    ENDIF
+
+    !
+    IF ( .NOT. almaoutput ) THEN
+       DO jst=1,nstm
+          ! var_name= "mc_1" ... "mc_3"
+          WRITE (var_name,"('moistc_',i1)") jst
+          CALL histwrite_p(hist_id, trim(var_name), kjit,mc(:,:,jst), kjpindex*nslm, indexlayer)
+
+          ! var_name= "kfactroot_1" ... "kfactroot_3"
+          WRITE (var_name,"('kfactroot_',i1)") jst
+          CALL histwrite_p(hist_id, trim(var_name), kjit, kfact_root(:,:,jst), kjpindex*nslm, indexlayer)
+
+          ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+          WRITE (var_name,"('vegetsoil_',i1)") jst
+          CALL histwrite_p(hist_id, trim(var_name), kjit,corr_veg_soil(:,:,jst), kjpindex*nvm, indexveg)
+       ENDDO
+       CALL histwrite_p(hist_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
+       CALL histwrite_p(hist_id, 'humtot', kjit, humtot, kjpindex, index)
+       njsc_tmp(:)=njsc(:)
+       CALL histwrite_p(hist_id, 'soilindex', kjit, njsc_tmp, kjpindex, index)
+       CALL histwrite_p(hist_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'drainage', kjit, drainage, kjpindex, index)
+       CALL histwrite_p(hist_id, 'runoff', kjit, runoff, kjpindex, index)
+       CALL histwrite_p(hist_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'rain', kjit, precip_rain, kjpindex, index)
+       CALL histwrite_p(hist_id, 'snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'SWI', kjit, swi, kjpindex, index)
+       !
+       IF ( control_in%do_floodplains ) THEN
+          CALL histwrite_p(hist_id, 'floodout', kjit, floodout, kjpindex, index)
+       ENDIF
+       !
+       IF ( hist2_id > 0 ) THEN
+          DO jst=1,nstm
+             ! var_name= "mc_1" ... "mc_3"
+             WRITE (var_name,"('moistc_',i1)") jst
+             CALL histwrite_p(hist2_id, trim(var_name), kjit,mc(:,:,jst), kjpindex*nslm, indexlayer)
+
+             ! var_name= "kfactroot_1" ... "kfactroot_3"
+             WRITE (var_name,"('kfactroot_',i1)") jst
+             CALL histwrite_p(hist2_id, trim(var_name), kjit, kfact_root(:,:,jst), kjpindex*nslm, indexlayer)
+
+             ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+             WRITE (var_name,"('vegetsoil_',i1)") jst
+             CALL histwrite_p(hist2_id, trim(var_name), kjit,corr_veg_soil(:,:,jst), kjpindex*nvm, indexveg)
+          ENDDO
+          CALL histwrite_p(hist2_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
+          CALL histwrite_p(hist2_id, 'humtot', kjit, humtot, kjpindex, index)
+          njsc_tmp(:)=njsc(:)
+          CALL histwrite_p(hist2_id, 'soilindex', kjit, njsc_tmp, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'drainage', kjit, drainage, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'runoff', kjit, runoff, kjpindex, index)
+          IF ( control_in%do_floodplains ) THEN
+             CALL histwrite_p(hist2_id, 'floodout', kjit, floodout, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'rain', kjit, precip_rain, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'SWI', kjit, swi, kjpindex, index) 
+          !
+          IF (check_waterbal) THEN
+             CALL histwrite_p(hist2_id, 'TotWater', kjit, tot_water_end, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'TotWaterFlux', kjit, tot_flux, kjpindex, index)
+          ENDIF
+       ENDIF
+    ELSE
+       CALL histwrite_p(hist_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Qs', kjit, runoff, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Qsb', kjit, drainage, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Qsm', kjit, tot_melt, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelSWE', kjit, delswe, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
+       !
+       CALL histwrite_p(hist_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
+       CALL histwrite_p(hist_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+       !
+       CALL histwrite_p(hist_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+       !
+       CALL histwrite_p(hist_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
+       !
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qs', kjit, runoff, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qsb', kjit, drainage, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qsm', kjit, tot_melt, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSWE', kjit, delswe, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
+          !
+          CALL histwrite_p(hist2_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
+          CALL histwrite_p(hist2_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+          !
+          CALL histwrite_p(hist2_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+          !
+          CALL histwrite_p(hist2_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
+       ENDIF
+    ENDIF
+
+    IF (l_second_hydrol) THEN 
+       l_second_hydrol=.FALSE.
+    ENDIF
+    IF (long_print) WRITE (numout,*) ' hydrol_main Done '
+
+    ! For dissolved organic carbon calulation in stomate
+    soil_mc(:,:,:)=zero
+    litter_mc(:,:)=zero
+    soil_mc(:,:,:)=mc(:,:,:)
+    litter_mc(:,:)= tmc_litter(:,:)
+
+  END SUBROUTINE hydrol_main
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_init
+!!
+!>\BRIEF        Initializations and memory allocation   
+!!
+!! DESCRIPTION  :
+!! - 1 Some initializations
+!! - 2 make dynamic allocation with good dimension
+!! - 2.1 array allocation for soil textur
+!! - 2.2 Soil texture choice
+!! - 3 Other array allocation
+!! - 4 Open restart input file and read data for HYDROLOGIC process
+!! - 5 get restart values if none were found in the restart file
+!! - 6 Vegetation array      
+!! - 7 set humrelv from us
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!!_ hydrol_init
+
+  SUBROUTINE hydrol_init(kjit, ldrestart_read, kjpindex, index, rest_id, veget_max, soiltile, humrel,&
+       &  vegstress, snow, snow_age, snow_nobio, snow_nobio_age, qsintveg)
+
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT (in)                         :: kjit               !! Time step number 
+    LOGICAL,INTENT (in)                                 :: ldrestart_read     !! Logical for _restart_ file to read
+    INTEGER(i_std), INTENT (in)                         :: kjpindex           !! Domain size
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index              !! Indeces of the points on the map
+    INTEGER(i_std), INTENT (in)                         :: rest_id            !! _Restart_ file identifier 
+    ! input fields
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget_max          !! Carte de vegetation max
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)  :: soiltile           !! Fraction of each soil tile (0-1, unitless)
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: humrel             !! Stress hydrique, relative humidity
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: vegstress          !! Veg. moisture stress (only for vegetation growth)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: snow               !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: snow_age           !! Snow age
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio       !! Snow on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio_age   !! Snow age on ice, lakes, ...
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)  :: qsintveg           !! Water on vegetation due to interception
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ier                   !! Error code
+    INTEGER(i_std)                                     :: ji, jv, jst, jsl, jsc !! Indices
+    INTEGER(i_std), PARAMETER                          :: error_level = 3       !! Error level for consistency check
+                                                                                !! Switch to 2 tu turn fatal errors into warnings  
+
+!_ ================================================================================================================================
+
+    ! initialisation
+    IF (l_first_hydrol) THEN 
+       l_first_hydrol=.FALSE.
+    ELSE 
+       WRITE (numout,*) ' l_first_hydrol false . we stop '
+       STOP 'hydrol_init'
+    ENDIF
+
+    !
+    !! 1 Some initializations
+    !
+    !
+    !Config Key   = CHECK_CWRR
+    !Config Desc  = Should we check detailed CWRR water balance ?
+    !Config Def   = FALSE
+    !Config If    = HYDROL_CWRR
+    !Config Help  = This parameters allows the user to check
+    !Config         the detailed water balance in each time step
+    !Config         of CWRR.
+    !Config Units = [FLAG]
+    !
+    check_cwrr = .FALSE.
+    CALL getin_p('CHECK_CWRR', check_cwrr)
+    !
+    !Config Key   = DO_PONDS
+    !Config Desc  = Should we include ponds 
+    !Config Def   = FALSE
+    !Config If    = HYDROL_CWRR
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the ponds and return 
+    !Config         the water into the soil moisture. If this is 
+    !Config         activated, then there is no reinfiltration 
+    !Config         computed inside the hydrol module.
+    !Config Units = [FLAG]
+    !
+    doponds = .FALSE.
+    CALL getin_p('DO_PONDS', doponds)
+    
+
+    !! 2 make dynamic allocation with good dimension
+
+    !! 2.1 array allocation for soil texture
+
+    ALLOCATE (nvan(nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in nvan allocation. We stop. We need nscm words = ',nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (avan(nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in avan allocation. We stop. We need nscm words = ',nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (mcr(nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mcr allocation. We stop. We need nscm words = ',nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (mcs(nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mcs allocation. We stop. We need nscm words = ',nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (ks(nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in ks allocation. We stop. We need nscm words = ',nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (pcent(nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in pcent allocation. We stop. We need nscm words = ',nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (free_drain_max(nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in free_drain_max allocation. We stop. We need nscm words = ',nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (mcf(nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mcf allocation. We stop. We need nscm words = ',nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (mcw(nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mcw allocation. We stop. We need nscm words = ',nscm
+       STOP 'hydrol_init'
+    END IF
+    
+    ALLOCATE (mc_awet(nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mc_awet allocation. We stop. We need nscm words = ',nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (mc_adry(nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mc_adry allocation. We stop. We need nscm words = ',nscm
+       STOP 'hydrol_init'
+    END IF
+       
+    !!__2.2 Soil texture choose
+
+    SELECTCASE (nscm)
+    CASE (3)
+              
+       nvan(:) = nvan_fao(:)       
+       avan(:) = avan_fao(:)
+       mcr(:) = mcr_fao(:)
+       mcs(:) = mcs_fao(:)
+       ks(:) = ks_fao(:)
+       pcent(:) = pcent_fao(:)
+       free_drain_max(:) = free_drain_max_fao(:)
+       mcf(:) = mcf_fao(:)
+       mcw(:) = mcw_fao(:)
+       mc_awet(:) = mc_awet_fao(:)
+       mc_adry(:) = mc_adry_fao(:)
+       
+    CASE (12)
+       
+       nvan(:) = nvan_usda(:)
+       avan(:) = avan_usda(:)
+       mcr(:) = mcr_usda(:)
+       mcs(:) = mcs_usda(:)
+       ks(:) = ks_usda(:)
+       pcent(:) = pcent_usda(:)
+       free_drain_max(:) = free_drain_max_usda(:)
+       mcf(:) = mcf_usda(:)
+       mcw(:) = mcw_usda(:)
+       mc_awet(:) = mc_awet_usda(:)
+       mc_adry(:) = mc_adry_usda(:)
+       
+    CASE DEFAULT
+       WRITE (numout,*) 'Unsupported soil type classification. Choose between zobler, fao and usda according to the map'
+       STOP 'hydrol_init'
+    ENDSELECT
+
+
+    !! 2.3 Read in the run.def the parameters values defined by the user
+
+    !Config Key   = CWRR_N_VANGENUCHTEN
+    !Config Desc  = Van genuchten coefficient n
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 1.89, 1.56, 1.31
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [-]
+    CALL getin_p("CWRR_N_VANGENUCHTEN",nvan)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(nvan(:) <= zero) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for CWRR_N_VANGENUCHTEN.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_A_VANGENUCHTEN
+    !Config Desc  = Van genuchten coefficient a
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.0075, 0.0036, 0.0019
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [1/mm]  
+    CALL getin_p("CWRR_A_VANGENUCHTEN",avan)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(avan(:) <= zero) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for CWRR_A_VANGENUCHTEN.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_RESIDUAL
+    !Config Desc  = Residual soil water content
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.065, 0.078, 0.095
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [mm]  
+    CALL getin_p("VWC_RESIDUAL",mcr)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcr(:) < zero) .OR. ANY(mcr(:) > 1.)  ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_RESIDUAL.", &
+            &     "This parameter is ranged between 0 and 1. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+    
+    !Config Key   = VWC_SAT
+    !Config Desc  = Saturated soil water content
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.41, 0.43, 0.41
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [-]  
+    CALL getin_p("VWC_SAT",mcs)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcs(:) < zero) .OR. ANY(mcs(:) > 1.) .OR. ANY(mcs(:) <= mcr(:)) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_SAT.", &
+            &     "This parameter should be greater than VWC_RESIDUAL and less than 1. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_KS 
+    !Config Desc  = Hydraulic conductivity Saturation
+    !Config If    = HYDROL_CWRR 
+    !Config Def   = 1060.8, 249.6, 62.4
+    !Config Help  = This parameter will be constant over the entire 
+    !Config         simulated domain, thus independent from soil
+    !Config         texture.   
+    !Config Units = [mm/d]   
+    CALL getin_p("CWRR_KS",ks)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(ks(:) <= zero) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for CWRR_KS.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = WETNESS_TRANSPIR_MAX
+    !Config Desc  = Soil moisture above which transpir is max
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.5, 0.5, 0.5
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [-]    
+    CALL getin_p("WETNESS_TRANSPIR_MAX",pcent)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(pcent(:) <= zero) .OR. ANY(pcent(:) > 1.) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for WETNESS_TRANSPIR_MAX.", &
+            &     "This parameter should be positive and less or equals than 1. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = DRAINAGE_FACTOR_F
+    !Config Desc  = Max value of the permeability coeff at the bottom of the soil 
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 1.0, 1.0, 1.0 
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [-]   
+    CALL getin_p("DRAINAGE_FACTOR_F",free_drain_max)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(free_drain_max(:) < zero) .OR. ANY(free_drain_max(:) > 1.) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for DRAINAGE_FACTOR_F.", &
+            &     "This parameter should be positive and not greater than 1. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_FC 
+    !Config Desc  = Volumetric water content field capacity
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.32, 0.32, 0.32
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [-]   
+    CALL getin_p("VWC_FC",mcf)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcf(:) > mcs(:)) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_FC.", &
+            &     "This parameter should be less than VWC_SAT. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_WP
+    !Config Desc  = Volumetric water content Wilting pt
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.10, 0.10, 0.10 
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [-]   
+    CALL getin_p("VWC_WP",mcw)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mcw(:) > mcf(:)) .OR. ANY(mcw(:) < mcr(:)) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_WP.", &
+            &     "This parameter should be greater or equal than VWC_RESIDUAL and less or equal than VWC_SAT.", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_MIN_FOR_WET_ALB
+    !Config Desc  = Vol. wat. cont. above which albedo is cst
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.25, 0.25, 0.25
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [-]  
+    CALL getin_p("VWC_MIN_FOR_WET_ALB",mc_awet)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mc_awet(:) < 0) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_MIN_FOR_WET_ALB.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = VWC_MAX_FOR_DRY_ALB
+    !Config Desc  = Vol. wat. cont. below which albedo is cst
+    !Config If    = HYDROL_CWRR
+    !Config Def   = 0.1, 0.1, 0.1
+    !Config Help  = This parameter is independent from soil texture for
+    !Config         the time being.
+    !Config Units = [-]   
+    CALL getin_p("VWC_MAX_FOR_DRY_ALB",mc_adry)
+
+    !! Check parameter value (correct range)
+    IF ( ANY(mc_adry(:) < 0) .OR. ANY(mc_adry(:) > mc_awet(:)) ) THEN
+       CALL ipslerr_p(error_level, "hydrol_init.", &
+            &     "Wrong parameter value for VWC_MAX_FOR_DRY_ALB.", &
+            &     "This parameter should be positive and not greater than VWC_MIN_FOR_WET_ALB.", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !! 3 Other array allocation
+
+
+    ALLOCATE (mask_veget(kjpindex,nvm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mask_veget allocation. We stop. We need kjpindex*nvm words = ',kjpindex*nvm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (mask_soiltile(kjpindex,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mask_soiltile allocation. We stop. We need kjpindex*nstm words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (humrelv(kjpindex,nvm,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in humrelv allocation. We stop. We need kjpindex words = ',kjpindex*nvm*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (vegstressv(kjpindex,nvm,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vegstressv allocation. We stop. We need kjpindex words = ',kjpindex*nvm*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (us(kjpindex,nvm,nstm,nslm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in us allocation. We stop. We need kjpindex words = ',kjpindex*nvm*nstm*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (precisol(kjpindex,nvm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in precisol allocation. We stop. We need kjpindex words = ',kjpindex*nvm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (precisol_ns(kjpindex,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in precisol_ns allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (free_drain_coef(kjpindex,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in free_drain_coef allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (frac_bare_ns(kjpindex,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in frac_bare_ns allocation. We stop. We need kjpindex*nstm words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (water2infilt(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in water2infilt allocation. We stop. We need kjpindex*nstm words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (ae_ns(kjpindex,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in ae_ns allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (evap_bare_lim_ns(kjpindex,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in evap_bare_lim_ns allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (rootsink(kjpindex,nslm,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in rootsink allocation. We stop. We need kjpindex words = ',kjpindex*nslm*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (subsnowveg(kjpindex),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in subsnowveg allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (subsnownobio(kjpindex,nnobio),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in subsnownobio allocation. We stop. We need kjpindex words = ',kjpindex*nnobio
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (snowmelt(kjpindex),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in snowmelt allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (icemelt(kjpindex),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in icemelt allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (subsinksoil(kjpindex),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in subsinksoil allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (mx_eau_var(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mx_eau_var allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (vegtot(kjpindex),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vegtot allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (resdist(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in resdist allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (humtot(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in humtot allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (flux(kjpindex),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in flux allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (resolv(kjpindex),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in resolv allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (k(kjpindex,nslm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in k allocation. We stop. We need kjpindex*nslm words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (a(kjpindex,nslm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in a allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (b(kjpindex,nslm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in b allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (d(kjpindex,nslm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in d allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (e(kjpindex,nslm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in e allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (f(kjpindex,nslm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in f allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (g1(kjpindex,nslm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in g1 allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (ep(kjpindex,nslm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in ep allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (fp(kjpindex,nslm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in fp allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (gp(kjpindex,nslm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in gp allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (rhs(kjpindex,nslm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in rhs allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (srhs(kjpindex,nslm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in srhs allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (gam(kjpindex,nslm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in gam allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmc(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmc allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmcs(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmcs allocation. We stop. We need kjpindex*nstm words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmcr(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmcr allocation. We stop. We need kjpindex*nstm words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmc_litter(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmc_litter allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmc_litt_mea(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmc_litt_mea allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmc_litter_res(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmc_litter_res allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmc_litter_wilt(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmc_litter_wilt allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmc_litter_field(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmc_litter_field allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmc_litter_sat(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmc_litter_sat allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmc_litter_awet(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmc_litter_awet allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmc_litter_adry(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmc_litter_adry allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmc_litt_wet_mea(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmc_litt_wet_mea allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmc_litt_dry_mea(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmc_litt_dry_mea allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (v1(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in v1 allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (qflux00(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in qflux00 allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (ru_ns(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in ru_ns allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+    ru_ns(:,:) = zero
+
+    ALLOCATE (dr_ns(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in dr_ns allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+    dr_ns(:,:) = zero
+
+    ALLOCATE (tr_ns(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tr_ns allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (cvs_over_veg(kjpindex,nvm,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in cvs_over_veg allocation. We stop. We need kjpindex*nvm*nstm words = ',kjpindex*nvm*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (corr_veg_soil(kjpindex,nvm,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in corr_veg_soil allocation. We stop. We need kjpindex*nvm*nstm words = ',kjpindex*nvm*nstm
+       STOP 'hydrol_init'
+    END IF
+
+
+    ALLOCATE (mc(kjpindex,nslm,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mc allocation. We stop. We need kjpindex words = ',kjpindex*nslm*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (soilmoist(kjpindex,nslm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in soilmoist allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (soil_wet(kjpindex,nslm,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in soil_wet allocation. We stop. We need kjpindex words = ',kjpindex*nslm*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (soil_wet_litter(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in soil_wet allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (qflux(kjpindex,nslm,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in qflux allocation. We stop. We need kjpindex words = ',kjpindex*nslm*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (tmat(kjpindex,nslm,3),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmat allocation. We stop. We need kjpindex words = ',kjpindex*nslm*trois
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (stmat(kjpindex,nslm,3),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in stmat allocation. We stop. We need kjpindex words = ',kjpindex*nslm*trois
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (nroot(nvm, nstm, nslm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in nroot allocation. We stop. We need nvm*nstm*nslm words = ',nvm * nstm * nslm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (kfact_root(kjpindex, nslm, nstm), stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE (numout,*) 'error in kfact_root allocation, We stop. We need kjpindex*nslm*nstm words = ',kjpindex*nslm*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (kfact(nslm, nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in kfact allocation. We stop. We need nslm*nscm words = ',nslm * nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (zz(nslm+1, nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in zz allocation. We stop. We need (nslm+1)*nstm words = ',(nslm+1) * nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (dz(nslm+1, nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in dz allocation. We stop. We need (nslm+1)*nstm words = ',(nslm+1) * nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (mc_lin(imin:imax, nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mc_lin allocation. We stop. We need (imax-imin)*nscm words = ',(imax-imin) * nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (k_lin(imin:imax, nslm, nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in k_lin allocation. We stop. We need (imax-imin)*nslm*nscm words = ',(imax-imin) * nslm * nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (d_lin(imin:imax, nslm, nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in d_lin allocation. We stop. We need (imax-imin)*nslm*nscm words = ',(imax-imin) * nslm * nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (a_lin(imin:imax, nslm, nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in a_lin allocation. We stop. We need (imax-imin)*nslm*nscm words = ',(imax-imin) * nslm * nscm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (b_lin(imin:imax, nslm, nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in b_lin allocation. We stop. We need (imax-imin)*nslm*nscm words = ',(imax-imin) * nslm * nscm
+       STOP 'hydrol_init'
+    END IF
+
+    !  If we check the water balance we need two more variables
+    IF ( check_waterbal ) THEN
+
+       ALLOCATE (tot_water_beg(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_water_beg allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+       ALLOCATE (tot_water_end(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_water_end allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+       ALLOCATE (tot_flux(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_flux allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+    ENDIF
+
+    ! Soil Wetness Index
+    ALLOCATE (swi(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in swi. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    ENDIF  
+ 
+    !
+    !  If we use the almaoutputs we need a few more variables
+    !  tdo - they could be allocated only if alma_output, but then they should also be computed only if alma_output
+    !
+    IF ( almaoutput ) THEN
+
+       ALLOCATE (tot_watveg_beg(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_watveg_beg allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+       ALLOCATE (tot_watveg_end(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_watveg_end allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+       ALLOCATE (tot_watsoil_beg(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_watsoil_beg allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+       ALLOCATE (tot_watsoil_end(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_watsoil_end allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+       ALLOCATE (delsoilmoist(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in delsoilmoist allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+       ALLOCATE (delintercept(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in delintercept. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+       ALLOCATE (delswe(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in delswe. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrol_init'
+       ENDIF
+
+       ALLOCATE (snow_beg(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in snow_beg allocation. We stop. We need kjpindex words =',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+       ALLOCATE (snow_end(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in snow_end allocation. We stop. We need kjpindex words =',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+    ENDIF
+
+    !! 4 Open restart input file and read data for HYDROLOGIC process
+
+    IF (ldrestart_read) THEN
+
+       IF (long_print) WRITE (numout,*) ' we have to read a restart file for HYDROLOGIC variables'
+
+       IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
+       !
+       DO jst=1,nstm
+          ! var_name= "mc_1" ... "mc_3"
+           WRITE (var_name,"('moistc_',I1)") jst
+           IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME',var_name)
+           CALL restget_p (rest_id, var_name, nbp_glo, nslm , 1, kjit, .TRUE., mc(:,:,jst), "gather", nbp_glo, index_g)
+       END DO
+       !
+       IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
+       DO jst=1,nstm
+          DO jsl=1,nslm
+             ! var_name= "us_1_01" ... "us_3_11"
+             WRITE (var_name,"('us_',i1,'_',i2.2)") jst,jsl
+             IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME',var_name)
+             CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., us(:,:,jst,jsl), "gather", nbp_glo, index_g)
+          END DO
+       END DO
+       !
+       var_name= 'free_drain_coef'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Coefficient for free drainage at bottom of soil')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., free_drain_coef, "gather", nbp_glo, index_g)
+       !
+       var_name= 'water2infilt'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Remaining water to be infiltrated on top of the soil')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., water2infilt, "gather", nbp_glo, index_g)
+       !
+       var_name= 'ae_ns'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+          CALL ioconf_setatt_p('LONG_NAME','Bare soil evap on each soil type')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., ae_ns, "gather", nbp_glo, index_g)
+       !
+       var_name= 'snow'        
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+          CALL ioconf_setatt_p('LONG_NAME','Snow mass')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, 1  , 1, kjit, .TRUE., snow, "gather", nbp_glo, index_g)
+       !
+       var_name= 'snow_age'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', 'd')
+          CALL ioconf_setatt_p('LONG_NAME','Snow age')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, 1  , 1, kjit, .TRUE., snow_age, "gather", nbp_glo, index_g)
+       !
+       var_name= 'snow_nobio'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+          CALL ioconf_setatt_p('LONG_NAME','Snow on other surface types')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nnobio  , 1, kjit, .TRUE., snow_nobio, "gather", nbp_glo, index_g)
+       !
+       var_name= 'snow_nobio_age'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', 'd')
+          CALL ioconf_setatt_p('LONG_NAME','Snow age on other surface types')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nnobio  , 1, kjit, .TRUE., snow_nobio_age, "gather", nbp_glo, index_g)
+       !
+       var_name= 'vegstress'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Vegetation growth moisture stress')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., vegstress, "gather", nbp_glo, index_g)
+       !
+       var_name= 'qsintveg'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+          CALL ioconf_setatt_p('LONG_NAME','Intercepted moisture')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., qsintveg, "gather", nbp_glo, index_g)
+       !
+       var_name= 'resdist'
+       IF (is_root_prc) THEN
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Distribution of reservoirs')
+       ENDIF
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., resdist, "gather", nbp_glo, index_g)
+       !
+       IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
+       DO jst=1,nstm
+          ! var_name= "cvs_over_veg_1" ... "cvs_over_veg_3"
+          WRITE (var_name,"('cvs_over_veg_',i1)") jst
+          IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME',var_name)
+          CALL restget_p (rest_id, var_name, nbp_glo,  nvm, 1, kjit, .TRUE., cvs_over_veg(:,:,jst), "gather",  nbp_glo, index_g)
+       END DO
+       !
+       IF ( check_waterbal ) THEN
+          var_name= 'tot_water_beg'
+          IF (is_root_prc) THEN
+             CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+             CALL ioconf_setatt_p('LONG_NAME','Previous Total water')
+          ENDIF
+          CALL restget_p (rest_id, var_name, nbp_glo, 1  , 1, kjit, .TRUE., tot_water_beg, "gather", nbp_glo, index_g)
+       ENDIF
+
+
+    !! 5 get restart values if none were found in the restart file
+       !
+       !Config Key   = HYDROL_MOISTURE_CONTENT
+       !Config Desc  = Soil moisture on each soil tile and levels
+       !Config If    = HYDROL_CWRR       
+       !Config Def   = 0.3
+       !Config Help  = The initial value of mc if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units =
+       !
+       CALL setvar_p (mc, val_exp, 'HYDROL_MOISTURE_CONTENT', 0.3_r_std)
+       !
+       !Config Key   = US_INIT
+       !Config Desc  = US_NVM_NSTM_NSLM
+       !Config If    = HYDROL_CWRR       
+       !Config Def   = 0.0
+       !Config Help  = The initial value of us (relative moisture) if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units =
+       !
+       DO jsl=1,nslm
+          CALL setvar_p (us(:,:,:,jsl), val_exp, 'US_INIT', zero)
+       ENDDO
+       !
+       !Config Key   = FREE_DRAIN_COEF
+       !Config Desc  = Coefficient for free drainage at bottom
+       !Config If    = HYDROL_CWRR       
+       !Config Def   = 1.0, 1.0, 1.0
+       !Config Help  = The initial value of free drainage if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units =
+       !
+       CALL setvar_p (free_drain_coef, val_exp, 'FREE_DRAIN_COEF', free_drain_max)
+       !
+       !Config Key   = WATER_TO_INFILT
+       !Config Desc  = Water to be infiltrated on top of the soil
+       !Config If    = HYDROL_CWRR    
+       !Config Def   = 0.0
+       !Config Help  = The initial value of free drainage if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units =
+       !
+       CALL setvar_p (water2infilt, val_exp, 'WATER_TO_INFILT', zero)
+       !
+       !Config Key   = EVAPNU_SOIL
+       !Config Desc  = Bare soil evap on each soil if not found in restart
+       !Config If    = HYDROL_CWRR  
+       !Config Def   = 0.0
+       !Config Help  = The initial value of bare soils evap if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units =
+       !
+       CALL setvar_p (ae_ns, val_exp, 'EVAPNU_SOIL', zero)
+       !
+       !Config Key  = HYDROL_SNOW
+       !Config Desc  = Initial snow mass if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of snow mass if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units =
+       !
+       CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', zero)
+       !
+       !Config Key   = HYDROL_SNOWAGE
+       !Config Desc  = Initial snow age if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of snow age if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units =
+       !
+       CALL setvar_p (snow_age, val_exp, 'HYDROL_SNOWAGE', zero)
+       !
+       !Config Key   = HYDROL_SNOW_NOBIO
+       !Config Desc  = Initial snow amount on ice, lakes, etc. if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of snow if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units =
+       !
+       CALL setvar_p (snow_nobio, val_exp, 'HYDROL_SNOW_NOBIO', zero)
+       !
+       !Config Key   = HYDROL_SNOW_NOBIO_AGE
+       !Config Desc  = Initial snow age on ice, lakes, etc. if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of snow age if its value is not found
+       !Config         in the restart file. This should only be used if the model is 
+       !Config         started without a restart file.
+       !Config Units =
+       !
+       CALL setvar_p (snow_nobio_age, val_exp, 'HYDROL_SNOW_NOBIO_AGE', zero)
+       !
+       !Config Key   = HYDROL_QSV
+       !Config Desc  = Initial water on canopy if not found in restart
+       !Config If    = OK_SECHIBA
+       !Config Def   = 0.0
+       !Config Help  = The initial value of moisture on canopy if its value 
+       !Config         is not found in the restart file. This should only be used if
+       !Config         the model is started without a restart file. 
+       !Config Units =
+       !
+       CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', zero)
+
+
+    !! 6 Vegetation array      
+       !
+       ! There is no need to configure the initialisation of resdist. If not available it is the vegetation map
+       !
+       IF ( MINVAL(resdist) .EQ.  MAXVAL(resdist) .AND. MINVAL(resdist) .EQ. val_exp) THEN
+          resdist(:,:) = soiltile(:,:)
+       ENDIF
+       !
+       !  Remember that it is only frac_nobio + SUM(veget_max(,:)) that is equal to 1. Thus we need vegtot
+       !
+       DO ji = 1, kjpindex
+          vegtot(ji) = SUM(veget_max(ji,:))
+       ENDDO
+       !
+       !
+       ! compute the masks for veget
+
+
+       mask_veget(:,:) = 0
+       mask_soiltile(:,:) = 0
+
+       DO jst=1,nstm
+          DO ji = 1, kjpindex
+             IF(soiltile(ji,jst) .GT. min_sechiba) THEN
+                mask_soiltile(ji,jst) = 1
+             ENDIF
+          END DO
+       ENDDO
+          
+       DO jv = 1, nvm
+          DO ji = 1, kjpindex
+             IF(veget_max(ji,jv) .GT. min_sechiba) THEN
+                mask_veget(ji,jv) = 1
+             ENDIF
+          END DO
+       END DO
+          
+    !! 7 set humrelv from us
+
+       humrelv(:,:,:) = SUM(us,dim=4)
+       vegstressv(:,:,:) = humrelv(:,:,:)
+       ! set humrel from humrelv, assuming equi-repartition for the first time step
+
+       humrel(:,:) = zero
+       CALL setvar_p (cvs_over_veg, val_exp, 'NO_KEYWORD', un)
+
+       DO jst=1,nstm
+          DO jv=1,nvm
+             DO ji=1,kjpindex
+
+                vegstress(ji,jv)=vegstress(ji,jv) + vegstressv(ji,jv,jst) * &
+                     & soiltile(ji,jst) * cvs_over_veg(ji,jv,jst) * vegtot(ji)
+
+                humrel(ji,jv)=humrel(ji,jv) + humrelv(ji,jv,jst) * & 
+                     & soiltile(ji,jst) * cvs_over_veg(ji,jv,jst) * vegtot(ji)
+                humrel(ji,jv)=MAX(humrel(ji,jv), zero)* mask_veget(ji,jv)           
+             END DO
+          END DO
+       END DO
+    ENDIF
+    !
+    !
+    IF (long_print) WRITE (numout,*) ' hydrol_init done '
+    !
+  END SUBROUTINE hydrol_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_clear
+!!
+!>\BRIEF        Deallocate arrays 
+!!
+!_ ================================================================================================================================
+!_ hydrol_clear
+
+  SUBROUTINE hydrol_clear()
+
+    l_first_hydrol=.TRUE.
+
+    ! Allocation for soiltile related parameters
+    IF ( ALLOCATED (nvan)) DEALLOCATE (nvan)
+    IF ( ALLOCATED (avan)) DEALLOCATE (avan)
+    IF ( ALLOCATED (mcr)) DEALLOCATE (mcr)
+    IF ( ALLOCATED (mcs)) DEALLOCATE (mcs)
+    IF ( ALLOCATED (ks)) DEALLOCATE (ks)
+    IF ( ALLOCATED (pcent)) DEALLOCATE (pcent)
+    IF ( ALLOCATED (free_drain_max)) DEALLOCATE (free_drain_max)
+    IF ( ALLOCATED (mcf)) DEALLOCATE (mcf)
+    IF ( ALLOCATED (mcw)) DEALLOCATE (mcw)
+    IF ( ALLOCATED (mc_awet)) DEALLOCATE (mc_awet)
+    IF ( ALLOCATED (mc_adry)) DEALLOCATE (mc_adry)
+    ! Other arrays
+    IF (ALLOCATED (mask_veget)) DEALLOCATE (mask_veget)
+    IF (ALLOCATED (mask_soiltile)) DEALLOCATE (mask_soiltile)
+    IF (ALLOCATED (humrelv)) DEALLOCATE (humrelv)
+    IF (ALLOCATED (vegstressv)) DEALLOCATE (vegstressv)
+    IF (ALLOCATED (us)) DEALLOCATE (us)
+    IF (ALLOCATED  (precisol)) DEALLOCATE (precisol)
+    IF (ALLOCATED  (precisol_ns)) DEALLOCATE (precisol_ns)
+    IF (ALLOCATED  (free_drain_coef)) DEALLOCATE (free_drain_coef)
+    IF (ALLOCATED  (frac_bare_ns)) DEALLOCATE (frac_bare_ns)
+    IF (ALLOCATED  (water2infilt)) DEALLOCATE (water2infilt)
+    IF (ALLOCATED  (ae_ns)) DEALLOCATE (ae_ns)
+    IF (ALLOCATED  (evap_bare_lim_ns)) DEALLOCATE (evap_bare_lim_ns)
+    IF (ALLOCATED  (rootsink)) DEALLOCATE (rootsink)
+    IF (ALLOCATED  (subsnowveg)) DEALLOCATE (subsnowveg)
+    IF (ALLOCATED  (subsnownobio)) DEALLOCATE (subsnownobio)
+    IF (ALLOCATED  (snowmelt)) DEALLOCATE (snowmelt)
+    IF (ALLOCATED  (icemelt)) DEALLOCATE (icemelt)
+    IF (ALLOCATED  (subsinksoil)) DEALLOCATE (subsinksoil)
+    IF (ALLOCATED  (mx_eau_var)) DEALLOCATE (mx_eau_var)
+    IF (ALLOCATED  (vegtot)) DEALLOCATE (vegtot)
+    IF (ALLOCATED  (resdist)) DEALLOCATE (resdist)
+    IF (ALLOCATED  (tot_water_beg)) DEALLOCATE (tot_water_beg)
+    IF (ALLOCATED  (tot_water_end)) DEALLOCATE (tot_water_end)
+    IF (ALLOCATED  (tot_flux)) DEALLOCATE (tot_flux)
+    IF (ALLOCATED  (tot_watveg_beg)) DEALLOCATE (tot_watveg_beg)
+    IF (ALLOCATED  (tot_watveg_end)) DEALLOCATE (tot_watveg_end)
+    IF (ALLOCATED  (tot_watsoil_beg)) DEALLOCATE (tot_watsoil_beg)
+    IF (ALLOCATED  (tot_watsoil_end)) DEALLOCATE (tot_watsoil_end)
+    IF (ALLOCATED  (delsoilmoist)) DEALLOCATE (delsoilmoist)
+    IF (ALLOCATED  (delintercept)) DEALLOCATE (delintercept)
+    IF (ALLOCATED  (snow_beg)) DEALLOCATE (snow_beg)
+    IF (ALLOCATED  (snow_end)) DEALLOCATE (snow_end)
+    IF (ALLOCATED  (delswe)) DEALLOCATE (delswe)
+    IF (ALLOCATED  (swi)) DEALLOCATE (swi)
+    ! more allocation for cwrr scheme
+    IF (ALLOCATED  (v1)) DEALLOCATE (v1)
+    IF (ALLOCATED  (humtot)) DEALLOCATE (humtot)
+    IF (ALLOCATED  (flux)) DEALLOCATE (flux)
+    IF (ALLOCATED  (resolv)) DEALLOCATE (resolv)
+    IF (ALLOCATED  (k)) DEALLOCATE (k)
+    IF (ALLOCATED  (a)) DEALLOCATE (a)
+    IF (ALLOCATED  (b)) DEALLOCATE (b)
+    IF (ALLOCATED  (d)) DEALLOCATE (d)
+    IF (ALLOCATED  (e)) DEALLOCATE (e)
+    IF (ALLOCATED  (f)) DEALLOCATE (f)
+    IF (ALLOCATED  (g1)) DEALLOCATE (g1)
+    IF (ALLOCATED  (ep)) DEALLOCATE (ep)
+    IF (ALLOCATED  (fp)) DEALLOCATE (fp)
+    IF (ALLOCATED  (gp)) DEALLOCATE (gp)
+    IF (ALLOCATED  (rhs)) DEALLOCATE (rhs)
+    IF (ALLOCATED  (srhs)) DEALLOCATE (srhs)
+    IF (ALLOCATED  (gam)) DEALLOCATE (gam)
+    IF (ALLOCATED  (tmc)) DEALLOCATE (tmc)
+    IF (ALLOCATED  (tmcs)) DEALLOCATE (tmcs)
+    IF (ALLOCATED  (tmcr)) DEALLOCATE (tmcr)
+    IF (ALLOCATED  (tmc_litter)) DEALLOCATE (tmc_litter)
+    IF (ALLOCATED  (tmc_litt_mea)) DEALLOCATE (tmc_litt_mea)
+    IF (ALLOCATED  (tmc_litter_res)) DEALLOCATE (tmc_litter_res)
+    IF (ALLOCATED  (tmc_litter_wilt)) DEALLOCATE (tmc_litter_wilt)
+    IF (ALLOCATED  (tmc_litter_field)) DEALLOCATE (tmc_litter_field)
+    IF (ALLOCATED  (tmc_litter_sat)) DEALLOCATE (tmc_litter_sat)
+    IF (ALLOCATED  (tmc_litter_awet)) DEALLOCATE (tmc_litter_awet)
+    IF (ALLOCATED  (tmc_litter_adry)) DEALLOCATE (tmc_litter_adry)
+    IF (ALLOCATED  (tmc_litt_wet_mea)) DEALLOCATE (tmc_litt_wet_mea)
+    IF (ALLOCATED  (tmc_litt_dry_mea)) DEALLOCATE (tmc_litt_dry_mea)
+    IF (ALLOCATED  (qflux00)) DEALLOCATE (qflux00)
+    IF (ALLOCATED  (ru_ns)) DEALLOCATE (ru_ns)
+    IF (ALLOCATED  (dr_ns)) DEALLOCATE (dr_ns)
+    IF (ALLOCATED  (tr_ns)) DEALLOCATE (tr_ns)
+    IF (ALLOCATED  (cvs_over_veg)) DEALLOCATE (cvs_over_veg)
+    IF (ALLOCATED  (corr_veg_soil)) DEALLOCATE (corr_veg_soil)
+    IF (ALLOCATED  (mc)) DEALLOCATE (mc)
+    IF (ALLOCATED  (soilmoist)) DEALLOCATE (soilmoist)
+    IF (ALLOCATED  (soil_wet)) DEALLOCATE (soil_wet)
+    IF (ALLOCATED  (soil_wet_litter)) DEALLOCATE (soil_wet_litter)
+    IF (ALLOCATED  (qflux)) DEALLOCATE (qflux)
+    IF (ALLOCATED  (tmat)) DEALLOCATE (tmat)
+    IF (ALLOCATED  (stmat)) DEALLOCATE (stmat)
+    IF (ALLOCATED  (nroot)) DEALLOCATE (nroot)
+    IF (ALLOCATED  (kfact_root)) DEALLOCATE (kfact_root)
+    IF (ALLOCATED  (kfact)) DEALLOCATE (kfact)
+    IF (ALLOCATED  (zz)) DEALLOCATE (zz)
+    IF (ALLOCATED  (dz)) DEALLOCATE (dz)
+    IF (ALLOCATED  (mc_lin)) DEALLOCATE (mc_lin)
+    IF (ALLOCATED  (k_lin)) DEALLOCATE (k_lin)
+    IF (ALLOCATED  (d_lin)) DEALLOCATE (d_lin)
+    IF (ALLOCATED  (a_lin)) DEALLOCATE (a_lin)
+    IF (ALLOCATED  (b_lin)) DEALLOCATE (b_lin)
+
+    RETURN 
+
+  END SUBROUTINE hydrol_clear
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_tmc_update
+!!
+!>\BRIEF        This routine updates the soil moisture profiles when the vegetation fraction have changed. 
+!!
+!! DESCRIPTION  :
+!! 
+!!    This routine update tmc and mc with variation of veget_max (LAND_USE or DGVM activated)
+!! 
+!!
+!!
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_tmc_update
+  SUBROUTINE hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, resdist )
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                          :: kjpindex      !! domain size
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget_max     !! max fraction of vegetation type
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile      !! Fraction of each soil tile (0-1, unitless)
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)   :: qsintveg   !! Amount of water in the canopy interception 
+    REAL(r_std), DIMENSION (kjpindex, nstm), INTENT(inout) :: resdist    !! Old vegetation map
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                           :: ji, jv, jst,jsl
+    LOGICAL                                  :: soil_upd        !! True if soiltile changed since last time step
+    LOGICAL                                  :: error=.FALSE.   !! If true, exit in the end of subroutine
+    REAL(r_std), DIMENSION(kjpindex,nstm)    :: vmr             !! Change in soiltile
+    REAL(r_std), DIMENSION(kjpindex)         :: vmr_sum
+    REAL(r_std), DIMENSION(kjpindex,nslm)    :: mc_dilu         !! Total loss of moisture content
+    REAL(r_std), DIMENSION(kjpindex)         :: infil_dilu      !! Total loss for water2infilt
+    REAL(r_std), DIMENSION(kjpindex,nstm)    :: tmc_old         !! tmc before calculations
+    REAL(r_std), DIMENSION(kjpindex,nstm)    :: water2infilt_old!! water2infilt before calculations
+    REAL(r_std), DIMENSION (kjpindex,nvm)    :: qsintveg_old    !! qsintveg before calculations
+    REAL(r_std), DIMENSION(kjpindex)         :: test
+
+    !! 0. Check if soiltiles changed since last time step
+    soil_upd=SUM(ABS(soiltile(:,:)-resdist(:,:))) .GT. zero
+    IF (long_print) WRITE (numout,*) 'soil_upd ', soil_upd
+
+    IF (check_cwrr) THEN
+       ! Save soil moisture for later use
+       tmc_old(:,:) = tmc(:,:) 
+       water2infilt_old(:,:) = water2infilt(:,:)
+       qsintveg_old(:,:) = qsintveg(:,:)
+    ENDIF
+
+    !! 1. If a PFT has disapperead as result from a veget_max change, 
+    !!    then add canopy water to surface water.
+
+    DO ji=1,kjpindex
+       DO jv=1,nvm
+          IF ((veget_max(ji,jv).LT.min_sechiba).AND.(qsintveg(ji,jv).GT.0.)) THEN
+             jst=pref_soil_veg(jv) ! soil tile index
+             water2infilt(ji,jst) = water2infilt(ji,jst) + qsintveg(ji,jv)/resdist(ji,jst)
+             qsintveg(ji,jv) = zero
+          ENDIF
+       ENDDO
+    ENDDO
+    
+    !! 2. Compute new soil moisture if soiltile changed due to veget_max's change
+    IF (soil_upd) THEN
+       !! 2.1 Define the change in soiltile
+       vmr(:,:) = soiltile(:,:) - resdist(:,:)  ! resdist is the previous values of soiltiles 
+
+       ! Total area loss by the three soil tiles
+       DO ji=1,kjpindex
+          vmr_sum(ji)=SUM(vmr(ji,:),MASK=vmr(ji,:).LT.zero)
+       ENDDO
+
+       !! 2.2 Shrinking soil tiles
+       !! 2.2.1 Total loss of moisture content from the shrinking soil tiles, expressed by soil layer
+       mc_dilu(:,:)=zero
+       DO jst=1,nstm
+          DO jsl = 1, nslm
+             DO ji=1,kjpindex
+                IF ( vmr(ji,jst) < zero ) THEN
+                   mc_dilu(ji,jsl) = mc_dilu(ji,jsl) + mc(ji,jsl,jst) * vmr(ji,jst) / vmr_sum(ji)
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+
+       !! 2.2.2 Total loss of water2inft from the shrinking soil tiles
+       infil_dilu(:)=zero
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF ( vmr(ji,jst) < zero ) THEN
+                infil_dilu(ji) = infil_dilu(ji) + water2infilt(ji,jst) * vmr(ji,jst) / vmr_sum(ji)
+             ENDIF
+          ENDDO
+       ENDDO
+
+       !! 2.3 Each gaining soil tile gets moisture proportionally to both the total loss and its areal increase 
+
+       ! As the original mc from each soil tile are in [mcr,mcs] and we do weighted avrage, the new mc are in [mcr,mcs]
+       ! The case where the soiltile is created (soiltile_old=0) works as the other cases
+
+       ! 2.3.1 Update mc(kjpindex,nslm,nstm) !m3/m3
+       DO jst=1,nstm
+          DO jsl = 1, nslm
+             DO ji=1,kjpindex
+                IF ( vmr(ji,jst) > zero ) THEN
+                   mc(ji,jsl,jst) = ( mc(ji,jsl,jst) * resdist(ji,jst) + mc_dilu(ji,jsl) * vmr(ji,jst) ) / soiltile(ji,jst)
+                   ! NB : soiltile can not be zero for case vmr > zero, see slowproc_veget
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+       
+       ! 2.3.2 Update water2inft
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF ( vmr(ji,jst) > zero ) THEN !donc soiltile>0     
+                water2infilt(ji,jst) = ( water2infilt(ji,jst) * resdist(ji,jst) + infil_dilu(ji) * vmr(ji,jst) ) / soiltile(ji,jst)
+             ENDIF !donc resdist>0
+          ENDDO
+       ENDDO
+
+       ! 2.3.3 Case where soiltile < min_sechiba 
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF ( soiltile(ji,jst) .LT. min_sechiba ) THEN
+                water2infilt(ji,jst) = zero
+                mc(ji,:,jst) = zero
+             ENDIF
+          ENDDO
+       ENDDO
+
+
+    ENDIF ! soil_upd 
+
+
+    !2.3.3 we compute tmc(kjpindex,nstm) and humtot!
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+             tmc(ji,jst) = dz(2,jst) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+             DO jsl = 2,nslm-1
+                tmc(ji,jst) = tmc(ji,jst) + dz(jsl,jst) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                     + dz(jsl+1,jst) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+             ENDDO
+             tmc(ji,jst) = tmc(ji,jst) + dz(nslm,jst) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+             tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
+       ENDDO
+    ENDDO
+
+    humtot(:) = zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          humtot(ji) = humtot(ji) + soiltile(ji,jst) * tmc(ji,jst)
+       ENDDO
+    ENDDO
+
+    !! 4 check
+    IF (check_cwrr) THEN
+       DO ji=1,kjpindex
+          test(ji) = ABS(SUM(tmc(ji,:)*soiltile(ji,:)) - SUM(tmc_old(ji,:)*resdist(ji,:)) + &
+               SUM(qsintveg(ji,:)) - SUM(qsintveg_old(ji,:))) ! sum(soiltile)=1
+          IF ( test(ji) .GT.  10.*allowed_err ) THEN
+             WRITE(numout,*) 'tmc update WRONG: ji',ji
+             WRITE(numout,*) 'tot water avant:',SUM(tmc_old(ji,:)*resdist(ji,:)) + SUM(qsintveg_old(ji,:))
+             WRITE(numout,*) 'tot water apres:',SUM(tmc(ji,:)*soiltile(ji,:)) + SUM(qsintveg(ji,:))
+             WRITE(numout,*) 'err:',test(ji)
+             WRITE(numout,*) 'allowed_err:',allowed_err
+             WRITE(numout,*) 'tmc:',tmc(ji,:)
+             WRITE(numout,*) 'tmc_old:',tmc_old(ji,:)
+             WRITE(numout,*) 'qsintveg:',qsintveg(ji,:)
+             WRITE(numout,*) 'qsintveg_old:',qsintveg_old(ji,:)
+             WRITE(numout,*) 'SUMqsintveg:',SUM(qsintveg(ji,:))
+             WRITE(numout,*) 'SUMqsintveg_old:',SUM(qsintveg_old(ji,:))
+             WRITE(numout,*) 'veget_max:',veget_max(ji,:)
+             WRITE(numout,*) 'soiltile:',soiltile(ji,:)
+             WRITE(numout,*) 'resdist:',resdist(ji,:)
+             WRITE(numout,*) 'vmr:',vmr(ji,:)
+             WRITE(numout,*) 'vmr_sum:',vmr_sum(ji)
+             DO jst=1,nstm
+                WRITE(numout,*) 'mc(',jst,'):',mc(ji,:,jst)
+             ENDDO
+             WRITE(numout,*) 'water2infilt:',water2infilt(ji,:)
+             WRITE(numout,*) 'water2infilt_old:',water2infilt_old(ji,:)
+             WRITE(numout,*) 'infil_dilu:',infil_dilu(ji)
+             WRITE(numout,*) 'mc_dilu:',mc_dilu(ji,:)
+
+             error=.TRUE.
+             CALL ipslerr_p(2, 'hydrol_tmc_update', 'Error in water balance', 'We STOP in the end of this subroutine','')
+          ENDIF
+       ENDDO
+    ENDIF
+
+    !! Now that the work is done, update resdist
+    resdist(:,:) = soiltile(:,:)
+
+    !
+    !!  Exit if error was found previously in this subroutine
+    !
+    IF ( error ) THEN
+       WRITE(numout,*) 'One or more errors have been detected in hydrol_tmc_update. Model stops.'
+       CALL ipslerr_p(3, 'hydrol_tmc_update', 'We will STOP now.',&
+                  & 'One or several fatal errors were found previously.','')
+    END IF
+
+    IF (long_print) WRITE (numout,*) ' hydrol_tmc_update done '
+
+  END SUBROUTINE hydrol_tmc_update
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_var_init
+!!
+!>\BRIEF        This routine initializes HYDROLOGIC variables.  
+!!
+!! DESCRIPTION  :
+!! - 1 compute the depths
+!! - 2 compute the profile for roots
+!! - 3 compute the profile for ksat, a and n Van Genuchten parameter
+!! - 4 compute the linearized values of k, a, b and d for the resolution of Fokker Planck equation
+!! - 5 water reservoirs initialisation
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_var_init
+
+  SUBROUTINE hydrol_var_init (kjpindex, veget, veget_max, soiltile, njsc, mx_eau_var, shumdiag, k_litt, &
+       & litterhumdiag, drysoil_frac, evap_bare_lim,qsintveg) 
+
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                          :: kjpindex      !! domain size
+    ! input fields
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget_max     !! max fraction of vegetation type
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget         !! fraction of vegetation type
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: njsc          !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless) 
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile      !! Fraction of each soil tile (0-1, unitless)
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: mx_eau_var    !!
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out) :: shumdiag      !! relative soil moisture
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: k_litt        !! litter cond.
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: litterhumdiag !! litter humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: drysoil_frac  !! function of litter humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)       :: evap_bare_lim !! 
+
+    !! 0.3 Modified variables
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)  :: qsintveg           !! Water on vegetation due to interception
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jv, jst, jsc, jsl, i
+    REAL(r_std)                                         :: m, frac
+    REAL(r_std)                                         :: avan_mod, nvan_mod !! modified VG parameters with exponantial profile
+    REAL(r_std), DIMENSION(nslm,nscm)                   :: afact, nfact  !! multiplicative factor for decay of a and n 
+    ! parameters for "soil densification" with depth
+    REAL(r_std)                                         :: dp_comp       !! depth at which the 'compacted value' (Van Genuchten) of 
+                                                                         !! ksat is reached 
+    REAL(r_std)                                         :: f_ks          !! exponential factor for decay of ksat with depth
+    ! Fixed parameters from fitted relationships
+    REAL(r_std)                                         :: n0            !! fitted value for relation log((n-n0)/(n_ref-n0)) = 
+                                                                         !! nk_rel * log(k/k_ref) 
+    REAL(r_std)                                         :: nk_rel        !! fitted value for relation log((n-n0)/(n_ref-n0)) = 
+                                                                         !! nk_rel * log(k/k_ref) 
+    REAL(r_std)                                         :: a0            !! fitted value for relation log((a-a0)/(a_ref-a0)) = 
+                                                                         !! ak_rel * log(k/k_ref) 
+    REAL(r_std)                                         :: ak_rel        !! fitted value for relation log((a-a0)/(a_ref-a0)) = 
+                                                                         !! ak_rel * log(k/k_ref) 
+    REAL(r_std)                                         :: kfact_max     !! Maximum factor for K due to depth
+    REAL(r_std)                                         :: k_tmp, tmc_litter_ratio
+    INTEGER(i_std), PARAMETER                           :: error_level = 3 !! Error level for consistency check
+                                                                           !! Switch to 2 tu turn fatal errors into warnings
+
+!_ ================================================================================================================================
+
+!!??Aurelien: Les 3 parametres qui suient pourait peut-être mis dans hydrol_init?
+    !
+    !
+    !Config Key   = CWRR_NKS_N0 
+    !Config Desc  = fitted value for relation log((n-n0)/(n_ref-n0)) = nk_rel * log(k/k_ref)
+    !Config Def   = 0.95
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =
+    !Config Units = [-]
+    n0 = 0.95
+    CALL getin_p("CWRR_NKS_N0",n0)
+
+    !! Check parameter value (correct range)
+    IF ( n0 < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for CWRR_NKS_N0.", &
+            &     "This parameter should be non-negative. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_NKS_POWER
+    !Config Desc  = fitted value for relation log((n-n0)/(n_ref-n0)) = nk_rel * log(k/k_ref)
+    !Config Def   = 0.34
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =
+    !Config Units = [-]
+    nk_rel = 0.34
+    CALL getin_p("CWRR_NKS_POWER",nk_rel)
+
+    !! Check parameter value (correct range)
+    IF ( nk_rel < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for CWRR_NKS_POWER.", &
+            &     "This parameter should be non-negative. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_AKS_A0 
+    !Config Desc  = fitted value for relation log((a-a0)/(a_ref-a0)) = ak_rel * log(k/k_ref)
+    !Config Def   = 0.00012
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =
+    !Config Units = [-]
+    a0 = 0.00012
+    CALL getin_p("CWRR_AKS_A0",a0)
+
+    !! Check parameter value (correct range)
+    IF ( a0 < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for CWRR_AKS_A0.", &
+            &     "This parameter should be non-negative. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = CWRR_AKS_POWER
+    !Config Desc  = fitted value for relation log((a-a0)/(a_ref-a0)) = ak_rel * log(k/k_ref)
+    !Config Def   = 0.53
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =
+    !Config Units = [-]
+    ak_rel = 0.53
+    CALL getin_p("CWRR_AKS_POWER",ak_rel)
+
+    !! Check parameter value (correct range)
+    IF ( nk_rel < zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for CWRR_AKS_POWER.", &
+            &     "This parameter should be non-negative. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = KFACT_DECAY_RATE
+    !Config Desc  = Factor for Ks decay with depth
+    !Config Def   = 2.0
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =  
+    !Config Units = [-]
+    f_ks = 2.0
+    CALL getin_p ("KFACT_DECAY_RATE", f_ks)
+
+    !! Check parameter value (correct range)
+    IF ( f_ks <= zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for KFACT_DECAY_RATE.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = KFACT_STARTING_DEPTH
+    !Config Desc  = Depth for compacted value of Ks 
+    !Config Def   = 0.3
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =  
+    !Config Units = [-]
+    dp_comp = 0.3
+    CALL getin_p ("KFACT_STARTING_DEPTH", dp_comp)
+
+    !! Check parameter value (correct range)
+    IF ( dp_comp <= zero ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for KFACT_STARTING_DEPTH.", &
+            &     "This parameter should be positive. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+
+    !Config Key   = KFACT_MAX
+    !Config Desc  = Maximum Factor for Ks increase due to vegetation
+    !Config Def   = 10.0
+    !Config If    = HYDROL_CWRR 
+    !Config Help  =
+    !Config Units = [-]
+    kfact_max = 10.0
+    CALL getin_p ("KFACT_MAX", kfact_max)
+
+    !! Check parameter value (correct range)
+    IF ( kfact_max < 10. ) THEN
+       CALL ipslerr_p(error_level, "hydrol_var_init.", &
+            &     "Wrong parameter value for KFACT_MAX.", &
+            &     "This parameter should be greater than 10. ", &
+            &     "Please, check parameter value in run.def. ")
+    END IF
+
+    !
+    DO jst=1,nstm
+       !-
+    !! 1 compute the depths
+       !-
+       zz(1,jst) = zero
+       dz(1,jst) = zero
+       DO jsl=2,nslm
+          zz(jsl,jst) = dpu_max* mille*((2**(jsl-1))-1)/ ((2**(nslm-1))-1)
+          dz(jsl,jst) = zz(jsl,jst)-zz(jsl-1,jst)
+       ENDDO
+       zz(nslm+1,jst) = zz(nslm,jst)
+       dz(nslm+1,jst) = zero
+
+       !-
+    !! 2 compute the profile for roots
+       !-
+       !! The three following equations concerning nroot computation are derived from the integrals 
+       !! of equations C9 to C11 of De Rosnay's (1999) PhD thesis (page 158).
+       !! The occasional absenceof minus sign before humcste parameter is correct.
+       DO jv = 1,nvm
+          DO jsl = 2, nslm-1
+             nroot(jv,jst,jsl) = (EXP(-humcste(jv)*zz(jsl,jst)/mille)) * &
+                     & (EXP(humcste(jv)*dz(jsl,jst)/mille/deux) - &
+                     & EXP(-humcste(jv)*dz(jsl+1,jst)/mille/deux))/ &
+                     & (EXP(-humcste(jv)*dz(2,jst)/mille/deux) &
+                     & -EXP(-humcste(jv)*zz(nslm,jst)/mille))
+          ENDDO
+       ENDDO
+       DO jv=1,nvm
+          nroot(jv,jst,1) = zero
+          nroot(jv,jst,nslm) = (EXP(humcste(jv)*dz(nslm,jst)/mille/deux) -un) * &
+                  & EXP(-humcste(jv)*zz(nslm,jst)/mille) / &
+                  & (EXP(-humcste(jv)*dz(2,jst)/mille/deux) &
+                  & -EXP(-humcste(jv)*zz(nslm,jst)/mille))
+       ENDDO
+    ENDDO
+
+       ! An additional exponential factor for ks depending on the amount of roots in the soil 
+       ! through a geometric average over the vegets
+       !!??Aurelien: Pkoi utiliser ks_usda?
+    kfact_root(:,:,:) = un
+       DO jsl = 1, nslm
+          DO jv = 2, nvm
+             jst = pref_soil_veg(jv)
+             DO ji = 1, kjpindex
+                IF(soiltile(ji,jst) .GT. min_sechiba) THEN
+                   kfact_root(ji,jsl,jst) = kfact_root(ji,jsl,jst) * &
+                        & MAX((MAXVAL(ks_usda)/ks(njsc(ji)))**(- veget(ji,jv) * (humcste(jv)*zz(jsl,jst)/mille - un)/deux), &
+                        un) 
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+    !-
+    !! 3 Compute the profile for ksat, a and n
+    !-
+
+       ! For every soil texture
+       DO jsc = 1, nscm
+          DO jsl=1,nslm
+             kfact(jsl,jsc) = MIN(MAX(EXP(- f_ks * (zz(jsl,jsc)/mille - dp_comp)), un/kfact_max),un)
+             !!??Aurelien: comment nk_rel et ak_rel ont-ils ete choisi? Et ce sont les memes pour chaque type de sol !?!
+             nfact(jsl,jsc) = ( kfact(jsl,jsc) )**nk_rel
+             afact(jsl,jsc) = ( kfact(jsl,jsc) )**ak_rel
+          ENDDO
+       ENDDO
+
+    
+    ! For every soil texture
+    DO jsc = 1, nscm
+       !-
+    !! 4 compute the linearized values of k, a, b and d
+       !-
+    ! Calcul the matrix coef for dublin model:
+    ! pice-wise linearised hydraulic conductivity k_lin=alin * mc_lin + b_lin
+    ! and diffusivity d_lin in each interval of mc, called mc_lin,
+    ! between imin, for residual mcr, 
+    ! and imax for saturation mcs.
+
+       mc_lin(imin,jsc)=mcr(jsc)
+       mc_lin(imax,jsc)=mcs(jsc)
+       DO ji= imin+1, imax-1 
+          mc_lin(ji,jsc) = mcr(jsc) + (ji-imin)*(mcs(jsc)-mcr(jsc))/(imax-imin)
+       ENDDO
+
+       DO jsl = 1, nslm
+          nvan_mod = n0 + (nvan(jsc)-n0) * nfact(jsl,jsc)
+          avan_mod = a0 + (avan(jsc)-a0) * afact(jsl,jsc)
+          !!??Aurelien: comment n0 et a0 ont-ils ete choisi? Et ce sont les memes pour chaque type de sol !?!
+          m = un - un / nvan_mod
+          ! Perhaps we may have problems with precision here for some machines (k being very small for ji=imin+1
+          ! How can we handle it?
+          DO ji = imax,imin+1,-1 
+             frac=MIN(un,(mc_lin(ji,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
+             k_lin(ji,jsl,jsc) = ks(jsc) * kfact(jsl,jsc) * (frac**0.5) * ( un - ( un - frac ** (un/m)) ** m )**2
+          ENDDO
+          ! We have to avoid k=0
+          k_lin(imin,jsl,jsc) = k_lin(imin+1,jsl,jsc)/mille
+          
+          DO ji = imin,imax-1 
+             a_lin(ji,jsl,jsc) = (k_lin(ji+1,jsl,jsc)-k_lin(ji,jsl,jsc)) / (mc_lin(ji+1,jsc)-mc_lin(ji,jsc))
+             b_lin(ji,jsl,jsc)  = k_lin(ji,jsl,jsc) - a_lin(ji,jsl,jsc)*mc_lin(ji,jsc)
+
+             IF(ji.NE.imin.AND.ji.NE.imax-1) THEN
+                frac=MIN(un,(mc_lin(ji,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
+                d_lin(ji,jsl,jsc) =(k_lin(ji,jsl,jsc) / (avan_mod*m*nvan_mod)) *  &
+                     &  ( (frac**(-un/m))/(mc_lin(ji,jsc)-mcr(jsc)) ) * &
+                  &  (  frac**(-un/m) -un ) ** (-m)
+                frac=MIN(un,(mc_lin(ji+1,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
+                d_lin(ji+1,jsl,jsc) =(k_lin(ji+1,jsl,jsc) / (avan_mod*m*nvan_mod))*&
+                     &  ( (frac**(-un/m))/(mc_lin(ji+1,jsc)-mcr(jsc)) ) * &
+                  &  (  frac**(-un/m) -un ) ** (-m)
+                d_lin(ji,jsl,jsc) = undemi * (d_lin(ji,jsl,jsc)+d_lin(ji+1,jsl,jsc))
+             ELSEIF(ji.EQ.imin) THEN
+                d_lin(ji,jsl,jsc) = zero
+             ELSEIF(ji.EQ.imax-1) THEN
+                frac=MIN(un,(mc_lin(ji,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
+                d_lin(ji,jsl,jsc) =(k_lin(ji,jsl,jsc) / (avan_mod*m*nvan_mod)) * &
+                     & ( (frac**(-un/m))/(mc_lin(ji,jsc)-mcr(jsc)) ) *  &
+                  & (  frac**(-un/m) -un ) ** (-m)
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDDO
+
+    !! 5 Water reservoir initialisation
+    !
+!!$    DO jst = 1,nstm
+!!$       DO ji = 1, kjpindex
+!!$          mx_eau_var(ji) = mx_eau_var(ji) + soiltile(ji,jst)*&
+!!$               &   dpu_max*mille*mcs(njsc(ji))
+!!$       END DO
+!!$    END DO
+!!$    IF (check_CWRR) THEN
+!!$       IF ( ANY ( ABS( mx_eau_var(:) - dpu_max*mille*mcs(njsc(:)) ) > min_sechiba ) ) THEN
+!!$          ji=MAXLOC ( ABS( mx_eau_var(:) - dpu_max*mille*mcs(njsc(:)) ) , 1)
+!!$          WRITE(numout, *) "Erreur formule simplifiÃ©e mx_eau_var ! ", mx_eau_var(ji), dpu_max*mille*mcs(njsc(ji))
+!!$          WRITE(numout, *) "err = ",ABS(mx_eau_var(ji) - dpu_max*mille*mcs(njsc(ji)))
+!!$          STOP 1
+!!$       ENDIF
+!!$    ENDIF
+
+    mx_eau_var(:) = zero
+    mx_eau_var(:) = dpu_max*mille*mcs(njsc(:)) 
+
+    DO ji = 1,kjpindex 
+       IF (vegtot(ji) .LE. zero) THEN
+          mx_eau_var(ji) = mx_eau_nobio*dpu_max
+          !!??Aurelien: c koi ce deux? a remplacer par dpu_max?
+          !!Et ça veut dire quoi vegtot=0? cad frac_nobio=1? Et si 0<frac_nobio<1 ???
+       ENDIF
+
+    END DO
+
+    ! Compute the litter humidity, shumdiag and fry
+    litterhumdiag(:) = zero
+    k_litt(:) = zero
+    tmc_litt_mea(:) = zero
+    tmc_litt_wet_mea(:) = zero
+    tmc_litt_dry_mea(:) = zero
+    shumdiag(:,:) = zero
+    soilmoist(:,:) = zero
+    humtot(:) = zero
+    tmc(:,:) = zero
+    swi(:) = zero
+
+    ! Loop on soil types to compute the variables (ji,jst)
+    DO jst=1,nstm 
+       DO ji = 1, kjpindex
+          tmcs(ji,jst)=dpu_max* mille*mcs(njsc(ji))
+          tmcr(ji,jst)=dpu_max* mille*mcr(njsc(ji))
+       ENDDO
+    ENDDO
+       
+    ! The total soil moisture for each soil type:
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          tmc(ji,jst)= dz(2,jst) * ( trois*mc(ji,1,jst)+ mc(ji,2,jst))/huit
+       END DO
+    ENDDO
+
+    DO jst=1,nstm 
+       DO jsl=2,nslm-1
+          DO ji=1,kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl,jst) * ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1,jst)*(trois*mc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
+          END DO
+       END DO
+    ENDDO
+
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          tmc(ji,jst) = tmc(ji,jst) +  dz(nslm,jst) * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+          tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
+       ENDDO
+    END DO
+
+    ! If veget has been updated before restart (with LAND USE or DGVM),
+    ! tmc and mc must be modified with respect to humtot conservation.
+    CALL hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, resdist )
+
+    ! The litter variables:
+    ! level 1
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          tmc_litter(ji,jst) = dz(2,jst) * (trois*mc(ji,1,jst)+mc(ji,2,jst))/huit
+          tmc_litter_wilt(ji,jst) = dz(2,jst) * mcw(njsc(ji)) / deux
+          tmc_litter_res(ji,jst) = dz(2,jst) * mcr(njsc(ji)) / deux
+          tmc_litter_field(ji,jst) = dz(2,jst) * mcf(njsc(ji)) / deux
+          tmc_litter_sat(ji,jst) = dz(2,jst) * mcs(njsc(ji)) / deux
+          tmc_litter_awet(ji,jst) = dz(2,jst) * mc_awet(njsc(ji)) / deux
+          tmc_litter_adry(ji,jst) = dz(2,jst) * mc_adry(njsc(ji)) / deux
+       ENDDO
+    END DO
+    ! sum from level 2 to 4
+    DO jst=1,nstm 
+       DO jsl=2,4
+          DO ji=1,kjpindex
+             tmc_litter(ji,jst) = tmc_litter(ji,jst) + dz(jsl,jst) * & 
+                  & ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1,jst)*(trois*mc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
+             tmc_litter_wilt(ji,jst) = tmc_litter_wilt(ji,jst) + &
+                  &(dz(jsl,jst)+ dz(jsl+1,jst))*& 
+                  & mcw(njsc(ji))/deux
+             tmc_litter_res(ji,jst) = tmc_litter_res(ji,jst) + &
+                  &(dz(jsl,jst)+ dz(jsl+1,jst))*& 
+                  & mcr(njsc(ji))/deux
+             tmc_litter_sat(ji,jst) = tmc_litter_sat(ji,jst) + &
+                  &(dz(jsl,jst)+ dz(jsl+1,jst))* & 
+                  & mcs(njsc(ji))/deux
+             tmc_litter_field(ji,jst) = tmc_litter_field(ji,jst) + &
+                  & (dz(jsl,jst)+ dz(jsl+1,jst))* & 
+                  & mcf(njsc(ji))/deux
+             tmc_litter_awet(ji,jst) = tmc_litter_awet(ji,jst) + &
+                  &(dz(jsl,jst)+ dz(jsl+1,jst))* & 
+                  & mc_awet(njsc(ji))/deux
+             tmc_litter_adry(ji,jst) = tmc_litter_adry(ji,jst) + &
+                  & (dz(jsl,jst)+ dz(jsl+1,jst))* & 
+                  & mc_adry(njsc(ji))/deux
+          END DO
+       END DO
+    END DO
+
+    ! subsequent calcul of soil_wet_litter (tmc-tmcw)/(tmcf-tmcw)
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          soil_wet_litter(ji,jst)=MIN(un, MAX(zero,&
+               &(tmc_litter(ji,jst)-tmc_litter_wilt(ji,jst))/&
+               & (tmc_litter_field(ji,jst)-tmc_litter_wilt(ji,jst)) ))
+       END DO
+    ENDDO
+
+    ! Soil wetness profiles (mc-mcw)/(mcs-mcw)
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          soil_wet(ji,1,jst) = MIN(un, MAX(zero,&
+               &(trois*mc(ji,1,jst) + mc(ji,2,jst) - quatre*mcw(njsc(ji)))&
+               & /(quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+    !!??Aurelien: a quoi sert cette ligne?
+          humrelv(ji,1,jst) = zero
+       ENDDO
+    END DO
+
+    DO jst=1,nstm 
+       DO jsl=2,nslm-1
+          DO ji=1,kjpindex
+             soil_wet(ji,jsl,jst) = MIN(un, MAX(zero,&
+                  & (trois*mc(ji,jsl,jst) + & 
+                  & mc(ji,jsl-1,jst) *(dz(jsl,jst)/(dz(jsl,jst)+dz(jsl+1,jst))) &
+                  & + mc(ji,jsl+1,jst)*(dz(jsl+1,jst)/(dz(jsl,jst)+dz(jsl+1,jst))) &
+                  & - quatre*mcw(njsc(ji))) / (quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+          END DO
+       END DO
+    END DO
+
+    DO jst=1,nstm 
+       DO ji=1,kjpindex
+          soil_wet(ji,nslm,jst) = MIN(un, MAX(zero,&
+               & (trois*mc(ji,nslm,jst) &
+               & + mc(ji,nslm-1,jst)-quatre*mcw(njsc(ji)))/(quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+       ENDDO
+    END DO
+
+    ! Compute the grid averaged values
+    DO jst=1,nstm        
+       DO ji=1,kjpindex
+          !
+          IF ( tmc_litter(ji,jst) < tmc_litter_res(ji,jst)) THEN
+             i = imin
+          ELSE
+             tmc_litter_ratio = (tmc_litter(ji,jst)-tmc_litter_res(ji,jst)) / &
+                  & (tmc_litter_sat(ji,jst)-tmc_litter_res(ji,jst))
+             i= MAX(MIN(INT((imax-imin)*tmc_litter_ratio)+imin , imax-1), imin)
+          ENDIF
+          ! k_litt is an averaged conductivity for saturated infiltration in the 'litter' layer
+          ! This is used for reinfiltration from surface water
+          k_tmp = MAX(k_lin(i,1,njsc(ji))*ks(njsc(ji)), zero)
+          k_litt(ji) = k_litt(ji) + soiltile(ji,jst) * SQRT(k_tmp)
+       ENDDO
+    ENDDO
+
+    DO jst=1,nstm        
+       DO ji=1,kjpindex
+          litterhumdiag(ji) = litterhumdiag(ji) + &
+               & soil_wet_litter(ji,jst) * soiltile(ji,jst)
+
+          tmc_litt_wet_mea(ji) =  tmc_litt_wet_mea(ji) + & 
+               & tmc_litter_awet(ji,jst)* soiltile(ji,jst)
+
+          tmc_litt_dry_mea(ji) = tmc_litt_dry_mea(ji) + &
+               & tmc_litter_adry(ji,jst) * soiltile(ji,jst) 
+
+          tmc_litt_mea(ji) = tmc_litt_mea(ji) + &
+               & tmc_litter(ji,jst) * soiltile(ji,jst) 
+       ENDDO
+    END DO
+
+    DO jst=1,nstm 
+       DO jsl=1,nbdl
+          DO ji=1,kjpindex
+             shumdiag(ji,jsl)= shumdiag(ji,jsl) + soil_wet(ji,jsl,jst) * &
+                  & ((mcs(njsc(ji))-mcw(njsc(ji)))/(mcf(njsc(ji))-mcw(njsc(ji)))) * &
+                  & soiltile(ji,jst)
+             soilmoist(ji,jsl) = soilmoist(ji,jsl) + mc(ji,jsl,jst)*soiltile(ji,jst)
+             shumdiag(ji,jsl) = MAX(MIN(shumdiag(ji,jsl), un), zero) 
+          END DO
+       END DO
+    END DO ! loop on soiltile
+    !
+    !
+    !
+    DO ji=1,kjpindex
+       IF ( tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji) > zero ) THEN
+          drysoil_frac(ji) = un + MAX( MIN( (tmc_litt_dry_mea(ji) - tmc_litt_mea(ji)) / &
+               & (tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji)), zero), - un)
+       ELSE
+          drysoil_frac(ji) = zero
+       ENDIF
+    END DO
+
+    evap_bare_lim = zero
+
+    IF (long_print) WRITE (numout,*) ' hydrol_var_init done '
+
+  END SUBROUTINE hydrol_var_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_snow
+!!
+!>\BRIEF        This routine computes snow processes. 
+!!
+!! DESCRIPTION  :
+!! - 0 initialisation
+!! - 1 On vegetation
+!! - 1.1 Compute snow masse
+!! - 1.2 Sublimation 
+!! - 1.2.1 Check that sublimation on the vegetated fraction is possible.
+!! - 1.3. snow melt only if temperature positive
+!! - 1.3.1 enough snow for melting or not
+!! - 1.3.2 not enough snow
+!! - 1.3.3 negative snow - now snow melt
+!! - 1.4 Snow melts only on weight glaciers
+!! - 2 On Land ice
+!! - 2.1 Compute snow
+!! - 2.2 Sublimation 
+!! - 2.3 Snow melt only for continental ice fraction
+!! - 2.3.1 If there is snow on the ice-fraction it can melt
+!! - 2.4 Snow melts only on weight glaciers 
+!! - 3 On other surface types - not done yet
+!! - 4 computes total melt (snow and ice)
+!! - 5 computes snow age on veg and ice (for albedo)
+!! - 5.1 Snow age on vegetation
+!! - 5.2 Snow age on ice
+!! - 6 Diagnose the depth of the snow layer
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_snow
+
+  SUBROUTINE hydrol_snow (kjpindex, dtradia, precip_rain, precip_snow , temp_sol_new, soilcap,&
+       & frac_nobio, totfrac_nobio, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age, &
+       & tot_melt, snowdepth)
+
+    ! 
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex      !! Domain size
+    REAL(r_std), INTENT (in)                                 :: dtradia       !! Time step in seconds
+    ! input fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_rain   !! Rainfall
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_snow   !! Snow precipitation
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: temp_sol_new  !! New soil temperature
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: soilcap       !! Soil capacity
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(in)     :: frac_nobio    !! Fraction of continental ice, lakes, ...
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: totfrac_nobio !! Total fraction of continental ice+lakes+ ...
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: tot_melt      !! Total melt  
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: snowdepth     !! Snow depth
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapnu       !! Bare soil evaporation
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapsno      !! Snow evaporation
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: snow          !! Snow mass [Kg/m^2]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: snow_age      !! Snow age
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout)  :: snow_nobio    !! Ice water balance
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout)  :: snow_nobio_age!! Snow age on ice, lakes, ...
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                               :: ji, jv
+    REAL(r_std), DIMENSION (kjpindex)             :: d_age  !! Snow age change
+    REAL(r_std), DIMENSION (kjpindex)             :: xx     !! temporary
+    REAL(r_std)                                   :: snowmelt_tmp !! The name says it all !
+
+!_ ================================================================================================================================
+
+    !
+    ! for continental points
+    !
+
+    !
+    !!_0 initialisation
+    !
+    DO jv = 1, nnobio
+       DO ji=1,kjpindex
+          subsnownobio(ji,jv) = zero
+       ENDDO
+    ENDDO
+    DO ji=1,kjpindex
+       subsnowveg(ji) = zero
+       snowmelt(ji) = zero
+       icemelt(ji) = zero
+       subsinksoil(ji) = zero
+       tot_melt(ji) = zero
+    ENDDO
+    !
+    !! 1 On vegetation
+    !
+    DO ji=1,kjpindex
+       !
+    !! 1.1 Compute snow masse
+       !
+       snow(ji) = snow(ji) + (un - totfrac_nobio(ji))*precip_snow(ji)
+       !
+       !
+    !! 1.2 Sublimation 
+       !      Separate between vegetated and no-veget fractions 
+       !      Care has to be taken as we might have sublimation from the
+       !      the frac_nobio while there is no snow on the rest of the grid.
+       !
+       IF ( snow(ji) > snowcri ) THEN
+          subsnownobio(ji,iice) = frac_nobio(ji,iice)*vevapsno(ji)
+          subsnowveg(ji) = vevapsno(ji) - subsnownobio(ji,iice)
+       ELSE
+          ! Correction Nathalie - Juillet 2006.
+          ! On doit d'abord tester s'il existe un frac_nobio!
+          ! Pour le moment je ne regarde que le iice
+          IF ( frac_nobio(ji,iice) .GT. min_sechiba) THEN
+             subsnownobio(ji,iice) = vevapsno(ji)
+             subsnowveg(ji) = zero
+          ELSE 
+             subsnownobio(ji,iice) = zero
+             subsnowveg(ji) = vevapsno(ji)
+          ENDIF
+       ENDIF
+       !
+       !
+    !! 1.2.1 Check that sublimation on the vegetated fraction is possible.
+       !
+       IF (subsnowveg(ji) .GT. snow(ji)) THEN
+          ! What could not be sublimated goes into soil evaporation
+          !         vevapnu(ji) = vevapnu(ji) + (subsnowveg(ji) - snow(ji))
+          IF( (un - totfrac_nobio(ji)).GT.min_sechiba) THEN
+             subsinksoil (ji) = (subsnowveg(ji) - snow(ji))/ (un - totfrac_nobio(ji))
+          END IF
+          ! Sublimation is thus limited to what is available
+          subsnowveg(ji) = snow(ji)
+          snow(ji) = zero
+          vevapsno(ji) = subsnowveg(ji) + subsnownobio(ji,iice)
+       ELSE
+          snow(ji) = snow(ji) - subsnowveg(ji)
+       ENDIF
+       !
+    !! 1.3. snow melt only if temperature positive
+       !
+       IF (temp_sol_new(ji).GT.tp_00) THEN
+          !
+          IF (snow(ji).GT.sneige) THEN
+             !
+             snowmelt(ji) = (un - frac_nobio(ji,iice))*(temp_sol_new(ji) - tp_00) * soilcap(ji) / chalfu0
+             !
+    !! 1.3.1 enough snow for melting or not
+             !
+             IF (snowmelt(ji).LT.snow(ji)) THEN
+                snow(ji) = snow(ji) - snowmelt(ji)
+             ELSE
+                snowmelt(ji) = snow(ji)
+                snow(ji) = zero
+             END IF
+             !
+          ELSEIF (snow(ji).GE.zero) THEN
+             !
+    !! 1.3.2 not enough snow
+             !
+             snowmelt(ji) = snow(ji)
+             snow(ji) = zero
+          ELSE
+             !
+    !! 1.3.3 negative snow - now snow melt
+             !
+             snow(ji) = zero
+             snowmelt(ji) = zero
+             WRITE(numout,*) 'hydrol_snow: WARNING! snow was negative and was reset to zero. '
+             !
+          END IF
+
+       ENDIF
+    !! 1.4 Snow melts only on weight glaciers
+       ! Ice melt only if there is more than a given mass : maxmass_glacier,
+       ! Ajouts Edouard Davin / Nathalie de Noblet add extra to melting
+       !
+       IF ( snow(ji) .GT. maxmass_glacier ) THEN
+          snowmelt(ji) = snowmelt(ji) + (snow(ji) - maxmass_glacier)
+          snow(ji) = maxmass_glacier
+       ENDIF
+       !
+    END DO
+    !
+    !! 2 On Land ice
+    !
+    DO ji=1,kjpindex
+       !
+    !! 2.1 Compute snow
+       !
+       !!??Aurelien: pkoi mettre precip_rain en dessous? We considere liquid precipitations becomes instantly snow?  
+       snow_nobio(ji,iice) = snow_nobio(ji,iice) + frac_nobio(ji,iice)*precip_snow(ji) + &
+            & frac_nobio(ji,iice)*precip_rain(ji)
+       !
+    !! 2.2 Sublimation 
+       !      Was calculated before it can give us negative snow_nobio but that is OK
+       !      Once it goes below a certain values (-maxmass_glacier for instance) we should kill
+       !      the frac_nobio(ji,iice) !
+       !
+       snow_nobio(ji,iice) = snow_nobio(ji,iice) - subsnownobio(ji,iice)
+       !
+    !! 2.3 Snow melt only for continental ice fraction
+       !
+       snowmelt_tmp = zero
+       IF (temp_sol_new(ji) .GT. tp_00) THEN
+          !
+    !! 2.3.1 If there is snow on the ice-fraction it can melt
+          !
+          snowmelt_tmp = frac_nobio(ji,iice)*(temp_sol_new(ji) - tp_00) * soilcap(ji) / chalfu0
+          !
+          IF ( snowmelt_tmp .GT. snow_nobio(ji,iice) ) THEN
+             snowmelt_tmp = MAX( zero, snow_nobio(ji,iice))
+          ENDIF
+          snowmelt(ji) = snowmelt(ji) + snowmelt_tmp
+          snow_nobio(ji,iice) = snow_nobio(ji,iice) - snowmelt_tmp
+          !
+       ENDIF
+       !
+    !! 2.4 Snow melts only on weight glaciers 
+       !      Ice melt only if there is more than a given mass : maxmass_glacier, 
+       !
+       IF ( snow_nobio(ji,iice) .GT. maxmass_glacier ) THEN
+          icemelt(ji) = snow_nobio(ji,iice) - maxmass_glacier
+          snow_nobio(ji,iice) = maxmass_glacier
+       ENDIF
+       !
+    END DO
+
+    !
+    !! 3 On other surface types - not done yet
+    !
+    IF ( nnobio .GT. 1 ) THEN
+       WRITE(numout,*) 'WE HAVE',nnobio-1,' SURFACE TYPES I DO NOT KNOW'
+       WRITE(numout,*) 'CANNOT TREAT SNOW ON THESE SURFACE TYPES'
+       STOP 'in hydrol_snow' 
+    ENDIF
+
+    !
+    !! 4 computes total melt (snow and ice)
+    !
+    DO ji = 1, kjpindex
+       tot_melt(ji) = icemelt(ji) + snowmelt(ji)
+    ENDDO
+
+    !
+    !! 5 computes snow age on veg and ice (for albedo)
+    !
+    DO ji = 1, kjpindex
+       !
+    !! 5.1 Snow age on vegetation
+       !
+       IF (snow(ji) .LE. zero) THEN
+          snow_age(ji) = zero
+       ELSE
+          snow_age(ji) =(snow_age(ji) + (un - snow_age(ji)/max_snow_age) * dtradia/one_day) &
+               & * EXP(-precip_snow(ji) / snow_trans)
+       ENDIF
+       !
+    !! 5.2 Snow age on ice
+       !
+       ! age of snow on ice: a little bit different because in cold regions, we really
+       ! cannot negect the effect of cold temperatures on snow metamorphism any more.
+       !
+       IF (snow_nobio(ji,iice) .LE. zero) THEN
+          snow_nobio_age(ji,iice) = zero
+       ELSE
+          !
+          d_age(ji) = ( snow_nobio_age(ji,iice) + &
+               &  (un - snow_nobio_age(ji,iice)/max_snow_age) * dtradia/one_day ) * &
+               &  EXP(-precip_snow(ji) / snow_trans) - snow_nobio_age(ji,iice)
+          IF (d_age(ji) .GT. min_sechiba ) THEN
+             xx(ji) = MAX( tp_00 - temp_sol_new(ji), zero )
+             xx(ji) = ( xx(ji) / 7._r_std ) ** 4._r_std
+             d_age(ji) = d_age(ji) / (un+xx(ji))
+          ENDIF
+          snow_nobio_age(ji,iice) = MAX( snow_nobio_age(ji,iice) + d_age(ji), zero )
+          !
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 6 Diagnose the depth of the snow layer
+    !
+
+    DO ji = 1, kjpindex
+       snowdepth(ji) = snow(ji) /sn_dens
+    ENDDO
+
+    IF (long_print) WRITE (numout,*) ' hydrol_snow done '
+
+  END SUBROUTINE hydrol_snow
+
+   
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_canop
+!!
+!>\BRIEF        This routine computes canopy processes.
+!!
+!! DESCRIPTION  :
+!! - 1 evaporation off the continents
+!! - 1.1 The interception loss is take off the canopy. 
+!! - 1.2 precip_rain is shared for each vegetation type
+!! - 1.3 Limits the effect and sum what receives soil
+!! - 1.4 swap qsintveg to the new value
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_canop
+
+  SUBROUTINE hydrol_canop (kjpindex, precip_rain, vevapwet, veget_max, veget, qsintmax, &
+       & qsintveg,precisol,tot_melt)
+
+    ! 
+    ! interface description
+    !
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex    !! Domain size
+    ! input fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_rain !! Rain precipitation
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: vevapwet    !! Interception loss
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: veget_max   !! max fraction of vegetation type
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: veget       !! Fraction of vegetation type 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: qsintmax    !! Maximum water on vegetation for interception
+    REAL(r_std), DIMENSION  (kjpindex), INTENT (in)          :: tot_melt    !! Total melt
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)       :: precisol    !! Water fallen onto the ground (throughfall)
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: qsintveg    !! Water on vegetation due to interception
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jv
+    REAL(r_std), DIMENSION (kjpindex,nvm)                    :: zqsintvegnew
+
+!_ ================================================================================================================================
+
+    ! boucle sur les points continentaux
+    ! calcul de qsintveg au pas de temps suivant
+    ! par ajout du flux interception loss
+    ! calcule par enerbil en fonction
+    ! des calculs faits dans diffuco
+    ! calcul de ce qui tombe sur le sol
+    ! avec accumulation dans precisol
+    ! essayer d'harmoniser le traitement du sol nu
+    ! avec celui des differents types de vegetation
+    ! fait si on impose qsintmax ( ,1) = 0.0
+    !
+    ! loop for continental subdomain
+    !
+    !
+    !! 1 evaporation off the continents
+    !
+    !! 1.1 The interception loss is take off the canopy. 
+    DO jv=2,nvm
+       qsintveg(:,jv) = qsintveg(:,jv) - vevapwet(:,jv)
+    END DO
+
+    !     It is raining :
+    !! 1.2 precip_rain is shared for each vegetation type
+    !     sum (veget (1,nvm)) must be egal to 1-totfrac_nobio.
+    !     iniveget computes veget each day
+    !
+    qsintveg(:,1) = zero
+    DO jv=2,nvm
+       IF ( ok_throughfall_by_pft ) THEN
+          ! Correction Nathalie - Juin 2006 - une partie de la pluie arrivera toujours sur le sol
+          ! sorte de throughfall supplementaire
+          qsintveg(:,jv) = qsintveg(:,jv) + veget(:,jv) * ((1-throughfall_by_pft(jv))*precip_rain(:))
+       ELSE
+          qsintveg(:,jv) = qsintveg(:,jv) + veget(:,jv) * precip_rain(:)
+       ENDIF
+    END DO
+
+    !
+    !! 1.3 Limits the effect and sum what receives soil
+    !
+    precisol(:,1)=veget_max(:,1)*precip_rain(:)
+    DO jv=2,nvm
+       DO ji = 1, kjpindex
+          zqsintvegnew(ji,jv) = MIN (qsintveg(ji,jv),qsintmax(ji,jv)) 
+          IF ( ok_throughfall_by_pft ) THEN
+             ! correction throughfall Nathalie - Juin 2006
+             precisol(ji,jv) = (veget(ji,jv)*throughfall_by_pft(jv)*precip_rain(ji)) + &
+                  qsintveg(ji,jv) - zqsintvegnew (ji,jv) + &
+                  (veget_max(ji,jv) - veget(ji,jv))*precip_rain(ji)
+          ELSE
+             precisol(ji,jv) = qsintveg(ji,jv) - zqsintvegnew (ji,jv) + &
+                  (veget_max(ji,jv) - veget(ji,jv))*precip_rain(ji)
+          ENDIF
+       ENDDO
+    END DO
+    !    
+    DO jv=1,nvm
+       DO ji = 1, kjpindex
+          IF (vegtot(ji).GT.min_sechiba) THEN
+             precisol(ji,jv) = precisol(ji,jv)+tot_melt(ji)*veget_max(ji,jv)/vegtot(ji)
+          ENDIF
+       ENDDO
+    END DO
+    !   
+    !
+    !! 1.4 swap qsintveg to the new value
+    !
+    DO jv=2,nvm
+       qsintveg(:,jv) = zqsintvegnew (:,jv)
+    END DO
+
+    IF (long_print) WRITE (numout,*) ' hydrol_canop done '
+
+  END SUBROUTINE hydrol_canop
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_vegupd
+!!
+!>\BRIEF        Vegetation update   
+!!
+!! DESCRIPTION  :
+!!   The vegetation cover has changed and we need to adapt the reservoir distribution 
+!!   and the distribution of plants on different soil types.
+!!   You may note that this occurs after evaporation and so on have been computed. It is
+!!   not a problem as a new vegetation fraction will start with humrel=0 and thus will have no
+!!   evaporation. If this is not the case it should have been caught above.
+!!
+!! - 1 Update of vegetation is it needed?
+!! - 2 calculate water mass that we have to redistribute
+!! - 3 put it into reservoir of plant whose surface area has grown
+!! - 4 Soil tile gestion
+!! - 5 update the corresponding masks
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_vegupd
+
+  SUBROUTINE hydrol_vegupd(kjpindex, veget, veget_max, soiltile,qsintveg,resdist)
+
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex 
+    ! input fields
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in)    :: veget            !! New vegetation map
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)     :: veget_max        !! Max. fraction of vegetation type
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)   :: soiltile         !! Fraction of each soil tile (0-1, unitless)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)  :: qsintveg         !! Water on old vegetation 
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(inout) :: resdist          !! Old vegetation map
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                 :: ji,jv,jst
+    REAL(r_std), DIMENSION(kjpindex)               :: tot_corr_veg_soil
+
+!_ ================================================================================================================================
+
+    !! 1 If veget has been updated at last time step (with LAND USE or DGVM),
+    !! tmc and mc must be modified with respect to humtot conservation.
+    CALL hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, resdist )
+
+    ! Remember that it is only frac_nobio + SUM(veget_max(,:)) that is equal to 1. Thus we need vegtot
+    DO ji = 1, kjpindex
+       vegtot(ji) = SUM(veget_max(ji,:))
+    ENDDO
+
+    ! Compute the masks for veget
+    
+    mask_veget(:,:) = 0
+    mask_soiltile(:,:) = 0
+    
+    DO jst=1,nstm
+       DO ji = 1, kjpindex
+          IF(soiltile(ji,jst) .GT. min_sechiba) THEN
+             mask_soiltile(ji,jst) = 1
+          ENDIF
+       END DO
+    ENDDO
+          
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          IF(veget_max(ji,jv) .GT. min_sechiba) THEN
+             mask_veget(ji,jv) = 1
+          ENDIF
+       END DO
+    END DO
+
+    ! Compute corr_veg_soil 
+    corr_veg_soil(:,:,:) = zero
+    DO jv = 1, nvm
+       jst = pref_soil_veg(jv)
+       DO ji=1,kjpindex
+          ! for veget distribution used in sechiba via humrel
+          IF (mask_soiltile(ji,jst).GT.0 .AND. vegtot(ji) > min_sechiba) THEN
+             corr_veg_soil(ji,jv,jst)=veget_max(ji,jv)/soiltile(ji,jst)
+          ENDIF
+       ENDDO
+    ENDDO
+
+    IF (check_cwrr .AND. l_second_hydrol) THEN
+       ! somme(soiltile * corr_veg_soil ) = 1
+       tot_corr_veg_soil(:)=zero
+       DO jst = 1, nstm
+          DO jv = 1,nvm
+             DO ji=1,kjpindex
+                tot_corr_veg_soil(ji)=tot_corr_veg_soil(ji)+soiltile(ji,jst)*corr_veg_soil(ji,jv,jst)
+             ENDDO
+          ENDDO
+       ENDDO
+
+       DO ji=1,kjpindex
+          IF ( ABS( tot_corr_veg_soil(ji) - vegtot(ji) ) > 10*EPS1 ) THEN
+             WRITE(numout,*) 'corr_veg_soil SPLIT FALSE:ji=',ji,&
+                  tot_corr_veg_soil(ji)
+             WRITE(numout,*) 'err',ABS( tot_corr_veg_soil(ji) - vegtot(ji) )
+             WRITE(numout,*) 'vegtot',vegtot(ji)
+             DO jv=1,nvm
+                WRITE(numout,*) 'jv,veget_max,corr_veg_soil',jv,veget_max(ji,jv),corr_veg_soil(ji,jv,:)
+             END DO
+             CALL ipslerr_p(3, 'hydrol_vegupd', 'Error in tot_corr_veg_soil or vegtot','','')
+          ENDIF
+       ENDDO
+    ENDIF
+
+    ! Tout dans cette routine est maintenant certainement obsolete (veget_max etant constant) en dehors des lignes suivantes:
+    frac_bare_ns(:,:) = zero
+    DO jst = 1, nstm
+       DO jv = 1, nvm
+          DO ji =1, kjpindex
+             IF(vegtot(ji) .GT. min_sechiba) THEN
+                frac_bare_ns(ji,jst) = frac_bare_ns(ji,jst) + corr_veg_soil(ji,jv,jst) * frac_bare(ji,jv) / vegtot(ji)
+             ENDIF
+          END DO
+       ENDDO
+    END DO
+
+    IF (long_print) WRITE (numout,*) ' hydrol_vegupd done '
+
+    RETURN
+    !
+  END SUBROUTINE hydrol_vegupd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_flood
+!!
+!>\BRIEF        This routine computes the evolution of the surface reservoir (floodplain).  
+!!
+!! DESCRIPTION  :
+!! - 1 Take out vevapflo from the reservoir and transfer the remaining to subsinksoil
+!! - 2 Compute the total flux from floodplain floodout (transfered to routing)
+!! - 3 Discriminate between precip over land and over floodplain
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_flood
+
+  SUBROUTINE hydrol_flood (kjpindex, dtradia, vevapflo, flood_frac, flood_res, floodout)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex         !!
+    ! input fields
+    REAL(r_std), INTENT (in)                                 :: dtradia          !! Time step in seconds
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: flood_frac       !! Fraction of floodplains in grid box
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: floodout         !! Flux to take out from floodplains
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: flood_res        !! Floodplains reservoir estimate
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapflo         !! Evaporation over floodplains
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jv           !! Indices
+    REAL(r_std), DIMENSION (kjpindex)                        :: temp             !! 
+
+!_ ================================================================================================================================
+    !- 
+    !! 1 Take out vevapflo from the reservoir and transfer the remaining to subsinksoil 
+    !-
+    DO ji = 1,kjpindex
+       temp(ji) = MIN(flood_res(ji), vevapflo(ji))
+    ENDDO
+    DO ji = 1,kjpindex
+       flood_res(ji) = flood_res(ji) - temp(ji)
+       subsinksoil(ji) = subsinksoil(ji) + vevapflo(ji) - temp(ji)
+       vevapflo(ji) = temp(ji)
+    ENDDO
+
+    !- 
+    !! 2 Compute the total flux from floodplain floodout (transfered to routing) 
+    !-
+    DO ji = 1,kjpindex
+       floodout(ji) = vevapflo(ji) - flood_frac(ji) * SUM(precisol(ji,:))
+    ENDDO
+
+    !-
+    !! 3 Discriminate between precip over land and over floodplain
+    !-
+    DO jv=1, nvm
+       DO ji = 1,kjpindex
+          precisol(ji,jv) = precisol(ji,jv) * (1 - flood_frac(ji))
+       ENDDO
+    ENDDO 
+
+    IF (long_print) WRITE (numout,*) ' hydrol_flood done'
+
+  END SUBROUTINE hydrol_flood
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: hydrol_soil
+!!
+!>\BRIEF        This routine computes soil processes with CWRR scheme.
+!!
+!! DESCRIPTION  :
+!! - 0 Arrays initialisation
+!! -   for each soil type
+!! - 1 We compare water2infilt and water2extract to keep only difference
+!! - 1.1 add to the first layer
+!! - 1.2 filling layers
+!! - 2 Before diffusion scheme
+!! - 2.1 Some initialisation necessary for the diffusion scheme to work
+!! - 2.2 coefficients are computed for the profile of mc before infiltration:
+!! - 3 The infiltration is computed 
+!! - 4 Coefficient are recomputed for the profile of mc after infiltration:
+!! - 5 Prepar the diffusion scheme
+!! - 5.1 Set the values for diffusion scheme
+!! - 5.2 verifications for a good soil humidity
+!! - 5.3 compute matrix coefficients
+!! - 6 Resolve diffusion scheme
+!! - 6.1 solve equations assuming atmosphere limiting
+!! - 6.2 check if really atmosphere limiting
+!! - 6.3 Reset the coefficient for diffusion (only used if resolv(ji) = .TRUE.)
+!! - 6.4 resolve the equations with new boundary conditions if necessary
+!! - 7 close the water balance
+!! - 7.1 compute dr_ns with the bottom boundary condition 
+!! - 7.2 compute total soil moisture content
+!! - 7.3 deduction of upper flux from soil moisture variation and bottom flux
+!! - 7.4 deduction of ae_ns and ru_ns:
+!! - 8 Special treatment for the unstable cases
+!! - 9 Then compute the temporary surface water and correct the outgoing runoff
+!! - 10 smooth again
+!! - 11 Optional computation of the fluxes 
+!! - 12 We make some useful output
+!! - 13 before closing the soil water, we check the water balance of soil
+!! - 14 sum 3d variables into 2d variables
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil
+
+  SUBROUTINE hydrol_soil (kjpindex, dtradia, veget_max, soiltile, njsc, reinf_slope, &
+       & transpir, vevapnu, evapot, evapot_penm, runoff, drainage, returnflow, reinfiltration, irrigation, &
+       & tot_melt, evap_bare_lim,  shumdiag, k_litt, litterhumdiag, humrel,vegstress, drysoil_frac,soil_mc,&
+       & litter_mc,wat_flux0, wat_flux, drainage_per_soil, runoff_per_soil)
+    ! 
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex 
+    ! input fields
+    REAL(r_std), INTENT (in)                                 :: dtradia          !! Time step [s]
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)       :: veget_max        !! Map of max vegetation types [-]
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltile         !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: transpir         !! Transpiration [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)           :: reinf_slope      !! Slope coef
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: returnflow       !! Water returning to the deep reservoir [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: reinfiltration   !! Water returning to the top of the soil [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: irrigation       !! Irrigation [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evapot           !! Potential evaporation [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evapot_penm      !! Potential evaporation Penman [mm] 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: tot_melt         !! snow melt [mm]
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: runoff           !! complete runoff [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: drainage         !! complete drainage [mm]
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)      :: runoff_per_soil  !! runoff for each soil type[mm]
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)      :: drainage_per_soil!! drainage for each soil type [mm]
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: evap_bare_lim    !! limitation of bare soil evaporation on each 
+                                                                                 !! soil column [mm] 
+    REAL(r_std), DIMENSION (kjpindex,nbdl), INTENT (out)     :: shumdiag         !! Relative soil moisture
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: k_litt           !! Litter cond.
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: litterhumdiag    !! Litter humidity
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out)      :: vegstress        !! Veg. moisture stress (only for vegetation 
+                                                                                 !! growth) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: drysoil_frac     !! Function of the litter humidity, that will be 
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(out)  :: soil_mc          !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out)       :: litter_mc        !! litter moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out)       :: wat_flux0        !! Water flux in the first soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(out)  :: wat_flux         !! Water flux in the soil layers exported for soil C calculations
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapnu          !! 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (inout)    :: humrel           !! Relative humidity [0-1, dimensionless]
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                 :: ji, jv, jsl, jst           !! indices
+    REAL(r_std), PARAMETER                         :: frac_mcs = 0.66            !! temporary depth
+    !!??Aurelien: frac_ms inutile?
+    REAL(r_std)                                    :: us_tmp                     !! temporary stress
+    REAL(r_std), DIMENSION(kjpindex)               :: temp                       !! temporary value for fluxes
+    REAL(r_std), DIMENSION(kjpindex)               :: tmcold, tmcint             !!
+    REAL(r_std), DIMENSION(kjpindex,nslm,nstm)     :: moderwilt                  !!
+    REAL(r_std), DIMENSION(kjpindex,nslm)          :: mcint                      !! To save mc values for future use
+    LOGICAL, DIMENSION(kjpindex)                   :: is_under_mcr               !! Allows under residual soil moisture due to evap 
+    LOGICAL, DIMENSION(kjpindex)                   :: is_over_mcs                !! Allows over saturated soil moisture due to 
+                                                                                 !! returnflow 
+    REAL(r_std), DIMENSION(kjpindex)               :: sum_rootsink               !! Sum of the root sink
+    REAL(r_std), DIMENSION(kjpindex)               :: deltahum,diff              !!
+    LOGICAL(r_std), DIMENSION(kjpindex)            :: test                       !!
+    REAL(r_std), DIMENSION(kjpindex)               :: tsink                      !!
+    REAL(r_std), DIMENSION(kjpindex)               :: water2extract              !! Temporary variable [mm]
+    REAL(r_std), DIMENSION(kjpindex)               :: returnflow_soil            !! Water from the routing back to the bottom of 
+                                                                                 !! the soil [mm] 
+    REAL(r_std), DIMENSION(kjpindex)               :: reinfiltration_soil        !! Water from the routing back to the top of the 
+                                                                                 !! soil [mm] 
+    REAL(r_std), DIMENSION(kjpindex)               :: irrigation_soil            !! Water from irrigation returning to soil 
+                                                                                 !! moisture for each soil type [mm] 
+    REAL(r_std), DIMENSION(kjpindex)               :: flux_infilt                !!
+    LOGICAL                                        :: error=.FALSE.              !! If true, exit in the end of subroutine
+
+!_ ================================================================================================================================
+
+    !! 0 Arrays initialisation
+
+    returnflow_soil(:) = zero
+    reinfiltration_soil(:) = zero
+    irrigation_soil(:) = zero
+    qflux(:,:,:) = zero
+    is_under_mcr(:) = .FALSE.
+    is_over_mcs(:) = .FALSE.
+    flux_infilt(:) = zero
+    wat_flux0(:,:) = zero
+    wat_flux(:,:,:) = zero
+
+    !
+    ! split 2d variables to 3d variables, per soil tile
+    !
+    CALL hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, evap_bare_lim)
+    !
+    ! Common variables
+    !
+    DO ji=1,kjpindex
+       IF(vegtot(ji).GT.min_sechiba) THEN
+          returnflow_soil(ji) = zero
+          reinfiltration_soil(ji) = (returnflow(ji) + reinfiltration(ji))/vegtot(ji)
+          irrigation_soil(ji) = irrigation(ji)/vegtot(ji)
+       ELSE
+          returnflow_soil(ji) = zero
+          reinfiltration_soil(ji) = zero
+          irrigation_soil(ji) = zero
+       ENDIF
+    ENDDO
+       
+    !
+    !!_  for each soil tile
+    !
+    DO jst = 1,nstm
+       !
+       !- Compute the sum of the sinks for future check-up
+       sum_rootsink(:)=SUM(rootsink(:,:,jst),dim=2)
+       DO ji=1,kjpindex
+          tsink(ji) = sum_rootsink(ji)+MAX(ae_ns(ji,jst),zero)+subsinksoil(ji)
+       ENDDO
+       !
+       ! The total moisture content (including water2infilt) is saved for balance checks at the end
+       tmcold(:) = tmc(:,jst)
+
+       !- The value of mc is kept in mcint, used in the flux computation after diffusion:
+       DO jsl = 1, nslm
+          DO ji = 1, kjpindex
+             mcint(ji,jsl) = mask_soiltile(ji,jst) * mc(ji,jsl,jst)
+          ENDDO
+       ENDDO
+
+       DO ji = 1, kjpindex
+          tmcint(ji) = dz(2,jst) * ( trois*mcint(ji,1) + mcint(ji,2) )/huit 
+       ENDDO
+
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmcint(ji) = tmcint(ji) + dz(jsl,jst) &
+                  & * (trois*mcint(ji,jsl)+mcint(ji,jsl-1))/huit &
+                  & + dz(jsl+1,jst) * (trois*mcint(ji,jsl)+mcint(ji,jsl+1))/huit
+          ENDDO
+       ENDDO
+
+       DO ji = 1, kjpindex
+          tmcint(ji) = tmcint(ji) + dz(nslm,jst) &
+               & * (trois * mcint(ji,nslm) + mcint(ji,nslm-1))/huit
+       ENDDO
+    !! 1 Compare water2infilt and water2extract to keep only difference
+
+       ! The bare soil evaporation is substracted to the soil moisture profile and first to the water available:  
+       DO ji = 1, kjpindex
+          water2extract(ji) = MIN(water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji), &
+               & MAX(ae_ns(ji,jst),zero) + subsinksoil(ji))
+       ENDDO
+
+       ! First we substract from the surface
+       DO ji = 1, kjpindex
+          water2infilt(ji,jst) = water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) - water2extract(ji)
+       ENDDO       
+             
+       ! Then we update the water to extract from the soil
+       DO ji = 1, kjpindex
+          water2extract(ji) =  MAX(ae_ns(ji,jst),zero) + subsinksoil(ji) - water2extract(ji)
+       ENDDO
+
+       !! We add and substract components to the soil
+       !! by filling the layers from top to bottom (same for reinfiltration) - this is done by smooth below
+       !! 1.1 add to the first layer
+       DO ji = 1, kjpindex
+          mc(ji,1,jst) = mc(ji,1,jst) - water2extract(ji) * deux / dz(2,jst)
+       ENDDO
+
+       !!??Aurelien: here, the first layer can be oversaturated, thats why we need hydrol_soil_smooth
+    !! 1.2 filling layers
+       CALL hydrol_soil_smooth(kjpindex,jst, njsc, is_under_mcr, is_over_mcs)
+
+   
+    !! 2 Before diffusion scheme
+   
+    !! 2.1 Some initialisation necessary for the diffusion scheme to work
+
+       DO ji = 1, kjpindex
+          !- We correct rootsink for first two layers so that it is not too low in the first layer
+          v1(ji,jst) = dz(2,jst)/huit * (trois * mc(ji,1,jst)+ mc(ji,2,jst))
+          rootsink(ji,2,jst) = rootsink(ji,2,jst) + MAX(rootsink(ji,1,jst)-v1(ji,jst), zero) 
+          rootsink(ji,1,jst) = MIN(rootsink(ji,1,jst),v1(ji,jst))
+          !- Flux at top of the soil column is zero
+          flux(ji) = zero
+       ENDDO
+
+       DO ji = 1, kjpindex
+          ! Initialise the flux to be infiltrated 
+          flux_infilt(ji) = water2infilt(ji,jst) + precisol_ns(ji,jst) 
+          !- The incoming flux is also first dedicated to fill the soil up to mcr (in case needed)
+       ENDDO
+
+
+     !! 2.1.2 Treat problem with to low soil moisture content in soil column : is_under_mcr
+       DO ji = 1, kjpindex
+          IF (is_under_mcr(ji)) THEN
+             ! Calculate minimum mc
+             temp(ji)=mc(ji,1,jst)
+             DO jsl=2,nslm
+                IF (mc(ji,jsl,jst) .LT. temp(ji)) THEN
+                   temp(ji)=mc(ji,jsl,jst)
+                END IF
+             END DO
+      
+             ! Calculate water deficit
+             temp(ji)=mcr(njsc(ji))-temp(ji)
+
+             ! Add to each soil layer
+             DO jsl=1,nslm
+                mc(ji,jsl,jst) = mc(ji,jsl,jst) + temp(ji)
+             END DO
+
+             ! Remove from flux_infilt
+             flux_infilt(ji)=flux_infilt(ji)-temp(ji)*(dpu_max*mille)
+             IF (flux_infilt(ji) .LT. 0.) THEN
+                WRITE(numout,*) 'BIG PROBLEM at grid cell ',ji
+                WRITE(numout,*) 'No available water in soil column!!!'
+                flux_infilt(ji) = 0.
+             END IF
+          END IF
+       END DO
+
+    !! 2.2 Coefficients are computed for the profile of mc before infiltration
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+    !! 3 The infiltration is computed 
+       CALL hydrol_soil_infilt(kjpindex, jst, dtradia, njsc, flux_infilt)
+
+    !! 4 Coefficient are recomputed for the profile of mc after infiltration
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+    !! 5 Prepar the diffusion scheme
+ 
+    !! 5.1 Set the values for diffusion scheme
+       CALL hydrol_soil_setup(kjpindex,jst,dtradia)
+
+    !! 5.2 verifications for a good soil humidity
+    ! We only run the scheme in case we are not under mcr after precip and various reinfiltrations and not over mcs
+       resolv(:) = (mask_soiltile(:,jst) .GT. 0) .AND. & 
+               & (.NOT. is_under_mcr(:)) .AND. (.NOT. is_over_mcs(:))    
+
+       ! In oversaturated case, we first take the evaporation from the outgoing water (the rest will be taken from the soil)
+       sum_rootsink(:)=SUM(rootsink(:,:,jst),dim=2)
+       WHERE (is_over_mcs(:))
+          mc(:,1,jst) = mc(:,1,jst) - flux(:) * deux / dz(2,jst)
+       ENDWHERE
+       DO jsl=1, nslm
+          WHERE (is_over_mcs(:))
+             mc(:,jsl,jst) = mc(:,jsl,jst) - sum_rootsink(:) / (dpu_max*mille) 
+          ENDWHERE
+       ENDDO
+       ! In under residual case, we equally spread the transpiration over the layers
+       DO jsl = 1, nslm
+          WHERE (is_under_mcr(:))
+             mc(:,jsl,jst) = mc(:,jsl,jst) - sum_rootsink(:) / (dpu_max*mille) 
+          ENDWHERE
+       ENDDO
+
+    !! 5.3 compute matrix coefficients
+       !- First layer
+       DO ji = 1, kjpindex
+          tmat(ji,1,1) = zero
+          tmat(ji,1,2) = f(ji,1)
+          tmat(ji,1,3) = g1(ji,1)
+          rhs(ji,1)    = fp(ji,1) * mc(ji,1,jst) + gp(ji,1)*mc(ji,2,jst) &
+               &  - flux(ji) - (b(ji,1)+b(ji,2))/deux *(dtradia/one_day) - rootsink(ji,1,jst)
+       ENDDO
+
+       !- soil body
+       DO jsl=2, nslm-1
+          DO ji = 1, kjpindex
+             tmat(ji,jsl,1) = e(ji,jsl)
+             tmat(ji,jsl,2) = f(ji,jsl)
+             tmat(ji,jsl,3) = g1(ji,jsl)
+             rhs(ji,jsl) = ep(ji,jsl)*mc(ji,jsl-1,jst) + fp(ji,jsl)*mc(ji,jsl,jst) &
+                  & +  gp(ji,jsl) * mc(ji,jsl+1,jst) & 
+                  & + (b(ji,jsl-1) - b(ji,jsl+1)) * (dtradia/one_day) / deux & 
+                  & - rootsink(ji,jsl,jst) 
+          ENDDO
+       ENDDO
+       
+       !- Last layer
+       DO ji = 1, kjpindex
+          jsl=nslm
+          tmat(ji,jsl,1) = e(ji,jsl)
+          tmat(ji,jsl,2) = f(ji,jsl)
+          tmat(ji,jsl,3) = zero
+          rhs(ji,jsl) = ep(ji,jsl)*mc(ji,jsl-1,jst) + fp(ji,jsl)*mc(ji,jsl,jst) &
+               & + (b(ji,jsl-1) + b(ji,jsl)*(un-deux*free_drain_coef(ji,jst))) * (dtradia/one_day) / deux &
+               & - rootsink(ji,jsl,jst)
+
+       ENDDO
+
+       !- store the equations in case needed again
+       DO jsl=1,nslm
+          DO ji = 1, kjpindex
+             srhs(ji,jsl) = rhs(ji,jsl)
+             stmat(ji,jsl,1) = tmat(ji,jsl,1)
+             stmat(ji,jsl,2) = tmat(ji,jsl,2)
+             stmat(ji,jsl,3) = tmat(ji,jsl,3) 
+          ENDDO
+       ENDDO
+
+    !! 6 Resolve diffusion scheme
+
+    !! 6.1 solve diffusion equations
+       CALL hydrol_soil_tridiag(kjpindex,jst)
+
+    !! 6.2 Correct bad moisture content due to numerical errors before water balance
+       DO ji = 1, kjpindex
+          DO jsl = 1,nslm
+             IF (mc(ji,jsl,jst) .LT. mcr(njsc(ji)) .AND. mc(ji,jsl,jst) .NE. 0.) THEN
+                mc(ji,jsl,jst)=mcr(njsc(ji))
+             END IF
+             IF (mc(ji,jsl,jst) .GT. mcs(njsc(ji)) .AND. mc(ji,jsl,jst) .NE. 0.) THEN
+                mc(ji,jsl,jst)=mcs(njsc(ji))
+             END IF
+          ENDDO
+       ENDDO
+
+    !! 7 close the water balance
+    !! 7.1 compute dr_ns with the bottom boundary condition 
+    !initialize qflux at bottom of diffusion and avoid over saturated or under residual soil moisture 
+
+       DO ji = 1, kjpindex
+          dr_ns(ji,jst)=zero
+          jsl=nslm
+          IF (.NOT. is_under_mcr(ji)) THEN
+             dr_ns(ji,jst) = mask_soiltile(ji,jst)*k(ji,jsl)*free_drain_coef(ji,jst) * (dtradia/one_day)
+          ENDIF
+       ENDDO
+          
+
+    !! 7.2 compute total soil moisture content
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = dz(2,jst) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit 
+       ENDDO
+          
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl,jst) &
+                  & * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1,jst) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+       ENDDO
+
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = tmc(ji,jst) + dz(nslm,jst) &
+               & * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+       END DO
+
+       DO ji = 1, kjpindex
+    !! 7.3 deduction of upper flux from soil moisture variation and bottom flux
+          qflux00(ji,jst) = mask_soiltile(ji,jst) * &
+               & (MIN(tmcs(ji,jst),tmc(ji,jst))-tmcint(ji)+SUM(rootsink(ji,:,jst))+dr_ns(ji,jst)-returnflow_soil(ji))
+
+    !! 7.4 deduction of ae_ns and ru_ns:
+    ! ae_ns+ru_ns=precisol_ns+irrigation-q0  
+          ru_ns(ji,jst) = (precisol_ns(ji,jst)  &
+              & +water2infilt(ji,jst)-water2extract(ji)-qflux00(ji,jst)) * mask_soiltile(ji,jst)
+          ae_ns(ji,jst) =ae_ns(ji,jst) + subsinksoil(ji)
+
+       ENDDO
+
+    !! 8 Special treatment for the unstable cases
+    !! 8.1 Negative runoff
+
+       IF (long_print) THEN
+          DO ji = 1, kjpindex
+             IF (ru_ns(ji,jst) .LT. zero) THEN
+                WRITE (numout,*) 'Negative runoff corrected', ji,jst,ru_ns(ji,jst), mc(ji,1,jst), tmc(ji,jst)
+             ENDIF
+          ENDDO
+       ENDIF
+
+      DO ji = 1, kjpindex
+             IF (ru_ns(ji,jst) .LT. zero) THEN
+                ! Available water in first layer
+                temp(ji)=MAX(((mc(ji,1,jst)-mcr(njsc(ji))) * dz(2,jst) / deux), zero)
+
+                ! Calculate and add maximum water to runoff
+                temp(ji)=MIN(temp(ji),ABS(ru_ns(ji,jst)))
+                ru_ns(ji,jst)=ru_ns(ji,jst)+temp(ji)
+
+                ! Update water balance
+                qflux00(ji,jst) = qflux00(ji,jst) - temp(ji)
+                mc(ji,1,jst)=mc(ji,1,jst)-(temp(ji) * deux / dz(2,jst))
+             END IF
+
+             ! If still negative runoff, take water from deeper layers
+             DO jsl = 2, nslm-1
+                IF (ru_ns(ji,jst) .LT. zero) THEN
+                   temp(ji)= MAX((mc(ji,jsl,jst)-mcr(njsc(ji)))*(dz(jsl,jst)+dz(jsl+1,jst)) / deux, zero)
+                   temp(ji)=MIN(temp(ji),ABS(ru_ns(ji,jst)))
+                   ru_ns(ji,jst)=ru_ns(ji,jst)+temp(ji)
+                   qflux00(ji,jst) = qflux00(ji,jst) - temp(ji)
+                   mc(ji,jsl,jst)=mc(ji,jsl,jst)-temp(ji) * deux / (dz(jsl,jst)+dz(jsl+1,jst))
+                END IF
+             ENDDO
+
+             ! Last layer
+             IF (ru_ns(ji,jst) .LT. zero) THEN
+                temp(ji)=MAX((mc(ji,nslm,jst)-mcr(njsc(ji))) * dz(nslm,jst) / deux, zero)
+                temp(ji)=MIN(temp(ji),ABS(ru_ns(ji,jst)))
+                ru_ns(ji,jst)=ru_ns(ji,jst)+temp(ji)
+                qflux00(ji,jst) = qflux00(ji,jst) - temp(ji)
+                mc(ji,nslm,jst)=mc(ji,nslm,jst)-temp(ji) * deux / dz(nslm,jst)
+             END IF
+
+             ! If still negative runoff, take water from bottom drainage
+             IF (ru_ns(ji,jst) .LT. zero) THEN
+                IF (long_print)  WRITE (numout,*) 'runoff and drainage before correction',&
+                     ru_ns(ji,jst),dr_ns(ji,jst)
+                dr_ns(ji,jst)=dr_ns(ji,jst)+ru_ns(ji,jst)
+                qflux00(ji,jst) = qflux00(ji,jst) + ru_ns(ji,jst)
+                ru_ns(ji,jst)= 0.
+             END IF
+             ! qflux0 is recorded in wat_flux0 to be send to stomate_soilcarbon
+             wat_flux0(ji,jst) = qflux00(ji,jst)             
+          ENDDO
+
+    !! 8.2 Compute total soil moisture content
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = dz(2,jst) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+       ENDDO
+
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl,jst) &
+                  & * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1,jst) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+       ENDDO
+
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = tmc(ji,jst) + dz(nslm,jst) &
+               & * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+       END DO
+
+    !! 8.3 Avoid under-precision value for the 3 outward flux
+       DO ji = 1, kjpindex  
+          IF (ABS(ae_ns(ji,jst)).LT.min_sechiba) THEN
+             ae_ns(ji,jst) = zero
+          ENDIF
+
+          IF(ABS(ru_ns(ji,jst)).LT.min_sechiba) THEN
+             ru_ns(ji,jst) = zero
+          ENDIF
+       ENDDO
+
+    !! 9 Compute temporary surface water and extract from runoff
+       IF ( .NOT. doponds ) THEN
+          DO ji = 1, kjpindex
+             water2infilt(ji,jst) = reinf_slope(ji) * ru_ns(ji,jst)
+          ENDDO
+       ELSE
+          DO ji = 1, kjpindex           
+             water2infilt(ji,jst) = zero
+          ENDDO
+       ENDIF
+       !
+       DO ji = 1, kjpindex           
+          ru_ns(ji,jst) = ru_ns(ji,jst) - water2infilt(ji,jst)
+       END DO
+
+    !! 10 Smooth again
+       ! Probably not necessary but harmless (Aurelien)
+       CALL hydrol_soil_smooth(kjpindex, jst, njsc, is_under_mcr, is_over_mcs)
+
+    !! 11 Optional computation of the fluxes 
+       IF ( check_cwrr ) THEN
+          CALL hydrol_soil_flux(kjpindex,jst,mcint,returnflow_soil)
+       ENDIF
+
+    !! 12 We make some useful output
+    !- Total soil moisture, soil moisture at litter levels, soil wetness...
+
+       !-total soil moisture:
+       DO ji=1,kjpindex
+          tmc(ji,jst)= dz(2,jst) * (trois*mc(ji,1,jst) + mc(ji,2,jst))/huit
+       END DO
+
+       DO jsl=2,nslm-1
+          DO ji=1,kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl,jst) * ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1,jst)*(trois*mc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
+          END DO
+       END DO
+
+       DO ji=1,kjpindex
+          tmc(ji,jst) = tmc(ji,jst) +  dz(nslm,jst) * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+          tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
+       END DO
+
+       ! qflux is recorded in wat_flux to be send to stomate_soilcarbon
+               wat_flux(:,:,:) = qflux(:,:,:)
+
+       ! The litter is the 4 top levels of the soil
+       ! Compute various field of soil moisture for the litter (used for stomate and for albedo)
+
+       DO ji=1,kjpindex
+          tmc_litter(ji,jst) = dz(2,jst) * ( trois*mc(ji,1,jst)+ mc(ji,2,jst))/huit
+          tmc_litter(ji,jst) = tmc_litter(ji,jst) 
+       END DO
+
+       ! sum from level 1 to 4
+
+       DO jsl=2,4
+          DO ji=1,kjpindex
+             tmc_litter(ji,jst) = tmc_litter(ji,jst) + dz(jsl,jst) * & 
+                  & ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
+                  & + dz(jsl+1,jst)*(trois*mc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
+          END DO
+       END DO
+
+       ! subsequent calcul of soil_wet_litter (tmc-tmcw)/(tmcf-tmcw)
+
+       DO ji=1,kjpindex
+          soil_wet_litter(ji,jst) = MIN(un, MAX(zero,&
+               & (tmc_litter(ji,jst)-tmc_litter_wilt(ji,jst)) / &
+               & (tmc_litter_field(ji,jst)-tmc_litter_wilt(ji,jst)) ))
+       END DO
+
+       ! Soil wetness profiles (mc-mcw)/(mcs-mcw)
+       ! soil_wet is the ratio of soil moisture to available soil moisture for plant
+       ! (ie soil moisture at saturation minus soil moisture at wilting point).
+
+       DO ji=1,kjpindex
+          soil_wet(ji,1,jst) = MIN(un, MAX(zero,&
+               & (trois*mc(ji,1,jst) + mc(ji,2,jst) - quatre*mcw(njsc(ji)))&
+               & /(quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+          humrelv(ji,1,jst) = zero
+       END DO
+
+       DO jsl=2,nslm-1
+          DO ji=1,kjpindex
+             soil_wet(ji,jsl,jst) = MIN(un, MAX(zero,&
+                  & (trois*mc(ji,jsl,jst) + & 
+                  & mc(ji,jsl-1,jst) *(dz(jsl,jst)/(dz(jsl,jst)+dz(jsl+1,jst))) &
+                  & + mc(ji,jsl+1,jst)*(dz(jsl+1,jst)/(dz(jsl,jst)+dz(jsl+1,jst))) &
+                  & - quatre*mcw(njsc(ji))) / (quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+          END DO
+       END DO
+
+       DO ji=1,kjpindex
+          soil_wet(ji,nslm,jst) = MIN(un, MAX(zero,&
+               & (trois*mc(ji,nslm,jst) &
+               & + mc(ji,nslm-1,jst)-quatre*mcw(njsc(ji)))/(quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
+       END DO
+
+       ! Compute the moderation of transpiration due to wilting point
+       ! moderwilt is a factor which is zero if soil moisture is below the wilting point
+       ! and is un if soil moisture is above the wilting point.
+
+
+       DO jsl=1,nslm
+          DO ji=1,kjpindex
+             moderwilt(ji,jsl,jst) = INT( MAX(soil_wet(ji,jsl,jst), zero) + un - min_sechiba )
+          END DO
+       END DO
+
+       ! Compute the new humrelv to use in sechiba:
+       ! loop on each vegetation type
+       humrelv(:,1,jst) = zero   
+
+       ! calcul of us for each layer and vegetation type.
+       DO jv = 2,nvm
+          DO ji=1,kjpindex
+             !- Here we make the assumption that roots do not take water from the 1st layer. 
+             !- Comment the us=0 if you want to change this.
+!             us(ji,jv,jst,1) = moderwilt(ji,1,jst)*MIN(un,((trois*mc(ji,1,jst) + mc(ji,2,jst)) &
+!                  & /(quatre*mcs(jst)*pcent(jst))) )* (un-EXP(-humcste(jv)*dz(2,jst)/mille/deux)) &
+!                  & /(un-EXP(-humcste(jv)*zz(nslm,jst)/mille))
+             us(ji,jv,jst,1) = zero
+             humrelv(ji,jv,jst) = MAX(us(ji,jv,jst,1),zero)
+          END DO
+       ENDDO
+
+       DO jsl = 2,nslm-1
+          DO jv = 2, nvm
+             DO ji=1,kjpindex
+                !
+                us_tmp= (trois*mc(ji,jsl,jst) + &
+                     & mc(ji,jsl-1,jst)*(dz(jsl,jst)/(dz(jsl,jst)+dz(jsl+1,jst)))+ &
+                     & mc(ji,jsl+1,jst)*(dz(jsl+1,jst)/(dz(jsl,jst)+dz(jsl+1,jst)))) &
+                     & /(quatre*mcs(njsc(ji))*pcent(njsc(ji)))
+                ! us_tmp should not be negative
+                !!??Aurelien: Useless, here we are sure mc between mcr and mcs
+                us_tmp=MAX(us_tmp, zero)
+                ! us is computed with a SQRT in order for it to grow more rapidly with soil moisture.
+                ! it is not essential
+                us(ji,jv,jst,jsl) = moderwilt(ji,jsl,jst) * MIN( un, SQRT(us_tmp) ) * nroot(jv,jst,jsl)
+                !
+                us(ji,jv,jst,jsl) = MAX(us (ji,jv,jst,jsl), zero)
+                humrelv(ji,jv,jst) = MAX((humrelv(ji,jv,jst) + us(ji,jv,jst,jsl)),zero)
+             END DO
+          END DO
+       ENDDO
+
+       DO jv = 2, nvm
+          DO ji=1,kjpindex
+             !
+             us_tmp = (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst)) / (quatre*mcs(njsc(ji))*pcent(njsc(ji)))
+             !
+             ! us_tmp should not be negative
+             us_tmp=MAX(us_tmp, zero)
+             !
+             us(ji,jv,jst,nslm) =moderwilt(ji,nslm,jst)*  &
+                  & MIN( un, SQRT(us_tmp) ) * nroot(jv,jst,nslm)
+
+             us(ji,jv,jst,nslm) = MAX(us(ji,jv,jst,nslm), zero)
+             humrelv(ji,jv,jst) = MAX(zero,MIN(un, humrelv(ji,jv,jst) + us(ji,jv,jst,nslm)))
+             vegstressv(ji,jv,jst) = humrelv(ji,jv,jst)
+          END DO
+       END DO
+
+       DO jv = 2, nvm
+          DO ji = 1, kjpindex
+             IF (corr_veg_soil(ji,jv,jst) .LT. min_sechiba) THEN
+                humrelv(ji,jv,jst) = zero  
+             ENDIF
+          END DO
+       END DO
+
+    !! 13 before closing the soil water, we check the water balance of soil
+
+       IF(check_cwrr) THEN
+          DO ji = 1,kjpindex
+             
+             deltahum(ji) = (tmc(ji,jst) - tmcold(ji))
+             diff(ji)     = precisol_ns(ji,jst)-ru_ns(ji,jst)-dr_ns(ji,jst)-tsink(ji) &
+                  & + irrigation_soil(ji) + returnflow_soil(ji) + reinfiltration_soil(ji)
+
+             test(ji) = (ABS(deltahum(ji)-diff(ji))*mask_soiltile(ji,jst) .GT. allowed_err)
+          ENDDO
+             
+          DO ji = 1,kjpindex
+             IF(test(ji)) THEN
+                
+                WRITE (numout,*)'CWRR pat: bilan non nul',ji,jst,njsc(ji),deltahum(ji)-diff(ji)
+                WRITE (numout,*)'tmc,tmcold,diff',tmc(ji,jst),tmcold(ji),deltahum(ji)
+                WRITE(numout,*) 'evapot,evapot_penm,ae_ns',evapot(ji),evapot_penm(ji),ae_ns(ji,jst)
+                WRITE (numout,*)'flux,ru_ns,qdrain,tsink,q0,precisol',flux(ji),ru_ns(ji,jst), &
+                     &      dr_ns(ji,jst),tsink(ji),qflux00(ji,jst),precisol_ns(ji,jst)
+                WRITE (numout,*)'water2infilt',water2infilt(ji,jst)
+                WRITE (numout,*)'soiltile',soiltile(ji,jst)
+                WRITE (numout,*)'irrigation, returnflow, reinfiltration', &
+                     & irrigation_soil(ji),returnflow_soil(ji),reinfiltration_soil(ji)
+                WRITE (numout,*)'mc',mc(ji,:,jst)
+                WRITE (numout,*)'qflux',qflux(ji,:,jst)
+                WRITE (numout,*)'veget_max', veget_max(ji,:)
+                WRITE (numout,*)'k', k(ji,:)
+                
+                error=.TRUE.
+                CALL ipslerr_p(2, 'hydrol_soil', 'We will STOP in the end of this subroutine.',&
+                     & 'CWRR water balance check','')
+             ENDIF
+          ENDDO
+
+          DO ji = 1,kjpindex
+             
+             IF(MINVAL(mc(ji,:,jst)).LT.-min_sechiba) THEN
+                WRITE (numout,*)'CWRR MC NEGATIVE', &
+                     & ji,lalo(ji,:),MINLOC(mc(ji,:,jst)),jst,mc(ji,:,jst)
+                WRITE (numout,*)'evapot,evapot_penm,ae_ns',evapot(ji),evapot_penm(ji),ae_ns(ji,jst)
+                WRITE (numout,*)'flux,ru_ns,qdrain,tsink,q0,precisol',flux(ji),ru_ns(ji,jst), &
+                     &      dr_ns(ji,jst),tsink(ji),qflux00(ji,jst),precisol_ns(ji,jst)
+                WRITE (numout,*)'water2infilt',water2infilt(ji,jst)
+                WRITE (numout,*)'soiltile',soiltile(ji,jst)
+                WRITE (numout,*)'irrigation, returnflow, reinfiltration', &
+                     & irrigation_soil(ji),returnflow_soil(ji),reinfiltration_soil(ji)
+                WRITE (numout,*)'mc',mc(ji,:,jst)
+                WRITE (numout,*)'qflux',qflux(ji,:,jst)
+                WRITE (numout,*)'veget_max', veget_max(ji,:)
+                WRITE (numout,*)'k', k(ji,:)
+                WRITE (numout,*)'soiltile',soiltile(ji,jst)
+
+                error=.TRUE.
+                CALL ipslerr_p(2, 'hydrol_soil', 'We will STOP in the end of this subroutine.',&
+                     & 'CWRR MC NEGATIVE','')
+             ENDIF
+          END DO
+
+          DO ji=1,kjpindex
+             IF (ru_ns(ji,jst)*soiltile(ji,jst).LT.-min_sechiba) THEN
+                WRITE (numout,*) 'Negative runoff', ji,jst, mask_soiltile(ji,jst) 
+                WRITE (numout,*) 'mc1, mc2', mc(ji,1,jst), mc(ji,2,jst)
+                WRITE (numout,*) 'mcint1, mcint2', mcint(ji,1), mcint(ji,2)
+                WRITE (numout,*) 'qflux1, flux', qflux(ji,nslm,jst), flux(ji)
+                WRITE (numout,*) 'is_over_mcs, is_under_mcr, test', &
+                     & is_over_mcs(ji), is_under_mcr(ji), tmc(ji,jst)-tmcint(ji)+qflux(ji,nslm,jst)+SUM(rootsink(ji,:,jst))
+                WRITE (numout,*)'mc', mc(ji,:,jst)
+                WRITE (numout,*)'mcint', mcint(ji,:)
+                WRITE (numout,*)'qflux', qflux(ji,:,jst)
+                WRITE (numout,*)'rootsink1,evapot_penm,vegtot', rootsink(ji,1,jst), evapot_penm(ji), vegtot(ji)
+                WRITE (numout,*) 'ae_ns, tsink, returnflow, reinfiltration, precisol_ns, irrigation, qflux0, ru_ns', &
+                     & ae_ns(ji,jst), tsink(ji), returnflow_soil(ji), reinfiltration_soil(ji), &
+                     & precisol_ns(ji,jst), irrigation_soil(ji), qflux00(ji,jst), ru_ns(ji,jst)
+
+                error=.TRUE.
+                CALL ipslerr_p(2, 'hydrol_soil', 'We will STOP in the end of this subroutine.',&
+                     & 'Negative runoff, non-saturated soil','')
+             ENDIF
+          ENDDO
+       ENDIF
+
+       IF (long_print) WRITE (numout,*) ' hydrol_soil done for jst =', jst     
+
+    END DO  ! end of loop on soiltile
+
+
+    !
+    !! 14 sum 3d variables into 2d variables
+    !
+    CALL hydrol_diag_soil (kjpindex, veget_max, soiltile, njsc, runoff, drainage, &
+         & evapot, vevapnu, returnflow, reinfiltration, irrigation, &
+         & shumdiag, k_litt, litterhumdiag, humrel, vegstress, drysoil_frac,tot_melt)
+
+
+    !
+    !! 15 Calculation of evap_bare_limit : limitation factor for bare soil evaporation
+    !
+    evap_bare_lim(:) = zero
+    evap_bare_lim_ns(:,:) = zero
+
+    !!_  for each soil tile
+    !   
+    DO jst = 1,nstm
+
+   !! 15.1 Save mc and tmc for use at the end of the time step
+   !!      and calculate tmcint corresponding to mc without water2infilt
+       DO jsl = 1, nslm
+          DO ji = 1, kjpindex
+             mcint(ji,jsl) = mask_soiltile(ji,jst) * mc(ji,jsl,jst)
+          ENDDO
+       ENDDO
+
+       DO ji = 1, kjpindex
+          temp(ji) = tmc(ji,jst)
+       ENDDO
+
+       ! Calculate tmc corresponding to mc without water2infilt and save it for later use
+       DO ji = 1, kjpindex
+          tmcint(ji) = dz(2,jst) * ( trois*mcint(ji,1) + mcint(ji,2) )/huit
+       ENDDO
+
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmcint(ji) = tmcint(ji) + dz(jsl,jst) &
+                  * (trois*mcint(ji,jsl)+mcint(ji,jsl-1))/huit &
+                  + dz(jsl+1,jst) * (trois*mcint(ji,jsl)+mcint(ji,jsl+1))/huit
+          ENDDO
+       ENDDO
+
+       DO ji = 1, kjpindex
+          tmcint(ji) = tmcint(ji) + dz(nslm,jst) &
+               * (trois * mcint(ji,nslm) + mcint(ji,nslm-1))/huit
+       ENDDO
+
+     !! 15.2  Coefficient are recomputed for the profile of mc
+       CALL hydrol_soil_coef(kjpindex,jst,njsc)
+
+     !! 15.3 Set the values for diffusion scheme
+       CALL hydrol_soil_setup(kjpindex,jst,dtradia)
+       resolv(:) = (mask_soiltile(:,jst) .GT. 0)
+
+     !! 15.3 compute matrix coefficients 
+     !- estimate maximum evaporation flux in mm/step, assuming the water is available
+       DO ji = 1, kjpindex
+          flux(ji) = zero
+          IF(vegtot(ji).GT.min_sechiba) THEN
+             flux(ji) = evapot_penm(ji) * &
+                  AINT(frac_bare_ns(ji,jst)+un-min_sechiba)
+          ENDIF
+       ENDDO
+       !- First layer
+       DO ji = 1, kjpindex
+          tmat(ji,1,1) = zero
+          tmat(ji,1,2) = f(ji,1)
+          tmat(ji,1,3) = g1(ji,1)
+          rhs(ji,1)    = fp(ji,1) * mc(ji,1,jst) + gp(ji,1)*mc(ji,2,jst) &
+               - flux(ji) - (b(ji,1)+b(ji,2))/deux *(dtradia/one_day)
+       ENDDO
+
+       !- soil body
+       DO jsl=2, nslm-1
+          DO ji = 1, kjpindex
+             tmat(ji,jsl,1) = e(ji,jsl)
+             tmat(ji,jsl,2) = f(ji,jsl)
+             tmat(ji,jsl,3) = g1(ji,jsl)
+             rhs(ji,jsl) = ep(ji,jsl)*mc(ji,jsl-1,jst) + fp(ji,jsl)*mc(ji,jsl,jst) &
+                  +  gp(ji,jsl) * mc(ji,jsl+1,jst) &
+                  + (b(ji,jsl-1) - b(ji,jsl+1)) * (dtradia/one_day) / deux
+          ENDDO
+       ENDDO
+
+       !- Last layer
+       DO ji = 1, kjpindex
+          jsl=nslm
+          tmat(ji,jsl,1) = e(ji,jsl)
+          tmat(ji,jsl,2) = f(ji,jsl)
+          tmat(ji,jsl,3) = zero
+          rhs(ji,jsl) = ep(ji,jsl)*mc(ji,jsl-1,jst) + fp(ji,jsl)*mc(ji,jsl,jst) &
+               + (b(ji,jsl-1) + b(ji,jsl)*(un-deux*free_drain_coef(ji,jst))) * (dtradia/one_day) / deux
+       ENDDO
+
+       !- Store the equations for later use
+       DO jsl=1,nslm
+          DO ji = 1, kjpindex
+             srhs(ji,jsl) = rhs(ji,jsl)
+             stmat(ji,jsl,1) = tmat(ji,jsl,1)
+             stmat(ji,jsl,2) = tmat(ji,jsl,2)
+             stmat(ji,jsl,3) = tmat(ji,jsl,3)
+          ENDDO
+       ENDDO
+
+    !! 15.5.1 Resolution with flux=evapot_penm
+       CALL hydrol_soil_tridiag(kjpindex,jst)
+
+    !! 15.5.2 Resolution with mc(1)=mcr
+       !! Prepare to rerun in case of under residual with evaporation 
+       DO ji = 1, kjpindex
+          resolv(ji) = (mc(ji,1,jst).LT.(mcr(njsc(ji))).AND.flux(ji).GT.min_sechiba)
+       ENDDO
+       !! Reset the coefficient for diffusion (only used if resolv(ji) = .TRUE.)
+       DO jsl=1,nslm
+          !- The new condition is to put the upper layer at residual soil moisture
+          DO ji = 1, kjpindex
+             rhs(ji,jsl) = srhs(ji,jsl)
+             tmat(ji,jsl,1) = stmat(ji,jsl,1)
+             tmat(ji,jsl,2) = stmat(ji,jsl,2)
+             tmat(ji,jsl,3) = stmat(ji,jsl,3)
+          END DO
+       END DO
+       
+       DO ji = 1, kjpindex
+          tmat(ji,1,2) = un
+          tmat(ji,1,3) = zero
+          rhs(ji,1) = mcr(njsc(ji))
+       ENDDO
+       
+       !! Resolve the equations with new boundary conditions if necessary
+       CALL hydrol_soil_tridiag(kjpindex,jst)
+
+       !! Correct bad moisture content due to numerical errors before water balance
+       DO ji = 1, kjpindex
+          DO jsl = 1,nslm
+             IF (mc(ji,jsl,jst) .LT. mcr(njsc(ji)) .AND. mc(ji,jsl,jst) .NE. 0.) THEN
+                mc(ji,jsl,jst)=mcr(njsc(ji))
+             END IF
+             IF (mc(ji,jsl,jst) .GT. mcs(njsc(ji)) .AND. mc(ji,jsl,jst) .NE. 0.) THEN
+                mc(ji,jsl,jst)=mcs(njsc(ji))
+             END IF
+          ENDDO
+       ENDDO
+
+    !! 15.6 Water balance
+
+    !! 15.6.1 Compute dr_ns with the bottom boundary condition 
+
+    !         Initialize qflux at bottom of diffusion
+       DO ji = 1, kjpindex
+          flux(ji) = mask_soiltile(ji,jst)*k(ji,nslm)*free_drain_coef(ji,jst) * (dtradia/one_day)
+       ENDDO
+
+    !! 15.6.2 Compute total soil moisture content
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = dz(2,jst) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
+       ENDDO
+       
+       DO jsl = 2,nslm-1
+          DO ji = 1, kjpindex
+             tmc(ji,jst) = tmc(ji,jst) + dz(jsl,jst) &
+                  * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
+                  + dz(jsl+1,jst) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
+          ENDDO
+       ENDDO
+       
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = tmc(ji,jst) + dz(nslm,jst) &
+               * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
+       END DO
+    
+    !! 15.6.3 Deducte upper flux from soil moisture variation and bottom flux
+    !! TMCi-D-E=TMC   
+       DO ji = 1, kjpindex
+          evap_bare_lim_ns(ji,jst) = mask_soiltile(ji,jst) * &
+               (tmcint(ji)-tmc(ji,jst)-flux(ji))
+       END DO
+
+    !! 15.7 Determination of evap_bar_lim_ns
+       DO ji = 1, kjpindex
+          ! Here we weight evap_bare_lim_ns by the fraction of bare evaporating soil. 
+          ! This is given by frac_bare_ns, taking into account bare soil under vegetation
+          IF(vegtot(ji) .GT. min_sechiba) THEN
+             evap_bare_lim_ns(ji,:) = evap_bare_lim_ns(ji,:) * frac_bare_ns(ji,:)
+          ELSE
+             evap_bare_lim_ns(ji,:) = 0.
+          ENDIF
+       END DO
+
+       DO ji=1,kjpindex
+          IF ((evapot(ji).GT.min_sechiba) .AND. &
+               (tmc_litter(ji,jst).GT.(tmc_litter_wilt(ji,jst)))) THEN
+             evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) / evapot(ji)
+          ELSEIF((evapot(ji).GT.min_sechiba).AND. &
+               (tmc_litter(ji,jst).GT.(tmc_litter_res(ji,jst)))) THEN
+             evap_bare_lim_ns(ji,jst) =  (un/deux) * evap_bare_lim_ns(ji,jst) / evapot(ji)
+          END IF
+          evap_bare_lim_ns(ji,jst)=MAX(MIN(evap_bare_lim_ns(ji,jst),1.),0.)
+       END DO
+
+    !! 15.8 Restore mc and tmc
+       DO jsl = 1, nslm
+          DO ji = 1, kjpindex
+             mc(ji,jsl,jst) = mask_soiltile(ji,jst) * mcint(ji,jsl)
+          ENDDO
+       ENDDO
+
+       DO ji = 1, kjpindex
+          tmc(ji,jst) = temp(ji)
+       ENDDO
+
+    ENDDO !end loop on tiles
+
+    !! 15.9 Deduction of evap_bar_lim
+    DO ji = 1, kjpindex
+       evap_bare_lim(ji) =  SUM(evap_bare_lim_ns(ji,:)*vegtot(ji)*soiltile(ji,:))
+    ENDDO
+
+    !! 15.10 Writing variables to DOC calculation in stomate
+    soil_mc(:,:,:)=zero
+    litter_mc(:,:)=zero
+    drainage_per_soil(:,:) = zero
+    runoff_per_soil(:,:) = zero
+    soil_mc(:,:,:)=mc(:,:,:)
+    litter_mc(:,:)=tmc_litter(:,:)
+    drainage_per_soil(:,:) = dr_ns(:,:)
+    runoff_per_soil(:,:) = ru_ns(:,:)
+    !
+    !! 16 Exit if error was found previously in this subroutine
+    !
+    IF ( error ) THEN
+       WRITE(numout,*) 'One or more errors have been detected in hydrol_soil. Model stops.'
+       CALL ipslerr_p(3, 'hydrol_soil', 'We will STOP now.',&
+                  & 'One or several fatal errors were found previously.','')
+    END IF
+
+  END SUBROUTINE hydrol_soil
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_infilt
+!!
+!>\BRIEF        Infiltration
+!!
+!! DESCRIPTION  :
+!! - 1 First layer
+!! - 2 Infiltration layer by layer 
+!! - 2.1 Initialisation
+!! - 2.2 Infiltrability of each layer if under a saturated one
+!! - 2.3 Compute the mean rate at which water actually infiltrate:
+!! - 2.4 From which we deduce the time it takes to fill up the layer or to end the time step...
+!! - 2.5 The water enters in the layer
+!! - 3 Verification
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_infilt
+
+  SUBROUTINE hydrol_soil_infilt(kjpindex, ins, dtradia, njsc, flux_infilt)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! GLOBAL (in or inout)
+    INTEGER(i_std), INTENT(in)                        :: kjpindex        !! Domain size
+    REAL(r_std), INTENT (in)                          :: dtradia         !! Time step in seconds
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)  :: njsc            !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)    :: flux_infilt     !! Water to infiltrate
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                :: ji, jsl, ins        !! Indices
+    REAL(r_std), DIMENSION (kjpindex)             :: wat_inf_pot         !! infiltrable water in the layer
+    REAL(r_std), DIMENSION (kjpindex)             :: wat_inf             !! infiltrated water in the layer
+    REAL(r_std), DIMENSION (kjpindex)             :: dt_tmp              !! time remaining before the end of the time step
+    REAL(r_std), DIMENSION (kjpindex)             :: dt_inf              !! the time it takes to complete the infiltration in the 
+                                                                         !! layer 
+    REAL(r_std)                                   :: k_m                 !! the mean conductivity used for the saturated front
+    REAL(r_std), DIMENSION (kjpindex)             :: infilt_tmp          !! infiltration rate for the considered layer 
+    REAL(r_std), DIMENSION (kjpindex)             :: infilt_tot          !! total infiltration 
+    REAL(r_std), DIMENSION (kjpindex)             :: flux_tmp            !! rate at which precip hits the ground
+
+!_ ================================================================================================================================
+
+    ! If data (or coupling with GCM) was available, a parameterization for subgrid rainfall could be performed
+
+    DO ji = 1, kjpindex
+       !-
+    !_ 1 First layer
+       !-
+       ! First we fill up the first layer (about 1mm) without any resistance and quasi-immediately
+       wat_inf_pot(ji) = MAX((mcs(njsc(ji))-mc(ji,1,ins)) * dz(2,ins) / deux, zero)
+       wat_inf(ji) = MIN(wat_inf_pot(ji), flux_infilt(ji))
+       mc(ji,1,ins) = mc(ji,1,ins) + wat_inf(ji) * deux / dz(2,ins)
+       !
+    ENDDO
+    !-
+    !! 2 Infiltration layer by layer 
+    !! 2.1 Initialisation
+    ! Initialize a countdown for infiltration during the time-step and the value of potential runoff
+    dt_tmp(:) = dtradia / one_day
+    infilt_tot(:) = wat_inf(:)
+    ! Compute the rate at which water will try to infiltrate each layer
+    flux_tmp(:) = (flux_infilt(:)-wat_inf(:)) / dt_tmp(:)
+    !
+    DO jsl = 2, nslm-1
+       DO ji = 1, kjpindex
+    !! 2.2 Infiltrability of each layer if under a saturated one
+          ! This is computed by an simple arithmetic average because 
+          ! the time step (30min) is not appropriate for a geometric average (advised by Haverkamp and Vauclin)
+          k_m = (k(ji,jsl) + ks(njsc(ji))*kfact(jsl-1,njsc(ji))*kfact_root(ji,jsl,ins)) / deux 
+
+    !! 2.3 We compute the mean rate at which water actually infiltrate:
+          !- Subgrid: Exponential distribution of  k around i_m, but average p directly used 
+          !!??Aurelien: A big black cloud for me
+          infilt_tmp(ji) = k_m * (un - EXP(- flux_tmp(ji) / k_m)) 
+
+    !! 2.4 From which we deduce the time it takes to fill up the layer or to end the time step...
+          wat_inf_pot(ji) =  MAX((mcs(njsc(ji))-mc(ji,jsl,ins)) * (dz(jsl,ins) + dz(jsl+1,ins)) / deux, zero)
+          IF ( infilt_tmp(ji) > min_sechiba) THEN
+             dt_inf(ji) =  MIN(wat_inf_pot(ji)/infilt_tmp(ji), dt_tmp(ji))
+             ! The water infiltration TIME has to limited by what is still available for infiltration.
+             IF ( dt_inf(ji) * infilt_tmp(ji) > flux_infilt(ji)-infilt_tot(ji) ) THEN
+                dt_inf(ji) = MAX(flux_infilt(ji)-infilt_tot(ji),zero)/infilt_tmp(ji)
+             ENDIF
+          ELSE
+             dt_inf(ji) = dt_tmp(ji)
+          ENDIF
+
+    !! 2.5 The water enters in the layer
+          wat_inf(ji) = dt_inf(ji) * infilt_tmp(ji)
+          ! bviously the moisture content
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) + &
+               & wat_inf(ji) * deux / (dz(jsl,ins) + dz(jsl+1,ins))
+          ! the time remaining before the next time step
+          dt_tmp(ji) = dt_tmp(ji) - dt_inf(ji)
+          ! and finally the infilt_tot (which is just used to check if there is a problem, below) 
+          infilt_tot(ji) = infilt_tot(ji) + infilt_tmp(ji) * dt_inf(ji)
+       ENDDO
+    ENDDO
+    
+    !! 3 Verification
+    DO ji = 1, kjpindex
+       IF (infilt_tot(ji) .LT. -min_sechiba .OR. infilt_tot(ji) .GT. flux_infilt(ji) + min_sechiba) THEN
+          WRITE (numout,*) 'Error in the calculation of infilt tot', infilt_tot(ji)
+          WRITE (numout,*) 'k, ji, jst, mc', k(ji,1:2), ji, ins, mc(ji,1,ins)
+          CALL ipslerr_p(3, 'hydrol_soil_infilt', 'We will STOP now.','Error in calculation of infilt tot','')
+       ENDIF
+    ENDDO
+
+    RETURN
+  END SUBROUTINE hydrol_soil_infilt
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_smooth
+!!
+!>\BRIEF        Smooth soil moisture values: avoid over-saturation or under-residual values.
+!!
+!! DESCRIPTION  :
+!! - 1 Avoid over-saturation values
+!! - 1.1 top to bottom
+!! - 1.2 bottom to top
+!! - 2 Avoid below residual values
+!! - 2.1 top to bottom
+!! - 2.2 bottom to top
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_smooth
+
+  SUBROUTINE hydrol_soil_smooth(kjpindex, ins, njsc, is_under_mcr, is_over_mcs)
+
+    !- arguments
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                         :: ins             !! number of soil type
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: njsc            !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+
+    !! 0.2 Output variables
+
+    LOGICAL, DIMENSION(kjpindex), INTENT(out)          :: is_under_mcr    !! Allows under residual soil moisture due to evap 
+    LOGICAL, DIMENSION(kjpindex), INTENT(out)          :: is_over_mcs     !! Allows over saturated soil moisture due to returnflow 
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                       :: ji,jsl
+    REAL(r_std)                          :: excess
+    REAL(r_std), DIMENSION(kjpindex)     :: excessji
+
+!_ ================================================================================================================================       
+    !-
+    !! 1 Avoid over-saturation values
+    !-
+    
+    ! in case of over-saturation we put the water where it is possible
+
+    !! 1.1 top to bottom
+    DO jsl = 1, nslm-2
+       DO ji=1, kjpindex
+          excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
+          mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) + excess * &
+               &  (dz(jsl,ins)+dz(jsl+1,ins))/(dz(jsl+1,ins)+dz(jsl+2,ins))
+       ENDDO
+    ENDDO
+
+    jsl = nslm-1
+    DO ji=1, kjpindex
+       excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
+       mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
+       mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) + excess * &
+            &  (dz(jsl,ins)+dz(jsl+1,ins))/dz(jsl+1,ins)
+    ENDDO
+
+    jsl = nslm
+    DO ji=1, kjpindex
+       excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
+       mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
+       mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) + excess * &
+            &  dz(jsl,ins)/(dz(jsl-1,ins)+dz(jsl,ins))
+    ENDDO
+    !! 1.2 bottom to top
+    DO jsl = nslm-1,2,-1
+       DO ji=1, kjpindex
+          excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
+          mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) + excess * &
+               &  (dz(jsl,ins)+dz(jsl+1,ins))/(dz(jsl-1,ins)+dz(jsl,ins))
+       ENDDO
+    ENDDO
+
+    DO ji=1, kjpindex
+       excessji(ji) = mask_soiltile(ji,ins) * MAX(mc(ji,1,ins)-mcs(njsc(ji)),zero)
+    ENDDO
+
+    DO ji=1, kjpindex
+       mc(ji,1,ins) = mc(ji,1,ins) - excessji(ji)
+
+       is_over_mcs(ji) = (excessji(ji) .GT. min_sechiba)
+    ENDDO
+    DO jsl = 1, nslm
+       DO ji=1, kjpindex
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) + excessji(ji) * dz(2,ins) / (deux * dpu_max*mille)
+       ENDDO
+    ENDDO
+
+    !-
+    !! 2 Avoid below residual values
+    !-
+       
+    ! Smooth the profile to avoid negative values of punctual soil moisture
+
+    !! 2.1 top to bottom
+    DO jsl = 1,nslm-2
+       DO ji=1, kjpindex
+          excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
+          mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) - excess * &
+               &  (dz(jsl,ins)+dz(jsl+1,ins))/(dz(jsl+1,ins)+dz(jsl+2,ins))
+       ENDDO
+    ENDDO
+
+    jsl = nslm-1
+    DO ji=1, kjpindex
+       excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
+       mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
+       mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) - excess * &
+            &  (dz(jsl,ins)+dz(jsl+1,ins))/dz(jsl+1,ins)
+    ENDDO
+
+    jsl = nslm
+    DO ji=1, kjpindex
+       excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
+       mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
+       mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) - excess * &
+            &  dz(jsl,ins)/(dz(jsl-1,ins)+dz(jsl,ins))
+    ENDDO
+
+    !! 2.2 bottom to top
+    DO jsl = nslm-1,2,-1
+       DO ji=1, kjpindex
+          excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
+          mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) - excess * &
+               &  (dz(jsl,ins)+dz(jsl+1,ins))/(dz(jsl-1,ins)+dz(jsl,ins))
+       ENDDO
+    ENDDO
+
+    DO ji=1, kjpindex
+       excessji(ji) = mask_soiltile(ji,ins) * MAX(mcr(njsc(ji))-mc(ji,1,ins),zero)
+    ENDDO
+    DO ji=1, kjpindex
+       mc(ji,1,ins) = mc(ji,1,ins) + excessji(ji)
+       is_under_mcr(ji) = (excessji(ji) .GT. min_sechiba)
+    ENDDO
+
+    DO jsl = 1, nslm
+       DO ji=1, kjpindex
+          mc(ji,jsl,ins) = mc(ji,jsl,ins) - excessji(ji) * dz(2,ins) / (deux * dpu_max*mille)
+       ENDDO
+    ENDDO
+
+    ! We just get sure that mc remains at 0 where soiltile=0
+    DO jsl = 1, nslm
+       DO ji=1, kjpindex
+          mc(ji,jsl,ins) = mask_soiltile(ji,ins) * mc(ji,jsl,ins)
+       ENDDO
+    ENDDO
+    
+    RETURN
+  END SUBROUTINE hydrol_soil_smooth
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_flux
+!!
+!>\BRIEF        This subroutine computes the hydrological fluxes between the different soil layers.
+!!
+!! DESCRIPTION  :
+!! - 1 Initialize qflux from the bottom, with dr_ns
+!! - 2 between layer nslm and nslm-1   
+!! - 3 we go to top and deduct qflux(1:nslm-2)   
+!! - 4 Water balance verification
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_flux
+
+  SUBROUTINE hydrol_soil_flux(kjpindex,ins,mcint,returnflow_soil)
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                         :: ins             !! index of soil type
+    REAL(r_std), DIMENSION (kjpindex,nslm), INTENT(in) :: mcint           !! mc values at the beginning of the time step
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)      :: returnflow_soil !! returnflow
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: jsl,ji
+    REAL(r_std), DIMENSION(kjpindex)                   :: temp
+
+!_ ================================================================================================================================    
+    !- Compute the flux at every level from bottom to top (using mc and sink values)
+    DO ji = 1, kjpindex
+    !! 1 Initialize qflux from the bottom, with dr_ns
+       jsl = nslm
+       qflux(ji,jsl,ins) = dr_ns(ji,ins) - returnflow_soil(ji)
+    !!_ between layer nslm and nslm-1   
+       jsl = nslm-1
+       qflux(ji,jsl,ins) = qflux(ji,jsl+1,ins) & 
+            &  + (mc(ji,jsl,ins)-mcint(ji,jsl) &
+            &  + trois*mc(ji,jsl+1,ins) - trois*mcint(ji,jsl+1)) &
+            &  * (dz(jsl+1,ins)/huit) &
+            &  + rootsink(ji,jsl+1,ins) 
+    ENDDO
+    !! 3 we go to top and deduct qflux(1:nslm-2)   
+    DO jsl = nslm-2,1,-1
+       DO ji = 1, kjpindex
+          qflux(ji,jsl,ins) = qflux(ji,jsl+1,ins) & 
+               &  + (mc(ji,jsl,ins)-mcint(ji,jsl) &
+               &  + trois*mc(ji,jsl+1,ins) - trois*mcint(ji,jsl+1)) &
+               &  * (dz(jsl+1,ins)/huit) &
+               &  + rootsink(ji,jsl+1,ins) &
+               &  + (dz(jsl+2,ins)/huit) &
+               &  * (trois*mc(ji,jsl+1,ins) - trois*mcint(ji,jsl+1) &
+               &  + mc(ji,jsl+2,ins)-mcint(ji,jsl+2)) 
+       END DO
+    ENDDO
+    
+    !! 4 Water balance verification  
+    DO ji = 1, kjpindex
+       temp(ji) =  qflux(ji,1,ins) + (dz(2,ins)/huit) &
+            &  * (trois* (mc(ji,1,ins)-mcint(ji,1)) + (mc(ji,2,ins)-mcint(ji,2))) &
+            &  + rootsink(ji,1,ins)
+    ENDDO
+
+    DO ji = 1, kjpindex
+       IF (ABS(qflux00(ji,ins)-temp(ji)).GT. deux*min_sechiba) THEN
+          WRITE(numout,*) 'Problem in the water balance, qflux computation', qflux00(ji,ins),temp(ji)
+          WRITE (numout,*) 'returnflow_soil', returnflow_soil(ji)
+          WRITE(numout,*) 'ji', ji, 'jsl',jsl,'ins',ins
+          WRITE(numout,*) 'mcint', mcint(ji,:)
+          WRITE(numout,*) 'mc', mc(ji,:,ins)
+          WRITE (numout,*) 'rootsink', rootsink(ji,1,ins)
+          CALL ipslerr_p(3, 'hydrol_soil_flux', 'We will STOP now.',&
+               & 'Problem in the water balance, qflux computation','')
+       ENDIF
+    ENDDO
+
+    RETURN
+  END SUBROUTINE hydrol_soil_flux
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_tridiag
+!!
+!>\BRIEF        This subroutine solves a set of linear equations which has a tridiagonal coefficient matrix. 
+!!
+!! DESCRIPTION  : None
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_tridiag 
+
+  SUBROUTINE hydrol_soil_tridiag(kjpindex,ins)
+
+    !- arguments
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                         :: ins             !! number of soil type
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     ::  ji,jsl
+    REAL(r_std), DIMENSION(kjpindex)                   :: bet
+
+!_ ================================================================================================================================
+    DO ji = 1, kjpindex
+
+       IF (resolv(ji)) THEN
+          bet(ji) = tmat(ji,1,2)
+          mc(ji,1,ins) = rhs(ji,1)/bet(ji)
+       ENDIF
+    ENDDO
+
+    DO jsl = 2,nslm
+       DO ji = 1, kjpindex
+          
+          IF (resolv(ji)) THEN
+
+             gam(ji,jsl) = tmat(ji,jsl-1,3)/bet(ji)
+             bet(ji) = tmat(ji,jsl,2) - tmat(ji,jsl,1)*gam(ji,jsl)
+             mc(ji,jsl,ins) = (rhs(ji,jsl)-tmat(ji,jsl,1)*mc(ji,jsl-1,ins))/bet(ji)
+          ENDIF
+
+       ENDDO
+    ENDDO
+
+    DO ji = 1, kjpindex
+       IF (resolv(ji)) THEN
+          DO jsl = nslm-1,1,-1
+             mc(ji,jsl,ins) = mc(ji,jsl,ins) - gam(ji,jsl+1)*mc(ji,jsl+1,ins)
+          ENDDO
+       ENDIF
+    ENDDO
+    RETURN
+  END SUBROUTINE hydrol_soil_tridiag
+ 
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_coef
+!!
+!>\BRIEF        Computes coef for the linearised hydraulic conductivity 
+!! k_lin=a_lin mc_lin+b_lin and the linearised diffusivity d_lin. 
+!!
+!! DESCRIPTION  :
+!! First, we identify the interval i in which the current value of mc is located.
+!! Then, we give the values of the linearized parameters to compute 
+!! conductivity and diffusivity as K=a*mc+b and d.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_soil_coef
+ 
+  SUBROUTINE hydrol_soil_coef(kjpindex,ins,njsc)
+
+    IMPLICIT NONE
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                        :: kjpindex         !! Domain size
+    INTEGER(i_std), INTENT(in)                        :: ins              !! Index of soil type
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)  :: njsc             !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                    :: jsl,ji,i
+    REAL(r_std)                                       :: mc_ratio
+
+!_ ================================================================================================================================
+    DO jsl=1,nslm
+       DO ji=1,kjpindex 
+          !
+          mc_ratio = MAX(mc(ji,jsl,ins)-mcr(njsc(ji)), zero)/(mcs(njsc(ji))-mcr(njsc(ji)))
+          !
+          i= MAX(MIN(INT((imax-imin)*mc_ratio)+imin , imax-1), imin)
+          a(ji,jsl) = a_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins)
+          b(ji,jsl) = b_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins)
+          d(ji,jsl) = d_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins)
+          k(ji,jsl) = MAX(k_lin(imin+1,jsl,njsc(ji)), &
+               & a_lin(i,jsl,njsc(ji)) * mc(ji,jsl,ins) + b_lin(i,jsl,njsc(ji))) 
+       ENDDO ! loop on grid
+    ENDDO
+    
+    RETURN
+  END SUBROUTINE hydrol_soil_coef
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_soil_setup
+!!
+!>\BRIEF        This subroutine computes the matrix coef.  
+!!
+!! DESCRIPTION  : None 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : matrix coef
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrol_soil_setup(kjpindex,ins,dtradia)
+
+
+    IMPLICIT NONE
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    REAL(r_std), INTENT (in)                           :: dtradia          !! Time step in seconds
+    ! parameters
+    INTEGER(i_std), INTENT(in)                        :: kjpindex          !! Domain size
+    INTEGER(i_std), INTENT(in)                        :: ins               !! index of soil type
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std) :: jsl,ji
+    REAL(r_std)                        :: temp3, temp4
+
+!_ ================================================================================================================================
+    !-we compute tridiag matrix coefficients (LEFT and RIGHT) 
+    ! of the system to solve [LEFT]*mc_{t+1}=[RIGHT]*mc{t}+[add terms]: 
+    ! e(nslm),f(nslm),g1(nslm) for the [left] vector
+    ! and ep(nslm),fp(nslm),gp(nslm) for the [right] vector
+
+    ! w_time=1 (in constantes_soil) indicates implicit computation for diffusion 
+    temp3 = w_time*(dtradia/one_day)/deux
+    temp4 = (un-w_time)*(dtradia/one_day)/deux
+
+    ! Passage to arithmetic means for layer averages also in this subroutine : Aurelien 11/05/10
+
+    !- coefficient for first layer
+    DO ji = 1, kjpindex
+       e(ji,1) = zero
+       f(ji,1) = trois * dz(2,ins)/huit  + temp3 &
+            & * ((d(ji,1)+d(ji,2))/(dz(2,ins))+a(ji,1))
+       g1(ji,1) = dz(2,ins)/(huit)       - temp3 &
+            & * ((d(ji,1)+d(ji,2))/(dz(2,ins))-a(ji,2))
+       ep(ji,1) = zero
+       fp(ji,1) = trois * dz(2,ins)/huit - temp4 &
+            & * ((d(ji,1)+d(ji,2))/(dz(2,ins))+a(ji,1))
+       gp(ji,1) = dz(2,ins)/(huit)       + temp4 &
+            & * ((d(ji,1)+d(ji,2))/(dz(2,ins))-a(ji,2))
+    ENDDO
+
+    !- coefficient for medium layers
+
+    DO jsl = 2, nslm-1
+       DO ji = 1, kjpindex
+          e(ji,jsl) = dz(jsl,ins)/(huit)                        - temp3 &
+               & * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl,ins))+a(ji,jsl-1))
+
+          f(ji,jsl) = trois * (dz(jsl,ins)+dz(jsl+1,ins))/huit  + temp3 &
+               & * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl,ins)) + &
+               & (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1,ins)) )
+
+          g1(ji,jsl) = dz(jsl+1,ins)/(huit)                     - temp3 &
+               & * ((d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1,ins))-a(ji,jsl+1))
+
+          ep(ji,jsl) = dz(jsl,ins)/(huit)                       + temp4 &
+               & * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl,ins))+a(ji,jsl-1))
+
+          fp(ji,jsl) = trois * (dz(jsl,ins)+dz(jsl+1,ins))/huit - temp4 &
+               & * ( (d(ji,jsl)+d(ji,jsl-1))/(dz(jsl,ins)) + &
+               & (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1,ins)) )
+
+          gp(ji,jsl) = dz(jsl+1,ins)/(huit)                     + temp4 &
+               & *((d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1,ins))-a(ji,jsl+1))
+       ENDDO
+    ENDDO
+
+    !- coefficient for last layer
+    DO ji = 1, kjpindex
+       e(ji,nslm) = dz(nslm,ins)/(huit)        - temp3 &
+            & * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm,ins))+a(ji,nslm-1))
+       f(ji,nslm) = trois * dz(nslm,ins)/huit  + temp3 &
+            & * ((d(ji,nslm)+d(ji,nslm-1)) / (dz(nslm,ins)) &
+            & -a(ji,nslm)*(un-deux*free_drain_coef(ji,ins)))
+       g1(ji,nslm) = zero
+       ep(ji,nslm) = dz(nslm,ins)/(huit)       + temp4 &
+            & * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm,ins))+a(ji,nslm-1))
+       fp(ji,nslm) = trois * dz(nslm,ins)/huit - temp4 &
+            & * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm,ins)) &
+            & -a(ji,nslm)*(un-deux*free_drain_coef(ji,ins)))
+       gp(ji,nslm) = zero
+    ENDDO
+
+    RETURN
+  END SUBROUTINE hydrol_soil_setup
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_split_soil
+!!
+!>\BRIEF        Splits 2d variables into 3d variables, per soil type. 
+!!
+!! DESCRIPTION  :
+!! - 1 split 2d variables into 3d variables, per soil type
+!! - 1.1 precipitation
+!! - 1.2 evaporation
+!! - 1.2.1 vevapnu_old
+!! - 1.2.2 ae_ns new
+!! - 1.3 transpiration
+!! - 1.4 root sink
+!! - 2 Verification
+!! - 2.1 Check of mc
+!! - 2.2 Check if the deconvolution is correct and conserves the fluxes
+!! - 2.2.1 the precisol and evapnu
+!! - 2.2.2 the transpiration and root sink
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_split_soil
+
+  SUBROUTINE hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel,evap_bare_lim)
+    ! 
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in)       :: veget_max        !! max Vegetation map 
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltile         !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)           :: vevapnu          !! Bare soil evaporation
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)       :: transpir         !! Transpiration
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)       :: humrel           !! Relative humidity
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evap_bare_lim    !!   
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                :: ji, jv, jsl, jst
+    REAL(r_std), DIMENSION (kjpindex)             :: vevapnu_old
+    REAL(r_std), DIMENSION (kjpindex)             :: tmp_check1
+    REAL(r_std), DIMENSION (kjpindex)             :: tmp_check2
+    REAL(r_std), DIMENSION (kjpindex,nstm)        :: tmp_check3
+    LOGICAL                                       :: error=.FALSE. !! If true, exit in the end of subroutine
+
+!_ ================================================================================================================================
+    !
+    !
+    !! 1 split 2d variables into 3d variables, per soil type
+    !
+    !
+    !! 1.1 precipitation
+    precisol_ns(:,:)=zero
+    DO jv=1,nvm
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF(veget_max(ji,jv).GT.min_sechiba) THEN
+                precisol_ns(ji,jst)=precisol_ns(ji,jst)+precisol(ji,jv)* &
+                     & corr_veg_soil(ji,jv,jst) /vegtot(ji) / veget_max(ji,jv)
+             ENDIF
+          END DO
+       END DO
+    END DO
+    !
+    !
+    !! 1.2 evaporation
+    !! 1.2.1 vevapnu_old
+    vevapnu_old(:)=zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          IF ( vegtot(ji) .GT. min_sechiba) THEN
+             vevapnu_old(ji)=vevapnu_old(ji)+ &
+                  & ae_ns(ji,jst)*soiltile(ji,jst)*vegtot(ji)
+          ENDIF
+       END DO
+    END DO
+    !
+    !
+    !! 1.2.2 ae_ns new
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          IF (vevapnu_old(ji).GT.min_sechiba) THEN   
+             IF(evap_bare_lim(ji).GT.min_sechiba) THEN       
+                ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji)
+             ELSE
+                IF(vevapnu_old(ji).GT.min_sechiba) THEN  
+                   ae_ns(ji,jst)=ae_ns(ji,jst) * vevapnu(ji)/vevapnu_old(ji)
+                ELSE
+                   ae_ns(ji,jst)=zero
+                ENDIF
+             ENDIF
+          ELSEIF(frac_bare_ns(ji,jst).GT.min_sechiba) THEN
+             IF(evap_bare_lim(ji).GT.min_sechiba) THEN  
+                ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji)
+             ELSE
+                IF(tot_bare_soil(ji).GT.min_sechiba) THEN  
+                   ae_ns(ji,jst) = vevapnu(ji) * frac_bare_ns(ji,jst)/tot_bare_soil(ji)
+                ELSE
+                   ae_ns(ji,jst) = zero
+                ENDIF
+             ENDIF
+          ENDIF
+          precisol_ns(ji,jst)=precisol_ns(ji,jst)+MAX(-ae_ns(ji,jst),zero)
+       END DO
+    END DO
+    !
+    !
+    !! 1.3 transpiration
+    tr_ns(:,:)=zero
+    DO jv=1,nvm
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF (humrel(ji,jv).GT.min_sechiba) THEN 
+                tr_ns(ji,jst)=tr_ns(ji,jst)+ cvs_over_veg(ji,jv,jst)*humrelv(ji,jv,jst)* & 
+                     & transpir(ji,jv)/humrel(ji,jv)
+             ENDIF
+          END DO
+       END DO
+    END DO
+
+    !
+    !
+    !! 1.4 root sink
+    rootsink(:,:,:)=zero
+    DO jv=1,nvm
+       DO jsl=1,nslm
+          DO jst=1,nstm
+             DO ji=1,kjpindex
+                IF (humrel(ji,jv).GT.min_sechiba) THEN 
+                   rootsink(ji,jsl,jst) = rootsink(ji,jsl,jst) &
+                        & + cvs_over_veg(ji,jv,jst)* (transpir(ji,jv)*us(ji,jv,jst,jsl))/ &
+                        & humrel(ji,jv)
+                END IF
+             END DO
+          END DO
+       END DO
+    END DO
+
+    !! 2 Verification
+    !! 2.1 Check of mc
+    IF(check_cwrr) THEN
+       DO jsl=1,nslm
+          DO jst=1,nstm
+             DO ji=1,kjpindex
+                IF(mc(ji,jsl,jst).LT.-0.05) THEN
+                   WRITE(numout,*) 'CWRR split-----------------------------------------------'
+                   WRITE(numout,*) 'ji,jst,jsl',ji,jst,jsl
+                   WRITE(numout,*) 'mc',mc(ji,jsl,jst)
+                   WRITE(numout,*) 'rootsink,us',rootsink(ji,:,jst),us(ji,:,jst,jsl)
+                   WRITE(numout,*) 'corr_veg_soil',corr_veg_soil(ji,:,jst)
+                   WRITE(numout,*) 'transpir',transpir(ji,:)
+                   WRITE(numout,*) 'veget_max',veget_max(ji,:)
+                   WRITE(numout,*) 'cvs_over_veg',cvs_over_veg(ji,:,jst)
+                   WRITE(numout,*) 'humrel',humrel(ji,:)
+                   WRITE(numout,*) 'humrelv (pour ce jst)',humrelv(ji,:,jst)
+                   WRITE(numout,*) 'ae_ns',ae_ns(ji,jst)
+                   WRITE(numout,*) 'tr_ns',tr_ns(ji,jst)
+                   WRITE(numout,*) 'vevapnuold',vevapnu_old(ji)
+                ENDIF
+             END DO
+          END DO
+       END DO
+    ENDIF
+
+
+    !! 2.2 Check if the deconvolution is correct and conserves the fluxes
+
+    IF (check_cwrr) THEN
+
+
+       tmp_check1(:)=zero
+       tmp_check2(:)=zero  
+
+    !! 2.2.1 the precisol and evapnu
+
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             tmp_check1(ji)=tmp_check1(ji) + &
+                  & (precisol_ns(ji,jst)-MAX(-ae_ns(ji,jst),zero))* &
+                  & soiltile(ji,jst)*vegtot(ji)
+          END DO
+       END DO
+
+       DO jv=1,nvm
+          DO ji=1,kjpindex
+             tmp_check2(ji)=tmp_check2(ji) + precisol(ji,jv)
+          END DO
+       END DO
+
+
+       DO ji=1,kjpindex   
+
+          IF(ABS(tmp_check1(ji)- tmp_check2(ji)).GT.allowed_err) THEN
+             WRITE(numout,*) 'PRECISOL SPLIT FALSE:ji=',ji,tmp_check1(ji),tmp_check2(ji)
+             WRITE(numout,*) 'err',ABS(tmp_check1(ji)- tmp_check2(ji))
+             WRITE(numout,*) 'vegtot',vegtot(ji)
+
+             DO jv=1,nvm
+                WRITE(numout,'(a,i2.2,"|",F13.4,"|",F13.4,"|",3(F9.6))') 'jv,veget_max, precisol, corr_veg_soil ',&
+                     jv,veget_max(ji,jv),precisol(ji,jv),corr_veg_soil(ji,jv,:)
+             END DO
+
+             DO jst=1,nstm
+                WRITE(numout,*) 'jst,precisol_ns',jst,precisol_ns(ji,jst)
+                WRITE(numout,*) 'soiltile', soiltile(ji,jst)
+             END DO
+
+             error=.TRUE.
+             CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
+                  & 'check_CWRR','PRECISOL SPLIT FALSE')
+          ENDIF
+
+       END DO
+
+
+       tmp_check1(:)=zero
+
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             tmp_check1(ji)=tmp_check1(ji) + ae_ns(ji,jst)* &
+                  & soiltile(ji,jst)*vegtot(ji)
+          END DO
+       END DO
+
+       DO ji=1,kjpindex   
+
+          IF(ABS(tmp_check1(ji)- vevapnu(ji)).GT.allowed_err) THEN
+             WRITE(numout,*) 'VEVAPNU SPLIT FALSE:ji, Sum(ae_ns), vevapnu =',ji,tmp_check1(ji),vevapnu(ji)
+             WRITE(numout,*) 'err',ABS(tmp_check1(ji)- vevapnu(ji))
+             WRITE(numout,*) 'ae_ns',ae_ns(ji,:)
+             WRITE(numout,*) 'vegtot',vegtot(ji)
+             WRITE(numout,*) 'evap_bare_lim, evap_bare_lim_ns',evap_bare_lim(ji), evap_bare_lim_ns(ji,:)
+             WRITE(numout,*) 'tot_bare_soil,frac_bare_ns',tot_bare_soil(ji),frac_bare_ns(ji,:)
+             WRITE(numout,*) 'vevapnu_old',vevapnu_old(ji)
+             DO jst=1,nstm
+                WRITE(numout,*) 'jst,ae_ns',jst,ae_ns(ji,jst)
+                WRITE(numout,*) 'soiltile', soiltile(ji,jst)
+                WRITE(numout,*) 'veget_max/vegtot/soiltile', veget_max(ji,:)/vegtot(ji)/soiltile(ji,jst)
+                WRITE(numout,*) "corr_veg_soil",corr_veg_soil(ji,:,jst)
+             END DO
+
+             error=.TRUE.
+             CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
+                  & 'check_CWRR','VEVAPNU SPLIT FALSE')
+          ENDIF
+       ENDDO
+
+    !! 2.2.2 the transpiration and root sink
+
+       tmp_check1(:)=zero
+       tmp_check2(:)=zero  
+
+
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             tmp_check1(ji)=tmp_check1(ji) + tr_ns(ji,jst)* &
+                  & soiltile(ji,jst)*vegtot(ji)
+          END DO
+       END DO
+
+       DO jv=1,nvm
+          DO ji=1,kjpindex
+             tmp_check2(ji)=tmp_check2(ji) + transpir(ji,jv)
+          END DO
+       END DO
+
+       DO ji=1,kjpindex   
+
+          IF(ABS(tmp_check1(ji)- tmp_check2(ji)).GT.allowed_err) THEN
+             WRITE(numout,*) 'TRANSPIR SPLIT FALSE:ji=',ji,tmp_check1(ji),tmp_check2(ji)
+             WRITE(numout,*) 'err',ABS(tmp_check1(ji)- tmp_check2(ji))
+             WRITE(numout,*) 'vegtot',vegtot(ji)
+
+             DO jv=1,nvm
+                WRITE(numout,*) 'jv,veget_max, transpir',jv,veget_max(ji,jv),transpir(ji,jv)
+                DO jst=1,nstm
+                   WRITE(numout,*) 'corr_veg_soil:ji,jv,jst',ji,jv,jst,corr_veg_soil(ji,jv,jst)
+                END DO
+             END DO
+
+             DO jst=1,nstm
+                WRITE(numout,*) 'jst,tr_ns',jst,tr_ns(ji,jst)
+                WRITE(numout,*) 'soiltile', soiltile(ji,jst)
+             END DO
+
+             error=.TRUE.
+             CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
+                  & 'check_CWRR','TRANSPIR SPLIT FALSE')
+          ENDIF
+
+       END DO
+
+
+       tmp_check3(:,:)=zero
+
+       DO jst=1,nstm
+          DO jsl=1,nslm
+             DO ji=1,kjpindex
+                tmp_check3(ji,jst)=tmp_check3(ji,jst) + rootsink(ji,jsl,jst)
+             END DO
+          END DO
+       ENDDO
+
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF(ABS(tmp_check3(ji,jst)- tr_ns(ji,jst)).GT.allowed_err) THEN
+                WRITE(numout,*) 'ROOTSINK SPLIT FALSE:ji,jst=', ji,jst,&
+                     & tmp_check3(ji,jst),tr_ns(ji,jst)
+                WRITE(numout,*) 'err',ABS(tmp_check3(ji,jst)- tr_ns(ji,jst))
+                WRITE(numout,*) 'HUMREL(jv=1:13)',humrel(ji,:)
+                WRITE(numout,*) 'TRANSPIR',transpir(ji,:)
+                DO jv=1,nvm 
+                   WRITE(numout,*) 'jv=',jv,'us=',us(ji,jv,jst,:)
+                ENDDO
+
+                error=.TRUE.
+                CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
+                  & 'check_CWRR','ROOTSINK SPLIT FALSE')
+             ENDIF
+          END DO
+       END DO
+
+    ENDIF
+
+!! Exit if error was found previously in this subroutine
+    IF ( error ) THEN
+       WRITE(numout,*) 'One or more errors have been detected in hydrol_split_soil. Model stops.'
+       CALL ipslerr_p(3, 'hydrol_split_soil', 'We will STOP now.',&
+                  & 'One or several fatal errors were found previously.','')
+    END IF
+
+  END SUBROUTINE hydrol_split_soil
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_diag_soil
+!!
+!>\BRIEF        ??
+!!
+!! DESCRIPTION  :
+!! - 1 Apply mask_soiltile
+!! - 2 sum 3d variables in 2d variables with fraction of vegetation per soil type
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_diag_soil
+
+  SUBROUTINE hydrol_diag_soil (kjpindex, veget_max, soiltile, njsc, runoff, drainage, &
+       & evapot, vevapnu, returnflow, reinfiltration, irrigation, &
+       & shumdiag, k_litt, litterhumdiag, humrel, vegstress, drysoil_frac, tot_melt)
+    ! 
+    ! interface description
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: veget_max       !! Max. vegetation type
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: njsc            !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltile        !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evapot          !! 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: returnflow      !! Water returning to the deep reservoir
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: reinfiltration  !! Water returning to the top of the soil
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: irrigation      !! Water from irrigation
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: tot_melt        !!
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: drysoil_frac    !! Function of litter wetness
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: runoff          !! complete runoff
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: drainage        !! Drainage
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)      :: shumdiag        !! relative soil moisture
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: k_litt          !! litter cond.
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: litterhumdiag   !! litter humidity
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)       :: humrel          !! Relative humidity
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out)      :: vegstress       !! Veg. moisture stress (only for vegetation growth)
+ 
+    !! 0.3 Modified variables 
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapnu         !!
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jv, jsl, jst, i
+    REAL(r_std), DIMENSION (kjpindex)                                    :: mask_vegtot
+    REAL(r_std)                                              :: k_tmp, tmc_litter_ratio
+
+!_ ================================================================================================================================
+    !
+    ! Put the prognostics variables of soil to zero if soiltype is zero
+
+
+    !! 1 Apply mask_soiltile
+    DO jst=1,nstm 
+
+       DO ji=1,kjpindex
+
+!!??Aurelien: who and why coment this line
+!          IF(soiltile(ji,jst).EQ.zero) THEN
+
+             ae_ns(ji,jst) = ae_ns(ji,jst) * mask_soiltile(ji,jst)
+             dr_ns(ji,jst) = dr_ns(ji,jst) * mask_soiltile(ji,jst)
+             ru_ns(ji,jst) = ru_ns(ji,jst) * mask_soiltile(ji,jst)
+             tmc(ji,jst) =  tmc(ji,jst) * mask_soiltile(ji,jst)
+
+             DO jv=1,nvm
+                humrelv(ji,jv,jst) = humrelv(ji,jv,jst) * mask_soiltile(ji,jst)
+                DO jsl=1,nslm
+                   us(ji,jv,jst,jsl) = us(ji,jv,jst,jsl)  * mask_soiltile(ji,jst)
+                END DO
+             END DO
+
+             DO jsl=1,nslm          
+                mc(ji,jsl,jst) = mc(ji,jsl,jst)  * mask_soiltile(ji,jst)
+             END DO
+
+!          ENDIF
+
+       END DO
+    END DO
+
+    runoff(:) = zero
+    drainage(:) = zero
+    humtot(:) = zero
+    shumdiag(:,:)= zero
+    k_litt(:) = zero
+    litterhumdiag(:) = zero
+    tmc_litt_mea(:) = zero
+    soilmoist(:,:) = zero
+    humrel(:,:) = zero
+    vegstress(:,:) = zero
+    swi(:) = zero
+    !
+    !! 2 sum 3d variables in 2d variables with fraction of vegetation per soil type
+
+    DO ji = 1, kjpindex
+       mask_vegtot(ji) = 0
+       IF(vegtot(ji) .GT. min_sechiba) THEN
+          mask_vegtot(ji) = 1
+       ENDIF
+    END DO
+    
+    DO ji = 1, kjpindex 
+       ! Here we weight ae_ns by the fraction of bare evaporating soil. 
+       ! This is given by frac_bare_ns, taking into account bare soil under vegetation
+       ae_ns(ji,:) = mask_vegtot(ji) * ae_ns(ji,:) * frac_bare_ns(ji,:)
+    END DO
+
+    DO jst = 1, nstm
+       DO ji = 1, kjpindex 
+          drainage(ji) = mask_vegtot(ji) * (drainage(ji) + vegtot(ji)*soiltile(ji,jst) * dr_ns(ji,jst))
+          runoff(ji) = mask_vegtot(ji) *  (runoff(ji) +   vegtot(ji)*soiltile(ji,jst) * ru_ns(ji,jst)) &
+               & + (1 - mask_vegtot(ji)) * (tot_melt(ji) + irrigation(ji) + returnflow(ji) + reinfiltration(ji))
+          humtot(ji) = mask_vegtot(ji) * (humtot(ji) + soiltile(ji,jst) * tmc(ji,jst)) 
+       END DO
+    END DO
+
+    ! we add the excess of snow sublimation to vevapnu
+
+    DO ji = 1,kjpindex
+       vevapnu(ji) = vevapnu (ji) + subsinksoil(ji)*vegtot(ji)
+    END DO
+
+    DO jst=1,nstm
+       DO jv=1,nvm
+          DO ji=1,kjpindex
+             IF(veget_max(ji,jv).GT.min_sechiba) THEN
+                vegstress(ji,jv)=vegstress(ji,jv)+vegstressv(ji,jv,jst)*soiltile(ji,jst) &
+                     & * corr_veg_soil(ji,jv,jst) *vegtot(ji)/veget_max(ji,jv)
+                vegstress(ji,jv)= MAX(vegstress(ji,jv),zero)
+             ENDIF
+          END DO
+       END DO
+    END DO
+
+    cvs_over_veg(:,:,:) = zero
+    DO jv=1,nvm
+       DO ji=1,kjpindex
+          IF(veget_max(ji,jv).GT.min_sechiba) THEN
+             DO jst=1,nstm
+                cvs_over_veg(ji,jv,jst) = corr_veg_soil(ji,jv,jst)/vegtot(ji) / veget_max(ji,jv)
+             ENDDO
+          ENDIF
+       END DO
+    END DO
+
+    DO jst=1,nstm
+       DO jv=1,nvm
+          DO ji=1,kjpindex
+             humrel(ji,jv)=humrel(ji,jv)+humrelv(ji,jv,jst)*soiltile(ji,jst) &
+                  & * cvs_over_veg(ji,jv,jst)*vegtot(ji)
+             humrel(ji,jv)=MAX(humrel(ji,jv),zero)
+          END DO
+       END DO
+    END DO
+
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          ! We compute here a mean k for the 'litter' used for reinfiltration from floodplains of ponds
+          !
+          IF ( tmc_litter(ji,jst) < tmc_litter_res(ji,jst)) THEN
+             i = imin
+          ELSE
+             tmc_litter_ratio = (tmc_litter(ji,jst)-tmc_litter_res(ji,jst)) / &
+                  & (tmc_litter_sat(ji,jst)-tmc_litter_res(ji,jst))
+             i= MAX(MIN(INT((imax-imin)*tmc_litter_ratio)+imin, imax-1), imin)
+          ENDIF
+          !
+          !
+          k_tmp = MAX(k_lin(i,1,njsc(ji))*ks(njsc(ji)), zero)
+          k_litt(ji) = k_litt(ji) + soiltile(ji,jst) * SQRT(k_tmp)
+       ENDDO
+    ENDDO
+
+    DO jst=1,nstm        
+
+       DO ji=1,kjpindex
+          litterhumdiag(ji) = litterhumdiag(ji) + &
+               & soil_wet_litter(ji,jst) * soiltile(ji,jst)
+
+          tmc_litt_mea(ji) = tmc_litt_mea(ji) + &
+               & tmc_litter(ji,jst) * soiltile(ji,jst) 
+
+       END DO
+
+       DO jsl=1,nbdl
+          DO ji=1,kjpindex
+             shumdiag(ji,jsl)= shumdiag(ji,jsl) + soil_wet(ji,jsl,jst) * &
+                  & ((mcs(njsc(ji))-mcw(njsc(ji)))/(mcf(njsc(ji))-mcw(njsc(ji)))) * &
+                  & soiltile(ji,jst)
+             soilmoist(ji,jsl)=soilmoist(ji,jsl)+mc(ji,jsl,jst)*soiltile(ji,jst)
+!             shumdiag(ji,jsl) = MAX(MIN(shumdiag(ji,jsl), un), zero) 
+          END DO
+       END DO
+
+    END DO
+
+    ! First we compute swi (ALMIP requirement) - we assume here that dz is independant of jst (jst=1)
+    jst=1
+    DO ji=1,kjpindex
+       swi(ji) = swi(ji) + shumdiag(ji,1) * (dz(2,jst))/(deux*dpu_max*mille)
+       DO jsl=2,nslm-1 
+          swi(ji) = swi(ji) + shumdiag(ji,jsl) * (dz(jsl,jst)+dz(jsl+1,jst))/(deux*dpu_max*mille)
+       ENDDO
+       jsl = nslm
+       swi(ji) = swi(ji) + shumdiag(ji,jsl) * (dz(jsl,jst))/(deux*dpu_max*mille)
+    END DO
+
+    ! For stomate we need shumdiag to be bounded by 0 and 1
+    shumdiag(:,:) = MIN(shumdiag(:,:), un)
+    shumdiag(:,:) = MAX(shumdiag(:,:), zero) 
+
+    DO ji=1,kjpindex
+       IF ( tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji) > zero ) THEN
+          drysoil_frac(ji) = un + MAX( MIN( (tmc_litt_dry_mea(ji) - tmc_litt_mea(ji)) / &
+               & (tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji)), zero), - un)
+       ELSE
+          drysoil_frac(ji) = zero
+       ENDIF
+    END DO
+
+  END SUBROUTINE hydrol_diag_soil
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_waterbal 
+!!
+!>\BRIEF        Checks the water balance.
+!!
+!! DESCRIPTION  :
+!! This routine checks the water balance. First it gets the total
+!! amount of water and then it compares the increments with the fluxes.
+!! The computation is only done over the soil area as over glaciers (and lakes?)
+!! we do not have water conservation.
+!! This verification does not make much sense in REAL*4 as the precision is the same as some
+!! of the fluxes
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_waterbal
+
+  SUBROUTINE hydrol_waterbal (kjpindex, index, first_call, dtradia, veget_max, totfrac_nobio, &
+       & qsintveg, snow,snow_nobio, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, tot_melt, &
+       & vevapwet, transpir, vevapnu, vevapsno, vevapflo, floodout, runoff, drainage)
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                        :: kjpindex     !! Domain size
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index        !! Indeces of the points on the map
+    LOGICAL, INTENT (in)                               :: first_call   !! At which time is this routine called ?
+    REAL(r_std), INTENT (in)                           :: dtradia      !! Time step in seconds
+    !
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max    !! Max Fraction of vegetation type 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: totfrac_nobio!! Total fraction of continental ice+lakes+...
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintveg     !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: snow         !! Snow mass [Kg/m^2]
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio !!Ice water balance
+    !
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_rain  !! Rain precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: precip_snow  !! Snow precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: returnflow   !! Water to the bottom
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: reinfiltration !! Water to the top
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: irrigation   !! Water from irrigation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: tot_melt     !! Total melt
+    !
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: vevapwet     !! Interception loss
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: transpir     !! Transpiration
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: vevapnu      !! Bare soil evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: vevapsno     !! Snow evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: vevapflo     !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: floodout     !! flow out of floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: runoff       !! complete runoff
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: drainage     !! Drainage
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std) :: ji
+    REAL(r_std) :: watveg, delta_water
+    LOGICAL     :: error=.FALSE.  !! If true, exit in the end of subroutine
+
+!_ ================================================================================================================================
+    !
+    !
+    !
+    IF ( ALL( tot_water_beg(:) == val_exp ) ) THEN
+
+       DO ji = 1, kjpindex
+          watveg = SUM(qsintveg(ji,:))
+          tot_water_beg(ji) = humtot(ji)*vegtot(ji) + watveg + snow(ji)&
+               & + SUM(snow_nobio(ji,:))
+       ENDDO
+
+       tot_water_end(:) = tot_water_beg(:)
+       tot_flux(:) = zero
+
+       RETURN
+    ELSE IF ( first_call ) THEN
+       tot_water_end(:) = tot_water_beg(:)
+       tot_flux(:) = zero
+
+       RETURN
+    ENDIF
+
+    tot_water_end(:) = zero
+    tot_flux(:) = zero
+    !
+    DO ji = 1, kjpindex
+       !
+       ! If the fraction of ice, lakes, etc. does not complement the vegetation fraction then we do not
+       ! need to go any further
+       !
+       IF ( ABS(un - (totfrac_nobio(ji) + vegtot(ji))) .GT. allowed_err ) THEN
+          WRITE(numout,*) 'HYDROL problem in vegetation or frac_nobio on point ', ji
+          WRITE(numout,*) 'totfrac_nobio : ', totfrac_nobio(ji)
+          WRITE(numout,*) 'vegetation fraction : ', vegtot(ji)
+
+          error=.TRUE.
+          CALL ipslerr_p(2, 'hydrol_waterbal', 'We will STOP in the end of hydrol_waterbal.','','')
+       ENDIF
+    ENDDO
+
+    DO ji = 1, kjpindex
+       !
+       watveg = SUM(qsintveg(ji,:))
+       tot_water_end(ji) = humtot(ji)*vegtot(ji) + watveg + &
+            & snow(ji) + SUM(snow_nobio(ji,:))
+       !
+       tot_flux(ji) =  precip_rain(ji) + precip_snow(ji) + irrigation (ji) - &
+            & SUM(vevapwet(ji,:)) - SUM(transpir(ji,:)) - vevapnu(ji) - vevapsno(ji) - vevapflo(ji) + &
+            & floodout(ji) - runoff(ji) - drainage(ji) + returnflow(ji) + reinfiltration(ji)
+    ENDDO
+    
+    DO ji = 1, kjpindex
+       !
+       delta_water = tot_water_end(ji) - tot_water_beg(ji)
+       !
+       !
+       !  Set some precision ! This is a wild guess and corresponds to what works on an IEEE machine
+       !  under double precision (REAL*8).
+       !
+       !
+       IF ( ABS(delta_water-tot_flux(ji)) .GT. deux*allowed_err ) THEN
+          WRITE(numout,*) '------------------------------------------------------------------------- '
+          WRITE(numout,*) 'HYDROL does not conserve water. The erroneous point is : ', ji
+          WRITE(numout,*) 'Coord erroneous point', lalo(ji,:)
+          WRITE(numout,*) 'The error in mm/s is :', (delta_water-tot_flux(ji))/dtradia, ' and in mm/dt : ', &
+               & delta_water-tot_flux(ji)
+          WRITE(numout,*) 'delta_water : ', delta_water, ' tot_flux : ', tot_flux(ji)
+          WRITE(numout,*) 'Actual and allowed error : ', ABS(delta_water-tot_flux(ji)), allowed_err
+          WRITE(numout,*) 'vegtot : ', vegtot(ji)
+          WRITE(numout,*) 'precip_rain : ', precip_rain(ji)
+          WRITE(numout,*) 'precip_snow : ',  precip_snow(ji)
+          WRITE(numout,*) 'Water from routing. Reinfiltration/returnflow/irrigation : ', reinfiltration(ji), &
+               & returnflow(ji),irrigation(ji)
+          WRITE(numout,*) 'Total water in soil humtot:',  humtot(ji)
+          WRITE(numout,*) 'mc:' , mc(ji,:,:)
+          WRITE(numout,*) 'Water on vegetation watveg:', watveg
+          WRITE(numout,*) 'Snow mass snow:', snow(ji)
+          WRITE(numout,*) 'Snow mass on ice snow_nobio:', SUM(snow_nobio(ji,:))
+          WRITE(numout,*) 'Melt water tot_melt:', tot_melt(ji)
+          WRITE(numout,*) 'evapwet : ', vevapwet(ji,:)
+          WRITE(numout,*) 'transpir : ', transpir(ji,:)
+          WRITE(numout,*) 'evapnu, evapsno, evapflo: ', vevapnu(ji), vevapsno(ji), vevapflo(ji)
+          WRITE(numout,*) 'drainage,runoff,floodout : ', drainage(ji),runoff(ji),floodout(ji)
+          
+          error=.TRUE.
+          CALL ipslerr_p(2, 'hydrol_waterbal', 'We will STOP in the end of hydrol_waterbal.','','')
+       ENDIF
+       !
+    ENDDO
+    !
+    ! Transfer the total water amount at the end of the current timestep top the begining of the next one.
+    !
+    tot_water_beg = tot_water_end
+    !
+    
+    ! Exit if one or more errors were found
+    IF ( error ) THEN
+       WRITE(numout,*) 'One or more errors have been detected in hydrol_waterbal. Model stops.'
+       CALL ipslerr_p(3, 'hydrol_waterbal', 'We will STOP now.',&
+            'One or several fatal errors were found previously.','')
+    END IF
+    
+  END SUBROUTINE hydrol_waterbal
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrol_alma 
+!!
+!>\BRIEF        This routine computes the changes in soil moisture and interception storage for the ALMA outputs.  
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!
+!! REFERENCE(S) : 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!_ hydrol_alma
+
+  SUBROUTINE hydrol_alma (kjpindex, index, first_call, qsintveg, snow, snow_nobio, soilwet)
+    !
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                        :: kjpindex     !! Domain size
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)   :: index        !! Indeces of the points on the map
+    LOGICAL, INTENT (in)                              :: first_call   !! At which time is this routine called ?
+    !
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: qsintveg     !! Water on vegetation due to interception
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: snow         !! Snow water equivalent
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio     !! Water balance on ice, lakes, .. [Kg/m^2]
+
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: soilwet     !! Soil wetness
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std) :: ji
+    REAL(r_std) :: watveg
+
+!_ ================================================================================================================================
+    !
+    !
+    IF ( first_call ) THEN
+
+       tot_watveg_beg(:) = zero
+       tot_watsoil_beg(:) = zero
+       snow_beg(:)        = zero
+       !
+       DO ji = 1, kjpindex
+          watveg = SUM(qsintveg(ji,:))
+          tot_watveg_beg(ji) = watveg
+          tot_watsoil_beg(ji) = humtot(ji)
+          snow_beg(ji)        = snow(ji)+ SUM(snow_nobio(ji,:))
+       ENDDO
+       !
+       tot_watveg_end(:) = tot_watveg_beg(:)
+       tot_watsoil_end(:) = tot_watsoil_beg(:)
+       snow_end(:)        = snow_beg(:)
+
+       RETURN
+
+    ENDIF
+    !
+    ! Calculate the values for the end of the time step
+    !
+    tot_watveg_end(:) = zero
+    tot_watsoil_end(:) = zero
+    snow_end(:) = zero
+    delintercept(:) = zero
+    delsoilmoist(:) = zero
+    delswe(:) = zero
+    !
+    DO ji = 1, kjpindex
+       watveg = SUM(qsintveg(ji,:))
+       tot_watveg_end(ji) = watveg
+       tot_watsoil_end(ji) = humtot(ji)
+       snow_end(ji) = snow(ji)+ SUM(snow_nobio(ji,:))
+       !
+       delintercept(ji) = tot_watveg_end(ji) - tot_watveg_beg(ji)
+       delsoilmoist(ji) = tot_watsoil_end(ji) - tot_watsoil_beg(ji)
+       delswe(ji)       = snow_end(ji) - snow_beg(ji)
+       !
+       !
+    ENDDO
+    !
+    !
+    ! Transfer the total water amount at the end of the current timestep top the begining of the next one.
+    !
+    tot_watveg_beg = tot_watveg_end
+    tot_watsoil_beg = tot_watsoil_end
+    snow_beg(:) = snow_end(:)
+    !
+    DO ji = 1,kjpindex
+       IF ( mx_eau_var(ji) > 0 ) THEN
+          soilwet(ji) = tot_watsoil_end(ji) / mx_eau_var(ji)
+       ELSE
+          soilwet(ji) = zero
+       ENDIF
+    ENDDO
+    !
+  END SUBROUTINE hydrol_alma
+  !
+  !
+END MODULE hydrol
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/hydrolc.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/hydrolc.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/hydrolc.f90	(revision 5166)
@@ -0,0 +1,3567 @@
+! =================================================================================================================================
+! MODULE          : hydrolc
+!
+! CONTACT         : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE         : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF          This module computes the water budget of 
+!! land surfaces. It distinguishes three main reservoirs with separate water budgets : 
+!! the canopy interception reservoir, the snow pack, and the soil, described here using two
+!! soil layers, following the so-called Choisnel scheme. The module contains the  
+!! following subroutines: hydrolc_main, hydrolc_init, hydrolc_clear, hydrolc_var_init, 
+!! hydrolc_snow, hydrolc_vegupd, hydrolc_canop, hydrolc_soil, hydrolc_waterbal, hydrolc_alma, 
+!! hydrolc_hdiff.  
+!!
+!! \n DESCRIPTION : The aim of this module is to update the different water prognostic variables 
+!! (within canopy, snow and soil) and to compute the related liquid water fluxes (e.g. 
+!! throughfall, runoff, snow melt) and diagnostic variables used in other modules (e.g. 
+!! humrel and rsol to compute latent heat fluxes ; shumdiag for soil thermodynamics; snow mass 
+!! and snow age for snow albedo). 
+!! 
+!! The main input variables are precipitation (liquid and solid) and the different terms of 
+!! evapotranspiration (transpiration, bare soil evaporation, interception loss, sublimation). 
+!! The module organizes the required initialisation of water prognostic variables, their
+!! integration at each timestep given the above forcings, and the required output (writing 
+!! of restart file, updated prognostic variables, diagnostic variables). 
+!! 
+!! The specificity of hydrolc in ORCHIDEE is to describe the soil using two soil layers, 
+!! following the so-called Choisnel scheme. The upper layer has a variable depth
+!! and can disappear after dry spells (DucoudrÃ© et al., 1993). Soil moisture stress on 
+!! transpiration and bare soil evaporation acts via the height of dry soil at the top of soil.
+!!
+!! Runoff is produced when the entire soil column is saturated, as in the bucket scheme 
+!! of Manabe (1969). Drainage and surface runoff are only diagnosed,  mostly for use in 
+!! the routing module, using a constant 95% - 5% redistribution (Ngo-Duc et al., 2005).
+!! Irrigation can interact with the soil columns (de Rosnay et al., 2003), as well as 
+!! river discharge in floodplains (Ngo-Duc et al., 2005).
+!!
+!! The dynamic of the one-layer snow pack results from accumulation, sublimation and 
+!! snowmelt. Snow ageing is accounted for but it does not influence snow density.  
+!!
+!! The subgrid variability of soil follows the one of vegetation, by introducing as many 
+!! soil columns as PFTs (de Rosnay & Polcher, 1998). The water budget is performed 
+!! independently in each PFT/soil column, but water can be exchanged laterally. 
+!! The soil moisture of the bottom layer is homogenized between the soil columns at 
+!! each timestep, and a diffusion between the top soil layers can be allowed if the
+!! flag ok_hdiff is true (the default value is false).
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! REFERENCE(S)     : 
+!!  - DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp. 248-273. 
+!!  - Ducharne, A. Laval, K. and Polcher, J. (1998) Sensitivity of the hydrological cycle to the 
+!! parameterization of soil hydrology in a GCM. Climate Dynamics, 14:307-327. 
+!!  - de Rosnay, P. and Polcher J. (1998) Modeling root water uptake in a complex land surface scheme
+!!  coupled to a GCM. Hydrology and Earth System Sciences, 2(2-3):239-256. 
+!!  - de Rosnay, P., Polcher, J., Laval, K. et Sabre, M. (2003). Integrated parameterization of 
+!! irrigation in the land surface model ORCHIDEE. Validation over Indian Peninsula. Geophys. Res.
+!! Lett, 30(19):HLS2-1 -
+!! HLS2-4. 
+!!  - Krinner, G., Viovy, N., de Noblet-DucoudrÃ©, N., Ogee, J., Polcher, J., Friedlingstein, P., 
+!! Ciais, P., Sitch, S. et Prentice, I. (2005). A dynamic global vegetation model for studies of the 
+!! coupled atmosphere-biosphere system. Global Biogeochem. Cycles, 19(1).
+!!  - Ngo-Duc, T., Laval, K., Ramillien, G., Polcher, J. et Cazenave, A. (2007). Validation of the land
+!!  water storage simulated by Organising Carbon and Hydrology in Dynamic Ecosystems (ORCHIDEE) with 
+!! Gravity Recovery and Climate Experiment (GRACE) data. Water Resour. Res, 43:W04427. 
+!!  - ALMA : http://www.lmd.jussieu.fr/~polcher/ALMA/
+!!  - DucoudrÃ©, N. (1990). Sensibilite du climat simule a la parametrisation des echanges de vapeur 
+!! d'eau entre la biosphere et l'atmosphere. These de Doctorat, UniversitÃ© Paris 6. 
+!!  - Ducharne A (1997). Le cycle de l'eau : modelisation de l'hydrologie continentale, etude de ses 
+!! interactions avec le climat, These de Doctorat, UniversitÃ© Paris 6. 
+!!  - de Rosnay, P. (1999). Representation des interactions sol-plante-atmosphere dans le modele de 
+!! circulation generale du LMD. These de doctorat, UniversitÃ© Paris 6. 
+!!  - Guimberteau, M. (2010). Modelisation de l'hydrologie continentale et influences de l'irrigation 
+!! sur le cycle de l'eau, these de doctorat, UniversitÃ© Paris 6. 
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+ 
+MODULE hydrolc
+  
+  ! modules used
+  USE ioipsl
+  USE ioipsl_para 
+  USE constantes        ! contains technical constants
+  USE constantes_soil   ! soil properties and geometry (underground)
+  USE pft_parameters    ! surface and vegetation properties
+  USE sechiba_io        ! for inpout/output
+  USE grid              ! for grid, masks and calendar
+  USE mod_orchidee_para ! for variable and subroutines realted to the parallelism of orchidee
+  USE slowproc 
+
+  IMPLICIT NONE
+
+  ! public routines :
+  ! hydrol
+  PRIVATE
+  PUBLIC :: hydrolc_main,hydrolc_clear 
+
+  
+  LOGICAL, SAVE                             :: l_first_hydrol=.TRUE. !! Initialisation has to be done one time (true/false)
+!$OMP THREADPRIVATE(l_first_hydrol)
+  !
+  LOGICAL, SAVE                                   :: ok_hdiff        !! To do horizontal diffusion between soil columns
+!$OMP THREADPRIVATE(ok_hdiff)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: bqsb            !! Water content in the bottom layer  
+                                                                     !! @tex ($kg m^{-2}$) @endtex 
+!$OMP THREADPRIVATE(bqsb)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: gqsb            !! Water content in the top layer @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(gqsb)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dsg             !! Depth of the top layer (m) 
+!$OMP THREADPRIVATE(dsg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dsp             !! Depth of dry soil in the bottom layer plus depth of top 
+                                                                     !! layer (m)
+!$OMP THREADPRIVATE(dsp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mean_bqsb       !! Mean water content in the bottom layer, averaged over the 
+                                                                     !! soil columns @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(mean_bqsb)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mean_gqsb       !! Mean water content in the top layer, averaged over the   
+                                                                     !! soil columns @tex ($kg m^{-2}$) @endtex 
+!$OMP THREADPRIVATE(mean_gqsb)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_flux        !! Total water flux
+!$OMP THREADPRIVATE(tot_flux)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_water_beg   !! Total amount of water at start of time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(tot_water_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_water_end   !! Total amount of water at end of time step  
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(tot_water_end)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_watveg_beg  !! Total amount of intercepted water on vegetation at start of
+                                                                     !! time step  @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(tot_watveg_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_watveg_end  !! Total amount of intercepted water on vegetation at end of 
+                                                                     !! time step  @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(tot_watveg_end)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_watsoil_beg !! Total amount of water in the soil at start of time step  
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(tot_watsoil_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_watsoil_end !! Total amount of water in the soil at end of time step  
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(tot_watsoil_end)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: snow_beg        !! Total snow water equivalent at start of time step  
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(snow_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: snow_end        !! Total snow water equivalent at end of time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(snow_end)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: delsoilmoist    !! Change in soil moisture during time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(delsoilmoist)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: delintercept    !! Change in interception storage during time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(delintercept)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: delswe          !! Change in snow water equivalent during time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(delswe)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dss             !! Depth of dry soil at the top, whether in the top or bottom 
+                                                                     !! layer (m) 
+!$OMP THREADPRIVATE(dss)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: hdry            !! Mean top dry soil height (m) version beton
+!$OMP THREADPRIVATE(hdry)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: precisol        !! Throughfall @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(precisol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: subsnowveg      !! Sublimation of snow on vegetation 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(subsnowveg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: subsnownobio    !! Sublimation of snow on other surface types (ice, lakes,...)
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(subsnownobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: snowmelt        !! Snow melt @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(snowmelt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: icemelt         !! Ice melt @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(icemelt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: gdrainage       !! Drainage between the two soil layers 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(gdrainage)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: vegtot          !! Total fraction of grid-cell covered by PFTs (bare soil + 
+                                                                     !! vegetation) (0-1, unitless)
+!$OMP THREADPRIVATE(vegtot)  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: resdist         !! Previous values of "veget" (0-1, unitless) ! Last map of 
+                                                                     !! PFT fractions used to define the soil columns 
+!$OMP THREADPRIVATE(resdist)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mx_eau_var      !! Maximum water content of the soil 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(mx_eau_var)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: ruu_ch          !! Volumetric soil water capacity @tex ($kg m^{-3}$) @endtex
+!$OMP THREADPRIVATE(ruu_ch)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: runoff          !! Total runoff @tex ($kg m^{-2}$) @endtex
+!$OMP THREADPRIVATE(runoff)
+  REAL(r_std), PARAMETER                          :: dsg_min = 0.001 !! Reference depth to define subgrid variability of saturated
+                                                                     !! top soil layer (m) 
+!_ ================================================================================================================================      
+                                                               
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE            : hydrolc_main 
+!!
+!>\BRIEF                 Main routine for water budget calculation on land surfaces. 
+!!
+!! DESCRIPTION           : This routine drives all the calls pertaining 
+!! to the land-surface water budget. It is called once during the initialisation of 
+!! ORCHIDEE, and then once for each time step, to drive the water budget calculations, 
+!! and the link to history files processing (histwrite). It is called one more time 
+!! at the last time step, for the writing of the restart file. 
+!!
+!! The initialisation step calls hydrolc_init and hydrolc_var_init, plus hydrolc_waterbal 
+!! if we choose to check the water balance. Writing is performed to the restart file, 
+!! before the water budget calculations, at a timestep that is controlled by the flag
+!! "ldrestart_write".
+!!
+!! The water budget calculations are separated into four subroutines related to the 
+!! main three water reservoirs over land grid-cells, and called at each time step : \n
+!!  - hydrolc_snow for snow process (including age of snow)
+!!  - hydrolc_vegupd to manage the required redistribution of water between reservoirs 
+!! when the vegetation fraction of PFTs has changed
+!!  - hydrolc_canop for canopy process (interception)
+!!  - hydrolc_soil for soil hydrological process (soil moisture and runoff), followed by 
+!! hydrolc_hdiff if we choose to account for horizontal diffusion between the soil columns.
+!! If we choose to check the water balance, this is done over each timestep dtradia, 
+!! by hydrolc_waterbal. 
+!!
+!! The link to "hist" files processing has two kinds of controls: 
+!! - the standard output ncdf file corresponds to hist_id ; if hist2_id positive, a second  
+!! ncdf file is output, with a different frequency
+!! - almaoutput defines the nature/name of the written variables, whether following the 
+!! ALMA norm or not
+!! Note that histwrite does different actions depending on the current time step : 
+!! writing on "hist" files at a selected frequency ; summing of the output variables 
+!! in between in view of averaging.
+!! The subroutine also handles some "CMIP5" output (mrro, mrros and prveg).
+!!
+!! We consider that any water on ice (nobio) is snow and we only peform a water balance to have consistency. 
+!! The water balance is limited to + or - \f$10^6\f$ so that accumulation is not endless
+!!
+!! IMPORTANT NOTE : The water fluxes are used in their integrated form, over the time step 
+!! dtradia, with a unit of \f$kg.m^{-2}\f$.
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S) : snow, snow_age, snow_nobio, snow_nobio_age, tot_melt, 
+!! returnflow, irrigation, humrel, vegstress, rsol, drysoil_frac, shumdiag, litterhumdiag 
+!! + variables declared in the module
+!! + variables sent for ouput by histwrite
+!!
+!! REFERENCE(S) : Same as for module hydrolc
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrolc_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexveg, control_in,&
+     & temp_sol_new, floodout, run_off_tot, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+     & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age, tot_melt, transpir, &
+     & precip_rain, precip_snow, returnflow, reinfiltration, irrigation, humrel, vegstress, rsol, drysoil_frac, &
+     & evapot, evapot_corr, flood_frac, flood_res, shumdiag, litterhumdiag, soilcap, rest_id, hist_id, hist2_id)   
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+ 
+    INTEGER(i_std), INTENT(in)                              :: kjit             !! Current time step number (unitless)
+    INTEGER(i_std), INTENT(in)                              :: kjpindex         !! Domain size (number of grid cells) (unitless)
+    INTEGER(i_std),INTENT (in)                              :: rest_id,hist_id  !! _Restart_ file and _history_ file identifier 
+                                                                                !! (unitless)
+    INTEGER(i_std),INTENT (in)                              :: hist2_id         !! Second _history_ file identifier (unitless)
+    REAL(r_std), INTENT (in)                                :: dtradia          !! Time step duration (s)  
+    LOGICAL, INTENT(in)                                     :: ldrestart_read   !! Logical to read  _restart_ file (true/false)
+    LOGICAL, INTENT(in)                                     :: ldrestart_write  !! Logical to write  _restart_ file  (true/false)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)        :: index            !! Indices of the land grid points on the map 
+                                                                                !! (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in)    :: indexveg         !! Indices of the PFT tiles / soil columns on 
+                                                                                !! the 3D map (unitless)
+    TYPE(control_type), INTENT (in)                         :: control_in       !! Flags that (de)activate parts of the model
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: precip_rain      !! Rainfall @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: precip_snow      !! Snowfall  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: returnflow       !! Routed water which comes back into the soil 
+                                                                                !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: reinfiltration   !! Routed water which comes back into the soil
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: irrigation       !! Irrigation water applied to soils 
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: temp_sol_new     !! New soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in)    :: frac_nobio       !! Fraction of terrestrial ice, lakes, ... 
+                                                                                !! (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: totfrac_nobio    !! Total fraction of terrestrial ice+lakes+...
+                                                                                !! (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: soilcap          !! Soil heat capacity @tex ($J K^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)       :: vevapwet         !! Interception loss over each PFT 
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)       :: veget            !! Grid-cell fraction effectively covered by 
+                                                                                !! vegetation for each PFT, except for soil 
+                                                                                !! (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)       :: veget_max        !! PFT fractions within grid-cells: max value of 
+                                                                                !! veget for vegetation PFTs and min value for bare soil (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)       :: qsintmax         !! Maximum amount of water in the canopy 
+                                                                                !! interception reservoir 
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)       :: transpir         !! Transpiration over each PFT 
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: evapot           !! [DISPENSABLE] Soil Potential Evaporation  
+                                                                                !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: evapot_corr      !! [DISPENSABLE] Soil Potential Evaporation 
+                                                                                !! Correction
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)           :: flood_frac       !! Flooded fraction 
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: run_off_tot      !! Diagnosed surface runoff  
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: flood_res        !! Flood reservoir estimate 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: drainage         !! Diagnosed rainage at the bottom of soil
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)          :: rsol             !! Resistance to bare soil evaporation 
+                                                                                !! @tex ($s m^{-1}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)          :: drysoil_frac     !! Fraction of visibly dry soil, for bare soil 
+                                                                                !! albedo calculation in condveg.f90 
+                                                                                !! (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)          :: litterhumdiag    !! Litter humidity factor (0-1, unitless), used
+                                                                                !! in stomate
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)          :: tot_melt         !! Total melt @tex ($kg m^{-2}$) @endtex
+
+    !! 0.3  Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: vevapnu          !! Bare soil evaporation @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: vevapsno         !! Snow evaporation  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: vevapflo         !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: snow             !! Snow water equivalent @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: snow_age         !! Snow age (days)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio       !! Snow water equivalent on nobio areas  
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio_age   !! Snow age on ice, lakes, ...  (days)
+    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)    :: humrel           !! Soil moisture stress factor on transpiration and
+                                                                                !! bare soil evaporation (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)    :: vegstress        !! Vegetation moisture stress (only for vegetation 
+                                                                                !! growth) (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)    :: qsintveg         !! Amount of water in the canopy interception 
+                                                                                !! reservoir @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)        :: floodout         !! flux out of floodplains
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (inout)   :: shumdiag         !! Mean relative soil moisture in the different
+                                                                                !! levels used by thermosoil.f90 (0-1, unitless)
+
+    !! 0.4 Local variables
+    
+    REAL(r_std),DIMENSION (kjpindex)                        :: soilwet          !! Temporary diagnostic of relative humidity of 
+                                                                                !! total soil (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex)                        :: snowdepth        !! Snow Depth (m)
+    INTEGER(i_std)                                          :: ji,jv            !! Grid-cell and PFT indices (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                        :: histvar          !! Ancillary variable when computations are needed
+                                                                                !! before writing to history files
+    CHARACTER(LEN=80)                                       :: var_name         !! To store variables names for I/O
+
+!_ ================================================================================================================================
+    
+  !! 1.  Initialisation
+    
+    IF (l_first_hydrol) THEN
+
+        IF (long_print) WRITE (numout,*) ' l_first_hydrol : call hydrolc_init '
+
+        CALL hydrolc_init (kjit, ldrestart_read, kjpindex, index, rest_id, veget, humrel, vegstress, &
+             & snow, snow_age, snow_nobio, snow_nobio_age, qsintveg) 
+
+        CALL hydrolc_var_init (kjpindex, veget, veget_max, rsol, drysoil_frac, mx_eau_var, ruu_ch, shumdiag, litterhumdiag)
+        
+        ! If we check the water balance, we first save the total amount of water
+        IF (check_waterbal) THEN
+           CALL hydrolc_waterbal(kjpindex, index, .TRUE., dtradia, veget, totfrac_nobio, qsintveg, snow, snow_nobio,&
+                & precip_rain, precip_snow, returnflow, reinfiltration, irrigation, tot_melt, vevapwet, transpir, &
+                & vevapnu, vevapsno, vevapflo, floodout, run_off_tot, drainage)
+        ENDIF
+        
+        IF (almaoutput) THEN
+           CALL hydrolc_alma(kjpindex, index, .TRUE., qsintveg, snow, snow_nobio, soilwet)
+        ENDIF
+        
+        ! shared time step
+        IF (long_print) WRITE (numout,*) 'hydrolc pas de temps = ',dtradia
+
+        RETURN
+
+    ENDIF !  initialisation
+    
+  !! 2. Preparing restart file for the next simulation
+    IF (ldrestart_write) THEN
+
+        IF (long_print) WRITE (numout,*) ' we have to complete restart file with HYDROLOGIC variables '
+
+        var_name= 'humrel'  
+        CALL restput_p(rest_id, var_name, nbp_glo,   nvm, 1, kjit,  humrel, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'vegstress'  
+        CALL restput_p(rest_id, var_name, nbp_glo,   nvm, 1, kjit,  vegstress, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'snow'    
+        CALL restput_p(rest_id, var_name, nbp_glo,   1, 1, kjit,  snow, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'snow_age'
+        CALL restput_p(rest_id, var_name, nbp_glo,   1, 1, kjit,  snow_age, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'snow_nobio'    
+        CALL restput_p(rest_id, var_name, nbp_glo, nnobio, 1, kjit,  snow_nobio, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'snow_nobio_age'
+        CALL restput_p(rest_id, var_name, nbp_glo, nnobio, 1, kjit, snow_nobio_age, 'scatter', nbp_glo, index_g)
+        
+        var_name= 'bqsb'    
+        CALL restput_p(rest_id, var_name, nbp_glo,   nvm, 1, kjit,  bqsb, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'gqsb'   
+        CALL restput_p(rest_id, var_name, nbp_glo,   nvm, 1, kjit,  gqsb, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'dsg'     
+        CALL restput_p(rest_id, var_name, nbp_glo,  nvm, 1, kjit,  dsg, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'dsp'    
+        CALL restput_p(rest_id, var_name, nbp_glo,   nvm, 1, kjit,  dsp, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'dss'    
+        CALL restput_p(rest_id, var_name, nbp_glo,   nvm, 1, kjit,  dss, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'hdry'    
+        CALL restput_p(rest_id, var_name, nbp_glo,   1, 1, kjit,  hdry, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'qsintveg'
+        CALL restput_p(rest_id, var_name, nbp_glo, nvm, 1, kjit,  qsintveg, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'resdist'
+        CALL restput_p(rest_id, var_name, nbp_glo, nvm, 1, kjit,  resdist, 'scatter',  nbp_glo, index_g)
+        RETURN
+        
+    END IF ! writing restart
+     
+  !! 3. Water budget calculations:
+    
+    !! 3.a snow processes
+    CALL hydrolc_snow(kjpindex, dtradia, precip_rain, precip_snow, temp_sol_new, soilcap, &
+         & frac_nobio, totfrac_nobio, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age, &
+         & tot_melt, snowdepth)
+   
+    !! 3.b canopy processes
+    CALL hydrolc_vegupd(kjpindex, veget, ruu_ch, qsintveg, gqsb, bqsb, dsg, dss,dsp, resdist)
+    
+    CALL hydrolc_canop(kjpindex, precip_rain, vevapwet, veget, qsintmax, qsintveg, precisol)
+    !
+    ! computes surface reservoir
+    !
+    CALL hydrolc_flood(kjpindex, dtradia, vevapnu, vevapflo, flood_frac, flood_res, floodout)
+   
+    !! 3.c soil hydrology processes
+    CALL hydrolc_soil(kjpindex, vevapnu, precisol, returnflow, reinfiltration, irrigation, tot_melt, mx_eau_var, veget, &
+         & ruu_ch, transpir,gqsb, bqsb, dsg, dss, rsol, drysoil_frac, hdry, dsp, runoff, run_off_tot, drainage, humrel, &
+         & vegstress, shumdiag, litterhumdiag)
+    
+    ! computes horizontal diffusion between the water reservoirs
+    IF ( ok_hdiff ) THEN
+      CALL hydrolc_hdiff(kjpindex, dtradia, veget, ruu_ch, gqsb, bqsb, dsg, dss, dsp)
+    ENDIF
+    
+    ! If we check the water balance, we end with the comparison of total water change and fluxes
+    IF (check_waterbal) THEN
+       CALL hydrolc_waterbal(kjpindex, index, .FALSE., dtradia, veget, totfrac_nobio, qsintveg, snow, snow_nobio,&
+            & precip_rain, precip_snow, returnflow, reinfiltration, irrigation, tot_melt, vevapwet, transpir, vevapnu, vevapsno,&
+            & vevapflo, floodout, run_off_tot, drainage )
+    ENDIF
+    
+  !! 4. Output
+    
+    ! If we use the ALMA standards (then 'humrel' is not written)
+    IF (almaoutput) THEN
+       CALL hydrolc_alma(kjpindex, index, .FALSE., qsintveg, snow, snow_nobio, soilwet)
+    ENDIF
+    
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite_p(hist_id, 'dss', kjit, dss, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'bqsb', kjit, mean_bqsb, kjpindex, index)
+       CALL histwrite_p(hist_id, 'gqsb', kjit, mean_gqsb, kjpindex, index)
+       CALL histwrite_p(hist_id, 'runoff', kjit, run_off_tot, kjpindex, index) ! this is surface runoff = 5% of total runoff
+       CALL histwrite_p(hist_id, 'drainage', kjit, drainage, kjpindex, index) ! this 95% of total runoff
+       IF ( control_in%do_floodplains ) THEN
+          CALL histwrite_p(hist_id, 'floodout', kjit, floodout, kjpindex, index)
+       ENDIF
+       CALL histwrite_p(hist_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'rain', kjit, precip_rain, kjpindex, index)
+       CALL histwrite_p(hist_id, 'snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg) ! this the transpiration stress factor
+
+    !! The output for "CMIP5" is handled here, assuming that fluxes in kg m^{-2} s^{-1}
+    !!  But the transformation below on mrro, mrros and prveg lead to fluxes that are 48 times too small !***
+
+       histvar(:)=zero
+       DO jv = 1, nvm
+          DO ji = 1, kjpindex
+             IF ( vegtot(ji) .GT. zero ) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+                IF (jv .EQ. 1) THEN
+                   histvar(ji)=histvar(ji)+tot_bare_soil(ji)/vegtot(ji)*MAX((0.1-dss(ji,jv))*wmax_veg(jv), zero)
+                ELSE
+                   histvar(ji)=histvar(ji)+veget(ji,jv)/vegtot(ji)*MAX((0.1-dss(ji,jv))*wmax_veg(jv), zero)
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDDO
+       ! this is soil moisture in the top 10 cms
+       CALL histwrite_p(hist_id, 'mrsos', kjit, histvar, kjpindex, index) 
+
+       ! this is total soil moisture
+       histvar(:)=mean_bqsb(:)+mean_gqsb(:)
+       CALL histwrite_p(hist_id, 'mrso', kjit, histvar, kjpindex, index) 
+
+       CALL histwrite_p(hist_id, 'mrros', kjit, run_off_tot, kjpindex, index)
+
+       histvar(:)=run_off_tot(:)+drainage(:)
+       CALL histwrite_p(hist_id, 'mrro', kjit, histvar, kjpindex, index)
+
+       histvar(:)=(precip_rain(:)-SUM(precisol(:,:),dim=2))
+       CALL histwrite_p(hist_id, 'prveg', kjit, histvar, kjpindex, index)
+
+    ELSE 
+       
+       ! almaoutput=true
+       CALL histwrite_p(hist_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+   
+       ! surface runoff = 5% of total runoff
+       CALL histwrite_p(hist_id, 'Qs', kjit, run_off_tot, kjpindex, index)
+
+       ! drainage = 95% of total runoff
+       CALL histwrite_p(hist_id, 'Qsb', kjit, drainage, kjpindex, index) 
+       CALL histwrite_p(hist_id, 'Qsm', kjit, tot_melt, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelSWE', kjit, delswe, kjpindex, index)
+       CALL histwrite_p(hist_id, 'DelIntercept', kjit, delintercept, kjpindex, index)      
+       CALL histwrite_p(hist_id, 'SoilMoist', kjit, tot_watsoil_end, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+       
+       ! this the transpiration stress factor
+       CALL histwrite_p(hist_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg) 
+       
+       CALL histwrite_p(hist_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
+       
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist2_id, 'dss', kjit, dss, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'bqsb', kjit, mean_bqsb, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'gqsb', kjit, mean_gqsb, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'runoff', kjit, run_off_tot, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'drainage', kjit, drainage, kjpindex, index)
+          IF ( control_in%do_floodplains ) THEN
+             CALL histwrite_p(hist2_id, 'floodout', kjit, floodout, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'rain', kjit, precip_rain, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg)
+
+          !
+          IF (check_waterbal) THEN
+             CALL histwrite_p(hist2_id, 'TotWater', kjit, tot_water_end, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'TotWaterFlux', kjit, tot_flux, kjpindex, index)
+          ENDIF
+
+          histvar(:)=zero
+          DO jv = 1, nvm
+             DO ji = 1, kjpindex
+                IF ( vegtot(ji) .GT. zero ) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+                   IF (jv .EQ. 1) THEN
+                      histvar(ji)=histvar(ji)+tot_bare_soil(ji)/vegtot(ji)*MAX((0.1-dss(ji,jv))*wmax_veg(jv), zero)
+                   ELSE
+                      histvar(ji)=histvar(ji)+veget(ji,jv)/vegtot(ji)*MAX((0.1-dss(ji,jv))*wmax_veg(jv), zero)
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+          CALL histwrite_p(hist2_id, 'mrsos', kjit, histvar, kjpindex, index)
+
+          histvar(:)=run_off_tot(:)+drainage(:)
+          CALL histwrite_p(hist2_id, 'mrro', kjit, histvar, kjpindex, index)
+
+       ELSE
+          CALL histwrite_p(hist2_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qs', kjit, run_off_tot, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qsb', kjit, drainage, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'Qsm', kjit, tot_melt, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSWE', kjit, delswe, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
+          
+          CALL histwrite_p(hist2_id, 'SoilMoist', kjit, tot_watsoil_end, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+          
+          CALL histwrite_p(hist2_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+          
+          CALL histwrite_p(hist2_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
+          
+       ENDIF
+    ENDIF
+    
+    IF (long_print) WRITE (numout,*) ' hydrolc_main Done '
+
+  END SUBROUTINE hydrolc_main
+ 
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrolc_init
+!!
+!>\BRIEF        This routine drives the initialisation of the water budget calculations. 
+!!
+!! DESCRIPTION : The following sequences are performed :
+!!  - Updating flag l_first_hydrol
+!!  - Setting ok_hdiff (default is false) for horizontal diffusion between soil columns
+!!  - Dynamic allocation of arrays that are local to module hydrolc
+!!  - Initializing prognostic variables from input restart file
+!!  - Default attribution is performed in case the model is started without a restart file
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : humrel, vegstress,snow, snow_age, snow_nobio, snow_nobio_age, qsintveg
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_ ================================================================================================================================  
+  
+  SUBROUTINE hydrolc_init(kjit, ldrestart_read, kjpindex, index, rest_id, veget, humrel, vegstress, &
+       & snow, snow_age, snow_nobio, snow_nobio_age, qsintveg)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+ 
+    INTEGER(i_std), INTENT (in)                          :: kjit                !! Current time step number (unitless)
+    LOGICAL,INTENT (in)                                  :: ldrestart_read      !! Logical to read  _restart_ file (true/false)
+    INTEGER(i_std), INTENT (in)                          :: kjpindex            !! Domain size (number of grid cells) (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)     :: index               !! Indices of the land grid points on the map 
+                                                                                !! (unitless)
+    INTEGER(i_std), INTENT (in)                          :: rest_id             !! _Restart_ file identifier (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget               !! Grid-cell fraction effectively covered by 
+                                                                                !! vegetation for each PFT, except for soil 
+                                                                                !! (0-1, unitless) 
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: humrel              !! Soil moisture stress factor on transpiration
+                                                                                !! and bare soil evaporation (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: vegstress           !! Vegetation moisture stress (only for 
+                                                                                !! vegetation growth) (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: snow                !! Snow water equivalent @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: snow_age            !! Snow age (days)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out):: snow_nobio          !! Snow water equivalent on nobio areas 
+                                                                                !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out):: snow_nobio_age      !! Snow age on ice, lakes, ...  (days)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)   :: qsintveg            !! Amount of water in the canopy interception 
+                                                                                !! reservoir @tex ($kg m^{-2}$) @endtex 
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                       :: ier                 !! To receive error flag during allocation
+    INTEGER(i_std)                                       :: ji,jv,ik            !! Indices for grid-cells, PFTs, and grid-cells 
+                                                                                !! (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm)                :: zdsp, tmpdss        !! Ancillary variables for initializing dsp 
+                                                                                !! and dss (m)
+    REAL(r_std), ALLOCATABLE, DIMENSION (:,:)            :: dsp_g               !! Ancillary variable for initializing dsp (m)
+                                                                                !! dss (m)   
+    REAL(r_std), DIMENSION(kjpindex)                     :: a_subgrd            !! Diagnosed subgrid fraction of saturated soil in
+                                                                                !! the top layer, to calculate hdry (0-1, unitless)
+    CHARACTER(LEN=80)                                    :: var_name            !! To store variables names for I/O
+!_ ================================================================================================================================
+
+  !! 1. Make sure initialization happens only once (l_first_hydrol becomes false)
+    
+    IF (l_first_hydrol) THEN 
+        l_first_hydrol=.FALSE.
+    ELSE 
+        WRITE (numout,*) ' l_first_hydrol false . we stop '
+        STOP 'hydrolc_init'
+    ENDIF
+    
+  !! 2. Setting ok_hdiff for horizontal diffusion between soil columns
+
+    !Config Key   = HYDROL_OK_HDIFF
+    !Config Desc  = do horizontal diffusion?
+    !Config If    = OK_SECHIBA and .NOT.(HYDROL_CWRR)  
+    !Config Def   = n
+    !Config Help  = If TRUE, then water can diffuse horizontally between
+    !Config         the PFTs' water reservoirs.
+    !Config Units = [FLAG]
+    ok_hdiff = .FALSE.
+    CALL getin_p('HYDROL_OK_HDIFF',ok_hdiff) 
+
+  !! 3. Make dynamic allocation with the good dimensions
+
+    ! one dimension array allocation with possible restart value
+    ALLOCATE (bqsb(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in bqsb allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    bqsb(:,:) = zero
+
+    ALLOCATE (gqsb(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in gqsb allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    gqsb(:,:) = zero
+
+    ALLOCATE (dsg(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in dsg allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    dsg(:,:) = zero
+
+    ALLOCATE (dsp(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in dsp allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    dsp(:,:) = zero
+
+    ! one dimension array allocation 
+    ALLOCATE (mean_bqsb(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in mean_bqsb allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    mean_bqsb(:) = zero
+
+    ALLOCATE (mean_gqsb(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in mean_gqsb allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    mean_gqsb(:) = zero
+
+    ALLOCATE (dss(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in dss allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    dss(:,:) = zero
+
+    ALLOCATE (hdry(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in hdry allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    hdry(:) = zero
+
+    ALLOCATE (precisol(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in precisol allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    precisol(:,:) = zero
+
+    ALLOCATE (gdrainage(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in precisol allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    gdrainage(:,:) = zero
+
+    ALLOCATE (subsnowveg(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in subsnowveg allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    subsnowveg(:) = zero
+
+    ALLOCATE (subsnownobio(kjpindex,nnobio),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in subsnownobio allocation. We stop. We need kjpindex*nnobio words = ', &
+          kjpindex*nnobio
+        STOP 'hydrolc_init'
+    END IF
+    subsnownobio(:,:) = zero
+
+    ALLOCATE (snowmelt(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in snowmelt allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    snowmelt(:) = zero
+
+    ALLOCATE (icemelt(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in icemelt allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    icemelt(:) = zero
+
+    ALLOCATE (mx_eau_var(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in mx_eau_var allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    mx_eau_var(:) = zero
+
+    ALLOCATE (ruu_ch(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in ruu_ch allocation. We stop. We need kjpindex words = ',kjpindex
+        STOP 'hydrolc_init'
+    END IF
+    ruu_ch(:) = zero
+
+    ALLOCATE (vegtot(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in vegtot allocation. We stop. We need kjpindex words = ',kjpindex*nvm
+        STOP 'hydrolc_init'
+    END IF
+    vegtot(:) = zero
+
+    ALLOCATE (resdist(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in resdist allocation. We stop. We need kjpindex words = ',kjpindex*nvm
+        STOP 'hydrolc_init'
+    END IF
+    resdist(:,:) = zero
+
+    ALLOCATE (runoff(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in runoff allocation. We stop. We need kjpindex words = ',kjpindex*nvm
+        STOP 'hydrolc_init'
+    END IF
+    runoff(:,:) = zero
+    
+    !  If we check the water balance we need two more variables
+    IF ( check_waterbal ) THEN
+
+       ALLOCATE (tot_water_beg(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_water_beg allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (tot_water_end(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_water_end allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (tot_flux(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_flux allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrol_init'
+       END IF
+
+    ENDIF
+    
+    !  If we use the almaoutputs we need four more variables
+    IF ( almaoutput ) THEN
+
+       ALLOCATE (tot_watveg_beg(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_watveg_beg allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (tot_watveg_end(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_watveg_end allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (tot_watsoil_beg(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_watsoil_beg allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (tot_watsoil_end(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in tot_watsoil_end allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (delsoilmoist(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in delsoilmoist allocation. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (delintercept(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in delintercept. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (delswe(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in delswe. We stop. We need kjpindex words = ',kjpindex
+          STOP 'hydrolc_init'
+       ENDIF
+
+       ALLOCATE (snow_beg(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in snow_beg allocation. We stop. We need kjpindex words =',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+       ALLOCATE (snow_end(kjpindex),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in snow_end allocation. We stop. We need kjpindex words =',kjpindex
+          STOP 'hydrolc_init'
+       END IF
+
+    ENDIF
+
+  !!  4. Initialization of hydrologic variables:
+
+    !! 4.a Read data from restart input file (opened by sechiba_init)
+    !! for HYDROLOGIC processes
+    IF (ldrestart_read) THEN
+
+        IF (long_print) WRITE (numout,*) ' we have to read a restart file for HYDROLOGIC variables'
+
+        var_name= 'snow'        
+        CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Snow mass')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1  , 1, kjit, .TRUE., snow, "gather", nbp_glo, index_g)
+!!$        ! correction for old restart
+!!$        DO ik=1, kjpindex
+!!$           if(snow(ik).gt.maxmass_glacier) snow(ik)=maxmass_glacier
+!!$        ENDDO
+        
+        var_name= 'snow_age'
+        CALL ioconf_setatt_p('UNITS', 'd')
+        CALL ioconf_setatt_p('LONG_NAME','Snow age')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1  , 1, kjit, .TRUE., snow_age, "gather", nbp_glo, index_g)
+        
+        var_name= 'snow_nobio'
+        CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Snow on other surface types')
+        CALL restget_p (rest_id, var_name, nbp_glo, nnobio  , 1, kjit, .TRUE., snow_nobio, "gather", nbp_glo, index_g)
+!!$        ! correction for old restart
+!!$        DO ik=1, kjpindex
+!!$           if(snow_nobio(ik,iice).gt.maxmass_glacier) snow_nobio(ik,iice)=maxmass_glacier
+!!$        ENDDO
+        
+        var_name= 'snow_nobio_age'
+        CALL ioconf_setatt_p('UNITS', 'd')
+        CALL ioconf_setatt_p('LONG_NAME','Snow age on other surface types')
+        CALL restget_p (rest_id, var_name, nbp_glo, nnobio  , 1, kjit, .TRUE., snow_nobio_age, "gather", nbp_glo, index_g)
+        
+        var_name= 'humrel'
+        CALL ioconf_setatt_p('UNITS', '-')
+        CALL ioconf_setatt_p('LONG_NAME','Soil moisture stress')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., humrel, "gather", nbp_glo, index_g)
+        
+        var_name= 'vegstress'
+        CALL ioconf_setatt_p('UNITS', '-')
+        CALL ioconf_setatt_p('LONG_NAME','Vegetation growth moisture stress')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., vegstress, "gather", nbp_glo, index_g)
+        
+        var_name= 'bqsb'
+        CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Deep soil moisture')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm , 1, kjit, .TRUE., bqsb, "gather", nbp_glo, index_g)
+        
+        var_name= 'gqsb'
+        CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Surface soil moisture')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm , 1, kjit, .TRUE., gqsb, "gather", nbp_glo, index_g)
+        
+        var_name= 'dsg'
+        CALL ioconf_setatt_p('UNITS', 'm')
+        CALL ioconf_setatt_p('LONG_NAME','Depth of upper reservoir')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm  , 1, kjit, .TRUE., dsg, "gather", nbp_glo, index_g)
+        
+        var_name= 'dsp'
+        CALL ioconf_setatt_p('UNITS', 'm')
+        CALL ioconf_setatt_p('LONG_NAME','Depth to lower reservoir')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm  , 1, kjit, .TRUE., dsp, "gather", nbp_glo, index_g)
+        
+        var_name= 'dss'
+        CALL ioconf_setatt_p('UNITS', 'm')
+        CALL ioconf_setatt_p('LONG_NAME','Hauteur au dessus du reservoir de surface')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm  , 1, kjit, .TRUE., dss, "gather", nbp_glo, index_g)
+                
+        var_name= 'hdry'
+        CALL ioconf_setatt_p('UNITS', 'm')
+        CALL ioconf_setatt_p('LONG_NAME','Dry soil heigth in meters')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1 , 1, kjit, .TRUE., hdry, "gather", nbp_glo, index_g)
+                
+        var_name= 'qsintveg'
+        CALL ioconf_setatt_p('UNITS', 'kg/m^2')
+        CALL ioconf_setatt_p('LONG_NAME','Intercepted moisture')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., qsintveg, "gather", nbp_glo, index_g)
+        
+        var_name= 'resdist'
+        CALL ioconf_setatt_p('UNITS', '-')
+        CALL ioconf_setatt_p('LONG_NAME','Distribution of reservoirs')
+        CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., resdist, "gather", nbp_glo, index_g)
+        
+        !! 4.b Assign default values if non were found in the restart file
+        !Config Key   = HYDROL_SNOW
+        !Config Desc  = Initial snow mass if not found in restart
+        !Config If    = OK_SECHIBA
+        !Config Def   = 0.0
+        !Config Help  = The initial value of snow mass if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [kg/m^2]
+        CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', zero)
+        
+        !Config Key   = HYDROL_SNOWAGE
+        !Config Desc  = Initial snow age if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.0
+        !Config Help  = The initial value of snow age if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [days]
+        CALL setvar_p (snow_age, val_exp, 'HYDROL_SNOWAGE', zero)
+        
+        !Config Key   = HYDROL_SNOW_NOBIO
+        !Config Desc  = Initial snow amount on ice, lakes, etc. if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.0
+        !Config Help  = The initial value of snow if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [m]
+        CALL setvar_p (snow_nobio, val_exp, 'HYDROL_SNOW_NOBIO', zero)
+        
+        !Config Key   = HYDROL_SNOW_NOBIO_AGE
+        !Config Desc  = Initial snow age on ice, lakes, etc. if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.0
+        !Config Help  = The initial value of snow age if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [days]
+        CALL setvar_p (snow_nobio_age, val_exp, 'HYDROL_SNOW_NOBIO_AGE', zero)
+        
+        !Config Key   = HYDROL_HUMR
+        !Config Desc  = Initial soil moisture stress if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 1.0
+        !Config Help  = The initial value of soil moisture stress if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [-]
+        CALL setvar_p (humrel, val_exp,'HYDROL_HUMR', un)
+        CALL setvar_p (vegstress, val_exp,'HYDROL_HUMR', un)
+        
+        !Config Key   = HYDROL_BQSB
+        !Config Desc  = Initial restart deep soil moisture if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 999999. 
+        !Config Help  = The initial value of deep soil moisture if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file. Default behaviour is a saturated soil.
+        !Config Units = [kg/m^2]
+        CALL setvar_p (bqsb, val_exp, 'HYDROL_BQSB', wmax_veg*dpu_max)
+        
+        !Config Key   = HYDROL_GQSB
+        !Config Desc  = Initial upper soil moisture if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.0
+        !Config Help  = The initial value of upper soil moisture if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [kg/m^2]
+        CALL setvar_p (gqsb, val_exp, 'HYDROL_GQSB', zero)
+        
+        !Config Key   = HYDROL_DSG
+        !Config Desc  = Initial upper reservoir depth if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.0
+        !Config Help  = The initial value of upper reservoir depth if its value is not found
+        !Config         in the restart file. This should only be used if the model is 
+        !Config         started without a restart file.
+        !Config Units = [m]
+        CALL setvar_p (dsg, val_exp, 'HYDROL_DSG', zero)
+        
+        !Config Key   = HYDROL_QSV
+        !Config Desc  = Initial water on canopy if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 0.0
+        !Config Help  = The initial value of moisture on canopy if its value 
+        !Config         is not found in the restart file. This should only be used if
+        !Config         the model is started without a restart file. 
+        !Config Units = [kg/m^2]
+        CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', zero)
+        
+        !! 4.c Specific calculations to define default values for dry soil depths : dsp, dss, and hdry
+        ! set inital value for dsp if needed
+        !Config Key   = HYDROL_DSP
+        !Config Desc  = Initial dry soil above upper reservoir if not found in restart
+        !Config If    = OK_SECHIBA 
+        !Config Def   = 999999.
+        !Config Help  = The initial value of dry soil above upper reservoir if its value 
+        !Config         is not found in the restart file. This should only be used if
+        !Config         the model is started without a restart file. The default behaviour
+        !Config         is to compute it from the variables above. Should be OK most of 
+        !Config         the time.
+        !Config Units = [m]
+        !
+        ! Calculate temporary variable to use for initialiaion of dsp.
+        ! This variable will only be used if no value is set in run.def
+	DO jv = 1,nvm
+           zdsp(:,jv) = dpu_max - bqsb(:,jv) / wmax_veg(jv)
+        END DO
+
+        CALL setvar_p(dsp, val_exp, 'HYDROL_DSP', zdsp) 
+
+        ! set inital value for dss 
+        DO jv = 1,nvm
+           tmpdss(:,jv) = dsg(:,jv) - gqsb(:,jv) / wmax_veg(jv)
+        END DO
+        
+        ! Initialize dss if it is not found in restart file
+        IF ( ALL( dss(:,:) == val_exp ) ) THEN
+           dss(:,:)=tmpdss(:,:)
+        END IF
+                
+        ! set inital value for hdry if not found in restart file
+        ! see hydrolc_soil, step 8.4
+        IF ( ALL( hdry(:) == val_exp ) ) THEN
+           a_subgrd(:) = zero
+           DO ji=1,kjpindex
+              IF ( gqsb(ji,1)+bqsb(ji,1) .GT. zero ) THEN
+                 
+                 IF (.NOT. (dsg(ji,1).EQ. zero .OR. gqsb(ji,1).EQ.zero)) THEN
+                    
+                    ! Ajouts Nathalie - Fred - le 28 Mars 2006
+                    a_subgrd(ji)=MIN(MAX(dsg(ji,1)-dss(ji,1),zero)/dsg_min,un)
+                    
+                 ENDIF
+              ENDIF
+              
+           ENDDO
+           
+           ! Correction Nathalie - le 28 Mars 2006 - re-ecriture drysoil_frac/hdry - Fred Hourdin
+           ! revu 22 novembre 2007
+           hdry(:) = a_subgrd(:)*dss(:,1) + (un-a_subgrd(:))*dsp(:,1)
+        ENDIF
+        
+        ! There is no need to configure the initialisation of resdist. If not available it is the vegetation map
+        IF ( MINVAL(resdist) .EQ.  MAXVAL(resdist) .AND. MINVAL(resdist) .EQ. val_exp) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+            resdist(:,1) = tot_bare_soil(:)
+            resdist(:,2:nvm) = veget(:,2:nvm)
+        ENDIF
+        
+        !! 4.d Compute vegtot (remember that it is only frac_nobio + SUM(veget(,:)) that is equal to 1)
+        DO ji = 1, kjpindex
+           vegtot(ji) = SUM(veget(ji,2:nvm)) + tot_bare_soil(ji)
+        ENDDO
+        
+    ENDIF ! IF (ldrestart_read)
+    
+  !! 5. Where vegetation fraction is zero, set moisture variables to those of bare soil
+  !!    This does not create any additional water.
+   
+    DO jv = 2, nvm
+      DO ji = 1, kjpindex
+        IF ( veget(ji,jv) .LT. EPSILON(un) ) THEN
+          gqsb(ji,jv) = gqsb(ji,1)
+          bqsb(ji,jv) = bqsb(ji,1)
+          dsg(ji,jv) = dsg(ji,1)
+          dss(ji,jv) = dss(ji,1)
+          dsp(ji,jv) = dsp(ji,1)
+        ENDIF
+      ENDDO
+    ENDDO
+    
+  !! 6. We limit the initial value of snow water equivalent 
+    
+    DO ik=1, kjpindex
+       if(snow(ik).gt.maxmass_glacier) then
+          WRITE(numout,*)' il faut diminuer le stock de neige car snow > maxmass_glacier dans restart'
+          snow(ik)=maxmass_glacier
+       endif
+       if(snow_nobio(ik,iice).gt.maxmass_glacier) then
+          WRITE(numout,*)' il faut diminuer le stock de neige car snow_nobio > maxmass_glacier dans restart'
+          snow_nobio(ik,iice)=maxmass_glacier
+       endif
+    ENDDO
+    
+    IF (long_print) WRITE (numout,*) ' hydrolc_init done '
+    
+  END SUBROUTINE hydrolc_init
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrolc_clear
+!!
+!>\BRIEF        Deallocates arrays that were allocated in hydrolc_init and hydrolc_var_init. 
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGES : None
+!! 
+!! MAIN OUTPUT VARIABLE(S) : None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+  
+  SUBROUTINE hydrolc_clear()
+ 
+    l_first_hydrol=.TRUE.
+
+    IF (ALLOCATED (bqsb)) DEALLOCATE (bqsb)
+    IF (ALLOCATED  (gqsb)) DEALLOCATE (gqsb)
+    IF (ALLOCATED  (dsg))  DEALLOCATE (dsg)
+    IF (ALLOCATED  (dsp))  DEALLOCATE (dsp)
+    IF (ALLOCATED  (mean_bqsb))  DEALLOCATE (mean_bqsb)
+    IF (ALLOCATED  (mean_gqsb)) DEALLOCATE (mean_gqsb)
+    IF (ALLOCATED  (dss)) DEALLOCATE (dss)
+    IF (ALLOCATED  (hdry)) DEALLOCATE (hdry)
+    IF (ALLOCATED  (precisol)) DEALLOCATE (precisol)
+    IF (ALLOCATED  (gdrainage)) DEALLOCATE (gdrainage)
+    IF (ALLOCATED  (subsnowveg)) DEALLOCATE (subsnowveg)
+    IF (ALLOCATED  (subsnownobio)) DEALLOCATE (subsnownobio)
+    IF (ALLOCATED  (snowmelt)) DEALLOCATE (snowmelt)
+    IF (ALLOCATED  (icemelt)) DEALLOCATE (icemelt)
+    IF (ALLOCATED  (mx_eau_var)) DEALLOCATE (mx_eau_var)
+    IF (ALLOCATED  (ruu_ch)) DEALLOCATE (ruu_ch)
+    IF (ALLOCATED  (vegtot)) DEALLOCATE (vegtot)
+    IF (ALLOCATED  (resdist)) DEALLOCATE (resdist)
+    IF (ALLOCATED  (runoff)) DEALLOCATE (runoff)
+    IF (ALLOCATED  (tot_water_beg)) DEALLOCATE (tot_water_beg)
+    IF (ALLOCATED  (tot_water_end)) DEALLOCATE (tot_water_end)
+    IF (ALLOCATED  (tot_flux)) DEALLOCATE (tot_flux)
+    IF (ALLOCATED  (tot_watveg_beg)) DEALLOCATE (tot_watveg_beg)
+    IF (ALLOCATED  (tot_watveg_end)) DEALLOCATE (tot_watveg_end)
+    IF (ALLOCATED  (tot_watsoil_beg)) DEALLOCATE (tot_watsoil_beg)
+    IF (ALLOCATED  (tot_watsoil_end)) DEALLOCATE (tot_watsoil_end)
+    IF (ALLOCATED  (delsoilmoist)) DEALLOCATE (delsoilmoist)
+    IF (ALLOCATED  (delintercept)) DEALLOCATE (delintercept)
+    IF (ALLOCATED  (snow_beg)) DEALLOCATE (snow_beg)
+    IF (ALLOCATED  (snow_end)) DEALLOCATE (snow_end)
+    IF (ALLOCATED  (delswe)) DEALLOCATE (delswe)
+    
+ END SUBROUTINE hydrolc_clear
+ 
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrolc_var_init
+!!
+!>\BRIEF        This routine initializes diagnostic hydrologic variables.
+!!
+!! DESCRIPTION  : The following variables are assigned :
+!!  - Soil characteristics : soil water capacities mx_eau_var and ruu_ch \f$(kg m^{-2})\f$ and \f$(kg m^{-3})\f$
+!!  - Initial values for diagnostic variables : mean_bqsb, mean_gqsb, mean_dsg, shumdiag, drysoil_frac, rsol, litterhumdiag
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : rsol, drysoil_frac, mx_eau_var, ruu_ch, shumdiag, litterhumdiag
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================  
+
+  SUBROUTINE hydrolc_var_init (kjpindex, veget, veget_max, rsol, drysoil_frac, mx_eau_var, ruu_ch, shumdiag, litterhumdiag)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables 
+
+    INTEGER(i_std), INTENT(in)                         :: kjpindex      !! Domain size (number of grid cells) (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget         !! Grid-cell fraction effectively covered by vegetation for
+                                                                        !! each PFT, except for soil (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max     !! PFT fractions within grid-cells: max value of veget for 
+                                                                        !! vegetation PFTs and min value for bare soil (0-1, 
+                                                                        !! unitless) 
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: rsol          !! Resistance to bare soil evaporation 
+                                                                        !! @tex ($s m^{-1}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: drysoil_frac  !! Fraction of visible dry soil  (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: mx_eau_var    !! Maximum water content of the soil 
+                                                                        !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: ruu_ch        !! Volumetric soil water capacity 
+                                                                        !! @tex ($kg m^{-3}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out):: shumdiag      !! Mean relative soil moisture, diagnosed for 
+                                                                        !! thermosoil.f90 (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)     :: litterhumdiag !! Litter humidity factor (0-1, unitless), used in stomate
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ji,jv, jd     !! Indices for grid-cells, PFTs and diagnostic levels in 
+                                                                        !! the soil (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                   :: mean_dsg      !! Mean Depth of the top layer, averaged over the soil 
+                                                                        !! columns (m)
+    REAL(r_std)                                        :: gtr, btr      !! Ancillary variables to compute shumdiag (0-1, unitless) 
+    REAL(r_std), DIMENSION(nbdl+1)                     :: tmp_dl        !! Temporary diagnostic levels in the soil (m)
+!_ ================================================================================================================================
+
+  !! 1. Vertical diagnostic levels to compute shumdiag (relative moisture for thermosoil)
+    
+    tmp_dl(1) = 0
+    tmp_dl(2:nbdl+1) = diaglev(1:nbdl)
+    
+  !! 2. Calculation of mx_eau_var and ruu_ch (soil water capacities)
+     
+    mx_eau_var(:) = zero
+    
+    DO ji = 1,kjpindex
+      DO jv = 1,nvm
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+         IF (jv .EQ. 1) THEN
+            mx_eau_var(ji) = mx_eau_var(ji) + tot_bare_soil(ji)*wmax_veg(jv)*dpu_max
+         ELSE
+            mx_eau_var(ji) = mx_eau_var(ji) + veget(ji,jv)*wmax_veg(jv)*dpu_max
+         ENDIF
+      END DO
+      IF (vegtot(ji) .GT. zero) THEN
+         mx_eau_var(ji) = mx_eau_var(ji)/vegtot(ji)
+      ELSE
+         ! lakes, ice, cities...
+         mx_eau_var(ji) = mx_eau_nobio*dpu_max
+      ENDIF
+      ruu_ch(ji) = mx_eau_var(ji) / dpu_max
+    END DO
+    
+  !! 3. Initial values of the mean soil layer depths and water contents
+    
+    ! could be done with SUM instruction but this kills vectorization
+    mean_bqsb(:) = zero
+    mean_gqsb(:) = zero
+    mean_dsg(:) = zero
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+        mean_bqsb(ji) = mean_bqsb(ji) + resdist(ji,jv)*bqsb(ji,jv)
+        mean_gqsb(ji) = mean_gqsb(ji) + resdist(ji,jv)*gqsb(ji,jv)
+        mean_dsg(ji) = mean_dsg(ji) + resdist(ji,jv)*dsg(ji,jv)
+      ENDDO
+    ENDDO
+    mean_dsg(:) = MAX( mean_dsg(:), mean_gqsb(:)/ruu_ch(:) )
+
+    DO ji = 1, kjpindex
+      IF (vegtot(ji) .GT. zero) THEN
+        mean_bqsb(ji) = mean_bqsb(ji)/vegtot(ji)
+        mean_gqsb(ji) = mean_gqsb(ji)/vegtot(ji)
+        mean_dsg(ji) = mean_dsg(ji)/vegtot(ji)
+      ENDIF
+    ENDDO
+    
+    !! 4. Initial value of shumdiag (see hydrolc_soil, 8.2 for details)
+
+    DO jd = 1,nbdl
+       
+       DO ji = 1,kjpindex
+       
+!!$       DO jd = 1,nbdl
+          IF ( tmp_dl(jd+1) .LT. mean_dsg(ji)) THEN
+             shumdiag(ji,jd) = mean_gqsb(ji)/mx_eau_var(ji)
+          ELSE
+             IF ( tmp_dl(jd) .LT. mean_dsg(ji)) THEN
+                gtr = (mean_dsg(ji)-tmp_dl(jd))/(tmp_dl(jd+1)-tmp_dl(jd))
+                btr = 1 - gtr
+                shumdiag(ji,jd) = gtr*mean_gqsb(ji)/mx_eau_var(ji) + &
+                     & btr*mean_bqsb(ji)/mx_eau_var(ji)
+             ELSE
+                shumdiag(ji,jd) = mean_bqsb(ji)/mx_eau_var(ji)
+             ENDIF
+          ENDIF
+          shumdiag(ji,jd) = MAX(MIN(shumdiag(ji,jd), un), zero)
+       ENDDO
+    ENDDO
+
+  !! 5. Initial value of the fraction of soil which is visibly dry (see hydrolc_soil, 8.3 for details)
+    
+    drysoil_frac(:) = MIN(MAX(dss(:,1),zero)*10._r_std, un)
+    
+  !! 6. Initial value of the resistance to bare soil evaporation (see hydrolc_soil, 8.4 for details)
+    
+    rsol(:) = -un
+    DO ji = 1, kjpindex
+       IF (tot_bare_soil(ji) .GE. min_sechiba) THEN
+          
+          ! Correction Nathalie - le 28 mars 2006 - sur conseils Fred Hourdin
+          ! on modifie le rsol pour que la resistance croisse subitement si on s'approche
+          ! du fond. En gros, rsol=hdry*rsol_cste pour hdry < 1m70
+          !rsol(ji) = dss(ji,1) * rsol_cste
+          !rsol(ji) =  ( drysoil_frac(ji) + un/(10.*(dpu_max - drysoil_frac(ji))+1.e-10)**2 ) * rsol_cste
+          rsol(ji) =  ( hdry(ji) + un/(10.*(dpu_max - hdry(ji))+1.e-10)**2 ) * rsol_cste
+       ENDIF
+    ENDDO
+    
+  !! 7. Initial value of litter humidity (see hydrolc_soil, 8.5 for details)
+    
+    litterhumdiag(:) = EXP( - hdry(:) / hcrit_litter )
+
+    ! special case: it has just been raining a few drops. The upper soil
+    ! reservoir is ridiculously small, but the dry soil height is zero.
+    ! Don't take it into account.
+    WHERE ( ( hdry(:) .LT. min_sechiba ) .AND. &
+            ( mean_dsg(:) .GT. min_sechiba ) .AND. ( mean_dsg(:) .LT. 5.E-4 ) )
+      litterhumdiag(:) = zero
+    ENDWHERE
+    
+    IF (long_print) WRITE (numout,*) ' hydrolc_var_init done '
+
+  END SUBROUTINE hydrolc_var_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrolc_snow
+!!
+!>\BRIEF        This routine computes accumulation, sublimation, snowmelt and snow ageing 
+!! over vegetated and nobio (eg land-ice) areas. Snowdepth is then updated.
+!! 
+!! DESCRIPTION  : In this routine the snow-related processes accumulation, sublimation, 
+!! melting and ageing are computed separately on vegetated and nobio areas. This subroutine 
+!! is the first one among the ones that compute the physical processes. The water budgets 
+!! of the interception reservoir and the soil are performed afterwards.\n
+!!
+!! - Values of the main parameters used in this routine are :\n
+!! tp_00=273.15K : freezing point\n
+!! snowcri=1.5\f$kg m^{-2}\f$ : critical snowmass for sublimation\n
+!! sneige=snowcri/1000._r_std : critical snowmass for snow melt\n
+!! maxmass_glacier=3000 \f$kg m^{-2}\f$ (~ 10m snow) : critical snowmass for glaciers\n
+!! snow_trans=0.3 (\f$kg m^{-2}\f$) : critical constant for snow ageing\n
+!! max_snow_age=50 (days) : maximum snow age\n
+!! sn_dens=330 (\f$kg m^{-3}\f$) : snow density\n
+!! one_day=86400 (s) : one day, expressed in seconds...
+!!
+!! - Accumulation\n
+!! On the vegetated areas, the snow mass increases due to area-weighted snow
+!! precipitations precip_snow; on nobio areas, rain additionnaly converts into snow.\n
+!!
+!! - Sublimation\n
+!! Sublimation on vegetated and nobio areas is calculated as the area-weighed fraction
+!! of vevapsno (from enerbil). In case snow on vegetated areas is limited (less than snowcri) 
+!! and a significant nobio area exists, the nobio area accomodates the whole sublimation 
+!! vevapsno. The nobio area also accomodates the possible excess sublimation from vegetated 
+!! areas, which otherwise goes into bare soil evaporation. In this case vevapsno is updated.\n
+!!
+!! - Melting\n
+!! Over vegetated and nobio areas, snowmelt occurs if the calculated soil temperature 
+!! temp_soil_new(ji) exceeds the freezing point tp_00. The energy required to warm up the soil
+!! surface above tp_00 is converted into melting, according to the following equation :
+!! \latexonly
+!! \input{hydrolcsnow1.tex}
+!! \endlatexonly
+!! \n
+!! with soilcap the soil heat capacity @tex ($J K^{-1}$) @endtex and chalfu0 the latent heat of
+!! fusion.\n
+!! A special case occurs in areas with snowmass exceeding maxmass_glacier, where
+!! all the snow in excess of maxmass_glacier adds to the total melting tot_melt.
+!! This excess melting is considered as additionnal snowmelt for vegetated areas
+!! and as ice_melt for nobio areas.\n
+!!
+!! - Ageing\n
+!! Over vegetated areas, during the time step dt_radia (usually 1800 s), the snow age is 
+!! incremented by a d_age calculated as follow:
+!! \latexonly
+!! \input{hydrolcsnow2.tex}
+!! \endlatexonly
+!! \n
+!! Over nobio areas and at subfreezing temperatures, snow ageing is limited by very 
+!! slow snow metamorphism, hence d_age is reduced as follow:
+!! \latexonly
+!! \input{hydrolcsnow3.tex}
+!! \endlatexonly
+!! \n
+!! Scientific reference for this parametrization choice is obviously missing !
+!! At the end of the routine the snowheight is diagnosed using the fixed
+!! snow density sn_dens.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLES:
+!! for vegetated and nobio areas respectively:\n
+!! snow(kjpindex) and snow_nobio(kjpindex)\n
+!! snow_age(kjpindex) and snow_nobio_age(kjpindex)\n
+!! for the whole grid-cell:\n
+!! vevapnu(kjpindex)
+!! vevapsno(kjpindex)
+!! tot_melt(kjpindex)
+!! snowdepth(kjpindex)
+!!   
+!! REFERENCES : None
+!! 
+!! FLOWCHART  : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrolc_snow (kjpindex, dtradia, precip_rain, precip_snow , temp_sol_new, soilcap,&
+       & frac_nobio, totfrac_nobio, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age, &
+       & tot_melt, snowdepth)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variabless
+ 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex        !! Domain size  (unitless)
+    REAL(r_std), INTENT (in)                                 :: dtradia         !! Time step of the simulations for sechiba (s) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_rain     !! Rainfall @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: precip_snow     !! Snow precipitation @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: temp_sol_new    !! New soil temperature (K)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: soilcap         !! Soil heat capacity @tex ($J K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(in)     :: frac_nobio      !! Fraction of continental ice, lakes, ... 
+                                                                                !! (unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: totfrac_nobio   !! Total fraction of continental ice+lakes+ ... 
+                                                                                !! (unitless)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: tot_melt        !! Total melt @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: snowdepth       !! Snow depth (m)
+    
+    !! 0.3  Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapnu         !! Bare soil evaporation @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapsno        !! Snow evaporation @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: snow            !! Snow mass @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: snow_age        !! Snow age (days)
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout)  :: snow_nobio      !! Snomass on nobio areas 
+                                                                                !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout)  :: snow_nobio_age  !! Snow age on ice, lakes, ...(days)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                           :: ji, jv          !! indices (unitless)
+    REAL(r_std), DIMENSION (kjpindex)                        :: d_age           !! Snow age change (days)
+    REAL(r_std), DIMENSION (kjpindex)                        :: xx              !! temporary
+    REAL(r_std)                                              :: snowmelt_tmp    !! temporary @tex ($kg m^{-2}$) @endtex
+    LOGICAL, DIMENSION (kjpindex)                            :: warnings 
+    LOGICAL                                                  :: any_warning
+!_ ================================================================================================================================
+    
+  !! 1. initialisation
+    
+    DO jv = 1, nnobio
+      DO ji=1,kjpindex
+        subsnownobio(ji,jv) = zero
+      ENDDO
+    ENDDO
+    DO ji=1,kjpindex
+      subsnowveg(ji) = zero
+      snowmelt(ji) = zero
+      icemelt(ji) = zero
+      tot_melt(ji) = zero
+    ENDDO
+  
+  !! 2. On vegetation
+        
+    ! 2.1. It is snowing 
+    DO ji=1,kjpindex
+      snow(ji) = snow(ji) + (un - totfrac_nobio(ji))*precip_snow(ji)
+    ENDDO
+
+    DO ji=1,kjpindex
+      
+      ! 2.2. Sublimation - separate between vegetated and no-veget fractions
+      !      Care has to be taken as we might have sublimation from the
+      !      the frac_nobio while there is no snow on the rest of the grid.
+      IF ( snow(ji) > snowcri ) THEN
+         subsnownobio(ji,iice) = frac_nobio(ji,iice)*vevapsno(ji)
+         subsnowveg(ji) = vevapsno(ji) - subsnownobio(ji,iice)
+      ELSE
+
+         ! Correction Nathalie - Juillet 2006.
+         ! On doit d'abord tester s'il existe un frac_nobio!
+         ! Pour le moment je ne regarde que le iice
+         IF ( frac_nobio(ji,iice) .GT. min_sechiba) THEN
+            subsnownobio(ji,iice) = vevapsno(ji)
+            subsnowveg(ji) = zero
+         ELSE 
+            subsnownobio(ji,iice) = zero
+            subsnowveg(ji) = vevapsno(ji)
+         ENDIF
+      ENDIF
+    ENDDO
+    
+    warnings(:) = .FALSE.
+    any_warning = .FALSE.
+    DO ji=1,kjpindex
+      
+      ! 2.2.1 Check that sublimation on the vegetated fraction is possible.
+      IF (subsnowveg(ji) .GT. snow(ji)) THEN 
+
+         ! What could not be sublimated goes into bare soil evaporation
+         ! Nathalie - Juillet 2006 - il faut avant tout tester s'il existe du
+         ! frac_nobio sur ce pixel pour eviter de puiser dans le sol!         
+         IF ( frac_nobio(ji,iice) .GT. min_sechiba) THEN
+            subsnownobio(ji,iice) = subsnownobio(ji,iice) + (subsnowveg(ji) - snow(ji))
+         ELSE  
+            vevapnu(ji) = vevapnu(ji) + (subsnowveg(ji) - snow(ji))
+            warnings(ji) = .TRUE.
+            any_warning = .TRUE.
+         ENDIF
+
+         ! Sublimation is thus limited to what is available
+         subsnowveg(ji) = snow(ji)
+         snow(ji) = zero
+         vevapsno(ji) = subsnowveg(ji) + subsnownobio(ji,iice)
+      ELSE 
+         snow(ji) = snow(ji) - subsnowveg(ji)
+      ENDIF
+    ENDDO
+    IF ( any_warning ) THEN
+       WRITE(numout,*)' ATTENTION on prend de l eau au sol nu sur au moins un point car evapsno est trop fort!'
+!!$       DO ji=1,kjpindex
+!!$          IF ( warnings(ji) ) THEN
+!!$             WRITE(numout,*)' ATTENTION on prend de l eau au sol nu car evapsno est trop fort!'
+!!$             WRITE(numout,*)' ',ji,'   vevapnu (en mm/jour) = ',vevapnu(ji)*one_day/dtradia
+!!$          ENDIF
+!!$       ENDDO
+    ENDIF
+    
+    warnings(:) = .FALSE.
+    any_warning = .FALSE.
+    DO ji=1,kjpindex
+      
+      ! 2.3. snow melt only if temperature positive
+      IF (temp_sol_new(ji).GT.tp_00) THEN 
+         
+         IF (snow(ji).GT.sneige) THEN 
+            
+            snowmelt(ji) = (un - frac_nobio(ji,iice))*(temp_sol_new(ji) - tp_00) * soilcap(ji) / chalfu0 
+            
+            ! 2.3.1 enough snow for melting or not
+            IF (snowmelt(ji).LT.snow(ji)) THEN 
+               snow(ji) = snow(ji) - snowmelt(ji)
+            ELSE 
+               snowmelt(ji) = snow(ji)
+               snow(ji) = zero
+            END IF
+            
+         ELSEIF (snow(ji).GE.zero) THEN 
+            
+            ! 2.3.2 not enough snow
+            snowmelt(ji) = snow(ji)
+            snow(ji) = zero
+         ELSE 
+            
+            ! 2.3.3 negative snow - now snow melt
+            snow(ji) = zero
+            snowmelt(ji) = zero
+            warnings(ji) = .TRUE.
+            any_warning = .TRUE.
+            
+         END IF
+
+      ENDIF
+    ENDDO
+    IF ( any_warning ) THEN
+       DO ji=1,kjpindex
+          IF ( warnings(ji) ) THEN
+             WRITE(numout,*) 'hydrolc_snow: WARNING! snow was negative and was reset to zero for point ',ji,'. '
+          ENDIF
+       ENDDO
+    ENDIF
+    
+    DO ji=1,kjpindex
+      
+      !! 2.4. Ice melt only if there is more than a given mass : maxmass_glacier
+      !      i.e. only weight melts glaciers !
+      !      Ajouts Edouard Davin / Nathalie de Noblet add extra to melting
+      IF ( snow(ji) .GT. maxmass_glacier ) THEN
+         snowmelt(ji) = snowmelt(ji) + (snow(ji) - maxmass_glacier)
+         snow(ji) = maxmass_glacier
+      ENDIF
+      
+    END DO
+    
+   !! 3. On Land ice
+    
+    DO ji=1,kjpindex
+      
+      !! 3.1. It is snowing
+      snow_nobio(ji,iice) = snow_nobio(ji,iice) + frac_nobio(ji,iice)*precip_snow(ji) + &
+           & frac_nobio(ji,iice)*precip_rain(ji)
+      
+      !! 3.2. Sublimation - was calculated before it can give us negative snow_nobio but that is OK
+      !      Once it goes below a certain values (-maxmass_glacier for instance) we should kill
+      !      the frac_nobio(ji,iice) !
+      snow_nobio(ji,iice) = snow_nobio(ji,iice) - subsnownobio(ji,iice)
+      
+      !! 3.3. snow melt only for continental ice fraction
+      snowmelt_tmp = zero
+      IF (temp_sol_new(ji) .GT. tp_00) THEN 
+         
+         ! 3.3.1 If there is snow on the ice-fraction it can melt 
+         snowmelt_tmp = frac_nobio(ji,iice)*(temp_sol_new(ji) - tp_00) * soilcap(ji) / chalfu0
+         
+         IF ( snowmelt_tmp .GT. snow_nobio(ji,iice) ) THEN
+             snowmelt_tmp = MAX( zero, snow_nobio(ji,iice))
+         ENDIF
+         snowmelt(ji) = snowmelt(ji) + snowmelt_tmp
+         snow_nobio(ji,iice) = snow_nobio(ji,iice) - snowmelt_tmp
+         
+      ENDIF
+      
+      !! 3.4 Ice melt only if there is more than a given mass : maxmass_glacier, 
+      !      i.e. only weight melts glaciers !
+      IF ( snow_nobio(ji,iice) .GT. maxmass_glacier ) THEN
+         icemelt(ji) = snow_nobio(ji,iice) - maxmass_glacier
+         snow_nobio(ji,iice) = maxmass_glacier
+      ENDIF
+      
+    END DO
+
+    
+  !! 4. On other surface types - not done yet
+  
+    IF ( nnobio .GT. 1 ) THEN
+      WRITE(numout,*) 'WE HAVE',nnobio-1,' SURFACE TYPES I DO NOT KNOW'
+      CALL ipslerr_p (3,'hydrolc_snow', '', &
+ &         'CANNOT TREAT SNOW ON THESE SURFACE TYPES', '')
+    ENDIF
+
+    
+  !! 5. computes total melt (snow and ice)
+ 
+
+    DO ji = 1, kjpindex
+      tot_melt(ji) = icemelt(ji) + snowmelt(ji)
+    ENDDO
+ 
+  !! 6. computes snow age on veg and ice (for albedo)
+    
+    DO ji = 1, kjpindex
+      
+      !! 6.1 Snow age on vegetation
+      IF (snow(ji) .LE. zero) THEN
+        snow_age(ji) = zero
+      ELSE
+        snow_age(ji) =(snow_age(ji) + (un - snow_age(ji)/max_snow_age) * dtradia/one_day) &
+          & * EXP(-precip_snow(ji) / snow_trans)
+      ENDIF
+      
+      !! 6.2 Snow age on ice
+      ! age of snow on ice: a little bit different because in cold regions, we really
+      ! cannot negect the effect of cold temperatures on snow metamorphism any more.
+      IF (snow_nobio(ji,iice) .LE. zero) THEN 
+        snow_nobio_age(ji,iice) = zero
+      ELSE
+      
+        d_age(ji) = ( snow_nobio_age(ji,iice) + &
+                    &  (un - snow_nobio_age(ji,iice)/max_snow_age) * dtradia/one_day ) * &
+                    &  EXP(-precip_snow(ji) / snow_trans) - snow_nobio_age(ji,iice)
+        IF (d_age(ji) .GT. zero ) THEN
+          xx(ji) = MAX( tp_00 - temp_sol_new(ji), zero )
+          xx(ji) = ( xx(ji) / 7._r_std ) ** 4._r_std
+          d_age(ji) = d_age(ji) / (un+xx(ji))
+        ENDIF
+        snow_nobio_age(ji,iice) = MAX( snow_nobio_age(ji,iice) + d_age(ji), zero )
+      
+      ENDIF
+
+    ENDDO
+
+  !! 7. Diagnose the depth of the snow layer
+
+    DO ji = 1, kjpindex
+      snowdepth(ji) = snow(ji) /sn_dens
+    ENDDO
+
+    IF (long_print) WRITE (numout,*) ' hydrolc_snow done '
+
+  END SUBROUTINE hydrolc_snow
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE      : hydrolc_canop 
+!!
+!>\BRIEF           This routine computes the water budget of the canopy interception reservoir. 
+!!
+!! DESCRIPTION     : The first sequence is to withdraw interception loss from the interception 
+!! reservoir, with independent values for each PFT. The reservoir loading happens afterwards. 
+!! Rain falls uniformly over the PFTs. It uniformly loads the canopy interception 
+!! reservoir of each PFT, up to the interception capacity, but a fraction of rainfall always falls to the ground.
+!! Throughfall is thus comprised of the fraction that always falls through, plus the remining fraction of rainfall that 
+!! exceeds the interception capacity, the interception loss having been removed. 
+!! \latexonly
+!! \input{interception.tex}
+!! \endlatexonly
+!! 
+!! IMPORTANT NOTE : Bare soil treatment is complex in hydrolc :
+!!  - veget_max(:,1) is the fraction of bare soil from the "annual" vegetation map 
+!!  - veget(:,1) is not the fraction of vegetation over bare soil but the total fraction of bare soil in the grid-cell 
+!! (including the bare soil fractions over the vegetation PFTs). 
+!! *** A diagram should be added in the spatial entry of the "umbrella"
+!!  - For interception to be zero on bare soil, we thus need to impose qsintmax(:,1)=0
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : precisol (throughfall), qsintveg (amount of water in the canopy interception reservoir)
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================  
+
+  SUBROUTINE hydrolc_canop (kjpindex, precip_rain, vevapwet, veget, qsintmax, qsintveg, precisol)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                           :: kjpindex           !! Domain size (number of grid cells) (unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)        :: precip_rain        !! Rainfall @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)    :: vevapwet           !! Interception loss over each PFT 
+                                                                               !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)    :: veget              !! Grid-cell fraction effectively covered by 
+                                                                               !! vegetation for each PFT, except for soil 
+                                                                               !! (0-1, unitless) 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)    :: qsintmax           !! Maximum amount of water in the canopy 
+                                                                               !! interception reservoir @tex ($kg m^{-2}$) @endtex 
+    
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)   :: precisol           !! Throughfall @tex ($kg m^{-2}$) @endtex
+
+    !! 0.3  Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: qsintveg           !! Amount of water in the canopy interception 
+                                                                               !! reservoir @tex ($kg m^{-2}$) @endtex
+    
+    !! 0.4 Local variabless
+  
+    INTEGER(i_std)                                       :: ji, jv             !! Grid-cell and PFT indices (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm)                :: zqsintvegnew       !! Temporary variable for intercepted water 
+                                                                               !! amount  @tex ($kg m^{-2}$) @endtex 
+
+!_ ================================================================================================================================
+
+    ! calcul de qsintmax a prevoir a chaque pas de temps
+    ! dans ini_sechiba
+    ! boucle sur les points continentaux
+    ! calcul de qsintveg au pas de temps suivant
+    ! par ajout du flux interception loss
+    ! calcule par enerbil en fonction
+    ! des calculs faits dans diffuco
+    ! calcul de ce qui tombe sur le sol
+    ! avec accumulation dans precisol
+    ! essayer d'harmoniser le traitement du sol nu
+    ! avec celui des differents types de vegetation
+    ! fait si on impose qsintmax ( ,1) = 0.0
+    !
+    ! loop for continental subdomain
+    !
+
+    !
+    ! 1. evaporation off the continents
+    !
+    ! 1.1 The interception loss is take off the canopy. 
+
+    DO jv=1,nvm
+      qsintveg(:,jv) = qsintveg(:,jv) - vevapwet(:,jv)
+    END DO
+
+    ! 1.2 It is raining : precip_rain is shared for each vegetation
+    ! type
+    !     sum (veget (1,nvm)) must be egal to 1-totfrac_nobio.
+    !     iniveget computes veget each day
+    !
+    DO jv=1,nvm
+      ! Correction Nathalie - Juin 2006 - une partie de la pluie arrivera toujours sur le sol
+      ! sorte de throughfall supplementaire
+      !qsintveg(:,jv) = qsintveg(:,jv) + veget(:,jv) * precip_rain(:)
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+       IF (jv .EQ. 1) THEN
+          qsintveg(:,jv) = qsintveg(:,jv) + tot_bare_soil(:) * ((1-throughfall_by_pft(jv))*precip_rain(:))
+       ELSE
+          qsintveg(:,jv) = qsintveg(:,jv) + veget(:,jv) * ((1-throughfall_by_pft(jv))*precip_rain(:))
+       ENDIF
+    END DO
+
+    !
+    ! 1.3 Limits the effect and sum what receives soil
+    !
+    precisol(:,:) = zero
+    DO jv=1,nvm
+      DO ji = 1, kjpindex
+        zqsintvegnew(ji,jv) = MIN (qsintveg(ji,jv),qsintmax(ji,jv)) 
+        ! correction throughfall Nathalie - Juin 2006
+        !precisol(ji,jv) = qsintveg(ji,jv ) - zqsintvegnew (ji,jv)
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+        IF (jv .EQ. 1) THEN
+           precisol(ji,jv) = (tot_bare_soil(ji)*throughfall_by_pft(jv)*precip_rain(ji)) + qsintveg(ji,jv ) - zqsintvegnew (ji,jv)
+        ELSE
+           precisol(ji,jv) = (veget(ji,jv)*throughfall_by_pft(jv)*precip_rain(ji)) + qsintveg(ji,jv ) - zqsintvegnew (ji,jv)
+        ENDIF
+      ENDDO
+    ENDDO
+    !
+    ! 1.4 swap qsintveg to the new value
+    !
+
+    DO jv=1,nvm
+      qsintveg(:,jv) = zqsintvegnew (:,jv)
+    END DO
+
+    IF (long_print) WRITE (numout,*) ' hydrolc_canop done '
+
+  END SUBROUTINE hydrolc_canop
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrolc_vegupd 
+!!
+!>\BRIEF        This subroutines works at adapting the distribution of water
+!! in the soil and interception reservoirs between the different soil columns when the vegetation 
+!! fraction of the PFTs (veget) has changed in slowproc.  
+!!
+!! DESCRIPTION  : Different vegetation changes are allowed in ORCHIDEE:\n 
+!!  - veget_max can be updated annually in slowproc (dynamic vegetation or prescribed vegetation change)\n
+!!  - veget can be updated daily in slowproc (because of changes in veget_max or depending on LAI)
+!!
+!! This subroutine aims at adapting the distribution of water among the different liquid water reservoirs 
+!! (interception reservoir and soil moisture) after these changes of veget :
+!! - the variable veget holds the "new" vegetation map
+!! - the variable resdist holds the previous vegetation map 
+!! *** I see no flag or time step dependance to control the call to vegupd : is it called at each time step ?
+!!
+!! The principle is that PFTs where "veget" has shrunk keep the same water contents in kg.m^{-2},
+!! whereas the water contents are increased in PFTs where "veget" has grown.
+!! *** I still have questions about redistribution to interception reservoirs which have shrunk
+!! *** and about thresholding to the reservoirs' capacities (is it ensured that the capacities are not exceeded ?)
+!! You may note that this occurs after evaporation and so on have been computed. It is not a 
+!! problem as a new vegetation fraction will start with humrel=0 and thus will have no evaporation. 
+!! If this is not the case it should have been caught above.
+!! 
+!! IMPORTANT NOTE : the definition of veget is not simple :
+!!  - for the non-bare soil PFTs (iv > 2), veget is the fraction effectively covered by 
+!! vegetation : veget \f$\le\f$ veget_max\n
+!!  - for the bare soil PFT (iv=1), veget holds the fraction of bare soil, from all 
+!! PFTs : veget(:,1) \f$\ge\f$ veget_max(:,1)\n
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S) : qsintveg, gqsb, bqsb, dsg, dss, dsp, resdist
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART   : None
+!! \n
+!_ ================================================================================================================================  
+  
+  SUBROUTINE hydrolc_vegupd(kjpindex, veget, ruu_ch, qsintveg, gqsb, bqsb, dsg, dss, dsp, resdist)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+ 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex   !! Domain size (number of grid cells) (unitless)
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in)       :: veget      !! Grid-cell fraction effectively covered by vegetation 
+                                                                           !! for each PFT, except for soil (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: ruu_ch     !! Volumetric soil water capacity 
+                                                                           !! @tex ($kg m^{-3}$) @endtex
+    
+    !! 0.2 Output variables
+
+    !! 0.3  Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)  :: qsintveg      !! Water on vegetation due to interception
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: gqsb       !! Water content in the top layer 
+                                                                           !! @tex ($kg m^{-2}$) @endtex    
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: bqsb       !! Water content in the bottom layer 
+                                                                           !! @tex ($kg m^{-2}$) @endtex     
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: dsg        !! Depth of the top layer (m)   
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: dss        !! Depth of dry soil at the top, whether in the top or
+                                                                           !! bottom layer (m)   
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: dsp        !! Depth of dry soil in the bottom layer plus depth of
+                                                                           !! top layer (m) 
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(inout)    :: resdist    !! Previous values of "veget" (0-1, unitless)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                :: ji,jv                 !!  Grid-cell and PFT indices (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm)           :: qsintveg2            !! Ancillary qsintveg @tex ($kg m^{-2}$) @endtex  
+    REAL(r_std), DIMENSION (kjpindex,nvm)          :: bdq, gdq             !! Changes in surface and bottom soil layer water 
+                                                                           !! content @tex ($kg m^{-2}; positive$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nvm)          :: qsdq                 !! Changes in interception reservoir water content  
+                                                                           !! @tex ($kg m^{-2}; positive$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nvm)          :: vmr                  !! Variation of "veget" since previous values 
+                                                                           !! (-1,1; unitless)
+    REAL(r_std), DIMENSION(kjpindex)               :: gtr                  !! Total water mass to redistribute between the top 
+                                                                           !! layers of a grid-cell @tex ($kg m^{-2}; positive) 
+                                                                           !! @ endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: btr                  !! Total water mass to redistribute between the bottom
+                                                                           !! layers of a grid-cell @tex ($kg m^{-2}; positive) 
+                                                                           !! @ endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: vtr                  !! Total fraction  over which "veget" has decreased 
+                                                                           !! (dimensionless; positive)
+    REAL(r_std), DIMENSION(kjpindex)               :: qstr                 !! Total water mass to redistribute between the 
+                                                                           !! interception reservoirs of a grid-cell 
+                                                                           !! @tex ($kg m^{-2}; positive$) @endtex
+    REAL(r_std), DIMENSION(kjpindex)               :: fra                  !! Weight for redistribution (dimensionless; negative)
+    REAL(r_std), DIMENSION(kjpindex) :: vegchtot                           !! Total change of "veget" in the grid-point 
+                                                                           !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), PARAMETER                         :: EPS1 = EPSILON(un)   !! Very small (scalar) *** why not use min_sechiba ?
+!_ ================================================================================================================================ 
+    
+  !! 1. vmr is the change in veget in the different PFTs
+
+    ! vmr is the change in veget in the different PFTs
+    ! (dimensionless; negative if the new "veget" is smaller, i.e. if the PFT has shrunk)
+    ! By construction, the algebraic sum of vmr in a grid-cell is zero
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+         IF (jv .EQ. 1) THEN 
+            IF ( ABS(tot_bare_soil(ji)-resdist(ji,jv)) .GT. EPS1 ) THEN
+               vmr(ji,jv) = tot_bare_soil(ji)-resdist(ji,jv)
+            ELSE
+               vmr(ji,jv) = zero
+            ENDIF
+         ELSE
+            IF ( ABS(veget(ji,jv)-resdist(ji,jv)) .GT. EPS1 ) THEN
+               vmr(ji,jv) = veget(ji,jv)-resdist(ji,jv)
+            ELSE
+               vmr(ji,jv) = zero
+            ENDIF
+         ENDIF
+  !! 2. qsintveg2 is the intercepted water in mm 
+
+        ! qsintveg2 is the intercepted water in mmif the total volume 
+        ! was redistributed over the previous "veget" fractions 
+        ! This the distribution of intercepted water that needs to be 
+        ! changed if "veget" changes 
+
+         IF (resdist(ji,jv) .GT. zero) THEN
+            qsintveg2(ji,jv) = qsintveg(ji,jv)/resdist(ji,jv)
+         ELSE
+            qsintveg2(ji,jv) = zero
+         ENDIF
+      ENDDO
+    ENDDO
+
+
+ !! 3. vegchtot is the total change of "veget" in the grid-points
+
+    ! vegchtot is the total change of "veget" in the grid-points, 
+    ! integrated over the PFTs (vegchtot in kg m^{-2})
+    ! It is the sum of the absolute values of changes, it may thus 
+    ! be larger than 1 : it serves as a flag of change in each grid-point
+    vegchtot(:) = zero
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+        vegchtot(ji) = vegchtot(ji) + ABS( vmr(ji,jv) )
+      ENDDO
+    ENDDO
+    
+
+  !! 4. In the grid-points with "veget" change, we define changes in water content
+    
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+        IF ( vegchtot(ji) .GT. zero ) THEN
+
+           ! change in surface soil layer water content @tex ($kg m^{-2}$) @endtex
+          gdq(ji,jv) = ABS(vmr(ji,jv)) * gqsb(ji,jv)
+
+          ! change in bottom soil layer water content @tex ($kg m^{-2}$) @endtex
+          bdq(ji,jv) = ABS(vmr(ji,jv)) * bqsb(ji,jv)
+
+          ! change in interception reservoir water content  @tex ($kg m^{-2}$) @endtex
+          qsdq(ji,jv) = ABS(vmr(ji,jv)) * qsintveg2(ji,jv)
+        ENDIF
+      ENDDO
+    ENDDO
+
+  !! 5. Total water mass to redistribute in a grid-point = sum of water changes from PFTs where "veget" decreases
+
+    !  Calculate the total water mass that we need to redistribute by grid-point, for each water reservoir
+    !  We sum up the water changes from PFTs where "veget" decreases : this is the water that needs to be redistributed
+    !  vtr is the total fraction  over which "veget" has decreased (> 0)
+    !  By construction, it is balanced by the total fraction where "veget" has increased
+
+    gtr(:) = zero
+    btr(:) = zero
+    qstr(:) = zero
+    vtr(:) = zero
+    !
+    !
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+        IF ( ( vegchtot(ji) .GT. zero ) .AND. ( vmr(ji,jv) .LT. zero ) ) THEN
+          gtr(ji) = gtr(ji) + gdq(ji,jv)
+          btr(ji) = btr(ji) + bdq(ji,jv)
+          qstr(ji) = qstr(ji) + qsdq(ji,jv) 
+
+          ! vtr is necessarily le 0 since we enter here only if vmr <0
+          vtr(ji) = vtr(ji) - vmr(ji,jv)
+        ENDIF
+      ENDDO
+    ENDDO
+   
+
+!! 6. Put the water to redistribute from the PFTs that "shrank" into the PFTs that "growed"
+
+    !     In doing so, water contents are kept constant in PFTs that shrank, and they increase in PFTs that growed
+    !     fra is the weight for that redistribution, scaled to vtr which is the total amount to redistribute 
+    !  *** Feasability of the redistribution : it doesn't seem to be checked ???
+    !  *** In the soil, if the water capacities are constant between PFTs, it's OK ;this is the default for wmax_veg in 
+    !  *** constantes_veg.f90
+    !  *** But qsintmax is different between PFTsand also evolves in time : how is this managed ???
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+
+        ! "veget" changed
+        IF ( vegchtot(ji) .GT. zero .AND. ABS(vtr(ji)) .GT. EPS1) THEN
+
+            ! negative when vmr positive, thus in the condition below 
+            fra(ji) = vmr(ji,jv) / vtr(ji)
+
+            ! the PFT growed, thus its water contents must be updated
+             IF ( vmr(ji,jv) .GT. zero)  THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+              IF (jv .EQ. 1) THEN
+                 IF (tot_bare_soil(ji) .GT. zero) THEN
+                    gqsb(ji,jv) = (resdist(ji,jv)*gqsb(ji,jv) + fra(ji)*gtr(ji))/tot_bare_soil(ji)
+                    bqsb(ji,jv) = (resdist(ji,jv)*bqsb(ji,jv) + fra(ji)*btr(ji))/tot_bare_soil(ji)
+                 ENDIF
+              ELSE
+                 IF (veget(ji,jv) .GT. zero) THEN
+                    gqsb(ji,jv) = (resdist(ji,jv)*gqsb(ji,jv) + fra(ji)*gtr(ji))/veget(ji,jv)
+                    bqsb(ji,jv) = (resdist(ji,jv)*bqsb(ji,jv) + fra(ji)*btr(ji))/veget(ji,jv)
+                 ENDIF
+              ENDIF
+              qsintveg(ji,jv) = qsintveg(ji,jv) + fra(ji)* qstr(ji)
+             ELSE
+
+              ! vmr negative *** I don't understand why we remove water from the interception reservoir in PFTs which shrank
+              qsintveg(ji,jv) = qsintveg(ji,jv) - qsdq(ji,jv)
+             ENDIF
+
+             ! Then we update the soil layers depths.
+             ! But we do not  change dss, so that the redistribution does directly affect transpiration
+             ! constantes : min_sechiba = 1.E-8_r_std
+             IF (gqsb(ji,jv) .LT. min_sechiba) THEN
+                dsg(ji,jv) = zero
+             ELSE
+                dsg(ji,jv) = (dss(ji,jv) * ruu_ch(ji) + gqsb(ji,jv)) &
+                             / ruu_ch(ji)
+             ENDIF
+             dsp(ji,jv) = dpu_max - bqsb(ji,jv) / ruu_ch(ji)
+        ENDIF
+      ENDDO
+    ENDDO
+
+
+    !! 7. We update resdist for the next "veget" change
+    
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+    resdist(:,1) = tot_bare_soil(:)
+    DO jv = 2, nvm
+       resdist(:,jv) = veget(:,jv)
+    ENDDO
+
+
+  !! 8. Where vegetation fraction is zero, set water to that of bare soil.
+
+    !   This does not create any additional water.
+    DO jv = 2, nvm
+      DO ji = 1, kjpindex
+        IF ( veget(ji,jv) .LT. EPS1 ) THEN
+          gqsb(ji,jv) = gqsb(ji,1)
+          bqsb(ji,jv) = bqsb(ji,1)
+          dsg(ji,jv) = dsg(ji,1)
+          dss(ji,jv) = dss(ji,1)
+          dsp(ji,jv) = dsp(ji,1)
+        ENDIF
+      ENDDO
+    ENDDO
+
+    RETURN
+    !
+  END SUBROUTINE hydrolc_vegupd
+
+!! ================================================================================================================================
+!! SUBROUTINE            : hydrolc_flood
+!!
+!>\BRIEF                   this routine computes the evolution of the surface reservoir (floodplain)
+!!
+!! DESCRIPTION           : 
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S) : floodout
+!!
+!! REFERENCE(S) : Same as for module hydrolc
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrolc_flood (kjpindex, dtradia, vevapnu, vevapflo, flood_frac, flood_res, floodout)
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex 
+    ! input fields
+    REAL(r_std), INTENT (in)                                 :: dtradia          !! Time step in seconds
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: flood_frac       !! Fraction of floodplains in grid box
+    ! modified fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: floodout         !! Flux to take out from floodplains
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: flood_res        !! Floodplains reservoir estimate
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapnu          !! Bare soil evaporation
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapflo         !! Floodplains evaporation
+    ! local declaration
+    INTEGER(i_std)                                          :: ji, jst, jv       !! indices
+    REAL(r_std)                                              :: k_m              !! conductivity in the soil
+    REAL(r_std)                                              :: temp             !! 
+
+!_ ================================================================================================================================
+
+    !- 
+    !- 1. Take out vevapflo from the reservoir and transfer the remaining to vevapnu 
+    !-
+    DO ji = 1,kjpindex
+       temp = MIN(flood_res(ji), vevapflo(ji))
+       flood_res(ji) = flood_res(ji) - temp
+       vevapnu(ji) = vevapnu(ji) + vevapflo(ji) - temp
+       vevapflo(ji) = temp
+    ENDDO
+
+    !- 
+    !- 2. Compute the total flux from floodplain floodout (transfered to routing) 
+    !-
+    DO ji = 1,kjpindex
+       floodout(ji) = vevapflo(ji) - flood_frac(ji) * SUM(precisol(ji,:))
+    ENDDO
+
+    !-
+    !- 3. Discriminate between precip over land and over floodplain
+    !-
+    DO jv=1, nvm
+       DO ji = 1,kjpindex
+          precisol(ji,jv) = precisol(ji,jv) * (1 - flood_frac(ji))
+       ENDDO
+    ENDDO 
+
+    IF (long_print) WRITE (numout,*) ' hydrolc_flood done'
+
+  END SUBROUTINE hydrolc_flood
+
+!! ================================================================================================================================
+!! SUBROUTINE      : hydrolc_soil
+!!
+!>\BRIEF           This routines computes the soil water budget and the related soil water 
+!! fluxes and soil moisture diagnostics using the two-layer Choisnel scheme.
+!!
+!! DESCRIPTION     : 
+!!
+!! 1. Main processes: The Choisnel scheme relies on two soil layers. 
+!! As show in the figure below, the upper one has a variable depth 
+!! and can disappear after dry spells. It is created by infiltration (of throughfall or snow melt), 
+!! in which case the layer is saturated. If this top layer is already present, infiltration can either 
+!! fill it or make it deeper (DucoudrÃ© et al., 1993). 
+!! \latexonly
+!! \includegraphics[scale = 0.5]{choisnelvariables.pdf}
+!! \endlatexonly
+!!
+!! In this framework, most water fluxes updating soil moisture act from top:\n
+!!  - throughfall, melted snow and ice, and irrigation increase soil moisture (of the top layer if present);
+!!  - transpiration and bare soil evaporation reduce soil moisture (of the top layer if present);
+!!  - return flow from rivers increases bottom soil moisture. \n
+!!
+!! Soil moisture stress on bare soil evaporation and transpiration (for diffuco), vegetation growth and 
+!! litter processes (for stomate), proceed respectively via a soil resistance (rsol), and three soil 
+!! moisture stress factor (humrel, vegstress, and litterhumdiag), which are all controlled by the 
+!! height of dry soil at the top of soil: \n
+!! - Soil moisture stress factor on transpiration and bare soil evaporation: humrel = \f$U_s\f$ \n
+!! \latexonly
+!! \input{humrel.tex}
+!! \endlatexonly \n
+!! - Resistance to bare soil evaporation: rsol = \f$r_\mathrm{soil}\f$ \n
+!! \latexonly
+!! \input{rsol.tex}
+!! \endlatexonly
+!!
+!! Runoff is only produced when the entire soil column is saturated, as in the bucket 
+!! scheme of Manabe (1969). Drainage at the bottom of soil and surface runoff are only diagnosed,  
+!! mostly for use in the routing module, using a constant 95% - 5% redistribution (Ngo-Duc et al., 2005).
+!! Internal drainage is allowed from the top to the bottom layer, following Ducharne et al. (1998).
+!! \latexonly
+!! \input{gdrainage.tex}
+!! \endlatexonly
+!!
+!! Irrigation (de Rosnay et al., 2003) and return flow are optional inflows, calculated by the 
+!! routing scheme (Ngo-Duc et al., 2005; Guimberteau, 2010).
+!! 
+!! 2. Subgrid variability:
+!! The subgrid variability of soil is described by introducing as many soil columns as PFTs 
+!! (de Rosnay & Polcher, 1998). The water budget is performed independently in each PFT/soil 
+!! column, but the bottom soil moisture is merged between all PFTs at the end of the calculations.
+!! Therefore, vegetation withdraws from a shared bottom moisture (grid-cell weighted average).
+!! There can also be horizontal diffusion between the top layers, if the flag ok_hdiff is true (the default value 
+!! is false). This is performed in the subroutine hydrolc_hdiff, call after the present subroutine.
+!!
+!! The areas of each soil column are defined by veget (the vegetation fraction of the PFTs),
+!! and not by veget_max (the maximum area of the PFT defined annually in slowproc). 
+!! As veget can change at a daily time step, a redistribution of water between the soil 
+!! columns is required : this is done in hydrolc_vegupd.
+!! 
+!! 3. Water budget issues :
+!! Different issues can arise when solving the above processes :
+!!  - negative total soil moisture (tracked using flag warning, but no action taken, cf. 4)
+!!  - dsg > dsp after merging the bottom layers, solved iteratively (6.2)
+!!  - we may also have a pathological behavior of rsol if hdry > dpu_cste (8.4)
+!!
+!! 4. Diagnostics for other subroutines: humrel for diffuco (7.1), vegstress for stomate (8.1),
+!! shumdiag for stomate (8.2), drysoil_frac for condveg (8.3), rsol for diffuco (8.4), 
+!! litterhumdiag for stomate (8.5).
+!!
+!! MAIN OUTPUT VARIABLE(S) : rsol, drysoil_frac, hdry, runoff (total), 
+!! run_off_tot (surface runoff), drainage, humrel, vegstress, shumdiag, litterhumdiag
+!! gqsb, bqsb, dsg, dss, dsp 
+!!
+!! REFERENCE(S) :
+!!  - DucoudrÃ©, N, Laval, K & Perrier, A, 1993. SECHIBA, a new set of parameterisations
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD Atmospheric General
+!! Circulation Model. Journal of Climate, 6, pp. 248-273.
+!!  - Ducharne, A. Laval, K. and Polcher, J. (1998) Sensitivity of the hydrological cycle to the parameterization 
+!! of soil hydrology in a GCM. Climate Dynamics, 14:307-327.
+!!  - de Rosnay, P. and Polcher J. (1998) Modeling root water uptake in a complex land surface scheme coupled 
+!! to a GCM. Hydrology and Earth System Sciences, 2(2-3):239-256.
+!!  - de Rosnay, P., Polcher, J., Laval, K. et Sabre, M. (2003). Integrated parameterization of irrigation in
+!! the land surface model ORCHIDEE. Validation over Indian Peninsula. Geophys. Res. Lett, 30(19):HLS2-1 -
+!! HLS2-4.
+!!  - Ngo-Duc, T., J. Polcher, and K. Laval (2005), A 53-year forcing data set for land surface models, 
+!! J. Geophys. Res., 110, D06116.
+!!  - ALMA : http://www.lmd.jussieu.fr/~polcher/ALMA/
+!!  - DucoudrÃ©, N. (1990). Sensibilite du climat simule a la parametrisation des echanges de vapeur d'eau entre 
+!! la biosphere et l'atmosphere. These de Doctorat, UniversitÃ© Paris 6.
+!!  - Ducharne A (1997). Le cycle de l'eau : modelisation de l'hydrologie continentale, etude de ses interactions 
+!! avec le climat, These de Doctorat, UniversitÃ© Paris 6.
+!!  - de Rosnay, P. (1999). Representation des interactions sol-plante-atmosphere dans le modele de circulation generale
+!! du LMD. These de doctorat, UniversitÃ© Paris 6.
+!!  - Guimberteau, M, 2010. Modelisation de l'hydrologie continentale et influences de l'irrigation sur le cycle de l'eau, 
+!! These de doctorat, UniversitÃ© Paris 6.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+    
+
+  SUBROUTINE hydrolc_soil(kjpindex, vevapnu, precisol, returnflow, reinfiltration, irrigation, tot_melt, mx_eau_var, &
+       & veget, ruu_ch, transpir,gqsb, bqsb, dsg, dss, rsol, drysoil_frac, hdry, dsp, runoff, run_off_tot, drainage, &
+       & humrel, vegstress, shumdiag, litterhumdiag)
+     
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+ 
+    INTEGER(i_std), INTENT(in)                          :: kjpindex       !! Domain size (number of grid cells) (unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: vevapnu        !! Bare soil evaporation  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)   :: precisol       !! Throughfall  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: returnflow     !! Routed water which comes back into the soil 
+                                                                          !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: reinfiltration !! Water returning to the top reservoir
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: irrigation     !! Irrigation water applied to soils 
+                                                                          !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: tot_melt       !! Total melt @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: mx_eau_var     !! Maximum water content of the soil 
+                                                                          !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in)  :: veget          !! Grid-cell fraction effectively covered by vegetation 
+                                                                          !! for each PFT, except for soil (0-1, unitless) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)       :: ruu_ch         !! Volumetric soil water capacity 
+                                                                          !! @tex ($kg m^{-3}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)   :: transpir       !! Transpiration over each PFT @tex ($kg m^{-2}$) @endtex 
+    
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)  :: runoff         !! Total runoff @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: run_off_tot    !! Diagnosed surface runoff  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: drainage       !! Diagnosed drainage at the bottom of soil
+                                                                          !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out) :: humrel         !! Soil moisture stress factor on transpiration and bare
+                                                                          !! soil evaporation (0-1, unitless) ! Relative humidity
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out) :: vegstress      !! Vegetation moisture stress (only for vegetation
+                                                                          !!  growth) (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out) :: shumdiag       !! Mean relative soil moisture in the different levels 
+                                                                          !! used by thermosoil.f90 (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: litterhumdiag  !! Litter humidity factor (0-1, unitless), used in 
+                                                                          !! stomate
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: rsol           !! Resistance to bare soil evaporation (s m^{-1}) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: drysoil_frac   !! Fraction of visible dry soil  (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: hdry           !! Mean top dry soil height (m) version beton
+
+    !! 0.3  Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout):: gqsb           !! Water content in the top layer 
+                                                                          !! @tex ($kg m^{-2}$) @endtex              
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout):: bqsb           !! Water content in the bottom layer 
+                                                                          !! @tex ($kg m^{-2}$) @endtex     
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout):: dsg            !! Depth of the top layer (m) 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout):: dss            !! Depth of dry soil at the top, whether in the top or 
+                                                                          !! bottom layer (m)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout):: dsp            !! Depth of dry soil in the bottom layer plus depth of
+                                                                          !! top layer (m) 
+    
+    !! 0.4 Local variables
+   
+    INTEGER(i_std)                                      :: ji,jv, jd      !! Indices for grid-cells, PFTs and diagnostic levels in
+                                                                          !! the soil (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: zhumrel_lo     !! Soil moisture stress factors on transpiration for the
+                                                                          !! bottom and top layers (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: zhumrel_up     !! Soil moisture stress factors on transpiration for the
+                                                                          !! bottom and top layers (0-1, unitless)    
+    REAL(r_std), DIMENSION(kjpindex,nvm)                :: zeflux         !! Evaporation to be withdrawn from soil 
+                                                                          !! @tex ($kg m^{-2}) @endtex ! *** why divided by veget ?
+    REAL(r_std), DIMENSION(kjpindex,nvm)                :: zpreci         !! Throughfall @tex ($kg m^{-2}$) @endtex  
+                                                                          !! ! *** why divided by veget ?
+    LOGICAL, DIMENSION(kjpindex,nvm)                    :: warning        !! To track negative total soil moisture cases in soil 
+                                                                          !! columns (true/false)
+    REAL(r_std)                                         :: gtr, btr       !! Fractions of top and botttom soil layers to the 
+                                                                          !! different diagnostic soil layers (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex)                    :: mean_dsg       !! Mean depth of water in top soil layer (m)
+    LOGICAL                                             :: OnceMore       !! To repeat the correction to solve dsg > dsp after 
+                                                                          !! diffusion between the bottom layers (true/false)
+    INTEGER(i_std), PARAMETER                           :: nitermax = 100 !! Maximum number of iterations to dsg > dsp after 
+                                                                          !! diffusion between the bottom layers (unitless) 
+    INTEGER(i_std)                                      :: niter          !! Counter of iterations to solve dsg > dsp after 
+                                                                          !! diffusion between the bottom layers (unitless) 
+    INTEGER(i_std)                                      :: nbad           !! Number of negative total soil moisture cases 
+                                                                          !! (unitless); this is before diffusion between the 
+                                                                          !! bottom layers, cf. "warning" ***
+    LOGICAL, DIMENSION(kjpindex,nvm)                    :: lbad           !! Tags "bad" PFTs where dsg > dsp after diffusion 
+                                                                          !! between the bottom layers (true/false)
+    LOGICAL, DIMENSION(kjpindex)                        :: lbad_ij        !! Tags "bad" grid-points where at least one PFT exhibits
+                                                                          !!  dsg > dsp after diffusion between the bottom layers 
+                                                                          !! (true/false) 
+    REAL(r_std)                                         :: gqseuil        !! Ancillary variables to compute drainage between the 
+                                                                          !! two soil layers @tex ($kg m^{-2}$) @endtex
+    REAL(r_std)                                         :: eausup         !! Ancillary variables to compute drainage between the 
+                                                                          !! two soil layers @tex ($kg m^{-2}$) @endtex
+    REAL(r_std)                                         :: wd1            !! Ancillary variables to compute drainage between the 
+                                                                          !! two soil layers @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nbdl+1)                      :: tmp_dl         !! Temporary diagnostic levels in the soil (m)
+    REAL(r_std), DIMENSION(kjpindex,nvm)                :: a_subgrd       !! Diagnosed subgrid fraction of saturated soil in the 
+                                                                          !! top layer, to calculate hdry (0-1, unitless)
+!_ ================================================================================================================================
+    
+  !! 1. Preliminary calculations
+    
+    !!  We define input and output fluxes at the soil surface, for each PFT
+    !!  The input flux is throughfall.
+    !!  The ouput flux is the total evaporation withdrawn from the soil (transpiration and bare soil evaporation, BSE)
+    ! *** I don't understand why the fluxes are divided by veget if they are in kg.m^{-2} within each PFT *** 
+    DO jv=1,nvm
+      DO ji = 1, kjpindex
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+         IF (jv .EQ. 1) THEN
+            IF ( tot_bare_soil(ji) .GT. zero ) THEN
+               zeflux(ji,jv) = transpir(ji,jv)/tot_bare_soil(ji)
+               zpreci(ji,jv) = precisol(ji,jv)/tot_bare_soil(ji)
+            ELSE
+               zeflux(ji,jv) = zero
+               zpreci(ji,jv) = zero
+            ENDIF
+         ELSE
+            IF ( veget(ji,jv) .GT. zero ) THEN
+               zeflux(ji,jv) = transpir(ji,jv)/veget(ji,jv)
+               zpreci(ji,jv) = precisol(ji,jv)/veget(ji,jv)
+            ELSE
+               zeflux(ji,jv) = zero
+               zpreci(ji,jv) = zero
+            ENDIF
+         ENDIF
+      ENDDO
+    ENDDO
+    
+    !!  For bare soil evaporation, we need to distinguish two cases. 
+    !!  This should only apply if there is vegetation but we do not test this case.
+    !!  Case 1 - if bare soil is present, BSE is extracted from the bare soil fraction
+    DO ji = 1, kjpindex
+      IF ( (vegtot(ji) .GT. zero) .AND. (tot_bare_soil(ji) .GT. min_sechiba) ) THEN
+        zeflux(ji,1) = vevapnu(ji)/tot_bare_soil(ji)
+      ENDIF
+    ENDDO
+
+    !!   Case 2 - if bare soil is not present, BSE is uniformly redistributed among the vegetation fractions
+    !!   This case is possible because of transfers (snow for instance). 
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+    DO jv = 2, nvm
+      DO ji = 1, kjpindex
+        IF ( (vegtot(ji) .GT. zero) .AND. (tot_bare_soil(ji) .LE. min_sechiba)&
+             & .AND. (veget(ji,jv) .GT. min_sechiba)) THEN
+          zeflux(ji,jv) =  zeflux(ji,jv) + vevapnu(ji)/vegtot(ji)
+        ENDIF
+      ENDDO
+    ENDDO
+    
+    ! Temporary diagnostic levels in the soil to diagnose shumdiag
+    tmp_dl(1) = 0
+    tmp_dl(2:nbdl+1) = diaglev(1:nbdl)
+
+  !! 2. Updating soil moisture
+
+    !!  We update soil moisture:
+    !!  The top soil moisture reacts to evaporation, throughfall, snow and ice melt, and inflow from irrigation
+    !!  The bottom soil moisture can receive returnflow from routing.f90
+    DO jv=1,nvm
+      DO ji=1,kjpindex
+      
+        ! Evaporated water is taken out of the ground
+        gqsb(ji,jv) = gqsb(ji,jv) - zeflux(ji,jv)
+        !
+        ! 1.2 Add snow and ice melt, troughfall from vegetation, reinfiltration and irrigation.
+        !
+        IF(vegtot(ji) .NE. zero) THEN
+
+           !  snow and ice melt, reinfiltration and troughfall from vegetation
+           gqsb(ji,jv) = gqsb(ji,jv) + zpreci(ji,jv) + (tot_melt(ji)+reinfiltration(ji))/vegtot(ji)
+           
+           ! We take care to add the irrigation only to the vegetated part if possible
+           !
+           IF (ABS(vegtot(ji)-tot_bare_soil(ji)) .LE. min_sechiba) THEN
+              gqsb(ji,jv) = gqsb(ji,jv) + irrigation(ji)/vegtot(ji)
+           ELSE
+
+              ! no vegetation, : we only add irrigation in the PFTs where vegetation can grow  
+              IF ( jv > 1 ) THEN
+
+                 ! Only add the irrigation to the upper soil if there is a reservoir.
+                 ! Without this the water evaporates right away.
+                 IF ( gqsb(ji,jv) > zero ) THEN
+                    gqsb(ji,jv) = gqsb(ji,jv) + irrigation(ji)/(vegtot(ji)-tot_bare_soil(ji))
+                 ELSE
+                    bqsb(ji,jv) = bqsb(ji,jv) + irrigation(ji)/(vegtot(ji)-tot_bare_soil(ji))
+                 ENDIF
+              ENDIF
+           ENDIF
+           
+           ! We add the water returning from rivers to the lower reservoir.
+           bqsb(ji,jv) = bqsb(ji,jv) + returnflow(ji)/vegtot(ji)
+           
+        ENDIF
+        
+      END DO
+    ENDDO
+    
+  !! 3. We compute runoff and adjust the soil layers' depth and water content
+
+    !!     The depth of top dry soil, dss, is of particular importance as it controls the soil moisture stresses 
+    !!     to transpiration and BSE     
+    runoff(:,:) = zero
+    
+    warning(:,:) = .FALSE.
+    DO jv=1,nvm
+      DO ji = 1, kjpindex
+        
+        !! 3.1 Soil moisture in excess of total water holding capacity runs off
+        runoff(ji,jv) = MAX(gqsb(ji,jv) + bqsb(ji,jv) - mx_eau_var(ji), zero)
+        
+        !! 3.2 If the soil is saturated (runoff is generated): no top layer; dss = dsp 
+        IF (mx_eau_var(ji) .LE. (gqsb(ji,jv) + bqsb(ji,jv))) THEN
+            !
+            gqsb(ji,jv) = zero
+            dsg(ji,jv) = zero
+            bqsb(ji,jv) = mx_eau_var(ji)
+            dsp(ji,jv) = zero
+            dss(ji,jv) = dsp (ji,jv)
+
+        ELSEIF ((gqsb(ji,jv) + bqsb(ji,jv)).GE.zero) THEN
+            
+            !! 3.3 Else, if the top layer holds more water than allowed by its depth, the top layer deepens
+            !! The top layer is saturated, so that dss=0.
+            !! In this case, dsp is useless, and is not updated, 
+            !! even if bqsb has changed because of irrigation and return flow.
+            IF (gqsb(ji,jv) .GT. dsg(ji,jv) * ruu_ch(ji)) THEN
+                !
+                dsg(ji,jv) = gqsb(ji,jv) / ruu_ch(ji)
+                dss(ji,jv) = zero
+            ELSEIF (gqsb(ji,jv) .GT. zero ) THEN
+ 
+            !! 3.4 If the top layer is not saturated, its total depth does not change and we only update its dry soil depth
+            !! In this case, dsp is useless, and is not updated, 
+            !! even if bqsb has changed because of irrigation and return flow.
+                !
+                dss(ji,jv) = ((dsg(ji,jv) * ruu_ch(ji)) - gqsb(ji,jv)) / ruu_ch(ji) 
+            ELSE
+
+            !! 3.5 If the top layer's moisture is negative, it vanishes and the required moisture is withdrawn from the bottom layer
+            !! dsp is updated accordingly, and defines the depth of top dray soil dss.
+                !
+                bqsb(ji,jv) = bqsb(ji,jv) + gqsb(ji,jv)
+                dsp(ji,jv) = dpu_max - bqsb(ji,jv) / ruu_ch(ji) ! dsp>dpu if bqsb<0 *** we can be here with bsqb<0 and bqsb+gqsb>0
+                gqsb(ji,jv) = zero
+                dsg(ji,jv) = zero
+                dss(ji,jv) = dsp(ji,jv)
+            END IF
+
+        ELSE 
+
+        !! 3.6 If the total soil moisture is negative: we keep track of the problem for further warning.
+        !! In this extreme case of dry soil, the top layer is absent.
+        !! The top dry soil depth, dsp, is equal to the soil depth.
+        !! But we keep the negative moisture for water budget closure, and assign it to the bottom layer.
+        ! Ceci ne devrait jamais arriver plus d'une fois par point. C-a-d une fois la valeur negative
+        ! atteinte les flux doivent etre nuls. On ne signale que ce cas donc. 
+        ! *** But this is obviously not the case in CMIP5 runs ***
+        ! *** Also, I don't see the use of conditionning upon zeflux(ji,jv) .GT. zero : negative moisture is always a problem !
+            
+            IF ( ( zeflux(ji,jv) .GT. zero ) .AND. &
+                 ( gqsb(ji,jv) + bqsb(ji,jv) .LT. -1.e-10 ) ) THEN
+               warning(ji,jv) = .TRUE.
+
+               ! WRITE (numout,*) 'WARNING! Soil Moisture will be negative' 
+               ! WRITE (numout,*) 'ji, jv = ', ji,jv
+               ! WRITE (numout,*) 'mx_eau_var = ', mx_eau_var(ji)
+               ! WRITE (numout,*) 'veget, resdist =', veget(ji,jv), resdist(ji,jv)
+               ! WRITE (numout,*) 'bqsb = ', bqsb(ji,jv)
+               ! WRITE (numout,*) 'gqsb = ', gqsb(ji,jv)
+               ! WRITE (numout,*) 'dss = ', dss(ji,jv)
+               ! WRITE (numout,*) 'dsg = ', dsg(ji,jv)
+               ! WRITE (numout,*) 'dsp = ', dsp(ji,jv)
+               ! WRITE (numout,*) 'humrel = ', humrel(ji, jv)
+               ! WRITE (numout,*) 'Soil evaporation = ', zeflux(ji,jv)
+               ! WRITE (numout,*) 'input = ',precisol(ji, jv), tot_melt(ji)
+               ! WRITE (numout,*) '============================'
+            ENDIF
+
+            
+            bqsb(ji,jv) = gqsb(ji,jv) + bqsb(ji,jv) ! this will be negative 
+            dsp(ji,jv) = dpu_max
+            gqsb(ji,jv) = zero
+            dsg(ji,jv) = zero
+            dss(ji,jv) = dsp(ji,jv)
+            
+        ENDIF
+        
+      ENDDO
+    ENDDO
+    
+  !! 4. If there are some PFTs with negative moisture, it is written in the run log
+    
+    nbad = COUNT( warning(:,:) .EQV. .TRUE. )
+    IF ( nbad .GT. 0 ) THEN
+      WRITE(numout,*) 'hydrolc_soil: WARNING! Soil moisture was negative at', &
+                       nbad, ' points:'
+      !DO jv = 1, nvm
+      !  DO ji = 1, kjpindex
+      !    IF ( warning(ji,jv) ) THEN
+      !      WRITE(numout,*) '  ji,jv = ', ji,jv
+      !      WRITE (numout,*) 'mx_eau_var = ', mx_eau_var(ji)
+      !      WRITE (numout,*) 'veget, resdist =', veget(ji,jv), resdist(ji,jv)
+      !      WRITE (numout,*) 'bqsb = ', bqsb(ji,jv)
+      !      WRITE (numout,*) 'gqsb = ', gqsb(ji,jv)
+      !      WRITE (numout,*) 'runoff = ',runoff(ji,jv)
+      !      WRITE (numout,*) 'dss = ', dss(ji,jv)
+      !      WRITE (numout,*) 'dsg = ', dsg(ji,jv)
+      !      WRITE (numout,*) 'dsp = ', dsp(ji,jv)
+      !      WRITE (numout,*) 'humrel = ', humrel(ji, jv)
+      !      WRITE (numout,*) 'Soil evaporation = ', zeflux(ji,jv)
+      !      WRITE (numout,*) 'Soil precipitation = ',zpreci(ji,jv)
+      !      WRITE (numout,*) 'input = ',precisol(ji, jv), tot_melt(ji)
+      !      WRITE (numout,*) 'returnflow = ',returnflow(ji)
+      !      WRITE (numout,*) '============================'
+      !    ENDIF
+      !  ENDDO
+      !ENDDO
+    ENDIF
+    
+  !! 5. Top layers that are very large or very dry can be deadlock situations for the Choisnel scheme
+ 
+    !!  Top layers that are very large or that hold a tiny amount of water .
+    !!  They are handled here.
+    IF (long_print) WRITE(numout,*)  'hydro_soil 2.0 : Resolve deadlocks'
+    DO jv=1,nvm
+      DO ji=1,kjpindex
+        
+        !! 5.1 If the top layer is almost dry, we merge the two layers 
+        IF ( ABS(dsp(ji,jv)-dsg(ji,jv)) .LT. min_sechiba ) THEN ! min_sechiba = 1.e-8 (constantes.f90)
+            bqsb(ji,jv) = bqsb(ji,jv) + gqsb(ji,jv)
+            dsp(ji,jv) = dpu_max - bqsb(ji,jv) / ruu_ch(ji) ! *** can this make dsp > dpu_cste
+            gqsb(ji,jv) = zero
+            dsg(ji,jv) = zero
+            dss(ji,jv) = dsp(ji,jv)
+        ENDIF
+        
+        !!  5.2 Internal drainage from the top to the bottom layer
+        !!   Much faster when the relative moisture of the top layer exceeds 75\% of the water holding capacity.
+        !!   The parameters are exp_drain = 1.5, min_drain = 0.002 mm/h and max_drain = 0.2 mm/h
+        gqseuil = min_sechiba * deux * ruu_ch(ji) ! min_sechiba = 1.e-8 (constantes.f90)
+        eausup = dsg(ji,jv) * ruu_ch(ji)
+        wd1 = .75*eausup
+        
+        IF (eausup .GT. gqseuil) THEN ! dsg > 2.e-8 m
+            gdrainage(ji,jv) = min_drain *  (gqsb(ji,jv)/eausup)
+            
+            IF ( gqsb(ji,jv) .GE. wd1 .AND. dsg(ji,jv) .GT. 0.10 ) THEN
+                
+                gdrainage(ji,jv) = gdrainage(ji,jv) + &
+                   (max_drain-min_drain)*((gqsb(ji,jv)-wd1) / (eausup-wd1))**exp_drain
+                
+            ENDIF
+            
+            gdrainage(ji,jv)=MIN(gdrainage(ji,jv), MAX(gqsb(ji,jv), zero))
+            
+        ELSE
+            gdrainage(ji,jv)=zero ! *** why not remove the top layer in that case ?? 
+        ENDIF
+        !
+        gqsb(ji,jv) = gqsb(ji,jv) -  gdrainage(ji,jv)
+        bqsb(ji,jv) = bqsb(ji,jv) + gdrainage(ji,jv)
+        dsg(ji,jv) = dsg(ji,jv) -  gdrainage(ji,jv) / ruu_ch(ji)
+        dsp(ji,jv) = dpu_max - bqsb(ji,jv)/ruu_ch(ji) ! *** this line shouldn't make dsp>dpu_cste
+      ENDDO
+    ENDDO
+    
+  !! 6. We want the vegetation to share a common bottom moisture:
+    !! Thus, we must account for moisture diffusion between the soil columns.
+    IF (long_print) WRITE(numout,*)  'hydrolc_soil 3.0 : Vertical diffusion'
+
+    !!  6.1 Average of bottom and top moisture over the "veget" fractions
+    mean_bqsb(:) = zero
+    mean_gqsb(:) = zero
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+        IF ( vegtot(ji) .GT. zero ) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+           IF (jv .EQ. 1) THEN
+              mean_bqsb(ji) = mean_bqsb(ji) + tot_bare_soil(ji)/vegtot(ji)*bqsb(ji,jv)
+              mean_gqsb(ji) = mean_gqsb(ji) + tot_bare_soil(ji)/vegtot(ji)*gqsb(ji,jv)
+           ELSE
+              mean_bqsb(ji) = mean_bqsb(ji) + veget(ji,jv)/vegtot(ji)*bqsb(ji,jv)
+              mean_gqsb(ji) = mean_gqsb(ji) + veget(ji,jv)/vegtot(ji)*gqsb(ji,jv)
+           ENDIF
+        ENDIF
+      ENDDO
+    ENDDO
+    
+    OnceMore = .TRUE.
+    niter = 0
+    lbad_ij(:)=.TRUE. 
+    DO WHILE ( OnceMore .AND. ( niter .LT. nitermax ) )  ! nitermax prevents infinite loops (should actually never occur)
+      
+      niter = niter + 1
+      
+      !! 6.2 We assign the mean value in all the soil columns in a grid-cell
+      DO jv = 1, nvm
+        DO ji = 1, kjpindex
+           IF (lbad_ij(ji)) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+              IF (jv .EQ. 1) THEN
+                 IF (tot_bare_soil(ji).GT.zero) THEN
+                    !
+                    bqsb(ji,jv) = mean_bqsb(ji)
+                    dsp(ji,jv) = dpu_max - bqsb(ji,jv)/ruu_ch(ji)
+                 ENDIF
+              ELSE IF ( veget(ji,jv) .GT. zero ) THEN
+                 !
+                 bqsb(ji,jv) = mean_bqsb(ji)
+                 dsp(ji,jv) = dpu_max - bqsb(ji,jv)/ruu_ch(ji) ! *** can this line make dsp>dpu_cste ?
+              ENDIF
+           ENDIF
+           
+        ENDDO
+      ENDDO    
+      
+      !! 6.3 Iterative adjustment if top layer larger than new average dsp
+      !! After averaging the bottom moistures, dsp becomes the mean depth of soil that is not filled by bottom moisture.
+      !! In "bad" points where dsg > dsp, we merge the two soil layers.
+      !! This adjustment needs to be done iteratively (WHILE loop)     
+      !! We diagnose the bad points where dsg>dsp
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+!!$      lbad(:,:) = ( ( dsp(:,:) .LT. dsg(:,:) ) .AND. &
+!!$                    ( dsg(:,:) .GT. zero ) .AND. &
+!!$                    ( veget(:,:) .GT. zero ) )
+      lbad(:,:) = ( ( dsp(:,:) .LT. dsg(:,:) ) .AND. &
+                    ( dsg(:,:) .GT. zero ) )
+      DO jv = 1, nvm
+         DO ji = 1, kjpindex
+            IF (jv .EQ. 1) THEN
+               lbad(ji,jv) = lbad(ji,jv) .AND. ( tot_bare_soil(ji) .GT. zero )
+            ELSE
+               lbad(ji,jv) = lbad(ji,jv) .AND. ( veget(ji,jv) .GT. zero )
+            ENDIF
+         ENDDO
+      ENDDO
+
+      
+      !! If there are no such points, we'll do no further iteration 
+      IF ( COUNT( lbad(:,:) ) .EQ. 0 ) OnceMore = .FALSE.
+      DO ji = 1, kjpindex
+        IF (COUNT(lbad(ji,:)) == 0 ) lbad_ij(ji)=.FALSE.
+      ENDDO
+      
+      !! In the bad PFTs, we merge the two soil layers.
+      DO jv = 1, nvm
+!YM
+!        !
+!        DO ji = 1, kjpindex
+!          IF ( veget(ji,jv) .GT. zero ) THEN
+!            !
+!            bqsb(ji,jv) = mean_bqsb(ji)
+!            dsp(ji,jv) = dpu_max - bqsb(ji,jv)/ruu_ch(ji)
+!          ENDIF
+!          !
+!        ENDDO
+        !
+        DO ji = 1, kjpindex
+          IF ( lbad(ji,jv) ) THEN
+            !
+            runoff(ji,jv) = runoff(ji,jv) + &
+                            MAX( bqsb(ji,jv) + gqsb(ji,jv) - mx_eau_var(ji), zero)
+            !
+            bqsb(ji,jv) = MIN( bqsb(ji,jv) + gqsb(ji,jv), mx_eau_var(ji))
+            !
+            gqsb(ji,jv) = zero
+            dsp(ji,jv) = dpu_max - bqsb(ji,jv)/ruu_ch(ji)  ! *** could this line make dsp>dpu_cste ? 
+                                                           ! *** set a max to dpu_cste to be sure !
+            dss(ji,jv) = dsp(ji,jv)
+            dsg(ji,jv) = zero
+            
+          ENDIF
+        ENDDO
+      ENDDO  
+      
+      !! New average of bottom and top moisture over the "veget" fractions, for the next iteration
+      mean_bqsb(:) = zero
+      mean_gqsb(:) = zero
+      DO jv = 1, nvm
+        DO ji = 1, kjpindex
+          IF ( vegtot(ji) .GT. zero ) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+             IF (jv .EQ. 1) THEN
+                mean_bqsb(ji) = mean_bqsb(ji) + tot_bare_soil(ji)/vegtot(ji)*bqsb(ji,jv)
+                mean_gqsb(ji) = mean_gqsb(ji) + tot_bare_soil(ji)/vegtot(ji)*gqsb(ji,jv)
+             ELSE
+                mean_bqsb(ji) = mean_bqsb(ji) + veget(ji,jv)/vegtot(ji)*bqsb(ji,jv)
+                mean_gqsb(ji) = mean_gqsb(ji) + veget(ji,jv)/vegtot(ji)*gqsb(ji,jv)
+             ENDIF
+          ENDIF
+        ENDDO
+      ENDDO
+      
+    ENDDO ! end while, but no warning if nitermax has been reached ***
+    
+  !! 7. Compute total runoff from all soil columns and partition it into drainage and surface runoff
+
+    ! *** why isn't run_off_tot divided by vegtot ?
+    IF (long_print) WRITE(numout,*)  'hydrolc_soil 4.0: Computes total runoff'
+
+    !! 7.1 Average total runoff
+    run_off_tot(:) = zero
+    DO ji = 1, kjpindex
+      IF ( vegtot(ji) .GT. zero ) THEN
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+       run_off_tot(ji) = run_off_tot(ji) + (runoff(ji,1)*tot_bare_soil(ji))
+       DO jv = 2, nvm
+        run_off_tot(ji) = run_off_tot(ji) + (runoff(ji,jv)*veget(ji,jv))
+       ENDDO
+      ELSE
+        run_off_tot(ji) = tot_melt(ji) + irrigation(ji) + reinfiltration(ji)
+      ENDIF
+    ENDDO
+    
+    !! 7.2 Diagnose drainage and surface runoff (95% and 5%)
+    drainage(:) = 0.95 * run_off_tot(:)
+    run_off_tot(:) = run_off_tot(:) - drainage(:)       
+    ! *** from now on, we lost track of total runoff
+    ! *** the name "run_off_tot" is VERY misleading
+    
+  !! 8. Diagnostics which are needed to carry information to other modules:
+
+    IF (long_print) WRITE(numout,*)  'hydro_soil 5.0: Diagnostics'
+    
+    ! Reset dsg if necessary
+    WHERE (gqsb(:,:) .LE. zero) dsg(:,:) = zero
+    
+    ! Average moisture profile for shumdiag
+    DO ji=1,kjpindex
+      mean_dsg(ji) = mean_gqsb(ji)/ruu_ch(ji) ! mean depth of water in top layer in meters
+    ENDDO
+    
+    !! 8.1 Moisture stress factors on vegetation (humrel and vegstress)
+    !! Moisture stress factors on vegetation:
+    !!  - "humrel" on transpiration (for condveg) exponentially decreases with top dry soil depth;
+    !!  the decay factor is the one of root density with depth (from 1 to 8 depending on PFTs),
+    !!  following de Rosnay and Polcher (1998) 
+    !!  - "vegstress" on vegetation growth (for stomate) 
+    IF (long_print) WRITE(numout,*)  'hydro_soil 6.0 : Moisture stress'
+
+    a_subgrd(:,:) = zero
+
+    DO jv = 1, nvm
+      DO ji=1,kjpindex
+         !
+         ! computes relative surface humidity
+         !
+         ! Only use the standard formulas if total soil moisture is larger than zero.
+         ! Else stress functions are set to zero. 
+         ! This will avoid that large negative soil moisture accumulate over time by the
+         ! the creation of small skin reservoirs which evaporate quickly.
+         !
+         IF ( gqsb(ji,jv)+bqsb(ji,jv) .GT. zero ) THEN
+            !
+            IF (dsg(ji,jv).EQ. zero .OR. gqsb(ji,jv).EQ.zero) THEN
+               humrel(ji,jv) = EXP( - humcste(jv) * dpu_max * (dsp(ji,jv)/dpu_max) )
+               dsg(ji,jv) = zero
+                   
+               ! humrel = 0 if dsp is larger than its value at the wilting point, or if the bottom layer's soil is negative
+               ! *** the condition based on qwilt (= 5.0) doesn't make much sense: (i) the Choisnel scheme works in available  
+               ! *** moisture, i.e. above wilting point (Ducharne & Laval, 2000), so that the moisture at withing point is ZERO; 
+               ! *** (ii) with the chosen values in constantes_soil.f90, qwilt/ruu_ch is around 0.033 and dpu_cste-qwilt/ruu_ch
+               ! *** is around dpu
+               IF (dsp(ji,jv).GT.(dpu_max - min_sechiba) .OR. bqsb(ji,jv).LT.zero) THEN
+                  humrel(ji,jv) = zero
+               ENDIF
+
+               vegstress(ji,jv) = humrel(ji,jv)
+               
+            ELSE
+
+               !! 8.1.2 If there are two soil layers, we need the "transpiring" fraction "a_subgrd"
+               !! We compute humrel as the average of the values defined by dss and dsp.
+	       !! The weights depend on "a_subgrd", which is defined by redistributing the top layer's 
+	       !! moisture in a virtual layer of depth dsg_min (set to 1 mm in hydrolc), 
+               !! what defines a totally dry and a totally saturated fraction (a_subgrd):
+               !!  - if the top layer's moisture > 1mm, then a_subgrd=1, and the humrel is normally deduced from dss only
+               !!  - if the top layer's moisture is very small, a_subgrd decreases from 1 to 0 as the top layer's moisture 
+               !!    vanishes, and it serves to describe a smooth transition to the case where the top soil layer has
+               !!    vanished and humrel depends on dsp.
+               !! \latexonly
+ 	       !! \includegraphics[scale = 1]{asubgrid.pdf}
+               !! \endlatexonly
+               !
+               zhumrel_lo(ji) = EXP( - humcste(jv) * dsp(ji,jv)) 
+               zhumrel_up(ji) = EXP( - humcste(jv) * dss(ji,jv))
+               a_subgrd(ji,jv)=MIN(MAX(dsg(ji,jv)-dss(ji,jv),zero)/dsg_min,un)
+               humrel(ji,jv)=a_subgrd(ji,jv)*zhumrel_up(ji)+(un-a_subgrd(ji,jv))*zhumrel_lo(ji)
+               
+               !! As we need a slower variable for vegetation growth, vegstress is computed differently from humrel.
+               ! *** la formule ci-dessous est d'un empirisme absolu : on ajoute deux stresses, on en retranche un autre...????
+               ! que veut dire slower variable ??
+               vegstress(ji,jv) = zhumrel_lo(ji) + zhumrel_up(ji) - EXP( - humcste(jv) * dsg(ji,jv) ) 
+               
+            ENDIF
+            
+         ELSE 
+ 
+            !! 8.1.3 If total moisture is negative, the two moisture stress factors are set to zero. 
+            !! This should avoid that large negative soil moisture accumulate over time because of small skin layers
+            !! which transpire quickly.
+            ! *** Yet, CMIP5 exhibits such behaviors => because of rsol ?? or other reasons ?? The routing shouldn't 
+            ! *** create such situations, but couldn't some patches here or there ???
+            humrel(ji,jv) = zero
+            vegstress(ji,jv) = zero
+            
+         ENDIF
+        !
+      ENDDO
+    ENDDO
+    
+    !! 8.2 Mean relative soil moisture in the diagnostic soil levels: shumdiag (for thermosoil)
+    !! It is deduced from the mean moisture and depth of the two soil layers in the grid cell,
+    !! depending on how the soil diagnostic levels intersect the two mean soil depths
+    DO jd = 1,nbdl
+      DO ji = 1, kjpindex
+         IF ( tmp_dl(jd+1) .LT. mean_dsg(ji)) THEN ! mean_dsg = mean depth of water in top layer in meters
+
+            ! If the diagnostic soil level entirely fits into the mean top soil layer depth, they have the same 
+            ! relative moisture
+            shumdiag(ji,jd) = mean_gqsb(ji)/mx_eau_var(ji)
+         ELSE 
+            IF ( tmp_dl(jd) .LT. mean_dsg(ji)) THEN
+
+               ! If the diagnostic soil level intersects both soil layers, its relative moisture is the weighted
+               ! mean of the ones of two soil layers
+               gtr = (mean_dsg(ji)-tmp_dl(jd))/(tmp_dl(jd+1)-tmp_dl(jd))
+               btr = 1 - gtr
+               shumdiag(ji,jd) = gtr*mean_gqsb(ji)/mx_eau_var(ji) + &
+                    & btr*mean_bqsb(ji)/mx_eau_var(ji)
+            ELSE
+
+               ! If the diagnostic soil level entirely fits into the mean bottom soil layer depth,
+               ! they have the same relative moisture 
+               shumdiag(ji,jd) = mean_bqsb(ji)/mx_eau_var(ji)
+            ENDIF
+         ENDIF
+         shumdiag(ji,jd) = MAX(MIN(shumdiag(ji,jd), un), zero)
+      ENDDO
+    ENDDO
+
+    !! 8.3 Fraction of visibly dry soil in the bare soil fraction for soil albedo
+    !!  if we want to account for its dependance on soil moisture in condveg.
+    !!  We redistribute the top layer's moisture in a virtual layer of depth 0.1 m,
+    !!  what defines a totally saturated and a totally dry fraction (drysoil_frac). 
+    !!  The latter is thus 1 if dss > 0.1 m. 
+    drysoil_frac(:) = MIN(MAX(dss(:,1),zero)*10._r_std, un)
+
+    !! 8.4 Resistance to bare soil evaporation
+    !!  This resistance increases with the height of top dry soil, described by hdry.
+    !!  It depends on both dss and dsp (dry soil heights) in the bare soil fraction, 
+    !!  and, as for the soil moisture stress factor on transpiration (humrel), 
+    !!  we use "a_subgrd" (see 8.1.2) to describe a smooth transition between cases 
+    !!  when the top layer's moisture > 1mm and hdry=dss and cases when the top layer's 
+    !!  has vanished and hdy=dsp. 
+    !!  The relationship between rsol and dry soil height has been changed since 
+    !!  de Rosnay and Polcher (1998), to make rsol becomes VERY large when hdry 
+    !!  gets close to dpu_cste 
+    !!  Owing to this non-linear dependance, BSE tends to zero when the depth of dry reaches dpu_cste.
+    ! *** if hdry > dpu (several cases might lead to this pathological situation), 
+    ! *** we shift to the other limb of the hyperbolic function, and rsol decreases towards hdry*rsol_cste 
+    ! *** can this explain the accumulation of very negative soil moisture in arid zones in CMIP5 ???
+    ! *** COULD'NT WE SIMPLY SET THAT hdry CANNOT EXCEED dpu_cste ???
+    hdry(:) = a_subgrd(:,1)*dss(:,1) + (un-a_subgrd(:,1))*dsp(:,1) 
+    
+    rsol(:) = -un
+    DO ji = 1, kjpindex
+       IF (tot_bare_soil(ji) .GE. min_sechiba) THEN
+          
+          ! Correction Nathalie - le 28 mars 2006 - sur conseils Fred Hourdin
+          ! on modifie le rsol pour que la resistance croisse subitement si on s'approche
+          ! du fond. En gros, rsol=hdry*rsol_cste pour hdry < 1m70
+          !rsol(ji) = dss(ji,1) * rsol_cste
+          rsol(ji) =  ( hdry(ji) + un/(10.*(dpu_max - hdry(ji))+1.e-10)**2 ) * rsol_cste
+       ENDIF
+    ENDDO
+    
+    !! 8.5 Litter humidity factor, used in stomate
+    !!  It varies from 1 when mean top dry soil height is 0, and decreases as mean top dry soil height increases
+    litterhumdiag(:) = EXP( - hdry(:) / hcrit_litter ) ! hcrit_litter=0.08_r_std
+
+    !!  Special case of it has just been raining a few drops: the top layer exists, but its height 
+    !!  is ridiculously small and the mean top dry soil height is almost zero: we assume a dry litter 
+    WHERE ( ( hdry(:) .LT. min_sechiba ) .AND. &  ! constantes : min_sechiba = 1.E-8_r_std
+            ( mean_dsg(:) .GT. min_sechiba ) .AND. ( mean_dsg(:) .LT. 5.E-4 ) )
+      litterhumdiag(:) = zero
+    ENDWHERE
+    
+    IF (long_print) WRITE (numout,*) ' hydrolc_soil done '
+
+  END SUBROUTINE hydrolc_soil
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE   : hydrolc_waterbal 
+!!
+!>\BRIEF        This subroutine checks the water balance closure in each terrestrial grid-cell
+!! over a time step.
+!!
+!! DESCRIPTION  : The change in total water amount over the time step must equal the algebraic sum of the  
+!! water fluxes causing the change, integrated over the timestep. The equality is checked to some precision, 
+!! set for double precision calculations (REAL*8). Note that this precision depends on the time step.
+!! This verification does not make much sense in REAL*4 as the precision is the same as some of the fluxes.
+!! The computation is only done over the soil area, as over glaciers (and lakes?) we do not have 
+!! water conservation. 
+!! *** The above sentence is not consistent with what I understand from the code, since snow_nobio is accounted for.
+!! *** what is the value of epsilon(1) ?
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : None
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================   
+  
+  SUBROUTINE hydrolc_waterbal (kjpindex, index, first_call, dtradia, veget, totfrac_nobio, qsintveg, snow, snow_nobio,&
+       & precip_rain, precip_snow, returnflow, reinfiltration, irrigation, tot_melt, vevapwet, transpir, vevapnu,&
+       & vevapsno, vevapflo, floodout, run_off_tot, drainage)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                            :: kjpindex       !! Domain size (number of grid cells) (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)       :: index          !! Indices of the points on the map
+    LOGICAL, INTENT (in)                                   :: first_call     !! This flag is set to true to initialize the total 
+                                                                             !! amount of water at beginning of time step 
+                                                                             !! (true/false)
+    REAL(r_std), INTENT (in)                               :: dtradia        !! Time step duration (s)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)      :: veget          !! Grid-cell fraction effectively covered by 
+                                                                             !! vegetation for each PFT, except for soil 
+                                                                             !! (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: totfrac_nobio  !! Total fraction of terrestrial ice+lakes+...
+                                                                             !! (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)      :: qsintveg       !! Amount of water in the canopy interception 
+                                                                             !! reservoir @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: snow           !! Snow water equivalent @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout):: snow_nobio     !! Snow water equivalent on nobio areas  
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+									     ! Ice water balance
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: precip_rain    !! Rainfall @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: precip_snow    !! Snowfall  @tex ($kg m^{-2}$) @endtex  
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: returnflow     !! Routed water which comes back into the soil 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: reinfiltration !! Water returning from routing to the top reservoir
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: irrigation     !! Irrigation water applied to soils 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: tot_melt       !! Total melt @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)      :: vevapwet       !! Interception loss over each PFT 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)      :: transpir       !! Transpiration over each PFT 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: vevapnu        !! Bare soil evaporation @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: vevapflo       !! Floodplains evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: vevapsno       !! Snow evaporation @tex ($kg m^{-2}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: floodout       !! Outflow from floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: run_off_tot    !! Diagnosed surface runoff @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)          :: drainage       !! Diagnosed rainage at the bottom of soil  
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    
+    !! 0.2 Output variables
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                         :: ji, jv, jn     !!  Grid-cell, PFT and "nobio" fraction indices 
+                                                                             !! (unitless)
+    REAL(r_std)                                            :: allowed_err    !! Allowed error in the water budget closure 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                       :: watveg         !! Total amount of intercepted water in a grid-cell  
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                       :: delta_water    !! Change in total water amount 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                       :: tot_flux       !! Algebraic sum of the water fluxes integrated over 
+                                                                             !! the timestep @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                       :: sum_snow_nobio !! Total amount of snow from the "nobio" fraction 
+                                                                             !! in a grid-cell @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                       :: sum_vevapwet   !! Sum of interception loss in the grid-cell 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex)                       :: sum_transpir   !! Sum of  transpiration in the grid-cell 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+!_ ================================================================================================================================
+
+  !! 1. We initialize the total amount of water in terrestrial grid-cells at the beginning of the first time step
+    
+    IF ( first_call ) THEN
+
+       tot_water_beg(:) = zero
+       watveg(:) = zero
+       sum_snow_nobio(:) = zero
+
+       !cdir NODEP
+       DO jv = 1, nvm
+          watveg(:) = watveg(:) + qsintveg(:,jv)
+       ENDDO
+
+       !cdir NODEP
+       DO jn = 1, nnobio ! nnobio=1
+          sum_snow_nobio(:) = sum_snow_nobio(:) + snow_nobio(:,jn)
+       ENDDO
+
+       !cdir NODEP
+       DO ji = 1, kjpindex
+          tot_water_beg(ji) = (mean_bqsb(ji) + mean_gqsb(ji))*vegtot(ji) + &
+            &  watveg(ji) + snow(ji) + sum_snow_nobio(ji)
+       ENDDO
+       tot_water_end(:) = tot_water_beg(:)
+
+       RETURN
+
+    ENDIF
+    
+  !! 2. We check the water balance : this is done at the end of a time step
+    
+    tot_water_end(:) = zero
+    
+    !! 2.1 If the "nobio" fraction does not complement the "bio" fraction, we issue a warning
+    !!   If the "nobio" fraction (ice, lakes, etc.) does not complement the "bio" fraction (vegetation and bare soil),
+    !!   we do not need to go any further, and we output a warning ! *** how are oceans treated ?
+    DO ji = 1, kjpindex
+
+       ! Modif Nathalie
+       ! IF ( (un - (totfrac_nobio(ji) + vegtot(ji))) .GT. EPSILON(un) ) THEN
+       IF ( (un - (totfrac_nobio(ji) + vegtot(ji))) .GT. (100*EPSILON(un)) ) THEN
+          WRITE(numout,*) 'HYDROL problem in vegetation or frac_nobio on point ', ji
+          WRITE(numout,*) 'totfrac_nobio : ', totfrac_nobio(ji)
+          WRITE(numout,*) 'vegetation fraction : ', vegtot(ji)
+          !STOP 'in hydrolc_waterbal'
+       ENDIF
+    ENDDO
+    
+    !! 2.2 We calculate the total amount of water in grid-cells at the end the time step
+    watveg(:) = zero
+    sum_vevapwet(:) = zero
+    sum_transpir(:) = zero
+    sum_snow_nobio(:) = zero
+
+    !cdir NODEP
+    DO jv = 1,nvm
+       watveg(:) = watveg(:) + qsintveg(:,jv)
+       sum_vevapwet(:) = sum_vevapwet(:) + vevapwet(:,jv)
+       sum_transpir(:) = sum_transpir(:) + transpir(:,jv)
+    ENDDO
+
+    !cdir NODEP
+    DO jn = 1,nnobio
+       sum_snow_nobio(:) = sum_snow_nobio(:) + snow_nobio(:,jn)
+    ENDDO
+    
+    !cdir NODEP
+    DO ji = 1, kjpindex
+       tot_water_end(ji) = (mean_bqsb(ji) + mean_gqsb(ji))*vegtot(ji) + &
+            & watveg(ji) + snow(ji) + sum_snow_nobio(ji)
+    ENDDO
+     
+    !! 2.3 Calculate the change in total water amount during the time step
+    !!  Calculate the change in total water amount during the time, stepand the algebraic sum
+    !!  of the water fluxes supposed to cause the total water amount change.
+    !!  If the model conserves water, they should be equal, since the fluxes are used in their integrated form, 
+    !!  over the time step dtradia, with a unit of kg m^{-2}.
+    DO ji = 1, kjpindex
+       
+       delta_water(ji) = tot_water_end(ji) - tot_water_beg(ji)
+       
+       tot_flux(ji) =  precip_rain(ji) + precip_snow(ji) + returnflow(ji) + reinfiltration(ji) + irrigation(ji) - &
+             & sum_vevapwet(ji) - sum_transpir(ji) - vevapnu(ji) - vevapsno(ji) - vevapflo(ji) + &
+             & floodout(ji)- run_off_tot(ji) - drainage(ji) 
+       
+    ENDDO
+    
+       !! 2.4 We do the check, given some minimum required precision
+       !!       This is a wild guess and corresponds to what works on an IEEE machine under double precision (REAL*8).
+       !!       If the water balance is not closed at this precision, we issue a warning with some diagnostics.
+       allowed_err = 50000*EPSILON(un) ! *** how much is epsilon(1) ? where is it defined ?
+       
+    DO ji = 1, kjpindex
+       IF ( ABS(delta_water(ji)-tot_flux(ji)) .GT. allowed_err ) THEN
+          WRITE(numout,*) 'HYDROL does not conserve water. The erroneous point is : ', ji
+          WRITE(numout,*) 'The error in mm/d is :', (delta_water(ji)-tot_flux(ji))/dtradia*one_day, &
+               & ' and in mm/dt : ', delta_water(ji)-tot_flux(ji)
+          WRITE(numout,*) 'delta_water : ', delta_water(ji), ' tot_flux : ', tot_flux(ji)
+          WRITE(numout,*) 'Actual and allowed error : ', ABS(delta_water(ji)-tot_flux(ji)), allowed_err
+          WRITE(numout,*) 'vegtot : ', vegtot(ji)
+          WRITE(numout,*) 'precip_rain : ', precip_rain(ji)
+          WRITE(numout,*) 'precip_snow : ',  precip_snow(ji)
+          WRITE(numout,*) 'Water from irrigation, floodplains:', reinfiltration(ji), returnflow(ji), irrigation(ji)
+          WRITE(numout,*) 'Total water in soil :', mean_bqsb(ji) + mean_gqsb(ji)
+          WRITE(numout,*) 'Water on vegetation :', watveg(ji)
+          WRITE(numout,*) 'Snow mass :', snow(ji)
+          WRITE(numout,*) 'Snow mass on ice :', sum_snow_nobio(ji)
+          WRITE(numout,*) 'Melt water :', tot_melt(ji)
+          WRITE(numout,*) 'evapwet : ', vevapwet(ji,:)
+          WRITE(numout,*) 'transpir : ', transpir(ji,:)
+          WRITE(numout,*) 'evapnu, evapsno, evapflo : ', vevapnu(ji), vevapsno(ji), vevapflo(ji)
+          WRITE(numout,*) 'floodout : ', floodout(ji)
+          WRITE(numout,*) 'drainage : ', drainage(ji)
+          STOP 'in hydrolc_waterbal'
+       ENDIF
+       
+    ENDDO
+    
+  !! 3. Transfer the total water amount at the end of the current timestep to the begining of the next one
+    
+    tot_water_beg = tot_water_end
+    
+  END SUBROUTINE hydrolc_waterbal
+ 
+
+!! ================================================================================================================================
+!! SUBROUTINE  : hydrolc_alma 
+!!
+!>\BRIEF       This routine computes diagnostic variables required under the ALMA standards:
+!! changes in water amounts over the time steps (in the soil, snow and interception reservoirs); total water amount 
+!! at the end of the time steps; soil relative humidity.
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!!  - soilwet: mean relative humidity of soil in the grid-cells (0-1, unitless)
+!!  - delsoilmoist, delswe, delintercept: changes in water amount during the time step @tex ($kg m^{-2}$) @endtex, 
+!!    for the three water reservoirs (soil,snow,interception)
+!!  - tot_watsoil_end: total water amount at the end of the time steps aincluding the three water resrevoirs  
+!! @tex ($kg m^{-2}$) @endtex. 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n   
+!_ ================================================================================================================================   
+  
+  SUBROUTINE hydrolc_alma (kjpindex, index, first_call, qsintveg, snow, snow_nobio, soilwet)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                         :: kjpindex    !! Domain size (number of grid cells) (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index       !! Indices of the points on the map (unitless)
+    LOGICAL, INTENT (in)                                :: first_call  !! This flag is set to true to initialize the water amount 
+                                                                       !! variables at beginning of time step (true/false)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: qsintveg    !! Amount of water in the canopy interception reservoir 
+                                                                       !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: snow        !! Snow water equivalent  @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in):: snow_nobio  !! Snow water equivalent on nobio areas 
+                                                                       !! @tex ($kg m^{-2}$) @endtex 
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: soilwet     !! Mean relative humidity of soil in the grid-cells 
+                                                                       !! (0-1, unitless)
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variabless
+    
+    INTEGER(i_std)                                      :: ji          !! Grid-cell indices (unitless)
+    REAL(r_std)                                         :: watveg      !! Total amount of intercepted water in a grid-cell 
+                                                                       !! @tex ($kg m^{-2}$) @endtex 
+!_ ================================================================================================================================
+
+  !! 1. Initialize water in terrestrial grid-cells at the beginning of the first time step
+
+    !! Initialize the amounts of water in terrestrial grid-cells at the beginning of the first time step, 
+    !! for the three water reservoirs (interception, soil and snow). 
+    IF ( first_call ) THEN
+
+       tot_watveg_beg(:) = zero
+       tot_watsoil_beg(:) = zero
+       snow_beg(:)        = zero 
+       
+       DO ji = 1, kjpindex
+          watveg = SUM(qsintveg(ji,:))
+          tot_watveg_beg(ji) = watveg
+          tot_watsoil_beg(ji) = mean_bqsb(ji) + mean_gqsb(ji)
+          snow_beg(ji)        = snow(ji)+ SUM(snow_nobio(ji,:))  
+       ENDDO
+       
+       tot_watveg_end(:) = tot_watveg_beg(:)
+       tot_watsoil_end(:) = tot_watsoil_beg(:)
+       snow_end(:)        = snow_beg(:)
+
+       RETURN
+
+    ENDIF
+    
+  !! 2. We calculate the required variables at the end of each time step 
+    
+    tot_watveg_end(:) = zero
+    tot_watsoil_end(:) = zero
+    snow_end(:) = zero
+    delintercept(:) = zero
+    delsoilmoist(:) = zero
+    delswe(:) = zero
+    
+    DO ji = 1, kjpindex
+       watveg = SUM(qsintveg(ji,:))
+       tot_watveg_end(ji) = watveg
+       tot_watsoil_end(ji) = mean_bqsb(ji) + mean_gqsb(ji)
+       snow_end(ji) = snow(ji)+ SUM(snow_nobio(ji,:))
+       !  
+       delintercept(ji) = tot_watveg_end(ji) - tot_watveg_beg(ji)
+       delsoilmoist(ji) = tot_watsoil_end(ji) - tot_watsoil_beg(ji)
+       delswe(ji)       = snow_end(ji) - snow_beg(ji)
+       !
+    ENDDO
+    
+  !! 3. Transfer the total water amount at the end of the current timestep to the begining of the next one.
+    
+    tot_watveg_beg = tot_watveg_end
+    tot_watsoil_beg = tot_watsoil_end
+    snow_beg(:) = snow_end(:)
+    
+  !! 4. We calculate the mean relative humidity of soil in the grid-cells
+    
+    DO ji = 1,kjpindex
+       soilwet(ji) = tot_watsoil_end(ji) / mx_eau_var(ji)
+    ENDDO
+    
+  END SUBROUTINE hydrolc_alma
+ 
+  
+!! ================================================================================================================================
+!! SUBROUTINE     : hydrolc_hdiff 
+!!
+!>\BRIEF          This subroutine performs horizontal diffusion of water between each PFT/soil column, 
+!! if the flag ok_hdiff is true. 
+!!
+!! DESCRIPTION    : The diffusion is realized on the water contents of both the top and bottom 
+!! soil layers, but the bottom soil layers share the same soil moisture since the end of hydrolc_soil (step 6).
+!! This subroutine thus only modifies the moisture of the top soil layer.
+!!  \latexonly
+!!  \input{hdiff.tex}
+!!  \endlatexonly
+!!
+!! RECENT CHANGE(S) : None
+!!      
+!! MAIN OUTPUT VARIABLE(S) : gqsb, bqsb, dsg, dss, dsp
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE hydrolc_hdiff(kjpindex, dtradia, veget, ruu_ch, gqsb, bqsb, dsg, dss, dsp)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                          :: kjpindex         !! Domain size  (number of grid cells) (unitless)
+    REAL(r_std), INTENT (in)                             :: dtradia          !! Time step duration (s)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)    :: veget            !! Grid-cell fraction effectively covered by 
+                                                                             !! vegetation for each PFT, except for soil 
+                                                                             !! (0-1, unitless) 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)        :: ruu_ch           !! Volumetric soil water capacity 
+                                                                             !! @tex ($kg m^{-3}$) @endtex
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: gqsb             !! Water content in the top layer 
+                                                                             !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: bqsb             !! Water content in the bottom layer 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: dsg              !! Depth of the top layer (m) 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: dss              !! Depth of dry soil at the top, whether in the top
+                                                                             !! or bottom layer (m)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: dsp              !! Depth of dry soil in the bottom layer plus depth
+                                                                             !! of top layer (m)
+    
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION (kjpindex)                    :: bqsb_mean        !! Mean value of bqsb in each grid-cell 
+                                                                             !! @tex ($kg m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex)                    :: gqsb_mean        !! Mean value of gqsb in each grid-cell 
+                                                                             !! @tex ($kg m^{-2}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex)                    :: dss_mean         !! Mean value of dss in each grid-cell (m)
+    REAL(r_std), DIMENSION (kjpindex)                    :: vegtot           !! Total fraction of grid-cell covered by PFTs (bare
+                                                                             !! soil + vegetation) (0-1, unitless) 
+                                                                             ! *** this variable is declared at the module level
+    REAL(r_std)                                          :: x                !! Coefficient of diffusion by time step 
+                                                                             !! (0-1, unitless)
+    INTEGER(i_std)                                       :: ji,jv            !! Indices for grid-cells and PFTs (unitless)
+    REAL(r_std), SAVE                                    :: tau_hdiff        !! Time scale for horizontal water diffusion (s) 
+!$OMP THREADPRIVATE(tau_hdiff)
+    LOGICAL, SAVE                                        :: firstcall=.TRUE. !! Flag to set tau_hdiff at the first time step 
+                                                                             !! ! *** why not define this parameter in 
+                                                                             !! constantes_soil.f90 ?
+!$OMP THREADPRIVATE(firstcall)
+!_ ================================================================================================================================
+
+  !! 1. First time step: we assign a value to the time scale for horizontal water diffusion (in seconds) 
+    
+    IF ( firstcall ) THEN
+
+      !Config Key   = HYDROL_TAU_HDIFF
+      !Config Desc  = time scale (s) for horizontal diffusion of water
+      !Config Def   = one_day
+      !Config If    = HYDROL_OK_HDIFF
+      !Config Help  = Defines how fast diffusion occurs horizontally between
+      !Config         the individual PFTs' water reservoirs. If infinite, no
+      !Config         diffusion.
+      !Config Units = [seconds]
+      tau_hdiff = one_day   ! 86400 s
+      CALL getin_p('HYDROL_TAU_HDIFF',tau_hdiff)
+
+      WRITE (numout,*) 'Hydrol: Horizontal diffusion, tau (s)=',tau_hdiff
+
+      firstcall = .FALSE.
+
+    ENDIF
+
+  !! 2. We calculate mean values of bqsb, gqsb and dss over the grid-cell ("bio" fraction).
+
+    ! Calculate mean values of bqsb, gqsb and dss over the grid-cell ("bio" fraction)
+    ! This could be done with SUM instruction but this kills vectorization
+    ! *** We compute here vegtot=SUM(veget), but it is already defined at a higher level (declared in the module) ***
+    bqsb_mean(:) = zero
+    gqsb_mean(:) = zero
+    dss_mean(:) = zero
+    vegtot(:) = zero
+    !
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+!MM veget(:,1) BUG ??!!!!!!!!!!!
+           IF (jv .EQ. 1) THEN
+              bqsb_mean(ji) = bqsb_mean(ji) + tot_bare_soil(ji)*bqsb(ji,jv)
+              gqsb_mean(ji) = gqsb_mean(ji) + tot_bare_soil(ji)*gqsb(ji,jv)
+              dss_mean(ji) = dss_mean(ji) + tot_bare_soil(ji)*dss(ji,jv)
+              vegtot(ji) = vegtot(ji) + tot_bare_soil(ji)
+           ELSE
+              bqsb_mean(ji) = bqsb_mean(ji) + veget(ji,jv)*bqsb(ji,jv)
+              gqsb_mean(ji) = gqsb_mean(ji) + veget(ji,jv)*gqsb(ji,jv)
+              dss_mean(ji) = dss_mean(ji) + veget(ji,jv)*dss(ji,jv)
+              vegtot(ji) = vegtot(ji) + veget(ji,jv)
+           ENDIF
+      ENDDO
+    ENDDO
+ 
+    DO ji = 1, kjpindex
+      IF (vegtot(ji) .GT. zero) THEN
+        bqsb_mean(ji) = bqsb_mean(ji)/vegtot(ji)
+        gqsb_mean(ji) = gqsb_mean(ji)/vegtot(ji)
+        dss_mean(ji) = dss_mean(ji)/vegtot(ji)
+      ENDIF
+    ENDDO
+
+  !! 3.  Relax PFT values towards grid-cell mean
+   
+    !! Relax values towards mean : the diffusion is proportional to the deviation to the mean,
+    !!  and inversely proportional to the timescale tau_hdiff
+    !!  We change the moisture of two soil layers, but also the depth of dry in the top soil layer. 
+    !!  Therefore, we need to accordingly adjust the top soil layer depth 
+    !!  and the dry soil depth above the bottom moisture (dsp).
+    ! *** This sequence does not seem to be fully consistent with the variable definitions, 
+    ! *** especially for the dry soil depths dss and dsp:
+    ! *** (i) is the "diffusion" of dss correct is some PFTs only have one soil layer (dss=dsp), 
+    ! *** given that hydrolc_soil acted to merge the bottom soil moistures bqsb
+    ! *** (ii) if gqsb is very small, we let the top layer vanish, but dss is not updated to dsp 
+    !
+    ! *** Also, it would be make much more sense to perform the diffusion in hydrolc_soil, when the 
+    ! *** bottom soil moistures are homogenized. It would benefit from the iterative consistency 
+    ! *** check between the dsg and dsp, and it would prevent from doing some calculations twice. 
+    ! *** Finally, it would be better to keep the water balance calculation for the real end of the 
+    ! *** hydrological processes.
+    !    
+    ! *** FORTUNATELY, the default value of ok_hdiff is false (hydrolc_init.f90)
+    x = MAX( zero, MIN( dtradia/tau_hdiff, un ) )
+    
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+
+        ! *** bqsb does not change as bqsb(ji,jv)=bqsb_mean(ji) since hydrolc_soil, step 6
+        bqsb(ji,jv) = (un-x) * bqsb(ji,jv) + x * bqsb_mean(ji) 
+        gqsb(ji,jv) = (un-x) * gqsb(ji,jv) + x * gqsb_mean(ji)
+
+        ! *** is it meaningful to apply the diffusion equation to dss ?
+        dss(ji,jv) = (un-x) * dss(ji,jv) + x * dss_mean(ji) 
+        
+        IF (gqsb(ji,jv) .LT. min_sechiba) THEN
+          dsg(ji,jv) = zero ! *** in this case, we should also set dss to dsp (defined below)
+        ELSE
+          dsg(ji,jv) = (dss(ji,jv) * ruu_ch(ji) + gqsb(ji,jv)) / ruu_ch(ji)
+        ENDIF
+        dsp(ji,jv) = dpu_max - bqsb(ji,jv) / ruu_ch(ji) ! no change here since bqsb does not change
+
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE hydrolc_hdiff
+  
+END MODULE hydrolc
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/intersurf.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/intersurf.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/intersurf.f90	(revision 5166)
@@ -0,0 +1,5811 @@
+!! This subroutine is the interface between the main program 
+!! (LMDZ or dim2_driver) and SECHIBA.
+!! - Input fields are gathered to keep just continental points
+!! - call sechiba_main That's SECHIBA process.
+!! - Output fields are scattered to complete global fields
+!!
+!! @call sechiba_main
+!! @Version : $Revision$, $Date$
+!!
+!! @author Marie-Alice Foujols and Jan Polcher
+!! 
+!< $HeadURL$
+!< $Date$
+!< $Author$
+!< $Revision$
+!! IPSL (2006)
+!!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!!
+!f90doc MODULEintersurf
+MODULE intersurf
+
+  USE IOIPSL
+  USE ioipsl_para 
+  USE defprec
+  USE sechiba
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE mod_orchidee_para
+  USE watchout
+  USE solar
+  USE grid
+  USE Orch_Write_field_p
+
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: Init_intersurf, intersurf_main,  intersurf_gathered, stom_define_history, stom_IPCC_define_history, intsurf_time
+
+
+  INTERFACE intersurf_main
+    MODULE PROCEDURE intersurf_main_2d, intersurf_main_1d, intersurf_gathered
+  END INTERFACE
+
+
+
+  !
+  !  Global variables
+  !
+  INTEGER(i_std),PARAMETER                           :: max_hist_level = 11
+  !
+  LOGICAL, SAVE                                     :: l_first_intersurf=.TRUE. !! Initialisation has to be done one time
+!$OMP THREADPRIVATE(l_first_intersurf)
+  !
+  INTEGER(i_std), SAVE                               :: hist_id, rest_id        !! IDs for history and restart files
+!$OMP THREADPRIVATE(hist_id, rest_id)
+  INTEGER(i_std), SAVE                               :: hist2_id                !! ID for the second history files (Hi-frequency ?)
+!$OMP THREADPRIVATE(hist2_id)
+  INTEGER(i_std), SAVE                               :: hist_id_stom, hist_id_stom_IPCC, rest_id_stom !! Dito for STOMATE
+!$OMP THREADPRIVATE(hist_id_stom, hist_id_stom_IPCC, rest_id_stom)
+  REAL(r_std), SAVE                                  :: dw                      !! frequency of history write (sec.)
+!$OMP THREADPRIVATE(dw)
+  !
+  INTEGER(i_std), SAVE                               :: itau_offset  !! This offset is used to phase the 
+  !                                                                 !! calendar of the GCM or the driver.
+!$OMP THREADPRIVATE(itau_offset)
+  REAL(r_std), SAVE                                  :: date0_shifted
+!$OMP THREADPRIVATE(date0_shifted)
+  !
+  TYPE(control_type), SAVE                          :: control_flags !! Flags that (de)activate parts of the model
+!$OMP THREADPRIVATE(control_flags)
+  !
+  !
+  !! first day of this year
+  REAL(r_std), SAVE :: julian0
+!$OMP THREADPRIVATE(julian0)
+  !
+  LOGICAL, PARAMETER :: check_INPUTS = .false.         !! (very) long print of INPUTs in intersurf 
+  LOGICAL, SAVE :: check_time = .FALSE.
+!$OMP THREADPRIVATE(check_time)
+  LOGICAL, SAVE :: impose_param = .TRUE.  !! Flag impos_param : should we read all the parameters in the run.def file ?
+!$OMP THREADPRIVATE(impose_param)
+  !
+  PUBLIC check_time, l_first_intersurf, impose_param
+  !
+CONTAINS
+  !
+  !f90doc CONTAINS
+  ! 
+
+  SUBROUTINE intersurf_main_2d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
+     & lrestart_read, lrestart_write, lon, lat, zcontfrac, zneighbours, zresolution, date0, &
+! First level conditions
+     & zlev, u, v, qair, temp_air, epot_air, ccanopy, &
+! Variables for the implicit coupling
+     & cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+! Rain, snow, radiation and surface pressure
+     & precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+! Output : Fluxes
+     & vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
+! Surface temperatures and surface properties
+     & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, &
+! For VOC  radiation  
+     & sinang,soil_mc,litter_mc)
+    ! routines called : sechiba_main
+    !
+    IMPLICIT NONE
+    !    
+    ! interface description for dummy arguments
+    ! input scalar 
+    INTEGER(i_std),INTENT (in)                            :: kjit            !! Time step number
+    INTEGER(i_std),INTENT (in)                            :: iim, jjm        !! Dimension of input fields
+    INTEGER(i_std),INTENT (in)                            :: kjpindex        !! Number of continental points
+    REAL(r_std),INTENT (in)                               :: xrdt            !! Time step in seconds
+    LOGICAL, INTENT (in)                                 :: lrestart_read    !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                 :: lrestart_write   !! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                              :: date0           !! Date at which kjit = 0
+    ! input fields
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: kindex          !! Index for continental points
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: u             !! Lowest level wind speed
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: v             !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: zlev          !! Height of first layer
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: qair          !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: precip_rain   !! Rain precipitation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: precip_snow   !! Snow precipitation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: lwdown        !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: swnet         !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: swdown        !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: sinang        !!
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: temp_air      !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: epot_air      !! Air potential energy
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: ccanopy       !! CO2 concentration in the canopy
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: petAcoef      !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: peqAcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: petBcoef      !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: peqBcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(inout)          :: cdrag         !! Cdrag
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: pb            !! Lowest level pressure
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: lon, lat      !! Geographical coordinates
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in)             :: zcontfrac     !! Fraction of continent in the grid
+    INTEGER, DIMENSION (iim,jjm,8), INTENT(in)              :: zneighbours   !! land neighbours
+    REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in)           :: zresolution   !! resolution in x and y dimensions
+    ! output fields
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: z0            !! Surface roughness
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: coastalflow   !! Diffuse flow of water into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: riverflow     !! Largest rivers flowing into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: tsol_rad      !! Radiative surface temperature
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: vevapp        !! Total of evaporation
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: temp_sol_new  !! New soil temperature
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: qsurf         !! Surface specific humidity
+    REAL(r_std),DIMENSION (iim,jjm,2), INTENT(out)          :: albedo        !! Albedo
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: fluxsens      !! Sensible chaleur flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: fluxlat       !! Latent chaleur flux
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(out)            :: emis          !! Emissivity
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(out) :: soil_mc       !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out)      :: litter_mc     !! litter moisture content \f($m^3 \times m^3$)\f
+
+    ! LOCAL declaration
+    ! work arrays to scatter and/or gather information just before/after sechiba_main call's
+    ! and to keep output value for next call
+    REAL(r_std),DIMENSION (kjpindex)                      :: zu            !! Work array to keep u
+    REAL(r_std),DIMENSION (kjpindex)                      :: zv            !! Work array to keep v
+    REAL(r_std),DIMENSION (kjpindex)                      :: zzlev         !! Work array to keep zlev
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqair         !! Work array to keep qair
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_rain  !! Work array to keep precip_rain
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_snow  !! Work array to keep precip_snow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zlwdown       !! Work array to keep lwdown
+    REAL(r_std),DIMENSION (kjpindex)                      :: zswnet        !! Work array to keep swnet
+    REAL(r_std),DIMENSION (kjpindex)                      :: zswdown       !! Work array to keep swdown
+    REAL(r_std),DIMENSION (kjpindex)                      :: zsinang       !! Work array to keep sinang
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_air     !! Work array to keep temp_air
+    REAL(r_std),DIMENSION (kjpindex)                      :: zepot_air     !! Work array to keep epot_air
+    REAL(r_std),DIMENSION (kjpindex)                      :: zccanopy      !! Work array to keep ccanopy
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpetAcoef     !! Work array to keep petAcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpeqAcoef     !! Work array to keep peqAcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpetBcoef     !! Work array to keep petBcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpeqBcoef     !! Work array to keep peqVcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcdrag        !! Work array to keep cdrag
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpb           !! Work array to keep pb
+    REAL(r_std),DIMENSION (kjpindex)                      :: zz0           !! Work array to keep z0
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoastal      !! Work array to keep coastalflow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep riverflow
+    REAL(r_std),DIMENSION (kjpindex)                      :: dcoastal      !! Work array to keep coastalflow
+    REAL(r_std),DIMENSION (kjpindex)                      :: driver        !! Work array to keep riverflow
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    !
+    INTEGER(i_std)                                       :: i, j, ik
+    INTEGER(i_std)                                       :: itau_sechiba
+    REAL(r_std)                                          :: zlev_mean
+    LOGICAL                                              :: do_watch      !! if it's time, write watchout
+    INTEGER                                              :: old_fileout   !! old Logical Int for std IO output
+    LOGICAL :: check = .FALSE.
+    !
+    CALL ipslnlf(new_number=numout,old_number=old_fileout)
+    !
+    IF (l_first_intersurf) THEN
+       !
+       CALL intsurf_time( kjit, date0, xrdt )
+       !
+       IF ( check ) WRITE(numout,*) 'Initialisation of intersurf_main_2d'
+       !
+       OFF_LINE_MODE = .TRUE. 
+       !
+       DO ik=1,kjpindex
+          
+          j = ((kindex(ik)-1)/iim) + 1
+          i = (kindex(ik) - (j-1)*iim)
+
+          !- Create the internal coordinate table
+          !-
+          lalo(ik,1) = lat(i,j)
+          lalo(ik,2) = lon(i,j)
+          !
+          !- Store the fraction of the continents only once so that the user
+          !- does not change them afterwards.
+          !-
+          contfrac(ik) = zcontfrac(i,j)
+       ENDDO
+       CALL gather(contfrac,contfrac_g)
+       CALL gather(lalo,lalo_g)
+       CALL gather2D_mpi(lon,lon_g)
+       CALL gather2D_mpi(lat,lat_g)
+       CALL gather2D_mpi(zlev,zlev_g)
+       !
+       !  Configuration of SSL specific parameters
+       !
+       CALL intsurf_config(control_flags, xrdt)
+       !
+       CALL intsurf_restart(kjit, iim, jjm, lon, lat, date0, xrdt, control_flags, rest_id, rest_id_stom, itau_offset)
+       itau_sechiba = kjit + itau_offset
+       !
+       CALL intsurf_history(iim, jjm, lon, lat, itau_sechiba, date0_shifted, xrdt, control_flags, hist_id, &
+            & hist2_id, hist_id_stom, hist_id_stom_IPCC)
+       !
+       IF ( ok_watchout ) THEN
+          IF (is_root_prc) THEN
+             zlev_mean = zero
+             DO ik=1, nbp_glo
+                j = ((index_g(ik)-1)/iim_g) + 1
+                i = (index_g(ik) - (j-1)*iim_g)
+       
+                zlev_mean = zlev_mean + zlev_g(i,j)
+             ENDDO
+             zlev_mean = zlev_mean / REAL(nbp_glo,r_std)
+          ENDIF
+
+          last_action_watch = itau_sechiba
+          last_check_watch  = last_action_watch
+
+          ! Only root proc write watchout file
+          CALL watchout_init (iim_g, jjm_g, kjpindex, nbp_glo, &
+               & date0_shifted, last_action_watch, dt_watch, index_g, lon_g, lat_g, zlev_mean)
+       ENDIF
+       !
+       IF ( check ) WRITE(numout,*) 'End of Initialisation of intersurf'
+       !
+    ENDIF
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    !
+    CALL intsurf_time( itau_sechiba, date0_shifted, xrdt )
+    !
+    ! 1. gather input fields from kindex array
+    !    Warning : I'm not sure this interface with one dimension array is the good one
+    !
+    DO ik=1, kjpindex
+      
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+       
+       zu(ik)           = u(i,j)
+       zv(ik)           = v(i,j)
+       zzlev(ik)        = zlev(i,j)
+       zqair(ik)        = qair(i,j)
+       zprecip_rain(ik) = precip_rain(i,j)*xrdt
+       zprecip_snow(ik) = precip_snow(i,j)*xrdt
+       zlwdown(ik)      = lwdown(i,j)
+       zswnet(ik)       = swnet(i,j)
+       zswdown(ik)      = swdown(i,j)
+       zsinang(ik)      = sinang(i,j)
+       ztemp_air(ik)    = temp_air(i,j)
+       zepot_air(ik)    = epot_air(i,j)
+       zccanopy(ik)     = ccanopy(i,j)
+       zpetAcoef(ik)    = petAcoef(i,j)
+       zpeqAcoef(ik)    = peqAcoef(i,j)
+       zpetBcoef(ik)    = petBcoef(i,j)
+       zpeqBcoef(ik)    = peqBcoef(i,j)
+       zcdrag(ik)       = cdrag(i,j)
+       zpb(ik)          = pb(i,j)
+       
+    ENDDO
+    !
+    IF (check_INPUTS) THEN
+       WRITE(numout,*) "Intersurf_main_2D :"
+       WRITE(numout,*) "Time step number = ",kjit
+       WRITE(numout,*) "Dimension of input fields = ",iim, jjm
+       WRITE(numout,*) "Number of continental points = ",kjpindex
+       WRITE(numout,*) "Time step in seconds = ",xrdt
+       WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
+       WRITE(numout,*) "Date at which kjit = 0  =  ",date0
+       WRITE(numout,*) "Index for continental points = ",kindex
+       WRITE(numout,*) "Lowest level wind speed North = ",zu
+       WRITE(numout,*) "Lowest level wind speed East = ",zv
+       WRITE(numout,*) "Height of first layer = ",zzlev
+       WRITE(numout,*) "Lowest level specific humidity = ",zqair
+       WRITE(numout,*) "Rain precipitation = ",zprecip_rain
+       WRITE(numout,*) "Snow precipitation = ",zprecip_snow
+       WRITE(numout,*) "Down-welling long-wave flux = ",zlwdown
+       WRITE(numout,*) "Net surface short-wave flux = ",zswnet
+       WRITE(numout,*) "Downwelling surface short-wave flux = ",zswdown
+       WRITE(numout,*) "Air temperature in Kelvin = ",ztemp_air
+       WRITE(numout,*) "Air potential energy = ",zepot_air
+       WRITE(numout,*) "CO2 concentration in the canopy = ",zccanopy
+       WRITE(numout,*) "Coeficients A from the PBL resolution = ",zpetAcoef
+       WRITE(numout,*) "One for T and another for q = ",zpeqAcoef
+       WRITE(numout,*) "Coeficients B from the PBL resolution = ",zpetBcoef
+       WRITE(numout,*) "One for T and another for q = ",zpeqBcoef
+       WRITE(numout,*) "Cdrag = ",zcdrag
+       WRITE(numout,*) "Lowest level pressure = ",zpb
+       WRITE(numout,*) "Geographical coordinates lon = ", (/ ( lon(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /)
+       WRITE(numout,*) "Geographical coordinates lat = ", (/ ( lat(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /) 
+       WRITE(numout,*) "Fraction of continent in the grid = ",contfrac
+    ENDIF
+    !
+    ! 2. save the grid
+    !
+    IF ( check ) WRITE(numout,*) 'Save the grid'
+    !
+    IF (l_first_intersurf) THEN
+       IF ( hist_id > 0 ) THEN
+          CALL histwrite(hist_id, 'LandPoints',  itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
+          CALL histwrite(hist_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+       END IF
+       IF ( control_flags%ok_stomate ) THEN
+          IF ( hist_id_stom > 0 ) THEN
+             CALL histwrite(hist_id_stom, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          END IF
+          IF ( hist_id_stom_IPCC > 0 ) THEN
+             CALL histwrite(hist_id_stom_IPCC, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          ENDIF
+       ENDIF
+
+       IF ( hist_id > 0 ) THEN
+          CALL histwrite(hist_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+          CALL histsync(hist_id)
+       END IF
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite(hist2_id, 'LandPoints',  itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
+          CALL histwrite(hist2_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          CALL histwrite(hist2_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+          CALL histsync(hist2_id)
+       ENDIF
+       !
+    ENDIF
+    !
+    ! 3. call sechiba for continental points only
+    !
+    IF ( check ) WRITE(numout,*) 'Calling sechiba'
+    !
+    CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, xrdt, date0_shifted, &
+       & lrestart_read, lrestart_write, control_flags, &
+       & lalo, contfrac, neighbours, resolution, &
+! First level conditions
+! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul rveget
+!       & zzlev, zu, zv, zqair, ztemp_air, zepot_air, zccanopy, &
+       & zzlev, zu, zv, zqair, zqair, ztemp_air, ztemp_air, zepot_air, zccanopy, &
+! Variables for the implicit coupling
+       & zcdrag, zpetAcoef, zpeqAcoef, zpetBcoef, zpeqBcoef, &
+! Rain, snow, radiation and surface pressure
+       & zprecip_rain ,zprecip_snow,  zlwdown, zswnet, zswdown, zsinang, zpb, &
+! Output : Fluxes
+       & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
+! Surface temperatures and surface properties
+       & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, &
+! File ids
+       & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC,soil_mc,litter_mc ) 
+    
+    !
+    IF ( check ) WRITE(numout,*) 'out of SECHIBA'
+    !
+    ! 4. save watchout
+    !
+    IF ( ok_watchout .AND. .NOT. l_first_intersurf ) THEN
+       ! Accumulate last time step
+       sum_zlev(:) = sum_zlev(:) + zzlev(:)
+       sum_u(:) = sum_u(:) + zu(:)
+       sum_v(:) = sum_v(:) + zv(:)
+       sum_qair(:) = sum_qair(:) + zqair(:) 
+       sum_temp_air(:) = sum_temp_air(:) + ztemp_air(:)
+       sum_epot_air(:) = sum_epot_air(:) + zepot_air(:)
+       sum_ccanopy(:) = sum_ccanopy(:) + zccanopy(:)
+       sum_cdrag(:) = sum_cdrag(:) + zcdrag(:)
+       sum_petAcoef(:) = sum_petAcoef(:) + zpetAcoef(:)
+       sum_peqAcoef(:) = sum_peqAcoef(:) + zpeqAcoef(:)
+       sum_petBcoef(:) = sum_petBcoef(:) + zpetBcoef(:)
+       sum_peqBcoef(:) = sum_peqBcoef(:) + zpeqBcoef(:)
+       sum_rain(:) = sum_rain(:) + zprecip_rain(:)
+       sum_snow(:) = sum_snow(:) + zprecip_snow(:)
+       sum_lwdown(:) = sum_lwdown(:) + zlwdown(:)
+       sum_pb(:) = sum_pb(:) + zpb(:)
+
+!!$       IF ( dt_watch > 3600 ) THEN
+!!$          julian_watch = date0_shifted+((itau_sechiba-0.5)/dt_split_watch)*dt_watch/one_day
+!!$          WRITE(numout, *) "WATCH register : julian_watch ",julian_watch, " julian0",julian0,"date0_shifted ",date0_shifted, &
+!!$               "itau_sechiba ",itau_sechiba, &
+!!$               dt_split_watch,dt_watch,one_day
+!!$          CALL solarang (julian_watch, julian0, iim, jjm, lon, lat, sinang)
+!!$          WHERE ( sinang(:,:) .LT. EPSILON(un) ) 
+!!$             isinang(:,:) = isinang(:,:) - 1
+!!$          ENDWHERE
+!!$          mean_sinang(:,:) = mean_sinang(:,:)+sinang(:,:)
+!!$          WRITE(numout, *) "WATCH sinang : ",sinang, mean_sinang
+!!$          WRITE(numout,*) "sum_swdown",sum_swdown
+!!$          !
+!!$          DO ik=1,kjpindex          
+!!$             j = ((kindex(ik)-1)/iim) + 1
+!!$             i = (kindex(ik) - (j-1)*iim)
+!!$             
+!!$             sum_swnet(ik) = sum_swnet(ik) + sinang(i,j)*zswnet(ik)
+!!$             sum_swdown(ik) = sum_swdown(ik) + sinang(i,j)*zswdown(ik)
+!!$          ENDDO
+!!$       ELSE
+          sum_swnet(:) = sum_swnet(:) + zswnet(:)
+          sum_swdown(:) = sum_swdown(:) + zswdown(:)
+!!$       ENDIF
+
+       do_watch = .FALSE.
+       call isittime &
+            &  (itau_sechiba,date0_shifted,xrdt,dt_watch,&
+            &   last_action_watch,last_check_watch,do_watch)
+       last_check_watch = itau_sechiba
+       IF (do_watch) THEN
+          !
+          IF ( check ) WRITE(numout,*) 'save watchout'
+          !
+          IF (long_print) THEN
+             WRITE(numout,*) "intersurf : write watchout for date ",date0,date0_shifted,itau_sechiba,&
+                  & last_action_watch, last_check_watch
+          ENDIF
+          last_action_watch = itau_sechiba
+
+          sum_zlev(:) = sum_zlev(:) / dt_split_watch
+          sum_u(:) = sum_u(:) / dt_split_watch
+          sum_v(:) = sum_v(:) / dt_split_watch
+          sum_qair(:) = sum_qair(:) / dt_split_watch
+          sum_temp_air(:) = sum_temp_air(:) / dt_split_watch
+          sum_epot_air(:) = sum_epot_air(:) / dt_split_watch
+          sum_ccanopy(:) = sum_ccanopy(:) / dt_split_watch
+          sum_cdrag(:) = sum_cdrag(:) / dt_split_watch
+          sum_petAcoef(:) = sum_petAcoef(:) / dt_split_watch
+          sum_peqAcoef(:) = sum_peqAcoef(:) / dt_split_watch
+          sum_petBcoef(:) = sum_petBcoef(:) / dt_split_watch
+          sum_peqBcoef(:) = sum_peqBcoef(:) / dt_split_watch
+          sum_rain(:) = sum_rain(:) / dt_split_watch
+          sum_snow(:) = sum_snow(:) / dt_split_watch
+          sum_lwdown(:) = sum_lwdown(:) / dt_split_watch
+          sum_pb(:) = sum_pb(:) / dt_split_watch
+
+!!$          IF ( dt_watch > 3600 ) THEN 
+!!$             WRITE(numout, *) "WATCH mean_sinang before norm : ",mean_sinang,isinang
+!!$             WHERE ( isinang(:,:) .LT. dt_split_watch )
+!!$                mean_sinang(:,:) = mean_sinang(:,:) / isinang(:,:)
+!!$             ENDWHERE
+!!$             WRITE(numout, *) "WATCH mean_sinang norm : ",mean_sinang
+!!$             WRITE(numout,*) "SWDOWN 0 : ",sum_swdown(:)
+!!$             !
+!!$             DO ik=1,kjpindex          
+!!$                j = ((kindex(ik)-1)/iim) + 1
+!!$                i = (kindex(ik) - (j-1)*iim)
+!!$                IF (mean_sinang(i,j) > zero) THEN
+!!$                   sum_swdown(ik) = sum_swdown(ik)/mean_sinang(i,j)
+!!$                   sum_swnet(ik) =  sum_swnet(ik)/mean_sinang(i,j)
+!!$                ELSE
+!!$                   sum_swdown(ik) = zero
+!!$                   sum_swnet(ik) =  zero
+!!$                ENDIF
+!!$             ENDDO
+!!$          ELSE
+             sum_swnet(:) = sum_swnet(:) / dt_split_watch
+             sum_swdown(:) = sum_swdown(:) / dt_split_watch
+!!$          ENDIF
+
+          CALL watchout_write_p(kjpindex, itau_sechiba, xrdt, sum_zlev, sum_swdown, sum_rain, &
+               &   sum_snow, sum_lwdown, sum_pb, sum_temp_air, sum_epot_air, sum_qair, &
+               &   sum_u, sum_v, sum_swnet, sum_petAcoef, sum_peqAcoef, sum_petBcoef, sum_peqBcoef, &
+               &   sum_cdrag, sum_ccanopy )
+       ENDIF
+    ENDIF
+    !
+    ! 5. scatter output fields
+    !
+    z0(:,:)           = undef_sechiba
+    coastalflow(:,:)  = undef_sechiba
+    riverflow(:,:)    = undef_sechiba
+    tsol_rad(:,:)     = undef_sechiba
+    vevapp(:,:)       = undef_sechiba
+    temp_sol_new(:,:) = undef_sechiba 
+    qsurf(:,:)        = undef_sechiba 
+    albedo(:,:,:)     = undef_sechiba
+    fluxsens(:,:)     = undef_sechiba
+    fluxlat(:,:)      = undef_sechiba
+    emis(:,:)         = undef_sechiba 
+    cdrag(:,:)        = undef_sechiba 
+    !
+    DO ik=1, kjpindex
+      
+    
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+
+       z0(i,j)           = zz0(ik)
+       coastalflow(i,j)  = zcoastal(ik)/mille
+       riverflow(i,j)    = zriver(ik)/mille
+       tsol_rad(i,j)     = ztsol_rad(ik)
+       vevapp(i,j)       = zvevapp(ik)
+       temp_sol_new(i,j) = ztemp_sol_new(ik)
+       qsurf(i,j)        = zqsurf(ik)
+       albedo(i,j,1)     = zalbedo(ik,1)
+       albedo(i,j,2)     = zalbedo(ik,2)
+       fluxsens(i,j)     = zfluxsens(ik)
+       fluxlat(i,j)      = zfluxlat(ik)
+       emis(i,j)         = zemis(ik)
+       cdrag(i,j)        = zcdrag(ik)
+
+    ENDDO
+    !
+    ! Modified fields for variables scattered during the writing
+    !
+    dcoastal(:) = (zcoastal(:))/mille     
+    driver(:)   = (zriver(:))/mille
+    !
+    IF ( .NOT. l_first_intersurf) THEN
+       !
+       IF ( .NOT. almaoutput ) THEN
+       !
+       !  scattered during the writing
+       !
+          IF ( hist_id > 0 ) THEN
+             CALL histwrite (hist_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite (hist_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
+             CALL histwrite (hist_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
+             CALL histwrite (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+             CALL histwrite (hist_id, 'fluxlat',  itau_sechiba, zfluxlat, kjpindex, kindex)
+             CALL histwrite (hist_id, 'swnet',    itau_sechiba, zswnet, kjpindex, kindex)
+             CALL histwrite (hist_id, 'swdown',   itau_sechiba, zswdown, kjpindex, kindex)
+             CALL histwrite (hist_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+             CALL histwrite (hist_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+             CALL histwrite (hist_id, 'tair',     itau_sechiba, ztemp_air, kjpindex, kindex)
+             CALL histwrite (hist_id, 'qair',     itau_sechiba, zqair, kjpindex, kindex)
+             ! Ajout Nathalie - Juin 2006 - on conserve q2m/t2m
+             CALL histwrite (hist_id, 'q2m',     itau_sechiba, zqair, kjpindex, kindex)
+             CALL histwrite (hist_id, 't2m',     itau_sechiba, ztemp_air, kjpindex, kindex)
+          END IF ! IF ( hist_id > 0 )
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite (hist2_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'fluxlat',  itau_sechiba, zfluxlat, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'swnet',    itau_sechiba, zswnet, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'swdown',   itau_sechiba, zswdown, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+             CALL histwrite (hist2_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+             CALL histwrite (hist2_id, 'tair',     itau_sechiba, ztemp_air, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'qair',     itau_sechiba, zqair, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'q2m',     itau_sechiba, zqair, kjpindex, kindex)
+             CALL histwrite (hist2_id, 't2m',     itau_sechiba, ztemp_air, kjpindex, kindex)
+          ENDIF
+       ELSE
+          IF ( hist_id > 0 ) THEN
+             CALL histwrite (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite (hist_id, 'SWnet',    itau_sechiba, zswnet, kjpindex, kindex)
+             CALL histwrite (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+             CALL histwrite (hist_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+             CALL histwrite (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist_id, 'Tair', itau_sechiba, ztemp_air, kjpindex, kindex)
+             CALL histwrite (hist_id, 'Qair', itau_sechiba, zqair, kjpindex, kindex)
+          END IF
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'SWnet',    itau_sechiba, zswnet, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+          ENDIF
+       ENDIF
+       !
+       IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
+          CALL histsync(hist_id)
+       ENDIF
+       !
+    ENDIF
+    !
+    ! 6. Transform the water fluxes into Kg/m^2s and m^3/s
+    !
+    DO ik=1, kjpindex
+    
+       j = ((kindex(ik)-1)/iim) + 1
+       i = (kindex(ik) - (j-1)*iim)
+
+       vevapp(i,j) = vevapp(i,j)/xrdt
+       coastalflow(i,j) = coastalflow(i,j)/xrdt
+       riverflow(i,j) = riverflow(i,j)/xrdt
+
+    ENDDO
+    !
+    IF ( lrestart_write .AND. ok_watchout .AND. is_root_prc ) THEN
+       CALL watchout_close()
+    ENDIF
+    !
+    ! Uncomment those lines to test all parallel getin in developments
+!    IF(l_first_intersurf) THEN
+!       CALL ipsldbg (new_status=.TRUE.)
+!       CALL getin_dump_para("test",mpi_rank) 
+!       CALL ipsldbg (new_status=.FALSE.)
+!    ENDIF
+    IF(l_first_intersurf .AND. is_root_prc) CALL getin_dump
+    l_first_intersurf = .FALSE.
+    !
+    IF (long_print) WRITE (numout,*) ' intersurf_main done '
+    !
+    CALL ipslnlf(new_number=old_fileout)
+    !
+  END SUBROUTINE intersurf_main_2d
+!
+  SUBROUTINE intersurf_main_1d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
+     & lrestart_read, lrestart_write, lon, lat, zcontfrac, zneighbours, zresolution, date0, &
+! First level conditions
+     & zlev,  u, v, qair, temp_air, epot_air, ccanopy, &
+! Variables for the implicit coupling
+     & cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+! Rain, snow, radiation and surface pressure
+     & precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+! Output : Fluxes
+     & vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
+! Surface temperatures and surface properties
+     & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, &
+! For VOC  radiation  
+    & sinang,soil_mc,litter_mc)    
+    ! routines called : sechiba_main
+    !
+    IMPLICIT NONE
+    !    
+    ! interface description for dummy arguments
+    ! input scalar 
+    INTEGER(i_std),INTENT (in)                            :: kjit          !! Time step number
+    INTEGER(i_std),INTENT (in)                            :: iim, jjm      !! Dimension of input fields
+    INTEGER(i_std),INTENT (in)                            :: kjpindex      !! Number of continental points
+    REAL(r_std),INTENT (in)                               :: xrdt          !! Time step in seconds
+    LOGICAL, INTENT (in)                                 :: lrestart_read !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                 :: lrestart_write!! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                              :: date0         !! Date at which kjit = 0
+    ! input fields
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: kindex        !! Index for continental points
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: u             !! Lowest level wind speed
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: v             !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: zlev          !! Height of first layer
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: qair          !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: precip_rain   !! Rain precipitation
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: precip_snow   !! Snow precipitation
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: lwdown        !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: swnet         !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: swdown        !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: sinang        !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: temp_air      !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: epot_air      !! Air potential energy
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: ccanopy       !! CO2 concentration in the canopy
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: petAcoef      !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: peqAcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: petBcoef      !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: peqBcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(inout)          :: cdrag         !! Cdrag
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: pb            !! Lowest level pressure
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: lon, lat      !! Geographical coordinates
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(in)             :: zcontfrac     !! Fraction of continent
+    INTEGER, DIMENSION (iim*jjm,8), INTENT(in)             :: zneighbours   !! land neighbours
+    REAL(r_std),DIMENSION (iim*jjm,2), INTENT(in)           :: zresolution   !! resolution in x and y dimensions
+    ! output fields
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(out)            :: z0            !! Surface roughness
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(out)            :: coastalflow   !! Diffuse flow of water into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(out)            :: riverflow     !! Largest rivers flowing into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(out)            :: tsol_rad      !! Radiative surface temperature
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(out)            :: vevapp        !! Total of evaporation
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(out)            :: temp_sol_new  !! New soil temperature
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(out)            :: qsurf         !! Surface specific humidity
+    REAL(r_std),DIMENSION (iim*jjm,2), INTENT(out)          :: albedo        !! Albedo
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(out)            :: fluxsens      !! Sensible chaleur flux
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(out)            :: fluxlat       !! Latent chaleur flux
+    REAL(r_std),DIMENSION (iim*jjm), INTENT(out)            :: emis          !! Emissivity
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(out) :: soil_mc       !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out)      :: litter_mc     !! litter moisture content \f($m^3 \times m^3$)\f
+
+    ! LOCAL declaration
+    ! work arrays to scatter and/or gather information just before/after sechiba_main call's
+    ! and to keep output value for next call
+    REAL(r_std),DIMENSION (kjpindex)                      :: zu            !! Work array to keep u
+    REAL(r_std),DIMENSION (kjpindex)                      :: zv            !! Work array to keep v
+    REAL(r_std),DIMENSION (kjpindex)                      :: zzlev         !! Work array to keep zlev
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqair         !! Work array to keep qair
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_rain  !! Work array to keep precip_rain
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_snow  !! Work array to keep precip_snow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zlwdown       !! Work array to keep lwdown
+    REAL(r_std),DIMENSION (kjpindex)                      :: zswnet        !! Work array to keep swnet
+    REAL(r_std),DIMENSION (kjpindex)                      :: zswdown       !! Work array to keep swdown
+    REAL(r_std),DIMENSION (kjpindex)                      :: zsinang       !! Work array to keep sinang
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_air     !! Work array to keep temp_air
+    REAL(r_std),DIMENSION (kjpindex)                      :: zepot_air     !! Work array to keep epot_air
+    REAL(r_std),DIMENSION (kjpindex)                      :: zccanopy      !! Work array to keep ccanopy
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpetAcoef     !! Work array to keep petAcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpeqAcoef     !! Work array to keep peqAcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpetBcoef     !! Work array to keep petBcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpeqBcoef     !! Work array to keep peqVcoef
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcdrag        !! Work array to keep cdrag
+    REAL(r_std),DIMENSION (kjpindex)                      :: zpb           !! Work array to keep pb
+    REAL(r_std),DIMENSION (kjpindex)                      :: zz0           !! Work array to keep z0
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoastal      !! Work array to keep coastal flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep river out flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: dcoastal      !! Work array to keep coastal flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: driver        !! Work array to keep river out flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    !
+    INTEGER(i_std)                                        :: i, j, ik
+    INTEGER(i_std)                                        :: itau_sechiba
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)              :: tmp_lon, tmp_lat, tmp_lev
+    REAL(r_std)                                           :: zlev_mean
+    LOGICAL                                               :: do_watch      !! if it's time, write watchout
+    INTEGER                                               :: old_fileout   !! old Logical Int for std IO output
+    LOGICAL :: check = .FALSE.
+    !
+    CALL ipslnlf(new_number=numout,old_number=old_fileout)
+    !
+    IF (l_first_intersurf) THEN
+       !
+       CALL intsurf_time( kjit, date0, xrdt )
+       !
+       IF ( check ) WRITE(numout,*) 'Initialisation of intersurf_main_1d'
+       !
+       OFF_LINE_MODE = .TRUE. 
+       !
+       !  Create the internal coordinate table
+       !
+       IF ( (.NOT.ALLOCATED(tmp_lon))) THEN
+          ALLOCATE(tmp_lon(iim,jjm))
+       ENDIF
+       IF ( (.NOT.ALLOCATED(tmp_lat))) THEN
+          ALLOCATE(tmp_lat(iim,jjm))
+       ENDIF
+       IF ( (.NOT.ALLOCATED(tmp_lev))) THEN
+          ALLOCATE(tmp_lev(iim,jjm))
+       ENDIF
+       !
+       DO i=1,iim
+          DO j=1,jjm
+             ik = (j-1)*iim + i
+             tmp_lon(i,j) = lon(ik)
+             tmp_lat(i,j) = lat(ik)
+             tmp_lev(i,j) = zlev(kindex(ik)) 
+          ENDDO
+       ENDDO
+       !
+       lalo(:,1) = lat(:)
+       lalo(:,2) = lon(:)
+       !
+       !- Store the fraction of the continents only once so that the user
+       !- does not change them afterwards.
+       !
+       DO ik=1,kjpindex
+
+          contfrac(ik) = zcontfrac(kindex(ik))
+
+       ENDDO
+       contfrac_g(:) = contfrac(:)
+       lalo_g(:,:) = lalo(:,:)
+       lon_g(:,:) = tmp_lon(:,:)
+       lat_g(:,:) = tmp_lat(:,:)
+       zlev_g(:,:) = tmp_lev(:,:)
+       !
+       !  Configuration of SSL specific parameters
+       !
+       CALL intsurf_config(control_flags, xrdt)
+       !
+       CALL intsurf_restart(kjit, iim, jjm, tmp_lon, tmp_lat, date0, xrdt, control_flags, rest_id, rest_id_stom, itau_offset)
+       itau_sechiba = kjit + itau_offset
+       !
+       CALL intsurf_history(iim, jjm, tmp_lon, tmp_lat, itau_sechiba, date0_shifted, xrdt, control_flags, hist_id, &
+            & hist2_id, hist_id_stom, hist_id_stom_IPCC)
+       !
+       IF ( ok_watchout ) THEN
+          zlev_mean = zero
+          DO ik=1, kjpindex
+
+             zlev_mean = zlev_mean + zlev(ik)
+          ENDDO
+          ! Divide by one
+          zlev_mean = zlev_mean / REAL(kjpindex,r_std)
+
+          last_action_watch = itau_sechiba
+          last_check_watch  = last_action_watch
+
+          CALL watchout_init(iim, jjm, kjpindex, kjpindex, &
+               & date0_shifted, last_action_watch, dt_watch, index_g, lon_g, lat_g, zlev_mean)
+       ENDIF
+       !
+       IF ( check ) WRITE(numout,*) 'End of Initialisation of intersurf'
+       !
+    ENDIF
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    !
+    CALL intsurf_time( itau_sechiba, date0_shifted, xrdt )
+    !
+    ! 1. gather input fields from kindex array
+    !
+    DO ik=1, kjpindex
+       
+       zu(ik)           = u(kindex(ik))
+       zv(ik)           = v(kindex(ik))
+       zzlev(ik)        = zlev(kindex(ik))
+       zqair(ik)        = qair(kindex(ik))
+       zprecip_rain(ik) = precip_rain(kindex(ik))*xrdt
+       zprecip_snow(ik) = precip_snow(kindex(ik))*xrdt
+       zlwdown(ik)      = lwdown(kindex(ik))
+       zswnet(ik)       = swnet(kindex(ik))
+       zswdown(ik)      = swdown(kindex(ik))
+       zsinang(ik)      = sinang(kindex(ik))
+       ztemp_air(ik)    = temp_air(kindex(ik))
+       zepot_air(ik)    = epot_air(kindex(ik))
+       zccanopy(ik)     = ccanopy(kindex(ik))
+       zpetAcoef(ik)    = petAcoef(kindex(ik))
+       zpeqAcoef(ik)    = peqAcoef(kindex(ik))
+       zpetBcoef(ik)    = petBcoef(kindex(ik))
+       zpeqBcoef(ik)    = peqBcoef(kindex(ik))
+       zcdrag(ik)       = cdrag(kindex(ik))
+       zpb(ik)          = pb(kindex(ik))
+       
+    ENDDO
+    !
+    ! 2. save the grid
+    !
+    IF ( check ) WRITE(numout,*) 'Save the grid'
+    !
+    IF (l_first_intersurf) THEN
+       IF ( hist_id > 0 ) THEN
+          CALL histwrite(hist_id, 'LandPoints',  itau_sechiba+1, (/ REAL(kindex) /), kjpindex, kindex)
+          CALL histwrite(hist_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+       END IF
+       IF ( control_flags%ok_stomate ) THEN
+          IF ( hist_id_stom > 0 ) THEN
+             CALL histwrite(hist_id_stom, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          END IF
+          IF ( hist_id_stom_IPCC > 0 ) THEN
+             CALL histwrite(hist_id_stom_IPCC, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          ENDIF
+       ENDIF
+       IF ( hist_id > 0 ) THEN
+          CALL histwrite(hist_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+          CALL histsync(hist_id)
+       END IF
+       
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite(hist2_id, 'LandPoints',  itau_sechiba+1, (/ REAL(kindex) /), kjpindex, kindex)
+          CALL histwrite(hist2_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          CALL histwrite(hist2_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+          CALL histsync(hist2_id)
+       ENDIF
+       !
+    ENDIF
+    !
+    ! 3. call sechiba
+    !
+    IF ( check ) WRITE(numout,*) 'Calling sechiba'
+    !
+    CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, xrdt, date0_shifted, &
+       & lrestart_read, lrestart_write, control_flags, &
+       & lalo, contfrac, neighbours, resolution, &
+! First level conditions
+! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul rveget
+!       & zzlev, zu, zv, zqair, ztemp_air, zepot_air, zccanopy, &
+       & zzlev, zu, zv, zqair, zqair, ztemp_air, ztemp_air, zepot_air, zccanopy, &
+! Variables for the implicit coupling
+       & zcdrag, zpetAcoef, zpeqAcoef, zpetBcoef, zpeqBcoef, &
+! Rain, snow, radiation and surface pressure
+       & zprecip_rain ,zprecip_snow,  zlwdown, zswnet, zswdown, zsinang, zpb, &
+! Output : Fluxes
+       & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
+! Surface temperatures and surface properties
+       & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, &
+! File ids
+       & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC,soil_mc,litter_mc ) 
+    
+    !
+    IF ( check ) WRITE(numout,*) 'out of SECHIBA'
+    !
+    ! 4. save watchout
+    !
+    IF ( ok_watchout .AND. .NOT. l_first_intersurf ) THEN
+       ! Accumulate last time step
+       sum_zlev(:) = sum_zlev(:) + zzlev(:)
+       sum_u(:) = sum_u(:) + zu(:)
+       sum_v(:) = sum_v(:) + zv(:)
+       sum_qair(:) = sum_qair(:) + zqair(:) 
+       sum_temp_air(:) = sum_temp_air(:) + ztemp_air(:)
+       sum_epot_air(:) = sum_epot_air(:) + zepot_air(:)
+       sum_ccanopy(:) = sum_ccanopy(:) + zccanopy(:)
+       sum_cdrag(:) = sum_cdrag(:) + zcdrag(:)
+       sum_petAcoef(:) = sum_petAcoef(:) + zpetAcoef(:)
+       sum_peqAcoef(:) = sum_peqAcoef(:) + zpeqAcoef(:)
+       sum_petBcoef(:) = sum_petBcoef(:) + zpetBcoef(:)
+       sum_peqBcoef(:) = sum_peqBcoef(:) + zpeqBcoef(:)
+       sum_rain(:) = sum_rain(:) + zprecip_rain(:)
+       sum_snow(:) = sum_snow(:) + zprecip_snow(:)
+       sum_lwdown(:) = sum_lwdown(:) + zlwdown(:)
+       sum_pb(:) = sum_pb(:) + zpb(:)
+       
+!!$       IF ( dt_watch > 3600 ) THEN
+!!$          julian_watch = date0_shifted+((itau_sechiba-0.5)/dt_split_watch)*dt_watch/one_day
+!!$          CALL solarang (julian_watch, julian0, iim, jjm, lon, lat, sinang)
+!!$          WHERE ( sinang(:,:) .LT. EPSILON(un) ) 
+!!$             isinang(:,:) = isinang(:,:) - 1
+!!$          ENDWHERE
+!!$          mean_sinang(:,:) = mean_sinang(:,:)+sinang(:,:)
+!!$          !
+!!$          DO ik=1,kjpindex          
+!!$             j = ((kindex(ik)-1)/iim) + 1
+!!$             i = (kindex(ik) - (j-1)*iim)
+!!$             
+!!$             sum_swnet(ik) = sum_swnet(ik) + sinang(i,j)*zswnet(ik)
+!!$             sum_swdown(ik) = sum_swdown(ik) + sinang(i,j)*zswdown(ik)
+!!$          ENDDO
+!!$       ELSE
+          sum_swnet(:) = sum_swnet(:) + zswnet(:)
+          sum_swdown(:) = sum_swdown(:) + zswdown(:)
+!!$       ENDIF
+          
+       do_watch = .FALSE.
+       call isittime &
+            &  (itau_sechiba,date0_shifted,xrdt,dt_watch,&
+            &   last_action_watch,last_check_watch,do_watch)
+       last_check_watch = itau_sechiba
+       IF (do_watch) THEN
+          !
+          IF ( check ) WRITE(numout,*) 'save watchout'
+          !
+          IF (long_print) THEN
+             WRITE(numout,*) "intersurf : write watchout for date ",date0,date0_shifted,itau_sechiba,&
+                  & last_action_watch, last_check_watch
+          ENDIF
+          last_action_watch = itau_sechiba
+
+          sum_zlev(:) = sum_zlev(:) / dt_split_watch
+          sum_u(:) = sum_u(:) / dt_split_watch
+          sum_v(:) = sum_v(:) / dt_split_watch
+          sum_qair(:) = sum_qair(:) / dt_split_watch
+          sum_temp_air(:) = sum_temp_air(:) / dt_split_watch
+          sum_epot_air(:) = sum_epot_air(:) / dt_split_watch
+          sum_ccanopy(:) = sum_ccanopy(:) / dt_split_watch
+          sum_cdrag(:) = sum_cdrag(:) / dt_split_watch
+          sum_petAcoef(:) = sum_petAcoef(:) / dt_split_watch
+          sum_peqAcoef(:) = sum_peqAcoef(:) / dt_split_watch
+          sum_petBcoef(:) = sum_petBcoef(:) / dt_split_watch
+          sum_peqBcoef(:) = sum_peqBcoef(:) / dt_split_watch
+          sum_rain(:) = sum_rain(:) / dt_split_watch
+          sum_snow(:) = sum_snow(:) / dt_split_watch
+          sum_lwdown(:) = sum_lwdown(:) / dt_split_watch
+          sum_pb(:) = sum_pb(:) / dt_split_watch
+
+!!$          IF ( dt_watch > 3600 ) THEN 
+!!$             WHERE ( isinang(:,:) .GT. 0 )
+!!$                mean_sinang(:,:) = mean_sinang(:,:) / isinang(:,:)
+!!$             ENDWHERE
+!!$             !
+!!$             DO ik=1,kjpindex          
+!!$                j = ((kindex(ik)-1)/iim) + 1
+!!$                i = (kindex(ik) - (j-1)*iim)
+!!$                IF (mean_sinang(i,j) > zero) THEN
+!!$                   sum_swdown(ik) = sum_swdown(ik)/mean_sinang(i,j)
+!!$                   sum_swnet(ik) =  sum_swnet(ik)/mean_sinang(i,j)
+!!$                ELSE
+!!$                   sum_swdown(ik) = zero
+!!$                   sum_swnet(ik) =  zero
+!!$                ENDIF
+!!$             ENDDO
+!!$          ELSE
+             sum_swnet(:) = sum_swnet(:) / dt_split_watch
+             sum_swdown(:) = sum_swdown(:) / dt_split_watch
+!!$          ENDIF
+
+          CALL watchout_write_p(kjpindex, itau_sechiba, xrdt, sum_zlev, sum_swdown, sum_rain, &
+               &   sum_snow, sum_lwdown, sum_pb, sum_temp_air, sum_epot_air, sum_qair, &
+               &   sum_u, sum_v, sum_swnet, sum_petAcoef, sum_peqAcoef, sum_petBcoef, sum_peqBcoef, &
+               &   sum_cdrag, sum_ccanopy )
+       ENDIF
+    ENDIF
+    !
+    ! 5. scatter output fields
+    !
+    !
+    z0(:)           = undef_sechiba
+    coastalflow(:)  = undef_sechiba
+    riverflow(:)    = undef_sechiba
+    tsol_rad(:)     = undef_sechiba
+    vevapp(:)       = undef_sechiba
+    temp_sol_new(:) = undef_sechiba 
+    qsurf(:)        = undef_sechiba 
+    albedo(:,:)     = undef_sechiba
+    fluxsens(:)     = undef_sechiba
+    fluxlat(:)      = undef_sechiba
+    emis(:)         = undef_sechiba 
+    cdrag(:)        = undef_sechiba 
+    !
+    DO ik=1, kjpindex
+       
+       z0(kindex(ik))           = zz0(ik)
+       coastalflow(kindex(ik))  = zcoastal(ik)/mille
+       riverflow(kindex(ik))    = zriver(ik)/mille
+       tsol_rad(kindex(ik))     = ztsol_rad(ik)
+       vevapp(kindex(ik))       = zvevapp(ik)
+       temp_sol_new(kindex(ik)) = ztemp_sol_new(ik)
+       qsurf(kindex(ik))        = zqsurf(ik)
+       albedo(kindex(ik),1)     = zalbedo(ik,1)
+       albedo(kindex(ik),2)     = zalbedo(ik,2)
+       fluxsens(kindex(ik))     = zfluxsens(ik)
+       fluxlat(kindex(ik))      = zfluxlat(ik)
+       emis(kindex(ik))         = zemis(ik)
+       cdrag(kindex(ik))        = zcdrag(ik)
+
+    ENDDO
+    !
+    ! Modified fields for variables scattered during the writing
+    !
+    dcoastal(:) = (zcoastal(:))/mille
+    driver(:)   = (zriver(:))/mille
+    !
+    IF ( .NOT. l_first_intersurf) THEN
+       !
+       IF ( .NOT. almaoutput ) THEN
+          !
+          !  scattered during the writing
+          !
+          IF ( hist_id > 0 ) THEN
+             CALL histwrite (hist_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite (hist_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
+             CALL histwrite (hist_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
+             CALL histwrite (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+             CALL histwrite (hist_id, 'fluxlat',  itau_sechiba, zfluxlat, kjpindex, kindex)
+             CALL histwrite (hist_id, 'swnet',    itau_sechiba, zswnet, kjpindex, kindex)
+             CALL histwrite (hist_id, 'swdown',   itau_sechiba, zswdown, kjpindex, kindex)
+             CALL histwrite (hist_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+             CALL histwrite (hist_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+             CALL histwrite (hist_id, 'tair',     itau_sechiba, ztemp_air, kjpindex, kindex)
+             CALL histwrite (hist_id, 'qair',     itau_sechiba, zqair, kjpindex, kindex)
+             ! Ajouts Nathalie - Juin 2006 - sauvegarde de t2m et q2m
+             CALL histwrite (hist_id, 'q2m',     itau_sechiba, zqair, kjpindex, kindex)
+             CALL histwrite (hist_id, 't2m',     itau_sechiba, ztemp_air, kjpindex, kindex)
+          END IF
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite (hist2_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
+             !
+             CALL histwrite (hist2_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'fluxlat',  itau_sechiba, zfluxlat, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'swnet',    itau_sechiba, zswnet, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'swdown',   itau_sechiba, zswdown, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+             CALL histwrite (hist2_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+             CALL histwrite (hist2_id, 'tair',     itau_sechiba, ztemp_air, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'qair',     itau_sechiba, zqair, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'q2m',     itau_sechiba, zqair, kjpindex, kindex)
+             CALL histwrite (hist2_id, 't2m',     itau_sechiba, ztemp_air, kjpindex, kindex)
+          ENDIF
+       ELSE
+          IF ( hist_id > 0 ) THEN
+             CALL histwrite (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite (hist_id, 'SWnet',    itau_sechiba, zswnet, kjpindex, kindex)
+             CALL histwrite (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+             CALL histwrite (hist_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+             CALL histwrite (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist_id, 'Tair', itau_sechiba, ztemp_air, kjpindex, kindex)
+             CALL histwrite (hist_id, 'Qair', itau_sechiba, zqair, kjpindex, kindex)
+          END IF
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'SWnet',    itau_sechiba, zswnet, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
+          ENDIF
+       ENDIF
+       !
+       IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
+          CALL histsync(hist_id)
+       ENDIF
+       !
+    ENDIF
+    !
+    ! 6. Transform the water fluxes into Kg/m^2s and m^3/s
+    !
+    DO ik=1, kjpindex
+
+       vevapp(kindex(ik)) = vevapp(kindex(ik))/xrdt
+       coastalflow(kindex(ik)) = coastalflow(kindex(ik))/xrdt
+       riverflow(kindex(ik)) = riverflow(kindex(ik))/xrdt
+
+    ENDDO
+    !
+    IF ( lrestart_write .AND. ok_watchout ) THEN
+       CALL watchout_close()
+    ENDIF
+    !
+    IF(l_first_intersurf .AND. is_root_prc) CALL getin_dump
+    l_first_intersurf = .FALSE.
+    !
+    IF (long_print) WRITE (numout,*) ' intersurf_main done '
+    !
+    CALL ipslnlf(new_number=old_fileout)
+    !    
+  END SUBROUTINE intersurf_main_1d
+
+
+  SUBROUTINE Init_intersurf(nbp_l_lon,nbp_l_lat,kjpindex,kindex,orch_offset,orch_omp_size,orch_omp_rank,COMM)
+    USE mod_orchidee_para
+    USE timer
+    IMPLICIT NONE
+
+    INTEGER,INTENT(IN)  :: nbp_l_lon
+    INTEGER,INTENT(IN)  :: nbp_l_lat
+    INTEGER,INTENT(IN)  :: kjpindex
+    INTEGER,INTENT(IN)  :: kindex(:)
+    INTEGER,INTENT(IN)  :: orch_offset
+    INTEGER,INTENT(IN)  :: COMM
+    INTEGER,INTENT(IN)  :: orch_omp_size
+    INTEGER,INTENT(IN)  :: orch_omp_rank
+
+    INTEGER,DIMENSION(kjpindex)  :: kindex_offset
+
+    IF (orch_omp_rank==0) THEN
+      CALL Init_timer
+      CALL start_timer(timer_mpi)
+      CALL set_grid_glo(nbp_l_lon,nbp_l_lat)
+    ENDIF
+    CALL barrier2_omp()   
+    CALL init_orchidee_data_para(kjpindex,kindex,orch_offset,orch_omp_size,orch_omp_rank,COMM)
+    CALL Set_stdout_file('out_orchidee')
+    
+    IF (is_omp_root) CALL Allocate_grid_glo
+    CALL barrier2_omp() 
+    CALL init_ioipsl_para
+          
+    kindex_offset(:)=kindex(:)+offset
+    CALL gather(kindex_offset,index_g)
+    CALL bcast(index_g)  
+
+    WRITE(numout,*) "kjpindex = ",kjpindex
+    WRITE(numout,*) "offset for OMP = ",offset_omp
+    WRITE(numout,*) "Index num local for continental points = ",kindex
+    WRITE(numout,*) "Index num global for continental points = ",kindex_offset
+    IF (is_omp_root) THEN
+       WRITE(numout,*) "ROOT OMP, Index global MPI : ",kindex_mpi(:)
+    ENDIF
+    IF (is_root_prc) THEN
+       WRITE(numout,*) "ROOT global, Index global : ",index_g(:)
+    ENDIF
+    
+  END SUBROUTINE Init_intersurf
+!
+!
+  SUBROUTINE intersurf_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
+     & lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
+! First level conditions
+     & zlev,  u, v, qair, temp_air, epot_air, ccanopy, &
+! Variables for the implicit coupling
+     & cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+! Rain, snow, radiation and surface pressure
+     & precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
+! Output : Fluxes
+     & vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
+! Surface temperatures and surface properties
+     & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, q2m, t2m, &
+! Add emission/deposit fields
+     & field_out_names, fields_out, field_in_names, fields_in, &
+! For VOC
+     & sinang,soil_mc,litter_mc)  
+    ! routines called : sechiba_main
+    !
+    USE mod_orchidee_para
+    IMPLICIT NONE
+    !    
+    ! interface description for dummy arguments
+    ! input scalar 
+    INTEGER(i_std),INTENT (in)                            :: kjit          !! Time step number
+    INTEGER(i_std),INTENT (in)                            :: iim_glo, jjm_glo  !! Dimension of global fields
+    INTEGER(i_std),INTENT (in)                            :: kjpindex      !! Number of continental points
+    REAL(r_std),INTENT (in)                               :: xrdt          !! Time step in seconds
+    LOGICAL, INTENT (in)                                 :: lrestart_read !! Logical for _restart_ file to read
+    LOGICAL, INTENT (in)                                 :: lrestart_write!! Logical for _restart_ file to write'
+    REAL(r_std), INTENT (in)                              :: date0         !! Date at which kjit = 0
+    ! input fields
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: kindex        !! Index for continental points
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: u             !! Lowest level wind speed
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: v             !! Lowest level wind speed 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: zlev          !! Height of first layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: qair          !! Lowest level specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: precip_rain   !! Rain precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: precip_snow   !! Snow precipitation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: lwdown        !! Down-welling long-wave flux 
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: swnet         !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: swdown        !! Downwelling surface short-wave flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: temp_air      !! Air temperature in Kelvin
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: epot_air      !! Air potential energy
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: ccanopy       !! CO2 concentration in the canopy
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: petAcoef      !! Coeficients A from the PBL resolution
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: peqAcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: petBcoef      !! Coeficients B from the PBL resolution
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: peqBcoef      !! One for T and another for q
+    REAL(r_std),DIMENSION (kjpindex), INTENT(inout)       :: cdrag         !! Cdrag
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: pb            !! Lowest level pressure
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)        :: latlon        !! Geographical coordinates
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: zcontfrac     !! Fraction of continent
+    INTEGER(i_std),DIMENSION (kjpindex,8), INTENT(in)    :: zneighbours   !! neighbours
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(in)        :: zresolution   !! size of the grid box
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL          :: q2m          !! Surface specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL          :: t2m          !! Surface air temperature
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(inout)   :: soil_mc   !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(inout)    :: litter_mc     !! litter moisture content \f($m^3 \times m^3$)\f
+    ! output fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: z0            !! Surface roughness
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: coastalflow   !! Diffuse flow of water into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: riverflow     !! Largest rivers flowing into the ocean (m^3/dt)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: tsol_rad      !! Radiative surface temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: vevapp        !! Total of evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: temp_sol_new  !! New soil temperature
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: qsurf         !! Surface specific humidity
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT(out)       :: albedo        !! Albedo
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: fluxsens      !! Sensible chaleur flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: fluxlat       !! Latent chaleur flux
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)         :: emis          !! Emissivity
+
+
+    !
+    ! Optional arguments
+    !
+    ! Names and fields for emission variables : to be transport by GCM to chemistry model.
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_out_names
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: fields_out
+    !
+    ! Names and fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE.
+    CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_in_names
+    REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN) :: fields_in
+    !
+    ! For VOC 
+    REAL(r_std), DIMENSION(kjpindex), OPTIONAL, INTENT(in) :: sinang  !! 
+
+
+    ! LOCAL declaration
+    ! work arrays to scatter and/or gather information just before/after sechiba_main call's
+    ! and to keep output value for next call
+    REAL(r_std),DIMENSION (kjpindex)                      :: zccanopy      !! Work array to keep ccanopy
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_rain  !! Work array to keep precip_rain
+    REAL(r_std),DIMENSION (kjpindex)                      :: zprecip_snow  !! Work array to keep precip_snow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zz0           !! Work array to keep z0
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcdrag        !! Work array for surface drag
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcoastal      !! Work array to keep coastal flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: zriver        !! Work array to keep river out flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: dcoastal      !! Work array to keep coastal flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: driver        !! Work array to keep river out flow
+    REAL(r_std),DIMENSION (kjpindex)                      :: znetco2       !! Work array to keep netco2flux
+    REAL(r_std),DIMENSION (kjpindex)                      :: zcarblu       !! Work array to keep fco2_land_use
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztsol_rad     !! Work array to keep tsol_rad
+    REAL(r_std),DIMENSION (kjpindex)                      :: zvevapp       !! Work array to keep vevapp
+    REAL(r_std),DIMENSION (kjpindex)                      :: ztemp_sol_new !! Work array to keep temp_sol_new
+    REAL(r_std),DIMENSION (kjpindex)                      :: zqsurf        !! Work array to keep qsurf
+    REAL(r_std),DIMENSION (kjpindex,2)                    :: zalbedo       !! Work array to keep albedo
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxsens     !! Work array to keep fluxsens
+    REAL(r_std),DIMENSION (kjpindex)                      :: zfluxlat      !! Work array to keep fluxlat
+    REAL(r_std),DIMENSION (kjpindex)                      :: zemis         !! Work array to keep emis
+    REAL(r_std),DIMENSION (kjpindex)                      :: zsinang       !! Work array to keep sinang
+
+    !
+    ! Optional arguments
+    !
+    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lon_scat_g, lat_scat_g !! The scattered values for longitude 
+    !
+    INTEGER(i_std)                          :: iim,jjm                                  !! local sizes
+    REAL(r_std),DIMENSION (:,:),ALLOCATABLE :: lon_scat, lat_scat !! The scattered values for longitude 
+    !                                                             !! and latitude.
+    !
+    !
+!    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dvevapp       !! Diagnostic array for evaporation
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dtemp_sol     !! for surface temperature
+!$OMP THREADPRIVATE(dtemp_sol)
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dfluxsens     !! for sensible heat flux
+!$OMP THREADPRIVATE(dfluxsens)
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dfluxlat      !! for latent heat flux
+!$OMP THREADPRIVATE(dfluxlat)
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dswnet        !! net solar radiation
+!$OMP THREADPRIVATE(dswnet)
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dswdown       !! Incident solar radiation
+!$OMP THREADPRIVATE(dswdown)
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:,:)                     :: dalbedo       !! albedo
+!$OMP THREADPRIVATE(dalbedo)
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dtair         !! air temperature
+!$OMP THREADPRIVATE(dtair)
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dqair         !! specific air humidity
+!$OMP THREADPRIVATE(dqair)
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dq2m          !! Surface specific humidity
+!$OMP THREADPRIVATE(dq2m)
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dt2m          !! Surface air temperature
+!$OMP THREADPRIVATE(dt2m)
+    !                                                                          !! and latitude.
+    !
+    INTEGER(i_std)                                        :: i, j, ik
+    INTEGER(i_std)                                        :: itau_sechiba
+    REAL(r_std)                                           :: mx, zlev_mean
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)              :: tmp_lon, tmp_lat, tmp_lev
+    LOGICAL                                               :: do_watch      !! if it's time, write watchout
+    INTEGER                                               :: old_fileout   !! old Logical Int for std IO output
+    LOGICAL :: check = .TRUE.
+    !
+    LOGICAL, SAVE                                         :: fatmco2       !! Flag to force the value of atmospheric CO2 for vegetation.
+!$OMP THREADPRIVATE(fatmco2)
+    REAL(r_std), SAVE                                     :: atmco2        !! atmospheric CO2 
+!$OMP THREADPRIVATE(atmco2)
+    LOGICAL, SAVE                                     :: ok_q2m_t2m
+!$OMP THREADPRIVATE(ok_q2m_t2m)
+
+    !
+    ! Number of fields to give (nb_fields_out) or get from (nb_fields_in) GCM :
+    INTEGER(i_std), SAVE                                  :: nb_fields_out, nb_fields_in
+!$OMP THREADPRIVATE(nb_fields_out, nb_fields_in)
+    ! Id of fields to give (nb_fields_out) or get from (nb_fields_in) GCM :
+    INTEGER(i_std)                                        :: i_fields_out, i_fields_in
+
+    REAL,ALLOCATABLE,DIMENSION(:,:)                  :: lalo_mpi
+    REAL,ALLOCATABLE,DIMENSION(:)                  :: zlev_glo1D
+     
+    !! Local landpoints vector
+    REAL(r_std),DIMENSION (kjpindex)                       :: landpoints
+    !
+    CALL ipslnlf_p(old_number=old_fileout)
+    CALL ipslnlf_p(new_number=numout)
+    
+
+    !
+    IF (l_first_intersurf) THEN
+       ! Test sur la presence de q2m et t2m
+       IF (PRESENT(q2m) .AND. PRESENT(t2m)) THEN
+         ok_q2m_t2m=.TRUE.
+       ELSE
+         ok_q2m_t2m=.FALSE.
+       ENDIF
+       !
+       CALL intsurf_time( kjit, date0, xrdt )
+       !
+       IF ( check ) WRITE(numout,*) 'Initialisation of intersurf'
+       !
+       CALL ioget_calendar (one_year, one_day)
+       !
+       iim=iim_g
+       jjm=jj_nb
+       
+       IF (is_omp_root) THEN
+          ALLOCATE(lon_scat(iim,jjm))
+          ALLOCATE(lat_scat(iim,jjm))
+       ELSE
+          ALLOCATE(lon_scat(1,1))
+          ALLOCATE(lat_scat(1,1))
+       ENDIF
+
+       ALLOCATE(dtemp_sol(kjpindex))
+       ALLOCATE(dfluxsens(kjpindex))
+       ALLOCATE(dfluxlat(kjpindex))
+       ALLOCATE(dswnet(kjpindex))
+       ALLOCATE(dswdown(kjpindex))
+       ALLOCATE(dalbedo(kjpindex,2))
+       ALLOCATE(dtair(kjpindex))
+       ALLOCATE(dqair(kjpindex)) 
+
+       IF (ok_q2m_t2m) THEN
+          ALLOCATE(dq2m(kjpindex))
+          ALLOCATE(dt2m(kjpindex))
+       ENDIF
+
+       CALL init_WriteField_p
+       !
+       ! Allocation of grid variables
+       !
+       CALL init_grid ( kjpindex )
+       !
+       !  Create the internal coordinate table
+       !
+       lalo(:,:) = latlon(:,:)
+       CALL gather(lalo,lalo_g)
+       !
+       !-
+       !- Store variable to help describe the grid
+       !- once the points are gathered.
+       !-
+       neighbours(:,:) = zneighbours(:,:)
+       CALL gather(neighbours,neighbours_g)
+       !
+       resolution(:,:) = zresolution(:,:)
+       CALL gather(resolution,resolution_g)
+       !
+       area(:) = resolution(:,1)*resolution(:,2)
+       CALL gather(area,area_g)
+       !
+       !- Store the fraction of the continents only once so that the user
+       !- does not change them afterwards.
+       !
+       contfrac(:) = zcontfrac(:)
+       CALL gather(contfrac,contfrac_g)
+       !
+       !
+       !  Create the internal coordinate table
+       !
+       IF ( (.NOT.ALLOCATED(tmp_lon))) THEN
+          ALLOCATE(tmp_lon(iim,jjm))
+       ENDIF
+       IF ( (.NOT.ALLOCATED(tmp_lat))) THEN
+          ALLOCATE(tmp_lat(iim,jjm))
+       ENDIF
+       IF ( (.NOT.ALLOCATED(tmp_lev))) THEN
+          ALLOCATE(tmp_lev(iim,jjm))
+       ENDIF
+       !
+       !  Either we have the scattered coordinates as arguments or
+       !  we have to do the work here.
+       !
+       IF (is_omp_root) THEN
+          lon_scat(:,:)=zero
+          lat_scat(:,:)=zero 
+          CALL scatter2D_mpi(lon_scat_g,lon_scat)
+          CALL scatter2D_mpi(lat_scat_g,lat_scat)
+          lon_scat(:,1)=lon_scat(:,2)
+          lon_scat(:,jj_nb)=lon_scat(:,2)
+          lat_scat(:,1)=lat_scat(iim_g,1)
+          lat_scat(:,jj_nb)=lat_scat(1,jj_nb)
+          
+          tmp_lon(:,:) = lon_scat(:,:)
+          tmp_lat(:,:) = lat_scat(:,:)
+          
+          IF (is_mpi_root) THEN
+             lon_g(:,:) = lon_scat_g(:,:)
+             lat_g(:,:) = lat_scat_g(:,:)
+          ENDIF
+       ENDIF
+       !
+
+!ANNE ici possibilite de calculer la grille du modele ? (lignes 965 ??
+       
+
+!ANNE calcul zlev, conserve la version de Martial
+       IF (is_root_prc) ALLOCATE(zlev_glo1D(nbp_glo))
+       CALL gather(zlev,zlev_glo1D)
+       
+       IF (is_root_prc) THEN
+          DO ik=1, nbp_glo
+             j = INT( (index_g(ik)-1) / iim_g ) + 1
+             i = index_g(ik) - (j-1) * iim_g
+             zlev_g(i,j) = zlev_glo1D(ik)
+          ENDDO
+       ENDIF  
+       !
+       !
+       !  Configuration of SSL specific parameters
+       !
+       CALL intsurf_config(control_flags,xrdt)
+       !
+       !Config  Key  = FORCE_CO2_VEG
+       !Config  Desc = Flag to force the value of atmospheric CO2 for vegetation.
+       !Config  Def  = FALSE
+       !Config  Help = If this flag is set to true, the ATM_CO2 parameter is used
+       !Config         to prescribe the atmospheric CO2.
+       !Config         This Flag is only use in couple mode.
+       !
+       fatmco2=.FALSE.
+       CALL getin_p('FORCE_CO2_VEG',fatmco2)
+       !
+       ! Next flag is only use in couple mode with a gcm in intersurf.
+       ! In forced mode, it has already been read and set in driver.
+       IF ( fatmco2 ) THEN
+          !Config  Key  = ATM_CO2
+          !Config  IF   = FORCE_CO2_VEG (in not forced mode)
+          !Config  Desc = Value for atm CO2 
+          !Config  Def  = 350.
+          !Config  Help = Value to prescribe the atm CO2.
+          !Config         For pre-industrial simulations, the value is 286.2 .
+          !Config         348. for 1990 year.
+          !
+          atmco2=350.
+          CALL getin_p('ATM_CO2',atmco2)
+          WRITE(numout,*) 'atmco2 ',atmco2
+       ENDIF
+       
+       !
+       CALL intsurf_restart(kjit, iim, jjm, tmp_lon, tmp_lat, date0, xrdt, control_flags, rest_id, rest_id_stom, itau_offset)
+       itau_sechiba = kjit + itau_offset
+       !
+       CALL intsurf_history(iim, jjm, tmp_lon, tmp_lat, itau_sechiba, &
+ &                          date0_shifted, xrdt, control_flags, hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC)
+       !
+       CALL bcast_omp(hist_id)
+       CALL bcast_omp(hist2_id)
+       CALL bcast_omp(hist_id_stom)
+       CALL bcast_omp(hist_id_stom_IPCC)
+       !
+       IF ( ok_watchout ) THEN
+          IF (is_root_prc) THEN
+             zlev_mean = zero
+             DO ik=1, nbp_glo
+                j = ((index_g(ik)-1)/iim_g) + 1
+                i = (index_g(ik) - (j-1)*iim_g)
+                
+                zlev_mean = zlev_mean + zlev_g(i,j)
+             ENDDO
+             zlev_mean = zlev_mean / REAL(nbp_glo,r_std)
+          ENDIF
+
+          last_action_watch = itau_sechiba
+          last_check_watch =  last_action_watch
+
+          ! Only root proc write watchout file
+          IF (is_root_prc) &
+               CALL watchout_init(iim_g, jjm_g, kjpindex, nbp_glo, &
+               & date0_shifted, last_action_watch, dt_watch, index_g, lon_g, lat_g, zlev_mean)
+       ENDIF
+
+       ! Prepare fieds out/in for interface with GCM.
+       IF (PRESENT(field_out_names)) THEN
+          nb_fields_out=SIZE(field_out_names)
+       ELSE
+          nb_fields_out=0
+       ENDIF
+       IF (PRESENT(field_in_names)) THEN
+          nb_fields_in=SIZE(field_in_names)
+       ELSE
+          nb_fields_in=0
+       ENDIF
+
+!>> VOC in coupled mode 
+       IF ( PRESENT(sinang) )  THEN 
+          zsinang(:) = sinang(:)
+       ELSE
+          zsinang(:) = zero
+       ENDIF
+
+       !
+       IF ( check ) WRITE(numout,*) 'End of Initialisation of intersurf'
+       !
+    ENDIF
+
+!!! ANNE CALL ipslnlf_p(new_number=numout) est-il utile ? 
+
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    !
+    CALL intsurf_time( itau_sechiba, date0_shifted, xrdt )
+
+    ! Test LMDz inputs
+    IF (check_INPUTS) THEN
+       IF ( sec <= 7200 ) THEN
+          WRITE(numout,*) "sec = ",sec
+          CALL WriteFieldI_p("Wu",u)
+          WRITE(numout,*) "Lowest level wind speed :",u
+          CALL WriteFieldI_p("Wv",v)
+          WRITE(numout,*) "Lowest level wind speed  :",v
+          CALL WriteFieldI_p("Wzlev",zlev)
+          WRITE(numout,*) "Height of first layer :",zlev
+          CALL WriteFieldI_p("Wqair",qair)
+          WRITE(numout,*) "Lowest level specific humidity :",qair
+          CALL WriteFieldI_p("Wprecip_rain",precip_rain)
+          WRITE(numout,*) "Rain precipitation :",precip_rain
+          CALL WriteFieldI_p("Wprecip_snow",precip_snow)
+          WRITE(numout,*) "Snow precipitation :",precip_snow
+          CALL WriteFieldI_p("Wlwdown",lwdown)
+          WRITE(numout,*) "Down-welling long-wave flux  :",lwdown
+          CALL WriteFieldI_p("Wswnet",swnet)
+          WRITE(numout,*) "Net surface short-wave flux :",swnet
+          CALL WriteFieldI_p("Wswdown",swdown)
+          WRITE(numout,*) "Downwelling surface short-wave flux :",swdown
+          CALL WriteFieldI_p("Wtemp_air",temp_air)
+          WRITE(numout,*) "Air temperature in Kelvin :",temp_air
+          CALL WriteFieldI_p("Wepot_air",epot_air)
+          WRITE(numout,*) "Air potential energy :",epot_air
+          CALL WriteFieldI_p("Wccanopy",ccanopy)
+          WRITE(numout,*) "CO2 concentration in the canopy :",ccanopy
+          CALL WriteFieldI_p("WpetAcoef",petAcoef)
+          WRITE(numout,*) "Coeficients A from the PBL resolution :",petAcoef
+          CALL WriteFieldI_p("WpeqAcoef",peqAcoef)
+          WRITE(numout,*) "One for T and another for q :",peqAcoef
+          CALL WriteFieldI_p("WpetBcoef",petBcoef)
+          WRITE(numout,*) "Coeficients B from the PBL resolution :",petBcoef
+          CALL WriteFieldI_p("WpeqBcoef",peqBcoef)
+          WRITE(numout,*) "One for T and another for q :",peqBcoef
+          CALL WriteFieldI_p("Wcdrag",cdrag)
+          WRITE(numout,*) "Cdrag :",cdrag
+          CALL WriteFieldI_p("Wpb",pb)
+          WRITE(numout,*) "Lowest level pressure :",pb
+          CALL WriteFieldI_p("Wzcontfrac",zcontfrac)
+          WRITE(numout,*) "Fraction of continent :",zcontfrac
+          IF ( ok_q2m_t2m) THEN
+             CALL WriteFieldI_p("Wq2m",q2m)
+             WRITE(numout,*) "Surface specific humidity :",q2m
+             CALL WriteFieldI_p("Wt2m",t2m)
+             WRITE(numout,*) "Surface air temperature :",t2m
+          ENDIF
+       ENDIF
+    ENDIF
+
+    !
+    ! 1. Just change the units of some input fields
+    !
+    DO ik=1, kjpindex
+       
+       zprecip_rain(ik) = precip_rain(ik)*xrdt
+       zprecip_snow(ik) = precip_snow(ik)*xrdt
+       zcdrag(ik)       = cdrag(ik)
+       
+    ENDDO
+    !
+    IF (check_INPUTS) THEN
+       WRITE(numout,*) "Intersurf_main_gathered :"
+       WRITE(numout,*) "Time step number = ",kjit
+       WRITE(numout,*) "Dimension of input fields = ",iim, jjm
+       WRITE(numout,*) "Number of continental points = ",kjpindex
+       WRITE(numout,*) "Time step in seconds = ",xrdt
+       WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
+       WRITE(numout,*) "Date at which kjit = 0  =  ",date0
+       WRITE(numout,*) "offset for OMP = ",offset_omp
+       WRITE(numout,*) "Index for continental points = ",kindex
+       IF (is_omp_root) THEN
+          WRITE(numout,*) "ROOT OMP, Index global MPI : ",kindex_mpi(:)
+       ENDIF
+       IF (is_root_prc) THEN
+          WRITE(numout,*) "ROOT global, Index global : ",index_g(:)
+       ENDIF
+       WRITE(numout,*) "Lowest level wind speed North = ",u
+       WRITE(numout,*) "Lowest level wind speed East = ",v
+       WRITE(numout,*) "Height of first layer = ",zlev
+       WRITE(numout,*) "Lowest level specific humidity = ",qair
+       WRITE(numout,*) "Rain precipitation = ",zprecip_rain
+       WRITE(numout,*) "Snow precipitation = ",zprecip_snow
+       WRITE(numout,*) "Down-welling long-wave flux = ",lwdown
+       WRITE(numout,*) "Net surface short-wave flux = ",swnet
+       WRITE(numout,*) "Downwelling surface short-wave flux = ",swdown
+       WRITE(numout,*) "Air temperature in Kelvin = ",temp_air
+       WRITE(numout,*) "Air potential energy = ",epot_air
+       WRITE(numout,*) "CO2 concentration in the canopy = ",ccanopy
+       WRITE(numout,*) "Coeficients A from the PBL resolution = ",petAcoef
+       WRITE(numout,*) "One for T and another for q = ",peqAcoef
+       WRITE(numout,*) "Coeficients B from the PBL resolution = ",petBcoef
+       WRITE(numout,*) "One for T and another for q = ",peqBcoef
+       WRITE(numout,*) "Cdrag = ",zcdrag
+       WRITE(numout,*) "Lowest level pressure = ",pb
+! Variables utilisees uniquement dans l_first et donc plus definies ensuite
+!       IF (is_omp_root) THEN
+!          WRITE(numout,*) "Geographical coordinates lon = "
+!          WRITE(numout,*) lon_scat
+!          WRITE(numout,*) "Geographical coordinates lat = "
+!          WRITE(numout,*) lat_scat 
+!       ENDIF
+       WRITE(numout,*) "Geographical land coordinates lon = ", lalo(:,2)
+       WRITE(numout,*) "Geographical land coordinates lat = ", lalo(:,1)
+       WRITE(numout,*) "Fraction of continent in the grid = ",zcontfrac
+    ENDIF
+
+    ! Fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE.
+    WRITE(numout,*) "Get fields from atmosphere."
+
+    DO i_fields_in=1,nb_fields_in
+       WRITE(numout,*) i_fields_in," Champ = ",TRIM(field_in_names(i_fields_in)) 
+       SELECT CASE(TRIM(field_in_names(i_fields_in)))
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'intsurf_gathered', &
+            &          'You ask in GCM an unknown field '//TRIM(field_in_names(i_fields_in))//&
+            &          ' to give to ORCHIDEE for this specific version.',&
+            &          'This model won''t be able to continue.', &
+            &          '(check your tracer parameters in GCM)')
+       END SELECT
+    ENDDO
+
+
+    !
+    ! 2. modification of co2
+    !
+    IF ( fatmco2 ) THEN
+       zccanopy(:) = atmco2
+       WRITE (numout,*) 'Modification of the ccanopy value. CO2 = ',atmco2
+    ELSE
+       zccanopy(:) = ccanopy(:)
+    ENDIF
+    !
+    ! 3. save the grid
+    !
+    IF ( check ) WRITE(numout,*) 'Save the grid'
+    !
+    IF (l_first_intersurf) THEN
+       landpoints(:)=(/ ( REAL(ik), ik=1,kjpindex ) /)
+       CALL histwrite_p(hist_id, 'LandPoints',  itau_sechiba+1, landpoints, kjpindex, kindex)
+       CALL histwrite_p(hist_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+       IF ( control_flags%ok_stomate ) THEN
+          CALL histwrite_p(hist_id_stom, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          IF ( hist_id_stom_ipcc > 0 ) &
+               CALL histwrite_p(hist_id_stom_IPCC, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+       ENDIF
+       CALL histwrite_p(hist_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+       
+       IF (is_omp_root .AND. hist_id > 0) THEN
+          CALL histsync(hist_id)
+       ENDIF
+       !
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite_p(hist2_id, 'LandPoints',  itau_sechiba+1, landpoints, kjpindex, kindex)
+          CALL histwrite_p(hist2_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          CALL histwrite_p(hist2_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+          IF (is_omp_root) THEN
+             CALL histsync(hist2_id)
+          ENDIF
+       ENDIF
+       !
+    ENDIF
+    !
+    ! 4. call sechiba for continental points only
+    !
+    IF ( check ) WRITE(numout,*) 'Calling sechiba'
+    !
+    IF (.NOT. ok_q2m_t2m) THEN
+       CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, xrdt, date0_shifted, &
+            & lrestart_read, lrestart_write, control_flags, &
+            & lalo, contfrac, neighbours, resolution, &
+! First level conditions
+! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul rveget
+!       & zlev, u, v, qair, temp_air, epot_air, ccanopy, &
+            & zlev, u, v, qair, qair, temp_air, temp_air, epot_air, zccanopy, &
+! Variables for the implicit coupling
+            & zcdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+! Rain, snow, radiation and surface pressure
+            & zprecip_rain ,zprecip_snow,  lwdown, swnet, swdown, zsinang, pb, &
+! Output : Fluxes
+            & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
+! Surface temperatures and surface properties
+            & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, &
+! File ids
+            & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC,soil_mc,litter_mc ) 
+    ELSE
+       CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, xrdt, date0_shifted, &
+            & lrestart_read, lrestart_write, control_flags, &
+            & lalo, contfrac, neighbours, resolution, &
+! First level conditions
+! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul rveget
+!       & zlev, u, v, qair, temp_air, epot_air, ccanopy, &
+            & zlev, u, v, qair, q2m, t2m, temp_air, epot_air, zccanopy, &
+! Variables for the implicit coupling
+            & zcdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+! Rain, snow, radiation and surface pressure
+            & zprecip_rain ,zprecip_snow,  lwdown, swnet, swdown, zsinang, pb, &
+! Output : Fluxes
+            & zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
+! Surface temperatures and surface properties
+            & ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, &
+! File ids
+            & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC,soil_mc,litter_mc ) 
+    ENDIF
+    !
+    IF ( check ) WRITE(numout,*) 'out of SECHIBA'
+    !
+    ! 5. save watchout 
+    !
+    IF ( ok_watchout .AND. .NOT. l_first_intersurf ) THEN
+       ! Accumulate last time step
+       sum_zlev(:) = sum_zlev(:) + zlev(:)
+       sum_u(:) = sum_u(:) + u(:)
+       sum_v(:) = sum_v(:) + v(:)
+       sum_qair(:) = sum_qair(:) + qair(:) 
+       sum_temp_air(:) = sum_temp_air(:) + temp_air(:)
+       sum_epot_air(:) = sum_epot_air(:) + epot_air(:)
+       sum_ccanopy(:) = sum_ccanopy(:) + ccanopy(:)
+       sum_cdrag(:) = sum_cdrag(:) + zcdrag(:)
+       sum_petAcoef(:) = sum_petAcoef(:) + petAcoef(:)
+       sum_peqAcoef(:) = sum_peqAcoef(:) + peqAcoef(:)
+       sum_petBcoef(:) = sum_petBcoef(:) + petBcoef(:)
+       sum_peqBcoef(:) = sum_peqBcoef(:) + peqBcoef(:)
+       sum_rain(:) = sum_rain(:) + zprecip_rain(:)
+       sum_snow(:) = sum_snow(:) + zprecip_snow(:)
+       sum_lwdown(:) = sum_lwdown(:) + lwdown(:)
+       sum_pb(:) = sum_pb(:) + pb(:)
+
+!!$       IF ( dt_watch > 3600 ) THEN 
+!!$          julian_watch = date0_shifted+((itau_sechiba-0.5)/dt_split_watch)*dt_watch/one_day
+!!$          CALL solarang (julian_watch, julian0, iim, jjm, tmp_lon, tmp_lat, sinang)
+!!$          WHERE ( sinang(:,:) .LT. EPSILON(un) )
+!!$             isinang(:,:) = isinang(:,:) - 1
+!!$          ENDWHERE
+!!$          mean_sinang(:,:) = mean_sinang(:,:)+sinang(:,:)
+!!$          !
+!!$          DO ik=1,kjpindex          
+!!$             j = ((kindex(ik)-1)/iim) + 1
+!!$             i = (kindex(ik) - (j-1)*iim)
+!!$             
+!!$             sum_swnet(ik) = sum_swnet(ik) + sinang(i,j)*swnet(ik)
+!!$             sum_swdown(ik) = sum_swdown(ik) + sinang(i,j)*swdown(ik)
+!!$          ENDDO
+!!$       ELSE
+          sum_swnet(:) = sum_swnet(:) + swnet(:)
+          sum_swdown(:) = sum_swdown(:) + swdown(:)
+!!$       ENDIF
+          
+       do_watch = .FALSE.
+       call isittime &
+            &  (itau_sechiba,date0_shifted,xrdt,dt_watch,&
+            &   last_action_watch,last_check_watch,do_watch)
+       last_check_watch = itau_sechiba
+       IF (do_watch) THEN
+          !
+          IF ( check ) WRITE(numout,*) 'save watchout'
+          !
+          IF (long_print) THEN
+             WRITE(numout,*) "intersurf : write watchout for date ",date0,date0_shifted,itau_sechiba, &
+                  & last_action_watch,last_check_watch
+          ENDIF
+          last_action_watch = itau_sechiba
+
+          sum_zlev(:) = sum_zlev(:) / dt_split_watch
+          sum_u(:) = sum_u(:) / dt_split_watch
+          sum_v(:) = sum_v(:) / dt_split_watch
+          sum_qair(:) = sum_qair(:) / dt_split_watch
+          sum_temp_air(:) = sum_temp_air(:) / dt_split_watch
+          sum_epot_air(:) = sum_epot_air(:) / dt_split_watch
+          sum_ccanopy(:) = sum_ccanopy(:) / dt_split_watch
+          sum_cdrag(:) = sum_cdrag(:) / dt_split_watch
+          sum_petAcoef(:) = sum_petAcoef(:) / dt_split_watch
+          sum_peqAcoef(:) = sum_peqAcoef(:) / dt_split_watch
+          sum_petBcoef(:) = sum_petBcoef(:) / dt_split_watch
+          sum_peqBcoef(:) = sum_peqBcoef(:) / dt_split_watch
+          sum_rain(:) = sum_rain(:) / dt_split_watch
+          sum_snow(:) = sum_snow(:) / dt_split_watch
+          sum_lwdown(:) = sum_lwdown(:) / dt_split_watch
+          sum_pb(:) = sum_pb(:) / dt_split_watch
+
+!!$          IF ( dt_watch > 3600 ) THEN 
+!!$             WHERE ( isinang(:,:) .GT. 0 )
+!!$                mean_sinang(:,:) = mean_sinang(:,:) / isinang(:,:)
+!!$             ENDWHERE
+!!$             !
+!!$             DO ik=1,kjpindex          
+!!$                j = ((kindex(ik)-1)/iim) + 1
+!!$                i = (kindex(ik) - (j-1)*iim)
+!!$                IF (mean_sinang(i,j) > zero) THEN
+!!$                   sum_swdown(ik) = sum_swdown(ik)/mean_sinang(i,j)
+!!$                   sum_swnet(ik) =  sum_swnet(ik)/mean_sinang(i,j)
+!!$                ELSE
+!!$                   sum_swdown(ik) = zero
+!!$                   sum_swnet(ik) =  zero
+!!$                ENDIF
+!!$             ENDDO
+!!$          ELSE
+             sum_swnet(:) = sum_swnet(:) / dt_split_watch
+             sum_swdown(:) = sum_swdown(:) / dt_split_watch
+!!$          ENDIF
+
+          CALL watchout_write_p(kjpindex, itau_sechiba, xrdt, sum_zlev, sum_swdown, sum_rain, &
+               &   sum_snow, sum_lwdown, sum_pb, sum_temp_air, sum_epot_air, sum_qair, &
+               &   sum_u, sum_v, sum_swnet, sum_petAcoef, sum_peqAcoef, sum_petBcoef, sum_peqBcoef, &
+               &   sum_cdrag, sum_ccanopy )
+       ENDIF       
+    ENDIF
+    !
+    ! 6. scatter output fields
+    !
+    z0(:)           = undef_sechiba
+    coastalflow(:)  = undef_sechiba
+    riverflow(:)    = undef_sechiba
+    tsol_rad(:)     = undef_sechiba
+    vevapp(:)       = undef_sechiba
+    temp_sol_new(:) = undef_sechiba
+    qsurf(:)        = undef_sechiba
+    albedo(:,1)     = undef_sechiba
+    albedo(:,2)     = undef_sechiba
+    fluxsens(:)     = undef_sechiba
+    fluxlat(:)      = undef_sechiba
+    emis(:)         = undef_sechiba
+    cdrag(:)        = undef_sechiba
+    !    
+
+    DO ik=1, kjpindex
+       
+       z0(ik)           = zz0(ik)
+       coastalflow(ik)  = zcoastal(ik)/mille
+       riverflow(ik)    = zriver(ik)/mille
+       tsol_rad(ik)     = ztsol_rad(ik)
+       vevapp(ik)       = zvevapp(ik)
+       temp_sol_new(ik) = ztemp_sol_new(ik)
+       qsurf(ik)        = zqsurf(ik)
+       albedo(ik,1)     = zalbedo(ik,1)
+       albedo(ik,2)     = zalbedo(ik,2)
+       fluxsens(ik)     = zfluxsens(ik)
+       fluxlat(ik)      = zfluxlat(ik)
+       emis(ik)         = zemis(ik)
+       cdrag(ik)        = zcdrag(ik)
+       
+      
+
+       
+    ENDDO
+
+    !
+    ! Modified fields for variables scattered during the writing
+    !
+    dcoastal(:) = (zcoastal(:))/mille
+    driver(:)   = (zriver(:))/mille
+    !
+    IF ( .NOT. l_first_intersurf) THEN
+       !
+       IF ( .NOT. almaoutput ) THEN
+          !
+          !  scattered during the writing
+          !           
+          CALL histwrite_p (hist_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
+          ! 
+          CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+
+          CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'fluxlat',  itau_sechiba, zfluxlat,  kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'swnet',    itau_sechiba, swnet,    kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'swdown',   itau_sechiba, swdown,   kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'tair',     itau_sechiba, temp_air, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'qair',     itau_sechiba, qair, kjpindex, kindex)
+          IF (ok_q2m_t2m) THEN
+             CALL histwrite_p (hist_id, 't2m',      itau_sechiba, t2m, kjpindex, kindex)
+             CALL histwrite_p (hist_id, 'q2m',      itau_sechiba, q2m, kjpindex, kindex)
+          ELSE
+            CALL histwrite_p (hist_id, 't2m',      itau_sechiba, temp_air, kjpindex, kindex)
+            CALL histwrite_p (hist_id, 'q2m',      itau_sechiba, qair, kjpindex, kindex)
+          ENDIF
+          !
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite_p (hist2_id, 'evap',     itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
+             ! 
+             CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, temp_sol_new, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, temp_sol_new, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, temp_sol_new, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'fluxlat',  itau_sechiba, zfluxlat,  kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'swnet',    itau_sechiba, swnet,    kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'swdown',   itau_sechiba, swdown,   kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'alb_vis',  itau_sechiba, zalbedo(:,1), kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'alb_nir',  itau_sechiba, zalbedo(:,2), kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'tair',     itau_sechiba, temp_air, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'qair',     itau_sechiba, qair, kjpindex, kindex)
+             IF (ok_q2m_t2m) THEN
+                CALL histwrite_p (hist2_id, 't2m',      itau_sechiba, t2m, kjpindex, kindex)
+                CALL histwrite_p (hist2_id, 'q2m',      itau_sechiba, q2m, kjpindex, kindex)
+             ELSE
+               CALL histwrite_p (hist2_id, 't2m',      itau_sechiba, temp_air, kjpindex, kindex)
+               CALL histwrite_p (hist2_id, 'q2m',      itau_sechiba, qair, kjpindex, kindex)
+            ENDIF
+          ENDIF
+       ELSE
+          CALL histwrite_p (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'SWnet',    itau_sechiba, swnet, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+          CALL histwrite_p (hist_id, 'RadT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+          !
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'SWnet',    itau_sechiba, swnet, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'Qle',  itau_sechiba, zfluxlat, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+             CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
+          ENDIF
+       ENDIF
+
+       !
+       IF (is_omp_root) THEN
+          IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
+             CALL histsync(hist_id)
+          ENDIF
+       ENDIF
+       !
+    ENDIF
+    !
+    ! 7. Transform the water fluxes into Kg/m^2s and m^3/s
+    !
+    DO ik=1, kjpindex
+
+       vevapp(ik) = vevapp(ik)/xrdt
+       coastalflow(ik) = coastalflow(ik)/xrdt
+       riverflow(ik) = riverflow(ik)/xrdt
+
+    ENDDO
+    !
+    WRITE(numout,*) "Give fields to atmosphere."
+    
+    ! Fields for emission variables : to be transport by GCM to chemistry model.
+    DO i_fields_out=1,nb_fields_out
+       SELECT CASE(TRIM(field_out_names(i_fields_out)))
+       CASE("fCO2_land") 
+          fields_out(:,i_fields_out)=znetco2(:)
+       CASE("fCO2_land_use")
+          fields_out(:,i_fields_out)=zcarblu(:)
+       CASE DEFAULT 
+          CALL ipslerr_p (3,'intsurf_gathered', &
+            &          'You ask from GCM an unknown field '//TRIM(field_out_names(i_fields_out))//&
+            &          ' to ORCHIDEE for this specific version.',&
+            &          'This model won''t be able to continue.', &
+            &          '(check your tracer parameters in GCM)')
+       END SELECT
+    ENDDO
+    !
+    IF ( lrestart_write .AND. ok_watchout .AND. is_root_prc ) THEN
+       CALL watchout_close()
+    ENDIF
+    !
+    IF(l_first_intersurf .AND. is_root_prc) CALL getin_dump
+    l_first_intersurf = .FALSE.
+    !
+    IF (long_print) WRITE (numout,*) ' intersurf_main done '
+
+!Test ORCHIDEE Outputs
+    IF (check_INPUTS) THEN
+       IF ( sec <= 7200 ) THEN
+          CALL WriteFieldI_p("Wcdrag",cdrag)
+          WRITE(numout,*) "Cdrag :",cdrag
+          CALL WriteFieldI_p("Wz0",z0)
+          WRITE(numout,*) "Surface roughness :",z0
+          CALL WriteFieldI_p("Wcoastalflow",coastalflow)
+          WRITE(numout,*) "Diffuse flow of water into the ocean (m^3/dt) :",coastalflow
+          CALL WriteFieldI_p("Wriverflow",riverflow)
+          WRITE(numout,*) "Largest rivers flowing into the ocean (m^3/dt) :",riverflow
+          CALL WriteFieldI_p("Wtsol_rad",tsol_rad)
+          WRITE(numout,*) "Radiative surface temperature :",tsol_rad
+          CALL WriteFieldI_p("Wvevapp",vevapp)
+          WRITE(numout,*) "Total of evaporation :",vevapp
+          CALL WriteFieldI_p("Wtemp_sol_new",temp_sol_new)
+          WRITE(numout,*) "New soil temperature :",temp_sol_new
+          CALL WriteFieldI_p("Wqsurf",qsurf)
+          WRITE(numout,*) "Surface specific humidity :",qsurf
+          CALL WriteFieldI_p("Walbedo_nir",albedo(:,1))
+          WRITE(numout,*) "Albedo nir:",albedo(:,1)
+          CALL WriteFieldI_p("Walbedo_vis",albedo(:,2))
+          WRITE(numout,*) "Albedo vir :",albedo(:,2)
+          CALL WriteFieldI_p("Wfluxsens",fluxsens)
+          WRITE(numout,*) "Sensible chaleur flux :",fluxsens
+          CALL WriteFieldI_p("Wfluxlat",fluxlat)
+          WRITE(numout,*) "Latent chaleur flux :",fluxlat
+          CALL WriteFieldI_p("Wemis",emis)
+          WRITE(numout,*) "Emissivity :",emis
+       ENDIF
+    ENDIF
+    !
+    CALL ipslnlf_p(new_number=old_fileout)
+    !        
+  END SUBROUTINE intersurf_gathered
+!
+
+
+  SUBROUTINE intsurf_time(istp, date0, dt)
+    !
+    !  This subroutine initialized the time global variables in grid module.
+    !
+    IMPLICIT NONE
+    !
+    INTEGER(i_std), INTENT(in)                  :: istp      !! Time step of the restart file
+    REAL(r_std), INTENT(in)                     :: date0     !! The date at which itau = 0
+    REAL(r_std), INTENT(in)                     :: dt        !! Time step
+    !
+
+    IF (l_first_intersurf) THEN
+       CALL ioget_calendar(calendar_str)
+       CALL ioget_calendar(one_year, one_day)
+       CALL tlen2itau('1Y',dt,date0,year_length)
+       IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN  
+          year_spread=un
+       ELSE
+          year_spread = one_year/365.2425
+       ENDIF
+
+       IF (check_time) THEN
+          write(numout,*) "calendar_str =",calendar_str
+          write(numout,*) "one_year=",one_year,", one_day=",one_day
+          write(numout,*) "dt=",dt,", date0=",date0,", year_length=",year_length,", year_spread=",year_spread
+       ENDIF
+    ENDIF
+
+    !
+    IF (check_time) &
+         WRITE(numout,*) "---" 
+    ! Dans diffuco (ie date0 == date0_shift !!) 
+
+    IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN  
+       !
+       ! Get Julian date
+       in_julian = itau2date(istp, date0, dt)
+
+       ! Real date
+       CALL ju2ymds (in_julian, year, month, day, sec)
+!!$       jur=zero
+!!$       julian_diff = in_julian
+!!$       month_len = ioget_mon_len (year,month)
+!!$       IF (check_time) THEN
+!!$          write(numout,*) "in_julian, jur, julian_diff=",in_julian, jur, julian_diff
+!!$          write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+!!$       ENDIF
+
+       ! julian number for january, the first.
+       CALL ymds2ju (year,1,1,zero, julian0)
+       julian_diff = in_julian-julian0
+       ! real number of seconds
+!       sec = (julian_diff-REAL(INT(julian_diff)))*one_day
+       sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day)
+       month_len = ioget_mon_len (year,month)
+       IF (check_time) THEN
+          write(numout,*) "2 in_julian, julian0, julian_diff=",in_julian, julian0, julian_diff
+          write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+       ENDIF
+    ELSE 
+!!$       in_julian = itau2date(istp-1, zero, dt)
+!!$       CALL ju2ymds (in_julian, year, month, day, sec)
+!!$       jur=zero
+!!$       julian_diff = in_julian
+!!$       month_len = ioget_mon_len (year,month)
+!!$       IF (check_time) THEN
+!!$          write(numout,*) "in_julian=",in_julian, jur, julian_diff
+!!$          write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+!!$       ENDIF
+!!$
+!!$
+!!$       CALL ymds2ju (year,1,1,zero, jur)
+!!$       julian_diff = in_julian-jur
+!!$       CALL ju2ymds (julian_diff, year, month, day, sec)
+!!$!       sec = (julian_diff-REAL(INT(julian_diff)))*one_day
+!!$       sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day)
+!!$       month_len = ioget_mon_len (year,month)
+!!$       IF (check_time) THEN
+!!$          write(numout,*) "2 in_julian, jur, julian_diff=",in_julian, jur, julian_diff
+!!$          write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+!!$       ENDIF
+
+
+!!$       IF (check_time) &
+!!$            WRITE(numout,*) "-"
+
+!MM
+!PB date0 = celui de Soenke (Ã  tester avec un autre date0)
+!       in_julian = itau2date(istp, 153116., dt)
+       in_julian = itau2date(istp, date0, dt)
+       CALL itau2ymds(istp, dt, year, month, day, sec)
+       CALL ymds2ju (year,1,1,zero, julian0)
+       julian_diff = in_julian - julian0
+       month_len = ioget_mon_len (year,month)
+       IF (check_time) THEN
+          write(numout,*) "in_julian=",in_julian, julian0, julian_diff
+          write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
+       ENDIF
+    ENDIF
+!!$    IF (check_time) &
+!!$         WRITE(numout,*) "---" 
+
+  END SUBROUTINE intsurf_time
+!
+
+!-------------------------------------------------------------------------------------
+!
+  SUBROUTINE intsurf_config(control_flags,dt)
+
+    !
+    !  This subroutine reads all the configuration flags which control the behaviour of the model
+    !
+    IMPLICIT NONE
+    !
+    REAL, INTENT(in)                           :: dt            !! Time step in seconds
+    !
+    TYPE(control_type), INTENT(out)            :: control_flags !! Flags that (de)activate parts of the model
+    ! LOCAL
+    INTEGER(i_std)                         :: jv
+
+    !
+    !Config Key   = LONGPRINT
+    !Config Desc  = ORCHIDEE will print more messages
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = This flag permits to print more debug messages in the run.
+    !Config Units = [FLAG]
+    !
+    long_print = .FALSE.
+    CALL getin_p('LONGPRINT',long_print)
+    !
+    !Config Key   = CHECKTIME
+    !Config Desc  = ORCHIDEE will print messages on time
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = This flag permits to print debug messages on the time.
+    !Config Units = [FLAG]
+    !
+    check_time = .FALSE.
+    CALL getin_p('CHECKTIME',check_time)
+    !
+    !Config Key   = SOILTYPE_CLASSIF
+    !Config Desc  = Type of classification used for the map of soil types 
+    !Config Def   = zobler
+    !Config If    = !IMPOSE_VEG
+    !Config Help  = The classification used in the file that we use here 
+    !Config         There are three classification supported:  
+    !Config         FAO (3 soil types), Zobler (7 converted to 3) and USDA (12) 
+    !Config Units = [-]
+    !
+    !-tdo- Suivant le type de classification utilisee pour le sol, on adapte nscm 
+    soil_classif = 'zobler'
+    CALL getin_p('SOILTYPE_CLASSIF',soil_classif)
+    SELECTCASE (soil_classif)
+    CASE ('zobler', 'fao','none')
+       nscm = nscm_fao
+    CASE ('usda')
+       nscm = nscm_usda
+    CASE DEFAULT
+       WRITE(numout,*) "Unsupported soil type classification. Choose between zobler, fao and usda according to the map"
+       STOP 'intsurf_config'
+    ENDSELECT
+    !
+    !Config Key   = ORCHIDEE_WATCHOUT
+    !Config Desc  = ORCHIDEE will write out its forcing to a file
+    !Config If    =
+    !Config Def   = n
+    !Config Help  = This flag allows to write to a file all the variables
+    !Config         which are used to force the land-surface. The file 
+    !Config         has exactly the same format than a normal off-line forcing
+    !Config         and thus this forcing can be used for forcing ORCHIDEE.
+    !Config Units = [FLAG]
+    !
+    ok_watchout = .FALSE.
+    CALL getin_p('ORCHIDEE_WATCHOUT',ok_watchout)
+    !
+    IF (ok_watchout) THEN
+       !Config Key   = DT_WATCHOUT
+       !Config Desc  = ORCHIDEE will write out with this frequency
+       !Config If    = ORCHIDEE_WATCHOUT
+       !Config Def   = dt
+       !Config Help  = This flag indicates the frequency of the write of the variables. 
+       !Config Units = [seconds]
+       !
+       dt_watch = dt
+       CALL getin_p('DT_WATCHOUT',dt_watch)
+       dt_split_watch = dt_watch / dt
+       !
+       !Config Key   = WATCHOUT_FILE
+       !Config Desc  = Filenane for the ORCHIDEE forcing file
+       !Config If    = ORCHIDEE_WATCHOUT
+       !Config Def   = orchidee_watchout.nc
+       !Config Help  = This is the name of the file in which the
+       !Config         forcing used here will be written for later use. 
+       !Config Units = [FILE]
+       !
+       watchout_file = "orchidee_watchout.nc"
+       CALL getin_p('WATCHOUT_FILE',watchout_file)
+       
+       WRITE(numout,*) 'WATCHOUT flag :', ok_watchout
+       WRITE(numout,*) 'WATCHOUT file :', watchout_file
+    ENDIF
+    !
+    !Config Key   = RIVER_ROUTING
+    !Config Desc  = Decides if we route the water or not
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = This flag allows the user to decide if the runoff
+    !Config         and drainage should be routed to the ocean
+    !Config         and to downstream grid boxes.
+    !Config Units = [FLAG]
+    !
+    control_flags%river_routing = .FALSE.
+    CALL getin_p('RIVER_ROUTING', control_flags%river_routing)
+    WRITE(numout,*) "RIVER routing is activated : ",control_flags%river_routing
+    !
+    !Config key   = HYDROL_CWRR
+    !Config Desc  = Allows to switch on the multilayer hydrology of CWRR
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = This flag allows the user to decide if the vertical
+    !Config         hydrology should be treated using the multi-layer 
+    !Config         diffusion scheme adapted from CWRR by Patricia de Rosnay.
+    !Config         by default the Choisnel hydrology is used.
+    !Config Units = [FLAG]
+    !
+    control_flags%hydrol_cwrr = .FALSE.
+    CALL getin_p('HYDROL_CWRR', control_flags%hydrol_cwrr)
+    WRITE(numout,*) "CWRR hydrology is activated : ",control_flags%hydrol_cwrr
+    !
+    IF ( control_flags%hydrol_cwrr ) THEN
+       dpu_max = 2.0
+    ELSE
+       WRITE(numout,*) "#################################################"
+       WRITE(numout,*) "################# WARNING #######################"
+       WRITE(numout,*) "#  THIS VERSION CAN RUN ONLY IF THE HYDROL_CWRR #"
+       WRITE(numout,*) "#          FLAG IS ACTIVATED PLEASE ADD         #"
+       WRITE(numout,*) "#       ok_newhydrol = y IN YOUR .card file     #"
+       WRITE(numout,*) "#################################################"
+       STOP
+       dpu_max = 4.0
+    END IF
+
+    !Config Key   = HYDROL_SOIL_DEPTH
+    !Config Desc  = Total depth of soil reservoir
+    !Config If    = OK_SECHIBA 
+    !Config Def   = 4./ 2. (if HYDROL_CWRR)
+    !Config Help  = By default, ORCHIDEE uses the AR5 configuration (Choisnel-4m).
+    !Config Units = [m]
+    CALL getin_p ("HYDROL_SOIL_DEPTH", dpu_max)
+    WRITE(numout,*) "Soil depth value read in configuration file run.def : ", dpu_max
+    !
+    DO jv = 1, nslm-1
+       diaglev(jv) = dpu_max/(2**(nslm-1) -1) * ( ( 2**(jv-1) -1) + ( 2**(jv) -1) ) / deux
+    ENDDO
+    diaglev(nslm) = dpu_max
+    !
+    !Config Key   = DO_IRRIGATION
+    !Config Desc  = Should we compute an irrigation flux 
+    !Config If    = RIVER_ROUTING 
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to compute an irigation flux. This performed for the
+    !Config         on very simple hypothesis. The idea is to have a good
+    !Config         map of irrigated areas and a simple function which estimates
+    !Config         the need to irrigate.
+    !Config Units = [FLAG]
+    !
+    control_flags%do_irrigation = .FALSE.
+    CALL getin_p('DO_IRRIGATION', control_flags%do_irrigation)
+    !
+    !Config Key   = DO_FLOODPLAINS
+    !Config Desc  = Should we include floodplains 
+    !Config If    = RIVER_ROUTING 
+    !Config Def   = n
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the flood plains and return 
+    !Config         the water into the soil moisture. It then can go 
+    !Config         back to the atmopshere. This tried to simulate 
+    !Config         internal deltas of rivers.
+    !Config Units = [FLAG]  
+    !
+    control_flags%do_floodplains = .FALSE.
+    CALL getin_p('DO_FLOODPLAINS', control_flags%do_floodplains)
+    !
+    !Config Key   = CHECK_WATERBAL
+    !Config Desc  = Should we check the global water balance 
+    !Config If    = OK_SECHIBA
+    !Config Def   = FALSE
+    !Config Help  = This parameters allows the user to check
+    !Config         the integrated water balance at the end
+    !Config         of each time step
+    !Config Units = [FLAG]  
+    !
+    check_waterbal = .FALSE.
+    CALL getin_p('CHECK_WATERBAL', check_waterbal)
+    !
+    !Config Key   = STOMATE_OK_CO2
+    !Config Desc  = Activate CO2?
+    !Config If    = OK_SECHIBA 
+    !Config Def   = n
+    !Config Help  = set to TRUE if photosynthesis is to be activated
+    !Config Units = [FLAG]
+    !
+    control_flags%ok_co2 = .FALSE.
+    CALL getin_p('STOMATE_OK_CO2', control_flags%ok_co2)
+    WRITE(numout,*) 'photosynthesis: ', control_flags%ok_co2
+    !
+    !Config Key   = STOMATE_OK_STOMATE
+    !Config Desc  = Activate STOMATE?
+    !Config If    = OK_SECHIBA and OK_CO2
+    !Config Def   = n
+    !Config Help  = set to TRUE if STOMATE is to be activated
+    !Config Units = [FLAG]
+    !
+    control_flags%ok_stomate = .FALSE.
+    CALL getin_p('STOMATE_OK_STOMATE',control_flags%ok_stomate)
+    WRITE(numout,*) 'STOMATE is activated: ',control_flags%ok_stomate
+    !
+    !Config Key   = STOMATE_OK_DGVM
+    !Config Desc  = Activate DGVM?
+    !Config If    = OK_STOMATE
+    !Config Def   = n
+    !Config Help  = set to TRUE if DGVM is to be activated
+    !Config Units = [FLAG]
+    !
+    control_flags%ok_dgvm = .FALSE.
+    CALL getin_p('STOMATE_OK_DGVM',control_flags%ok_dgvm)
+    !
+    !Config Key   = DIFFUCO_OK_INCA
+    !Config Desc  = Activate DIFFUCO_INCA?
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = set to TRUE if biogenic emissions calculation is to be activated
+    !Config Units = [FLAG]
+    !
+    control_flags%ok_inca = .FALSE.
+    CALL getin_p('DIFFUCO_OK_INCA', control_flags%ok_inca)
+    WRITE(numout,*) 'Biogenic emissions: ', control_flags%ok_inca
+    !
+    !Config Key   = LEAFAGE_OK_INCA
+    !Config Desc  = Activate LEAFAGE?
+    !Config If    = DIFFUCO_OK_INCA
+    !Config Def   = n
+    !Config Help  = set to TRUE if biogenic emissions calculation takes leaf age into account
+    !Config Units = [FLAG]
+    !
+    control_flags%ok_leafage = .FALSE.
+    CALL getin_p('LEAFAGE_OK_INCA', control_flags%ok_leafage)
+    WRITE(numout,*) 'Leaf Age: ', control_flags%ok_leafage
+    !
+    !Config Key   = CANOPY_EXTINCTION 
+    !Config Desc  = Use canopy radiative transfer model?
+    !Config If    = DIFFUCO_OK_INCA 
+    !Config Def   = n
+    !Config Help  = set to TRUE if canopy radiative transfer model is used for biogenic emissions 
+    !Config Units = [FLAG]
+    !
+    control_flags%ok_radcanopy = .FALSE.
+    CALL getin_p('CANOPY_EXTINCTION', control_flags%ok_radcanopy)
+    WRITE(numout,*) 'Canopy radiative transfer model: ', control_flags%ok_radcanopy
+    !
+    !Config Key   = CANOPY_MULTILAYER
+    !Config Desc  = Use canopy radiative transfer model with multi-layers
+    !Config If    = CANOPY_EXTINCTION 
+    !Config Def   = n
+    !Config Help  = set to TRUE if canopy radiative transfer model is with multiple layers 
+    !Config Units = [FLAG]
+    !
+    control_flags%ok_multilayer = .FALSE.
+    CALL getin_p('CANOPY_MULTILAYER', control_flags%ok_multilayer)
+    WRITE(numout,*) 'Multi-layer Canopy model: ', control_flags%ok_multilayer
+    !
+    !Config Key   = NOx_RAIN_PULSE
+    !Config Desc  = Calculate NOx emissions with pulse?
+    !Config If    = DIFFUCO_OK_INCA 
+    !Config Def   = n
+    !Config Help  = set to TRUE if NOx rain pulse is taken into account
+    !Config Units = [FLAG]
+    !
+    control_flags%ok_pulse_NOx = .FALSE.
+    CALL getin_p('NOx_RAIN_PULSE', control_flags%ok_pulse_NOx)
+    WRITE(numout,*) 'Rain NOx pulsing: ', control_flags%ok_pulse_NOx
+    !
+    !Config Key   = NOx_BBG_FERTIL
+    !Config Desc  = Calculate NOx emissions with bbg fertilizing effect?
+    !Config If    = DIFFUCO_OK_INCA 
+    !Config Def   = n
+    !Config Help  = set to TRUE if NOx emissions are calculated with bbg effect 
+    !Config         Fertil effect of bbg on NOx soil emissions 
+    !Config Units = [FLAG]
+    !
+    control_flags%ok_bbgfertil_NOx = .FALSE.
+    CALL getin_p('NOx_BBG_FERTIL', control_flags%ok_bbgfertil_NOx)
+    WRITE(numout,*) 'NOx bbg fertil effect: ', control_flags%ok_bbgfertil_NOx
+    !
+    !Config Key   = NOx_FERTILIZERS_USE
+    !Config Desc  = Calculate NOx emissions with fertilizers use?
+    !Config If    = DIFFUCO_OK_INCA 
+    !Config Def   = n
+    !Config Help  = set to TRUE if NOx emissions are calculated with fertilizers use
+    !Config         Fertilizers use effect on NOx soil emissions  
+    !Config Units = [FLAG] 
+    !
+    control_flags%ok_cropsfertil_NOx = .FALSE.
+    CALL getin_p('NOx_FERTILIZERS_USE', control_flags%ok_cropsfertil_NOx)
+    WRITE(numout,*) 'NOx Fertilizers use: ', control_flags%ok_cropsfertil_NOx
+    !
+    !Config Key   = LD_DOC
+    !Config Desc  = activate debug comments for DOC module
+    !Config If    = ld_doc
+    !Config Def   = n
+    !Config Help  = set to TRUE if we want debug mode for DOC module
+    !Config       DOC processes commented 
+    !Config Units = [FLAG] 
+    !
+    control_flags%ld_doc = .FALSE.
+    CALL getin_p('LD_DOC', control_flags%ld_doc)
+    WRITE(numout,*) 'LD_DOC: ', control_flags%ld_doc
+
+
+    !
+    ! control initialisation with sechiba
+    !
+    control_flags%ok_sechiba = .TRUE.
+    !
+    !
+    ! Ensure consistency
+    !
+    IF ( control_flags%ok_dgvm ) control_flags%ok_stomate = .TRUE.
+    IF ( control_flags%ok_stomate ) control_flags%ok_co2 = .TRUE.
+    IF ( control_flags%ok_multilayer .AND. .NOT.(control_flags%ok_radcanopy) ) THEN
+       control_flags%ok_radcanopy  = .TRUE.
+       WRITE(numout,*) 'You want to use the multilayer model without activating the flag CANOPY_EXTINCTION'
+       WRITE(numout,*) 'We set CANOPY_EXTINCTION to TRUE to ensure consistency'
+    ENDIF
+    !
+    !Config Key   = STOMATE_WATCHOUT
+    !Config Desc  = STOMATE does minimum service
+    !Config If    = OK_SECHIBA 
+    !Config Def   = n
+    !Config Help  = set to TRUE if you want STOMATE to read
+    !Config         and write its start files and keep track
+    !Config         of longer-term biometeorological variables.
+    !Config         This is useful if OK_STOMATE is not set,
+    !Config         but if you intend to activate STOMATE later.
+    !Config         In that case, this run can serve as a 
+    !Config         spinup for longer-term biometeorological
+    !Config         variables.
+    !Config Units = [FLAG]
+    !
+    control_flags%stomate_watchout = .FALSE.
+    CALL getin_p('STOMATE_WATCHOUT',control_flags%stomate_watchout)
+    WRITE(numout,*) 'STOMATE keeps an eye open: ',control_flags%stomate_watchout
+    !
+    ! Here we need the same initialisation as above
+    !
+    control_flags%ok_pheno = .TRUE.
+    !
+
+    !
+    ! Configuration : number of PFTs and parameters
+    !
+
+    ! 1. Number of PFTs defined by the user
+
+    !Config Key   = NVM
+    !Config Desc  = number of PFTs  
+    !Config If    = OK_SECHIBA or OK_STOMATE
+    !Config Def   = 13
+    !Config Help  = The number of vegetation types define by the user
+    !Config Units = [-]
+    !
+    CALL getin_p('NVM',nvm)
+    WRITE(numout,*)'the number of pfts used by the model is : ', nvm
+
+    ! 2. Should we read the parameters in the run.def file ?
+
+    !Config Key   = IMPOSE_PARAM
+    !Config Desc  = Do you impose the values of the parameters?
+    !Config if    = OK_SECHIBA or OK_STOMATE
+    !Config Def   = y
+    !Config Help  = This flag can deactivate the reading of some parameters.
+    !               Useful if you want to use the standard values without commenting the run.def
+    !Config Units = [FLAG]
+    !
+    CALL getin_p('IMPOSE_PARAM',impose_param)
+
+    ! 3. Allocate and intialize the pft parameters
+
+    CALL pft_parameters_main(control_flags)
+
+    ! 4. Activation sub-models of ORCHIDEE
+
+    CALL activate_sub_models(control_flags)
+
+    ! 5. Vegetation configuration (impose_veg, land_use, lcchange...previously in slowproc)
+
+    CALL veget_config
+
+    ! 6. Read the parameters in the run.def file  according the flags
+
+    IF (impose_param ) THEN 
+       CALL config_pft_parameters
+    ENDIF
+
+    IF ( control_flags%ok_sechiba ) THEN
+       IF (impose_param ) THEN
+          CALL config_sechiba_parameters
+          CALL config_soil_parameters(control_flags)
+          CALL config_sechiba_pft_parameters(control_flags)
+          WRITE(numout,*)'    some sechiba parameters have been imposed '
+       ENDIF
+    ENDIF
+
+    IF ( control_flags%ok_co2 ) THEN
+       IF ( impose_param ) THEN
+          CALL config_co2_parameters
+          WRITE(numout,*)'    some co2 parameters have been imposed '         
+       ENDIF
+    ENDIF
+    
+    IF ( control_flags%ok_stomate ) THEN
+       IF ( impose_param ) THEN
+          CALL config_stomate_parameters
+          CALL config_stomate_pft_parameters
+          WRITE(numout,*)'    some stomate parameters have been imposed '
+       ENDIF
+    ENDIF
+    
+    IF ( control_flags%ok_dgvm ) THEN
+       IF ( impose_param ) THEN
+          CALL config_dgvm_parameters
+          WRITE(numout,*)'    some dgvm parameters have been imposed '         
+       ENDIF
+    ENDIF    
+
+    !
+    !
+    RETURN
+    !
+  END SUBROUTINE intsurf_config
+  !
+  !
+  !
+  SUBROUTINE intsurf_restart(istp, iim, jjm, lon, lat, date0, dt, control_flags, rest_id, rest_id_stom, itau_offset)
+
+    USE mod_orchidee_para
+    !
+    !  This subroutine initialized the restart file for the land-surface scheme
+    !
+    IMPLICIT NONE
+    !
+    INTEGER(i_std), INTENT(in)                  :: istp      !! Time step of the restart file
+    INTEGER(i_std), INTENT(in)                  :: iim, jjm  !! Size in x and y of the data to be handeled
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat  !! Logitude and latitude of the data points
+    REAL(r_std)                                 :: date0     !! The date at which itau = 0
+    REAL(r_std)                                 :: dt        !! Time step
+    INTEGER(i_std), INTENT(out)                 :: rest_id, rest_id_stom   !! ID of the restart file
+    INTEGER(i_std), INTENT(out)                 :: itau_offset
+    !
+    TYPE(control_type), INTENT(in)             :: control_flags !! Flags that (de)activate parts of the model
+    !
+    !  LOCAL
+    !
+    REAL(r_std)                 :: dt_rest, date0_rest
+    INTEGER(i_std)              :: itau_dep
+    INTEGER(i_std),PARAMETER    :: llm=1
+    REAL(r_std), DIMENSION(llm) :: lev
+    LOGICAL                    :: overwrite_time
+    REAL(r_std)                 :: in_julian, rest_julian
+    INTEGER(i_std)              :: yy, mm, dd
+    REAL(r_std)                 :: ss
+    !
+    !Config Key   = SECHIBA_restart_in
+    !Config Desc  = Name of restart to READ for initial conditions
+    !Config If    = OK_SECHIBA 
+    !Config Def   = NONE
+    !Config Help  = This is the name of the file which will be opened
+    !Config         to extract the initial values of all prognostic
+    !Config         values of the model. This has to be a netCDF file.
+    !Config         Not truly COADS compliant. NONE will mean that
+    !Config         no restart file is to be expected.
+    !Config Units = [FILE]
+!-
+    CALL getin_p('SECHIBA_restart_in',restname_in)
+    WRITE(numout,*) 'INPUT RESTART_FILE', restname_in
+    !-
+    !Config Key   = SECHIBA_rest_out
+    !Config Desc  = Name of restart files to be created by SECHIBA
+    !Config If    = OK_SECHIBA
+    !Config Def   = sechiba_rest_out.nc
+    !Config Help  = This variable give the name for
+    !Config         the restart files. The restart software within
+    !Config         IOIPSL will add .nc if needed.
+    !Config Units = [FILE]
+    !
+    CALL getin_p('SECHIBA_rest_out', restname_out)
+    !
+    !Config Key   = SECHIBA_reset_time
+    !Config Desc  = Override the time from the restart files for SECHIBA and STOMATE
+    !Config If    = OK_SECHIBA
+    !Config Def   = y
+    !Config Help  = This option allows the model to override the time
+    !Config         found in the restart files of SECHIBA and STOMATE with the time
+    !Config         given by the GCM or the forcing file.
+    !Config Units = [FLAG]
+    !
+    overwrite_time = .TRUE.
+    CALL getin_p('SECHIBA_reset_time', overwrite_time)
+    !
+    lev(:) = zero
+    itau_dep = istp
+    in_julian = itau2date(istp, date0, dt)
+    date0_rest = date0
+    dt_rest = dt
+    !
+    IF (is_root_prc) THEN
+      CALL restini( restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
+         &  restname_out, itau_dep, date0_rest, dt_rest, rest_id, overwrite_time)
+    ELSE
+       rest_id=0
+    ENDIF
+    CALL bcast (itau_dep)
+    CALL bcast (date0_rest)
+    CALL bcast (dt_rest)
+    !
+    !  itau_dep of SECHIBA is phased with the GCM if needed
+    !
+    rest_julian = itau2date(itau_dep, date0_rest, dt_rest)
+    !
+    IF ( ABS( in_julian - rest_julian) .GT. dt/one_day .AND. .NOT. OFF_LINE_MODE ) THEN
+       IF ( overwrite_time ) THEN
+          WRITE(numout,*) 'The SECHIBA restart is not for the same timestep as the GCM,'
+          WRITE(numout,*) 'the two are synchronized. The land-surface conditions can not impose'
+          WRITE(numout,*) 'the chronology of the simulation.'
+          WRITE(numout,*) 'Time step of the GCM :', istp, 'Julian day : ', in_julian
+          CALL ju2ymds(in_julian, yy, mm, dd, ss)
+          WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
+          WRITE(numout,*) 'Time step of SECHIBA :', itau_dep, 'Julian day : ', rest_julian
+          CALL ju2ymds(rest_julian, yy, mm, dd, ss)
+          WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
+
+          itau_offset = itau_dep - istp
+          date0_shifted = date0 - itau_offset*dt/one_day
+!MM_ A VOIR : dans le TAG 1.4 :
+!         date0_shifted = in_julian - itau_dep*dt/one_day
+!MM_ Bon calcul ?
+
+          WRITE(numout,*) 'The new starting date is :', date0_shifted
+          CALL ju2ymds(date0_shifted, yy, mm, dd, ss)
+          WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
+       ELSE
+          WRITE(numout,*) 'IN -> OUT :', istp, '->', itau_dep
+          WRITE(numout,*) 'IN -> OUT :', in_julian, '->', rest_julian
+          WRITE(numout,*) 'SECHIBA''s restart file is not consistent with the one of the GCM'
+          WRITE(numout,*) 'Correct the time axis of the restart file or force the code to change it.'
+          STOP
+       ENDIF
+    ELSE
+       itau_offset = 0
+       date0_shifted = date0
+    ENDIF
+    !
+!!!    CALL ioconf_startdate(date0_shifted)
+    !
+    !=====================================================================
+    !- 1.5 Restart file for STOMATE
+    !=====================================================================
+    IF ( control_flags%ok_stomate .OR. control_flags%stomate_watchout ) THEN 
+       !-
+       ! STOMATE IS ACTIVATED
+       !-
+       !Config Key   = STOMATE_RESTART_FILEIN
+       !Config Desc  = Name of restart to READ for initial conditions of STOMATE
+       !Config If    = STOMATE_OK_STOMATE or STOMATE_WATCHOUT
+       !Config Def   = NONE
+       !Config Help  = This is the name of the file which will be opened
+       !Config         to extract the initial values of all prognostic
+       !Config         values of STOMATE.
+       !Config Units = [FILE]
+       !-
+       CALL getin_p('STOMATE_RESTART_FILEIN',stom_restname_in)
+       WRITE(numout,*) 'STOMATE INPUT RESTART_FILE', stom_restname_in
+       !-
+       !Config Key   = STOMATE_RESTART_FILEOUT
+       !Config Desc  = Name of restart files to be created by STOMATE
+       !Config If    = STOMATE_OK_STOMATE or STOMATE_WATCHOUT
+       !Config Def   = stomate_restart.nc
+       !Config Help  = This is the name of the file which will be opened
+       !Config         to write the final values of all prognostic values
+       !Config         of STOMATE.
+       !Config Units = [FILE]
+       !-
+       CALL getin_p('STOMATE_RESTART_FILEOUT', stom_restname_out)
+       WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE', stom_restname_out
+       !-
+       IF (is_root_prc) THEN
+         CALL restini (stom_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
+            &  stom_restname_out, itau_dep, date0_rest, dt_rest, rest_id_stom, overwrite_time)
+       ELSE
+         rest_id_stom=0
+       ENDIF
+       CALL bcast (itau_dep)
+       CALL bcast (date0_rest)
+       CALL bcast (dt_rest)
+       !-
+    ENDIF
+    !
+  END SUBROUTINE intsurf_restart
+  
+  SUBROUTINE intsurf_history(iim, jjm, lon, lat, istp_old, date0, dt, control_flags, hist_id, hist2_id, &
+       & hist_id_stom, hist_id_stom_IPCC)
+
+    USE mod_orchidee_para
+    !
+    !   
+    !  This subroutine initialized the history files for the land-surface scheme
+    !
+    IMPLICIT NONE
+    !
+    INTEGER(i_std), INTENT(in)                  :: iim, jjm  !! Size in x and y of the data to be handeled
+    REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat  !! Longitude and latitude of the data points
+    INTEGER(i_std), INTENT(in)                  :: istp_old  !! Time step counter
+    REAL(r_std), INTENT(in)                     :: date0     !! Julian day at which istp=0
+    REAL(r_std), INTENT(in)                     :: dt        !! Time step of the counter in seconds
+    !
+    TYPE(control_type), INTENT(in)             :: control_flags !! Flags that (de)activate parts of the model
+    !
+    INTEGER(i_std), INTENT(out)                 :: hist_id !! History file identification for SECHIBA
+    INTEGER(i_std), INTENT(out)                 :: hist2_id !! History file 2 identification for SECHIBA (Hi-frequency ?)
+    !! History file identification for STOMATE and IPCC
+    INTEGER(i_std), INTENT(out)                 :: hist_id_stom, hist_id_stom_IPCC 
+    !
+    !  LOCAL
+    !
+    CHARACTER(LEN=80) :: histname,histname2                    !! Name of history files for SECHIBA
+    CHARACTER(LEN=80) :: stom_histname, stom_ipcc_histname     !! Name of history files for STOMATE
+    LOGICAL           :: ok_histfile2                 !! Flag to switch on histfile 2 for SECHIBA
+    REAL(r_std)       :: dw2                          !! frequency of history write (sec.)
+    CHARACTER(LEN=30)   :: flux_op                    !! Operations to be performed on fluxes
+!    CHARACTER(LEN=30)   :: flux_sc                    !! Operations which do not include a scatter
+    CHARACTER(LEN=40)   :: flux_insec, flux_scinsec   !! Operation in seconds
+    INTEGER(i_std)     :: hist_level, hist2_level     !! history output level (default is 10 => maximum output)
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: &
+         & ave, avecels, avescatter, fluxop, &
+         & fluxop_scinsec, tmincels, tmaxcels, once, sumscatter  !! The various operation to be performed
+!!, tmax, fluxop_sc, fluxop_insec, &
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: &
+         & ave2, avecels2, avescatter2, fluxop2, &
+         & fluxop_scinsec2, tmincels2, tmaxcels2, once2, sumscatter2  !! The various operation to be performed
+!!, tmax2, fluxop_sc2, fluxop_insec2, &
+    CHARACTER(LEN=80) :: global_attribute              !! for writing attributes in the output files
+    INTEGER(i_std)     :: i, jst
+    ! SECHIBA AXIS
+    INTEGER(i_std)     :: hori_id                      !! ID of the default horizontal longitude and latitude map.
+    INTEGER(i_std)     :: vegax_id, laiax_id, solax_id, soltax_id, nobioax_id !! ID's for two vertical coordinates
+    INTEGER(i_std)     :: solayax_id                   !! ID for the vertical axis of the CWRR hydrology 
+    INTEGER(i_std)     :: hori_id2                      !! ID of the default horizontal longitude and latitude map.
+    INTEGER(i_std)     :: vegax_id2, laiax_id2, solax_id2, soltax_id2, nobioax_id2, albax_id2 !! ID's for two vertical coordinates
+    INTEGER(i_std)     :: solayax_id2                   !! ID for the vertical axis of the CWRR hydrology 
+    ! STOMATE AXIS
+    INTEGER(i_std)     :: hist_PFTaxis_id
+     INTEGER(i_std)     :: hist_solax_id
+! deforestation
+    INTEGER(i_std)     :: hist_pool_10axis_id
+    INTEGER(i_std)     :: hist_pool_100axis_id
+    INTEGER(i_std)     :: hist_pool_11axis_id
+    INTEGER(i_std)     :: hist_pool_101axis_id
+    ! STOMATE IPCC AXIS
+    INTEGER(i_std)     :: hist_IPCC_PFTaxis_id
+    !
+    LOGICAL                               :: rectilinear
+    INTEGER(i_std)                         :: ier
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lon_rect, lat_rect
+    !
+    REAL(r_std),DIMENSION(nvm)   :: veg
+    REAL(r_std),DIMENSION(nlai+1):: lai
+    REAL(r_std),DIMENSION(ngrnd) :: sol
+    REAL(r_std),DIMENSION(nstm)  :: soltyp
+    REAL(r_std),DIMENSION(nnobio):: nobiotyp
+    REAL(r_std),DIMENSION(2)     :: albtyp
+    REAL(r_std),DIMENSION(nslm)  :: solay
+    REAL(r_std),DIMENSION(nbdl)  :: zsoil         !! soil depths at diagnostic levels
+    !
+    CHARACTER(LEN=80)           :: var_name           !! To store variables names
+    !
+    ! STOMATE history file
+    REAL(r_std)                  :: hist_days_stom     !!- GK time step in days for this history file
+    REAL(r_std)                  :: hist_dt_stom       !!- GK time step in seconds for this history file
+    REAL(r_std)                  :: dt_slow_           !!  for test : time step of slow processes and STOMATE
+    REAL(r_std),DIMENSION(nvm)   :: hist_PFTaxis       !!- GK An axis we need for the history files
+!
+    REAL(r_std),DIMENSION(10)  :: hist_pool_10axis     !! Deforestation axis
+    REAL(r_std),DIMENSION(100)  :: hist_pool_100axis     !! Deforestation axis
+    REAL(r_std),DIMENSION(11)  :: hist_pool_11axis     !! Deforestation axis
+    REAL(r_std),DIMENSION(101)  :: hist_pool_101axis     !! Deforestation axis
+    !
+    ! IPCC history file
+    REAL(r_std)                  :: hist_days_stom_ipcc     !!- GK time step in days for this history file
+    REAL(r_std)                  :: hist_dt_stom_ipcc       !!- GK time step in seconds for this history file
+!
+    !
+    !
+    !=====================================================================
+    !- 3.0 Setting up the history files
+    !=====================================================================
+    !- 3.1 SECHIBA
+    !=====================================================================
+    !Config Key   = ALMA_OUTPUT
+    !Config Desc  = Should the output follow the ALMA convention
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = If this logical flag is set to true the model
+    !Config         will output all its data according to the ALMA 
+    !Config         convention. It is the recommended way to write
+    !Config         data out of ORCHIDEE.
+    !Config Units = [FLAG]
+    !-
+    almaoutput = .FALSE.
+    CALL getin_p('ALMA_OUTPUT', almaoutput)    
+    WRITE(numout,*) 'ALMA_OUTPUT', almaoutput
+    !-
+    !Config Key   = OUTPUT_FILE
+    !Config Desc  = Name of file in which the output is going to be written
+    !Config If    = OK_SECHIBA
+    !Config Def   = sechiba_history.nc
+    !Config Help  = This file is going to be created by the model
+    !Config         and will contain the output from the model.
+    !Config         This file is a truly COADS compliant netCDF file.
+    !Config         It will be generated by the hist software from
+    !Config         the IOIPSL package.
+    !Config Units = [FILE]
+    !-
+    histname='sechiba_history.nc'
+    CALL getin_p('OUTPUT_FILE', histname)
+    WRITE(numout,*) 'OUTPUT_FILE', histname
+    !-
+    !Config Key   = WRITE_STEP
+    !Config Desc  = Frequency in seconds at which to WRITE output
+    !Config If    = OK_SECHIBA
+    !Config Def   = one_day
+    !Config Help  = This variables gives the frequency the output of
+    !Config         the model should be written into the netCDF file.
+    !Config         It does not affect the frequency at which the
+    !Config         operations such as averaging are done.
+    !Config         That is IF the coding of the calls to histdef
+    !Config         are correct !
+    !Config Units = [seconds]
+    !-
+    dw = one_day
+    CALL getin_p('WRITE_STEP', dw)
+    IF ( dw == 0 ) WRITE(numout,*) ' sechiba_history file will not be created' 
+    !
+    veg(1:nvm)   = (/ (REAL(i,r_std),i=1,nvm) /)
+    lai(1:nlai+1) = (/ (REAL(i,r_std),i=1,nlai+1) /)
+    sol(1:ngrnd) = (/ (REAL(i,r_std),i=1,ngrnd) /)   
+    soltyp(1:nstm) = (/ (REAL(i,r_std),i=1,nstm) /)
+    nobiotyp(1:nnobio) = (/ (REAL(i,r_std),i=1,nnobio) /)
+    albtyp(1:2) = (/ (REAL(i,r_std),i=1,2) /)
+    solay(1:nslm) = (/ (REAL(i,r_std),i=1,nslm) /)
+    !
+    !- We need to flux averaging operation as when the data is written
+    !- from within SECHIBA a scatter is needed. In the driver on the other
+    !- hand the data is 2D and can be written is it is.
+    !-
+    WRITE(flux_op,'("ave(scatter(X*",F8.1,"))")') one_day/dt
+    ! WRITE(flux_op,'("(ave(scatter(X))*",F8.1,")")') one_day/dt
+!    WRITE(flux_sc,'("ave(X*",F8.1,")")') one_day/dt
+!    WRITE(flux_insec,'("ave(X*",F8.6,")")') un/dt
+!    WRITE(flux_insec,'("ave(X*",F12.10,")")') un/dt
+    WRITE(flux_scinsec,'("ave(scatter(X*",F12.10,"))")') un/dt
+    WRITE(numout,*) flux_op, one_day/dt, dt, dw
+    !-
+    !Config Key   = SECHIBA_HISTLEVEL
+    !Config Desc  = SECHIBA history output level (0..10)
+    !Config If    = OK_SECHIBA and HF
+    !Config Def   = 5
+    !Config Help  = Chooses the list of variables in the history file. 
+    !Config         Values between 0: nothing is written; 10: everything is 
+    !Config         written are available More details can be found on the web under documentation.
+    !Config Units = [-]
+    !-
+    hist_level = 5
+    CALL getin_p('SECHIBA_HISTLEVEL', hist_level)
+    !-
+    WRITE(numout,*) 'SECHIBA history level: ',hist_level
+    IF ( (hist_level > max_hist_level).OR.(hist_level < 0) ) THEN
+       STOP 'This history level is not allowed'
+    ENDIF
+    !-
+    !- define operations as a function of history level.
+    !- Above hist_level, operation='never'
+    !-
+    ave(1:max_hist_level) = 'ave(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       ave(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    sumscatter(1:max_hist_level) = 't_sum(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       sumscatter(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+!    avecels(1:max_hist_level) = 'ave(cels(X))'
+!    IF (hist_level < max_hist_level) THEN
+!       avecels(hist_level+1:max_hist_level) = 'never'
+!    ENDIF
+
+    avecels(1:max_hist_level) = 'ave(cels(scatter(X)))'
+    IF (hist_level < max_hist_level) THEN
+       avecels(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+    avescatter(1:max_hist_level) = 'ave(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       avescatter(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    tmincels(1:max_hist_level) = 't_min(cels(scatter(X)))'
+    IF (hist_level < max_hist_level) THEN
+       tmincels(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    tmaxcels(1:max_hist_level) = 't_max(cels(scatter(X)))'
+    IF (hist_level < max_hist_level) THEN
+       tmaxcels(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+!!$    tmax(1:max_hist_level) = 't_max(X)'
+!!$    IF (hist_level < max_hist_level) THEN
+!!$       tmax(hist_level+1:max_hist_level) = 'never'
+!!$    ENDIF
+    fluxop(1:max_hist_level) = flux_op
+    IF (hist_level < max_hist_level) THEN
+       fluxop(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+!!$    fluxop_sc(1:max_hist_level) = flux_sc
+!!$    IF (hist_level < max_hist_level) THEN
+!!$       fluxop_sc(hist_level+1:max_hist_level) = 'never'
+!!$    ENDIF
+!!$    fluxop_insec(1:max_hist_level) = flux_insec
+!!$    IF (hist_level < max_hist_level) THEN
+!!$       fluxop_insec(hist_level+1:max_hist_level) = 'never'
+!!$    ENDIF
+    fluxop_scinsec(1:max_hist_level) = flux_scinsec
+    IF (hist_level < max_hist_level) THEN
+       fluxop_scinsec(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+    once(1:max_hist_level) = 'once(scatter(X))'
+    IF (hist_level < max_hist_level) THEN
+       once(hist_level+1:max_hist_level) = 'never'
+    ENDIF
+
+
+    !- Initialize sechiba_history output file
+    !- 
+    IF ( dw == 0 ) THEN
+       ! sechiba_history file will not be created.
+       hist_id = -1
+
+    ELSE
+       ! sechiba_history file will be created
+
+       !- Calculation necessary for initialization of sechiba_history file
+       !- Check if we have by any change a rectilinear grid. This would allow us to 
+       !- simplify the output files.
+    IF (is_omp_root) THEN
+
+       rectilinear = .FALSE.
+       IF ( ALL(lon(:,:) == SPREAD(lon(:,1), 2, SIZE(lon,2))) .AND. &
+            & ALL(lat(:,:) == SPREAD(lat(1,:), 1, SIZE(lat,1))) ) THEN
+          rectilinear = .TRUE.
+          ALLOCATE(lon_rect(iim),stat=ier)
+          IF (ier .NE. 0) THEN
+             WRITE (numout,*) ' error in lon_rect allocation. We stop. We need iim words = ',iim
+             STOP 'intersurf_history'
+          ENDIF
+          ALLOCATE(lat_rect(jjm),stat=ier)
+          IF (ier .NE. 0) THEN
+             WRITE (numout,*) ' error in lat_rect allocation. We stop. We need jjm words = ',jjm
+             STOP 'intersurf_history'
+          ENDIF
+          lon_rect(:) = lon(:,1)
+          lat_rect(:) = lat(1,:)
+       ENDIF
+       !-
+       !-
+       !-
+       ! Initialize sechiba_history file
+       IF ( .NOT. almaoutput ) THEN
+          !- 
+          IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+             CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id,orch_domain_id)
+#else
+             CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id)
+#endif
+             WRITE(numout,*)  'HISTBEG --->',istp_old,date0,dt,dw,hist_id
+          ELSE
+#ifdef CPP_PARA
+             CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id,domain_id=orch_domain_id)
+#else
+             CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id)
+#endif
+          ENDIF
+          !-
+          CALL histvert(hist_id, 'veget', 'Vegetation types', '1', &
+               &    nvm,   veg, vegax_id)
+          CALL histvert(hist_id, 'laiax', 'Nb LAI', '1', &
+               &    nlai+1,   lai, laiax_id)
+          CALL histvert(hist_id, 'solth', 'Soil levels',      'm', &
+               &    ngrnd, sol, solax_id)
+          CALL histvert(hist_id, 'soiltyp', 'Soil types',      '1', &
+               &    nstm, soltyp, soltax_id)
+          CALL histvert(hist_id, 'nobio', 'Other surface types',      '1', &
+               &    nnobio, nobiotyp, nobioax_id)
+          IF (  control_flags%hydrol_cwrr ) THEN
+             CALL histvert(hist_id, 'solay', 'Hydrol soil levels',      'm', &
+                  &    nslm, -diaglev(1:nslm), solayax_id)
+          ENDIF
+          !-
+          !- SECHIBA_HISTLEVEL = 1
+          !-
+          CALL histdef(hist_id, 'evap', 'Evaporation', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
+          CALL histdef(hist_id, 'coastalflow', 'Diffuse coastal flow', 'm^3/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'riverflow', 'River flow to the oceans', 'm^3/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw) 
+          CALL histdef(hist_id, 'temp_sol', 'Surface Temperature', 'C', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avecels(1), dt,dw)
+          CALL histdef(hist_id, 'rain', 'Rainfall', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
+          CALL histdef(hist_id, 'snowf', 'Snowfall', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
+          CALL histdef(hist_id, 'netrad', 'Net radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'lai', 'Leaf Area Index', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(1), dt,dw)
+          !
+          IF (  control_flags%hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'reinf_slope', 'Slope index for each grid box', '1', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1),  dt,dw)
+             CALL histdef(hist_id, 'soilindex', 'Soil index', '1', &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, once(1),  dt,dw)
+          ENDIF
+          !
+          IF ( control_flags%river_routing ) THEN
+             CALL histdef(hist_id, 'basinmap', 'Aproximate map of the river basins', ' ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw) 
+             CALL histdef(hist_id, 'nbrivers', 'Number or rivers in the outflow grid box', ' ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)  
+          ENDIF
+          !-
+          !- SECHIBA_HISTLEVEL = 2
+          !-
+          CALL histdef(hist_id, 'subli', 'Sublimation', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+          CALL histdef(hist_id, 'evapnu', 'Bare soil evaporation', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+          CALL histdef(hist_id, 'runoff', 'Surface runoff', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+          CALL histdef(hist_id, 'drainage', 'Deep drainage', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+          IF ( control_flags%river_routing ) THEN
+             CALL histdef(hist_id, 'riversret', 'Return from endorheic rivers', 'mm/d', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
+             CALL histdef(hist_id, 'hydrographs', 'Hydrographs of gridbox outflow', 'm^3/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(2), dt,dw)
+          ENDIF
+          IF ( control_flags%hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'evapnu_soil', 'Bare soil evap for soil type', 'mm/d', &
+                  & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
+             CALL histdef(hist_id, 'drainage_soil', 'Drainage for soil type', 'mm/d', &
+                  & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
+             CALL histdef(hist_id, 'transpir_soil', 'Transpir for soil type', 'mm/d', &
+                  & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
+             CALL histdef(hist_id, 'runoff_soil', 'Runoff for soil type', 'mm/d', &
+                  & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
+          ENDIF
+          !
+          CALL histdef(hist_id, 'tair', 'Air Temperature', 'K',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'qair', 'Air humidity', 'g/g',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          ! Ajouts Nathalie - Juillet 2006
+          CALL histdef(hist_id, 'q2m', '2m Air humidity', 'g/g',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 't2m', '2m Air Temperature', 'K',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          ! Fin ajouts Nathalie
+          CALL histdef(hist_id, 'alb_vis', 'Albedo visible', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'alb_nir', 'Albedo near infrared', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          ! Ajouts Nathalie - Septembre 2008
+          CALL histdef(hist_id, 'soilalb_vis', 'Soil Albedo visible', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'soilalb_nir', 'Soil Albedo near infrared', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'vegalb_vis', 'Vegetation Albedo visible', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'vegalb_nir', 'Vegetation Albedo near infrared', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          ! Fin ajouts Nathalie - Septembre 2008
+          CALL histdef(hist_id, 'z0', 'Surface roughness', 'm',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'roughheight', 'Effective roughness height', 'm',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
+          CALL histdef(hist_id, 'transpir', 'Transpiration', 'mm/d', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(2), dt,dw)
+          CALL histdef(hist_id, 'inter', 'Interception loss', 'mm/d', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(2), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 3
+          !-
+          CALL histdef(hist_id, 'tsol_max', 'Maximum Surface Temperature',&
+               & 'C', iim,jjm, hori_id, 1,1,1, -99, 32, tmaxcels(3), dt,dw)
+          CALL histdef(hist_id, 'tsol_min', 'Minimum Surface Temperature',&
+               & 'C', iim,jjm, hori_id, 1,1,1, -99, 32, tmincels(3), dt,dw)
+          CALL histdef(hist_id, 'fluxsens', 'Sensible Heat Flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(3), dt,dw)
+          CALL histdef(hist_id, 'fluxlat', 'Latent Heat Flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(3), dt,dw)
+          CALL histdef(hist_id, 'snow', 'Snow mass', 'kg/m^2', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'snowage', 'Snow age', '?', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'snownobio', 'Snow on other surfaces', 'kg/m^2', &
+               & iim,jjm, hori_id, nnobio,1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'snownobioage', 'Snow age on other surfaces', 'd', &
+               & iim,jjm, hori_id, nnobio,1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'vegetfrac', 'Fraction of vegetation', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'tot_bare_soil', "Total Bare Soil Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'nobiofrac', 'Fraction of other surface types', '1', &
+               & iim,jjm, hori_id, nnobio, 1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
+          IF ( control_flags%do_floodplains ) THEN
+             CALL histdef(hist_id, 'flood_frac', 'Flooded fraction', '1', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
+             CALL histdef(hist_id, 'reinfiltration', 'Reinfiltration from floodplains', 'mm/d', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(3), dt,dw)
+          ENDIF
+          IF ( control_flags%hydrol_cwrr ) THEN
+             DO jst=1,nstm
+             
+                ! var_name= "mc_1" ... "mc_3"
+                WRITE (var_name,"('moistc_',i1)") jst
+                CALL histdef(hist_id, var_name, 'Soil Moisture profile for soil type', '%', &
+                     & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(3),  dt,dw)
+                
+                ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+                WRITE (var_name,"('vegetsoil_',i1)") jst
+                CALL histdef(hist_id, var_name, 'Fraction of vegetation on soil types', '%', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3),  dt,dw)
+                
+                ! var_name= "kfact_root_1" ... "kfact_root_3"
+                WRITE (var_name,"('kfactroot_',i1)") jst
+                CALL histdef(hist_id, var_name, 'Root fraction profile for soil type', '%', &
+                     & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(3), dt,dw)
+                
+             ENDDO
+          ENDIF
+          !
+          CALL histdef(hist_id, 'frac_bare', 'Bare soil fraction for each tile', '-', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'soiltile', 'Fraction of soil tiles', '%', &
+               & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, once(3),  dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 4
+          !-
+          IF ( .NOT. control_flags%hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'dss', 'Up-reservoir Height', 'm',  &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
+             CALL histdef(hist_id, 'gqsb', 'Upper Soil Moisture', 'Kg/m^2',  &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
+             CALL histdef(hist_id, 'bqsb', 'Lower Soil Moisture', 'Kg/m^2',  &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
+          ELSE
+             CALL histdef(hist_id, 'humtot', 'Total Soil Moisture', 'Kg/m^2', &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
+             CALL histdef(hist_id, 'humtot_soil', 'Soil Moisture for soil type', 'Kg/m^2', &
+                  & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, avescatter(4), dt,dw)
+             CALL histdef(hist_id, 'SWI', 'Soil wetness index','-',  &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
+             CALL histdef(hist_id, 'njsc', 'Soil class used for hydrology', '-', &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, once(4), dt,dw)
+          ENDIF
+          CALL histdef(hist_id, 'qsintveg', 'Water on canopy', 'Kg/m^2', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
+          CALL histdef(hist_id, 'rstruct', 'Structural resistance', 's/m', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
+          IF ( control_flags%ok_co2 ) THEN
+             CALL histdef(hist_id, 'gpp', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+          ENDIF
+          IF ( control_flags%ok_stomate ) THEN
+             CALL histdef(hist_id, 'nee', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
+             CALL histdef(hist_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt, dw)
+          ENDIF
+          CALL histdef(hist_id, 'precisol', 'Throughfall', 'mm/d',  &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(4), dt,dw)
+          CALL histdef(hist_id, 'drysoil_frac', 'Fraction of visibly dry soil', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(4), dt,dw)
+          CALL histdef(hist_id, 'evapot', 'Potential evaporation', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(4), dt,dw)
+          CALL histdef(hist_id, 'evapot_corr', 'Potential evaporation', 'mm/d',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(4), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 5
+          !-
+          CALL histdef(hist_id, 'swnet', 'Net solar radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(5), dt,dw)
+          CALL histdef(hist_id, 'swdown', 'Incident solar radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(5), dt,dw)
+          CALL histdef(hist_id, 'lwdown', 'Absorbed downward longwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
+          CALL histdef(hist_id, 'lwnet', 'Net surface longwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 6
+          !-
+          CALL histdef(hist_id, 'ptn', 'Deep ground temperature', 'K', &
+               & iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(6),  dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 7
+          !-
+          IF ( control_flags%river_routing ) THEN
+             CALL histdef(hist_id, 'fastr', 'Fast flow reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
+             CALL histdef(hist_id, 'slowr', 'Slow flow reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
+             CALL histdef(hist_id, 'streamr', 'Stream flow reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
+             CALL histdef(hist_id, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
+             
+             !-
+             !- SECHIBA_HISTLEVEL = 8
+             !-
+             CALL histdef(hist_id, 'pondr', 'Ponds reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+             CALL histdef(hist_id, 'swampmap', 'Map of swamps', 'm^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(8), dt,dw)
+             !
+             IF ( control_flags%do_irrigation ) THEN
+                CALL histdef(hist_id, 'irrigation', 'Net irrigation', 'mm/d', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(8), dt,dw)
+                CALL histdef(hist_id, 'netirrig', 'Net irrigation requirement', 'mm/d', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(8), dt,dw)
+                CALL histdef(hist_id, 'irrigmap', 'Map of irrigated surfaces', 'm^2', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, once(8), dt,dw)
+             ENDIF
+             IF ( control_flags%do_floodplains ) THEN
+                CALL histdef(hist_id, 'floodmap', 'Map of floodplains', 'm^2', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, once(8), dt,dw)
+                CALL histdef(hist_id, 'floodh', 'Floodplains height', 'mm', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+                CALL histdef(hist_id, 'floodr', 'Floodplains reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+                CALL histdef(hist_id, 'floodout', 'Flow out of floodplains', 'mm/d', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(8), dt,dw)
+                CALL histdef(hist_id, 'evapflo', 'Floodplains evaporation', 'mm/d', &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(8), dt,dw)
+             ENDIF
+             !
+          ENDIF
+
+          IF ( control_flags%hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'k_litt', 'Litter cond', 'mm/d', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          ENDIF
+          CALL histdef(hist_id, 'beta', 'Beta Function', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'raero', 'Aerodynamic resistance', 's/m',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          ! Ajouts Nathalie - Novembre 2006
+          CALL histdef(hist_id, 'cdrag', 'Drag coefficient for LE and SH', '?',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'Wind', 'Wind speed', 'm/s',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          ! Fin ajouts Nathalie
+          !
+          CALL histdef(hist_id, 'qsatt' , 'Surface saturated humidity', 'g/g', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'vbeta1', 'Beta for sublimation', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'vbeta4', 'Beta for bare soil', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          CALL histdef(hist_id, 'vbeta5', 'Beta for floodplains', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
+          IF ( control_flags%ok_co2 ) THEN
+             CALL histdef(hist_id, 'vbetaco2', 'beta for CO2', 'mm/d', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(8), dt,dw)
+          ENDIF
+          CALL histdef(hist_id, 'humrel', 'Soil moisture stress', '1',  &
+               & iim,jjm, hori_id, nvm,1,nvm, vegax_id, 32, avescatter(8), dt,dw)
+          !-
+          !- SECHIBA_HISTLEVEL = 9
+          !-
+          !-
+          !- SECHIBA_HISTLEVEL = 10
+          !-
+          IF ( control_flags%ok_co2 ) THEN
+             CALL histdef(hist_id, 'cimean', 'Stomatal CO2 concentation', 'mmole/m2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          ENDIF
+          CALL histdef(hist_id, 'vbeta3', 'Beta for Transpiration', 'mm/d', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'rveget', 'Canopy resistance', 's/m', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          IF ( .NOT. control_flags%hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'rsol', 'Soil resistance', 's/m',  &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(10), dt,dw)
+          ENDIF
+          CALL histdef(hist_id,'vbeta2','Beta for Interception loss','mm/d', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+          CALL histdef(hist_id, 'qsintmax', 'Maximum Interception capacity', 'Kg/m^2', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
+
+          !- SECHIBA_HISTLEVEL = 11
+          !-
+
+          IF ( .NOT. control_flags%hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'mrsos', "Moisture in Upper 0.1 m of Soil Column", "kg m-2", &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+             
+             CALL histdef(hist_id, 'mrso', "Total Soil Moisture Content", "kg m-2", &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+             
+             CALL histdef(hist_id, 'mrros', "Surface Runoff", "kg m-2 s-1", &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+             
+             CALL histdef(hist_id, 'mrro', "Total Runoff", "kg m-2 s-1", &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+             
+             CALL histdef(hist_id, 'prveg', "Precipitation onto Canopy", "kg m-2 s-1", &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+
+          ENDIF
+
+
+          CALL histdef(hist_id, 'evspsblveg', "Evaporation from Canopy", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+          
+          CALL histdef(hist_id, 'evspsblsoi', "Water Evaporation from Soil", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+          
+          CALL histdef(hist_id, 'tran', "Transpiration", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(11), dt,dw)
+          
+          CALL histdef(hist_id, 'treeFrac', "Tree Cover Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'grassFrac', "Natural Grass Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'cropFrac', "Crop Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'baresoilFrac', "Bare Soil Fraction", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          CALL histdef(hist_id, 'residualFrac', &
+               & "Fraction of Grid Cell that is Land but Neither Vegetation-Covered nor Bare Soil", "%", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
+          
+          IF ( control_flags%ok_inca ) THEN
+             CALL histdef(hist_id, 'PAR', 'PAR', 'umol phot/m^2/s',  &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+             IF ( control_flags%ok_radcanopy ) THEN
+                CALL histdef(hist_id, 'PARsun', 'Sunlit Leaf PAR', 'umol phot/m^2/s', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'PARsh', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'laisun', 'Sunlit Leaf Area Index', '1', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'laish', 'Shaded Leaf Area Index', '1', &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'Fdf', 'Fdf', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                IF ( control_flags%ok_multilayer ) then 
+                   CALL histdef(hist_id, 'PARsuntab', 'Sunlit Leaf PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(11), dt,dw)
+                   CALL histdef(hist_id, 'PARshtab', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id, nlai+1, 1, nlai+1, laiax_id, 32, avescatter(11), dt,dw)
+                ENDIF
+                CALL histdef(hist_id, 'Sinang', 'Sinang', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'PARdf', 'PARdf', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'PARdr', 'PARdr', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'Trans', 'Trans', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'Day', 'Day', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+                CALL histdef(hist_id, 'Year_length', 'Year_length', '1',  &
+                     & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+             END IF
+             
+             CALL histdef(hist_id, 'flx_fertil_no', 'flx_fertil_no', 'ngN/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'CRF', 'CRF', '1', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_co2_bbg_year', 'flx_co2_bbg_year', 'kgC/m^2/yr ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(11), dt,dw)  
+             CALL histdef(hist_id, 'N_qt_WRICE_year', 'N_qt_WRICE_year', 'kgN/yr ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(11), dt,dw)  
+             CALL histdef(hist_id, 'N_qt_OTHER_year', 'N_qt_OTHER_year', 'kgN/yr ', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(11), dt,dw)  
+             CALL histdef(hist_id, 'ptnlev1', 'ptnlev1', 'K',  &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_iso', 'flx_iso', 'kgC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_mono', 'flx_mono', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_ORVOC', 'flx_ORVOC', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_MBO', 'flx_MBO', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_methanol', 'flx_methanol', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_acetone', 'flx_acetone', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_acetal', 'flx_acetal', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_formal', 'flx_formal', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_acetic', 'flx_acetic', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_formic', 'flx_formic', 'kgC/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_no_soil', 'flx_no_soil', 'ngN/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+             CALL histdef(hist_id, 'flx_no', 'flx_no', 'ngN/m^2/s',&
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(11), dt,dw)
+          ENDIF
+
+       ELSE 
+          !-
+          !- This is the ALMA convention output now
+          !-
+          !- 
+          IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+             CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id,orch_domain_id)
+#else
+             CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id)
+#endif
+          ELSE
+#ifdef CPP_PARA
+             CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id,domain_id=orch_domain_id)
+#else
+             CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id)
+#endif
+          ENDIF
+          !-
+          CALL histvert(hist_id, 'veget', 'Vegetation types', '1', &
+               &    nvm,   veg, vegax_id)
+          CALL histvert(hist_id, 'solth', 'Soil levels',      'm', &
+               &    ngrnd, sol, solax_id)
+          CALL histvert(hist_id, 'soiltyp', 'Soil types',      '1', &
+               &    nstm, soltyp, soltax_id)
+          CALL histvert(hist_id, 'nobio', 'Other surface types',      '1', &
+               &    nnobio, nobiotyp, nobioax_id)
+          IF (  control_flags%hydrol_cwrr ) THEN
+             CALL histvert(hist_id, 'solay', 'Hydrol soil levels',      'm', &
+                  &    nslm, diaglev(1:nslm), solayax_id)
+          ENDIF
+          !-
+          !-  Vegetation
+          !-
+          CALL histdef(hist_id, 'vegetfrac', 'Fraction of vegetation', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
+               & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
+          CALL histdef(hist_id, 'nobiofrac', 'Fraction of other surface types', '1', &
+               & iim,jjm, hori_id, nnobio, 1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
+          !- 
+          !-  General energy balance
+          !-
+          CALL histdef(hist_id, 'Tair', 'Near surface air temperature at forcing level', 'K',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'Qair', 'Near surface specific humidity at forcing level', 'g/g',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'SWnet', 'Net shortwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
+          CALL histdef(hist_id, 'LWnet', 'Net longwave radiation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'Qh', 'Sensible heat flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
+          CALL histdef(hist_id, 'Qle', 'Latent heat flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
+          CALL histdef(hist_id, 'Qg', 'Ground heat flux', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'Qf', 'Energy of fusion', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
+          CALL histdef(hist_id, 'Qv', 'Energy of sublimation', 'W/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelSurfHeat', 'Change in surface layer heat', 'J/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, sumscatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelColdCont', 'Change in snow surface layer cold content', 'J/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, sumscatter(1), dt,dw)
+          !-
+          !- General water balance
+          !-
+          CALL histdef(hist_id, 'Snowf', 'Snowfall rate', 'kg/m^2/s',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'Rainf', 'Rainfall rate', 'kg/m^2/s',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'Evap', 'Total Evapotranspiration', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'Qs', 'Surface runoff', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'Qsb', 'Sub-surface runoff', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'Qsm', 'Snowmelt', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'DelSoilMoist', 'Change in soil moisture', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelSurfStor', 'Change in Surface Water Storage','kg/m^2',&
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelIntercept', 'Change in interception storage', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
+          CALL histdef(hist_id, 'DelSWE', 'Change in Snow Water Equivalent', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
+          IF ( control_flags%do_irrigation ) THEN
+             CALL histdef(hist_id, 'Qirrig', 'Irrigation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'Qirrig_req', 'Irrigation requirement', 'kg/m^2/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          ENDIF
+          !-
+          !- Surface state
+          !-
+          CALL histdef(hist_id, 'AvgSurfT', 'Average surface temperature', 'K', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
+          CALL histdef(hist_id, 'PotSurfT', 'Potential (Unstressed) surface temperature', 'K', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
+          CALL histdef(hist_id, 'RadT', 'Surface radiative temperature', 'K', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
+          CALL histdef(hist_id, 'Albedo', 'Albedo', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SWI', 'Soil wetness index','1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SurfStor', 'Surface Water Storage','kg/m^2',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SWE', 'Snow Water Equivalent', 'kg/m^2', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          !!-
+          !-  Sub-surface state
+          !- 
+          IF ( .NOT. control_flags%hydrol_cwrr ) THEN
+             CALL histdef(hist_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2',  &
+                  & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
+          ELSE
+             CALL histdef(hist_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2',  &
+                  & iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1), dt,dw)
+          ENDIF
+          CALL histdef(hist_id, 'SoilWet', 'Total soil wetness', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SoilTemp', '3D layer average soil temperature', 'K', &
+               & iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(1),  dt,dw)
+          !- 
+          !-  Evaporation components
+          !-
+          CALL histdef(hist_id, 'PotEvap', 'Potential evapotranspiration', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'PotEvapOld', 'Potential evapotranspiration old method', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'ECanop', 'Interception evaporation', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'TVeg', 'Transpiration', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'ESoil', 'Bare soil evaporation', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'EWater', 'Open water evaporation', 'kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'RootMoist','Root zone soil water', 'kg/m^2',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SubSnow','Snow sublimation','kg/m^2/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          CALL histdef(hist_id, 'ACond', 'Aerodynamic conductance', 'm/s',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          IF ( control_flags%do_floodplains ) THEN
+             CALL histdef(hist_id, 'Qflood', 'Floodplain Evaporation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
+          ENDIF
+          !-
+          !- Surface turbulence
+          !-
+          CALL histdef(hist_id, 'Z0', 'Roughness height', 'm',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'EffectHeight', 'Effective displacement height (h-d)', 'm',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          !-
+          !-
+          !-  Cold Season Processes
+          !-
+          CALL histdef(hist_id, 'SnowFrac', 'Snow cover fraction', '1',  &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SAlbedo', 'Snow albedo', '1', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          CALL histdef(hist_id, 'SnowDepth', '3D snow depth', 'm', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          !-
+          !- Hydrologic variables
+          !-
+          CALL histdef(hist_id, 'SwampMap', 'Map of swamp areas', 'm^2', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
+          CALL histdef(hist_id, 'Dis', 'Simulated River Discharge', 'm^3/s', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(2), dt,dw)
+          IF ( control_flags%do_irrigation ) THEN
+             CALL histdef(hist_id, 'IrrigationMap', 'Map of irrigated areas', 'm^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
+          ENDIF
+          IF ( control_flags%do_floodplains ) THEN
+             CALL histdef(hist_id, 'FloodplainsMap', 'Map of flooded areas', 'm^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
+             CALL histdef(hist_id, 'FloodFrac', 'Floodplain Fraction', '-', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+          ENDIF
+          CALL histdef(hist_id, 'humrel', 'Soil moisture stress', '1',  &
+               & iim,jjm, hori_id, nvm,1,nvm, vegax_id, 32, avescatter(8), dt,dw)
+          !-
+          !-  The carbon budget
+          !-
+          IF ( control_flags%ok_co2 ) THEN
+             CALL histdef(hist_id, 'GPP', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+          ENDIF
+          IF ( control_flags%ok_stomate ) THEN
+             CALL histdef(hist_id, 'NEE', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+             CALL histdef(hist_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                  & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+          ENDIF
+          !
+       ENDIF
+       !-
+       !- Forcing and grid information
+       !-
+       CALL histdef(hist_id, 'LandPoints', 'Land Points', '1', &
+            & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)  
+       CALL histdef(hist_id, 'Areas', 'Mesh areas', 'm2', &
+            & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt, dw)
+       CALL histdef(hist_id, 'Contfrac', 'Continental fraction', '1', &
+            & iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt, dw)
+       !-
+       ! Write the names of the pfts in the history files
+       global_attribute="PFT_name"
+       DO i=1,nvm
+          WRITE(global_attribute(9:10),"(I2.2)") i
+          CALL histglobal_attr(hist_id, global_attribute, PFT_name(i))
+       ENDDO
+       !-
+       CALL histend(hist_id)
+    ENDIF ! IF (is_omp_root)
+ 
+    END IF !IF ( dw == 0 )
+    !
+    !
+    ! Second SECHIBA hist file
+    !
+    !-
+    !Config Key   = SECHIBA_HISTFILE2
+    !Config Desc  = Flag to switch on histfile 2 for SECHIBA (hi-frequency ?)
+    !Config If    = OK_SECHIBA
+    !Config Def   = n
+    !Config Help  = This Flag switch on the second SECHIBA writing for hi (or low) 
+    !Config         frequency writing. This second output is optional and not written
+    !Config         by default.
+    !Config Units = [FLAG]
+    !-
+    ok_histfile2=.FALSE.
+    CALL getin_p('SECHIBA_HISTFILE2', ok_histfile2)
+    WRITE(numout,*) 'SECHIBA_HISTFILE2 ', ok_histfile2
+    !
+    !-
+    !Config Key   = WRITE_STEP2
+    !Config Desc  = Frequency in seconds at which to WRITE output
+    !Config If    = SECHIBA_HISTFILE2
+    !Config Def   = 1800.0
+    !Config Help  = This variables gives the frequency the output 2 of
+    !Config         the model should be written into the netCDF file.
+    !Config         It does not affect the frequency at which the
+    !Config         operations such as averaging are done.
+    !Config         That is IF the coding of the calls to histdef
+    !Config         are correct !
+    !Config Units = [seconds]
+    !-
+    dw2 = 1800.0
+    CALL getin_p('WRITE_STEP2', dw2)
+    
+    ! Deactivate sechiba_histfile2 if the frequency is set to zero
+    IF ( dw2 == 0 ) THEN
+       ok_histfile2=.FALSE.
+       WRITE(numout,*) 'WRITE_STEP2 was set to zero and therfore SECHIBA_HISTFILE2 is deactivated.'
+    ELSE IF ( hist_id < 0 ) THEN
+       ! Deactivate all history files if sechiba_history file is deactivated
+       ok_histfile2=.FALSE.
+       WRITE(numout,*) 'SECHIBA_HISTFILE2 will not be created because sechiba_history file is deactivated.'
+    END IF
+
+    hist2_id = -1
+    !
+    IF (ok_histfile2) THEN
+       !-
+       !Config Key   = SECHIBA_OUTPUT_FILE2
+       !Config Desc  = Name of file in which the output number 2 is going to be written
+       !Config If    = SECHIBA_HISTFILE2
+       !Config Def   = sechiba_out_2.nc
+       !Config Help  = This file is going to be created by the model
+       !Config         and will contain the output 2 from the model.
+       !Config Units = [FILE]
+       !-
+       histname2='sechiba_out_2.nc'
+       CALL getin_p('SECHIBA_OUTPUT_FILE2', histname2)
+       WRITE(numout,*) 'SECHIBA_OUTPUT_FILE2 ', histname2
+       !-
+       !Config Key   = SECHIBA_HISTLEVEL2
+       !Config Desc  = SECHIBA history 2 output level (0..10)
+       !Config If    = SECHIBA_HISTFILE2
+       !Config Def   = 1
+       !Config Help  = Chooses the list of variables in the history file. 
+       !Config         Values between 0: nothing is written; 10: everything is 
+       !Config         written are available More details can be found on the web under documentation.
+       !Config         web under documentation.
+       !Config         First level contains all ORCHIDEE outputs.
+       !Config Units = [-] 
+       !-
+       hist2_level = 1
+       CALL getin_p('SECHIBA_HISTLEVEL2', hist2_level)
+       !-
+       WRITE(numout,*) 'SECHIBA history level 2 : ',hist2_level
+       IF ( (hist2_level > max_hist_level).OR.(hist2_level < 0) ) THEN
+          STOP 'This history level 2 is not allowed'
+       ENDIF
+       !
+       !-
+       !- define operations as a function of history level.
+       !- Above hist2_level, operation='never'
+       !-
+       ave2(1:max_hist_level) = 'ave(scatter(X))'
+       IF (hist2_level < max_hist_level) THEN
+          ave2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       sumscatter2(1:max_hist_level) = 't_sum(scatter(X))'
+       IF (hist2_level < max_hist_level) THEN
+          sumscatter2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       avecels2(1:max_hist_level) = 'ave(cels(scatter(X)))'
+       IF (hist2_level < max_hist_level) THEN
+          avecels2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       avescatter2(1:max_hist_level) = 'ave(scatter(X))'
+       IF (hist2_level < max_hist_level) THEN
+          avescatter2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       tmincels2(1:max_hist_level) = 't_min(cels(scatter(X)))'
+       IF (hist2_level < max_hist_level) THEN
+          tmincels2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       tmaxcels2(1:max_hist_level) = 't_max(cels(scatter(X)))'
+       IF (hist2_level < max_hist_level) THEN
+          tmaxcels2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+!!$       tmax2(1:max_hist_level) = 't_max(X)'
+!!$       IF (hist2_level < max_hist_level) THEN
+!!$          tmax2(hist2_level+1:max_hist_level) = 'never'
+!!$       ENDIF
+       fluxop2(1:max_hist_level) = flux_op
+       IF (hist2_level < max_hist_level) THEN
+          fluxop2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+!!$       fluxop_sc2(1:max_hist_level) = flux_sc
+!!$       IF (hist2_level < max_hist_level) THEN
+!!$          fluxop_sc2(hist2_level+1:max_hist_level) = 'never'
+!!$       ENDIF
+!!$       fluxop_insec2(1:max_hist_level) = flux_insec
+!!$       IF (hist2_level < max_hist_level) THEN
+!!$          fluxop_insec2(hist2_level+1:max_hist_level) = 'never'
+!!$       ENDIF
+       fluxop_scinsec2(1:max_hist_level) = flux_scinsec
+       IF (hist2_level < max_hist_level) THEN
+          fluxop_scinsec2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       once2(1:max_hist_level) = 'once(scatter(X))'
+       IF (hist2_level < max_hist_level) THEN
+          once2(hist2_level+1:max_hist_level) = 'never'
+       ENDIF
+       ! 
+       IF (is_omp_root) THEN
+          IF ( .NOT. almaoutput ) THEN
+             !- 
+             IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+                CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id,orch_domain_id)
+#else
+                CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id)
+#endif
+                WRITE(numout,*)  'HISTBEG2 --->',istp_old,date0,dt,dw2,hist2_id
+             ELSE
+#ifdef CPP_PARA
+                CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id,domain_id=orch_domain_id)
+#else
+                CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id)
+#endif
+             ENDIF
+             !-
+             CALL histvert(hist2_id, 'veget', 'Vegetation types', '1', &
+                  &    nvm,   veg, vegax_id2)
+             CALL histvert(hist2_id, 'laiax', 'Nb LAI', '1', &
+                  &    nlai+1,   lai, laiax_id2)
+             CALL histvert(hist2_id, 'solth', 'Soil levels',      'm', &
+                  &    ngrnd, sol, solax_id2)
+             CALL histvert(hist2_id, 'soiltyp', 'Soil types',      '1', &
+                  &    nstm, soltyp, soltax_id2)
+             CALL histvert(hist2_id, 'nobio', 'Other surface types',      '1', &
+                  &    nnobio, nobiotyp, nobioax_id2)
+             CALL histvert(hist2_id, 'albtyp', 'Albedo Types',     '1', &
+                  &    2, albtyp, albax_id2)
+             IF (  control_flags%hydrol_cwrr ) THEN
+                CALL histvert(hist2_id, 'solay', 'Hydrol soil levels',      'm', &
+                     &    nslm, solay, solayax_id2)
+             ENDIF
+             !-
+             !- SECHIBA_HISTLEVEL2 = 1
+             !-
+             CALL histdef(hist2_id, 'ptn', 'Deep ground temperature', 'K', &
+                  & iim,jjm, hori_id2, ngrnd, 1, ngrnd, solax_id2, 32, avescatter2(1),  dt, dw2)
+             IF ( .NOT. control_flags%hydrol_cwrr ) THEN
+                CALL histdef(hist2_id, 'mrsos', "Moisture in Upper 0.1 m of Soil Column", "kg m-2", &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt,dw2)
+                
+                CALL histdef(hist2_id, 'mrro', "Total Runoff", "kg m-2 s-1", &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(1), dt,dw2)
+             ENDIF
+             !-
+             !- SECHIBA_HISTLEVEL2 = 2
+             !-
+             CALL histdef(hist2_id, 'cdrag', 'Drag coefficient for LE and SH', '?',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt, dw2)
+             ! Ajouts Nathalie - Septembre 2008
+             CALL histdef(hist2_id, 'soilalb_vis', 'Soil Albedo visible', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+             CALL histdef(hist2_id, 'soilalb_nir', 'Soil Albedo near infrared', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+             CALL histdef(hist2_id, 'vegalb_vis', 'Vegetation Albedo visible', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+             CALL histdef(hist2_id, 'vegalb_nir', 'Vegetation Albedo near infrared', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+             ! Fin ajouts Nathalie - Septembre 2008
+             CALL histdef(hist2_id, 'z0', 'Surface roughness', 'm',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt, dw2)
+             CALL histdef(hist2_id, 'coastalflow', 'Diffuse coastal flow', 'm^3/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), dt, dw2)
+             CALL histdef(hist2_id, 'riverflow', 'River flow to the oceans', 'm^3/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), dt, dw2) 
+             CALL histdef(hist2_id, 'tsol_rad', 'Radiative surface temperature', 'C', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avecels2(2), dt, dw2)
+             IF ( control_flags%do_floodplains ) THEN
+                CALL histdef(hist2_id, 'floodout', 'Flow out of floodplains', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt,dw2)
+                CALL histdef(hist2_id, 'vevapflo', 'Floodplains evaporation', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt, dw2)
+                CALL histdef(hist2_id, 'flood_frac', 'Flooded fraction', '1', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
+                CALL histdef(hist2_id, 'reinfiltration', 'Reinfiltration from floodplains', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt,dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'vevapnu', 'Bare soil evaporation', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt, dw2)
+             CALL histdef(hist2_id, 'temp_sol', 'New Surface Temperature', 'C', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avecels2(2), dt, dw2)
+             CALL histdef(hist2_id, 'qsurf', 'Near surface specific humidity', 'g/g',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
+             CALL histdef(hist2_id, 'albedo', 'Albedo', '1', &
+                  & iim,jjm, hori_id2, 2,1,2, albax_id2, 32, avescatter2(2), dt, dw2)
+             CALL histdef(hist2_id, 'fluxsens', 'Sensible Heat Flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
+             CALL histdef(hist2_id, 'fluxlat', 'Latent Heat Flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
+             CALL histdef(hist2_id, 'emis', 'Surface emissivity', '?', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 3
+             !-
+             CALL histdef(hist2_id, 'evap', 'Evaporation', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
+             CALL histdef(hist2_id, 'rain', 'Rainfall', 'mm/d',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
+             CALL histdef(hist2_id, 'snowf', 'Snowfall', 'mm/d',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
+             CALL histdef(hist2_id, 'netrad', 'Net radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(3), dt, dw2)
+             CALL histdef(hist2_id, 'lai', 'Leaf Area Index', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
+             IF ( control_flags%river_routing ) THEN
+                CALL histdef(hist2_id, 'basinmap', 'Aproximate map of the river basins', ' ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(3), dt, dw2) 
+                CALL histdef(hist2_id, 'nbrivers', 'Number or rivers in the outflow grid box', ' ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(3), dt, dw2)  
+             ENDIF
+             IF (check_waterbal) THEN
+                CALL histdef(hist2_id, 'TotWater', 'Total amount of water at end of time step', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(3), dt, dw2)
+                CALL histdef(hist2_id, 'TotWaterFlux', 'Total water flux', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
+             ENDIF
+             !-
+             !- SECHIBA_HISTLEVEL2 = 4
+             !-
+             CALL histdef(hist2_id, 'subli', 'Sublimation', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
+             CALL histdef(hist2_id, 'runoff', 'Surface runoff', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
+             CALL histdef(hist2_id, 'drainage', 'Deep drainage', 'mm/d', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
+             IF ( control_flags%river_routing ) THEN
+                CALL histdef(hist2_id, 'riversret', 'Return from endorheic rivers', 'mm/d', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
+                CALL histdef(hist2_id, 'hydrographs', 'Hydrographs of gridbox outflow', 'm^3/s', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(4), dt, dw2)
+             ENDIF
+             IF ( control_flags%hydrol_cwrr ) THEN
+                CALL histdef(hist2_id, 'evapnu_soil', 'Bare soil evap for soil type', 'mm/d', &
+                     & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
+                CALL histdef(hist2_id, 'drainage_soil', 'Drainage for soil type', 'mm/d', &
+                     & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
+                CALL histdef(hist2_id, 'transpir_soil', 'Transpir for soil type', 'mm/d', &
+                     & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
+                CALL histdef(hist2_id, 'runoff_soil', 'Runoff for soil type', 'mm/d', &
+                     & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
+             ENDIF
+             !
+             CALL histdef(hist2_id, 'tair', 'Air Temperature', 'K',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 'qair', 'Air humidity', 'g/g',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             ! Ajouts Nathalie - Juillet 2006
+             CALL histdef(hist2_id, 'q2m', '2m Air humidity', 'g/g',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 't2m', '2m Air Temperature', 'K',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             ! Fin ajouts Nathalie
+             CALL histdef(hist2_id, 'alb_vis', 'Albedo visible', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 'alb_nir', 'Albedo near infrared', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
+             CALL histdef(hist2_id, 'roughheight', 'Effective roughness height', 'm',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(4), dt, dw2)
+             CALL histdef(hist2_id, 'transpir', 'Transpiration', 'mm/d', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(4), dt, dw2)
+             CALL histdef(hist2_id, 'inter', 'Interception loss', 'mm/d', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(4), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 5
+             !-
+             CALL histdef(hist2_id, 'tsol_max', 'Maximum Surface Temperature',&
+                  & 'C', iim,jjm, hori_id2, 1,1,1, -99, 32, tmaxcels2(5), dt, dw2)
+             CALL histdef(hist2_id, 'tsol_min', 'Minimum Surface Temperature',&
+                  & 'C', iim,jjm, hori_id2, 1,1,1, -99, 32, tmincels2(5), dt, dw2)
+             CALL histdef(hist2_id, 'snow', 'Snow mass', 'kg/m^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'snowage', 'Snow age', '?', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'snownobio', 'Snow on other surfaces', 'kg/m^2', &
+                  & iim,jjm, hori_id2, nnobio,1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'snownobioage', 'Snow age on other surfaces', 'd', &
+                  & iim,jjm, hori_id2, nnobio,1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'vegetfrac', 'Fraction of vegetation', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'nobiofrac', 'Fraction of other surface types', '1', &
+                  & iim,jjm, hori_id2, nnobio, 1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
+             IF ( control_flags%hydrol_cwrr ) THEN
+                DO jst=1,nstm
+                   
+                   ! var_name= "mc_1" ... "mc_3"
+                   WRITE (var_name,"('moistc_',i1)") jst
+                   CALL histdef(hist2_id, var_name, 'Soil Moisture profile for soil type', '%', &
+                        & iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(5), dt, dw2)
+                   
+                   ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+                   WRITE (var_name,"('vegetsoil_',i1)") jst
+                   CALL histdef(hist2_id, var_name, 'Fraction of vegetation on soil types', '%', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
+                   
+                   ! var_name= "kfact_root_1" ... "kfact_root_3"
+                   WRITE (var_name,"('kfactroot_',i1)") jst
+                   CALL histdef(hist2_id, var_name, 'Root fraction profile for soil type', '%', &
+                        & iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(5), dt,dw2)
+                ENDDO
+             ENDIF
+             !-
+             !- SECHIBA_HISTLEVEL2 = 6
+             !-
+             IF ( .NOT. control_flags%hydrol_cwrr ) THEN
+                CALL histdef(hist2_id, 'dss', 'Up-reservoir Height', 'm',  &
+                     & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter2(6), dt,dw)
+                CALL histdef(hist2_id, 'gqsb', 'Upper Soil Moisture', 'Kg/m^2',  &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
+                CALL histdef(hist2_id, 'bqsb', 'Lower Soil Moisture', 'Kg/m^2',  &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
+             ELSE
+                CALL histdef(hist2_id, 'humtot', 'Total Soil Moisture', 'Kg/m^2', &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
+                CALL histdef(hist2_id, 'humtot_soil', 'Soil Moisture for soil type', 'Kg/m^2', &
+                     & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, avescatter2(6), dt, dw2)
+                CALL histdef(hist2_id, 'SWI', 'Soil wetness index','-',  &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt,dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'qsintveg', 'Water on canopy', 'Kg/m^2', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(6), dt, dw2)
+             CALL histdef(hist2_id, 'rstruct', 'Structural resistance', 's/m', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(6), dt, dw2)
+             IF ( control_flags%ok_co2 ) THEN
+                CALL histdef(hist2_id, 'gpp', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
+             ENDIF
+             IF ( control_flags%ok_stomate ) THEN
+                CALL histdef(hist2_id, 'nee', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
+                CALL histdef(hist2_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
+                CALL histdef(hist2_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
+                CALL histdef(hist2_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt, dw2)
+                CALL histdef(hist2_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt, dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'precisol', 'Throughfall', 'mm/d',  &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(6), dt, dw2)
+             CALL histdef(hist2_id, 'drysoil_frac', 'Fraction of visibly dry soil', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(6), dt, dw2)
+             CALL histdef(hist2_id, 'evapot', 'Potential evaporation', 'mm/d',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(6), dt, dw2)
+             CALL histdef(hist2_id, 'evapot_corr', 'Potential evaporation', 'mm/d',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(6), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 7
+             !-
+             CALL histdef(hist2_id, 'swnet', 'Net solar radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(7), dt, dw2)
+             CALL histdef(hist2_id, 'swdown', 'Incident solar radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(7), dt, dw2)
+             CALL histdef(hist2_id, 'lwdown', 'Absorbed downward longwave radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'lwnet', 'Net surface longwave radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 8
+             !-
+             IF ( control_flags%river_routing ) THEN
+                CALL histdef(hist2_id, 'fastr', 'Fast flow reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+                CALL histdef(hist2_id, 'slowr', 'Slow flow reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+                CALL histdef(hist2_id, 'streamr', 'Stream flow reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+                CALL histdef(hist2_id, 'floodr', 'Floodplains reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt,dw2)
+                CALL histdef(hist2_id, 'floodh', 'Floodplains height', 'mm', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt,dw2)
+                CALL histdef(hist2_id, 'pondr', 'Ponds reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt,dw2)
+                CALL histdef(hist2_id, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+                IF ( control_flags%do_irrigation ) THEN
+                   CALL histdef(hist2_id, 'irrigation', 'Net irrigation', 'mm/d', &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(8), dt, dw2)
+                   CALL histdef(hist2_id, 'netirrig', 'Net irrigation requirement', 'mm/d', &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(8), dt, dw2)
+                   CALL histdef(hist2_id, 'irrigmap', 'Map of irrigated areas', 'm^2', &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(8), dt, dw2)
+                ENDIF
+                CALL histdef(hist2_id, 'floodmap', 'Map of floodplains', 'm^2', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(8), dt,dw2)
+                CALL histdef(hist2_id, 'swampmap', 'Map of swamps', 'm^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(8), dt,dw2)
+             ENDIF
+             !-
+             !- SECHIBA_HISTLEVEL2 = 9
+             !-
+             CALL histdef(hist2_id, 'beta', 'Beta Function', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'raero', 'Aerodynamic resistance', 's/m',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             ! Ajouts Nathalie - Novembre 2006
+             CALL histdef(hist2_id, 'Wind', 'Wind speed', 'm/s',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             ! Fin ajouts Nathalie
+             CALL histdef(hist2_id, 'qsatt' , 'Surface saturated humidity', 'g/g', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'vbeta1', 'Beta for sublimation', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             CALL histdef(hist2_id, 'vbeta4', 'Beta for bare soil', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             IF ( control_flags%ok_co2 ) THEN
+                CALL histdef(hist2_id, 'vbetaco2', 'beta for CO2', 'mm/d', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'vbeta5', 'Beta for floodplains', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
+             IF (  control_flags%hydrol_cwrr ) THEN
+                CALL histdef(hist2_id, 'reinf_slope', 'Slope index for each grid box', '1', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(9),  dt,dw2)
+                CALL histdef(hist2_id, 'soilindex', 'Soil index', '1', &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, once2(9),  dt,dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'humrel', 'Soil moisture stress', '1',  &
+                  & iim,jjm, hori_id2, nvm,1,nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
+             !-
+             !- SECHIBA_HISTLEVEL2 = 10
+             !-
+             IF ( control_flags%ok_co2 ) THEN
+                CALL histdef(hist2_id, 'cimean', 'Stomatal CO2 concentation', 'mmole/m2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'vbeta3', 'Beta for Transpiration', 'mm/d', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
+             CALL histdef(hist2_id, 'rveget', 'Canopy resistance', 's/m', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
+             IF ( .NOT. control_flags%hydrol_cwrr ) THEN
+                CALL histdef(hist2_id, 'rsol', 'Soil resistance', 's/m',  &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt, dw2)
+             ENDIF
+             CALL histdef(hist2_id,'vbeta2','Beta for Interception loss','mm/d', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
+             CALL histdef(hist2_id, 'qsintmax', 'Maximum Interception capacity', 'Kg/m^2', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
+             ! 
+             IF ( control_flags%ok_inca ) THEN
+                CALL histdef(hist2_id, 'PAR', 'PAR', 'umol phot/m^2/s',  &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                IF ( control_flags%ok_radcanopy ) THEN
+                   CALL histdef(hist2_id, 'PARsun', 'Sunlit Leaf PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'PARsh', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'laisun', 'Sunlit Leaf Area Index', '1', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'laish', 'Shaded Leaf Area Index', '1', &
+                        & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'Fdf', 'Fdf', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   IF ( control_flags%ok_multilayer ) then 
+                      CALL histdef(hist2_id, 'PARsuntab', 'Sunlit Leaf PAR', 'umol phot/m^2/s', &
+                           & iim,jjm, hori_id2, nlai+1, 1, nlai+1, laiax_id2, 32, avescatter2(10), dt,dw2)
+                      CALL histdef(hist2_id, 'PARshtab', 'Shaded Leaf Area PAR', 'umol phot/m^2/s', &
+                           & iim,jjm, hori_id2, nlai+1, 1, nlai+1, laiax_id2, 32, avescatter2(10), dt,dw2)
+                   ENDIF
+                   CALL histdef(hist2_id, 'Sinang', 'Sinang', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'PARdf', 'PARdf', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'PARdr', 'PARdr', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'Trans', 'Trans', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'Day', 'Day', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                   CALL histdef(hist2_id, 'Year_length', 'Year_length', '1',  &
+                        & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                END IF
+                
+                CALL histdef(hist2_id, 'flx_fertil_no', 'flx_fertil_no', 'ngN/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'CRF', 'CRF', '1', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_co2_bbg_year', 'flx_co2_bbg_year', 'kgC/m^2/yr ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt,dw2)  
+                CALL histdef(hist2_id, 'N_qt_WRICE_year', 'N_qt_WRICE_year', 'kgN/yr ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt,dw2)  
+                CALL histdef(hist2_id, 'N_qt_OTHER_year', 'N_qt_OTHER_year', 'kgN/yr ', &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(10), dt,dw2)  
+                CALL histdef(hist2_id, 'ptnlev1', 'ptnlev1', 'K',  &
+                     & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_iso', 'flx_iso', 'kgC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_mono', 'flx_mono', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_ORVOC', 'flx_ORVOC', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_MBO', 'flx_MBO', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_methanol', 'flx_methanol', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_acetone', 'flx_acetone', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_acetal', 'flx_acetal', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_formal', 'flx_formal', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_acetic', 'flx_acetic', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_formic', 'flx_formic', 'kgC/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_no_soil', 'flx_no_soil', 'ngN/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+                CALL histdef(hist2_id, 'flx_no', 'flx_no', 'ngN/m^2/s',&
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt,dw2)
+             ENDIF
+          ELSE 
+             !-
+             !- This is the ALMA convention output now
+             !-
+             !- 
+             IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+                CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id,orch_domain_id)
+#else
+                CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id)
+#endif
+                WRITE(numout,*)  'HISTBEG2 --->',istp_old,date0,dt,dw2,hist2_id
+             ELSE
+#ifdef CPP_PARA
+                CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id,domain_id=orch_domain_id)
+#else
+                CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id2, hist2_id)
+#endif 
+             ENDIF
+             !-
+             CALL histvert(hist2_id, 'veget', 'Vegetation types', '1', &
+                  &    nvm,   veg, vegax_id2)
+             CALL histvert(hist2_id, 'solth', 'Soil levels',      'm', &
+                  &    ngrnd, sol, solax_id2)
+             CALL histvert(hist2_id, 'soiltyp', 'Soil types',      '1', &
+                  &    nstm, soltyp, soltax_id2)
+             CALL histvert(hist2_id, 'nobio', 'Other surface types',      '1', &
+                  &    nnobio, nobiotyp, nobioax_id2)
+             IF (  control_flags%hydrol_cwrr ) THEN
+                CALL histvert(hist2_id, 'solay', 'Hydrol soil levels',      'm', &
+                     &    nslm, -diaglev(1:nslm), solayax_id2)
+             ENDIF
+             !-
+             !-  Vegetation
+             !-
+             CALL histdef(hist2_id, 'vegetfrac', 'Fraction of vegetation', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
+             CALL histdef(hist2_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
+             CALL histdef(hist2_id, 'nobiofrac', 'Fraction of other surface types', '1', &
+                  & iim,jjm, hori_id2, nnobio, 1, nnobio, nobioax_id2, 32, avescatter2(3), dt, dw2)
+             !- 
+             !-  General energy balance
+             !-
+             CALL histdef(hist2_id, 'SWnet', 'Net shortwave radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
+             CALL histdef(hist2_id, 'LWnet', 'Net longwave radiation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qh', 'Sensible heat flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qle', 'Latent heat flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qg', 'Ground heat flux', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qf', 'Energy of fusion', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(5), dt, dw2)
+             CALL histdef(hist2_id, 'Qv', 'Energy of sublimation', 'W/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             CALL histdef(hist2_id, 'DelSurfHeat', 'Change in surface layer heat', 'J/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, sumscatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'DelColdCont', 'Change in snow surface layer cold content', 'J/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, sumscatter2(7), dt, dw2)
+             !-
+             !- General water balance
+             !-
+             CALL histdef(hist2_id, 'Snowf', 'Snowfall rate', 'kg/m^2/s',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Rainf', 'Rainfall rate', 'kg/m^2/s',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Evap', 'Total Evapotranspiration', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qs', 'Surface runoff', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qsb', 'Sub-surface runoff', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'Qsm', 'Snowmelt', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'DelSoilMoist', 'Change in soil moisture', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'DelSurfStor', 'Change in Surface Water Storage','kg/m^2',&
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(7), dt,dw2)
+             CALL histdef(hist2_id, 'DelIntercept', 'Change in interception storage', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'DelSWE', 'Change in interception storage Snow Water Equivalent', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(7), dt, dw2)
+             !-
+             !- Surface state
+             !-
+             CALL histdef(hist2_id, 'AvgSurfT', 'Average surface temperature', 'K', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
+             CALL histdef(hist2_id, 'RadT', 'Surface radiative temperature', 'K', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(5), dt, dw2)
+             CALL histdef(hist2_id, 'Albedo', 'Albedo', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'SWI', 'Soil wetness index','1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'SurfStor', 'Surface Water Storage','kg/m^2',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'SWE', 'Snow Water Equivalent', 'kg/m^2', &
+                  & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
+             !!-
+             !-  Sub-surface state
+             !- 
+             IF ( .NOT. control_flags%hydrol_cwrr ) THEN
+                CALL histdef(hist2_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2',  &
+                     & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(7), dt, dw2)
+             ELSE
+                CALL histdef(hist2_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2',  &
+                     & iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(7), dt, dw2)
+             ENDIF
+             CALL histdef(hist2_id, 'SoilWet', 'Total soil wetness', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'SoilTemp', '3D layer average soil temperature', 'K', &
+                  & iim,jjm, hori_id2, ngrnd, 1, ngrnd, solax_id2, 32, avescatter2(7), dt, dw2)
+             !- 
+             !-  Evaporation components
+             !-
+             CALL histdef(hist2_id, 'PotEvap', 'Potential evapotranspiration', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'ECanop', 'Interception evaporation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(5), dt, dw2)
+             CALL histdef(hist2_id, 'TVeg', 'Transpiration', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(5), dt, dw2)
+             CALL histdef(hist2_id, 'ESoil', 'Bare soil evaporation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(5), dt, dw2)
+             CALL histdef(hist2_id, 'EWater', 'Open water evaporation', 'kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(5), dt, dw2)
+             CALL histdef(hist2_id, 'RootMoist','Root zone soil water', 'kg/m^2',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt, dw2)
+             CALL histdef(hist2_id, 'SubSnow','Snow sublimation','kg/m^2/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
+             CALL histdef(hist2_id, 'ACond', 'Aerodynamic conductance', 'm/s',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
+             !-
+             !-
+             !-  Cold Season Processes
+             !-
+             CALL histdef(hist2_id, 'SnowFrac', 'Snow cover fraction', '1',  &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'SAlbedo', 'Snow albedo', '1', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             CALL histdef(hist2_id, 'SnowDepth', '3D snow depth', 'm', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
+             !-
+             !- Hydrologic variables
+             !-
+             CALL histdef(hist2_id, 'IrrigationMap', 'Map of irrigated areas', 'm^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
+             CALL histdef(hist2_id, 'FloodplainsMap', 'Map of flooded areas', 'm^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt,dw2)
+             CALL histdef(hist2_id, 'SwampMap', 'Map of swamp areas', 'm^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt,dw2)
+             CALL histdef(hist2_id, 'Dis', 'Simulated River Discharge', 'm^3/s', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt,dw2)
+             CALL histdef(hist2_id, 'humrel', 'Soil moisture stress', '1',  &
+                  & iim,jjm, hori_id2, nvm,1,nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
+             !-
+             !-  The carbon budget
+             !-
+             IF ( control_flags%ok_co2 ) THEN
+                CALL histdef(hist2_id, 'GPP', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
+             ENDIF
+             IF ( control_flags%ok_stomate ) THEN
+                CALL histdef(hist2_id, 'NEE', 'Net Ecosystem Exchange', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
+                CALL histdef(hist2_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
+                CALL histdef(hist2_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
+                  & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
+                CALL histdef(hist2_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
+                CALL histdef(hist2_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
+                     & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
+             ENDIF
+             !
+          ENDIF
+          !-
+          CALL histdef(hist2_id, 'LandPoints', 'Land Points', '1', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)  
+          CALL histdef(hist2_id, 'Areas', 'Mesh areas', 'm2', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
+          CALL histdef(hist2_id, 'Contfrac', 'Continental fraction', '1', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
+          !-
+          ! Write the names of the pfts in the high frequency sechiba history files
+          global_attribute="PFT_name"
+          DO i=1,nvm
+             WRITE(global_attribute(9:10),"(I2.2)") i
+             CALL histglobal_attr(hist2_id, global_attribute, PFT_name(i))
+          ENDDO
+          !-
+          CALL histend(hist2_id)
+       ENDIF
+    ENDIF
+    !-
+    !=====================================================================
+    !- 3.2 STOMATE's history file
+    !=====================================================================
+    IF ( control_flags%ok_stomate ) THEN
+       !-
+       ! STOMATE IS ACTIVATED
+       !-
+       !Config Key   = STOMATE_OUTPUT_FILE
+       !Config Desc  = Name of file in which STOMATE's output is going to be written
+       !Config If    = OK_STOMATE
+       !Config Def   = stomate_history.nc
+       !Config Help  = This file is going to be created by the model
+       !Config         and will contain the output from the model.
+       !Config         This file is a truly COADS compliant netCDF file.
+       !Config         It will be generated by the hist software from
+       !Config         the IOIPSL package.
+       !Config Units = [FILE]
+       !-
+       stom_histname='stomate_history.nc'
+       CALL getin_p('STOMATE_OUTPUT_FILE', stom_histname)       
+       WRITE(numout,*) 'STOMATE_OUTPUT_FILE', TRIM(stom_histname)
+       !-
+       !Config Key   = STOMATE_HIST_DT
+       !Config Desc  = STOMATE history time step
+       !Config If    = OK_STOMATE
+       !Config Def   = 10.
+       !Config Help  = Time step of the STOMATE history file
+       !Config Units = [days]
+       !-
+       hist_days_stom = 10.
+       CALL getin_p('STOMATE_HIST_DT', hist_days_stom)       
+
+       IF ( hist_id < 0 ) THEN
+          ! Deactivate all history files if sechiba_history file is deactivated
+          hist_dt_stom=0
+          WRITE(numout,*) 'STOMATE history file will not be created because sechiba_history file is deactivated.'
+       ELSE IF ( hist_days_stom == moins_un ) THEN
+          hist_dt_stom = moins_un
+          WRITE(numout,*) 'output frequency for STOMATE history file (d): one month.'
+       ELSE IF ( hist_days_stom == 0 ) THEN
+          ! Deactivate this file
+          hist_dt_stom=0
+          WRITE(numout,*) 'STOMATE history file will not be created'
+       ELSE
+          hist_dt_stom = NINT( hist_days_stom ) * one_day
+          WRITE(numout,*) 'output frequency for STOMATE history file (d): ', &
+               hist_dt_stom/one_day
+       ENDIF
+
+       ! test consistency between STOMATE_HIST_DT and DT_SLOW parameters
+       dt_slow_ = one_day
+       CALL getin_p('DT_SLOW', dt_slow_)
+       IF ( hist_days_stom /= moins_un .AND. hist_dt_stom/=0) THEN
+          IF (dt_slow_ > hist_dt_stom) THEN
+             WRITE(numout,*) "DT_SLOW = ",dt_slow_,"  , STOMATE_HIST_DT = ",hist_dt_stom
+             CALL ipslerr_p (3,'intsurf_history', &
+                  &          'Problem with DT_SLOW > STOMATE_HIST_DT','', &
+                  &          '(must be less or equal)')
+          ENDIF
+       ENDIF
+       !-
+       !- Initialize stomate_history file
+       IF ( hist_dt_stom == 0 ) THEN
+          ! Case hist_dt_stom=0 : No creation of stomate_history.nc file
+          ! Nothing will be done.
+          hist_id_stom=-1
+       ELSE
+          ! Initialise stomate_history file
+       IF (is_omp_root) THEN
+          IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+             CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id_stom,domain_id=orch_domain_id)
+#else
+             CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id_stom)
+#endif
+          ELSE
+#ifdef CPP_PARA
+             CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id_stom,domain_id=orch_domain_id)
+#else
+             CALL histbeg(stom_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+                  &     istp_old, date0, dt, hori_id, hist_id_stom)
+#endif
+          ENDIF
+          !- declare this axis
+    ! depth at center of the levels
+    zsoil(1) = diaglev(1) / 2.
+    DO i = 2, nbdl
+       zsoil(i) = ( diaglev(i) + diaglev(i-1) ) / 2.
+    ENDDO
+          CALL histvert (hist_id_stom, 'Depth', 'Soil levels', &
+               & 'm', nslm, -zsoil(1:nbdl), hist_solax_id)
+          !- define PFT axis
+          hist_PFTaxis = (/ ( REAL(i,r_std), i=1,nvm ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'PFT', 'Plant functional type', &
+               & '1', nvm, hist_PFTaxis, hist_PFTaxis_id)
+          ! deforestation
+          !- define Pool_10 axis
+          hist_pool_10axis = (/ ( REAL(i,r_std), i=1,10 ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P10', 'Pool 10 years', &
+               & '1', 10, hist_pool_10axis, hist_pool_10axis_id)
+          
+          !- define Pool_100 axis
+          hist_pool_100axis = (/ ( REAL(i,r_std), i=1,100 ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P100', 'Pool 100 years', &
+               & '1', 100, hist_pool_100axis, hist_pool_100axis_id)
+          
+          !- define Pool_11 axis
+          hist_pool_11axis = (/ ( REAL(i,r_std), i=1,11 ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P11', 'Pool 10 years + 1', &
+               & '1', 11, hist_pool_11axis, hist_pool_11axis_id)
+          
+          !- define Pool_101 axis
+          hist_pool_101axis = (/ ( REAL(i,r_std), i=1,101 ) /)
+          !- declare this axis
+          CALL histvert (hist_id_stom, 'P101', 'Pool 100 years + 1', &
+               & '1', 101, hist_pool_101axis, hist_pool_101axis_id)
+       ENDIF
+       !- define STOMATE history file
+       CALL stom_define_history (hist_id_stom, nvm, iim, jjm, &
+            & dt, hist_dt_stom, hori_id, hist_PFTaxis_id, &
+            & hist_pool_10axis_id, hist_pool_100axis_id, &
+            & hist_pool_11axis_id, hist_pool_101axis_id, hist_solax_id)
+       
+       !- Write the names of the pfts in the stomate history files 
+       IF (is_omp_root) THEN
+          global_attribute="PFT_name"
+          DO i=1,nvm
+             WRITE(global_attribute(9:10),"(I2.2)") i
+             CALL histglobal_attr(hist_id_stom, global_attribute, PFT_name(i))
+          ENDDO
+
+       !- end definition
+          CALL histend(hist_id_stom)
+       ENDIF
+    END IF ! IF ( hist_dt_stom == 0 )
+
+       !-
+       !-
+       !-
+       ! STOMATE IPCC OUTPUTS IS ACTIVATED
+       !-
+       !Config Key   = STOMATE_IPCC_OUTPUT_FILE
+       !Config Desc  = Name of file in which STOMATE's output is going to be written
+       !Config If    = OK_STOMATE
+       !Config Def   = stomate_ipcc_history.nc
+       !Config Help  = This file is going to be created by the model
+       !Config         and will contain the output from the model.
+       !Config         This file is a truly COADS compliant netCDF file.
+       !Config         It will be generated by the hist software from
+       !Config         the IOIPSL package.
+       !Config Units = [FILE]
+       !-
+       stom_ipcc_histname='stomate_ipcc_history.nc'
+       CALL getin_p('STOMATE_IPCC_OUTPUT_FILE', stom_ipcc_histname)       
+       WRITE(numout,*) 'STOMATE_IPCC_OUTPUT_FILE', TRIM(stom_ipcc_histname)
+       !-
+       !Config Key   = STOMATE_IPCC_HIST_DT
+       !Config Desc  = STOMATE IPCC history time step
+       !Config If    = OK_STOMATE
+       !Config Def   = 0.
+       !Config Help  = Time step of the STOMATE IPCC history file
+       !Config Units = [days]
+       !-
+       hist_days_stom_ipcc = zero
+       CALL getin_p('STOMATE_IPCC_HIST_DT', hist_days_stom_ipcc)       
+       IF ( hist_days_stom_ipcc == moins_un ) THEN
+          hist_dt_stom_ipcc = moins_un
+          WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): one month.'
+       ELSE
+          hist_dt_stom_ipcc = NINT( hist_days_stom_ipcc ) * one_day
+          WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): ', &
+            hist_dt_stom_ipcc/one_day
+       ENDIF
+       
+       IF ( hist_dt_stom_ipcc /= 0 .AND. hist_id < 0 ) THEN
+          ! sechiba_history file is not created therefore STOMATE IPCC history file will be deactivated
+          hist_dt_stom_ipcc=0
+          hist_days_stom_ipcc=0
+          WRITE(numout,*) 'STOMATE IPCC history file is not created.'
+       END IF
+
+       ! test consistency between STOMATE_IPCC_HIST_DT and DT_SLOW parameters
+       dt_slow_ = one_day
+       CALL getin_p('DT_SLOW', dt_slow_)
+       IF ( hist_days_stom_ipcc > zero ) THEN
+          IF (dt_slow_ > hist_dt_stom_ipcc) THEN
+             WRITE(numout,*) "DT_SLOW = ",dt_slow_,"  , STOMATE_IPCC_HIST_DT = ",hist_dt_stom_ipcc
+             CALL ipslerr_p (3,'intsurf_history', &
+                  &          'Problem with DT_SLOW > STOMATE_IPCC_HIST_DT','', &
+                  &          '(must be less or equal)')
+          ENDIF
+       ENDIF
+
+       IF ( hist_dt_stom_ipcc == 0 ) THEN
+          hist_id_stom_ipcc = -1
+       ELSE
+          !-
+          !- initialize
+          IF (is_omp_root) THEN
+             IF ( rectilinear ) THEN
+#ifdef CPP_PARA
+                CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
+#else
+                CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect,  1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id, hist_id_stom_ipcc)
+#endif
+             ELSE
+#ifdef CPP_PARA
+                CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
+#else
+                CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat,  1, iim, 1, jjm, &
+                     &     istp_old, date0, dt, hori_id, hist_id_stom_ipcc)
+#endif
+             ENDIF
+             !- declare this axis
+             CALL histvert (hist_id_stom_IPCC, 'PFT', 'Plant functional type', &
+                  & '1', nvm, hist_PFTaxis, hist_IPCC_PFTaxis_id)
+             
+             !- define STOMATE history file
+             CALL stom_IPCC_define_history (hist_id_stom_IPCC, nvm, iim, jjm, &
+                  & dt, hist_dt_stom_ipcc, hori_id, hist_IPCC_PFTaxis_id)
+             
+             !- Write the names of the pfts in the stomate history files 
+             global_attribute="PFT_name"
+             DO i=1,nvm
+                WRITE(global_attribute(9:10),"(I2.2)") i
+                CALL histglobal_attr(hist_id_stom_IPCC, global_attribute, PFT_name(i))
+             ENDDO
+
+             !- end definition
+             CALL histend(hist_id_stom_IPCC)
+          ENDIF
+       ENDIF
+    ENDIF
+
+
+    RETURN
+
+  END SUBROUTINE intsurf_history
+  !  
+  SUBROUTINE stom_define_history &
+       & (hist_id_stom, nvm, iim, jjm, dt, &
+       &  hist_dt, hist_hori_id, hist_PFTaxis_id, &
+       & hist_pool_10axis_id, hist_pool_100axis_id, &
+       & hist_pool_11axis_id, hist_pool_101axis_id, hist_solax_id)
+    ! deforestation axis added as arguments
+
+    !---------------------------------------------------------------------
+    !- Tell ioipsl which variables are to be written
+    !- and on which grid they are defined
+    !---------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    !- Input
+    !-
+    !- File id
+    INTEGER(i_std),INTENT(in) :: hist_id_stom
+    !- number of PFTs
+    INTEGER(i_std),INTENT(in) :: nvm
+    !- Domain size
+    INTEGER(i_std),INTENT(in) :: iim, jjm
+    !- Time step of STOMATE (seconds)
+    REAL(r_std),INTENT(in)    :: dt
+    !- Time step of history file (s)
+    REAL(r_std),INTENT(in)    :: hist_dt
+    !- id horizontal grid
+    INTEGER(i_std),INTENT(in) :: hist_hori_id
+    !- id of PFT axis
+    INTEGER(i_std),INTENT(in) :: hist_PFTaxis_id
+    !- id of Deforestation axis
+    INTEGER(i_std),INTENT(in) :: hist_pool_10axis_id,hist_pool_100axis_id
+    INTEGER(i_std),INTENT(in) :: hist_pool_11axis_id,hist_pool_101axis_id
+    !- id of depth axis
+    INTEGER(i_std),INTENT(in) :: hist_solax_id
+    !-
+    !- 1 local
+    !-
+    !- maximum history level
+    INTEGER(i_std), PARAMETER  :: max_hist_level = 10
+    !- output level (between 0 and 10)
+    !-  ( 0:nothing is written, 10:everything is written)
+    INTEGER(i_std)             :: hist_level
+    !- Character strings to define operations for histdef
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: ave
+
+    !---------------------------------------------------------------------
+    !=====================================================================
+    !- 1 history level
+    !=====================================================================
+    !- 1.1 define history levelx
+    !=====================================================================
+    !Config Key   = STOMATE_HISTLEVEL
+    !Config Desc  = STOMATE history output level (0..10)
+    !Config If    = OK_STOMATE
+    !Config Def   = 10
+    !Config Help  = 0: nothing is written; 10: everything is written
+    !Config Units = [-]
+    !-
+    hist_level = 10
+    CALL getin_p('STOMATE_HISTLEVEL', hist_level)
+    !-
+    WRITE(numout,*) 'STOMATE history level: ',hist_level
+    IF ( (hist_level > max_hist_level).OR.(hist_level < 0) ) THEN
+       STOP 'This history level is not allowed'
+    ENDIF
+    !=====================================================================
+    !- 1.2 define operations according to output level
+    !=====================================================================
+    ave(1:hist_level) =  'ave(scatter(X))'
+    ave(hist_level+1:max_hist_level) =  'never          '
+    !=====================================================================
+    !- 2 surface fields (2d)
+    !- 3 PFT: 3rd dimension
+    !=====================================================================
+
+
+    ! structural litter above ground
+    IF (is_omp_root) THEN
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_STR_AB       "), &
+            &               TRIM("structural litter above ground per m2 of soil     "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! metabolic litter above ground                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_MET_AB       "), &
+            &               TRIM("metabolic litter above ground per m2 of soil      "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! structural litter below ground               
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_STR_BE       "), &
+            &               TRIM("structural litter below ground per m3 of soil     "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+       
+       ! metabolic litter below ground                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTER_MET_BE       "), &
+            &               TRIM("metabolic litter below ground per m3 of soil      "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+       
+       ! fraction of soil covered by dead leaves           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("DEADLEAF_COVER      "), &
+            &               TRIM("fraction of soil covered by dead leaves           "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+       
+       ! total soil and litter carbon
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_SOIL_CARB     "), &
+            &               TRIM("total soil and belowground litter C per m3 of soil"), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)       
+
+       ! active soil carbon in ground                 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CARBON_ACTIVE       "), &
+            &               TRIM("active soil carbon in ground per m3 of soil        "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+       
+       ! slow soil carbon in ground                   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CARBON_SLOW         "), &
+            &               TRIM("slow soil carbon in ground per m3 of soil          "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+       
+       ! passive soil carbon in ground                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CARBON_PASSIVE      "), &
+            &               TRIM("passive soil carbon in ground per m3 of soil       "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)
+ 
+       ! free dissolved organic carbon in soil                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FREE_DOC           "), &
+            &               TRIM("free dissolved organic C in soil per m3 of soil     "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt) 
+       ! adsorbed dissolved organic carbon in soil                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ADSORBED_DOC        "), &
+            &               TRIM("adsorbed dissolved org. C in soil per m3 of soil    "), &
+            &               TRIM("gC/m^3/z            "), iim,jjm, hist_hori_id, &
+            &               nbdl,1,nbdl, hist_solax_id,32, ave(5), dt, hist_dt)      
+       ! exported dissolved organic carbon                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("EXPORTED_DOC_RUNOFF "), &
+            &               TRIM("exported DOC from runoff "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("EXPORTED_DOC_DRAIN  "), &
+            &               TRIM("exported DOC from drainage "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("EXPORTED_DOC_FLOOD  "), &
+            &               TRIM("exported DOC from  flood "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+!       CALL histdef (hist_id_stom, &
+!            &               TRIM("EXPORTED_DOC_STOCK "), &
+!            &               TRIM("exported DOC from drainage, runoff and flood "), &
+!            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+!            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! Long term 2 m temperature                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("T2M_LONGTERM        "), &
+            &               TRIM("Longterm 2 m temperature                          "), &
+            &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(9), dt, hist_dt)
+       
+       ! Monthly 2 m temperature                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("T2M_MONTH           "), &
+            &               TRIM("Monthly 2 m temperature                           "), &
+            &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+       ! Weekly 2 m temperature                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("T2M_WEEK            "), &
+            &               TRIM("Weekly 2 m temperature                            "), &
+            &               TRIM("K                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(1), dt, hist_dt)
+       
+       ! heterotr. resp. from ground                  
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HET_RESP            "), &
+            &               TRIM("heterotr. resp. from ground                       "), &
+            &               TRIM("gC/m^2 tot/pft/day  "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+       
+       ! black carbon on average total ground              
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BLACK_CARBON        "), &
+            &               TRIM("black carbon on average total ground              "), &
+            &               TRIM("gC/m^2 tot          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(10), dt, hist_dt)
+       
+       ! Fire fraction on ground
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FIREFRAC            "), &
+            &               TRIM("Fire fraction on ground                           "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Fire index on ground                      
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FIREINDEX           "), &
+            &               TRIM("Fire index on ground                              "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
+       
+       ! Litter humidity                                   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LITTERHUM           "), &
+            &               TRIM("Litter humidity                                   "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+       
+       ! CO2 flux                                  
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CO2FLUX             "), &
+            &               TRIM("CO2 flux                                          "), &
+            &               TRIM("gC/m^2/pft/mth      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+!!$    CALL histdef(hist_id_stom, &
+!!$         &               TRIM("CO2FLUX_MONTHLY_SUM "), &
+!!$         &               TRIM("Monthly CO2 flux Sum                              "), &
+!!$         &               TRIM("PgC/m^2/mth         "), iim,jjm, hist_hori_id, &
+!!$         &               1,1,1, -99, 32, 'inst(scatter(X))', dt, hist_dt)
+
+       ! Output CO2 flux from fire                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CO2_FIRE            "), &
+            &               TRIM("Output CO2 flux from fire                         "), &
+            &               TRIM("gC/day/m^2/pft      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+       
+       ! CO2 taken from atmosphere for initiate growth     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CO2_TAKEN           "), &
+            &               TRIM("CO2 taken from atmosphere for initiate growth     "), &
+            &               TRIM("gC/day/m^2/pft      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+       
+       ! Leaf Area Index                                   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LAI                 "), &
+            &               TRIM("Leaf Area Index                                   "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+       
+       ! Maximum vegetation fraction (LAI -> infinity)     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("VEGET_MAX           "), &
+            &               TRIM("Maximum vegetation fraction (LAI -> infinity)     "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+       
+       ! Net primary productivity                          
+       CALL histdef (hist_id_stom, &
+            &               TRIM("NPP                 "), &
+            &               TRIM("Net primary productivity                          "), &
+            &               TRIM("gC/day/(m^2 tot)    "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Gross primary productivity                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GPP                 "), &
+            &               TRIM("Gross primary productivity                        "), &
+            &               TRIM("gC/day/m^2          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+       ! Density of individuals                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("IND                 "), &
+            &               TRIM("Density of individuals                            "), &
+            &               TRIM("1/ m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! Adaptation to climate
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ADAPTATION          "), &
+            &               TRIM("Adaptation to climate (DGVM)                      "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+    
+       ! Probability from regenerative
+       CALL histdef (hist_id_stom, &
+            &               TRIM("REGENERATION        "), &
+            &               TRIM("Probability from regenerative (DGVM)               "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+       
+       ! crown area of individuals (m**2)
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CN_IND              "), &
+            &               TRIM("crown area of individuals                         "), &
+            &               TRIM("m^2                 "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! woodmass of individuals (gC)
+       CALL histdef (hist_id_stom, &
+            &               TRIM("WOODMASS_IND        "), &
+            &               TRIM("Woodmass of individuals                           "), &
+            &               TRIM("gC/pft              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! total living biomass
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_M             "), &
+            &               TRIM("Total living biomass                              "), &
+            &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+       
+       ! Leaf mass                                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LEAF_M              "), &
+            &               TRIM("Leaf mass                                         "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! Sap mass above ground                             
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_M_AB            "), &
+            &               TRIM("Sap mass above ground                             "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Sap mass below ground                             
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_M_BE            "), &
+            &               TRIM("Sap mass below ground                             "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! Heartwood mass above ground                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEART_M_AB          "), &
+            &               TRIM("Heartwood mass above ground                       "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Heartwood mass below ground                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEART_M_BE          "), &
+            &               TRIM("Heartwood mass below ground                       "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Root mass                                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ROOT_M              "), &
+            &               TRIM("Root mass                                         "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! Fruit mass                                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FRUIT_M             "), &
+            &               TRIM("Fruit mass                                        "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! Carbohydrate reserve mass                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("RESERVE_M           "), &
+            &               TRIM("Carbohydrate reserve mass                         "), &
+            &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! total turnover rate
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_TURN          "), &
+            &               TRIM("total turnover rate                               "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Leaf turnover                                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LEAF_TURN           "), &
+            &               TRIM("Leaf turnover                                     "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Sap turnover above                                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_AB_TURN         "), &
+            &               TRIM("Sap turnover above                                "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Root turnover                                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ROOT_TURN           "), &
+            &               TRIM("Root turnover                                     "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Fruit turnover                                    
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FRUIT_TURN          "), &
+            &               TRIM("Fruit turnover                                    "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! total conversion of biomass to litter 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TOTAL_BM_LITTER     "), &
+            &               TRIM("total conversion of biomass to litter             "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Leaf death                                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LEAF_BM_LITTER      "), &
+            &               TRIM("Leaf death                                        "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+       
+       ! Sap death above ground                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_AB_BM_LITTER    "), &
+            &               TRIM("Sap death above ground                            "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Sap death below ground                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("SAP_BE_BM_LITTER    "), &
+            &               TRIM("Sap death below ground                            "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Heartwood death above ground                      
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEART_AB_BM_LITTER  "), &
+            &               TRIM("Heartwood death above ground                      "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Heartwood death below ground                      
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEART_BE_BM_LITTER  "), &
+            &               TRIM("Heartwood death below ground                      "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Root death                                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ROOT_BM_LITTER      "), &
+            &               TRIM("Root death                                        "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+       
+       ! Fruit death                                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FRUIT_BM_LITTER     "), &
+            &               TRIM("Fruit death                                       "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Carbohydrate reserve death                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("RESERVE_BM_LITTER   "), &
+            &               TRIM("Carbohydrate reserve death                        "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
+
+       ! Maintenance respiration                           
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MAINT_RESP          "), &
+            &               TRIM("Maintenance respiration                           "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+
+       ! Growth respiration                                
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GROWTH_RESP         "), &
+            &               TRIM("Growth respiration                                "), &
+            &               TRIM("gC/m^2/day          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
+       
+       ! age                                               
+       CALL histdef (hist_id_stom, &
+            &               TRIM("AGE                 "), &
+            &               TRIM("age                                               "), &
+            &               TRIM("years               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(7), dt, hist_dt)
+       
+       ! height                                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HEIGHT              "), &
+            &               TRIM("height                                            "), &
+            &               TRIM("m                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(7), dt, hist_dt)
+
+       ! weekly moisture stress                            
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MOISTRESS           "), &
+            &               TRIM("weekly moisture stress                            "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
+
+       ! Maximum rate of carboxylation                     
+       CALL histdef (hist_id_stom, &
+            &               TRIM("VCMAX               "), &
+            &               TRIM("Maximum rate of carboxylation                     "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! leaf age                                          
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LEAF_AGE            "), &
+            &               TRIM("leaf age                                          "), &
+            &               TRIM("days                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+       
+       ! Fraction of trees that dies (gap)                 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("MORTALITY           "), &
+            &               TRIM("Fraction of trees that dies (gap)                 "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! Fraction of plants killed by fire                 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FIREDEATH           "), &
+            &               TRIM("Fraction of plants killed by fire                 "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! Density of newly established saplings             
+       CALL histdef (hist_id_stom, &
+            &               TRIM("IND_ESTAB           "), &
+            &               TRIM("Density of newly established saplings             "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! Establish tree
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ESTABTREE           "), &
+            &               TRIM("Rate of tree establishement                       "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(6), dt, hist_dt)
+
+       ! Establish grass
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ESTABGRASS          "), &
+            &               TRIM("Rate of grass establishement                      "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(6), dt, hist_dt)
+
+       ! Fraction of plants that dies (light competition)  
+       CALL histdef (hist_id_stom, &
+            &               TRIM("LIGHT_DEATH         "), &
+            &               TRIM("Fraction of plants that dies (light competition)  "), &
+            &               TRIM("1/day               "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
+
+       ! biomass allocated to leaves                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_LEAF       "), &
+            &               TRIM("biomass allocated to leaves                       "), &
+            &               TRIM("gC/m**2/pft/dt      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to sapwood above ground         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_SAP_AB     "), &
+            &               TRIM("biomass allocated to sapwood above ground         "), &
+            &               TRIM("gC/m**2/pft/dt      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to sapwood below ground         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_SAP_BE     "), &
+            &               TRIM("biomass allocated to sapwood below ground         "), &
+            &               TRIM("gC/m**2/pft/dt      "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to roots                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_ROOT       "), &
+            &               TRIM("biomass allocated to roots                        "), &
+            &               TRIM("gC/m**2/pft/dt          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to fruits                       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_FRUIT      "), &
+            &               TRIM("biomass allocated to fruits                       "), &
+            &               TRIM("gC/m**2/pft/dt          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! biomass allocated to carbohydrate reserve         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BM_ALLOC_RES        "), &
+            &               TRIM("biomass allocated to carbohydrate reserve         "), &
+            &               TRIM("gC/m**2/pft/dt          "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! time constant of herbivore activity               
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HERBIVORES          "), &
+            &               TRIM("time constant of herbivore activity               "), &
+            &               TRIM("days                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+
+       ! turnover time for grass leaves                    
+       CALL histdef (hist_id_stom, &
+            &               TRIM("TURNOVER_TIME       "), &
+            &               TRIM("turnover time for grass leaves                    "), &
+            &               TRIM("days                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
+       
+       ! 10 year wood product pool                         
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PROD10              "), &
+            &               TRIM("10 year wood product pool                         "), &
+            &               TRIM("gC/m**2             "), iim,jjm, hist_hori_id, &
+            &               11,1,11, hist_pool_11axis_id,32, ave(5), dt, hist_dt)
+       
+       ! annual flux for each 10 year wood product pool    
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FLUX10              "), &
+            &               TRIM("annual flux for each 10 year wood product pool    "), &
+            &               TRIM("gC/m**2/yr          "), iim,jjm, hist_hori_id, &
+            &               10,1,10, hist_pool_10axis_id,32, ave(5), dt, hist_dt)
+       
+       ! 100 year wood product pool                        
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PROD100             "), &
+            &               TRIM("100 year wood product pool                        "), &
+            &               TRIM("gC/m**2             "), iim,jjm, hist_hori_id, &
+            &               101,1,101, hist_pool_101axis_id,32, ave(5), dt, hist_dt)
+
+       ! annual flux for each 100 year wood product pool   
+       CALL histdef (hist_id_stom, &
+            &               TRIM("FLUX100             "), &
+            &               TRIM("annual flux for each 100 year wood product pool   "), &
+            &               TRIM("gC/m**2/yr          "), iim,jjm, hist_hori_id, &
+            &               100,1,100, hist_pool_100axis_id,32, ave(5), dt, hist_dt)
+
+       ! annual release right after deforestation          
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CONVFLUX            "), &
+            &               TRIM("annual release right after deforestation          "), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+
+       ! annual release from all 10 year wood product pools 
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CFLUX_PROD10        "), &
+            &               TRIM("annual release from all 10 year wood product pools"), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+
+       ! annual release from all 100year wood product pools
+       CALL histdef (hist_id_stom, &
+            &               TRIM("CFLUX_PROD100       "), &
+            &               TRIM("annual release from all 100year wood product pools"), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+       ! agriculure product
+       CALL histdef (hist_id_stom, &
+            &               TRIM("HARVEST_ABOVE       "), &
+            &               TRIM("annual release product after harvest              "), &
+            &               TRIM("gC/m**2/day          "), iim,jjm, hist_hori_id, &
+            &               1,1,1, -99,32, ave(5), dt, hist_dt)
+
+
+       CALL histdef(hist_id_stom, 'RESOLUTION_X', 'E-W resolution', 'm', &
+            & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+       CALL histdef(hist_id_stom, 'RESOLUTION_Y', 'N-S resolution', 'm', &
+            & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+       CALL histdef(hist_id_stom, 'CONTFRAC', 'Continental fraction', '1', &
+            & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+       CALL histdef(hist_id_stom, 'Areas', 'Mesh areas', 'm2', &
+            & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+       
+       !  Special outputs for phenology
+       CALL histdef (hist_id_stom, &
+            &               TRIM("WHEN_GROWTHINIT     "), &
+            &               TRIM("Time elapsed from season beginning                "), &
+            &               TRIM("d                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("PFTPRESENT          "), &
+            &               TRIM("PFT exists                                        "), &
+            &               TRIM("d                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GDD_MIDWINTER       "), &
+            &               TRIM("Growing degree days, since midwinter              "), &
+            &               TRIM("degK                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+
+       CALL histdef (hist_id_stom, &
+            &               TRIM("GDD_M5_DORMANCE     "), &
+            &               TRIM("Growing degree days, since dormance               "), &
+            &               TRIM("degK                "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("NCD_DORMANCE        "), &
+            &               TRIM("Number of chilling days, since leaves were lost   "), &
+            &               TRIM("d                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("ALLOW_INITPHENO     "), &
+            &               TRIM("Allow to declare beginning of the growing season  "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+       
+       CALL histdef (hist_id_stom, &
+            &               TRIM("BEGIN_LEAVES        "), &
+            &               TRIM("Signal to start putting leaves on                 "), &
+            &               TRIM("-                   "), iim,jjm, hist_hori_id, &
+            &               nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
+    ENDIF
+    !---------------------------------
+  END SUBROUTINE stom_define_history
+  !
+  SUBROUTINE stom_IPCC_define_history &
+       & (hist_id_stom_IPCC, nvm, iim, jjm, dt, &
+       &  hist_dt, hist_hori_id, hist_PFTaxis_id)
+    ! deforestation axis added as arguments
+
+    !---------------------------------------------------------------------
+    !- Tell ioipsl which variables are to be written
+    !- and on which grid they are defined
+    !---------------------------------------------------------------------
+    IMPLICIT NONE
+    !-
+    !- Input
+    !-
+    !- File id
+    INTEGER(i_std),INTENT(in) :: hist_id_stom_IPCC
+    !- number of PFTs
+    INTEGER(i_std),INTENT(in) :: nvm
+    !- Domain size
+    INTEGER(i_std),INTENT(in) :: iim, jjm
+    !- Time step of STOMATE (seconds)
+    REAL(r_std),INTENT(in)    :: dt
+    !- Time step of history file (s)
+    REAL(r_std),INTENT(in)    :: hist_dt
+    !- id horizontal grid
+    INTEGER(i_std),INTENT(in) :: hist_hori_id
+    !- id of PFT axis
+    INTEGER(i_std),INTENT(in) :: hist_PFTaxis_id
+    !-
+    !- 1 local
+    !-
+    !- Character strings to define operations for histdef
+    CHARACTER(LEN=40),DIMENSION(max_hist_level) :: ave
+
+    !=====================================================================
+    !- 1 define operations
+    !=====================================================================
+    ave(1) =  'ave(scatter(X))'
+    !=====================================================================
+    !- 2 surface fields (2d)
+    !=====================================================================
+    ! Carbon in Vegetation
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cVeg"), &
+         &               TRIM("Carbon in Vegetation"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Litter Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLitter"), &
+         &               TRIM("Carbon in Litter Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoil"), &
+         &               TRIM("Carbon in Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Products of Land Use Change
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cProduct"), &
+         &               TRIM("Carbon in Products of Land Use Change"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon Mass Variation
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cMassVariation"), &
+         &               TRIM("Terrestrial Carbon Mass Variation"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Leaf Area Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("lai"), &
+         &               TRIM("Leaf Area Fraction"), &
+         &               TRIM("1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Gross Primary Production
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("gpp"), &
+         &               TRIM("Gross Primary Production"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Autotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("ra"), &
+         &               TRIM("Autotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Net Primary Production
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("npp"), &
+         &               TRIM("Net Primary Production"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Heterotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("rh"), &
+         &               TRIM("Heterotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Emission from Fire
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fFire"), &
+         &               TRIM("CO2 Emission from Fire"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! CO2 Flux to Atmosphere from Crop Harvesting
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fHarvest"), &
+         &               TRIM("CO2 Flux to Atmosphere from Crop Harvesting"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux to Atmosphere from Land Use Change
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fLuc"), &
+         &               TRIM("CO2 Flux to Atmosphere from Land Use Change"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Net Biospheric Production
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nbp"), &
+         &               TRIM("Net Biospheric Production"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Total Carbon Flux from Vegetation to Litter
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fVegLitter"), &
+         &               TRIM("Total Carbon Flux from Vegetation to Litter"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Total Carbon Flux from Litter to Soil
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("fLitterSoil"), &
+         &               TRIM("Total Carbon Flux from Litter to Soil"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! Carbon in Leaves
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLeaf"), &
+         &               TRIM("Carbon in Leaves"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Wood
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cWood"), &
+         &               TRIM("Carbon in Wood"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Roots
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cRoot"), &
+         &               TRIM("Carbon in Roots"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Other Living Compartments
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cMisc"), &
+         &               TRIM("Carbon in Other Living Compartments"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! Carbon in Above-Ground Litter
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLitterAbove"), &
+         &               TRIM("Carbon in Above-Ground Litter"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Below-Ground Litter
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cLitterBelow"), &
+         &               TRIM("Carbon in Below-Ground Litter"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Fast Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoilFast"), &
+         &               TRIM("Carbon in Fast Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Medium Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoilMedium"), &
+         &               TRIM("Carbon in Medium Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Carbon in Slow Soil Pool
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("cSoilSlow"), &
+         &               TRIM("Carbon in Slow Soil Pool"), &
+         &               TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    !- 3 PFT: 3rd dimension
+    ! Fractional Land Cover of PFT
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("landCoverFrac"), &
+         &               TRIM("Fractional Land Cover of PFT"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
+
+
+    ! Total Primary Deciduous Tree Cover Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("treeFracPrimDec"), &
+         &               TRIM("Total Primary Deciduous Tree Cover Fraction"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! Total Primary Evergreen Tree Cover Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("treeFracPrimEver"), &
+         &               TRIM("Total Primary Evergreen Tree Cover Fraction"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    ! Total C3 PFT Cover Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("c3PftFrac"), &
+         &               TRIM("Total C3 PFT Cover Fraction"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Total C4 PFT Cover Fraction
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("c4PftFrac"), &
+         &               TRIM("Total C4 PFT Cover Fraction"), &
+         &               TRIM("%"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Growth Autotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("rGrowth"), &
+         &               TRIM("Growth Autotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Maintenance Autotrophic Respiration
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("rMaint"), &
+         &               TRIM("Maintenance Autotrophic Respiration"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux from Atmosphere due to NPP Allocation to Leaf
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nppLeaf"), &
+         &               TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Leaf"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux from Atmosphere due to NPP Allocation to Wood
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nppWood"), &
+         &               TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Wood"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! CO2 Flux from Atmosphere due to NPP Allocation to Root
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nppRoot"), &
+         &               TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Root"), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+    ! Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity on Land.
+    CALL histdef (hist_id_stom_IPCC, &
+         &               TRIM("nep"), &
+         &               TRIM("Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity."), &
+         &               TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(1), dt, hist_dt)
+
+    CALL histdef(hist_id_stom_IPCC, 'RESOLUTION_X', 'E-W resolution', 'm', &
+         & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+    CALL histdef(hist_id_stom_IPCC, 'RESOLUTION_Y', 'N-S resolution', 'm', &
+         & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+    CALL histdef(hist_id_stom_IPCC, 'CONTFRAC', 'Continental fraction', '1', &
+         & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+    CALL histdef(hist_id_stom_IPCC, 'Areas', 'Mesh areas', 'm2', &
+         & iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
+
+    !---------------------------------
+  END SUBROUTINE stom_IPCC_define_history
+END MODULE intersurf
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/qsat_moisture.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/qsat_moisture.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/qsat_moisture.f90	(revision 5166)
@@ -0,0 +1,584 @@
+! =================================================================================================================================
+! MODULE 	: qsat_moisture
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2011)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "qsat_moisture" module contains public tools functions like qsat, dev_qsat.   
+!!
+!!\n DESCRIPTION: This module is the result of the splitting of constantes_veg.\n
+!!                As the subroutines qsatcalc, dev_qsatcalc are used only by enerbil and diffuco, they are part of SECHIBA 
+!!                component. 
+!!
+!! REFERENCE(S)	: 
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE qsat_moisture
+
+  USE defprec
+  USE constantes
+  USE IOIPSL
+
+!-
+  IMPLICIT NONE
+!-
+
+  LOGICAL,SAVE :: l_qsat_first=.TRUE.                !! First call to qsat subroutines and functions (true/false)
+!$OMP THREADPRIVATE(l_qsat_first)
+
+
+  INTEGER(i_std),PARAMETER :: max_temp=370           !! Maximum temperature for saturated humidity (K) and also used as 
+                                                     !! the size of local array to keep saturated humidity (unitless)
+
+  INTEGER(i_std),PARAMETER :: min_temp=100           !! Minimum temperature for saturated humidity (K)
+
+  REAL(r_std),DIMENSION(max_temp),SAVE :: qsfrict    !! Array to keep saturated humidity at each temperature level 
+                                                     !! (kg of water/kg of air)
+!$OMP THREADPRIVATE(qsfrict)
+
+  CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: qsatcalc
+!! 
+!>\BRIEF          This routine calculates the saturated humidity using the pressure
+!!                and the temperature for all pixels. 
+!!
+!! DESCRIPTION : This routine interpolates qsat between temperatures by the following formula :
+!!               \latexonly
+!!               \input{qsatcalc.tex}
+!!               \endlatexonly
+!!               \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S) : qsat_out
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+    SUBROUTINE qsatcalc (kjpindex,temp_in,pres_in,qsat_out)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration
+      
+      !! 0.1 Input variables
+      
+      INTEGER(i_std),INTENT(in) :: kjpindex                   !! Domain size (unitless)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: temp_in  !! Temperature in degre Kelvin (K)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: pres_in  !! Pressure (Pa)
+      
+      !! 0.2 Output variables 
+      
+      REAL(r_std),DIMENSION(kjpindex),INTENT(out) :: qsat_out !! Saturated humidity at the surface (kg of water/kg of air)
+      
+      !! 0.4 Local variables
+      
+      INTEGER(i_std), DIMENSION(kjpindex) :: jt               !! Temporary array stocking the truncated temperatures in Kelvin 
+                                                              !!(converted into integers)
+      INTEGER(i_std)                      :: ji               !! indices (unitless)
+      REAL(r_std),DIMENSION(kjpindex)     :: zz_a, zz_b, zz_f !! Temporary variables
+      INTEGER(i_std)                      :: nbad             !! Number of points where the temperature is too high or too low
+      INTEGER(i_std),DIMENSION(1)         :: lo               !! Temporary vector to mark the position of the highest temperature
+                                                              !! or the lowest temperature over all the pixels in jt (unitless)
+!_ ================================================================================================================================
+
+      !-
+      !! 1.Initialize qsfrict array if needed
+      !-
+      IF (l_qsat_first) THEN
+         !-
+         CALL qsfrict_init
+         l_qsat_first = .FALSE.
+         !-
+      ENDIF !(l_qsat_first)
+      
+      !-
+      !! 2. Computes qsat interpolation into two successive temperature
+      !-
+      jt = INT(temp_in(:))
+       
+      !! 2.1 Diagnostic pixels where the temperature is too high 
+      nbad = COUNT(jt(:) >= max_temp-1)
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) ' qsatcalc: temperature too high at ', &
+              &    nbad, ' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(2,'qsatcalc','diffuco', '', &
+                 &                     'temperature incorect.') ! Warning message
+         ELSE
+            lo = MAXLOC(temp_in(:))
+            WRITE(numout,*) &
+                 &     'Maximum temperature ( ',MAXVAL(temp_in),') found at ',lo(1)
+            WHERE (jt(:) >= max_temp-1)   jt(:) = max_temp-1
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF ! (nbad > 0)
+ 
+      
+      !! 2.2 Diagnostic pixels where the temperature is too low
+      nbad = COUNT(jt(:) <= min_temp)
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) ' qsatcalc: temperature too low at ', &
+              &    nbad, ' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(2,'qsatcalc','diffuco', '', &
+                 &                   'temperature incorect.') ! Warning message
+         ELSE
+            lo = MINLOC(temp_in(:))
+            WRITE(numout,*) &
+                 &     'Minimum temperature ( ',MINVAL(temp_in),') found at ',lo(1)
+            WHERE (jt(:) <= min_temp)   jt(:) = min_temp
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF! (nbad > 0)
+ 
+      !! 2.3 Temporary variables needed for interpolation
+      DO ji = 1, kjpindex ! Loop over # pixels
+         
+         zz_f(ji) = temp_in(ji)-FLOAT(jt(ji))
+         zz_a(ji) = qsfrict(jt(ji))
+         zz_b(ji) = qsfrict(jt(ji)+1)
+         
+      ENDDO ! Loop over # pixels
+      
+      !-
+      !! 3. Interpolation between these two values
+      !-
+      DO ji = 1, kjpindex ! Loop over # pixels
+         
+         qsat_out(ji) = ((zz_b(ji)-zz_a(ji))*zz_f(ji)+zz_a(ji))/pres_in(ji)
+         
+      ENDDO  ! Loop over # pixels
+
+
+    END SUBROUTINE qsatcalc
+ 
+!! ================================================================================================================================
+!! FUNCTION 	: [DISPENSABLE] qsat
+!!
+!>\BRIEF         This function computes deviation the saturated humidity with the pressure
+!! and the temperature for a scalar. 
+!!
+!! DESCRIPTION : This routine is obsolete : replaced by the subroutine qsatcalc. \n
+!!               qsat is interpolated by : \n
+!!               \latexonly
+!!               \input{qsat.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): None\n
+!!
+!! RETURN VALUE : qsat_result
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================    
+
+    FUNCTION qsat (temp_in,pres_in) RESULT (qsat_result)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration
+
+      !! 0.1 Input variables
+
+      REAL(r_std),INTENT(in) :: temp_in   !! Temperature (K)
+      REAL(r_std),INTENT(in) :: pres_in   !! Pressure    (Pa)
+
+      !! 0.2 Result
+      
+      REAL(r_std) :: qsat_result          !! Saturated humidity calculated at the surface (kg/kg)
+      
+      !! 0.4 Local variables
+      
+      INTEGER(i_std)   :: jt              !! Temporary scalar stocking the truncated temperature in Kelvin 
+                                          !! (converted into integer)
+      REAL(r_std)      :: zz_a,zz_b,zz_f  !! Temporary scalar variables      
+ 
+!_ ================================================================================================================================
+
+      !-
+      !! 1.Initialize qsfrict array if needed
+      !-
+      IF (l_qsat_first) THEN
+         !-
+         CALL qsfrict_init
+         l_qsat_first = .FALSE.
+         !-
+      ENDIF
+
+      !-
+      !! 2. Computes qsat interpolation into two successive temperatures
+      !-
+      jt = INT(temp_in)
+
+      !! 2.1 Is the temperature too high ?
+      IF (jt >= max_temp-1) THEN
+         WRITE(numout,*) &
+              &   ' We stop. temperature too BIG : ',temp_in, &
+              &   ' approximation for : ',jt
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(2,'qsat','', '',&
+                 &                   'temperature incorect.') ! Warning message
+         ELSE
+            qsat_result = 999999.
+            RETURN
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(jt >= max_temp-1)
+
+      !! 2.2 Is the temperature too low ?
+      IF (jt <= min_temp ) THEN
+         WRITE(numout,*) &
+              &   ' We stop. temperature too SMALL : ',temp_in, &
+              &   ' approximation for : ',jt
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(2,'qsat','', '',&
+                 &                   'temperature incorect.')
+         ELSE
+            qsat_result = -999999.
+            RETURN
+         ENDIF!(.NOT.diag_qsat)
+         !-
+      ENDIF !(jt <= min_temp )
+
+      !! 2.3 Temporary variables needed for interpolation
+      zz_f = temp_in-FLOAT(jt)
+      zz_a = qsfrict(jt)
+      zz_b = qsfrict(jt+1)
+
+      !! 3. Interpolates between these two values
+
+      qsat_result = ((zz_b-zz_a)*zz_f+zz_a)/pres_in
+
+
+    END FUNCTION qsat
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: dev_qsatcalc
+!!
+!>\BRIEF         This routine calculates the deviation of the saturated humidity qsat.
+!!
+!! DESCRIPTION : The deviation of qsat is calculated by :
+!!               \latexonly
+!!               \input{dev_qsatcalc.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S) : dev_qsat_out
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!!
+!! FLOWCHART    :
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_moigdd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================ 
+
+    SUBROUTINE dev_qsatcalc (kjpindex,temp_in,pres_in,dev_qsat_out)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration
+      
+      !! 0.1 Input variables
+
+      INTEGER(i_std),INTENT(in)                   :: kjpindex       !! Domain size (unitless)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: temp_in        !! Temperature (K)
+      REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: pres_in        !! Pressure
+
+
+      !! 0.2 Output variables 
+      
+      REAL(r_std),DIMENSION(kjpindex),INTENT(out) :: dev_qsat_out   !! Result (??units??) 
+
+      
+      !! 0.4 Local variables
+      
+      INTEGER(i_std),DIMENSION(kjpindex) :: jt                      !! Temporary array stocking the truncated temperatures
+                                                                    !! in Kelvin (converted into integers) 
+      INTEGER(i_std)                     :: ji                      !! Indice (unitless)
+      REAL(r_std),DIMENSION(kjpindex)    :: zz_a, zz_b, zz_c, zz_f  !! Temporary vector variables
+      INTEGER(i_std)                     :: nbad                    !! Number of points where the temperature is too high or too low
+
+!_ ================================================================================================================================
+
+      !-
+      !! 1.Initialize qsfrict array if needed
+      !-
+      IF (l_qsat_first) THEN
+         !-
+         CALL qsfrict_init
+         l_qsat_first = .FALSE.
+         !-
+      ENDIF
+
+      !-
+      !! 2. Compute qsat interpolation into two successive temperature
+      !-
+      jt = INT(temp_in(:)+undemi)
+      
+      !! 2.1 Pixels where the temperature is too high 
+      nbad = COUNT( jt(:) >= max_temp-1 )
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) &
+              &   ' dev_qsatcalc: temperature too high at ',nbad,' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'dev_qsatcalc','', '', &
+                 &                   'temperature incorect.') ! Fatal error
+         ELSE
+            WHERE (jt(:) >= max_temp-1)   jt(:) = max_temp-1
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(nbad > 0)
+      
+      !! 2.2 Pixels where the temperature is too low
+      nbad = COUNT( jt(:) <= min_temp )
+      
+      IF (nbad > 0) THEN
+         WRITE(numout,*) &
+              &   ' dev_qsatcalc: temperature too low at ',nbad,' points.'
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'dev_qsatcalc', '', '',&
+                 &                   'temperature incorect.') ! Fatal error
+         ELSE
+            WHERE (jt(:) <= min_temp)   jt(:) = min_temp
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(nbad > 0)
+
+      !! 2.3 Temporary variables needed for interpolation
+      DO ji=1,kjpindex  ! Loop over # pixels
+         
+         zz_f(ji) = temp_in(ji)+undemi-FLOAT(jt(ji))
+         zz_a(ji) = qsfrict(jt(ji)-1)
+         zz_b(ji) = qsfrict(jt(ji))
+         zz_c(ji) = qsfrict(jt(ji)+1)
+         
+      ENDDO ! Loop over # pixels
+      
+      !-
+      !! 3. Interpolates between these two values
+      !-
+      DO ji = 1, kjpindex ! Loop over # pixels
+         
+         dev_qsat_out(ji) = &
+              &   ((zz_c(ji)-deux*zz_b(ji)+zz_a(ji))*(zz_f(ji)-un) + &
+              &                         zz_c(ji)-zz_b(ji))/pres_in(ji)
+         
+      ENDDO ! Loop over # pixels
+
+
+    END SUBROUTINE dev_qsatcalc
+
+!! ================================================================================================================================
+!! FUNCTION 	: [DISPENSABLE] dev_qsat
+!!
+!>\BRIEF         This function computes deviation of qsat. 
+!!
+!! DESCRIPTION : The deviation of qsat is calculated by :
+!!               \latexonly
+!!               \input{dev_qsat.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : dev_qsat_result
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+    FUNCTION dev_qsat (temp_in,pres_in) RESULT (dev_qsat_result)
+
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration 
+   
+      !! 0.1 Input variables
+
+      REAL(r_std),INTENT(in)  :: pres_in          !! Pressure (Pa)
+      REAL(r_std),INTENT(in)  :: temp_in          !! Temperture (K)
+      
+      !! 0.2 Result
+
+      REAL(r_std) :: dev_qsat_result              !! (??units??) !!
+      
+      !! 0.4 Local variables
+
+      INTEGER(i_std)  :: jt                       !! Index (unitless)
+      REAL(r_std)     :: zz_a, zz_b, zz_c, zz_f   !! Temporary scalars   
+
+!_ ================================================================================================================================
+ 
+      !-
+      !! 1.Initialize qsfrict array if needed
+      !-
+      IF (l_qsat_first) THEN
+         !-
+         CALL qsfrict_init
+         l_qsat_first = .FALSE.
+         !-
+      ENDIF
+
+      !-
+      !! 2. computes qsat deviation interpolation
+      !!    into two successive temperature
+      !-
+      jt = INT(temp_in+undemi)
+
+      !! 2.1 Is the temperature too high ?
+      IF (jt >= max_temp-1) THEN
+         !-
+         WRITE(numout,*) &
+              &   ' We stop. temperature too HIGH : ',temp_in, &
+              &   ' approximation for : ',jt
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'dev_qsat','', '',&
+                 &                   'temperature incorect.') ! Fatal error
+         ELSE
+            dev_qsat_result = 999999.
+            RETURN
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(jt >= max_temp-1)
+      !-
+      !! 2.2 Is the temperature too low ?
+      IF (jt <= min_temp ) THEN
+         WRITE(numout,*) &
+              &   ' We stop. temperature too LOW : ',temp_in, &
+              &   ' approximation for : ',jt
+         !-
+         IF (.NOT.diag_qsat) THEN
+            CALL ipslerr_p(3,'dev_qsat','', '',&
+                 &                    'temperature incorect.')
+         ELSE
+            dev_qsat_result = -999999.
+            RETURN
+         ENDIF !(.NOT.diag_qsat)
+         !-
+      ENDIF !(jt <= min_temp )
+
+      !! 2.3  Temporary variables for interpolation
+      zz_f = temp_in+undemi-FLOAT(jt)
+      zz_a = qsfrict(jt-1)
+      zz_b = qsfrict(jt)
+      zz_c = qsfrict(jt+1)
+
+      !-
+      !! 3. Interpolate
+      !-
+      dev_qsat_result=((zz_c-deux*zz_b+zz_a)*(zz_f-un)+zz_c-zz_b)/pres_in
+
+    END FUNCTION dev_qsat
+ 
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: qsfrict_init
+!!
+!>\BRIEF         The qsfrict_init routine initialises qsfrict array to store 
+!!               precalculated values for qsat by using Goff-Gratch equations.  
+!!
+!! DESCRIPTION : This routine calculates the specific humidity qsat as a function of temperature in 
+!!               Kelvin by using the modified Goff-Gratch equations(1946): \n
+!!               \latexonly
+!!               \input{goff_gratch.tex}
+!!               \endlatexonly
+!!               qsfrict is initialized by the following formulas : \n
+!!               \latexonly
+!!               \input{qsfrict_init.tex}
+!!               \endlatexonly
+!!               These values are used by the subroutines qsatcalc, dev_qsat. \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::qsfrict
+!!
+!! REFERENCE(S)	:
+!! - Algorithme d'un ensemble de paramÃ©trisation physique (1998), 
+!! Note de Laurent Li dÃ©crivant les paramÃ©trisations physiques incluses dans le modÃšle (pdf),
+!! http://lmdz.lmd.jussieu.fr/developpeurs/notes-techniques 
+!! - Goff, J. A., and S. Gratch (1946) Low-pressure properties of water from â160 to 212 Â°F, in Transactions of the
+!! American Society of Heating and Ventilating Engineers, pp 95â122, presented at the 52nd annual meeting of the
+!! American Society of Heating and Ventilating Engineers, New York, 1946.
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+    SUBROUTINE qsfrict_init
+      
+      IMPLICIT NONE
+
+      !! 0. Variables and parameters declaration
+      
+      !! 0.4 Local variables
+
+      INTEGER(i_std) :: ji                             !! Indice(unitless)
+      REAL(r_std)    :: zrapp,zcorr,ztemperature,zqsat !! Temporary vector variables      
+
+!_ ================================================================================================================================
+
+      !! 1. Initialisation
+      zrapp = msmlr_h2o/msmlr_air
+      zcorr = 0.00320991_r_std
+      
+      !! 2. Computes saturated humidity one time and store in qsfrict local array
+      DO ji=100,max_temp ! Loop over size(qsfrict) : each position of qsfrict matches a temperature 
+         
+         ztemperature = FLOAT(ji)
+         !-
+         IF (ztemperature < 273._r_std) THEN 
+           zqsat = zrapp*10.0_r_std**(2.07023_r_std-zcorr*ztemperature &
+                 &             -2484.896/ztemperature+3.56654*LOG10(ztemperature)) ! Equilibrium water vapor - solid
+         ELSE 
+            zqsat = zrapp*10.0**(23.8319-2948.964/ztemperature & 
+                 &              -5.028*LOG10(ztemperature) &
+                 &              -29810.16*EXP(-0.0699382*ztemperature) &
+                 &              +25.21935*EXP(-2999.924/ztemperature)) ! Equilibrium water vapor - liquid
+         ENDIF !(ztemperature < 273._r_std)
+         !-
+         qsfrict (ji) = zqsat
+         
+      ENDDO ! Loop over size(qsfrict) 
+
+      !! 3. Set to zero the non-computed values
+      qsfrict(1:100) = zero 
+      !-
+      IF (long_print) WRITE (numout,*) ' qsfrict_init done'
+
+
+    END SUBROUTINE qsfrict_init
+
+
+END MODULE qsat_moisture
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/routing.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/routing.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/routing.f90	(revision 5166)
@@ -0,0 +1,9374 @@
+!w =================================================================================================================================
+
+! MODULE       : routing
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module routes the water over the continents into the oceans and computes the water
+!!             stored in floodplains or taken for irrigation.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) :
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+! 
+!
+! Histoire Salee
+!---------------
+! La douce riviere
+! Sortant de son lit
+! S'est jetee ma chere
+! dans les bras mais oui
+! du beau fleuve
+!
+! L'eau coule sous les ponts
+! Et puis les flots s'emeuvent
+! - N'etes vous pas au courant ?
+! Il parait que la riviere 
+! Va devenir mer
+!                       Roland Bacri
+!
+
+
+MODULE routing
+  !
+  !
+  ! routines called : restput, restget
+  !
+  USE ioipsl   
+  USE ioipsl_para 
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE sechiba_io
+  USE interpol_help
+  USE grid
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+ 
+  ! public routines :
+ 
+  PRIVATE
+  PUBLIC :: routing_main, routing_clear
+ 
+  ! variables shared by all subroutines inside the routing module : declaration and initialisation
+  LOGICAL, SAVE                                              :: l_first_routing=.TRUE.      !! Logical to initialize the routine. 
+                                                                                            !! Initialisation has to be done one 
+                                                                                            !! time (true/false)
+ 
+!! PARAMETERS
+  INTEGER(i_std), PARAMETER                                  :: nbasmax=7                   !! The maximum number of basins we wish
+                                                                                            !! to have per grid box (truncation of 
+                                                                                            !! the model) (unitless)
+  INTEGER(i_std)                                             :: nbvmax                      !! The maximum number of basins we can 
+                                                                                            !! handle at any time during the 
+                                                                                            !! generation of the maps (unitless)
+  REAL(r_std), PARAMETER                                     :: slow_tcst_cwrr = 25.0       !! Property of the slow reservoir,
+                                                                                            !! when CWRR hydrology is activated 
+                                                                                            !! @tex $(day m^{-1})$ @endtex
+  REAL(r_std), PARAMETER                                     :: fast_tcst_cwrr = 3.0        !! Property of the fast reservoir, when
+                                                                                            !! CWRR hydrology is activated 
+                                                                                            !! @tex $(day m^{-1})$ @endtex
+  REAL(r_std), PARAMETER                                     :: stream_tcst_cwrr = 0.24     !! Property of the stream reservoir, 
+                                                                                            !! when CWRR hydrology is activated 
+                                                                                            !! @tex $(day m^{-1})$ @endtex
+  REAL(r_std), PARAMETER                                     :: flood_tcst_cwrr = 4.0       !! Property of the floodplains 
+                                                                                            !! reservoir, when CWRR hydrology is 
+                                                                                            !! activated 
+                                                                                            !! @tex $(day m^{-1})$ @endtex
+  REAL(r_std), PARAMETER                                     :: swamp_cst_cwrr = 0.2        !! Fraction of the river transport that 
+                                                                                            !! flows to the swamps, when CWRR 
+                                                                                            !! hydrology is activated 
+                                                                                            !! (unitless;0-1)
+  REAL(r_std), PARAMETER                                     :: slow_tcst_chois = 25.0      !! Property of the slow reservoir, when
+                                                                                            !! Choisnel hydrology is activated 
+                                                                                            !! @tex $(day m^{-1})$ @endtex
+  REAL(r_std), PARAMETER                                     :: fast_tcst_chois = 3.0       !! Property of the fast reservoir, when 
+                                                                                            !! Choisnel hydrology is activated 
+                                                                                            !! @tex $(day m^{-1})$ @endtex
+  REAL(r_std), PARAMETER                                     :: stream_tcst_chois = 0.24    !! Property of the stream reservoir, 
+                                                                                            !! when Choisnel hydrology is activated 
+                                                                                            !! @tex $(day m^{-1})$ @endtex
+  REAL(r_std), PARAMETER                                     :: flood_tcst_chois = 4.0      !! Property of the floodplains 
+                                                                                            !! reservoir, when Choisnel hydrology 
+                                                                                            !! is activated 
+                                                                                            !! @tex $(day m^{-1})$ @endtex
+  REAL(r_std), PARAMETER                                     :: swamp_cst_chois = 0.2       !! Fraction of the river transport that
+                                                                                            !! flows to the swamps, when Choisnel 
+                                                                                            !! hydrology is activated 
+                                                                                            !! (unitless;0-1)
+  REAL(r_std), SAVE                                          :: fast_tcst                   !! Property of the fast reservoir,
+                                                                                            !! @tex $(day m^{-1})$ @endtex
+  REAL(r_std), SAVE                                          :: slow_tcst                   !! Property of the slow reservoir, 
+                                                                                            !! @tex $(day m^{-1})$ @endtex
+  REAL(r_std), SAVE                                          :: stream_tcst                 !! Property of the stream reservoir, 
+                                                                                            !! @tex $(day m^{-1})$ @endtex
+  REAL(r_std), SAVE                                          :: flood_tcst                  !! Property of the floodplains reservoir, 
+                                                                                            !! @tex $(day m^{-1})$ @endtex
+  REAL(r_std), SAVE                                          :: swamp_cst                   !! Fraction of the river transport that 
+                                                                                            !! flows to the swamps (unitless;0-1)
+  
+  !  Relation between volume and fraction of floodplains
+  
+  REAL(r_std), PARAMETER                                     :: beta = 2.0                  !! Parameter to fix the shape of the 
+                                                                                            !! floodplain (>1 for convex edges, 
+                                                                                            !! <1 for concave edges) (unitless)
+  REAL(r_std), PARAMETER                                     :: betap = 0.5                 !! Ratio of the basin surface 
+                                                                                            !! intercepted by ponds and the maximum 
+                                                                                            !! surface of ponds (unitless;0-1)
+  REAL(r_std), PARAMETER                                     :: floodcri = 2000.0           !! Potential height for which all the 
+                                                                                            !! basin is flooded (mm)
+  
+  !  Relation between maximum surface of ponds and basin surface, and drainage (mm/j) to the slow_res
+  
+  REAL(r_std), PARAMETER                                     :: pond_bas = 50.0             !! [DISPENSABLE] - not used
+  REAL(r_std), PARAMETER                                     :: pondcri = 2000.0            !! Potential height for which all the 
+                                                                                            !! basin is a pond (mm)
+  REAL(r_std), PARAMETER                                     :: maxevap_lake = 7.5/86400.   !! Maximum evaporation rate from lakes
+                                                                                            !! @tex $(kg m^{-2} s^{-1})$ @endtex
+  REAL(r_std), PARAMETER                                     :: min_reservoir = 1.E-6_r_std !! A minimum amount of water in the 
+                                                                                            !! reservoir is set so that we do not 
+                                                                                            !! loose when correcting for rounding 
+                                                                                            !! errors (kg)
+  
+  REAL(r_std), PARAMETER                                     :: crop_coef = 1.0             !! Empirical crop coefficient dependent 
+                                                                                            !! on vegetation characteristics
+                                                                                            !! according to Kassel irrigation 
+                                                                                            !! parametrization.
+                                                                                            !! When potential transpiration is used 
+                                                                                            !! this coefficient has another 
+                                                                                            !! interpretation (unitless)
+  
+  REAL(r_std),SAVE                                           :: dt_routing                  !! Routing time step (s)
+  
+  INTEGER(i_std), SAVE                                       :: diagunit = 87               !! Diagnostic file unit (unitless)
+
+  ! Decomposition rates for dissolved organic carbon
+  REAL(r_std), SAVE                                          :: T_water = 25                !! Water temperature (Â°C)
+                                                                                            !! Maybe better in Kelvin?
+                                                                                            !! Maybe we need different water
+                                                                                            !! for different reservoirs 
+  REAL(r_std), SAVE                                          :: fast_dec = 0.05             !! Preliminary test rate (unitless)
+  REAL(r_std), SAVE                                          :: slow_dec = 0.05             !! Preliminary test rate (unitless)  
+  REAL(r_std), SAVE                                          :: stream_dec = 0.05           !! Preliminary test rate (unitless)
+  REAL(r_std), SAVE                                          :: flood_dec = 0.05            !! Preliminary test rate (unitless)
+  REAL(r_std), SAVE                                          :: pond_dec = 0.05             !! Preliminary test rate (unitless)
+  REAL(r_std), SAVE                                          :: CO2_conc1 = 12.0E-6         !! Test concentrations for C (unitless)
+  REAL(r_std), SAVE                                          :: CO2_conc2 = 12.0E-7         !! Test concentrations for C (unitless)
+  REAL(r_std), SAVE                                          :: CO2_conc3 = 15.0E-8         !! Test concentrations for C (unitless) 
+  REAL(r_std), SAVE                                          :: doc_conc1 = 1.0E-6          !! Test concentrations for C (unitless)
+  REAL(r_std), SAVE                                          :: doc_conc2 = 1.0E-5          !! Test concentrations for C (unitless)  
+  REAL(r_std), SAVE                                          :: doc_conc3 = 2.0E-6          !! Test concentrations for C (unitless)
+  REAL(r_std), SAVE                                          :: k_headw = 3.0               !! Gas_exchange velocity in head waters
+                                                                                            !! @tex $(m day^{-1})$ @endtex
+  REAL(r_std), SAVE                                          :: k_stream = 3.0              !! Gas_exchange velocity in streams
+                                                                                            !! @tex $(m day^{-1})$ @endtex
+                                                                                            !! k_headw and k_stream later from 
+                                                                                            !! forcing file (also in floodplains)
+  REAL(r_std), SAVE                                          :: k_flood = 3.0               !! Gas_exchange velocity in head waters
+                                                                                            !! @tex $(m day^{-1})$ @endtex
+  REAL(r_std), SAVE                                          :: k_pond = 3.0                !! Gas_exchange velocity in head waters
+                                                                                            !! @tex $(m day^{-1})$ @endtex
+  REAL(r_std), SAVE                                          :: pCO2_atm = 350.0            !! Atmospheric pCO2 (atm)
+  INTEGER(i_std), SAVE                                       :: nstep_FCO2 = 240            !! Segmentation steps per day used
+                                                                                            !! used in calculation of CO2 evasion
+                                                                                            !! from water surfaces
+                                                                                            
+  ! Logicals to control model configuration  
+  LOGICAL, SAVE                                              :: doirrigation = .FALSE.      !! Logical to choose if irrigation is
+                                                                                            !! activated or not (true/false)
+  LOGICAL, SAVE                                              :: dofloodplains = .FALSE.     !! Logical to choose if floodplains are
+                                                                                            !! activated or not (true/false)
+  LOGICAL, SAVE                                              :: dofloodinfilt = .FALSE.     !! Logical to choose if floodplains 
+                                                                                            !! infiltration is activated or not 
+                                                                                            !! (true/false)
+  LOGICAL, SAVE                                              :: doswamps = .FALSE.          !! Logical to choose if swamps are 
+                                                                                            !! activated or not (true/false)
+  LOGICAL, SAVE                                              :: doponds = .FALSE.           !! Logical to choose if ponds are 
+                                                                                            !! activated or not (true/false)
+  LOGICAL, SAVE                                              :: ok_doc = .TRUE.             !! Logical to choose if C is activated
+                                                                                            !! or not (true/false)
+  
+  ! The variables describing the basins and their routing, need to be in the restart file.  
+  INTEGER(i_std), SAVE                                       :: num_largest                 !! Number of largest river basins which 
+                                                                                            !! should be treated as independently 
+                                                                                            !! as rivers (not flow into ocean as 
+                                                                                            !! diffusion coastal flow) (unitless)
+  REAL(r_std), SAVE                                          :: time_counter                !! Time counter (s)
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: routing_area_loc            !! Surface of basin 
+                                                                                            !! @tex $(m^2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: topo_resid_loc              !! Topographic index of the retention 
+                                                                                            !! time (m)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_togrid_loc            !! Grid into which the basin flows 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_tobasin_loc           !! Basin in to which the water goes 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_nbintobas_loc         !! Number of basin into current one 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: global_basinid_loc          !! ID of basin (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:,:):: hydrodiag_loc               !! Variable to diagnose the hydrographs
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:)       :: hydroupbasin_loc            !! The area upstream of the gauging 
+                                                                                            !! station @tex $(m^2})$ @endtex
+  
+  ! parallelism
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: routing_area_glo            !! Surface of basin 
+                                                                                            !! @tex $(m^2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: topo_resid_glo              !! Topographic index of the retention
+                                                                                            !! time (m)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_togrid_glo            !! Grid into which the basin flows 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_tobasin_glo           !! Basin in to which the water goes 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_nbintobas_glo         !! Number of basin into current one 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: global_basinid_glo          !! ID of basin (unitless)
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:,:):: hydrodiag_glo               !! Variable to diagnose the hydrographs
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:)       :: hydroupbasin_glo            !! The area upstream of the gauging 
+                                                                                            !! station @tex $(m^2})$ @endtex
+  
+  REAL(r_std), SAVE, POINTER, DIMENSION(:,:)                 :: routing_area                !! Surface of basin 
+                                                                                            !! @tex $(m^2})$ @endtex
+  REAL(r_std), SAVE, POINTER, DIMENSION(:,:)                 :: topo_resid                  !! Topographic index of the retention 
+                                                                                            !! time (m)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: route_togrid                !! Grid into which the basin flows 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: route_tobasin               !! Basin in to which the water goes 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: route_nbintobas             !! Number of basin into current one 
+                                                                                            !! (unitless)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)              :: global_basinid              !! ID of basin (unitless)
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:,:)            :: hydrodiag                   !! Variable to diagnose the hydrographs
+  REAL(r_std), SAVE, POINTER, DIMENSION(:)                   :: hydroupbasin                !! The area upstream of the gauging 
+                                                                                            !! station @tex $(m^2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: irrigated                   !! Area equipped for irrigation in each 
+                                                                                            !! grid box @tex $(m^2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: floodplains                 !! Maximal surface which can be 
+                                                                                            !! inundated in each grid box 
+                                                                                            !! @tex $(m^2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: swamp                       !! Maximal surface of swamps in each 
+                                                                                            !! grid box @tex $(m^2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: headw_area                  !! Head water surface area in each 
+                                                                                            !! grid box @tex $(m^2})$ @endtex  
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: stream_area                 !! Stream/river surface area in each 
+                                                                                            !! grid box @tex $(m^2})$@endtex   
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: upstream_area               !! Upstream lying, contributing 
+                                                                                            !! area (=catchment area)  
+                                                                                            !! @tex $(m^2})$ @endtex          
+  ! The reservoirs, also to be put into the restart file.
+  
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:)           :: fast_reservoir              !! Water or matter amount in the  
+                                                                                            !! fast reservoir (kg)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:)           :: slow_reservoir              !! Water or matter amount in the 
+                                                                                            !! slow reservoir (kg)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:)           :: stream_reservoir            !! Water or matter amount in the 
+                                                                                            !! stream reservoir (kg)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:)           :: flood_reservoir             !! Water or matter amount in the 
+                                                                                            !! floodplains reservoir (kg)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: lake_reservoir              !! Water or matter amount in the 
+                                                                                            !! lake reservoir (kg)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: pond_reservoir              !! Water or matter amount in the 
+                                                                                            !! pond reservoir (kg)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: flood_frac_bas              !! Flooded fraction per basin 
+                                                                                            !! (unitless;0-1)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: pond_frac                   !! Pond fraction per grid box 
+                                                                                            !! (unitless;0-1)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: flood_height                !! Floodplain height (mm)
+  
+  ! The accumulated fluxes.
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: floodout_mean               !! Accumulated flow out of floodplains
+                                                                                            !! Evaporation-Precipitation 
+                                                                                            !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: runoff_mean                 !! Accumulated runoff 
+                                                                                            !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: drainage_mean               !! Accumulated drainage 
+                                                                                            !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: transpot_mean               !! Mean potential transpiration from 
+                                                                                            !! the plants 
+                                                                                            !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: precip_mean                 !! Accumulated precipitation 
+                                                                                            !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: humrel_mean                 !! Mean soil moisture stress, mean root 
+                                                                                            !! extraction potential (unitless)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: totnobio_mean               !! Mean last total fraction of no bio 
+                                                                                            !! (unitless;0-1)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: vegtot_mean                 !! Mean potentially vegetated fraction 
+                                                                                            !! (unitless;0-1)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: k_litt_mean                 !! Mean averaged conductivity for 
+                                                                                            !! saturated infiltration in the 
+                                                                                            !! 'litter' layer 
+                                                                                            !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  
+  ! The averaged outflow fluxes.
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: lakeinflow_mean              !! Mean lake inflow 
+                                                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: returnflow_mean              !! Mean water and matter flow from 
+                                                                                             !! lakes and swamps which returns to 
+                                                                                             !! the grid box.
+                                                                                             !! This water and dissolved matter 
+                                                                                             !! will go back into the hydrol or 
+                                                                                             !! hydrolc module to allow 
+                                                                                             !! re-evaporation 
+                                                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: reinfiltration_mean          !! Mean water and matter flow which 
+                                                                                             !! returns to the grid box 
+                                                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: irrigation_mean              !! Mean irrigation flux.
+                                                                                             !! This is the water taken from the 
+                                                                                             !! reservoirs and beeing put into the
+                                                                                             !! upper layers of the soil 
+                                                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: riverflow_mean               !! Mean Outflow of the major rivers.
+                                                                                             !! The flux will be located on the 
+                                                                                             !! continental grid but this should be
+                                                                                             !! a coastal point 
+                                                                                             !! @tex $(kg dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: coastalflow_mean             !! Mean outflow on coastal points by 
+                                                                                             !! small basins.
+                                                                                             !! It flows in a disperse way into 
+                                                                                             !! the ocean 
+                                                                                             !! @tex $(kg dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: floodtemp                    !! Temperature to decide if 
+                                                                                             !! floodplains work (K)
+  INTEGER(i_std), SAVE                                       :: floodtemp_lev                !! Temperature level to decide if 
+                                                                                             !! floodplains work (K)
+  
+  ! Diagnostic variables ... well sort of !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: irrig_netereq                !! Irrigation requirement (water 
+                                                                                             !! requirements by the crop for its 
+                                                                                             !! optimal growth 
+                                                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: hydrographs                  !! Hydrographs at the outflow of the 
+                                                                                             !! grid box for major basins 
+                                                                                             !! @tex $(kg dt^{-1})$ @endtex
+                                                                                             !! sofar no dimension for matterfluxes
+                                                                                             !! were added
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: FCO2_aq                      !! CO2 evasion from water surface
+                                                                                             !! @tex $(kg C dt^{-1})$ @endtex  
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: pCO2_aq                      !! CO2 evasion from water surface
+                                                                                             !! @tex $(kg C dt^{-1})$ @endtex   
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: DOC_inp                      !! Input DOC
+  ! Diagnostics for the various reservoirs we use @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: fast_diag                    !! Diagnostic for the fast reservoir 
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: slow_diag                    !! Diagnostic for the slow reservoir 
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: stream_diag                  !! Diagnostic for the stream reservoir
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: flood_diag                   !! Diagnostic for the floodplain 
+                                                                                             !! reservoir 
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: pond_diag                    !! Diagnostic for the pond reservoir 
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)             :: lake_diag                    !! Diagnostic for the lake reservoir 
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)               :: delsurfstor                  !! Diagnostic of the change in surface 
+                                                                                             !! water storage (flood, pond and lake
+                                                                                             !! reservoirs) 
+                                                                                             !! @tex $(kg m^{-2})$ @endtex
+  
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_main 
+!!
+!>\BRIEF          This module routes the water over the continents (runoff and
+!!                drainage produced by the hydrolc or hydrol module) into the oceans. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags):
+!! The routing scheme (Polcher, 2003) carries the water from the runoff and drainage simulated by SECHIBA
+!! to the ocean through reservoirs, with some delay. The routing scheme is based on
+!! a parametrization of the water flow on a global scale (Miller et al., 1994; Hagemann
+!! and Dumenil, 1998). Given the global map of the main watersheds (Oki et al., 1999;
+!! Fekete et al., 1999; Vorosmarty et al., 2000) which delineates the boundaries of subbasins
+!! and gives the eight possible directions of water flow within the pixel, the surface
+!! runoff and the deep drainage are routed to the ocean. The time-step of the routing is one day.
+!! The scheme also diagnoses how much water is retained in the foodplains and thus return to soil
+!! moisture or is taken out of the rivers for irrigation. \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!! The result of the routing are 3 fluxes :
+!! - riverflow   : The water which flows out from the major rivers. The flux will be located
+!!                 on the continental grid but this should be a coastal point.
+!! - coastalflow : This is the water which flows in a disperse way into the ocean. Essentially these
+!!                 are the outflows from all of the small rivers.
+!! - returnflow  : This is the water which flows into a land-point - typically rivers which end in
+!!                 the desert. This water will go back into the hydrol module to allow re-evaporation.
+!! - irrigation  : This is water taken from the reservoir and is being put into the upper 
+!!                 layers of the soil.
+!! The two first fluxes are in kg/dt and the last two fluxes are in kg/(m^2dt).\n
+!!
+!! REFERENCE(S) :
+!! - Miller JR, Russell GL, Caliri G (1994)
+!!   Continental-scale river flow in climate models.
+!!   J. Clim., 7:914-928
+!! - Hagemann S and Dumenil L. (1998)
+!!   A parametrization of the lateral waterflow for the global scale.
+!!   Clim. Dyn., 14:17-31
+!! - Oki, T., T. Nishimura, and P. Dirmeyer (1999)
+!!   Assessment of annual runoff from land surface models using total runoff integrating pathways (TRIP)
+!!   J. Meteorol. Soc. Jpn., 77, 235-255
+!! - Fekete BM, Charles V, Grabs W (2000)
+!!   Global, composite runoff fields based on observed river discharge and simulated water balances.
+!!   Technical report, UNH/GRDC, Global Runoff Data Centre, Koblenz
+!! - Vorosmarty, C., B. Fekete, B. Meybeck, and R. Lammers (2000)
+!!   Global system of rivers: Its role in organizing continental land mass and defining land-to-ocean linkages
+!!   Global Biogeochem. Cycles, 14, 599-621
+!! - Vivant, A-C. (?? 2002)
+!!   DÃ©veloppement du schÃ©ma de routage et des plaines d'inondation, MSc Thesis, Paris VI University
+!! - J. Polcher (2003)
+!!   Les processus de surface a l'echelle globale et leurs interactions avec l'atmosphere
+!!   Habilitation a diriger les recherches, Paris VI University, 67pp.
+!!
+!! FLOWCHART    :
+!! \latexonly 
+!! \includegraphics[scale=0.75]{routing_main_flowchart.png}
+!! \endlatexonly
+!! \n
+! <JR19012> Could there be more labels on the picture to make it clear what does V_1, V_2 etc correspond to?
+!_ ================================================================================================================================
+
+SUBROUTINE routing_main(kjit, nbpt, dtradia, control_flags, ldrestart_read, ldrestart_write, index, &
+       & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, &
+       & drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, &
+       & stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, rest_id, &
+       & hist_id, hist2_id, DOC_EXP_agg_d)
+    !
+    IMPLICIT NONE
+ 
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)     :: kjit                 !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)     :: nbpt                 !! Domain size (unitless)
+    INTEGER(i_std),INTENT(in)      :: rest_id              !! Restart file identifier (unitless)
+    INTEGER(i_std),INTENT(in)      :: hist_id              !! Access to history file (unitless)
+    INTEGER(i_std),INTENT(in)      :: hist2_id             !! Access to history file 2 (unitless)
+    REAL(r_std), INTENT(in)        :: dtradia              !! Time step of the model (s)
+    TYPE(control_type), INTENT(in) :: control_flags        !! Flags that (de)activate parts of the model (unitless)
+    LOGICAL, INTENT(in)            :: ldrestart_read       !! Logical for _restart_ file to read (true/false)
+    LOGICAL, INTENT(in)            :: ldrestart_write      !! Logical for _restart_ file to write (true/false)
+    INTEGER(i_std), INTENT(in)     :: index(nbpt)          !! Indices of the points on the map (unitless)
+    REAL(r_std), INTENT(in)        :: lalo(nbpt,2)         !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)     :: neighbours(nbpt,8)   !! Vector of neighbours for each grid point 
+                                                           !! (unitless; 1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), INTENT(in)        :: resolution(nbpt,2)   !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)        :: contfrac(nbpt)       !! Fraction of land in each grid box (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: totfrac_nobio(nbpt)  !! Total fraction of no-vegetation (continental ice, lakes ...) 
+                                                           !! (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: veget_max(nbpt,nvm)  !! Maximal fraction of vegetation (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: floodout(nbpt)       !! Grid-point flow out of floodplains 
+                                                           !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)        :: runoff(nbpt)         !! Grid-point runoff @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)        :: drainage(nbpt)       !! Grid-point drainage @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)        :: transpot(nbpt,nvm)   !! Potential transpiration of the vegetation 
+                                                           !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)        :: precip_rain(nbpt)    !! Rainfall @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)        :: k_litt(nbpt)         !! Averaged conductivity for saturated infiltration in the 'litter' 
+                                                           !! layer @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)        :: humrel(nbpt,nvm)     !! Soil moisture stress, root extraction potential (unitless)
+    REAL(r_std), INTENT(in)        :: stempdiag(nbpt,nbdl) !! Diagnostic soil temperature profile
+    REAL(r_std), INTENT(in)        :: reinf_slope(nbpt)    !! Coefficient which determines the reinfiltration ratio in the 
+                                                           !! grid box due to flat areas (unitless;0-1)
+    REAL(r_std), INTENT(in)        :: DOC_EXP_agg_d(nbpt,nexp)   !! DOC exports, diffrenet paths (nexp), in  
+                                                                 !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex                                                              
+    
+    !! 0.2 Output variables
+    REAL(r_std), INTENT(out)       :: returnflow(nbpt,nflow)     !! The water flow from lakes and swamps which returns to 
+                                                                 !! the grid box. This water will go back into the hydrol
+                                                                 !! or hydrolc module to allow re-evaporation 
+                                                                 !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(out)       :: reinfiltration(nbpt,nflow) !! Water flow from ponds and floodplains which returns 
+                                                                 !! to the grid box @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(out)       :: irrigation(nbpt,nflow)     !! Irrigation flux. This is the water taken from the 
+                                                                 !! reservoirs and beeing put into the upper layers of the 
+                                                                 !! soil @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(out)       :: riverflow(nbpt,nflow)      !! Outflow of the major rivers. The flux will be located 
+                                                                 !! on the continental grid but this should be a coastal point 
+                                                                 !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), INTENT(out)       :: coastalflow(nbpt,nflow)    !! Outflow on coastal points by small basins. This is the water 
+                                                                 !! which flows in a disperse way into the ocean 
+                                                                 !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), INTENT(out)       :: flood_frac(nbpt)           !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), INTENT(out)       :: flood_res(nbpt)            !! Diagnostic of water amount in the floodplains reservoir (kg)
+    
+    !! 0.3 Local variables
+    CHARACTER(LEN=80)                 :: var_name                !! To store variables names for I/O (unitless)
+    CHARACTER(LEN=10)                 :: flow_suff               !! To assign a suffix to the variables name indicating the 
+                                                                 !! transported specie
+    CHARACTER(LEN=80)                 :: var_long_name           !! To store variables long names for I/O (unitless)
+    REAL(r_std), DIMENSION(1)         :: tmp_day                 !! 
+    REAL(r_std), DIMENSION(nbpt,nflow):: return_lakes            !! Water from lakes flowing back into soil moisture 
+                                                                 !! @tex $(kg m^{-2} dt^{-1})$ @endtex                                                              
+    INTEGER(i_std)                    :: ig, jv                  !! Indices (unitless)
+    LOGICAL, SAVE                     :: init_irrig=.FALSE.      !! Logical to initialize the irrigation (true/false)
+    LOGICAL, SAVE                     :: init_flood=.FALSE.      !! Logical to initialize the floodplains (true/false)
+    LOGICAL, SAVE                     :: init_swamp=.FALSE.      !! Logical to initialize the swamps (true/false)
+    LOGICAL, SAVE                     :: init_streamsurf=.FALSE. !! Logical to initialize the stream surface (true/false)
+    REAL(r_std), DIMENSION(nbpt)      :: tot_vegfrac_nowoody     !! Total fraction occupied by grass (0-1,unitless)
+    INTEGER(i_std)                    :: iflow                   !! Index (unitless)
+
+!_ ================================================================================================================================
+
+!! 1. Initialize
+
+    !! 1.1 First call only
+    IF (l_first_routing) THEN
+       
+       nbvmax = 440
+       ! Here we will allocate the memory and get the fixed fields from the restart file.
+       ! If the info is not found then we will compute the routing map.
+       
+       CALL routing_init (kjit, nbpt, index, control_flags, dtradia, &
+            &             returnflow, reinfiltration, irrigation, riverflow, coastalflow, &
+            &             flood_frac, flood_res, stempdiag, rest_id)
+
+
+       routing_area => routing_area_loc  
+       topo_resid => topo_resid_loc
+       route_togrid => route_togrid_loc
+       route_tobasin => route_tobasin_loc
+       global_basinid => global_basinid_loc
+       hydrodiag => hydrodiag_loc
+       
+       ! This routine computes the routing map if the route_togrid_glo is undefined. This means that the
+       ! map has not been initialized during the restart process..
+       
+       !! Reads in the map of the basins and flow directions to construct the catchments of each grid box
+       !
+       IF ( COUNT(route_togrid_glo .GE. undef_int) .GT. 0 ) THEN
+          CALL routing_basins_p(nbpt, lalo, neighbours, resolution, contfrac)
+       ENDIF
+       !
+       ! Do we have what we need if we want to do irrigation
+       !! Initialisation of flags for irrigated land, flood plains and swamps
+       !! and stream surface and head water surface areas
+       IF ( doirrigation .OR. dofloodplains .OR. doswamps .OR. ok_doc) THEN
+
+          IF ( doirrigation ) THEN 
+             IF (COUNT(irrigated .GE. undef_sechiba-1) > 0) THEN
+                init_irrig = .TRUE.
+             ENDIF
+          ENDIF
+
+          IF ( dofloodplains ) THEN
+             IF (COUNT(floodplains .GE. undef_sechiba-1) > 0) THEN
+                init_flood = .TRUE.
+             ENDIF
+          ENDIF
+
+          IF ( doswamps ) THEN
+             IF (COUNT(swamp .GE. undef_sechiba-1) > 0) THEN
+                init_swamp = .TRUE.
+             ENDIF
+          ENDIF
+          
+          IF ( ok_doc ) THEN
+             IF (COUNT((headw_area+stream_area) .GE. undef_sechiba-1) > 0) THEN
+                init_streamsurf = .TRUE.
+             ENDIF
+          ENDIF          
+
+          !! If we have irrigated land, flood plains or swamps then we need to interpolate the 
+          !! 0.5 degree base data set to the resolution of the model.
+
+          IF ( init_irrig .OR. init_flood .OR. init_swamp .OR. init_streamsurf ) THEN
+             CALL routing_irrigmap (nbpt, index, lalo, neighbours, resolution, contfrac, &
+       &                     init_irrig, irrigated, init_flood, floodplains, init_swamp, &
+       &                     swamp, init_streamsurf, headw_area, stream_area, hist_id, hist2_id) 
+          ENDIF
+
+          IF ( doirrigation ) THEN 
+             WRITE(numout,*) 'Verification : range of irrigated : ', MINVAL(irrigated), MAXVAL(irrigated) 
+             IF ( .NOT. almaoutput ) THEN
+                CALL histwrite(hist_id, 'irrigmap', 1, irrigated, nbpt, index)
+             ELSE
+                CALL histwrite(hist_id, 'IrrigationMap', 1, irrigated, nbpt, index)
+             ENDIF
+             IF ( hist2_id > 0 ) THEN
+                IF ( .NOT. almaoutput ) THEN
+                   CALL histwrite(hist2_id, 'irrigmap', 1, irrigated, nbpt, index)
+                ELSE
+                   CALL histwrite(hist2_id, 'IrrigationMap', 1, irrigated, nbpt, index)
+                ENDIF
+             ENDIF
+          ENDIF
+          !
+          IF ( dofloodplains ) THEN
+             WRITE(numout,*) 'Verification : range of floodplains : ', MINVAL(floodplains), MAXVAL(floodplains) 
+             IF ( .NOT. almaoutput ) THEN
+                CALL histwrite(hist_id, 'floodmap', 1, floodplains, nbpt, index)
+             ELSE
+                CALL histwrite(hist_id, 'FloodplainsMap', 1, floodplains, nbpt, index)
+             ENDIF
+             IF ( hist2_id > 0 ) THEN
+                IF ( .NOT. almaoutput ) THEN
+                   CALL histwrite(hist2_id, 'floodmap', 1, floodplains, nbpt, index)
+                ELSE
+                   CALL histwrite(hist2_id, 'FloodplainsMap', 1, floodplains, nbpt, index)
+                ENDIF
+             ENDIF
+          ENDIF
+          !
+          IF ( doswamps ) THEN
+             WRITE(numout,*) 'Verification : range of swamp : ', MINVAL(swamp), MAXVAL(swamp) 
+             IF ( .NOT. almaoutput ) THEN
+                CALL histwrite(hist_id, 'swampmap', 1, swamp, nbpt, index)
+             ELSE
+                CALL histwrite(hist_id, 'SwampMap', 1, swamp, nbpt, index)
+             ENDIF
+             IF ( hist2_id > 0 ) THEN
+                IF ( .NOT. almaoutput ) THEN
+                   CALL histwrite(hist2_id, 'swampmap', 1, swamp, nbpt, index)
+                ELSE
+                   CALL histwrite(hist2_id, 'SwampMap', 1, swamp, nbpt, index)
+                ENDIF
+             ENDIF
+          ENDIF
+          !
+          IF ( ok_doc ) THEN
+             WRITE(numout,*) 'Verification : range of head water surface : ', &
+              &              MINVAL(headw_area), MAXVAL(headw_area) 
+             WRITE(numout,*) 'Verification : range of stream/river surface : ', &
+              &              MINVAL(stream_area), MAXVAL(stream_area)               
+             IF ( .NOT. almaoutput ) THEN
+                CALL histwrite(hist_id, 'headw_map', 1, headw_area, nbpt, index)
+                CALL histwrite(hist_id, 'stream_map', 1, stream_area, nbpt, index)                
+             ELSE
+                CALL histwrite(hist_id, 'Headw_Map', 1, headw_area, nbpt, index)
+                CALL histwrite(hist_id, 'Stream_Map', 1, stream_area, nbpt, index)                
+             ENDIF
+             IF ( hist2_id > 0 ) THEN
+                IF ( .NOT. almaoutput ) THEN
+                   CALL histwrite(hist2_id, 'headw_map', 1, headw_area, nbpt, index)
+                   CALL histwrite(hist2_id, 'stream_map', 1, stream_area, nbpt, index)                   
+                ELSE
+                   CALL histwrite(hist2_id, 'Headw_Map', 1, headw_area, nbpt, index)
+                   CALL histwrite(hist2_id, 'Stream_Map', 1, stream_area, nbpt, index)                   
+                ENDIF
+             ENDIF
+          ENDIF
+          !
+       ENDIF
+       !
+       !! This routine gives a diagnostic of the basins used.
+       !
+       CALL routing_diagnostic_p(nbpt, index, lalo, resolution, contfrac, hist_id, hist2_id)
+       !
+       l_first_routing = .FALSE.
+       !
+       RETURN
+       !
+    ENDIF
+
+    !! 1.2 Computes the variables averaged between routing time steps 
+    !! and which will be used in subsequent calculations
+    
+    ! The floodtemeperature is needed to evaluate wether the implementation of the flood plains
+    ! work or not
+    floodtemp(:) = stempdiag(:,floodtemp_lev)
+    
+    ! 'precip_rain', 'runoff', 'drainage'  are input parameters only for water. The parameters 
+    ! 'precip_mean', 'runoff_mean', 'drainage_mean', on the other hand, have a third dimension 
+    ! for different matter fluxes. The dimension iflow=2 (DOC) and iflow=3 (CO2) are at this 
+    ! preliminary stage computed with a test concentration  which is taken for both species. 
+    ! Next steps: The concentrations, or better the fluxes of CO2 and DOC in runoff and drainage 
+    ! will come from the soil carbon module. For precipitation, we will have to distinguish direct 
+    ! precipitation on e.g. water surface of flooded areas, which has likely negligible 
+    ! concnetrations of DOC, and throughfall. The CO2 conentrations in the precipitation could 
+    ! be assumed to be in equilibrium with the atmosphere. Similarly, 'floodout' is only calculated 
+    ! for water sofar, later, there needs to be a C balance for precipitation gains and evaporation 
+    ! losses.   
+    floodout_mean(:) = floodout_mean(:) + floodout(:)   
+    precip_mean(:,ih2o) =  precip_mean(:,ih2o) + precip_rain(:)
+    runoff_mean(:,ih2o) = runoff_mean(:,ih2o) + runoff(:)
+    drainage_mean(:,ih2o) = drainage_mean(:,ih2o) + drainage(:)
+
+    DOC_inp = DOC_EXP_agg_d
+    IF(ok_doc)THEN 
+       drainage_mean(:,idoc)   = DOC_EXP_agg_d(:,idrainage)*1e-3   
+       runoff_mean(:,idoc)     = DOC_EXP_agg_d(:,irunoff)*1e-3   
+       precip_mean(:,idoc)     = precip_mean(:,idoc) + precip_rain(:)*doc_conc3
+       drainage_mean(:,iCO2aq) = drainage_mean(:,iCO2aq) + drainage(:)*CO2_conc1    
+       runoff_mean(:,iCO2aq)   = runoff_mean(:,iCO2aq) + runoff(:)*CO2_conc2    
+       precip_mean(:,iCO2aq)   = precip_mean(:,iCO2aq) + precip_rain(:)*CO2_conc3    
+    ENDIF !ok_doc
+
+    !! Computes the total fraction occupied by the grasses and the crops for each grid cell
+    tot_vegfrac_nowoody(:) = zero
+    DO jv  = 1, nvm
+       IF ( (jv /= ibare_sechiba) .AND. .NOT.(is_tree(jv)) ) THEN  
+       !RL This was changed by Camille and FGU:  IF ( is_c3(jv) .OR. is_c4(jv) ) THEN
+          tot_vegfrac_nowoody(:) = tot_vegfrac_nowoody(:) + veget_max(:,jv) 
+       END IF
+    END DO
+
+    DO ig = 1, nbpt
+       IF ( tot_vegfrac_nowoody(ig) .GT. min_sechiba ) THEN
+          DO jv = 1,nvm
+             IF ( (jv /= ibare_sechiba) .AND. .NOT.(is_tree(jv)) ) THEN 
+             !RL This was changed by Camille and FGU:  IF ( is_c3(jv) .OR. is_c4(jv) ) THEN
+                transpot_mean(ig) = transpot_mean(ig) + transpot(ig,jv) &
+                               &  * veget_max(ig,jv)/tot_vegfrac_nowoody(ig)  
+             END IF
+          END DO
+       ELSE
+          IF (MAXVAL(veget_max(ig,2:nvm)) .GT. min_sechiba) THEN
+             DO jv = 2, nvm
+                transpot_mean(ig) = transpot_mean(ig) + transpot(ig,jv) &
+                              &   * veget_max(ig,jv)/ SUM(veget_max(ig,2:nvm))
+             ENDDO
+          ENDIF
+       ENDIF
+    ENDDO
+
+    ! Averaged variables (i.e. *dtradia/dt_routing). This accounts for the difference between 
+    ! the shorter timestep dtradia of other parts of the model and the long dt_routing timestep 
+    ! (set to one day at present)
+    
+    totnobio_mean(:) = totnobio_mean(:) + totfrac_nobio(:)*dtradia/dt_routing
+    k_litt_mean(:) = k_litt_mean(:) + k_litt(:)*dtradia/dt_routing
+    
+    ! Only potentially vegetated surfaces are taken into account. At the start of
+    ! the growing seasons we will give more weight to these areas.
+    
+    DO jv=2,nvm
+       DO ig=1,nbpt
+          humrel_mean(ig) = humrel_mean(ig) + humrel(ig,jv)*veget_max(ig,jv)*dtradia/dt_routing
+          vegtot_mean(ig) = vegtot_mean(ig) + veget_max(ig,jv)*dtradia/dt_routing
+       ENDDO
+    ENDDO
+    
+    time_counter = time_counter + dtradia 
+    
+    !! 2 If the time has come we do the routing.
+    
+    IF ( NINT(time_counter) .GE. NINT(dt_routing) ) THEN 
+       
+       !! 2.1 Check the water balance if needed
+       
+       IF ( check_waterbal ) THEN
+          CALL routing_waterbal(nbpt, .TRUE., flood_frac, floodout_mean, precip_mean, runoff_mean,&
+          & drainage_mean, returnflow_mean, reinfiltration_mean, irrigation_mean, riverflow_mean, & 
+          & coastalflow_mean)
+       ENDIF
+       ! Make sure we do not flood north of 49N as there freezing processes start to play a 
+       ! role and they are not yet well treated in ORCHIDEE.
+       
+       DO ig=1,nbpt
+          IF ( lalo(ig,1) > 49.0 ) THEN
+             floodtemp(ig) = tp_00 - un
+          ENDIF
+       ENDDO
+      
+       !! 2.2 Computes the transport of water in the various reservoirs
+       
+       CALL routing_flow(nbpt, dt_routing, floodout_mean, runoff_mean, drainage_mean, &
+       & vegtot_mean, totnobio_mean, transpot_mean, precip_mean, humrel_mean, &
+       & k_litt_mean, floodtemp, reinf_slope, lakeinflow_mean, returnflow_mean, &
+       & reinfiltration_mean, irrigation_mean, riverflow_mean, coastalflow_mean, hydrographs,&
+       & flood_frac, flood_res)
+       
+       !! 2.3 Responsible for storing the water in lakes
+       
+       CALL routing_lake(nbpt, dt_routing, lakeinflow_mean, humrel_mean, return_lakes)
+
+       returnflow_mean(:,:) = returnflow_mean(:,:) + return_lakes(:,:)
+       
+       !! 2.4 Check the water balance in the routing scheme
+       
+       IF ( check_waterbal ) THEN
+          CALL routing_waterbal(nbpt, .FALSE., flood_frac, floodout_mean, precip_mean, &
+          & runoff_mean, drainage_mean, returnflow_mean, reinfiltration_mean, irrigation_mean, &
+          & riverflow_mean, coastalflow_mean)
+       ENDIF    
+       
+       !! 2.5 Reinitalize variables for averages
+       time_counter = zero
+       !
+       floodout_mean(:) = zero
+       runoff_mean(:,:) = zero
+       drainage_mean(:,:) = zero
+       transpot_mean(:) = zero
+       precip_mean(:,:) = zero
+       !
+       humrel_mean(:) = zero
+       totnobio_mean(:) = zero
+       k_litt_mean(:) = zero
+       vegtot_mean(:) = zero
+       
+       !! 2.6 Change the units of the routing fluxes from kg/dt_routing into kg/dtradia
+       !!                                    and from m^3/dt_routing into m^3/dtradia
+       
+       returnflow_mean(:,:) = returnflow_mean(:,:)/dt_routing*dtradia
+       reinfiltration_mean(:,:) = reinfiltration_mean(:,:)/dt_routing*dtradia
+       irrigation_mean(:,:) = irrigation_mean(:,:)/dt_routing*dtradia
+       irrig_netereq(:) = irrig_netereq(:)/dt_routing*dtradia
+       
+       riverflow_mean(:,:) = riverflow_mean(:,:)/dt_routing*dtradia
+       coastalflow_mean(:,:) = coastalflow_mean(:,:)/dt_routing*dtradia
+       hydrographs(:,:) = hydrographs(:,:)/dt_routing*dtradia
+       
+       !! 2.7 Convert from kg/dtradia to m^3/dtradia
+       
+       hydrographs(:,:) = hydrographs(:,:)/1000.
+    ENDIF  !( NINT(time_counter) .GE. NINT(dt_routing) ) 
+    
+    !! 2.8 Return the fraction of routed water and transported matter for this time step.
+    
+    returnflow(:,:) = returnflow_mean(:,:)
+    reinfiltration(:,:) = reinfiltration_mean(:,:)
+    irrigation(:,:) = irrigation_mean(:,:)
+    riverflow(:,:) = riverflow_mean(:,:)
+    coastalflow(:,:) = coastalflow_mean(:,:)
+
+    
+    !! 3 Write restart
+    
+    IF (ldrestart_write) THEN 
+               !
+       var_name ="routingcounter"
+       tmp_day(1) = time_counter
+       IF (is_root_prc) CALL restput (rest_id, var_name, 1, 1, 1, kjit, tmp_day)
+       !
+       var_name = 'routingarea'
+       CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, routing_area, 'scatter', &
+            &         nbp_glo, index_g)
+       var_name = 'routetogrid'
+       CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, REAL(route_togrid,r_std), &
+            &         'scatter', nbp_glo, index_g)
+       var_name = 'routetobasin'
+       CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, REAL(route_tobasin,r_std), &
+            &         'scatter', nbp_glo, index_g)
+       var_name = 'basinid'
+       CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, REAL(global_basinid,r_std), &
+            &         'scatter', nbp_glo, index_g)
+       var_name = 'topoindex'
+       CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, topo_resid, 'scatter', &
+            &         nbp_glo, index_g)
+       var_name = 'floodh'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, flood_height, 'scatter', nbp_glo, &
+            &         index_g)
+       var_name = 'flood_frac_bas'
+       CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, flood_frac_bas, 'scatter', &
+            &         nbp_glo, index_g)
+       var_name = 'pond_frac'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, pond_frac, 'scatter',  nbp_glo, &
+            &         index_g)
+       var_name = 'flood_frac'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, flood_frac, 'scatter',  nbp_glo, &
+            &         index_g)
+       var_name = 'flood_res'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, flood_res, 'scatter', nbp_glo, &
+            &         index_g)
+       
+       DO iflow = 1, nflow
+          IF (iflow .EQ. 1) THEN
+             flow_suff = ''
+          ELSEIF (iflow .EQ. 2) THEN 
+             flow_suff = '_doc'
+          ELSEIF (iflow .EQ. 3) THEN
+             flow_suff = '_CO2'
+          ELSEIF (iflow .EQ. 4) THEN
+             flow_suff = '_CO2ev'          
+          ELSE
+             flow_suff = '_NoName'  !!ERROR - suffixes not specified
+          ENDIF !iflow=1...nflow
+          ! variables with two dimensions
+          var_name = 'fastres'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, &
+               &          fast_reservoir(:,:,iflow), 'scatter',  nbp_glo, index_g)
+          var_name = 'slowres'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit,  &
+               &          slow_reservoir(:,:,iflow), 'scatter',  nbp_glo, index_g)
+          var_name = 'streamres'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, &
+               &          stream_reservoir(:,:,iflow),'scatter',nbp_glo,index_g)
+          var_name = 'floodres'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, &
+               &          flood_reservoir(:,:,iflow), 'scatter',  nbp_glo, index_g)            
+          
+          !variables with one dimension
+          
+          var_name = 'lakeres'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, lake_reservoir(:,iflow), &
+               &            'scatter', nbp_glo, index_g)
+          var_name = 'pondres'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, pond_reservoir(:,iflow), &
+               &            'scatter', nbp_glo, index_g)     
+          var_name = 'lakeinflow'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, lakeinflow_mean(:,iflow), &
+               &            'scatter', nbp_glo, index_g)
+          var_name = 'returnflow'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, returnflow_mean(:,iflow), &
+               &            'scatter', nbp_glo, index_g)
+          var_name = 'reinfiltration'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, reinfiltration_mean(:,iflow), &
+               &            'scatter',  nbp_glo, index_g)
+          var_name = 'riverflow'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, riverflow_mean(:,iflow), &
+               &            'scatter',  nbp_glo, index_g)
+          var_name = 'coastalflow'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, coastalflow_mean(:,iflow), &
+               &            'scatter',  nbp_glo, index_g)
+          var_name = 'runoff_route'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, runoff_mean(:,iflow), &
+               &            'scatter', nbp_glo, index_g)
+          var_name = 'drainage_route'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, drainage_mean(:,iflow), &
+               &            'scatter', nbp_glo, index_g)
+          var_name = 'precip_route'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, precip_mean(:,iflow), &
+               &            'scatter', nbp_glo, index_g) 
+          var_name = 'hydrographs'//flow_suff
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, hydrographs(:,iflow), &
+               &         'scatter', nbp_glo, index_g)               
+          IF ( doirrigation ) THEN 
+             var_name = 'irrigation'//flow_suff
+             CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, irrigation_mean(:,iflow), &
+                     &            'scatter',  nbp_glo, index_g)
+          ENDIF !doirrigation
+       ENDDO !DO iflow = 1, nflow
+       
+
+       
+       ! Keep track of the accumulated variables
+       
+       var_name = 'floodout_route'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, floodout_mean, 'scatter', &
+            &         nbp_glo, index_g)
+       var_name = 'transpot_route'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, transpot_mean, 'scatter', &
+            &         nbp_glo, index_g)
+       var_name = 'humrel_route'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, humrel_mean, 'scatter', &
+            &         nbp_glo, index_g)
+       var_name = 'totnobio_route'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, totnobio_mean, 'scatter', &
+            &         nbp_glo, index_g)
+       var_name = 'k_litt_route'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, k_litt_mean, 'scatter', &
+            &         nbp_glo, index_g)
+       var_name = 'vegtot_route'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, vegtot_mean, 'scatter', &
+            &         nbp_glo, index_g)
+ 
+       IF ( doirrigation ) THEN 
+          var_name = 'irrigated'
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, irrigated,'scatter', &
+               &         nbp_glo, index_g)
+       ENDIF !doirrigation 
+       
+       IF ( dofloodplains ) THEN
+          var_name = 'floodplains'
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, floodplains, 'scatter', &
+               &         nbp_glo, index_g)
+       ENDIF
+       
+       IF ( doswamps ) THEN
+
+       ENDIF
+       
+       IF (ok_doc) THEN
+          var_name = 'stream_area'
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, stream_area, 'scatter', &
+               &         nbp_glo, index_g)          
+          var_name = 'headw_area'
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, headw_area, 'scatter', &
+               &         nbp_glo, index_g)          
+       ENDIF !ok_doc
+       
+       RETURN
+       
+    ENDIF !(ldrestart_write)
+    
+    !! 4 Write diagnostics
+    
+    IF ( .NOT. almaoutput ) THEN
+       ! first, only variables which are only for water
+       !
+       IF ( dofloodplains ) THEN
+          CALL histwrite(hist_id, 'floodh', kjit, flood_height, nbpt, index)
+       ENDIF
+       !
+       IF ( doirrigation ) THEN
+          CALL histwrite(hist_id, 'netirrig', kjit, irrig_netereq, nbpt, index)
+       ENDIF
+       ! now, the variables with differnet matter fluxes
+       DO iflow = 1, nflow
+       IF (iflow .EQ. 1) THEN
+          flow_suff = ''
+       ELSEIF (iflow .EQ. 2) THEN 
+          flow_suff = '_doc'
+       ELSEIF (iflow .EQ. 3) THEN
+          flow_suff = '_CO2'
+       ELSEIF (iflow .EQ. 4) THEN
+          flow_suff = '_CO2ev' 
+       ELSE
+          flow_suff = '_NoName'  !!ERROR - suffixes not specified
+       ENDIF !iflow=1...nflow
+       var_name = 'riversret'//flow_suff
+       CALL histwrite(hist_id, var_name, kjit, returnflow(:,iflow), nbpt, index)
+       var_name = 'fastr'//flow_suff       
+       CALL histwrite(hist_id, var_name, kjit, fast_diag(:,iflow), nbpt, index)
+       var_name = 'slowr'//flow_suff           
+       CALL histwrite(hist_id, var_name, kjit, slow_diag(:,iflow), nbpt, index)
+       var_name = 'streamr'//flow_suff         
+       CALL histwrite(hist_id, var_name, kjit, stream_diag(:,iflow), nbpt, index)
+       var_name = 'pondr'//flow_suff           
+       CALL histwrite(hist_id, var_name, kjit, pond_diag(:,iflow), nbpt, index)
+       var_name = 'lakevol'//flow_suff         
+       CALL histwrite(hist_id, var_name, kjit, lake_diag(:,iflow), nbpt, index)     
+       var_name = 'hydrographs'//flow_suff
+       CALL histwrite(hist_id, var_name, kjit, hydrographs(:,iflow), nbpt, index)       
+       IF (dofloodplains .OR. doponds) THEN
+          var_name = 'reinfiltration'//flow_suff           
+          CALL histwrite(hist_id, var_name, kjit, reinfiltration(:,iflow), nbpt, index)
+       ENDIF     
+       IF ( dofloodplains ) THEN
+          var_name = 'floodr'//flow_suff       
+          CALL histwrite(hist_id, var_name, kjit, flood_diag(:,iflow), nbpt, index)
+       ENDIF       
+       IF ( doirrigation ) THEN
+          var_name = 'irrigation'//flow_suff       
+          CALL histwrite(hist_id, var_name, kjit, irrigation(:,iflow), nbpt, index)
+          var_name = 'returnflow'//flow_suff          
+          CALL histwrite(hist_id, var_name, kjit, returnflow(:,iflow), nbpt, index)       
+       ENDIF       ! doiirigation
+       ENDDO !iflow = 1...nflow
+      !! FCO2 RL
+       DO iflow=1,naqsys
+          IF (iflow .EQ. 1) THEN
+             flow_suff = '_fast'
+          ELSEIF (iflow .EQ. 2) THEN 
+             flow_suff = '_slow'
+          ELSEIF (iflow .EQ. 3) THEN
+             flow_suff = '_stream'
+          ELSEIF (iflow .EQ. 4) THEN
+             flow_suff = '_flood' 
+          ELSEIF (iflow .EQ. 5) THEN
+             flow_suff = '_pond'        
+          ELSE
+             flow_suff = '_NoName'  !ERROR - suffixes not specified
+          ENDIF !iflow=1...nflow       
+          var_name = 'FCO2_aq'//flow_suff       
+          CALL histwrite(hist_id, var_name, kjit, FCO2_aq(:,iflow), nbpt, index)  
+          var_name = 'pCO2_aq'//flow_suff       
+          CALL histwrite(hist_id, var_name, kjit, pCO2_aq(:,iflow), nbpt, index)           
+       ENDDO !iflow=1,naqsys   
+       
+       !check DOC inputs
+       var_name = 'DOC_inp_runoff'       
+       CALL histwrite(hist_id, var_name, kjit, DOC_inp(:,irunoff), nbpt, index) 
+       var_name = 'DOC_inp_drainage'       
+       CALL histwrite(hist_id, var_name, kjit, DOC_inp(:,idrainage), nbpt, index)        
+       
+    ELSE !( .NOT. almaoutput )
+       ! For hydrographs, no diemnsion for matter transport was added so far        
+       
+       ! Now, writing histfiles for variables with dimension for different 
+       ! species of transported matter
+       DO iflow = 1, nflow
+       IF (iflow .EQ. 1) THEN
+          flow_suff = ''
+       ELSEIF (iflow .EQ. 2) THEN 
+          flow_suff = '_doc'
+       ELSEIF (iflow .EQ. 3) THEN
+          flow_suff = '_CO2'
+       ELSEIF (iflow .EQ. 4) THEN
+          flow_suff = '_CO2ev' 
+       ELSE
+          flow_suff = '_NoName'  !ERROR - suffixes not specified
+       ENDIF !iflow=1...nflow
+       var_name = 'fastr'//flow_suff       
+       CALL histwrite(hist_id, var_name, kjit, fast_diag(:,iflow), nbpt, index)
+       var_name = 'slowr'//flow_suff       
+       CALL histwrite(hist_id, var_name, kjit, slow_diag(:,iflow), nbpt, index)
+       var_name = 'streamr'//flow_suff     
+       CALL histwrite(hist_id, var_name, kjit, stream_diag(:,iflow), nbpt, index)
+       var_name = 'lakevol'//flow_suff     
+       CALL histwrite(hist_id, var_name, kjit, lake_diag(:,iflow), nbpt, index)
+       var_name = 'irrigation'//flow_suff      
+       CALL histwrite(hist_id, var_name, kjit, irrigation(:,iflow), nbpt, index)
+       var_name = 'hydrographs'//flow_suff        
+       CALL histwrite(hist_id, var_name, kjit, hydrographs(:,iflow), nbpt, index)       
+       ENDDO !iflow = 1, nflow
+       !! FCO2 RL
+       DO iflow=1,naqsys
+          IF (iflow .EQ. 1) THEN
+             flow_suff = '_fast'
+          ELSEIF (iflow .EQ. 2) THEN 
+             flow_suff = '_slow'
+          ELSEIF (iflow .EQ. 3) THEN
+             flow_suff = '_stream'
+          ELSEIF (iflow .EQ. 4) THEN
+             flow_suff = '_flood' 
+          ELSEIF (iflow .EQ. 5) THEN
+             flow_suff = '_pond'        
+          ELSE
+             flow_suff = '_NoName'  !ERROR - suffixes not specified
+          ENDIF !iflow=1...nflow       
+          var_name = 'FCO2_aq'//flow_suff       
+          CALL histwrite(hist_id, var_name, kjit, FCO2_aq(:,iflow), nbpt, index)   
+          var_name = 'pCO2_aq'//flow_suff       
+          CALL histwrite(hist_id, var_name, kjit, pCO2_aq(:,iflow), nbpt, index)             
+       ENDDO !iflow=1,naqsys       
+       
+       !check DOC inputs
+       var_name = 'DOC_inp_runoff'       
+       CALL histwrite(hist_id, var_name, kjit, DOC_inp(:,irunoff), nbpt, index) 
+       var_name = 'DOC_inp_drainage'       
+       CALL histwrite(hist_id, var_name, kjit, DOC_inp(:,idrainage), nbpt, index)    
+       
+       WRITE(*,*) 'routing tmp 854: ecriture de irrigmap'
+       CALL histwrite(hist_id, 'irrigmap', kjit, irrigated, nbpt, index)                 
+       !
+       delsurfstor(:) = delsurfstor(:) + flood_diag(:,ih2o) + pond_diag(:,ih2o) + lake_diag(:,ih2o)
+       CALL histwrite(hist_id, 'DelSurfStor', kjit, delsurfstor, nbpt, index)
+       CALL histwrite(hist_id, 'SurfStor', kjit, flood_diag(:,ih2o)+pond_diag(:,ih2o) &
+            &        +lake_diag(:,ih2o), nbpt, index)
+       CALL histwrite(hist_id, 'Dis', kjit, hydrographs(:,ih2o), nbpt, index)
+       IF ( doirrigation ) THEN
+          CALL histwrite(hist_id, 'Qirrig', kjit, irrigation(:,ih2o), nbpt, index)
+          CALL histwrite(hist_id, 'Qirrig_req', kjit, irrig_netereq, nbpt, index)
+       ENDIF
+       !
+    ENDIF !( .NOT. almaoutput )
+    
+    IF ( hist2_id > 0 ) THEN        !for hist2_id there is no addition of C fluxes
+       IF ( .NOT. almaoutput ) THEN
+          !
+          CALL histwrite(hist2_id, 'riversret', kjit, returnflow(:,ih2o), nbpt, index)
+          IF (dofloodplains .OR. doponds) THEN
+             CALL histwrite(hist2_id, 'reinfiltration', kjit, reinfiltration(:,ih2o), nbpt, index)
+          ENDIF
+          CALL histwrite(hist2_id, 'hydrographs', kjit, hydrographs(:,ih2o), nbpt, index)
+          !
+          CALL histwrite(hist2_id, 'fastr', kjit, fast_diag(:,ih2o), nbpt, index)
+          CALL histwrite(hist2_id, 'slowr', kjit, slow_diag(:,ih2o), nbpt, index)
+          IF ( dofloodplains ) THEN
+             CALL histwrite(hist2_id, 'floodr', kjit, flood_diag(:,ih2o), nbpt, index)
+             CALL histwrite(hist2_id, 'floodh', kjit, flood_height, nbpt, index)
+          ENDIF
+          CALL histwrite(hist2_id, 'pondr', kjit, pond_diag(:,ih2o), nbpt, index)
+          CALL histwrite(hist2_id, 'streamr', kjit, stream_diag(:,ih2o), nbpt, index)
+          CALL histwrite(hist2_id, 'lakevol', kjit, lake_diag(:,ih2o), nbpt, index)
+          !
+          IF ( doirrigation ) THEN
+             CALL histwrite(hist2_id, 'irrigation', kjit, irrigation(:,ih2o), nbpt, index)
+             CALL histwrite(hist2_id, 'returnflow', kjit, returnflow(:,ih2o), nbpt, index)
+             CALL histwrite(hist2_id, 'netirrig', kjit, irrig_netereq, nbpt, index)
+          ENDIF
+          !
+       ELSE
+          !
+          delsurfstor(:) = delsurfstor(:) + flood_diag(:,ih2o) + pond_diag(:,ih2o) &
+               &         + lake_diag(:,ih2o)
+          CALL histwrite(hist2_id, 'DelSurfStor', kjit, delsurfstor, nbpt, index)
+          CALL histwrite(hist2_id, 'SurfStor', kjit, flood_diag(:,ih2o) + pond_diag(:,ih2o) &
+               &        + lake_diag(:,ih2o), nbpt, index)
+          CALL histwrite(hist2_id, 'Dis', kjit, hydrographs(:,ih2o), nbpt, index)
+          !
+       ENDIF
+    ENDIF
+    !
+    !
+  END SUBROUTINE routing_main
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_init
+!!
+!> BRIEF         This subroutine allocates the memory and get the fixed fields from the restart file.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_init(kjit, nbpt, index, control_flags, dtradia, returnflow, reinfiltration, irrigation, &
+       &                  riverflow, coastalflow, flood_frac, flood_res, stempdiag, rest_id)
+    
+    IMPLICIT NONE
+    
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                   :: kjit           !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)                   :: nbpt           !! Domain size (unitless)
+    INTEGER(i_std), DIMENSION (nbpt), INTENT(in) :: index          !! Indices of the points on the map (unitless)
+    TYPE(control_type), INTENT(in)               :: control_flags  !! Flags that (de)activate parts of the model (unitless)
+    REAL(r_std), INTENT(in)                      :: dtradia        !! Time step of the model (s)
+    REAL(r_std), DIMENSION(nbpt,nbdl),INTENT(in) :: stempdiag      !! Temperature profile in soil
+    INTEGER(i_std), INTENT(in)                   :: rest_id        !! Restart file identifier (unitless)
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION (nbpt,nflow),INTENT(out)    :: returnflow     !! The water flow from lakes and swamps which returns 
+                                                                         !! into the grid box. This water will go back into the 
+                                                                         !! hydrol or hydrolc module to allow re-evaporation 
+                                                                         !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION (nbpt,nflow),INTENT(out)    :: reinfiltration !! Water flow from ponds and floodplains which returns 
+                                                                         !! to the grid box @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION (nbpt,nflow),INTENT(out)    :: irrigation     !! Irrigation flux. This is the water taken from the 
+                                                                         !! reservoirs and beeing put into the upper layers of 
+                                                                         !! the soil.@tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION (nbpt,nflow),INTENT(out)    :: riverflow      !! Outflow of the major rivers. The flux will be located 
+                                                                         !! on the continental grid but this should be a coastal 
+                                                                         !! point @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION (nbpt,nflow),INTENT(out)    :: coastalflow    !! Outflow on coastal points by small basins. This is the 
+                                                                         !! water which flows in a disperse way into the ocean 
+                                                                         !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)          :: flood_frac     !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)          :: flood_res      !! Diagnostic of water amount in the floodplains reservoir
+                                                                         !! (kg)
+    
+    !! 0.3 LOCAL VARIABLES
+    CHARACTER(LEN=80)                            :: var_name       !! To store variables names for I/O (unitless)
+    CHARACTER(LEN=10)                            :: flow_suff      !! To assign a suffix to the variables name indicating the 
+                                                                   !! transported specie
+    CHARACTER(LEN=80)                            :: var_long_name  !! To store variables long names for I/O (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: tmp_real_g     !! A temporary real array for the integers
+    REAL(r_std), DIMENSION(1)                    :: tmp_day        !!
+    REAL(r_std)                                  :: ratio          !! Diagnostic ratio to check that dt_routing is a multiple of 
+                                                                   !! dtradia (unitless)
+    REAL(r_std)                                  :: totarea        !! Total area of basin @tex $(m^2})$ @endtex
+    INTEGER(i_std)                               :: ier, ig, ib, ipn(1) !! Indices (unitless)
+    INTEGER(i_std)                               :: iflow          !! Index (unitless)
+    LOGICAL                                      :: hydrol_cwrr    !! Flag to select the CWRR hydrology (true/false)
+
+ !! 1. Get values for control variables 
+    ! Taken from overall control of model
+    !
+    hydrol_cwrr = control_flags%hydrol_cwrr
+    doirrigation = control_flags%do_irrigation
+    dofloodplains = control_flags%do_floodplains
+    !
+    !
+    ! These variables will require the configuration infrastructure
+    !
+    !Config Key   = ROUTING_TIMESTEP
+    !Config If    = RIVER_ROUTING
+    !Config Desc  = Time step of the routing scheme
+    !Config Def   = one_day
+    !Config Help  = This values gives the time step in seconds of the routing scheme. 
+    !Config         It should be multiple of the main time step of ORCHIDEE. One day
+    !Config         is a good value.
+    !Config Units = [seconds]
+    !
+    dt_routing = one_day
+    CALL getin_p('ROUTING_TIMESTEP', dt_routing)
+    !
+    !Config Key   = ROUTING_RIVERS
+    !Config If    = RIVER_ROUTING
+    !Config Desc  = Number of rivers 
+    !Config Def   = 50
+    !Config Help  = This parameter chooses the number of largest river basins
+    !Config         which should be treated as independently as rivers and not
+    !Config         flow into the oceans as diffusion coastal flow.
+    !Config Units = [-]
+    num_largest = 50
+    CALL getin_p('ROUTING_RIVERS', num_largest)
+    !
+    !Config Key   = DO_FLOODINFILT
+    !Config Desc  = Should floodplains reinfiltrate into the soil 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = FALSE
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the flood plains reinfiltration 
+    !Config         into the soil moisture. It then can go 
+    !Config         back to the slow and fast reservoirs
+    !Config Units = [FLAG]
+    !
+    dofloodinfilt = .FALSE.
+    CALL getin_p('DO_FLOODINFILT', dofloodinfilt)
+    !
+    !Config Key   = DO_SWAMPS
+    !Config Desc  = Should we include swamp parameterization 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = FALSE
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the swamps and return 
+    !Config         the water into the bottom of the soil. It then can go 
+    !Config         back to the atmopshere. This tried to simulate 
+    !Config         internal deltas of rivers.
+    !Config Units = [FLAG]
+    !
+    doswamps = .FALSE.
+    CALL getin_p('DO_SWAMPS', doswamps)
+    !
+    !Config Key   = DO_PONDS
+    !Config Desc  = Should we include ponds 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = FALSE
+    !Config Help  = This parameters allows the user to ask the model
+    !Config         to take into account the ponds and return 
+    !Config         the water into the soil moisture. It then can go 
+    !Config         back to the atmopshere. This tried to simulate 
+    !Config         little ponds especially in West Africa.
+    !Config Units = [FLAG]
+    !
+    doponds = .FALSE.
+    CALL getin_p('DO_PONDS', doponds)
+    !
+    ! Fix the time constants according to hydrol_cwrr flag
+    !
+    !
+    !Config Key   = SLOW_TCST
+    !Config Desc  = Time constant for the slow reservoir 
+    !Config If    = RIVER_ROUTING 
+    !Config Def   = FALSE
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         time constant (in days) of the slow reservoir
+    !Config         in order to get better river flows for 
+    !Config         particular regions.
+    !Config Units = [days]
+    !
+!> A value for property of each reservoir (in day/m) is given to compute a time constant (in day)
+!> for each reservoir (product of tcst and topo_resid).
+!> The value of tcst has been calibrated for the three reservoirs over the Senegal river basin only,
+!> during the 1 degree NCEP Corrected by Cru (NCC) resolution simulations (Ngo-Duc et al., 2005, Ngo-Duc et al., 2006) and
+!> generalized for all the basins of the world. The "slow reservoir" and the "fast reservoir"
+!> have the highest value in order to simulate the groundwater. 
+!> The "stream reservoir", which represents all the water of the stream, has the lowest value.
+!> Those figures are the same for all the basins of the world.
+!> The value of slow_tcst is equal to fast_tcst when CWRR is activated.
+!> This assumption should be re-discussed.
+    !
+    IF ( hydrol_cwrr ) THEN
+       slow_tcst = slow_tcst_cwrr
+    ELSE
+       slow_tcst = slow_tcst_chois
+    ENDIF
+    CALL getin_p('SLOW_TCST', slow_tcst)
+    !
+    !Config Key   = FAST_TCST
+    !Config Desc  = Time constant for the fast reservoir 
+    !Config If    = RIVER_ROUTING 
+    !Config Def   = FALSE
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         time constant (in days) of the fast reservoir
+    !Config         in order to get better river flows for 
+    !Config         particular regions.
+    !Config Units = [days]
+    !
+    IF ( hydrol_cwrr ) THEN
+       fast_tcst = fast_tcst_cwrr
+    ELSE
+       fast_tcst = fast_tcst_chois
+    ENDIF
+    CALL getin_p('FAST_TCST', fast_tcst)
+    !
+    !Config Key   = STREAM_TCST
+    !Config Desc  = Time constant for the stream reservoir 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = FALSE
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         time constant (in days) of the stream reservoir
+    !Config         in order to get better river flows for 
+    !Config         particular regions.
+    !Config Units = [days]
+    !
+    IF ( hydrol_cwrr ) THEN
+       stream_tcst = stream_tcst_cwrr
+    ELSE
+       stream_tcst = stream_tcst_chois
+    ENDIF
+    CALL getin_p('STREAM_TCST', stream_tcst)
+    !
+    !Config Key   = FLOOD_TCST
+    !Config Desc  = Time constant for the flood reservoir 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 4.0
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         time constant (in days) of the flood reservoir
+    !Config         in order to get better river flows for 
+    !Config         particular regions.
+    !Config Units = [days]
+    !
+    IF ( hydrol_cwrr ) THEN
+       flood_tcst = flood_tcst_cwrr
+    ELSE
+       flood_tcst = flood_tcst_chois
+    ENDIF
+    CALL getin_p('FLOOD_TCST', flood_tcst)
+    !
+    !Config Key   = SWAMP_CST
+    !Config Desc  = Fraction of the river that flows back to swamps 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 0.2
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         fraction of the river transport
+    !Config         that flows to swamps
+    !Config Units = [-]
+    !
+    IF ( hydrol_cwrr ) THEN
+       swamp_cst = swamp_cst_cwrr
+    ELSE
+       swamp_cst = swamp_cst_chois
+    ENDIF
+    CALL getin_p('SWAMP_CST', swamp_cst)
+    !
+    !Config Key   = FAST_DEC, SLOW_DEC, STREAM_DEC, FLOOD_DEC, POND_DEC
+    !Config Desc  = Oxidation rates of DOC in the diffrenet inland water types 
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 0.05
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         the proportion of DOC composed per
+    !Config         one day time step
+    !Config Units = [-]    
+    CALL getin_p('FAST_DEC', fast_dec)    
+    CALL getin_p('SLOW_DEC', slow_dec)        
+    CALL getin_p('STREAM_DEC', stream_dec)        
+    CALL getin_p('FLOOD_DEC', flood_dec)      
+    CALL getin_p('POND_DEC', pond_dec)      
+    !
+    !Config Key   = K_HEADW, K_STREAM, K_FLOOD, K_POND
+    !Config Desc  = Gas exchange velocities for CO2 and differrnt types of inland waters
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 3.0
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         gas exchange velocity for CO2 an the different
+    !Config         types of inland waters
+    !Config Units = @tex $(m day^{-1})$ @endtex    
+    CALL getin_p('K_HEADW', k_headw)    
+    CALL getin_p('K_STREAM', k_stream)        
+    CALL getin_p('K_FLOOD', k_flood)      
+    CALL getin_p('K_POND', k_pond)      
+    !
+    !Config Key   = DRAINAGE_CO2
+    !Config Desc  = Fixed CO2 concentration of the drainage
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 12.0E-06
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         a CO2 concnetration for the drainage
+    !Config Units = @tex $(kg C kg^{-1})$ @endtex  
+    CALL getin_p('DRAINAGE_CO2', CO2_conc1)    
+    !
+    !Config Key   = RUNOFF_CO2
+    !Config Desc  = Fixed CO2 concentration of the runoff
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 12.0E-07
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         a CO2 concnetration for the runoff
+    !Config Units = @tex $(kg C kg^{-1})$ @endtex  
+    CALL getin_p('RUNOFF_CO2', CO2_conc2)     
+    !
+    !Config Key   = PRECIP_CO2
+    !Config Desc  = Fixed CO2 concentration of the precipitation
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 15.0E-08
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         a CO2 concnetration for the precipitation
+    !Config Units = @tex $(kg C kg^{-1})$ @endtex  
+    CALL getin_p('PRECIP_CO2', CO2_conc3) 
+    !
+    !Config Key   = DRAINAGE_DOC
+    !Config Desc  = Fixed DOC concentration of the drainage
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 1.0E-06
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         a DOC concnetration for the drainage
+    !Config Units = @tex $(kg C kg^{-1})$ @endtex  
+    CALL getin_p('DRAINAGE_DOC', doc_conc1)    
+    !
+    !Config Key   = RUNOFF_DOC
+    !Config Desc  = Fixed DOC concentration of the runoff
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 1.0E-05
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         a DOC concnetration for the runoff
+    !Config Units = @tex $(kg C kg^{-1})$ @endtex  
+    CALL getin_p('RUNOFF_DOC', doc_conc2)     
+    !
+    !Config Key   = PRECIP_DOC
+    !Config Desc  = Fixed DOC concentration of the precipitation
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 2.0E-06
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         a DOC concnetration for the precipitation
+    !Config Units = @tex $(kg C kg^{-1})$ @endtex  
+    CALL getin_p('PRECIP_DOC', doc_conc3)     
+    !
+    !Config Key   = ATM_CO2
+    !Config Desc  = Fixed value of atmospehric partial pressure of CO2
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 350
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         pCO2 of the Atmosphere, The same value is also used
+    !Config         for other parts of the code
+    !Config Units = uatm 
+    CALL getin_p('ATM_CO2', pCO2_atm)     
+    !    
+    !Config Key   = T_WATER
+    !Config Desc  = Fixed value of water temperature
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 25
+    !Config Help  = This parameters allows the user to fix the 
+    !Config         water temperature 
+    !Config Units = deg Celsius 
+    CALL getin_p('T_WATER', T_water)  
+    !    
+    !Config Key   = STEPS_FCO2
+    !Config Desc  = Number of iterations for DOC decomposition and CO2 evasion calculations
+    !Config If    = RIVER_ROUTING
+    !Config Def   = 240
+    !Config Help  = This parameters allows the user set the number of 
+    !Config         iterations of DOC oxidation and CO2 evasion calculations
+    !Config         per day    
+    !Config Units = deg Celsius 
+    CALL getin_p('STEPS_FCO2', nstep_FCO2)      
+    !    
+    ratio = dt_routing/dtradia
+    IF ( ABS(NINT(ratio) - ratio) .GT. 10*EPSILON(ratio)) THEN
+       WRITE(numout,*) 'WARNING -- WARNING -- WARNING -- WARNING'
+       WRITE(numout,*) "The chosen time step for the routing is not a multiple of the"
+       WRITE(numout,*) "main time step of the model. We will change dt_routing so that"
+       WRITE(numout,*) "this condition os fulfilled"
+       dt_routing = NINT(ratio) * dtradia
+       WRITE(numout,*) 'THE NEW DT_ROUTING IS : ', dt_routing
+    ENDIF
+    !
+    IF ( dt_routing .LT. dtradia) THEN
+       WRITE(numout,*) 'WARNING -- WARNING -- WARNING -- WARNING'
+       WRITE(numout,*) 'The routing timestep can not be smaller than the one'
+       WRITE(numout,*) 'of the model. We reset its value to the model''s timestep.'
+       WRITE(numout,*) 'The old DT_ROUTING is : ', dt_routing
+       dt_routing = dtradia
+       WRITE(numout,*) 'THE NEW DT_ROUTING IS : ', dt_routing
+    ENDIF
+    
+  !! 2. Allocate and initialize variables from the restart files
+    var_name ="routingcounter"
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt('UNITS', 's')
+       CALL ioconf_setatt('LONG_NAME','Time counter for the routing scheme')
+       CALL restget (rest_id, var_name, 1, 1, 1, kjit, .TRUE., tmp_day)
+       IF (tmp_day(1) == val_exp) THEN
+          time_counter = zero
+       ELSE
+          time_counter = tmp_day(1) 
+       ENDIF
+       CALL setvar (time_counter, val_exp, 'NO_KEYWORD', zero)
+    ENDIF
+    CALL bcast(time_counter)
+!$    CALL setvar_p (time_counter, val_exp, 'NO_KEYWORD', zero)
+
+    ALLOCATE (routing_area_loc(nbpt,nbasmax))
+    ALLOCATE (routing_area_glo(nbp_glo,nbasmax))
+    var_name = 'routingarea'
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Area of basin')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., routing_area_glo, &
+            &       "gather", nbp_glo, index_g)
+    ENDIF
+    CALL scatter(routing_area_glo,routing_area_loc)
+    routing_area=>routing_area_loc
+    !
+    ALLOCATE (tmp_real_g(nbp_glo,nbasmax))
+    !
+    ALLOCATE (route_togrid_loc(nbpt,nbasmax))
+    ALLOCATE (route_togrid_glo(nbp_glo,nbasmax))      ! used in global in routing_flow
+    IF (is_root_prc) THEN
+       var_name = 'routetogrid'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','Grid into which the basin flows')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., tmp_real_g, "gather", &
+            &       nbp_glo, index_g)
+       route_togrid_glo(:,:) = undef_int
+       WHERE ( tmp_real_g .LT. val_exp )
+          route_togrid_glo = NINT(tmp_real_g)
+    ENDWHERE
+    ENDIF
+    CALL bcast(route_togrid_glo)                      ! used in global in routing_flow
+    CALL scatter(route_togrid_glo,route_togrid_loc)
+    route_togrid=>route_togrid_loc
+    !
+    ALLOCATE (route_tobasin_loc(nbpt,nbasmax))
+    ALLOCATE (route_tobasin_glo(nbp_glo,nbasmax))
+    IF (is_root_prc) THEN
+       var_name = 'routetobasin'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','Basin in to which the water goes')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., tmp_real_g, "gather", &
+            &       nbp_glo, index_g)
+       route_tobasin_glo = undef_int
+       WHERE ( tmp_real_g .LT. val_exp )
+         route_tobasin_glo = NINT(tmp_real_g)
+      ENDWHERE
+    ENDIF
+    CALL scatter(route_tobasin_glo,route_tobasin_loc)
+    route_tobasin=>route_tobasin_loc
+    !
+    ! nbintobasin
+    !
+    ALLOCATE (route_nbintobas_loc(nbpt,nbasmax))
+    ALLOCATE (route_nbintobas_glo(nbp_glo,nbasmax))
+    IF (is_root_prc) THEN
+       var_name = 'routenbintobas'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','Number of basin into current one')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., tmp_real_g, "gather", &
+            &       nbp_glo, index_g)
+       route_nbintobas_glo = undef_int
+       WHERE ( tmp_real_g .LT. val_exp )
+         route_nbintobas_glo = NINT(tmp_real_g)
+      ENDWHERE
+    ENDIF
+    CALL scatter(route_nbintobas_glo,route_nbintobas_loc)
+    route_nbintobas=>route_nbintobas_loc
+    !
+    ALLOCATE (global_basinid_loc(nbpt,nbasmax))
+    ALLOCATE (global_basinid_glo(nbp_glo,nbasmax))
+    IF (is_root_prc) THEN
+       var_name = 'basinid'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','ID of basin')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., tmp_real_g, "gather", &
+            &       nbp_glo, index_g)
+       global_basinid_glo = undef_int
+       WHERE ( tmp_real_g .LT. val_exp )
+          global_basinid_glo = NINT(tmp_real_g)
+       ENDWHERE
+    ENDIF
+    CALL scatter(global_basinid_glo,global_basinid_loc)
+    global_basinid=>global_basinid_loc
+    !
+    ALLOCATE (topo_resid_loc(nbpt,nbasmax))
+    ALLOCATE (topo_resid_glo(nbp_glo,nbasmax))
+    IF (is_root_prc) THEN
+       var_name = 'topoindex'
+       CALL ioconf_setatt('UNITS', 'm')
+       CALL ioconf_setatt('LONG_NAME','Topographic index of the residence time')
+       CALL restget (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., topo_resid_glo, &
+            &       "gather", nbp_glo, index_g)
+    ENDIF
+    CALL scatter(topo_resid_glo,topo_resid_loc)
+    topo_resid=>topo_resid_loc
+
+    ! Ininitialize variables with a dimension for differnet matter fluxes (iflow) 
+    ! The attribution of variable long names still needs to be optimized
+    ! Also the attribution of suffixes for the diffrenet matter fluxes could be maganed 
+    ! in a diffrenet way, maybe as a function
+    ALLOCATE (fast_reservoir(nbpt,nbasmax,nflow))   
+    ALLOCATE (slow_reservoir(nbpt,nbasmax,nflow))   
+    ALLOCATE (stream_reservoir(nbpt,nbasmax,nflow)) 
+    ALLOCATE (flood_reservoir(nbpt,nbasmax,nflow))   
+    ALLOCATE (lake_reservoir(nbpt,nflow))
+    ALLOCATE (pond_reservoir(nbpt,nflow))
+    ALLOCATE (lakeinflow_mean(nbpt,nflow))     
+    ALLOCATE (returnflow_mean(nbpt,nflow))
+    ALLOCATE (reinfiltration_mean(nbpt,nflow))
+    ALLOCATE (irrigation_mean(nbpt,nflow))
+    ALLOCATE (riverflow_mean(nbpt,nflow))
+    ALLOCATE (coastalflow_mean(nbpt,nflow))    
+    DO iflow = 1, nflow
+       IF (iflow .EQ. 1) THEN
+       flow_suff = ''
+       ELSEIF (iflow .EQ. 2) THEN 
+       flow_suff = '_doc'
+       ELSEIF (iflow .EQ. 3) THEN
+       flow_suff = '_CO2'
+       ELSEIF (iflow .EQ. 4) THEN
+       flow_suff = '_CO2ev' 
+       ELSE
+       flow_suff = '_NoName'  !!ERROR - suffixes not specified
+       ENDIF !iflow=1...nflow
+       
+       var_name = 'fastres'//flow_suff
+       var_long_name = 'Water in the fast reservoir'//flow_suff    
+       CALL ioconf_setatt('UNITS', 'Kg')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., &
+            &         fast_reservoir(:,:,iflow), "gather", nbp_glo, index_g)
+       
+       var_name = 'slowres'//flow_suff
+       var_long_name = 'Water in the slow reservoir'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., &
+            &         slow_reservoir(:,:,iflow), "gather", nbp_glo, index_g)
+       
+       var_name = 'streamres'//flow_suff
+       var_long_name = 'Water in the stream reservoir'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')       
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., &
+            &         stream_reservoir(:,:,iflow), "gather", nbp_glo, index_g)
+       
+       var_name = 'floodres'//flow_suff
+       var_long_name = 'Water in the flood reservoir'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')       
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., &
+            &         flood_reservoir(:,:,iflow), "gather", nbp_glo, index_g)
+       
+       var_name = 'lakeres'//flow_suff
+       var_long_name = 'Water in the lake reservoir'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')   
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         lake_reservoir(:,iflow), "gather", nbp_glo, index_g)
+       
+       var_name = 'pondres'//flow_suff
+       var_long_name =  'Water in the pond reservoir'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')           
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         pond_reservoir(:,iflow), "gather", nbp_glo, index_g)
+       
+       var_name = 'lakeinflow'//flow_suff
+       var_long_name = 'Lake inflow'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg/dt')            
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         lakeinflow_mean(:,iflow), "gather", nbp_glo, index_g)
+       
+       var_name = 'returnflow'//flow_suff
+       var_long_name ='Deep return flux'
+       CALL ioconf_setatt('UNITS', 'Kg/m^2/dt')        
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         returnflow_mean(:,iflow), "gather", nbp_glo, index_g)
+       
+       var_name = 'reinfiltration'//flow_suff
+       var_long_name = 'Top return flux'//flow_suff    
+       CALL ioconf_setatt('UNITS', 'Kg/m^2/dt')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         reinfiltration_mean(:,iflow), "gather", nbp_glo, index_g)
+       
+       IF ( doirrigation ) THEN
+       var_name = 'irrigation'//flow_suff
+       var_long_name = 'Artificial irrigation flux'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg/dt')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         irrigation_mean(:,iflow), "gather", nbp_glo, index_g)
+       ELSE
+          irrigation_mean(:,iflow) = zero
+       ENDIF
+       
+       var_name = 'riverflow'//flow_suff
+       var_long_name = 'River flux into the sea'//flow_suff    
+       CALL ioconf_setatt('UNITS', 'Kg/dt')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         riverflow_mean(:,iflow), "gather", nbp_glo, index_g)
+       !
+       var_name = 'coastalflow'//flow_suff
+       var_long_name = 'Diffuse flux into the sea'//flow_suff      
+       CALL ioconf_setatt('UNITS', 'Kg/dt')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., &
+            &         coastalflow_mean(:,iflow), "gather", nbp_glo, index_g)
+    ENDDO !iflow=1...nflow
+    CALL setvar_p (fast_reservoir, val_exp, 'NO_KEYWORD', zero) 
+    CALL setvar_p (slow_reservoir, val_exp, 'NO_KEYWORD', zero) 
+    CALL setvar_p (stream_reservoir, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (flood_reservoir, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (lake_reservoir, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (pond_reservoir, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (lakeinflow_mean, val_exp, 'NO_KEYWORD', zero)
+    CALL setvar_p (returnflow_mean, val_exp, 'NO_KEYWORD', zero)
+    returnflow = returnflow_mean       
+    CALL setvar_p (reinfiltration_mean, val_exp, 'NO_KEYWORD', zero)
+    reinfiltration = reinfiltration_mean       
+    IF ( doirrigation ) THEN
+      CALL setvar_p (irrigation_mean, val_exp, 'NO_KEYWORD', zero)  
+    ENDIF
+    irrigation = irrigation_mean           
+    CALL setvar_p (riverflow_mean, val_exp, 'NO_KEYWORD', zero)
+    riverflow = riverflow_mean 
+    CALL setvar_p (coastalflow_mean, val_exp, 'NO_KEYWORD', zero)
+    coastalflow = coastalflow_mean
+    ! end initializing variables with dimension for matter transport
+    
+    var_name = 'flood_res'
+    CALL ioconf_setatt('UNITS','mm')       
+    CALL ioconf_setatt('LONG_NAME','Flooded quantity (estimation)')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., flood_res, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (flood_res, val_exp, 'NO_KEYWORD', zero)
+    !    flood_res = zero      
+    
+    ALLOCATE (flood_frac_bas(nbpt,nbasmax))
+    var_name = 'flood_frac_bas'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Flooded fraction per basin')
+    CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., flood_frac_bas, &
+         &         "gather", nbp_glo, index_g)
+    CALL setvar_p (flood_frac_bas, val_exp, 'NO_KEYWORD', zero)
+    
+    ALLOCATE (flood_height(nbpt))
+    var_name = 'floodh'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., flood_height, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (flood_height, val_exp, 'NO_KEYWORD', zero)
+    
+    ALLOCATE (pond_frac(nbpt))
+    var_name = 'pond_frac'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Pond fraction per grid box')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., pond_frac, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (pond_frac, val_exp, 'NO_KEYWORD', zero)
+    
+    var_name = 'flood_frac'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Flooded fraction per grid box')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., flood_frac, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (flood_frac, val_exp, 'NO_KEYWORD', zero)
+    
+    ! Map of irrigated areas
+    
+    IF ( doirrigation ) THEN
+       ALLOCATE (irrigated(nbpt))
+       var_name = 'irrigated'
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Surface of irrigated area')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., irrigated, "gather", &
+            &         nbp_glo, index_g)
+       CALL setvar_p (irrigated, val_exp, 'NO_KEYWORD', undef_sechiba)
+    ENDIF
+    !
+    IF ( dofloodplains ) THEN
+       ALLOCATE (floodplains(nbpt))
+       var_name = 'floodplains'
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Surface which can be flooded')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., floodplains, "gather", &
+            &         nbp_glo, index_g)
+       CALL setvar_p (floodplains, val_exp, 'NO_KEYWORD', undef_sechiba)
+    ENDIF
+    IF ( doswamps ) THEN
+       ALLOCATE (swamp(nbpt))
+       var_name = 'swamp'
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Surface which can become swamp')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., swamp, "gather", nbp_glo, &
+            &         index_g)
+       CALL setvar_p (swamp, val_exp, 'NO_KEYWORD', undef_sechiba)
+    ENDIF
+    IF ( ok_doc ) THEN
+       ALLOCATE (headw_area(nbpt))
+       var_name = 'headw_area'
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Headwater surface area')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., headw_area, "gather", nbp_glo, &
+            &         index_g)
+       CALL setvar_p (headw_area, val_exp, 'NO_KEYWORD', undef_sechiba)
+       !
+       ALLOCATE (stream_area(nbpt))
+       var_name = 'stream_area'
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Stream/river surface area')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., stream_area, "gather", nbp_glo, &
+            &         index_g)
+       CALL setvar_p (stream_area, val_exp, 'NO_KEYWORD', undef_sechiba)      
+
+       ALLOCATE (upstream_area(nbpt,nbasmax))
+       var_name = 'upstream_area'
+       CALL ioconf_setatt('UNITS', 'm^2')
+       CALL ioconf_setatt('LONG_NAME','Upstream area per basin')
+       CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., upstream_area, &
+           &         "gather", nbp_glo, index_g)
+       CALL setvar_p (upstream_area, val_exp, 'NO_KEYWORD', zero)    
+       
+    ENDIF !ok_doc
+    ! Put into the restart file the fluxes so that they can be regenerated at restart.
+
+    ALLOCATE (irrig_netereq(nbpt))
+    irrig_netereq(:) = zero
+    
+    ! Locate it at the 2m level
+    ipn = MINLOC(ABS(diaglev-2))
+    floodtemp_lev = ipn(1)
+    ALLOCATE (floodtemp(nbpt))
+    floodtemp(:) = stempdiag(:,floodtemp_lev)
+    
+    ALLOCATE(hydrographs(nbpt,nflow))
+    var_name = 'hydrographs'
+    CALL ioconf_setatt('UNITS', '1000 kg/dt')
+    CALL ioconf_setatt('LONG_NAME','Hydrograph at outlow of grid')
+    CALL restget_p (rest_id, var_name, nbp_glo, nflow, 1, kjit, .TRUE., hydrographs, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (hydrographs, val_exp, 'NO_KEYWORD', zero)
+    
+    ! The diagnostic variables, they are initialized from the above restart variables.
+    
+    ALLOCATE(fast_diag(nbpt,nflow), slow_diag(nbpt,nflow), stream_diag(nbpt,nflow), &
+    & flood_diag(nbpt,nflow), pond_diag(nbpt,nflow), lake_diag(nbpt,nflow), delsurfstor(nbpt), &
+    & FCO2_aq(nbpt,naqsys), pCO2_aq(nbpt,naqsys), DOC_inp(nbpt,nexp), stat=ier)
+    
+    fast_diag(:,:)   = zero
+    slow_diag(:,:)   = zero
+    stream_diag(:,:) = zero
+    flood_diag(:,:)  = zero
+    pond_diag(:,:)   = zero
+    lake_diag(:,:)   = zero
+    delsurfstor(:)   = zero
+    FCO2_aq(:,:)     = zero
+    pCO2_aq(:,:)     = zero    
+    DOC_inp(:,:)     = zero
+    
+    DO ig=1,nbpt
+       totarea = zero
+       DO ib=1,nbasmax
+          totarea = totarea + routing_area(ig,ib)
+       ENDDO !ib=1,nbasmax    
+          
+       DO iflow=1,nflow
+          DO ib=1,nbasmax                
+            fast_diag(ig,iflow) = fast_diag(ig,iflow) + fast_reservoir(ig,ib,iflow)
+            slow_diag(ig,iflow) = slow_diag(ig,iflow) + slow_reservoir(ig,ib,iflow)
+            stream_diag(ig,iflow) = stream_diag(ig,iflow) + stream_reservoir(ig,ib,iflow)
+            flood_diag(ig,iflow) = flood_diag(ig,iflow) + flood_reservoir(ig,ib,iflow)
+          ENDDO !ib=1,nbasmax
+          !
+          fast_diag(ig,iflow) = fast_diag(ig,iflow)/totarea
+          slow_diag(ig,iflow) = slow_diag(ig,iflow)/totarea
+          stream_diag(ig,iflow) = stream_diag(ig,iflow)/totarea
+          flood_diag(ig,iflow) = flood_diag(ig,iflow)/totarea
+          !
+          ! This is the volume of the lake scaled to the entire grid.
+          ! It would be better to scale it to the size of the lake
+          ! but this information is not yet available.
+          !
+          lake_diag(ig,iflow) = lake_reservoir(ig,iflow)/totarea
+       ENDDO !iflow=1,nflow
+    ENDDO !ig=1,nbpt
+    
+    ! Get from the restart the fluxes we accumulated.
+    
+    ALLOCATE (floodout_mean(nbpt))
+    var_name = 'floodout_route'
+    CALL ioconf_setatt('UNITS', 'Kg')
+    CALL ioconf_setatt('LONG_NAME','Accumulated flow out of floodplains for routing')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., floodout_mean, "gather",&
+         &         nbp_glo, index_g)
+    CALL setvar_p (floodout_mean, val_exp, 'NO_KEYWORD', zero)
+    
+    ! Runoff, drainage and precipitation are input fluxes which can contain dissolved or 
+    ! particulate matter. For these three input fluxes the are different dimensions, 
+    ! for the different species transported
+    
+    ALLOCATE(runoff_mean(nbpt,nflow))
+    ALLOCATE(drainage_mean(nbpt,nflow)) 
+    ALLOCATE(precip_mean(nbpt,nflow))
+
+    DO iflow = 1, nflow
+       IF (iflow .EQ. 1) THEN
+       flow_suff = ''
+       ELSEIF (iflow .EQ. 2) THEN 
+       flow_suff = '_doc'
+       ELSEIF (iflow .EQ. 3) THEN
+       flow_suff = '_CO2'
+       ELSEIF (iflow .EQ. 4) THEN
+       flow_suff = '_CO2ev' 
+       ELSE
+       flow_suff = '_NoName'  !!ERROR - suffixes not specified
+       ENDIF !iflow=1...nflow
+       !
+       var_name = 'runoff_route'//flow_suff
+       var_long_name = 'Accumulated runoff for routing'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., runoff_mean(:,iflow), &
+            &         "gather", nbp_glo, index_g)
+       
+       var_name = 'drainage_route'//flow_suff
+       var_long_name = 'Accumulated drainage for routing'//flow_suff       
+       CALL ioconf_setatt('UNITS', 'Kg')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., drainage_mean(:,iflow), &
+            &         "gather", nbp_glo, index_g)
+       
+       var_name = 'precip_route'//flow_suff
+       var_long_name = 'Accumulated rain precipitation for irrigation'//flow_suff
+       CALL ioconf_setatt('UNITS', 'Kg/m^2')
+       CALL ioconf_setatt('LONG_NAME',var_long_name)
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., precip_mean(:,iflow), &
+            &         "gather", nbp_glo, index_g)
+    ENDDO !iflow=1...nflow
+    CALL setvar_p (runoff_mean, val_exp, 'NO_KEYWORD', zero)    
+    CALL setvar_p (drainage_mean, val_exp, 'NO_KEYWORD', zero)  
+    CALL setvar_p (precip_mean, val_exp, 'NO_KEYWORD', zero)    
+    
+    ! Now again variables which do not have diffrenet dimensions for different species
+    
+    ALLOCATE(transpot_mean(nbpt))
+    var_name = 'transpot_route'
+    CALL ioconf_setatt('UNITS', 'Kg/m^2')
+    CALL ioconf_setatt('LONG_NAME','Accumulated potential transpiration for routing/irrigation')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., transpot_mean, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (transpot_mean, val_exp, 'NO_KEYWORD', zero)  
+    
+    ALLOCATE(humrel_mean(nbpt))
+    var_name = 'humrel_route'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Mean humrel for irrigation')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., humrel_mean, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (humrel_mean, val_exp, 'NO_KEYWORD', un)
+    
+    ALLOCATE(k_litt_mean(nbpt))
+    var_name = 'k_litt_route'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Mean cond. for litter')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., k_litt_mean, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (k_litt_mean, val_exp, 'NO_KEYWORD', zero)
+    
+    ALLOCATE(totnobio_mean(nbpt))
+    var_name = 'totnobio_route'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Last Total fraction of no bio for irrigation')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., totnobio_mean, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (totnobio_mean, val_exp, 'NO_KEYWORD', zero)
+    
+    ALLOCATE(vegtot_mean(nbpt))
+    var_name = 'vegtot_route'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Last Total fraction of vegetation')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., vegtot_mean, "gather", &
+         &         nbp_glo, index_g)
+    CALL setvar_p (vegtot_mean, val_exp, 'NO_KEYWORD', un)
+    
+    DEALLOCATE(tmp_real_g)
+    
+    ! Allocate diagnostic variables
+    
+    ALLOCATE(hydrodiag_loc(nbpt,nbasmax,nflow),hydrodiag_glo(nbp_glo,nbasmax,nflow),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in hydrodiag allocation. We stop. We need kjpindex words = ', &
+         &               nbpt*nbasmax*nflow
+        STOP 'routing_init'
+    END IF
+
+    hydrodiag=>hydrodiag_loc
+    
+    ALLOCATE(hydroupbasin_loc(nbpt),hydroupbasin_glo(nbp_glo), stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in hydroupbasin allocation. We stop. We need kjpindex words = ', &
+         &               nbpt*nbasmax
+        STOP 'routing_init'
+    END IF
+    hydroupbasin=>hydroupbasin_loc
+    
+  END SUBROUTINE routing_init
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_clear
+!!
+!> BRIEF        : This subroutine deallocates the block memory previously allocated.
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_clear()
+    !
+    l_first_routing=.TRUE.
+    !
+    IF (ALLOCATED(routing_area_loc)) DEALLOCATE(routing_area_loc)
+    IF (ALLOCATED(route_togrid_loc)) DEALLOCATE(route_togrid_loc)
+    IF (ALLOCATED(route_tobasin_loc)) DEALLOCATE(route_tobasin_loc)
+    IF (ALLOCATED(route_nbintobas_loc)) DEALLOCATE(route_nbintobas_loc)
+    IF (ALLOCATED(global_basinid_loc)) DEALLOCATE(global_basinid_loc)
+    IF (ALLOCATED(topo_resid_loc)) DEALLOCATE(topo_resid_loc)
+    IF (ALLOCATED(routing_area_glo)) DEALLOCATE(routing_area_glo)
+    IF (ALLOCATED(route_togrid_glo)) DEALLOCATE(route_togrid_glo)
+    IF (ALLOCATED(route_tobasin_glo)) DEALLOCATE(route_tobasin_glo)
+    IF (ALLOCATED(route_nbintobas_glo)) DEALLOCATE(route_nbintobas_glo)
+    IF (ALLOCATED(global_basinid_glo)) DEALLOCATE(global_basinid_glo)
+    IF (ALLOCATED(topo_resid_glo)) DEALLOCATE(topo_resid_glo)
+    IF (ALLOCATED(fast_reservoir)) DEALLOCATE(fast_reservoir)
+    IF (ALLOCATED(slow_reservoir)) DEALLOCATE(slow_reservoir)
+    IF (ALLOCATED(stream_reservoir)) DEALLOCATE(stream_reservoir)
+    IF (ALLOCATED(flood_reservoir)) DEALLOCATE(flood_reservoir)
+    IF (ALLOCATED(flood_frac_bas)) DEALLOCATE(flood_frac_bas)
+    IF (ALLOCATED(flood_height)) DEALLOCATE(flood_height)
+    IF (ALLOCATED(pond_frac)) DEALLOCATE(pond_frac)
+    IF (ALLOCATED(lake_reservoir)) DEALLOCATE(lake_reservoir)
+    IF (ALLOCATED(pond_reservoir)) DEALLOCATE(pond_reservoir)
+    IF (ALLOCATED(returnflow_mean)) DEALLOCATE(returnflow_mean)
+    IF (ALLOCATED(reinfiltration_mean)) DEALLOCATE(reinfiltration_mean)
+    IF (ALLOCATED(riverflow_mean)) DEALLOCATE(riverflow_mean)
+    IF (ALLOCATED(coastalflow_mean)) DEALLOCATE(coastalflow_mean)
+    IF (ALLOCATED(lakeinflow_mean)) DEALLOCATE(lakeinflow_mean)
+    IF (ALLOCATED(runoff_mean)) DEALLOCATE(runoff_mean)
+    IF (ALLOCATED(floodout_mean)) DEALLOCATE(floodout_mean)
+    IF (ALLOCATED(drainage_mean)) DEALLOCATE(drainage_mean)
+    IF (ALLOCATED(transpot_mean)) DEALLOCATE(transpot_mean)
+    IF (ALLOCATED(precip_mean)) DEALLOCATE(precip_mean)
+    IF (ALLOCATED(humrel_mean)) DEALLOCATE(humrel_mean)
+    IF (ALLOCATED(k_litt_mean)) DEALLOCATE(k_litt_mean)
+    IF (ALLOCATED(totnobio_mean)) DEALLOCATE(totnobio_mean)
+    IF (ALLOCATED(vegtot_mean)) DEALLOCATE(vegtot_mean)
+    IF (ALLOCATED(floodtemp)) DEALLOCATE(floodtemp)
+    IF (ALLOCATED(hydrodiag_loc)) DEALLOCATE(hydrodiag_loc)
+    IF (ALLOCATED(hydrodiag_glo)) DEALLOCATE(hydrodiag_glo)
+    IF (ALLOCATED(hydroupbasin_loc)) DEALLOCATE(hydroupbasin_loc)    
+    IF (ALLOCATED(hydroupbasin_glo)) DEALLOCATE(hydroupbasin_glo)
+    IF (ALLOCATED(hydrographs)) DEALLOCATE(hydrographs)
+    IF (ALLOCATED(irrigation_mean)) DEALLOCATE(irrigation_mean)   
+    IF (ALLOCATED(irrigated)) DEALLOCATE(irrigated)
+    IF (ALLOCATED(floodplains)) DEALLOCATE(floodplains)
+    IF (ALLOCATED(swamp)) DEALLOCATE(swamp)
+    IF (ALLOCATED(headw_area)) DEALLOCATE(headw_area)    
+    IF (ALLOCATED(stream_area)) DEALLOCATE(stream_area)  
+    IF (ALLOCATED(upstream_area)) DEALLOCATE(upstream_area)        
+    IF (ALLOCATED(fast_diag)) DEALLOCATE(fast_diag)
+    IF (ALLOCATED(slow_diag)) DEALLOCATE(slow_diag)
+    IF (ALLOCATED(stream_diag)) DEALLOCATE(stream_diag)
+    IF (ALLOCATED(flood_diag)) DEALLOCATE(flood_diag)
+    IF (ALLOCATED(pond_diag)) DEALLOCATE(pond_diag)
+    IF (ALLOCATED(lake_diag)) DEALLOCATE(lake_diag)
+    IF (ALLOCATED(delsurfstor)) DEALLOCATE(delsurfstor)
+    IF (ALLOCATED(FCO2_aq)) DEALLOCATE(FCO2_aq)  
+    IF (ALLOCATED(pCO2_aq)) DEALLOCATE(pCO2_aq) 
+    IF (ALLOCATED(DOC_inp)) DEALLOCATE(DOC_inp)     
+    !
+  END SUBROUTINE routing_clear
+  !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_flow
+!!
+!> BRIEF         This subroutine computes the transport of water in the various reservoirs
+!!                (including ponds and floodplains) and the water withdrawals from the reservoirs for irrigation.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!! This will first compute the amount of water which flows out of each of the 3 reservoirs using the assumption of an 
+!! exponential decrease of water in the reservoir (see Hagemann S and Dumenil L. (1998)). Then we compute the fluxes 
+!! for floodplains and ponds. All this will then be used in order to update each of the basins : taking water out of 
+!! the up-stream basin and adding it to the down-stream one.
+!! As this step happens globaly we have to stop the parallel processing in order to exchange the information. Once 
+!! all reservoirs are updated we deal with irrigation. The final step is to compute diagnostic fluxes. Among them
+!! the hydrographs of the largest rivers we have chosen to monitor.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): lakeinflow, returnflow, reinfiltration, irrigation, riverflow, coastalflow, hydrographs, flood_frac, 
+!!                          flood_res
+!!
+!! REFERENCES   :
+!! - Ngo-Duc, T., K. Laval, G. Ramillien, J. Polcher, and A. Cazenave (2007)
+!!   Validation of the land water storage simulated by Organising Carbon and Hydrology in Dynamic Ecosystems (ORCHIDEE) with 
+!!   Gravity Recovery and Climate Experiment (GRACE) data.
+!!   Water Resour. Res., 43, W04427, doi:10.1029/2006WR004941.
+!! * Irrigation:
+!! - de Rosnay, P., J. Polcher, K. Laval, and M. Sabre (2003)
+!!   Integrated parameterization of irrigation in the land surface model ORCHIDEE. Validation over Indian Peninsula.
+!!   Geophys. Res. Lett., 30(19), 1986, doi:10.1029/2003GL018024.
+!! - A.C. Vivant (2003)
+!!   Les plaines d'inondations et l'irrigation dans ORCHIDEE, impacts de leur prise en compte.
+!!   , , 51pp.
+!! - N. Culson (2004)
+!!   Impact de l'irrigation sur le cycle de l'eau
+!!   Master thesis, Paris VI University, 55pp.
+!! - X.-T. Nguyen-Vinh (2005)
+!!   Analyse de l'impact de l'irrigation en Amerique du Nord - plaine du Mississippi - sur la climatologie regionale
+!!   Master thesis, Paris VI University, 33pp.
+!! - M. Guimberteau (2006)
+!!   Analyse et modifications proposees de la modelisation de l'irrigation dans un modele de surface.
+!!   Master thesis, Paris VI University, 46pp.
+!! - Guimberteau M. (2010)
+!!   Modelisation de l'hydrologie continentale et influences de l'irrigation sur le cycle de l'eau.
+!!   Ph.D. thesis, Paris VI University, 195pp.
+!! - Guimberteau M., Laval K., Perrier A. and Polcher J. (2011).
+!!   Global effect of irrigation and its impact on the onset of the Indian summer monsoon.
+!!   In press, Climate Dynamics, doi: 10.1007/s00382-011-1252-5.
+!! * Floodplains:
+!! - A.C. Vivant (2002)
+!!   L'ecoulement lateral de l'eau sur les surfaces continentales. Prise en compte des plaines d'inondations dans ORCHIDEE.
+!!   Master thesis, Paris VI University, 46pp.
+!! - A.C. Vivant (2003)
+!!   Les plaines d'inondations et l'irrigation dans ORCHIDEE, impacts de leur prise en compte.
+!!   , , 51pp.
+!! - T. d'Orgeval (2006)
+!!   Impact du changement climatique sur le cycle de l'eau en Afrique de l'Ouest: modelisation et incertitudes.
+!!   Ph.D. thesis, Paris VI University, 188pp.
+!! - T. d'Orgeval, J. Polcher, and P. de Rosnay (2008)
+!!   Sensitivity of the West African hydrological cycle in ORCHIDEE to infiltration processes.
+!!   Hydrol. Earth Syst. Sci., 12, 1387-1401
+!! - M. Guimberteau, G. Drapeau, J. Ronchail, B. Sultan, J. Polcher, J.-M. Martinez, C. Prigent, J.-L. Guyot, G. Cochonneau,
+!!   J. C. Espinoza, N. Filizola, P. Fraizy, W. Lavado, E. De Oliveira, R. Pombosa, L. Noriega, and P. Vauchel (2011)
+!!   Discharge simulation in the sub-basins of the Amazon using ORCHIDEE forced by new datasets.
+!!   Hydrol. Earth Syst. Sci. Discuss., 8, 11171-11232, doi:10.5194/hessd-8-11171-2011
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_flow(nbpt, dt_routing, floodout, runoff, drainage, &
+       &                  vegtot, totnobio, transpot_mean, precip, humrel, k_litt, floodtemp,  &
+       &                  reinf_slope, lakeinflow, returnflow, reinfiltration, irrigation, &
+       &                  riverflow, coastalflow, hydrographs, flood_frac, flood_res) 
+    
+    IMPLICIT NONE
+    
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                         :: nbpt            !! Domain size (unitless)
+    REAL(r_std), INTENT (in)                           :: dt_routing      !! Routing time step (s)
+    REAL(r_std), INTENT(in), DIMENSION(nbpt,nflow)     :: runoff          !! Grid-point runoff 
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in), DIMENSION(nbpt)           :: floodout        !! Grid-point flow out of floodplains 
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in), DIMENSION(nbpt,nflow)     :: drainage        !! Grid-point drainage 
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in), DIMENSION(nbpt)           :: vegtot          !! Potentially vegetated fraction (unitless;0-1)
+    REAL(r_std), INTENT(in), DIMENSION(nbpt)           :: totnobio        !! Other areas which can not have vegetation
+    REAL(r_std), INTENT(in), DIMENSION(nbpt)           :: transpot_mean   !! Mean potential transpiration of the vegetation
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in), DIMENSION(nbpt,nflow)     :: precip          !! Rainfall @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in), DIMENSION(nbpt)           :: humrel          !! Soil moisture stress, root extraction potential 
+                                                                          !! (unitless)
+    REAL(r_std), INTENT(in), DIMENSION(nbpt)           :: k_litt          !! Averaged conductivity for saturated infiltration 
+                                                                          !! in the 'litter' layer 
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in), DIMENSION(nbpt)           :: floodtemp       !! Temperature to decide if floodplains work (K)
+    REAL(r_std), INTENT(in), DIMENSION(nbpt)           :: reinf_slope     !! Coefficient which determines the reinfiltration 
+                                                                          !! ratio in the grid box due to flat areas (unitless;0-1)
+
+    !! 0.2 Ouput variables
+    REAL(r_std), INTENT(out), DIMENSION(nbpt,nflow)    :: lakeinflow      !! Water inflow to the lakes @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), INTENT(out), DIMENSION(nbpt,nflow)    :: returnflow      !! The water flow from lakes and swamps which returns 
+                                                                          !! into the grid box. This water will go back into the 
+                                                                          !! hydrol or hydrolc module to allow re-evaporation
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(out), DIMENSION(nbpt,nflow)    :: reinfiltration  !! Water flow from ponds and floodplains which returns 
+                                                                          !! to the grid box @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(out), DIMENSION(nbpt,nflow)    :: irrigation      !! Irrigation flux. This is the water taken 
+                                                                          !! from the reservoirs and beeing put into the
+                                                                          !! upper layers of the soil 
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(out), DIMENSION(nbpt,nflow)    :: riverflow       !! Outflow of the major rivers. The flux will be located 
+                                                                          !! on the continental grid but this should be a coastal 
+                                                                          !! point @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), INTENT(out), DIMENSION(nbpt,nflow)    :: coastalflow     !! Outflow on coastal points by small basins. This is the 
+                                                                          !! water which flows in a disperse way into the ocean 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), INTENT(out), DIMENSION(nbpt,nflow)    :: hydrographs     !! Hydrographs at the outflow of the grid box for major 
+                                                                          !! basins @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), INTENT(out), DIMENSION(nbpt)          :: flood_frac      !! Flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), INTENT(out), DIMENSION(nbpt)          :: flood_res       !! Diagnostic of water amount in the floodplains 
+                                                                          !! reservoir (kg)
+
+    !! 0.3 Local variables
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: fast_flow       !! Outflow from the fast reservoir 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: slow_flow       !! Outflow from the slow reservoir 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: stream_flow     !! Outflow from the stream reservoir 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: flood_flow      !! Outflow from the floodplain reservoir 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: pond_inflow     !! Inflow to the pond reservoir 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: pond_drainage   !! Drainage from pond 
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: flood_drainage  !! Drainage from floodplains 
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: return_swamp    !! Inflow to the swamp 
+                                                                          !! @tex $(kg dt^{-1})$ @endtex
+                                                                          
+    ! Variables used in calculating CO2 evasion
+    REAL(r_std)                                        :: K_CO2           !! Henry constant for CO2 @tex $(mol atm^{-1})$ @endtex
+    REAL(r_std)                                        :: pCO2_wa         !! pCO2 in water (atm)    
+    REAL(r_std), DIMENSION(nbpt)                       :: tot_upstream    !! Value used for partioning stream area among basins   
+                                                                          !! @tex $(m)$ @endtex 
+    REAL(r_std), DIMENSION(nbpt, nbasmax)              :: headw_area_bas  !! Area of headwaters per basin
+                                                                          !! @tex $(m^2)$ @endtex 
+    REAL(r_std), DIMENSION(nbpt, nbasmax)              :: stream_area_bas !! Area of streams and rivers per basin
+                                                                          !! @tex $(m^2)$ @endtex          
+                                                                          
+    REAL(r_std)                                        :: FCO2, FCO2_ac   !! CO2 evasion from water surface
+                                                                          !! @tex $(kg m^{-2} dt^{-1})$ @endtex   
+    REAL(r_std)                                        :: store_CO2       !! CO2 storage in water column
+                                                                          !! @tex $(kg)$ @endtex   
+    REAL(r_std)                                        :: store_doc       !! DOC storage in water column
+                                                                          !! @tex $(kg)$ @endtex                        
+    REAL(r_std)                                        :: decompos        !! decomposition rate per sub time-step 
+                                                                          !! (nstep_FCO2 per day)
+    REAL(r_std), DIMENSION(nbpt, nbasmax, naqsys)      :: pCO2_aq_bas     !! avg pCO2 per basin and aq. system
+                                                                          !! @tex $(m^2)$ @endtex 
+    REAL(r_std)                                        :: pCO2_avg        !! used to calculate average pCO2 over the  
+                                                                          !! nstep_FCO2 time-steps per day)
+    REAL(r_std)                                        :: pCO2_aggr       !! used to aggreagte pco2 par grid cell
+                                                                          !! weighted by the water storage of
+                                                                          !! each basin
+                                                                          !! @tex $(atm kg H2O)$ @endtex               
+                                                                          
+    ! Variables used to preserve the preceding values of the reservoirs for follwoing calculations 
+    
+    real(r_std), DIMENSION(nflow)                      :: slow_reservoir_prec       !! Temporary storage retaining preceding value
+                                                                                    !! for slow reservoir for aother calculation.
+                                                                                    !! @tex $(kg dt^{-1})$ @endtex                                                                                  
+    real(r_std), DIMENSION(nflow)                      :: fast_reservoir_prec       !! Temporary storage retaining preceding value
+                                                                                    !! for fast reservoir for aother calculation. 
+                                                                                    !! @tex $(kg dt^{-1})$ @endtex                                                                                  
+    real(r_std), DIMENSION(nflow)                      :: stream_reservoir_prec     !! Temporary storage retaining preceding value
+                                                                                    !! for stream reservoir for aother calculation. 
+                                                                                    !! @tex $(kg dt^{-1})$ @endtex
+    ! Irrigation per basin
+    
+    REAL(r_std), DIMENSION(nbpt, nbasmax)              :: irrig_needs       !! Total irrigation requirement (water requirements by
+                                                                            !! the crop for its optimal growth) (kg)
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: irrig_actual      !! Possible irrigation according to the water 
+                                                                            !! availability in the reservoirs (kg)
+    REAL(r_std), DIMENSION(nbpt, nbasmax)              :: irrig_deficit     !! Amount of water missing for irrigation (kg)
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: irrig_adduct      !! Amount of water carried over from other basins for 
+                                                                            !! irrigation (kg)
+    REAL(r_std), DIMENSION(nbpt, 0:nbasmax+3,nflow)    :: transport         !! Water transport between basins 
+                                                                            !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbp_glo, 0:nbasmax+3,nflow) :: transport_glo     !! Water transport between basins 
+                                                                            !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: floods            !! Water flow in to the floodplains 
+                                                                            !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt, nbasmax,nflow)        :: potflood          !! Potential inflow to the swamps 
+                                                                            !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nbpt)                       :: tobeflooded       !! Maximal surface which can be inundated in each 
+                                                                            !! grid box @tex $(m^2})$ @endtex
+    REAL(r_std), DIMENSION(nbpt)                       :: totarea           !! Total area of basin @tex $(m^2})$ @endtex
+    REAL(r_std), DIMENSION(nbpt,nflow)                 :: totflood          !! Total amount of water in the floodplains reservoir
+                                                                            !! (kg)
+    REAL(r_std), DIMENSION(nbasmax,nflow)              :: pond_excessflow   !! Pond excess flow from basin 
+                                                                            !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std)                                        :: flow              !! Outflow computation for the reservoirs 
+                                                                            !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std)                                        :: floodindex        !! Fraction of grid box area inundated (unitless;0-1)
+    REAL(r_std)                                        :: pondex            !! Pond excess flow from grid box 
+                                                                            !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std)                                        :: flood_frac_pot    !! Total fraction of the grid box which is flooded at 
+                                                                            !! optimum repartition (unitless;0-1)
+    REAL(r_std)                                        :: total_area        !! Sum of all the surfaces of the basins 
+                                                                            !! @tex $(m^2})$ @endtex
+    REAL(r_std)                                        :: stream_tot        !! Total water amount in the stream reservoirs (kg)
+    REAL(r_std), DIMENSION(nflow)                      :: adduction         !! Importation of water from a stream reservoir of a 
+                                                                            !! neighboring grid box (kg)
+    REAL(r_std), DIMENSION(8,nbasmax)                  :: streams_around    !! Stream reservoirs of the neighboring grid boxes (kg)
+    INTEGER(i_std), DIMENSION(8)                       :: igrd              !! Indices (unitless)
+    INTEGER(i_std), DIMENSION(2)                       :: ff                !! Indices (unitless)
+    INTEGER(i_std), DIMENSION(1)                       :: fi                !! Indices (unitless)
+    INTEGER(i_std)                                     :: ig, ib, ib2, ig2  !! Indices (unitless)
+    INTEGER(i_std)                                     :: rtg, rtb, in      !! Indices (unitless)
+    INTEGER(i_std)                                     :: iflow, istep_FCO2 !! Indices (unitless)   
+    
+    
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)         :: fast_flow_g               !! Outflow from the fast reservoir 
+                                                                                    !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)         :: slow_flow_g               !! Outflow from the slow reservoir 
+                                                                                    !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)         :: stream_flow_g             !! Outflow from the stream reservoir 
+                                                                                    !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)           :: irrig_deficit_glo         !! Amount of water missing for irrigation (kg)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)         :: stream_reservoir_glo      !! Water amount in the stream reservoir (kg)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)         :: irrig_adduct_glo          !! Amount of water carried over from other 
+                                                                                    !! basins for irrigation (kg)
+    
+    LOGICAL                                            :: error_reservoir           !! Logical to check if there is a negative 
+                                                                                    !! amount of water in the slow reservoir 
+                                                                                    !! (true/false)
+
+    LOGICAL, PARAMETER                                 :: check_reservoir = .FALSE. !! Logical to choose if we write informations 
+                                                                                    !! when a negative amount of water is occurring 
+                                                                                    !! in a reservoir (true/false)
+
+ !! 1. Calculation of fluxes
+    ! The main variables related to reservoirs of water storage and fluxes from and to the 
+    ! reservoirs have a dimension specifying the stored/transported species. These species 
+    ! comprise sofar water (ih2o=1), dissolved organic carbon (idoc=1), and dissolved CO2 
+    ! (iCO2aq=2). For all outflows of a reservoir, i.e. a lateral outflow or infiltration 
+    ! into the soil, the concnetration in dissolved matter is assumed to be that in the reservoir.
+    
+    !! 1.1 Initializing variables
+    transport(:,:,:) = zero
+    transport_glo(:,:,:) = zero
+    irrig_netereq(:) = zero
+    irrig_needs(:,:) = zero
+    irrig_actual(:,:,:) = zero
+    irrig_deficit(:,:) = zero
+    irrig_adduct(:,:,:) = zero
+    totarea(:) = zero
+    totflood(:,:) = zero
+    
+    !! 1.2 Aggreating area and flood reservoirs per grid box
+    
+    DO ib=1,nbasmax
+       DO ig=1,nbpt
+          !
+          totarea(ig) = totarea(ig) + routing_area(ig,ib)
+          totflood(ig,:) = totflood(ig,:) + flood_reservoir(ig,ib,:)
+       ENDDO
+    ENDDO
+    
+    !! 1.3 Calculating outflows from fast, slow, stream reservoirs
+    
+    !> The outflow fluxes from the three reservoirs are computed. 
+    !> The outflow of volume of water Vi into the reservoir i is assumed to be linearly related 
+    !> to its volume. The water travel simulated by the routing scheme is dependent on the water 
+    !> retention index topo_resid given by a 0.5 degree resolution map for each pixel performed 
+    !> from a simplification of Manning's formula(Dingman, 1994; Ducharne et al., 2003).
+    !> The resulting product of tcst (in day/m) and topo_resid (in m) represents the time constant 
+    !> (day) which is an e-folding time, the time necessary for the water amount
+    !> in the stream reservoir to decrease by a factor e. Hence, it gives an order of
+    !> magnitude of the travel time through this reservoir between
+    !> the sub-basin considered and its downstream neighbor.
+
+    !! 1.3.1 Calculation of water outflows
+    DO ib=1,nbasmax     
+       DO ig=1,nbpt
+          IF ( route_tobasin(ig,ib) .GT. 0 ) THEN
+             !
+             ! Each of the fluxes is limited by the water in the reservoir and a small margin 
+             ! (min_reservoir) to avoid rounding errors.
+             ! Because the minimum content of the reservoirs is only defined for water,
+             ! the water fluxes are calculated first. The matter fluxes are calculated later
+             ! based on the water fluxes (1.3.2)
+             !
+             flow = MIN(fast_reservoir(ig,ib,ih2o)&
+                  & /((topo_resid(ig,ib)/1000.)*fast_tcst*one_day/dt_routing),&
+                  & fast_reservoir(ig,ib,ih2o)-min_reservoir)
+             fast_flow(ig,ib,ih2o) = MAX(flow, zero)
+             !
+             flow = MIN(slow_reservoir(ig,ib,ih2o)&
+                  & /((topo_resid(ig,ib)/1000.)*slow_tcst*one_day/dt_routing),&
+                  & slow_reservoir(ig,ib,ih2o)-min_reservoir)
+             slow_flow(ig,ib,ih2o) = MAX(flow, zero)
+             !
+             flow = MIN(stream_reservoir(ig,ib,ih2o)/((topo_resid(ig,ib)/1000.)*stream_tcst* & 
+                  & MAX(un-SQRT(flood_frac_bas(ig,ib)),min_sechiba)*one_day/dt_routing),&
+                  & stream_reservoir(ig,ib,ih2o)-min_reservoir)
+             stream_flow(ig,ib,ih2o) = MAX(flow, zero)
+             !
+          ELSE !route_tobasin(ig,ib)
+             fast_flow(ig,ib,ih2o) = zero
+             slow_flow(ig,ib,ih2o) = zero
+             stream_flow(ig,ib,ih2o) = zero
+          ENDIF !route_tobasin(ig,ib)
+       ENDDO !nbpt
+    ENDDO    !nbsmax
+    
+    !! 1.3.2 Calculation of dissolved matter outflows
+    ! Based on the water fluxes from the reservoirs, the matter fluxes are calculated
+    ! The outflows are assumed to have the same concentrations as the reservoirs
+    
+    DO iflow=ih2o+1,nflow
+       DO ib=1,nbasmax
+          DO ig=1,nbpt        
+             IF (fast_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                fast_flow(ig,ib,iflow)= fast_flow(ig,ib,ih2o) &
+                    &                 * (fast_reservoir(ig,ib,iflow) / fast_reservoir(ig,ib,ih2o))
+             ELSE  
+                fast_flow(ig,ib,iflow)=zero
+             ENDIF
+             !
+             IF (slow_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                slow_flow(ig,ib,iflow)= slow_flow(ig,ib,ih2o) &
+                    &                 * (slow_reservoir(ig,ib,iflow) / slow_reservoir(ig,ib,ih2o))
+             ELSE  
+                slow_flow(ig,ib,iflow)=zero
+             ENDIF
+             !  
+             IF (stream_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN 
+                stream_flow(ig,ib,iflow)= stream_flow(ig,ib,ih2o) &
+                      &                 * (stream_reservoir(ig,ib,iflow) &
+                      &                 / stream_reservoir(ig,ib,ih2o))
+             ELSE  
+                stream_flow(ig,ib,iflow)=zero
+             ENDIF
+             !            
+          ENDDO !ig=1,nbpt      
+       ENDDO !  ib=1,nbasmax
+    ENDDO !iflow=ih2o+1,nflow
+ 
+    
+    !! 1.4 Compute the fluxes from the floodplains and ponds if they exist.
+    !! 1.4.1 Compute vertical fluxes with precipitation and potential evaporation
+    ! Note that the variable 'floodout' represents the balance evaporation - precipitation 
+    ! on the floodes area. 'Floodout' is calculated in the hydrol module.
+    IF (dofloodplains .OR. doponds) THEN
+       DO ig=1,nbpt
+          IF (flood_frac(ig) .GT. min_sechiba) THEN
+             
+             flow = MIN(floodout(ig)*totarea(ig)*pond_frac(ig)/flood_frac(ig), &
+               &    pond_reservoir(ig,ih2o)+totflood(ig,ih2o))
+             pondex = MAX(flow - pond_reservoir(ig,ih2o), zero)
+             pond_reservoir(ig,ih2o) = pond_reservoir(ig,ih2o) - (flow - pondex) 
+             
+             ! If demand was over reservoir size, we will take it out from floodplains
+             
+             pond_excessflow(:,:) = zero
+
+             DO ib=1,nbasmax
+                pond_excessflow(ib,ih2o) = MIN(pondex*flood_frac_bas(ig,ib)&
+                     &                     /(flood_frac(ig)-pond_frac(ig)),&
+                     &                     flood_reservoir(ig,ib,ih2o))
+                pondex = pondex - pond_excessflow(ib,ih2o)
+             ENDDO !ib=1,nbasmax
+             
+             IF ( pondex .GT. min_sechiba) THEN
+                WRITE(numout,*) "Unable to redistribute the excess pond outflow over the water &
+                     &          available in the floodplain."
+                WRITE(numout,*) "Pondex = ", pondex
+                WRITE(numout,*) "pond_excessflow(:,ih2o) = ", pond_excessflow(:,ih2o)
+             ENDIF
+             
+                         
+             DO ib=1,nbasmax
+                
+                flow = floodout(ig)*routing_area(ig,ib)*flood_frac_bas(ig,ib)/flood_frac(ig) &
+                  &  + pond_excessflow(ib,ih2o)
+                flood_reservoir(ig,ib,ih2o) = flood_reservoir(ig,ib,ih2o) - flow
+                
+                IF (flood_reservoir(ig,ib,ih2o) .LT. min_sechiba) flood_reservoir(ig,ib,ih2o) =zero
+             ENDDO ! ib=1,nbasmax
+             
+             !! Now update of the other elementatl flows
+             !! We assume that now dissolved matter is lost due to evaporation, which
+             !! means an upconcetration if evaporation exceeds precipitation. Thus, for the
+             !! storage changes in dissolved matter, only inputs from precipitation are considered
+             !! This simplifies the calculations as compared to above, because there can only be
+             !! a gain of dissolved matter. To be consistent with the equations above, however,
+             !! the gains are here represented by negative numbers (floodout is the net-evaporation
+             !! per day). Note that floodout refers to net-evaporation from floodplains only but  
+             !! was normalized to the whole grid cell. Thus, in the equations above one has to  
+             !! devide by flood_frac(ig). 'precip(ig,iflow)' gives the precipitation per area and  
+             !! time, which is valid for the whole grid box. But here, we are only interseted in 
+             !! the amount of precipitation (and the associated wet deposition) on water surfaces.
+
+
+             DO iflow=ih2o+1, nflow
+                flow = -precip(ig,iflow)*totarea(ig)*pond_frac(ig)
+                pond_reservoir(ig,iflow) = pond_reservoir(ig,iflow) - flow     
+                          
+                DO ib=1,nbasmax
+                
+                   flow = -precip(ig,iflow) * routing_area(ig,ib) * flood_frac_bas(ig,ib) 
+                   flood_reservoir(ig,ib,iflow) = flood_reservoir(ig,ib,iflow) - flow
+                
+                   IF (flood_reservoir(ig,ib,ih2o) .LT. min_sechiba) &
+                              &     flood_reservoir(ig,ib,iflow) =zero
+                ENDDO ! ib=1,nbasmax    
+             ENDDO !iflow=ih2o+1, nflow
+             
+             !! If ponds fall dry, storage of dissolved matter is set to zero
+             IF (pond_reservoir(ig,ih2o) .LT. min_sechiba) pond_reservoir(ig,:) = zero             
+          ENDIF !(flood_frac(ig) .GT. min_sechiba)
+       ENDDO ! ig=1,nbpt
+    ENDIF !(flood_frac(ig) .GT. min_sechiba)
+    
+    !! 1.4.2 Computing the drainage from floodplains and update reservoirs
+    !> Drainage from floodplains is depending on a averaged conductivity (k_litt) 
+    !> for saturated infiltration in the 'litter' layer. Flood_drainage will be
+    !> a component of the total reinfiltration that leaves the routing scheme.
+    !-
+    IF (dofloodplains) THEN
+       IF (dofloodinfilt) THEN
+          !! 1.4.2.1 Drainage of water
+          DO ib=1,nbasmax
+             DO ig=1,nbpt
+                flood_drainage(ig,ib,ih2o) = MAX(zero, MIN(flood_reservoir(ig,ib,ih2o), &
+                     & flood_frac(ig)*routing_area(ig,ib)*k_litt(ig)*dt_routing/one_day))
+             ENDDO !ig=1,nbpt   
+          ENDDO !ib=1,nbasmax   
+          
+          !! 1.4.2.2 Drainage of dissolved matter
+          ! The matter fluxes with the drainage are computed based on the assumption that the  
+          ! drainage has the same concentrations as the water in the reservoirs. This assumption
+          ! is used to directly scale the fluxes of dissolved matter with that of water.
+          ! This will not work for particualte matter fluxes.
+          
+          DO iflow=ih2o+1,nflow
+             DO ib=1,nbasmax
+                DO ig=1,nbpt 
+                   IF (flood_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                      flood_drainage(ig,ib,iflow) = flood_drainage(ig,ib,ih2o) &
+                         &  * (flood_reservoir(ig,ib,iflow) / flood_reservoir(ig,ib,ih2o))
+                   ELSE
+                      flood_drainage(ig,ib,iflow) = zero
+                   ENDIF
+                ENDDO !ig=1,nbpt    
+             ENDDO !ib=1,nbasmax                
+          ENDDO !iflow=ih2o+1,nflow
+          
+          !! 1.4.2.3 Update flood reservoir with drainage losses 
+          DO iflow=1,nflow
+             DO ib=1,nbasmax
+                DO ig=1,nbpt                      
+                   flood_reservoir(ig,ib,iflow) = flood_reservoir(ig,ib,iflow) &
+                                    &           - flood_drainage(ig,ib,iflow)
+                ENDDO !ig=1,nbpt
+             ENDDO !ib=1,nbasmax
+          ENDDO !iflow=1,nflow      
+          
+          !! 1.4.2.4 If floddinfiltration not activated, drainage is zero         
+       ELSE !dofloodinfilt
+          flood_drainage(:,:,:) = zero 
+       ENDIF
+
+       !! 1.4.3 Compute the lateral outflows from the floodplains
+       !> Outflow from floodplains is computed depending a delay. This delay is characterized by a
+       !> time constant function of the surface of the floodplains and the product of topo_resid 
+       !> and flood_tcst. flood_tcst has been calibrated through observations in the Niger Inner 
+       !> Delta (D'Orgeval, 2006).
+       
+       DO iflow=1,nflow 
+          DO ib=1,nbasmax
+             DO ig=1,nbpt
+                IF ( route_tobasin(ig,ib) .GT. 0 ) THEN
+                   IF (flood_frac_bas(ig,ib) .GT. min_sechiba) THEN
+                      flow = MIN(flood_reservoir(ig,ib,iflow)  &
+                           & /((topo_resid(ig,ib)/1000.)*flood_tcst* &
+                           & flood_frac_bas(ig,ib)*one_day/dt_routing),&
+                           & flood_reservoir(ig,ib,iflow))
+                   ELSE
+                      flow = zero
+                   ENDIF
+                   flood_flow(ig,ib,iflow) = flow
+                ELSE
+                   flood_flow(ig,ib,iflow) = zero
+                ENDIF
+             ENDDO !ig=1,nbpt
+          ENDDO !ib=1,nbasmax
+       ENDDO !iflow=1,nflow        
+    ELSE! floodplains
+    ! The followin nested loops are not necessary, this can simply be optimized!
+      flood_drainage(:,:,:)  = zero
+      flood_flow(:,:,:)      = zero
+      flood_reservoir(:,:,:) = zero
+    ENDIF
+
+    !! 1.4.4 Drainage and inflow for ponds
+    !- Computing drainage and inflow for ponds
+    !> Drainage from ponds is computed in the same way as for floodplains.
+    !> Reinfiltrated fraction from the runoff (i.e. the outflow from the fast reservoir)
+    !> is the inflow of the pond reservoir.
+    !-
+    IF (doponds) THEN
+       ! If used, the slope coef is not used in hydrol for water2infilt
+       
+       ! As k_litt refers to water infiltration, pond_drainage is first only calculated for water
+       ! in a second step, the dissolved matter fluxes associated to infiltration are calcutaed 
+       ! based on the infiltration of water, assuming the same concentrations in the drainage as 
+       ! in the water stored in the reservoir.
+       
+       !! 1.4.4.1 Drainage of water in ponds       
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             pond_drainage(ig,ib,ih2o) = MIN(pond_reservoir(ig,ih2o) &
+                  &                    * routing_area(ig,ib)/totarea(ig), &
+                  &                      pond_frac(ig) * routing_area(ig,ib) * k_litt(ig) &
+                  &                    * dt_routing/one_day)
+          ENDDO !ig=1,nbpt
+       ENDDO !ib=1,nbasmax
+       
+       !! 1.4.4.2 Flows of dissolved matter with drainage
+       
+       DO iflow=ih2o+1,nflow
+          DO ib=1,nbasmax
+             DO ig=1,nbpt      
+                IF (pond_reservoir(ig,ih2o) .GT. min_sechiba) THEN
+                   pond_drainage(ig,ib,iflow) = pond_drainage(ig,ib,ih2o) &
+                                 &            * (pond_reservoir(ig,iflow) &
+                                 &            / pond_reservoir(ig,ih2o))
+                ELSE
+                   pond_drainage(ig,ib,iflow) = zero
+                ENDIF
+             ENDDO !ig=1,nbpt           
+          ENDDO !ib=1,nbasmax        
+       ENDDO !iflow=ih2o+1,nflow
+       
+       !! 1.4.4.3 Inflows of water and dissolved matter to ponds
+       ! Calculation of pond inflow using water and dissolved matter from the fast flow
+       ! Then, update of fast flow
+       
+       DO iflow=1,nflow
+          DO ib=1,nbasmax
+             DO ig=1,nbpt
+                pond_inflow(ig,ib,iflow) = fast_flow(ig,ib,iflow) * reinf_slope(ig)               
+                fast_flow(ig,ib,iflow) = fast_flow(ig,ib,iflow) - pond_inflow(ig,ib,iflow) 
+             ENDDO !ig=1,nbpt
+          ENDDO !ib=1,nbasmax
+       ENDDO !iflow=1,nflow 
+    ELSE
+       pond_inflow(:,:,:) = zero
+       pond_drainage(:,:,:) = zero
+       pond_reservoir(:,:) = zero   
+    ENDIF 
+
+    !! 1.5 Compute the transport from one basin to another
+
+    IF (is_root_prc)  THEN
+       ALLOCATE( fast_flow_g(nbp_glo, nbasmax, nflow), slow_flow_g(nbp_glo, nbasmax, nflow), &
+            stream_flow_g(nbp_glo, nbasmax, nflow))
+    ELSE
+       ALLOCATE( fast_flow_g(1,1,1), slow_flow_g(1,1,1), &
+            stream_flow_g(1,1,1) )
+    ENDIF
+    
+       
+    CALL gather(fast_flow,fast_flow_g)
+    CALL gather(slow_flow,slow_flow_g)
+    CALL gather(stream_flow,stream_flow_g)
+
+    IF (is_root_prc) THEN
+       ! routing is done for all matter fluxes at the same time 
+       DO ib=1,nbasmax
+          DO ig=1,nbp_glo
+             !
+             rtg = route_togrid_glo(ig,ib)
+             rtb = route_tobasin_glo(ig,ib)
+             transport_glo(rtg,rtb,:) = transport_glo(rtg,rtb,:) + fast_flow_g(ig,ib,:) &
+                                    & + slow_flow_g(ig,ib,:) + stream_flow_g(ig,ib,:)
+             !
+          ENDDO !ig=1,nbp_glo
+       ENDDO !ib=1,nbasmax
+    ENDIF !is_root_prc
+
+    DEALLOCATE( fast_flow_g, slow_flow_g, stream_flow_g )
+   
+    CALL scatter(transport_glo,transport)
+
+    !! 1.6 Do the floodings 
+    !! 1.6.1 Initialize
+    return_swamp(:,:,:)=zero
+    floods(:,:,:)=zero
+    
+    !! 1.6.2 Swamps: Calculating returnflow taking water from river
+    !> Over swamp areas, a fraction of water (return_swamp) is withdrawn from the river depending
+    !> on the parameter swamp_cst.
+    !> It will be transferred into soil moisture and thus does not return directly to the river.
+
+    IF ( doswamps ) THEN
+       tobeflooded(:) = swamp(:)
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             potflood(ig,ib,:) = transport(ig,ib,:) 
+             
+             IF ( tobeflooded(ig) > 0. .AND. potflood(ig,ib,ih2o) > 0. &
+             &  .AND. floodtemp(ig) > tp_00 ) THEN
+                
+                IF (routing_area(ig,ib) > tobeflooded(ig)) THEN
+                   floodindex = tobeflooded(ig) / routing_area(ig,ib)
+                ELSE
+                   floodindex = 1.0
+                ENDIF
+                return_swamp(ig,ib,:) = swamp_cst * potflood(ig,ib,:) * floodindex
+                
+                tobeflooded(ig) = tobeflooded(ig) - routing_area(ig,ib) 
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+
+    !! 1.6.3 Floodplains: Update amount of water/matter which enters the floodplains
+ 
+    IF ( dofloodplains ) THEN
+       DO ig=1,nbpt
+          IF (floodplains(ig) .GT. min_sechiba .AND. floodtemp(ig) .GT. tp_00) THEN
+             DO ib=1,nbasmax
+                floods(ig,ib,:) = transport(ig,ib,:) - return_swamp(ig,ib,:) 
+             ENDDO !ib=1,nbasmax
+          ENDIF
+       ENDDO !ig=1,nbpt
+    ENDIF
+    
+    !! 2. Update all reservoirs
+    !> The slow and deep reservoir (slow_reservoir) collect the deep drainage whereas the
+    !> fast_reservoir collects the computed surface runoff. Both discharge into a third reservoir
+    !> (stream_reservoir) of the next sub-basin downstream.
+    !> Water from the floodplains reservoir (flood_reservoir) flows also into the stream_reservoir 
+    !> of the next sub-basin downstream. Water that flows into the pond_reservoir is withdrawn 
+    !> from the fast_reservoir.
+    
+    error_reservoir=.FALSE.
+    loopresnbpt : DO ig=1,nbpt
+       DO ib=1,nbasmax
+          !! 2.1 Update all reservoirs based on in and out flows 
+          ! No loop for iflow, reservoirs are update for all species at once
+          fast_reservoir(ig,ib,:)   = fast_reservoir(ig,ib,:) + runoff(ig,:)*routing_area(ig,ib) &
+               &                    - fast_flow(ig,ib,:) - pond_inflow(ig,ib,:)
+          
+          slow_reservoir(ig,ib,:)   = slow_reservoir(ig,ib,:) + drainage(ig,:)*routing_area(ig,ib) &
+               &                    - slow_flow(ig,ib,:)
+          
+          stream_reservoir(ig,ib,:) = stream_reservoir(ig,ib,:) + flood_flow(ig,ib,:) &
+               &                    + transport(ig,ib,:) - stream_flow(ig,ib,:) &
+               &                    - return_swamp(ig,ib,:) - floods(ig,ib,:)
+          
+          flood_reservoir(ig,ib,:)  = flood_reservoir(ig,ib,:) + floods(ig,ib,:) &
+               &                    - flood_flow(ig,ib,:) 
+          
+          pond_reservoir(ig,:)      = pond_reservoir(ig,:) + pond_inflow(ig,ib,:) &
+               &                    - pond_drainage(ig,ib,:)
+          
+ 
+          !! 2.2 Check reservoirs for negative values
+          ! If the floodplain reservoir is assigned a negative water storage, the floodplain
+          ! reservoir is reset to 0 kg, and the missing water is taken from the stream reservoir. 
+          ! If the stream reservoir is negative, then water is taken from the fast reservoir. 
+          ! And if the fast reservoir is negative, the missing water is finally taken from the 
+          ! slow reservoir. In case of negative values in the slow reservoir, then routing stops 
+          ! with an error message. When water fluxes are corrected, this correction is done
+          ! for the dissolved matter at the same time.
+          
+          IF ( flood_reservoir(ig,ib,ih2o) .LT. zero ) THEN 
+             IF ( check_reservoir ) THEN
+                WRITE(numout,*) "WARNING : negative flood reservoir at :", ig, ib, &
+                       &        ". Problem is being corrected."
+                WRITE(numout,*) "flood_reservoir, floods, flood_flow : ", &
+                       &        flood_reservoir(ig,ib,ih2o), floods(ig,ib,ih2o), &
+                       &        flood_flow(ig,ib,ih2o) 
+             ENDIF
+             stream_reservoir(ig,ib,:) = stream_reservoir(ig,ib,:) + flood_reservoir(ig,ib,:)
+             flood_reservoir(ig,ib,:) = zero
+          ENDIF
+          
+          IF ( stream_reservoir(ig,ib,ih2o) .LT. zero ) THEN
+             IF ( check_reservoir ) THEN
+                WRITE(numout,*) "WARNING : negative stream reservoir at :", ig, ib, &
+                       &        ". Problem is being corrected."
+                WRITE(numout,*) "stream_reservoir, flood_flow, transport : ", &
+                       &        stream_reservoir(ig,ib,ih2o), flood_flow(ig,ib,ih2o), &
+                       &        transport(ig,ib,ih2o)
+                WRITE(numout,*) "stream_flow, return_swamp, floods :", stream_flow(ig,ib,ih2o), &
+                       &        return_swamp(ig,ib,ih2o), floods(ig,ib,ih2o)
+             ENDIF
+             fast_reservoir(ig,ib,:) =  fast_reservoir(ig,ib,:) + stream_reservoir(ig,ib,:)
+             stream_reservoir(ig,ib,:) = zero        
+          ENDIF
+          
+          IF ( fast_reservoir(ig,ib,ih2o) .LT. zero ) THEN
+             IF ( check_reservoir ) THEN
+                WRITE(numout,*) "WARNING : negative fast reservoir at :", ig, ib, &
+                       &        ". Problem is being corrected."
+                WRITE(numout,*) "fast_reservoir, runoff, fast_flow, ponf_inflow  : ", &
+                       &        fast_reservoir(ig,ib,ih2o), runoff(ig,ih2o), &
+                       &        fast_flow(ig,ib,ih2o), pond_inflow(ig,ib,ih2o)
+             ENDIF
+             slow_reservoir(ig,ib,:) =  slow_reservoir(ig,ib,:) + fast_reservoir(ig,ib,:)
+             fast_reservoir(ig,ib,:) = zero
+          ENDIF
+          
+          IF ( slow_reservoir(ig,ib,ih2o) .LT. zero ) THEN
+             error_reservoir=.TRUE.
+             EXIT loopresnbpt
+          ENDIF
+          !
+       ENDDO !ib=1,nbasmax
+       ! DOC decomposition in ponds is calculated after the loop for the basins, as the pond 
+       ! reservoir has no dimension for different basins and always relates to the entire grid box.
+       IF (ok_doc) THEN
+          pond_reservoir(ig,ico2aq) = pond_reservoir(ig,ico2aq) - pond_dec*pond_reservoir(ig,idoc)
+          pond_reservoir(ig,idoc)   = (1 - pond_dec) * pond_reservoir(ig,idoc)
+       ENDIF 
+    ENDDO loopresnbpt
+
+    IF (error_reservoir) THEN
+       WRITE(numout,*) 'There is a negative reservoir at :', ig, ib
+       WRITE(numout,*) 'slowr, slow_flow, drainage', &
+            & slow_reservoir(ig,ib,ih2o), slow_flow(ig,ib,ih2o), drainage(ig,ih2o)
+       WRITE(numout,*) 'pondr, pond_inflow, pond_drainage', &
+            & pond_reservoir(ig,ih2o), pond_inflow(ig,ib,ih2o), pond_drainage(ig,ib,ih2o)
+       CALL ipslerr(3, 'routing_flow', 'ERROR, slow_reservoir can be safely be reset to zero.',&
+            & '','')
+    ENDIF
+    
+       ! All resservoirs were sofar checked for water content and eventually corrected where water
+       ! content was negative(see above). For dissolved matter transport, there might however 
+       ! still be very small negative or positive values due to rounding errors.
+           
+      
+    !! 2.3 Aggreagte the flood reservoirs per grid box   
+    totflood(:,:) = zero
+    DO ig=1,nbpt
+       DO ib=1,nbasmax
+          totflood(ig,:) = totflood(ig,:) + flood_reservoir(ig,ib,:)
+       ENDDO
+    ENDDO
+
+
+    !! 3 Computes the fraction of floodplains and ponds according to their volume
+
+    IF (dofloodplains .OR. doponds) THEN
+       flood_frac(:) = zero
+       flood_height(:) = zero
+       flood_frac_bas(:,:) = zero
+       DO ig=1, nbpt
+          IF (totflood(ig,ih2o) .GT. min_sechiba) THEN
+             ! We first compute the total fraction of the grid box which is flooded at 
+             ! optimum repartition
+             flood_frac_pot = (totflood(ig,ih2o) / (totarea(ig)*floodcri/(beta+un))) & 
+                  &         **(beta/(beta+un))
+             flood_frac(ig) = MIN(floodplains(ig) / totarea(ig), flood_frac_pot)
+             ! Then we diagnose the fraction for each basin with the size of its flood_reservoir 
+             ! (flood_frac_bas may be > 1)
+             DO ib=1,nbasmax
+                IF (routing_area(ig,ib) .GT. min_sechiba) THEN
+                   flood_frac_bas(ig,ib) = flood_frac(ig) &
+                        &                * (flood_reservoir(ig,ib,ih2o) / totflood(ig,ih2o)) &
+                        &                / (routing_area(ig,ib) / totarea(ig))
+                ENDIF
+             ENDDO
+             ! We diagnose the maximum height of floodplain
+             flood_height(ig) = (beta/(beta+1))*floodcri*(flood_frac(ig))**(un/beta) &
+                        &     + totflood(ig,ih2o)/(totarea(ig)*flood_frac(ig)) 
+             ! And finally add the pond surface
+             pond_frac(ig) = MIN(un-flood_frac(ig), &
+                        &    ((betap+1)*pond_reservoir(ig,ih2o) / (pondcri*totarea(ig))) &
+                        &  **(betap/(betap+1)) ) 
+             flood_frac(ig) = flood_frac(ig) + pond_frac(ig)
+             
+          ENDIF
+       ENDDO
+    ELSE
+       flood_frac(:) = zero
+       flood_height(:) = zero
+       flood_frac_bas(:,:) = zero
+    ENDIF
+
+    !!
+    !! 4 Compute CO2 evasion from all five reservoirs
+    IF (ok_doc) THEN   
+       !! 4.1 Partioning the headwater and stream areas among the basins of each cell 
+       !! Aggreagte squares of stream and fast (head water) reservoirs to partition areas between 
+       !! basins. Square root was chosen as it corresponds more or less to the typical exponent in 
+       !! reported discharge stream width relationships. 
+       !! THe headwaters would here be represented by fast resrvoir
+       !! Headwaters represent lotic wtare bodies below grid scale, which are nethertheless important
+       !! for the biogeochemical budget
+       !! 4.1.1 Initialize
+       tot_upstream(:) = zero
+       !! 4.1.2 Aggregate squares of water reservoirs
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             !
+             tot_upstream(ig)  = tot_upstream(ig) + upstream_area(ig,ib)**undemi
+          ENDDO !ig=1,nbpt
+       ENDDO !ib=1,nbasmax   
+       !! 4.2 Calculate stream and headwater per basin
+       DO ig=1,nbpt
+          total_area = sum(routing_area(ig,:))
+          DO ib=1,nbasmax
+             !   
+             IF (tot_upstream(ig) .GT. min_sechiba) THEN
+                stream_area_bas(ig,ib) = stream_area(ig) * (upstream_area(ig,ib)**undemi) &
+                     &                 / tot_upstream(ig)
+             ELSE 
+                stream_area_bas(ig,ib) = zero
+             ENDIF !(tot_upstream(ig) .GT. min_sechiba)
+             !
+             IF (total_area .GT. min_sechiba) THEN
+                headw_area_bas(ig,ib)  = headw_area(ig) * routing_area(ig,ib) / total_area
+             ELSE 
+                headw_area_bas(ig,ib)  = zero    
+             ENDIF !(total_area(ig) .GT. min_sechiba)         
+          ENDDO !ib=1,nbasmax
+       ENDDO  !ig=1,nbpt           
+       !! 4.3 Calculate DOC decomposition and CO2 evasion
+       !! 4.3.0 Calculation of Henry constant
+       !! This is just the preliminary position, once we figured out how to best estimate water
+       !! temperature, this will be within the loops on gridboxes (and basins???)
+       K_CO2 = 10.0**( - (-2.22E-06 * (T_water**trois) - 1.91E-05 * (T_water**deux) &
+         &   + 1.63E-02 * T_water + 1.11))
+       !! This is an equation from Telmer and Veizer (1999),GCA, which was derived from data
+       !! listed in the text book by Stumm and Morgan
+       !! 4.3.1 Intilaize FCO2_aq and pCO2_aq
+       FCO2_aq(:,:) = zero
+       pCO2_aq(:,:) = zero       
+       !! 4.3.2 Calculation
+         !! First, the decomposition of DOC and subsequent CO2 production are calculated 
+         !! (at present state with fixed decomposition rates per day).
+         !! The decomposition is not calculated for the whole day at once but over
+         !! a certain number of time segments over the day (nstep_FCO2, for the moment
+         !! nstep_FCO2=240). For each of these time segments, the CO2 evasion (FCO2)
+         !! is calculated as well. This segmentation was necessary as the storage of 
+         !! dissolved CO2, and thus the implied concentrations of dissolved CO2, are the
+         !! initial values for each time step. As the CO2 concentation decreases during
+         !! the outgassing, at a given gas exchange rate, the flux rates would decrease
+         !! in proportion to the decreasing pCO2 gradient between water and air.
+         !! Using the initial concentrations (and thus initial partial pressures) for  
+         !! each 1 day time step to calculate the FCO2 over the whole day would lead 
+         !! to systematically too high numbers. The number of time segments can be changed in
+         !! the main declaration part.
+         !! For the calculation of CO2 evasion from the different reservoirs (FCO2), first,
+         !! the pCO2 of the water column is claculated (pCO2_wa). Then FCO2 is calcluated
+         !! based on the diffrence between pCO2 of water and in the atmosphere, the Henry
+         !! constant (K_CO2), the gas exchange velocity k, and the water surface area.
+         !! mmslr_C is the atmoic weight of C in mol/kg, defined in constantes_var.f90.
+         !! As the gas exchanges velocity k in m/d can be larger then required to
+         !! equilibrate the water column with the atmosphere, which happens if the water
+         !! column has an average depth in m (not directly given here, but implied by the
+         !! relationship of water storage in the reservoir and water surface area) that
+         !! is lower then the water column depth therotical equilibrate per day (=k),
+         !! the maximum outgassing is defined by the amount of dissolved CO2 in the
+         !! reservoir which is in excess to the theoretical equilibrium state with the 
+         !! atmosphere (By having a large number of time segments, this risk is lowered,
+         !! but not entriely ruled out). 
+         !! As the pCO2_wa calculated from the concentration of dissolved
+         !! CO2 (iCO2aq) is further depending on the water temperature, changes in water 
+         !! temperature can cause the water column to be undersaturated with respect
+         !! to atmospheric pCO2, particulary if water imputs and stored water from the
+         !! preceding time step were at or close to the equilibrium with the atmosphere. 
+         !! In that case, FCO2 is set to zero. Negative values for FCO2, that is CO2
+         !! uptake from the atmosphere are not represented in this model.  
+
+         
+       DO ig=1,nbpt
+          DO ib=1,nbasmax 
+             !! 4.3.2.1 Floodplains
+             IF (flood_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                ! Initializing
+                FCO2_ac = zero
+                pCO2_avg = zero
+                store_CO2 = flood_reservoir(ig,ib,iCO2aq)
+                store_doc = flood_reservoir(ig,ib,idoc) 
+                decompos  = flood_dec*flood_reservoir(ig,ib,idoc)/nstep_FCO2                  
+                ! Outgassing over nstep_FCO2 time segments per day
+                DO istep_FCO2 = 1, nstep_FCO2
+                   pCO2_wa = ((store_CO2 / flood_reservoir(ig,ib,ih2o)) &
+                      &    / msmlr_C) / K_CO2
+                   FCO2    = min((K_CO2 * (pCO2_wa-1.0E-06*pCO2_atm) * msmlr_C * k_flood &
+                        &  * flood_frac_bas(ig,ib) * routing_area(ig,ib) * mille/ nstep_FCO2), &
+                        &    max((K_CO2 * (pCO2_wa-1.0E-06*pCO2_atm) * msmlr_C &
+                        &  * flood_reservoir(ig,ib,ih2o)), zero))  
+                   FCO2_ac = FCO2_ac + FCO2
+                   pCO2_avg = pCO2_avg + pCO2_wa
+                   store_CO2 = store_CO2 - FCO2 + decompos
+                   store_doc = store_doc - decompos
+                ENDDO !istep_FCO2 = 1, nstep_FCO2
+                flood_reservoir(ig,ib,idoc)= store_doc                
+                flood_reservoir(ig,ib,iCO2ev) = flood_reservoir(ig,ib,iCO2ev) + FCO2_ac
+                flood_reservoir(ig,ib,iCO2aq) = store_CO2
+                FCO2_aq(ig,ifloodr) = FCO2_aq(ig,ifloodr) + FCO2_ac 
+                pCO2_aq_bas(ig,ib,ifloodr) = pCO2_avg / nstep_FCO2
+             ELSE 
+                flood_reservoir(ig,ib,:) = zero
+             ENDIF !(flood_reservoir(ig,ib,ih2o) .GT. min_sechiba)
+             !
+             !! 4.3.2.2 Streams and rivers
+             IF (stream_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                ! Initializing
+                FCO2_ac = zero
+                pCO2_avg = zero                
+                store_CO2 = stream_reservoir(ig,ib,iCO2aq)
+                store_doc = stream_reservoir(ig,ib,idoc) 
+                decompos  = stream_dec*stream_reservoir(ig,ib,idoc)/nstep_FCO2                    
+                ! Outgassing over nstep_FCO2 time segments per day
+                DO istep_FCO2 = 1, nstep_FCO2
+                   pCO2_wa = ((store_CO2 / stream_reservoir(ig,ib,ih2o)) &
+                      &    / msmlr_C) / K_CO2
+                   FCO2    = min((K_CO2 * (pCO2_wa-1.0E-06*pCO2_atm) * msmlr_C * k_stream &
+                      &    * stream_area_bas(ig,ib) * mille / nstep_FCO2), &
+                      &      max((K_CO2 * (pCO2_wa-1.0E-06*pCO2_atm) * msmlr_C &
+                      &    * stream_reservoir(ig,ib,ih2o)), zero))  
+                   FCO2_ac = FCO2_ac + FCO2
+                   pCO2_avg = pCO2_avg + pCO2_wa
+                   store_CO2 = store_CO2 - FCO2 + decompos
+                   store_doc = store_doc - decompos
+                ENDDO !istep_FCO2 = 1, nstep_FCO2  
+                stream_reservoir(ig,ib,idoc)= store_doc                
+                stream_reservoir(ig,ib,iCO2ev) = stream_reservoir(ig,ib,iCO2ev) + FCO2_ac
+                stream_reservoir(ig,ib,iCO2aq) = store_CO2               
+                FCO2_aq(ig,istreamr) = FCO2_aq(ig,istreamr) + FCO2_ac 
+                pCO2_aq_bas(ig,ib,istreamr) = pCO2_avg / nstep_FCO2                
+             ELSE 
+                stream_reservoir(ig,ib,:) = zero
+             ENDIF !(stream_reservoir(ig,ib,ih2o) .GT. min_sechiba)
+             !
+             !! 4.3.2.3 Fast reservoir
+             ! Here we calculate the CO2 evasion from the headwaters, which are represented by fast
+             ! reservoir (runoff). First, we calculate the oxidation of DOC, and thus production of 
+             ! CO2. Then, we calculate the CO2 evasion assumin that all dissolved CO2 in excess to 
+             ! the atmospheric partial pressure of pCO2 is evading. 
+             IF (fast_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                ! Initializing
+                FCO2_ac = zero  
+                pCO2_avg = zero                 
+                decompos  = fast_dec*fast_reservoir(ig,ib,idoc)  
+                store_CO2 = fast_reservoir(ig,ib,iCO2aq) + decompos               
+                store_doc = fast_reservoir(ig,ib,idoc) - decompos
+                
+                pCO2_wa = ((store_CO2 / fast_reservoir(ig,ib,ih2o)) &
+                   &    / msmlr_C) / K_CO2
+                FCO2    = max((K_CO2 * (pCO2_wa-1.0E-06*pCO2_atm) * msmlr_C &
+                   &    * fast_reservoir(ig,ib,ih2o)), zero)  
+                  
+                store_CO2 = store_CO2 - FCO2
+
+                fast_reservoir(ig,ib,idoc)= store_doc                
+                fast_reservoir(ig,ib,iCO2ev) = fast_reservoir(ig,ib,iCO2ev) + FCO2
+                fast_reservoir(ig,ib,iCO2aq) = store_CO2               
+                FCO2_aq(ig,ifastr) = FCO2_aq(ig,ifastr) + FCO2   
+                pCO2_aq_bas(ig,ib,ifastr) = pCO2_wa                 
+             ELSE 
+                fast_reservoir(ig,ib,:) = zero
+             ENDIF !(fast_reservoir(ig,ib,ih2o) .GT. min_sechiba)
+             
+             !! 4.3.2.4 Groundwater (slow reservoir)
+             ! For the slow reservoir, which we assume to present the groundwater reservoir,
+             ! we assume CO2 evasion to be zero. The only process here is the decomposition
+             ! DOC, which fuels the dissolved CO2 storage.
+             IF (slow_reservoir(ig,ib,ih2o) .GT. min_sechiba) THEN
+                ! Initializing             
+                decompos  = slow_dec*slow_reservoir(ig,ib,idoc)                    
+                slow_reservoir(ig,ib,idoc)= slow_reservoir(ig,ib,idoc) - decompos                
+                slow_reservoir(ig,ib,iCO2aq) = slow_reservoir(ig,ib,iCO2aq) + decompos   
+                pCO2_aq_bas(ig,ib,islowr) = ((slow_reservoir(ig,ib,iCO2aq) &
+                      &                   / slow_reservoir(ig,ib,ih2o)) &
+                      &                   / msmlr_C) / K_CO2               
+             ELSE 
+                slow_reservoir(ig,ib,:) = zero
+             ENDIF !(slow_reservoir(ig,ib,ih2o) .GT. min_sechiba)                  
+          ENDDO !ib=1,nbasmax 
+          !! 4.3.2.5 Ponds
+          IF (pond_reservoir(ig,ih2o) .GT. min_sechiba) THEN
+             ! Initializing
+             FCO2_ac = zero
+             pCO2_avg = zero               
+             store_CO2 = pond_reservoir(ig,iCO2aq) 
+             store_doc = pond_reservoir(ig,idoc) 
+             decompos  = pond_dec * pond_reservoir(ig,idoc) / nstep_FCO2              
+             ! Outgassing over nstep_FCO2 time segments per day
+             DO istep_FCO2 = 1, nstep_FCO2       
+                pCO2_wa = ((store_CO2 / pond_reservoir(ig,ih2o)) &
+                   &    / msmlr_C) / K_CO2
+                FCO2    = min((K_CO2 * (pCO2_wa - 1.0E-06*pCO2_atm) * msmlr_C*k_pond*totarea(ig) &
+                   &    * pond_frac(ig) * mille/nstep_FCO2), max((K_CO2*(pCO2_wa-1.0E-06*pCO2_atm)&
+                   &    * msmlr_C * pond_reservoir(ig,ih2o)), zero))  
+                FCO2_ac = FCO2_ac + FCO2
+                pCO2_avg = pCO2_avg + pCO2_wa                  
+                store_CO2 = store_CO2 - FCO2 + decompos
+                store_doc = store_doc - decompos    
+             ENDDO !istep_FCO2 = 1, nstep_FCO2  
+             pond_reservoir(ig,idoc)   = store_doc            
+             pond_reservoir(ig,iCO2ev) = pond_reservoir(ig,iCO2ev) + FCO2_ac
+             pond_reservoir(ig,iCO2aq) = store_CO2         
+             FCO2_aq(ig,ipondr)         = FCO2_ac 
+             pCO2_aq(ig,ipondr)         = pCO2_avg / nstep_FCO2              
+          ELSE
+             pond_reservoir(ig,:) = zero
+          ENDIF !(pond_reservoir(ig,ib,ih2o) .GT. min_sechiba)
+       ENDDO !ig=1,nbpt
+       
+       !! 4.4 Aggreagte pCO2 values for flood, stream, fast and slow reservoirs
+       !! per grid box. This is done using the water storage per reservoir and basin as weight.
+       DO ig=1,nbpt
+       
+          pCO2_aggr = zero
+          IF (sum(flood_reservoir(ig,:,ih2o)) .GT. min_sechiba) THEN
+             DO ib=1,nbasmax 
+                !! 4.4.1 Floodplains
+                pCO2_aggr = pCO2_aggr + pCO2_aq_bas(ig,ib,ifloodr)*flood_reservoir(ig,ib,ih2o)
+             ENDDO
+             pCO2_aq(ig,ifloodr) = pCO2_aggr / sum(flood_reservoir(ig,:,ih2o))
+          ELSE
+             ! Do nothing, would be zero from initialization
+          ENDIF !   sum(flood_reservoir(ig,:,ih2o)) .GT. min_sechiba
+          
+          pCO2_aggr = zero
+          IF (sum(stream_reservoir(ig,:,ih2o)) .GT. min_sechiba) THEN
+             DO ib=1,nbasmax 
+                !! 4.4.2 Streams
+                pCO2_aggr = pCO2_aggr + pCO2_aq_bas(ig,ib,istreamr)*stream_reservoir(ig,ib,ih2o)
+             ENDDO
+             pCO2_aq(ig,istreamr) = pCO2_aggr / sum(stream_reservoir(ig,:,ih2o))
+          ELSE
+             ! Do nothing, would be zero from initialization
+          ENDIF !   sum(stream_reservoir(ig,:,ih2o)) .GT. min_sechiba       
+
+          pCO2_aggr = zero
+          IF (sum(fast_reservoir(ig,:,ih2o)) .GT. min_sechiba) THEN
+             DO ib=1,nbasmax 
+                !! 4.4.3 fast reservoir
+                pCO2_aggr = pCO2_aggr + pCO2_aq_bas(ig,ib,ifastr)*fast_reservoir(ig,ib,ih2o)
+             ENDDO
+             pCO2_aq(ig,ifastr) = pCO2_aggr / sum(fast_reservoir(ig,:,ih2o))
+          ELSE
+             ! Do nothing, would be zero from initialization
+          ENDIF !   sum(fast_reservoir(ig,:,ih2o)) .GT. min_sechiba      
+
+          pCO2_aggr = zero
+          IF (sum(slow_reservoir(ig,:,ih2o)) .GT. min_sechiba) THEN
+             DO ib=1,nbasmax 
+                !! 4.4.4 slow reservoir
+                pCO2_aggr = pCO2_aggr + pCO2_aq_bas(ig,ib,islowr)*slow_reservoir(ig,ib,ih2o)
+             ENDDO
+             pCO2_aq(ig,islowr) = pCO2_aggr / sum(slow_reservoir(ig,:,ih2o))
+          ELSE
+             ! Do nothing, would be zero from initialization
+          ENDIF !   sum(slow_reservoir(ig,:,ih2o)) .GT. min_sechiba    
+
+          !! 4.4.5 Pond reservoir
+          !! does not need to be aggreagted, was already calculated per whole grid cell
+       ENDDO !ig=1,nbpt
+       
+       !! 4.5 Recalculate pCO2 from atm to uatm
+       pCO2_aq = pCO2_aq * 1.0E06
+                      
+    ENDIF !ok_doc)   
+    
+    !! 5. Compute the total reinfiltration and returnflow to the grid box
+    !> A term of returnflow is computed including the water from the swamps that does not return 
+    !> directly to the river but will be put into soil moisture (see hydrol module).
+    !> A term of reinfiltration is computed including the water that reinfiltrated from the ponds 
+    !> and floodplains areas. It will be put into soil moisture (see hydrol module).
+    !-
+    IF (dofloodplains .OR. doswamps .OR. doponds) THEN
+       returnflow(:,:) = zero
+       reinfiltration(:,:) = zero
+       
+       DO ib=1,nbasmax
+          DO ig=1,nbpt
+             ! No loop for species transported, all calculated at the same time
+             ! This will work for dissolved species, as long as similar concentrations in
+             ! infiltrating water and reservoirs are assumed
+             returnflow(ig,:)     = returnflow(ig,:) + return_swamp(ig,ib,:)
+             reinfiltration(ig,:) = reinfiltration(ig,:) + pond_drainage(ig,ib,:) &
+                   &              + flood_drainage(ig,ib,:) 
+          ENDDO !ig=1,nbpt
+       ENDDO !ib=1,nbasmax
+       
+       DO ig=1,nbpt ! This loop is maybe redundant if index 'ig' is replaced by ':'
+          returnflow(ig,:) = returnflow(ig,:)/totarea(ig)
+          reinfiltration(ig,:) = reinfiltration(ig,:)/totarea(ig)
+       ENDDO !ig=1,nbpt
+    ELSE
+       returnflow(:,:) = zero
+       reinfiltration(:,:) = zero
+    ENDIF
+
+    !! 6. Compute the net irrigation requirement from Univ of Kassel
+
+    ! This is a very low priority process and thus only applies if
+    ! there is some water left in the reservoirs after all other things.
+
+!> The computation of the irrigation is performed here.
+!> * First step
+!> In a first time, the water requirements (irrig_netereq) by the crops for their optimal growth 
+!> are calculated over each irrigated fraction (irrigated(ig)/totarea(ig)). It is the difference
+!> between the maximal water loss by the crops (transpot_mean) and the net water amount kept by the 
+!> soil (precipitation and reinfiltration). Transpot_mean is computed in the routines enerbil and 
+!> diffuco. It is derived from the effective transpiration parametrization under stress-free 
+!> conditions, called potential transpiration. Crop_coef was used by a previous parametrization of
+!> irrigation in the code. Here, its value is equal to one. The crop coefficient was constant in 
+!> space and time to represent a mean resistance of the vegetation to the potential evaporation. 
+!> Now, the term crop_coef*Epot is substituted by transpot_mean (see Guimberteau et al., 2011).
+!> * Second step
+!> We compute irrigation needs in order to supply Irrig_netereq. Water for irrigation 
+!> (irrig_actual) is withdrawn from the reservoirs. The amount of water is withdrawn in priority
+!> from the stream reservoir. If the irrigation requirement is higher than the water availability
+!> of the reservoir, water is withdrawn from the fast reservoir or, in the extreme case, from the 
+!> slow reservoir.
+!> * Third step
+!> We compute a deficit in water for irrigation. If it is positive, irrigation (depending on water
+!> availibility in the reservoirs) has not supplied the crops requirements.
+!
+    IF ( doirrigation ) THEN
+       DO ig=1,nbpt
+          !! 6.1 Compute irrigation requirements
+          IF ((vegtot(ig) .GT. min_sechiba) .AND. (humrel(ig) .LT. un-min_sechiba) .AND. &
+               & (runoff(ig,ih2o) .LT. min_sechiba) ) THEN
+             
+             irrig_netereq(ig) = (irrigated(ig) / totarea(ig) )  & 
+                  &            * MAX(zero, crop_coef * transpot_mean(ig)  & 
+                  &            - (precip(ig,ih2o)+reinfiltration(ig,ih2o)) )
+             
+          ENDIF
+          !! 6.2 Compute irrigation adduction within each basin
+          DO ib=1,nbasmax
+             IF ( routing_area(ig,ib) .GT. 0 ) THEN
+                !! 6.2.1 Water fluxes related to irrigation        
+                irrig_needs(ig,ib) = irrig_netereq(ig) * routing_area(ig,ib)
+                
+                irrig_actual(ig,ib,ih2o) = MIN(irrig_needs(ig,ib),&
+                     &                         stream_reservoir(ig,ib,ih2o) &
+                     &                         + fast_reservoir(ig,ib,ih2o) &
+                     &                         + slow_reservoir(ig,ib,ih2o))
+                
+                IF (ok_doc) THEN
+                    slow_reservoir_prec(:) = slow_reservoir(ig,ib,:) 
+                    fast_reservoir_prec(:) = fast_reservoir(ig,ib,:) 
+                    stream_reservoir_prec(:) = stream_reservoir(ig,ib,:)
+                ENDIF !(ok_doc)
+
+                
+                slow_reservoir(ig,ib,ih2o)   = MAX(zero, slow_reservoir(ig,ib,ih2o) &
+                                         &        + MIN(zero, fast_reservoir(ig,ib,ih2o) &
+                                         &             + MIN(zero, stream_reservoir(ig,ib,ih2o) &
+                                         &                  - irrig_actual(ig,ib,ih2o))))
+
+                fast_reservoir(ig,ib,ih2o)   = MAX(zero, fast_reservoir(ig,ib,ih2o) &
+                                       &          + MIN(zero, stream_reservoir(ig,ib,ih2o) &
+                                       &               - irrig_actual(ig,ib,ih2o)))
+
+                stream_reservoir(ig,ib,ih2o) = MAX(zero, stream_reservoir(ig,ib,ih2o) &
+                                       &          - irrig_actual(ig,ib,ih2o) )
+                
+                !! 6.2.2 Dissolved matter fluxes related to irrigation
+                IF (ok_doc) THEN
+                    IF (slow_reservoir_prec(ih2o) .GT. zero) THEN
+                       slow_reservoir(ig,ib,ih2o+1:nflow) = slow_reservoir(ig,ib,ih2o) &
+                                                        & * slow_reservoir(ig,ib,ih2o+1:nflow) &
+                                                        & / slow_reservoir_prec(ih2o)
+                    ELSE !(slow_reservoir_prec(ih2o) .GT. 0.0)
+                       slow_reservoir(ig,ib,ih2o+1:nflow) = zero
+                    ENDIF !(slow_reservoir_prec(ih2o) .GT. 0.0)
+                    
+                    IF (fast_reservoir_prec(ih2o) .GT. zero) THEN
+                       fast_reservoir(ig,ib,ih2o+1:nflow) = fast_reservoir(ig,ib,ih2o) &
+                                                        & * fast_reservoir(ig,ib,ih2o+1:nflow) &
+                                                        & / fast_reservoir_prec(ih2o)
+                    ELSE !(fast_reservoir_prec(ih2o).GT. 0.0)
+                       fast_reservoir(ig,ib,ih2o+1:nflow) = zero
+                    ENDIF !(fast_reservoir_prec(ih2o).GT. 0.0)                  
+                    
+                    IF (stream_reservoir_prec(ih2o) .GT. zero) THEN
+                       stream_reservoir(ig,ib,ih2o+1:nflow) = stream_reservoir(ig,ib,ih2o) &
+                                                          & * stream_reservoir(ig,ib,ih2o+1:nflow)&
+                                                          & / stream_reservoir_prec(ih2o)
+                    ELSE !(stream_reservoir_prec(ih2o) .GT. 0.0)
+                       stream_reservoir(ig,ib,ih2o+1:nflow) = zero
+                    ENDIF !(stream_reservoir_prec(ih2o) .GT. 0.0)                       
+                    
+                    irrig_actual(ig,ib,ih2o+1:nflow) = (slow_reservoir_prec(ih2o+1:nflow) &
+                                    &                - slow_reservoir(ig,ib,ih2o+1:nflow)) &
+                                    &                + (fast_reservoir_prec(ih2o+1:nflow) &
+                                    &                - fast_reservoir(ig,ib,ih2o+1:nflow)) &
+                                    &                + (stream_reservoir_prec(ih2o+1:nflow) &
+                                    &                - stream_reservoir(ig,ib,ih2o+1:nflow))
+                ENDIF !(ok_doc)
+                !! 6.2.3 Update of irrigation deficit 
+                irrig_deficit(ig,ib) = irrig_needs(ig,ib)-irrig_actual(ig,ib,ih2o)
+             ENDIF !( routing_area(ig,ib) .GT. 0 )
+          ENDDO!ib=1,nbasmax, we are still in the loop for grid boxes
+          
+          !! 6.3 Irrigation between basins within gridbox
+          ! Check if we cannot find the missing water in another basin of the same grid 
+          ! (stream reservoir only). If we find that then we create some adduction from 
+          ! that subbasin to the one where we need it for irrigation.
+          
+          !> If crops water requirements have not been supplied (irrig_deficit>0), we check 
+          !> if we cannot find the missing water in another basin of the same grid. If there 
+          !> is water in the stream reservoir of this subbasin, we create some adduction
+          !> from that subbasin to the one where we need it for irrigation.
+
+          DO ib=1,nbasmax
+
+             stream_tot = SUM(stream_reservoir(ig,:,ih2o))
+
+             DO WHILE ( irrig_deficit(ig,ib) > min_sechiba .AND. stream_tot > min_sechiba)
+                
+                fi = MAXLOC(stream_reservoir(ig,:,ih2o))
+                ib2 = fi(1)
+                !! 6.3.1 Water transfer
+                irrig_adduct(ig,ib,ih2o) = MIN(irrig_deficit(ig,ib), stream_reservoir(ig,ib2,ih2o))
+                IF (ok_doc) THEN
+                    stream_reservoir_prec(:) = stream_reservoir(ig,ib2,:)
+                ENDIF ! (ok_doc)
+                ! the updated stream reservoir has to be calculated firts for water
+                ! from the updated stream water reservoir, the matter transfer with the adduction 
+                ! flux will be calculated
+                stream_reservoir(ig,ib2,ih2o) = stream_reservoir(ig,ib2,ih2o) &
+                                   &          - irrig_adduct(ig,ib,ih2o)
+                
+                !! 6.3.2 Transfer of dissolved matter
+                IF (ok_doc) THEN
+                    IF (stream_reservoir_prec(ih2o) .GT. zero) THEN
+                    irrig_adduct(ig,ib,ih2o+1:nflow) = stream_reservoir(ig,ib2,ih2o+1:nflow) &
+                                                &    * (1-(stream_reservoir(ig,ib2,ih2o) &
+                                                &    / stream_reservoir_prec(ih2o)))
+                    stream_reservoir(ig,ib2,ih2o+1:nflow) = stream_reservoir(ig,ib2,ih2o+1:nflow) &
+                                       &                  - irrig_adduct(ig,ib,ih2o+1:nflow)
+                    ! that means the reservoir is reduced linearly to the reduction in the water 
+                    ! reservoir, the concentration remains the same
+                    ELSE !(stream_reservoir_prec(ih2o) .GT. zero)
+                    stream_reservoir(ig,ib2,ih2o+1:nflow) = zero
+                    irrig_adduct(ig,ib,ih2o+1:nflow) =zero
+                    ENDIF !(stream_reservoir_prec(ih2o) .GT. zero)
+                ENDIF ! OK_DOC
+                !! 6.3.3 Update of irrigation deficit
+                irrig_deficit(ig,ib) = irrig_deficit(ig,ib)-irrig_adduct(ig,ib,ih2o)
+             
+                stream_tot = SUM(stream_reservoir(ig,:,ih2o))
+                
+             ENDDO !WHILE ( irrig_deficit(ig,ib) > min_sechiba .AND. stream_tot > min_sechiba)
+             
+          ENDDO !basins
+          !
+       ENDDO !grid boxes
+       
+       !! 6.4 Irrigation with water from neighbouring grid boxes
+       ! If we are at higher resolution we might need to look at neighboring grid boxes to find 
+       ! the streams which can feed irrigation
+
+       !> At higher resolution (grid box smaller than 100x100km), we can import water from 
+       !> neighboring grid boxes to the one where we need it for irrigation.
+       
+       IF (is_root_prc) THEN
+          ALLOCATE(irrig_deficit_glo(nbp_glo, nbasmax), stream_reservoir_glo(nbp_glo, nbasmax, nflow), &
+               &        irrig_adduct_glo(nbp_glo, nbasmax, nflow))
+       ELSE
+          ALLOCATE(irrig_deficit_glo(0, 0), stream_reservoir_glo(0, 0, 0), irrig_adduct_glo(0, 0, 0))
+       ENDIF
+
+       CALL gather(irrig_deficit, irrig_deficit_glo)
+       CALL gather(stream_reservoir, stream_reservoir_glo)
+       CALL gather(irrig_adduct, irrig_adduct_glo)
+
+
+       IF (is_root_prc) THEN
+          !
+          DO ig=1,nbp_glo
+             ! Only work if the grid box is smaller than 100x100km. Else the piplines we build
+             ! here would be too long to be reasonable.
+             IF ( resolution_g(ig,1) < 100000. .AND. resolution_g(ig,2) < 100000. ) THEN
+                DO ib=1,nbasmax
+                   !
+                   IF ( irrig_deficit_glo(ig,ib)  > min_sechiba ) THEN
+                      !
+                      DO in=1,8
+                         ig2 = neighbours_g(ig,in)
+                         streams_around(in,:) = stream_reservoir_glo(ig2,:,ih2o)
+                         igrd(in) = ig2
+                      ENDDO
+                      !
+                      ff=MAXLOC(streams_around)
+                      ig2=igrd(ff(1))
+                      ib2=ff(2)
+                      !
+                      IF ( routing_area_glo(ig2,ib2) .GT. zero &
+                         &  .AND. stream_reservoir_glo(ig2,ib2,ih2o) .GT. zero ) THEN
+                         adduction(ih2o) = MIN(irrig_deficit_glo(ig,ib), &
+                              &            stream_reservoir_glo(ig2,ib2,ih2o))
+                         IF (ok_doc) THEN
+                            IF (stream_reservoir_glo(ig2,ib2,ih2o) .GT. zero) THEN
+                            adduction(ih2o+1:nflow) = adduction(ih2o) &
+                                      &             * (stream_reservoir_glo(ig2,ib2,ih2o+1:nflow) &      
+                                      &             / stream_reservoir_glo(ig2,ib2,ih2o))
+                            ELSE !(stream_reservoir_glo(ig2,ib2,ih2o) .GT. zero)
+                            adduction(ih2o+1:nflow) = zero
+                            ENDIF !(stream_reservoir_glo(ig2,ib2,ih2o) .GT. zero)
+                         ENDIF !ok_doc
+                         stream_reservoir_glo(ig2,ib2,:) = stream_reservoir_glo(ig2,ib2,:) &
+                                      &                  - adduction(:)
+
+                         irrig_deficit_glo(ig,ib) = irrig_deficit_glo(ig,ib) - adduction(ih2o)
+                         irrig_adduct_glo(ig,ib,:) = irrig_adduct_glo(ig,ib,:) + adduction(:)
+                      ENDIF !( routing_area_glo(ig2,ib2) .GT. 0 
+                            ! .AND. stream_reservoir_glo(ig2,ib2,ih2o) .GT. zero )
+                      
+                   ENDIF !( irrig_deficit_glo(ig,ib)  > min_sechiba )
+                   
+                ENDDO !ib=1,nbasmax
+             ENDIF !( resolution_g(ig,1) < 100000. .AND. resolution_g(ig,2) < 100000. )
+          ENDDO !ig=1,nbp_glo
+          
+       ENDIF !(is_root_prc)
+
+       CALL scatter(irrig_deficit_glo, irrig_deficit)
+       CALL scatter(stream_reservoir_glo,  stream_reservoir)
+       CALL scatter(irrig_adduct_glo, irrig_adduct)
+
+       DEALLOCATE(irrig_deficit_glo, stream_reservoir_glo, irrig_adduct_glo)
+
+    ENDIF !doirrigation
+
+    !! 7. Compute the fluxes which leave the routing scheme
+    
+    ! Lakeinflow is in Kg/dt
+    ! returnflow is in Kg/m^2/dt
+    !! 7.1 Initialize diagnostic variables
+    delsurfstor(:)   = -flood_diag(:,ih2o)-pond_diag(:,ih2o)-lake_diag(:,ih2o)
+    hydrographs(:,:) = zero
+    fast_diag(:,:)   = zero
+    slow_diag(:,:)   = zero
+    stream_diag(:,:) = zero
+    flood_diag(:,:)  =  zero
+    pond_diag(:,:)   =  zero
+    irrigation(:,:)  = zero
+    
+    !! 7.2 Aggregate diagnostic variables per grid box
+    DO ib=1,nbasmax      
+       DO ig=1,nbpt
+          IF (hydrodiag(ig,ib,ih2o) > 0 ) THEN
+             hydrographs(ig,:) = hydrographs(ig,:) + fast_flow(ig,ib,:) + slow_flow(ig,ib,:) & 
+                           & + stream_flow(ig,ib,:) 
+          ENDIF ! Maybe something similar for fluvial matter fluxes?
+          fast_diag(ig,:) = fast_diag(ig,:) + fast_reservoir(ig,ib,:)
+          slow_diag(ig,:) = slow_diag(ig,:) + slow_reservoir(ig,ib,:)
+          stream_diag(ig,:) = stream_diag(ig,:) + stream_reservoir(ig,ib,:)
+          flood_diag(ig,:) = flood_diag(ig,:) + flood_reservoir(ig,ib,:)
+          irrigation (ig,:) = irrigation (ig,:) + irrig_actual(ig,ib,:) + irrig_adduct(ig,ib,:)
+       ENDDO !ig=1,nbpt
+    ENDDO !ib=1,nbasmax
+    
+    !! 7.3 Normalize fluxes by area of the grid box
+    DO ig=1,nbpt
+       fast_diag(ig,:) = fast_diag(ig,:)/totarea(ig)
+       slow_diag(ig,:) = slow_diag(ig,:)/totarea(ig)
+       stream_diag(ig,:) = stream_diag(ig,:)/totarea(ig)
+       flood_diag(ig,:) = flood_diag(ig,:)/totarea(ig)
+       pond_diag(ig,:) = pond_reservoir(ig,:)/totarea(ig)
+       
+       irrigation(ig,:) = irrigation(ig,:)/totarea(ig)
+    
+    !! 7.4 Calculate lateral outflows from the river network
+       ! The three output types for the routing : endoheric basins, rivers and 
+       ! diffuse coastal flow.
+       
+       lakeinflow(ig,:) = transport(ig,nbasmax+1,:)
+       coastalflow(ig,:) = transport(ig,nbasmax+2,:)
+       riverflow(ig,:) = transport(ig,nbasmax+3,:)
+    ENDDO !ig=1,nbpt
+    !! 7.5 Sum up water storages in pond and floodplains as input for hydrol module
+    flood_res(:) = flood_diag(:,ih2o) + pond_diag(:,ih2o)
+    
+  END SUBROUTINE routing_flow
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_lake
+!!
+!> BRIEF        : This subroutine stores water in lakes so that it does not cycle through the runoff.
+!!                For the moment it only works for endoheric lakes but I can be extended in the future.
+!!
+!! DESCRIPTION (definitions, functional, design, flags): The return flow to the soil moisture reservoir
+!! is based on a maximum lake evaporation rate (maxevap_lake). \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_lake(nbpt, dt_routing, lakeinflow, humrel, return_lakes)
+    !
+    IMPLICIT NONE
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                      :: nbpt         !! Domain size (unitless)
+    REAL(r_std), INTENT (in)                        :: dt_routing   !! Routing time step (s)
+    REAL(r_std), INTENT(in), DIMENSION(nbpt,nflow)  :: lakeinflow   !! Water inflow to the lakes 
+                                                                    !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in), DIMENSION(nbpt)        :: humrel       !! Soil moisture stress, root extraction potential (unitless)
+
+    !! 0.2 Output variables 
+    REAL(r_std), INTENT(out), DIMENSION(nbpt,nflow) :: return_lakes !! Water from lakes flowing back into soil moisture 
+                                                                    !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+
+    !! 0.3 Local variables  
+    INTEGER(i_std)                                  :: ig, iflow    !! Indices (unitless)
+    REAL(r_std)                                     :: refill       !! Potential amount of water infiltrating into the lake soil 
+                                                                    !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std)                                     :: total_area   !! Sum of all the surfaces of the basins @tex $(m^2})$ @endtex
+
+ !! 1. Calculate infiltration and update lake reservoir
+    DO ig=1,nbpt
+       
+       total_area = SUM(routing_area(ig,:))
+       !! 1.1 Update lake reservoir with inflows
+       lake_reservoir(ig,:) = lake_reservoir(ig,:) + lakeinflow(ig,:)
+       
+       !! 1.2 Calculate inflitration in lakes (returnflow to soil column)
+       !! 1.2.1 Infiltration of water
+       refill = MAX(zero, maxevap_lake * (un - humrel(ig)) * dt_routing * total_area)
+       return_lakes(ig,ih2o) = MIN(refill, lake_reservoir(ig,ih2o))
+       !! 1.2.2 Infiltration of dissolved matter
+       IF (ok_doc) THEN
+           IF (lake_reservoir(ig,ih2o).GT.0.0) THEN
+                 return_lakes(ig,ih2o+1:nflow)=return_lakes(ig,ih2o) & 
+                                           &  * lake_reservoir(ig,ih2o+1:nflow) &
+                                           &  / lake_reservoir(ig,ih2o)     
+           ELSE !  (lake_reservoir(ig,ih2o).GT.0.0)
+                 return_lakes(ig,ih2o+1:nflow)=zero
+           ENDIF ! (lake_reservoir(ig,ih2o).GT.0.0)
+       ENDIF ! (ok_doc) 
+       !! 1.3 Update of lake reservoir with returnflow
+       lake_reservoir(ig,:) = lake_reservoir(ig,:) - return_lakes(ig,:) 
+       
+       !! 1.4 Scaling returnflow to grid box
+       IF ( doswamps ) THEN
+          return_lakes(ig,:) = return_lakes(ig,:)/total_area
+       ELSE
+          return_lakes(ig,:) = zero
+       ENDIF
+       !! 1.5 Scaling lake reservoir to grid box
+       ! This is the volume of the lake scaled to the entire grid.
+       ! It would be batter to scale it to the size of the lake
+       ! but this information is not yet available.
+       lake_diag(ig,:) = lake_reservoir(ig,:)/total_area
+    
+    ENDDO !ig=1,nbpt
+  END SUBROUTINE routing_lake
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_diagnostic_p
+!!
+!> BRIEF         This parallelized subroutine gives a diagnostic of the basins used
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_diagnostic_p(nbpt, index, lalo, resolution, contfrac, hist_id, hist2_id)
+    !
+    IMPLICIT NONE
+    
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)      :: nbpt               !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)      :: index(nbpt)        !! Indices of the points on the map (unitless)
+    REAL(r_std), INTENT(in)         :: lalo(nbpt,2)       !! Vector of latitude and longitudes (beware of the order !)
+    REAL(r_std), INTENT(in)         :: resolution(nbpt,2) !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)         :: contfrac(nbpt)     !! Fraction of land in each grid box (unitless;0-1)
+    INTEGER(i_std),INTENT (in)      :: hist_id            !! Access to history file (unitless)
+    INTEGER(i_std),INTENT (in)      :: hist2_id           !! Access to history file 2 (unitless)
+    !
+!! LOCAL VARIABLES
+    REAL(r_std), DIMENSION(nbpt)    :: nbrivers           !! Number of rivers in the grid (unitless)
+    REAL(r_std), DIMENSION(nbpt)    :: basinmap           !! Map of basins (unitless)
+    REAL(r_std), DIMENSION(nbp_glo) :: nbrivers_g         !! Number of rivers in the grid (unitless)
+    REAL(r_std), DIMENSION(nbp_glo) :: basinmap_g         !! Map of basins (unitless)
+
+    routing_area => routing_area_glo  
+    topo_resid => topo_resid_glo
+    route_togrid => route_togrid_glo
+    route_tobasin => route_tobasin_glo
+    route_nbintobas => route_nbintobas_glo
+    global_basinid => global_basinid_glo
+    hydrodiag=>hydrodiag_glo
+    hydroupbasin=>hydroupbasin_glo
+    
+    IF (is_root_prc) CALL routing_diagnostic(nbp_glo, index_g, lalo_g, resolution_g, contfrac_g, nbrivers_g,basinmap_g)
+
+    routing_area => routing_area_loc  
+    topo_resid => topo_resid_loc
+    route_togrid => route_togrid_loc
+    route_tobasin => route_tobasin_loc
+    route_nbintobas => route_nbintobas_loc
+    global_basinid => global_basinid_loc
+    hydrodiag=>hydrodiag_loc
+    hydroupbasin=>hydroupbasin_loc
+    
+    CALL scatter(nbrivers_g,nbrivers)
+    CALL scatter(basinmap_g,basinmap)
+    CALL scatter(hydrodiag_glo,hydrodiag_loc)
+    CALL scatter(hydroupbasin_glo,hydroupbasin_loc)
+        
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite(hist_id, 'basinmap', 1, basinmap, nbpt, index)
+       CALL histwrite(hist_id, 'nbrivers', 1, nbrivers, nbpt, index)
+    ELSE
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite(hist2_id, 'basinmap', 1, basinmap, nbpt, index)
+          CALL histwrite(hist2_id, 'nbrivers', 1, nbrivers, nbpt, index)
+       ELSE
+       ENDIF
+    ENDIF
+    
+        
+  END SUBROUTINE routing_diagnostic_p
+
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_diagnostic
+!!
+!> BRIEF         This non-parallelized subroutine gives a diagnostic of the basins used. This produces some information 
+!!               on the rivers which are being diagnosed.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : As not all rivers can be monitored in the model, we will only
+!! archive num_largest rivers. In this routine we will diagnose the num_largest largest rivers and print to the standard
+!! output the names of these basins and their area. The list of names of these largest rivers are taken from a list coded in the 
+!! routine routing_names. As this standard output is not sufficient, we will also write it to a netCDF file with the routine 
+!! routing_diagncfile. It is important to keep for diagnostic the fraction of the largest basins in each grid box and keep information
+!! how they are linked one to the other.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): No output variables.
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_diagnostic(nbpt, l_index, lalo, resolution, contfrac, nbrivers, basinmap)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                   :: nbpt                !! Domain size  (unitless)
+    INTEGER(i_std), INTENT(in)                   :: l_index(nbpt)       !! Indices of the points on the map (unitless)
+    REAL(r_std), INTENT(in)                      :: lalo(nbpt,2)        !! Vector of latitude and longitudes (beware of the order !) 
+    REAL(r_std), INTENT(in)                      :: resolution(nbpt,2)  !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)                      :: contfrac(nbpt)      !! Fraction of land in each grid box (unitless;0-1)
+    !
+!! OUTPUT VARIABLES
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)    :: nbrivers            !! Number of rivers in the grid (unitless)
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)    :: basinmap            !! Map of basins (unitless)
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std), DIMENSION(nbpt,nbasmax)      :: outids              !! IDs of river to which this basin contributes (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: pts                 !! List the points belonging to the basin (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: ptbas               !! List the basin number for this point (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: outpt               !! Outflow point for each basin (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)    :: nb_pts              !! Number of points in the basin (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: totarea             !! Total area of basin @tex $(m^2})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: tmparea             !! 
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)    :: topids              !! The IDs of the first num_largest basins (unitless)
+    CHARACTER(LEN=25), ALLOCATABLE, DIMENSION(:) :: basin_names         !! Names of the rivers (unitless)
+    CHARACTER(LEN=25)                            :: name_str            !!
+    !
+    LOGICAL                                      :: river_file          !! Choose to write a description of the rivers (true/false)
+    CHARACTER(LEN=80)                            :: river_file_name     !! Filename in which we write the description of the rivers (unitless)
+    !
+    CHARACTER(LEN=25), ALLOCATABLE, DIMENSION(:)  :: sorted_names       !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: streams_nb         !! Number of streams in basin (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: streams_avehops    !! Average number of hops in streams (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: streams_minhops    !! Minimum number of hops in streams (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: streams_maxhops    !! Minimum number of hops in streams (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)        :: streams_resid      !! Average residence time
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lbasin_area        !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lbasin_uparea      !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: lrivercode         !!
+    !
+    INTEGER(i_std)                                :: ig, ib, og, ob, ign, ibn, ff(1), ic, icc, nb_small, idbas, slen, ii !! Indices (unitless)
+    CHARACTER(LEN=2)                              :: nn                 !!
+    INTEGER(i_std)                                :: name_found         !!
+    !
+    REAL(r_std)                                   :: averesid           !!
+    REAL(r_std), DIMENSION(nbasmax)               :: tmpbas             !!
+    REAL(r_std), DIMENSION(nbpt,nbasmax)          :: areaupbasin        !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: sortedrivs         !!
+    !
+    ! Variables for the river coding
+    !
+    INTEGER(i_std)                               :: longest_river       !!
+    INTEGER(i_std)                               :: nbmax               !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: allstreams          !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: upstreamchange      !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)    :: tstreams, tslen, tpts, tptbas, tcode !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: tuparea             !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: tupstreamchange     !!
+    !
+    LOGICAL                                      :: err_nbpt_grid_basin !! (true/false)
+    LOGICAL                                      :: err_basin_number    !! (true/false)
+    !
+    !
+    ALLOCATE(pts(num_largest, nbpt))
+    ALLOCATE(ptbas(num_largest, nbpt))
+    ALLOCATE(outpt(num_largest, 2))
+    ALLOCATE(nb_pts(num_largest))
+    ALLOCATE(totarea(num_largest), tmparea(num_largest))
+    ALLOCATE(topids(num_largest))
+    ALLOCATE(sortedrivs(num_largest))
+    ALLOCATE(sorted_names(num_largest))
+    ALLOCATE(streams_nb(num_largest), streams_avehops(num_largest), streams_minhops(num_largest))
+    ALLOCATE(streams_maxhops(num_largest))
+    ALLOCATE(streams_resid(num_largest))
+    !
+    ALLOCATE(lbasin_area(num_largest,nbpt), lbasin_uparea(num_largest,nbpt), lrivercode(num_largest,nbpt))
+    !
+    IF ( .NOT. is_root_prc) THEN
+       WRITE(numout,*) "routing_diagnostic is not suitable for running in parallel"
+       WRITE(numout,*) "We are here on a non root processor. is_root_prc = ", is_root_prc
+       WRITE(numout,*) "STOP from routing_diagnostic"
+       STOP
+    ENDIF
+    ! 
+    !
+    !Config Key   = RIVER_DESC
+    !Config Desc  = Writes out a description of the rivers
+    !Config If    = RIVER_ROUTING
+    !Config Def   = n
+    !Config Help  = This flag allows to write out a file containing the list of 
+    !Config         rivers which are beeing simulated. It provides location of outflow
+    !Config         drainage area, name and ID.
+    !Config Units = [FLAG]
+    !
+    river_file=.FALSE.
+    CALL getin('RIVER_DESC', river_file)
+    !
+    !Config Key   = RIVER_DESC_FILE
+    !Config Desc  = Filename in which we write the description of the rivers. If suffix is ".nc" a netCDF file is created
+    !Config If    = RIVER_DESC
+    !Config Def   = river_desc.txt
+    !Config Help  = File name where we will write the information. If the suffix is ".nc" a netCDF file is generated. Else
+    !Config         a simple text file will contain some information. The netCDF file is valuable for post-processing the
+    !               data as it will contain the fraction of the large basins in each grid box.
+    !Config Units = [FILE]
+    !
+    river_file_name="river_desc.txt"
+    CALL getin('RIVER_DESC_FILE', river_file_name)
+    !
+    !
+    ! First we get the list of all river outflow points
+    ! We work under the assumption that we only have num_largest basins finishing with
+    ! nbasmax+3. This is checked in routing_truncate.
+    !
+    nb_small = 1
+    outpt(:,:) = -1
+    ic = 0
+    DO ig=1,nbpt
+       DO ib=1,nbasmax
+          ign = route_togrid(ig, ib)
+          ibn = route_tobasin(ig, ib)
+          IF ( ibn .EQ. nbasmax+3) THEN
+             ic = ic + 1
+             outpt(ic,1) = ig
+             outpt(ic,2) = ib
+             !
+             ! Get the largest id of the basins we call a river. This is
+             ! to extract the names of all rivers.
+             !
+             IF ( global_basinid(ig,ib) > nb_small ) THEN
+                nb_small = global_basinid(ig,ib)
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    nb_small = MIN(nb_small, 349)
+    !
+    ALLOCATE(basin_names(nb_small))
+    !
+    CALL routing_names(nb_small, basin_names)
+    !
+    ! Go through all points and basins to see if they outflow as a river and store the
+    ! information needed in the various arrays.
+    !
+    nb_pts(:) = 0
+    totarea(:) = zero
+    hydrodiag(:,:,:) = 0
+    areaupbasin(:,:) = zero
+    outids(:,:) = -1
+    ob = -1
+    og = -1
+    lbasin_area(:,:) = zero
+    lbasin_uparea(:,:) = zero
+    longest_river = 0
+    !
+    err_nbpt_grid_basin = .FALSE.
+    loopgridbasin : DO ig=1,nbpt
+       !
+       DO ib=1,nbasmax
+          IF ( routing_area(ig,ib) .GT. zero ) THEN
+             ic = 0
+             ign = ig
+             ibn = ib
+             ! Locate outflow point
+             DO WHILE (ibn .GT. 0 .AND. ibn .LE. nbasmax .AND. ic .LT. nbasmax*nbpt)
+                ic = ic + 1
+                og = ign
+                ob = ibn
+                ign = route_togrid(og, ob)
+                ibn = route_tobasin(og, ob)
+                areaupbasin(og, ob) = areaupbasin(og, ob) + routing_area(ig,ib)
+             ENDDO
+             !
+             longest_river = MAX(longest_river, ic)
+             !
+             ! Now that we have an outflow check if it is one of the num_largest rivers. 
+             ! In this case we keeps the location so we diagnose it.
+             !
+             IF ( ibn .EQ. nbasmax + 3) THEN
+                DO icc = 1,num_largest
+                   IF ( outpt(icc,1) .EQ. og .AND. outpt(icc,2) .EQ. ob ) THEN
+                      !
+                      ! We only keep this point for our map if it is large enough.
+                      !
+                      nb_pts(icc) = nb_pts(icc) + 1
+                      !
+                      !
+                      IF ( nb_pts(icc) > nbpt ) THEN
+                         err_nbpt_grid_basin = .TRUE.
+                         EXIT loopgridbasin
+                      ENDIF
+                      !
+                      pts(icc, nb_pts(icc)) = ig
+                      ptbas(icc, nb_pts(icc)) = ib
+                      totarea(icc) = totarea(icc) + routing_area(ig,ib)
+                      !
+                      lbasin_area(icc,nb_pts(icc)) = routing_area(ig,ib)
+                      !
+                      ! ID of the river is taken from the last point before the outflow.
+                      topids(icc) = global_basinid(og,ob)
+                      outids(ig,ib) = global_basinid(og,ob)
+                      !
+                      ! On this gridbox and basin we will diagnose the hydrograph
+                      !
+                      hydrodiag(ig, ib, :) = 1
+                      !
+                   ENDIF
+                ENDDO
+             ENDIF
+          ENDIF
+          !
+       ENDDO
+       !
+    ENDDO loopgridbasin
+    !
+    IF ( err_nbpt_grid_basin ) THEN
+       WRITE(numout, *) "routing_diagnostic : The number of grid points in basin ", icc
+       WRITE(numout, *) "routing_diagnostic : is larger than anticiped. "
+       CALL ipslerr(3, 'routing_diagnostic', 'We are heading for a out of bounds in arrays pts, ptsbas and lbasin_area.',&
+                     & 'Increase the last dimension of these arrays.','')
+    ENDIF
+    !
+    ! Now we decide which points we will keep from the largest basins
+    !
+    ! Temporary fix
+    route_nbintobas(:,:) = 0
+    !
+    basinmap(:) = zero
+    DO ig=1,nbpt
+       !
+       ! Look for the dominant basin in this grid. This information only affects some
+       ! diagnostics : hydrographs and saved area upstream.
+       !
+       icc = 0
+       idbas = -1
+       !
+       DO ib=1,nbasmax
+          IF ( outids(ig,ib) > 0 ) THEN
+             IF ( COUNT(outids(ig,:) == outids(ig,ib)) > icc ) THEN
+                icc = COUNT(outids(ig,:) == outids(ig,ib))
+                idbas = outids(ig,ib)
+             ENDIF
+          ENDIF
+       ENDDO
+       !
+       ! If we have found a point from the large basins and decided which one
+       ! takes over this grid then we note it on the map.
+       ! Clean-up a little the hydrodiag array
+       !
+       IF ( idbas > 0 ) THEN
+          basinmap(ig) = REAL(idbas, r_std)
+       ENDIF
+       !
+       ! Now place the hydrograph diagnostic on the point closest to the
+       ! ocean.
+       !
+       tmpbas(:) = zero
+       DO ib=1,nbasmax
+          IF ( outids(ig,ib) .EQ. idbas) THEN
+             tmpbas(ib) = areaupbasin(ig,ib)
+          ENDIF
+       ENDDO
+       hydrodiag(ig,:,:) = 0
+       ff=MAXLOC(tmpbas)
+       hydrodiag(ig,ff(1),:) = 1
+       hydroupbasin(ig) = areaupbasin(ig,ff(1))
+       !
+    ENDDO
+    !
+    !
+    !
+    tmparea(:) = totarea(:)
+    DO icc = 1, num_largest
+       ff = MAXLOC(tmparea)
+       sortedrivs(icc) = ff(1)
+       tmparea(ff(1)) = 0.0
+    ENDDO
+    !
+    ! Diagnose the complexity of the basins obtained and determine their code in the Pfafstetter system
+    !
+    nbmax=MAXVAL(nb_pts)
+    ALLOCATE(allstreams(nbmax, longest_river), upstreamchange(nbmax, longest_river))
+    ALLOCATE(tstreams(longest_river), tupstreamchange(longest_river))
+    ALLOCATE(tslen(nbmax), tpts(nbmax), tptbas(nbmax), tuparea(nbmax))
+    ALLOCATE(tcode(nbmax))
+    !
+    DO icc = 1, num_largest
+       !
+       ! Work through the largest basins
+       !
+       idbas = sortedrivs(icc)
+       !
+       streams_nb(idbas) = 0
+       streams_avehops(idbas) = 0
+       streams_minhops(idbas) = undef_int
+       streams_maxhops(idbas) = 0
+       streams_resid(idbas) = zero
+       tslen(:) = 0
+       !
+       allstreams(:,:) = 0
+       upstreamchange(:,:) = zero
+       !
+       DO ii=1,nb_pts(idbas)
+          !
+          ig = pts(idbas, ii)
+          ib = ptbas(idbas, ii)
+          !
+          lbasin_uparea(idbas,ii) = areaupbasin(ig,ib)
+          !
+          slen = 0
+          ign = ig
+          ibn = ib
+          og = ig
+          ob = ib
+          !
+          averesid = zero
+          tupstreamchange(:) = zero
+          ! go to outflow point to count the number of hops
+          DO WHILE (ibn .GT. 0 .AND. ibn .LE. nbasmax)
+             ! Store data
+             slen = slen + 1
+             tstreams(slen) = ign
+             tupstreamchange(slen) = areaupbasin(ign,ibn)-areaupbasin(og,ob)
+             ! Move to next point
+             og = ign
+             ob = ibn
+             ign = route_togrid(og, ob)
+             ibn = route_tobasin(og, ob)
+             averesid = averesid + topo_resid(og, ob)**2
+          ENDDO
+          !
+          allstreams(ii,1:slen) = tstreams(slen:1:-1)
+          upstreamchange(ii,1:slen) = tupstreamchange(slen:1:-1)
+          tslen(ii) = slen
+          !
+          ! Save diagnostics
+          !
+          streams_nb(idbas) = streams_nb(idbas) + 1
+          streams_avehops(idbas) = streams_avehops(idbas) + slen
+          streams_resid(idbas) = streams_resid(idbas) + SQRT(averesid)
+          IF ( slen < streams_minhops(idbas) ) THEN
+             streams_minhops(idbas) = slen
+          ENDIF
+          IF ( slen > streams_maxhops(idbas) ) THEN
+             streams_maxhops(idbas) = slen
+          ENDIF
+          !
+       ENDDO
+       ! build the average
+       IF ( streams_nb(idbas) > 0 ) THEN
+          streams_avehops(idbas) = streams_avehops(idbas)/streams_nb(idbas)
+          streams_resid(idbas) = streams_resid(idbas)/REAL(streams_nb(idbas), r_std)
+       ELSE
+          ! River without streams ... very rare but happens
+          streams_avehops(idbas) = zero
+          streams_resid(idbas) = zero
+          streams_maxhops(idbas) = zero
+          streams_minhops(idbas) = zero
+       ENDIF
+       !
+       !
+       ii=nb_pts(idbas)
+       tpts(:) = 0
+       tpts(1:ii) = pts(idbas,1:ii)
+       tptbas(:) = 0
+       tptbas(1:ii) = ptbas(idbas,1:ii)
+       tuparea(:) = 0
+       tuparea(1:ii) = lbasin_uparea(idbas,1:ii)
+       !
+       CALL routing_diagcode(ii, tpts, tptbas, tuparea, tslen, MAXVAL(tslen), allstreams, upstreamchange, tcode)  
+       !
+       lrivercode(idbas,:) = 0
+       lrivercode(idbas,1:ii) = tcode(1:ii)
+       !
+    ENDDO
+    !
+    ! Create the sorted list of names
+    !
+    err_basin_number = .FALSE.
+    DO icc = 1, num_largest
+       !
+       ib=sortedrivs(icc)
+       !
+       IF ( topids(ib) .GT. nb_small ) THEN
+          IF (topids(ib) <= 99 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I2.2)') topids(ib)
+          ELSE IF (topids(ib) <= 999 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I3.3)') topids(ib)
+          ELSE IF (topids(ib) <= 9999 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I4.4)') topids(ib)
+          ELSE IF (topids(ib) <= 99999 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I5.5)') topids(ib)
+          ELSE IF (topids(ib) <= 999999 ) THEN
+             WRITE(sorted_names(icc), '("Nb_",I6.6)') topids(ib)
+          ELSE
+             err_basin_number = .TRUE.
+             EXIT
+          ENDIF
+
+       ELSE
+          sorted_names(icc) = basin_names(topids(ib))
+       ENDIF
+       !
+    ENDDO
+    !
+    IF ( err_basin_number ) THEN
+       CALL ipslerr(3, 'routing_diagnostic', 'We found a basin number larger than 999999.',&
+            & 'This is impossible. Please verify your configuration.','')
+    ENDIF
+    !
+    ! Check for doubles and rename if needed
+    !
+    DO icc = 1, num_largest
+       name_found=0
+       DO ic=1, num_largest
+          IF ( TRIM(sorted_names(icc)) == TRIM(sorted_names(ic)) ) THEN
+             name_found = name_found + 1
+          ENDIF
+       ENDDO
+       !
+       IF ( name_found > 1 ) THEN
+          DO ic=num_largest,1,-1
+             IF ( TRIM(sorted_names(icc)) == TRIM(sorted_names(ic)) ) THEN
+                IF ( name_found > 1 ) THEN
+                   WRITE(nn,'(I2)')  name_found
+                   IF (name_found < 10) nn(1:1) = '0'
+                   sorted_names(ic) = TRIM(sorted_names(ic))//nn
+                   name_found = name_found - 1
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDIF
+       !
+    ENDDO
+    !
+    ! Print to stdout on ROOT_PROC the diagnostics for the largest basins we have found.
+    !
+    DO icc = 1, num_largest
+       !
+       IF ( nb_pts(sortedrivs(icc)) .GT. 2 ) THEN
+          name_str = sorted_names(icc)
+          WRITE(numout,'("Basin ID ", I5," ", A15, " Area [km^2] : ", F13.4, " Nb points : ", I4)')&
+               & topids(sortedrivs(icc)), name_str(1:15), totarea(sortedrivs(icc))/1.e6,  nb_pts(sortedrivs(icc))
+          ENDIF
+          !
+    ENDDO
+    !
+    ! Save some of the basin information into files.
+    !
+    IF ( river_file ) THEN
+
+       IF ( INDEX(river_file_name,".nc") > 1 ) THEN
+
+          CALL routing_diagncfile(river_file_name, nbpt, lalo, nb_pts, topids, sorted_names, sortedrivs, &
+               &                  pts, lbasin_area, lbasin_uparea, lrivercode, outpt, streams_nb, streams_avehops, &
+               &                  streams_minhops, streams_maxhops, streams_resid)
+
+       ELSE
+
+          OPEN(diagunit, FILE=river_file_name)
+          WRITE(diagunit,'(A)') "Basin ID, Area [km^2], Nb points, Lon and Lat of outflow"
+          WRITE(diagunit,'(A)') "Nb streams, total number of hops, min, ave and max number of hops per stream"
+          !
+          DO icc = 1, num_largest
+             !
+             IF ( nb_pts(sortedrivs(icc)) .GT. 2 ) THEN
+                !
+                name_str = sorted_names(icc)
+                !
+                WRITE(diagunit,'(I5,A25,F14.5,I5,2F9.2)') topids(sortedrivs(icc)), name_str(1:15), totarea(sortedrivs(icc))/1.e6, &
+                     &    nb_pts(sortedrivs(icc)), lalo(outpt(sortedrivs(icc),1),2), lalo(outpt(sortedrivs(icc),1),1)
+                WRITE(diagunit,'(5I9,F16.4)') streams_nb(sortedrivs(icc)), &
+                     & streams_avehops(sortedrivs(icc))*streams_nb(sortedrivs(icc)), &
+                     & streams_minhops(sortedrivs(icc)), &
+                     & streams_avehops(sortedrivs(icc)), &
+                     & streams_maxhops(sortedrivs(icc)), streams_resid(sortedrivs(icc))
+                !
+             ENDIF
+             !
+          ENDDO
+          !
+          CLOSE(diagunit)
+          !
+       ENDIF
+       !
+    ENDIF
+    !
+    !
+    nbrivers(:) = zero
+    DO ig=1,nbpt
+       nbrivers(ig) = COUNT(route_tobasin(ig,1:nbasmax) == nbasmax+3)
+    ENDDO
+    DO ig=1,nbpt
+       IF ( nbrivers(ig) > 1 ) THEN
+          WRITE(numout,*) 'Grid box ', ig, ' has ', NINT(nbrivers(ig)), ' outflow points.'
+          WRITE(numout,*) 'The rivers which flow into the ocean at this point are :'
+          DO icc=1,nbasmax
+             IF ( route_tobasin(ig,icc) == nbasmax+3) THEN
+                IF ( global_basinid(ig,icc) <= nb_small ) THEN
+                   WRITE(numout,*) 'ID = ',global_basinid(ig,icc), ' Name = ', basin_names(global_basinid(ig,icc))
+                ELSE
+                   WRITE(numout,*) 'ID = ',global_basinid(ig,icc), ' Problem ===== ID is larger than possible'
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDIF
+    ENDDO
+    !
+    WRITE(numout,*) 'Maximum topographic index :', MAXVAL(topo_resid)
+    ic = COUNT(topo_resid .GT. 0.)
+    WRITE(numout,*) 'Mean topographic index :', SUM(topo_resid, MASK=topo_resid .GT. zero)/ic
+    WRITE(numout,*) 'Minimum topographic index :', MINVAL(topo_resid, MASK=topo_resid .GT. zero)
+    !
+    DEALLOCATE(pts)
+    DEALLOCATE(outpt)
+    DEALLOCATE(nb_pts)
+    DEALLOCATE(totarea, tmparea)
+    DEALLOCATE(streams_nb, streams_avehops, streams_minhops, streams_maxhops)
+    !
+    DEALLOCATE(lbasin_area, lbasin_uparea, lrivercode)
+    !
+    DEALLOCATE(allstreams)
+    DEALLOCATE(tstreams)
+    DEALLOCATE(tslen, tpts, tptbas, tuparea)
+    DEALLOCATE(tcode)
+    !
+    WRITE(numout,*) 'Maximum topographic index :', MAXVAL(topo_resid)
+    ic = COUNT(topo_resid .GT. 0.)
+    WRITE(numout,*) 'Mean topographic index :', SUM(topo_resid, MASK=topo_resid .GT. 0.)/ic
+    WRITE(numout,*) 'Minimum topographic index :', MINVAL(topo_resid, MASK=topo_resid .GT. 0.)
+    !
+    !
+  END SUBROUTINE routing_diagnostic
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_diagcode
+!!
+!> BRIEF       This subroutine determines the code in the Pfafstetter system for all points
+!!              within the given catchment.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): streamcode
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_diagcode(ip, tpts, tpbas, tuparea, tslen, ls, allstreams, upstreamchange, streamcode)  
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                   :: ip             !!
+    INTEGER(i_std), INTENT(in)                   :: ls             !!
+    INTEGER(i_std), DIMENSION(ip), INTENT(in)    :: tpts           !!
+    INTEGER(i_std), DIMENSION(ip), INTENT(in)    :: tpbas          !!
+    REAL(r_std), DIMENSION(ip), INTENT(in)       :: tuparea        !!
+    INTEGER(i_std), DIMENSION(ip), INTENT(in)    :: tslen          !!
+    INTEGER(i_std), DIMENSION(ip,ls), INTENT(in) :: allstreams     !!
+    REAL(r_std), DIMENSION(ip,ls), INTENT(in)    :: upstreamchange !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), DIMENSION(ip), INTENT(out)   :: streamcode     !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                               :: ilev, cntsubbas, ib, ic, i, it, ilevmax, imaxlen, nbzero !!
+    INTEGER(i_std)                               :: tstreamcode(ip)!!
+    INTEGER(i_std)                               :: indsubbas(ip)  !!
+    INTEGER(i_std)                               :: iw(ip)         !!
+    INTEGER(i_std)                               :: tdiff(ip)      !!
+    INTEGER(i_std)                               :: tmpjunc(4)     !!
+    INTEGER(i_std)                               :: junction(4)    !!
+    INTEGER(i_std)                               :: ff(1)          !!
+    INTEGER(i_std)                               :: ll             !!
+    REAL(r_std)                                  :: chguparea(ip)  !!
+    REAL(r_std)                                  :: largest        !!
+    !
+    streamcode(:) = 0
+    !
+    ! If we accept 4 grid boxes per coded basin then per level we need at least
+    ! 4*9=36 boxes.
+    !
+    ilevmax = 0
+    it = ip
+    DO WHILE (it >= 36)
+       ilevmax = ilevmax+1
+       it = it/9
+    ENDDO
+    !
+    DO ilev=1,ilevmax
+       !
+       ! Count number of sub-basins we already have
+       !
+       cntsubbas=0
+       tstreamcode(:) = streamcode(:)
+       DO WHILE ( COUNT(tstreamcode(:) >= 0) > 0 )
+         cntsubbas=cntsubbas+1
+         indsubbas(cntsubbas) = MAXVAL(tstreamcode(:))
+         WHERE ( tstreamcode(:) == indsubbas(cntsubbas) ) tstreamcode = -1
+       ENDDO
+       !
+       ! Go through all these basins in order to find the next Pfafstetter numbers
+       !
+       DO ib=1,cntsubbas
+          !
+          ! Get all the streams which have the current Pfadstetter number
+          !
+          it=0
+          DO ic=1,ip
+             IF ( streamcode(ic) == indsubbas(ib) ) THEN
+                it =it+1
+                iw(it)=ic 
+             ENDIF
+          ENDDO
+          !
+          ! Which is the longest stream in this basin ?
+          !
+          ff=MAXLOC(tslen(iw(1:it)))
+          imaxlen=iw(ff(1))
+          chguparea(:) = zero
+          chguparea(1:tslen(imaxlen)) = upstreamchange(imaxlen, 1:tslen(imaxlen))
+          !
+          IF ( COUNT(chguparea(1:tslen(imaxlen)) > 0) < 4 ) THEN
+             !
+             ! If this subbasin is too small we just set all points to zero
+             !
+             DO i=1,it
+                streamcode(iw(i)) = streamcode(iw(i))*10
+             ENDDO
+          ELSE
+             ! 
+             ! Else do the Pfafstetter numbering
+             ! 
+             !
+             ! Where do we have the 4 largest change in upstream area on this stream.
+             ! This must be the confluence of 2 rivers and thus a junction point.
+             !
+             largest=pi*R_Earth*R_Earth
+             DO i=1,4
+                ff = MAXLOC(chguparea(1:tslen(imaxlen)), MASK = chguparea(1:tslen(imaxlen)) < largest)
+                tmpjunc(i) = ff(1)
+                largest=chguparea(tmpjunc(i))
+             ENDDO
+             ! sort junctions to go from the outflow up-stream
+             ff(1)=0
+             DO i=1,4
+                junction(i) = MINVAL(tmpjunc, MASK=tmpjunc > ff(1))
+                ff(1) = junction(i)
+             ENDDO
+             !
+             ! Find all streams which are identical up to that junction and increase their code accordingly 
+             !
+             DO i=1,it
+                ll=MIN(tslen(imaxlen),tslen(iw(i)))
+                tdiff(1:ll) = allstreams(imaxlen,1:ll)-allstreams(iw(i),1:ll)
+                nbzero = COUNT(tdiff(1:ll) == 0)
+                IF (nbzero < junction(1) ) THEN
+                   ! Before first of the 4 largest basins
+                   streamcode(iw(i)) = streamcode(iw(i))*10+1
+                ELSE IF (nbzero == junction(1) ) THEN
+                   ! Stream part of the first largest basin
+                   streamcode(iw(i)) = streamcode(iw(i))*10+2
+                ELSE IF (nbzero < junction(2) ) THEN
+                   ! Between first and second stream
+                   streamcode(iw(i)) = streamcode(iw(i))*10+3
+                ELSE IF (nbzero == junction(2) ) THEN
+                   ! Stream part of the second basin
+                   streamcode(iw(i)) = streamcode(iw(i))*10+4
+                ELSE IF (nbzero < junction(3) ) THEN
+                   ! In between stream 2 and 3
+                   streamcode(iw(i)) = streamcode(iw(i))*10+5
+                ELSE IF (nbzero == junction(3) ) THEN
+                   ! Part of 3rd basin
+                   streamcode(iw(i)) = streamcode(iw(i))*10+6
+                ELSE IF (nbzero < junction(4) ) THEN
+                   ! In between 3 and 4th basins
+                   streamcode(iw(i)) = streamcode(iw(i))*10+7
+                ELSE IF (nbzero == junction(4) ) THEN
+                   ! Final of the 4 largest basins
+                   streamcode(iw(i)) = streamcode(iw(i))*10+8
+                ELSE
+                   ! The rest of the points and also the basin of the longest stream
+                   streamcode(iw(i)) = streamcode(iw(i))*10+9
+                ENDIF
+             ENDDO
+          ENDIF
+       ENDDO
+       !
+    ENDDO
+    !
+    !
+  END SUBROUTINE routing_diagcode
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_diagncfile
+!!
+!> BRIEF         This subroutine creates a netCDF file containing all the informations
+!!                on the largest rivers which can be used for a refined analysis. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_diagncfile(river_file_name, nbpt, lalo, nb_pts, topids, sorted_names, sortedrivs, &
+       &       lbasin_index, lbasin_area, lbasin_uparea, lrivercode, outpt, streams_nb, streams_avehops, &
+       &       streams_minhops, streams_maxhops, streams_resid)
+    !
+    USE netcdf
+    !
+    IMPLICIT NONE
+    !
+    !
+!! INPUT VARIABLES
+    REAL(r_std), INTENT(in)                     :: lalo(nbpt,2)             !! Vector of latitude and longitudes (beware of the order !)
+
+!! LOCAL VARIABLES
+    CHARACTER(LEN=80)                           :: river_file_name          !! Filename in which we write the description of the rivers (1)
+    INTEGER(i_std)                              :: nbpt                     !! Domain size  (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: nb_pts                   !! Number of points in the basin (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: topids                   !! The IDs of the first num_largest basins (unitless)
+    CHARACTER(LEN=25), DIMENSION(num_largest)   :: sorted_names             !! Names of the basins to be put into the file (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: sortedrivs               !!
+    INTEGER(i_std), DIMENSION(num_largest,nbpt) :: lbasin_index             !!
+    REAL(r_std), DIMENSION(num_largest,nbpt)    :: lbasin_area              !!
+    REAL(r_std), DIMENSION(num_largest,nbpt)    :: lbasin_uparea            !!
+    INTEGER(i_std), DIMENSION(num_largest,nbpt) :: lrivercode               !!
+    !
+    INTEGER(i_std), DIMENSION(num_largest,2)    :: outpt                    !! Outflow point for each basin (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: streams_nb               !! Number of streams in basin (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: streams_avehops          !! Average number of hops in streams (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: streams_minhops          !! Minimum number of hops in streams (unitless)
+    INTEGER(i_std), DIMENSION(num_largest)      :: streams_maxhops          !! Minimum number of hops in streams (unitless)
+    REAL(r_std), DIMENSION(num_largest)         :: streams_resid            !! Average residence time
+    !
+    INTEGER(i_std)                              :: icc, fid, iret, ierr_tot, ib, ij, ik, i, j, lcc !! Indices (unitless)
+    INTEGER(i_std)                              :: nlonid, nlatid, varid, varid2, varid3
+    INTEGER(i_std)                              :: dims(2)                  !!
+    REAL(r_std)                                 :: lon_min, lon_max, lat_min, lat_max
+    CHARACTER(LEN=80)                           :: lon_name, lat_name, var_name, long_name, nc_name, att_str
+    CHARACTER(LEN=15)                           :: gridtype                 !!
+    !
+    REAL(r_std)                                 :: basinfrac(iim_g,jjm_g)   !!
+    REAL(r_std)                                 :: basinuparea(iim_g,jjm_g) !!
+    INTEGER(i_std)                              :: basincode(iim_g,jjm_g)   !!
+    !
+    LOGICAL                                     :: check=.FALSE.            !! (true/false)
+    !
+!! PARAMETERS
+    INTEGER(i_std),PARAMETER                    :: kind_r_diag=NF90_REAL8   !!
+    INTEGER(i_std),PARAMETER                    :: kind_i_diag=NF90_INT     !!
+    !
+    !
+    ! 1.0 Create the NETCDF file and store the coordinates.
+    !
+    ! This variable should be defined and computed in the module grid.f90.
+    ! Jan
+    gridtype="regular"
+    !
+    iret = NF90_CREATE(TRIM(river_file_name), NF90_CLOBBER, fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not create file :', &
+            & TRIM(river_file_name), '(Problem with disk place or filename ?)')
+    ENDIF
+    !
+    ! 1.1 Define dimensions
+    !
+    IF ( INDEX(gridtype, "regular") == 1 ) THEN
+       !
+       ! 1.1.1 regular grid
+       !
+       iret = NF90_DEF_DIM(fid, 'lon', iim_g, dims(1))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Dimension "x" can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       iret = NF90_DEF_DIM(fid, 'lat', jjm_g, dims(2))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Dimension "y" can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+    ELSE
+       !
+       ! 1.1.2 irregular grid
+       !
+       iret = NF90_DEF_DIM(fid, 'x', iim_g, dims(1))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Dimension "x" can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       
+       iret = NF90_DEF_DIM(fid, 'y', jjm_g, dims(2))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Dimension "y" can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+    ENDIF
+    !
+    !
+    ! 1.2 Define variables and attributes
+    !
+    IF ( INDEX(gridtype, "regular") == 1 ) THEN
+       !
+       ! 1.2.1 regular grid
+       !
+       lon_name = 'lon'
+       !
+       iret = NF90_DEF_VAR(fid, lon_name, kind_r_diag, dims(1), nlonid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Variable '//lon_name//' can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+       lat_name = 'lat'
+       iret = NF90_DEF_VAR(fid, lat_name, kind_r_diag, dims(2), nlatid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Variable '//lat_name//' can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+    ELSE
+       !
+       ! 1.2.2 irregular grid
+       !
+       lon_name = 'nav_lon'
+       !
+       iret = NF90_DEF_VAR(fid, lon_name, kind_r_diag, dims, nlonid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Variable '//lon_name//' can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+       lat_name = 'nav_lat'
+       iret = NF90_DEF_VAR(fid, lat_name, kind_r_diag, dims, nlatid)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Variable '//lat_name//' can not be defined for the file : ', &
+               &         TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+    ENDIF
+    !
+    ! 1.3 Add attributes to the coordinate variables
+    !
+    iret = NF90_PUT_ATT(fid, nlonid, 'units', "degrees_east") 
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lon_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    lon_min = -180.
+    lon_max = 180.
+    !
+    iret = NF90_PUT_ATT(fid, nlonid, 'valid_min', lon_min)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lon_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_ATT(fid, nlonid, 'valid_max', lon_max)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lon_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    iret = NF90_PUT_ATT(fid, nlonid, 'long_name', "Longitude")
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lon_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_ATT(fid, nlatid, 'units', "degrees_north")
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lat_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    lat_max = 90.
+    lat_min = -90.
+    !
+    iret = NF90_PUT_ATT(fid, nlatid, 'valid_min', lat_min)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lat_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_ATT(fid, nlatid, 'valid_max', lat_max)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lat_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    iret = NF90_PUT_ATT(fid, nlatid, 'long_name', "Latitude")
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not add attribut to variable '//lat_name//' for the file :', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    iret = NF90_ENDDEF(fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', 'Could not end definitions in the file : ', &
+ &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    !  1.4 Write coordinates
+    !
+    IF ( INDEX(gridtype, "regular") == 1 ) THEN
+       !
+       ! 1.4.1 regular grid
+       !
+       iret = NF90_PUT_VAR(fid, nlonid, lon_g(1:iim_g,1))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Could not put variable nav_lon  in the file : ', &
+               &          TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+       iret = NF90_PUT_VAR(fid, nlatid, lat_g(1,1:jjm_g))
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Could not put variable nav_lat  in the file : ', &
+               &          TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+    ELSE
+       !
+       ! 1.4.2 irregular grid
+       !
+       iret = NF90_PUT_VAR(fid, nlonid, lon_g)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Could not put variable nav_lon  in the file : ', &
+               &          TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+       !
+       iret = NF90_PUT_VAR(fid, nlatid, lat_g)
+       IF (iret /= NF90_NOERR) THEN
+          CALL ipslerr (3,'routing_diagncfile', 'Could not put variable nav_lat  in the file : ', &
+               &          TRIM(river_file_name),'(Solution ?)')
+       ENDIF
+    ENDIF
+    !
+    ! 2.0 Go through all basins and wirte the information into the netCDF file.
+    !
+    DO icc = 1, num_largest
+       !
+       ! 2.1 Compute the fields to be saved in the file
+       !
+       ib=sortedrivs(icc)
+       !
+       !
+       IF ( nb_pts(ib) > 2 ) THEN
+          !
+          basinfrac(:,:) = zero
+          basinuparea(:,:) = zero
+          basincode(:,:) = zero
+          !
+          DO ij=1, nb_pts(ib)
+
+             ik=lbasin_index(ib,ij)
+
+             j = ((index_g(ik)-1)/iim_g) + 1
+             i = (index_g(ik)-(j-1)*iim_g)
+
+             basinfrac(i,j) = basinfrac(i,j) + lbasin_area(ib,ij)/(resolution_g(ik,1)*resolution_g(ik,2))
+             basinuparea(i,j) = MAX(basinuparea(i,j), lbasin_uparea(ib,ij))
+             basincode(i,j) = lrivercode(ib,ij)
+
+          ENDDO
+          !
+          DO i=1,iim_g
+             DO j=1,jjm_g
+                IF ( basinfrac(i,j) <= EPSILON(zero) ) THEN
+                   basinfrac(i,j) = undef_sechiba
+                   basinuparea(i,j)  = undef_sechiba
+                   basincode(i,j)  = undef_int
+                ELSE
+                   basinfrac(i,j) = MAX(basinfrac(i,j), un)
+                ENDIF 
+             ENDDO
+          ENDDO
+          !
+          ! 
+          ! 2.2 Define the variables in the netCDF file
+          !
+          iret = NF90_REDEF(fid)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', &
+                  &          'Could not restart definitions in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! Create a name more suitable for a variable in a netCDF file
+          !
+          nc_name =  TRIM(sorted_names(icc))
+          ! Take out all character which could cause problems
+          lcc=LEN_TRIM(nc_name)
+          DO ij=1,lcc
+             IF ( nc_name(ij:ij) == " " ) nc_name(ij:ij) = "_"
+             IF ( nc_name(ij:ij) == "(" ) nc_name(ij:ij) = "_"
+             IF ( nc_name(ij:ij) == ")" ) nc_name(ij:ij) = "_"
+          ENDDO
+          ! reduce redundant "__"
+          DO ij=1,lcc
+             IF ( nc_name(ij:ij+1) == "__" ) nc_name(ij+1:)=nc_name(ij+2:lcc)
+          ENDDO
+          lcc=LEN_TRIM(nc_name)
+          IF ( nc_name(lcc:lcc) == "_" ) nc_name(lcc:lcc) = " "
+          !
+          !
+          ! 2.3 Fraction variable
+          !
+          IF (check) WRITE(*,*) "Define Fraction variable and add attributes"
+          !
+          var_name =  TRIM(nc_name)//"_frac"
+          !
+          iret = NF90_DEF_VAR(fid, TRIM(var_name), kind_r_diag, dims, varid)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Variable '//TRIM(var_name)//' can not be defined for the file : ', &
+                  &         TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ierr_tot = 0
+          ! Units
+          iret = NF90_PUT_ATT(fid, varid, 'units', "-")
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Units',  iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          ! Long name
+          long_name = "Fraction of basin "//TRIM(sorted_names(icc))//" per grid box"
+          iret = NF90_PUT_ATT(fid, varid, 'long_name', long_name)
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Long_Name', long_name, iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          ! Missing value
+          iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Missing value', undef_sechiba, iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ib=sortedrivs(icc)
+          IF ( check ) WRITE(*,*) "Doing basin ", icc," corrsdponding to index = ", ib, "num_largest : ", num_largest
+          !
+          ! Nb of grid points in basin
+          att_str='Nb_of_grid_points_in_basin'
+          iret = NF90_PUT_ATT(fid, varid, att_str, nb_pts(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Nb of grid points in basin', nb_pts(ib), iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Longitude of outflow point 
+          att_str='Longitude_of_outflow_point'
+          iret = NF90_PUT_ATT(fid, varid, att_str, lalo(outpt(ib,1),2))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Longitude of outflow point', lalo(outpt(ib,1),2), iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Latitide of outflow point
+          att_str='Latitude_of_outflow_point'
+          iret = NF90_PUT_ATT(fid, varid, att_str, lalo(outpt(ib,1),1))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Latitude of outflow point',  lalo(outpt(ib,1),1), iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Number of streams
+          att_str= 'Number_of_streams'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_nb(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Number of streams', streams_nb(ib), iret
+             WRITE(*,*) TRIM(NF90_STRERROR(iret))
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Total number of hops to go to the oceans
+          att_str='Total_number_of_hops_to_ocean'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_avehops(ib)*streams_nb(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Total number of hops to go to the oceans ', streams_avehops(ib)*streams_nb(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Minimum number of hops to go to the ocean for any stream
+          att_str='Minimum_number_of_hops_to_ocean_for_any_stream'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_minhops(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Minimum number of hops to go tp the ocean for any stream', streams_minhops(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Average number of hops to go to the ocean for any stream 
+          att_str='Average_number_of_hops_to_ocean_for_any_stream'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_avehops(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Average number of hops to go tp the ocean for any stream', streams_avehops(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Maximum number of hops to go to the ocean for any stream 
+          att_str='Maximum_number_of_hops_to_ocean_for_any_stream'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_maxhops(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Maximum number of hops to go tp the ocean for any stream', streams_maxhops(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          ! Average residence time in the basin
+          att_str='Average_residence_time_in_basin'
+          iret = NF90_PUT_ATT(fid, varid, att_str, streams_resid(ib))
+          IF (iret /= NF90_NOERR) THEN
+             WRITE(*,*) 'Average residence time in the basin', streams_resid(ib), iret
+             ierr_tot = ierr_tot + 1
+          ENDIF
+          !
+          IF (ierr_tot > 0 ) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Could not add some attributes to variable '//var_name//' for the file :', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! 2.4 Upstream area variable variable
+          !
+          IF (check) WRITE(*,*) "Define Upstream variable and add attributes"
+          !
+          ! Create a name more suitable for a variable in a netCDF file
+          !
+          var_name =  TRIM(nc_name)//"_upstream"
+          DO ij=1,LEN_TRIM(var_name)
+             IF ( var_name(ij:ij) == " " ) var_name(ij:ij) = "_"
+          ENDDO
+          !
+          iret = NF90_DEF_VAR(fid, TRIM(var_name), kind_r_diag, dims, varid2)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Variable '//TRIM(var_name)//' can not be defined for the file : ', &
+                  &         TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ierr_tot = 0
+          ! Units
+          iret = NF90_PUT_ATT(fid, varid2, 'units', "m^2")
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          ! Long name
+          long_name = "Upstream area of basin "//TRIM(sorted_names(icc))//" in the grid box"
+          iret = NF90_PUT_ATT(fid, varid2, 'long_name', long_name)
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          ! Missing value
+          iret = NF90_PUT_ATT(fid, varid2, 'missing_value', undef_sechiba)
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          !
+          IF (ierr_tot > 0 ) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Could not add some attributes to variable '//var_name//' for the file :', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! 2.5 Pfafstetter codes for basins
+          !
+          IF (check) WRITE(*,*) "Define Pfafstetter codes variable and add attributes"
+          !
+          var_name =  TRIM(nc_name)//"_coding"
+          DO ij=1,LEN_TRIM(var_name)
+             IF ( var_name(ij:ij) == " " ) var_name(ij:ij) = "_"
+          ENDDO
+          !
+          iret = NF90_DEF_VAR(fid, TRIM(var_name), kind_i_diag, dims, varid3)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Variable '//TRIM(var_name)//' can not be defined for the file : ', &
+                  &         TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ierr_tot = 0
+          ! Units
+          iret = NF90_PUT_ATT(fid, varid3, 'units', "-")
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          ! Long name
+          long_name = "Pfafstetter codes of grid boxes in basin "//TRIM(sorted_names(icc))
+          iret = NF90_PUT_ATT(fid, varid3, 'long_name', long_name)
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          ! Missing value
+          iret = NF90_PUT_ATT(fid, varid3, 'missing_value', undef_int)
+          IF (iret /= NF90_NOERR) ierr_tot = ierr_tot + 1
+          !
+          IF (ierr_tot > 0 ) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Could not add some attributes to variable '//var_name//' for the file :', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! 2.6 ENDDEF of netCDF file
+          !
+          IF (check) WRITE(*,*) "END define"
+          !
+          iret = NF90_ENDDEF(fid)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', &
+                  &          'Could not end definitions in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+          ! 2.7 Write the data to the file
+          !
+          IF (check) WRITE(*,*) "Put basinfrac"
+          iret = NF90_PUT_VAR(fid, varid, basinfrac)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Could not put variable basinfrac in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+
+          IF (check) WRITE(*,*) "Put basinuparea"
+          iret = NF90_PUT_VAR(fid, varid2, basinuparea)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagncfile', 'Could not put variable basinuparea in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+
+          IF (check) WRITE(*,*) "Put basincode"
+          iret = NF90_PUT_VAR(fid, varid3, basincode)
+          IF (iret /= NF90_NOERR) THEN
+             CALL ipslerr (3,'routing_diagfile', 'Could not put variable basincode in the file : ', &
+                  &          TRIM(river_file_name),'(Solution ?)')
+          ENDIF
+          !
+       ENDIF
+       !
+    ENDDO
+    !
+    IF (check) WRITE(*,*) "Close file"
+    !
+    ! Close netCDF file and do some memory management.
+    !
+    iret = NF90_CLOSE(fid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr (3,'routing_diagncfile', &
+            &          'Could not end definitions in the file : ', &
+            &          TRIM(river_file_name),'(Solution ?)')
+    ENDIF
+    !
+    !
+  END SUBROUTINE routing_diagncfile
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_basins_p
+!!
+!> BRIEF        This parallelized subroutine computes the routing map if needed. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_basins_p(nbpt, lalo, neighbours, resolution, contfrac)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in) :: nbpt                          !! Domain size (unitless)
+    REAL(r_std), INTENT(in)    :: lalo(nbpt,2)                  !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in) :: neighbours(nbpt,8)            !! Vector of neighbours for each grid point 
+                                                                !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) (unitless)
+    REAL(r_std), INTENT(in)    :: resolution(nbpt,2)            !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)    :: contfrac(nbpt)                !! Fraction of land in each grid box (unitless;0-1)   
+
+!    INTEGER(i_std)    :: neighbours_tmp(nbpt,8)
+!    INTEGER(i_std) :: i,j
+    
+!    DO i=1,nbp_loc
+!      DO j=1,8
+!   IF (neighbours(i,j)==-1) THEN
+!     neighbours_tmp(i,j)=neighbours(i,j)
+!   ELSE
+!     neighbours_tmp(i,j)=neighbours(i,j)+nbp_para_begin(mpi_rank)-1
+!   ENDIF  
+!      ENDDO
+!    ENDDO
+
+    routing_area => routing_area_glo  
+    topo_resid => topo_resid_glo
+    route_togrid => route_togrid_glo
+    route_tobasin => route_tobasin_glo
+    route_nbintobas => route_nbintobas_glo
+    global_basinid => global_basinid_glo
+ 
+    IF (is_root_prc) CALL routing_basins(nbp_glo,lalo_g, neighbours_g, resolution_g, contfrac_g)
+
+    routing_area => routing_area_loc  
+    topo_resid => topo_resid_loc
+    route_togrid => route_togrid_loc
+    route_tobasin => route_tobasin_loc
+    route_nbintobas => route_nbintobas_loc
+    global_basinid => global_basinid_loc
+
+    CALL scatter(routing_area_glo,routing_area_loc)
+    CALL scatter(topo_resid_glo,topo_resid_loc)
+    CALL scatter(route_togrid_glo,route_togrid_loc)
+    CALL scatter(route_tobasin_glo,route_tobasin_loc)
+    CALL scatter(route_nbintobas_glo,route_nbintobas_loc)
+    CALL scatter(global_basinid_glo,global_basinid_loc)
+    
+  END SUBROUTINE routing_basins_p
+  ! 
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_basins
+!!
+!> BRIEF        This non-parallelized subroutine reads in the map of basins and flow direction to construct
+!!              the catchments of each grid box. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!! The work is done in a number of steps which are performed locally on the 
+!! GCM grid:
+!!  1) First we find the grid-points of the high resolution routing grid which are
+!!     within the coarser grid of the GCM.
+!!  2) When we have these grid points we decompose them into basins in the routine
+!!     routing_findbasins. A number of simplifications are done if needed.
+!!  3) In the routine routing_globalize we put the basin information of this grid
+!!     into the global fields.
+!! Then we work on the global grid to perform the following tasks :
+!!  1) We link up the basins of the various grid points and check the global consistency.
+!!  2) The area of each outflow point is computed.
+!!  3) The final step is to reduce the number of basins in order to fit into the truncation.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None, as the routine puts information into the global variables of the module.
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_basins(nbpt, lalo, neighbours, resolution, contfrac)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                    :: nbpt                  !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                       :: lalo(nbpt,2)          !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)                    :: neighbours(nbpt,8)    !! Vector of neighbours for each grid point (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) (unitless)
+    REAL(r_std), INTENT(in)                       :: resolution(nbpt,2)    !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)                       :: contfrac(nbpt)        !! Fraction of land in each grid box (unitless;0-1)
+!! LOCAL VARIABLES
+    CHARACTER(LEN=80)                             :: filename              !! Name of the netcdf file (unitless)
+    INTEGER(i_std)                                :: iml, jml, lml, tml, fid, ib, ip, jp, fopt !! Indices (unitless)
+    REAL(r_std)                                   :: lev(1), date, dt, coslat
+    INTEGER(i_std)                                :: itau(1)               !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: trip                  !! The trip field (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: basins                !! The basin field (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: topoindex             !! Topographic index of the residence time (m)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: hierarchy             !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lat_rel               !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lon_rel               !!
+    !
+    INTEGER(i_std)                                :: nbi, nbj              !! Number of point in x and y within the grid (unitless)
+    REAL(r_std)                                   :: min_topoind           !! The current minimum of topographic index (m)
+    REAL(r_std)                                   :: max_basins            !!
+    REAL(r_std)                                   :: invented_basins       !!
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: area_bx               !! Area of each small box in the grid box @tex $(m^2})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: hierarchy_bx          !! Level in the basin of the point
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lon_bx                !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: lat_bx                !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: topoind_bx            !! Topographic index of the residence time for each of the smaller boxes (m)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: trip_bx               !! The trip field for each of the smaller boxes (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: basin_bx              !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: coast_pts             !! The coastal flow points (unitless)
+    !
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_count           !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: basin_id              !!
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: basin_area            !!
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: basin_hierarchy       !!
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: basin_topoind         !! Topographic index of the residence time for a basin (m)
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: fetch_basin           !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: basin_flowdir         !! Water flow directions in the basin (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: outflow_grid          !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: outflow_basin         !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: inflow_number         !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: inflow_basin          !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: inflow_grid           !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: nbcoastal             !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: coastal_basin         !!
+    !
+    ! Interpolation help variables
+    !
+    INTEGER(i_std)                                :: nix, njx              !!
+    CHARACTER(LEN=30)                             :: callsign              !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)    :: resol_lu              !! Resolution
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: mask                  !! Mask to exclude some points (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)      :: sub_area              !! Area on the fine grid @tex $(m^2})$ @endtex
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sub_index             !! Indices of the points we need on the fine grid (unitless)
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: sub_pts               !! Number of high resolution points on this grid (unitless)
+    INTEGER                                       :: ALLOC_ERR             !!
+    LOGICAL                                       :: ok_interpol = .FALSE. !! Flag for interpolation (true/false)
+    !
+    INTEGER(i_std)                                :: nb_basin              !! Number of sub-basins (unitless)
+    INTEGER(i_std)                                :: nwbas                 !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_inbxid          !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_sz              !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_bxout           !!
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: basin_pts             !!
+    CHARACTER(LEN=7)                              :: fmt                   !!
+    LOGICAL                                       :: debug = .FALSE.       !! (true/false)
+    !
+    INTEGER(i_std), DIMENSION(2)                  :: diagbox = (/ 1, 2 /)  !!
+    !
+    !
+    IF ( .NOT. is_root_prc) THEN
+       WRITE(numout,*) "is_root_prc = ", is_root_prc
+       CALL ipslerr (3,'routing_basins', &
+            &          'routing_basins is not suitable for running in parallel', &
+            &          'We are here on a non root processor. ','(STOP from routing_basins)')
+    ENDIF
+    !
+    ! Test on diagbox and nbpt
+    !
+    IF (debug) THEN
+       IF (ANY(diagbox .GT. nbpt)) THEN 
+          WRITE(numout,*) "Debug diganostics : nbpt, diagbox", nbpt, diagbox
+          call ipslerr(3,'routing_basin', &
+               &      'Problem with diagbox in debug mode.', & 
+               &      'diagbox values can''t be greater than land points number.', &
+               &      '(decrease diagbox wrong value)')
+       ENDIF
+    ENDIF
+    !
+    !
+    !  Needs to be a configurable variable
+    !
+    !
+    !Config Key   = ROUTING_FILE
+    !Config Desc  = Name of file which contains the routing information
+    !Config If    = RIVER_ROUTING
+    !Config Def   = routing.nc
+    !Config Help  = The file provided here should alow the routing module to
+    !Config         read the high resolution grid of basins and the flow direction 
+    !Config         from one mesh to the other.
+    !Config Units = [FILE]
+    !
+    filename = 'routing.nc'
+    CALL getin('ROUTING_FILE',filename)
+    !
+    CALL flininfo(filename,iml, jml, lml, tml, fid)
+    CALL flinclo(fid)
+    !
+    ! soils_param.nc file is 1Â° soit texture file.
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lat_rel (routing_basins): ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lon_rel (routing_basins): ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    ALLOC_ERR=-1
+    ALLOCATE (trip(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of trip (routing_basins): ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE (basins(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of basins (routing_basins): ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE (topoindex(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of topoindex (routing_basins): ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE (hierarchy(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of hierarchy (routing_basins): ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    !
+    CALL flinopen(filename, .FALSE., iml, jml, lml, lon_rel, lat_rel, lev, tml, itau, date, dt, fid)
+    !!
+    !! From the basin description data we will read the following variables :
+    !!
+    !! Trip : Provides the flow direction following the convention :
+    !! trip = 1 : flow = N
+    !! trip = 2 : flow = NE
+    !! trip = 3 : flow = E
+    !! trip = 4 : flow = SE
+    !! trip = 5 : flow = S
+    !! trip = 6 : flow = SW
+    !! trip = 7 : flow = W
+    !! trip = 8 : flow = NW
+    !! trip = 97 : return flow into the ground
+    !! trip = 98 : coastal flow (diffuse flow into the oceans)
+    !! trip = 99 : river flow into the oceans
+    !!
+    !! Basins : Provides a uniqe ID for each basin. These IDs are also used to get
+    !! the name of the basin from the table in routine routing_names.
+    !! 
+    !! Topoind :  is the topographic index for the retention time of the water in the
+    !! grid box. It has been computed with the following formula : 1000 x sqrt(d^3/Dz) 
+    !! where d is the distance of the river from the current grid box to the next one
+    !! as indicated by the variable trip.
+    !! Dz the hight difference between between the two grid boxes.
+    !! All these variables are in meters.
+    !! Furthermore  we have to limit the height difference to 5m in order to avoid any unpleasant
+    !! surprises. If dz < 5m then dz=5.
+    !!
+    !
+    CALL flinget(fid, 'trip', iml, jml, lml, tml, 1, 1, trip)
+    !
+    CALL flinget(fid, 'basins', iml, jml, lml, tml, 1, 1, basins)
+    !
+    CALL flinget(fid, 'topoind', iml, jml, lml, tml, 1, 1, topoindex)
+    !
+    CALL flinclo(fid)
+    !
+    min_topoind = MINVAL(topoindex, MASK=topoindex .LT. undef_sechiba-un)
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          IF ( trip(ip,jp) < 1.e10 .AND. topoindex(ip,jp) > 1.e10) THEN
+             WRITE(numout,*) 'trip exists but not topoind :'
+             WRITE(numout,*) 'ip, jp :', ip, jp
+             WRITE(numout,*) 'trip, topoind : ', trip(ip,jp), topoindex(ip,jp)
+             STOP
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of resol_lu : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    ! Consider all points a priori
+    !
+    mask(:,:) = 0
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          ! Determine the land mask of the basin map read from the file ROUTING_FILE
+          !
+          IF ( trip(ip,jp) < 1.e10 ) THEN
+             mask(ip,jp) = 1
+          ENDIF
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )     
+          IF ( ip .EQ. 1 ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip,jp) ) * pi/180. * R_Earth * coslat
+          ELSEIF ( ip .EQ. iml ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip,jp) - lon_rel(ip-1,jp) ) * pi/180. * R_Earth * coslat
+          ELSE
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp) - lat_rel(ip,jp+1) ) * pi/180. * R_Earth
+          ELSEIF ( jp .EQ. jml ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp) ) * pi/180. * R_Earth
+          ELSE
+             resol_lu(ip,jp,2) =  ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp+1) )/2. * pi/180. * R_Earth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! The maximum number of points of the source map (basin description here) which can fit into
+    ! any grid point of the ORCHIDEE grid is stimated here.
+    ! Some margin is taken.
+    !
+    callsign = "routing_basins"
+    ok_interpol = .FALSE.
+    !  
+    nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+    njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+    nbvmax = nix*njx*2
+    !
+    ! We are on the root processor here as this routine is not in parallel. So no need to broadcast.
+    !
+    WRITE(numout,*) "Projection arrays for ",callsign," : "
+    WRITE(numout,*) "Routing : nbvmax = ", nbvmax
+    !
+    !
+    ALLOC_ERR=-1
+    ALLOCATE (sub_area(nbpt,nbvmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+       STOP
+    ENDIF
+    sub_area(:,:)=zero
+    ALLOC_ERR=-1
+    ALLOCATE (sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+       STOP 
+    ENDIF
+    sub_index(:,:,:)=0
+    ALLOC_ERR=-1
+    ALLOCATE (sub_pts(nbpt), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of sub_pts : ",ALLOC_ERR
+       STOP 
+    ENDIF
+    sub_pts(:)=0
+    !
+    ! routine aggregate will for each point of the ORCHIDEE grid determine which points
+    ! of the source grid (basin definitions here) fit in there and which fraction of
+    ! of the ORCHIDEE grid it represents.
+    !
+    CALL aggregate(nbpt, lalo, neighbours, resolution, contfrac, &
+         &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+         &                nbvmax, sub_index, sub_area, ok_interpol)
+    !
+    WHERE (sub_area < 0) sub_area=zero
+    !
+    ! Some verifications
+    !
+    DO ib=1,nbpt
+       sub_pts(ib) = COUNT(sub_area(ib,:) > zero)
+       DO fopt=1,sub_pts(ib)
+          IF (sub_area(ib, fopt) == 0 ) THEN
+             WRITE(numout,*) "Zero Area - Sub_area > 0 : ", ib, fopt
+             WRITE(numout,*) "Zero Area - lon : ",lalo(ib,2)
+             WRITE(numout,*) "Zero Area - lon_rel : ", lon_rel(sub_index(ib, fopt, 1),sub_index(ib, fopt, 2))
+             WRITE(numout,*) "Zero Area - lat : ",lalo(ib,1)
+             WRITE(numout,*) "Zero Area - lat_rel : ", lat_rel(sub_index(ib, fopt, 1),sub_index(ib, fopt, 2))
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Do some memory management.
+    !
+    nwbas = MAXVAL(sub_pts)
+    !
+    ALLOCATE (area_bx(nbvmax,nbvmax))
+    ALLOCATE (hierarchy_bx(nbvmax,nbvmax))
+    ALLOCATE (lon_bx(nbvmax,nbvmax))
+    ALLOCATE (lat_bx(nbvmax,nbvmax))
+    ALLOCATE (topoind_bx(nbvmax,nbvmax))
+    ALLOCATE (trip_bx(nbvmax,nbvmax))
+    ALLOCATE (basin_bx(nbvmax,nbvmax))
+    ALLOCATE (coast_pts(nbvmax))
+    !
+    ALLOCATE (basin_inbxid(nbvmax))
+    ALLOCATE (basin_sz(nbvmax))
+    ALLOCATE (basin_pts(nbvmax,nbvmax,2))
+    ALLOCATE (basin_bxout(nbvmax))
+    !
+    ALLOCATE (basin_count(nbpt))
+    ALLOCATE (basin_area(nbpt,nwbas), basin_hierarchy(nbpt,nwbas), basin_topoind(nbpt,nwbas))
+    ALLOCATE (fetch_basin(nbpt,nwbas))
+    ALLOCATE (basin_id(nbpt,nwbas),  basin_flowdir(nbpt,nwbas))
+    ALLOCATE (outflow_grid(nbpt,nwbas),outflow_basin(nbpt,nwbas))
+    ALLOCATE (inflow_number(nbpt,nwbas))
+    ALLOCATE (inflow_basin(nbpt,nwbas,nbvmax), inflow_grid(nbpt,nwbas,nbvmax))
+    ALLOCATE (nbcoastal(nbpt), coastal_basin(nbpt,nwbas))
+    !
+    !    Order all sub points in each grid_box and find the sub basins
+    !
+    !    before we start we set the maps to empty
+    !
+    basin_id(:,:) = undef_int
+    basin_count(:) = 0
+    hierarchy(:,:) = undef_sechiba
+    max_basins = MAXVAL(basins, MASK=basins .LT. 1.e10)
+    invented_basins = max_basins
+    nbcoastal(:) = 0
+    !
+    !! Finds,in each grid box, the distance to the outflow point ... this defines the order in which
+    !! the water will go through the sub-basins and grid boxes.
+    !
+    CALL routing_hierarchy(iml, jml, trip, topoindex, hierarchy)
+    !
+    !
+    DO ib =1, nbpt
+       !
+       !
+       !  extract the information for this grid box
+       !
+       !! Extracts from the global high resolution fields the data for the current grid box.
+       !
+       CALL routing_getgrid(nbpt, iml, jml, ib, sub_pts, sub_index, sub_area, max_basins, min_topoind, &
+            & lon_rel, lat_rel, lalo, resolution, contfrac, trip, basins, topoindex, hierarchy, &
+            & nbi, nbj, area_bx, trip_bx, basin_bx, topoind_bx, hierarchy_bx, lon_bx, lat_bx)
+       !
+       !! Finds the basins: returns the list of all points which are within the same basin of the grid box.
+       !
+       CALL routing_findbasins(nbi, nbj, trip_bx, basin_bx, hierarchy_bx, topoind_bx,&
+            & nb_basin, basin_inbxid, basin_sz, basin_bxout, basin_pts, coast_pts)
+       !
+       !  Deal with the case where nb_basin=0 for this grid box. In this case all goes into coastal flow.
+       !
+       IF ( debug .AND. (COUNT(diagbox .EQ. ib) .GT. 0) ) THEN
+          WRITE(numout,*) '===================== IB = :', ib
+          WRITE(numout,*) "sub_pts(ib) :", sub_pts(ib), "sub_area(ib,:) :",sub_area(ib,1:2)
+          WRITE(numout,*) 'LON LAT of GCM :', lalo(ib,2), lalo(ib,1)
+          WRITE(numout,*) 'Neighbor options :',  neighbours(ib,1:8)
+          WRITE(numout,*) 'Resolution :', resolution(ib,1:2)
+          WRITE(fmt,"('(',I3,'I6)')") nbi
+          WRITE(numout,*) '-------------> trip ', trip_bx(1,1)
+          DO jp=1,nbj
+             WRITE(numout,fmt) trip_bx(1:nbi,jp)
+          ENDDO
+          WRITE(numout,*) '-------------> basin ',basin_bx(1,1)
+          DO jp=1,nbj
+             WRITE(numout,fmt) basin_bx(1:nbi,jp)
+          ENDDO
+          WRITE(numout,*) '-------------> hierarchy ',hierarchy_bx(1,1)
+          DO jp=1,nbj
+             WRITE(numout,fmt) INT(hierarchy_bx(1:nbi,jp)/1000.)
+          ENDDO
+          WRITE(numout,*) '-------------> topoindex ',topoind_bx(1,1)
+          DO jp=1,nbj
+             WRITE(numout,fmt) INT(topoind_bx(1:nbi,jp)/1000.)
+          ENDDO
+          !
+          WRITE(numout,*) '------------> The basins we retain'
+          DO jp=1,nb_basin
+             WRITE(numout,*) 'index, size, bxout, coast :', basin_inbxid(jp), basin_sz(jp),&
+                  & basin_bxout(jp), coast_pts(jp)
+          ENDDO
+          !
+       ENDIF
+       !
+       !! Puts the basins found for the current grid box in the context of the global map.
+       !
+       CALL routing_globalize(nbpt, ib, neighbours, area_bx, trip_bx, hierarchy_bx, topoind_bx, min_topoind,&
+            & nb_basin, basin_inbxid, basin_sz, basin_pts, basin_bxout, coast_pts, nwbas, basin_count,&
+            & basin_area, basin_hierarchy, basin_topoind, basin_id, basin_flowdir, outflow_grid,&
+            & nbcoastal, coastal_basin) 
+       !
+       !
+       IF ( debug .AND. (COUNT(diagbox .EQ. ib) .GT. 0) ) THEN
+          WRITE(numout,*) 'GLOBAL information after routing_globalize for grid ', ib
+          DO jp=1,basin_count(ib)
+             WRITE(numout,*) 'Basin ID : ', basin_id(ib, jp)
+             WRITE(numout,*) 'Basin flowdir :', basin_flowdir(ib, jp)
+             WRITE(numout,*) 'Basin hierarchy :', basin_hierarchy(ib, jp)
+             WRITE(numout,*) 'Basin topoindex :', basin_topoind(ib, jp)
+             WRITE(numout,*) 'Basin outflow grid :', outflow_grid(ib,jp)
+          ENDDO
+       ENDIF
+       !
+    ENDDO
+    !
+    !! Makes the connections between the bains and ensures global coherence.
+    !
+    CALL routing_linkup(nbpt, neighbours, nwbas, basin_count, basin_area, basin_id, basin_flowdir, &
+         & basin_hierarchy, outflow_grid, outflow_basin, inflow_number, inflow_grid, inflow_basin, &
+         & nbcoastal, coastal_basin, invented_basins)
+    ! 
+    !
+    WRITE(numout,*) 'The maximum number of basins in any grid :', MAXVAL(basin_count)
+    !
+    IF ( debug ) THEN
+       DO ib=1,SIZE(diagbox)
+          IF ( diagbox(ib) .GT. 0 ) THEN
+             WRITE(numout,*) 'After routing_linkup information for grid ', diagbox(ib)
+             DO jp=1,basin_count(diagbox(ib))
+                WRITE(numout,*) 'Basin ID : ', basin_id(diagbox(ib), jp)
+                WRITE(numout,*) 'Basin outflow_grid :', outflow_grid(diagbox(ib), jp)
+                WRITE(numout,*) 'Basin outflow_basin:', outflow_basin(diagbox(ib), jp)
+                WRITE(numout,*) 'Basin hierarchy :', basin_hierarchy(diagbox(ib), jp)
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDIF
+    !
+    !! Computes the fetch of each basin, upstream area in known.
+    !
+    CALL routing_fetch(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_id, outflow_grid, &
+         & outflow_basin, fetch_basin)
+    !
+    !
+    WRITE(numout,*) "Start reducing the number of basins per grid to meet the required truncation."
+    !
+    !! Reduces the number of basins per grid to the value chosen by the user.
+    !
+    CALL routing_truncate(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_topoind,&
+         & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+         & inflow_grid, inflow_basin)
+    !
+    !! Calculate the fetch again and store the upstream areas which are here used as output variable     
+    CALL routing_fetch(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_id, outflow_grid, &
+         & outflow_basin, fetch_basin)         
+    upstream_area = fetch_basin     
+    
+
+    !
+    DEALLOCATE (lat_rel)
+    DEALLOCATE (lon_rel)
+    !
+    DEALLOCATE (trip)
+    DEALLOCATE (basins)
+    DEALLOCATE (topoindex)
+    DEALLOCATE (hierarchy)
+    !
+    DEALLOCATE (sub_area)
+    DEALLOCATE (sub_index)
+    DEALLOCATE (sub_pts)
+    !
+    DEALLOCATE (mask)
+    DEALLOCATE (resol_lu)
+    !
+    DEALLOCATE (basin_count)
+    DEALLOCATE (basin_area, basin_hierarchy, basin_topoind, fetch_basin)
+    DEALLOCATE (basin_id,  basin_flowdir)
+    DEALLOCATE (outflow_grid,outflow_basin)
+    DEALLOCATE (inflow_number)
+    DEALLOCATE (inflow_basin, inflow_grid)
+    DEALLOCATE (nbcoastal, coastal_basin)
+    !
+    RETURN
+    !
+  END SUBROUTINE routing_basins
+  !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_getgrid
+!!
+!> BRIEF         This subroutine extracts from the global high resolution fields
+!!               the data for the current grid box we are dealing with.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!! Convention for trip on the input :
+!! The trip field follows the following convention for the flow of the water :
+!! trip = 1 : flow = N
+!! trip = 2 : flow = NE
+!! trip = 3 : flow = E
+!! trip = 4 : flow = SE
+!! trip = 5 : flow = S
+!! trip = 6 : flow = SW
+!! trip = 7 : flow = W
+!! trip = 8 : flow = NW
+!! trip = 97 : return flow into the ground
+!! trip = 98 : coastal flow (diffuse flow into the oceans) These values are created here
+!! trip = 99 : river flow into the oceans
+!!
+!! On output, the grid boxes of the basin map which flow out of the GCM grid are identified
+!! by numbers larger than 100 :
+!! trip = 101 : flow = N out of the coarse grid
+!! trip = 102 : flow = NE out of the coarse grid
+!! trip = 103 : flow = E out of the coarse grid
+!! trip = 104 : flow = SE out of the coarse grid
+!! trip = 105 : flow = S out of the coarse grid
+!! trip = 106 : flow = SW out of the coarse grid
+!! trip = 107 : flow = W out of the coarse grid
+!! trip = 108 : flow = NW out of the coarse grid
+!! Inside the grid the convention remains the same as above (ie between 1 and 99).:\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_getgrid(nbpt, iml, jml, ib, sub_pts, sub_index, sub_area, max_basins, min_topoind, &
+       & lon_rel, lat_rel, lalo, resolution, contfrac, trip, basins, topoindex, hierarchy, &
+       & nbi, nbj, area_bx, trip_bx, basin_bx, topoind_bx, hierarchy_bx, lon_bx, lat_bx)
+    !
+    IMPLICIT NONE
+    !
+!!  INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)  :: nbpt                        !! Domain size (unitless)
+    INTEGER(i_std), INTENT(in)  :: iml                         !! X resolution of the high resolution grid
+    INTEGER(i_std), INTENT(in)  :: jml                         !! Y resolution of the high resolution grid
+    INTEGER(i_std), INTENT(in)  :: ib                          !! Current basin (unitless)
+    INTEGER(i_std), INTENT(in)  :: sub_pts(nbpt)               !! Number of high resolution points on this grid (unitless)
+    INTEGER(i_std), INTENT(in)  :: sub_index(nbpt,nbvmax,2)    !! Indices of the points we need on the fine grid (unitless)
+    REAL(r_std), INTENT(inout)  :: max_basins                  !! The current maximum of basins
+    REAL(r_std), INTENT(in)     :: min_topoind                 !! The current minimum of topographic index (m)
+    REAL(r_std), INTENT(in)     :: sub_area(nbpt,nbvmax)       !! Area on the fine grid @tex $(m^2})$ @endtex
+    REAL(r_std), INTENT(in)     :: lon_rel(iml,jml)            !!
+    REAL(r_std), INTENT(in)     :: lat_rel(iml,jml)            !! coordinates of the fine grid
+    REAL(r_std), INTENT(in)     :: lalo(nbpt,2)                !! Vector of latitude and longitudes (beware of the order !)
+    REAL(r_std), INTENT(in)     :: resolution(nbpt,2)          !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)     :: contfrac(nbpt)              !! Fraction of land in each grid box (unitless;0-1)
+    REAL(r_std), INTENT(inout)  :: trip(iml,jml)               !! The trip field (unitless)
+    REAL(r_std), INTENT(inout)  :: basins(iml,jml)             !! data on the fine grid
+    REAL(r_std), INTENT(inout)  :: topoindex(iml,jml)          !! Topographic index of the residence time (m)
+    REAL(r_std), INTENT(inout)  :: hierarchy(iml, jml)         !! data on the fine grid
+    !
+!!  OUTPUT VARIABLES
+    INTEGER(i_std), INTENT(out) :: nbi, nbj                    !! Number of point in x and y within the grid (unitless)
+    REAL(r_std), INTENT(out)    :: area_bx(nbvmax,nbvmax)      !! Area of each small box in the grid box @tex $(m^2})$ @endtex
+    REAL(r_std), INTENT(out)    :: hierarchy_bx(nbvmax,nbvmax) !! Level in the basin of the point
+    REAL(r_std), INTENT(out)    :: lon_bx(nbvmax,nbvmax)       !!
+    REAL(r_std), INTENT(out)    :: lat_bx(nbvmax,nbvmax)       !!
+    REAL(r_std), INTENT(out)    :: topoind_bx(nbvmax,nbvmax)   !! Topographic index of the residence time for each of the smaller boxes (m)
+    INTEGER(i_std), INTENT(out) :: trip_bx(nbvmax,nbvmax)      !! The trip field for each of the smaller boxes (unitless)
+    INTEGER(i_std), INTENT(out) :: basin_bx(nbvmax,nbvmax)     !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)              :: ip, jp, ll(1), iloc, jloc   !! Indices (unitless)
+    REAL(r_std)                 :: lonstr(nbvmax*nbvmax)       !!
+    REAL(r_std)                 :: latstr(nbvmax*nbvmax)       !!
+
+!_ ================================================================================================================================
+
+    !
+    ! Set everything to undef to locate easily empty points
+    !
+    trip_bx(:,:) = undef_int
+    basin_bx(:,:) = undef_int
+    topoind_bx(:,:) = undef_sechiba
+    area_bx(:,:) = undef_sechiba
+    hierarchy_bx(:,:) = undef_sechiba
+    !
+    IF ( sub_pts(ib) > 0 ) THEN
+       !
+       DO ip=1,sub_pts(ib)
+          lonstr(ip) = lon_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+          latstr(ip) = lat_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+       ENDDO
+       !
+       !  Get the size of the area and order the coordinates to go from North to South and West to East
+       !
+       CALL routing_sortcoord(sub_pts(ib), lonstr, 'WE', nbi)
+       CALL routing_sortcoord(sub_pts(ib), latstr, 'NS', nbj)
+       !
+       ! Transfer the data in such a way that (1,1) is the North Western corner and
+       ! (nbi, nbj) the South Eastern.
+       !
+       DO ip=1,sub_pts(ib)
+          ll = MINLOC(ABS(lonstr(1:nbi) - lon_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))))
+          iloc = ll(1)
+          ll = MINLOC(ABS(latstr(1:nbj) - lat_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))))
+          jloc = ll(1)
+          trip_bx(iloc, jloc) = NINT(trip(sub_index(ib, ip, 1), sub_index(ib, ip, 2)))
+          basin_bx(iloc, jloc) = NINT(basins(sub_index(ib, ip, 1), sub_index(ib, ip, 2)))
+          area_bx(iloc, jloc) = sub_area(ib, ip)
+          topoind_bx(iloc, jloc) = topoindex(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+          hierarchy_bx(iloc, jloc) = hierarchy(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+          lon_bx(iloc, jloc) = lon_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+          lat_bx(iloc, jloc) = lat_rel(sub_index(ib, ip, 1), sub_index(ib, ip, 2))
+       ENDDO
+    ELSE
+       !
+       ! This is the case where the model invented a continental point
+       !
+       nbi = 1
+       nbj = 1
+       iloc = 1
+       jloc = 1
+       trip_bx(iloc, jloc) = 98
+       basin_bx(iloc, jloc) = NINT(max_basins + 1)
+       max_basins = max_basins + 1
+       area_bx(iloc, jloc) = resolution(ib,1)*resolution(ib,2)*contfrac(ib)
+       topoind_bx(iloc, jloc) = min_topoind
+       hierarchy_bx(iloc, jloc) =  min_topoind
+       lon_bx(iloc, jloc) = lalo(ib,2)
+       lat_bx(iloc, jloc) = lalo(ib,1)
+       !
+    ENDIF
+    !
+    ! Tag in trip all the outflow conditions. The table is thus :
+    ! trip = 100+n : Outflow into another grid box
+    ! trip = 99    : River outflow into the ocean
+    ! trip = 98    : This will be coastal flow (not organized as a basin)
+    ! trip = 97    : return flow into the soil (local)
+    !
+    DO jp=1,nbj
+       IF ( trip_bx(1,jp) .EQ. 8 .OR. trip_bx(1,jp) .EQ. 7 .OR. trip_bx(1,jp) .EQ. 6) THEN
+          trip_bx(1,jp) = trip_bx(1,jp) + 100
+       ENDIF
+       IF ( trip_bx(nbi,jp) .EQ. 2 .OR. trip_bx(nbi,jp) .EQ. 3 .OR. trip_bx(nbi,jp) .EQ. 4) THEN
+          trip_bx(nbi,jp) = trip_bx(nbi,jp) + 100
+       ENDIF
+    ENDDO
+    DO ip=1,nbi
+       IF ( trip_bx(ip,1) .EQ. 8 .OR. trip_bx(ip,1) .EQ. 1 .OR. trip_bx(ip,1) .EQ. 2) THEN
+          trip_bx(ip,1) = trip_bx(ip,1) + 100
+       ENDIF
+       IF ( trip_bx(ip,nbj) .EQ. 6 .OR. trip_bx(ip,nbj) .EQ. 5 .OR. trip_bx(ip,nbj) .EQ. 4) THEN
+          trip_bx(ip,nbj) = trip_bx(ip,nbj) + 100
+       ENDIF
+    ENDDO
+    !
+    !
+    !  We simplify the outflow. We only need the direction normal to the
+    !     box boundary and the 4 corners.
+    ! 
+    ! Northern border
+    IF ( trip_bx(1,1) .EQ. 102 ) trip_bx(1,1) = 101
+    IF ( trip_bx(nbi,1) .EQ. 108 ) trip_bx(nbi,1) = 101
+    DO ip=2,nbi-1
+       IF ( trip_bx(ip,1) .EQ. 108 .OR. trip_bx(ip,1) .EQ. 102 ) trip_bx(ip,1) = 101
+    ENDDO
+    ! Southern border
+    IF ( trip_bx(1,nbj) .EQ. 104 ) trip_bx(1,nbj) = 105
+    IF ( trip_bx(nbi,nbj) .EQ. 106 ) trip_bx(nbi,nbj) = 105
+    DO ip=2,nbi-1
+       IF ( trip_bx(ip,nbj) .EQ. 104 .OR. trip_bx(ip,nbj) .EQ. 106 ) trip_bx(ip,nbj) = 105
+    ENDDO
+    ! Eastern border
+    IF ( trip_bx(nbi,1) .EQ. 104) trip_bx(nbi,1) = 103
+    IF ( trip_bx(nbi,nbj) .EQ. 102) trip_bx(nbi,nbj) = 103
+    DO jp=2,nbj-1
+       IF ( trip_bx(nbi,jp) .EQ. 104 .OR. trip_bx(nbi,jp) .EQ. 102 ) trip_bx(nbi,jp) = 103
+    ENDDO
+    ! Western border
+    IF ( trip_bx(1,1) .EQ. 106) trip_bx(1,1) = 107
+    IF ( trip_bx(1,nbj) .EQ. 108) trip_bx(1,nbj) = 107
+    DO jp=2,nbj-1
+       IF ( trip_bx(1,jp) .EQ. 106 .OR. trip_bx(1,jp) .EQ. 108 ) trip_bx(1,jp) = 107
+    ENDDO       
+    !
+    !
+  END SUBROUTINE routing_getgrid
+!
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_sortcoord
+!!
+!> BRIEF         This subroutines orders the coordinates to go from North to South and West to East.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_sortcoord(nb_in, coords, direction, nb_out)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)   :: nb_in             !!
+    REAL(r_std), INTENT(inout)   :: coords(nb_in)     !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), INTENT(out)  :: nb_out            !!
+    !
+!! LOCAL VARIABLES
+    CHARACTER(LEN=2)             :: direction         !!
+    INTEGER(i_std)               :: ipos              !!
+    REAL(r_std)                  :: coords_tmp(nb_in) !!
+    INTEGER(i_std), DIMENSION(1) :: ll                !!
+    INTEGER(i_std)               :: ind(nb_in)        !!
+    !
+    ipos = 1
+    nb_out = nb_in
+    !
+    ! Compress the coordinates array
+    !
+    DO WHILE ( ipos < nb_in )
+       IF ( coords(ipos+1) /= undef_sechiba) THEN
+         IF ( COUNT(coords(ipos:nb_out) == coords(ipos)) > 1 ) THEN
+            coords(ipos:nb_out-1) = coords(ipos+1:nb_out) 
+            coords(nb_out:nb_in) = undef_sechiba
+            nb_out = nb_out - 1
+         ELSE
+            ipos = ipos + 1
+         ENDIF
+      ELSE
+         EXIT
+      ENDIF
+    ENDDO
+    !
+    ! Sort it now
+    !
+    ! First we get ready and adjust for the periodicity in longitude
+    !
+    coords_tmp(:) = undef_sechiba
+    IF ( INDEX(direction, 'WE') == 1 .OR.  INDEX(direction, 'EW') == 1) THEN
+       IF ( MAXVAL(ABS(coords(1:nb_out))) .GT. 160 ) THEN
+          coords_tmp(1:nb_out) = MOD(coords(1:nb_out) + 360.0, 360.0)
+       ELSE
+          coords_tmp(1:nb_out) = coords(1:nb_out)
+       ENDIF
+    ELSE IF ( INDEX(direction, 'NS') == 1 .OR.  INDEX(direction, 'SN') == 1) THEN
+       coords_tmp(1:nb_out) = coords(1:nb_out)
+    ELSE
+       WRITE(numout,*) 'The chosen direction (', direction,') is not recognized'
+       STOP 'routing_sortcoord'
+    ENDIF
+    !
+    ! Get it sorted out now
+    !
+    ipos = 1
+    !
+    IF ( INDEX(direction, 'WE') == 1 .OR. INDEX(direction, 'SN') == 1) THEN
+       DO WHILE (COUNT(ABS(coords_tmp(:)-undef_sechiba) > EPSILON(undef_sechiba)*10.) >= 1)
+          ll = MINLOC(coords_tmp(:), coords_tmp /= undef_sechiba)
+          ind(ipos) = ll(1) 
+          coords_tmp(ll(1)) = undef_sechiba
+          ipos = ipos + 1
+       ENDDO
+    ELSE IF ( INDEX(direction, 'EW') == 1 .OR. INDEX(direction, 'NS') == 1) THEN
+       DO WHILE (COUNT(ABS(coords_tmp(:)-undef_sechiba) > EPSILON(undef_sechiba)*10.) >= 1)
+          ll = MAXLOC(coords_tmp(:), coords_tmp /= undef_sechiba)
+          ind(ipos) = ll(1) 
+          coords_tmp(ll(1)) = undef_sechiba
+          ipos = ipos + 1
+       ENDDO
+    ELSE
+       WRITE(numout,*) 'The chosen direction (', direction,') is not recognized (second)'
+       STOP 'routing_sortcoord'
+    ENDIF
+    !
+    coords(1:nb_out) = coords(ind(1:nb_out))
+    IF (nb_out < nb_in) THEN
+       coords(nb_out+1:nb_in) = zero
+    ENDIF
+    !
+  END SUBROUTINE routing_sortcoord
+  !
+
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_findbasins
+!!
+!> BRIEF         This subroutine finds the basins and does some clean up.
+!!               The aim is to return the list off all points which are within the
+!!               same basin of the grid box.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!!  We will also collect all points which directly flow into the ocean in one basin
+!!  Make sure that we do not have a basin with two outflows and other exceptions.
+!!  At this stage no effort is made to come down to the truncation of the model.
+!!
+!! Convention for trip    \n
+!! -------------------    \n
+!! Inside of the box :    \n
+!! trip = 1 : flow = N    \n
+!! trip = 2 : flow = NE    \n
+!! trip = 3 : flow = E    \n
+!! trip = 4 : flow = SE    \n
+!! trip = 5 : flow = S    \n
+!! trip = 6 : flow = SW    \n
+!! trip = 7 : flow = W    \n
+!! trip = 8 : flow = NW    \n
+!! trip = 97 : return flow into the ground    \n
+!! trip = 98 : coastal flow (diffuse flow into the oceans) These values are created here    \n
+!! trip = 99 : river flow into the oceans    \n
+!!
+!! Out flow from the grid :    \n
+!! trip = 101 : flow = N out of the coarse grid    \n
+!! trip = 102 : flow = NE out of the coarse grid    \n
+!! trip = 103 : flow = E out of the coarse grid    \n
+!! trip = 104 : flow = SE out of the coarse grid    \n
+!! trip = 105 : flow = S out of the coarse grid    \n
+!! trip = 106 : flow = SW out of the coarse grid    \n
+!! trip = 107 : flow = W out of the coarse grid    \n
+!! trip = 108 : flow = NW out of the coarse grid!    \n
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE routing_findbasins(nbi, nbj, trip, basin, hierarchy, topoind, nb_basin, basin_inbxid, basin_sz,&
+       & basin_bxout, basin_pts, coast_pts)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)    :: nbi                          !! Number of point in x within the grid (unitless)
+    INTEGER(i_std), INTENT(in)    :: nbj                          !! Number of point in y within the grid (unitless)
+    REAL(r_std), INTENT(in)       :: hierarchy(:,:)               !!
+    REAL(r_std), INTENT(in)       :: topoind(:,:)                 !! Topographic index of the residence time (m)
+    !
+    !  Modified
+    INTEGER(i_std), INTENT(inout) :: trip(:,:)                    !! The trip field (unitless)
+    INTEGER(i_std), INTENT(inout) :: basin(:,:)                   !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), INTENT(out)   :: nb_basin                     !! Number of sub-basins (unitless)
+    INTEGER(i_std), INTENT(out)   :: basin_inbxid(nbvmax)         !!
+    INTEGER(i_std), INTENT(out)   :: basin_sz(nbvmax)             !!
+    INTEGER(i_std), INTENT(out)   :: basin_bxout(nbvmax)          !!
+    INTEGER(i_std), INTENT(out)   :: basin_pts(nbvmax, nbvmax, 2) !!
+    INTEGER(i_std), INTENT(out)   :: coast_pts(nbvmax)            !! The coastal flow points (unitless)
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                :: ibas, ilf, nbb, nb_in        !!
+    INTEGER(i_std)                :: bname(nbvmax)                !!
+    INTEGER(i_std)                :: sz(nbvmax)                   !!
+    INTEGER(i_std)                :: pts(nbvmax,nbvmax,2)         !!
+    INTEGER(i_std)                :: nbout(nbvmax)                !!
+    INTEGER(i_std)                :: new_nb                       !!
+    INTEGER(i_std)                :: new_bname(nbvmax)            !!
+    INTEGER(i_std)                :: new_sz(nbvmax)               !!
+    INTEGER(i_std)                :: new_pts(nbvmax,nbvmax,2)     !!
+    INTEGER(i_std)                :: itrans                       !!
+    INTEGER(i_std)                :: trans(nbvmax)                !!
+    INTEGER(i_std)                :: outdir(nbvmax)               !!
+    INTEGER(i_std)                :: tmpsz(nbvmax)                !!
+    INTEGER(i_std)                :: ip, jp, jpp(1), ipb          !!
+    INTEGER(i_std)                :: sortind(nbvmax)              !!
+    CHARACTER(LEN=7)              :: fmt                          !!
+    !
+    nbb = 0
+    ibas = -1
+    bname(:) = undef_int
+    sz(:) = 0
+    nbout(:) = 0
+    new_pts(:,:,:) = 0
+    !
+    ! 1.0 Find all basins within this grid box
+    !     Sort the variables per basin so that we can more easily
+    !     access data from the same basin (The variables are :
+    !     bname, sz, pts, nbout)
+    !
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( basin(ip,jp) .LT. undef_int) THEN
+             IF ( COUNT(basin(ip,jp) .EQ. bname(:)) .EQ. 0 ) THEN
+                nbb = nbb + 1
+                IF ( nbb .GT. nbvmax ) STOP 'nbvmax too small'
+                bname(nbb) = basin(ip,jp)
+                sz(nbb) = 0
+             ENDIF
+             !
+             DO ilf=1,nbb
+                IF ( basin(ip,jp) .EQ. bname(ilf) ) THEN
+                   ibas = ilf
+                ENDIF
+             ENDDO
+             !
+             sz(ibas) = sz(ibas) + 1
+             IF ( sz(ibas) .GT. nbvmax ) STOP 'nbvmax too small'
+             pts(ibas, sz(ibas), 1) = ip
+             pts(ibas, sz(ibas), 2) = jp
+             ! We deal only with outflow and leave flow back into the grid box for later.
+             IF ( trip(ip,jp) .GE. 97 ) THEN
+                nbout(ibas) = nbout(ibas) + 1
+             ENDIF
+             !
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! 2.0 All basins which have size 1 and flow to the ocean are put together.
+    !
+    itrans = 0
+    coast_pts(:) = undef_int
+    ! Get all the points we can collect
+    DO ip=1,nbb
+       IF ( sz(ip) .EQ. 1 .AND. trip(pts(ip,1,1),pts(ip,1,2)) .EQ. 99) THEN
+          itrans = itrans + 1
+          trans(itrans) = ip
+          trip(pts(ip,1,1),pts(ip,1,2)) = 98
+       ENDIF
+    ENDDO
+    ! put everything in the first basin
+    IF ( itrans .GT. 1) THEN
+       ipb = trans(1)
+       coast_pts(sz(ipb)) = bname(ipb)
+       bname(ipb) = -1
+       DO ip=2,itrans
+          sz(ipb) = sz(ipb) + 1
+          coast_pts(sz(ipb)) = bname(trans(ip))
+          sz(trans(ip)) = 0
+          pts(ipb, sz(ipb), 1) = pts(trans(ip), 1, 1) 
+          pts(ipb, sz(ipb), 2) = pts(trans(ip), 1, 2) 
+       ENDDO
+    ENDIF
+    !
+    ! 3.0 Make sure that we have only one outflow point in each basin
+    !
+    ! nbb is the number of basins on this grid box.
+    new_nb = 0
+    DO ip=1,nbb
+       ! We only do this for grid-points which have more than one outflow
+       IF ( sz(ip) .GT. 1 .AND. nbout(ip) .GT. 1) THEN
+          !
+          ! Pick up all points needed and store them in trans
+          !
+          itrans = 0
+          DO jp=1,sz(ip)
+             IF ( trip(pts(ip,jp,1),pts(ip,jp,2)) .GE. 97) THEN
+                itrans = itrans + 1
+                trans(itrans) = trip(pts(ip,jp,1),pts(ip,jp,2))
+             ENDIF
+          ENDDO
+          !
+          ! First issue : We have more than one point of the basin which flows into
+          ! the ocean. In this case we put everything into coastal flow. It will go into
+          ! a separate basin in the routing_globalize routine.
+          !
+          IF ( (COUNT(trans(1:itrans) .EQ. 99) + COUNT(trans(1:itrans) .EQ. 98)) .GT. 1) THEN
+             DO jp=1,sz(ip)
+                IF ( trip(pts(ip,jp,1),pts(ip,jp,2)) .EQ. 99 ) THEN
+                   trip(pts(ip,jp,1),pts(ip,jp,2)) = 98
+                   trans(itrans) = trip(pts(ip,jp,1),pts(ip,jp,2))
+                ENDIF
+             ENDDO
+          ENDIF
+          !
+          ! Second issue : We have redundant outflows at the boundaries. That is two small grid
+          ! boxes flowing into the same GCM grid box.
+          !
+          IF ( COUNT(trans(1:itrans) .GT. 100) .GE. 1) THEN
+             CALL routing_simplify(nbi, nbj, trip, basin, hierarchy, bname(ip))
+             itrans = 0
+             DO jp=1,sz(ip)
+                IF ( trip(pts(ip,jp,1),pts(ip,jp,2)) .GE. 9) THEN
+                   itrans = itrans + 1
+                   trans(itrans) = trip(pts(ip,jp,1),pts(ip,jp,2))
+                ENDIF
+             ENDDO
+          ENDIF
+          !
+          ! Third issue : we have more than one outflow from the boxes. This could be 
+          !             - flow into 2 or more neighboring GCM grids
+          !             - flow into a neighboring GCM grids and into the ocean or be a return flow (=97. =98, =99)
+          !             - flow into a neighboring GCM grids or ocean and back into the same GCM grid box
+          ! The only solution is to cut the basin up in as many parts.
+          !
+          IF ( COUNT(trans(1:itrans) .GE. 97) .GT. 1) THEN
+             !
+             nb_in =  new_nb
+             CALL routing_cutbasin(nbi, nbj, nbb, trip, basin, bname(ip), new_nb, new_bname, new_sz, new_pts)
+             !
+             ! If we have split the basin then we need to cancel the old one
+             !
+             IF ( nb_in .NE. new_nb) THEN
+                sz(ip) = 0
+             ENDIF
+             !
+          ENDIF
+          !
+       ENDIF
+    ENDDO
+    !
+    !  Add the new basins to the end of the list
+    !
+    If ( nbb+new_nb .LE. nbvmax) THEN
+       DO ip=1,new_nb
+          bname(nbb+ip) = new_bname(ip)
+          sz(nbb+ip) = new_sz(ip)
+          pts(nbb+ip,:,:) = new_pts(ip,:,:)
+       ENDDO
+       nbb = nbb+new_nb
+    ELSE
+       WRITE(numout,*) 'Increase nbvmax. It is too small to contain all the basins (routing_findbasins)'
+       STOP
+    ENDIF
+    !
+    ! Keep the output direction
+    !
+    DO ip=1,nbb
+       IF ( sz(ip) .GT. 0 ) THEN
+          trans(:) = 0
+          DO jp=1,sz(ip)
+             trans(jp) = trip(pts(ip,jp,1),pts(ip,jp,2))
+          ENDDO
+          outdir(ip) = MAXVAL(trans(1:sz(ip)))
+          IF ( outdir(ip) .GE. 97 ) THEN
+             outdir(ip) = outdir(ip) - 100
+          ELSE
+             WRITE(numout,*) 'Why are we here and can not find a trip larger than 96'
+             WRITE(numout,*) 'Does this mean that the basin does not have any outflow ', ip, bname(ip)
+             WRITE(fmt,"('(',I3,'I9)')") nbi
+             WRITE(numout,*) '-----------------------> trip'
+             DO jp=1,nbj
+                WRITE(numout,fmt) trip(1:nbi,jp)
+             ENDDO
+             WRITE(numout,*) '-----------------------> basin'
+             DO jp=1,nbj
+                WRITE(numout,fmt) basin(1:nbi,jp)
+             ENDDO
+             STOP 'SUBROUTINE : routing_findbasins'
+          ENDIF
+       ENDIF
+    ENDDO
+    !
+    !
+    ! Sort the output by size of the various basins. 
+    !
+    nb_basin = COUNT(sz(1:nbb) .GT. 0)
+    tmpsz(:) = -1
+    tmpsz(1:nbb) = sz(1:nbb)
+    DO ip=1,nbb
+       jpp = MAXLOC(tmpsz(:))
+       IF ( sz(jpp(1)) .GT. 0) THEN
+          sortind(ip) = jpp(1)
+          tmpsz(jpp(1)) = -1
+       ENDIF
+    ENDDO
+    basin_inbxid(1:nb_basin) = bname(sortind(1:nb_basin))
+    basin_sz(1:nb_basin) = sz(sortind(1:nb_basin))
+    basin_pts(1:nb_basin,:,:) = pts(sortind(1:nb_basin),:,:)
+    basin_bxout(1:nb_basin) = outdir(sortind(1:nb_basin))
+    !
+    ! We can only check if we have at least as many outflows as basins
+    !
+    ip = COUNT(trip(1:nbi,1:nbj) .GE. 97 .AND. trip(1:nbi,1:nbj) .LT. undef_int)
+!!    ip = ip + COUNT(trip(1:nbi,1:nbj) .EQ. 97)
+!!    IF ( COUNT(trip(1:nbi,1:nbj) .EQ. 98) .GT. 0) ip = ip + 1
+    IF ( ip .LT. nb_basin ) THEN
+       WRITE(numout,*) 'We have less outflow points than basins :', ip
+       WRITE(fmt,"('(',I3,'I9)')") nbi
+       WRITE(numout,*) '-----------------------> trip'
+       DO jp=1,nbj
+          WRITE(numout,fmt) trip(1:nbi,jp)
+       ENDDO
+       WRITE(numout,*) '-----------------------> basin'
+       DO jp=1,nbj
+          WRITE(numout,fmt) basin(1:nbi,jp)
+       ENDDO
+       WRITE(numout,*) 'nb_basin :', nb_basin
+       WRITE(numout,*) 'Basin sized :', basin_sz(1:nb_basin)
+       STOP 'in routing_findbasins'
+    ENDIF
+    !
+  END SUBROUTINE routing_findbasins
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_simplify
+!!
+!> BRIEF         This subroutine symplifies the routing out of each basin by taking 
+!!               out redundancies at the borders of the GCM box.
+!!               The aim is to have only one outflow point per basin and grid box.
+!!               But here we will not change the direction of the outflow.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_simplify(nbi, nbj, trip, basin, hierarchy, basin_inbxid)
+    !
+    IMPLICIT NONE
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                             :: nbi                        !! Number of point in x within the grid (unitless)
+    INTEGER(i_std)                             :: nbj                        !! Number of point in y within the grid (unitless)
+    INTEGER(i_std)                             :: trip(:,:)                  !! The trip field (unitless)
+    INTEGER(i_std)                             :: basin(:,:)                 !!
+    REAL(r_std)                                :: hierarchy(:,:)             !!
+    INTEGER(i_std)                             :: basin_inbxid               !!
+    !
+    INTEGER(i_std)                             :: ip, jp, nbout, basin_sz, iborder !!
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)   :: trip_tmp                   !! Temporary trip field which only contains the values for the basin on which we currently work (1)
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2) :: trip_flow                  !!
+    INTEGER(i_std), DIMENSION(nbvmax,2)        :: outflow                    !!
+    INTEGER(i_std), DIMENSION(nbvmax)          :: outsz                      !!
+    CHARACTER(LEN=7)                           :: fmt                        !!
+    !
+    INTEGER(i_std), DIMENSION(8,2)             :: inc                        !!
+    INTEGER(i_std)                             :: itodo, ill(1), icc, ismall, ibas, iip, jjp, ib, id !! Indices (unitless)
+    INTEGER(i_std), DIMENSION(nbvmax)          :: todopt                     !!
+!$, todosz
+    REAL(r_std), DIMENSION(nbvmax)             :: todohi                     !!
+    LOGICAL                                    :: not_found, debug = .FALSE. !! (true/false)
+    !
+    !
+    !  The routing code (i=1, j=2)
+    !
+    inc(1,1) = 0
+    inc(1,2) = -1
+    inc(2,1) = 1
+    inc(2,2) = -1
+    inc(3,1) = 1
+    inc(3,2) = 0
+    inc(4,1) = 1
+    inc(4,2) = 1
+    inc(5,1) = 0
+    inc(5,2) = 1
+    inc(6,1) = -1
+    inc(6,2) = 1
+    inc(7,1) = -1
+    inc(7,2) = 0
+    inc(8,1) = -1
+    inc(8,2) = -1
+    !
+    !
+    !  Symplify the outflow conditions first. We are only interested in the
+    !  outflows which go to different GCM grid boxes.
+    !
+    IF ( debug ) THEN
+       WRITE(numout,*) '+++++++++++++++++++ BEFORE ANYTHING ++++++++++++++++++++'
+       WRITE(fmt,"('(',I3,'I6)')") nbi
+       DO jp=1,nbj
+          WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+       ENDDO
+    ENDIF
+    !
+    !  transfer the trips into an array which only contains the basin we are interested in
+    !
+    trip_tmp(:,:) = -1
+    basin_sz = 0
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( basin(ip,jp) .EQ. basin_inbxid) THEN
+             trip_tmp(ip,jp) = trip(ip,jp)
+             basin_sz = basin_sz + 1
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Determine for each point where it flows to
+    !
+    CALL routing_findrout(nbi, nbj, trip_tmp, basin_sz, basin_inbxid, nbout, outflow, trip_flow, outsz)
+    !
+    !
+    !
+    !
+    ! Over the width of a GCM grid box we can have many outflows but we are interested
+    ! in only one for each basin. Thus we wish to collect them all to form only one outflow
+    ! to the neighboring grid box.
+    !
+    DO iborder = 101,107,2
+       !
+       ! If we have more than one of these outflows then we need to merge the sub-basins
+       !
+       icc = COUNT(trip_tmp .EQ. iborder)-1
+       DO WHILE ( icc .GT. 0)
+          ! Pick out all the points we will have to do
+          itodo = 0
+          DO ip=1,nbout
+             IF (trip_tmp(outflow(ip,1),outflow(ip,2)) .EQ. iborder) THEN
+                itodo = itodo + 1
+                todopt(itodo) = ip
+!$                todosz(itodo) = outsz(ip)
+                ! We take the hierarchy of the outflow point as we will try to
+                ! minimize if for the outflow of the entire basin.
+                todohi(itodo) = hierarchy(outflow(ip,1),outflow(ip,2))
+             ENDIF
+          ENDDO
+          !
+          ! We change the direction of the smallest basin.
+          !
+          ill=MAXLOC(todohi(1:itodo))
+          ismall = todopt(ill(1))
+          !
+          DO ip=1,nbi
+             DO jp=1,nbj
+                IF ( trip_flow(ip,jp,1) .EQ. outflow(ismall,1) .AND.&
+                     & trip_flow(ip,jp,2) .EQ. outflow(ismall,2) ) THEN
+                   ! Now that we have found a point of the smallest sub-basin we 
+                   ! look around for another sub-basin
+                   ib = 1
+                   not_found = .TRUE.
+                   DO WHILE ( not_found .AND. ib .LE. itodo ) 
+                      IF ( ib .NE. ill(1) ) THEN
+                         ibas = todopt(ib)
+                         DO id=1,8
+                            iip = ip + inc(id,1)
+                            jjp = jp + inc(id,2)
+                            ! Can we look at this points or is there any need to ?
+                            IF ( iip .GE. 1 .AND. iip .LE. nbi .AND. &
+                                 & jjp .GE. 1 .AND. jjp .LE. nbj .AND. not_found) THEN
+                               ! Is this point the one we look for ?
+                               IF ( trip_flow(iip,jjp,1) .EQ. outflow(ibas,1) .AND. &
+                                    & trip_flow(iip,jjp,2) .EQ. outflow(ibas,2)) THEN
+                                  trip_flow(ip,jp,1) = outflow(ibas,1)
+                                  trip_flow(ip,jp,2) = outflow(ibas,2)
+                                  trip_tmp(ip,jp) = id
+                                  ! This last line ensures that we do not come back to this point
+                                  ! and that in the end the outer while will stop
+                                  not_found = .FALSE.
+                               ENDIF
+                            ENDIF
+                         ENDDO
+                      ENDIF
+                      ib = ib + 1
+                   ENDDO
+                ENDIF
+             ENDDO
+          ENDDO
+          !
+          icc = icc - 1
+       ENDDO
+       !
+       !
+    ENDDO
+    !
+    IF ( debug ) THEN
+       WRITE(numout,*) '+++++++++++++++++++ AFTER +++++++++++++++++++++++++++++'
+       WRITE(fmt,"('(',I3,'I6)')") nbi
+       DO jp=1,nbj
+          WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+       ENDDO
+    ENDIF
+    !
+    !  Put trip_tmp back into trip
+    !
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( trip_tmp(ip,jp) .GT. 0) THEN
+             trip(ip,jp) = trip_tmp(ip,jp)
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE routing_simplify
+!
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_cutbasin
+!!
+!> BRIEF        This subroutine cuts the original basin which has more than one outflow
+!!              into as many subbasins as outflow directions.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_cutbasin (nbi, nbj, nbbasins, trip, basin, basin_inbxid, nb, bname, sz, pts)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                 :: nbi, nbj             !! Number of point in x and y within the grid (unitless)
+    INTEGER(i_std), INTENT(in)                 :: nbbasins             !!
+    INTEGER(i_std), INTENT(in)                 :: basin_inbxid         !!
+    !
+    !  Modified
+    INTEGER(i_std), INTENT(inout)              :: trip(:,:)            !! The trip field (unitless)
+    INTEGER(i_std), INTENT(inout)              :: basin(:,:)           !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), INTENT(out)                :: nb                   !!
+    INTEGER(i_std), INTENT(out)                :: bname(nbvmax)        !!
+    INTEGER(i_std), INTENT(out)                :: sz(nbvmax)           !!
+    INTEGER(i_std), INTENT(out)                :: pts(nbvmax,nbvmax,2) !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                             :: ip, jp, iip, jjp, ib, ibb, id, nbout !! Indices (unitless)
+    INTEGER(i_std)                             :: basin_sz             !!
+    INTEGER(i_std)                             :: nb_in                !!
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)   :: trip_tmp             !! Temporary trip field which only contains the values for the basin on which we currently work (unitless)
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2) :: trip_flow            !!
+    INTEGER(i_std), DIMENSION(nbvmax,2)        :: outflow              !!
+    INTEGER(i_std), DIMENSION(nbvmax)          :: outsz                !!
+    CHARACTER(LEN=7)                           :: fmt                  !!
+    LOGICAL                                    :: not_found            !! (true/false)
+    LOGICAL                                    :: debug=.FALSE.        !! (true/false)
+    !
+    INTEGER(i_std), DIMENSION(8,2)             :: inc                  !!
+    !
+    !
+    !  The routing code (i=1, j=2)
+    !
+    inc(1,1) = 0
+    inc(1,2) = -1
+    inc(2,1) = 1
+    inc(2,2) = -1
+    inc(3,1) = 1
+    inc(3,2) = 0
+    inc(4,1) = 1
+    inc(4,2) = 1
+    inc(5,1) = 0
+    inc(5,2) = 1
+    inc(6,1) = -1
+    inc(6,2) = 1
+    inc(7,1) = -1
+    inc(7,2) = 0
+    inc(8,1) = -1
+    inc(8,2) = -1
+    !
+    ! Set up a temporary trip field which only contains the values
+    ! for the basin on which we currently work.
+    !
+    trip_tmp(:,:) = -1
+    basin_sz = 0
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( basin(ip,jp) .EQ. basin_inbxid) THEN
+             trip_tmp(ip,jp) = trip(ip,jp)
+             basin_sz = basin_sz + 1
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    CALL routing_findrout(nbi, nbj, trip_tmp, basin_sz, basin_inbxid, nbout, outflow, trip_flow, outsz)
+    ! 
+!    IF ( debug ) THEN
+!       DO ib = nb_in+1,nb
+!          DO ip=1,sz(ib)
+!             trip_tmp(pts(ib, ip, 1),pts(ib, ip, 2)) = ib*(-1)-900
+!          ENDDO
+!       ENDDO
+!       WRITE(fmt,"('(',I3,'I6)')") nbi
+!       WRITE(numout,*)  'BEFORE ------------> New basins '
+!       WRITE(numout,*) nb, ' sz :', sz(1:nb)
+!       DO jp=1,nbj
+!          WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+!       ENDDO
+!    ENDIF
+    !
+    !  Take out the small sub-basins. That is those which have only one grid box
+    !  This is only done if we need to save space in the number of basins. Else we
+    !  can take it easy and keep diverging sub-basins for the moment. 
+    !
+    IF ( nbbasins .GE. nbasmax ) THEN
+       DO ib=1,nbout
+          ! If the sub-basin is of size one and its larger neighbor is flowing into another
+          ! direction then we put them together.
+          IF ( outsz(ib) .EQ. 1 .AND. trip(outflow(ib,1), outflow(ib,2)) .GT. 99 ) THEN
+             !
+             not_found = .TRUE.
+             DO id=1,8
+                ip = outflow(ib,1)
+                jp = outflow(ib,2)
+                iip = ip + inc(id,1)
+                jjp = jp + inc(id,2)
+                ! Can we look at this points ?
+                IF ( iip .GE. 1 .AND. iip .LE. nbi .AND. &
+                     & jjp .GE. 1 .AND. jjp .LE. nbj .AND. not_found) THEN
+                   ! Did we find a direct neighbor which is an outflow point ?
+                   IF ( trip_tmp(iip,jjp) .GT. 100 ) THEN
+                      ! IF so direct the flow towards it and update the tables.
+                      not_found = .FALSE.
+                      trip(ip,jp) = id
+                      trip_tmp(ip,jp) = id
+                      outsz(ib) = 0
+                      ! update the table of this basin
+                      DO ibb=1,nbout
+                         IF ( iip .EQ. outflow(ibb,1) .AND. jjp .EQ. outflow(ibb,2) ) THEN
+                            outsz(ibb) = outsz(ibb)+1 
+                            trip_flow(ip,jp,1) = outflow(ibb,1)
+                            trip_flow(ip,jp,2) = outflow(ibb,2)
+                         ENDIF
+                      ENDDO
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDIF
+    !
+    !
+    !  Cut the basin if we have more than 1 left.
+    !
+    !
+    IF ( COUNT(outsz(1:nbout) .GT. 0) .GT. 1 ) THEN
+       !
+       nb_in = nb
+       !
+       DO ib = 1,nbout
+          IF ( outsz(ib) .GT. 0) THEN
+             nb = nb+1
+             IF ( nb .GT. nbvmax) THEN
+                WRITE(numout,*) 'nbvmax too small, increase it (routing_cutbasin)'
+             ENDIF
+             bname(nb) = basin_inbxid
+             sz(nb) = 0
+             DO ip=1,nbi
+                DO jp=1,nbj
+                   IF ( (trip_flow(ip,jp,1) + trip_flow(ip,jp,1)) .GT. 0 .AND. &
+                      & trip_flow(ip,jp,1) .EQ. outflow(ib,1) .AND. &
+                      & trip_flow(ip,jp,2) .EQ. outflow(ib,2) ) THEN
+                      sz(nb) = sz(nb) + 1
+                      pts(nb, sz(nb), 1) = ip
+                      pts(nb, sz(nb), 2) = jp
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDIF
+       ENDDO
+       ! A short verification 
+       IF ( SUM(sz(nb_in+1:nb)) .NE. basin_sz) THEN
+          WRITE(numout,*) 'Lost some points while spliting the basin'
+          WRITE(numout,*) 'nbout :', nbout
+          DO ib = nb_in+1,nb
+             WRITE(numout,*) 'ib, SZ :', ib, sz(ib)
+          ENDDO
+          WRITE(fmt,"('(',I3,'I6)')") nbi
+          WRITE(numout,*)  '-------------> trip '
+          DO jp=1,nbj
+             WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+          ENDDO
+          STOP
+       ENDIF
+       !
+       IF ( debug ) THEN
+          DO ib = nb_in+1,nb
+             DO ip=1,sz(ib)
+                trip_tmp(pts(ib, ip, 1),pts(ib, ip, 2)) = ib*(-1)-900
+             ENDDO
+          ENDDO
+          WRITE(fmt,"('(',I3,'I6)')") nbi
+          WRITE(numout,*)  'AFTER-------------> New basins '
+          WRITE(numout,*) nb, ' sz :', sz(1:nb)
+          DO jp=1,nbj
+             WRITE(numout,fmt) trip_tmp(1:nbi,jp)
+          ENDDO
+          IF ( MAXVAl(trip_tmp(1:nbi,1:nbj)) .GT. 0) THEN
+             STOP
+          ENDIF
+       ENDIF
+    ENDIF
+    !
+  END SUBROUTINE routing_cutbasin
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_hierarchy
+!!
+!> BRIEF        This subroutine finds, for each point, the distance to the outflow
+!!               point along the flowlines of the basin. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_hierarchy(iml, jml, trip, topoindex, hierarchy)
+    !
+    IMPLICIT NONE
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                  :: iml          !! X resolution of the high resolution grid
+    INTEGER(i_std)                  :: jml          !! Y resolution of the high resolution grid
+    REAL(r_std), DIMENSION(iml,jml) :: trip         !! The trip field (unitless)
+    REAL(r_std), DIMENSION(iml,jml) :: hierarchy    !!
+    REAL(r_std), DIMENSION(iml,jml) :: topoindex    !! Topographic index of the residence time (m)
+    !
+    INTEGER(i_std), DIMENSION(8,2)  :: inc          !!
+    INTEGER(i_std)                  :: ip, jp, ib, ntripi, ntripj, cnt, trp !!
+    REAL(r_std)                     :: topohier     !! The new value of topographically weighted hierarchy (m)
+    REAL(r_std)                     :: topohier_old !! The old value of topographically weighted hierarchy (m)
+    CHARACTER(LEN=7)                :: fmt          !!
+    !
+    !  The routing code (i=1, j=2)
+    !
+    inc(1,1) = 0
+    inc(1,2) = -1
+    inc(2,1) = 1
+    inc(2,2) = -1
+    inc(3,1) = 1
+    inc(3,2) = 0
+    inc(4,1) = 1
+    inc(4,2) = 1
+    inc(5,1) = 0
+    inc(5,2) = 1
+    inc(6,1) = -1
+    inc(6,2) = 1
+    inc(7,1) = -1
+    inc(7,2) = 0
+    inc(8,1) = -1
+    inc(8,2) = -1
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          IF ( trip(ip,jp) .LT. undef_sechiba ) THEN
+             ntripi = ip
+             ntripj = jp
+             trp = NINT(trip(ip,jp))
+             cnt = 1
+             ! Warn for extreme numbers
+             IF (  topoindex(ip,jp) .GT. 1.e10 ) THEN
+                WRITE(numout,*) 'We have a very large topographic index for point ', ip, jp
+                WRITE(numout,*) 'This can not be right :', topoindex(ip,jp)
+                STOP
+             ELSE
+                topohier = topoindex(ip,jp)
+             ENDIF
+             !
+             DO WHILE ( trp .GT. 0 .AND. trp .LT. 9 .AND. cnt .LT. iml*jml) 
+                cnt = cnt + 1
+                ntripi = ntripi + inc(trp,1)
+                IF ( ntripi .LT. 1) ntripi = iml
+                IF ( ntripi .GT. iml) ntripi = 1
+                ntripj = ntripj + inc(trp,2)
+                topohier_old = topohier
+                topohier = topohier + topoindex(ntripi, ntripj)
+                IF ( topohier_old .GT. topohier) THEN
+                   WRITE(numout,*) 'Big Problem, how comes we climb up a hill ?'
+                   WRITE(numout,*) 'The old value of topographicaly weighted hierarchy was : ', topohier_old
+                   WRITE(numout,*) 'The new one is :', topohier
+                   STOP 'routing_hierarchy'
+                ENDIF
+                trp = NINT(trip(ntripi, ntripj))
+             ENDDO
+             !
+             IF ( cnt .EQ. iml*jml) THEN
+                WRITE(numout,*) 'We could not route point (routing_findrout) :', ip, jp
+                WRITE(numout,*) '-------------> trip '
+                WRITE(fmt,"('(',I3,'I6)')") iml
+                DO ib=1,jml
+                   WRITE(numout,fmt) trip(1:iml,ib)
+                ENDDO
+                STOP
+             ENDIF
+             !
+             hierarchy(ip,jp) = topohier
+             !
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    !
+  END SUBROUTINE routing_hierarchy
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_findrout
+!!
+!> BRIEF        This subroutine simply computes the route to each outflow point
+!!              and returns the outflow point for each point in the basin.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_findrout(nbi, nbj, trip, basin_sz, basinid, nbout, outflow, trip_flow, outsz)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std)                                          :: nbi       !! Number of point in x within the grid (unitless)
+    INTEGER(i_std)                                          :: nbj       !! Number of point in y within the grid (unitless)
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)                :: trip      !! The trip field (unitless)
+    INTEGER(i_std)                                          :: basin_sz  !!
+    INTEGER(i_std)                                          :: basinid   !!
+    !
+!! OUTPUT VARIABLES
+    INTEGER(i_std), DIMENSION(nbvmax,2), INTENT(out)        :: outflow   !!
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2), INTENT(out) :: trip_flow !!
+    INTEGER(i_std), INTENT(out)                             :: nbout     !! 
+    INTEGER(i_std), DIMENSION(nbvmax), INTENT(out)          :: outsz     !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std), DIMENSION(8,2)                          :: inc       !!
+    INTEGER(i_std)                                          :: ip, jp, ib, cnt, trp, totsz !! Indices (unitless)
+    CHARACTER(LEN=7)                                        :: fmt       !!
+    !
+    !
+    !  The routing code (i=1, j=2)
+    !
+    inc(1,1) = 0
+    inc(1,2) = -1
+    inc(2,1) = 1
+    inc(2,2) = -1
+    inc(3,1) = 1
+    inc(3,2) = 0
+    inc(4,1) = 1
+    inc(4,2) = 1
+    inc(5,1) = 0
+    inc(5,2) = 1
+    inc(6,1) = -1
+    inc(6,2) = 1
+    inc(7,1) = -1
+    inc(7,2) = 0
+    inc(8,1) = -1
+    inc(8,2) = -1
+    !
+    !
+    !  Get the outflows and determine for each point to which outflow point it belong 
+    !
+    nbout = 0
+    trip_flow(:,:,:) = 0
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( trip(ip,jp) .GT. 9) THEN
+             nbout = nbout + 1
+             outflow(nbout,1) = ip
+             outflow(nbout,2) = jp
+          ENDIF 
+          IF ( trip(ip,jp) .GT. 0) THEN
+             trip_flow(ip,jp,1) = ip
+             trip_flow(ip,jp,2) = jp
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Follow the flow of the water
+    !
+    DO ip=1,nbi
+       DO jp=1,nbj
+          IF ( (trip_flow(ip,jp,1) + trip_flow(ip,jp,2)) .GT. 0) THEN
+             trp = trip(trip_flow(ip,jp,1), trip_flow(ip,jp,2))
+             cnt = 0
+             DO WHILE ( trp .GT. 0 .AND. trp .LT. 9 .AND. cnt .LT. nbi*nbj) 
+                cnt = cnt + 1
+                trip_flow(ip,jp,1) = trip_flow(ip,jp,1) + inc(trp,1)
+                trip_flow(ip,jp,2) = trip_flow(ip,jp,2) + inc(trp,2)
+                trp = trip(trip_flow(ip,jp,1), trip_flow(ip,jp,2))
+             ENDDO
+             IF ( cnt .EQ. nbi*nbj) THEN
+                WRITE(numout,*) 'We could not route point (routing_findrout) :', ip, jp
+                WRITE(numout,*) '-------------> trip '
+                WRITE(fmt,"('(',I3,'I6)')") nbi
+                DO ib=1,nbj
+                   WRITE(numout,fmt) trip(1:nbi,ib)
+                ENDDO
+                STOP
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    !  What is the size of the region behind each outflow point ?
+    !
+    totsz = 0
+    DO ip=1,nbout
+       outsz(ip) = COUNT(trip_flow(:,:,1) .EQ. outflow(ip,1) .AND. trip_flow(:,:,2) .EQ. outflow(ip,2))
+       totsz = totsz + outsz(ip)
+    ENDDO
+    IF ( basin_sz .NE. totsz) THEN
+       WRITE(numout,*) 'Water got lost while I tried to follow it '
+       WRITE(numout,*) basin_sz, totsz
+       WRITE(numout,*) 'Basin id :', basinid
+       DO ip=1,nbout
+          WRITE(numout,*) 'ip :', ip, ' outsz :', outsz(ip), ' outflow :', outflow(ip,1), outflow(ip,2)
+       ENDDO
+       WRITE(numout,*) '-------------> trip '
+       WRITE(fmt,"('(',I3,'I6)')") nbi
+       DO jp=1,nbj
+          WRITE(numout,fmt) trip(1:nbi,jp)
+       ENDDO
+       STOP
+    ENDIF
+    !
+  END SUBROUTINE routing_findrout
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_globalize
+!!
+!> BRIEF        This subroutine puts the basins found for grid box in the global map.
+!!               Connection can only be made later when all information is together. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!! One of the outputs is basin_flowdir. Its convention is 1-8 for the directions from North to North
+!! West going through South. The negative values will be -3 for return flow, -2 for coastal flow
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_globalize(nbpt, ib, neighbours, area_bx, trip_bx, hierarchy_bx, topoind_bx, min_topoind,&
+       & nb_basin, basin_inbxid, basin_sz, basin_pts, basin_bxout, coast_pts, nwbas, basin_count,&
+       & basin_area, basin_hierarchy, basin_topoind, basin_id, basin_flowdir, outflow_grid,&
+       & nbcoastal, coastal_basin)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT (in)                :: nbpt                   !! Domain size (unitless)
+    INTEGER(i_std), INTENT (in)                :: ib                     !! Current basin (unitless)
+    INTEGER(i_std), INTENT(in)                 :: neighbours(nbpt,8)     !! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    !
+!! LOCAL VARIABLES 
+    REAL(r_std), DIMENSION(nbvmax,nbvmax)      :: area_bx                !! Area of each small box in the grid box @tex $(m^2})$ @endtex
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)   :: trip_bx                !! The trip field for each of the smaller boxes (unitless)
+    REAL(r_std), DIMENSION(nbvmax,nbvmax)      :: hierarchy_bx           !! Level in the basin of the point
+    REAL(r_std), DIMENSION(nbvmax,nbvmax)      :: topoind_bx             !! Topographic index of the residence time for each of the smaller boxes (m)
+    REAL(r_std)                                :: min_topoind            !! The current minimum of topographic index (m)
+    INTEGER(i_std)                             :: nb_basin               !! Number of sub-basins (unitless)
+    INTEGER(i_std), DIMENSION(nbvmax)          :: basin_inbxid, basin_sz !! ID of basin, number of points in the basin
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2) :: basin_pts              !! Points in each basin
+    INTEGER(i_std), DIMENSION(nbvmax)          :: basin_bxout            !! outflow direction
+    INTEGER(i_std)                             :: coast_pts(nbvmax)      !! The coastal flow points (unitless)
+    ! global maps
+    INTEGER(i_std)                             :: nwbas                  !!
+    INTEGER(i_std), DIMENSION(nbpt)            :: basin_count            !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)      :: basin_id               !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)      :: basin_flowdir          !! Water flow directions in the basin (unitless)
+    REAL(r_std), DIMENSION(nbpt,nwbas)         :: basin_area             !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)         :: basin_hierarchy        !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)         :: basin_topoind          !! Topographic index of the residence time for a basin (m)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)      :: outflow_grid           !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt)            :: nbcoastal              !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)      :: coastal_basin          !!
+    !
+    INTEGER(i_std)                             :: ij, iz                 !! Indices (unitless)
+    CHARACTER(LEN=4)                           :: hierar_method = 'OUTP' !!
+    !
+    !
+    DO ij=1, nb_basin
+       !
+       ! Count the basins and keep their ID
+       !
+       basin_count(ib) = basin_count(ib)+1
+       if (basin_count(ib) > nwbas) then 
+          WRITE(numout,*) 'ib=',ib
+          call ipslerr(3,'routing_globalize', &
+               &      'Problem with basin_count : ', & 
+               &      'It is greater than number of allocated basin nwbas.', &
+               &      '(stop to count basins)')
+       endif 
+       basin_id(ib,basin_count(ib)) = basin_inbxid(ij)
+       !
+       ! Transfer the list of basins which flow into the ocean as coastal flow.
+       !
+       IF ( basin_id(ib,basin_count(ib)) .LT. 0) THEN
+          nbcoastal(ib) = basin_sz(ij)
+          coastal_basin(ib,1:nbcoastal(ib)) = coast_pts(1:nbcoastal(ib))
+       ENDIF
+       !
+       !
+       ! Compute the area of the basin
+       !
+       basin_area(ib,ij) = zero
+       basin_hierarchy(ib,ij) = zero
+       !
+       SELECT CASE (hierar_method)
+          !
+          CASE("MINI")
+             basin_hierarchy(ib,ij) = undef_sechiba
+          !
+       END SELECT
+       basin_topoind(ib,ij) = zero
+       !
+       DO iz=1,basin_sz(ij)
+          !
+          basin_area(ib,ij) = basin_area(ib,ij) + area_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+          basin_topoind(ib,ij) = basin_topoind(ib,ij) + topoind_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+          !
+          ! There are a number of ways to determine the hierarchy of the entire basin.
+          ! We allow for three here :
+          !     - Take the mean value
+          !     - Take the minimum value within the basin
+          !     - Take the value at the outflow point
+          ! Probably taking the value of the outflow point is the best solution.
+          !
+          SELECT CASE (hierar_method)
+             !
+             CASE("MEAN")
+                ! Mean hierarchy of the basin
+                basin_hierarchy(ib,ij) = basin_hierarchy(ib,ij) + &
+                     & hierarchy_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+             CASE("MINI")
+                ! The smallest value of the basin
+                IF ( hierarchy_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2)) .LT. basin_hierarchy(ib,ij)) THEN
+                   basin_hierarchy(ib,ij) = hierarchy_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+                ENDIF
+             CASE("OUTP")
+                ! Value at the outflow point
+                IF ( trip_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2)) .GT. 100 ) THEN
+                   basin_hierarchy(ib,ij) = hierarchy_bx(basin_pts(ij,iz,1),basin_pts(ij,iz,2))
+                ENDIF
+             CASE DEFAULT
+                WRITE(numout,*) 'Unknown method for computing the hierarchy of the basin'
+                STOP 'routing_globalize'
+          END SELECT
+          !
+       ENDDO
+       !
+       basin_topoind(ib,ij) = basin_topoind(ib,ij)/REAL(basin_sz(ij),r_std)
+       !
+       SELECT CASE (hierar_method)
+          !
+          CASE("MEAN")
+             basin_hierarchy(ib,ij) = basin_hierarchy(ib,ij)/REAL(basin_sz(ij),r_std)
+          !
+       END SELECT
+       !
+       ! To make sure that it has the lowest number if this is an outflow point we reset  basin_hierarchy
+       !
+       IF (basin_bxout(ij) .LT. 0) THEN
+          basin_hierarchy(ib,ij) = min_topoind
+          basin_topoind(ib,ij) = min_topoind
+       ENDIF
+       !
+       !
+       ! Keep the outflow boxes and basin
+       !
+       basin_flowdir(ib,ij) = basin_bxout(ij)
+       IF (basin_bxout(ij) .GT. 0) THEN
+          outflow_grid(ib,ij) = neighbours(ib,basin_bxout(ij))
+       ELSE
+          outflow_grid(ib,ij) = basin_bxout(ij)
+       ENDIF
+       !
+       !
+    ENDDO
+    !
+
+    !
+  END SUBROUTINE routing_globalize
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_linkup
+!!
+!> BRIEF         This subroutine makes the connections between the basins and ensure global coherence. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) :
+!! The convention for outflow_grid is :
+!! outflow_grid = -1 : River flow
+!! outflow_grid = -2 : Coastal flow
+!! outflow_grid = -3 : Return flow\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_linkup(nbpt, neighbours, nwbas, basin_count, basin_area, basin_id, basin_flowdir, &
+       & basin_hierarchy, outflow_grid, outflow_basin, inflow_number, inflow_grid, inflow_basin, nbcoastal,&
+       & coastal_basin, invented_basins)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT (in)                    :: nbpt                  !! Domain size  (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,8), INTENT (in) :: neighbours            !!
+    REAL(r_std), INTENT(in)                        :: invented_basins       !!
+    !
+    INTEGER(i_std)                                 :: nwbas                 !!
+    INTEGER(i_std), DIMENSION(nbpt)                :: basin_count           !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: basin_id              !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: basin_flowdir         !! Water flow directions in the basin (unitless)
+    REAL(r_std), DIMENSION(nbpt,nwbas)             :: basin_area            !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)             :: basin_hierarchy       !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: outflow_grid          !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: outflow_basin         !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: inflow_number         !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nbvmax)   :: inflow_basin          !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nbvmax)   :: inflow_grid           !!
+    INTEGER(i_std), DIMENSION(nbpt)                :: nbcoastal             !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: coastal_basin         !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                                 :: sp, sb, sbl, inp, bid, outdm1, outdp1 !! Indices (unitless)
+    INTEGER(i_std)                                 :: dp1, dm1, dm1i, dp1i, bp1, bm1 !! Indices (unitless)
+    INTEGER(i_std)                                 :: dop, bop              !!
+    INTEGER(i_std)                                 :: fbas(nwbas), nbfbas   !!
+    REAL(r_std)                                    :: fbas_hierarchy(nwbas) !!
+    INTEGER(i_std)                                 :: ff(1)                 !!
+    !
+    ! ERRORS 
+    LOGICAL                                        :: error1, error2, error3, error4, error5 !! (true/false)
+    !
+!! PARAMETERS
+    LOGICAL, PARAMETER                             :: check = .FALSE.       !! (true/false)
+    
+    error1=.FALSE.
+    error2=.FALSE.
+    error3=.FALSE.
+    error4=.FALSE.
+    error5=.FALSE.
+
+    outflow_basin(:,:) = undef_int
+    inflow_number(:,:) = 0
+    !
+    DO sp=1,nbpt
+       DO sb=1,basin_count(sp)
+          !
+          inp = outflow_grid(sp,sb)
+          bid = basin_id(sp,sb)
+          !
+          ! We only work on this point if it does not flow into the ocean
+          ! At this point any of the outflows is designated by a negative values in
+          ! outflow_grid
+          !
+          IF ( inp .GT. 0 ) THEN
+             !
+             ! Now find the basin in the onflow point (inp)
+             !
+             nbfbas = 0
+             !
+             !
+             DO sbl=1,basin_count(inp)
+                !
+                ! Either it is a standard basin or one aggregated from ocean flow points.
+                ! If we flow into a another grid box we have to make sure that its hierarchy in the
+                ! basin is lower.
+                !
+                !
+                IF ( basin_id(inp,sbl) .GT. 0 ) THEN
+                   IF ( basin_id(inp,sbl) .EQ. bid .OR. basin_id(inp,sbl) .GT. invented_basins) THEN
+                      nbfbas =nbfbas + 1
+                      fbas(nbfbas) = sbl
+                      fbas_hierarchy(nbfbas) = basin_hierarchy(inp,sbl)
+                   ENDIF
+                ELSE
+                   IF ( COUNT(coastal_basin(inp,1:nbcoastal(inp)) .EQ. bid) .GT. 0 ) THEN
+                      nbfbas =nbfbas + 1
+                      fbas(nbfbas) = sbl
+                      fbas_hierarchy(nbfbas) = basin_hierarchy(inp,sbl)
+                   ENDIF
+                ENDIF
+                !
+             ENDDO
+             ! 
+             !  If we have more than one basin we will take the one which is lowest
+             !  in the hierarchy.
+             !
+             IF (nbfbas .GE. 1) THEN
+                ff = MINLOC(fbas_hierarchy(1:nbfbas))
+                sbl = fbas(ff(1))
+                !
+                bop = undef_int
+                IF ( basin_hierarchy(inp,sbl) .LE. basin_hierarchy(sp,sb) ) THEN
+                   IF ( basin_hierarchy(inp,sbl) .LE. basin_hierarchy(sp,sb) ) THEN
+                      bop = sbl
+                   ELSE
+                      ! The same hierarchy is allowed if both grids flow in about 
+                      ! the same direction :
+                      IF ( ( MOD(basin_flowdir(inp,sbl)+1-1, 8)+1 .EQ. basin_flowdir(sp,sb)).OR. &
+                           & ( basin_flowdir(inp,sbl) .EQ. basin_flowdir(sp,sb)).OR. &
+                           & ( MOD(basin_flowdir(inp,sbl)+7-1, 8)+1 .EQ. basin_flowdir(sp,sb)) ) THEN
+                         bop = sbl
+                      ENDIF
+                   ENDIF
+                ENDIF
+                !
+                ! If the basin is suitable (bop < undef_int) then take it
+                !
+                IF ( bop .LT. undef_int ) THEN
+                   outflow_basin(sp,sb) = bop
+                   inflow_number(inp,bop) =  inflow_number(inp,bop) + 1
+                   IF ( inflow_number(inp,bop) .LE. nbvmax ) THEN
+                      inflow_grid(inp, bop, inflow_number(inp,bop)) = sp
+                      inflow_basin(inp, bop, inflow_number(inp,bop)) = sb
+                   ELSE
+                      error1=.TRUE.
+                      EXIT
+                   ENDIF
+                ENDIF
+             ENDIF
+             !
+             !
+          ENDIF
+          !
+          !
+          !
+          ! Did we find it ?
+          !
+          ! In case the outflow point was ocean or we did not find the correct basin we start to look
+          ! around. We find two options for the outflow direction (dp1 & dm1) and the corresponding 
+          ! basin index (bp1 & bm1).
+          !
+          !
+          IF ( outflow_basin(sp,sb) .EQ. undef_int &
+               & .AND. basin_flowdir(sp,sb) .GT. 0) THEN
+             !
+             dp1i = MOD(basin_flowdir(sp,sb)+1-1, 8)+1
+             dp1 = neighbours(sp,dp1i)
+             dm1i = MOD(basin_flowdir(sp,sb)+7-1, 8)+1
+             IF ( dm1i .LT. 1 ) dm1i = 8
+             dm1 = neighbours(sp,dm1i)
+             !
+             !
+             bp1 = -1
+             IF ( dp1 .GT. 0 ) THEN
+                DO sbl=1,basin_count(dp1)
+                   IF (basin_id(dp1,sbl) .EQ. bid .AND.&
+                        & basin_hierarchy(sp,sb) .GE. basin_hierarchy(dp1,sbl) .AND. &
+                        & bp1 .LT. 0) THEN
+                      IF ( basin_hierarchy(sp,sb) .GT. basin_hierarchy(dp1,sbl) ) THEN
+                         bp1 = sbl
+                      ELSE
+                         ! The same hierarchy is allowed if both grids flow in about 
+                         ! the same direction :
+                         IF ( ( MOD(basin_flowdir(dp1,sbl)+1-1, 8)+1 .EQ. basin_flowdir(sp,sb)).OR. &
+                            & ( basin_flowdir(dp1,sbl) .EQ. basin_flowdir(sp,sb)).OR. &
+                            & ( MOD(basin_flowdir(dp1,sbl)+7-1, 8)+1 .EQ. basin_flowdir(sp,sb)) ) THEN
+                            bp1 = sbl
+                         ENDIF
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDIF
+             !
+             bm1 = -1
+             IF ( dm1 .GT. 0 ) THEN
+                DO sbl=1,basin_count(dm1)
+                   IF (basin_id(dm1,sbl) .EQ. bid .AND.&
+                        & basin_hierarchy(sp,sb) .GE. basin_hierarchy(dm1,sbl) .AND. &
+                        & bm1 .LT. 0) THEN
+                      IF ( basin_hierarchy(sp,sb) .GT. basin_hierarchy(dm1,sbl) ) THEN
+                         bm1 = sbl
+                      ELSE                         
+                         ! The same hierarchy is allowed if both grids flow in about 
+                         ! the same direction :
+                         IF ( ( MOD(basin_flowdir(dm1,sbl)+1-1, 8)+1 .EQ. basin_flowdir(sp,sb)) .OR. &
+                            & ( basin_flowdir(dm1,sbl) .EQ. basin_flowdir(sp,sb)) .OR. &
+                            & ( MOD(basin_flowdir(dm1,sbl)+7-1, 8)+1 .EQ. basin_flowdir(sp,sb)) ) THEN
+                            bm1 = sbl
+                         ENDIF
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDIF
+             !
+             !
+             ! First deal with the case on land.
+             !
+             ! For that we need to check if the water will be able to flow out of the grid dp1 or dm1 
+             ! and not return to our current grid. If it is the current grid
+             ! then we can not do anything with that neighbour. Thus we set the
+             ! value of outdm1 and outdp1 back to -1
+             !
+             outdp1 = undef_int
+             IF ( dp1 .GT. 0 .AND. bp1 .GT. 0 ) THEN
+                ! if the outflow is into the ocean then we put something less than undef_int in outdp1!
+                IF (basin_flowdir(dp1,bp1) .GT. 0) THEN
+                   outdp1 = neighbours(dp1,basin_flowdir(dp1,bp1))
+                   IF ( outdp1 .EQ. sp ) outdp1 = undef_int 
+                ELSE
+                   outdp1 = nbpt + 1
+                ENDIF
+             ENDIF
+             outdm1 = undef_int
+             IF ( dm1 .GT. 0 .AND. bm1 .GT. 0 ) THEN
+                IF (basin_flowdir(dm1,bm1) .GT. 0) THEN
+                   outdm1 = neighbours(dm1,basin_flowdir(dm1,bm1))
+                   IF ( outdm1 .EQ. sp )  outdm1 = undef_int
+                ELSE
+                   outdm1 = nbpt + 1
+                ENDIF
+             ENDIF
+             !
+             ! Now that we know our options we need go through them.
+             !
+             dop = undef_int
+             bop = undef_int
+             IF ( outdp1 .LT. undef_int .AND. outdm1 .LT. undef_int) THEN
+                ! 
+                ! In this case we let the current basin flow into the smaller one
+                !
+                IF ( basin_area(dp1,bp1) .LT.  basin_area(dm1,bm1) ) THEN
+                   dop = dp1
+                   bop = bp1
+                ELSE
+                   dop = dm1
+                   bop = bm1
+                ENDIF
+                !
+                !
+             ELSE IF (  outdp1 .LT. undef_int ) THEN
+                ! If only the first one is possible
+                dop = dp1
+                bop = bp1
+             ELSE IF ( outdm1 .LT. undef_int ) THEN
+                ! If only the second one is possible
+                dop = dm1
+                bop = bm1
+             ELSE
+                !
+                ! Now we are at the point where none of the neighboring points is suitable 
+                ! or we have a coastal point.
+                !
+                ! If there is an option to put the water into the ocean go for it.
+                !
+                IF ( outflow_grid(sp,sb) .LT. 0 .OR. dm1 .LT. 0 .OR. dp1 .LT. 0 ) THEN
+                   dop = -1
+                ELSE
+                   !
+                   ! If we are on a land point with only land neighbors but no one suitable to let the 
+                   ! water flow into we have to look for a solution in the current grid box.
+                   ! 
+                   !
+                   IF ( bp1 .LT. 0 .AND. bm1 .LT. 0 ) THEN
+                      !
+                      ! Do we have more than one basin with the same ID ?
+                      !
+                      IF ( COUNT(basin_id(sp,1:basin_count(sp)) .EQ. bid) .GE. 2) THEN
+                         !
+                         ! Now we can try the option of flowing into the basin of the same grid box.
+                         !
+                         DO sbl=1,basin_count(sp)
+                            IF (sbl .NE. sb .AND. basin_id(sp,sbl) .EQ. bid) THEN
+                               ! In case this basin has a lower hierarchy or flows into a totaly
+                               ! different direction we go for it.
+                               IF ( (basin_hierarchy(sp,sb) .GE. basin_hierarchy(sp,sbl)) .OR. &
+                                    & (basin_flowdir(sp,sbl) .LT. dm1i .AND.&
+                                    & basin_flowdir(sp,sbl) .GT. dp1i) ) THEN
+                                  dop = sp
+                                  bop = sbl
+                                  IF (check) THEN
+                                     IF (basin_hierarchy(sp,sb) .LT. basin_hierarchy(sp,sbl)) THEN
+                                        WRITE(numout,*) '>>>>>>> POINT CORRECTED against hierarchy :',&
+                                             & sp, sb, 'into', sbl
+                                     ENDIF
+                                  ENDIF
+                               ENDIF
+                               !
+                            ENDIF
+                         ENDDO
+                         !
+                      ENDIF
+                   ENDIF
+                ENDIF
+                !
+                IF ( dop .EQ. undef_int .AND. bop .EQ. undef_int ) THEN
+                   IF (check) THEN
+                      WRITE(numout,*) 'Why are we here with point ', sp, sb
+                      WRITE(numout,*) 'Coordinates : (lon,lat) = ', lalo(sp,2), lalo(sp,1)
+                      WRITE(numout,*) 'Contfrac : = ', contfrac(sp)
+                      WRITE(numout,*) 'Local Basin ID :', basin_id(sp,1:basin_count(sp))
+                      WRITE(numout,*) 'Local hierarchies :', basin_hierarchy(sp,1:basin_count(sp))
+                      WRITE(numout,*) 'Local basin_flowdir :', basin_flowdir(sp,1:basin_count(sp))
+                      WRITE(numout,*) 'Local outflowgrid :', outflow_grid(sp,1:basin_count(sp))
+                      WRITE(numout,*) 'outflow_grid :', inp
+                      WRITE(numout,*) 'Coodinates outflow : (lon,lat) = ', lalo(inp,2), lalo(inp,1)
+                      WRITE(numout,*) 'Contfrac : = ', contfrac(inp)
+                      WRITE(numout,*) 'Outflow Basin ID :', basin_id(inp,1:basin_count(inp))
+                      WRITE(numout,*) 'Outflow hierarchies :', basin_hierarchy(inp,1:basin_count(inp))
+                      WRITE(numout,*) 'Outflow basin_flowdir :', basin_flowdir(inp,1:basin_count(inp))
+                      WRITE(numout,*) 'Explored options +1 :', dp1, bp1, outdp1
+                      WRITE(numout,*) 'Explored +1 Basin ID :', basin_id(dp1,1:basin_count(dp1))
+                      WRITE(numout,*) 'Explored +1 hierarchies :', basin_hierarchy(dp1,1:basin_count(dp1))
+                      WRITE(numout,*) 'Explored +1 basin_flowdir :', basin_flowdir(dp1,1:basin_count(dp1))
+                      WRITE(numout,*) 'Explored options -1 :', dm1, bm1, outdm1
+                      WRITE(numout,*) 'Explored -1 Basin ID :', basin_id(dm1,1:basin_count(dm1))
+                      WRITE(numout,*) 'Explored -1 hierarchies :', basin_hierarchy(dm1,1:basin_count(dm1))
+                      WRITE(numout,*) 'Explored -1 basin_flowdir :', basin_flowdir(dm1,1:basin_count(dm1))
+                      WRITE(numout,*) '****************************'
+                   ENDIF
+                   IF ( contfrac(sp) > 0.01 ) THEN
+                      error2=.TRUE.
+                      EXIT
+                   ENDIF
+                ENDIF
+                !
+             ENDIF
+             !
+             ! Now that we know where we want the water to flow to we write the
+             ! the information in the right fields.
+             !
+             IF ( dop .GT. 0 .AND. dop .NE. undef_int ) THEN
+                outflow_grid(sp,sb) = dop
+                outflow_basin(sp,sb) = bop
+                inflow_number(dop,bop) =  inflow_number(dop,bop) + 1
+                IF ( inflow_number(dop,bop) .LE. nbvmax ) THEN
+                   inflow_grid(dop, bop, inflow_number(dop,bop)) = sp
+                   inflow_basin(dop, bop, inflow_number(dop,bop)) = sb
+                ELSE
+                   error3=.TRUE.
+                   EXIT
+                ENDIF
+                !
+             ELSE
+                outflow_grid(sp,sb) = -2
+                outflow_basin(sp,sb) = undef_int
+             ENDIF
+             !
+          ENDIF
+          !
+          !
+          ! If we still have not found anything then we have to check that there is not a basin
+          ! within the same grid box which has a lower hierarchy.
+          !
+          !
+          IF ( outflow_grid(sp,sb) .GT. 0 .AND. outflow_basin(sp,sb) .EQ. undef_int &
+               & .AND. basin_flowdir(sp,sb) .GT. 0) THEN
+             !
+             
+             IF (check) &
+                  WRITE(numout,*) 'There is no reason to here, this part of the code should be dead :', sp,sb
+             !
+             DO sbl=1,basin_count(sp)
+                !
+                ! Three conditions are needed to let the water flow into another basin of the
+                ! same grid :
+                ! - another basin than the current one
+                ! - same ID
+                ! - of lower hierarchy.
+                !
+                IF ( (sbl .NE. sb) .AND. (basin_id(sp,sbl) .EQ. bid)&
+                     & .AND. (basin_hierarchy(sp,sb) .GT. basin_hierarchy(sp,sbl)) ) THEN
+                   outflow_basin(sp,sb) = sbl
+                   inflow_number(sp,sbl) =  inflow_number(sp,sbl) + 1
+                   IF ( inflow_number(sp,sbl) .LE. nbvmax ) THEN
+                      IF ( sp .EQ. 42 .AND. sbl .EQ. 1) THEN
+                         IF (check) &
+                              WRITE(numout,*) 'ADD INFLOW (3):', sp, sb
+                      ENDIF
+                      inflow_grid(sp, sbl, inflow_number(sp,sbl)) = sp
+                      inflow_basin(sp, sbl, inflow_number(sp,sbl)) = sb
+                   ELSE
+                      error4=.TRUE.
+                      EXIT
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDIF
+          !
+          ! Ok that is it, we give up :-)
+          !
+          IF ( outflow_grid(sp,sb) .GT. 0 .AND. outflow_basin(sp,sb) .EQ. undef_int &
+               & .AND. basin_flowdir(sp,sb) .GT. 0) THEN
+             !
+             error5=.TRUE.
+             EXIT
+          ENDIF
+       ENDDO
+       !
+    ENDDO
+    IF (error1) THEN
+       WRITE(numout,*) " routing_linkup : bop .LT. undef_int",bop
+       CALL ipslerr(3,'routing_linkup', &
+            "bop .LT. undef_int",'Increase nbvmax','stop routing_linkup')
+    ENDIF
+    IF (error2) THEN
+       CALL ipslerr(3,'routing_linkup', &
+            &      'In the routine which make connections between the basins and ensure global coherence,', & 
+            &      'there is a problem with outflow linkup without any valid direction. Try with check=.TRUE.', &
+            &      '(Perhaps there is a problem with the grid.)')
+    ENDIF
+    IF (error3) THEN
+       WRITE(numout,*) " routing_linkup : dop .GT. 0 .AND. dop .NE. undef_int",dop
+       CALL ipslerr(3,'routing_linkup', &
+            "dop .GT. 0 .AND. dop .NE. undef_int",'Increase nbvmax. Try with check=.TRUE.','stop routing_linkup')
+    ENDIF
+    IF (error4) THEN
+       WRITE(numout,*) " routing_linkup : (sbl .NE. sb) .AND. (basin_id(sp,sbl) .EQ. bid) ", & 
+            &  " .AND. (basin_hierarchy(sp,sb) .GT. basin_hierarchy(sp,sbl))",sbl,sb,basin_id(sp,sbl),bid, & 
+            &  basin_hierarchy(sp,sb),basin_hierarchy(sp,sbl)
+       CALL ipslerr(3,'routing_linkup', &
+            "(sbl .NE. sb) .AND. (basin_id(sp,sbl) .EQ. bid) .AND. (basin_hierarchy(sp,sb) .GT. basin_hierarchy(sp,sbl))" &
+            ,'Increase nbvmax. Try with check=.TRUE.','stop routing_linkup')
+    ENDIF
+    IF (error5) THEN
+       WRITE(numout,*) 'We could not find the basin into which we need to flow'
+       WRITE(numout,*) 'Grid point ', sp, ' and basin ', sb
+       WRITE(numout,*) 'Explored neighbours :', dm1, dp1 
+       WRITE(numout,*) 'Outflow direction :', basin_flowdir(sp,sb)
+       WRITE(numout,*) 'Outlfow grid :', outflow_grid(sp,sb)
+       WRITE(numout,*) 'Outlfow basin :',outflow_basin(sp,sb)
+       WRITE(numout,*) 'basin ID:',basin_id(sp,sb)
+       WRITE(numout,*) 'Hierarchy :', basin_hierarchy(sp,sb)
+       CALL ipslerr(3,'routing_linkup', &
+            "We could not find the basin into which we need to flow",'Try with check=.TRUE.','stop routing_linkup')
+    ENDIF
+    !
+    ! Check for each outflow basin that it exists
+    !
+    DO sp=1,nbpt
+       DO sb=1,basin_count(sp)
+          !
+          inp = outflow_grid(sp,sb)
+          sbl = outflow_basin(sp,sb)
+          IF ( inp .GE. 0 ) THEN
+             IF ( basin_count(inp) .LT. sbl ) THEN
+                WRITE(numout,*) 'point :', sp, ' basin :', sb
+                WRITE(numout,*) 'Flows into point :', inp, ' basin :', sbl
+                WRITE(numout,*) 'But it flows into now here as basin count = ', basin_count(inp)
+                STOP
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE routing_linkup
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_fetch
+!!
+!> BRIEF        This subroutine computes the fetch of each basin. This means that for each basin we
+!!               will know how much area is upstream. It will help decide how to procede with the
+!!               the truncation later and allow to set correctly in outflow_grid the distinction
+!!               between coastal and river flow. 
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_fetch(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_id,&
+       & outflow_grid, outflow_basin, fetch_basin)
+    !
+    IMPLICIT NONE
+    !
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                           :: nbpt          !! Domain size  (unitless)
+    !
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in)           :: resolution    !! The size of each grid box in X and Y (m)
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)             :: contfrac      !! Fraction of land in each grid box (unitless;0-1)
+    !
+    INTEGER(i_std)                                       :: nwbas         !!
+    INTEGER(i_std), DIMENSION(nbpt), INTENT(in)          :: basin_count   !!
+    REAL(r_std), DIMENSION(nbpt,nwbas), INTENT(inout)    :: basin_area    !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas), INTENT(in)    :: basin_id      !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas), INTENT(inout) :: outflow_grid  !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas), INTENT(in)    :: outflow_basin !!
+!
+!! OUTPUT VARIABLES
+    REAL(r_std), DIMENSION(nbpt,nwbas), INTENT(out)      :: fetch_basin   !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                                        :: ib, ij, ff(1), it, itt, igrif, ibasf, nboutflow !! Indices (unitless)
+    REAL(r_std)                                           :: contarea     !!
+    REAL(r_std)                                           :: totbasins    !!
+    REAL(r_std), DIMENSION(nbpt*nbvmax)                   :: tmp_area     !!
+    INTEGER(i_std), DIMENSION(nbpt*nbvmax,2)              :: tmpindex     !!
+    !
+    !
+    ! Normalize the area of all basins
+    !
+    DO ib=1,nbpt
+       !
+       totbasins = SUM(basin_area(ib,1:basin_count(ib)))
+       contarea = resolution(ib,1)*resolution(ib,2)*contfrac(ib)
+       !
+       DO ij=1,basin_count(ib)
+          basin_area(ib,ij) = basin_area(ib,ij)/totbasins*contarea
+       ENDDO
+       !
+    ENDDO
+    WRITE(numout,*) 'Normalization done'
+    !
+    ! Compute the area upstream of each basin
+    !
+    fetch_basin(:,:) = zero
+    !
+    !
+    DO ib=1,nbpt
+       !
+       DO ij=1,basin_count(ib)
+          !
+          fetch_basin(ib, ij) = fetch_basin(ib, ij) + basin_area(ib,ij)
+          !
+          igrif = outflow_grid(ib,ij)
+          ibasf = outflow_basin(ib,ij)
+          !
+          itt = 0
+          DO WHILE (igrif .GT. 0)
+             fetch_basin(igrif,ibasf) =  fetch_basin(igrif,ibasf) + basin_area(ib, ij)
+             it = outflow_grid(igrif, ibasf)
+             ibasf = outflow_basin(igrif, ibasf)
+             igrif = it
+             itt = itt + 1
+             IF ( itt .GT. 500) THEN
+                WRITE(numout,&
+                     "('Grid ',I5, ' and basin ',I5, 'did not converge after iteration ',I5)") ib, ij, itt
+                WRITE(numout,*) 'Basin ID :', basin_id(igrif,ibasf)
+                WRITE(numout,&
+                     "('We are stuck with the flow into grid ',I5,' and basin ',I5)") igrif, ibasf
+                IF ( itt .GT. 510) THEN
+                   STOP ' routing_fetch'
+                ENDIF
+             ENDIF
+          ENDDO
+          !
+       ENDDO
+       !
+    ENDDO
+    !
+    WRITE(numout,*) 'The smallest FETCH :', MINVAL(fetch_basin)
+    WRITE(numout,*) 'The largest FETCH :', MAXVAL(fetch_basin)
+    !
+    ! Now we set for the 'num_largest' largest basins the outflow condition as stream flow 
+    ! (i.e. outflow_grid = -1) and all other outflow basins are set to coastal flow 
+    ! (i.e. outflow_grid = -2). The return flow is not touched.
+    !
+    nboutflow = 0
+    !
+    DO ib=1,nbpt
+       !
+       DO ij=1,basin_count(ib)
+          !
+          ! We do not need any more the river flow flag as we are going to reset it.
+          !
+          IF ( outflow_grid(ib,ij) .EQ. -1) THEN
+             outflow_grid(ib,ij) = -2
+          ENDIF
+          !
+          IF ( outflow_grid(ib,ij) .EQ. -2) THEN
+             !
+             nboutflow = nboutflow + 1
+             tmp_area(nboutflow) = fetch_basin(ib,ij)
+             tmpindex(nboutflow,1) = ib
+             tmpindex(nboutflow,2) = ij
+             !
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    DO ib=1, num_largest
+       ff = MAXLOC(tmp_area(1:nboutflow))
+       outflow_grid(tmpindex(ff(1),1), tmpindex(ff(1),2)) = -1
+       tmp_area(ff(1)) = zero
+    ENDDO
+    !
+  END SUBROUTINE routing_fetch
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_truncate
+!!
+!> BRIEF         This subroutine reduces the number of basins per grid to the value chosen by the user.
+!!               It also computes the final field which will be used to route the water at the
+!!               requested truncation.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : 
+!! Truncate if needed and find the path closest to the high resolution data.
+!!
+!! The algorithm :
+!! 
+!! We only go through this procedure only as many times as there are basins to take out at most.
+!! This is important as it allows the simplifications to spread from one grid to the other.
+!! The for each step of the iteration and at each grid point we check the following options for 
+!! simplifying the pathways of water :
+!! 1) If the basin of a grid flows into another basin of the same grid. Kill the one which only
+!!    served as a transition
+!! 2) If in one grid box we have a number of basins which flow into the ocean as coastal flow. 
+!!    We kill the smallest one and put into the largest basin. There is no need to manage many 
+!!    basins going into the ocean as coastal flows. 
+!! 3) If we have streams run in parallel from one gird box to the others (that is these are 
+!!    different basins) we will put the smaller one in the larger one. This may hapen at any
+!!    level of the flow but in theory it should propagate downstream.
+!! 4) If we have two basins with the same ID but flow into different grid boxes we sacrifice
+!!    the smallest one and route it through the largest. 
+!!
+!! Obviously if any of the options find something then we skip the rest and take out the basin.:\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_truncate(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_topoind,&
+       & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+       & inflow_grid, inflow_basin)
+    !
+    IMPLICIT NONE
+    !
+!! PARAMETERS
+    INTEGER(i_std), PARAMETER                       :: pickmax = 200  !!
+
+!! INPUT VARIABLES
+    INTEGER(i_std)                                  :: nbpt           !! Domain size  (unitless)
+    !
+    REAL(r_std), DIMENSION(nbpt,2)                  :: resolution     !! The size of each grid box in X and Y (m)
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)        :: contfrac       !! Fraction of land in each grid box (unitless;0-1)
+    !
+    INTEGER(i_std)                                  :: nwbas          !!
+    INTEGER(i_std), DIMENSION(nbpt)                 :: basin_count    !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: basin_id       !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: basin_flowdir  !! Water flow directions in the basin (unitless)
+    REAL(r_std), DIMENSION(nbpt,nwbas)              :: basin_area     !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)              :: basin_topoind  !! Topographic index of the residence time for a basin (m)
+    REAL(r_std), DIMENSION(nbpt,nwbas)              :: fetch_basin    !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: outflow_grid   !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: outflow_basin  !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)           :: inflow_number  !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nwbas)     :: inflow_basin   !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nwbas)     :: inflow_grid    !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                                  :: ib, ij, ibf, ijf, igrif, ibasf, cnt, pold, bold, ff(2) !! Indices (unitless)
+    INTEGER(i_std)                                  :: ii, kbas, sbas, ik, iter, ibt, obj !! Indices (unitless)
+    REAL(r_std), DIMENSION(nbpt,nbasmax)            :: floflo         !!
+    REAL(r_std), DIMENSION(nbpt)                    :: gridarea       !!
+    REAL(r_std), DIMENSION(nbpt)                    :: gridbasinarea  !!
+    REAL(r_std)                                     :: ratio          !!
+    INTEGER(i_std), DIMENSION(pickmax,2)            :: largest_basins !!
+    INTEGER(i_std), DIMENSION(pickmax)              :: tmp_ids        !!
+    INTEGER(i_std)                                  :: multbas        !!
+    INTEGER(i_std)                                  :: iml(1)         !! X resolution of the high resolution grid
+    INTEGER(i_std), DIMENSION(pickmax)              :: multbas_sz     !!
+    REAL(r_std), DIMENSION(pickmax)                 :: tmp_area       !!
+    INTEGER(i_std), DIMENSION(pickmax,pickmax)      :: multbas_list   !!
+    !
+    INTEGER(i_std)                                  :: nbtruncate     !!
+    INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:) :: indextrunc     !!
+    !
+    !
+    IF ( .NOT. ALLOCATED(indextrunc)) THEN
+       ALLOCATE(indextrunc(nbpt))
+    ENDIF
+    !
+    ! We have to go through the grid as least as often as we have to reduce the number of basins
+    ! For good measure we add 3 more passages.
+    !
+    !
+    DO iter = 1, MAXVAL(basin_count) - nbasmax +3
+       !
+       ! Get the points over which we wish to truncate
+       !
+       nbtruncate = 0
+       DO ib = 1, nbpt
+          IF ( basin_count(ib) .GT. nbasmax ) THEN
+             nbtruncate = nbtruncate + 1
+             indextrunc(nbtruncate) = ib
+          ENDIF
+       ENDDO
+       !
+       ! Go through the basins which need to be truncated.       
+       !
+       DO ibt=1,nbtruncate
+          !
+          ib = indextrunc(ibt)
+          !
+          ! Check if we have basin which flows into a basin in the same grid
+          ! kbas = basin we will have to kill
+          ! sbas = basin which takes over kbas
+          !
+          kbas = 0
+          sbas = 0
+          !
+          ! 1) Can we find a basin which flows into a basin of the same grid ?
+          !
+          DO ij=1,basin_count(ib)
+             DO ii=1,basin_count(ib)
+                IF ( outflow_grid(ib,ii) .EQ. ib .AND. outflow_basin(ib, ii) .EQ. ij .AND. kbas*sbas .NE. 0) THEN
+                   kbas = ii
+                   sbas = ij
+                ENDIF
+             ENDDO
+          ENDDO
+          !
+          ! 2) Merge two basins which flow into the ocean as coastal or return flow 
+          ! (outflow_grid = -2 or -3). Well obviously only if we have more than 1 and 
+          ! have not found anything yet!
+          !
+          IF ( (COUNT(outflow_grid(ib,1:basin_count(ib)) .EQ. -2) .GT. 1 .OR.&
+               & COUNT(outflow_grid(ib,1:basin_count(ib)) .EQ. -3) .GT. 1) .AND.&
+               & kbas*sbas .EQ. 0) THEN
+             !
+             multbas = 0
+             multbas_sz(:) = 0
+             !
+             IF ( COUNT(outflow_grid(ib,1:basin_count(ib)) .EQ. -2) .GT. 1 ) THEN
+                obj = -2
+             ELSE
+                obj = -3
+             ENDIF
+             !
+             ! First we get the list of all basins which go out as coastal or return flow (obj)
+             !
+             DO ij=1,basin_count(ib)
+                IF ( outflow_grid(ib,ij) .EQ. obj ) THEN
+                   multbas = multbas + 1
+                   multbas_sz(multbas) = ij
+                   tmp_area(multbas) = fetch_basin(ib,ij)
+                ENDIF
+             ENDDO
+             !
+             ! Now the take the smallest to be transfered to the largest
+             !
+             iml = MAXLOC(tmp_area(1:multbas), MASK = tmp_area(1:multbas) .GT. zero)
+             sbas = multbas_sz(iml(1))
+             iml = MINLOC(tmp_area(1:multbas), MASK = tmp_area(1:multbas) .GT. zero)
+             kbas = multbas_sz(iml(1))
+             !
+          ENDIF
+          !
+          !   3) If we have basins flowing into the same grid but different basins then we put them 
+          !   together. Obviously we first work with the grid which has most streams running into it
+          !   and putting the smallest in the largests catchments.
+          !
+          IF ( kbas*sbas .EQ. 0) THEN
+             !
+             tmp_ids(1:basin_count(ib)) = outflow_grid(ib,1:basin_count(ib))
+             multbas = 0
+             multbas_sz(:) = 0
+             !
+             ! First obtain the list of basins which flow into the same basin
+             !
+             DO ij=1,basin_count(ib)
+                IF ( outflow_grid(ib,ij) .GT. 0 .AND.&
+                     & COUNT(tmp_ids(1:basin_count(ib)) .EQ. outflow_grid(ib,ij)) .GT. 1) THEN
+                   multbas = multbas + 1
+                   DO ii=1,basin_count(ib)
+                      IF ( tmp_ids(ii) .EQ. outflow_grid(ib,ij)) THEN
+                         multbas_sz(multbas) = multbas_sz(multbas) + 1
+                         multbas_list(multbas,multbas_sz(multbas)) = ii
+                         tmp_ids(ii) = -99
+                      ENDIF
+                   ENDDO
+                ELSE
+                   tmp_ids(ij) = -99
+                ENDIF
+             ENDDO
+             !
+             ! Did we come up with any basins to deal with this way ?
+             !
+             IF ( multbas .GT. 0 ) THEN
+                !
+                iml = MAXLOC(multbas_sz(1:multbas))
+                ik = iml(1)
+                !
+                ! Take the smallest and largest of these basins !
+                !
+                DO ii=1,multbas_sz(ik)
+                   tmp_area(ii) = fetch_basin(ib, multbas_list(ik,ii))
+                ENDDO
+                !
+                iml = MAXLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                sbas = multbas_list(ik,iml(1))
+                iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                kbas = multbas_list(ik,iml(1))
+                !
+             ENDIF
+             !
+          ENDIF
+          !
+          !   4) If we have twice the same basin we put them together even if they flow into different
+          !   directions. If one of them goes to the ocean it takes the advantage.
+          !
+          IF ( kbas*sbas .EQ. 0) THEN
+             !
+             tmp_ids(1:basin_count(ib)) = basin_id(ib,1:basin_count(ib))
+             multbas = 0
+             multbas_sz(:) = 0
+             !
+             ! First obtain the list of basins which have sub-basins in this grid box.
+             ! (these are identified by their IDs)
+             !
+             DO ij=1,basin_count(ib)
+                IF ( COUNT(tmp_ids(1:basin_count(ib)) .EQ. basin_id(ib,ij)) .GT. 1) THEN
+                   multbas = multbas + 1
+                   DO ii=1,basin_count(ib)
+                      IF ( tmp_ids(ii) .EQ. basin_id(ib,ij)) THEN
+                         multbas_sz(multbas) = multbas_sz(multbas) + 1
+                         multbas_list(multbas,multbas_sz(multbas)) = ii
+                         tmp_ids(ii) = -99
+                      ENDIF
+                   ENDDO
+                ELSE
+                   tmp_ids(ij) = -99
+                ENDIF
+             ENDDO
+             !
+             ! We are going to work on the basin with the largest number of sub-basins.
+             ! (IF we have a basin which has subbasins !)
+             !
+             IF ( multbas .GT. 0 ) THEN
+                !
+                iml = MAXLOC(multbas_sz(1:multbas))
+                ik = iml(1)
+                !
+                ! If one of the basins goes to the ocean then it is going to have the priority
+                !
+                tmp_area(:) = zero
+                IF ( COUNT(outflow_grid(ib,multbas_list(ik,1:multbas_sz(ik))) .LT. 0) .GT. 0) THEN
+                   DO ii=1,multbas_sz(ik)
+                      IF ( outflow_grid(ib,multbas_list(ik,ii)) .LT. 0 .AND. sbas .EQ. 0 ) THEN
+                         sbas = multbas_list(ik,ii)
+                      ELSE
+                         tmp_area(ii) = fetch_basin(ib, multbas_list(ik,ii))
+                      ENDIF
+                   ENDDO
+                   ! take the smallest of the subbasins
+                   iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                   kbas = multbas_list(ik,iml(1))
+                ELSE
+                   !
+                   ! Else we take simply the largest and smallest
+                   !
+                   DO ii=1,multbas_sz(ik)
+                      tmp_area(ii) = fetch_basin(ib, multbas_list(ik,ii))
+                   ENDDO
+                   iml = MAXLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                   sbas = multbas_list(ik,iml(1))
+                   iml = MINLOC(tmp_area(1:multbas_sz(ik)), MASK = tmp_area(1:multbas_sz(ik)) .GT. zero)
+                   kbas = multbas_list(ik,iml(1))
+                   !
+                ENDIF
+                !
+                !
+             ENDIF
+          ENDIF
+          !
+          !
+          !
+          ! Then we call routing_killbas to clean up the basins in this grid
+          !
+          IF ( kbas .GT. 0 .AND. sbas .GT. 0 ) THEN
+             CALL routing_killbas(nbpt, ib, kbas, sbas, nwbas, basin_count, basin_area, basin_topoind,&
+                  & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+                  & inflow_grid, inflow_basin)
+          ENDIF
+          !
+       ENDDO
+       !
+       !      
+    ENDDO
+    !
+    ! If there are any grids left with too many basins we need to take out the big hammer !
+    ! We will only do it if this represents less than 5% of all points.
+    !
+    IF ( COUNT(basin_count .GT. nbasmax) .GT. 0 ) THEN
+       !
+       !
+       IF ( COUNT(basin_count .GT. nbasmax)/nbpt*100 .GT. 5 ) THEN
+          WRITE(numout,*) 'We have ', COUNT(basin_count .GT. nbasmax)/nbpt*100, '% of all points which do not yet'
+          WRITE(numout,*) 'have the right trunctaction. That is too much to apply a brutal method'
+          DO ib = 1, nbpt
+             IF ( basin_count(ib) .GT. nbasmax ) THEN
+                !
+                WRITE(numout,*) 'We did not find a basin which could be supressed. We will'
+                WRITE(numout,*) 'not be able to reduce the truncation in grid ', ib
+                DO ij=1,basin_count(ib)
+                   WRITE(numout,*) 'grid, basin nb and id :', ib, ij, basin_id(ib,ij)
+                   WRITE(numout,*) 'Outflow grid and basin ->', outflow_grid(ib,ij), outflow_basin(ib, ij)
+                ENDDO
+             ENDIF
+          ENDDO
+          STOP 'routing_truncate'
+          !
+       ELSE
+          !
+          !
+          DO ib = 1,nbpt
+             DO WHILE ( basin_count(ib) .GT. nbasmax )
+                !
+                WRITE(numout,*) 'HAMMER, ib, basin_count :', ib, basin_count(ib)
+                !
+                ! Here we simply put the smallest basins into the largest ones. It is really a brute force
+                ! method but it will only be applied if everything has failed.
+                !
+                DO ii = 1,basin_count(ib)
+                   tmp_area(ii) = fetch_basin(ib, ii)
+                ENDDO
+                !
+                iml = MAXLOC(tmp_area(1:basin_count(ib)), MASK = tmp_area(1:basin_count(ib)) .GT. 0.)
+                sbas =iml(1)
+                iml = MINLOC(tmp_area(1:basin_count(ib)), MASK = tmp_area(1:basin_count(ib)) .GT. 0.)
+                kbas = iml(1)
+                !
+                IF ( kbas .GT. 0 .AND. sbas .GT. 0 ) THEN
+                   CALL routing_killbas(nbpt, ib, kbas, sbas, nwbas, basin_count, basin_area, basin_topoind,&
+                        & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+                        & inflow_grid, inflow_basin)
+                ENDIF
+             ENDDO
+          ENDDO
+          !
+       ENDIF
+       !
+       !
+    ENDIF
+    !
+    ! Now that we have reached the right truncation (resolution) we will start
+    ! to produce the variables we will use to route the water.
+    !
+    DO ib=1,nbpt
+       !
+       ! For non existing basins the route_tobasin variable is put to zero. This will allow us
+       ! to pick up the number of basin afterwards.
+       !
+       route_togrid(ib,:) = ib
+       route_tobasin(ib,:) = 0
+       routing_area(ib,:) = zero
+       !
+    ENDDO
+    !
+    ! Transfer the info into the definitive variables
+    !
+    DO ib=1,nbpt
+       DO ij=1,basin_count(ib)
+          routing_area(ib,ij) = basin_area(ib,ij)
+          topo_resid(ib,ij) = basin_topoind(ib,ij)
+          global_basinid(ib,ij) = basin_id(ib,ij)
+          route_togrid(ib,ij) = outflow_grid(ib,ij)
+          route_tobasin(ib,ij) = outflow_basin(ib,ij)
+       ENDDO
+    ENDDO
+    !
+    !
+    ! Set the new convention for the outflow conditions
+    ! Now it is based in the outflow basin and the outflow grid will
+    ! be the same as the current.
+    ! returnflow to the grid : nbasmax + 1
+    ! coastal flow           : nbasmax + 2
+    ! river outflow          : nbasmax + 3
+    !
+    ! Here we put everything here in coastal flow. It is later where we will
+    ! put the largest basins into river outflow.
+    !
+    DO ib=1,nbpt
+       DO ij=1,basin_count(ib)
+          ! River flows
+          IF ( route_togrid(ib,ij) .EQ. -1 ) THEN
+             route_tobasin(ib,ij) = nbasmax + 2
+             route_togrid(ib,ij) = ib
+          ! Coastal flows
+          ELSE IF ( route_togrid(ib,ij) .EQ. -2 ) THEN
+             route_tobasin(ib,ij) = nbasmax + 2
+             route_togrid(ib,ij) = ib
+          ! Return flow
+          ELSE IF ( route_togrid(ib,ij) .EQ. -3 ) THEN
+             route_tobasin(ib,ij) = nbasmax + 1
+             route_togrid(ib,ij) = ib
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! A second check on the data. Just make sure that each basin flows somewhere.
+    !
+    DO ib=1,nbpt
+       DO ij=1,basin_count(ib)
+          ibf = route_togrid(ib,ij)
+          ijf = route_tobasin(ib,ij)
+          IF ( ijf .GT. basin_count(ibf) .AND.  ijf .LE. nbasmax) THEN
+             WRITE(numout,*) 'Second check'
+             WRITE(numout,*) 'point :', ib, ' basin :', ij
+             WRITE(numout,*) 'Flows into point :', ibf, ' basin :', ijf
+             WRITE(numout,*) 'But it flows into now here as basin count = ', basin_count(ibf)
+             STOP
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! Verify areas of the continents
+    !
+    floflo(:,:) = zero
+    gridarea(:) = contfrac(:)*resolution(:,1)*resolution(:,2)
+    DO ib=1,nbpt
+       gridbasinarea(ib) = SUM(routing_area(ib,:))
+    ENDDO
+    !
+    DO ib=1,nbpt
+       DO ij=1,basin_count(ib)
+          cnt = 0
+          igrif = ib
+          ibasf = ij
+          DO WHILE (ibasf .LE. nbasmax .AND. cnt .LT. nbasmax*nbpt)
+             cnt = cnt + 1
+             pold = igrif
+             bold = ibasf
+             igrif = route_togrid(pold, bold)
+             ibasf = route_tobasin(pold, bold)
+             IF ( ibasf .GT. basin_count(igrif)  .AND.  ibasf .LE. nbasmax) THEN
+                WRITE(numout,*) 'We should not be here as the basin flows into the pampa'
+                WRITE(numout,*) 'Last correct point :', pold, bold
+                WRITE(numout,*) 'It pointed to in the new variables :', route_togrid(pold, bold),route_tobasin(pold, bold) 
+                WRITE(numout,*) 'The old variables gave :', outflow_grid(pold, bold), outflow_basin(pold, bold) 
+                WRITE(numout,*) 'Where we ended up :', igrif,ibasf
+                STOP
+             ENDIF
+          ENDDO
+          !
+          IF ( ibasf .GT. nbasmax ) THEN
+             floflo(igrif,bold) = floflo(igrif,bold) + routing_area(ib,ij)
+          ELSE
+             WRITE(numout,*) 'The flow did not end up in the ocean or in the grid cell.'
+             WRITE(numout,*) 'For grid ', ib, ' and basin ', ij
+             WRITE(numout,*) 'The last grid was ', igrif, ' and basin ', ibasf
+             STOP 'routing_truncate'
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    DO ib=1,nbpt
+       IF ( gridbasinarea(ib) > zero ) THEN
+          ratio = gridarea(ib)/gridbasinarea(ib)
+          routing_area(ib,:) = routing_area(ib,:)*ratio
+       ELSE
+          WRITE(numout,*) 'gridbasinarea(ib) <= zero. We should stop here :', ib
+       ENDIF
+    ENDDO
+    !
+    WRITE(numout,*) 'Sum of area of all outflow areas :',SUM(routing_area)
+    WRITE(numout,*) 'Surface of all continents :', SUM(gridarea)
+    !
+    ! Redo the the distinction between river outflow and coastal flow. We can not
+    ! take into account the return flow points.
+    !
+    ibf = 0
+    DO ib=1, pickmax
+       ff = MAXLOC(floflo)
+       ! tdo - To take into account rivers that do not flow to the oceans 
+       IF ( route_tobasin(ff(1), ff(2)) .GT. nbasmax ) THEN
+!       IF ( route_tobasin(ff(1), ff(2)) .EQ. nbasmax + 2) THEN
+          ibf = ibf + 1
+          largest_basins(ibf,:) = ff(:)
+       ENDIF
+       floflo(ff(1), ff(2)) = zero
+    ENDDO
+    !
+    ! Put the largest basins into river flows.
+    !
+    IF ( ibf .LT.  num_largest) THEN
+       WRITE(numout,*) 'Not enough basins to choose the ',  num_largest, 'largest'
+       STOP 'routing_truncate'
+    ENDIF
+    !
+    !
+    !
+    DO ib=1, num_largest
+       route_tobasin(largest_basins(ib,1),largest_basins(ib,2)) = nbasmax + 3
+    ENDDO
+    !
+    WRITE(numout,*) 'NUMBER OF RIVERS :', COUNT(route_tobasin .GE. nbasmax + 3)
+    !
+  END SUBROUTINE  routing_truncate
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_killbas
+!!
+!> BRIEF        The aim of this subroutine is to kill a basin (that is put into another larger one).
+!!              When we do this we need to be careful and change all associated variables.  
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_killbas(nbpt, ib, tokill, totakeover, nwbas, basin_count, basin_area, basin_topoind,&
+       & fetch_basin, basin_id, basin_flowdir, outflow_grid, outflow_basin, inflow_number,&
+       & inflow_grid, inflow_basin)
+    !
+    !
+    IMPLICIT NONE
+    !
+    INTEGER(i_std)                              :: tokill        !!
+    INTEGER(i_std)                              :: totakeover    !!
+    INTEGER(i_std)                              :: nbpt          !! Domain size  (unitless)
+    INTEGER(i_std)                              :: ib            !! Current basin (unitless)
+    !
+    INTEGER(i_std)                              :: nwbas         !!
+    INTEGER(i_std), DIMENSION(nbpt)             :: basin_count   !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: basin_id      !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: basin_flowdir !! Water flow directions in the basin (unitless)
+    REAL(r_std), DIMENSION(nbpt,nwbas)          :: basin_area    !!
+    REAL(r_std), DIMENSION(nbpt,nwbas)          :: basin_topoind !! Topographic index of the residence time for a basin (m)
+    REAL(r_std), DIMENSION(nbpt,nwbas)          :: fetch_basin   !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: outflow_grid  !! Type of outflow on the grid box (unitless)
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: outflow_basin !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)       :: inflow_number !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nwbas) :: inflow_basin  !!
+    INTEGER(i_std), DIMENSION(nbpt,nwbas,nwbas) :: inflow_grid   !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                              :: inf, ibs, ing, inb, ibasf, igrif, it !! Indices (unitless)
+    LOGICAL                                     :: doshift       !! (true/false)
+    !
+    ! Update the information needed in the basin "totakeover"
+    ! For the moment only area
+    !
+    WRITE(numout,*) 'KILL BASIN :', ib, tokill, totakeover, basin_id(ib,tokill), basin_id(ib,totakeover)
+    !
+    !
+    basin_area(ib, totakeover) = basin_area(ib, totakeover) +  basin_area(ib, tokill)
+    basin_topoind(ib, totakeover) = (basin_topoind(ib, totakeover) + basin_topoind(ib, tokill))/2.0
+    !
+    ! Add the fetch of the basin will kill to the one which gets the water
+    !
+    fetch_basin(ib, totakeover) = fetch_basin(ib, totakeover) + fetch_basin(ib, tokill)
+    igrif = outflow_grid(ib,totakeover)
+    ibasf = outflow_basin(ib,totakeover)
+    !
+    inf = 0
+    DO WHILE (igrif .GT. 0)
+       fetch_basin(igrif,ibasf) =  fetch_basin(igrif,ibasf) + fetch_basin(ib, tokill) 
+       it = outflow_grid(igrif, ibasf)
+       ibasf = outflow_basin(igrif, ibasf)
+       igrif = it
+       inf = inf + 1
+    ENDDO
+    !
+    ! Take out the basin we have just rerouted from the fetch of the basins in which it used to flow.
+    !
+    igrif = outflow_grid(ib,tokill)
+    ibasf = outflow_basin(ib,tokill)
+    !
+    DO WHILE (igrif .GT. 0)
+       fetch_basin(igrif,ibasf) =  fetch_basin(igrif,ibasf) - fetch_basin(ib, tokill)
+       it = outflow_grid(igrif, ibasf)
+       ibasf = outflow_basin(igrif, ibasf)
+       igrif = it
+    ENDDO   
+    !
+    !  Redirect the flows which went into the basin to be killed before we change everything
+    !
+    DO inf = 1, inflow_number(ib, tokill)
+       outflow_basin(inflow_grid(ib, tokill, inf), inflow_basin(ib, tokill, inf)) = totakeover
+       inflow_number(ib, totakeover) = inflow_number(ib, totakeover) + 1
+       inflow_grid(ib, totakeover,  inflow_number(ib, totakeover)) = inflow_grid(ib, tokill, inf)
+       inflow_basin(ib, totakeover,  inflow_number(ib, totakeover)) = inflow_basin(ib, tokill, inf)
+    ENDDO
+    !
+    ! Take out the basin to be killed from the list of inflow basins of the downstream basin
+    ! (In case the basin does not flow into an ocean or lake)
+    !
+    IF ( outflow_grid(ib,tokill) .GT. 0) THEN
+       !
+       ing = outflow_grid(ib, tokill)
+       inb = outflow_basin(ib, tokill)
+       doshift = .FALSE.
+       !
+       DO inf = 1, inflow_number(ing, inb)
+          IF ( doshift ) THEN
+             inflow_grid(ing, inb, inf-1) = inflow_grid(ing, inb, inf)
+             inflow_basin(ing, inb, inf-1) = inflow_basin(ing, inb, inf)
+          ENDIF
+          IF ( inflow_grid(ing, inb, inf) .EQ. ib .AND. inflow_basin(ing, inb, inf) .EQ. tokill) THEN
+             doshift = .TRUE.
+          ENDIF
+       ENDDO
+       !
+       ! This is only to allow for the last check
+       !
+       inf = inflow_number(ing, inb)
+       IF ( inflow_grid(ing, inb, inf) .EQ. ib .AND. inflow_basin(ing, inb, inf) .EQ. tokill) THEN
+          doshift = .TRUE.
+       ENDIF
+       !
+       IF ( .NOT. doshift ) THEN
+          WRITE(numout,*) 'Strange we did not find the basin to kill in the downstream basin'
+          STOP 'routing_killbas'
+       ENDIF
+       inflow_number(ing, inb) = inflow_number(ing, inb) - 1
+       !
+    ENDIF
+    !
+    ! Now remove from the arrays the information of basin "tokill"
+    !
+    basin_id(ib, tokill:basin_count(ib)-1) = basin_id(ib, tokill+1:basin_count(ib))
+    basin_flowdir(ib, tokill:basin_count(ib)-1) = basin_flowdir(ib, tokill+1:basin_count(ib))
+    basin_area(ib, tokill:basin_count(ib)-1) = basin_area(ib, tokill+1:basin_count(ib))
+    basin_area(ib, basin_count(ib):nwbas) = zero
+    basin_topoind(ib, tokill:basin_count(ib)-1) = basin_topoind(ib, tokill+1:basin_count(ib))
+    basin_topoind(ib, basin_count(ib):nwbas) = zero
+    fetch_basin(ib, tokill:basin_count(ib)-1) = fetch_basin(ib, tokill+1:basin_count(ib))
+    fetch_basin(ib, basin_count(ib):nwbas) = zero
+    !
+    ! Before we remove the information from the outflow fields we have to correct the corresponding inflow fields
+    ! of the grids into which the flow goes
+    !
+    DO ibs = tokill+1,basin_count(ib)
+       ing = outflow_grid(ib, ibs)
+       inb = outflow_basin(ib, ibs)
+       IF ( ing .GT. 0 ) THEN
+          DO inf = 1, inflow_number(ing, inb)
+             IF ( inflow_grid(ing,inb,inf) .EQ. ib .AND. inflow_basin(ing,inb,inf) .EQ. ibs) THEN
+                inflow_basin(ing,inb,inf) = ibs - 1
+             ENDIF
+          ENDDO
+       ENDIF
+    ENDDO
+    outflow_grid(ib, tokill:basin_count(ib)-1) = outflow_grid(ib, tokill+1:basin_count(ib))
+    outflow_basin(ib, tokill:basin_count(ib)-1) = outflow_basin(ib, tokill+1:basin_count(ib))
+    !
+    ! Basins which moved down also need to redirect their incoming flows.
+    !
+    DO ibs=tokill+1, basin_count(ib)
+       DO inf = 1, inflow_number(ib, ibs)
+          outflow_basin(inflow_grid(ib, ibs, inf), inflow_basin(ib, ibs, inf)) = ibs-1
+       ENDDO
+    ENDDO
+    !
+    ! Shift the inflow basins
+    !
+    DO it = tokill+1,basin_count(ib)
+       inflow_grid(ib, it-1, 1:inflow_number(ib,it)) =  inflow_grid(ib, it, 1:inflow_number(ib,it))
+       inflow_basin(ib, it-1, 1:inflow_number(ib,it)) =  inflow_basin(ib, it, 1:inflow_number(ib,it))
+       inflow_number(ib,it-1) = inflow_number(ib,it)
+    ENDDO
+    !
+    basin_count(ib) = basin_count(ib) - 1
+    !
+  END SUBROUTINE routing_killbas 
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_names
+!!
+!> BRIEF         This subroutine lists the name of the largest basins which are explicitly listed in the basin
+!!               description file used by ORCHIDEE.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_names(numlar, basin_names)
+    !
+    IMPLICIT NONE
+    !
+    ! Arguments
+    !
+    INTEGER(i_std), INTENT(in)             :: numlar              !!
+    CHARACTER(LEN=*), INTENT(inout)        :: basin_names(numlar) !! Name of the basins (unitless)
+!! PARAMETERS
+    INTEGER(i_std), PARAMETER              :: listleng=349        !!
+    !
+!! LOCAL VARIABLES
+    INTEGER(i_std)                         :: lenstr, i           !!
+    CHARACTER(LEN=60), DIMENSION(listleng) :: list_names          !!
+    CHARACTER(LEN=60)                      :: tmp_str             !!
+    !
+
+    lenstr = LEN(basin_names(1))
+    !
+    list_names(1) = "Amazon"
+    list_names(2) = "Nile"
+    list_names(3) = "Zaire"
+    list_names(4) = "Mississippi"
+    list_names(5) = "Amur"
+    list_names(6) = "Parana"
+    list_names(7) = "Yenisei"
+    list_names(8) = "Ob"
+    list_names(9) = "Lena"
+    list_names(10) = "Niger"
+    list_names(11) = "Zambezi"
+    list_names(12) = "Erg Iguidi (Sahara)"
+    list_names(13) = "Chang Jiang (Yangtze)"
+    list_names(14) = "Mackenzie"
+    list_names(15) = "Ganges"
+    list_names(16) = "Chari"
+    list_names(17) = "Volga"
+    list_names(18) = "St. Lawrence"
+    list_names(19) = "Indus"
+    list_names(20) = "Syr-Darya"
+    list_names(21) = "Nelson"
+    list_names(22) = "Orinoco"
+    list_names(23) = "Murray"
+    list_names(24) = "Great Artesian Basin"
+    list_names(25) = "Shatt el Arab"
+    list_names(26) = "Orange"
+    list_names(27) = "Huang He"
+    list_names(28) = "Yukon"
+    list_names(29) = "Senegal"
+    list_names(30) = "Chott Jerid"
+    list_names(31) = "Jubba"
+    list_names(32) = "Colorado (Ari)"
+    list_names(33) = "Rio Grande (US)"
+    list_names(34) = "Danube"
+    list_names(35) = "Mekong"
+    list_names(36) = "Tocantins"
+    list_names(37) = "Wadi al Farigh"
+    list_names(38) = "Tarim"
+    list_names(39) = "Columbia"
+    list_names(40) = "Komadugu Yobe (Tchad)"
+    list_names(41) = "Kolyma"
+    list_names(42) = "Sao Francisco"
+    list_names(43) = "Amu-Darya"
+    list_names(44) = "GHAASBasin51"
+    list_names(45) = "Dnepr"
+    list_names(46) = "GHAASBasin61"
+    list_names(47) = "Don"
+    list_names(48) = "Colorado (Arg)"
+    list_names(49) = "Limpopo"
+    list_names(50) = "GHAASBasin50"
+    list_names(51) = "Zhujiang"
+    list_names(52) = "Irrawaddy"
+    list_names(53) = "Volta"
+    list_names(54) = "GHAASBasin54"
+    list_names(55) = "Farah"
+    list_names(56) = "Khatanga"
+    list_names(57) = "Dvina"
+    list_names(58) = "Urugay"
+    list_names(59) = "Qarqan"
+    list_names(60) = "GHAASBasin75"
+    list_names(61) = "Parnaiba"
+    list_names(62) = "GHAASBasin73"
+    list_names(63) = "Indigirka"
+    list_names(64) = "Churchill (Hud)"
+    list_names(65) = "Godavari"
+    list_names(66) = "Pur - Taz"
+    list_names(67) = "Pechora"
+    list_names(68) = "Baker"
+    list_names(69) = "Ural"
+    list_names(70) = "Neva"
+    list_names(71) = "Liao"
+    list_names(72) = "Salween"
+    list_names(73) = "GHAASBasin73"
+    list_names(74) = "Jordan"
+    list_names(75) = "GHAASBasin78"
+    list_names(76) = "Magdalena"
+    list_names(77) = "Krishna"
+    list_names(78) = "Salado"
+    list_names(79) = "Fraser"
+    list_names(80) = "Hai Ho"
+    list_names(81) = "Huai"
+    list_names(82) = "Yana"
+    list_names(83) = "GHAASBasin95"
+    list_names(84) = "GHAASBasin105"
+    list_names(85) = "Kura"
+    list_names(86) = "Olenek"
+    list_names(87) = "Ogooue"
+    list_names(88) = "Taymyr"
+    list_names(89) = "Negro Arg"
+    list_names(90) = "Chubut"
+    list_names(91) = "GHAASBasin91"
+    list_names(92) = "GHAASBasin122"
+    list_names(93) = "GHAASBasin120"
+    list_names(94) = "Sacramento"
+    list_names(95) = "Fitzroy West"
+    list_names(96) = "Grande de Santiago"
+    list_names(97) = "Rufiji"
+    list_names(98) = "Wisla"
+    list_names(99) = "GHAASBasin47"
+    list_names(100) = "GHAASBasin127"
+    list_names(101) = "Hong"
+    list_names(102) = "GHAASBasin97"
+    list_names(103) = "Swan-Avon"
+    list_names(104) = "Rhine"
+    list_names(105) = "Cuanza"
+    list_names(106) = "GHAASBasin106"
+    list_names(107) = "GHAASBasin142"
+    list_names(108) = "Roviuna"
+    list_names(109) = "Essequibo"
+    list_names(110) = "Elbe"
+    list_names(111) = "Koksoak"
+    list_names(112) = "Chao Phraya"
+    list_names(113) = "Brahmani"
+    list_names(114) = "GHAASBasin165"
+    list_names(115) = "Pyasina"
+    list_names(116) = "Fitzroy East"
+    list_names(117) = "GHAASBasin173"
+    list_names(118) = "Albany"
+    list_names(119) = "Sanaga"
+    list_names(120) = "GHAASBasin120"
+    list_names(121) = "GHAASBasin178"
+    list_names(122) = "GHAASBasin148"
+    list_names(123) = "Brazos (Tex)"
+    list_names(124) = "GHAASBasin124"
+    list_names(125) = "Alabama"
+    list_names(126) = "GHAASBasin174"
+    list_names(127) = "GHAASBasin179"
+    list_names(128) = "Balsas"
+    list_names(129) = "GHAASBasin172"
+    list_names(130) = "Burdekin"
+    list_names(131) = "Colorado (Texas)"
+    list_names(132) = "GHAASBasin150"
+    list_names(133) = "Odra"
+    list_names(134) = "Loire"
+    list_names(135) = "GHAASBasin98"
+    list_names(136) = "Galana"
+    list_names(137) = "Kuskowin"
+    list_names(138) = "Moose"
+    list_names(139) = "Narmada"
+    list_names(140) = "GHAASBasin140"
+    list_names(141) = "GHAASBasin141"
+    list_names(142) = "Flinders"
+    list_names(143) = "Kizil Irmak"
+    list_names(144) = "GHAASBasin144"
+    list_names(145) = "Save"
+    list_names(146) = "Roper"
+    list_names(147) = "Churchill (Atlantic)"
+    list_names(148) = "GHAASBasin148"
+    list_names(149) = "Victoria"
+    list_names(150) = "Back"
+    list_names(151) = "Bandama"
+    list_names(152) = "Severn (Can)"
+    list_names(153) = "Po"
+    list_names(154) = "GHAASBasin154"
+    list_names(155) = "GHAASBasin155"
+    list_names(156) = "GHAASBasin156"
+    list_names(157) = "Rhone"
+    list_names(158) = "Tana (Ken)"
+    list_names(159) = "La Grande"
+    list_names(160) = "GHAASBasin160"
+    list_names(161) = "Cunene"
+    list_names(162) = "Douro"
+    list_names(163) = "GHAASBasin163"
+    list_names(164) = "Nemanus"
+    list_names(165) = "GHAASBasin165"
+    list_names(166) = "Anabar"
+    list_names(167) = "Hayes"
+    list_names(168) = "Mearim"
+    list_names(169) = "GHAASBasin169"
+    list_names(170) = "Panuco"
+    list_names(171) = "GHAASBasin171"
+    list_names(172) = "Doce"
+    list_names(173) = "Gasgoyne"
+    list_names(174) = "GHAASBasin174"
+    list_names(175) = "GHAASBasin175"
+    list_names(176) = "Ashburton"
+    list_names(177) = "GHAASBasin177"
+    list_names(178) = "Peel"
+    list_names(179) = "Daugava"
+    list_names(180) = "GHAASBasin180"
+    list_names(181) = "Ebro"
+    list_names(182) = "Comoe"
+    list_names(183) = "Jacui"
+    list_names(184) = "GHAASBasin184"
+    list_names(185) = "Kapuas"
+    list_names(186) = "GHAASBasin186"
+    list_names(187) = "Penzhina"
+    list_names(188) = "Cauweri"
+    list_names(189) = "GHAASBasin189"
+    list_names(190) = "Mamberamo"
+    list_names(191) = "Sepik"
+    list_names(192) = "GHAASBasin192"
+    list_names(193) = "Sassandra"
+    list_names(194) = "GHAASBasin194"
+    list_names(195) = "GHAASBasin195"
+    list_names(196) = "Nottaway"
+    list_names(197) = "Barito"
+    list_names(198) = "GHAASBasin198"
+    list_names(199) = "Seine"
+    list_names(200) = "Tejo"
+    list_names(201) = "GHAASBasin201"
+    list_names(202) = "Gambia"
+    list_names(203) = "Susquehanna"
+    list_names(204) = "Dnestr"
+    list_names(205) = "Murchinson"
+    list_names(206) = "Deseado"
+    list_names(207) = "Mitchell"
+    list_names(208) = "Mahakam"
+    list_names(209) = "GHAASBasin209"
+    list_names(210) = "Pangani"
+    list_names(211) = "GHAASBasin211"
+    list_names(212) = "GHAASBasin212"
+    list_names(213) = "GHAASBasin213"
+    list_names(214) = "GHAASBasin214"
+    list_names(215) = "GHAASBasin215"
+    list_names(216) = "Bug"
+    list_names(217) = "GHAASBasin217"
+    list_names(218) = "Usumacinta"
+    list_names(219) = "Jequitinhonha"
+    list_names(220) = "GHAASBasin220"
+    list_names(221) = "Corantijn"
+    list_names(222) = "Fuchun Jiang"
+    list_names(223) = "Copper"
+    list_names(224) = "Tapti"
+    list_names(225) = "Menjiang"
+    list_names(226) = "Karun"
+    list_names(227) = "Mezen"
+    list_names(228) = "Guadiana"
+    list_names(229) = "Maroni"
+    list_names(230) = "GHAASBasin230"
+    list_names(231) = "Uda"
+    list_names(232) = "GHAASBasin232"
+    list_names(233) = "Kuban"
+    list_names(234) = "Colville"
+    list_names(235) = "Thaane"
+    list_names(236) = "Alazeya"
+    list_names(237) = "Paraiba do Sul"
+    list_names(238) = "GHAASBasin238"
+    list_names(239) = "Fortesque"
+    list_names(240) = "GHAASBasin240"
+    list_names(241) = "GHAASBasin241"
+    list_names(242) = "Winisk"
+    list_names(243) = "GHAASBasin243"
+    list_names(244) = "GHAASBasin244"
+    list_names(245) = "Ikopa"
+    list_names(246) = "Gilbert"
+    list_names(247) = "Kouilou"
+    list_names(248) = "Fly"
+    list_names(249) = "GHAASBasin249"
+    list_names(250) = "GHAASBasin250"
+    list_names(251) = "GHAASBasin251"
+    list_names(252) = "Mangoky"
+    list_names(253) = "Damodar"
+    list_names(254) = "Onega"
+    list_names(255) = "Moulouya"
+    list_names(256) = "GHAASBasin256"
+    list_names(257) = "Ord"
+    list_names(258) = "GHAASBasin258"
+    list_names(259) = "GHAASBasin259"
+    list_names(260) = "GHAASBasin260"
+    list_names(261) = "GHAASBasin261"
+    list_names(262) = "Narva"
+    list_names(263) = "GHAASBasin263"
+    list_names(264) = "Seal"
+    list_names(265) = "Cheliff"
+    list_names(266) = "Garonne"
+    list_names(267) = "Rupert"
+    list_names(268) = "GHAASBasin268"
+    list_names(269) = "Brahmani"
+    list_names(270) = "Sakarya"
+    list_names(271) = "Gourits"
+    list_names(272) = "Sittang"
+    list_names(273) = "Rajang"
+    list_names(274) = "Evros"
+    list_names(275) = "Appalachicola"
+    list_names(276) = "Attawapiskat"
+    list_names(277) = "Lurio"
+    list_names(278) = "Daly"
+    list_names(279) = "Penner"
+    list_names(280) = "GHAASBasin280"
+    list_names(281) = "GHAASBasin281"
+    list_names(282) = "Guadalquivir"
+    list_names(283) = "Nadym"
+    list_names(284) = "GHAASBasin284"
+    list_names(285) = "Saint John"
+    list_names(286) = "GHAASBasin286"
+    list_names(287) = "Cross"
+    list_names(288) = "Omoloy"
+    list_names(289) = "Oueme"
+    list_names(290) = "GHAASBasin290"
+    list_names(291) = "Gota"
+    list_names(292) = "Nueces"
+    list_names(293) = "Stikine"
+    list_names(294) = "Yalu"
+    list_names(295) = "Arnaud"
+    list_names(296) = "GHAASBasin296"
+    list_names(297) = "Jequitinhonha"
+    list_names(298) = "Kamchatka"
+    list_names(299) = "GHAASBasin299"
+    list_names(300) = "Grijalva"
+    list_names(301) = "GHAASBasin301"
+    list_names(302) = "Kemijoki"
+    list_names(303) = "Olifants"
+    list_names(304) = "GHAASBasin304"
+    list_names(305) = "Tsiribihina"
+    list_names(306) = "Coppermine"
+    list_names(307) = "GHAASBasin307"
+    list_names(308) = "GHAASBasin308"
+    list_names(309) = "Kovda"
+    list_names(310) = "Trinity"
+    list_names(311) = "Glama"
+    list_names(312) = "GHAASBasin312"
+    list_names(313) = "Luan"
+    list_names(314) = "Leichhardt"
+    list_names(315) = "GHAASBasin315"
+    list_names(316) = "Gurupi"
+    list_names(317) = "GR Baleine"
+    list_names(318) = "Aux Feuilles"
+    list_names(319) = "GHAASBasin319"
+    list_names(320) = "Weser"
+    list_names(321) = "GHAASBasin321"
+    list_names(322) = "GHAASBasin322"
+    list_names(323) = "Yesil"
+    list_names(324) = "Incomati"
+    list_names(325) = "GHAASBasin325"
+    list_names(326) = "GHAASBasin326"
+    list_names(327) = "Pungoe"
+    list_names(328) = "GHAASBasin328"
+    list_names(329) = "Meuse"
+    list_names(330) = "Eastmain"
+    list_names(331) = "Araguari"
+    list_names(332) = "Hudson"
+    list_names(333) = "GHAASBasin333"
+    list_names(334) = "GHAASBasin334"
+    list_names(335) = "GHAASBasin335"
+    list_names(336) = "GHAASBasin336"
+    list_names(337) = "Kobuk"
+    list_names(338) = "Altamaha"
+    list_names(339) = "GHAASBasin339"
+    list_names(340) = "Mand"
+    list_names(341) = "Santee"
+    list_names(342) = "GHAASBasin342"
+    list_names(343) = "GHAASBasin343"
+    list_names(344) = "GHAASBasin344"
+    list_names(345) = "Hari"
+    list_names(346) = "GHAASBasin346"
+    list_names(347) = "Wami"
+    list_names(348) = "GHAASBasin348"
+    list_names(349) = "GHAASBasin349"
+    !
+    basin_names(:) = '    '
+    !
+    DO i=1,numlar
+       tmp_str = list_names(i)
+       basin_names(i) = tmp_str(1:MIN(lenstr,LEN_TRIM(tmp_str)))
+    ENDDO
+    !
+  END SUBROUTINE routing_names
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_irrigmap
+!!
+!> BRIEF         This  subroutine interpolates the 0.5x0.5 degree based map of irrigated areas to the resolution of the model.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_irrigmap (nbpt, index, lalo, neighbours, resolution, contfrac, &
+       &                     init_irrig, irrigated, init_flood, floodplains, init_swamp, &
+       &                     swamp, init_streamsurf, headw_area, stream_area, hist_id, hist2_id)   
+       
+    !
+    IMPLICIT NONE
+    !
+!! PARAMETERS
+    INTEGER(r_std), PARAMETER                      :: ilake = 1             !! Number of type of lakes area (unitless)
+    INTEGER(r_std), PARAMETER                      :: idam = 2              !! Number of type of dams area (unitless)
+    INTEGER(r_std), PARAMETER                      :: iflood = 3            !! Number of type of floodplains area (unitless)
+    INTEGER(r_std), PARAMETER                      :: iswamp = 4            !! Number of type of swamps area (unitless)
+    INTEGER(r_std), PARAMETER                      :: isal = 5              !! Number of type of salines area (unitless)
+    INTEGER(r_std), PARAMETER                      :: ipond = 6             !! Number of type of ponds area (unitless)
+    INTEGER(r_std), PARAMETER                      :: ntype = 6             !! Number of types of flooded surfaces (unitless)
+!!RL This is something that should have been defined in constantes_var
+    
+!! INPUT VARIABLES
+    INTEGER(i_std), INTENT(in)                     :: nbpt                  !! Domain size  (unitless)
+    INTEGER(i_std), INTENT(in)                     :: index(nbpt)           !! Index on the global map.
+    REAL(r_std), INTENT(in)                        :: lalo(nbpt,2)          !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)                     :: neighbours(nbpt,8)    !! Vector of neighbours for each grid point (1=N, 2=E, 3=S, 4=W)
+    REAL(r_std), INTENT(in)                        :: resolution(nbpt,2)    !! The size of each grid box in X and Y (m)
+    REAL(r_std), INTENT(in)                        :: contfrac(nbpt)        !! Fraction of land in each grid box (unitless;0-1)
+    INTEGER(i_std), INTENT(in)                     :: hist_id               !! Access to history file (unitless)
+    INTEGER(i_std), INTENT(in)                     :: hist2_id              !! Access to history file 2 (unitless)
+    LOGICAL, INTENT(in)                            :: init_irrig            !! Logical to initialize the irrigation (true/false)
+    LOGICAL, INTENT(in)                            :: init_flood            !! Logical to initialize the floodplains (true/false)
+    LOGICAL, INTENT(in)                            :: init_swamp            !! Logical to initialize the swamps (true/false)
+    LOGICAL, INTENT(in)                            :: init_streamsurf       !! Logical to initialize the stream surface (true/false)
+    !
+!! OUTPUT VARIABLES
+    REAL(r_std), INTENT(out)                       :: irrigated(:)          !! Irrigated surface in each grid box @tex $(m^2})$ @endtex
+    REAL(r_std), INTENT(out)                       :: floodplains(:)        !! Surface which can be inundated in each grid box @tex $(m^2})$ @endtex
+    REAL(r_std), INTENT(out)                       :: swamp(:)              !! Surface which can be swamp in each grid box @tex $(m^2})$ @endtex
+    REAL(r_std), INTENT(out)                       :: headw_area(:)         !! Surface of head waters in each grid box @tex $(m^2})$ @endtex  
+    REAL(r_std), INTENT(out)                       :: stream_area(:)        !! Surface of rivers in each grid box @tex $(m^2})$ @endtex     
+    !
+!! LOCAL VARIABLES
+    ! Interpolation variables
+    ! 
+    INTEGER(i_std)                                 :: nbpmax, nix, njx, fopt!! Idices, (unitless)
+    CHARACTER(LEN=30)                              :: callsign              !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)     :: resol_lu              !! Resolution read on the map
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)    :: mask                  !! Mask to exclude some points (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: sub_area              !! Area on the fine grid @tex $(m^2})$ @endtex
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index             !! Indices of the points we need on the fine grid (unitless)
+    INTEGER                                        :: ALLOC_ERR             !!
+    LOGICAL                                        :: ok_interpol = .FALSE. !! Flag for interpolation (true/false)
+    !
+    CHARACTER(LEN=80)                              :: filename              !! Name of the netcdf file (unitless)
+    INTEGER(i_std)                                 :: iml, jml, lml, tml, fid, ib, ip, jp, itype !! Indices (unitless)
+    REAL(r_std)                                    :: lev(1), date, dt, coslat !!
+    INTEGER(i_std)                                 :: itau(1)               !!
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: latrel                !! Latitude
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: lonrel                !! Longitude
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: irrigated_frac        !! Irrigated fraction of the grid box (unitless;0-1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)     :: flood_fracmax         !! Maximal flooded fraction of the grid box (unitless;0-1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: stream_frac           !! Sream fraction of the grid box (unitless;0-1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)       :: headw_frac            !! Head water fraction of the grid box (unitless;0-1)   
+    REAL(r_std)                                    :: area_irrig            !! Irrigated surface in the grid box @tex $(m^2})$ @endtex
+    REAL(r_std)                                    :: area_flood(ntype)     !! Flooded surface in the grid box @tex $(m^2})$ @endtex
+    REAL(r_std)                                    :: area_stream           !! River surface in the grid box @tex $(m^2})$ @endtex
+    REAL(r_std)                                    :: area_headw            !! Head water surface in the grid box @tex $(m^2})$ @endtex    
+!$    REAL(r_std)                                :: irrigmap(nbpt)
+!$    REAL(r_std)                                :: floodmap(nbpt)
+!$    REAL(r_std)                                :: swampmap(nbpt)
+
+!_ ================================================================================================================================
+
+    !
+    !Config Key   = IRRIGATION_FILE
+    !Config Desc  = Name of file which contains the map of irrigated areas
+    !Config Def   = floodplains.nc
+    !Config If    = DO_IRRIGATION OR DO_FLOODPLAINS OR ok_doc
+    !Config Help  = The name of the file to be opened to read the field
+    !Config         with the area in m^2 of the area irrigated within each
+    !Config         0.5 0.5 deg grid box. The map currently used is the one
+    !Config         developed by the Center for Environmental Systems Research 
+    !Config         in Kassel (1995).
+    !Config Units = [FILE]
+    !
+    filename = 'floodplains.nc' !
+    CALL getin_p('IRRIGATION_FILE',filename)  
+    !
+    IF (is_root_prc) THEN
+       CALL flininfo(filename,iml, jml, lml, tml, fid)
+       CALL flinclo(fid)
+    ENDIF
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    !
+    !
+    ALLOC_ERR=-10
+    ALLOCATE (latrel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of latrel : ",ALLOC_ERR, iml, jml
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE (lonrel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lonrel : ",ALLOC_ERR
+      STOP 
+    ENDIF
+
+    ALLOC_ERR=-1
+    ALLOCATE (irrigated_frac(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of irrigated_frac : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE (flood_fracmax(iml,jml,ntype), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of flood_fracmax : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE (headw_frac(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of headw_frac : ",ALLOC_ERR
+      STOP 
+    ENDIF    
+    ALLOC_ERR=-1
+    ALLOCATE (stream_frac(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of stream_frac : ",ALLOC_ERR
+      STOP 
+    ENDIF        
+    !
+    IF (is_root_prc) CALL flinopen(filename, .FALSE., iml, jml, lml, lonrel, latrel, lev, tml, itau, date, dt, fid)
+    CALL bcast(lonrel)
+    CALL bcast(latrel)
+    CALL bcast(lev)
+    CALL bcast(itau)
+    CALL bcast(date)
+    CALL bcast(dt)
+    
+ 
+    IF (is_root_prc) CALL flinget(fid, 'irrig', iml, jml, lml, tml, 1, 1, irrigated_frac)
+    CALL bcast(irrigated_frac)
+    IF (is_root_prc) CALL flinget(fid, 'lake', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,ilake))
+    IF (is_root_prc) CALL flinget(fid, 'dam', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,idam))
+    IF (is_root_prc) CALL flinget(fid, 'flood', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,iflood))
+    IF (is_root_prc) CALL flinget(fid, 'swamp', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,iswamp))
+    IF (is_root_prc) CALL flinget(fid, 'saline', iml, jml, lml, tml, 1, 1, flood_fracmax(:,:,isal))
+    CALL bcast(flood_fracmax)
+    IF (is_root_prc) CALL flinget(fid, 'headw', iml, jml, lml, tml, 1, 1, headw_frac)
+    CALL bcast(headw_frac)    
+    IF (is_root_prc) CALL flinget(fid, 'stream', iml, jml, lml, tml, 1, 1, stream_frac)
+    CALL bcast(stream_frac)    
+    !
+    IF (is_root_prc) CALL flinclo(fid)
+    !
+    ! Set to zero all fraction which are less than 0.5%
+    ! For head water and stream surface area a lower min threshold was chosen. 
+    ! Should we keep the 0.5% for floodplains, or better decrease the min_number?
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          IF ( irrigated_frac(ip,jp) .LT. undef_sechiba-un) THEN
+             irrigated_frac(ip,jp) = irrigated_frac(ip,jp)/100.
+             IF ( irrigated_frac(ip,jp) < 0.005 ) irrigated_frac(ip,jp) = zero
+          ENDIF
+          !
+          DO itype=1,ntype
+             IF ( flood_fracmax(ip,jp,itype) .LT. undef_sechiba-1.) THEN
+                flood_fracmax(ip,jp,itype) = flood_fracmax(ip,jp,itype)/100
+                IF ( flood_fracmax(ip,jp,itype) < 0.005 )  flood_fracmax(ip,jp,itype) = zero
+             ENDIF
+          ENDDO
+          !
+          IF ( headw_frac(ip,jp) .LT. undef_sechiba-un) THEN
+             headw_frac(ip,jp) = headw_frac(ip,jp)/100.
+             IF ( headw_frac(ip,jp) < 0.0001 ) headw_frac(ip,jp) = zero
+          ENDIF
+          !         
+          IF ( stream_frac(ip,jp) .LT. undef_sechiba-un) THEN
+             stream_frac(ip,jp) = stream_frac(ip,jp)/100.
+             IF ( stream_frac(ip,jp) < 0.0001 ) stream_frac(ip,jp) = zero
+          ENDIF
+          !           
+       ENDDO
+    ENDDO
+    !
+    WRITE(numout,*) 'lonrel : ', MAXVAL(lonrel), MINVAL(lonrel)
+    WRITE(numout,*) 'latrel : ', MAXVAL(latrel), MINVAL(latrel)
+    WRITE(numout,*) 'irrigated_frac : ', MINVAL(irrigated_frac, MASK=irrigated_frac .GT. 0), &
+         &                          MAXVAL(irrigated_frac, MASK=irrigated_frac .LT. undef_sechiba)
+    WRITE(numout,*) 'flood_fracmax : ', MINVAL(flood_fracmax, MASK=flood_fracmax .GT. 0), &
+         &                      MAXVAL(flood_fracmax, MASK=flood_fracmax .LT. undef_sechiba)
+    WRITE(numout,*) 'headw_frac : ', MINVAL(headw_frac, MASK=headw_frac .GT. 0), &
+         &                          MAXVAL(headw_frac, MASK=headw_frac .LT. undef_sechiba)          
+    WRITE(numout,*) 'stream_frac : ', MINVAL(stream_frac, MASK=stream_frac .GT. 0), &
+         &                          MAXVAL(stream_frac, MASK=stream_frac .LT. undef_sechiba)         
+    !
+    ! Consider all points a priori
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of resol_lu : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    mask(:,:) = 0
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          ! Exclude the points where we are close to the missing value.
+          !
+!MG This condition cannot be applied in floodplains/swamps configuration because
+!   the same mask would be used for the interpolation of irrigation, floodplains and swamps maps.
+!          IF ( irrigated_frac(ip,jp) < undef_sechiba ) THEN
+             mask(ip,jp) = 1
+!          ENDIF
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( latrel(ip,jp) * pi/180. ), mincos )     
+          IF ( ip .EQ. 1 ) THEN
+             resol_lu(ip,jp,1) = ABS( lonrel(ip+1,jp) - lonrel(ip,jp) ) * pi/180. * R_Earth * coslat
+          ELSEIF ( ip .EQ. iml ) THEN
+             resol_lu(ip,jp,1) = ABS( lonrel(ip,jp) - lonrel(ip-1,jp) ) * pi/180. * R_Earth * coslat
+          ELSE
+             resol_lu(ip,jp,1) = ABS( lonrel(ip+1,jp) - lonrel(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resol_lu(ip,jp,2) = ABS( latrel(ip,jp) - latrel(ip,jp+1) ) * pi/180. * R_Earth
+          ELSEIF ( jp .EQ. jml ) THEN
+             resol_lu(ip,jp,2) = ABS( latrel(ip,jp-1) - latrel(ip,jp) ) * pi/180. * R_Earth
+          ELSE
+             resol_lu(ip,jp,2) =  ABS( latrel(ip,jp-1) - latrel(ip,jp+1) )/2. * pi/180. * R_Earth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+       njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+       nbpmax = nix*njx
+    ENDIF
+    CALL bcast(nbpmax)
+    !
+    callsign = 'Irrigation map' 
+    ok_interpol = .FALSE.
+    !
+    WRITE(numout,*) "Projection arrays for ",callsign," : "
+    WRITE(numout,*) "nbpmax = ",nbpmax, nix, njx
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(sub_index(nbpt, nbpmax, 2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+       STOP 
+    ENDIF
+    sub_index(:,:,:)=0
+    ALLOC_ERR=-1
+    ALLOCATE(sub_area(nbpt, nbpmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+       STOP 
+    ENDIF
+    sub_area(:,:)=zero
+    !
+    CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+         &                iml, jml, lonrel, latrel, mask, callsign, &
+         &                nbpmax, sub_index, sub_area, ok_interpol)
+    !
+    !
+    WHERE (sub_area < 0) sub_area=zero
+    !  
+    !
+    DO ib=1,nbpt
+                   !
+       area_irrig  = 0.0
+       area_flood  = 0.0
+       area_stream = 0.0
+       area_headw  = 0.0
+       ! 
+       fopt=1
+       !
+       DO WHILE ( sub_area(ib,fopt) > zero ) 
+          !
+          ip = sub_index(ib, fopt, 1)
+          jp = sub_index(ib, fopt, 2)
+          !
+          IF (irrigated_frac(ip,jp) .LT. undef_sechiba-1.) THEN
+             area_irrig = area_irrig + sub_area(ib,fopt)*irrigated_frac(ip,jp)
+          ENDIF
+          !
+          DO itype=1,ntype
+             IF (flood_fracmax(ip,jp,itype) .LT. undef_sechiba-1.) THEN
+                area_flood(itype) = area_flood(itype) + sub_area(ib,fopt)*flood_fracmax(ip,jp,itype)
+             ENDIF
+          ENDDO
+          !
+          IF (headw_frac(ip,jp) .LT. undef_sechiba-1.) THEN
+             area_headw = area_headw + sub_area(ib,fopt)*headw_frac(ip,jp)
+          ENDIF
+          !
+          IF (stream_frac(ip,jp) .LT. undef_sechiba-1.) THEN
+             area_stream = area_stream + sub_area(ib,fopt)*stream_frac(ip,jp)
+          ENDIF          
+          !
+          fopt = fopt + 1
+          !
+       ENDDO
+       !
+       ! Put the total irrigated and flooded areas in the output variables
+       !
+       IF ( init_irrig ) THEN
+          irrigated(ib) = MIN(area_irrig, resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( irrigated(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', irrigated(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_irrig
+             STOP
+          ENDIF
+!$          ! Compute a diagnostic of the map.
+!$          IF(contfrac(ib).GT.zero) THEN
+!$             irrigmap (ib) = irrigated(ib) / ( resolution(ib,1)*resolution(ib,2)*contfrac(ib) )
+!$          ELSE
+!$             irrigmap (ib) = zero
+!$          ENDIF
+          !
+       ENDIF
+       !
+       IF ( init_flood ) THEN
+          floodplains(ib) = MIN(area_flood(iflood)+area_flood(idam)+area_flood(isal), &
+               & resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( floodplains(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', floodplains(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_flood
+             STOP
+          ENDIF
+!$          ! Compute a diagnostic of the map.
+!$          IF(contfrac(ib).GT.zero) THEN
+!$             floodmap(ib) = floodplains(ib) / ( resolution(ib,1)*resolution(ib,2)*contfrac(ib) )
+!$          ELSE
+!$             floodmap(ib) = 0.0
+!$          ENDIF
+       ENDIF
+       !
+       IF ( init_swamp ) THEN
+          swamp(ib) = MIN(area_flood(iswamp), resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( swamp(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', swamp(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_flood
+             STOP
+          ENDIF
+!$          ! Compute a diagnostic of the map.
+!$          IF(contfrac(ib).GT.zero) THEN
+!$             swampmap(ib) = swamp(ib) / ( resolution(ib,1)*resolution(ib,2)*contfrac(ib) )
+!$          ELSE
+!$             swampmap(ib) = zero
+!$          ENDIF
+       ENDIF
+       !
+       IF ( init_streamsurf ) THEN
+          headw_area(ib) = MIN(area_headw, resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( headw_area(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', headw_area(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_headw
+             STOP
+          ENDIF
+          
+          stream_area(ib) = MIN(area_stream, resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+          IF ( stream_area(ib) < 0 ) THEN
+             WRITE(numout,*) 'We have a problem here : ', stream_area(ib) 
+             WRITE(numout,*) 'resolution :', resolution(ib,1), resolution(ib,2)
+             WRITE(numout,*) area_stream
+             STOP
+          ENDIF
+          !
+       ENDIF
+       !
+       !
+       !
+    ENDDO
+    !
+    !
+    IF ( init_irrig ) WRITE(numout,*) "Diagnostics irrigated :", MINVAL(irrigated), MAXVAL(irrigated)
+    IF ( init_flood ) WRITE(numout,*) "Diagnostics floodplains :", MINVAL(floodplains), MAXVAL(floodplains)
+    IF ( init_swamp ) WRITE(numout,*) "Diagnostics swamp :", MINVAL(swamp), MAXVAL(swamp)
+    IF ( init_streamsurf ) WRITE(numout,*) "Diagnostics head waters :", MINVAL(headw_area), MAXVAL(headw_area)  
+    IF ( init_streamsurf ) WRITE(numout,*) "Diagnostics rivers :", MINVAL(stream_area), MAXVAL(stream_area)    
+!
+! No compensation is done for overlapping floodplains, swamp and irrig. At least overlapping will not
+! happen between floodplains and swamp alone
+!    IF ( init_irrig .AND. init_flood ) THEN
+!       DO ib = 1, nbpt
+!          surp = (floodplains(ib)+swamp(ib)+irrigated(ib)) / (resolution(ib,1)*resolution(ib,2)*contfrac(ib))
+!          IF ( surp .GT. un ) THEN
+!             floodplains(ib) = floodplains(ib) / surp
+!             swamp(ib) = swamp(ib) / surp
+!             irrigated(ib) = irrigated(ib) / surp
+!          ENDIF
+!       ENDDO
+!    ENDIF
+    !
+    DEALLOCATE (sub_area)
+    DEALLOCATE (sub_index)
+    !
+    DEALLOCATE (mask)
+    DEALLOCATE (resol_lu)
+    !
+    DEALLOCATE (lonrel)
+    DEALLOCATE (latrel)
+    !
+  END SUBROUTINE routing_irrigmap
+  !
+!! ================================================================================================================================
+!! SUBROUTINE   : routing_waterbal
+!!
+!> BRIEF         This subroutine checks the water balance in the routing module.
+!!
+!! DESCRIPTION (definitions, functional, design, flags) : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE routing_waterbal(nbpt, firstcall, flood_frac, floodout, precipitation, runoff, drainage,  &
+               & returnflow, reinfiltration, irrigation, riverflow, coastalflow)
+    
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in) :: nbpt                       !! Domain size  (unitless)
+    LOGICAL, INTENT(in)        :: firstcall                  !! Controls behaviour (true/false)
+    REAL(r_std), INTENT(in)    :: flood_frac(nbpt)           !! Grid-point fraction of floodplains     
+    REAL(r_std), INTENT(in)    :: floodout(nbpt)             !! Grid-point flow out of floodplains 
+                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: precipitation(nbpt,nflow)  !! Grid-point precipitation @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: runoff(nbpt,nflow)         !! Grid-point runoff @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: drainage(nbpt,nflow)       !! Grid-point drainage @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: returnflow(nbpt,nflow)     !! The water flow from lakes and swamps which returns to the grid box.
+                                                             !! This water will go back into the hydrol or hydrolc module to allow 
+                                                             !! re-evaporation @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: reinfiltration(nbpt,nflow) !! Water flow from ponds and floodplains which returns to the grid box 
+                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: irrigation(nbpt,nflow)     !! Irrigation flux. This is the water taken from the reservoirs and 
+                                                             !! beeing put into the upper layers of the soil 
+                                                             !! @tex $(kg m^{-2} dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: riverflow(nbpt,nflow)      !! Outflow of the major rivers. The flux will be located on the 
+                                                             !! continental grid but this should be a coastal point 
+                                                             !! @tex $(kg dt^{-1})$ @endtex
+    REAL(r_std), INTENT(in)    :: coastalflow(nbpt,nflow)    !! Outflow on coastal points by small basins. This is the water which 
+                                                             !! flows in a disperse way into the ocean @tex $(kg dt^{-1})$ @endtex
+    
+    ! We sum-up all the water we have in the warious reservoirs
+    !! 0.2 Local variables    
+    REAL(r_std), SAVE          :: totw_flood           !! Sum of all the water amount in the floodplains reservoirs (kg)
+    REAL(r_std), SAVE          :: totw_stream          !! Sum of all the water amount in the stream reservoirs (kg)
+    REAL(r_std), SAVE          :: totw_fast            !! Sum of all the water amount in the fast reservoirs (kg)
+    REAL(r_std), SAVE          :: totw_slow            !! Sum of all the water amount in the slow reservoirs (kg)
+    REAL(r_std), SAVE          :: totw_lake            !! Sum of all the water amount in the lake reservoirs (kg)
+    REAL(r_std), SAVE          :: totw_pond            !! Sum of all the water amount in the pond reservoirs (kg)
+    REAL(r_std), SAVE          :: totw_in              !! Sum of the water flow in to the routing scheme
+    REAL(r_std), SAVE          :: totw_out             !! Sum of the water flow out to the routing scheme
+    REAL(r_std), SAVE          :: totw_return          !! 
+    REAL(r_std), SAVE          :: totw_irrig           !! 
+    REAL(r_std), SAVE          :: totw_river           !! 
+    REAL(r_std), SAVE          :: totw_coastal         !! 
+    REAL(r_std), SAVE          :: totc_flood           !! Sum of all the carbon amount in the floodplains reservoirs (kg)
+    REAL(r_std), SAVE          :: totc_stream          !! Sum of all the carbon amount in the stream reservoirs (kg)
+    REAL(r_std), SAVE          :: totc_fast            !! Sum of all the carbon amount in the fast reservoirs (kg)
+    REAL(r_std), SAVE          :: totc_slow            !! Sum of all the carbon amount in the slow reservoirs (kg)
+    REAL(r_std), SAVE          :: totc_lake            !! Sum of all the carbon amount in the lake reservoirs (kg)
+    REAL(r_std), SAVE          :: totc_pond            !! Sum of all the carbon amount in the pond reservoirs (kg)
+    REAL(r_std), SAVE          :: totc_in              !! Sum of the carbon flow in to the routing scheme
+    REAL(r_std), SAVE          :: totc_out             !! Sum of the carbon flow out to the routing scheme
+    REAL(r_std), SAVE          :: totc_return          !! 
+    REAL(r_std), SAVE          :: totc_irrig           !! 
+    REAL(r_std), SAVE          :: totc_river           !! 
+    REAL(r_std), SAVE          :: totc_coastal         !!
+    REAL(r_std), SAVE          :: totc_FCO2         !!    
+    REAL(r_std)                :: totarea              !! Total area of basin @tex $(m^2})$ @endtex
+    REAL(r_std)                :: area                 !! Total area of routing @tex $(m^2})$ @endtex
+    INTEGER(i_std)             :: ig                   !! 
+    
+    ! Just to make sure we do not get too large numbers !
+    
+    !! PARAMETERS
+    REAL(r_std), PARAMETER     :: scaling = 1.0E+6     !!
+    REAL(r_std), PARAMETER     :: allowed_err = 50.    !!
+  !! 1. Calculate water balance
+    IF ( firstcall ) THEN
+       !
+       totw_flood = zero
+       totw_stream = zero
+       totw_fast = zero
+       totw_slow = zero
+       totw_lake = zero
+       totw_pond = zero 
+       totw_in = zero
+       !
+       DO ig=1,nbpt
+          !
+          totarea = SUM(routing_area(ig,:))
+          !
+          totw_flood = totw_flood + SUM(flood_reservoir(ig,:,ih2o)/scaling)
+          totw_stream = totw_stream + SUM(stream_reservoir(ig,:,ih2o)/scaling)
+          totw_fast = totw_fast + SUM(fast_reservoir(ig,:,ih2o)/scaling)
+          totw_slow = totw_slow + SUM(slow_reservoir(ig,:,ih2o)/scaling)
+          totw_lake = totw_lake + lake_reservoir(ig,ih2o)/scaling
+          totw_pond = totw_pond + pond_reservoir(ig,ih2o)/scaling
+          !
+          totw_in = totw_in + (runoff(ig,ih2o) + drainage(ig,ih2o) - floodout(ig))&
+          &       * totarea / scaling
+          !
+       ENDDO
+       !
+    ELSE
+       !
+       totw_out = zero
+       totw_return = zero
+       totw_irrig = zero
+       totw_river = zero
+       totw_coastal = zero
+       area = zero
+       !
+       DO ig=1,nbpt
+          !
+          totarea = SUM(routing_area(ig,:))
+          !
+          totw_flood = totw_flood - SUM(flood_reservoir(ig,:,ih2o)/scaling)
+          totw_stream = totw_stream - SUM(stream_reservoir(ig,:,ih2o)/scaling)
+          totw_fast = totw_fast - SUM(fast_reservoir(ig,:,ih2o)/scaling)
+          totw_slow = totw_slow - SUM(slow_reservoir(ig,:,ih2o)/scaling)
+          totw_lake = totw_lake - lake_reservoir(ig,ih2o)/scaling
+          totw_pond = totw_pond - pond_reservoir(ig,ih2o)/scaling
+          !
+          totw_return = totw_return + (reinfiltration(ig,ih2o)+returnflow(ig,ih2o))*totarea/scaling
+          totw_irrig = totw_irrig + irrigation(ig,ih2o)*totarea/scaling
+          totw_river = totw_river + riverflow(ig,ih2o)/scaling
+          totw_coastal = totw_coastal + coastalflow(ig,ih2o)/scaling
+          !
+          area = area + totarea
+          !
+       ENDDO
+       totw_out = totw_return + totw_irrig + totw_river + totw_coastal
+       !
+       ! Now we have all the information to balance our water
+       !
+       IF ( ABS((totw_flood + totw_stream + totw_fast + totw_slow + totw_lake + totw_pond) - &
+            & (totw_out - totw_in)) > allowed_err ) THEN
+          WRITE(numout,*) 'WARNING : Water not conserved in routing. Limit at ', allowed_err, ' 10^6 kg'
+          WRITE(numout,*) '--Water-- change : flood stream fast ', totw_flood, totw_stream, totw_fast
+          WRITE(numout,*) '--Water-- change : slow, lake ', totw_slow, totw_lake
+          WRITE(numout,*) '--Water>>> change in the routing res. : ', totw_flood + totw_stream + totw_fast + totw_slow + totw_lake
+          WRITE(numout,*) '--Water input : ', totw_in
+          WRITE(numout,*) '--Water output : ', totw_out
+          WRITE(numout,*) '--Water output : return, irrig ', totw_return, totw_irrig
+          WRITE(numout,*) '--Water output : river, coastal ',totw_river, totw_coastal
+          WRITE(numout,*) '--Water>>> change by fluxes : ', totw_out - totw_in, ' Diff [mm/dt]: ',   &
+               & ((totw_flood + totw_stream + totw_fast + totw_slow + totw_lake) - (totw_out - totw_in))/area
+       ENDIF
+       !       !
+    ENDIF
+    !! 2 Calculate C fluxes
+    IF ( firstcall ) THEN
+       !
+       totc_flood = zero
+       totc_stream = zero
+       totc_fast = zero
+       totc_slow = zero
+       totc_lake = zero
+       totc_pond = zero 
+       totc_in = zero
+       !
+       DO ig=1,nbpt
+          !
+          totarea = SUM(routing_area(ig,:))
+          !
+          totc_flood  = totc_flood + SUM(flood_reservoir(ig,:,idoc)) &
+          &           + SUM(flood_reservoir(ig,:,iCO2aq))
+          totc_stream = totc_stream + SUM(stream_reservoir(ig,:,idoc)) &
+          &           + SUM(stream_reservoir(ig,:,iCO2aq))
+          totc_fast = totc_fast + SUM(fast_reservoir(ig,:,idoc)) + SUM(fast_reservoir(ig,:,iCO2aq))
+          totc_slow = totc_slow + SUM(slow_reservoir(ig,:,idoc)) + SUM(slow_reservoir(ig,:,iCO2aq))
+          totc_lake = totc_lake + lake_reservoir(ig,idoc) + lake_reservoir(ig,iCO2aq)
+          totc_pond = totc_pond + pond_reservoir(ig,idoc) + pond_reservoir(ig,iCO2aq)
+          !
+          totc_in = totc_in + totarea &
+          & * ((precipitation(ig,idoc) + precipitation(ig,iCO2aq)) * flood_frac(ig) &
+          & + runoff(ig,idoc) + runoff(ig,iCO2aq) + drainage(ig,idoc) + drainage(ig,iCO2aq))            
+          !
+       ENDDO
+       !
+    ELSE
+       !
+       totc_out = zero
+       totc_return = zero
+       totc_irrig = zero
+       totc_river = zero
+       totc_coastal = zero
+       totc_FCO2 = zero
+       area = zero
+       !
+       DO ig=1,nbpt
+          !
+          totarea = SUM(routing_area(ig,:))
+          !
+          totc_flood  = totc_flood - SUM(flood_reservoir(ig,:,idoc)) &
+          &           - SUM(flood_reservoir(ig,:,iCO2aq))
+          totc_stream = totc_stream - SUM(stream_reservoir(ig,:,idoc)) &
+          &           - SUM(stream_reservoir(ig,:,iCO2aq))
+          totc_fast = totc_fast - SUM(fast_reservoir(ig,:,idoc)) - SUM(fast_reservoir(ig,:,iCO2aq))
+          totc_slow = totc_slow - SUM(slow_reservoir(ig,:,idoc)) - SUM(slow_reservoir(ig,:,iCO2aq))
+          totc_lake = totc_lake - lake_reservoir(ig,idoc) - lake_reservoir(ig,iCO2aq)
+          totc_pond = totc_pond - pond_reservoir(ig,idoc) - pond_reservoir(ig,iCO2aq)
+          !
+          totc_return = totc_return + (reinfiltration(ig,idoc) + returnflow(ig,idoc) &
+          &           + reinfiltration(ig,iCO2aq) + returnflow(ig,iCO2aq) )*totarea
+          totc_irrig = totc_irrig + (irrigation(ig,idoc)+irrigation(ig,iCO2aq)) * totarea
+          totc_river = totc_river + riverflow(ig,idoc) + riverflow(ig,iCO2aq)
+          totc_coastal = totc_coastal + coastalflow(ig,idoc) + coastalflow(ig,iCO2aq)
+          totc_FCO2    = totc_FCO2 + SUM(FCO2_aq(ig,:))
+          !
+          area = area + totarea
+          !
+       ENDDO
+       totc_out = totc_return + totc_irrig + totc_river + totc_coastal + totc_FCO2
+       !
+       ! Now we have all the information to balance our carbon
+       !
+       IF ( ABS((totc_flood + totc_stream + totc_fast + totc_slow + totc_lake + totc_pond) - &
+            & (totc_out - totc_in)) > allowed_err ) THEN
+          WRITE(numout,*) 'WARNING : carbon not conserved in routing. Limit at ', allowed_err, ' 10^6 kg'
+          WRITE(numout,*) '--carbon-- change : flood stream fast ', totc_flood, totc_stream, totc_fast
+          WRITE(numout,*) '--carbon-- change : slow, lake ', totc_slow, totc_lake
+          WRITE(numout,*) '--carbon>>> change in the routing res. : ', totc_flood + totc_stream &
+          &               + totc_fast + totc_slow + totc_lake
+          WRITE(numout,*) '--carbon input : ', totc_in
+          WRITE(numout,*) '--carbon output : ', totc_out
+          WRITE(numout,*) '--carbon output : return, irrig ', totc_return, totc_irrig
+          WRITE(numout,*) '--carbon output : river, coastal ',totc_river, totc_coastal
+          WRITE(numout,*) '--carbon>>> change by fluxes : ', totc_out - totc_in, ' Diff [mm/dt]: ',   &
+          & ((totc_flood + totc_stream + totc_fast + totc_slow + totc_lake) - (totc_out - totc_in))/area
+       ENDIF
+       !       !
+    ENDIF    
+    !
+  END SUBROUTINE routing_waterbal
+  
+  
+END MODULE routing
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/sechiba.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/sechiba.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/sechiba.f90	(revision 5166)
@@ -0,0 +1,2062 @@
+!  ==============================================================================================================================\n
+!  MODULE 	: sechiba
+! 
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Structures the calculation of atmospheric and hydrological 
+!! variables by calling diffuco_main, enerbil_main, hydrolc_main (or hydrol_main),
+!! enerbil_fusion, condveg_main and thermosoil_main. Note that sechiba_main
+!! calls slowproc_main and thus indirectly calculates the biogeochemical
+!! processes as well.
+!!
+!!\n DESCRIPTION  : :: shumdiag, :: litterhumdiag and :: stempdiag are not 
+!! saved in the restart file because at the first time step because they 
+!! are recalculated. However, they must be saved as they are in slowproc 
+!! which is called before the modules which calculate them.
+!! 
+!! RECENT CHANGE(S): None 
+!! 
+!! REFERENCE(S) : None
+!!   
+!! SVN     :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+ 
+MODULE sechiba
+ 
+  USE ioipsl
+  
+  ! modules used :
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE diffuco
+  USE condveg
+  USE enerbil
+  USE hydrol                                                                     !! 
+  USE hydrolc
+  USE thermosoil
+  USE sechiba_io
+  USE slowproc
+  USE routing
+  use ioipsl_para
+
+
+  IMPLICIT NONE
+
+  ! Private and public routines
+
+  PRIVATE
+  PUBLIC sechiba_main,sechiba_clear
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexveg       !! indexing array for the 3D fields of vegetation
+!$OMP THREADPRIVATE(indexveg)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexlai       !! indexing array for the 3D fields of vegetation
+!$OMP THREADPRIVATE(indexlai)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexnobio     !! indexing array for the 3D fields of other surfaces (ice,
+                                                                     !! lakes, ...)
+!$OMP THREADPRIVATE(indexnobio)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexsoil      !! indexing array for the 3D fields of soil types
+!$OMP THREADPRIVATE(indexsoil)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexgrnd      !! indexing array for the 3D ground heat profiles
+!$OMP THREADPRIVATE(indexgrnd)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexlayer     !! indexing array for the 3D fields of soil layers 
+!$OMP THREADPRIVATE(indexlayer)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexalb       !! indexing array for the 2 fields of albedo
+!$OMP THREADPRIVATE(indexalb)
+ 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: veget          !! Fraction of vegetation type (unitless, 0-1)       
+!$OMP THREADPRIVATE(veget)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: veget_max      !! Max. fraction of vegetation type (LAI -> infty, unitless)
+!$OMP THREADPRIVATE(veget_max)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: height         !! Vegetation Height (m)
+!$OMP THREADPRIVATE(height)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: totfrac_nobio  !! Total fraction of continental ice+lakes+cities+...
+                                                                     !! (unitless, 0-1)
+!$OMP THREADPRIVATE(totfrac_nobio)
+  REAL(r_std),ALLOCATABLE, SAVE,  DIMENSION (:,:)  :: wat_flux0      !! Water flux in the first soil layers exported for soil C calculations
+!$OMP THREADPRIVATE(wat_flux0)
+  REAL(r_std),ALLOCATABLE, SAVE,  DIMENSION (:,:,:) :: wat_flux       !! Water flux in the soil layers exported for soil C calculations
+!$OMP THREADPRIVATE(wat_flux)
+  REAL(r_std),ALLOCATABLE, SAVE,  DIMENSION (:,:)  :: drainage_per_soil !! Drainage per soil type exported for soil C calculations
+!$OMP THREADPRIVATE(drainage_per_soil)
+  REAL(r_std),ALLOCATABLE, SAVE,  DIMENSION (:,:)  :: runoff_per_soil !! Runoff per soil type exported for soil C calculations
+!$OMP THREADPRIVATE(runoff_per_soil)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: floodout       !! Flow out of floodplains from hydrol
+!$OMP THREADPRIVATE(floodout)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: runoff         !! Surface runoff calculated by hydrol or hydrolc 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: DOC_EXP_agg_d  !! DOC exports, diffrenet paths (nexp), in  
+                                                                     !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex 
+!$OMP THREADPRIVATE(runoff)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: drainage       !! Deep drainage calculatedd by hydrol or hydrolc 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(drainage)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: returnflow     !! Water flow from lakes and swamps which returns to 
+                                                                     !! the grid box @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(returnflow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: reinfiltration !! Routed water which returns into the soil
+!$OMP THREADPRIVATE(reinfiltration)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: irrigation     !! Irrigation flux taken from the routing reservoirs and 
+                                                                     !! being put into the upper layers of the soil 
+                                                                     !! @tex $(kg m^{-2})$ @endtex                                           
+!$OMP THREADPRIVATE(irrigation)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: DOC_to_topsoil !! Sum of DOC fluxes from irrirgation and reinfiltration 
+                                                                     !! @tex $(g m^{-2})$ @endtex                                           
+!$OMP THREADPRIVATE(DOC_to_topsoil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: DOC_to_subsoil !! DOC fluxes from returnflow in lakes and swamps 
+                                                                     !! @tex $(g m^{-2})$ @endtex                                           
+!$OMP THREADPRIVATE(DOC_to_subsoil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: emis           !! Surface emissivity (unitless)
+!$OMP THREADPRIVATE(emis)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: z0             !! Surface roughness (m)
+!$OMP THREADPRIVATE(z0)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: roughheight    !! Effective height for roughness (m)
+!$OMP THREADPRIVATE(roughheight)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: reinf_slope    !! slope coefficient (reinfiltration) 
+!$OMP THREADPRIVATE(reinf_slope)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: shumdiag       !! Mean relative soil moisture in the different levels used 
+                                                                     !! by thermosoil.f90 (unitless, 0-1)
+!$OMP THREADPRIVATE(shumdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: k_litt         !! litter cond.
+!$OMP THREADPRIVATE(k_litt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: litterhumdiag  !! Litter dryness factor (unitless, 0-1)
+!$OMP THREADPRIVATE(litterhumdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: stempdiag      !! Temperature which controls canopy evolution (K)
+!$OMP THREADPRIVATE(stempdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: qsintveg       !! Water on vegetation due to interception 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(qsintveg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta2         !! Interception resistance (unitless,0-1)
+!$OMP THREADPRIVATE(vbeta2)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta3         !! Vegetation resistance (unitless,0-1)
+!$OMP THREADPRIVATE(vbeta3)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta3pot      !! Potential vegetation resistance
+!$OMP THREADPRIVATE(vbeta3pot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbetaco2       !! STOMATE: Vegetation resistance to CO2 (unitless,0-1)
+!$OMP THREADPRIVATE(vbetaco2)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: cimean         !! STOMATE: mean intercellular CO2 concentration 
+                                                                     !! @tex $(\mumol m^{-2} s^{-1})$ @endtex
+!$OMP THREADPRIVATE(cimean)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vevapwet       !! Interception loss over each PFT 
+                                                                     !! @tex $(kg m^{-2} days^{-1})$ @endtex
+!$OMP THREADPRIVATE(vevapwet)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: transpir       !! Transpiration @tex $(kg m^{-2} days^{-1})$ @endtex
+!$OMP THREADPRIVATE(transpir)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: transpot       !! Potential Transpiration (needed for irrigation)
+!$OMP THREADPRIVATE(transpot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: qsintmax       !! Maximum amount of water in the canopy interception 
+                                                                     !! reservoir @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(qsintmax)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: rveget         !! Surface resistance for the vegetation 
+                                                                     !! @tex $(s m^{-1})$ @endtex
+!$OMP THREADPRIVATE(rveget)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: rstruct        !! Vegetation structural resistance
+!$OMP THREADPRIVATE(rstruct)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: snow_nobio     !! Snow mass of non-vegetative surfaces 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+!$OMP THREADPRIVATE(snow_nobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: snow_nobio_age !! Snow age on non-vegetative surfaces (days)
+!$OMP THREADPRIVATE(snow_nobio_age)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: frac_nobio     !! Fraction of non-vegetative surfaces (continental ice, 
+                                                                     !! lakes, ...) (unitless, 0-1)
+!$OMP THREADPRIVATE(frac_nobio)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: albedo         !! Surface albedo for visible and near-infrared 
+                                                                     !! (unitless, 0-1)
+!$OMP THREADPRIVATE(albedo)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:):: assim_param    !! min+max+opt temps, vcmax, vjmax for photosynthesis
+!$OMP THREADPRIVATE(assim_param)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lai            !! Surface foliaire
+!$OMP THREADPRIVATE(lai)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: gpp            !! STOMATE: GPP. gC/m**2 of total area
+!$OMP THREADPRIVATE(gpp)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: humrel         !! Relative humidity
+!$OMP THREADPRIVATE(humrel)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vegstress      !! Vegetation moisture stress (only for vegetation growth)
+!$OMP THREADPRIVATE(vegstress)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:):: frac_age       !! Age efficacity from STOMATE for isoprene 
+!$OMP THREADPRIVATE(frac_age)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: soiltile       !! Fraction of each soil tile (0-1, unitless)
+!$OMP THREADPRIVATE(soiltile)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+!$OMP THREADPRIVATE(njsc)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta1         !! Snow resistance 
+!$OMP THREADPRIVATE(vbeta1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta4         !! Bare soil resistance
+!$OMP THREADPRIVATE(vbeta4)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta5         !! Floodplains resistance
+!$OMP THREADPRIVATE(vbeta5)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: soilcap        !!
+!$OMP THREADPRIVATE(soilcap)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: soilflx        !!
+!$OMP THREADPRIVATE(soilflx)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: temp_sol       !! Soil temperature
+!$OMP THREADPRIVATE(temp_sol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: qsurf          !! near soil air moisture
+!$OMP THREADPRIVATE(qsurf)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: flood_res      !! flood reservoir estimate
+!$OMP THREADPRIVATE(flood_res)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: flood_frac     !! flooded fraction
+!$OMP THREADPRIVATE(flood_frac)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: snow           !! Snow mass [Kg/m^2]
+!$OMP THREADPRIVATE(snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: snow_age       !! Snow age
+!$OMP THREADPRIVATE(snow_age)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: drysoil_frac   !! Fraction of visibly (albedo) Dry soil (Between 0 and 1)
+!$OMP THREADPRIVATE(drysoil_frac)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: rsol           !! resistance to bare soil evaporation
+!$OMP THREADPRIVATE(rsol)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: evap_bare_lim  !! Bare soil stress
+!$OMP THREADPRIVATE(evap_bare_lim)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: co2_flux       !! CO2 flux (gC/m**2 of average ground/s)
+!$OMP THREADPRIVATE(co2_flux)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: evapot         !! Soil Potential Evaporation
+!$OMP THREADPRIVATE(evapot)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: evapot_corr    !! Soil Potential Evaporation Correction (Milly 1992)
+!$OMP THREADPRIVATE(evapot_corr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vevapflo       !! Floodplains evaporation
+!$OMP THREADPRIVATE(vevapflo)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vevapsno       !! Snow evaporation
+!$OMP THREADPRIVATE(vevapsno)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vevapnu        !! Bare soil evaporation
+!$OMP THREADPRIVATE(vevapnu)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: t2mdiag        !! 2 meter temperature
+!$OMP THREADPRIVATE(t2mdiag)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: tot_melt       !! Total melt
+!$OMP THREADPRIVATE(tot_melt)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta          !! Resistance coefficient
+!$OMP THREADPRIVATE(vbeta)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: valpha         !! Resistance coefficient
+!$OMP THREADPRIVATE(valpha)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: fusion         !!
+!$OMP THREADPRIVATE(fusion)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: rau            !! Density
+!$OMP THREADPRIVATE(rau)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: deadleaf_cover !! Fraction of soil covered by dead leaves
+!$OMP THREADPRIVATE(deadleaf_cover)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: ptnlev1        !! 1st level Different levels soil temperature
+!$OMP THREADPRIVATE(ptnlev1)
+
+
+  LOGICAL, SAVE                                    :: l_first_sechiba = .TRUE. !! Flag controlling the intialisation (true/false)
+!$OMP THREADPRIVATE(l_first_sechiba)
+  LOGICAL, SAVE                                    :: river_routing            !! Flag that decides if we route surface runoff 
+                                                                               !! and deep drainage to the ocean through the 
+                                                                               !! rivers
+!$OMP THREADPRIVATE(river_routing)
+  LOGICAL, SAVE                                    :: hydrol_cwrr              !! Flag that decides if we use the 11-layer 
+                                                                               !! hydrology module. If not, Choisnel module is 
+                                                                               !! taken.
+!$OMP THREADPRIVATE(hydrol_cwrr)
+  LOGICAL, SAVE                                    :: myfalse=.FALSE.          !! Local flag (true/false)
+!$OMP THREADPRIVATE(myfalse)
+  LOGICAL, SAVE                                    :: mytrue=.TRUE.            !! Local flag (true/false)
+!$OMP THREADPRIVATE(mytrue)
+  LOGICAL, SAVE                                   :: ok_doc= .TRUE.
+!$OMP THREADPRIVATE(ok_doc)   
+  CHARACTER(LEN=80)    :: var_name       !! To store variables names for I/O (unitless)
+  CHARACTER(LEN=10)    :: flow_suff      !! To assign a suffix to the variables name indicating the transported specie
+  CHARACTER(LEN=80)    :: var_long_name  !! To store variables long names for I/O (unitless) 
+CONTAINS
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_main
+!!
+!>\BRIEF        Main routine for the sechiba module performing three functions:
+!! variable initialization (during the first call only), calculating temporal
+!! evolution of all variables (every call including the first call) and preparation
+!! of output and restart files (during the last call only)
+!!
+!!\n DESCRIPTION : Main routine for the sechiba module. This module is called 
+!! two times:
+!! - a first time to set initial values
+!! - a second time to compute the entire algorithm.\n 
+!! Every time the module is called, three major if/then loops are checked:
+!! - initialization (first call only),
+!! - time step evolution of all variables (every call including the first),
+!! - preparation of output and storage for the restart arrays (last call only).\n
+!! One time step evolution consists of:
+!! - call sechiba_var_init to do some initialization,
+!! - call slowproc_main to do some daily initialization,
+!! - call diffuco_main for diffusion coefficient calculation,
+!! - call enerbil_main for energy budget calculation,
+!! - call hydrolc_main (or hydrol_main) for hydrologic processes calculation,
+!! - call enerbil_fusion : last part with fusion,
+!! - call condveg_main for surface conditions such as roughness, albedo, and emmisivity,
+!! - call thermosoil_main for soil thermodynamic calculation,
+!! - call sechiba_end to swap previous to new fields.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): Hydrological variables (:: coastalflow and :: riverflow),
+!! components of the energy budget (:: tsol_rad, :: vevapp, :: fluxsens, 
+!! :: temp_sol_new and :: fluxlat), surface characteristics (:: z0_out, :: emis_out, 
+!! :: tq_cdrag and :: albedo_out) and land use related CO2 fluxes (:: netco2flux and 
+!! :: fco2_lu)            
+!!
+!! REFERENCE(S)	: 
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!! \includegraphics[scale = 0.5]{sechibamainflow.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE sechiba_main (kjit, kjpij, kjpindex, index, dtradia, date0, &
+       & ldrestart_read, ldrestart_write, control_in, &
+       & lalo, contfrac, neighbours, resolution,&
+       ! First level conditions
+       & zlev, u, v, qair, q2m, t2m, temp_air, epot_air, ccanopy, &
+       ! Variables for the implicit coupling
+       & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+       ! Rain, snow, radiation and surface pressure
+       & precip_rain, precip_snow, lwdown, swnet, swdown, sinang, pb, &
+       ! Output : Fluxes
+       & vevapp, fluxsens, fluxlat, coastalflow, riverflow, netco2flux, fco2_lu, &
+       ! Surface temperatures and surface properties
+       & tsol_rad, temp_sol_new, qsurf_out, albedo_out, emis_out, z0_out, &
+       ! File ids
+       & rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC,soil_mc,litter_mc)
+
+!! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                               :: kjit              !! Time step number (unitless)
+    INTEGER(i_std), INTENT(in)                               :: kjpij             !! Total size of the un-compressed grid 
+                                                                                  !! (unitless)
+    INTEGER(i_std), INTENT(in)                               :: kjpindex          !! Domain size - terrestrial pixels only 
+                                                                                  !! (unitless)
+    INTEGER(i_std),INTENT (in)                               :: rest_id           !! _Restart_ file identifier (unitless)
+    INTEGER(i_std),INTENT (in)                               :: hist_id           !! _History_ file identifier (unitless)
+    INTEGER(i_std),INTENT (in)                               :: hist2_id          !! _History_ file 2 identifier (unitless)
+    INTEGER(i_std),INTENT (in)                               :: rest_id_stom      !! STOMATE's _Restart_ file identifier 
+                                                                                  !! (unitless)
+    INTEGER(i_std),INTENT (in)                               :: hist_id_stom      !! STOMATE's _History_ file identifier 
+                                                                                  !! (unitless)
+    INTEGER(i_std),INTENT(in)                                :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file file 
+                                                                                  !! identifier (unitless)
+    REAL(r_std), INTENT (in)                                 :: dtradia           !! Time step (s)
+    REAL(r_std), INTENT (in)                                 :: date0             !! Initial date (??unit??)
+    LOGICAL, INTENT(in)                                      :: ldrestart_read    !! Logical for _restart_ file to read 
+                                                                                  !! (true/false)
+    LOGICAL, INTENT(in)                                      :: ldrestart_write   !! Logical for _restart_ file to write 
+                                                                                  !! (true/false)
+    TYPE(control_type), INTENT(in)                           :: control_in        !! Flags that (de)activate parts of the model
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)          :: lalo              !! Geographic coordinates (latitude,longitude)
+                                                                                  !! for grid cells (degrees)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: contfrac          !! Fraction of continent in the grid 
+                                                                                  !! (unitless, 0-1)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)         :: index             !! Indices of the pixels on the map. 
+                                                                                  !! Sechiba uses a reduced grid excluding oceans
+                                                                                  !! ::index contains the indices of the 
+                                                                                  !! terrestrial pixels only! (unitless)
+    INTEGER(i_std), DIMENSION (kjpindex,8), INTENT(in)       :: neighbours        !! Neighboring grid points if land!(unitless)
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)          :: resolution        !! Size in x and y of the grid (m)
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: u                 !! Lowest level wind speed in direction u 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: v                 !! Lowest level wind speed in direction v 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: zlev              !! Height of first layer (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: qair              !! Lowest level specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: q2m               !! 2m specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: t2m               !! 2m air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_rain       !! Rain precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: precip_snow       !! Snow precipitation 
+                                                                                  !! @tex $(kg m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: lwdown            !! Down-welling long-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: sinang            !! Sine of the solar angle (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swnet             !! Net surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: swdown            !! Down-welling surface short-wave flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_air          !! Air temperature (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: epot_air          !! Air potential energy (??J)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: ccanopy           !! CO2 concentration in the canopy (ppm)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petAcoef          !! Coefficients A for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqAcoef          !! Coefficients A for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: petBcoef          !! Coefficients B for T from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: peqBcoef          !! Coefficients B for q from the Planetary 
+                                                                                  !! Boundary Layer
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: pb                !! Lowest level pressure (Pa)
+
+
+!! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,nflow), INTENT (out)     :: coastalflow       !! Outflow on coastal points by small basins.
+                                                                                  !! This is the water which flows in a disperse 
+                                                                                  !! way into the ocean
+                                                                                  !! @tex $(kg dt_routing^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex,nflow), INTENT (out)     :: riverflow         !! Outflow of the major rivers.
+                                                                                  !! The flux will be located on the continental 
+                                                                                  !! grid but this should be a coastal point  
+                                                                                  !! @tex $(kg dt_routing^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: tsol_rad          !! Radiative surface temperature 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: vevapp            !! Total of evaporation 
+                                                                                  !! @tex $(kg m^{-2} days^{-1})$ @endtex
+    
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: qsurf_out         !! Surface specific humidity 
+                                                                                  !! @tex $(kg kg^{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: z0_out            !! Surface roughness (output diagnostic, m)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (out)         :: albedo_out        !! VIS and NIR albedo (output diagnostic, 
+                                                                                  !! unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxsens          !! Sensible heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fluxlat           !! Latent heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: emis_out          !! Emissivity (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: netco2flux        !! Sum CO2 flux over PFTs 
+                                                                                  !! ??(gC m^{-2} s^{-1})??
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)           :: fco2_lu           !! Land Cover Change CO2 flux 
+                                                                                  !! ??(gC m^{-2} s^{-1})??
+
+!! 0.3 Modified
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: tq_cdrag          !! Surface drag coefficient 
+                                                                                  !! @tex $(m.s^{-1})$ @endtex 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: temp_sol_new      !! New ground temperature (K)
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(inout):: soil_mc           !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(inout)     :: litter_mc         !! litter moisture content \f($m^3 \times m^3$)\f
+
+!! 0.4 local variables
+
+    INTEGER(i_std)                                           :: ji, jv		  !! Index (unitless)
+    REAL(r_std), ALLOCATABLE, DIMENSION (:)                  :: runoff1           !! ??Temporary surface runoff calculated by 
+                                                                                  !! hydrol @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION (:)                  :: drainage1         !! ??Temporary deep drainage calculatedd by 
+                                                                                  !! hydrol @tex $(kg m^{-2})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION (:)                  :: soilcap1          !! ??Temporary soil heat capacity 
+                                                                                  !! @tex $(J K^{-1})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION (:)                  :: soilflx1          !! ??Temporary soil heat flux 
+                                                                                  !! @tex $(W m^{-2})$ @endtex
+    REAL(r_std), ALLOCATABLE, DIMENSION (:,:)                :: shumdiag1         !! ??Temporary relative soil moisture 
+                                                                                  !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(kjpindex)                         :: histvar           !! Computations for history files (unitless)
+    CHARACTER(LEN=80)                                        :: var_name          !! To store variables names for I/O (unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_treefrac      !! Total fraction occupied by trees (0-1, uniless) 
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_grassfrac     !! Total fraction occupied by grasses (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex)                         :: sum_cropfrac      !! Total fraction occcupied by crops (0-1, unitess)
+
+!_ ================================================================================================================================
+
+    IF (long_print) WRITE(numout,*) ' sechiba kjpindex =',kjpindex
+
+!! 1. Initialize variables on first call!
+
+    IF (l_first_sechiba) THEN
+
+       !! 1.1 Initialize most of sechiba's variables
+       CALL sechiba_init (kjit, ldrestart_read, kjpij, kjpindex, index, rest_id, control_in, lalo)
+     
+       ALLOCATE(runoff1 (kjpindex),drainage1 (kjpindex), soilcap1 (kjpindex),soilflx1 (kjpindex))
+       ALLOCATE(shumdiag1(kjpindex,nbdl))
+        
+       !! 1.2 Initialize some variables of energy budget from restart file     
+       IF (ldrestart_read) THEN
+          
+          IF (long_print) WRITE (numout,*) ' we have to read a restart file for SECHIBA variables'
+          var_name='soilcap' ;
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Soil calorific capacity')
+          soilcap1=val_exp
+          IF ( ok_var(var_name) ) THEN
+             CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., soilcap1, "gather", nbp_glo, index_g)
+             IF (MINVAL(soilcap1) < MAXVAL(soilcap1) .OR. MAXVAL(soilcap1) < val_exp) THEN
+                soilcap(:) = soilcap1(:)
+             ENDIF
+          ENDIF
+          
+          var_name='soilflx' ;
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Soil flux')
+          soilflx1=val_exp
+          IF ( ok_var(var_name) ) THEN
+             CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., soilflx1, "gather", nbp_glo, index_g)
+             IF (MINVAL(soilflx1) < MAXVAL(soilflx1)  .OR. MAXVAL(soilflx1) < val_exp) THEN
+                soilflx(:) = soilflx1(:)
+             ENDIF
+          ENDIF
+          
+          var_name='shumdiag' ;
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Relative soil moisture')
+          shumdiag1=val_exp
+          IF ( ok_var(var_name) ) THEN
+             CALL restget_p (rest_id, var_name, nbp_glo, nbdl, 1, kjit, .TRUE., shumdiag1, "gather", nbp_glo, index_g)
+             IF (MINVAL(shumdiag1) < MAXVAL(shumdiag1) .OR. MAXVAL(shumdiag1) < val_exp) THEN
+                shumdiag(:,:) = shumdiag1(:,:)
+             ENDIF
+          ENDIF
+      
+
+             
+          var_name='runoff' ;
+          CALL ioconf_setatt_p('UNITS', 'mm/d')
+          CALL ioconf_setatt_p('LONG_NAME','Complete runoff')
+          runoff1=val_exp
+          IF ( ok_var(var_name) ) THEN
+             CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., runoff1, "gather", nbp_glo, index_g)
+             IF (MINVAL(runoff1) < MAXVAL(runoff1) .OR. MAXVAL(runoff1) < val_exp) THEN
+                runoff(:) = runoff1(:)
+             ENDIF
+          ENDIF
+
+          var_name='drainage' ;
+          CALL ioconf_setatt_p('UNITS', 'mm/d')
+          CALL ioconf_setatt_p('LONG_NAME','Deep drainage')
+          drainage1=val_exp
+          IF ( ok_var(var_name) ) THEN
+             CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., drainage1, "gather", nbp_glo, index_g)
+             IF (MINVAL(drainage1) < MAXVAL(drainage1) .OR. MAXVAL(drainage1) < val_exp) THEN
+                drainage(:) = drainage1(:)
+             ENDIF
+          ENDIF
+
+    ENDIF ! ldrestart_read
+
+      !! 1.3 Initialize stomate's variables
+       CALL slowproc_main (kjit, kjpij, kjpindex, dtradia, date0, &
+            ldrestart_read, ldrestart_write, control%ok_co2, control%ok_stomate, &
+            index, indexveg, lalo, neighbours, resolution, contfrac, soiltile, reinf_slope, &
+            t2mdiag, t2mdiag, temp_sol, stempdiag, &
+            vegstress, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+            deadleaf_cover, &
+            assim_param, &
+            lai, frac_age, height, veget, frac_nobio, njsc, veget_max, totfrac_nobio, qsintmax, &
+            rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+            co2_flux, fco2_lu,soil_mc, litter_mc, floodout, runoff, drainage, wat_flux0, wat_flux, &
+            drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, DOC_to_topsoil, DOC_to_subsoil)
+       netco2flux(:) = zero
+       DO jv = 2,nvm
+          netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv)
+       ENDDO
+
+           !! 1.4 Initialize diffusion coefficients
+       CALL diffuco_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexveg, indexlai, u, v, &
+            & zlev, z0, roughheight, temp_sol, temp_air, rau, tq_cdrag, qsurf, qair, q2m, t2m, pb ,  &
+            & rsol, evap_bare_lim, evapot, evapot_corr, snow, flood_frac, flood_res, frac_nobio, snow_nobio, totfrac_nobio, &
+            & swnet, swdown, sinang, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, &
+            & vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, vbetaco2, rveget, rstruct, cimean, &
+            & lalo, neighbours, resolution, ptnlev1, precip_rain, frac_age, &
+            & rest_id, hist_id, hist2_id)
+
+       !! 1.5 Initialize remaining variables of energy budget
+       CALL enerbil_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, &
+            & index, indexveg, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef,&
+            & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, &
+            & vbetaco2, cimean, ccanopy, emis, soilflx, soilcap, tq_cdrag, humrel, fluxsens, fluxlat, &
+            & vevapp, transpir, transpot, gpp, vevapnu, vevapwet, vevapsno, vevapflo, t2mdiag, temp_sol, tsol_rad, &
+            & temp_sol_new, qsurf, evapot, evapot_corr, rest_id, hist_id, hist2_id) 
+       
+
+       !! 1.6 Initialize some hydrological variables from restart file
+
+       IF (ldrestart_read) THEN
+
+          IF ( ok_var("shumdiag") ) THEN
+             IF (MINVAL(shumdiag1) < MAXVAL(shumdiag1) .OR. MAXVAL(shumdiag1) < val_exp) THEN
+                shumdiag(:,:) = shumdiag1(:,:)
+             ENDIF
+          ENDIF
+       ENDIF ! ldrestart_read
+       
+       !! 1.7 Initialize remaining hydrological variables
+       IF ( .NOT. hydrol_cwrr ) THEN
+          ! 1.7.1 Initialize remaining hydrological variables from Choisnel module (2 soil layers)
+          CALL hydrolc_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexveg, control_in, &
+               & temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+               & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age,&
+               & tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, humrel, &
+               & vegstress, rsol, drysoil_frac, evapot, evapot_corr, flood_frac, flood_res, shumdiag, litterhumdiag, &
+               & soilcap, rest_id, hist_id, hist2_id) 
+
+          evap_bare_lim(:) = -un
+          k_litt(:) = huit
+       ELSE
+          !! 1.7.2 Initialize remaining hydrological variables from CWRR module (11 soil layers)
+          CALL hydrol_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, &
+               & index, indexveg, indexsoil, indexlayer, control_in, &
+               & temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max, njsc, &
+               & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age,&
+               & tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, humrel, &
+               & vegstress, drysoil_frac, evapot, evapot_corr, evap_bare_lim, flood_frac, flood_res, &
+               & shumdiag, k_litt, litterhumdiag, soilcap, soiltile, reinf_slope, rest_id, hist_id, hist2_id,soil_mc, &
+               & litter_mc,wat_flux0, wat_flux, drainage_per_soil, runoff_per_soil)
+       ENDIF !hydrol_cwrr
+
+
+       !! 1.8 Initialize some water balance variables from restart file
+       IF (ldrestart_read) THEN
+          
+          IF ( ok_var("runoff") ) THEN
+             IF (MINVAL(runoff1) < MAXVAL(runoff1) .OR. MAXVAL(runoff1) < val_exp) THEN
+                runoff(:) = runoff1(:)
+             ENDIF
+          ENDIF
+
+          IF ( ok_var("drainage") ) THEN
+             IF (MINVAL(drainage1) < MAXVAL(drainage1) .OR. MAXVAL(drainage1) < val_exp) THEN
+                drainage(:) = drainage1(:)
+             ENDIF
+          ENDIF
+          
+          IF ( ok_var("shumdiag") ) THEN
+             IF (MINVAL(shumdiag1) < MAXVAL(shumdiag1) .OR. MAXVAL(shumdiag1) < val_exp) THEN
+                shumdiag(:,:) = shumdiag1(:,:)
+             ENDIF
+          ENDIF
+      ENDIF ! ldrestart_read
+
+     
+
+       !! 1.9 Initialize surface parameters (emissivity, albedo and roughness)
+       CALL condveg_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, &
+            & lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, &
+            & zlev, snow, snow_age, snow_nobio, snow_nobio_age, &
+            & drysoil_frac, height,  emis, albedo, z0, roughheight, rest_id, hist_id, hist2_id)
+
+       !! 1.10 Initialization of soil thermodynamics
+       CALL thermosoil_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, &
+            & index, indexgrnd, temp_sol_new, snow, soilcap, soilflx, shumdiag, stempdiag, ptnlev1, rest_id, hist_id, hist2_id) 
+
+       !! 1.11 Initialize some soil thermodynamics from restart file
+       IF (ldrestart_read) THEN
+          IF ( ok_var("soilcap") ) THEN
+             IF (MINVAL(soilcap1) < MAXVAL(soilcap1) .OR. MAXVAL(soilcap1) < val_exp) THEN
+                soilcap(:) = soilcap1(:)
+             ENDIF
+          ENDIF
+         
+          IF ( ok_var("soilflx") ) THEN
+             IF (MINVAL(soilflx1) < MAXVAL(soilflx1)  .OR. MAXVAL(soilflx1) < val_exp) THEN
+                soilflx(:) = soilflx1(:)
+             ENDIF
+          ENDIF
+       ENDIF ! ldrestart_read
+
+       !! 1.12 Initialize river routing
+       IF ( river_routing .AND. nbp_glo .GT. 1) THEN
+          !! 1.12.1 Initialize river routing
+          CALL routing_main (kjit, kjpindex, dtradia, control_in, ldrestart_read, ldrestart_write, index, &
+               & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, &
+               & drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, &
+               & stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, &
+               & rest_id, hist_id, hist2_id, DOC_EXP_agg_d)
+       ELSE
+          !! 1.12.2 No routing, set variables to zero
+          riverflow(:,:) = zero
+          coastalflow(:,:) = zero
+          returnflow(:,:) = zero
+          reinfiltration(:,:) = zero
+          irrigation(:,:) = zero
+          flood_frac(:) = zero
+          flood_res(:) = zero
+       ENDIF
+       
+       !! 1.13 Write internal variables to output fields
+       z0_out(:) = z0(:)
+       emis_out(:) = emis(:)
+       albedo_out(:,:) = albedo(:,:) 
+       qsurf_out(:) = qsurf(:)
+
+       !! 1.14 Deallocate memory
+       DEALLOCATE(runoff1,drainage1,soilcap1,soilflx1)
+       DEALLOCATE(shumdiag1)
+       
+       RETURN ! Out of sechiba main (should remain the last line!)
+ 
+    ENDIF ! l_first_sechiba
+
+ 
+!! 2. Computes SECHIBA's variables
+    
+    !! 2.1 Initialize variables at each time step
+    CALL sechiba_var_init (kjpindex, rau, pb, temp_air) 
+
+    !! 2.2 Compute diffusion coefficients
+    CALL diffuco_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, index, indexveg, indexlai, u, v, &
+!        & zlev, z0, roughheight, temp_sol, temp_air, rau, tq_cdrag, qsurf, qair, pb ,  &  !!?? could this line be deleted?
+         & zlev, z0, roughheight, temp_sol, temp_air, rau, tq_cdrag, qsurf, qair, q2m, t2m, pb ,  &
+         & rsol, evap_bare_lim, evapot, evapot_corr, snow, flood_frac, flood_res, frac_nobio, snow_nobio, totfrac_nobio, &
+         & swnet, swdown, sinang, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, &
+         & vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, vbetaco2, rveget, rstruct, cimean, &
+         & lalo, neighbours, resolution, ptnlev1, precip_rain, frac_age, &
+         & rest_id, hist_id, hist2_id)
+    
+    !! 2.3 Compute energy balance
+    CALL enerbil_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, &
+         & index, indexveg, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef, &
+         & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, &
+         & vbetaco2, cimean, ccanopy, emis, soilflx, soilcap, tq_cdrag, humrel, fluxsens, fluxlat, &
+         & vevapp, transpir, transpot, gpp, vevapnu, vevapwet, vevapsno, vevapflo, t2mdiag, temp_sol, tsol_rad, &
+         & temp_sol_new, qsurf, evapot, evapot_corr, rest_id, hist_id, hist2_id)
+   
+    !! 2.4 Compute hydrology
+    IF ( .NOT. hydrol_cwrr ) THEN
+       ! 2.4.1 Water balance from Choisnel module (2 soil layers)
+       CALL hydrolc_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, index, indexveg, control_in,&
+            & temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+            & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age,&
+            & tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, humrel, &
+            & vegstress, rsol, drysoil_frac, evapot, evapot_corr, flood_frac, flood_res, shumdiag, litterhumdiag, &
+            & soilcap, rest_id, hist_id, hist2_id) 
+
+       evap_bare_lim(:) = -un
+       k_litt(:) = huit
+    ELSE
+       !! 2.4.1 Water balance from CWRR module (11 soil layers)
+       CALL hydrol_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, &
+            & index, indexveg, indexsoil, indexlayer, control_in, &
+            & temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max, njsc,&
+            & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age,&
+            & tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, humrel, &
+            & vegstress, drysoil_frac, evapot, evapot_corr, evap_bare_lim, flood_frac, flood_res, &
+            & shumdiag, k_litt, litterhumdiag, soilcap, soiltile, reinf_slope, rest_id, hist_id, hist2_id,soil_mc, &
+            & litter_mc,wat_flux0, wat_flux, drainage_per_soil, runoff_per_soil)
+       rsol(:) = -un
+
+    ENDIF
+     
+    !! 2.5 Compute remaining components of the energy balance
+    CALL enerbil_fusion (kjpindex, dtradia, tot_melt, soilcap, temp_sol_new, fusion)
+
+    
+    !! 2.6 Compute surface variables (emissivity, albedo and roughness)
+    CALL condveg_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, index,&
+         & lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, &
+         & zlev, snow, snow_age, snow_nobio, snow_nobio_age, &
+         & drysoil_frac, height,  emis, albedo, z0, roughheight, rest_id, hist_id, hist2_id)
+     
+    !! 2.7 Compute soil thermodynamics
+    CALL thermosoil_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, index, indexgrnd, &
+         & temp_sol_new, snow, soilcap, soilflx, shumdiag, stempdiag, ptnlev1, rest_id, hist_id, hist2_id) 
+
+
+    !! 2.8 Compute river routing 
+    IF ( river_routing .AND. nbp_glo .GT. 1) THEN
+       !! 2.8.1 River routing
+       CALL routing_main (kjit, kjpindex, dtradia, control_in, ldrestart_read, myfalse, index, &
+            & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, &
+            & drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, &
+            & stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, &
+            & rest_id, hist_id, hist2_id, DOC_EXP_agg_d)
+    ELSE
+       !! 2.8.2 No routing, set variables to zero
+       riverflow(:,:) = zero
+       coastalflow(:,:) = zero
+       returnflow(:,:) = zero
+       reinfiltration(:,:) = zero
+       irrigation(:,:) = zero
+       flood_frac(:) = zero
+       flood_res(:) = zero
+    ENDIF
+    
+    ! Calculate DOC inputs to soil column from stomate_soilcarbon.f90, to be exported via slowprocesses
+    DOC_to_topsoil(:,icarbon) = (reinfiltration(:,idoc)+irrigation(:,idoc))*mille
+    DOC_to_subsoil(:,icarbon) = returnflow(:,idoc)*mille  
+       
+    !! 2.9 Compute slow processes (i.e. 'daily' and annual time step)
+    ! ::ok_co2 and ::ok_stomate are flags that determine whether the
+    ! forcing files are written.
+    CALL slowproc_main (kjit, kjpij, kjpindex, dtradia, date0, &
+         ldrestart_read, myfalse, control%ok_co2, control%ok_stomate, &
+         index, indexveg, lalo, neighbours, resolution, contfrac, soiltile, reinf_slope, &
+         t2mdiag, t2mdiag, temp_sol, stempdiag, &
+         vegstress, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+         deadleaf_cover, &
+         assim_param, &
+         lai, frac_age, height, veget, frac_nobio, njsc, veget_max, totfrac_nobio, qsintmax, &
+         rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+         co2_flux, fco2_lu, soil_mc, litter_mc, floodout, runoff, drainage, wat_flux0, wat_flux, &
+         drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, DOC_to_topsoil, DOC_to_subsoil)
+   
+    !! 2.9 Compute global CO2 flux
+    netco2flux(:) = zero
+    DO jv = 2,nvm
+       netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv)
+    ENDDO
+ 
+    !! 2.10 Swap old for newly computed values 
+    CALL sechiba_end (kjpindex, dtradia, temp_sol, temp_sol_new)
+   
+    !! 2.11 Write internal variables to output fields
+    z0_out(:) = z0(:)
+    emis_out(:) = emis(:)
+    albedo_out(:,:) = albedo(:,:) 
+    qsurf_out(:) = qsurf(:)
+ 
+    !! 2.12 Write global variables to history files
+    sum_treefrac(:) = zero
+    sum_grassfrac(:) = zero
+    sum_cropfrac(:) = zero
+    DO jv = 2, nvm 
+       IF (is_tree(jv) .AND. natural(jv)) THEN
+          sum_treefrac(:) = sum_treefrac(:) + veget_max(:,jv)
+       ELSE IF ((.NOT. is_tree(jv))  .AND. natural(jv)) THEN
+          sum_grassfrac(:) = sum_grassfrac(:) + veget_max(:,jv)
+       ELSE 
+          sum_cropfrac = sum_cropfrac(:) + veget_max(:,jv)
+       ENDIF
+    ENDDO          
+    !
+    IF ( .NOT. almaoutput ) THEN
+       ! Write history file in IPSL-format
+       CALL histwrite_p(hist_id, 'beta', kjit, vbeta, kjpindex, index)
+       CALL histwrite_p(hist_id, 'z0', kjit, z0, kjpindex, index)
+       CALL histwrite_p(hist_id, 'roughheight', kjit, roughheight, kjpindex, index)
+       CALL histwrite_p(hist_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+       CALL histwrite_p(hist_id, 'lai', kjit, lai, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'subli', kjit, vevapsno, kjpindex, index)
+       CALL histwrite_p(hist_id, 'evapnu', kjit, vevapnu, kjpindex, index)
+       CALL histwrite_p(hist_id, 'transpir', kjit, transpir, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'inter', kjit, vevapwet, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'vbeta1', kjit, vbeta1, kjpindex, index)
+       CALL histwrite_p(hist_id, 'vbeta2', kjit, vbeta2, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'vbeta3', kjit, vbeta3, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'vbeta4', kjit, vbeta4, kjpindex, index)    
+       CALL histwrite_p(hist_id, 'vbeta5', kjit, vbeta5, kjpindex, index)    
+       CALL histwrite_p(hist_id, 'drysoil_frac', kjit, drysoil_frac, kjpindex, index)
+       CALL histwrite_p(hist_id, 'rveget', kjit, rveget, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'rstruct', kjit, rstruct, kjpindex*nvm, indexveg)
+       IF ( .NOT. control_in%hydrol_cwrr ) THEN
+          CALL histwrite_p(hist_id, 'rsol', kjit, rsol, kjpindex, index)
+       ENDIF
+       CALL histwrite_p(hist_id, 'snow', kjit, snow, kjpindex, index)
+       CALL histwrite_p(hist_id, 'snowage', kjit, snow_age, kjpindex, index)
+       CALL histwrite_p(hist_id, 'snownobio', kjit, snow_nobio, kjpindex*nnobio, indexnobio)
+       CALL histwrite_p(hist_id, 'snownobioage', kjit, snow_nobio_age, kjpindex*nnobio, indexnobio)
+       !
+       CALL histwrite_p(hist_id, 'soiltile',  kjit, soiltile, kjpindex*nstm, indexsoil)
+       !
+       IF ( control_in%hydrol_cwrr ) THEN
+          CALL histwrite_p(hist_id, 'soilindex',  kjit, REAL(njsc, r_std), kjpindex, index)
+          CALL histwrite_p(hist_id, 'reinf_slope',  kjit, reinf_slope, kjpindex, index)
+          CALL histwrite_p(hist_id, 'k_litt', kjit, k_litt, kjpindex, index)
+       ENDIF
+       IF ( control_in%do_floodplains ) THEN
+          CALL histwrite_p(hist_id, 'evapflo', kjit, vevapflo, kjpindex, index)
+          CALL histwrite_p(hist_id, 'flood_frac', kjit, flood_frac, kjpindex, index)
+       ENDIF
+       IF ( control%ok_co2 ) THEN
+          CALL histwrite_p(hist_id, 'vbetaco2', kjit, vbetaco2, kjpindex*nvm, indexveg)    
+          CALL histwrite_p(hist_id, 'gpp', kjit, gpp, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'cimean', kjit, cimean, kjpindex*nvm, indexveg)    
+       ENDIF
+       IF ( control%ok_stomate ) THEN
+          CALL histwrite_p(hist_id, 'nee', kjit, co2_flux, kjpindex*nvm, indexveg)    
+       ENDIF
+
+       histvar(:)=SUM(vevapwet(:,:),dim=2)
+       CALL histwrite_p(hist_id, 'evspsblveg', kjit, histvar, kjpindex, index)
+
+       histvar(:)= vevapnu(:)+vevapsno(:)
+       CALL histwrite_p(hist_id, 'evspsblsoi', kjit, histvar, kjpindex, index)
+
+       histvar(:)=SUM(transpir(:,:),dim=2)
+       CALL histwrite_p(hist_id, 'tran', kjit, histvar, kjpindex, index)
+
+       histvar(:)= sum_treefrac(:)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'treeFrac', kjit, histvar, kjpindex, index) 
+
+       histvar(:)= sum_grassfrac(:)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'grassFrac', kjit, histvar, kjpindex, index) 
+
+       histvar(:)= sum_cropfrac(:)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'cropFrac', kjit, histvar, kjpindex, index)
+
+       histvar(:)=veget_max(:,1)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'baresoilFrac', kjit, histvar, kjpindex, index)
+
+       histvar(:)=SUM(frac_nobio(:,1:nnobio),dim=2)*100*contfrac(:)
+       CALL histwrite_p(hist_id, 'residualFrac', kjit, histvar, kjpindex, index)
+    ELSE
+       ! Write history file in ALMA format 
+       CALL histwrite_p(hist_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+       CALL histwrite_p(hist_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+       CALL histwrite_p(hist_id, 'Qf', kjit, fusion, kjpindex, index)
+       CALL histwrite_p(hist_id, 'ESoil', kjit, vevapnu, kjpindex, index)
+       CALL histwrite_p(hist_id, 'EWater', kjit, vevapflo, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SWE', kjit, snow, kjpindex, index)
+       histvar(:)=zero
+       DO jv=1,nvm
+          histvar(:) = histvar(:) + transpir(:,jv)
+       ENDDO
+       CALL histwrite_p(hist_id, 'TVeg', kjit, histvar, kjpindex, index)
+       histvar(:)=zero
+       DO jv=1,nvm
+          histvar(:) = histvar(:) + vevapwet(:,jv)
+       ENDDO
+       CALL histwrite_p(hist_id, 'ECanop', kjit, histvar, kjpindex, index)
+       CALL histwrite_p(hist_id, 'ACond', kjit, tq_cdrag, kjpindex, index)
+       CALL histwrite_p(hist_id, 'SnowFrac', kjit, vbeta1, kjpindex, index)
+       !
+       CALL histwrite_p(hist_id, 'Z0', kjit, z0, kjpindex, index)
+       CALL histwrite_p(hist_id, 'EffectHeight', kjit, roughheight, kjpindex, index)
+       !
+       IF ( control_in%do_floodplains ) THEN
+          CALL histwrite_p(hist_id, 'Qflood', kjit, vevapflo, kjpindex, index)
+          CALL histwrite_p(hist_id, 'FloodFrac', kjit, flood_frac, kjpindex, index)
+       ENDIF
+       !
+       IF ( control%ok_co2 ) THEN
+          CALL histwrite_p(hist_id, 'GPP', kjit, gpp, kjpindex*nvm, indexveg)
+       ENDIF
+       IF ( control%ok_stomate ) THEN
+             CALL histwrite_p(hist_id, 'NEE', kjit, co2_flux, kjpindex*nvm, indexveg)    
+       ENDIF
+    ENDIF ! almaoutput
+    
+    !! 2.13 Write additional output file with higher frequency
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          ! Write history file in IPSL-format
+          CALL histwrite_p(hist2_id, 'tsol_rad', kjit, tsol_rad, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'qsurf', kjit, qsurf, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'albedo', kjit, albedo, kjpindex*2, indexalb)
+          CALL histwrite_p(hist2_id, 'emis', kjit, emis, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'beta', kjit, vbeta, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'z0', kjit, z0, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'roughheight', kjit, roughheight, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+          CALL histwrite_p(hist2_id, 'lai', kjit, lai, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'subli', kjit, vevapsno, kjpindex, index)
+          IF ( control_in%do_floodplains ) THEN
+             CALL histwrite_p(hist2_id, 'vevapflo', kjit, vevapflo, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'flood_frac', kjit, flood_frac, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'vevapnu', kjit, vevapnu, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'transpir', kjit, transpir, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'inter', kjit, vevapwet, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'vbeta1', kjit, vbeta1, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'vbeta2', kjit, vbeta2, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'vbeta3', kjit, vbeta3, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'vbeta4', kjit, vbeta4, kjpindex, index)    
+          CALL histwrite_p(hist2_id, 'vbeta5', kjit, vbeta5, kjpindex, index)    
+          CALL histwrite_p(hist2_id, 'drysoil_frac', kjit, drysoil_frac, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'rveget', kjit, rveget, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'rstruct', kjit, rstruct, kjpindex*nvm, indexveg)
+          IF ( .NOT. control_in%hydrol_cwrr ) THEN
+             CALL histwrite_p(hist2_id, 'rsol', kjit, rsol, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'snow', kjit, snow, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snowage', kjit, snow_age, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'snownobio', kjit, snow_nobio, kjpindex*nnobio, indexnobio)
+          CALL histwrite_p(hist2_id, 'snownobioage', kjit, snow_nobio_age, kjpindex*nnobio, indexnobio)
+          !
+          IF (  control_in%hydrol_cwrr ) THEN
+             CALL histwrite_p(hist2_id, 'soilindex',  kjit, REAL(njsc, r_std), kjpindex, index)
+             CALL histwrite_p(hist2_id, 'reinf_slope',  kjit, reinf_slope, kjpindex, index)
+          ENDIF
+          !
+          IF ( control%ok_co2 ) THEN
+             CALL histwrite_p(hist2_id, 'vbetaco2', kjit, vbetaco2, kjpindex*nvm, indexveg)    
+             CALL histwrite_p(hist2_id, 'gpp', kjit, gpp, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'cimean', kjit, cimean, kjpindex*nvm, indexveg)    
+          ENDIF
+          IF ( control%ok_stomate ) THEN
+             CALL histwrite_p(hist2_id, 'nee', kjit, co2_flux, kjpindex*nvm, indexveg)    
+          ENDIF
+       ELSE
+          ! Write history file in ALMA format
+          CALL histwrite_p(hist2_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist2_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+          CALL histwrite_p(hist2_id, 'Qf', kjit, fusion, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'ESoil', kjit, vevapnu, kjpindex, index)
+          IF ( control_in%do_floodplains ) THEN
+             CALL histwrite_p(hist2_id, 'EWater', kjit, vevapflo, kjpindex, index)
+             CALL histwrite_p(hist2_id, 'FloodFrac', kjit, flood_frac, kjpindex, index)
+          ENDIF
+          CALL histwrite_p(hist2_id, 'SWE', kjit, snow, kjpindex, index)
+          histvar(:)=zero
+          DO jv=1,nvm
+             histvar(:) = histvar(:) + transpir(:,jv)
+          ENDDO
+          CALL histwrite_p(hist2_id, 'TVeg', kjit, histvar, kjpindex, index)
+          histvar(:)=zero
+          DO jv=1,nvm
+             histvar(:) = histvar(:) + vevapwet(:,jv)
+          ENDDO
+          CALL histwrite_p(hist2_id, 'ECanop', kjit, vevapwet, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'ACond', kjit, tq_cdrag, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'SnowFrac', kjit, vbeta1, kjpindex, index)
+          IF ( control%ok_co2 ) THEN
+             CALL histwrite_p(hist2_id, 'GPP', kjit, gpp, kjpindex*nvm, indexveg)
+          ENDIF
+          IF ( control%ok_stomate ) THEN
+             CALL histwrite_p(hist2_id, 'NEE', kjit, co2_flux, kjpindex*nvm, indexveg)    
+          ENDIF
+       ENDIF ! almaoutput
+    ENDIF ! hist2_id
+
+!! 3. Write restart file for the next simulation from SECHIBA and other modules
+    IF (ldrestart_write) THEN
+
+       ! Only called during the last run
+       IF (long_print) WRITE (numout,*) ' we have to write a restart file '
+       !! 3.1 Call diffuco_main to write restart files
+       CALL diffuco_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexveg, indexlai, u, v, &
+!           & zlev, z0, roughheight, temp_sol, temp_air, rau, tq_cdrag, qsurf, qair, pb ,  & !!?? Could this line be deleted?
+            & zlev, z0, roughheight, temp_sol, temp_air, rau, tq_cdrag, qsurf, qair, q2m, t2m, pb ,  &
+            & rsol, evap_bare_lim, evapot, evapot_corr, snow, flood_frac, flood_res, frac_nobio, snow_nobio, totfrac_nobio, &
+            & swnet, swdown, sinang, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, &
+            & vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, vbetaco2, rveget, rstruct, cimean, &
+            & lalo, neighbours, resolution, ptnlev1, precip_rain, frac_age, &
+            & rest_id, hist_id, hist2_id)
+
+ 
+       !! 3.2 Call energy budget to write restart files
+       CALL enerbil_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, &
+            & index, indexveg, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef,&
+            & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta3pot, vbeta4, vbeta5, &
+            & vbetaco2, cimean, ccanopy, emis, soilflx, soilcap, tq_cdrag, humrel, fluxsens, fluxlat, &
+            & vevapp, transpir, transpot, gpp, vevapnu, vevapwet, vevapsno, vevapflo, t2mdiag, temp_sol, tsol_rad, &
+            & temp_sol_new, qsurf, evapot, evapot_corr, rest_id, hist_id, hist2_id) 
+
+       !! 3.3 Call hydrology to write restart files
+       IF ( .NOT. hydrol_cwrr ) THEN
+          !! 3.3.1 Call water balance from Choisnel module (2 soil layers) to write restart file
+          CALL hydrolc_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexveg, control_in, &
+               & temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+               & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age,&
+               & tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, &
+               & humrel, vegstress, rsol, drysoil_frac, evapot, evapot_corr, flood_frac, flood_res, shumdiag, litterhumdiag, &
+               & soilcap, rest_id, hist_id, hist2_id)
+          evap_bare_lim(:) = -un
+          k_litt(:) = huit
+       ELSE
+          !! 3.3.2 Call water balance from CWRR module (11 soil layers) to write restart file
+          CALL hydrol_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, &
+               & index, indexveg, indexsoil, indexlayer, control_in, &
+               & temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max, njsc, &
+               & qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age,&
+               & tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, humrel, &
+               & vegstress, drysoil_frac, evapot, evapot_corr, evap_bare_lim, flood_frac, flood_res, &
+               & shumdiag, k_litt, litterhumdiag, soilcap, soiltile, reinf_slope, rest_id, hist_id, hist2_id,soil_mc, &
+               & litter_mc,wat_flux0, wat_flux, drainage_per_soil, runoff_per_soil)
+          rsol(:) = -un
+       ENDIF ! hydrol_cwrr
+   
+       !! 3.4 Call condveg to write surface variables to restart files
+       CALL condveg_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, &
+            & lalo, neighbours, resolution, contfrac, veget, veget_max, frac_nobio, totfrac_nobio, &
+            & zlev, snow, snow_age, snow_nobio, snow_nobio_age, &
+            & drysoil_frac, height,  emis, albedo, z0, roughheight, rest_id, hist_id, hist2_id)
+ 
+       !! 3.5 Call soil thermodynamic to write restart files
+       CALL thermosoil_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexgrnd, &
+            & temp_sol_new, snow, soilcap, soilflx, shumdiag, stempdiag, ptnlev1, rest_id, hist_id, hist2_id) 
+
+       !! 3.6 Add river routing to restart files  
+       IF ( river_routing .AND. nbp_glo .GT. 1) THEN
+          !! 3.6.1 Call river routing to write restart files 
+          CALL routing_main (kjit, kjpindex, dtradia, control_in, ldrestart_read, ldrestart_write, index, &
+               & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, &
+               & drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, &
+               & stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, &
+               & rest_id, hist_id, hist2_id, DOC_EXP_agg_d)
+       ELSE
+          !! 3.6.2 No routing, set variables to zero
+          riverflow(:,:) = zero
+          coastalflow(:,:) = zero
+          reinfiltration(:,:) = zero
+          returnflow(:,:) = zero
+          irrigation(:,:) = zero
+          flood_frac(:) = zero
+          flood_res(:) = zero
+       ENDIF ! river_routing
+       ! Calculate DOC inputs to soil column from stomate_soilcarbon.f90, to be exported via slowprocesses
+       DOC_to_topsoil(:,icarbon) = (reinfiltration(:,idoc)+irrigation(:,idoc))*mille
+       DOC_to_subsoil(:,icarbon) = returnflow(:,idoc)*mille       
+
+       !! 3.7 Call slowproc_main to add 'daily' and annual variables to restart file
+       CALL slowproc_main (kjit, kjpij, kjpindex, dtradia, date0, &
+            ldrestart_read, ldrestart_write, control%ok_co2, control%ok_stomate, &
+            index, indexveg, lalo, neighbours, resolution, contfrac, soiltile, reinf_slope, &
+            t2mdiag, t2mdiag, temp_sol, stempdiag, &
+            vegstress, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+            deadleaf_cover, &
+            assim_param, &
+            lai, frac_age, height, veget, frac_nobio, njsc, veget_max, totfrac_nobio, qsintmax, &
+            rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+            co2_flux, fco2_lu,soil_mc, litter_mc, floodout, runoff, drainage, wat_flux0, wat_flux, &
+            drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, DOC_to_topsoil, DOC_to_subsoil)
+       ! Compute global CO2 flux !*
+       netco2flux(:) = zero
+       DO jv = 2,nvm
+          netco2flux(:) = netco2flux(:) + co2_flux(:,jv)*veget_max(:,jv)
+       ENDDO
+
+       !! 3.8 Add some remaining variables to the restart file
+       var_name= 'shumdiag'  
+       CALL restput_p(rest_id, var_name, nbp_glo,   nbdl, 1, kjit,  shumdiag, 'scatter',  nbp_glo, index_g)
+       var_name= 'runoff'  
+       CALL restput_p(rest_id, var_name, nbp_glo,   1, 1, kjit,  runoff, 'scatter',  nbp_glo, index_g)
+       var_name= 'drainage'  
+       CALL restput_p(rest_id, var_name, nbp_glo,   1, 1, kjit,  drainage, 'scatter',  nbp_glo, index_g)
+    
+    END IF ! ldrestart_write 
+
+
+    IF (long_print) WRITE (numout,*) ' sechiba_main done '
+
+  END SUBROUTINE sechiba_main
+
+  
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_init
+!!
+!>\BRIEF        Dynamic allocation of the variables, the dimensions of the 
+!! variables are determined by user-specified settings. If ::ldrestart_read is
+!! true, initial varaible values are read from the restart file.
+!! 
+!! DESCRIPTION  : The domain size (:: kjpindex) is used to allocate the correct
+!! dimensions to all variables in sechiba. Depending on the variable, its 
+!! dimensions are also determined by the number of PFT's (::nvm), number of 
+!! soil types (::nstm), number of non-vegetative surface types (::nnobio),
+!! number of soil levels (::ngrnd), number of soil layers in the hydrological 
+!! model (i.e. cwrr) (::nslm). Values for these variables are set in
+!! constantes_soil.f90 and constantes_veg.f90.\n
+!!
+!! Memory is allocated for all Sechiba variables and new indexing tables
+!! are build making use of both (::kjpij) and (::kjpindex). New indexing tables 
+!! are needed because a single pixel can contain several PFTs, soil types, etc.
+!! The new indexing tables have separate indices for the different
+!! PFTs, soil types, etc.\n
+!!
+!! The routine uses the flag ::ldrestart_read to retrieve initial variable 
+!! settings from the restart file.\n
+!!  
+!! ??Flags are getting swapped by it is not entirly clear why?? 
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output 
+!! variables. However, the routine allocates memory and builds new indexing 
+!! variables for later use.
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================ 
+
+  SUBROUTINE sechiba_init (kjit, ldrestart_read, kjpij, kjpindex, index, rest_id, control_in, lalo)
+
+!! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT (in)                         :: kjit               !! Time step number (unitless)
+    INTEGER(i_std), INTENT (in)                         :: kjpij              !! Total size of the un-compressed grid (unitless)
+    INTEGER(i_std), INTENT (in)                         :: kjpindex           !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std), INTENT (in)                         :: rest_id            !! _Restart_ file identifier (unitless)
+    TYPE(control_type), INTENT(in)                      :: control_in         !! Flags that (de)activate parts of the model
+    LOGICAL,INTENT (in)                                 :: ldrestart_read     !! Logical for restart file to read (true/false)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index              !! Indeces of the points on the map (unitless)
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)     :: lalo               !! Geographical coordinates (latitude,longitude) 
+                                                                              !! for pixels (degrees)
+!! 0.2 Output variables
+
+!! 0.3 Modified variables
+
+!! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ier                !! Check errors in memory allocation (unitless)
+    INTEGER(i_std)                                      :: ji, jv             !! Indeces (unitless)
+!_ ==============================================================================================================================
+
+!! 1. Initialize variables 
+    
+    ! Dynamic allocation with user-specified dimensions on first call
+    IF (l_first_sechiba) THEN 
+       l_first_sechiba=.FALSE.
+    ELSE 
+       WRITE (numout,*) ' l_first_sechiba false . we stop '
+       STOP 'sechiba_init'
+    ENDIF
+
+
+    !! 1.1 Initialize 3D vegetation indexation table
+    ALLOCATE (indexveg(kjpindex*nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in indexveg allocation. We stop. We need kjpindex words = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (indexlai(kjpindex*(nlai+1)),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in indexlai allocation. We stop. We need kjpindex words = ',kjpindex*(nlai+1)
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (indexsoil(kjpindex*nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in indexsoil allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (indexnobio(kjpindex*nnobio),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in indexnobio allocation. We stop. We need kjpindex words = ',kjpindex*nnobio
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (indexgrnd(kjpindex*ngrnd),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in indexgrnd allocation. We stop. We need kjpindex words = ',kjpindex*ngrnd
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (indexlayer(kjpindex*nslm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in indexlayer allocation. We stop. We need kjpindex words = ',kjpindex*nslm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (indexalb(kjpindex*2),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in indexalb allocation. We stop. We need kjpindex words = ',kjpindex*2
+       STOP 'sechiba_init'
+    END IF
+
+    !! 1.2  Initialize 1D array allocation with restartable value
+    IF (long_print) WRITE (numout,*) 'Allocation of 1D variables. We need for each kjpindex words = ',kjpindex
+    ALLOCATE (flood_res(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in flood_res allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    flood_res(:) = undef_sechiba
+
+    IF (long_print) WRITE (numout,*) 'Allocation of 1D variables. We need for each kjpindex words = ',kjpindex
+    ALLOCATE (flood_frac(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in flood_frac allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    flood_frac(:) = undef_sechiba
+
+    IF (long_print) WRITE (numout,*) 'Allocation of 1D variables. We need for each kjpindex words = ',kjpindex
+    ALLOCATE (snow(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in snow allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    snow(:) = undef_sechiba
+
+    ALLOCATE (snow_age(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in snow_age allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    snow_age(:) = undef_sechiba
+
+    ALLOCATE (drysoil_frac(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in drysoil_frac allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    drysoil_frac(:) = zero
+
+    ALLOCATE (rsol(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in rsol allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (evap_bare_lim(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in evap_bare_lim allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (evapot(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in evapot allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    evapot(:) = undef_sechiba
+
+    ALLOCATE (evapot_corr(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in evapot_corr allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (humrel(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in humrel allocation. We stop. we need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    humrel(:,:) = undef_sechiba
+
+    ALLOCATE (vegstress(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vegstress allocation. We stop. we need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    vegstress(:,:) = undef_sechiba
+
+    ALLOCATE (njsc(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in njsc allocation. We stop. we need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    njsc(:)= undef_int
+
+    ALLOCATE (soiltile(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in soiltile allocation. We stop. we need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    soiltile(:,:)=undef_sechiba
+
+    ALLOCATE (reinf_slope(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in reinf_slope allocation. We stop. we need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    reinf_slope(:)=undef_sechiba
+
+    ALLOCATE (vbeta1(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vbeta1 allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (vbeta4(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vbeta4 allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (vbeta5(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vbeta5 allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (soilcap(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in soilcap allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (soilflx(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in soilflx allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (temp_sol(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in temp_sol allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    temp_sol(:) = undef_sechiba
+
+    ALLOCATE (qsurf(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in qsurf allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    qsurf(:) = undef_sechiba
+
+    !! 1.3 Initialize 2D array allocation with restartable value
+    ALLOCATE (qsintveg(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in qsintveg allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm,' = ',kjpindex*nvm 
+       STOP 'sechiba_init'
+    END IF
+    qsintveg(:,:) = undef_sechiba
+
+    ALLOCATE (vbeta2(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vbeta2 allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (vbeta3(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vbeta3 allocation. We stop.We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (vbeta3pot(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vbeta3pot allocation. We stop.We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (vbetaco2(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vbetaco2 allocation. We stop.We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (cimean(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in cimean allocation. We stop.We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (gpp(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in gpp allocation. We stop.We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+    gpp(:,:) = undef_sechiba
+
+    ALLOCATE (veget(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in veget allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+    veget(:,:)=undef_sechiba
+
+    ALLOCATE (veget_max(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in veget_max allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+    veget_max(:,:)=undef_sechiba
+
+    ALLOCATE (lai(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in lai allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+    lai(:,:)=undef_sechiba
+
+    ALLOCATE (frac_age(kjpindex,nvm,nleafages),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in frac_age allocation. We stop. We need kjpindex x nvm words = ',&
+             & kjpindex,' x ' ,nvm, 'x',nleafages,' = ',kjpindex*nvm*nleafages
+        STOP 'sechiba_init'
+    END IF
+    frac_age(:,:,:)=undef_sechiba
+
+    ALLOCATE (height(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in height allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+    height(:,:)=undef_sechiba
+
+    ALLOCATE (frac_nobio(kjpindex,nnobio),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in frac_nobio allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    frac_nobio(:,:) = undef_sechiba
+
+    ALLOCATE (albedo(kjpindex,2),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in albedo allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (snow_nobio(kjpindex,nnobio),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in snow_nobio allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    snow_nobio(:,:) = undef_sechiba
+
+    ALLOCATE (snow_nobio_age(kjpindex,nnobio),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in snow_nobio_age allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    snow_nobio_age(:,:) = undef_sechiba
+
+    ALLOCATE (assim_param(kjpindex,nvm,npco2),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in assim_param allocation. We stop. We need kjpindex x nvm x npco2 words = ',&
+            & kjpindex,' x ' ,nvm,' x ',npco2, ' = ',kjpindex*nvm*npco2
+       STOP 'sechiba_init'
+    END IF
+
+    !! 1.4 Initialize 1D array allocation 
+    ALLOCATE (vevapflo(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vevapflo allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    vevapflo(:)=zero
+
+    ALLOCATE (vevapsno(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vevapsno allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (vevapnu(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vevapnu allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (t2mdiag(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in t2mdiag allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (totfrac_nobio(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in totfrac_nobio allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (floodout(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in floodout allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (runoff(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in runoff allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+   ALLOCATE (wat_flux0(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in wat_flux0 allocation. We stop. We need kjpindex*nstm words = ',kjpindex*nstm
+       STOP 'sechiba_init'
+    END IF
+ 
+    ALLOCATE (wat_flux(kjpindex,nslm, nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in wat_flux allocation. We stop. We need kjpindex*nslm*nstm words = ',kjpindex*nslm*nstm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (drainage_per_soil(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in drainage_per_soil allocation. We stop. We need kjpindex*nstm words = ',kjpindex*nstm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (runoff_per_soil(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in runoff_per_soil allocation. We stop. We need kjpindex*nstm words = ',kjpindex*nstm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (drainage(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in drainage allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (returnflow(kjpindex,nflow),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in returnflow allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    returnflow(:,:) = zero
+    
+    ALLOCATE (DOC_EXP_agg_d(kjpindex,nflow),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in DOC_EXP_agg_d allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    DOC_EXP_agg_d(:,:) = zero    
+
+    ALLOCATE (reinfiltration(kjpindex,nflow),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in reinfiltration allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    reinfiltration(:,:) = zero
+
+    ALLOCATE (irrigation(kjpindex,nflow),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in irrigation allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    irrigation(:,:) = zero
+    
+    ALLOCATE (DOC_to_topsoil(kjpindex,nelements),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in DOC_to_topsoil allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    DOC_to_topsoil(:,:) = zero    
+    
+    ALLOCATE (DOC_to_subsoil(kjpindex,nelements),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in DOC_to_subsoil allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    DOC_to_subsoil(:,:) = zero       
+    
+    ALLOCATE (z0(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in z0 allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (roughheight(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in roughheight allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (emis(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in emis allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (tot_melt(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tot_melt allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (valpha(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in valpha allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (vbeta(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vbeta allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (fusion(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in fusion allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (rau(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in rau allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (deadleaf_cover(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in deadleaf_cover allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (stempdiag(kjpindex, nbdl),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in stempdiag allocation. We stop. We need kjpindex*nbdl words = ',&
+            & kjpindex*nbdl
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (co2_flux(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in co2_flux allocation. We stop. We need kjpindex*nvm words = ' ,kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+    co2_flux(:,:)=zero
+
+    ALLOCATE (shumdiag(kjpindex,nbdl),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in shumdiag allocation. We stop. We need kjpindex*nbdl words = ',&
+            & kjpindex*nbdl
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (litterhumdiag(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in litterhumdiag allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (ptnlev1(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in ptnlev1 allocation. We stop. We need kjpindex words = ', kjpindex
+        STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (k_litt(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in k_litt allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+
+    !! 1.5 Initialize 2D array allocation
+    ALLOCATE (vevapwet(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vevapwet allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+    vevapwet(:,:)=undef_sechiba
+
+    ALLOCATE (transpir(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in transpir allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (transpot(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in transpot allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (qsintmax(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in qsintmax allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm 
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (rveget(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in rveget allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+
+    ALLOCATE (rstruct(kjpindex,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in rstruct allocation. We stop. We need kjpindex x nvm words = ',&
+            & kjpindex,' x ' ,nvm, ' = ',kjpindex*nvm
+       STOP 'sechiba_init'
+    END IF
+
+    !! 1.6 Initialize indexing table for the vegetation fields. 
+    ! In SECHIBA we work on reduced grids but to store in the full 3D filed vegetation variable 
+    ! we need another index table : indexveg, indexsoil, indexnobio and indexgrnd
+    DO ji = 1, kjpindex
+       !
+       DO jv = 1, nlai+1
+          indexlai((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, nvm
+          indexveg((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !      
+       DO jv = 1, nstm
+          indexsoil((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !      
+       DO jv = 1, nnobio
+          indexnobio((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, ngrnd
+          indexgrnd((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, nslm
+          indexlayer((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+       DO jv = 1, 2
+          indexalb((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+       !
+    ENDDO
+
+!! 2. Read restart files to set initial variable values
+    
+    IF (ldrestart_read) THEN
+
+       IF (long_print) WRITE (numout,*) ' we have to read a restart file for SECHIBA variables'
+       ! Open restart file and read data
+       ! ?? Where is the code to open the restart file?? !!?? I guess, the IF just writes out the comment.
+       !!?? The single routines are called in sechiba_main. It would be more logical to put it in sechiba_main
+       ! Read the default value that will be put into variable which are not in the restart file
+       CALL ioget_expval(val_exp)
+
+    ENDIF
+
+!! 3. Swapping flags
+    !??What is going with the flags (also next section??). Why is this done?? Where are the values specified??
+    river_routing = control_in%river_routing
+    hydrol_cwrr = control_in%hydrol_cwrr
+    
+!! 4. Run control: store flags in a common variable
+
+    control%river_routing = control_in%river_routing
+    control%hydrol_cwrr = control_in%hydrol_cwrr
+    control%ok_co2 = control_in%ok_co2
+    control%ok_sechiba = control_in%ok_sechiba
+    control%ok_stomate = control_in%ok_stomate
+    control%ok_dgvm = control_in%ok_dgvm
+    control%do_land_use = control_in%do_land_use
+    control%ok_pheno = control_in%ok_pheno
+    control%stomate_watchout = control_in%stomate_watchout
+    control%ok_inca = control_in%ok_inca                    
+    control%ok_leafage = control_in%ok_leafage         
+    control%ok_radcanopy = control_in%ok_radcanopy
+    control%ok_multilayer = control_in%ok_multilayer
+    control%ok_pulse_NOx = control_in%ok_pulse_NOx       
+    control%ok_bbgfertil_NOx = control_in%ok_bbgfertil_NOx     
+    control%ok_cropsfertil_NOx = control_in%ok_cropsfertil_NOx
+    control%ld_doc = control_in%ld_doc
+    IF (long_print) WRITE (numout,*) ' sechiba_init done '
+
+  END SUBROUTINE sechiba_init
+  
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_clear
+!!
+!>\BRIEF        Deallocate memory of sechiba's variables
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================ 
+
+  SUBROUTINE sechiba_clear (forcing_name,cforcing_name)
+
+    CHARACTER(LEN=100), INTENT(in)           :: forcing_name       !! Name of forcing file (unitless)
+    CHARACTER(LEN=100), INTENT(in)           :: cforcing_name      !! Name of forcing file with carbon related variables (unitless)
+!_ ================================================================================================================================
+    
+!! 1. Initialize first run
+
+    l_first_sechiba=.TRUE.
+
+!! 2. Deallocate dynamic variables of sechiba
+
+    IF ( ALLOCATED (indexveg)) DEALLOCATE (indexveg)
+    IF ( ALLOCATED (indexlai)) DEALLOCATE (indexlai)
+    IF ( ALLOCATED (indexsoil)) DEALLOCATE (indexsoil)
+    IF ( ALLOCATED (indexnobio)) DEALLOCATE (indexnobio)
+    IF ( ALLOCATED (indexgrnd)) DEALLOCATE (indexgrnd)
+    IF ( ALLOCATED (indexlayer)) DEALLOCATE (indexlayer)
+    IF ( ALLOCATED (indexalb)) DEALLOCATE (indexalb)
+    IF ( ALLOCATED (flood_res)) DEALLOCATE (flood_res)
+    IF ( ALLOCATED (flood_frac)) DEALLOCATE (flood_frac)
+    IF ( ALLOCATED (snow)) DEALLOCATE (snow)
+    IF ( ALLOCATED (snow_age)) DEALLOCATE (snow_age)
+    IF ( ALLOCATED (drysoil_frac)) DEALLOCATE (drysoil_frac)
+    IF ( ALLOCATED (rsol)) DEALLOCATE (rsol)
+    IF ( ALLOCATED (evap_bare_lim)) DEALLOCATE (evap_bare_lim)
+    IF ( ALLOCATED (evapot)) DEALLOCATE (evapot)
+    IF ( ALLOCATED (evapot_corr)) DEALLOCATE (evapot_corr)
+    IF ( ALLOCATED (humrel)) DEALLOCATE (humrel)
+    IF ( ALLOCATED (vegstress)) DEALLOCATE (vegstress)
+    IF ( ALLOCATED (soiltile)) DEALLOCATE (soiltile)
+    IF ( ALLOCATED (njsc)) DEALLOCATE (njsc)
+    IF ( ALLOCATED (reinf_slope)) DEALLOCATE (reinf_slope)
+    IF ( ALLOCATED (vbeta1)) DEALLOCATE (vbeta1)
+    IF ( ALLOCATED (vbeta4)) DEALLOCATE (vbeta4)
+    IF ( ALLOCATED (vbeta5)) DEALLOCATE (vbeta5)
+    IF ( ALLOCATED (soilcap)) DEALLOCATE (soilcap)
+    IF ( ALLOCATED (soilflx)) DEALLOCATE (soilflx)
+    IF ( ALLOCATED (temp_sol)) DEALLOCATE (temp_sol)
+    IF ( ALLOCATED (qsurf)) DEALLOCATE (qsurf)
+    IF ( ALLOCATED (qsintveg)) DEALLOCATE (qsintveg)
+    IF ( ALLOCATED (vbeta2))  DEALLOCATE (vbeta2)
+    IF ( ALLOCATED (vbeta3)) DEALLOCATE (vbeta3)
+    IF ( ALLOCATED (vbeta3pot)) DEALLOCATE (vbeta3pot)
+    IF ( ALLOCATED (vbetaco2)) DEALLOCATE (vbetaco2)
+    IF ( ALLOCATED (cimean)) DEALLOCATE (cimean)
+    IF ( ALLOCATED (gpp)) DEALLOCATE (gpp)
+    IF ( ALLOCATED (veget)) DEALLOCATE (veget)
+    IF ( ALLOCATED (veget_max)) DEALLOCATE (veget_max)
+    IF ( ALLOCATED (lai)) DEALLOCATE (lai)
+    IF ( ALLOCATED (frac_age)) DEALLOCATE (frac_age)
+    IF ( ALLOCATED (height)) DEALLOCATE (height)
+    IF ( ALLOCATED (roughheight)) DEALLOCATE (roughheight)
+    IF ( ALLOCATED (frac_nobio)) DEALLOCATE (frac_nobio)
+    IF ( ALLOCATED (snow_nobio)) DEALLOCATE (snow_nobio)
+    IF ( ALLOCATED (snow_nobio_age)) DEALLOCATE (snow_nobio_age)
+    IF ( ALLOCATED (assim_param)) DEALLOCATE (assim_param)
+    IF ( ALLOCATED (vevapflo)) DEALLOCATE (vevapflo)
+    IF ( ALLOCATED (vevapsno)) DEALLOCATE (vevapsno)
+    IF ( ALLOCATED (vevapnu)) DEALLOCATE (vevapnu)
+    IF ( ALLOCATED (t2mdiag)) DEALLOCATE (t2mdiag)
+    IF ( ALLOCATED (totfrac_nobio)) DEALLOCATE (totfrac_nobio)
+    IF ( ALLOCATED (floodout)) DEALLOCATE (floodout)
+    IF ( ALLOCATED (runoff)) DEALLOCATE (runoff)
+    IF ( ALLOCATED (drainage)) DEALLOCATE (drainage)
+    IF ( ALLOCATED (reinfiltration)) DEALLOCATE (reinfiltration)
+    IF ( ALLOCATED (DOC_EXP_agg_d)) DEALLOCATE (DOC_EXP_agg_d) 
+    IF ( ALLOCATED (DOC_to_topsoil)) DEALLOCATE (DOC_to_topsoil) 
+    IF ( ALLOCATED (DOC_to_subsoil)) DEALLOCATE (DOC_to_subsoil)     
+    IF ( ALLOCATED (irrigation)) DEALLOCATE (irrigation)
+    IF ( ALLOCATED (tot_melt)) DEALLOCATE (tot_melt)
+    IF ( ALLOCATED (valpha)) DEALLOCATE (valpha)
+    IF ( ALLOCATED (vbeta)) DEALLOCATE (vbeta)
+    IF ( ALLOCATED (fusion)) DEALLOCATE (fusion)
+    IF ( ALLOCATED (rau)) DEALLOCATE (rau)
+    IF ( ALLOCATED (deadleaf_cover)) DEALLOCATE (deadleaf_cover)
+    IF ( ALLOCATED (stempdiag)) DEALLOCATE (stempdiag)
+    IF ( ALLOCATED (co2_flux)) DEALLOCATE (co2_flux)
+    IF ( ALLOCATED (shumdiag)) DEALLOCATE (shumdiag)
+    IF ( ALLOCATED (litterhumdiag)) DEALLOCATE (litterhumdiag)
+    IF ( ALLOCATED (ptnlev1)) DEALLOCATE (ptnlev1)
+    IF ( ALLOCATED (k_litt)) DEALLOCATE (k_litt)
+    IF ( ALLOCATED (vevapwet)) DEALLOCATE (vevapwet)
+    IF ( ALLOCATED (transpir)) DEALLOCATE (transpir)
+    IF ( ALLOCATED (transpot)) DEALLOCATE (transpot)
+    IF ( ALLOCATED (qsintmax)) DEALLOCATE (qsintmax)
+    IF ( ALLOCATED (rveget)) DEALLOCATE (rveget)
+    IF ( ALLOCATED (rstruct)) DEALLOCATE (rstruct)
+    IF ( ALLOCATED (wat_flux0)) DEALLOCATE (wat_flux0)
+    IF ( ALLOCATED (wat_flux)) DEALLOCATE (wat_flux)
+    IF ( ALLOCATED (drainage_per_soil)) DEALLOCATE (drainage_per_soil)
+    IF ( ALLOCATED (runoff_per_soil)) DEALLOCATE (runoff_per_soil)
+
+!! 3. Clear all allocated memory
+
+    CALL pft_parameters_clear
+    CALL slowproc_clear 
+    CALL diffuco_clear 
+    CALL enerbil_clear  
+    IF ( hydrol_cwrr ) THEN
+       CALL hydrol_clear 
+    ELSE
+       CALL hydrolc_clear  
+    ENDIF
+    CALL condveg_clear 
+    CALL thermosoil_clear
+    CALL routing_clear
+
+!! 4. Give name to next block
+    !?? Not clear what is done here and why??
+    stomate_forcing_name=forcing_name
+    stomate_Cforcing_name=Cforcing_name
+
+  END SUBROUTINE sechiba_clear
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_var_init
+!!
+!>\BRIEF        Calculate air density as a function of air temperature and 
+!! pressure for each terrestrial pixel.
+!! 
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S): air density (::rau, kg m^{-3}).
+!! 
+!! REFERENCE(S)	: None
+!! 
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE sechiba_var_init (kjpindex, rau, pb, temp_air) 
+
+!! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                    :: kjpindex        !! Domain size - terrestrial pixels only (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: pb              !! Lowest level pressure (Pa)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: temp_air        !! Air temperature (K)
+    
+!! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: rau             !! Air density @tex $(kg m^{-3})$ @endtex
+
+!! 0.3 Modified variables
+
+!! 0.4 Local variables
+
+    INTEGER(i_std)                                 :: ji              !! Indices (unitless)
+!_ ================================================================================================================================
+    
+!! 1. Calculate intial air density (::rau)
+   
+    DO ji = 1,kjpindex
+       rau(ji) = pa_par_hpa * pb(ji) / (cte_molr*temp_air(ji))
+    END DO
+
+    IF (long_print) WRITE (numout,*) ' sechiba_var_init done '
+
+  END SUBROUTINE sechiba_var_init
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE 	: sechiba_end
+!!
+!>\BRIEF        Swap old for newly calculated soil temperature.
+!! 
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUT VARIABLE(S): soil temperature (::temp_sol; K)
+!! 
+!! REFERENCE(S)	: None
+!! 
+!! FLOWCHART    : None
+!! \n
+!! ================================================================================================================================ 
+
+  SUBROUTINE sechiba_end (kjpindex, dtradia, temp_sol, temp_sol_new)
+
+!! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                       :: kjpindex           !! Domain size - terrestrial pixels only (unitless)
+    REAL(r_std),INTENT (in)                           :: dtradia            !! Time step (seconds)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)     :: temp_sol_new       !! New soil temperature (K)
+    
+!! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)    :: temp_sol           !! Soil temperature (K)
+
+!! 0.3 Modified variables
+
+!! 0.4 Local variables
+
+!_ ================================================================================================================================
+    
+!! 1. Swap temperature
+
+    temp_sol(:) = temp_sol_new(:)
+
+    IF (long_print) WRITE (numout,*) ' sechiba_end done '
+
+  END SUBROUTINE sechiba_end
+
+END MODULE sechiba
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/sechiba_io.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/sechiba_io.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/sechiba_io.f90	(revision 5166)
@@ -0,0 +1,467 @@
+!! This subroutines initialize a variable or an array
+!! with a variable or an array of smaller rank
+!! - i is for integer interface - r for real interface
+!! - 0 is for a scalar - 1 for a 1D array - 2 for a 2D array
+!! Thee right routines is automatically called depending type of input variable
+!! This initialisation is done only if the value of input field is egal to val_exp
+!!
+!! If a key word is provided which is not equal to "NO_KEYWORD" or "NOKEYWORD" then
+!! we try to find the value to fill in in the configuration file.
+!!
+!! @author Marie-Alice Foujols and Jan Polcher
+!! @Version : $Revision$, $Date$
+!! 
+!< $HeadURL$
+!< $Date$
+!< $Author$
+!< $Revision$
+!! IPSL (2006)
+!!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!!
+MODULE sechiba_io
+
+  USE defprec
+  USE constantes
+  USE ioipsl
+  USE sechiba_io_p
+
+  IMPLICIT NONE
+
+  INTERFACE setvar
+    MODULE PROCEDURE i0setvar, i10setvar, i20setvar, i11setvar, i21setvar, i22setvar
+    MODULE PROCEDURE r0setvar, r10setvar, r20setvar, r11setvar, r21setvar, r22setvar, r30setvar
+  END INTERFACE
+
+!
+! mettre la l'interface des routines utilisees:
+!
+! restget/put/ini histbeg/def flinopen/close
+!
+
+LOGICAL, SAVE                  :: long_print_setvar=.FALSE.  !! change to true to have more information
+!$OMP THREADPRIVATE(long_print_setvar)
+
+CONTAINS 
+
+
+!! Interface for integer scalar to scalar.
+SUBROUTINE i0setvar (var, val_exp, key_wd, val_put)
+
+  INTEGER(i_std), INTENT(inout)                   :: var                  !! Integer scalar to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Initial value to stored
+
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar) WRITE(numout,*) "i0setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( var == val_exp ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var = val_tmp
+  END IF
+  
+END SUBROUTINE i0setvar
+
+
+!! Interface for initialising an 1D integer array with a scalar integer.
+SUBROUTINE i10setvar (var, val_exp, key_wd, val_put)
+
+  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+  
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar) WRITE(numout,*) "i10setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var(:) = val_tmp
+  END IF
+  
+END SUBROUTINE i10setvar
+
+
+!! Interface for initialising an 1D array integer with an other 1D array integer.
+SUBROUTINE i11setvar (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
+
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar) WRITE(numout,*) "i11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var(:) = val_tmp (:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i11setvar
+
+
+!! Interface for initialising an 2D array integer with a scalar integer.
+SUBROUTINE i20setvar (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  !
+  ! this subroutine set val_put value to var if var is constant
+  ! 
+  !
+  IF (long_print_setvar) WRITE(numout,*) "i20setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var(:,:) = val_tmp
+  END IF
+  
+END SUBROUTINE i20setvar
+
+
+!! Interface for initialising an 2D array integer with an 1D array integer.
+!! Row or column depending size of 1D array to stored.
+!!
+!! example: 1D 1,2,3     2D is 1, 2, 3,
+!!                             1, 2, 3
+!!
+!!
+!! example: 1D 1,2,3     2D is 1, 1,
+!!                             2, 2,
+!!                             3, 3
+!!
+SUBROUTINE i21setvar (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D integer array to stored
+  
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  ! test if the 1D array dimension is compatible with first or second 
+  ! dimension of the 2D array
+
+  IF (long_print_setvar) WRITE(numout,*) "i21setvar :", key_wd, val_exp, val_put
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF (SIZE(val_put)==SIZE(var,1)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+      !                                1., 2., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
+      END IF
+  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 1.,
+      !                                2., 2.,
+      !                                3., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
+      END IF
+  ELSE 
+      WRITE(numout,*) ' incompatible dimension var and val_put'
+      WRITE(numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
+      WRITE(numout,*) ' val_put ', SIZE(val_put)
+      STOP 'setvar'
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i21setvar
+
+!! Interface for initialising an 2D array integer with an other 2D array integer.
+SUBROUTINE i22setvar (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd              !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
+
+  INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar) WRITE(numout,*) "i21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
+
+  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
+  val_tmp(:,:) = val_put(:,:)
+
+  IF ( ALL(var(:,:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:,:) = val_tmp(:,:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i22setvar
+
+
+!! Interface for scalar to scalar real
+SUBROUTINE r0setvar (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), INTENT(inout)                   :: var                  !! Real scalar to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Initial value to stored
+  
+  REAL(r_std)                                  :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar) WRITE(numout,*) "r0setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( var==val_exp ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var = val_tmp
+  END IF
+  
+END SUBROUTINE r0setvar
+
+
+!! Interface for initialising an 1D real array with a scalar real.
+SUBROUTINE r10setvar (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+   
+  REAL(r_std)                                  :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+ 
+  IF (long_print_setvar) WRITE(numout,*) "r10setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:) = val_tmp
+  END IF
+  
+END SUBROUTINE r10setvar
+
+
+!! Interface for initialising an 1D array real with an other 1D array real.
+SUBROUTINE r11setvar (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd              !! The Key word we will look for
+  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
+
+  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+   
+  IF (long_print_setvar) WRITE(numout,*) "r11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:) = val_tmp (:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r11setvar
+
+
+!! Interface for initialising an 2D array real with a scalar real.
+SUBROUTINE r20setvar (var, val_exp, key_wd, val_put)
+  
+  ! interface for scalar to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd                  !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+ 
+  REAL(r_std)                                  :: val_tmp  
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+ 
+  IF (long_print_setvar) WRITE(numout,*) "r20setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd,  val_tmp)
+     var(:,:) = val_tmp
+  END IF
+  
+END SUBROUTINE r20setvar
+
+
+!! Interface for initialising an 2D array real with an 1D array real.
+!! Row or column depending size of 1D array to stored.
+!!
+!! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+!!                                1., 2., 3.
+!!
+!!
+!! example: 1D 1.,2.,3.     2D is 1., 1.,
+!!                                2., 2.,
+!!                                3., 3.
+!!
+SUBROUTINE r21setvar (var, val_exp, key_wd, val_put)
+  
+  ! interface for 1D array to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D real array to stored
+
+  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  ! test if the 1D array dimension is compatible with first or second 
+  ! dimension of the 2D array
+
+  IF (long_print_setvar) WRITE(numout,*) "r21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF (SIZE(val_put)==SIZE(var,1)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+      !                                1., 2., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
+      END IF
+  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 1.,
+      !                                2., 2.,
+      !                                3., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
+      END IF
+  ELSE 
+      WRITE(numout,*) ' incompatible dimension var and val_put'
+      WRITE(numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
+      WRITE(numout,*) ' val_put ', SIZE(val_put)
+      STOP 'setvar'
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r21setvar
+
+
+!! Interface for initialising an 2D array real with an other 2D array real. 
+SUBROUTINE r22setvar (var, val_exp, key_wd, val_put)
+  
+  ! interface for 2D array to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd              !! The Key word we will look for
+  REAL(r_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
+
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar) WRITE(numout,*) "r22setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
+
+  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
+  val_tmp(:,:) = val_put(:,:)
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:,:) = val_tmp(:,:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r22setvar
+
+!! Interface for initialising an 3D array real with a scalar real.
+SUBROUTINE r30setvar (var, val_exp, key_wd, val_put)
+
+  ! interface for scalar to 3D array real
+
+  REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: var                  !! 3D integer array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+
+  REAL(r_std)                                  :: val_tmp 
+  INTEGER(i_std)                              :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar) WRITE(numout,*) 'r30setvar',val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:,:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) CALL getin(key_wd, val_tmp)
+     var(:,:,:) = val_tmp
+  END IF
+
+END SUBROUTINE r30setvar
+
+END MODULE sechiba_io
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/sechiba_io_p.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/sechiba_io_p.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/sechiba_io_p.f90	(revision 5166)
@@ -0,0 +1,528 @@
+!! This subroutines initialize a variable or an array
+!! with a variable or an array of smaller rank
+!! - i is for integer interface - r for real interface
+!! - 0 is for a scalar - 1 for a 1D array - 2 for a 2D array
+!! Thee right routines is automatically called depending type of input variable
+!! This initialisation is done only if the value of input field is egal to val_exp
+!!
+!! If a key word is provided which is not equal to "NO_KEYWORD" or "NOKEYWORD" then
+!! we try to find the value to fill in in the configuration file.
+!!
+!! @author Marie-Alice Foujols and Jan Polcher
+!! @Version : $Revision$, $Date$
+!! 
+!< $HeadURL$
+!< $Date$
+!< $Author$
+!< $Revision$
+!! IPSL (2006)
+!!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!!
+MODULE sechiba_io_p
+
+  USE defprec
+  USE constantes
+  USE ioipsl
+  USE ioipsl_para
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  INTERFACE setvar_p
+    MODULE PROCEDURE i0setvar_p, i10setvar_p, i20setvar_p, i11setvar_p, i21setvar_p, i22setvar_p
+    MODULE PROCEDURE r0setvar_p, r10setvar_p, r20setvar_p, r11setvar_p, r21setvar_p, r22setvar_p, r30setvar_p
+  END INTERFACE
+
+!
+! mettre la l'interface des routines utilisees:
+!
+! restget/put/ini histbeg/def flinopen/close
+!
+
+LOGICAL, SAVE                  :: long_print_setvar_p=.FALSE.  !! change to true to have more information
+!$OMP THREADPRIVATE(long_print_setvar_p)
+
+CONTAINS 
+
+!! pour declencher les restarts rajoutes avec un parametre externe
+FUNCTION ok_var ( varname )
+  CHARACTER(LEN=*), INTENT(IN) :: varname
+  LOGICAL ok_var
+  ok_var=.FALSE.
+  CALL getin_p(varname, ok_var)
+END FUNCTION ok_var
+
+!! Interface for integer scalar to scalar.
+SUBROUTINE i0setvar_p (var, val_exp, key_wd, val_put)
+
+  INTEGER(i_std), INTENT(inout)                   :: var                  !! Integer scalar to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Initial value to stored
+
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar_p) WRITE (numout,*) "i0setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( var == val_exp ) THEN 
+     IF ( is_key <= 0 ) THEN
+        CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var = val_tmp
+  END IF
+  
+END SUBROUTINE i0setvar_p
+
+
+!! Interface for initialising an 1D integer array with a scalar integer.
+SUBROUTINE i10setvar_p (var, val_exp, key_wd, val_put)
+
+  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+  
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar_p) WRITE (numout,*) "i10setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:) = val_tmp
+  END IF
+  
+END SUBROUTINE i10setvar_p
+
+
+!! Interface for initialising an 1D array integer with an other 1D array integer.
+SUBROUTINE i11setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  INTEGER(i_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
+  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable 
+
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp_g
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar_p) WRITE (numout,*) "i11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+        IF (PRESENT(is_grid) ) THEN
+           IF (is_root_prc) THEN
+              ALLOCATE( val_tmp_g(nbp_glo) )
+           ELSE
+              ALLOCATE( val_tmp_g(1) )
+           ENDIF
+           CALL gather( val_tmp,val_tmp_g )
+           IF (is_root_prc) &
+              CALL getin(key_wd,  val_tmp_g)
+           CALL scatter( val_tmp,val_tmp_g )
+           DEALLOCATE( val_tmp_g )
+        ELSE
+           CALL getin_p(key_wd,  val_tmp)
+        ENDIF
+     ENDIF
+     var(:) = val_tmp (:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i11setvar_p
+
+
+!! Interface for initialising an 2D array integer with a scalar integer.
+SUBROUTINE i20setvar_p (var, val_exp, key_wd, val_put)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+
+  INTEGER(i_std)                                  :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  !
+  ! this subroutine set val_put value to var if var is constant
+  ! 
+  !
+  IF (long_print_setvar_p) WRITE (numout,*) "i20setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:,:) = val_tmp
+  END IF
+  
+END SUBROUTINE i20setvar_p
+
+
+!! Interface for initialising an 2D array integer with an 1D array integer.
+!! Row or column depending size of 1D array to stored.
+!!
+!! example: 1D 1,2,3     2D is 1, 2, 3,
+!!                             1, 2, 3
+!!
+!!
+!! example: 1D 1,2,3     2D is 1, 1,
+!!                             2, 2,
+!!                             3, 3
+!!
+SUBROUTINE i21setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D integer array to stored
+  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable 
+  
+  INTEGER(i_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  ! test if the 1D array dimension is compatible with first or second 
+  ! dimension of the 2D array
+
+  IF (long_print_setvar_p) WRITE (numout,*) "i21setvar :", key_wd, val_exp, val_put
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF (SIZE(val_put)==SIZE(var,1)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+      !                                1., 2., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) THEN
+           CALL getin_p(key_wd,  val_tmp)
+         ENDIF
+         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
+      END IF
+  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 1.,
+      !                                2., 2.,
+      !                                3., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) THEN
+           CALL getin_p(key_wd,  val_tmp)
+         ENDIF
+         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
+      END IF
+  ELSE 
+      WRITE (numout,*) ' incompatible dimension var and val_put'
+      WRITE (numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
+      WRITE (numout,*) ' val_put ', SIZE(val_put)
+      STOP 'setvar'
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i21setvar_p
+
+!! Interface for initialising an 2D array integer with an other 2D array integer.
+SUBROUTINE i22setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  INTEGER(i_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D integer array to modify
+  INTEGER(i_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd              !! The Key word we will look for
+  INTEGER(i_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
+  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable 
+
+  INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
+  INTEGER(i_std)                                  :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  IF (long_print_setvar_p) WRITE (numout,*) "i21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
+
+  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
+  val_tmp(:,:) = val_put(:,:)
+
+  IF ( ALL(var(:,:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:,:) = val_tmp(:,:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE i22setvar_p
+
+
+!! Interface for scalar to scalar real
+SUBROUTINE r0setvar_p (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), INTENT(inout)                   :: var                  !! Real scalar to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Initial value to stored
+  
+  REAL(r_std)                                  :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar_p) WRITE (numout,*) "r0setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( var==val_exp ) THEN 
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var = val_tmp
+  END IF
+  
+END SUBROUTINE r0setvar_p
+
+
+!! Interface for initialising an 1D real array with a scalar real.
+SUBROUTINE r10setvar_p (var, val_exp, key_wd, val_put)
+  
+  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                  !! 1D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+   
+  REAL(r_std)                                  :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+ 
+  IF (long_print_setvar_p) WRITE (numout,*) "r10setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:) = val_tmp
+  END IF
+  
+END SUBROUTINE r10setvar_p
+
+
+!! Interface for initialising an 1D array real with an other 1D array real.
+SUBROUTINE r11setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  REAL(r_std), DIMENSION(:), INTENT(inout)     :: var                 !! 1D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd              !! The Key word we will look for
+  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put             !! 1D integer array to stored
+  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable 
+
+  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+   
+  IF (long_print_setvar_p) WRITE (numout,*) "r11setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF ( ALL( var(:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:) = val_tmp (:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r11setvar_p
+
+
+!! Interface for initialising an 2D array real with a scalar real.
+SUBROUTINE r20setvar_p (var, val_exp, key_wd, val_put)
+  
+  ! interface for scalar to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D integer array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd                  !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+ 
+  REAL(r_std)                                  :: val_tmp  
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+ 
+  IF (long_print_setvar_p) WRITE (numout,*) "r20setvar :", key_wd, val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:,:) = val_tmp
+  END IF
+  
+END SUBROUTINE r20setvar_p
+
+
+!! Interface for initialising an 2D array real with an 1D array real.
+!! Row or column depending size of 1D array to stored.
+!!
+!! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+!!                                1., 2., 3.
+!!
+!!
+!! example: 1D 1.,2.,3.     2D is 1., 1.,
+!!                                2., 2.,
+!!                                3., 3.
+!!
+SUBROUTINE r21setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  ! interface for 1D array to 2D array real
+
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                  !! 2D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                   :: key_wd               !! The Key word we will look for
+  REAL(r_std), DIMENSION(:), INTENT(in)        :: val_put              !! 1D real array to stored
+  LOGICAL,        OPTIONAL                        :: is_grid              !! Parameter present indicates a setvar for a grid variable 
+
+  REAL(r_std), ALLOCATABLE,DIMENSION(:)        :: val_tmp
+  INTEGER(i_std)                                     :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+  
+  ! test if the 1D array dimension is compatible with first or second 
+  ! dimension of the 2D array
+
+  IF (long_print_setvar_p) WRITE (numout,*) "r21setvar :", key_wd, val_exp, SIZE(val_put), val_put(1)
+
+  ALLOCATE(val_tmp(SIZE(val_put)))
+  val_tmp(:) = val_put(:)
+
+  IF (SIZE(val_put)==SIZE(var,1)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 2., 3.,
+      !                                1., 2., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) THEN
+           CALL getin_p(key_wd,  val_tmp)
+         ENDIF
+         var(:,:) = SPREAD(val_tmp(:),2,SIZE(var,1))
+      END IF
+  ELSEIF (SIZE(val_put)==SIZE(var,2)) THEN 
+      !
+      ! example: 1D 1.,2.,3.     2D is 1., 1.,
+      !                                2., 2.,
+      !                                3., 3.
+      !
+      IF ( ALL( var(:,:) == val_exp ) ) THEN 
+         IF ( is_key <= 0 ) THEN
+           CALL getin_p(key_wd,  val_tmp)
+         ENDIF
+         var(:,:) = SPREAD(val_tmp(:),1,SIZE(var,1))
+      END IF
+  ELSE 
+      WRITE (numout,*) ' incompatible dimension var and val_put'
+      WRITE (numout,*) ' var     ', SIZE(var,1), SIZE(var,2)
+      WRITE (numout,*) ' val_put ', SIZE(val_put)
+      STOP 'setvar'
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r21setvar_p
+
+
+!! Interface for initialising a real 2D array with a scalar parameter from run.def or an other 2D array in argument 
+SUBROUTINE r22setvar_p (var, val_exp, key_wd, val_put)   
+  ! interface for 2D array to 2D array real
+  ! If a key_wd is set, it is supposed to be a scalar parameter will be read from run.def 
+  ! It is not possible to read a 2D variable from run.def
+  REAL(r_std), DIMENSION(:,:), INTENT(inout)   :: var                 !! 2D real array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp             !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                 :: key_wd              !! The Key word we will look for
+  REAL(r_std), DIMENSION(:,:), INTENT(in)      :: val_put             !! 2D integer array to stored
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: val_tmp
+  REAL(r_std)                                  :: val_scal            !! Temporary variable to read a scalar value from run.def
+  INTEGER(i_std)                               :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar_p) WRITE (numout,*) "r22setvar :", key_wd, val_exp, SIZE(val_put), val_put(1,1)
+
+  ALLOCATE(val_tmp(SIZE(val_put,DIM=1),SIZE(val_put,DIM=2)))
+  val_tmp(:,:) = val_put(:,:)
+
+  IF ( ALL( var(:,:) == val_exp ) ) THEN 
+     IF ( is_key <= 0 ) THEN
+        ! This case only read a scalar value with getin 
+        val_scal=val_exp 
+        CALL getin_p(key_wd, val_scal) 
+        ! If a value was found in run.def, then set val_tmp to this value. 
+        IF (val_scal/=val_exp) val_tmp(:,:)=val_scal
+     ENDIF
+     var(:,:) = val_tmp(:,:)
+  END IF
+
+  DEALLOCATE(val_tmp)
+  
+END SUBROUTINE r22setvar_p
+
+!! Interface for initialising an 3D array real with a scalar real.
+SUBROUTINE r30setvar_p (var, val_exp, key_wd, val_put)
+
+  ! interface for scalar to 3D array real
+
+  REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: var                  !! 3D integer array to modify
+  REAL(r_std), INTENT(in)                      :: val_exp              !! Exceptional value
+  CHARACTER(LEN=*), INTENT(in)                :: key_wd               !! The Key word we will look for
+  REAL(r_std), INTENT(in)                      :: val_put              !! Scalar value to stored
+
+  REAL(r_std)                                  :: val_tmp 
+  INTEGER(i_std)                              :: is_key
+
+  is_key = MAX(INDEX(key_wd, 'NO_KEYWORD'), INDEX(key_wd, 'NOKEYWORD'))
+
+  IF (long_print_setvar_p) WRITE(numout,*) 'r30setvar',val_exp, val_put
+
+  val_tmp = val_put
+
+  IF ( ALL( var(:,:,:) == val_exp ) ) THEN
+     IF ( is_key <= 0 ) THEN
+       CALL getin_p(key_wd,  val_tmp)
+     ENDIF
+     var(:,:,:) = val_tmp
+  END IF
+
+END SUBROUTINE r30setvar_p
+
+END MODULE sechiba_io_p
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/slowproc.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/slowproc.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/slowproc.f90	(revision 5166)
@@ -0,0 +1,6364 @@
+! =================================================================================================================================
+! MODULE       : slowproc
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Groups the subroutines that: (1) initialize all variables used in 
+!! slowproc_main, (2) prepare the restart file for the next simulation, (3) Update the 
+!! vegetation cover if needed, and (4) handle all slow processes if the carbon
+!! cycle is activated (call STOMATE) or update the vegetation properties (LAI and 
+!! fractional cover) in the case of a run with only SECHIBA.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE slowproc
+
+  ! modules used:
+
+  USE defprec
+  USE constantes 
+  USE constantes_soil
+  USE pft_parameters
+  USE ioipsl
+  USE ioipsl_para
+  USE sechiba_io
+  USE interpol_help
+  USE stomate
+  USE stomate_data
+  USE grid
+  USE mod_orchidee_para
+
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PRIVATE
+  PUBLIC slowproc_main,slowproc_clear
+
+!!??VB Are these old comments? Questions you have yourself. I'm not clear what it's about anyway.
+  ! Specific To use OLD or NEW interpolation schemes depending on the given arguments
+  ! For interpol the OLD routines correspond to the tag 1.6 and should be dropped ???
+  ! For interpol ONLY the subroutines *_g are used ?? (should delete the others ?)
+  INTERFACE slowproc_interlai
+     MODULE PROCEDURE slowproc_interlai_OLD, slowproc_interlai_NEW
+  END INTERFACE
+  INTERFACE slowproc_interpol
+     MODULE PROCEDURE slowproc_interpol_OLD, slowproc_interpol_NEW
+  END INTERFACE
+  INTERFACE slowproc_interpol_g
+     MODULE PROCEDURE slowproc_interpol_OLD_g, slowproc_interpol_NEW_g
+  END INTERFACE
+
+  !
+  ! variables used inside slowproc module : declaration and initialisation
+  !
+!!?? Many units are lacking (even flags should be stated as "unitless")
+!!?? You should use a sign (eg. !£!) which can be automatically searched and points to obsolete/dispensable variables
+  LOGICAL, SAVE                                   :: l_first_slowproc = .TRUE.  !! Flag to do the initialisation only one time
+!$OMP THREADPRIVATE(l_first_slowproc)
+  REAL(r_std), SAVE                               :: dt_slow                    !! time step of slow processes and STOMATE
+!$OMP THREADPRIVATE(dt_slow)
+  !
+  REAL(r_std), SAVE                                :: slope_default = 0.1
+!$OMP THREADPRIVATE(slope_default)
+  !
+  INTEGER(i_std) , SAVE                           :: veget_update=0             !! update frequency in years for landuse (nb of years)
+!$OMP THREADPRIVATE(veget_update)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: clayfraction            !! Clayfraction (0-1, unitless)
+!$OMP THREADPRIVATE(clayfraction)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: bulk_density            !! bulk_density (kg m-3)
+!$OMP THREADPRIVATE(bulk_density)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: soil_ph                 !! soil_ph (0-14, pH units)
+!$OMP THREADPRIVATE(soil_ph)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: laimap                  !! LAI map when the LAI is prescribed and not calculated by STOMATE
+!$OMP THREADPRIVATE(laimap)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: soilclass_default
+!$OMP THREADPRIVATE(soilclass_default)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: veget_nextyear          !! next year fraction of vegetation type (0-1, unitless)
+!$OMP THREADPRIVATE(veget_nextyear)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_nobio_nextyear     !! next year fraction of ice+lakes+cities+... (0-1, unitless)
+!$OMP THREADPRIVATE(frac_nobio_nextyear)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: totfrac_nobio_nextyear  !! next year total fraction of ice+lakes+cities+... (0-1, unitless)
+!$OMP THREADPRIVATE(totfrac_nobio_nextyear)
+
+  ! Update vegetation and bare soil fraction
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_bare_soil    !! total evaporating bare soil fraction 
+!$OMP THREADPRIVATE(tot_bare_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_bare        !! Fraction (of veget_max) of bare soil in each vegetation type           
+!$OMP THREADPRIVATE(frac_bare)
+  PUBLIC tot_bare_soil,frac_bare
+
+CONTAINS
+
+!!?? The "brief" section should be more precise (check and drop the "possibly").
+!!?? Rather than "main routine that managed variable utilisation", be more precise:
+!!?? Calls slowproc_init (which intialize variables) ...
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_main
+!!
+!>\BRIEF         Main routine that manage variable initialisation (slowproc_init), 
+!! prepare the restart file with the slowproc variables, update the time variables 
+!! for slow processes, and possibly update the vegetation cover, before calling 
+!! STOMATE in the case of the carbon cycle activated or just update LAI (and possibly
+!! the vegetation cover) for simulation with only SECHIBA   
+!!
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): The subroutine manages 
+!! diverses tasks:
+!! (1) Initializing all variables of slowproc (first call)
+!! (2) Preparation of the restart file for the next simulation with all prognostic variables
+!! (3) Compute and update time variable for slow processes
+!! (4) Update the vegetation cover if there is some land use change (only every years)
+!! (5) Call STOMATE for the runs with the carbone cycle activated (ok_stomate) and compute the respiration
+!!     and the net primary production
+!! (6) Compute the LAI and possibly update the vegetation cover for run without STOMATE 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S):  ::co2_flux, ::fco2_lu, ::lai, ::height, ::veget, ::frac_nobio,  
+!! ::veget_max, ::totfrac_nobio, ::soiltype, ::assim_param, ::deadleaf_cover, ::qsintmax,
+!! and resp_maint, resp_hetero, resp_growth, npp that are calculated and stored
+!! in stomate is activated.  
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : 
+! \latexonly 
+! \includegraphics(scale=0.5){SlowprocMainFlow.eps} !PP to be finalize!!)
+! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_main (kjit, kjpij, kjpindex, dtradia, date0, &
+       ldrestart_read, ldrestart_write, ldforcing_write, ldcarbon_write, &
+       IndexLand, indexveg, lalo, neighbours, resolution, contfrac, soiltile, reinf_slope, &
+       t2m, t2m_min, temp_sol, stempdiag, &
+       humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+       deadleaf_cover, &
+       assim_param, &
+       lai, frac_age, height, veget, frac_nobio, njsc, veget_max, totfrac_nobio, qsintmax, &
+       rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+       co2_flux, fco2_lu, soil_mc, litter_mc,floodout, runoff, drainage, wat_flux0, wat_flux,&
+       drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, DOC_to_topsoil, DOC_to_subsoil)
+       
+  
+!! INTERFACE DESCRIPTION
+
+!! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: kjit                !! Time step number
+    INTEGER(i_std), INTENT(in)                          :: kjpij               !! Total size of the un-compressed grid
+    INTEGER(i_std),INTENT(in)                           :: kjpindex            !! Domain size - terrestrial pixels only
+    REAL(r_std),INTENT(in)                              :: dtradia             !! Time step of SECHIBA
+    REAL(r_std),INTENT (in)                             :: date0               !! Initial date of what ???
+    LOGICAL, INTENT(in)                                 :: ldrestart_read      !! Logical for _restart_ file to read
+    LOGICAL, INTENT(in)                                 :: ldrestart_write     !! Logical for _restart_ file to write
+    LOGICAL, INTENT(in)                                 :: ldforcing_write     !! Logical for _forcing_ file to write
+    LOGICAL, INTENT(in)                                 :: ldcarbon_write      !! Logical for _carbon_forcing_ file to write
+    INTEGER(i_std),INTENT (in)                          :: rest_id,hist_id     !! _Restart_ file and _history_ file identifier
+    INTEGER(i_std),INTENT (in)                          :: hist2_id            !! _history_ file 2 identifier
+    INTEGER(i_std),INTENT (in)                          :: rest_id_stom        !! STOMATE's _Restart_ file identifier
+    INTEGER(i_std),INTENT (in)                          :: hist_id_stom        !! STOMATE's _history_ file identifier
+    INTEGER(i_std),INTENT(in)                           :: hist_id_stom_IPCC   !! STOMATE's IPCC _history_ file identifier
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: IndexLand           !! Indices of the points on the land map
+    INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in):: indexveg            !! Indices of the points on the vegetation (3D map ???) 
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)     :: lalo                !! Geogr. coordinates (latitude,longitude) (degrees)
+    INTEGER(i_std), DIMENSION (kjpindex,8), INTENT(in)  :: neighbours          !! neighoring grid points if land. In what ??? indices or geographical coordinates (lat/lon) ??? 
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)     :: resolution          !! size in x an y of the grid (m)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: contfrac            !! Fraction of continent in the grid (0-1, unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)  :: humrel              !! Relative humidity ("moisture stress") (0-1, unitless)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: t2m                 !! 2 m air temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)        :: t2m_min             !! min. 2 m air temp. during forcing time step (K)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: temp_sol            !! Surface temperature (K)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)  :: stempdiag           !! Soil temperature (K)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)  :: shumdiag            !! Relative soil moisture (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(in)  :: soil_mc         !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in)   :: litter_mc           !! litter moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: litterhumdiag       !! Litter humidity  (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: precip_rain         !! Rain precipitation (mm dt_slow^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: precip_snow         !! Snow precipitation (mm dt_slow^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)    :: gpp                 !! GPP of total ground area (gC m^{-2} time step^{-1}). 
+                                                                               !! Calculated in sechiba, account for vegetation cover and 
+                                                                               !! effective time step to obtain gpp_d   
+   REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: floodout             !! flux out of floodplains
+   REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: runoff               !! Complete runoff
+   REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: drainage             !! Drainage
+   REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in)   :: wat_flux0            !! Water flux in the first soil layers exported for soil C calculations
+   REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(in)   :: wat_flux        !! Water flux in the soil layers exported for soil C calculations
+   REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in)   :: drainage_per_soil    !! Drainage per soil type exported for soil C calculations 
+   REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in)   :: runoff_per_soil    !! Runoff per soil type exported for soil C calculations 
+   REAL(r_std),DIMENSION (kjpindex,nelements), INTENT(in)   :: DOC_to_topsoil  !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                               !! floodplains and from irrigation
+                                                                               !! @tex $(gC m^{-2} day{-1})$ @endtex
+   REAL(r_std),DIMENSION (kjpindex,nelements), INTENT(in)   :: DOC_to_subsoil  !! DOC inputs to bottom of the soil column, from returnflow
+                                                                               !! in swamps and lakes
+                                                                               !! @tex $(gC m^{-2} day{-1})$ @endtex
+!! 0.2 Output variables 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)      :: co2_flux            !! CO2 flux per average ground area (gC m^{-2} dt_slow^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: fco2_lu             !! CO2 flux from land-use (without forest management) (gC m^{-2} dt_slow^{-1})
+    REAL(r_std),DIMENSION(kjpindex, nexp), INTENT (out) :: DOC_EXP_agg_d       !! DOC exports, diffrenet paths (nexp), in  
+                                                                               !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex      
+!! 0.3 Modified variables
+    INTEGER(i_std), DIMENSION(kjpindex), INTENT(inout)       :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: lai            !! Leaf area index (m^2 m^{-2})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: height         !! height of vegetation (m)
+    REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT(inout):: frac_age   !! Age efficacity from STOMATE for isoprene
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: veget          !! Fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout)  :: frac_nobio     !! Fraction of ice, lakes, cities etc. in the mesh
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: veget_max      !! Maximum fraction of vegetation type including none biological fraction (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: totfrac_nobio  !! Total fraction of ice+lakes+cities etc. in the mesh
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout)    :: soiltile       !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT(inout)          :: reinf_slope    !! slope coef for reinfiltration
+    REAL(r_std),DIMENSION (kjpindex,nvm,npco2),INTENT (inout):: assim_param    !! min+max+opt temperatures & vmax for photosynthesis (K, \mumol m^{-2} s^{-1})
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)         :: deadleaf_cover !! Fraction of soil covered by dead leaves (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)     :: qsintmax       !! Maximum water storage on vegetation from interception (mm)
+    
+
+!! 0.4 Local variables
+    INTEGER(i_std)                                                 :: j, jv                !! indices 
+    INTEGER(i_std), SAVE                                           :: lcanop               !! canopy levels used for LAI
+!$OMP THREADPRIVATE(lcanop) 
+    REAL(r_std)                                                    :: tmp_day(1)           !! temporary variable for I/O
+    CHARACTER(LEN=80)                                              :: var_name             !! To store variables names for I/O
+    REAL(r_std), DIMENSION(kjpindex,nvm)                           :: resp_maint           !! Maitanance component of autotrophic respiration in (gC m^{-2} dt_slow^{-1})
+    REAL(r_std), DIMENSION(kjpindex)                               :: resp_hetero          !! heterotrophic resp. (gC/(m**2 of total ground)/time step)
+    REAL(r_std), DIMENSION(kjpindex,nvm)                           :: resp_growth          !! Growth component of autotrophic respiration in gC m^{-2} dt_slow^{-1})
+    REAL(r_std), DIMENSION(kjpindex,nvm)                           :: npp                  !! Net Ecosystem Exchange (gC/(m**2 of total ground)/time step) 
+    INTEGER(i_std) , SAVE                                          :: veget_year           !! year for landuse
+!$OMP THREADPRIVATE(veget_year)  
+    LOGICAL                                                        :: land_use_updated     !! logical for landuse
+    LOGICAL, PARAMETER                                             :: check = .FALSE.      !! logical 
+    REAL(r_std), SAVE                                              :: sec_old = zero       !! Time counter for to save the old  
+!$OMP THREADPRIVATE(sec_old)
+!_ ================================================================================================================================
+
+! 1 Initialize all variables at the first call 
+!
+    IF (l_first_slowproc) THEN
+
+       ! 1.1 Perform the allocation of all variables, define some files and some flags. 
+       !     Restart file read for Sechiba.
+       IF (long_print) WRITE (numout,*) ' l_first_slowproc : call slowproc_init '
+       CALL slowproc_init (kjit, ldrestart_read, dtradia, date0, kjpindex, IndexLand, lalo, neighbours, resolution, contfrac, &
+            & rest_id, read_lai, lai, frac_age, veget, frac_nobio, totfrac_nobio, soiltile, reinf_slope, veget_max, njsc, &
+            & height, lcanop, veget_update, veget_year)
+
+       !
+       ! 1.2 Define Time step in days for stomate
+       dt_days = dt_slow / one_day
+
+       ! 1.3 Set to zero all respiration fluxes and all soil and litter pools
+       resp_maint(:,:)  = zero
+       resp_hetero(:) = zero
+       resp_growth(:,:) = zero
+
+       ! 1.4 check time step coherence between slow processes and fast processes
+       IF ( dt_slow .LT. dtradia ) THEN
+          WRITE(numout,*) 'slow_processes: time step smaller than forcing time step.'
+          STOP 'slowproc_main'
+       ENDIF
+
+       ! 1.5 Call stomate to initialize all variables manadged in stomate,
+       !     when Stomate is used or when the "watchout"?? diagnostics are requested 
+       IF ( control%stomate_watchout .OR. control%ok_stomate ) THEN
+
+          CALL stomate_main (kjit, kjpij, kjpindex, dtradia, dt_slow, &
+               ldrestart_read, ldrestart_write, ldforcing_write, ldcarbon_write, &
+               IndexLand, lalo, neighbours, resolution, contfrac, totfrac_nobio, clayfraction, &
+               t2m, t2m_min, temp_sol, stempdiag, &
+               humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+               deadleaf_cover, &
+               assim_param, &
+               lai, frac_age, height, veget, veget_max, &
+               veget_nextyear, totfrac_nobio_nextyear, &
+               hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+               co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth,soil_mc,soiltile,&
+               litter_mc,floodout, runoff, drainage,wat_flux0, wat_flux, &
+               bulk_density, soil_ph, drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, &
+               DOC_to_topsoil, DOC_to_subsoil)
+
+       ENDIF
+       ! 1.6 Specific run without the carbon cycle (STOMATE not called): 
+       !     Need to initialize some variables that will be used in SECHIBA:
+       !     height, deadleaf_cover, assim_param, lai, qsintmax.
+       IF ( .NOT. control%ok_stomate ) THEN
+
+          CALL slowproc_derivvar (kjpindex, veget, lai, &
+               qsintmax, deadleaf_cover, assim_param, height)
+       ELSE
+          qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
+          qsintmax(:,1) = zero
+       ENDIF
+
+       RETURN
+    ELSE
+
+    ENDIF
+
+
+    ! 2 preparation of a restart file for the next simulation 
+    !  that will contain all pronostic variables to be used
+    !  use restput routine for scalar and restput_p routine for arrays
+    IF (ldrestart_write) THEN
+
+       IF (long_print) WRITE (numout,*) ' we have to complete restart file with SLOWPROC variables '
+
+       ! 2.1 Write a series of variables controled by slowproc: day
+       ! counter, vegetation fraction, max vegetation fraction, LAI
+       ! variable from stomate, fraction of bare soil, soiltype
+       ! fraction, clay fraction, height of vegetation, map of LAI
+
+       ! write day counter
+       tmp_day(1) = day_counter
+       var_name= 'day_counter'
+       IF (is_root_prc) CALL restput (rest_id, var_name, 1 , 1  , 1, kjit, tmp_day)
+
+!!$       var_name= 'veget'
+!!$       CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, veget, 'scatter',  nbp_glo, index_g)
+       !
+       var_name= 'veget_max'
+       CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, veget_max, 'scatter',  nbp_glo, index_g)
+       !
+       var_name= 'lai'
+       CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, lai, 'scatter',  nbp_glo, index_g)
+       !
+       var_name= 'frac_nobio'
+       CALL restput_p (rest_id, var_name, nbp_glo, nnobio, 1, kjit, frac_nobio, 'scatter',  nbp_glo, index_g)
+
+       IF ( control%ok_sechiba ) THEN
+
+          var_name= 'soiltile_frac'
+          CALL restput_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, soiltile, 'scatter',  nbp_glo, index_g)
+          !
+          var_name= 'njsc'
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, REAL(njsc, r_std), 'scatter',  nbp_glo, index_g)
+
+          IF ( control%hydrol_cwrr ) THEN
+             var_name= 'reinf_slope'
+             CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, reinf_slope, 'scatter',  nbp_glo, index_g)
+          END IF
+
+       END IF !( control%ok_sechiba )
+
+       var_name= 'clay_frac'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, clayfraction, 'scatter',  nbp_glo, index_g)
+       var_name= 'bulk_dens'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, bulk_density, 'scatter',  nbp_glo, index_g)
+       var_name= 'soil_ph'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, soil_ph, 'scatter',  nbp_glo, index_g)
+       !
+       ! The height of the vegetation could in principle be recalculated at the beginning of the run.
+       ! However, this is very tedious, as many special cases have to be taken into account. This variable
+       ! is therefore saved in the restart file.
+       var_name= 'height'
+       CALL restput_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, height, 'scatter',  nbp_glo, index_g)
+       !
+       ! Specific case where the LAI is read and not calculated by STOMATE: need to be saved
+       IF (read_lai) THEN     
+          var_name= 'laimap'
+          CALL restput_p (rest_id, var_name, nbp_glo, nvm, 12, kjit, laimap)
+       ENDIF
+       !
+       ! If there is some land use change, write the year for the land use ??? 
+       IF (land_use) THEN
+          tmp_day(1) = REAL(veget_year,r_std)
+          var_name='veget_year'
+          IF (is_root_prc) CALL restput (rest_id, var_name, 1 , 1  , 1, kjit, tmp_day)
+       ENDIF
+       
+       ! 2.2 call STOMATE to write specific variables managed by STOMATE in the RESTART files 
+       ! when Stomate is used or when the "watchout"?? diagnostics are requested 
+       IF ( control%stomate_watchout .OR. control%ok_stomate ) THEN
+          CALL stomate_main (kjit, kjpij, kjpindex, dtradia, dt_slow, &
+               ldrestart_read, ldrestart_write, ldforcing_write, ldcarbon_write, &
+               IndexLand, lalo, neighbours, resolution, contfrac, totfrac_nobio, clayfraction, &
+               t2m, t2m_min, temp_sol, stempdiag, &
+               humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+               deadleaf_cover, &
+               assim_param, &
+               lai, frac_age, height, veget, veget_max, &
+               veget_nextyear, totfrac_nobio_nextyear, &
+               hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+               co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth,soil_mc,soiltile, &
+               litter_mc,floodout, runoff, drainage,wat_flux0, wat_flux, &
+               bulk_density, soil_ph, drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, &
+               DOC_to_topsoil, DOC_to_subsoil)
+       ENDIF
+
+       RETURN
+
+    ENDIF
+
+
+    ! 3 Compute and update all variables linked to the date and time
+    !   counter for the call of STOMATE
+    !
+    ! 3.1 update day counter
+    day_counter = day_counter + dtradia
+    IF (check) WRITE(numout,*) "slowproc: day_counter 3",day_counter
+
+    ! 3.2 Check if we are turning from one day to the next day 
+    !     Assert all slow processes (days and years)
+    IF ( sec_old >= one_day - dtradia .AND.  sec >= zero ) THEN
+
+       ! 3.2.1 reset daily counter
+       day_counter = zero
+       IF (check) WRITE(numout,*) "slowproc: day_counter 2",day_counter
+
+       ! 3.2.2 Activate slow processes
+       do_slow = .TRUE.
+
+       ! 3.2.3 Count the number of days 
+       date = date + nint(dt_days)
+       IF (check) WRITE(numout,*) "New date : ",date, 'year_length ',year_length,kjit
+
+       ! 3.2.4 Calculate if we have just turned into a new year
+       !       Note that: EndOfYear must be true once per year
+       !       during a call of stomate_season ??
+       IF ( month == 1 .AND. day == 1 .AND. sec .LT. dtradia ) THEN
+          EndOfYear = .TRUE.
+       ELSE
+          EndOfYear = .FALSE.
+       ENDIF
+    
+    ! 3.3 We are not a new day so that slow processes in STOMATE will
+    ! not be done (but why end of year set to false ???)
+    ELSE
+       do_slow = .FALSE.
+       EndOfYear = .FALSE.
+    ENDIF
+
+    ! 3.4 Reset old time counter to the new value
+    sec_old = sec
+
+    IF ( EndOfYear ) THEN
+       WRITE(numout,*)  'slowproc: EndOfYear is activated.'
+    ENDIF
+
+    ! 4 Define the Land USE and update the vegetation for the next year
+    !   This is done only every "veget_update" years (veget_update correspond
+    !   to a number of years between each vegetation updates)
+    land_use_updated=.FALSE.
+    IF ( (land_use) .AND. (veget_update .GT. 0) ) THEN
+
+       ! Check if we are effectively at the end of the year 
+       IF ( EndOfYear ) THEN
+          !
+          veget_year = veget_year + 1
+
+          ! Update of the vegetation cover with Land Use only if 
+          ! the current year match the requested condition (a multiple of
+          ! "veget_update")
+          IF ( MOD(veget_year - veget_year_orig, veget_update) == 0 ) THEN
+          
+             WRITE(numout,*)  'We are updating land use veget for year =' , veget_year
+             
+             ! Call the routine to update the vegetation (output is veget_nextyear)
+             CALL slowproc_update(kjpindex, lalo, neighbours, resolution, contfrac, &
+               &               veget_max, frac_nobio, veget_nextyear, frac_nobio_nextyear, veget_year)
+            
+             DO j = 1, nnobio
+                totfrac_nobio_nextyear(:) = totfrac_nobio_nextyear(:) + frac_nobio_nextyear(:,j)
+             ENDDO
+             land_use_updated=.TRUE.
+             !
+          ENDIF
+          !
+       ENDIF
+    ENDIF 
+    IF (EndOfYear .AND. .NOT. land_use_updated) THEN
+       lcchange=.FALSE.
+    ENDIF
+
+    ! 5 call STOMATE, either because we want to keep track of
+    !   long-term variables (WATCHOUT case) or just because STOMATE is
+    !   activated
+    IF ( control%stomate_watchout .OR. control%ok_stomate ) THEN
+
+       ! 5.1 call stomate main routine that will call all c-cycle routines       !
+       CALL stomate_main (kjit, kjpij, kjpindex, dtradia, dt_slow, &
+            ldrestart_read, ldrestart_write, ldforcing_write, ldcarbon_write, &
+            IndexLand, lalo, neighbours, resolution, contfrac, totfrac_nobio, clayfraction, &
+            t2m, t2m_min, temp_sol, stempdiag, &
+            humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+            deadleaf_cover, &
+            assim_param, &
+            lai, frac_age, height, veget, veget_max, &
+            veget_nextyear, totfrac_nobio_nextyear, &
+            hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+            co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth,soil_mc,soiltile,&
+            litter_mc,floodout, runoff, drainage,wat_flux0, wat_flux, &
+            bulk_density, soil_ph, drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, &
+            DOC_to_topsoil, DOC_to_subsoil)
+
+       ! 5.2 output the respiration terms and the net primary
+       !     production (NPP) that are calculated in STOMATE
+       IF ( control%ok_stomate .AND. control%ok_sechiba ) THEN
+
+          ! 5.2.1 Output the 3 respiration terms
+          CALL histwrite_p(hist_id, 'maint_resp', kjit, resp_maint, kjpindex*nvm, indexveg)
+          CALL histwrite_p(hist_id, 'hetero_resp', kjit, resp_hetero, kjpindex, indexveg)
+          CALL histwrite_p(hist_id, 'growth_resp', kjit, resp_growth, kjpindex*nvm, indexveg)
+
+          ! 5.2.2 Compute the net primary production as the diff from
+          ! Gross primary productin and the growth and maintenance
+          ! respirations (WHY making separate case for index 1 (bare
+          ! soil) ?)
+          npp(:,1)=zero
+          DO j = 2,nvm
+             npp(:,j) = gpp(:,j) - resp_growth(:,j) - resp_maint(:,j)
+          ENDDO
+          CALL histwrite_p(hist_id, 'npp', kjit, npp, kjpindex*nvm, indexveg)
+       ENDIF
+
+       IF ( hist2_id > 0 ) THEN
+          IF ( control%ok_stomate ) THEN
+             CALL histwrite_p(hist2_id, 'maint_resp', kjit, resp_maint, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'hetero_resp', kjit, resp_hetero, kjpindex, indexveg)
+             CALL histwrite_p(hist2_id, 'growth_resp', kjit, resp_growth, kjpindex*nvm, indexveg)
+             CALL histwrite_p(hist2_id, 'npp', kjit, npp, kjpindex*nvm, indexveg)
+          ENDIF
+       ENDIF
+    ENDIF
+
+    ! 6 STOMATE is not activated: we have to compute the LAI  
+    !   and possibly update the vegetation fraction if there was
+    !   updated land use 
+    IF ( .NOT. control%ok_stomate ) THEN
+
+       IF (land_use_updated) THEN
+          veget_max(:,:)=veget_nextyear(:,:)
+          frac_nobio(:,:)=frac_nobio_nextyear(:,:)
+       ENDIF
+
+       IF ( do_slow ) THEN
+          !
+          ! 2.2.1 do daily processes if necessary
+          !
+          IF (long_print) WRITE (numout,*) 'slowproc_main : We update the daily variables'
+
+          ! 6.1.1 Updates the LAI each dt_slow (day)
+          CALL slowproc_lai (kjpindex, lcanop,stempdiag, &
+               lalo,resolution,lai,month,day,read_lai,laimap)
+
+          frac_age(:,:,1) = un
+          frac_age(:,:,2) = zero
+          frac_age(:,:,3) = zero
+          frac_age(:,:,4) = zero
+       ENDIF
+
+       ! 6.3 Define the CO2 flux from the grid point to zero (no carbone cycle)
+       co2_flux(:) = zero
+
+    ELSE IF (land_use_updated) THEN
+       !
+       frac_nobio(:,:)=frac_nobio_nextyear(:,:)
+       !
+    ENDIF
+
+    !
+    ! 2.4 do daily processes if necessary
+    !
+    IF ( do_slow .OR. land_use_updated ) THEN
+       !
+       ! 2.4.1 updates veget
+       CALL slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile)
+       
+       ! 2.4.2 updates qsintmax and other derived variables
+       IF ( .NOT. control%ok_stomate ) THEN
+          CALL slowproc_derivvar (kjpindex, veget, lai, &
+               qsintmax, deadleaf_cover, assim_param, height)
+       ELSE
+          qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
+          qsintmax(:,1) = zero
+       ENDIF
+       !
+    END IF
+
+    !
+    ! Do some basic tests on the surface fractions updated above
+    !
+    CALL slowproc_checkveget(kjpindex, frac_nobio, veget_max, veget, soiltile)
+
+    IF ( control%ok_sechiba ) THEN
+       IF ( .NOT. almaoutput) THEN
+          CALL histwrite_p(hist_id, 'tot_bare_soil', kjit, tot_bare_soil, kjpindex, IndexLand)
+          CALL histwrite_p(hist_id, 'frac_bare', kjit, frac_bare, kjpindex*nvm, indexveg)
+       ENDIF
+    END IF
+
+    IF (long_print) WRITE (numout,*) ' slowproc_main done '
+
+  END SUBROUTINE slowproc_main
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_init
+!!
+!>\BRIEF         Initialisation of all variables linked to SLOWPROC
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): The subroutine manages 
+!! diverses tasks:
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lcanop, ::veget_update, ::veget_year,
+!! ::lai, ::veget, ::frac_nobio, ::totfrac_nobio, ::veget_max, ::height, ::soiltype
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+SUBROUTINE slowproc_init (kjit, ldrestart_read, dtradia, date0, kjpindex, IndexLand, lalo, neighbours, resolution, contfrac, &
+       & rest_id, read_lai, lai, frac_age, veget, frac_nobio, totfrac_nobio, soiltile, reinf_slope, veget_max, njsc, &
+       & height, lcanop, veget_update, veget_year)
+
+  !! INTERFACE DESCRIPTION
+
+  !! 0. Parameters values
+  LOGICAL, PARAMETER                                    :: check = .FALSE.!! Flag to check what???
+
+  !! 0.1 input variables and scalar
+  INTEGER(i_std), INTENT (in)                           :: kjit           !! Time step number
+  LOGICAL, INTENT (in)                                  :: ldrestart_read !! Logical for _restart_ file to read
+  REAL(r_std),INTENT (in)                               :: dtradia        !! Time step for SECHIBA (fast processes)
+  REAL(r_std), INTENT (in)                              :: date0          !! intial date of the simulation ???
+  INTEGER(i_std), INTENT (in)                           :: kjpindex       !! Domain size - Terrestrial pixels only 
+  INTEGER(i_std), INTENT (in)                           :: rest_id        !! Restart file identifier
+
+  INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: IndexLand      !! Indices of the land points on the map
+  REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)       :: lalo           !! Geogr. coordinates (latitude,longitude) (degrees)
+  INTEGER(i_std), DIMENSION (kjpindex,8), INTENT(in)    :: neighbours     !! Vector of neighbours for each grid point 1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) 
+  REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)       :: resolution     !! size in x and y of the grid (m)
+  REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: contfrac       !! Fraction of continent in the grid (unitless)
+  LOGICAL, INTENT(in)                                   :: read_lai       !! Flag related to the read of laimap 
+
+  !! 0.2 output variables and scalar
+  INTEGER(i_std), INTENT(out)                           :: lcanop         !! Number of Canopy level used to compute LAI
+  INTEGER(i_std), INTENT(out)                           :: veget_update   !! update frequency in timesteps (years or days ??) for landuse
+  INTEGER(i_std), INTENT(out)                           :: veget_year     !! first year for landuse   (year or index ???)
+
+  REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: lai            !! Leaf Area index (m^2 / m^2)
+  REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: veget          !! Fraction of vegetation type (unitless)
+  REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: frac_nobio     !! Fraction of ice,lakes,cities, ... (unitless)
+  REAL(r_std),DIMENSION (kjpindex), INTENT (out)        :: totfrac_nobio  !! Total fraction of ice+lakes+cities+... (unitless)
+  REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: veget_max      !! Max fraction of vegetation type (unitless)
+  REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)    :: height         !! Height of vegetation or surface in genral ??? (m)
+  REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT (out):: frac_age !! Age efficacity from STOMATE for isoprene
+  REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)   :: soiltile       !! Fraction of each soil tile (0-1, unitless)
+  REAL(r_std), DIMENSION (kjpindex), INTENT(out)        :: reinf_slope    !! slope coef for reinfiltration
+  INTEGER(i_std), DIMENSION(kjpindex), INTENT(out)      :: njsc           !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
+    
+  !! 0.4 local scalar and variables 
+  REAL(r_std)                                           :: tmp_day(1)        !! temporary variable 
+  REAL(r_std)                                           :: tmp_veget_year(1) !! temporary variable
+  REAL(r_std)                                           :: zcanop            !! ???? soil depth taken for canopy
+  INTEGER(i_std)                                        :: vtmp(1)           !! temporary variable
+  REAL(r_std), DIMENSION(nbdl)                          :: zsoil             !! soil depths at diagnostic levels
+  INTEGER(i_std)                                        :: j,l               !! Indices
+  CHARACTER(LEN=80)                                     :: var_name          !! To store variables names for I/O
+  INTEGER(i_std)                                        :: ji, jv, ier       !! Indices 
+  LOGICAL                                               :: get_slope
+  REAL(r_std)                                           :: frac_nobio1       !! temporary variable for frac_nobio(see above)
+  REAL(r_std), DIMENSION(kjpindex)                      :: tmp_real
+  REAL(r_std), DIMENSION(kjpindex,nbdl)                 :: stempdiag2_bid    !! matrix to store stempdiag_bid
+  REAL(r_std), DIMENSION (kjpindex,nscm)                :: soilclass         !! Fractions of each soil textural class in the grid cell (0-1, unitless)
+  CHARACTER(LEN=4)                                      :: vegsoil_dist      !! Flag to choose the soil/vegetation distribution
+  !
+  CHARACTER(LEN=30), SAVE                               :: veget_str         !! update frequency for landuse
+!$OMP THREADPRIVATE(veget_str)
+  REAL(r_std),DIMENSION (nbp_glo,nnobio)                :: frac_nobio_g      !! Fraction of ice, lakes, cities etc. in the mesh (global)
+  REAL(r_std),DIMENSION (nbp_glo,nvm)                   :: veget_max_g       !! Fraction of vegetation type at global scale
+  REAL(r_std), DIMENSION(kjpindex)                      :: frac_crop_tot     !! Total fraction occupied by crops (0-1, unitless)
+  
+!_ ================================================================================================================================
+
+    ! 1 Allocation and initialisation of the different arrays: clayfraction, veget_nextyear,
+    !   frac_nobio_nextyear
+    !
+    IF (long_print) WRITE (numout,*) "In slowproc_init"
+
+    ALLOCATE (clayfraction(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in clayfraction allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'slowproc_init'
+    END IF
+    !? why there is a specific undef for sechiba ?
+    clayfraction(:)=undef_sechiba
+
+    ALLOCATE (bulk_density(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in bulk_density allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'slowproc_init'
+    END IF
+    !? why there is a specific undef for sechiba ?
+    bulk_density(:)=undef_sechiba
+
+    ALLOCATE (soil_ph(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in soil_ph allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'slowproc_init'
+    END IF
+    !? why there is a specific undef for sechiba ?
+    soil_ph(:)=undef_sechiba
+
+
+    ! Initialisation of the fraction of the different vegetation: Start with 100% of bare soil
+    !? (RISKY to have bare soil index fixed to 1)
+    ALLOCATE (soilclass_default(nscm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in indexveg allocation. We stop. We need nstm words = ',nscm
+       STOP 'hydrol_init'
+    END IF
+    soilclass_default(:)=undef_sechiba
+    !
+    veget_max(:,1) = un
+    veget_max(:,2:nvm) = zero
+    frac_nobio(:,:) = zero
+    totfrac_nobio(:) = zero
+
+    ! Allocation of next year vegetation fraction in case of land use change
+    ier=-1
+    ALLOCATE(veget_nextyear(kjpindex, nvm), STAT=ier)
+    IF (ier/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of veget_nextyear : ",ier
+      STOP 
+    ENDIF
+    veget_nextyear(:,1) = un
+    veget_nextyear(:,2:nvm) = zero
+
+    ! Allocation of the fraction of non biospheric areas 
+    ier=-1
+    ALLOCATE(frac_nobio_nextyear(kjpindex, nnobio), STAT=ier)
+    IF (ier/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of frac_nobio_nextyear : ",ier
+      STOP 
+    ENDIF
+    frac_nobio_nextyear(:,:) = zero
+    
+    ier=-1
+    ALLOCATE(totfrac_nobio_nextyear(kjpindex), STAT=ier)
+    IF (ier/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of totfrac_nobio_nextyear : ",ier
+      STOP 
+    ENDIF
+    !
+    ALLOCATE (tot_bare_soil(kjpindex),STAT=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tot_bare_soil allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP
+    END IF
+    !
+    ALLOCATE (frac_bare(kjpindex,nvm),STAT=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in frac_bare allocation. We stop. We need kjpindex*nvm words = ',kjpindex*nvm
+       STOP
+    END IF
+
+    IF (long_print) WRITE (numout,*) 'slowproc_init : End of allocations'
+
+    !? Danger: it should be rather divided by nnobio if nnobio >1 
+!MM must be corrected when nnobio > 1 !!
+    totfrac_nobio_nextyear(:) = nnobio*un
+
+    ! 2 read the day counter from the restart file: 
+    ! val_exp is a default value to test if the variable exist in the restart file
+    ! tmp_day is the current value of day_counter from the restart file: only readed
+    ! by the main processor (parallelisation)
+    ! Day_counter is set to zero if we are at the first time step of the simulation    
+    !?? BUT DAY_counter is not used anymore: we should remove this variable
+    var_name= 'day_counter'
+    CALL ioconf_setatt_p('UNITS', 'd')
+    CALL ioconf_setatt_p('LONG_NAME','Fraction of computed day')
+    IF (is_root_prc) THEN
+       CALL restget (rest_id, var_name, 1 , 1  , 1, kjit, .TRUE., tmp_day)
+       IF (tmp_day(1) == val_exp) THEN
+          day_counter = zero
+       ELSE
+          day_counter = tmp_day(1)
+       ENDIF
+    ENDIF
+    ! specific for parallelisation (synchronize day_counter)
+    CALL bcast(day_counter)
+
+    IF (long_print) WRITE (numout,*) 'slowproc_init : End of allocationsGot restart file set'
+
+    ! get restart value if none were found in the restart file
+    !
+
+    !Config Key   = SECHIBA_DAY
+    !Config Desc  = Time within the day simulated
+    !Config if    = OK_SECHIBA
+    !Config Def   = 0.0
+    !Config Help  = This is the time spent simulating the current day. This variable is
+    !Config         prognostic as it will trigger all the computations which are
+    !Config         only done once a day.
+    !Config Units = [days]
+    !
+    CALL setvar_p (day_counter, val_exp, 'SECHIBA_DAY', zero)
+
+!!$    var_name= 'veget'
+!!$    CALL ioconf_setatt_p('UNITS', '-')
+!!$    CALL ioconf_setatt_p('LONG_NAME','Vegetation fraction')
+!!$    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., veget, "gather", nbp_glo, index_g)
+    !
+    var_name= 'veget_max'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Maximum vegetation fraction')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., veget_max, "gather", nbp_glo, index_g)
+   
+    ! Get frac_nobio from the restart file 
+    frac_nobio(:,:) = val_exp
+    var_name= 'frac_nobio'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Special soil type fraction')
+    CALL restget_p (rest_id, var_name, nbp_glo, nnobio, 1, kjit, .TRUE., frac_nobio, "gather", nbp_glo, index_g)
+
+    veget_update=0
+
+    !
+    ! control%do_land_use is not activate if land use map won't be updated
+    control%do_land_use = .FALSE.
+    !
+    IF (land_use) THEN
+       !
+       var_name= 'veget_year'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Last year get in Land Use file.')
+       IF (is_root_prc) THEN
+          CALL restget (rest_id, var_name, 1       , 1  , 1, kjit, .TRUE., tmp_veget_year)
+          !
+          IF (tmp_veget_year(1) == val_exp) THEN
+             veget_year=veget_year_orig
+          ELSE
+             IF (veget_reinit) THEN
+                veget_year=veget_year_orig
+             ELSE
+                veget_year=INT(tmp_veget_year(1))
+             ENDIF
+          ENDIF
+       ENDIF
+       CALL bcast(veget_year)
+
+       !
+       !Config Key   = VEGET_UPDATE
+       !Config Desc  = Update vegetation frequency
+       !Config If    = LAND_USE
+       !Config Def   = 0Y
+       !Config Help  = The veget datas will be update each this time step.
+       !Config Units = [years]
+       !
+       veget_update=0
+       WRITE(veget_str,'(a)') '0Y'
+     !?? danger : VEGET_UPDATE now called VEGET_LENGTH in Thomas L. run.def ??!!  
+       CALL getin_p('VEGET_UPDATE', veget_str)
+       !
+       !
+       l=INDEX(TRIM(veget_str),'Y')
+       READ(veget_str(1:(l-1)),"(I2.2)") veget_update
+       WRITE(numout,*) "Update frequency for land use in years :",veget_update
+       !
+       ! control%do_land_use is activated if update frequency is not zero.
+       IF ( veget_update > 0 ) THEN
+          control%do_land_use = .TRUE.
+       ENDIF
+
+       IF ( veget_update == 0 .AND. lcchange ) THEN
+          CALL ipslerr_p (2,'slowproc_init', &
+             &     'You have asked for LAND_COVER_CHANGE activated with VEGET_UPDATE = 0Y.',&
+             &     'We can''t use this land cover change model if veget is not updated.', &
+             &     'We have disabled it.')
+          lcchange=.FALSE.
+       ENDIF
+
+    ENDIF
+    !
+    IF (long_print) WRITE (numout,*) 'slowproc_init : End of Land_Use configuration'
+
+    IF ( control%ok_sechiba ) THEN
+       
+       var_name= 'soiltile_frac'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Fraction of each soil type')
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., soiltile, "gather", nbp_glo, index_g)
+
+       ! Test if the soiltile_frac was in restartfile. If not, try the old name 'soiltype_frac'.
+       IF ( ALL(soiltile(:,:) == val_exp ) ) THEN
+          WRITE(numout,*) 'The variable soiltile_frac was not in restart file. Try to read old variable name soiltype_frac instead.'
+          var_name= 'soiltype_frac'
+          CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., soiltile, "gather", nbp_glo, index_g)
+       END IF
+
+       IF ( control%hydrol_cwrr ) THEN
+          var_name= 'reinf_slope'
+          CALL ioconf_setatt_p('UNITS', '-')
+          CALL ioconf_setatt_p('LONG_NAME','Slope coef for reinfiltration')
+          CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., reinf_slope, "gather", nbp_glo, index_g)
+       END IF
+       var_name= 'njsc'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Index of soil type')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tmp_real, "gather", nbp_glo, index_g)
+       WHERE ( tmp_real .LT. val_exp )
+          njsc = NINT(tmp_real)
+       ENDWHERE
+       
+    END IF !( control%ok_sechiba ) 
+    !
+    var_name= 'clay_frac'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Fraction of clay in each mesh')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., clayfraction, "gather", nbp_glo, index_g)
+    !
+    var_name= 'bulk_dens'
+    CALL ioconf_setatt_p('UNITS', 'kg m-3')
+    CALL ioconf_setatt_p('LONG_NAME','soil bulk density in each mesh')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., bulk_density, "gather", nbp_glo, index_g)
+    !
+    var_name= 'soil_ph'
+    CALL ioconf_setatt_p('UNITS', 'pH units')
+    CALL ioconf_setatt_p('LONG_NAME','soil pH in each mesh')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., soil_ph, "gather", nbp_glo, index_g)
+    !
+    IF (long_print) WRITE (numout,*) 'slowproc_init : End CWRR configuration'
+    !
+    var_name= 'lai'
+    CALL ioconf_setatt_p('UNITS', '-')
+    CALL ioconf_setatt_p('LONG_NAME','Leaf area index')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., lai, "gather", nbp_glo, index_g)
+    !
+    ! The height of the vegetation could in principle be recalculated at the beginning of the run.
+    ! However, this is very tedious, as many special cases have to be taken into account. This variable
+    ! is therefore saved in the restart file.
+    var_name= 'height'
+    CALL ioconf_setatt_p('UNITS', 'm')
+    CALL ioconf_setatt_p('LONG_NAME','Height of vegetation')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., height, "gather", nbp_glo, index_g)
+    
+    !
+    IF (read_lai)THEN
+       !
+       ALLOCATE (laimap(kjpindex,nvm,12),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in laimap allocation. We stop. We need kjpindex*nvm*12 words = ',kjpindex*nvm*12
+          STOP 'slowproc_init'
+       END IF
+       laimap(:,:,:) = val_exp
+       !
+       var_name= 'laimap'
+       CALL ioconf_setatt_p('UNITS', '-')
+       CALL ioconf_setatt_p('LONG_NAME','Leaf area index read')
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 12, kjit, .TRUE., laimap)
+       !
+    ELSE
+       !
+       ALLOCATE (laimap(1,1,1))
+    ENDIF
+    !
+    !Config Key   = SECHIBA_ZCANOP
+    !Config Desc  = Soil level used for canopy development (if STOMATE disactivated)
+    !Config If    = OK_SECHIBA and .NOT. OK_STOMATE  
+    !Config Def   = 0.5
+    !Config Help  = The temperature at this soil depth is used to determine the LAI when
+    !Config         STOMATE is not activated.
+    !Config Units = [m]
+    !
+    zcanop = 0.5_r_std
+    CALL setvar_p (zcanop, val_exp, 'SECHIBA_ZCANOP', 0.5_r_std)
+    !
+    ! depth at center of the levels
+    zsoil(1) = diaglev(1) / 2.
+    DO l = 2, nbdl
+       zsoil(l) = ( diaglev(l) + diaglev(l-1) ) / 2.
+    ENDDO
+
+    ! index of this level
+    vtmp = MINLOC ( ABS ( zcanop - zsoil(:) ) )
+    lcanop = vtmp(1)
+
+    !
+    !  Interception reservoir coefficient
+    !
+    !Config Key   = SECHIBA_QSINT 
+    !Config Desc  = Interception reservoir coefficient
+    !Config If    = OK_SECHIBA 
+    !Config Def   = 0.1
+    !Config Help  = Transforms leaf area index into size of interception reservoir
+    !Config         for slowproc_derivvar or stomate
+    !Config Units = [m]
+    CALL getin_p('SECHIBA_QSINT', qsintcst)
+    WRITE(numout, *)' SECHIBA_QSINT, qsintcst = ', qsintcst
+
+    !
+    ! Time step of STOMATE and LAI update
+    !
+    !Config Key   = DT_SLOW
+    !Config Desc  = Time step of STOMATE and other slow processes
+    !Config If    = OK_STOMATE
+    !Config Def   = one_day
+    !Config Help  = Time step (s) of regular update of vegetation
+    !Config         cover, LAI etc. This is also the time step
+    !Config         of STOMATE.
+    !Config Units = [seconds]
+
+    dt_slow = one_day
+    CALL getin_p('DT_SLOW', dt_slow)
+
+    !
+    ! get restart value if none were found in the restart file
+    !
+    !
+    IF ( impveg ) THEN
+       !
+       !  We are on a point and thus we can read the information from the run.def
+       !
+       !
+       !Config Key   = SECHIBA_VEGMAX
+       !Config Desc  = Maximum vegetation distribution within the mesh (0-dim mode)
+       !Config If    = IMPOSE_VEG
+       !Config Def   = 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0
+       !Config Help  = The fraction of vegetation is read from the restart file. If
+       !Config         it is not found there we will use the values provided here.
+       !Config Units = [-]
+       !
+       CALL setvar_p (veget_max, val_exp, 'SECHIBA_VEGMAX', veget_ori_fixed_test_1)
+       IF (SUM(veget_ori_fixed_test_1) > un) THEN
+          CALL ipslerr_p (2,'slowproc_init', &
+             &     'The sum of the fractions of the array SECHIBA_VEGMAX is greater than 1.', &
+             &     'The sum should be equal to 1.', &
+             &     'Check your configuration file.')
+       ENDIF
+
+       !
+       !Config Key   = SECHIBA_FRAC_NOBIO
+       !Config Desc  = Fraction of other surface types within the mesh (0-dim mode)
+       !Config If    = IMPOSE_VEG
+       !Config Def   = 0.0
+       !Config Help  = The fraction of ice, lakes, etc. is read from the restart file. If
+       !Config         it is not found there we will use the values provided here.
+       !Config         For the moment, there is only ice.
+       !Config Units = [-]
+       !
+     !?? problem with frac_nobio : everything intialized as if every frac_nobio point is 
+        ! covered with ice sheets (continental ice) 
+     !?? direct calculation possible from vegetmax not possible ?
+       ! laisser ca tant qu'il n'y a que la glace. Pb avec setvar?
+       frac_nobio1 = frac_nobio(1,1)
+       CALL setvar_p (frac_nobio1, val_exp, 'SECHIBA_FRAC_NOBIO', frac_nobio_fixed_test_1)
+       frac_nobio(:,:) = frac_nobio1
+       ! CALL setvar (frac_nobio, val_exp, 'SECHIBA_FRAC_NOBIO', frac_nobio_fixed_test_1)
+
+       !
+       !Config Key   = SECHIBA_LAI
+       !Config Desc  = LAI for all vegetation types (0-dim mode)
+       !Config Def   = 0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2.
+       !Config If    = IMPOSE_VEG
+       !Config Help  = The maximum LAI used in the 0dim mode. The values should be found
+       !Config         in the restart file. The new values of LAI will be computed anyway
+       !Config         at the end of the current day. The need for this variable is caused
+       !Config         by the fact that the model may stop during a day and thus we have not
+       !Config         yet been through the routines which compute the new surface conditions.
+       !Config Units = [-]
+       !
+       CALL setvar_p (lai, val_exp, 'SECHIBA_LAI', llaimax)
+
+       IF (impsoilt) THEN
+
+          ! If njsc is not in restart file, then initialize soilclass from values 
+          ! from run.def file and recalculate njsc
+          IF ( ALL(njsc(:) .EQ. undef_int )) THEN
+             !Config Key   = SOIL_FRACTIONS
+             !Config Desc  = Fraction of the 3 soil types (0-dim mode)
+             !Config Def   = undef_sechiba
+             !Config If    = IMPOSE_VEG and IMPOSE_SOILT
+             !Config Help  = Determines the fraction for the 3 soil types
+             !Config         in the mesh in the following order : sand loam and clay.
+             !Config Units = [-]
+          
+             soilclass(1,:) = soilclass_default(:)
+             CALL getin_p('SOIL_FRACTIONS',soilclass(1,:))
+             DO ji=2,kjpindex
+                soilclass(ji,:) = soilclass(1,:)
+             ENDDO
+
+             njsc(:) = 0
+             DO ji = 1, kjpindex
+                njsc(ji) = MAXLOC(soilclass(ji,:),1)
+             ENDDO
+          END IF
+
+          !Config Key   = CLAY_FRACTION
+          !Config Desc  = Fraction of the clay fraction (0-dim mode)
+          !Config Def   = 0.2
+          !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+          !Config Help  = Determines the fraction of clay in the grid box.
+          !Config Units = [-] 
+          !
+          CALL setvar_p (clayfraction, val_exp, 'CLAY_FRACTION', clayfraction_default)
+
+
+          !Config Key   = SOIL_PH
+          !Config Desc  = pH of the soil (0-dim mode)
+          !Config Def   = 7.0
+          !Config If    = IMPOSE_VEG and IMPOSE_SOIL
+          !Config Help  = Determines the soil pH in the grid box.
+          !Config Units = [pH units] 
+          !
+          CALL setvar_p (soil_ph, val_exp, 'soil_ph', soil_ph_default)
+
+          !
+          !Config Key   = BULK_DENSITY
+          !Config Desc  = value of the soil bulk density 
+          !Config if    = IMPOSE_VEG and IMPOSE_SOIL
+          !Config Def   = 1.65
+          !Config Help  =
+          CALL setvar_p (bulk_density, val_exp, 'BULK_DENSITY', bulk_density_default)
+
+       ELSE
+
+          IF ( MINVAL(clayfraction) .EQ. MAXVAL(clayfraction) .AND. MAXVAL(clayfraction) .EQ. val_exp .OR. &
+               MINVAL(soil_ph) .EQ. MAXVAL(soil_ph) .AND. MAXVAL(soil_ph) .EQ. val_exp .OR. &
+               MINVAL(njsc) .EQ. MAXVAL(njsc) .AND. MAXVAL(njsc) .EQ. undef_int ) THEN
+             
+             CALL slowproc_soilt(kjpindex, lalo, neighbours, resolution, contfrac, soilclass, clayfraction, bulk_density, soil_ph)
+             njsc(:) = 0
+             DO ji = 1, kjpindex
+                njsc(ji) = MAXLOC(soilclass(ji,:),1)
+             ENDDO
+          ENDIF
+       ENDIF
+
+       !Config Key   = REINF_SLOPE
+       !Config Desc  = Slope coef for reinfiltration 
+       !Config Def   = 0.1
+       !Config If    = IMPOSE_VEG
+       !Config Help  = Determines the reinfiltration ratio in the grid box due to flat areas
+       !Config Units = [-]
+       !
+       slope_default=0.1
+       CALL setvar_p (reinf_slope, val_exp, 'SLOPE', slope_default)
+
+       !Config Key   = SLOWPROC_HEIGHT
+       !Config Desc  = Height for all vegetation types 
+       !Config Def   = 0., 30., 30., 20., 20., 20., 15., 15., 15., .5, .6, 1.0, 1.0
+       !Config If    = OK_SECHIBA
+       !Config Help  = The height used in the 0dim mode. The values should be found
+       !Config         in the restart file. The new values of height will be computed anyway
+       !Config         at the end of the current day. The need for this variable is caused
+       !Config         by the fact that the model may stop during a day and thus we have not
+       !Config         yet been through the routines which compute the new surface conditions.
+       !Config Units = [m]
+       !
+       CALL setvar_p (height, val_exp, 'SLOWPROC_HEIGHT', height_presc)
+
+    ELSE
+       !
+       !  We are in the full 2-D case thus we need to do the interpolation if the potential vegetation
+       !  is not available
+       !
+       IF ( ALL( veget_max(:,:) .EQ. val_exp ) .OR. ALL( frac_nobio(:,:) .EQ. val_exp ) ) THEN
+
+          IF ( .NOT. land_use ) THEN
+
+             ! The interpolation of vegetation has changed.
+             IF (is_root_prc) THEN
+                IF ( .NOT. old_veget ) THEN
+                   ! NEW slowproc interpol :
+                   CALL slowproc_interpol_g(nbp_glo, lalo_g, neighbours_g, resolution_g, contfrac_g, veget_max_g, frac_nobio_g)
+                ELSE
+                   ! OLD slowproc interpol :
+                   CALL slowproc_interpol_g(nbp_glo, lalo_g, neighbours_g, resolution_g, veget_max_g, frac_nobio_g)
+                ENDIF
+             ENDIF
+             CALL scatter(veget_max_g,veget_max)
+             CALL scatter(frac_nobio_g, frac_nobio)
+             !
+             IF ( control%ok_dgvm ) THEN
+                !
+                ! If we are dealing with dynamic vegetation then all
+                ! natural PFTs should be set to veget_max = 0
+                !  And in case no agriculture is desired, agriculture PFTS should be
+                ! set to 0 as well
+             
+                IF (agriculture) THEN
+                   DO jv=2,nvm
+                      IF (natural(jv)) THEN 
+                         veget_max(:,jv)=zero
+                      ENDIF
+                   ENDDO
+                   !
+                   ! 1. Here we calculate the fraction of crop for each point
+                   frac_crop_tot(:) = zero
+                   ! 2. we sum only on the indexes corresponding to the non_natural pfts
+                   DO jv = 2,nvm
+                      IF (.NOT. natural(jv)) THEN
+                         DO ji = 1, kjpindex               
+                            frac_crop_tot(ji) = frac_crop_tot(ji) + veget_max(ji,jv)
+                         ENDDO
+                      ENDIF
+                   ENDDO
+                   ! 3. we calculate the fraction of bare soil
+                   DO ji = 1, kjpindex
+                      veget_max(ji,1) = un - frac_crop_tot(ji) - SUM(frac_nobio(ji,:))
+                   ENDDO
+                   !
+                ELSE
+                   veget_max(:,:) = zero
+                   DO ji = 1, kjpindex
+                      veget_max(ji,1) = un  - SUM(frac_nobio(ji,:))
+                   ENDDO
+                ENDIF
+                !
+             ENDIF
+          ELSE
+             WRITE(numout,*)  'We initialize land use veget for year =' , veget_year
+             ! If restart doesn''t contain veget, then it is the first computation
+             CALL slowproc_update(kjpindex, lalo, neighbours, resolution, contfrac, &
+               &               veget_nextyear, frac_nobio_nextyear, veget_max, frac_nobio, veget_year, init=.TRUE.)
+             !
+             IF ( control%ok_dgvm  ) THEN
+                !
+                ! If we are dealing with dynamic vegetation then all
+                ! natural PFTs should be set to veget_max = 0
+                !  And in case no agriculture is desired, agriculture PFTS should be
+                ! set to 0 as well
+                
+                IF (agriculture) THEN
+                   !
+                   DO jv = 2, nvm
+                      IF (natural(jv)) THEN 
+                         veget_max(:,jv)=zero
+                      ENDIF
+                   ENDDO
+                   !
+                   ! 1. Here we calculate the fraction of crop for each point
+                   frac_crop_tot(:) = zero
+                   ! 2. we sum only on the indexes corresponding to the non_natural pfts
+                   DO jv = 2, nvm
+                      IF(.NOT. natural(jv)) THEN
+                         DO ji = 1, kjpindex
+                            frac_crop_tot(ji) = frac_crop_tot(ji) + veget_max(ji,jv)
+                         ENDDO
+                      ENDIF
+                   ENDDO
+                   ! 3. we calculate the fraction of bare soil
+                   DO ji = 1, kjpindex
+                      veget_max(ji,1) = un - frac_crop_tot(ji) - SUM(frac_nobio(ji,:))   
+                   ENDDO
+                   !
+                ELSE
+                   veget_max(:,:) = zero
+                   DO ji = 1, kjpindex
+                      veget_max(ji,1) = un  - SUM(frac_nobio(ji,:))
+                   ENDDO
+                ENDIF
+                !
+             ENDIF
+             !
+          ENDIF
+             !
+       ELSE
+          ! WITH restarts for vegetation and DGVM and NO AGRICULTURE
+          IF ( control%ok_dgvm  ) THEN
+             !
+             ! If we are dealing with dynamic vegetation then all
+             ! natural PFTs should be set to veget_max = 0
+             !  And in case no agriculture is desired, agriculture PFTS should be
+             ! set to 0 as well
+             !
+             IF (.NOT. agriculture) THEN
+                ! 1 .We calculate the total fraction of crops for each point
+                frac_crop_tot(:) = zero
+                DO jv = 2, nvm  
+                   IF ( .NOT. natural (jv))  THEN
+                      DO ji = 1, kjpindex
+                         frac_crop_tot(ji) = frac_crop_tot(ji) + veget_max(ji,jv)
+                      ENDDO
+                   ENDIF
+                ENDDO
+                ! 2. We add to the fraction of bare soil the fraction of crops
+                DO ji = 1, kjpindex
+                   veget_max(ji,1) = veget_max(ji,1) + frac_crop_tot(ji)
+                ENDDO
+                ! 3. We set the fractions of crops to zero
+                DO jv = 2, nvm                  
+                   IF ( .NOT. natural (jv))  THEN
+                      veget_max(:,jv) = zero
+                   ENDIF
+                ENDDO
+                !-
+             ENDIF
+             !
+          ENDIF
+          !
+       ENDIF
+       !
+       !
+
+
+       IF (read_lai) THEN
+
+          !
+          !  In case the LAI map was not found in the restart then we need to recompute it
+          !
+          IF ( ALL( laimap(:,:,:) .EQ. val_exp) ) THEN
+             ! The interpolation of LAI has changed.
+             IF ( .NOT. old_lai ) THEN
+                ! NEW slowproc interlai :
+                CALL slowproc_interlai (kjpindex, lalo, resolution,  neighbours, contfrac, laimap)
+             ELSE
+                ! OLD slowproc interlai :
+                CALL slowproc_interlai(kjpindex, lalo,  resolution, laimap)
+             ENDIF
+             !
+             ! Compute the current LAI just to be sure 
+             !
+             stempdiag2_bid(1:kjpindex,1:nbdl) = stempdiag_bid
+             CALL slowproc_lai (kjpindex, lcanop, stempdiag2_bid, &
+                  lalo,resolution,lai,month,day,read_lai,laimap)
+             !
+             !  Make sure that we redo the computation when we will be back in slowproc_main
+             day_counter = dt_slow - dtradia
+             !
+          ENDIF
+          !
+       ENDIF
+       !
+       IF ( MINVAL(lai) .EQ. MAXVAL(lai) .AND. MAXVAL(lai) .EQ. val_exp) THEN
+          !
+          !  Get a first guess at the LAI
+          !
+          IF ( read_lai ) THEN
+             IF ( ALL( laimap(:,:,:) .EQ. val_exp) ) THEN
+                ! The interpolation of LAI has changed.
+                IF ( .NOT. old_lai ) THEN
+                   ! NEW slowproc interlai :
+                   CALL slowproc_interlai (kjpindex, lalo, resolution,  neighbours, contfrac, laimap)
+                ELSE
+                   ! OLD slowproc interlai :
+                   CALL slowproc_interlai(kjpindex, lalo,  resolution, laimap)
+                ENDIF
+             ENDIF
+          ENDIF
+          !
+          stempdiag2_bid(1:kjpindex,1:nbdl) = stempdiag_bid
+          CALL slowproc_lai (kjpindex, lcanop, stempdiag2_bid, &
+               lalo,resolution,lai,month,day,read_lai,laimap)
+          !
+          ! If we start from scratch, we set lai to zero for consistency with stomate
+          IF ( .NOT. read_lai ) THEN
+             lai(:,:) = zero
+          ENDIF
+          !   
+          frac_age(:,:,1) = un
+          frac_age(:,:,2) = zero
+          frac_age(:,:,3) = zero
+          frac_age(:,:,4) = zero
+
+          ! Make sure that we redo the computation when we will be back in slowproc_main
+          day_counter = dt_slow - dtradia
+
+       ENDIF
+
+       IF ( MINVAL(height) .EQ. MAXVAL(height) .AND. MAXVAL(height) .EQ. val_exp) THEN
+       
+          ! Impose height
+          DO jv = 1, nvm
+             height(:,jv) = height_presc(jv)
+          ENDDO
+
+       ENDIF
+
+       IF ( MINVAL(clayfraction) .EQ. MAXVAL(clayfraction) .AND. MAXVAL(clayfraction) .EQ. val_exp .OR. &
+               MINVAL(bulk_density) .EQ. MAXVAL(bulk_density) .AND. MAXVAL(bulk_density) .EQ. val_exp .OR. &
+               MINVAL(soil_ph) .EQ. MAXVAL(soil_ph) .AND. MAXVAL(soil_ph) .EQ. val_exp .OR. &
+            MINVAL(njsc) .EQ. MAXVAL(njsc) .AND. MAXVAL(njsc) .EQ. undef_int ) THEN
+
+          CALL slowproc_soilt(kjpindex, lalo, neighbours, resolution, contfrac, soilclass, clayfraction, bulk_density, soil_ph)
+
+          njsc(:) = 0
+          DO ji = 1, kjpindex
+             njsc(ji) = MAXLOC(soilclass(ji,:),1)
+          ENDDO
+       ENDIF
+
+
+       !Config Key   = GET_SLOPE
+       !Config Desc  = Read slopes from file and do the interpolation
+       !Config Def   = .FALSE.
+       !Config If    =
+       !Config Help  = Needed for reading the slopesfile and doing the interpolation. This will be
+       !               used by the re-infiltration parametrization
+       !Config Units = [FLAG]
+       get_slope = .FALSE.
+       CALL getin_p('GET_SLOPE',get_slope)
+       
+       IF ( control%hydrol_cwrr ) THEN
+          IF ( MINVAL(reinf_slope) .EQ. MAXVAL(reinf_slope) .AND. MAXVAL(reinf_slope) .EQ. val_exp .OR. get_slope) THEN
+             
+             CALL slowproc_slope(kjpindex, lalo, neighbours, resolution, contfrac, reinf_slope)
+             
+          ENDIF
+       END IF
+    ENDIF
+
+    ! Have a first guess at the vegetation fraction
+    CALL slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile)
+
+    l_first_slowproc = .FALSE.
+
+    IF (long_print) WRITE (numout,*) ' slowproc_init done '
+
+  END SUBROUTINE slowproc_init
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_clear
+!!
+!>\BRIEF          Clear all variables related to slowproc and stomate modules  
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_clear 
+
+  ! 1 Reset l_first_slowproc and clear all the variables defined as common for the routines in slowproc 
+
+    l_first_slowproc = .TRUE.
+    
+    IF (ALLOCATED (clayfraction)) DEALLOCATE (clayfraction)
+    IF (ALLOCATED (bulk_density)) DEALLOCATE (bulk_density)
+    IF (ALLOCATED (soil_ph)) DEALLOCATE (soil_ph)
+    IF (ALLOCATED (laimap)) DEALLOCATE (laimap)
+    IF (ALLOCATED (veget_nextyear)) DEALLOCATE (veget_nextyear)
+    IF (ALLOCATED (frac_nobio_nextyear)) DEALLOCATE (frac_nobio_nextyear)
+    IF (ALLOCATED (totfrac_nobio_nextyear)) DEALLOCATE (totfrac_nobio_nextyear)
+    !
+    IF ( ALLOCATED (soilclass_default)) DEALLOCATE (soilclass_default)
+    !
+    IF (ALLOCATED  (tot_bare_soil)) DEALLOCATE (tot_bare_soil)
+    IF (ALLOCATED  (frac_bare)) DEALLOCATE (frac_bare)
+    !
+
+ ! 2. Clear all the variables in stomate 
+
+    CALL stomate_clear 
+    !
+  END SUBROUTINE slowproc_clear
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_derivvar
+!!
+!>\BRIEF         Initializes variables related to the
+!! parameters to be assimilated, the maximum water on vegetation, the vegetation height, 
+!! and the fraction of soil covered by dead leaves and the vegetation height 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags):
+!! (1) Initialization of the variables relevant for the assimilation parameters  
+!! (2) Intialization of the fraction of soil covered by dead leaves
+!! (3) Initialization of the Vegetation height per PFT
+!! (3) Initialization the maximum water on vegetation for interception with a particular treatement of the PFT no.1
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::qsintmax, ::deadleaf_cover, ::assim_param, ::height  
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_derivvar (kjpindex, veget, lai, &
+       qsintmax, deadleaf_cover, assim_param, height)
+
+    !! INTERFACE DESCRIPTION
+
+    !! 0.1 Input scalar and fields 
+    INTEGER(i_std), INTENT (in)                                :: kjpindex       !! Domain size - terrestrial pixels only
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)          :: veget          !! Fraction of pixel covered by PFT. Fraction accounts for none-biological land covers (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)          :: lai            !! PFT leaf area index (m^{2} m^{-2})
+
+    !! 0.2. Output scalar and fields 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)          :: qsintmax       !! Maximum water on vegetation for interception(mm)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)              :: deadleaf_cover !! fraction of soil covered by dead leaves (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nvm,npco2), INTENT (out)   :: assim_param    !! min+max+opt temperatures & vmax for photosynthesis (K, \mumol m^{-2} s^{-1})
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out)          :: height         !! height of the vegetation or surface in general ??? (m)
+    !
+    !! 0.3 Local declaration
+    INTEGER(i_std)                                              :: ji, jv         !! Local indices
+!_ ================================================================================================================================
+
+    !
+    ! 1. Initialize (why here ??) the variables revelant for the assimilation parameters
+    !
+    DO jv = 1, nvm
+       assim_param(:,jv,itmin) = co2_tmin_fix(jv) + tp_00
+       assim_param(:,jv,itopt) = co2_topt_fix(jv) + tp_00
+       assim_param(:,jv,itmax) = co2_tmax_fix(jv) + tp_00
+       assim_param(:,jv,ivcmax) = vcmax_fix(jv)
+       assim_param(:,jv,ivjmax) = vjmax_fix(jv)
+    ENDDO
+
+    !
+    ! 2. Intialize the fraction of soil covered by dead leaves 
+    !
+    deadleaf_cover(:) = zero
+
+    !
+    ! 3. Initialize the Vegetation height per PFT
+    !
+    DO jv = 1, nvm
+       height(:,jv) = height_presc(jv)
+    ENDDO
+    !
+    ! 4. Initialize the maximum water on vegetation for interception
+    !
+    qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
+
+    ! Added by Nathalie - July 2006
+    !  Initialize the case of the PFT no.1 to zero 
+    qsintmax(:,1) = zero
+
+  END SUBROUTINE slowproc_derivvar
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_mean
+!!
+!>\BRIEF          Accumulates field_in over a period of dt_tot.
+!! Has to be called at every time step (dt). 
+!! Mean value is calculated if ldmean=.TRUE.
+!! field_mean must be initialized outside of this routine! 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!! (1) AcumAcuumlm 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::field_main
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_mean (npts, n_dim2, dt_tot, dt, ldmean, field_in, field_mean)
+
+    !
+    !! 0 declarations
+
+    !! 0.1 input scalar and variables 
+    INTEGER(i_std), INTENT(in)                           :: npts     !! Domain size- terrestrial pixels only 
+    INTEGER(i_std), INTENT(in)                           :: n_dim2   !! Number of PFTs 
+    REAL(r_std), INTENT(in)                              :: dt_tot   !! Time step of stomate (in days). The period over which the accumulation or the mean is computed 
+    REAL(r_std), INTENT(in)                              :: dt       !! Time step in days 
+    LOGICAL, INTENT(in)                                  :: ldmean   !! Flag to calculate the mean after the accumulation ???
+    REAL(r_std), DIMENSION(npts,n_dim2), INTENT(in)      :: field_in !! Daily field 
+
+    !! 0.3 Modified field; The computed sum or mean field over dt_tot time period depending on the flag ldmean 
+    REAL(r_std), DIMENSION(npts,n_dim2), INTENT(inout)   :: field_mean !! Accumulated field at dt_tot time period or mean field over dt_tot 
+ 
+
+!_ ================================================================================================================================
+
+    !
+    ! 1. Accumulation the field over dt_tot period 
+    !
+    field_mean(:,:) = field_mean(:,:) + field_in(:,:) * dt
+
+    !
+    ! 2. If the flag ldmean set, the mean field is computed over dt_tot period  
+    !
+    IF (ldmean) THEN
+       field_mean(:,:) = field_mean(:,:) / dt_tot
+    ENDIF
+
+  END SUBROUTINE slowproc_mean
+
+
+  
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_long
+!!
+!>\BRIEF        Calculates a temporally smoothed field (field_long) from
+!! instantaneous input fields.Time constant tau determines the strength of the smoothing.
+!! For tau -> infinity??, field_long becomes the true mean value of field_inst
+!! (but  the spinup becomes infinietly long, too).
+!! field_long must be initialized outside of this routine! 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!! (1) Testing the time coherence betwen the time step dt and the time tau over which
+!! the rescaled of the mean is performed   
+!!  (2) Computing the rescaled mean over tau period 
+!! MAIN OUTPUT VARIABLE(S): field_long  
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::field_long
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_long (npts, n_dim2, dt, tau, field_inst, field_long)
+
+    !
+    ! 0 declarations
+    !
+
+    ! 0.1 input scalar and fields 
+
+    INTEGER(i_std), INTENT(in)                                 :: npts        !! Domain size- terrestrial pixels only
+    INTEGER(i_std), INTENT(in)                                 :: n_dim2      !! Second dimension of the fields, which represents the number of PFTs
+    REAL(r_std), INTENT(in)                                    :: dt          !! Time step in days   
+    REAL(r_std), INTENT(in)                                    :: tau         !! Integration time constant (has to have same unit as dt!)  
+    REAL(r_std), DIMENSION(npts,n_dim2), INTENT(in)            :: field_inst  !! Instantaneous field 
+
+
+    ! 0.2 modified field
+
+    ! Long-term field
+    REAL(r_std), DIMENSION(npts,n_dim2), INTENT(inout)         :: field_long  !! Mean value of the instantaneous field rescaled at tau time period 
+
+!_ ================================================================================================================================
+
+    !
+    ! 1 test coherence of the time 
+
+    IF ( ( tau .LT. dt ) .OR. ( dt .LE. zero ) .OR. ( tau .LE. zero ) ) THEN
+       WRITE(numout,*) 'slowproc_long: Problem with time steps'
+       WRITE(numout,*) 'dt=',dt
+       WRITE(numout,*) 'tau=',tau
+    ENDIF
+
+    !
+    ! 2 integration of the field over tau 
+
+    field_long(:,:) = ( field_inst(:,:)*dt + field_long(:,:)*(tau-dt) ) / tau
+
+  END SUBROUTINE slowproc_long
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_veget
+!!
+!>\BRIEF        Sum up veget_max and frac_nobio and test if sum is equal to 1.
+!! In case there is a problem, a correction is performed when possible, otherwise
+!! it stops.    
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!! (1) Summing up frac_nobio and veget_max. Test if the sum is equal to unity.
+!!  If not, when possible a solution is proposed, otherwise the routine stops 
+!! (2) Setting veget to veget_max 
+!! (3) Testing the  lai of a vegetation type. If small the soil part of the pixel is increased
+!! (4) Summing the surface fractions and test if it is equal to 1. If not, when
+!! possible, a solution is given, otherwise the routine stops.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::veget
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_veget (kjpindex, lai, frac_nobio, totfrac_nobio, veget_max, veget, soiltile)
+    !
+    ! 0. Declarations
+    !
+
+    ! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                             :: kjpindex    !! Domain size - terrestrial pixels only
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)       :: lai         !! PFT leaf area index (m^{2} m^{-2})
+
+    ! 0.2 Modified variables 
+    REAL(r_std), DIMENSION(kjpindex,nnobio), INTENT(inout) :: frac_nobio  !! Fraction of the mesh which is covered by ice, lakes, ...
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout)    :: veget_max   !! Maximum fraction of vegetation type including none biological fraction (unitless)
+
+    ! 0.3 Output variables 
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)      :: veget       !! Fraction of pixel covered by PFT. Fraction accounts for none-biological land covers (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)    :: totfrac_nobio
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out)   :: soiltile     !! Fraction of each soil tile (0-1, unitless)
+
+    ! 0.4 Local scalar and varaiables 
+    REAL(r_std), DIMENSION(kjpindex)                       :: fracsum     !! Sum of both fracnobio and veget_max 
+    INTEGER(i_std)                                         :: nbad        !!
+    INTEGER(i_std)                                         :: ji, jv, jst !! indices 
+
+    ! Test Nathalie	
+    REAL(r_std)                                            :: SUMveg      !!
+!!!$    REAL(r_std)                                            :: trans_veg
+!_ ================================================================================================================================
+
+    ! 0. Set to zero fractions of frac_nobio and veget_max smaller than min_vegfrac
+    DO ji = 1, kjpindex
+       IF ( SUM(frac_nobio(ji,:)) .LT. min_vegfrac ) THEN
+          frac_nobio(ji,:) = zero
+       ENDIF
+       DO jv = 1, nvm
+          IF ( veget_max(ji,jv) .LT. min_vegfrac ) THEN
+             veget_max(ji,jv) = zero
+          ENDIF
+       ENDDO
+       SUMveg = SUM(frac_nobio(ji,:))+SUM(veget_max(ji,:))
+       frac_nobio(ji,:) = frac_nobio(ji,:)/SUMveg
+       veget_max(ji,:) = veget_max(ji,:)/SUMveg
+    ENDDO
+
+    !
+    ! 1. Sum up veget_max and frac_nobio and test if sum is equal to 1
+    !
+    !
+    ! 1.1 Sum up
+    !
+    fracsum(:) = zero
+    DO jv = 1, nnobio
+       DO ji = 1, kjpindex
+          fracsum(ji) = fracsum(ji) + frac_nobio(ji,jv)
+       ENDDO
+    ENDDO
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          fracsum(ji) = fracsum(ji) + veget_max(ji,jv)
+       ENDDO
+    ENDDO
+    !
+    ! 1.2 stop if there is a severe problem, that is an error above 0.01%
+    !     The rest will be scaled
+    !
+    nbad = COUNT( ABS(fracsum(:)-un) .GT. 0.0001 )
+    IF ( nbad .GT. 0 ) THEN
+      WRITE(numout,*) 'Problem with total surface areas.'
+      DO ji = 1, kjpindex
+        IF ( ABS(fracsum(ji)-un) .GT. 0.0001 ) THEN
+          WRITE(numout,*) 'Point :', ji
+          WRITE(numout,*) '  frac_nobio :', frac_nobio(ji,:)
+          WRITE(numout,*) '  Veget_max :', veget_max(ji,:)
+          WRITE(numout,*) '  Fracsum :', fracsum(ji), EPSILON(un)
+          WRITE(numout,*) '  The error is :', un - ( SUM(frac_nobio(ji,:)) + SUM(veget_max(ji,:)) )
+          STOP 'slowproc_veget'
+        ENDIF
+      ENDDO
+    ENDIF
+    !
+    ! 1.3 correction at places where the problem is surely precision-related
+    !
+    nbad = COUNT( ABS(fracsum(:)-un) .GT. EPSILON(un) )
+    !
+    IF ( nbad .GT. 0 ) THEN
+       !
+       IF ( long_print ) THEN
+          WRITE(numout,*) 'WARNING! scaling frac_nobio and veget_max at', nbad, ' points'
+       ENDIF
+       !
+       DO jv = 1, nnobio
+          DO ji = 1, kjpindex
+             IF ( ABS(fracsum(ji)-un) .GT. EPSILON(un) ) THEN
+                frac_nobio(ji,jv) = frac_nobio(ji,jv)/fracsum(ji)
+             ENDIF
+          ENDDO
+       ENDDO
+       !
+       DO jv = 1, nvm
+          DO ji = 1, kjpindex
+             IF ( ABS(fracsum(ji)-un) .GT. EPSILON(un) ) THEN
+                veget_max(ji,jv) = veget_max(ji,jv)/fracsum(ji)
+             ENDIF
+          ENDDO
+       ENDDO
+       !
+    ENDIF
+
+    !
+    ! 2. Set veget equal to veget_max
+    !
+    veget(:,1)=veget_max(:,1)
+    !
+    ! 3. if lai of a vegetation type (jv > 1) is small, increase soil part
+    !
+    ! Ajout Nouveau calcul (stomate-like) 
+    DO ji = 1, kjpindex
+       SUMveg = zero
+       tot_bare_soil(ji) = veget_max(ji,1)
+       DO jv = 2, nvm
+          veget(ji,jv) = veget_max(ji,jv) * ( un - exp( - lai(ji,jv) * ext_coeff(jv) ) )
+          tot_bare_soil(ji) = tot_bare_soil(ji) + (veget_max(ji,jv) - veget(ji,jv))
+          SUMveg = SUMveg + veget(ji,jv)
+       ENDDO
+       SUMveg = SUMveg + tot_bare_soil(ji) + SUM(frac_nobio(ji,:)) 
+       IF (SUMveg .LT. 0.99999) THEN
+          WRITE(numout,*)' ATTENTION, en ji, SUMveg LT 1: ', ji, SUMveg
+          WRITE(numout,*)'   frac_nobio = ',SUM(frac_nobio(ji,:))
+          WRITE(numout,*)  '              ',veget(ji,:)
+          WRITE(numout,*)  '              ',tot_bare_soil(ji)
+       ENDIF
+    ENDDO
+
+    !
+    ! 4. Sum up surface fractions and test if the sum is equal to 1
+    !
+
+    !
+    ! 4.1 Sum up
+    !
+    fracsum(:) = zero
+    DO jv = 1, nnobio
+       DO ji = 1, kjpindex
+          fracsum(ji) = fracsum(ji) + frac_nobio(ji,jv)
+       ENDDO
+    ENDDO
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          fracsum(ji) = fracsum(ji) + veget_max(ji,jv)
+       ENDDO
+    ENDDO
+
+    !
+    ! 4.2 stop if there is a severe problem
+    !
+    nbad = COUNT( ABS(fracsum(:)-un) .GT. (REAL(nvm+nnobio,r_std)*EPSILON(un)) )
+    !
+    IF ( nbad .GT. 0 ) THEN
+       WRITE(numout,*) 'Problem with veget or frac_nobio.'
+       DO ji = 1, kjpindex
+          IF ( ABS(fracsum(ji)-un) .GT. (10.*EPSILON(un)) ) THEN
+             WRITE(numout,*) 'Point :', ji
+             WRITE(numout,*) '  frac_nobio :', frac_nobio(ji,:)
+             WRITE(numout,*) '  Veget :', veget(ji,:)
+             WRITE(numout,*) '  The error is :', un - (SUM(frac_nobio(ji,:)) + SUM(veget(ji,:)))
+             STOP 'slowproc_veget'
+          ENDIF
+       ENDDO
+    ENDIF
+
+    ! 
+    ! 4.3 correction at places where the problem is surely precision-related
+    !
+    nbad = COUNT( ABS(fracsum(:)-un) .GT. EPSILON(un) )
+    !
+    IF ( nbad .GT. 0 ) THEN
+       !
+       IF ( long_print ) THEN
+          WRITE(numout,*) 'slowproc_veget: scaling veget at', nbad, ' points'
+       ENDIF
+       !
+       DO ji = 1, kjpindex
+          IF ( ABS(fracsum(ji)-un) .GT. EPSILON(un) ) THEN
+             veget_max(ji,1) = veget_max(ji,1) / fracsum(ji)
+          ENDIF
+       ENDDO
+       veget(:,1)=veget_max(:,1)
+       !
+       DO jv = 2, nvm
+          DO ji = 1, kjpindex
+             IF ( ABS(fracsum(ji)-un) .GT. EPSILON(un) ) THEN
+                veget_max(ji,jv) = veget_max(ji,jv) / fracsum(ji)
+                veget(ji,jv) = veget(ji,jv) / fracsum(ji)
+             ENDIF
+          ENDDO
+       ENDDO
+       !
+       DO jv = 1, nnobio
+          DO ji = 1, kjpindex
+             IF ( ABS(fracsum(ji)-un) .GT. EPSILON(un) ) THEN
+                frac_nobio(ji,jv) = frac_nobio(ji,jv) / fracsum(ji)
+             ENDIF
+          ENDDO
+       ENDDO
+
+    ENDIF
+
+    !
+    tot_bare_soil(:) = veget_max(:,1)
+    DO jv = 2, nvm
+       DO ji =1, kjpindex
+          tot_bare_soil(ji) = tot_bare_soil(ji) + (veget_max(ji,jv) - veget(ji,jv))
+       ENDDO
+    END DO
+    
+    DO ji =1, kjpindex
+       IF( veget_max(ji,1) .GT. min_sechiba ) THEN
+          frac_bare(ji,1) = un
+       ELSE
+          frac_bare(ji,1) = zero
+       ENDIF
+    ENDDO
+    DO jv = 2, nvm
+       DO ji =1, kjpindex
+          IF( veget_max(ji,jv) .GT. min_sechiba ) THEN
+             frac_bare(ji,jv) = un - veget(ji,jv)/veget_max(ji,jv)
+          ELSE
+             frac_bare(ji,jv) = zero
+          ENDIF
+       ENDDO
+    ENDDO
+
+    totfrac_nobio(:) = zero
+    DO jv = 1, nnobio
+       totfrac_nobio(:) = totfrac_nobio(:) + frac_nobio(:,jv)
+    ENDDO
+    
+    ! Soiltiles are only used in hydrol, but we fix them in here because some time it might depend
+    ! on a changing vegetation (but then some adaptation should be made to hydrol) and be also used
+    ! in the other modules to perform separated energy balances
+    soiltile(:,:) = zero
+    soiltile(:,1) = totfrac_nobio(:)
+    DO jv = 1, nvm
+       jst = pref_soil_veg(jv)
+       DO ji = 1, kjpindex
+          soiltile(ji,jst) = soiltile(ji,jst) + veget_max(ji,jv)
+!!$          IF (jv==1) THEN
+!!$             soiltile(ji,jst) = soiltile(ji,jst) + tot_bare_soil(ji)
+!!$          ENDIF
+       ENDDO
+    ENDDO
+!!$    ! Avoid soiltile < 0.01
+!!$    DO jst = 1, nstm
+!!$       DO ji = 1, kjpindex
+!!$          IF (soiltile(ji,jst) .LT. 0.01) THEN
+!!$             soiltile(ji,MAXLOC(soiltile(ji,:),1)) = soiltile(ji,MAXLOC(soiltile(ji,:),1)) + soiltile(ji,jst)
+!!$             soiltile(ji,jst) = zero
+!!$          ENDIF
+!!$       ENDDO
+!!$    ENDDO
+    
+  END SUBROUTINE slowproc_veget
+ 
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_lai
+!!
+!>\BRIEF        Do the interpolation of lai for the PFTs in case the laimap is not read   
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!! (1) Interplation by using the mean value of laimin and laimax for the PFTs    
+!! (2) Interpolation between laimax and laimin values by using the temporal
+!!  variations 
+!! (3) If problem occurs during the interpolation, the routine stops 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lai
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_lai (kjpindex,lcanop,stempdiag,lalo,resolution,lai,mm,dd,read_lai,laimap)
+    !
+    ! 0. Declarations
+    !
+    !! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                          :: kjpindex   !! Domain size - terrestrial pixels only
+    INTEGER(i_std), INTENT(in)                          :: lcanop     !! soil level used for LAI
+    INTEGER(i_std), INTENT(in)                          :: mm, dd     !! Number of the month in the year and number of day of the month 
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)  :: stempdiag  !! Soil temperature (K) ???
+    REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)     :: lalo       !! Geogr. coordinates (latitude,longitude) (degrees)
+    REAL(r_std), DIMENSION (kjpindex,2), INTENT(in)     :: resolution !! Size in x an y of the grid (m) - surface area of the gridbox
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: laimap     !! map of lai read 
+    LOGICAL, INTENT(in)                                 :: read_lai   !! Flag for the reading of laimap 
+
+    !! 0.2 Output
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)   :: lai        !! PFT leaf area index (m^{2} m^{-2})LAI
+
+    !! 0.4 Local
+    INTEGER(i_std)                                      :: ji,jv      !! Local indices 
+!_ ================================================================================================================================
+
+    !
+    IF  ( .NOT. read_lai ) THEN
+    
+       lai(: ,1) = zero
+       ! On boucle sur 2,nvm au lieu de 1,nvm
+       DO jv = 2,nvm
+          SELECT CASE (type_of_lai(jv))
+             
+          CASE ("mean ")
+             !
+             ! 1. do the interpolation between laimax and laimin
+             !
+             lai(:,jv) = undemi * (llaimax(jv) + llaimin(jv))
+             !
+          CASE ("inter")
+             !
+             ! 2. do the interpolation between laimax and laimin
+             !
+             DO ji = 1,kjpindex
+                lai(ji,jv) = llaimin(jv) + tempfunc(stempdiag(ji,lcanop)) * (llaimax(jv) - llaimin(jv))
+             ENDDO
+             !
+          CASE default
+             !
+             ! 3. Problem
+             !
+             WRITE (numout,*) 'This kind of lai choice is not possible. '// &
+                  ' We stop with type_of_lai ',jv,' = ', type_of_lai(jv) 
+             STOP 'slowproc_lai'
+             
+          END SELECT
+          
+       ENDDO
+       !
+    ELSE
+       lai(: ,1) = zero
+       ! On boucle sur 2,nvm au lieu de 1,nvm
+       DO jv = 2,nvm
+
+          SELECT CASE (type_of_lai(jv))
+             
+          CASE ("mean ")
+             !
+             ! 1. force MAXVAL of laimap on lai on this PFT
+             !
+             DO ji = 1,kjpindex
+                lai(ji,jv) = MAXVAL(laimap(ji,jv,:))
+             ENDDO
+             !
+          CASE ("inter")
+             !
+             ! 2. do the interpolation between laimax and laimin
+             !
+             !
+             ! If January
+             !
+             IF (mm .EQ. 1 ) THEN
+                IF (dd .LE. 15) THEN
+                   lai(:,jv) = laimap(:,jv,12)*(1-(dd+15)/30.) + laimap(:,jv,1)*((dd+15)/30.)
+                ELSE
+                   lai(:,jv) = laimap(:,jv,1)*(1-(dd-15)/30.) + laimap(:,jv,2)*((dd-15)/30.)
+                ENDIF
+                !
+                ! If December
+                !
+             ELSE IF (mm .EQ. 12) THEN
+                IF (dd .LE. 15) THEN
+                   lai(:,jv) = laimap(:,jv,11)*(1-(dd+15)/30.) + laimap(:,jv,12)*((dd+15)/30.)
+                ELSE
+                   lai(:,jv) = laimap(:,jv,12)*(1-(dd-15)/30.) + laimap(:,jv,1)*((dd-15)/30.)
+                ENDIF
+          !
+          ! ELSE
+          !
+             ELSE
+                IF (dd .LE. 15) THEN
+                   lai(:,jv) = laimap(:,jv,mm-1)*(1-(dd+15)/30.) + laimap(:,jv,mm)*((dd+15)/30.)
+                ELSE
+                   lai(:,jv) = laimap(:,jv,mm)*(1-(dd-15)/30.) + laimap(:,jv,mm+1)*((dd-15)/30.)
+                ENDIF
+             ENDIF
+             !
+          CASE default
+             !
+             ! 3. Problem
+             !
+             WRITE (numout,*) 'This kind of lai choice is not possible. '// &
+                  ' We stop with type_of_lai ',jv,' = ', type_of_lai(jv) 
+             STOP 'slowproc_lai'
+             
+          END SELECT
+          
+       ENDDO
+    ENDIF
+
+  END SUBROUTINE slowproc_lai
+
+! SHOULD BE DROPED (not commented) ???
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_interlai_OLD
+!!
+!>\BRIEF         Interpolate the LAI map to the grid of the model 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::laimap
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_interlai_OLD(nbpt, lalo,  resolution, laimap)
+    !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)          :: nbpt                  !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)             :: lalo(nbpt,2)          !! Vector of latitude and longitudes (beware of the order !)
+    REAL(r_std), INTENT(in)             :: resolution(nbpt,2)    !! The size in km of each grid-box in X and Y
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)    ::  laimap(nbpt,nvm,12)          !! lai read variable and re-dimensioned
+    !
+    !  0.3 LOCAL
+    !
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, ijml, i, j, ik, lml, tml, fid, ib, jb,ip, jp, vid, ai,iki,jkj
+    REAL(r_std) :: lev(1), date, dt, coslat
+    INTEGER(i_std) :: itau(1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) ::  mask_lu
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lat_lu, lon_lu, mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lat_ful, lon_ful
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: laimaporig
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: laimap_lu
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lon_up, lon_low, lat_up, lat_low
+    INTEGER, DIMENSION(nbpt) :: n_origlai
+    INTEGER, DIMENSION(nbpt) :: n_found
+    REAL(r_std), DIMENSION(nbpt,nvm) :: frac_origlai
+
+    CHARACTER(LEN=80) :: meter
+    REAL(r_std) :: prog, sumf
+    LOGICAL :: found
+    INTEGER :: idi,jdi, ilast, jlast, jj, ii, jv, inear, iprog
+    REAL(r_std) :: domaine_lon_min, domaine_lon_max, domaine_lat_min, domaine_lat_max
+
+!_ ================================================================================================================================
+    !
+    !
+    !Config Key   = LAI_FILE
+    !Config Desc  = Name of file from which the vegetation map is to be read
+    !Config If    = NOT(LAI_MAP)
+    !Config Def   = lai2D.nc
+    !Config Help  = The name of the file to be opened to read the LAI
+    !Config         map is to be given here. Usualy SECHIBA runs with a 5kmx5km
+    !Config         map which is derived from a Nicolas VIOVY one. 
+    !Config Units = [FILE]
+    !
+    filename = 'lai2D.nc'
+    CALL getin_p('LAI_FILE',filename)
+    !
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    !
+    !
+    ALLOCATE(lon_lu(iml))
+    ALLOCATE(lat_lu(jml))
+    ALLOCATE(laimap_lu(iml,jml,nvm,tml))
+    ALLOCATE(mask_lu(iml,jml))
+    !
+    WRITE(numout,*) 'slowproc_interlai : Reading the LAI file'
+    !
+    IF (is_root_prc) THEN
+       CALL flinget(fid, 'longitude', iml, 0, 0, 0, 1, 1, lon_lu)
+       CALL flinget(fid, 'latitude', jml, 0, 0, 0, 1, 1, lat_lu)
+       CALL flinget(fid, 'LAI', iml, jml, nvm, tml, 1, 12, laimap_lu)
+       CALL flinget(fid, 'mask', iml, jml, 0, 0, 0, 1, mask_lu)
+       !
+       CALL flinclo(fid)
+    ENDIF
+    CALL bcast(lon_lu)
+    CALL bcast(lat_lu)
+    CALL bcast(laimap_lu)
+    CALL bcast(mask_lu)
+    !
+    WRITE(numout,*) 'slowproc_interlai : ', lon_lu(1), lon_lu(iml),lat_lu(1), lat_lu(jml)
+    !
+    !
+    ijml=iml*jml
+    ALLOCATE(lon_ful(ijml))
+    ALLOCATE(lat_ful(ijml))
+    ALLOCATE(laimaporig(ijml,nvm,tml))
+    ALLOCATE(mask(ijml))
+
+    DO i=1,iml
+       DO j=1,jml
+          iki=(j-1)*iml+i
+          lon_ful(iki)=lon_lu(i)
+          lat_ful(iki)=lat_lu(j)
+          laimaporig(iki,:,:)=laimap_lu(i,j,:,:)
+          mask(iki)=mask_lu(i,j)
+       ENDDO
+    ENDDO
+    !
+    WHERE  ( laimaporig(:,:,:) .LT. 0 )
+       laimaporig(:,:,:) = zero
+    ENDWHERE
+    !
+    !
+    ALLOCATE(lon_up(nbpt)) 
+    ALLOCATE(lon_low(nbpt))
+    ALLOCATE(lat_up(nbpt))
+    ALLOCATE(lat_low(nbpt))
+    !
+    DO ib =1, nbpt
+       !
+       !  We find the 4 limits of the grid-box. As we transform the resolution of the model
+       !  into longitudes and latitudes we do not have the problem of periodicity.
+       !  coslat is a help variable here !
+       !
+       coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+       !
+       lon_up(ib) = lalo(ib,2) + resolution(ib,1)/(2.0*coslat) 
+       lon_low(ib) = lalo(ib,2) - resolution(ib,1)/(2.0*coslat) 
+       !
+       coslat = pi/180. * R_Earth
+       !
+       lat_up(ib) = lalo(ib,1) + resolution(ib,2)/(2.0*coslat) 
+       lat_low(ib) = lalo(ib,1) - resolution(ib,2)/(2.0*coslat) 
+       !
+       !
+       !
+    ENDDO
+    lon_up = NINT( lon_up * 1E6 ) * 1E-6
+    lon_low = NINT( lon_low * 1E6 ) * 1E-6
+    lat_up = NINT( lat_up * 1E6 ) * 1E-6
+    lat_low = NINT( lat_low * 1E6 ) * 1E-6
+    !
+    !  Get the limits of the integration domaine so that we can speed up the calculations
+    !
+    domaine_lon_min = MINVAL(lon_low)
+    domaine_lon_max = MAXVAL(lon_up)
+    domaine_lat_min = MINVAL(lat_low)
+    domaine_lat_max = MAXVAL(lat_up)
+    !
+!!$    WRITE(*,*) 'DOMAINE lon :', domaine_lon_min, domaine_lon_max
+!!$    WRITE(*,*) 'DOMAINE lat :', domaine_lat_min, domaine_lat_max
+    !
+    ! Ensure that the fine grid covers the whole domain
+    WHERE ( lon_ful(:) .LT. domaine_lon_min )
+      lon_ful(:) = lon_ful(:) + 360.
+    ENDWHERE
+    !
+    WHERE ( lon_ful(:) .GT. domaine_lon_max )
+      lon_ful(:) = lon_ful(:) - 360.
+    ENDWHERE
+    lon_ful = NINT( lon_ful * 1E6 ) * 1E-6
+    lat_ful = NINT( lat_ful * 1E6 ) * 1E-6
+    !
+    WRITE(numout,*) 'Interpolating the lai map :'
+    WRITE(numout,'(2a40)')'0%--------------------------------------', &
+                   & '------------------------------------100%'
+    !
+    ilast = 1
+    n_origlai(:) = 0
+    laimap(:,:,:) = zero   
+    !
+    DO ip=1,ijml
+       !
+       !   Give a progress meter
+       !
+       ! prog = ip/float(ijml)*79.
+       !  IF ( ABS(prog - NINT(prog)) .LT. 1/float(ijml)*79. ) THEN
+       !   meter(NINT(prog)+1:NINT(prog)+1) = 'x'
+       !   WRITE(numout, advance="no", FMT='(a)') ACHAR(13)
+       !   WRITE(numout, advance="no", FMT='(a80)') meter
+       ! ENDIF
+       iprog = NINT(float(ip)/float(ijml)*79.) - NINT(float(ip-1)/float(ijml)*79.)
+       IF ( iprog .NE. 0 ) THEN
+          WRITE(numout,'(a1,$)') 'y'
+       ENDIF
+       !
+       !  Only start looking for its place in the smaler grid if we are within the domaine
+       !  That should speed up things !
+       !
+       IF ( ( lon_ful(ip) .GE. domaine_lon_min ) .AND. &
+            ( lon_ful(ip) .LE. domaine_lon_max ) .AND. &
+            ( lat_ful(ip) .GE. domaine_lat_min ) .AND. &
+            ( lat_ful(ip) .LE. domaine_lat_max )        ) THEN
+          !
+          ! look for point on GCM grid which this point on fine grid belongs to.
+          ! First look at the point on the model grid where we arrived just before. There is 
+          ! a good chace that neighbouring points on the fine grid fall into the same model
+          ! grid box.
+          !
+          IF ( ( lon_ful(ip) .GE. lon_low(ilast) ) .AND. &
+               ( lon_ful(ip) .LT. lon_up(ilast) ) .AND. &
+               ( lat_ful(ip) .GE. lat_low(ilast) ) .AND. &
+               ( lat_ful(ip) .LT. lat_up(ilast) )         ) THEN
+             !
+             ! We were lucky
+             !
+             IF (mask(ip) .GT. 0) THEN
+                n_origlai(ilast) =  n_origlai(ilast) + 1  
+                DO i=1,nvm
+                   DO j=1,12   
+                      laimap(ilast,i,j) = laimap(ilast,i,j) + laimaporig(ip,i,j)
+                   ENDDO
+                ENDDO
+             ENDIF
+             !
+          ELSE
+             !
+             ! Otherwise, look everywhere.
+             ! Begin close to last grid point.
+             !
+             found = .FALSE. 
+             idi = 1
+             !
+             DO WHILE ( (idi .LT. nbpt) .AND. ( .NOT. found ) )
+
+                !
+                ! forward and backward
+                !
+                DO ii = 1,2
+                   !
+                   IF ( ii .EQ. 1 ) THEN
+                      ib = ilast - idi
+                   ELSE
+                      ib = ilast + idi
+                   ENDIF
+                   !
+                   IF ( ( ib .GE. 1 ) .AND. ( ib .LE. nbpt ) ) THEN 
+                      IF ( ( lon_ful(ip) .GE. lon_low(ib) ) .AND. &
+                           ( lon_ful(ip) .LT. lon_up(ib) ) .AND. &
+                           ( lat_ful(ip) .GE. lat_low(ib) ) .AND. &
+                           ( lat_ful(ip) .LT. lat_up(ib) )         ) THEN
+                         !
+                         IF (mask(ip) .gt. 0) THEN
+                            DO i=1,nvm
+                               DO j=1,12                
+                                  laimap(ib,i,j) = laimap(ib,i,j) + laimaporig(ip,i,j) 
+                               ENDDO
+                            ENDDO
+                            n_origlai(ib) =  n_origlai(ib) + 1
+                         ENDIF
+                         ilast = ib
+                         found = .TRUE.
+                         !
+                      ENDIF
+                   ENDIF
+                   !
+                ENDDO
+                !
+                idi = idi + 1
+                !
+             ENDDO
+             !
+          ENDIF ! lucky/not lucky
+          !
+       ENDIF     ! in the domain
+    ENDDO
+
+
+    ! determine fraction of LAI points in each box of the coarse grid
+    DO ip=1,nbpt
+       IF ( n_origlai(ip) .GT. 0 ) THEN
+          DO jv =1,nvm
+             laimap(ip,jv,:) = laimap(ip,jv,:)/REAL(n_origlai(ip),r_std)
+          ENDDO
+       ELSE
+          !
+          ! Now we need to handle some exceptions
+          !
+          IF ( lalo(ip,1) .LT. -56.0) THEN
+             ! Antartica
+             DO jv =1,nvm
+                laimap(ip,jv,:) = zero
+             ENDDO
+             !
+          ELSE IF ( lalo(ip,1) .GT. 70.0) THEN
+             ! Artica
+             DO jv =1,nvm
+                laimap(ip,jv,:) = zero
+             ENDDO
+             !
+          ELSE IF ( lalo(ip,1) .GT. 55.0 .AND. lalo(ip,2) .GT. -65.0 .AND. lalo(ip,2) .LT. -20.0) THEN
+             ! Greenland
+             DO jv =1,nvm
+                laimap(ip,jv,:) = zero
+             ENDDO
+             !
+          ELSE
+             !
+             WRITE(numout,*) 'PROBLEM, no point in the lai map found for this grid box'
+             WRITE(numout,*) 'Longitude range : ', lon_low(ip), lon_up(ip)
+             WRITE(numout,*) 'Latitude range : ', lat_low(ip), lat_up(ip)
+             !
+             WRITE(numout,*) 'Looking for nearest point on the lai map file'
+             CALL slowproc_nearest (ijml, lon_ful, lat_ful, &
+                  lalo(ip,2), lalo(ip,1), inear)
+             WRITE(numout,*) 'Coordinates of the nearest point, ',inear,' :', &
+                  lon_ful(inear),lat_ful(inear)
+             !
+             DO jv =1,nvm
+                laimap(ip,jv,:) = laimaporig(inear,jv,:)
+             ENDDO
+          ENDIF
+       ENDIF
+    ENDDO
+    ! 
+    WRITE(numout,*) 'slowproc_interlai : Interpolation Done'
+    !
+    !  
+    !
+    DEALLOCATE(lon_up)
+    DEALLOCATE(lon_low)
+    DEALLOCATE(lat_up)
+    DEALLOCATE(lat_low)
+    DEALLOCATE(lat_ful)
+    DEALLOCATE(lon_ful)
+    DEALLOCATE(lat_lu)
+    DEALLOCATE(lon_lu)
+    DEALLOCATE(laimap_lu)
+    DEALLOCATE(laimaporig)
+    DEALLOCATE(mask_lu)
+    DEALLOCATE(mask)
+    !
+    RETURN
+    !
+  END SUBROUTINE slowproc_interlai_OLD
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_interlai_NEW
+!!
+!>\BRIEF         Interpolate the LAI map to the grid of the model 
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::laimap
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_interlai_NEW(nbpt, lalo,  resolution, neighbours, contfrac, laimap)
+    !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)          :: nbpt                  !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)             :: lalo(nbpt,2)          !! Vector of latitude and longitudes 
+                                                                 !! (beware of the order = 1 : latitude, 2 : longitude)
+    REAL(r_std), INTENT(in)             :: resolution(nbpt,2)    !! The size in km of each grid-box in X and Y
+    !
+    INTEGER(i_std), INTENT(in)         :: neighbours(nbpt,8)     !! Vector of neighbours for each grid point 1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) 
+                            
+    REAL(r_std), INTENT(in)             :: contfrac(nbpt)        !! Fraction of land in each grid box.
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)    ::  laimap(nbpt,nvm,12)          !! lai read variable and re-dimensioned
+    !
+    !  0.3 LOCAL
+    !
+    !
+    CHARACTER(LEN=80) :: filename                               !! name of the LAI map read
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lat_lu, lon_lu    !! latitude and
+                                                                !! longitude, extract from LAI map
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat, lon        !! en 2D ???
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area     !! the area of the fine grid in the model grid ???
+                                                                !! cf src_global/interpol_help.f90, line 377, called "areaoverlap"
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index !! the indexes from the grid boxes from the data that go into the 
+                                                                !! model's boxes  
+                                                                !! cf src_global/interpol_help.f90,line 300, called "ip"
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: laimap_lu   !! value in LAIMAP
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: resol_lu
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    !
+    REAL(r_std) :: coslat, lmax, lmin, ldelta
+    INTEGER(i_std) :: nix, njx
+    REAL(r_std) :: totarea
+    INTEGER(i_std) :: idi, nbvmax                               !! nbvmax : number of maximum vegetation map
+                                                                !! points in the GCM grid ; idi : its counter
+    CHARACTER(LEN=30) :: callsign                               !! Allows to specify which variable is beeing treated
+    !
+    LOGICAL ::           renormelize_lai  ! flag to force LAI renormelization
+    LOGICAL ::           ok_interpol                            !! optionnal return of aggregate_2d
+    !
+    INTEGER                  :: ALLOC_ERR 
+!_ ================================================================================================================================
+    !
+    !Config Key   = LAI_FILE
+    !Config Desc  = Name of file from which the vegetation map is to be read
+    !Config If    = LAI_MAP
+    !Config Def   = lai2D.nc
+    !Config Help  = The name of the file to be opened to read the LAI
+    !Config         map is to be given here. Usualy SECHIBA runs with a 5kmx5km
+    !Config         map which is derived from a Nicolas VIOVY one. 
+    !Config Units = [FILE]
+    !
+    filename = 'lai2D.nc'
+    CALL getin_p('LAI_FILE',filename)
+    !
+    !
+    !Config Key   = RENORM_LAI
+    !Config Desc  = flag to force LAI renormelization
+    !Config If    = LAI_MAP
+    !Config Def   = n
+    !Config Help  = If true, the laimap will be renormalize between llaimin and llaimax parameters.
+    !Config Units = [FLAG]
+    !
+    renormelize_lai = .FALSE.
+    CALL getin_p('RENORM_LAI',renormelize_lai)
+
+    !
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    !
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(lon_lu(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lon_lu : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(lat_lu(jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lat_lu : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(laimap_lu(iml,jml,nvm,tml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of laimap_lu : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of resol_lu : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    !
+    IF (is_root_prc) THEN
+       CALL flinget(fid, 'longitude', iml, 0, 0, 0, 1, 1, lon_lu)
+       CALL flinget(fid, 'latitude', jml, 0, 0, 0, 1, 1, lat_lu)
+       CALL flinget(fid, 'LAI', iml, jml, nvm, tml, 1, 12, laimap_lu)
+       !
+       WHERE (laimap_lu(:,:,:,:) < zero )
+          laimap_lu(:,:,:,:) = zero
+       ENDWHERE
+       !
+       CALL flinclo(fid)
+    ENDIF
+    CALL bcast(lon_lu)
+    CALL bcast(lat_lu)
+    CALL bcast(laimap_lu)
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lon : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lat : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    DO ip=1,iml
+       lat(ip,:) = lat_lu(:)
+    ENDDO
+    DO jp=1,jml
+       lon(:,jp) = lon_lu(:)
+    ENDDO
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    ! Consider all points a priori
+    !
+    mask(:,:) = 0
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          ! Exclude the points where there is never a LAI value. It is probably 
+          ! an ocean point.
+          !
+          IF ( ANY(laimap_lu(ip,jp,:,:) < 20.) ) THEN
+             mask(ip,jp) = 1
+          ENDIF
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( lat(ip,jp) * pi/180. ), mincos )     
+          IF ( ip .EQ. 1 ) THEN
+             resol_lu(ip,jp,1) = ABS( lon(ip+1,jp) - lon(ip,jp) ) * pi/180. * R_Earth * coslat
+          ELSEIF ( ip .EQ. iml ) THEN
+             resol_lu(ip,jp,1) = ABS( lon(ip,jp) - lon(ip-1,jp) ) * pi/180. * R_Earth * coslat
+          ELSE
+             resol_lu(ip,jp,1) = ABS( lon(ip+1,jp) - lon(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resol_lu(ip,jp,2) = ABS( lat(ip,jp) - lat(ip,jp+1) ) * pi/180. * R_Earth
+          ELSEIF ( jp .EQ. jml ) THEN
+             resol_lu(ip,jp,2) = ABS( lat(ip,jp-1) - lat(ip,jp) ) * pi/180. * R_Earth
+          ELSE
+             resol_lu(ip,jp,2) =  ABS( lat(ip,jp-1) - lat(ip,jp+1) )/2. * pi/180. * R_Earth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+       njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+       nbvmax = nix*njx
+    ENDIF
+    CALL bcast(nbvmax)
+    !
+    callsign = 'LAI map'
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+       !WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+       !
+       ALLOC_ERR=-1
+       ALLOCATE(sub_index(nbpt, nbvmax, 2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+          STOP 
+       ENDIF
+       sub_index(:,:,:)=0
+       ALLOC_ERR=-1
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+          STOP 
+       ENDIF
+       sub_area(:,:)=zero
+       !
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon, lat, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       !
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+       ENDIF
+       !
+       nbvmax = nbvmax * 2
+    ENDDO
+    !
+    laimap(:,:,:) = zero
+    !
+    DO ib=1,nbpt
+       idi = COUNT(sub_area(ib,:) > zero)
+       IF ( idi > 0 ) THEN
+          totarea = zero
+          DO jj=1,idi
+             ip = sub_index(ib,jj,1)
+             jp = sub_index(ib,jj,2)
+             DO jv=1,nvm
+                DO it=1,12
+                   laimap(ib,jv,it) = laimap(ib,jv,it) + laimap_lu(ip,jp,jv,it)*sub_area(ib,jj)
+                ENDDO
+             ENDDO
+             totarea = totarea + sub_area(ib,jj)
+          ENDDO
+          !
+          ! Normalize
+          !
+          laimap(ib,:,:) = laimap(ib,:,:)/totarea
+          !
+       ELSE
+          WRITE(numout,*) 'On point ', ib, ' no points where found for interpolating the LAI map.'
+          WRITE(numout,*) 'Location : ', lalo(ib,2), lalo(ib,1)
+          DO jv=1,nvm
+             laimap(ib,jv,:) = (llaimax(jv)+llaimin(jv))/deux
+          ENDDO
+          WRITE(numout,*) 'Solved by putting the average LAI for the PFT all year long'
+       ENDIF
+    ENDDO
+    !
+    ! Normelize the read LAI by the values SECHIBA is used to
+    !
+    IF ( renormelize_lai ) THEN
+       DO ib=1,nbpt
+          DO jv=1,nvm
+             lmax = MAXVAL(laimap(ib,jv,:))
+             lmin = MINVAL(laimap(ib,jv,:))
+             ldelta = lmax-lmin
+             IF ( ldelta < min_sechiba) THEN
+                ! LAI constante ... keep it constant
+                laimap(ib,jv,:) = (laimap(ib,jv,:)-lmin)+(llaimax(jv)+llaimin(jv))/deux
+             ELSE
+                laimap(ib,jv,:) = (laimap(ib,jv,:)-lmin)/(lmax-lmin)*(llaimax(jv)-llaimin(jv))+llaimin(jv)
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+    !
+    WRITE(numout,*) 'slowproc_interlai : Interpolation Done'
+    !
+    !  
+    !
+    DEALLOCATE(lat_lu)
+    DEALLOCATE(lon_lu)
+    DEALLOCATE(lon)
+    DEALLOCATE(lat)
+    DEALLOCATE(laimap_lu)
+    DEALLOCATE(mask)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(sub_index)
+    DEALLOCATE (resol_lu)
+    !
+    RETURN
+    !
+  END SUBROUTINE slowproc_interlai_NEW
+
+! NOT COMMENTED YET!
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_update
+!!
+!>\BRIEF          Interpolate a vegetation map (by pft) NEED TO BE DONE!!!!!!!!
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_update(nbpt, lalo, neighbours,  resolution, contfrac, & 
+       &       veget_last, frac_nobio_last, & 
+       &       veget_next, frac_nobio_next, veget_year, init)
+    !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)                             :: nbpt            !! Number of points for which the data needs 
+                                                                              !! to be interpolated
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in)             :: lalo            !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), DIMENSION(nbpt,8), INTENT(in)         :: neighbours       !! Vector of neighbours for each grid point 
+                                                                              !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in)             :: resolution      !! The size in km of each grid-box in X and Y
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)               :: contfrac        !! Fraction of continent in the grid
+    !
+    REAL(r_std), DIMENSION(nbpt,nvm), INTENT(in)           :: veget_last      !! old max vegetfrac
+    REAL(r_std), DIMENSION(nbpt,nnobio), INTENT(in)        :: frac_nobio_last !! old fraction of the mesh which is 
+                                                                              !! covered by ice, lakes, ...
+    !
+    INTEGER(i_std), INTENT(in)         :: veget_year            !! first year for landuse (0 == NO TIME AXIS)
+    LOGICAL, OPTIONAL, INTENT(in)      :: init                  !! initialisation : in case of dgvm, it forces update of all PFTs
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), DIMENSION(nbpt,nvm), INTENT(out)          :: veget_next       !! new max vegetfrac
+    REAL(r_std), DIMENSION(nbpt,nnobio), INTENT(out)       :: frac_nobio_next  !! new fraction of the mesh which is 
+    !! covered by ice, lakes, ...
+    !
+    !  0.3 LOCAL
+    !
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, inobio, jv
+    INTEGER(i_std) :: nb_coord,nb_var, nb_gat,nb_dim
+    REAL(r_std) :: date, dt
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)  :: itau
+    REAL(r_std), DIMENSION(1)  :: time_counter
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lat_lu, lon_lu
+    INTEGER,DIMENSION(flio_max_var_dims) :: l_d_w, i_d_w
+    LOGICAL :: exv, l_ex
+    !
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: vegmap            ! last coord is time with only one value = 1
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: vegmap_1            ! last coord is time with only one value = 1  (IF VEGET_YEAR == 0 , NO TIME AXIS)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_ful, lon_ful
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    !
+    REAL(r_std) :: sumf, err, norm
+    REAL(r_std) :: totarea
+    INTEGER(i_std) :: idi, nbvmax
+    CHARACTER(LEN=30) :: callsign
+    !
+    LOGICAL ::           ok_interpol ! optionnal return of aggregate_2d
+    !
+    ! for DGVM case :
+    REAL(r_std)                 :: sum_veg                     ! sum of vegets
+    REAL(r_std)                 :: sum_nobio                   ! sum of nobios
+    REAL(r_std)                 :: sumvAnthro_old, sumvAnthro  ! last an new sum of antrhopic vegets
+    REAL(r_std)                 :: rapport                     ! (S-B) / (S-A)
+    LOGICAL                    :: partial_update              ! if TRUE, partialy update PFT (only anthropic ones) 
+                                                              ! e.g. in case of DGVM and not init (optional parameter)
+    !
+    LOGICAL, PARAMETER         :: debug = .FALSE.
+    !
+    INTEGER                  :: ALLOC_ERR
+
+!_ ================================================================================================================================
+    !
+    !Config Key   = VEGETATION_FILE
+    !Config Desc  = Name of file from which the vegetation map is to be read
+    !Config If    = LAND_USE
+    !Config Def   = PFTmap.nc
+    !Config Help  = The name of the file to be opened to read a vegetation
+    !Config         map (in pft) is to be given here. 
+    !Config Units = [FILE]
+    !
+    filename = 'PFTmap.nc'
+    CALL getin_p('VEGETATION_FILE',filename)
+    !
+    IF (is_root_prc) THEN
+       IF (debug) THEN
+          WRITE(numout,*) "Entering slowproc_update. Debug mode."
+          WRITE (*,'(/," --> fliodmpf")')
+          CALL fliodmpf (TRIM(filename))
+          WRITE (*,'(/," --> flioopfd")')
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (debug) THEN
+          WRITE (*,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (*,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (*,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+    CALL bcast(nb_coord)
+    CALL bcast(nb_var)
+    CALL bcast(nb_gat)
+!    IF ( veget_year > 0 ) THEN
+WRITE(numout,*) "is_root_prc", is_root_prc
+       IF (is_root_prc) &
+         CALL flioinqv (fid,v_n="time_counter",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) 
+       CALL bcast(l_d_w)
+       tml=l_d_w(1)
+       WRITE(numout,*) "tml =",tml
+!    ENDIF
+    IF (is_root_prc) &
+         CALL flioinqv (fid,v_n="lon",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) 
+    CALL bcast(l_d_w)
+    iml=l_d_w(1)
+    WRITE(numout,*) "iml =",iml
+    
+    IF (is_root_prc) &
+         CALL flioinqv (fid,v_n="lat",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) 
+    CALL bcast(l_d_w)
+    jml=l_d_w(1)
+    WRITE(numout,*) "jml =",jml
+    
+    IF (is_root_prc) &
+         CALL flioinqv (fid,v_n="veget",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) 
+    CALL bcast(l_d_w)
+    lml=l_d_w(1)
+    WRITE(numout,*) "lml =",lml
+
+    IF (lml /= nvm) &
+         CALL ipslerr_p (3,'slowproc_update', &
+               &          'Problem with vegetation file for Land Use','lml /= nvm', &
+               &          '(number of pft must be equal)')
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(lat_lu(jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lat_lu : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(lon_lu(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lon_lu : ",ALLOC_ERR
+      STOP 
+    ENDIF
+
+!    IF ( veget_year > 0 ) THEN
+       IF (tml > 0) THEN
+          ALLOC_ERR=-1
+          ALLOCATE(itau(tml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR/=0) THEN
+             WRITE(numout,*) "ERROR IN ALLOCATION of itau : ",ALLOC_ERR
+             STOP 
+          ENDIF
+       ENDIF
+       !
+    IF ( veget_year > 0 ) THEN
+       IF (is_root_prc) THEN
+          IF (tml > 0) THEN
+             CALL fliogstc (fid, t_axis=itau,x_axis=lon_lu,y_axis=lat_lu)
+             IF (veget_year <= tml) THEN
+                CALL fliogetv (fid,"time_counter",time_counter, start=(/ veget_year /), count=(/ 1 /))
+                WRITE(numout,*) "slowproc_update LAND_USE : the date read for vegetmax is ",time_counter
+             ELSE
+                CALL fliogetv (fid,"time_counter",time_counter, start=(/ tml /), count=(/ 1 /))
+                WRITE(numout,*) "slowproc_update LAND_USE : You try to update vegetmax with a the date greater than in the file."
+                WRITE(numout,*) "                           We will keep the last one :",time_counter
+             ENDIF
+          ELSE
+             CALL fliogstc (fid, x_axis=lon_lu,y_axis=lat_lu)
+          ENDIF
+       ENDIF
+    ENDIF
+    IF (tml > 0) THEN
+       CALL bcast(itau)
+    ENDIF
+    CALL bcast(lon_lu)
+    CALL bcast(lat_lu)
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(lat_ful(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lat_ful : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(lon_ful(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lon_ful : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    DO ip=1,iml
+       lon_ful(ip,:)=lon_lu(ip)
+    ENDDO
+    DO jp=1,jml
+       lat_ful(:,jp)=lat_lu(jp)
+    ENDDO
+    !
+    !
+    WRITE(numout,*) 'Reading the LAND USE vegetation file'
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(vegmap(iml,jml,nvm,1), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of vegmap : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    IF ( veget_year == 0 ) THEN
+       IF (is_root_prc) THEN
+          ALLOC_ERR=-1
+          ALLOCATE(vegmap_1(iml,jml,nvm), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR/=0) THEN
+             WRITE(numout,*) "ERROR IN ALLOCATION of vegmap_1 : ",ALLOC_ERR
+             STOP 
+          ENDIF
+       ENDIF
+    ENDIF
+    !
+!!!$    CALL flinopen &
+!!!$       &  (filename, .FALSE., iml, jml, lml, lon_ful, lat_ful, &
+!!!$       &   lev_ful, tml, itau, date, dt, fid)
+!!!=> FATAL ERROR FROM ROUTINE flinopen
+!!! --> No time axis found
+ !!
+!!!MM modif TAG 1.4 : 
+!!!    CALL flinget(fid, 'lon', iml, 0, 0, 0, 1, 1, lon_lu)
+!!!    CALL flinget(fid, 'lat', jml, 0, 0, 0, 1, 1, lat_lu)
+!!!    CALL flinget(fid, 'maxvegetfrac', iml, jml, nvm, tml, 1, 293, vegmap_lu)
+!!!FATAL ERROR FROM ROUTINE flinopen
+!!! --> No variable lon
+!!!   We get only the right year
+!!!$    CALL flinget(fid, 'maxvegetfrac', iml, jml, nvm, tml, veget_year, veget_year, vegmap)
+!!!$    !
+!!!$    CALL flinclo(fid)
+
+    IF (is_root_prc) &
+         CALL flioinqv (fid,"maxvegetfrac",exv,nb_dims=nb_dim,len_dims=l_d_w,id_dims=i_d_w)
+    CALL bcast(exv)
+    CALL bcast(nb_dim)
+    CALL bcast(l_d_w)
+    CALL bcast(i_d_w)
+
+    IF (exv) THEN
+       IF (debug) THEN
+          WRITE (numout,'(" Number of dimensions : ",I2)') nb_dim
+          WRITE (numout,'(" Dimensions :",/,5(1X,I7,:))') l_d_w(1:nb_dim)
+          WRITE (numout,'(" Identifiers :",/,5(1X,I7,:))') i_d_w(1:nb_dim)
+       ENDIF
+       !
+       IF ( veget_year > 0 ) THEN
+          IF (is_root_prc) THEN
+             IF (veget_year <= tml) THEN
+                CALL fliogetv (fid,"maxvegetfrac", vegmap, start=(/ 1, 1, 1, veget_year /), count=(/ iml, jml, nvm, 1 /))
+             ELSE
+                CALL fliogetv (fid,"maxvegetfrac", vegmap, start=(/ 1, 1, 1, tml /), count=(/ iml, jml, nvm, 1 /))
+             ENDIF
+          ENDIF
+       ELSE
+          IF (is_root_prc) THEN
+             CALL fliogetv (fid,"maxvegetfrac", vegmap_1, start=(/ 1, 1, 1 /), count=(/ iml, jml, nvm /))
+             vegmap(:,:,:,1)=vegmap_1(:,:,:)
+             DEALLOCATE(vegmap_1)
+          ENDIF
+       ENDIF
+       CALL bcast(vegmap)
+       IF (is_root_prc) CALL flioclo (fid)
+    ELSE
+       CALL ipslerr_p (3,'slowproc_update', &
+            &          'Problem with vegetation file for Land Use.', &
+            &          "Variable maxvegetfrac doesn't exist.", &
+            &          '(verify your land use file.)')
+    ENDIF
+    !
+    ! Mask of permitted variables.
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    mask(:,:) = 0
+    DO ip=1,iml
+       DO jp=1,jml
+          sum_veg=SUM(vegmap(ip,jp,:,1))
+          IF ( sum_veg .GE. min_sechiba .AND. sum_veg .LE. 1.-1.e-7) THEN
+             mask(ip,jp) = 1
+             IF (debug) THEN
+                WRITE(numout,*) "update : SUM(vegmap(",ip,jp,")) = ",sum_veg
+             ENDIF
+          ELSEIF ( sum_veg .GT. 1.-1.e-7 .AND. sum_veg .LE. 2.) THEN
+             ! normalization
+             vegmap(ip,jp,:,1) = vegmap(ip,jp,:,1) / sum_veg
+             mask(ip,jp) = 1
+             IF (debug) THEN
+                WRITE(numout,*) "update : SUM(vegmap(",ip,jp,"))_c = ",SUM(vegmap(ip,jp,:,1))
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    !
+    ! The number of maximum vegetation map points in the GCM grid should
+    ! also be computed and not imposed here.
+    !
+    nbvmax = 200
+    !
+    callsign="Land Use Vegetation map"
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+       !WRITE(numout,*) "nbvmax = ",nbvmax
+       !
+       ALLOC_ERR=-1
+       ALLOCATE(sub_index(nbpt, nbvmax,2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+          STOP 
+       ENDIF
+       sub_index(:,:,:)=0
+
+       ALLOC_ERR=-1
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+          STOP 
+       ENDIF
+       sub_area(:,:)=zero
+       !
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon_ful, lat_ful, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       !
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+       ENDIF
+       !
+       nbvmax = nbvmax * 2
+    ENDDO
+    !
+    ! Compute the logical for partial (only anthropic) PTFs update
+    IF (PRESENT(init)) THEN
+       partial_update = control%ok_dgvm  .AND. .NOT. init
+    ELSE
+       partial_update = control%ok_dgvm  
+    ENDIF
+    !
+    IF ( .NOT. partial_update ) THEN
+       !
+       veget_next(:,:)=zero
+       !
+       DO ib = 1, nbpt
+          sumf=zero
+          DO idi=1, nbvmax
+             ! Leave the do loop if all sub areas are treated, sub_area <= 0
+             IF ( sub_area(ib,idi) <= zero ) EXIT
+             ip = sub_index(ib,idi,1)
+             jp = sub_index(ib,idi,2)
+             veget_next(ib,:) = veget_next(ib,:) + vegmap(ip,jp,:,1)*sub_area(ib,idi)
+             sumf=sumf + sub_area(ib,idi)
+          ENDDO
+!!!$          !
+!!!$          !  Limit the smalest vegetation fraction to 0.5%
+!!!$          !
+!!!$          DO jv = 1, nvm
+!!!$             IF ( veget_next(ib,jv) .LT. min_vegfrac ) THEN
+!!!$                veget_next(ib,jv) = zero
+!!!$             ENDIF
+!!!$          ENDDO
+          !
+          ! Normalize
+          !
+          IF (sumf > min_sechiba) THEN
+             veget_next(ib,:) = veget_next(ib,:) / sumf
+          ELSE
+             WRITE(numout,*) "slowproc_update : No land point in the map for point ",&
+                  ib,",(",lalo(ib,1),",",lalo(ib,2),")" 
+             CALL ipslerr_p (2,'slowproc_update', &
+                  &          'Problem with vegetation file for Land Use.', &
+                  &          "No land point in the map for point", &
+                  &          'Keep old values. (verify your land use file.)')
+!!$             CALL slowproc_nearest (iml, lon_ful, lat_ful, &
+!!$                  lalo(ib,2), lalo(ib,1), inear)
+             IF (PRESENT(init)) THEN
+                IF (init) THEN
+                    veget_next(ib,1) = un
+                    veget_next(ib,2:nvm) = zero
+                ELSE
+                   veget_next(ib,:) = veget_last(ib,:)
+                ENDIF
+             ELSE
+                veget_next(ib,:) = veget_last(ib,:)
+             ENDIF
+          ENDIF
+          !
+          IF (debug) THEN
+             WRITE(numout,*) "SUM(veget_next(",ib,")) = ",SUM(veget_next(ib,:))
+          ENDIF
+       ENDDO
+    ELSE
+       DO ib = 1, nbpt
+          ! last veget for this point
+          sum_veg=SUM(veget_last(ib,:))
+          IF (debug) THEN
+             WRITE(numout,*) "SUM(veget_last(",ib,")) = ",sum_veg
+          ENDIF
+          !
+          ! If the DGVM is activated, only anthropiques PFT are utpdated,
+          ! other are copied 
+          veget_next(ib,:) = veget_last(ib,:)
+          !
+          ! natural ones are initialized to zero.
+          DO jv = 2, nvm
+             ! If the DGVM is activated, only anthropiques PFT are utpdated 
+             IF ( .NOT. natural(jv) ) THEN
+                veget_next(ib,jv) = zero
+             ENDIF
+          ENDDO
+          !
+          sumf=zero
+          DO idi=1, nbvmax
+             ! Leave the do loop if all sub areas are treated, sub_area <= 0
+             IF ( sub_area(ib,idi) <= zero ) EXIT
+             ip = sub_index(ib,idi,1)
+             jp = sub_index(ib,idi,2)
+             ! If the DGVM is activated, only anthropic PFTs are utpdated 
+             DO jv = 2, nvm
+                IF ( .NOT. natural(jv) ) THEN       
+                   veget_next(ib,jv) = veget_next(ib,jv) + vegmap(ip,jp,jv,1)*sub_area(ib,idi)
+                ENDIF
+             ENDDO
+             sumf=sumf + sub_area(ib,idi)
+          ENDDO
+!!!$          !
+!!!$          !  Limit the smalest vegetation fraction to 0.5%
+!!!$          !
+!!!$          DO jv = 2, nvm
+!!!$             ! On anthropic and natural PFTs ? 
+!!!$             IF ( veget_next(ib,jv) .LT. min_vegfrac ) THEN
+!!!$                veget_next(ib,jv) = zero
+!!!$             ENDIF
+!!!$          ENDDO
+          !
+          ! Normalize
+          !
+          ! Proposition de Pierre :
+          ! apres modification de la surface des PFTs anthropiques,
+          ! on doit conserver la proportion des PFTs naturels.
+          ! ie la somme des vegets est conservee
+          !    et PFT naturel / (somme des vegets - somme des vegets anthropiques)
+          !       est conservee.
+          ! Modification de Nathalie : 
+          ! Si les PFTs anthropique diminue, on les remplace plutôt par du sol nu.
+          ! Le DGVM est chargé de ré-introduire les PFTs naturels.
+          IF (sumf > min_sechiba) THEN
+             sumvAnthro_old = zero
+             sumvAnthro     = zero
+             DO jv = 2, nvm
+                IF ( .NOT. natural(jv) ) THEN
+                   veget_next(ib,jv) = veget_next(ib,jv) / sumf
+                   sumvAnthro = sumvAnthro + veget_next(ib,jv)
+                   sumvAnthro_old = sumvAnthro_old + veget_last(ib,jv)
+                ENDIF
+             ENDDO
+
+             IF ( sumvAnthro_old < sumvAnthro ) THEN
+                ! deforestation
+                ! conservation :
+                rapport = ( sum_veg - sumvAnthro ) / ( sum_veg - sumvAnthro_old )
+                DO jv = 1, nvm
+                   IF ( natural(jv) ) THEN
+                      veget_next(ib,jv) = veget_last(ib,jv) * rapport
+                   ENDIF
+                ENDDO
+             ELSE
+                ! reforestation
+                DO jv = 1, nvm
+                   IF ( natural(jv) ) THEN
+                      veget_next(ib,jv) = veget_last(ib,jv)
+                   ENDIF
+                ENDDO
+                veget_next(ib,1) = veget_next(ib,1) + sumvAnthro_old - sumvAnthro
+             ENDIF
+
+             ! test
+             IF ( ABS( SUM(veget_next(ib,:)) - sum_veg ) > 10*EPSILON(un) ) THEN
+                WRITE(numout,*) "No conservation of sum of veget for point ",ib,",(",lalo(ib,1),",",lalo(ib,2),")" 
+                WRITE(numout,*) "last sum of veget ",sum_veg," new sum of veget ",SUM(veget_next(ib,:))," error : ",&
+                     &                         SUM(veget_next(ib,:)) - sum_veg
+                WRITE(numout,*) "Anthropic modifications : last ",sumvAnthro_old," new ",sumvAnthro     
+                CALL ipslerr_p (3,'slowproc_update', &
+                     &          'No conservation of sum of veget_next', &
+                     &          "The sum of veget_next is different after reading Land Use map.", &
+                     &          '(verify the dgvm case model.)')
+             ENDIF
+          ELSE
+             WRITE(numout,*) "No land point in the map for point ",ib,",(",lalo(ib,1),",",lalo(ib,2),")" 
+!             CALL ipslerr_p (3,'slowproc_update', &
+             CALL ipslerr_p (2,'slowproc_update', &
+                  &          'Problem with vegetation file for Land Use.', &
+                  &          "No land point in the map for point", &
+                  &          '(verify your land use file.)')
+             veget_next(ib,:) = veget_last(ib,:)
+          ENDIF
+          
+       ENDDO       
+    ENDIF
+    !
+    frac_nobio_next (:,:) = un
+    !
+!MM
+    ! Work only for one nnobio !! (ie ice)
+    DO inobio=1,nnobio
+       DO jv=1,nvm
+          !
+          DO ib = 1, nbpt
+             frac_nobio_next(ib,inobio) = frac_nobio_next(ib,inobio) - veget_next(ib,jv)
+          ENDDO
+       ENDDO
+       !
+    ENDDO
+    !
+    DO ib = 1, nbpt
+       sum_veg = SUM(veget_next(ib,:))
+       sum_nobio = SUM(frac_nobio_next(ib,:))
+       IF (sum_nobio < 0.) THEN
+          frac_nobio_next(ib,:) = zero
+          veget_next(ib,1) = veget_next(ib,1) - sum_nobio
+          sum_veg = SUM(veget_next(ib,:))
+       ENDIF
+       sumf = sum_veg + sum_nobio
+       IF (sumf > min_sechiba) THEN
+          veget_next(ib,:) = veget_next(ib,:) / sumf
+          frac_nobio_next(ib,:) = frac_nobio_next(ib,:) / sumf
+          norm=SUM(veget_next(ib,:))+SUM(frac_nobio_next(ib,:))
+          err=norm-un
+          IF (debug) &
+             WRITE(numout,*) "ib ",ib," SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-un, sumf",err,sumf
+          IF (abs(err) > -EPSILON(un)) THEN
+!MM 1.9.3
+!          IF (abs(err) > 0.) THEN
+             IF ( SUM(frac_nobio_next(ib,:)) > min_sechiba ) THEN
+                frac_nobio_next(ib,1) = frac_nobio_next(ib,1) - err
+             ELSE
+                veget_next(ib,1) = veget_next(ib,1) - err
+             ENDIF
+             norm=SUM(veget_next(ib,:))+SUM(frac_nobio_next(ib,:))
+             err=norm-un
+             IF (debug) &
+                  WRITE(numout,*) "ib ",ib," SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-un",err
+             IF (abs(err) > EPSILON(un)) THEN
+!MM 1.9.3
+!             IF (abs(err) > 0.) THEN
+                WRITE(numout,*) "update : Problem with point ",ib,",(",lalo(ib,1),",",lalo(ib,2),")" 
+                WRITE(numout,*) "         err(sum-1.) = ",abs(err)
+                CALL ipslerr_p (2,'slowproc_update', &
+                     &          'Problem with sum vegetation + sum fracnobio for Land Use.', &
+                     &          "sum not equal to 1.", &
+                     &          '(verify your land use file.)')
+             ENDIF
+          ENDIF
+       ELSE
+          WRITE(numout,*) "No vegetation nor frac_nobio for point ",ib,",(",lalo(ib,1),",",lalo(ib,2),")" 
+          WRITE(numout,*)"Replaced by bare_soil !! "
+          veget_next(ib,1) = un
+          veget_next(ib,2:nvm) = zero
+          frac_nobio_next(ib,:) = zero
+!!!$          CALL ipslerr_p (3,'slowproc_update', &
+!!!$               &          'Problem with vegetation file for Land Use.', &
+!!!$               &          "No vegetation nor frac_nobio for point ", &
+!!!$               &          '(verify your land use file.)')
+       ENDIF
+    ENDDO
+    !
+    WRITE(numout,*) 'slowproc_update : Interpolation Done'
+    !
+    DEALLOCATE(vegmap)
+    DEALLOCATE(lat_lu,lon_lu)
+    DEALLOCATE(lat_ful,lon_ful)
+    DEALLOCATE(mask)
+    DEALLOCATE(sub_index,sub_area)
+    !
+    RETURN
+    !
+  END SUBROUTINE slowproc_update
+
+
+! NEED TO GET RID OF SLOWPROC_INTERPOL_OLD because it is never called!
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_interpol_OLD
+!!
+!>\BRIEF         Interpolate the IGBP vegetation map to the grid of the model
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  !MM TAG 1.6 model !
+  SUBROUTINE slowproc_interpol_OLD(nbpt, lalo, neighbours, resolution, veget, frac_nobio )
+  !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)          :: nbpt                  !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)             :: lalo(nbpt,2)          !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)          :: neighbours(nbpt,8)    !! Vector of neighbours for each grid point 
+                                                                 !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), INTENT(in)             :: resolution(nbpt,2)    !! The size in km of each grid-box in X and Y
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)    ::  veget(nbpt,nvm)         !! Vegetation fractions
+    REAL(r_std), INTENT(out)    ::  frac_nobio(nbpt,nnobio) !! Fraction of the mesh which is covered by ice, lakes, ...
+    !
+    !  0.3 LOCAL
+    !
+    INTEGER(i_std), PARAMETER                       :: nolson = 94  !! Number of Olson classes
+    !
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, vid
+    REAL(r_std) :: lev(1), date, dt, coslat
+    INTEGER(i_std) :: itau(1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lat_ful, lon_ful, vegmap
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lon_up, lon_low, lat_up, lat_low
+    INTEGER, DIMENSION(nbpt,nolson) :: n_origveg
+    INTEGER, DIMENSION(nbpt) :: n_found
+    REAL(r_std), DIMENSION(nbpt,nolson) :: frac_origveg
+    REAL(r_std) :: vegcorr(nolson,nvm)
+    REAL(r_std) :: nobiocorr(nolson,nnobio)
+    CHARACTER(LEN=80) :: meter
+    REAL(r_std) :: prog, sumf
+    LOGICAL :: found
+    INTEGER :: idi, ilast, ii, jv, inear, iprog
+    REAL(r_std) :: domaine_lon_min, domaine_lon_max, domaine_lat_min, domaine_lat_max
+!_ ================================================================================================================================
+    !
+    CALL get_vegcorr (nolson,vegcorr,nobiocorr)
+    !
+    !Config Key   = VEGETATION_FILE
+    !Config Desc  = Name of file from which the vegetation map is to be read
+    !Config If    = NOT(IMPOSE_VEG)
+    !Config Def   = carteveg5km.nc
+    !Config Help  = The name of the file to be opened to read the vegetation
+    !Config         map is to be given here. Usualy SECHIBA runs with a 5kmx5km
+    !Config         map which is derived from the IGBP one. We assume that we have
+    !Config         a classification in 87 types. This is Olson modified by Viovy.
+    !Config Units = [FILE]
+    !
+    filename = 'carteveg5km.nc'
+    CALL getin_p('VEGETATION_FILE',filename)
+    !
+    if (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    !
+    !
+    ALLOCATE(lat_ful(iml))
+    ALLOCATE(lon_ful(iml))
+    ALLOCATE(vegmap(iml))
+    !
+    WRITE(numout,*) 'Reading the vegetation file'
+    !
+    IF (is_root_prc) THEN
+       CALL flinget(fid, 'longitude', iml, jml, lml, tml, 1, 1, lon_ful)
+       CALL flinget(fid, 'latitude', iml, jml, lml, tml, 1, 1, lat_ful)
+       CALL flinget(fid, 'vegetation_map', iml, jml, lml, tml, 1, 1, vegmap)
+       !
+       CALL flinclo(fid)
+    ENDIF
+    
+    CALL bcast(lon_ful)
+    CALL bcast(lat_ful)
+    CALL bcast(vegmap)
+    
+    !
+    IF (MAXVAL(vegmap) .LT. nolson) THEN
+       WRITE(numout,*) 'WARNING -- WARNING'
+       WRITE(numout,*) 'The vegetation map has to few vegetation types.'
+       WRITE(numout,*) 'If you are lucky it will work but please check'
+    ELSE IF ( MAXVAL(vegmap) .GT. nolson) THEN
+       WRITE(numout,*) 'More vegetation types in file than the code can'
+       WRITE(numout,*) 'deal with.: ',  MAXVAL(vegmap),  nolson
+       STOP 'slowproc_interpol'
+    ENDIF
+    !
+    ALLOCATE(lon_up(nbpt)) 
+    ALLOCATE(lon_low(nbpt))
+    ALLOCATE(lat_up(nbpt))
+    ALLOCATE(lat_low(nbpt))
+    !
+    DO ib =1, nbpt
+       !
+       !  We find the 4 limits of the grid-box. As we transform the resolution of the model
+       !  into longitudes and latitudes we do not have the problem of periodicity.
+       !  coslat is a help variable here !
+       !
+       coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+       !
+       lon_up(ib) = lalo(ib,2) + resolution(ib,1)/(2.0*coslat) 
+       lon_low(ib) = lalo(ib,2) - resolution(ib,1)/(2.0*coslat) 
+       !
+       coslat = pi/180. * R_Earth
+       !
+       lat_up(ib) = lalo(ib,1) + resolution(ib,2)/(2.0*coslat) 
+       lat_low(ib) = lalo(ib,1) - resolution(ib,2)/(2.0*coslat) 
+       !
+       !
+       veget(ib,:) = zero
+       frac_nobio (ib,:) = zero
+       !
+    ENDDO
+    !
+    !  Get the limits of the integration domaine so that we can speed up the calculations
+    !
+    domaine_lon_min = MINVAL(lon_low)
+    domaine_lon_max = MAXVAL(lon_up)
+    domaine_lat_min = MINVAL(lat_low)
+    domaine_lat_max = MAXVAL(lat_up)
+    !
+!!$    WRITE(*,*) 'DOMAINE lon :', domaine_lon_min, domaine_lon_max
+!!$    WRITE(*,*) 'DOMAINE lat :', domaine_lat_min, domaine_lat_max
+    !
+    ! Ensure that the fine grid covers the whole domain
+    WHERE ( lon_ful(:) .LT. domaine_lon_min )
+      lon_ful(:) = lon_ful(:) + 360.
+    ENDWHERE
+    !
+    WHERE ( lon_ful(:) .GT. domaine_lon_max )
+      lon_ful(:) = lon_ful(:) - 360.
+    ENDWHERE
+    !
+    WRITE(numout,*) 'Interpolating the vegetation map :'
+    WRITE(numout,'(2a40)')'0%--------------------------------------', &
+                   & '------------------------------------100%'
+    !
+    ilast = 1
+    n_origveg(:,:) = 0
+    !
+    DO ip=1,iml
+      !
+      !   Give a progress meter
+      !
+      ! prog = ip/float(iml)*79.
+      !  IF ( ABS(prog - NINT(prog)) .LT. 1/float(iml)*79. ) THEN
+      !   meter(NINT(prog)+1:NINT(prog)+1) = 'x'
+      !   WRITE(numout, advance="no", FMT='(a)') ACHAR(13)
+      !   WRITE(numout, advance="no", FMT='(a80)') meter
+      ! ENDIF
+      iprog = NINT(float(ip)/float(iml)*79.) - NINT(float(ip-1)/float(iml)*79.)
+      IF ( iprog .NE. 0 ) THEN
+        WRITE(numout,'(a1,$)') 'x'
+      ENDIF
+      !
+      !  Only start looking for its place in the smaler grid if we are within the domaine
+      !  That should speed up things !
+      !
+      IF ( ( lon_ful(ip) .GE. domaine_lon_min ) .AND. &
+           ( lon_ful(ip) .LE. domaine_lon_max ) .AND. &
+           ( lat_ful(ip) .GE. domaine_lat_min ) .AND. &
+           ( lat_ful(ip) .LE. domaine_lat_max )        ) THEN
+        !
+        ! look for point on GCM grid which this point on fine grid belongs to.
+        ! First look at the point on the model grid where we arrived just before. There is 
+        ! a good chace that neighbouring points on the fine grid fall into the same model
+        ! grid box.
+        !
+        !
+        ! THERE IS A BUG HERE !!! IF THE GCM GRID SITS ON THE DATE LINE WE WILL HAVE FOR INSTANCE
+        ! LON_LOW = -182 AND LON_UP = -178. THUS WE WILL ONLY PICK UP HALF THE POINTS NEEDED.
+        !
+        IF ( ( lon_ful(ip) .GT. lon_low(ilast) ) .AND. &
+             ( lon_ful(ip) .LT. lon_up(ilast) ) .AND. &
+             ( lat_ful(ip) .GT. lat_low(ilast) ) .AND. &
+             ( lat_ful(ip) .LT. lat_up(ilast) )         ) THEN
+          !
+          ! We were lucky
+          !
+          n_origveg(ilast,NINT(vegmap(ip))) = n_origveg(ilast,NINT(vegmap(ip))) + 1
+          !
+        ELSE
+          !
+          ! Otherwise, look everywhere.
+          ! Begin close to last grid point.
+          !
+          found = .FALSE. 
+          idi = 1
+          !
+          DO WHILE ( (idi .LT. nbpt) .AND. ( .NOT. found ) )
+            !
+            ! forward and backward
+            !
+            DO ii = 1,2
+              !
+              IF ( ii .EQ. 1 ) THEN
+                ib = ilast - idi
+              ELSE
+                ib = ilast + idi
+              ENDIF
+              !
+              IF ( ( ib .GE. 1 ) .AND. ( ib .LE. nbpt ) ) THEN
+                IF ( ( lon_ful(ip) .GT. lon_low(ib) ) .AND. &
+                     ( lon_ful(ip) .LT. lon_up(ib) ) .AND. &
+                     ( lat_ful(ip) .GT. lat_low(ib) ) .AND. &
+                     ( lat_ful(ip) .LT. lat_up(ib) )         ) THEN
+                  !
+                  n_origveg(ib,NINT(vegmap(ip))) = n_origveg(ib,NINT(vegmap(ip))) + 1
+                  ilast = ib
+                  found = .TRUE.
+                  !
+                ENDIF
+              ENDIF
+              !
+            ENDDO
+            !
+            idi = idi + 1
+            !
+          ENDDO
+          !
+        ENDIF ! lucky/not lucky
+        !
+      ENDIF     ! in the domain
+    ENDDO
+
+    !
+    ! Now we know how many points of which Olson type from the fine grid fall
+    ! into each box of the (coarse) model grid: n_origveg(nbpt,nolson)
+    !
+
+    !
+    ! determine number of points of the fine grid which fall into each box of the 
+    ! coarse grid
+    !
+    DO ib = 1, nbpt
+      n_found(ib) = SUM( n_origveg(ib,:) )
+    ENDDO
+
+    !
+    ! determine fraction of Olson vegetation type in each box of the coarse grid
+    !
+    DO vid = 1, nolson
+      WHERE ( n_found(:) .GT. 0 ) 
+        frac_origveg(:,vid) =  REAL(n_origveg(:,vid),r_std) /  REAL(n_found(:),r_std)
+      ELSEWHERE
+         frac_origveg(:,vid) = zero
+      ENDWHERE
+    ENDDO
+
+    !
+    ! now finally calculate coarse vegetation map
+    ! Find which model vegetation corresponds to each Olson type 
+    !
+    DO vid = 1, nolson
+      !
+      DO jv = 1, nvm
+        veget(:,jv) = veget(:,jv) + frac_origveg(:,vid) * vegcorr(vid,jv)
+      ENDDO
+      !
+      DO jv = 1, nnobio
+        frac_nobio(:,jv) = frac_nobio(:,jv) + frac_origveg(:,vid) * nobiocorr(vid,jv)
+      ENDDO
+      !
+    ENDDO
+    !
+    !
+    WRITE(numout,*)
+    WRITE(numout,*) 'Interpolation Done'
+    !
+    !   Clean up the point of the map
+    !
+    DO ib = 1, nbpt
+       !
+       !  Let us see if all points found something in the 5km map !
+       !
+       IF ( n_found(ib) .EQ. 0 ) THEN
+          !
+          ! Now we need to handle some exceptions
+          !
+          IF ( lalo(ib,1) .LT. -56.0) THEN
+             ! Antartica
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+             !
+          ELSE IF ( lalo(ib,1) .GT. 70.0) THEN
+             ! Artica
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+             !
+          ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN
+             ! Greenland
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+             !
+          ELSE
+             !
+             WRITE(numout,*) 'PROBLEM, no point in the 5km map found for this grid box'
+             WRITE(numout,*) 'Longitude range : ', lon_low(ib), lon_up(ib)
+             WRITE(numout,*) 'Latitude range : ', lat_low(ib), lat_up(ib)
+             !
+             WRITE(numout,*) 'Looking for nearest point on the 5 km map'
+             CALL slowproc_nearest (iml, lon_ful, lat_ful, &
+                                    lalo(ib,2), lalo(ib,1), inear)
+             WRITE(numout,*) 'Coordinates of the nearest point:', &
+                              lon_ful(inear),lat_ful(inear)
+             !
+             DO jv = 1, nvm
+               veget(ib,jv) = vegcorr(NINT(vegmap(inear)),jv)
+             ENDDO
+             !
+             DO jv = 1, nnobio
+               frac_nobio(ib,jv) = nobiocorr(NINT(vegmap(inear)),jv)
+             ENDDO
+             !
+          ENDIF
+          !
+       ENDIF
+       !
+       !
+       !  Limit the smalest vegetation fraction to 0.5%
+       !
+       DO vid = 1, nvm
+          IF ( veget(ib,vid) .LT. min_vegfrac ) THEN
+             veget(ib,vid) = zero
+          ENDIF
+       ENDDO
+       !
+       sumf = SUM(frac_nobio(ib,:))+SUM(veget(ib,:))
+       frac_nobio(ib,:) = frac_nobio(ib,:)/sumf
+       veget(ib,:) = veget(ib,:)/sumf
+       !
+       !       
+    ENDDO
+    !
+    DEALLOCATE(lon_up)
+    DEALLOCATE(lon_low)
+    DEALLOCATE(lat_up)
+    DEALLOCATE(lat_low)
+    DEALLOCATE(lat_ful)
+    DEALLOCATE(lon_ful)
+    DEALLOCATE(vegmap)
+    !
+    RETURN
+    !
+ END SUBROUTINE slowproc_interpol_OLD
+
+
+! NEED TO GET RID OF SLOWPROC_INTERPOL_NEW because it is never called!
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_interpol_NEW
+!!
+!>\BRIEF         Interpolate the IGBP vegetation map to the grid of the model
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_interpol_NEW(nbpt, lalo, neighbours, resolution, contfrac, veget, frac_nobio )
+    !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)          :: nbpt                  !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)              :: lalo(nbpt,2)         !! Vector of latitude and longitudes (beware of the order!)
+    INTEGER(i_std), INTENT(in)          :: neighbours(nbpt,8)    !! Vector of neighbours for each grid point 
+                                                                 !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), INTENT(in)              :: resolution(nbpt,2)   !! The size in km of each grid-box in X and Y
+    REAL(r_std),DIMENSION (nbpt), INTENT (in) :: contfrac        !! Fraction of continent in the grid
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)    ::  veget(nbpt,nvm)              !! Vegetation fractions
+    REAL(r_std), INTENT(out)    ::  frac_nobio(nbpt,nnobio)      !! Fraction of the mesh which is covered by ice, lakes, ...
+    !
+    LOGICAL ::           ok_interpol                             !! optionnal return of aggregate_vec
+    !
+    !  0.3 LOCAL
+    !
+    INTEGER(i_std), PARAMETER  :: nolson = 94                    !! Number of Olson classes
+    !
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, vid
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lat_ful, lon_ful, vegmap
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: sub_area
+    INTEGER(i_std),ALLOCATABLE, DIMENSION(:,:) :: sub_index
+    REAL(r_std), DIMENSION(nbpt,nolson) :: n_origveg
+    REAL(r_std), DIMENSION(nbpt) :: n_found
+    REAL(r_std), DIMENSION(nbpt,nolson) :: frac_origveg
+    REAL(r_std) :: vegcorr(nolson,nvm)
+    REAL(r_std) :: nobiocorr(nolson,nnobio)
+    CHARACTER(LEN=40) :: callsign
+    REAL(r_std) :: sumf, resol_lon, resol_lat
+    INTEGER(i_std) :: idi, jv, inear, nbvmax, nix, njx
+    !
+    INTEGER                  :: ALLOC_ERR
+
+!_ ================================================================================================================================
+    !
+    n_origveg(:,:) = zero
+    n_found(:) = zero
+    !
+    CALL get_vegcorr (nolson,vegcorr,nobiocorr)
+    !
+    !Config Key   = VEGETATION_FILE
+    !Config Desc  = Name of file from which the vegetation map is to be read
+    !Config If    = NOT(IMPOSE_VEG) and NOT(LAND_USE)
+    !Config Def   = carteveg5km.nc
+    !Config Help  = The name of the file to be opened to read the vegetation
+    !Config         map is to be given here. Usualy SECHIBA runs with a 5kmx5km
+    !Config         map which is derived from the IGBP one. We assume that we have
+    !Config         a classification in 87 types. This is Olson modified by Viovy.
+    !Config Units = [FILE]
+    !
+    filename = 'carteveg5km.nc'
+    CALL getin_p('VEGETATION_FILE',filename)
+    !
+    if (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    !
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(lat_ful(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lat_ful : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(lon_ful(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lon_ful : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(vegmap(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of vegmap : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    WRITE(numout,*) 'Reading the OLSON type vegetation file'
+    !
+    IF (is_root_prc) THEN
+       CALL flinget(fid, 'longitude', iml, jml, lml, tml, 1, 1, lon_ful)
+       CALL flinget(fid, 'latitude', iml, jml, lml, tml, 1, 1, lat_ful)
+       CALL flinget(fid, 'vegetation_map', iml, jml, lml, tml, 1, 1, vegmap)
+       !
+       CALL flinclo(fid)
+    ENDIF
+    
+    CALL bcast(lon_ful)
+    CALL bcast(lat_ful)
+    CALL bcast(vegmap)
+    
+    !
+    IF (MAXVAL(vegmap) .LT. nolson) THEN
+       WRITE(numout,*) 'WARNING -- WARNING'
+       WRITE(numout,*) 'The vegetation map has to few vegetation types.'
+       WRITE(numout,*) 'If you are lucky it will work but please check'
+    ELSE IF ( MAXVAL(vegmap) .GT. nolson) THEN
+       WRITE(numout,*) 'More vegetation types in file than the code can'
+       WRITE(numout,*) 'deal with.: ',  MAXVAL(vegmap),  nolson
+       STOP 'slowproc_interpol'
+    ENDIF
+    !
+    ! Some assumptions on the vegetation file. This information should be
+    ! be computed or read from the file. 
+    ! It is the reolution in meters of the grid of the vegetation file.
+    !
+    resol_lon = 5000.
+    resol_lat = 5000.
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution_g(:,1))*2/resol_lon)+2
+       njx=INT(MAXVAL(resolution_g(:,2))*2/resol_lon)+2
+       nbvmax = nix*njx
+    ENDIF
+    CALL bcast(nbvmax)
+    !
+    callsign="Vegetation map"
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+    !WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+       !
+       ALLOC_ERR=-1
+       ALLOCATE(sub_index(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+          STOP 
+       ENDIF
+       sub_index(:,:)=0
+       ALLOC_ERR=-1
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+          STOP 
+       ENDIF
+       sub_area(:,:)=zero
+       !
+    WRITE(numout,*) 'Carteveg range LON:', MINVAL(lon_ful), MAXVAL(lon_ful)
+    WRITE(numout,*) 'Carteveg range LAT:', MINVAL(lat_ful), MAXVAL(lat_ful)
+    !
+       CALL aggregate_p (nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, lon_ful, lat_ful, resol_lon, resol_lat, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       !
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          !
+          nbvmax = nbvmax * 2
+       ELSE
+          !
+          DO ib = 1, nbpt
+             DO idi=1, nbvmax
+                ! Leave the do loop if all sub areas are treated, sub_area <= 0
+                IF ( sub_area(ib,idi) <= zero ) EXIT 
+                ip = sub_index(ib,idi)
+                n_origveg(ib,NINT(vegmap(ip))) = n_origveg(ib,NINT(vegmap(ip))) + sub_area(ib,idi)
+                n_found(ib) =  n_found(ib) + sub_area(ib,idi)
+             ENDDO
+          ENDDO
+          !
+       ENDIF
+    ENDDO
+    !
+    ! Now we know how many points of which Olson type from the fine grid fall
+    ! into each box of the (coarse) model grid: n_origveg(nbpt,nolson)
+    !
+    !
+    ! determine fraction of Olson vegetation type in each box of the coarse grid
+    !
+    DO vid = 1, nolson
+       WHERE ( n_found(:) .GT. 0 ) 
+          frac_origveg(:,vid) = n_origveg(:,vid) / n_found(:)
+       ELSEWHERE
+          frac_origveg(:,vid) = zero
+       ENDWHERE
+    ENDDO
+    !
+    ! now finally calculate coarse vegetation map
+    ! Find which model vegetation corresponds to each Olson type 
+    !
+    veget(:,:) = zero
+    frac_nobio(:,:) = zero
+    !
+    DO vid = 1, nolson
+       !
+       DO jv = 1, nvm
+          veget(:,jv) = veget(:,jv) + frac_origveg(:,vid) * vegcorr(vid,jv)
+       ENDDO
+       !
+       DO jv = 1, nnobio
+          frac_nobio(:,jv) = frac_nobio(:,jv) + frac_origveg(:,vid) * nobiocorr(vid,jv)
+       ENDDO
+       !
+    ENDDO
+    !
+    WRITE(numout,*) 'slowproc_interpol : Interpolation Done'
+    !
+    !   Clean up the point of the map
+    !
+    DO ib = 1, nbpt
+       !
+       !  Let us see if all points found something in the 5km map !
+       !
+       IF ( n_found(ib) .EQ. 0 ) THEN
+          !
+          ! Now we need to handle some exceptions
+          !
+          IF ( lalo(ib,1) .LT. -56.0) THEN
+             ! Antartica
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+             !
+          ELSE IF ( lalo(ib,1) .GT. 70.0) THEN
+             ! Artica
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+             !
+          ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN
+             ! Greenland
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+             !
+          ELSE
+             !
+             WRITE(numout,*) 'PROBLEM, no point in the 5km map found for this grid box',ib
+             WRITE(numout,*) 'Longitude range : ', lalo(ib,2)
+             WRITE(numout,*) 'Latitude range : ', lalo(ib,1)
+             !
+             WRITE(numout,*) 'Looking for nearest point on the 5 km map'
+             CALL slowproc_nearest (iml, lon_ful, lat_ful, &
+                  lalo(ib,2), lalo(ib,1), inear)
+             WRITE(numout,*) 'Coordinates of the nearest point:', &
+                  lon_ful(inear),lat_ful(inear)
+             !
+             DO jv = 1, nvm
+                veget(ib,jv) = vegcorr(NINT(vegmap(inear)),jv)
+             ENDDO
+             !
+             DO jv = 1, nnobio
+                frac_nobio(ib,jv) = nobiocorr(NINT(vegmap(inear)),jv)
+             ENDDO
+             !
+          ENDIF
+          !
+       ENDIF
+       !
+       !
+       !  Limit the smalest vegetation fraction to 0.5%
+       !
+       DO vid = 1, nvm
+          IF ( veget(ib,vid) .LT. min_vegfrac ) THEN
+             veget(ib,vid) = zero
+          ENDIF
+       ENDDO
+       !
+       sumf = SUM(frac_nobio(ib,:))+SUM(veget(ib,:))
+       frac_nobio(ib,:) = frac_nobio(ib,:)/sumf
+       veget(ib,:) = veget(ib,:)/sumf
+       !
+       !       
+    ENDDO
+    !
+    DEALLOCATE(vegmap)
+    DEALLOCATE(lat_ful, lon_ful)
+    DEALLOCATE(sub_index)
+    DEALLOCATE(sub_area)
+
+    !
+    RETURN
+    !
+  END SUBROUTINE slowproc_interpol_NEW
+
+! NEED TO GET RID OF SLOWPROC_INTERPOL_OLD_g because it correspond to version 1.6 of the code
+! for CMIP3 simulations (too old)
+!
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_interpol_OLD_g
+!!
+!>\BRIEF         Interpolate the IGBP vegetation map to the grid of the model
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  !MM TAG 1.6 model !
+  SUBROUTINE slowproc_interpol_OLD_g(nbpt, lalo, neighbours, resolution, veget, frac_nobio )
+  !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)          :: nbpt                  !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)             :: lalo(nbpt,2)          !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)          :: neighbours(nbpt,8)    !! Vector of neighbours for each grid point 
+                                                                 !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), INTENT(in)             :: resolution(nbpt,2)    !! The size in km of each grid-box in X and Y
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)    ::  veget(nbpt,nvm)         !! Vegetation fractions
+    REAL(r_std), INTENT(out)    ::  frac_nobio(nbpt,nnobio) !! Fraction of the mesh which is covered by ice, lakes, ...
+    !
+    !  0.3 LOCAL
+    !
+    INTEGER(i_std), PARAMETER                       :: nolson = 94      !! Number of Olson classes
+    !
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, vid
+    REAL(r_std) :: lev(1), date, dt, coslat
+    INTEGER(i_std) :: itau(1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lat_ful, lon_ful, vegmap
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lon_up, lon_low, lat_up, lat_low
+    INTEGER, DIMENSION(nbpt,nolson) :: n_origveg
+    INTEGER, DIMENSION(nbpt) :: n_found
+    REAL(r_std), DIMENSION(nbpt,nolson) :: frac_origveg
+    REAL(r_std) :: vegcorr(nolson,nvm)
+    REAL(r_std) :: nobiocorr(nolson,nnobio)
+    CHARACTER(LEN=80) :: meter
+    REAL(r_std) :: prog, sumf
+    LOGICAL :: found
+    INTEGER :: idi, ilast, ii, jv, inear, iprog
+    REAL(r_std) :: domaine_lon_min, domaine_lon_max, domaine_lat_min, domaine_lat_max
+
+!_ ================================================================================================================================
+    !
+    !
+    CALL get_vegcorr (nolson,vegcorr,nobiocorr)
+    !
+    !Config Key   = VEGETATION_FILE
+    !Config Desc  = Name of file from which the vegetation map is to be read
+    !Config If    = NOT(IMPOSE_VEG)
+    !Config Def   = carteveg5km.nc
+    !Config Help  = The name of the file to be opened to read the vegetation
+    !Config         map is to be given here. Usualy SECHIBA runs with a 5kmx5km
+    !Config         map which is derived from the IGBP one. We assume that we have
+    !Config         a classification in 87 types. This is Olson modified by Viovy.
+    !Config Units = [FILE]
+    !
+    filename = 'carteveg5km.nc'
+    CALL getin('VEGETATION_FILE',filename)
+    !
+    CALL flininfo(filename, iml, jml, lml, tml, fid)
+    !
+    !
+    ALLOCATE(lat_ful(iml))
+    ALLOCATE(lon_ful(iml))
+    ALLOCATE(vegmap(iml))
+    !
+    WRITE(numout,*) 'Reading the vegetation file'
+    !
+    CALL flinget(fid, 'longitude', iml, jml, lml, tml, 1, 1, lon_ful)
+    CALL flinget(fid, 'latitude', iml, jml, lml, tml, 1, 1, lat_ful)
+    CALL flinget(fid, 'vegetation_map', iml, jml, lml, tml, 1, 1, vegmap)
+    !
+    CALL flinclo(fid)
+    
+    !
+    IF (MAXVAL(vegmap) .LT. nolson) THEN
+      WRITE(*,*) 'WARNING -- WARNING'
+      WRITE(*,*) 'The vegetation map has to few vegetation types.'
+      WRITE(*,*) 'If you are lucky it will work but please check'
+    ELSE IF ( MAXVAL(vegmap) .GT. nolson) THEN
+      WRITE(*,*) 'More vegetation types in file than the code can'
+      WRITE(*,*) 'deal with.: ',  MAXVAL(vegmap),  nolson
+      STOP 'slowproc_interpol'
+    ENDIF
+    !
+    ALLOCATE(lon_up(nbpt)) 
+    ALLOCATE(lon_low(nbpt))
+    ALLOCATE(lat_up(nbpt))
+    ALLOCATE(lat_low(nbpt))
+    !
+    DO ib =1, nbpt
+       !
+       !  We find the 4 limits of the grid-box. As we transform the resolution of the model
+       !  into longitudes and latitudes we do not have the problem of periodicity.
+       !  coslat is a help variable here !
+       !
+       coslat = MAX(COS(lalo(ib,1) * pi/180. ), mincos )*pi/180. * R_Earth
+       !
+       lon_up(ib) = lalo(ib,2) + resolution(ib,1)/(2.0*coslat) 
+       lon_low(ib) = lalo(ib,2) - resolution(ib,1)/(2.0*coslat) 
+       !
+       coslat = pi/180. * R_Earth
+       !
+       lat_up(ib) = lalo(ib,1) + resolution(ib,2)/(2.0*coslat) 
+       lat_low(ib) = lalo(ib,1) - resolution(ib,2)/(2.0*coslat) 
+       !
+       !
+       veget(ib,:) = zero
+       frac_nobio (ib,:) = zero
+       !
+    ENDDO
+    !
+    !  Get the limits of the integration domaine so that we can speed up the calculations
+    !
+    domaine_lon_min = MINVAL(lon_low)
+    domaine_lon_max = MAXVAL(lon_up)
+    domaine_lat_min = MINVAL(lat_low)
+    domaine_lat_max = MAXVAL(lat_up)
+    !
+!!$    WRITE(*,*) 'DOMAINE lon :', domaine_lon_min, domaine_lon_max
+!!$    WRITE(*,*) 'DOMAINE lat :', domaine_lat_min, domaine_lat_max
+    !
+    ! Ensure that the fine grid covers the whole domain
+    WHERE ( lon_ful(:) .LT. domaine_lon_min )
+      lon_ful(:) = lon_ful(:) + 360.
+    ENDWHERE
+    !
+    WHERE ( lon_ful(:) .GT. domaine_lon_max )
+      lon_ful(:) = lon_ful(:) - 360.
+    ENDWHERE
+    !
+    WRITE(numout,*) 'Interpolating the vegetation map :'
+    WRITE(numout,'(2a40)')'0%--------------------------------------', &
+                   & '------------------------------------100%'
+    !
+    ilast = 1
+    n_origveg(:,:) = 0
+    !
+    DO ip=1,iml
+      !
+      !   Give a progress meter
+      !
+      ! prog = ip/float(iml)*79.
+      !  IF ( ABS(prog - NINT(prog)) .LT. 1/float(iml)*79. ) THEN
+      !   meter(NINT(prog)+1:NINT(prog)+1) = 'x'
+      !   WRITE(numout, advance="no", FMT='(a)') ACHAR(13)
+      !   WRITE(numout, advance="no", FMT='(a80)') meter
+      ! ENDIF
+      iprog = NINT(float(ip)/float(iml)*79.) - NINT(float(ip-1)/float(iml)*79.)
+      IF ( iprog .NE. 0 ) THEN
+        WRITE(numout,'(a1,$)') 'x'
+      ENDIF
+      !
+      !  Only start looking for its place in the smaler grid if we are within the domaine
+      !  That should speed up things !
+      !
+      IF ( ( lon_ful(ip) .GE. domaine_lon_min ) .AND. &
+           ( lon_ful(ip) .LE. domaine_lon_max ) .AND. &
+           ( lat_ful(ip) .GE. domaine_lat_min ) .AND. &
+           ( lat_ful(ip) .LE. domaine_lat_max )        ) THEN
+        !
+        ! look for point on GCM grid which this point on fine grid belongs to.
+        ! First look at the point on the model grid where we arrived just before. There is 
+        ! a good chace that neighbouring points on the fine grid fall into the same model
+        ! grid box.
+        !
+        !
+        ! THERE IS A BUG HERE !!! IF THE GCM GRID SITS ON THE DATE LINE WE WILL HAVE FOR INSTANCE
+        ! LON_LOW = -182 AND LON_UP = -178. THUS WE WILL ONLY PICK UP HALF THE POINTS NEEDED.
+        !
+        IF ( ( lon_ful(ip) .GT. lon_low(ilast) ) .AND. &
+             ( lon_ful(ip) .LT. lon_up(ilast) ) .AND. &
+             ( lat_ful(ip) .GT. lat_low(ilast) ) .AND. &
+             ( lat_ful(ip) .LT. lat_up(ilast) )         ) THEN
+          !
+          ! We were lucky
+          !
+          n_origveg(ilast,NINT(vegmap(ip))) = n_origveg(ilast,NINT(vegmap(ip))) + 1
+          !
+        ELSE
+          !
+          ! Otherwise, look everywhere.
+          ! Begin close to last grid point.
+          !
+          found = .FALSE. 
+          idi = 1
+          !
+          DO WHILE ( (idi .LT. nbpt) .AND. ( .NOT. found ) )
+            !
+            ! forward and backward
+            !
+            DO ii = 1,2
+              !
+              IF ( ii .EQ. 1 ) THEN
+                ib = ilast - idi
+              ELSE
+                ib = ilast + idi
+              ENDIF
+              !
+              IF ( ( ib .GE. 1 ) .AND. ( ib .LE. nbpt ) ) THEN
+                IF ( ( lon_ful(ip) .GT. lon_low(ib) ) .AND. &
+                     ( lon_ful(ip) .LT. lon_up(ib) ) .AND. &
+                     ( lat_ful(ip) .GT. lat_low(ib) ) .AND. &
+                     ( lat_ful(ip) .LT. lat_up(ib) )         ) THEN
+                  !
+                  n_origveg(ib,NINT(vegmap(ip))) = n_origveg(ib,NINT(vegmap(ip))) + 1
+                  ilast = ib
+                  found = .TRUE.
+                  !
+                ENDIF
+              ENDIF
+              !
+            ENDDO
+            !
+            idi = idi + 1
+            !
+          ENDDO
+          !
+        ENDIF ! lucky/not lucky
+        !
+      ENDIF     ! in the domain
+    ENDDO
+
+    !
+    ! Now we know how many points of which Olson type from the fine grid fall
+    ! into each box of the (coarse) model grid: n_origveg(nbpt,nolson)
+    !
+
+    !
+    ! determine number of points of the fine grid which fall into each box of the 
+    ! coarse grid
+    !
+    DO ib = 1, nbpt
+      n_found(ib) = SUM( n_origveg(ib,:) )
+    ENDDO
+
+    !
+    ! determine fraction of Olson vegetation type in each box of the coarse grid
+    !
+    DO vid = 1, nolson
+      WHERE ( n_found(:) .GT. 0 ) 
+        frac_origveg(:,vid) =  REAL(n_origveg(:,vid),r_std) /  REAL(n_found(:),r_std)
+      ELSEWHERE
+         frac_origveg(:,vid) = zero
+      ENDWHERE
+    ENDDO
+
+    !
+    ! now finally calculate coarse vegetation map
+    ! Find which model vegetation corresponds to each Olson type 
+    !
+    DO vid = 1, nolson
+      !
+      DO jv = 1, nvm
+        veget(:,jv) = veget(:,jv) + frac_origveg(:,vid) * vegcorr(vid,jv)
+      ENDDO
+      !
+      DO jv = 1, nnobio
+        frac_nobio(:,jv) = frac_nobio(:,jv) + frac_origveg(:,vid) * nobiocorr(vid,jv)
+      ENDDO
+      !
+    ENDDO
+    !
+    !
+    WRITE(numout,*)
+    WRITE(numout,*) 'Interpolation Done'
+    !
+    !   Clean up the point of the map
+    !
+    DO ib = 1, nbpt
+       !
+       !  Let us see if all points found something in the 5km map !
+       !
+       IF ( n_found(ib) .EQ. 0 ) THEN
+          !
+          ! Now we need to handle some exceptions
+          !
+          IF ( lalo(ib,1) .LT. -56.0) THEN
+             ! Antartica
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+             !
+          ELSE IF ( lalo(ib,1) .GT. 70.0) THEN
+             ! Artica
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+             !
+          ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN
+             ! Greenland
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+             !
+          ELSE
+             !
+             WRITE(numout,*) 'PROBLEM, no point in the 5km map found for this grid box'
+             WRITE(numout,*) 'Longitude range : ', lon_low(ib), lon_up(ib)
+             WRITE(numout,*) 'Latitude range : ', lat_low(ib), lat_up(ib)
+             !
+             WRITE(numout,*) 'Looking for nearest point on the 5 km map'
+             CALL slowproc_nearest (iml, lon_ful, lat_ful, &
+                                    lalo(ib,2), lalo(ib,1), inear)
+             WRITE(numout,*) 'Coordinates of the nearest point:', &
+                              lon_ful(inear),lat_ful(inear)
+             !
+             DO jv = 1, nvm
+               veget(ib,jv) = vegcorr(NINT(vegmap(inear)),jv)
+             ENDDO
+             !
+             DO jv = 1, nnobio
+               frac_nobio(ib,jv) = nobiocorr(NINT(vegmap(inear)),jv)
+             ENDDO
+             !
+          ENDIF
+          !
+       ENDIF
+       !
+       !
+       !  Limit the smalest vegetation fraction to 0.5%
+       !
+       DO vid = 1, nvm
+          IF ( veget(ib,vid) .LT. min_vegfrac ) THEN
+             veget(ib,vid) = zero
+          ENDIF
+       ENDDO
+       !
+       sumf = SUM(frac_nobio(ib,:))+SUM(veget(ib,:))
+       frac_nobio(ib,:) = frac_nobio(ib,:)/sumf
+       veget(ib,:) = veget(ib,:)/sumf
+       !
+       !       
+    ENDDO
+    !
+    DEALLOCATE(lon_up)
+    DEALLOCATE(lon_low)
+    DEALLOCATE(lat_up)
+    DEALLOCATE(lat_low)
+    DEALLOCATE(lat_ful)
+    DEALLOCATE(lon_ful)
+    DEALLOCATE(vegmap)
+    !
+    RETURN
+    !
+  END SUBROUTINE slowproc_interpol_OLD_g
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_interpol_NEW_g
+!!
+!>\BRIEF         Interpolate the IGBP vegetation map to the grid of the model
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::veget, ::frac_nobio
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_interpol_NEW_g(nbpt, lalo, neighbours, resolution, contfrac, veget, frac_nobio )
+    !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)           :: nbpt                  !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)              :: lalo(nbpt,2)          !! Vector of latitude and longitudes 
+                                                                  !! (beware of the order : 1=latitude ; 2=longitude)
+    INTEGER(i_std), INTENT(in)           :: neighbours(nbpt,8)    !! Vector of neighbours for each grid point 
+                                                                  !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), INTENT(in)              :: resolution(nbpt,2)    !! The size in km of each grid-box in X and Y
+    REAL(r_std),DIMENSION (nbpt), INTENT (in) :: contfrac         !! Fraction of continent in the grid
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)    ::  veget(nbpt,nvm)               !! Vegetation fractions
+    REAL(r_std), INTENT(out)    ::  frac_nobio(nbpt,nnobio)       !! Fraction of the mesh which is covered by ice, lakes, ...
+    !
+    LOGICAL ::           ok_interpol                              !! optionnal return of aggregate_vec
+    !
+    !  0.3 LOCAL
+    !
+    INTEGER(i_std), PARAMETER                       :: nolson = 94      !! Number of Olson classes
+    !
+    !
+    CHARACTER(LEN=80) :: filename                                       !!vegetation map filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, vid              
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lat_ful, lon_ful, vegmap  !! for 5km vegetation map 
+                                                                        !! latitude vector, longitude vector, and 
+                                                                        !! value of Olson's classes for each location
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: sub_area                !! the area of the fine grid in the model grid ??? 
+                                                                        !! cf src_global/interpol_help.f90, line 377, called "areaoverlap"
+    INTEGER(i_std),ALLOCATABLE, DIMENSION(:,:) :: sub_index             !! the indexes from the grid boxes from the data that go 
+                                                                        !! into the model's boxes 
+                                                                        !! cf src_global/interpol_help.f90,line 300, called "ip"
+    REAL(r_std), DIMENSION(nbpt,nolson) :: n_origveg                    !! number of points of each Olson type from the fine grid 
+                                                                        !! in each box of the (coarse) model grid 
+    REAL(r_std), DIMENSION(nbpt) :: n_found                             !! total number of different Olson types found in each 
+                                                                        !! box of the (coarse) model grid
+    REAL(r_std), DIMENSION(nbpt,nolson) :: frac_origveg                 !! fraction of each Olson type in each box of the (coarse) model grid
+    REAL(r_std) :: vegcorr(nolson,nvm)                                  !! correspondance table between Olson and the following SECHIBA Classes.
+                                                                        !!   vegcorr(i,:)+nobiocorr(i,:) = 1.  for all i 
+                                                                        !! see each class in src_parameters/constantes_veg.f90
+
+    REAL(r_std) :: nobiocorr(nolson,nnobio)                             !! non-biospheric surface typesi
+    CHARACTER(LEN=40) :: callsign                                       !! Allows to specify which variable is beeing treated
+    REAL(r_std) :: sumf, resol_lon, resol_lat                           !! sumf = sum veget + sum nobio
+                                                                        !! resol_lon, resol_lat  reolution in meters of the grid of the vegetation file
+    INTEGER(i_std) :: idi, jv, inear, nbvmax                            !! idi : counter for nbvmax, see below   
+                                                                        !! jv : counter for nvm, number of PFT
+                                                                        !! inear : location of the point of vegmap, which is the closest from the modelled point
+                                                                        !! nbvmax : number of maximum vegetation map points in the GCM grid 
+    INTEGER(i_std) :: nix, njx
+    !
+    INTEGER                  :: ALLOC_ERR                               !! location of the eventual missing value in vegmap
+
+!_ ================================================================================================================================
+    !
+    n_origveg(:,:) = zero
+    n_found(:) = zero
+    !
+    CALL get_vegcorr (nolson,vegcorr,nobiocorr)
+    !
+    !Config Key   = VEGETATION_FILE
+    !Config Desc  = Name of file from which the vegetation map is to be read
+    !Config If    = NOT(IMPOSE_VEG) and NOT(LAND_USE)
+    !Config Def   = carteveg5km.nc
+    !Config Help  = The name of the file to be opened to read the vegetation
+    !Config         map is to be given here. Usualy SECHIBA runs with a 5kmx5km
+    !Config         map which is derived from the IGBP one. We assume that we have
+    !Config         a classification in 87 types. This is Olson modified by Viovy.
+    !Config Units = [FILE]
+    !
+    filename = 'carteveg5km.nc'
+    CALL getin('VEGETATION_FILE',filename)  ! GETIN_P !!
+    !
+    CALL flininfo(filename, iml, jml, lml, tml, fid)   
+    !
+    ! see IOIPSL/src/flincom.f90, line 665
+    ! fid      : File ID
+    !- iml      | These 4 variables give the size of the variables
+    !- jml      | to be read. It will be verified that the variables
+    !- lml      | fits in there.
+    !- tml     
+    ! iml, jml : horizontal size of the grid, lml = vertical size
+    ! tml : size of time axis
+
+    ! TL : pourquoi 2 variables pour la taille horizontale ? cf
+    ! IOIPSL/src/flincom.f90 , line 160 
+
+    ALLOC_ERR=-1
+    ALLOCATE(lat_ful(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lat_ful : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(lon_ful(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lon_ful : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(vegmap(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of vegmap : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    WRITE(numout,*) 'Reading the OLSON type vegetation file'
+    !
+    CALL flinget(fid, 'longitude', iml, jml, lml, tml, 1, 1, lon_ful)
+    CALL flinget(fid, 'latitude', iml, jml, lml, tml, 1, 1, lat_ful)
+    CALL flinget(fid, 'vegetation_map', iml, jml, lml, tml, 1, 1, vegmap)
+    !
+    WRITE(numout,*) 'File name : ', filename
+    WRITE(numout,*) 'Min and max vegetation numbers : ', MINVAL(vegmap), MAXVAL(vegmap)
+    !
+    CALL flinclo(fid)
+    !
+    IF (MAXVAL(vegmap) .LT. nolson) THEN
+       WRITE(numout,*) 'WARNING -- WARNING'
+       WRITE(numout,*) 'The vegetation map has too few vegetation types.'
+       WRITE(numout,*) 'If you are lucky it will work but please check'
+    ELSE IF ( MAXVAL(vegmap) .GT. nolson) THEN
+       WRITE(numout,*) 'More vegetation types in file than the code can'
+       WRITE(numout,*) 'deal with.: ',  MAXVAL(vegmap),  nolson
+       STOP 'slowproc_interpol'
+    ENDIF
+    !
+    ! Some assumptions on the vegetation file. This information should be
+    ! be computed or read from the file. 
+    ! It is the reolution in meters of the grid of the vegetation file.
+    !
+    
+    !TL : CODE EN DUR ????? 
+    resol_lon = 5000.
+    resol_lat = 5000.
+    !
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some margin is taken.
+    !
+    nix=INT(MAXVAL(resolution_g(:,1)*2)/resol_lon)+1
+    njx=INT(MAXVAL(resolution_g(:,2)*2)/resol_lon)+1
+    nbvmax = nix*njx
+    !
+    ! No need to broadcast as this routine is only called on root_proc
+    !
+    callsign="Vegetation map"
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+    !WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+       !
+       ALLOC_ERR=-1
+       ALLOCATE(sub_index(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+          STOP 
+       ENDIF
+       sub_index(:,:)=0
+       ALLOC_ERR=-1
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+          STOP 
+       ENDIF
+       sub_area(:,:)=zero
+       !
+       CALL aggregate (nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, lon_ful, lat_ful, resol_lon, resol_lat, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       !
+       ! Defined as aggregate_2d or aggregate_vec in src_global/interpol_help.f90, depending
+       ! on the dimensions (2D region or vector)i. 
+       ! This routing will get for each point of the coarse grid the
+       ! indexes of the finer grid and the area of overlap.
+       ! This routine is designed for a fine grid which is regular in lat/lon.
+
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          !
+          nbvmax = nbvmax * 2
+       ELSE
+          !
+          DO ib = 1, nbpt
+             DO idi=1, nbvmax
+                ! Leave the do loop if all sub areas are treated, sub_area <= 0
+                IF ( sub_area(ib,idi) <= zero ) EXIT
+
+                ip = sub_index(ib,idi)
+                n_origveg(ib,NINT(vegmap(ip))) = n_origveg(ib,NINT(vegmap(ip))) + sub_area(ib,idi)
+                n_found(ib) =  n_found(ib) + sub_area(ib,idi)
+             ENDDO
+          ENDDO
+          !
+       ENDIF
+    ENDDO
+    !
+    ! Now we know how many points of which Olson type from the fine grid fall
+    ! into each box of the (coarse) model grid: n_origveg(nbpt,nolson)
+    !
+    !
+    ! determine fraction of Olson vegetation type in each box of the coarse grid
+    !
+    DO vid = 1, nolson
+       WHERE ( n_found(:) .GT. 0 ) 
+          frac_origveg(:,vid) = n_origveg(:,vid) / n_found(:)
+       ELSEWHERE
+          frac_origveg(:,vid) = zero
+       ENDWHERE
+    ENDDO
+    !
+    ! now finally calculate coarse vegetation map
+    ! Find which model vegetation corresponds to each Olson type 
+    !
+    veget(:,:) = zero
+    frac_nobio(:,:) = zero
+    !
+    DO vid = 1, nolson
+       !
+       DO jv = 1, nvm
+          veget(:,jv) = veget(:,jv) + frac_origveg(:,vid) * vegcorr(vid,jv)
+       ENDDO
+       !
+       DO jv = 1, nnobio
+          frac_nobio(:,jv) = frac_nobio(:,jv) + frac_origveg(:,vid) * nobiocorr(vid,jv)
+       ENDDO
+       !
+    ENDDO
+    !
+    WRITE(numout,*) 'slowproc_interpol : Interpolation Done'
+    !
+    !   Clean up the point of the map
+    !
+    DO ib = 1, nbpt
+       !
+       !  Let us see if all points found something in the 5km map !
+       !
+       IF ( n_found(ib) .EQ. 0 ) THEN
+          !
+          ! Now we need to handle some exceptions
+          !
+          IF ( lalo(ib,1) .LT. -56.0) THEN
+             ! Antartica
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+             !
+          ELSE IF ( lalo(ib,1) .GT. 70.0) THEN
+             ! Artica
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+             !
+          ELSE IF ( lalo(ib,1) .GT. 55.0 .AND. lalo(ib,2) .GT. -65.0 .AND. lalo(ib,2) .LT. -20.0) THEN
+             ! Greenland
+             frac_nobio(ib,:) = zero
+             frac_nobio(ib,iice) = un
+             veget(ib,:) = zero
+             !
+          ELSE
+             !
+             WRITE(numout,*) 'PROBLEM, no point in the 5km map found for this grid box',ib
+             WRITE(numout,*) 'Longitude range : ', lalo(ib,2)
+             WRITE(numout,*) 'Latitude range : ', lalo(ib,1)
+             !
+             WRITE(numout,*) 'Looking for nearest point on the 5 km map'
+             CALL slowproc_nearest (iml, lon_ful, lat_ful, &
+                  lalo(ib,2), lalo(ib,1), inear)
+             WRITE(numout,*) 'Coordinates of the nearest point:', &
+                  lon_ful(inear),lat_ful(inear)
+             !
+             DO jv = 1, nvm
+                veget(ib,jv) = vegcorr(NINT(vegmap(inear)),jv)
+             ENDDO
+             !
+             DO jv = 1, nnobio
+                frac_nobio(ib,jv) = nobiocorr(NINT(vegmap(inear)),jv)
+             ENDDO
+             !
+          ENDIF
+          !
+       ENDIF
+       !
+       !
+       !  Limit the smallest vegetation fraction to 0.5%
+       !
+       DO vid = 1, nvm
+          IF ( veget(ib,vid) .LT. min_vegfrac ) THEN  ! min_vegfrac=0.001 in constantes_veg.f90
+             veget(ib,vid) = zero
+          ENDIF
+       ENDDO
+       !
+       sumf = SUM(frac_nobio(ib,:))+SUM(veget(ib,:))
+       frac_nobio(ib,:) = frac_nobio(ib,:)/sumf
+       veget(ib,:) = veget(ib,:)/sumf
+       !
+       !       
+    ENDDO
+    !
+    DEALLOCATE(vegmap)
+    DEALLOCATE(lat_ful, lon_ful)
+    DEALLOCATE(sub_index)
+    DEALLOCATE(sub_area)
+
+    !
+    RETURN
+    !
+  END SUBROUTINE slowproc_interpol_NEW_g
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_nearest
+!!
+!>\BRIEF         looks for nearest grid point on the fine map
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::inear
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_nearest(iml, lon5, lat5, lonmod, latmod, inear)
+
+    !! INTERFACE DESCRIPTION
+    
+    !! 0.1 input variables
+
+    INTEGER(i_std), INTENT(in)                   :: iml             !! size of the vector
+    REAL(r_std), DIMENSION(iml), INTENT(in)      :: lon5, lat5      !! longitude and latitude vector, for the 5km vegmap
+    REAL(r_std), INTENT(in)                      :: lonmod, latmod  !! longitude  and latitude modelled
+
+    !! 0.2 output variables
+    
+    INTEGER(i_std), INTENT(out)                  :: inear           !! location of the grid point from the 5km vegmap grid
+                                                                    !! closest from the modelled grid point
+
+    !! 0.4 Local variables
+
+    REAL(r_std)                                  :: pa, p
+    REAL(r_std)                                  :: coscolat, sincolat
+    REAL(r_std)                                  :: cospa, sinpa
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: cosang
+    INTEGER(i_std)                               :: i
+    INTEGER(i_std), DIMENSION(1)                 :: ineartab
+    INTEGER                                      :: ALLOC_ERR
+
+!_ ================================================================================================================================
+
+    ALLOC_ERR=-1
+    ALLOCATE(cosang(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of cosang : ",ALLOC_ERR
+      STOP 
+    ENDIF
+
+    pa = pi/2.0 - latmod*pi/180.0 ! dist. between north pole and the point a 
+                                                      !! COLATITUDE, in radian
+    cospa = COS(pa)
+    sinpa = SIN(pa)
+
+    DO i = 1, iml
+
+       sincolat = SIN( pi/2.0 - lat5(i)*pi/180.0 ) !! sinus of the colatitude
+       coscolat = COS( pi/2.0 - lat5(i)*pi/180.0 ) !! cosinus of the colatitude
+
+       p = (lonmod-lon5(i))*pi/180.0 !! angle between a & b (between their meridian)in radians
+
+       !! dist(i) = ACOS( cospa*coscolat + sinpa*sincolat*COS(p))
+       cosang(i) = cospa*coscolat + sinpa*sincolat*COS(p) !! TL : cosang is maximum when angle is at minimal value  
+!! orthodromic distance between 2 points : cosang = cosinus (arc(AB)/R), with
+!R = Earth radius, then max(cosang) = max(cos(arc(AB)/R)), reached when arc(AB)/R is minimal, when
+! arc(AB) is minimal, thus when point B (corresponding grid point from LAI MAP) is the nearest from
+! modelled A point
+    ENDDO
+
+    ineartab = MAXLOC( cosang(:) )
+    inear = ineartab(1)
+
+    DEALLOCATE(cosang)
+  END SUBROUTINE slowproc_nearest
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_soilt
+!!
+!>\BRIEF         Interpolate the Zobler soil type map
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::soiltype, ::clayfraction, bulk_density, soil_ph
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_soilt(nbpt, lalo, neighbours, resolution, contfrac, soilclass, clayfraction, bulk_density, soil_ph)
+    !
+    !
+    !   This subroutine should read the Zobler map and interpolate to the model grid. The method
+    !   is to get fraction of the three main soiltypes for each grid box.
+    !   The soil fraction are going to be put into the array soiltype in the following order :
+    !   coarse, medium and fine.
+    !
+    !
+    !!  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)    :: nbpt                   !! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)       :: lalo(nbpt,2)           !! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)    :: neighbours(nbpt,8)     !! Vector of neighbours for each grid point 
+                                                            !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), INTENT(in)       :: resolution(nbpt,2)     !! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)         !! Fraction of land in each grid box.
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)      :: soilclass(nbpt, nstm)   !! Soil type map to be created from the Zobler map
+    REAL(r_std), INTENT(out)      :: clayfraction(nbpt)     !! The fraction of clay as used by STOMATE
+    REAL(r_std), INTENT(out)      :: bulk_density(nbpt)     !! The soil bulk density
+    REAL(r_std), INTENT(out)      :: soil_ph(nbpt)          !! The soil pH
+    !
+    !
+    !  0.3 LOCAL
+    !
+    INTEGER(i_std)               :: nbvmax
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, fopt, ilf, nbexp
+    REAL(r_std) :: lev(1), date, dt
+    INTEGER(i_std) :: itau(1)
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_rel, lon_rel
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: soiltext, soiltext2, soilbd, soilph
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)  :: sub_area
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: resol_lu
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: solt, solt2
+    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: solbd, solph
+    REAL(r_std) ::  sgn, coslat
+    CHARACTER(LEN=30) :: callsign
+    INTEGER(i_std) :: nix, njx
+    !
+    ! Number of texture classes in Zobler
+    !
+    INTEGER(i_std), PARAMETER :: nzobler = 7
+    REAL(r_std),ALLOCATABLE   :: textfrac_table(:,:)
+    !   
+    LOGICAL                  :: ok_interpol  ! optionnal return of aggregate_2d
+    !   
+    INTEGER                  :: ALLOC_ERR
+
+!_ ================================================================================================================================
+    !
+    !
+    !  Needs to be a configurable variable
+    !
+    !
+    !Config Key   = SOILCLASS_FILE
+    !Config Desc  = Name of file from which soil types are read
+    !Config Def   = soils_param.nc
+    !Config If    = NOT(IMPOSE_VEG)
+    !Config Help  = The name of the file to be opened to read the soil types. 
+    !Config         The data from this file is then interpolated to the grid of
+    !Config         of the model. The aim is to get fractions for sand loam and
+    !Config         clay in each grid box. This information is used for soil hydrology
+    !Config         and respiration.
+    !Config Units = [FILE]
+    !
+    filename = 'soils_param.nc'
+    CALL getin_p('SOILCLASS_FILE',filename)
+    !
+    IF (is_root_prc) THEN
+       CALL flininfo(filename,iml, jml, lml, tml, fid)
+       CALL flinclo(fid)
+    ENDIF
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    !
+    ! soils_param.nc file is 1° soit texture file.
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lat_rel : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lon_rel : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(soiltext(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of soiltext : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(soilbd(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of soilbd : ",ALLOC_ERR
+      STOP
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(soilph(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of soilph : ",ALLOC_ERR
+      STOP
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(soiltext2(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of soiltext2 : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of resol_lu : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    IF (is_root_prc) CALL flinopen(filename, .FALSE., iml, jml, lml, lon_rel, lat_rel, lev, tml, itau, date, dt, fid)
+    CALL bcast(lon_rel)
+    CALL bcast(lat_rel)
+    CALL bcast(itau)
+    CALL bcast(date)
+    CALL bcast(dt)
+    
+    !
+    IF (is_root_prc) CALL flinget(fid, 'soiltext', iml, jml, lml, tml, 1, 1, soiltext)
+    CALL bcast(soiltext)
+
+    IF (.NOT. impsoilt) THEN
+    IF (is_root_prc) CALL flinget(fid, 'soil_ph', iml, jml, lml, tml, 1, 1, soilph)
+    CALL bcast(soilph)
+    !
+    IF (is_root_prc) CALL flinget(fid, 'soilbd', iml, jml, lml, tml, 1, 1, soilbd)
+    CALL bcast(soilbd)
+    ENDIF
+    !
+    IF (is_root_prc) CALL flinclo(fid)
+    !
+    nbexp = 0
+    !
+    !
+    ! Mask of permitted variables.
+    !
+    mask(:,:) = zero
+    DO ip=1,iml
+       DO jp=1,jml
+          !
+          IF (soiltext(ip,jp) .GT. min_sechiba) THEN
+             mask(ip,jp) = un
+          ENDIF
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )     
+          IF ( ip .EQ. 1 ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip,jp) ) * pi/180. * R_Earth * coslat
+          ELSEIF ( ip .EQ. iml ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip,jp) - lon_rel(ip-1,jp) ) * pi/180. * R_Earth * coslat
+          ELSE
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp) - lat_rel(ip,jp+1) ) * pi/180. * R_Earth
+          ELSEIF ( jp .EQ. jml ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp) ) * pi/180. * R_Earth
+          ELSE
+             resol_lu(ip,jp,2) =  ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp+1) )/2. * pi/180. * R_Earth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+       njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+       nbvmax = nix*njx
+    ENDIF
+    CALL bcast(nbvmax)
+    !
+    callsign = "Soil types"
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+    !WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+       !
+       ALLOC_ERR=-1
+       ALLOCATE(solt(nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of solt : ",ALLOC_ERR
+          STOP 
+       ENDIF
+       ALLOC_ERR=-1
+    ALLOCATE(solt2(nbvmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of solt2 : ",ALLOC_ERR
+       STOP 
+    ENDIF
+       ALLOC_ERR=-1
+    ALLOCATE(solbd(nbvmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of solbd : ",ALLOC_ERR
+       STOP
+    ENDIF
+       ALLOC_ERR=-1
+    ALLOCATE(solph(nbvmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of solph : ",ALLOC_ERR
+       STOP
+    ENDIF
+
+    ALLOC_ERR=-1
+       ALLOCATE(sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+          STOP 
+       ENDIF
+       sub_index(:,:,:)=0
+       ALLOC_ERR=-1
+       ALLOCATE(sub_area(nbpt,nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR/=0) THEN
+          WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+          STOP 
+       ENDIF
+       sub_area(:,:)=zero
+       !
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       !
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          DEALLOCATE(solt)
+          DEALLOCATE(solt2)
+          DEALLOCATE(solbd)
+          DEALLOCATE(solph)
+          !
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+    !
+    !
+    SELECTCASE(soil_classif)
+    CASE('none')
+       ALLOCATE(textfrac_table(nscm,ntext))
+       DO ib=1, nbpt
+          soilclass(ib,:) = soilclass_default_fao
+          clayfraction(ib) = clayfraction_default
+          bulk_density(ib) = bulk_density_default
+          soil_ph(ib) = soil_ph_default
+       ENDDO
+    CASE('zobler')
+       !
+       soilclass_default=soilclass_default_fao
+       !
+       WRITE(numout,*) "Using a soilclass map with Zobler classification"
+       !
+       ALLOCATE(textfrac_table(nzobler,ntext))
+       !
+       CALL get_soilcorr (nzobler, textfrac_table)
+       !
+       !
+       DO ib =1, nbpt
+          !
+          ! GO through the point we have found
+          !
+          !
+          fopt = COUNT(sub_area(ib,:) > zero)
+          !
+          !    Check that we found some points
+          !
+          soilclass(ib,:) = zero
+          clayfraction(ib) = zero
+          bulk_density(ib) = zero 
+          soil_ph(ib) = zero
+          !
+          IF ( fopt .EQ. 0) THEN
+             nbexp = nbexp + 1
+             soilclass(ib,:) = soilclass_default(:)
+             clayfraction(ib) = clayfraction_default
+             bulk_density(ib) = bulk_density_default
+             soil_ph(ib) = soil_ph_default
+          ELSE
+             !
+             DO ilf = 1,fopt
+                solt(ilf) = soiltext(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+                solbd(ilf) = soilbd(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+                solph(ilf) = soilph(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+             ENDDO
+             !
+             sgn = zero
+             !
+             !   Compute the average bare soil albedo parameters
+             !
+             DO ilf = 1,fopt
+                !
+                ! We have to take care of two exceptions here : type 6 = glacier and type 0 = ocean
+                !
+                IF ( (solt(ilf) .LE. nzobler) .AND. (solt(ilf) .GT. 0) .AND.&
+                     & (solt(ilf) .NE. 6)) THEN
+                   SELECTCASE(solt(ilf))
+                   CASE(1)
+                      soilclass(ib,1) = soilclass(ib,1) + sub_area(ib,ilf)
+                   CASE(2)
+                      soilclass(ib,2) = soilclass(ib,2) + sub_area(ib,ilf)
+                   CASE(3)
+                      soilclass(ib,2) = soilclass(ib,2) + sub_area(ib,ilf)
+                   CASE(4)
+                      soilclass(ib,2) = soilclass(ib,2) + sub_area(ib,ilf)
+                   CASE(5)
+                      soilclass(ib,3) = soilclass(ib,3) + sub_area(ib,ilf)
+                   CASE(7)
+                      soilclass(ib,2) = soilclass(ib,2) + sub_area(ib,ilf)
+                   CASE DEFAULT
+                      WRITE(numout,*) 'We should not be here, an impossible case appeared'
+                      STOP 'slowproc_soilt'
+                   END SELECT
+                   clayfraction(ib) = clayfraction(ib) + &
+                        & textfrac_table(solt(ilf),3) * sub_area(ib,ilf)
+                   bulk_density(ib) = bulk_density(ib) + solbd(ilf) * sub_area(ib,ilf) 
+                   soil_ph(ib) = soil_ph(ib) + solph(ilf)  * sub_area(ib,ilf)
+                   sgn = sgn + sub_area(ib,ilf)
+                ELSE
+                   IF (solt(ilf) .GT. nzobler) THEN
+                      WRITE(numout,*) 'The file contains a soil color class which is incompatible with this program'
+                      STOP 'slowproc_soilt'
+                   ENDIF
+                ENDIF
+                !
+             ENDDO
+             !
+             ! Normalize the surface
+             !
+             IF ( sgn .LT. min_sechiba) THEN
+                nbexp = nbexp + 1
+                soilclass(ib,:) = soilclass_default(:)
+                clayfraction(ib) = clayfraction_default
+                bulk_density(ib) = bulk_density_default
+                soil_ph(ib) = soil_ph_default
+             ELSE
+                soilclass(ib,:) = soilclass(ib,:)/sgn
+                clayfraction(ib) = clayfraction(ib)/sgn
+                bulk_density(ib) = bulk_density(ib)/sgn
+                soil_ph(ib) = soil_ph(ib)/sgn
+             ENDIF
+             !
+          ENDIF
+       ENDDO
+   
+    !
+    CASE("fao")
+       !
+       soilclass_default=soilclass_default_fao
+       !
+       WRITE(numout,*) "Using a soilclass map with fao classification"
+       !
+       ALLOCATE(textfrac_table(nscm,ntext))
+       !
+       CALL get_soilcorr (nscm, textfrac_table)
+       !
+       DO ib =1, nbpt
+          !
+          ! GO through the point we have found
+          !
+          !
+          fopt = COUNT(sub_area(ib,:) > zero)
+          !
+          !    Check that we found some points
+          !
+          soilclass(ib,:) = 0.0
+          clayfraction(ib) = 0.0
+          bulk_density(ib) = 0.0
+          soil_ph(ib) = 0.0
+          !
+          IF ( fopt .EQ. 0) THEN
+             nbexp = nbexp + 1
+             soilclass(ib,:) = soilclass_default(:)
+             clayfraction(ib) = clayfraction_default
+             bulk_density(ib) = bulk_density_default
+             soil_ph(ib) = soil_ph_default
+          ELSE
+             !
+             DO ilf = 1,fopt
+                solt(ilf) = soiltext(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+                solbd(ilf) = soilbd(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+                solph(ilf) = soilph(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+             ENDDO
+             !
+             !
+             !   Compute the average bare soil albedo parameters
+             !
+             sgn = zero
+             !
+             DO ilf = 1,fopt
+                !
+                ! 
+                !
+                IF ( (solt(ilf) .LE. nscm) .AND. (solt(ilf) .GT. 0) ) THEN
+                   soilclass(ib,solt(ilf)) = soilclass(ib,solt(ilf)) + sub_area(ib,ilf)
+                   clayfraction(ib) = clayfraction(ib) + textfrac_table(solt(ilf),3) * sub_area(ib,ilf)
+                   bulk_density(ib) = bulk_density(ib) + solbd(ilf) * sub_area(ib,ilf)
+                   soil_ph(ib) = soil_ph(ib) + solph(ilf)  * sub_area(ib,ilf)
+                   sgn = sgn + sub_area(ib,ilf)
+
+                ELSE
+                   IF (solt(ilf) .GT. nscm) THEN
+                      WRITE(*,*) 'The file contains a soil color class which is incompatible with this program'
+                      STOP 'slowproc_soilt'
+                   ENDIF
+                ENDIF
+                !
+             ENDDO
+             !
+             ! Normalize the surface
+             !
+             IF ( sgn .LT. min_sechiba) THEN
+                nbexp = nbexp + 1
+                soilclass(ib,:) = soilclass_default(:)
+                clayfraction(ib) = clayfraction_default
+                bulk_density(ib) = bulk_density_default
+                soil_ph(ib) = soil_ph_default
+             ELSE
+                soilclass(ib,:) = soilclass(ib,:)/sgn
+                clayfraction(ib) = clayfraction(ib)/sgn
+                bulk_density(ib) = bulk_density(ib)/sgn
+                soil_ph(ib) = soil_ph(ib)/sgn
+             ENDIF
+             !
+          ENDIF
+          !
+       ENDDO
+       !
+       !
+    CASE("usda")
+       !
+       soilclass_default=soilclass_default_usda
+       !
+       WRITE(numout,*) "Using a soilclass map with usda classification"
+       !
+       ALLOCATE(textfrac_table(nscm,ntext))
+       !
+       CALL get_soilcorr (nscm, textfrac_table)
+       !
+       DO ib =1, nbpt
+          !
+          ! GO through the point we have found
+          !
+          !
+          fopt = COUNT(sub_area(ib,:) > zero)
+          !
+          !    Check that we found some points
+          !
+          soilclass(ib,:) = 0.0
+          clayfraction(ib) = 0.0
+          bulk_density(ib) = 0.0
+          soil_ph(ib) = 0.0
+          !
+          IF ( fopt .EQ. 0) THEN
+             nbexp = nbexp + 1
+             soilclass(ib,:) = soilclass_default
+             clayfraction(ib) = clayfraction_default
+             bulk_density(ib) = bulk_density_default
+             soil_ph(ib) = soil_ph_default
+          ELSE
+             !
+             DO ilf = 1,fopt
+                solt(ilf) = soiltext(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+                solbd(ilf) = soilbd(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+                solph(ilf) = soilph(sub_index(ib,ilf,1),sub_index(ib,ilf,2))
+             ENDDO
+
+             !
+             !
+             !   Compute the average bare soil albedo parameters
+             !
+             sgn = zero
+             !
+             DO ilf = 1,fopt
+                !
+                ! 
+                !
+                IF ( (solt(ilf) .LE. nscm) .AND. (solt(ilf) .GT. 0) ) THEN
+                   soilclass(ib,solt(ilf)) = soilclass(ib,solt(ilf)) + sub_area(ib,ilf)
+                   clayfraction(ib) = clayfraction(ib) + textfrac_table(solt(ilf),3) * sub_area(ib,ilf)
+                   bulk_density(ib) = bulk_density(ib) + solbd(ilf) * sub_area(ib,ilf)
+                   soil_ph(ib) = soil_ph(ib) + solph(ilf)  * sub_area(ib,ilf)
+
+                   sgn = sgn + sub_area(ib,ilf)
+                ELSE
+                   IF (solt(ilf) .GT. nscm) THEN
+                      WRITE(*,*) 'The file contains a soil color class which is incompatible with this program'
+                      STOP 'slowproc_soilt'
+                   ENDIF
+                ENDIF
+                !
+             ENDDO
+             !
+             ! Normalize the surface
+             !
+             IF ( sgn .LT. min_sechiba) THEN
+                nbexp = nbexp + 1
+                soilclass(ib,:) = soilclass_default(:)
+                clayfraction(ib) = clayfraction_default
+                bulk_density(ib) = bulk_density_default
+                soil_ph(ib) = soil_ph_default
+             ELSE
+                soilclass(ib,:) = soilclass(ib,:)/sgn
+                clayfraction(ib) = clayfraction(ib)/sgn
+                bulk_density(ib) = bulk_density(ib)/sgn
+                soil_ph(ib) = soil_ph(ib)/sgn
+             ENDIF
+             !
+          ENDIF
+          !
+       ENDDO
+       !
+    CASE DEFAULT
+       WRITE(*,*) 'A non supported soil type classification has been chosen'
+       STOP 'slowproc_soilt'
+    ENDSELECT
+    !
+    WRITE(numout,*) 'Interpolation Done'
+       !
+    IF ( nbexp .GT. 0 ) THEN
+       WRITE(numout,*) 'slowproc_soilt : The interpolation of the bare soil albedo had ', nbexp
+       WRITE(numout,*) 'slowproc_soilt : points without data. This are either coastal points or'
+       WRITE(numout,*) 'slowproc_soilt : ice covered land.'
+       WRITE(numout,*) 'slowproc_soilt : The problem was solved by using the default soil types.'
+    ENDIF
+    !
+    DEALLOCATE (lat_rel)
+    DEALLOCATE (lon_rel)
+    DEALLOCATE (mask)
+    DEALLOCATE (sub_area)
+    DEALLOCATE (sub_index)
+    DEALLOCATE (soiltext)
+    DEALLOCATE (soilbd)
+    DEALLOCATE (soilph)
+    DEALLOCATE (solt)
+    !
+    DEALLOCATE (soiltext2)
+    DEALLOCATE (solt2)
+    DEALLOCATE (textfrac_table)
+    !
+    DEALLOCATE (resol_lu)
+    !
+    !
+    RETURN
+    !
+  END SUBROUTINE slowproc_soilt
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_slope
+!!
+!>\BRIEF         Calculate mean slope coef in each  model grid box from the slope map
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::reinf_slope
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_slope(nbpt, lalo, neighbours, resolution, contfrac, reinf_slope)
+    !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)          :: nbpt                  ! Number of points for which the data needs to be interpolated
+    REAL(r_std), INTENT(in)              :: lalo(nbpt,2)          ! Vector of latitude and longitudes (beware of the order !)
+    INTEGER(i_std), INTENT(in)          :: neighbours(nbpt,8)    ! Vector of neighbours for each grid point 
+    ! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std), INTENT(in)              :: resolution(nbpt,2)    ! The size in km of each grid-box in X and Y
+    REAL(r_std), INTENT (in)             :: contfrac(nbpt)         !! Fraction of continent in the grid
+    !
+    !  0.2 OUTPUT
+    !
+    REAL(r_std), INTENT(out)    ::  reinf_slope(nbpt)                   ! slope coef 
+    !
+    !  0.3 LOCAL
+    !
+    !
+    REAL(r_std)  :: slope_noreinf                 ! Slope above which runoff is maximum
+    CHARACTER(LEN=80) :: filename
+    CHARACTER(LEN=30) :: callsign
+    INTEGER(i_std)    :: iml, jml, lml, tml, fid, ib, ip, jp, vid
+    INTEGER(i_std)    :: idi, idi_last, nbvmax
+    REAL(r_std)        :: slopecoef, coslat
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sub_index
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: lat_rel, lon_rel, slopemap
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)      :: lat_lu, lon_lu
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: resol_lu
+    INTEGER(i_std) :: nix, njx
+    !
+    LOGICAL ::           ok_interpol = .FALSE. ! optionnal return of aggregate_2d
+    !
+    INTEGER                  :: ALLOC_ERR
+!_ ================================================================================================================================
+
+    !
+    !Config Key   = SLOPE_NOREINF
+    !Config Desc  = See slope_noreinf above
+    !Config If    = 
+    !Config Def   = 0.5
+    !Config Help  = The slope above which there is no reinfiltration
+    !Config Units = [-]
+    !
+    slope_noreinf = 0.5
+    !
+    CALL getin_p('SLOPE_NOREINF',slope_noreinf)
+    !
+    !Config Key   = TOPOGRAPHY_FILE
+    !Config Desc  = Name of file from which the topography map is to be read
+    !Config If    = 
+    !Config Def   = cartepente2d_15min.nc
+    !Config Help  = The name of the file to be opened to read the orography
+    !Config         map is to be given here. Usualy SECHIBA runs with a 2'
+    !Config         map which is derived from the NGDC one. 
+    !Config Units = [FILE]
+    !
+    filename = 'cartepente2d_15min.nc'
+    CALL getin_p('TOPOGRAPHY_FILE',filename)
+    !
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+    CALL bcast(iml)
+    CALL bcast(jml)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(lat_lu(jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lat_lu : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(lon_lu(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lon_lu : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(slopemap(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of slopemap : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of resol_lu : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    WRITE(numout,*) 'Reading the topography file'
+    !
+    IF (is_root_prc) THEN
+       CALL flinget(fid, 'longitude', iml, 0, 0, 0, 1, 1, lon_lu)
+       CALL flinget(fid, 'latitude', jml, 0, 0, 0, 1, 1, lat_lu)
+       CALL flinget(fid, 'pente', iml, jml, 0, 0, 1, 1, slopemap)
+       !
+       CALL flinclo(fid)
+    ENDIF
+    CALL bcast(lon_lu)
+    CALL bcast(lat_lu)
+    CALL bcast(slopemap)
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lon_rel : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of lat_rel : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    DO ip=1,iml
+       lat_rel(ip,:) = lat_lu(:)
+    ENDDO
+    DO jp=1,jml
+       lon_rel(:,jp) = lon_lu(:)
+    ENDDO
+    !
+    !
+    ! Mask of permitted variables.
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+      WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
+      STOP 
+    ENDIF
+    !
+    mask(:,:) = zero
+    DO ip=1,iml
+       DO jp=1,jml
+          IF (slopemap(ip,jp) .GT. min_sechiba) THEN
+             mask(ip,jp) = un
+          ENDIF
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )     
+          IF ( ip .EQ. 1 ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip,jp) ) * pi/180. * R_Earth * coslat
+          ELSEIF ( ip .EQ. iml ) THEN
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip,jp) - lon_rel(ip-1,jp) ) * pi/180. * R_Earth * coslat
+          ELSE
+             resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp) - lat_rel(ip,jp+1) ) * pi/180. * R_Earth
+          ELSEIF ( jp .EQ. jml ) THEN
+             resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp) ) * pi/180. * R_Earth
+          ELSE
+             resol_lu(ip,jp,2) =  ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp+1) )/2. * pi/180. * R_Earth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
+       njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
+       nbvmax = nix*njx
+    ENDIF
+    CALL bcast(nbvmax)
+    !
+    callsign="Slope map"
+    !
+    WRITE(numout,*) "Projection arrays for ",callsign," : "
+    !WRITE(numout,*) "nbvmax = ",nbvmax
+    !
+    ALLOC_ERR=-1
+    ALLOCATE(sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
+       STOP 
+    ENDIF
+    sub_index(:,:,:)=0
+    ALLOC_ERR=-1
+    ALLOCATE(sub_area(nbpt,nbvmax), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+       WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
+       STOP 
+    ENDIF
+    sub_area(:,:)=zero
+    !
+    CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+         &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+         &                nbvmax, sub_index, sub_area, ok_interpol)
+
+    IF (.NOT. ok_interpol ) THEN
+       WRITE(numout,*) 'Error. Something went wrong in aggreate_p. Probably nbvmax is too small. STOP NOW!'
+       STOP
+    END IF
+    !
+    !
+    DO ib = 1, nbpt
+      !-
+      !- Reinfiltration coefficient due to the slope: Calculation with parameteres maxlope_ro 
+      !-
+      slopecoef = zero
+
+      ! Initialize last index to the highest possible 
+      idi_last=nbvmax
+      DO idi=1, nbvmax
+         ! Leave the do loop if all sub areas are treated, sub_area <= 0
+         IF ( sub_area(ib,idi) <= zero ) THEN
+            ! Set last index to the last one used
+            idi_last=idi-1
+            ! Exit do loop
+            EXIT
+         END IF
+
+         ip = sub_index(ib,idi,1)
+         jp = sub_index(ib,idi,2)
+
+         slopecoef = slopecoef + MIN(slopemap(ip,jp)/slope_noreinf, un) * sub_area(ib,idi)
+      ENDDO
+
+      IF ( idi_last >= 1 ) THEN
+         reinf_slope(ib) = un - slopecoef / SUM(sub_area(ib,1:idi_last)) 
+      ELSE
+         reinf_slope(ib) = slope_default
+      ENDIF
+    ENDDO
+    !
+    !
+    WRITE(numout,*) 'Interpolation Done'
+    !
+    !
+    DEALLOCATE(slopemap)
+    DEALLOCATE(sub_index)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(mask)
+    DEALLOCATE(lon_lu)
+    DEALLOCATE(lat_lu)
+    DEALLOCATE(lon_rel)
+    DEALLOCATE(lat_rel)
+    !
+    !
+    RETURN
+    !
+  END SUBROUTINE slowproc_slope
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: get_vegcorr
+!!
+!>\BRIEF         The "get_vegcorr" routine defines the table of correspondence
+!!               between the 94 Olson vegetation types and the 13 Plant Functional Types known 
+!!               by SECHIBA and STOMATE. Used by slowproc for the old interpolation.
+!!
+!!\DESCRIPTION : get_vegcorr is needed if you use the old_map carteveg5km.nc. \n
+!!               Usually SECHIBA can run with a 5kmx5km map which is derived from the IGBP one. \n
+!!               We assume that we have a classification in 94 types. This is Olson one modified by Nicolas Viovy.\n
+!!               ORCHIDEE has to convert the Olson vegetation types into PFTs for the run (interpolation step).\n
+!!               Each Olson matches to a combination of fractions of one or several PFTs.\n
+!!               This routine uses the same process for the non-biospheric map (not used).\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::vegcorr, ::nobiocorr.
+!!
+!! REFERENCE(S)	: 
+!! - Olson, J.S., J.A. Watts, and L.J. Allison., 1983. 
+!! "Carbon in Live Vegetation of Major World Ecosystems." 
+!! Report ORNL-5862. Oak Ridge National Laboratory, Oak Ridge, Tennessee. 
+!! - Olson, J.S., J.A. Watts, and L.J. Allison., 1985. 
+!! "Major World Ecosystem Complexes Ranked by Carbon in Live Vegetation: A Database." 
+!! NDP-017. Carbon Dioxide Information Center, Oak Ridge National Laboratory, Oak Ridge, Tennessee.
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE get_vegcorr (nolson,vegcorr,nobiocorr)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+    
+    INTEGER(i_std),PARAMETER :: nolson94 = 94                       !! Number of Olson vegetation types (unitless)
+    INTEGER(i_std),PARAMETER :: nvm13 = 13                          !! Number of PFTS of ORCHIDEE (unitless) 
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in) :: nolson                             !! Number of Olson vegetation types (unitless)
+    
+    !! 0.2 Output variables 
+
+    REAL(r_std),DIMENSION(nolson,nvm),INTENT(out) :: vegcorr        !! Correspondence array between Olson types and PFTS 
+                                                                    !! (0-1, unitless)
+    REAL(r_std),DIMENSION(nolson,nnobio),INTENT(out) :: nobiocorr   !! Correspondence array between non-vegetation types and nobio 
+                                                                    !! types (lake,etc..) (0-1, unitless)
+
+    !! 0.4 Local variable
+    
+    INTEGER(i_std) :: ib                                            !! Indice (unitless)
+    
+ !_ ================================================================================================================================
+
+    !-
+    ! 0. Check consistency
+    !-
+    IF (nolson /= nolson94) THEN
+       WRITE(numout,*) nolson,nolson94
+       CALL ipslerr_p(3,'get_vegcorr', '', '',&
+            &                 'wrong number of OLSON vegetation types.') ! Fatal error
+    ENDIF !(nolson /= nolson94)
+    
+    IF (nvm /= nvm13) THEN
+       WRITE(numout,*) nvm,nvm13
+       CALL ipslerr_p(3,'get_vegcorr', '', '',&
+            &                 'wrong number of SECHIBA vegetation types.') ! Fatal error
+    ENDIF !(nvm /= nvm13)
+
+    ! The carteveg5km cannot be used if the PFTs are not in the standard order
+    DO ib = 1,nvm
+       IF (pft_to_mtc(ib) /= ib ) THEN
+          CALL ipslerr_p(3,'get_vegcorr','You have redefined the order of the 13 PFTS', & 
+               &          'You can not use carteveg5km', 'Use the standard configuration of PFTS' )
+       ENDIF
+    ENDDO
+
+    !-
+    ! 1 set the indices of non-biospheric surface types to 0.
+    !-
+    nobiocorr(:,:) = zero
+    !-
+    ! 2 Here we construct the correspondance table
+    !   between Olson and the following SECHIBA Classes.
+    !   vegcorr(i,:)+nobiocorr(i,:) = 1.  for all i.
+    !-
+    ! The modified OLSON types found in file carteveg5km.nc
+    ! created by Nicolas Viovy :
+    !  1 Urban
+    vegcorr( 1,:) = &
+         & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    !  2 Cool low sparse grassland
+    vegcorr( 2,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    !  3 Cold conifer forest
+    vegcorr( 3,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    !  4 Cold deciduous conifer forest
+    vegcorr( 4,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0/)
+    !  5 Cool Deciduous broadleaf forest
+    vegcorr( 5,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    !  6 Cool evergreen broadleaf forests
+    vegcorr( 6,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    !  7 Cool tall grasses and shrubs
+    vegcorr( 7,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    !  8 Warm C3 tall grasses and shrubs
+    vegcorr( 8,:) = &
+         & (/0.1, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    !  9 Warm C4 tall grases and shrubs
+    vegcorr( 9,:) = &
+         & (/0.1, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0/)
+    ! 10 Bare desert
+    vegcorr(10,:) = &
+         & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 11 Cold upland tundra
+    vegcorr(11,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    ! 12 Cool irrigated grassland
+    vegcorr(12,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.0/)
+    ! 13 Semi desert
+    vegcorr(13,:) = &
+         & (/0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
+    ! 14 Glacier ice
+    vegcorr(14,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    nobiocorr(14,iice) = 1.
+    ! 15 Warm wooded wet swamp
+    vegcorr(15,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0/)
+    ! 16 Inland water
+    vegcorr(16,:) = &
+         & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 17 sea water
+    vegcorr(17,:) = &
+         & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 18 cool shrub evergreen
+    vegcorr(18,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 19 cold shrub deciduous
+    vegcorr(19,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 20 Cold evergreen forest and fields
+    vegcorr(20,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0/)
+    ! 21 cool rain forest
+    vegcorr(21,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 22 cold conifer boreal forest
+    vegcorr(22,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 23 cool conifer forest
+    vegcorr(23,:) = &
+         & (/0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 24 warm mixed forest
+    vegcorr(24,:) = &
+         & (/0.0, 0.4, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0/)
+    ! 25 cool mixed forest
+    vegcorr(25,:) = &
+         & (/0.0, 0.0, 0.0, 0.4, 0.0, 0.4, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 26 cool broadleaf forest
+    vegcorr(26,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0/)
+    ! 27 cool deciduous broadleaf forest
+    vegcorr(27,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.3, 0.5, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 28 warm montane tropical forest
+    vegcorr(28,:) = &
+         & (/0.0, 0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0/)
+    ! 29 warm seasonal tropical forest
+    vegcorr(29,:) = &
+         & (/0.0, 0.5, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0/)
+    ! 30 cool crops and towns
+    vegcorr(30,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0/)
+    ! 31 warm crops and towns
+    vegcorr(31,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8/)
+    ! 32 cool crops and towns
+    vegcorr(32,:) = &
+         & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0/)
+    ! 33 warm dry tropical woods
+    vegcorr(33,:) = &
+         & (/0.2, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
+    ! 34 warm tropical rain forest
+    vegcorr(34,:) = &
+         & (/0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 35 warm tropical degraded forest
+    vegcorr(35,:) = &
+         & (/0.1, 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0/)
+    ! 36 warm corn and beans cropland
+    vegcorr(36,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0/)
+    ! 37 cool corn and bean cropland
+    vegcorr(37,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/)
+    ! 38 warm rice paddy and field
+    vegcorr(38,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0/)
+    ! 39 hot irrigated cropland
+    vegcorr(39,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0/)
+    ! 40 cool irrigated cropland
+    vegcorr(40,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/)
+    ! 41 cold irrigated cropland
+    vegcorr(41,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/)
+    ! 42 cool grasses and shrubs
+    vegcorr(42,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0/)
+    ! 43 hot and mild grasses and shrubs
+    vegcorr(43,:) = &
+         & (/0.2, 0.0, 0.1, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0/)
+    ! 44 cold grassland
+    vegcorr(44,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.0/)
+    ! 45 Savanna (woods) C3
+    vegcorr(45,:) = &
+         & (/0.1, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0/)
+    ! 46 Savanna woods C4
+    vegcorr(46,:) = &
+         & (/0.1, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0/)
+    ! 47 Mire, bog, fen
+    vegcorr(47,:) = &
+         & (/0.1, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0/)
+    ! 48 Warm marsh wetland
+    vegcorr(48,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    ! 49 cold marsh wetland
+    vegcorr(49,:) = &
+         & (/0.0, 0.0, 0.0, 0.1, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    ! 50 mediteraean scrub
+    vegcorr(50,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    ! 51 Cool dry woody scrub
+    vegcorr(51,:) = &
+         & (/0.3, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 52 Warm dry evergreen woods
+    vegcorr(52,:) = &
+         & (/0.1, 0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 53 Volcanic rocks
+    vegcorr(53,:) = &
+         & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 54 sand desert
+    vegcorr(54,:) = &
+         & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 55 warm semi desert shrubs
+    vegcorr(55,:) = &
+         & (/0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
+    ! 56 cool semi desert shrubs
+    vegcorr(56,:) = &
+         & (/0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0/)
+    ! 57 semi desert sage
+    vegcorr(57,:) = &
+         & (/0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 58 Barren tundra
+    vegcorr(58,:) = &
+         & (/0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0/)
+    ! 59 cool southern hemisphere mixed forest
+    vegcorr(59,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.3, 0.3, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
+    ! 60 cool fields and woods
+    vegcorr(60,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
+    ! 61 warm forest and filed
+    vegcorr(61,:) = &
+         & (/0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6/)
+    ! 62 cool forest and field
+    vegcorr(62,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
+    ! 63 warm C3 fields and woody savanna
+    vegcorr(63,:) = &
+         & (/0.1, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
+    ! 64 warm C4 fields and woody savanna
+    vegcorr(64,:) = &
+         & (/0.1, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6/)
+    ! 65 cool fields and woody savanna
+    vegcorr(65,:) = &
+         & (/0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
+    ! 66 warm succulent and thorn scrub
+    vegcorr(66,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
+    ! 67 cold small leaf mixed woods
+    vegcorr(67,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.3, 0.0, 0.5, 0.0, 0.0, 0.0/)
+    ! 68 cold deciduous and mixed boreal fores
+    vegcorr(68,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
+    ! 69 cold narrow conifers
+    vegcorr(69,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0/)
+    ! 70 cold wooded tundra
+    vegcorr(70,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.7, 0.0, 0.0, 0.0/)
+    ! 71 cold heath scrub
+    vegcorr(71,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.7, 0.0, 0.0, 0.0/)
+    ! 72 Polar and alpine desert
+    vegcorr(72,:) = &
+         & (/0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0/)
+    ! 73 warm Mangrove
+    vegcorr(73,:) = &
+         & (/0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 74 cool crop and water mixtures
+    vegcorr(74,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
+    ! 75 cool southern hemisphere mixed forest
+    vegcorr(75,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.4, 0.4, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 76 cool moist eucalyptus
+    vegcorr(76,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
+    ! 77 warm rain green tropical forest
+    vegcorr(77,:) = &
+         & (/0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    ! 78 warm C3 woody savanna
+    vegcorr(78,:) = &
+         & (/0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 79 warm C4 woody savanna
+    vegcorr(79,:) = &
+         & (/0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0/)
+    ! 80 cool woody savanna
+    vegcorr(80,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 81 cold woody savanna
+    vegcorr(81,:) = &
+         & (/0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
+    ! 82 warm broadleaf crops
+    vegcorr(82,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0/)
+    ! 83 warm C3 grass crops
+    vegcorr(83,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0/)
+    ! 84 warm C4 grass crops
+    vegcorr(84,:) = &
+         & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9/)
+    ! 85 cool grass crops
+    vegcorr(85,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/)
+    ! 86 warm C3 crops grass,shrubs
+    vegcorr(86,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0/)
+    ! 87 cool crops,grass,shrubs
+    vegcorr(87,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.5, 0.0/)
+    ! 88 warm evergreen tree crop
+    vegcorr(88,:) = &
+         & (/0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2/)
+    ! 89 cool evergreen tree crop
+    vegcorr(89,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0/)
+    ! 90 cold evergreen tree crop
+    vegcorr(90,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0/)
+    ! 91 warm deciduous tree crop
+    vegcorr(91,:) = &
+         & (/0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2/)
+    ! 92 cool deciduous tree crop
+    vegcorr(92,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0/)
+    ! 93 cold deciduous tree crop
+    vegcorr(93,:) = &
+         & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.2, 0.0/)
+    ! 94 wet sclerophylic forest
+    vegcorr(94,:) = &
+         & (/0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
+    !-
+    ! 3 Check the mapping for the Olson types which are going into the
+    !   the veget and nobio array.
+    !-
+    DO ib=1,nolson
+       !
+       IF ( ABS(SUM(vegcorr(ib,:))+SUM(nobiocorr(ib,:))-1.0) &
+            &       > EPSILON(1.0)) THEN
+          WRITE(numout,*) 'Wrong correspondance for Olson type :', ib
+          CALL ipslerr_p(3,'get_vegcorr', '', '',&
+               &                 'Wrong correspondance for Olson type.') ! Fatal error
+       ENDIF
+       !
+    ENDDO ! Loop over the # Olson type
+
+
+  END SUBROUTINE get_vegcorr
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: get_soilcorr
+!!
+!>\BRIEF         The "get_soilcorr" routine defines the table of correspondence
+!!               between the Zobler types and the three texture types known by SECHIBA and STOMATE :
+!!               silt, sand and clay. 
+!!
+!! DESCRIPTION : get_soilcorr is needed if you use soils_param.nc .\n
+!!               The data from this file is then interpolated to the grid of the model. \n
+!!               The aim is to get fractions for sand loam and clay in each grid box.\n
+!!               This information is used for soil hydrology and respiration.
+!!
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::texfrac_table
+!!
+!! REFERENCE(S)	: 
+!! - Zobler L., 1986, A World Soil File for global climate modelling. NASA Technical memorandum 87802. NASA 
+!!   Goddard Institute for Space Studies, New York, U.S.A.
+!!
+!! FLOWCHART	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE get_soilcorr (nzobler,textfrac_table)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameters declaration
+    
+    INTEGER(i_std),PARAMETER :: nbtypes_zobler = 7                    !! Number of Zobler types (unitless)
+
+    !! 0.1  Input variables
+    
+    INTEGER(i_std),INTENT(in) :: nzobler                              !! Size of the array (unitless)
+    
+    !! 0.2 Output variables 
+    
+    REAL(r_std),DIMENSION(nzobler,nstm),INTENT(out) :: textfrac_table !! Table of correspondence (0-1, unitless)
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std) :: ib                                              !! Indice (unitless)
+    
+!_ ================================================================================================================================
+
+    !-
+    ! 0. Check consistency
+    !-  
+    IF (nzobler /= nbtypes_zobler) THEN 
+       CALL ipslerr_p(3,'get_soilcorr', 'nzobler /= nbtypes_zobler',&
+          &   'We do not have the correct number of classes', &
+          &                 ' in the code for the file.')  ! Fatal error
+    ENDIF
+
+    !-
+    ! 1. Textural fraction for : silt        sand         clay
+    !-
+    textfrac_table(1,:) = (/ 0.12, 0.82, 0.06 /)
+    textfrac_table(2,:) = (/ 0.32, 0.58, 0.10 /)
+    textfrac_table(3,:) = (/ 0.39, 0.43, 0.18 /)
+    textfrac_table(4,:) = (/ 0.15, 0.58, 0.27 /)
+    textfrac_table(5,:) = (/ 0.34, 0.32, 0.34 /)
+    textfrac_table(6,:) = (/ 0.00, 1.00, 0.00 /)
+    textfrac_table(7,:) = (/ 0.39, 0.43, 0.18 /)
+
+
+    !-
+    ! 2. Check the mapping for the Zobler types which are going into the ORCHIDEE textures classes 
+    !-
+    DO ib=1,nzobler ! Loop over # classes soil
+       
+       IF (ABS(SUM(textfrac_table(ib,:))-1.0) > EPSILON(1.0)) THEN ! The sum of the textural fractions should not exceed 1 !
+          WRITE(numout,*) &
+               &     'Error in the correspondence table', &
+               &     ' sum is not equal to 1 in', ib
+          WRITE(numout,*) textfrac_table(ib,:)
+          CALL ipslerr_p(3,'get_soilcorr', 'SUM(textfrac_table(ib,:)) /= 1.0',&
+               &                 '', 'Error in the correspondence table') ! Fatal error
+       ENDIF
+       
+    ENDDO ! Loop over # classes soil
+
+    
+  END SUBROUTINE get_soilcorr
+
+!! ================================================================================================================================
+!! FUNCTION 	: tempfunc
+!!
+!>\BRIEF        ! This function interpolates value between ztempmin and ztempmax
+!! used for lai detection. 
+!!
+!! DESCRIPTION   : This subroutine calculates a scalar between 0 and 1 with the following equation :\n
+!!                 \latexonly
+!!                 \input{constantes_veg_tempfunc.tex}
+!!                 \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : tempfunc_result
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION tempfunc (temp_in) RESULT (tempfunc_result)
+
+
+    !! 0. Variables and parameters declaration
+
+    REAL(r_std),PARAMETER    :: ztempmin=273._r_std   !! Temperature for laimin (K)
+    REAL(r_std),PARAMETER    :: ztempmax=293._r_std   !! Temperature for laimax (K)
+    REAL(r_std)              :: zfacteur              !! Interpolation factor   (K^{-2})
+
+    !! 0.1 Input variables
+
+    REAL(r_std),INTENT(in)   :: temp_in               !! Temperature (K)
+
+    !! 0.2 Result
+
+    REAL(r_std)              :: tempfunc_result       !! (unitless)
+    
+!_ ================================================================================================================================
+
+    !! 1. Define a coefficient
+    zfacteur = un/(ztempmax-ztempmin)**2
+    
+    !! 2. Computes tempfunc
+    IF     (temp_in > ztempmax) THEN
+       tempfunc_result = un
+    ELSEIF (temp_in < ztempmin) THEN
+       tempfunc_result = zero
+    ELSE
+       tempfunc_result = un-zfacteur*(ztempmax-temp_in)**2
+    ENDIF !(temp_in > ztempmax)
+
+
+  END FUNCTION tempfunc
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : slowproc_checkveget
+!!
+!>\BRIEF         To verify the consistency of the various fractions defined within the grid box after having been
+!!               been updated by STOMATE or the standard procedures.
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: none
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+!
+  SUBROUTINE slowproc_checkveget(nbpt, frac_nobio, veget_max, veget, soiltile)
+    !
+    !
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)                      :: nbpt       ! Number of points for which the data needs to be interpolated
+    REAL(r_std),DIMENSION (nbpt,nnobio), INTENT(in) :: frac_nobio ! Fraction of ice,lakes,cities, ... (unitless)
+    REAL(r_std),DIMENSION (nbpt,nvm), INTENT(in)    :: veget_max  ! Maximum fraction of vegetation type including none biological fraction (unitless) 
+    REAL(r_std),DIMENSION (nbpt,nvm), INTENT(in)    :: veget      ! Vegetation fractions
+    REAL(r_std),DIMENSION (nbpt,nstm), INTENT(in)   :: soiltile   ! Fraction of soil tiles in the gridbox (unitless)
+    !
+    !  0.2 OUTPUT
+    !
+
+    !
+    !  0.3 LOCAL
+    !
+    INTEGER(i_std) :: ji, jn, jv, js
+    REAL(r_std)  :: epsilocal
+    REAL(r_std)  :: totfrac
+    CHARACTER(len=80) :: str1, str2
+    INTEGER(i_std), PARAMETER :: ibaresoil=1
+    !
+!_ ================================================================================================================================
+    !
+    !
+    ! There is some margin added as the computing errors might bring us above EPSILON(un)
+    !
+    epsilocal = EPSILON(un)*1000.
+    !
+    ! 1.0 Verify that none of the fractions are smaller than min_vegfrac, without beeing zero.
+    !
+    DO ji=1,nbpt
+       DO jn=1,nnobio
+          IF ( frac_nobio(ji,jn) > epsilocal .AND. frac_nobio(ji,jn) < min_vegfrac ) THEN
+             WRITE(str1,'("Occurs on grid box", I8," and nobio type ",I3 )') ji, jn
+             WRITE(str2,'("The small value obtained is ", E14.4)') frac_nobio(ji,jn)
+             CALL ipslerr_p (3,'slowproc_checkveget', &
+                   "frac_nobio is larger than zero but smaller than min_vegfrac.", str1, str2)
+          ENDIF
+       ENDDO
+       DO jv=1,nvm
+          IF ( veget_max(ji,jv) > epsilocal .AND. veget_max(ji,jv) < min_vegfrac ) THEN
+             WRITE(str1,'("Occurs on grid box", I8," and nobio type ",I3 )') ji, jn
+             WRITE(str2,'("The small value obtained is ", E14.4)') veget_max(ji,jv)
+             CALL ipslerr_p (3,'slowproc_checkveget', &
+                   "veget_max is larger than zero but smaller than min_vegfrac.", str1, str2)
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! 2.0 verify that with all the fractions we cover the entire grid box  
+    !
+    DO ji=1,nbpt
+       totfrac = zero
+       DO jn=1,nnobio
+          totfrac = totfrac + frac_nobio(ji,jn)
+       ENDDO
+       DO jv=1,nvm
+          totfrac = totfrac + veget_max(ji,jv)
+       ENDDO
+       IF ( ABS(totfrac - un) > epsilocal) THEN
+             WRITE(str1,'("This occurs on grid box", I8)') ji
+             WRITE(str2,'("The sum over all fraction and error are ", E14.4, E14.4)') totfrac, ABS(totfrac - un)
+             CALL ipslerr_p (3,'slowproc_checkveget', &
+                   "veget_max + frac_nobio is not equal to 1.", str1, str2)
+             WRITE(*,*) "EPSILON =", epsilocal 
+       ENDIF
+    ENDDO
+    !
+    ! 3.0 Verify that veget is smaller or equal to veget_max
+    !
+    DO ji=1,nbpt
+       DO jv=1,nvm
+          IF ( jv == ibaresoil ) THEN
+             IF ( ABS(veget(ji,jv) - veget_max(ji,jv)) > epsilocal ) THEN
+                WRITE(str1,'("This occurs on grid box", I8)') ji
+                WRITE(str2,'("The difference is ", E14.4)') veget(ji,jv) - veget_max(ji,jv)
+                CALL ipslerr_p (3,'slowproc_checkveget', &
+                     "veget is not equal to veget_max on bare soil.", str1, str2)
+             ENDIF
+          ELSE
+             IF ( veget(ji,jv) > veget_max(ji,jv) ) THEN
+                WRITE(str1,'("This occurs on grid box", I8)') ji
+                WRITE(str2,'("The values for veget and veget_max :", F8.4, F8.4)') veget(ji,jv), veget_max(ji,jv)
+                CALL ipslerr_p (3,'slowproc_checkveget', &
+                     "veget is greater than veget_max.", str1, str2)
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! 4.0 Test tot_bare_soil in relation to the other variables
+    !
+    DO ji=1,nbpt
+       totfrac = zero
+       DO jv=1,nvm
+          totfrac = totfrac + (veget_max(ji,jv) - veget(ji,jv))
+       ENDDO
+       ! add the bare soil fraction to totfrac
+       totfrac = totfrac + veget(ji,ibaresoil)
+       ! do the test
+       IF ( ABS(totfrac - tot_bare_soil(ji)) > epsilocal ) THEN
+          WRITE(str1,'("This occurs on grid box", I8)') ji
+          WRITE(str2,'("The values for tot_bare_soil, tot frac and error :", F8.4, F8.4, E14.4)') &
+               &  tot_bare_soil(ji), totfrac, ABS(totfrac - tot_bare_soil(ji))
+          CALL ipslerr_p (3,'slowproc_checkveget', &
+               "tot_bare_soil does not correspond to the total bare soil fraction.", str1, str2)
+       ENDIF
+    ENDDO
+    !
+    ! 5.0 Test that soiltile has the right sum
+    !
+    DO ji=1,nbpt
+       totfrac = zero
+       DO js=1,nstm
+          totfrac = totfrac + soiltile(ji,js)
+       ENDDO
+       IF ( ABS(totfrac - un) > epsilocal ) THEN
+          WRITE(str1,'("This occurs on grid box", I8)') ji
+          WRITE(str2,'("The sum of soiltile and error are :", F8.4, E14.4)') soiltile, ABS(totfrac - un)
+          CALL ipslerr_p (3,'slowproc_checkveget', &
+               "soiltile does not sum-up to one.", str1, str2)
+       ENDIF
+    ENDDO
+    !
+  END SUBROUTINE slowproc_checkveget
+    
+
+END MODULE slowproc
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/thermosoil.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/thermosoil.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/thermosoil.f90	(revision 5166)
@@ -0,0 +1,1585 @@
+! =================================================================================================================================
+! MODULE       : thermosoil
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Calculates the soil temperatures by solving the heat
+!! diffusion equation within the soil
+!!
+!!\n DESCRIPTION : General important informations about the numerical scheme and
+!!                 the soil vertical discretization:\n
+!!               - the soil is divided into "ngrnd" (=7 by default) layers, reaching to as
+!!                 deep as 5.5m down within the soil, with thiscknesses
+!!                 following a geometric series of ration 2.\n
+!!               - "jg" is usually used as the index going from 1 to ngrnd to describe the
+!!                  layers, from top (jg=1) to bottom (jg=ngrnd)\n
+!!               - the thermal numerical scheme is implicit finite differences.\n
+!!                 -- When it is resolved in thermosoil_profile at the present timestep t, the
+!!                 dependancy from the previous timestep (t-1) is hidden in the
+!!                 integration coefficients cgrnd and dgrnd, which are therefore
+!!                 calculated at the very end of thermosoil_main (call to
+!!                 thermosoil_coef) for use in the next timestep.\n
+!!                 -- At timestep t, the system becomes :\n 
+!!
+!!                              T(k+1)=cgrnd(k)+dgrnd(k)*T(k) \n
+!!                                      -- EQ1 -- \n
+!!
+!!                 (the bottom boundary condition has been used to obtained this equation).\n
+!!                 To solve it, the uppermost soil temperature T(1) is required.
+!!                 It is obtained from the surface temperature Ts, which is
+!!                 considered a linear extrapolation of T(1) and T(2)\n
+!!
+!!                           Ts=(1-lambda)*T(1) -lambda*T(2) \n 
+!!                                      -- EQ2--\n
+!!
+!!                 -- caveat 1 : Ts is called 'temp_soil_new' in this routine,
+!!                 don' t act.\n
+!!                 -- caveat 2 : actually, the surface temperature at time t Ts
+!!                 depends on the soil temperature at time t through the
+!!                 ground heat flux. This is again implicitly solved, with Ts(t)
+!!                 expressed as :\n
+!!
+!!                 soilcap*(Ts(t)-Ts(t-1))/dt=soilflux+otherfluxes(Ts(t))\n 
+!!                                      -- EQ3 --\n
+!!
+!!                 and the dependency from the previous timestep is hidden in
+!!                 soilcap and soilflux (apparent surface heat capacity and heat
+!!                 flux respectively). Soilcap and soilflux are therefore
+!!                 calculated at the previsou timestep, at the very end of thermosoil
+!!                 (final call to thermosoil_coef) and stored to be used at the next time step.
+!!                 At timestep t, EQ3 is solved for Ts in enerbil, and Ts
+!!                 is used in thermosoil to get T(1) and solve EQ1.\n
+!!
+!! - lambda is the @tex $\mu$ @endtex of F. Hourdin' s PhD thesis, equation (A28); ie the
+!! coefficient of the linear extrapolation of Ts (surface temperature) from T1 and T2 (ptn(jg=1) and ptn(jg=2)), so that:\n
+!! Ts= (1+lambda)*T(1)-lambda*T(2) --EQ2-- \n
+!! lambda = (zz_coeff(1))/((zz_coef(2)-zz_coef(1))) \n
+!!
+!! - cstgrnd is the attenuation depth of the diurnal temperature signal
+!! (period : one_day) as a result of the heat conduction equation
+!! with no coefficients :
+!!\latexonly
+!!\input{thermosoil_var_init0.tex}
+!!\endlatexonly
+!!  -- EQ4 --\n
+!! This equation results from the change of variables :
+!! z' =z*sqrt(Cp/K) where z' is the new depth (homogeneous
+!! to sqrt(time) ), z the real depth (in m), Cp and K the soil heat
+!! capacity and conductivity respectively.\n
+!!
+!! the attenuation depth of a diurnal thermal signal for EQ4 is therefore homogeneous to sqrt(time) and
+!! equals : \n
+!! cstgrnd = sqrt(oneday/Pi)
+!!
+!! - lskin is the attenuation depth of the diurnal temperature signal
+!! (period : one_day) within the soil for the complete heat conduction equation
+!! (ie : with coefficients)
+!!\latexonly
+!!\input{thermosoil_var_init00.tex}
+!!\endlatexonly
+!! -- EQ5 --  \n
+!! it can be retrieved from cstgrnd using the change of variable  z' =z*sqrt(Cp/K):\n
+!! lskin = sqrt(K/Cp)*cstgrnd =  sqrt(K/Cp)*sqrt(oneday//Pi)\n
+!! 
+!! In thermosoil, the ratio lskin/cstgrnd is frequently used as the
+!! multiplicative factor to go from
+!!'adimensional' depths (like z' ) to real depths (z). z' is not really
+!! adimensional but is reffered to like this in the code.
+!!
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) : None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE thermosoil
+
+  ! modules used :
+  USE ioipsl
+  USE ioipsl_para
+  USE constantes
+  USE constantes_soil
+  USE sechiba_io
+  USE grid
+
+
+  IMPLICIT NONE
+
+  !private and public routines :
+  PRIVATE
+  PUBLIC :: thermosoil_main,thermosoil_clear 
+
+  LOGICAL, SAVE                                   :: l_first_thermosoil=.TRUE.!! does the initialisation of the routine 
+                                                                              !! (true/false)
+!$OMP THREADPRIVATE(l_first_thermosoil)
+  CHARACTER(LEN=80) , SAVE                        :: var_name                 !! To store variables names for the 
+                                                                              !! input-outputs dealt with by IOIPSL
+!$OMP THREADPRIVATE(var_name)
+  REAL(r_std), SAVE                               :: lambda, cstgrnd, lskin   !! See Module description
+!$OMP THREADPRIVATE(lambda, cstgrnd, lskin)
+  REAL(r_std), SAVE                               :: fz1, zalph               !! usefull constants for diverse use
+!$OMP THREADPRIVATE(fz1, zalph)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ptn                      !! vertically discretized 
+                                                                              !! soil temperatures @tex ($K$) @endtex. 
+!$OMP THREADPRIVATE(ptn)
+  REAL(r_std), SAVE, DIMENSION (ngrnd)            :: zz                       !! depths of the soil thermal numerical nodes. 
+                                                                              !! Caveats: they are not exactly the centers of the
+                                                                              !! thermal layers, see the calculation in 
+                                                                              !! ::thermosoil_var_init  @tex ($m$) @endtex.
+!$OMP THREADPRIVATE(zz)
+  REAL(r_std), SAVE, DIMENSION (ngrnd)            :: zz_coef		      !! depths of the boundaries of the thermal layers,
+                                                                              !! see the calculation in 
+                                                                              !! thermosoil_var_init  @tex ($m$) @endtex.
+!$OMP THREADPRIVATE(zz_coef)
+  REAL(r_std), SAVE, DIMENSION (ngrnd)            :: dz1                      !! numerical constant used in the thermal numerical
+                                                                              !! scheme  @tex ($m^{-1}$) @endtex. ; it corresponds
+                                                                              !! to the coefficient  @tex $d_k$ @endtex of equation
+                                                                              !! (A.12) in F. Hourdin PhD thesis.
+!$OMP THREADPRIVATE(dz1)
+  REAL(r_std), SAVE, DIMENSION (ngrnd)            :: dz2                      !! thicknesses of the thermal layers  @tex ($m$)
+                                                                              !! @endtex; typically: 
+                                                                              !! dz2(jg)=zz_coef(jg+1)-zz_coef(jg); calculated once 
+                                                                              !! and for all in thermosoil_var_init
+!$OMP THREADPRIVATE(dz2)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: z1                       !! constant of the numerical scheme; it is an 
+                                                                              !! intermediate buffer for the calculation of the 
+                                                                              !! integration coefficients cgrnd and dgrnd.
+!$OMP THREADPRIVATE(z1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: cgrnd                    !! integration coefficient for the numerical scheme,
+                                                                              !! see eq.1
+!$OMP THREADPRIVATE(cgrnd)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dgrnd                    !! integration coefficient for the numerical scheme,
+                                                                              !! see eq.1
+!$OMP THREADPRIVATE(dgrnd)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcapa                    !! volumetric vertically discretized soil heat 
+                                                                              !! capacity  @tex ($J K^{-1} m^{-3}$) @endtex. 
+                                                                              !! It depends on the soil
+                                                                              !! moisture content (wetdiag) and is calculated at 
+                                                                              !! each time step in thermosoil_coef.
+!$OMP THREADPRIVATE(pcapa)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pkappa                   !! vertically discretized soil thermal conductivity 
+                                                                              !!  @tex ($W K^{-1} m^{-1}$) @endtex. Same as pcapa.
+!$OMP THREADPRIVATE(pkappa)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: zdz1                     !! numerical constant of the numerical scheme; it is
+                                                                              !! an intermediate buffer for the calculation of the 
+                                                                              !! integration coefficients cgrnd and dgrnd 
+                                                                              !!  @tex ($W K^{-1} m^{-1}$) @endtex 
+!$OMP THREADPRIVATE(zdz1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: zdz2                     !! numerical constant of the numerical scheme; it is 
+                                                                              !! an intermediate buffer for the calculation of the 
+                                                                              !! integration coefficients cgrnd and dgrnd
+                                                                              !!  @tex ($W K^{-1} m^{-1}$) @endtex
+!$OMP THREADPRIVATE(zdz2)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcapa_en                 !! heat capacity used for surfheat_incr and 
+                                                                              !! coldcont_incr 
+!$OMP THREADPRIVATE(pcapa_en)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ptn_beg                  !! vertically discretized temperature at the 
+                                                                              !! beginning of the time step  @tex ($K$) @endtex; 
+                                                                              !! is used in 
+                                                                              !! thermosoil_energy for energy-related diagnostic of
+                                                                              !! the routine.
+!$OMP THREADPRIVATE(ptn_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: temp_sol_beg             !! Surface temperature at the beginning of the 
+                                                                              !! timestep  @tex ($K$) @endtex
+!$OMP THREADPRIVATE(temp_sol_beg)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: surfheat_incr            !! Change in soil heat content during the timestep 
+                                                                              !!  @tex ($J$) @endtex.
+!$OMP THREADPRIVATE(surfheat_incr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: coldcont_incr            !! Change in snow heat content  @tex ($J$) @endtex.
+!$OMP THREADPRIVATE(coldcont_incr)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: wetdiag                  !! Soil wetness on the thermodynamical levels 
+                                                                              !! (1, ngrnd) (0-1, dimensionless). corresponds to the
+                                                                              !! relative soil humidity to the wilting point when 
+                                                                              !! the 11-layers hydrology (hydrol) is used, see more
+                                                                              !! precisions in thermosoil_humlev.
+!$OMP THREADPRIVATE(wetdiag)
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_main
+!!
+!>\BRIEF        Thermosoil_main computes the soil thermal properties and dynamics, ie solves
+!! the heat diffusion equation within the soil. The soil temperature profile is
+!! then interpolated onto the diagnostic axis.
+!!
+!! DESCRIPTION : The resolution of the soil heat diffusion equation 
+!! relies on a numerical finite-difference implicit scheme
+!! fully described in the reference and in the header of the thermosoil module.
+!! - The dependency of the previous timestep hidden in the 
+!! integration coefficients cgrnd and dgrnd (EQ1), calculated in thermosoil_coef, and 
+!! called at the end of the routine to prepare for the next timestep.
+!! - The effective computation of the new soil temperatures is performed in thermosoil_profile. 
+!!
+!! - The calling sequence of thermosoil_main is summarized in the flowchart below.
+!! - Thermosoil_init and thermosoil_var_init initialize the variables from
+!! restart files or with default values; they also set up
+!! the vertical discretization for the numerical scheme.
+!! - thermosoil_coef calculates the coefficients for the numerical scheme for the very first iteration of thermosoil;
+!! after that, thermosoil_coef is called only at the end of the module to calculate the coefficients for the next timestep.
+!! - thermosoil_profile solves the numerical scheme.\n
+!!
+!! - Flags : one unique flag : THERMOSOIL_TPRO (to be set to the desired initial soil in-depth temperature in K; by default 280K)
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): vertically discretized soil temperatures ptn, soil
+!! thermal properties (pcapa, pkappa), apparent surface heat capacity (soilcap)
+!! and heat flux (soilflux) to be used in enerbil at the next timestep to solve
+!! the surface energy balance.
+!!
+!! REFERENCE(S) : 
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of planetary atmospheres,
+!!  Ph.D. thesis, Paris VII University. Remark: the part of F. Hourdin' s PhD thesis relative to the thermal
+!!  integration scheme has been scanned and is provided along with the documentation, with name : 
+!!  Hourdin_1992_PhD_thermal_scheme.pdf
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{thermosoil_flowchart.png}
+!! \endlatexonly
+!! 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, index, indexgrnd, &
+       & temp_sol_new, snow, soilcap, soilflx, shumdiag, stempdiag, ptnlev1, rest_id, hist_id, hist2_id)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                            :: kjit             !! Time step number (unitless) 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex         !! Domain size (unitless)
+    INTEGER(i_std),INTENT (in)                            :: rest_id,hist_id  !! Restart_ file and history file identifier 
+                                                                              !! (unitless)
+    INTEGER(i_std),INTENT (in)                            :: hist2_id         !! history file 2 identifier (unitless)
+    REAL(r_std), INTENT (in)                              :: dtradia          !! model iteration time step in seconds (s)
+    LOGICAL, INTENT(in)                                   :: ldrestart_read   !! Logical for restart files to be read 
+                                                                              !! (true/false)
+    LOGICAL, INTENT(in)                                   :: ldrestart_write  !! Logical for restart files to be writen 
+                                                                              !! (true/false)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)      :: index            !! Indeces of the points on the map (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex*ngrnd), INTENT (in):: indexgrnd        !! Indeces of the points on the 3D map (vertical 
+                                                                              !! dimension towards the ground) (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: temp_sol_new     !! Surface temperature at the present time-step,
+                                                                              !! Ts @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: snow             !! Snow mass @tex ($kg$) @endtex.
+                                                                              !! Caveat: when there is snow on the
+                                                                              !! ground, the snow is integrated into the soil for
+                                                                              !! the calculation of the thermal dynamics. It means
+                                                                              !! that the uppermost soil layers can completely or 
+                                                                              !! partially consist in snow. In the second case, zx1
+                                                                              !! and zx2 are the fraction of the soil layer 
+                                                                              !! consisting in snow and 'normal' soil, respectively
+                                                                              !! This is calculated in thermosoil_coef.
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)    :: shumdiag         !! Relative soil humidity on the diagnostic axis 
+                                                                              !! (0-1, unitless). Caveats: when "hydrol" 
+                                                                              !! (the 11-layers hydrology) 
+                                                                              !! is used, this humidity is 
+                                                                              !! calculated with respect to the wilting point: 
+                                                                              !! shumdiag= (mc-mcw)/(mcs-mcw), with mc : moisture 
+                                                                              !! content; mcs : saturated soil moisture content; 
+                                                                              !! mcw: soil moisture content at the wilting point. 
+                                                                              !! When the 2-layers hydrology "hydrolc" is used, 
+                                                                              !! shumdiag is just a soil wetness index, from 0 to 1
+                                                                              !! but cannot direcly be linked to a soil moisture 
+                                                                              !! content.
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: soilcap          !! apparent surface heat capacity
+                                                                              !! @tex ($J m^{-2} K^{-1}$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)      :: soilflx          !! apparent soil heat flux @tex ($W m^{-2}$) @endtex
+                                                                              !! , positive 
+                                                                              !! towards the soil, writen as Qg (ground heat flux) 
+                                                                              !! in the history files, and computed at the end of 
+                                                                              !! thermosoil for the calculation of Ts in enerbil, 
+                                                                              !! see EQ3.
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (inout) :: stempdiag        !! diagnostic temperature profile @tex ($K$) @endtex
+                                                                              !! , eg on the 
+                                                                              !! diagnostic axis (levels:1:nbdl). The soil 
+                                                                              !! temperature is put on this diagnostic axis to be
+                                                                              !! used by other modules (slowproc.f90; routing.f90;
+                                                                              !! hydrol or hydrolc when a frozen soil 
+                                                                              !! parametrization is used..)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)       :: ptnlev1           !! 1st level soil temperature   
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    REAL(r_std),DIMENSION (kjpindex,ngrnd)                :: temp             !! buffer
+    REAL(r_std),DIMENSION (kjpindex,ngrnd-1)              :: temp1            !! buffer
+    REAL(r_std),DIMENSION (kjpindex)                      :: temp2            !! buffer
+    CHARACTER(LEN=80)                                     :: var_name         !! To store variables names for I/O
+
+!_ ================================================================================================================================
+    
+  !! 1. do initialisation
+    
+    IF (l_first_thermosoil) THEN
+
+        IF (long_print) WRITE (numout,*) ' l_first_thermosoil : call thermosoil_init '
+
+        
+        !! 1.1. Allocate and initialize soil temperatures variables
+        !! by reading restart files or using default values. 
+        CALL thermosoil_init (kjit, ldrestart_read, kjpindex, index, rest_id)
+
+       
+        !! 1.2.Computes physical constants and arrays; initializes soil thermal properties; produces the first stempdiag
+        !!  Computes some physical constants and arrays depending on the soil vertical discretization 
+        !! (lskin, cstgrnd, zz, zz_coef, dz1, dz2); get the vertical humidity onto the thermal levels, and 
+        !! initializes soil thermal properties (pkappa, pcapa); produces the first temperature diagnostic stempdiag.
+        CALL thermosoil_var_init (kjpindex, zz, zz_coef, dz1, dz2, pkappa, pcapa, pcapa_en, shumdiag, stempdiag, snow)
+
+        
+        !! 1.3. Computes cgrd, dgrd, soilflx and soilcap coefficients from restart values or initialisation values.
+        CALL thermosoil_coef (kjpindex, dtradia, temp_sol_new, snow, ptn, soilcap, soilflx, zz, dz1, dz2, z1, zdz1,&
+           & zdz2, cgrnd, dgrnd, pcapa, pcapa_en, pkappa)
+        
+        !! 1.4. call to thermosoil_energy, if you wish to perform some checks (?)
+        !!?? the usefulness of this routine seems questionable.
+        CALL thermosoil_energy (kjpindex, temp_sol_new, soilcap, .TRUE.)
+
+        !! 1.5. read restart files for other variables than ptn.
+        !!?? mind the use of ok_var here.
+        !!?? ok_var is a function of sechiba_io_p.f90, documented as follows :
+        !!!! pour dÃ©clancher les restarts rajoutÃ©s avec un paramÃštre externe
+           !!FUNCTION ok_var ( varname )
+           !!CHARACTER(LEN=*), INTENT(IN) :: varname
+           !!LOGICAL ok_var
+           !!ok_var=.FALSE.
+           !!CALL getin_p(varname, ok_var)
+           !!END FUNCTION ok_var
+         !!
+         !! from what we understand, it looks for the chain varname in
+         !!run.def; if absent, returns .FALSE., and the variable named
+         !!'varname' is not searched for in the restart. This looks like a
+         !!trick to read variables in restart files when they are not read
+         !!there by default. For all variables in the following sequence, ok_var
+         !!is by default false, so don' t bother about this.
+         !! this is also logical as those variables have been initialized
+         !!above.
+         !!?? so maybe this part of the code could be deleted to add clarity.
+        IF (ldrestart_read) THEN
+           IF (long_print) WRITE (numout,*) ' we have to READ a restart file for THERMOSOIL variables'
+
+           var_name= 'cgrnd'
+           CALL ioconf_setatt_p('UNITS', '-')
+           CALL ioconf_setatt_p('LONG_NAME','Cgrnd coefficient.')
+           IF ( ok_var(var_name) ) THEN
+              CALL restget_p (rest_id, var_name, nbp_glo, ngrnd-1, 1, kjit, .TRUE., temp1, "gather", nbp_glo, index_g)
+              IF (MINVAL(temp1) < MAXVAL(temp1) .OR. MAXVAL(temp1) .NE. val_exp) THEN
+                 cgrnd(:,:)=temp1(:,:)
+              ENDIF
+           ENDIF
+
+           var_name= 'dgrnd'
+           CALL ioconf_setatt_p('UNITS', '-')
+           CALL ioconf_setatt_p('LONG_NAME','Dgrnd coefficient.')
+           IF ( ok_var(var_name) ) THEN
+              CALL restget_p (rest_id, var_name, nbp_glo, ngrnd-1, 1, kjit, .TRUE., temp1, "gather", nbp_glo, index_g)
+              IF (MINVAL(temp1) < MAXVAL(temp1) .OR. MAXVAL(temp1) .NE. val_exp) THEN
+                 dgrnd(:,:)=temp1(:,:)
+              ENDIF
+           ENDIF
+
+           var_name= 'z1'
+           CALL ioconf_setatt_p('UNITS', '-')
+           CALL ioconf_setatt_p('LONG_NAME','?.')
+           IF ( ok_var(var_name) ) THEN
+              CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., temp2, "gather", nbp_glo, index_g)
+              IF (MINVAL(temp2) < MAXVAL(temp2) .OR. MAXVAL(temp2) .NE. val_exp) THEN
+                 z1(:)=temp2(:)
+              ENDIF
+           ENDIF
+
+           var_name= 'pcapa'
+           CALL ioconf_setatt_p('UNITS', '-')
+           CALL ioconf_setatt_p('LONG_NAME','?.')
+           IF ( ok_var(var_name) ) THEN
+              CALL restget_p (rest_id, var_name, nbp_glo, ngrnd, 1, kjit, .TRUE., temp, "gather", nbp_glo, index_g)
+              IF (MINVAL(temp) < MAXVAL(temp) .OR. MAXVAL(temp) .NE. val_exp) THEN
+                 pcapa(:,:)=temp(:,:)
+              ENDIF
+           ENDIF
+
+           var_name= 'pcapa_en'
+           CALL ioconf_setatt_p('UNITS', '-')
+           CALL ioconf_setatt_p('LONG_NAME','?.')
+           IF ( ok_var(var_name) ) THEN
+              CALL restget_p (rest_id, var_name, nbp_glo, ngrnd, 1, kjit, .TRUE., temp, "gather", nbp_glo, index_g)
+              IF (MINVAL(temp) < MAXVAL(temp) .OR. MAXVAL(temp) .NE. val_exp) THEN
+                 pcapa_en(:,:)=temp(:,:)
+              ENDIF
+           ENDIF
+
+           var_name= 'pkappa'
+           CALL ioconf_setatt_p('UNITS', '-')
+           CALL ioconf_setatt_p('LONG_NAME','?.')
+           IF ( ok_var(var_name) ) THEN
+              CALL restget_p (rest_id, var_name, nbp_glo, ngrnd, 1, kjit, .TRUE., temp, "gather", nbp_glo, index_g)
+              IF (MINVAL(temp) < MAXVAL(temp) .OR. MAXVAL(temp) .NE. val_exp) THEN
+                 pkappa(:,:)=temp(:,:)
+              ENDIF
+           ENDIF
+
+           var_name= 'zdz1'
+           CALL ioconf_setatt_p('UNITS', '-')
+           CALL ioconf_setatt_p('LONG_NAME','?.')
+           IF ( ok_var(var_name) ) THEN
+              CALL restget_p (rest_id, var_name, nbp_glo, ngrnd-1, 1, kjit, .TRUE., temp1, "gather", nbp_glo, index_g)
+              IF (MINVAL(temp1) < MAXVAL(temp1) .OR. MAXVAL(temp1) .NE. val_exp) THEN
+                 zdz1(:,:)=temp1(:,:)
+              ENDIF
+           ENDIF
+
+           var_name= 'zdz2'
+           CALL ioconf_setatt_p('UNITS', '-')
+           CALL ioconf_setatt_p('LONG_NAME','?.')
+           IF ( ok_var(var_name) ) THEN
+              CALL restget_p (rest_id, var_name, nbp_glo, ngrnd, 1, kjit, .TRUE., temp, "gather", nbp_glo, index_g)
+              IF (MINVAL(temp) < MAXVAL(temp) .OR. MAXVAL(temp) .NE. val_exp) THEN
+                 zdz2(:,:)=temp(:,:)
+              ENDIF
+           ENDIF
+
+           var_name='temp_sol_beg'
+           CALL ioconf_setatt_p('UNITS', 'K')
+           CALL ioconf_setatt_p('LONG_NAME','Old Surface temperature')
+           IF ( ok_var(var_name) ) THEN
+              CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., temp2, "gather", nbp_glo, index_g)
+              IF (MINVAL(temp2) < MAXVAL(temp2) .OR. MAXVAL(temp2) .NE. val_exp) THEN
+                 temp_sol_beg(:) = temp2(:)
+              ENDIF
+           ENDIF
+
+        ENDIF !ldrestart_read
+
+        RETURN 
+
+    ENDIF !l_first_thermosoil
+
+    
+  !! 2. Prepares the restart files for the next simulation
+
+    !!?? do all the coefficients (cgrnd, dgrnd...) be put in the restart file
+    !! as they are by default not read there, but calculated in
+    !!thermosoil_var_init from the restart or initial temperature ?
+    !! exceptions are soilcap and soilflx, used in enerbil, and of course ptn.
+    IF (ldrestart_write) THEN
+
+        IF (long_print) WRITE (numout,*) ' we have to complete restart file with THERMOSOIL variables'
+
+        var_name= 'ptn'
+        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd, 1, kjit, ptn, 'scatter', nbp_glo, index_g)
+
+        var_name= 'cgrnd'
+        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd-1, 1, kjit, cgrnd, 'scatter', nbp_glo, index_g)
+        var_name= 'dgrnd'
+        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd-1, 1, kjit, dgrnd, 'scatter', nbp_glo, index_g)
+
+        var_name= 'z1'
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit, z1, 'scatter', nbp_glo, index_g)
+
+        var_name= 'pcapa'
+        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd, 1, kjit, pcapa, 'scatter', nbp_glo, index_g)
+
+        var_name= 'pcapa_en'
+        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd, 1, kjit, pcapa_en, 'scatter', nbp_glo, index_g)
+
+        var_name= 'pkappa'
+        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd, 1, kjit, pkappa, 'scatter', nbp_glo, index_g)
+
+        var_name= 'zdz1'
+        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd-1, 1, kjit, zdz1, 'scatter', nbp_glo, index_g)
+
+        var_name= 'zdz2'
+        CALL restput_p(rest_id, var_name, nbp_glo, ngrnd, 1, kjit, zdz2, 'scatter', nbp_glo, index_g)
+
+        var_name= 'temp_sol_beg'
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit, temp_sol_beg, 'scatter', nbp_glo, index_g)
+
+        var_name= 'soilcap'  
+        CALL restput_p(rest_id, var_name, nbp_glo,   1, 1, kjit,  soilcap, 'scatter',  nbp_glo, index_g)
+        
+        var_name= 'soilflx'  
+        CALL restput_p(rest_id, var_name, nbp_glo,   1, 1, kjit,  soilflx, 'scatter',  nbp_glo, index_g)
+
+        ! read in enerbil
+        var_name= 'temp_sol_new'
+        CALL restput_p(rest_id, var_name, nbp_glo, 1, 1, kjit, temp_sol_new, 'scatter', nbp_glo, index_g)
+
+        RETURN 
+
+    END IF !ldrestart_write
+
+  !! 3. Put the soil wetness diagnostic on the levels of the soil temperature
+
+    !!?? this could logically be put just before the last call to
+    !!thermosoil_coef, as the results are used there...
+    CALL thermosoil_humlev(kjpindex, shumdiag, snow)
+
+    
+  !! 4. Effective computation of the soil temperatures profile, using the cgrd and dgrd coefficients from previsou tstep.
+    
+    CALL thermosoil_profile (kjpindex, temp_sol_new, ptn, stempdiag)
+
+  !! 5. Call to thermosoil_energy, still to be clarified..
+
+    CALL thermosoil_energy (kjpindex, temp_sol_new, soilcap, .FALSE.)
+    
+  !! 6. Writing the history files according to the ALMA standards (or not..)
+
+    !in only one file (hist2_id <=0) or in 2 different files (hist2_id >0).
+    IF ( .NOT. almaoutput ) THEN
+      CALL histwrite_p(hist_id, 'ptn', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+    ELSE
+      CALL histwrite_p(hist_id, 'SoilTemp', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+      CALL histwrite_p(hist_id, 'Qg', kjit, soilflx, kjpindex, index)
+      CALL histwrite_p(hist_id, 'DelSurfHeat', kjit, surfheat_incr, kjpindex, index)
+      CALL histwrite_p(hist_id, 'DelColdCont', kjit, coldcont_incr, kjpindex, index)
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite_p(hist2_id, 'ptn', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+       ELSE
+          CALL histwrite_p(hist2_id, 'SoilTemp', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+          CALL histwrite_p(hist2_id, 'Qg', kjit, soilflx, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelSurfHeat', kjit, surfheat_incr, kjpindex, index)
+          CALL histwrite_p(hist2_id, 'DelColdCont', kjit, coldcont_incr, kjpindex, index)
+       ENDIF
+    ENDIF
+    
+  !! 7. A last final call to thermosoil_coef
+ 
+    !! A last final call to thermosoil_coef, which calculates the different
+    !!coefficients (cgrnd, dgrnd, dz1, z1, zdz2, soilcap, soilflx) from this time step to be
+    !!used at the next time step, either in the surface temperature calculation
+    !!(soilcap, soilflx) or in the soil thermal numerical scheme.
+    CALL thermosoil_coef (kjpindex, dtradia, temp_sol_new, snow, ptn, soilcap, soilflx, zz, dz1, dz2, z1, zdz1,&
+           & zdz2, cgrnd, dgrnd, pcapa, pcapa_en, pkappa)
+
+    ptnlev1(:) = ptn(:,1)
+
+    IF (long_print) WRITE (numout,*) ' thermosoil_main done '
+
+  END SUBROUTINE thermosoil_main
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_init
+!!
+!>\BRIEF        Allocates local and global arrays; initializes soil temperatures using either restart files
+!! or a fixed value set by the flag THERMOSOIL_TPRO.
+!!		  
+!! DESCRIPTION  : flag : THERMOSOIL_TPRO (to be set to the desired initial temperature in K; by default 280K).
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_init(kjit, ldrestart_read, kjpindex, index, rest_id)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT (in)                         :: kjit               !! Time step number (unitless) 
+    LOGICAL,INTENT (in)                                 :: ldrestart_read     !! Logical for restart file to read (true/false)
+    INTEGER(i_std), INTENT (in)                         :: kjpindex           !! Domain size (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index              !! Indeces of the points on the map (unitless)
+    INTEGER(i_std), INTENT (in)                         :: rest_id            !! Restart file identifier (unitless)
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ier
+    CHARACTER(LEN=80)                                  :: var_name            !! To store variables names for I/O
+
+!_ ================================================================================================================================
+
+  !! 1. Initialisation
+
+    !! Initialisation has to be done only one time, so the logical
+    !! logical l_first_thermosoil has to be set to .FALSE. now..
+    IF (l_first_thermosoil) THEN 
+        l_first_thermosoil=.FALSE.
+    ELSE 
+        WRITE (numout,*) ' l_first_thermosoil false . we stop '
+        STOP 'thermosoil_init'
+    ENDIF
+
+  !! 2. Arrays allocations
+
+    ALLOCATE (ptn(kjpindex,ngrnd),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in ptn allocation. We stop. We need ',kjpindex,' fois ',ngrnd,' words = '&
+           & , kjpindex*ngrnd
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (z1(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in z1 allocation. We STOP. We need ',kjpindex,' words '
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (cgrnd(kjpindex,ngrnd-1),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in cgrnd allocation. We STOP. We need ',kjpindex,' fois ',ngrnd-1 ,' words  = '&
+           & , kjpindex*(ngrnd-1)
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (dgrnd(kjpindex,ngrnd-1),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in dgrnd allocation. We STOP. We need ',kjpindex,' fois ',ngrnd-1 ,' words  = '&
+           & , kjpindex*(ngrnd-1)
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (pcapa(kjpindex,ngrnd),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in pcapa allocation. We STOP. We need ',kjpindex,' fois ',ngrnd ,' words  = '&
+           & , kjpindex*ngrnd
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (pkappa(kjpindex,ngrnd),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in pkappa allocation. We STOP. We need ',kjpindex,' fois ',ngrnd ,' words  = '&
+           & , kjpindex*ngrnd
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (zdz1(kjpindex,ngrnd-1),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in zdz1 allocation. We STOP. We need ',kjpindex,' fois ',ngrnd-1 ,' words  = '&
+           & , kjpindex*(ngrnd-1)
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (zdz2(kjpindex,ngrnd),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in zdz2 allocation. We STOP. We need ',kjpindex,' fois ',ngrnd ,' words  = '&
+           & , kjpindex*ngrnd
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (surfheat_incr(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in surfheat_incr allocation. We STOP. We need ',kjpindex,' words  = '&
+           & , kjpindex
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (coldcont_incr(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in coldcont_incr allocation. We STOP. We need ',kjpindex,' words  = '&
+           & , kjpindex
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (pcapa_en(kjpindex,ngrnd),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in pcapa_en allocation. We STOP. We need ',kjpindex,' fois ',ngrnd ,' words  = '&
+           & , kjpindex*ngrnd
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (ptn_beg(kjpindex,ngrnd),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in ptn_beg allocation. We STOP. We need ',kjpindex,' fois ',ngrnd ,' words  = '&
+           & , kjpindex*ngrnd
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (temp_sol_beg(kjpindex),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in temp_sol_beg allocation. We STOP. We need ',kjpindex,' words  = '&
+           & , kjpindex
+        STOP 'thermosoil_init'
+    END IF
+
+    ALLOCATE (wetdiag(kjpindex,ngrnd),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in wetdiag allocation. We STOP. We need ',kjpindex,' fois ',ngrnd ,' words  = '&
+           & , kjpindex*ngrnd
+        STOP 'thermosoil_init'
+    END IF
+    
+  !! 3. Reads restart files for soil temperatures only 
+    
+    !! Reads restart files for soil temperatures only. If no restart file is
+    !! found,  the initial soil temperature is by default set to 280K at all depths. The user
+    !! can decide to initialize soil temperatures at an other value, in which case he should set the flag THERMOSOIL_TPRO
+    !! to this specific value in the run.def.
+    IF (ldrestart_read) THEN
+        IF (long_print) WRITE (numout,*) ' we have to READ a restart file for THERMOSOIL variables'
+
+        var_name= 'ptn'
+        CALL ioconf_setatt_p('UNITS', 'K')
+        CALL ioconf_setatt_p('LONG_NAME','Soil Temperature profile')
+        CALL restget_p (rest_id, var_name, nbp_glo, ngrnd, 1, kjit, .TRUE., ptn, "gather", nbp_glo, index_g)
+        !
+        !Config Key   = THERMOSOIL_TPRO
+        !Config Desc  = Initial soil temperature profile if not found in restart
+        !Config Def   = 280.
+        !Config If    = OK_SECHIBA
+        !Config Help  = The initial value of the temperature profile in the soil if 
+        !Config         its value is not found in the restart file. This should only 
+        !Config         be used if the model is started without a restart file. Here
+        !Config         we only require one value as we will assume a constant 
+        !Config         throughout the column.
+        !Config Units = Kelvin [K]
+        !
+        CALL setvar_p (ptn, val_exp,'THERMOSOIL_TPRO',280._r_std)
+
+    ENDIF
+
+    IF (long_print) WRITE (numout,*) ' thermosoil_init done '
+
+  END SUBROUTINE thermosoil_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_clear
+!!
+!>\BRIEF        Sets the flag l_first_thermosoil to true and desallocates the allocated arrays.
+!! ??!! the call of thermosoil_clear originates from sechiba_clear but the calling sequence and 
+!! its purpose require further investigation.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE thermosoil_clear()
+
+        l_first_thermosoil=.TRUE.
+ 
+        IF ( ALLOCATED (ptn)) DEALLOCATE (ptn)
+        IF ( ALLOCATED (z1)) DEALLOCATE (z1) 
+        IF ( ALLOCATED (cgrnd)) DEALLOCATE (cgrnd) 
+        IF ( ALLOCATED (dgrnd)) DEALLOCATE (dgrnd) 
+        IF ( ALLOCATED (pcapa)) DEALLOCATE (pcapa)
+        IF ( ALLOCATED (pkappa))  DEALLOCATE (pkappa)
+        IF ( ALLOCATED (zdz1)) DEALLOCATE (zdz1)
+        IF ( ALLOCATED (zdz2)) DEALLOCATE (zdz2)
+        IF ( ALLOCATED (pcapa_en)) DEALLOCATE (pcapa_en)
+        IF ( ALLOCATED (ptn_beg)) DEALLOCATE (ptn_beg)
+        IF ( ALLOCATED (temp_sol_beg)) DEALLOCATE (temp_sol_beg)
+        IF ( ALLOCATED (surfheat_incr)) DEALLOCATE (surfheat_incr)
+        IF ( ALLOCATED (coldcont_incr)) DEALLOCATE (coldcont_incr)
+        IF ( ALLOCATED (wetdiag)) DEALLOCATE (wetdiag)
+
+  END SUBROUTINE thermosoil_clear
+
+
+!! ================================================================================================================================
+!! FUNCTION     : fz
+!!
+!>\BRIEF        fz(rk), the function's result, is the "rk"th element of a geometric series 
+!! with first element fz1 and ration zalph.
+!!
+!! DESCRIPTION  : This function is used to calculate the depths of the boudaries of the thermal layers (zz_coef) and 
+!! of the numerical nodes (zz) of the thermal scheme. Formulae to get the adimensional depths are followings :
+!!      zz(jg)      = fz(REAL(jg,r_std) - undemi); \n
+!!      zz_coef(jg) = fz(REAL(jg,r_std))
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! RETURN VALUE : fz(rk)
+!!
+!! REFERENCE(S) : None 
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION fz(rk) RESULT (fz_result)
+
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    REAL(r_std), INTENT(in)                        :: rk
+    
+    !! 0.2 Output variables
+
+    REAL(r_std)                                    :: fz_result
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+!_ ================================================================================================================================
+
+    fz_result = fz1 * (zalph ** rk - un) / (zalph - un)
+
+  END FUNCTION fz
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_var_init
+!!
+!>\BRIEF        Define and initializes the soil thermal parameters
+!!		  
+!! DESCRIPTION	: This routine\n
+!! 1. Defines the parameters ruling the vertical grid of the thermal scheme (fz1, zalpha).\n
+!! 2. Defines the scaling coefficients for adimensional depths (lskin, cstgrnd, see explanation in the 
+!!    variables description of thermosoil_main). \n
+!! 3. Calculates the vertical discretization of the soil (zz, zz_coef, dz2) and the constants used
+!!    in the numerical scheme and which depend only on the discretization (dz1, lambda).\n
+!! 4. Initializes the soil thermal parameters (capacity, conductivity) based on initial soil moisture content.\n
+!! 5. Produces a first temperature diagnostic based on temperature initialization.\n
+!!
+!! The scheme comprizes ngrnd=7 layers by default.
+!! The layer' s boundaries depths (zz_coef) follow a geometric series of ratio zalph=2 and first term fz1.\n
+!! zz_coef(jg)=fz1.(1-zalph^jg)/(1-zalph) \n
+!! The layers' boudaries depths are first calculated 'adimensionally', ie with a
+!! discretization adapted to EQ5. This discretization is chosen for its ability at
+!! reproducing a thermal signal with periods ranging from days to centuries. (see
+!! Hourdin, 1992). Typically, fz1 is chosen as : fz1=0.3*cstgrnd (with cstgrnd the
+!! adimensional attenuation depth). \n
+!! The factor lskin/cstgrnd is then used to go from adimensional depths to
+!! depths in m.\n
+!! zz(real)=lskin/cstgrnd*zz(adimensional)\n
+!! Similarly, the depths of the numerical nodes are first calculated
+!! adimensionally, then the conversion factor is applied.\n
+!! the numerical nodes (zz) are not exactly the layers' centers : their depths are calculated as follows:\n
+!! zz(jg)=fz1.(1-zalph^(jg-1/2))/(1-zalph)\n
+!! The values of zz and zz_coef used in the default thermal discretization are in the following table.
+!! \latexonly
+!! \includegraphics{thermosoil_var_init1.jpg}
+!! \endlatexonly\n
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : None
+!!
+!! REFERENCE(S)	:
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of 
+!! planetary atmospheres, Ph.D. thesis, Paris VII University.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_var_init(kjpindex, zz, zz_coef, dz1, dz2, pkappa, pcapa, pcapa_en, shumdiag, stempdiag, snow)
+
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex          !! Domain size (unitless)
+    REAL(r_std), DIMENSION (kjpindex,nbdl), INTENT (in)      :: shumdiag          !! Relative soil humidity on the diagnostic axis 
+                                                                                  !! (unitless), [0,1]. (see description of the 
+                                                                                  !! variables of thermosoil_main for more 
+                                                                                  !! explanations) 
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)     	     :: snow              !! Snow quantity   
+    
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (ngrnd), INTENT(out)              :: zz                !! depths of the layers'numerical nodes 
+                                                                                  !! @tex ($m$)@endtex 
+    REAL(r_std), DIMENSION (ngrnd), INTENT(out)              :: zz_coef		  !! depths of the layers'boundaries 
+                                                                                  !! @tex ($m$)@endtex 
+    REAL(r_std), DIMENSION (ngrnd), INTENT(out)              :: dz1               !! numerical constant depending on the vertical
+                                                                                  !! thermal grid only @tex  ($m^{-1}$) @endtex. 
+                                                                                  !! (see description
+                                                                                  !! of the variables of thermosoil_main for more
+                                                                                  !! explanations)
+    REAL(r_std), DIMENSION (ngrnd), INTENT(out)              :: dz2               !! thicknesses of the soil thermal layers 
+                                                                                  !! @tex ($m$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(out)     :: pcapa             !! volumetric vertically discretized soil heat 
+                                                                                  !! capacity @tex ($J K^{-1} m^{-3}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(out)     :: pcapa_en	  !! volumetric vertically discretized heat 
+                                                                                  !! capacity used in thermosoil_energy
+                                                                                  !! @tex ($J K^{-1} m^{-3}$) @endtex ;
+                                                                                  !! usefulness still to be clarified.
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(out)     :: pkappa            !! vertically discretized soil thermal 
+                                                                                  !! conductivity @tex ($W m^{-1} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,nbdl), INTENT (out)     :: stempdiag         !! Diagnostic temperature profile @tex ($K$)
+                                                                                  !! @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ier, ji, jg       !! Index (unitless)
+    REAL(r_std)                                              :: sum               !! Temporary variable
+    REAL(r_std)                                              :: so_capa           !! Average Thermal Conductivity of soils 
+                                                                                  !! @tex $(W.m^{-2}.K^{-1})$ @endtex
+    REAL(r_std)                                              :: so_cond           !! Average Thermal Conductivity of soils 
+                                                                                  !! @tex $(W.m^{-2}.K^{-1})$ @endtex
+
+!_ ================================================================================================================================
+
+  !! 1. Initialization of the parameters of the vertical discretization and of the attenuation depths
+    
+    !! so_capa and so_cond are temporary variables which contain the average values of soil conductivity 
+    !! and soil conductivity and are only needed in thermosoil_var_init to set the vertical layering. 
+    so_capa = (so_capa_dry + so_capa_wet)/deux
+    so_cond = (so_cond_dry + so_cond_wet)/deux
+
+    cstgrnd=SQRT(one_day / pi)
+    lskin = SQRT(so_cond / so_capa * one_day / pi)
+    fz1 = 0.3_r_std * cstgrnd
+    zalph = deux
+    
+  !! 2.  Computing the depth of the thermal levels (numerical nodes) and the layers boundaries
+   
+    !! Computing the depth of the thermal levels (numerical nodes) and 
+    !! the layers boundariesusing the so-called
+    !! adimentional variable z' = z/lskin*cstgrnd (with z in m)
+    
+    !! 2.1 adimensional thicknesses of the layers
+    DO jg=1,ngrnd
+
+    !!?? code simplification hopefully possible here with up-to-date compilers !
+    !!! This needs to be solved soon. Either we allow CPP options in SECHIBA or the VPP
+    !!! fixes its compiler 
+    !!!#ifdef VPP5000
+      dz2(jg) = fz(REAL(jg,r_std)-undemi+undemi) - fz(REAL(jg-1,r_std)-undemi+undemi)
+    !!!#else
+    !!!      dz2(jg) = fz(REAL(jg,r_std)) - fz(REAL(jg-1,r_std))
+    !!!#endif
+    ENDDO
+    
+    !! 2.2 adimentional depth of the numerical nodes and layers' boudaries
+    DO jg=1,ngrnd
+      zz(jg)      = fz(REAL(jg,r_std) - undemi)
+      zz_coef(jg) = fz(REAL(jg,r_std)-undemi+undemi)
+    ENDDO
+
+    !! 2.3 Converting to meters
+    DO jg=1,ngrnd
+      zz(jg)      = zz(jg) /  cstgrnd * lskin
+      zz_coef(jg) = zz_coef(jg) / cstgrnd * lskin 
+      dz2(jg)     = dz2(jg) /  cstgrnd * lskin
+    ENDDO
+
+    !! 2.4 Computing some usefull constants for the numerical scheme
+    DO jg=1,ngrnd-1
+      dz1(jg)  = un / (zz(jg+1) - zz(jg))
+    ENDDO
+    lambda = zz(1) * dz1(1)
+
+    !! 2.5 Get the wetness profile on the thermal vertical grid from the diagnostic axis
+    CALL thermosoil_humlev(kjpindex, shumdiag, snow)
+
+    !! 2.6 Thermal conductivity at all levels
+    DO jg = 1,ngrnd
+      DO ji = 1,kjpindex
+        pkappa(ji,jg) = so_cond_dry + wetdiag(ji,jg)*(so_cond_wet - so_cond_dry)
+        pcapa(ji,jg) = so_capa_dry + wetdiag(ji,jg)*(so_capa_wet - so_capa_dry)
+        pcapa_en(ji,jg) = so_capa_dry + wetdiag(ji,jg)*(so_capa_wet - so_capa_dry)
+      ENDDO
+    ENDDO
+    
+  !! 3. Diagnostics : consistency checks on the vertical grid.
+
+    WRITE (numout,*) 'diagnostic des niveaux dans le sol' !!?? to be changed,
+    WRITE (numout,*) 'niveaux intermediaires et pleins'
+    sum = zero
+    DO jg=1,ngrnd
+      sum = sum + dz2(jg)
+      WRITE (numout,*) zz(jg),sum
+    ENDDO
+
+    
+  !! 4. Compute a first diagnostic temperature profile
+    
+    CALL thermosoil_diaglev(kjpindex, stempdiag)
+
+    IF (long_print) WRITE (numout,*) ' thermosoil_var_init done '
+
+  END SUBROUTINE thermosoil_var_init
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_coef
+!!
+!>\BRIEF        Calculate soil thermal properties, integration coefficients, apparent heat flux,
+!! surface heat capacity,  
+!!
+!! DESCRIPTION	: This routine computes : \n
+!!		1. the soil thermal properties. \n 
+!!		2. the integration coefficients of the thermal numerical scheme, cgrnd and dgrnd,
+!!              which depend on the vertical grid and on soil properties, and are used at the next 
+!!              timestep.\n
+!!              3. the soil apparent heat flux and surface heat capacity soilflux
+!!              and soilcap, used by enerbil to compute the surface temperature at the next
+!!              timestep.\n
+!!             -  The soil thermal properties depend on water content (wetdiag) and on the presence 
+!!              of snow : snow is integrated into the soil for the thermal calculations, ie if there 
+!!              is snow on the ground, the first thermal layer(s) consist in snow, depending on the 
+!!              snow-depth. If a layer consists out of snow and soil, wheighed soil properties are 
+!!              calculated\n
+!!             - The coefficients cgrnd and dgrnd are the integration
+!!              coefficients for the thermal scheme \n
+!!                              T(k+1)=cgrnd(k)+dgrnd(k)*T(k) \n
+!!                                      -- EQ1 -- \n
+!!              They correspond respectively to $\beta$ and $\alpha$ from F. Hourdin\'s thesis and 
+!!              their expression can be found in this document (eq A19 and A20)
+!!             - soilcap and soilflux are the apparent surface heat capacity and flux
+!!               used in enerbil at the next timestep to solve the surface
+!!               balance for Ts (EQ3); they correspond to $C_s$ and $F_s$ in F.
+!!               Hourdin\'s PhD thesis and are expressed in eq. A30 and A31. \n
+!!                 soilcap*(Ts(t)-Ts(t-1))/dt=soilflux+otherfluxes(Ts(t)) \n
+!!                                      -- EQ3 --\n
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): cgrnd, dgrnd, pcapa, pkappa, soilcap, soilflx
+!!
+!! REFERENCE(S) :
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of planetary atmospheres,
+!! Ph.D. thesis, Paris VII University. Remark: the part of F. Hourdin's PhD thesis relative to the thermal
+!! integration scheme has been scanned and is provided along with the documentation, with name : 
+!! Hourdin_1992_PhD_thermal_scheme.pdf
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_coef (kjpindex, dtradia, temp_sol_new, snow, ptn, soilcap, soilflx, zz, dz1, dz2, z1, zdz1,&
+           & zdz2, cgrnd, dgrnd, pcapa, pcapa_en, pkappa)
+
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                             :: kjpindex     !! Domain size (unitless)
+    REAL(r_std), INTENT (in)                               :: dtradia      !! Time step in seconds @tex ($s$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: temp_sol_new !! soil surface temperature @tex ($K$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT (in)         :: snow         !! snow mass @tex ($Kg$) @endtex
+    REAL(r_std), DIMENSION (ngrnd), INTENT(in)             :: zz           !! depths of the soil thermal numerical nodes 
+                                                                           !! @tex ($m$) @endtex 
+    REAL(r_std), DIMENSION (ngrnd), INTENT(in)             :: dz1          !! numerical constant depending on the vertical 
+                                                                           !! thermal grid only @tex ($m^{-1}$) @endtex 
+    REAL(r_std), DIMENSION (ngrnd), INTENT(in)             :: dz2          !! thicknesses of the soil thermal layers
+                                                                           !! @tex ($m$) @endtex 
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT (in)   :: ptn          !! vertically discretized soil temperatures  
+                                                                           !! @tex ($K$) @endtex
+    
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)        :: soilcap      !! surface heat capacity
+                                                                           !! @tex ($J m^{-2} K^{-1}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)        :: soilflx      !! surface heat flux @tex ($W m^{-2}$) @endtex,
+                                                                           !! positive towards the 
+                                                                           !! soil, writen as Qg (ground heat flux) in the history 
+                                                                           !! files.
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)        :: z1           !! numerical constant @tex ($W m^{-1} K^{-1}$) @endtex
+
+    REAL(r_std), DIMENSION (kjpindex,ngrnd-1), INTENT(out) :: cgrnd        !! matrix coefficient for the computation of soil 
+                                                                           !! temperatures (beta in F. Hourdin thesis)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd-1), INTENT(out) :: dgrnd        !! matrix coefficient for the computation of soil 
+                                                                           !! temperatures (alpha in F. Hourdin thesis)
+    REAL(r_std), DIMENSION (kjpindex,ngrnd-1), INTENT(out) :: zdz1         !! numerical (buffer) constant 
+                                                                           !! @tex ($W m^{-1} K^{-1}$) @endtex
+
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(out)   :: zdz2         !! numerical (buffer) constant  
+                                                                           !! @tex ($W m^{-1} K^{-1}$) @endtex
+
+
+    !! 0.3 Modified variable
+
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(inout) :: pcapa        !! volumetric vertically discretized soil heat capacity
+                                                                           !! @tex ($J K^{-1} m^{-3}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(inout) :: pcapa_en     !! volumetric vertically discretized heat capacity used 
+                                                                           !! to calculate surfheat_incr
+                                                                           !! @tex ($J K^{-1} m^{-3}$) @endtex
+    REAL(r_std), DIMENSION (kjpindex,ngrnd), INTENT(inout) :: pkappa       !! vertically discretized soil thermal conductivity 
+                                                                           !! @tex ($W m^{-1} K^{-1}$) @endtex
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                         :: ji, jg
+    REAL(r_std), DIMENSION(kjpindex)                       :: snow_h       !! snow_h is the snow height @tex ($m$) @endtex 
+    REAL(r_std), DIMENSION(kjpindex)                       :: zx1, zx2     !! zx1 and zx2 are the layer fraction consisting in snow
+                                                                           !! and soil respectively.
+!_ ================================================================================================================================
+
+  !! 1. Computation of the soil thermal properties
+   
+    ! Computation of the soil thermal properties; snow properties are also accounted for
+    DO ji = 1,kjpindex
+      snow_h(ji) = snow(ji) / sn_dens
+
+      IF ( snow_h(ji) .GT. zz_coef(1) ) THEN
+          pcapa(ji,1) = sn_capa
+          pcapa_en(ji,1) = sn_capa
+          pkappa(ji,1) = sn_cond
+      ELSE IF ( snow_h(ji) .GT. zero ) THEN
+          pcapa_en(ji,1) = sn_capa
+          zx1(ji) = snow_h(ji) / zz_coef(1)
+          zx2(ji) = ( zz_coef(1) - snow_h(ji)) / zz_coef(1)
+          pcapa(ji,1) = zx1(ji) * sn_capa + zx2(ji) * so_capa_wet
+          pkappa(ji,1) = un / ( zx1(ji) / sn_cond + zx2(ji) / so_cond_wet )
+      ELSE
+          pcapa(ji,1) = so_capa_dry + wetdiag(ji,1)*(so_capa_wet - so_capa_dry)
+          pkappa(ji,1) = so_cond_dry + wetdiag(ji,1)*(so_cond_wet - so_cond_dry)
+          pcapa_en(ji,1) = so_capa_dry + wetdiag(ji,1)*(so_capa_wet - so_capa_dry)
+      ENDIF
+      !
+      DO jg = 2, ngrnd - 2
+        IF ( snow_h(ji) .GT. zz_coef(jg) ) THEN
+            pcapa(ji,jg) = sn_capa
+            pkappa(ji,jg) = sn_cond
+            pcapa_en(ji,jg) = sn_capa
+        ELSE IF ( snow_h(ji) .GT. zz_coef(jg-1) ) THEN
+            zx1(ji) = (snow_h(ji) - zz_coef(jg-1)) / (zz_coef(jg) - zz_coef(jg-1))
+            zx2(ji) = ( zz_coef(jg) - snow_h(ji)) / (zz_coef(jg) - zz_coef(jg-1))
+            pcapa(ji,jg) = zx1(ji) * sn_capa + zx2(ji) * so_capa_wet
+            pkappa(ji,jg) = un / ( zx1(ji) / sn_cond + zx2(ji) / so_cond_wet )
+            pcapa_en(ji,jg) = sn_capa
+        ELSE
+            pcapa(ji,jg) = so_capa_dry + wetdiag(ji,jg)*(so_capa_wet - so_capa_dry)
+            pkappa(ji,jg) = so_cond_dry + wetdiag(ji,jg)*(so_cond_wet - so_cond_dry)
+            pcapa_en(ji,jg) = so_capa_dry + wetdiag(ji,jg)*(so_capa_wet - so_capa_dry)
+        ENDIF
+      ENDDO
+    
+    ENDDO
+
+    !! 2. computation of the coefficients of the numerical integration scheme
+
+    ! cgrnd, dgrnd
+
+    !! 2.1.  some "buffer" values
+    DO jg=1,ngrnd
+      DO ji=1,kjpindex
+        zdz2(ji,jg)=pcapa(ji,jg) * dz2(jg)/dtradia
+      ENDDO
+    ENDDO
+    
+    DO jg=1,ngrnd-1
+      DO ji=1,kjpindex
+        zdz1(ji,jg) = dz1(jg) * pkappa(ji,jg)
+      ENDDO
+    ENDDO
+    
+    !! 2.2.  the coefficients ! 
+    DO ji = 1,kjpindex
+      z1(ji) = zdz2(ji,ngrnd) + zdz1(ji,ngrnd-1)
+      cgrnd(ji,ngrnd-1) = zdz2(ji,ngrnd) * ptn(ji,ngrnd) / z1(ji)
+      dgrnd(ji,ngrnd-1) = zdz1(ji,ngrnd-1) / z1(ji)
+    ENDDO
+
+    DO jg = ngrnd-1,2,-1
+      DO ji = 1,kjpindex
+        z1(ji) = un / (zdz2(ji,jg) + zdz1(ji,jg-1) + zdz1(ji,jg) * (un - dgrnd(ji,jg)))
+        cgrnd(ji,jg-1) = (ptn(ji,jg) * zdz2(ji,jg) + zdz1(ji,jg) * cgrnd(ji,jg)) * z1(ji)
+        dgrnd(ji,jg-1) = zdz1(ji,jg-1) * z1(ji)
+      ENDDO
+    ENDDO
+
+  !! 3. Computation of the apparent ground heat flux 
+    
+    !! Computation of the apparent ground heat flux (> towards the soil) and
+    !! apparent surface heat capacity, used at the next timestep by enerbil to
+    !! compute the surface temperature.
+    DO ji = 1,kjpindex
+      soilflx(ji) = zdz1(ji,1) * (cgrnd(ji,1) + (dgrnd(ji,1)-1.) * ptn(ji,1))
+      soilcap(ji) = (zdz2(ji,1) * dtradia + dtradia * (un - dgrnd(ji,1)) * zdz1(ji,1))
+      z1(ji) = lambda * (un - dgrnd(ji,1)) + un
+      soilcap(ji) = soilcap(ji) / z1(ji)
+      soilflx(ji) = soilflx(ji) + &
+         & soilcap(ji) * (ptn(ji,1) * z1(ji) - lambda * cgrnd(ji,1) - temp_sol_new(ji)) / dtradia 
+    ENDDO
+
+    IF (long_print) WRITE (numout,*) ' thermosoil_coef done '
+
+  END SUBROUTINE thermosoil_coef
+ 
+ 
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_profile
+!!
+!>\BRIEF        In this routine solves the numerical soil thermal scheme, ie calculates the new soil temperature profile; 
+!! This profile is then exported onto the diagnostic axis (call thermosoil_diaglev)
+!!
+!! DESCRIPTION	: The calculation of the new soil temperature profile is based on
+!! the cgrnd and dgrnd values from the previous timestep and the surface temperature Ts aka temp_sol_new. (see detailed
+!! explanation in the header of the thermosoil module or in the reference).\n
+!!                              T(k+1)=cgrnd(k)+dgrnd(k)*T(k)\n
+!!                                      -- EQ1 --\n
+!!                           Ts=(1-lambda)*T(1) -lambda*T(2)\n 
+!!                                      -- EQ2--\n
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): ptn (soil temperature profile on the thermal axis), 
+!!                          stempdiag (soil temperature profile on the diagnostic axis)
+!!
+!! REFERENCE(S) :
+!! - Hourdin, F. (1992). Study and numerical simulation of the general circulation of planetary atmospheres,
+!! Ph.D. thesis, Paris VII University. Remark: the part of F. Hourdin's PhD thesis relative to the thermal
+!! integration scheme has been scanned and is provided along with the documentation, with name : 
+!! Hourdin_1992_PhD_thermal_scheme.pdf
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+ SUBROUTINE thermosoil_profile (kjpindex, temp_sol_new, ptn, stempdiag)
+
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                               :: kjpindex       !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)            :: temp_sol_new   !! Surface temperature at the present time-step 
+                                                                               !! @tex ($K$) @endtex
+    
+    !! 0.2 Output variables
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)      :: stempdiag      !! diagnostic temperature profile 
+                                                                               !! @tex ($K$) @endtex
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION (kjpindex,ngrnd), INTENT (inout)   :: ptn            !! vertically discretized soil temperatures 
+                                                                               !! @tex ($K$) @endtex
+
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                           :: ji, jg
+!_ ================================================================================================================================
+    
+  !! 1. Computes the soil temperatures ptn.
+
+    !! 1.1. ptn(jg=1) using EQ1 and EQ2
+    DO ji = 1,kjpindex
+      ptn(ji,1) = (lambda * cgrnd(ji,1) + temp_sol_new(ji)) / (lambda * (un - dgrnd(ji,1)) + un)
+    ENDDO
+
+    !! 1.2. ptn(jg=2:ngrnd) using EQ1.
+    DO jg = 1,ngrnd-1
+      DO ji = 1,kjpindex
+        ptn(ji,jg+1) = cgrnd(ji,jg) + dgrnd(ji,jg) * ptn(ji,jg)
+      ENDDO
+    ENDDO
+
+  !! 2. Put the soil temperatures onto the diagnostic axis 
+  
+    !! Put the soil temperatures onto the diagnostic axis for convenient
+    !! use in other routines (stomate..)
+    CALL thermosoil_diaglev(kjpindex, stempdiag)
+
+    IF (long_print) WRITE (numout,*) ' thermosoil_profile done '
+
+  END SUBROUTINE thermosoil_profile
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_diaglev
+!!
+!>\BRIEF        Interpolation of the soil in-depth temperatures onto the diagnostic profile.
+!!
+!! DESCRIPTION  : This is a very easy linear interpolation, with intfact(jd, jg) the fraction
+!! the thermal layer jg comprised within the diagnostic layer jd. The depths of
+!! the diagnostic levels are diaglev(1:nbdl), computed in slowproc.f90.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): stempdiag (soil temperature profile on the diagnostic axis)
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_diaglev(kjpindex, stempdiag)
+    
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT(in)                          :: kjpindex       !! Domain size (unitless)
+   
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out) :: stempdiag      !! Diagnostoc soil temperature profile @tex ($K$) @endtex
+    
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                      :: ji, jd, jg
+    REAL(r_std)                                         :: lev_diag, prev_diag, lev_prog, prev_prog
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)      :: intfact
+!$OMP THREADPRIVATE(intfact)
+    LOGICAL, PARAMETER                                  :: check=.FALSE.
+!_ ================================================================================================================================
+    
+  !! 1. Computes intfact(jd, jg)
+
+    !! Computes intfact(jd, jg), the fraction
+    !! the thermal layer jg comprised within the diagnostic layer jd.
+    IF ( .NOT. ALLOCATED(intfact)) THEN
+        
+        ALLOCATE(intfact(nbdl, ngrnd))
+        
+        prev_diag = zero
+        DO jd = 1, nbdl
+          lev_diag = diaglev(jd)
+          prev_prog = zero
+          DO jg = 1, ngrnd
+             IF ( jg == ngrnd .AND. (prev_prog + dz2(jg)) < lev_diag ) THEN
+                lev_prog = lev_diag
+             ELSE
+                lev_prog = prev_prog + dz2(jg)
+             ENDIF
+            intfact(jd,jg) = MAX(MIN(lev_diag,lev_prog)-MAX(prev_diag, prev_prog), zero)/(lev_diag-prev_diag)
+            prev_prog = lev_prog
+          ENDDO
+           prev_diag = lev_diag
+        ENDDO
+        
+        IF ( check ) THEN
+           WRITE(numout,*) 'thermosoil_diagev -- thermosoil_diaglev -- thermosoil_diaglev --' 
+           DO jd = 1, nbdl
+              WRITE(numout,*) jd, '-', intfact(jd,1:ngrnd)
+           ENDDO
+           WRITE(numout,*) "SUM -- SUM -- SUM SUM -- SUM -- SUM"
+           DO jd = 1, nbdl
+              WRITE(numout,*) jd, '-', SUM(intfact(jd,1:ngrnd))
+           ENDDO
+           WRITE(numout,*) 'thermosoil_diaglev -- thermosoil_diaglev -- thermosoil_diaglev --' 
+        ENDIF
+        
+    ENDIF
+
+ !! 2. does the interpolation
+
+    stempdiag(:,:) = zero
+    DO jg = 1, ngrnd
+      DO jd = 1, nbdl
+        DO ji = 1, kjpindex
+          stempdiag(ji,jd) = stempdiag(ji,jd) + ptn(ji,jg)*intfact(jd,jg)
+        ENDDO
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE thermosoil_diaglev
+  
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_humlev
+!!
+!>\BRIEF        Interpolates the diagnostic soil humidity profile shumdiag(nbdl, diagnostic axis) onto 
+!!              the thermal axis, which gives wetdiag(ngrnd, thermal axis).
+!!
+!! DESCRIPTION  : Same as in thermosoil_diaglev : This is a very easy linear interpolation, with intfactw(jd, jg) the fraction
+!! the thermal layer jd comprised within the diagnostic layer jg. 
+!!?? I would think wise to change the indeces here, to keep jD for Diagnostic
+!!?? and jG for Ground thermal levels...
+!! 
+!! The depths of the diagnostic levels are diaglev(1:nbdl), computed in slowproc.f90.
+!! Recall that when the 11-layer hydrology is used,
+!! wetdiag and shumdiag are with reference to the moisture content (mc)
+!! at the wilting point mcw : wetdiag=(mc-mcw)/(mcs-mcw).
+!! with mcs the saturated soil moisture content.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): wetdiag (soil soil humidity profile on the thermal axis)
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+  SUBROUTINE thermosoil_humlev(kjpindex, shumdiag, snow)
+  
+  !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std), INTENT(in)                            :: kjpindex    !! Domain size (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in)    :: shumdiag    !! Relative soil humidity on the diagnostic axis. 
+                                                                         !! (0-1, unitless). Caveats : when "hydrol" (the 11-layers
+                                                                         !! hydrology) is used, this humidity is calculated with 
+                                                                         !! respect to the wilting point : 
+                                                                         !! shumdiag= (mc-mcw)/(mcs-mcw), with mc : moisture 
+                                                                         !! content; mcs : saturated soil moisture content; mcw: 
+                                                                         !! soil moisture content at the wilting point. when the 2-layers
+                                                                         !! hydrology "hydrolc" is used, shumdiag is just
+                                                                         !! a diagnostic humidity index, with no real physical 
+                                                                         !! meaning.
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)         :: snow 
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                       :: ji, jd, jg
+    REAL(r_std)                                          :: lev_diag, prev_diag, lev_prog, prev_prog
+    REAL(r_std), DIMENSION(ngrnd,nbdl)                   :: intfactw     !! fraction of each diagnostic layer (jd) comprized within
+                                                                         !! a given thermal layer (jg)(0-1, unitless) 
+    REAL(r_std), DIMENSION(kjpindex)               :: snow_h
+    LOGICAL, PARAMETER :: check=.FALSE.
+
+!_ ================================================================================================================================
+    
+  !! 1. computes intfactw(jd,jg), the fraction of each diagnostic layer (jg) comprized within a given thermal layer (jd)
+    IF ( check ) &
+         WRITE(numout,*) 'thermosoil_humlev --' 
+
+    ! Snow height
+    snow_h(:)=snow(:)/sn_dens
+    !
+    wetdiag(:,:) = zero
+    DO ji=1,kjpindex
+       prev_diag = zero
+       DO jd = 1, ngrnd
+          lev_diag = prev_diag + dz2(jd)
+          prev_prog = snow_h(ji)
+          DO jg = 1, nbdl
+             IF ( jg == nbdl .AND. diaglev(jg)+snow_h(ji) < lev_diag ) THEN
+                lev_prog = lev_diag+snow_h(ji)
+             ELSE
+                lev_prog = diaglev(jg)+snow_h(ji)
+             ENDIF
+             intfactw(jd,jg) = MAX(MIN(lev_diag,lev_prog)-MAX(prev_diag, prev_prog), zero)/(lev_diag-prev_diag)
+             prev_prog = lev_prog
+          ENDDO
+          prev_diag = lev_diag
+       ENDDO
+
+       DO jg = 1, nbdl
+          DO jd = 1, ngrnd
+             wetdiag(ji,jd) = wetdiag(ji,jd) + shumdiag(ji,jg)*intfactw(jd,jg)
+          ENDDO
+       ENDDO
+       !
+       IF ( check ) THEN
+          DO jd = 1, ngrnd
+             WRITE(numout,*) ji,jd, '-', intfactw(jd,1:nbdl),'-sum-', SUM(intfactw(jd,1:nbdl))
+          ENDDO
+       ENDIF
+    ENDDO
+    IF ( check ) &
+         WRITE(numout,*) 'thermosoil_humlev --' 
+
+  END SUBROUTINE thermosoil_humlev
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : thermosoil_energy
+!!
+!>\BRIEF         Energy check-up.
+!!
+!! DESCRIPTION  : I didn\'t comment this routine since at do not understand its use, please
+!! ask initial designers (Jan ? Nathalie ?).
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ??
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None 
+!! \n 
+!_ ================================================================================================================================
+
+  SUBROUTINE thermosoil_energy(kjpindex, temp_sol_new, soilcap, first_call)
+  
+   !! 0. Variables and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                     :: kjpindex     !! Domain size (unitless)
+    LOGICAL, INTENT (in)                           :: first_call   !! First call (true/false)
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: temp_sol_new !! Surface temperature at the present time-step, Ts 
+                                                                   !! @tex ($K$) @endtex
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)  :: soilcap      !! Apparent surface heat capacity 
+                                                                   !! @tex ($J m^{-2} K^{-1}$) @endtex, 
+                                                                   !! see eq. A29 of F. Hourdin\'s PhD thesis.
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+    
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)                                 :: ji, jg
+!_ ================================================================================================================================
+   
+    IF (first_call) THEN
+
+     DO ji = 1, kjpindex
+      surfheat_incr(ji) = zero
+      coldcont_incr(ji) = zero
+      temp_sol_beg(ji)  = temp_sol_new(ji)
+      
+      DO jg = 1, ngrnd
+       ptn_beg(ji,jg)   = ptn(ji,jg)
+      ENDDO
+      
+     ENDDO
+    
+     RETURN
+
+    ENDIF
+
+     DO ji = 1, kjpindex
+      surfheat_incr(ji) = zero
+      coldcont_incr(ji) = zero
+     ENDDO
+    
+    !  Sum up the energy content of all layers in the soil.
+    DO ji = 1, kjpindex
+   
+       IF (pcapa_en(ji,1) .LE. sn_capa) THEN
+          
+          ! Verify the energy conservation in the surface layer
+          coldcont_incr(ji) = soilcap(ji) * (temp_sol_new(ji) - temp_sol_beg(ji))
+          surfheat_incr(ji) = zero
+       ELSE
+          
+          ! Verify the energy conservation in the surface layer
+          surfheat_incr(ji) = soilcap(ji) * (temp_sol_new(ji) - temp_sol_beg(ji))
+          coldcont_incr(ji) = zero
+       ENDIF
+    ENDDO
+    
+    ptn_beg(:,:)      = ptn(:,:)
+    temp_sol_beg(:)   = temp_sol_new(:)
+
+  END SUBROUTINE thermosoil_energy
+
+END MODULE thermosoil
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/watchout.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/watchout.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_sechiba/watchout.f90	(revision 5166)
@@ -0,0 +1,2288 @@
+MODULE watchout
+
+  USE defprec
+  USE mod_orchidee_para 
+  USE constantes
+  USE netcdf
+
+  PRIVATE
+  PUBLIC :: watchout_init, watchout_write_p, watchout_close
+!watchout_write ??
+
+  LOGICAL,SAVE,PUBLIC             :: ok_watchout = .FALSE.
+!$OMP THREADPRIVATE(ok_watchout)
+  REAL, SAVE,PUBLIC               :: dt_watch = zero
+!$OMP THREADPRIVATE(dt_watch)
+  INTEGER, SAVE,PUBLIC            :: last_action_watch = 0, &
+       & last_check_watch = 0
+!$OMP THREADPRIVATE(last_action_watch, last_check_watch)
+  CHARACTER(LEN=80),SAVE, PUBLIC   :: watchout_file
+!$OMP THREADPRIVATE(watchout_file)
+  ! At module level we need the ids of the variables for the ORCHIDEE_WATCH. They will be 
+  ! shared by the watchout_init and watchout_write routines.
+  ! The flag which will control all this is watchout
+  !
+  INTEGER(i_std),SAVE      :: time_id, timestp_id
+!$OMP THREADPRIVATE(time_id, timestp_id)
+  INTEGER(i_std),SAVE      :: watchfid, zlevid, soldownid, rainfid, snowfid, lwradid, &
+       & psolid, tairid, eairid, qairid, uid, vid, &
+       & solnetid, petAcoefid, peqAcoefid, petBcoefid, peqBcoefid, cdragid, ccanopyid
+!$OMP THREADPRIVATE(watchfid, zlevid, soldownid, rainfid)
+!$OMP THREADPRIVATE(snowfid, lwradid, psolid, tairid) 
+!$OMP THREADPRIVATE( eairid, qairid, uid, vid) 
+!$OMP THREADPRIVATE(solnetid, petAcoefid, peqAcoefid, petBcoefid) 
+!$OMP THREADPRIVATE(peqBcoefid, cdragid, ccanopyid) 
+  INTEGER(i_std),SAVE      :: watchoffset
+!$OMP THREADPRIVATE(watchoffset) 
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_zlev
+!$OMP THREADPRIVATE(sum_zlev) 
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_u, sum_v
+!$OMP THREADPRIVATE(sum_u, sum_v)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_qair
+!$OMP THREADPRIVATE(sum_qair) 
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_temp_air
+!$OMP THREADPRIVATE(sum_temp_air) 
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_epot_air
+!$OMP THREADPRIVATE(sum_epot_air) 
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_ccanopy
+!$OMP THREADPRIVATE(sum_ccanopy) 
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_cdrag
+!$OMP THREADPRIVATE(sum_cdrag) 
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_petAcoef, sum_peqAcoef, sum_petBcoef, sum_peqBcoef
+!$OMP THREADPRIVATE(sum_petAcoef, sum_peqAcoef) 
+!$OMP THREADPRIVATE(sum_petBcoef, sum_peqBcoef)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_rain, sum_snow
+!$OMP THREADPRIVATE(sum_rain, sum_snow)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_lwdown
+!$OMP THREADPRIVATE(sum_lwdown)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_swnet
+!$OMP THREADPRIVATE(sum_swnet)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_swdown
+!$OMP THREADPRIVATE(sum_swdown)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_pb
+!$OMP THREADPRIVATE(sum_pb)
+  !! Short wave mean : compute with solar angle, as in readdim2
+!!$  REAL(r_std), ALLOCATABLE, DIMENSION(:,:), SAVE, PUBLIC  :: sinang, mean_sinang
+!!$  INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:), SAVE, PUBLIC :: isinang
+
+  REAL(r_std), SAVE, PUBLIC :: dt_split_watch
+!$OMP THREADPRIVATE(dt_split_watch) 
+  !! mean julian time for each time step
+  REAL(r_std), SAVE, PUBLIC :: julian_watch
+!$OMP THREADPRIVATE(julian_watch)
+CONTAINS 
+SUBROUTINE watchout_init(iim, jjm, kjpindex, igmax, date0, itau, dt, kindex, lon, lat, lev0)
+  !
+  IMPLICIT NONE
+  !
+  ! This routine will allow to set up forcing files for ORCHIDEE. The idea is that
+  ! during a coupled simulation one write's out all the forcing so that ORCHIDEE can
+  ! can be re-run (to equilibrium or for sensitivity) afterwards.
+  !
+  ! INPUT
+  INTEGER(i_std), INTENT(in)   :: iim, jjm, igmax, kjpindex
+  REAL(r_std), INTENT(in)      :: date0, dt
+  INTEGER(i_std), INTENT(in)   :: itau, kindex(igmax)
+  REAL(r_std), INTENT(in)      :: lon(iim,jjm), lat(iim,jjm), lev0
+  !
+  ! OUTPUT
+  !
+  !
+  ! LOCAL
+  !
+  INTEGER(i_std)   :: iret, nlonid1, nlatid1, nlevid1, fid, nlandid1, tdimid1
+  INTEGER(i_std)   :: dims(3)
+  INTEGER(i_std)   :: nlonid, nlatid, nlevid, nlandid, varid, contid, resolxid, resolyid
+  INTEGER(i_std), DIMENSION(8)  ::  neighid
+  REAL(r_std)      :: lon_min, lon_max, lat_min, lat_max, lev_min, lev_max
+  INTEGER(i_std)   :: yy, mm, dd, hh, mn, i, j, ig, direction
+  REAL(r_std)      :: ss
+  REAL(r_std),ALLOCATABLE :: tmpdata(:,:)
+  CHARACTER(LEN=3)  :: cal(12)
+  CHARACTER(LEN=10) :: today, att, axx
+  CHARACTER(LEN=30) :: str30
+  CHARACTER(LEN=70) :: str70, var, unit, titre, assoc
+  CHARACTER(LEN=80) :: stamp, lon_name, lat_name, land_name,time_name
+  !    
+  INTEGER,PARAMETER :: kind_r_watch=nf90_real8
+  !
+  ! Only root proc write watchout file
+  IF (is_root_prc) THEN
+
+     cal(1) = 'JAN'
+     cal(2) = 'FEB'
+     cal(3) = 'MAR'
+     cal(4) = 'APR'
+     cal(5) = 'MAY'
+     cal(6) = 'JUN'
+     cal(7) = 'JUL'
+     cal(8) = 'AUG'
+     cal(9) = 'SEP'
+     cal(10) = 'OCT'
+     cal(11) = 'NOV'
+     cal(12) = 'DEC'
+     !
+     iret = NF90_CREATE (TRIM(watchout_file), NF90_CLOBBER, fid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not create file :',TRIM(watchout_file), &
+             &          '(Problem with disk place or filename ?)')
+     ENDIF
+     !
+     !   Dimensions
+     !
+     iret = NF90_DEF_DIM(fid, 'x', iim, nlonid1)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Dimension "x" can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_DEF_DIM(fid, 'y', jjm, nlatid1)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Dimension "y" can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_DEF_DIM(fid, 'z', 1, nlevid1)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Dimension "z" can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     iret = NF90_DEF_DIM(fid, 'land', igmax, nlandid1)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Dimension "land" can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_DEF_DIM(fid, 'tstep', NF90_UNLIMITED, tdimid1)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Dimension "tstep" can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     !   Coordinate  VARIABLES
+     !
+     dims(1) = nlonid1
+     dims(2) = nlatid1
+     !
+     lon_name = 'nav_lon'
+     iret = NF90_DEF_VAR(fid, lon_name, kind_r_watch, dims(1:2), nlonid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//lon_name//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, nlonid, 'units', "degrees_east") 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//lon_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     lon_min = -180.
+     lon_max = 180.
+     !
+     iret = NF90_PUT_ATT(fid, nlonid, 'valid_min', lon_min)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//lon_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, nlonid, 'valid_max', lon_max)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//lon_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     iret = NF90_PUT_ATT(fid, nlonid, 'long_name', "Longitude")
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//lon_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     lat_name = 'nav_lat'
+     iret = NF90_DEF_VAR(fid, lat_name, kind_r_watch, dims(1:2), nlatid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//lat_name//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, nlatid, 'units', "degrees_north")
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//lat_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     lat_max = 90.
+     lat_min = -90.
+     !
+     iret = NF90_PUT_ATT(fid, nlatid, 'valid_min', lat_min)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//lat_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, nlatid, 'valid_max', lat_max)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//lat_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, nlatid, 'long_name', "Latitude")
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//lat_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     lat_name = 'level'
+     iret = NF90_DEF_VAR(fid, lat_name, kind_r_watch,(/ nlevid1 /), nlevid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//lat_name//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, nlevid, 'units', "m")
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//lat_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     lev_max = lev0
+     lev_min = lev0
+     !
+     iret = NF90_PUT_ATT(fid, nlevid, 'valid_min', lev_min)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//lat_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, nlevid, 'valid_max', lev_max)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//lat_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, nlevid, 'long_name', "Vertical levels")
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//lat_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     !
+     land_name = 'land'
+     iret = NF90_DEF_VAR(fid, land_name, NF90_INT, (/ nlandid1 /), nlandid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//land_name//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, nlandid, 'compress', "y x") 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//land_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     !   Time in real days !
+     !
+     time_name = 'time'
+     iret = NF90_DEF_VAR(fid, time_name, kind_r_watch, (/ tdimid1 /), time_id)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//time_name//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     ! Compute an itau offset so that we can relate the itau of the model
+     ! to the position in the file
+     !
+     watchoffset = itau
+     !
+    CALL ju2ymds(date0, yy, mm, dd, ss)
+    hh = INT(ss/3600.)
+    ss = ss - hh*3600.
+     mn = INT(ss/60.) 
+     ss = ss - mn*60.
+    WRITE(str70,7000) yy, mm, dd, hh, mn, INT(ss)
+!!MM : Time axis by month : 
+!!$     hh = INT(sec/3600.)
+!!$     ss = sec - hh*3600.
+!!$     mn = INT(ss/60.) 
+!!$     ss = ss - mn*60.
+!!$     WRITE(str70,7000) year, month, day, hh, mn, INT(ss)
+     !
+     iret = NF90_PUT_ATT(fid, time_id, 'units', TRIM(str70))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//time_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     CALL ioget_calendar(str30)
+     iret = NF90_PUT_ATT(fid, time_id, 'calendar', TRIM(str30))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//time_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     iret = NF90_PUT_ATT(fid, time_id, 'title', 'Time')
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//time_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     iret = NF90_PUT_ATT(fid, time_id, 'long_name', 'Time axis')
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//time_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+    WRITE(str70,7001) yy, cal(mm), dd, hh, mn, INT(ss)
+!!MM : Time axis by month : 
+!!!$     WRITE(str70,7001) year, CAL(month), day, hh, mn, INT(ss)
+     iret = NF90_PUT_ATT(fid, time_id, 'time_origin', TRIM(str70))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//time_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     !   Time steps
+     !
+     time_name = 'timestp'
+     iret = NF90_DEF_VAR(fid, time_name, NF90_INT, (/ tdimid1 /), timestp_id)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//time_name//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+    WRITE(str70,7002) yy, mm, dd, hh, mn, INT(ss)
+!!MM : Time axis by month : 
+!!!$     WRITE(str70,7002) year, month, day, hh, mn, INT(ss)
+     iret = NF90_PUT_ATT(fid, timestp_id, 'units', TRIM(str70))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//time_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     iret = NF90_PUT_ATT(fid, timestp_id, 'title', 'Time steps')
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//time_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     iret = NF90_PUT_ATT(fid, timestp_id, 'tstep_sec', dt)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//time_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     iret = NF90_PUT_ATT(fid, timestp_id, 'long_name', 'Time step axis')
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//time_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+    WRITE(str70,7001) yy, cal(mm), dd, hh, mn, INT(ss)
+!!MM : Time axis by month : 
+!!!$     WRITE(str70,7001) year, CAL(month), day, hh, mn, INT(ss)
+     iret = NF90_PUT_ATT(fid, timestp_id, 'time_origin', TRIM(str70))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//time_name//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+7000 FORMAT('seconds since ', I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)
+7001 FORMAT(' ', I4.4,'-',A3,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)
+7002 FORMAT('timesteps since ', I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)
+     !
+
+     dims(1) = nlandid1
+     dims(2) = tdimid1
+
+     assoc = 'time (nav_lat nav_lon)'
+     axx='TYX'
+     !
+     var = 'SWdown'
+     unit = 'W/m^2'
+     titre = 'Surface incident shortwave radiation'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     soldownid = varid
+     !
+     var = 'SWnet'
+     unit = 'W/m^2'
+     titre = 'Net surface short-wave flux'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     solnetid = varid
+     !
+     var = 'Rainf'
+     unit = 'Kg/m^2s'
+     titre = 'Rainfall rate'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     rainfid = varid
+     !
+     var = 'Snowf'
+     unit = 'Kg/m^2s'
+     titre = 'Snowfall rate'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     snowfid = varid
+     !
+     var = 'LWdown'
+     unit = 'W/m^2'
+     titre = 'Surface incident longwave radiation'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     lwradid = varid
+     !
+     var = 'PSurf'
+     unit = 'Pa'
+     titre = 'Surface pressure'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     psolid = varid
+     !
+     !
+     !  3D Variables to be written
+     !
+     dims(1) = nlandid1
+     dims(2) = nlevid1
+     dims(3) = tdimid1
+     !
+     assoc = 'time level (nav_lat nav_lon)'
+     axx='TZYX'
+     !
+     lat_name = 'levels'
+     iret = NF90_DEF_VAR(fid, lat_name, kind_r_watch, dims(1:3), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', "m")
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', "Vertical levels")
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     lev_min = 2.
+     lev_max = 100.
+     iret = NF90_PUT_ATT(fid, varid, 'valid_min', lev_min)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'valid_max', lev_max)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     zlevid = varid
+     !
+     !
+     var = 'Tair'
+     unit = 'K'
+     titre = 'Near surface air temperature'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:3), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     tairid = varid
+     !
+     var = 'Eair'
+     unit = 'J/m^2'
+     titre = 'Air potential energy'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:3), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     eairid = varid
+     !
+     var = 'Qair'
+     unit = 'Kg/Kg'
+     titre = 'Near surface specific humidity'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:3), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     qairid = varid
+     !
+     var = 'Wind_N'
+     unit = 'm/s'
+     titre = 'Near surface northward wind component'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:3), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     uid = varid
+     !
+     var = 'Wind_E'
+     unit = 'm/s'
+     titre = 'Near surface eastward wind component'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:3), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     vid = varid
+     !
+     var = 'petAcoef'
+     unit = '-'
+     titre = 'Coeficients A from the PBL resolution for T'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:3), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     petAcoefid = varid
+     !
+     var = 'peqAcoef'
+     unit = '-'
+     titre = 'Coeficients A from the PBL resolution for q'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:3), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     peqAcoefid = varid
+     !
+     var = 'petBcoef'
+     unit = '-'
+     titre = 'Coeficients B from the PBL resolution for T'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:3), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     petBcoefid = varid
+     !
+     var = 'peqBcoef'
+     unit = '-'
+     titre = 'Coeficients B from the PBL resolution for q'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:3), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     peqBcoefid = varid
+     !
+     var = 'cdrag'
+     unit = '-'
+     titre = 'Surface drag'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:3), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     cdragid = varid
+     !
+     !
+     var = 'ccanopy'
+     unit = '-'
+     titre = 'CO2 concentration in the canopy'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:3), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     ccanopyid = varid
+     !
+     !
+     ! Time fixed variable
+     !
+     dims(1) = nlonid1
+     dims(2) = nlatid1
+     !
+     var = 'contfrac'
+     unit = '-'
+     titre = 'Fraction of continent'
+     assoc = 'nav_lat nav_lon'
+     axx='YX'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     contid=varid
+     !
+     !
+     var = 'neighboursNN'
+     unit = '-'
+     titre = 'indices of North neighbours of each grid point'
+     assoc = 'nav_lat nav_lon'
+     axx='YX'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     neighid(1)=varid
+     !
+     var = 'neighboursNE'
+     unit = '-'
+     titre = 'indices of North-East neighbours of each grid point'
+     assoc = 'nav_lat nav_lon'
+     axx='YX'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     neighid(2)=varid
+     !
+     var = 'neighboursEE'
+     unit = '-'
+     titre = 'indices of East neighbours of each grid point'
+     assoc = 'nav_lat nav_lon'
+     axx='YX'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     neighid(3)=varid
+     !
+     var = 'neighboursSE'
+     unit = '-'
+     titre = 'indices of South-East neighbours of each grid point'
+     assoc = 'nav_lat nav_lon'
+     axx='YX'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     neighid(4)=varid
+     !
+     var = 'neighboursSS'
+     unit = '-'
+     titre = 'indices of South neighbours of each grid point'
+     assoc = 'nav_lat nav_lon'
+     axx='YX'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     neighid(5)=varid
+     !
+     var = 'neighboursSW'
+     unit = '-'
+     titre = 'indices of South-West neighbours of each grid point'
+     assoc = 'nav_lat nav_lon'
+     axx='YX'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     neighid(6)=varid
+     !
+     var = 'neighboursWW'
+     unit = '-'
+     titre = 'indices of West neighbours of each grid point'
+     assoc = 'nav_lat nav_lon'
+     axx='YX'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     neighid(7)=varid
+     !
+     var = 'neighboursNW'
+     unit = '-'
+     titre = 'indices of North-West neighbours of each grid point'
+     assoc = 'nav_lat nav_lon'
+     axx='YX'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     neighid(8)=varid
+     !
+     !
+     var = 'resolutionX'
+     unit = 'm'
+     titre = 'resolution in x at each grid point'
+     assoc = 'nav_lat nav_lon'
+     axx='YX'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     resolxid=varid
+     !
+     var = 'resolutionY'
+     unit = 'm'
+     titre = 'resolution in y at each grid point'
+     assoc = 'nav_lat nav_lon'
+     axx='YX'
+     iret = NF90_DEF_VAR(fid,var, kind_r_watch, dims(1:2), varid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &         'Variable '//var//' can not be defined for the file : ', &
+             &         TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'axis',  TRIM(axx) )
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'units', TRIM(unit)) 
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'long_name', TRIM(titre))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'associate', TRIM(assoc))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, varid, 'missing_value', undef_sechiba)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add attribut to variable '//var//' for the file :', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     resolyid=varid
+     !
+     !
+     !  Global attributes
+     !
+     CALL DATE_AND_TIME(today, att)
+     stamp = "Forcing generated by intersurf in a previous run "//today(1:LEN_TRIM(today))//" at "//att(1:LEN_TRIM(att))
+     iret = NF90_PUT_ATT(fid, NF90_GLOBAL, 'Conventions', "GDT 1.2")
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add global attribut to the file : ', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, NF90_GLOBAL, 'file_name', TRIM(watchout_file))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add global attribut to the file : ', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     iret = NF90_PUT_ATT(fid, NF90_GLOBAL, 'production', TRIM(stamp))
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not add global attribut to the file : ', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     iret = NF90_ENDDEF(fid)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not end definitions in the file : ', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     !    Write coordinates
+     !
+     iret = NF90_PUT_VAR(fid, nlonid, lon)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not put variable nav_lon  in the file : ', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     iret = NF90_PUT_VAR(fid, nlatid, lat)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not put variable nav_lat  in the file : ', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     iret = NF90_PUT_VAR(fid, nlevid, lev0)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not put variable level  in the file : ', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     iret = NF90_PUT_VAR(fid, nlandid, kindex)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not put variable land  in the file : ', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     IF ( .NOT. ALLOCATED(tmpdata)) THEN
+        ALLOCATE(tmpdata(iim,jjm))
+     ENDIF
+     !
+     tmpdata(:,:) = undef_sechiba
+     DO ig=1,igmax
+
+        j = ((kindex(ig)-1)/iim) + 1
+        i = (kindex(ig) - (j-1)*iim)
+
+        tmpdata(i,j) = contfrac_g(ig)
+
+     ENDDO
+     iret = NF90_PUT_VAR(fid, contid, tmpdata)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not put variable contfrac  in the file : ', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !    
+     DO direction=1,8
+        tmpdata(:,:) = undef_sechiba
+        DO ig=1,igmax
+
+           j = ((kindex(ig)-1)/iim) + 1
+           i = (kindex(ig) - (j-1)*iim)
+
+           tmpdata(i,j) = REAL( neighbours_g(ig,direction) )
+
+        ENDDO
+        iret = NF90_PUT_VAR(fid, neighid(direction), tmpdata)
+        IF (iret /= NF90_NOERR) THEN
+           CALL ipslerr_p (3,'watchout_init', &
+                &             'Could not put variable neighbours  in the file : ', &
+                &             TRIM(watchout_file),'(Solution ?)')
+        ENDIF
+     ENDDO
+     !
+     tmpdata(:,:) = undef_sechiba
+     DO ig=1,igmax
+
+        j = ((kindex(ig)-1)/iim) + 1
+        i = (kindex(ig) - (j-1)*iim)
+
+        tmpdata(i,j) = resolution_g(ig,1)
+
+     ENDDO
+     iret = NF90_PUT_VAR(fid, resolxid, tmpdata)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not put variable resolutionx  in the file : ', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     tmpdata(:,:) = undef_sechiba
+     DO ig=1,igmax
+
+        j = ((kindex(ig)-1)/iim) + 1
+        i = (kindex(ig) - (j-1)*iim)
+
+        tmpdata(i,j) = resolution_g(ig,2)
+
+     ENDDO
+     iret = NF90_PUT_VAR(fid, resolyid, tmpdata)
+     IF (iret /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'watchout_init', &
+             &          'Could not put variable resolutiony  in the file : ', &
+             &          TRIM(watchout_file),'(Solution ?)')
+     ENDIF
+     !
+     DEALLOCATE(tmpdata)
+     !
+     watchfid = fid
+     !
+  ENDIF
+  !
+  ALLOCATE(sum_zlev(kjpindex))
+  ALLOCATE(sum_u(kjpindex), sum_v(kjpindex))
+  ALLOCATE(sum_qair(kjpindex))
+  ALLOCATE(sum_temp_air(kjpindex))
+  ALLOCATE(sum_epot_air(kjpindex))
+  ALLOCATE(sum_ccanopy(kjpindex))
+  ALLOCATE(sum_cdrag(kjpindex))
+  ALLOCATE(sum_petAcoef(kjpindex), sum_peqAcoef(kjpindex), sum_petBcoef(kjpindex), sum_peqBcoef(kjpindex))
+  ALLOCATE(sum_rain(kjpindex), sum_snow(kjpindex))
+  ALLOCATE(sum_lwdown(kjpindex))
+  ALLOCATE(sum_swnet(kjpindex))
+  ALLOCATE(sum_swdown(kjpindex))
+  ALLOCATE(sum_pb(kjpindex))
+!!$  ALLOCATE(mean_sinang(iim,jjm))
+!!$  ALLOCATE(sinang(iim,jjm))
+!!$  ALLOCATE(isinang(iim,jjm))
+
+  sum_zlev(:) = zero
+  sum_u(:) = zero
+  sum_v(:) = zero
+  sum_qair(:) = zero
+  sum_temp_air(:) = zero
+  sum_epot_air(:) = zero
+  sum_ccanopy(:) = zero
+  sum_cdrag(:) = zero
+  sum_petAcoef(:) = zero
+  sum_peqAcoef(:) = zero
+  sum_petBcoef(:) = zero
+  sum_peqBcoef(:) = zero
+  sum_rain(:) = zero
+  sum_snow(:) = zero
+  sum_lwdown(:) = zero
+  sum_swnet(:) = zero
+  sum_swdown(:) = zero
+  sum_pb(:) = zero
+
+!!$  mean_sinang(:,:) = zero
+!!$  sinang(:,:) = zero
+!!$  isinang(:,:) = dt_split_watch
+
+END SUBROUTINE watchout_init
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE watchout_write_p(igmax, itau, dt, levels, &
+       &                        soldown, rain, snow, lwdown, psurf, temp, eair, qair, u, v, &
+       &                        solnet, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy )
+    !
+    ! 
+    IMPLICIT NONE
+    !
+    ! INPUT
+    !
+    INTEGER(i_std), INTENT(in) :: igmax, itau
+    REAL(r_std), INTENT(inout) :: levels(igmax)
+    REAL(r_std), DIMENSION(igmax), INTENT(inout) :: soldown, rain, snow, lwdown, psurf, &
+         &                                      solnet, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+         &                                      cdrag, ccanopy
+    REAL(r_std), INTENT(inout) :: temp(igmax), eair(igmax), qair(igmax), u(igmax), v(igmax)
+    REAL(r_std), INTENT(in) :: dt
+    !
+    ! LOCAL
+    !
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: levels_g
+!$OMP THREADPRIVATE(levels_g)
+    REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: soldown_g, rain_g, snow_g, lwdown_g, psurf_g, &
+         &                             solnet_g, petAcoef_g, peqAcoef_g, petBcoef_g, peqBcoef_g, cdrag_g, &
+         &                             temp_g, eair_g, qair_g, u_g, v_g, ccanopy_g
+!$OMP THREADPRIVATE(soldown_g, rain_g, snow_g, lwdown_g)
+!$OMP THREADPRIVATE(psurf_g,solnet_g, petAcoef_g, peqAcoef_g)
+!$OMP THREADPRIVATE( petBcoef_g, peqBcoef_g, cdrag_g,temp_g)
+!$OMP THREADPRIVATE(eair_g, qair_g, u_g, v_g, ccanopy_g)
+    !
+    LOGICAL, SAVE                          :: is_first_time=.TRUE.
+!$OMP THREADPRIVATE(is_first_time)
+    INTEGER(i_std)                         :: ier
+
+    IF (is_first_time .AND. is_root_prc) THEN
+       ALLOCATE(levels_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in levels_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(soldown_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in soldown_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(rain_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in rain_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(snow_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in snow_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(lwdown_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in lwdown_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(psurf_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in psurf_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(solnet_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in solnet_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(petAcoef_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in petAcoef_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(peqAcoef_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in peqAcoef_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(petBcoef_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in petBcoef_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(peqBcoef_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in peqBcoef_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(cdrag_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in cdrag_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(temp_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in temp_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(eair_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in eair_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(qair_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in qair_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(u_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in u_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(v_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in v_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+
+       ALLOCATE(ccanopy_g(nbp_glo),stat=ier)
+       IF (ier .NE. 0) THEN
+          WRITE (numout,*) ' error in ccanopy_g allocation. We stop. We need iim words = ',nbp_glo
+          STOP 'watchout_write_p'
+       ENDIF
+    ENDIF
+    is_first_time=.FALSE.
+
+    CALL gather(levels,levels_g)
+    CALL gather(soldown,soldown_g)
+    CALL gather(rain,rain_g)
+    CALL gather(snow,snow_g)
+    CALL gather(lwdown,lwdown_g)
+    CALL gather(psurf,psurf_g)
+    CALL gather(solnet,solnet_g)
+    CALL gather(petAcoef,petAcoef_g)
+    CALL gather(peqAcoef,peqAcoef_g)
+    CALL gather(petBcoef,petBcoef_g)
+    CALL gather(peqBcoef,peqBcoef_g)
+    CALL gather(cdrag,cdrag_g)
+    CALL gather(temp,temp_g)
+    CALL gather(eair,eair_g)
+    CALL gather(qair,qair_g)
+    CALL gather(u,u_g)
+    CALL gather(v,v_g)
+    CALL gather(ccanopy,ccanopy_g)
+
+    IF (is_root_prc) THEN
+      CALL watchout_write(nbp_glo, itau, dt, levels_g, &
+       &                      soldown_g, rain_g, snow_g, lwdown_g, psurf_g, temp_g, eair_g, qair_g, u_g, v_g, &
+       &                      solnet_g, petAcoef_g, peqAcoef_g, petBcoef_g, peqBcoef_g, cdrag_g, ccanopy_g )
+    ENDIF
+
+    levels(:) = zero
+    soldown(:) = zero
+    rain(:) = zero
+    snow(:) = zero
+    lwdown(:) = zero
+    psurf(:) = zero
+    solnet(:) = zero
+    petAcoef(:) = zero
+    peqAcoef(:) = zero
+    petBcoef(:) = zero
+    peqBcoef(:) = zero
+    cdrag(:) = zero
+    temp(:) = zero
+    eair(:) = zero
+    qair(:) = zero
+    u(:) = zero
+    v(:) = zero
+    ccanopy(:) = zero
+
+!!$    mean_sinang(:,:) = zero
+!!$    isinang(:,:) = dt_split_watch
+
+  END SUBROUTINE watchout_write_p
+
+  SUBROUTINE watchout_write(igmax, itau, dt, levels, &
+       &                        soldown, rain, snow, lwdown, psurf, temp, eair, qair, u, v, &
+       &                        solnet, petAcoef, peqAcoef, petBcoef, peqBcoef, cdrag, ccanopy )
+    !
+    ! 
+    IMPLICIT NONE
+    !
+    ! This subroutine will write to the file the current fields which force the
+    ! land-surface scheme. It will be in exactly the same format as the other forcing
+    ! files, i.e. ALMA convention !
+    !
+    !
+    ! INPUT
+    !
+    INTEGER(i_std) :: igmax, itau
+    REAL(r_std) :: levels(igmax)
+    REAL(r_std), DIMENSION(igmax), INTENT(in) :: soldown, rain, snow, lwdown, psurf, &
+         &                                      solnet, petAcoef, peqAcoef, petBcoef, peqBcoef, &
+         &                                      cdrag, ccanopy
+    REAL(r_std) :: temp(igmax), eair(igmax), qair(igmax), u(igmax), v(igmax)
+    REAL(r_std) :: dt
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: iret
+    INTEGER(i_std) :: corner(3), edges(3)
+    REAL(r_std) :: timestp
+    LOGICAL    :: check=.FALSE.
+    REAL(r_std),ALLOCATABLE :: tmpdata(:)
+    INTEGER(i_std) :: corner_tstp
+    !
+    ! For dt_watch non equal to dt :
+    !
+    corner_tstp = NINT((itau - watchoffset)/dt_split_watch)
+    !
+    corner(1) = corner_tstp
+    edges(1) = 1
+    IF ( check ) &
+         WRITE(numout,*) 'watchout_write corners, edges : ', corner(1), edges(1)
+    !
+    timestp = itau/dt_split_watch
+!!MM : Time axis by month : 
+!!!$    timestp = (itau - watchoffset)/dt_split_watch
+    IF ( check ) &
+         WRITE(numout,*) "watchout_write : timestp = ",timestp
+    iret = NF90_PUT_VAR(watchfid, timestp_id, (/ timestp /), &
+         &              start=(/ corner(1) /), count=(/ edges(1) /))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable timestp  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+    !
+    timestp=timestp*dt_watch
+    IF ( check ) &
+         WRITE(numout,*) "watchout_write : time = ",timestp
+    iret = NF90_PUT_VAR(watchfid, time_id, (/ timestp /), &
+         &              start=(/ corner(1) /), count=(/ edges(1) /))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable time  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+    !
+    corner(1) = 1
+    edges(1) = igmax
+    corner(2) = corner_tstp
+    edges(2) = 1
+    !
+    IF ( .NOT. ALLOCATED(tmpdata)) THEN
+       ALLOCATE(tmpdata(igmax))
+    ENDIF
+    !
+    ! 2D
+    IF ( check ) THEN
+       WRITE(numout,*) '--',itau, ' SOLDOWN : ', MINVAL(soldown), MAXVAL(soldown)
+    ENDIF
+    iret = NF90_PUT_VAR(watchfid, soldownid, soldown, start=corner(1:2), count=edges(1:2))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable SWdown  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+    !
+    iret = NF90_PUT_VAR(watchfid, solnetid, solnet, start=corner(1:2), count=edges(1:2))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable SWnet  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+    !
+    ! Bring back to kg/m^2/s
+    !
+    tmpdata = rain/dt
+    IF ( check ) THEN
+       WRITE(numout,*) '--',itau, ' RAIN : ', MINVAL(tmpdata), MAXVAL(tmpdata)
+    ENDIF
+    iret = NF90_PUT_VAR(watchfid, rainfid, tmpdata, start=corner(1:2), count=edges(1:2))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable Rainf  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+    tmpdata = snow/dt
+    iret = NF90_PUT_VAR(watchfid, snowfid, tmpdata, start=corner(1:2), count=edges(1:2))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable Snowf  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+    !
+    iret = NF90_PUT_VAR(watchfid, lwradid, lwdown, start=corner(1:2), count=edges(1:2)) 
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable LWdown  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+    !
+    !  Bring back to Pa
+    !
+    tmpdata = psurf*100.
+    iret = NF90_PUT_VAR(watchfid, psolid, tmpdata, start=corner(1:2), count=edges(1:2))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable PSurf  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+    !
+    ! 3D
+    corner(2) = 1
+    edges(2) = 1
+    corner(3) = corner_tstp
+    edges(3) = 1
+    !
+    iret = NF90_PUT_VAR(watchfid, zlevid, levels, start=corner(1:3), count=edges(1:3))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable levels  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+    !
+    iret = NF90_PUT_VAR(watchfid, tairid, temp, start=corner(1:3), count=edges(1:3))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable Tair  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+
+    iret = NF90_PUT_VAR(watchfid, eairid, eair, start=corner(1:3), count=edges(1:3))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable Eair  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+
+    iret = NF90_PUT_VAR(watchfid, qairid, qair, start=corner(1:3), count=edges(1:3))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable Qair  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+
+    iret = NF90_PUT_VAR(watchfid, uid, u, start=corner(1:3), count=edges(1:3))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable Wind_N  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+
+    iret = NF90_PUT_VAR(watchfid, vid, v, start=corner(1:3), count=edges(1:3))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable Wind_E  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+    !
+    iret = NF90_PUT_VAR(watchfid, petAcoefid, petAcoef, start=corner(1:3), count=edges(1:3))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable petAcoef  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+
+    iret = NF90_PUT_VAR(watchfid, peqAcoefid, peqAcoef, start=corner(1:3), count=edges(1:3))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable peqAcoef  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+
+    iret = NF90_PUT_VAR(watchfid, petBcoefid, petBcoef, start=corner(1:3), count=edges(1:3))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable petBcoef  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+
+    iret = NF90_PUT_VAR(watchfid, peqBcoefid, peqBcoef, start=corner(1:3), count=edges(1:3))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable peqBcoef  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+
+    iret = NF90_PUT_VAR(watchfid, cdragid, cdrag, start=corner(1:3), count=edges(1:3))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable cdrag  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+
+    iret = NF90_PUT_VAR(watchfid, ccanopyid, ccanopy, start=corner(1:3), count=edges(1:3))
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_write', &
+ &          'Could not put variable ccanopy  in the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+
+    DEALLOCATE(tmpdata)
+    !
+  END SUBROUTINE watchout_write
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE watchout_close()
+    !
+    !  Close the watch files
+    !
+    IMPLICIT NONE
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: iret
+    LOGICAL       :: check = .FALSE.
+    !
+    !
+    IF ( check )  THEN
+       WRITE(numout,*) 'watchout_close : closing file : ', watchfid
+    ENDIF
+    iret = NF90_CLOSE(watchfid)
+    IF (iret /= NF90_NOERR) THEN
+       CALL ipslerr_p (3,'watchout_close','Could not close the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+    !
+  END SUBROUTINE watchout_close
+
+END MODULE watchout
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/AA_make
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/AA_make	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/AA_make	(revision 5166)
@@ -0,0 +1,220 @@
+#-
+#- $Id$
+#-
+PARALLEL_LIB = $(LIBDIR)/libparallel.a
+SXPARALLEL_LIB = $(PARALLEL_LIB)
+#-Q- sxnec  SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx6nec SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- eshpux SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-Q- sx8brodie SXPARALLEL_LIB = $(LIBDIR)/libsxparallel.a
+#-
+PARAM_LIB = $(LIBDIR)/libparameters.a
+SXPARAM_LIB = $(PARAM_LIB)
+#-Q- sxnec  SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx6nec SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- eshpux SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-Q- sx8brodie SXPARAM_LIB = $(LIBDIR)/libsxparameters.a
+#-
+ORGLOB_LIB = $(LIBDIR)/liborglob.a
+SXORGLOB_LIB = $(ORGLOB_LIB)
+#-Q- sxnec  SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx6nec SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- eshpux SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-Q- sx8brodie SXORGLOB_LIB = $(LIBDIR)/libsxorglob.a
+#-
+MODS1 = stomate_data.f90      \
+        lpj_constraints.f90        \
+        lpj_cover.f90              \
+        lpj_crown.f90              \
+        lpj_establish.f90          \
+        lpj_fire.f90               \
+        lpj_gap.f90                \
+        lpj_kill.f90               \
+        lpj_light.f90              \
+        lpj_pftinout.f90           \
+        stomate_alloc.f90          \
+        stomate_data.f90           \
+        stomate_io.f90             \
+        stomate_litter.f90         \
+        stomate_npp.f90            \
+        stomate_phenology.f90      \
+        stomate_prescribe.f90      \
+        stomate_season.f90         \
+        stomate_soilcarbon.f90     \
+        stomate_turnover.f90       \
+        stomate_vmax.f90           \
+        stomate_assimtemp.f90      \
+        stomate_lcchange.f90       \
+        stomate_lpj.f90            \
+        stomate_resp.f90           \
+        stomate.f90
+
+OBJSMODS1 = $(MODS1:.f90=.o)
+#-
+.PRECIOUS : $(MODEL_LIB)
+#-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB)
+#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB)
+#-Q- sx8brodie .PRECIOUS : $(SXMODEL_LIB)
+#-
+all:
+	$(M_K) libparallel
+	$(M_K) libparameters
+	$(M_K) liborglob
+	$(M_K) m_all
+	@echo stomate is OK
+
+m_all: $(MODEL_LIB)($(OBJSMODS1))
+#-Q- intel m_all: WORK_MOD $(MODEL_LIB)($(OBJSMODS1))
+
+memory:
+#-Q- sxnec 	@echo maximum memory must be defined on Rhodes 
+#-Q- sxnec 	@echo in sh or ksh : ulimit -v unlimited 
+#-Q- sxnec 	@echo in csh or tcsh : limit vmemoryuse unlimited 
+#-Q- sxnec 	-/sbin/ulimit -v unlimited
+#-Q- sxnec 	-limit vmemoryuse unlimited
+
+libparallel:
+	(cd ../src_parallel; $(M_K) -f Makefile)
+
+libparameters:
+	(cd ../src_parameters; $(M_K) -f Makefile)
+
+liborglob:
+	(cd ../src_global; $(M_K) -f Makefile)
+
+$(MODEL_LIB)(%.o): %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+	$(A_C) $(ORCHIDEE_LIB) $*.o
+#-Q- sxnec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sxnec 	mv $*.mod $(MODDIR)
+#-Q- sx6nec 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx6nec 	mv $*.mod $(MODDIR)
+#-Q- eshpux 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- eshpux 	mv $*.mod $(MODDIR)
+#-Q- sx8mercure 	mv $*.mod $(MODDIR)
+#-Q- sx9mercure 	mv $*.mod $(MODDIR)
+#-Q- sx8brodie 	$(A_X) $(SXMODEL_LIB) $*.o
+#-Q- sx8brodie 	mv $*.mod $(MODDIR)
+#-Q- solaris 	mv $*.mod $(MODDIR)
+	$(RM) $*.o
+#-Q- intel
+#-Q- intel WORK_MOD:
+#-Q- intel 	$(RM) work.pcl
+#-Q- intel 	@echo "work.pc" > work.pcl
+#-Q- intel 	@echo "../src_parameters/work.pc" >> work.pcl
+#-Q- intel 	@echo "../../IOIPSL/src/work.pc" >> work.pcl
+
+config: 
+	$(BINDIR)/Fparser -name STOMATE $(MODS1)
+	echo 'Configuration of STOMATE done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(stomate.o):          \
+  $(PARAM_LIB)(pft_parameters.o)  \
+  $(MODEL_LIB)(stomate_io.o)      \
+  $(MODEL_LIB)(stomate_lpj.o)
+
+$(MODEL_LIB)(stomate_data.o): \
+  $(PARAM_LIB)(pft_parameters.o)	\
+  $(PARAM_LIB)(constantes.o)  
+
+$(MODEL_LIB)(lpj_constraints.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_cover.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_crown.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_establish.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_fire.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_gap.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_kill.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_light.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(lpj_pftinout.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_alloc.o): \
+  $(PARAM_LIB)(pft_parameters.o)	\
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_io.o): \
+  $(MODEL_LIB)(stomate_data.o) \
+  $(PARALLEL_LIB)(mod_orchidee_para.o)
+
+
+$(MODEL_LIB)(stomate_litter.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_npp.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_phenology.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_prescribe.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_resp.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_season.o): \
+  $(PARAM_LIB)(pft_parameters.o)	\
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_soilcarbon.o): \
+  $(MODEL_LIB)(stomate_data.o) \
+  $(ORGLOB_LIB)(grid.o)\
+  $(ORGLOB_LIB)(solar.o)
+
+$(MODEL_LIB)(stomate_turnover.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_vmax.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_assimtemp.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_lcchange.o): \
+  $(MODEL_LIB)(stomate_data.o)
+
+$(MODEL_LIB)(stomate_lpj.o):            \
+  $(MODEL_LIB)(lpj_constraints.o)       \
+  $(MODEL_LIB)(lpj_cover.o)             \
+  $(MODEL_LIB)(lpj_crown.o)             \
+  $(MODEL_LIB)(lpj_establish.o)         \
+  $(MODEL_LIB)(lpj_fire.o)              \
+  $(MODEL_LIB)(lpj_gap.o)               \
+  $(MODEL_LIB)(lpj_kill.o)              \
+  $(MODEL_LIB)(lpj_light.o)             \
+  $(MODEL_LIB)(lpj_pftinout.o)          \
+  $(MODEL_LIB)(stomate_alloc.o)         \
+  $(MODEL_LIB)(stomate_data.o)          \
+  $(MODEL_LIB)(stomate_litter.o)        \
+  $(MODEL_LIB)(stomate_npp.o)           \
+  $(MODEL_LIB)(stomate_phenology.o)     \
+  $(MODEL_LIB)(stomate_prescribe.o)     \
+  $(MODEL_LIB)(stomate_season.o)        \
+  $(MODEL_LIB)(stomate_soilcarbon.o)    \
+  $(MODEL_LIB)(stomate_turnover.o)      \
+  $(MODEL_LIB)(stomate_vmax.o)          \
+  $(MODEL_LIB)(stomate_assimtemp.o)     \
+  $(MODEL_LIB)(stomate_resp.o)          \
+  $(MODEL_LIB)(stomate_lcchange.o)
+
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/AA_make.ldef
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/AA_make.ldef	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/AA_make.ldef	(revision 5166)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a STOMATE
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+ORCHIDEE_LIB = $(LIBDIR)/liborchidee.a
+MODEL_LIB = $(LIBDIR)/libstomate.a
+SXMODEL_LIB = $(MODEL_LIB)
+#-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxstomate.a
+#-Q- sx8brodie SXMODEL_LIB = $(LIBDIR)/libsxstomate.a
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_constraints.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_constraints.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_constraints.f90	(revision 5166)
@@ -0,0 +1,248 @@
+! =================================================================================================================================
+! MODULE       : lpj_constraints
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!              This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Groups the subroutines that: (1) initialize all variables in 
+!! lpj_constraints and (2) check the temperature threshold to decide for each PFT 
+!! if it can adapt to and regenerate under prevailing climate conditions**1
+!! 
+!!\n RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) :
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!   plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!   global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!   dynamics in the modelling of terrestrial ecosystems: comparing two
+!!   contrasting approaches within European climate space,
+!!   Global Ecology and Biogeography, 10, 621-637.\n
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_constraints
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC constraints,constraints_clear
+
+  LOGICAL, SAVE                           :: firstcall = .TRUE.      !! first call
+!$OMP THREADPRIVATE(firstcall)
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : constraints_clear
+!!
+!>\BRIEF        Set the flag ::firstcall to .TRUE. and as such activate section 
+!!              1.1 of the subroutine constraints (see subroutine constraints).
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE constraints_clear
+    firstcall = .TRUE. 
+  END SUBROUTINE constraints_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : constraints
+!!
+!>\BRIEF        Determine whether each PFT can adapt to and regenerate under the prevailing climate
+!! conditions. Climate conditions are characterised by different threshold values for air temperature.
+!!
+!! DESCRIPTION : PFTs are adapted to the climate conditions if the daily air temperature does not drop below 
+!! the treshold values ::tcm_crit. Some PFT's do not have a ::tcm_crit treshold. Seasonal trees die if leafage 
+!! does not show a clear seasonality. (i.e. if the start of the growing season is never detected)
+!! 
+!! If the monthly temperature is below ::tcm_crit i.e. the critical temperature of the coldest month, the 
+!! PFT will be able to regenerate. If minimum temperatures do not drop below ::tcm_crit, its regenerative 
+!! capacity decreases with time. Hence, plants that need vernalization die after a few years if they don't
+!! vernalize (even if they would not loose their leaves).
+!!
+!! The treshold values ::t_min_crit, the critical temperature of the coldest month is defined in 
+!! stomate_constants.f90'. However, ::regenerate_min, the critical temperature to support regeneration is 
+!! calculated in this routine from parameters of which none depenent on the PFT. The value for 
+!! ::large_value is defined as 1.E33 in stomata_constraints
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::adapted (0-1, unitless) and ::regenerate (0-1, unitless)
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : 
+!! \latexonly 
+!!     \includegraphics[scale=0.3]{lpj_constraints_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+  
+    SUBROUTINE constraints (npts, dt, &
+       t2m_month, t2m_min_daily, when_growthinit, &
+       adapted, regenerate)
+    
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variable
+
+    INTEGER(i_std), INTENT(in)                      :: npts            !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                         :: dt              !! Time step   (days)
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: t2m_month       !! "Monthly" 2-meter temperature by defualt 
+                                                                       !! monthly spans 20 days a (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: t2m_min_daily   !! Daily minimum 2-meter temperature (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)    :: when_growthinit !! Days since beginning of growing season (days)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: adapted         !! Winter too cold? (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: regenerate      !! Winter sufficiently cold? (0 to 1, unitless)
+
+    !! 0.4 Local variables
+
+    REAL(r_std)                                     :: tau_adapt       !! Memory length for adaption (days)
+    REAL(r_std)                                     :: tau_regenerate  !! Memory length for regeneration (days)
+    REAL(r_std)                                     :: regenerate_min  !! Critical value of "regenerate" below which plant 
+                                                                       !! dies (unitless)
+    INTEGER(i_std)                                  :: j               !! Index
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering constraints' ! diagnostic level in implimentation
+
+  !! 1. Initializations
+
+    tau_adapt = one_year
+    tau_regenerate = one_year
+
+    !! 1.1 Print parameter settings
+    IF ( firstcall ) THEN
+
+       WRITE(numout,*) 'constraints:'
+       
+       WRITE(numout,*) '   > Memory length for adaption (d): ',tau_adapt
+       WRITE(numout,*) '   > Memory length for regeneration (d): ',tau_regenerate
+       WRITE(numout,*) '   > Longest sustainable time without vernalization (y):', too_long
+       WRITE(numout,*) '   > For trees, longest sustainable time without growth init (y):', too_long
+       
+       firstcall = .FALSE.
+       
+    ENDIF
+
+    !! 1.2 Calculate critical value for "regenerate"
+    !      Critical value for "regenerate", below this value, the last vernalization
+    !      happened too far in the past, The PFT is can not regenerate under the 
+    !      prevailing climate conditions.
+    regenerate_min = exp ( - too_long * one_year / tau_regenerate )
+
+  !! 2. Calculate ::adapted and ::regenerate
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! 2.1 PFT mask for natural or agriculture vegetations
+       IF ( natural(j) .OR. agriculture ) THEN
+
+          !! 2.1.1 Climate criteria
+ 
+          !! 2.1.1.1 There is no critical temperature for the PFT 
+          !          Frost restistant PFT do not have a critical temperature for growth
+          IF ( tmin_crit(j) .EQ. undef ) THEN
+             
+             adapted(:,j) = un 
+
+          !! 2.1.1.2 Frost occured in frost sensitive PFTs
+          !          For example, tropical plants will die if frost, below the treshold, occured
+          ELSE
+
+             WHERE ( t2m_min_daily(:) .LT. tmin_crit(j) )
+                adapted(:,j) = zero
+             ENDWHERE
+
+             ! The PFT does not disappear after a single cold shock. The PFT has a memory
+             ! and if the cold shock do not happen too often, it will get forgotten.
+             ! No reference found for this approach
+             adapted(:,j) = un - ( un - adapted(:,j) ) * (tau_adapt- dt)/tau_adapt 
+             
+          ENDIF
+
+          !! 2.1.2 Seasonal trees die if leafage does not show a clear seasonality.
+          !        Seasonal trees die if leafage does not show a clear seasonality
+          !        (i.e. if the start of the growing season is never detected).
+          IF ( is_tree(j) .AND. ( pheno_model(j) .NE. 'none' ) ) THEN
+
+             WHERE ( when_growthinit(:,j) .GT. too_long*one_year .AND. when_growthinit(:,j).LT. large_value)
+                adapted(:,j) = zero
+             ENDWHERE
+
+          ENDIF
+
+          !! 2.1.3 Test if PFT is regenerative
+
+          !! 2.1.3.1 Check PFT vernalization. 
+          !          If sufficiently cold, PFT will be able to regenerate for some time.
+          !          Several PFTs (ex: evergreen) don't need vernalization 
+          IF ( tcm_crit(j) .EQ. undef ) THEN
+
+             regenerate(:,j) = un
+
+          !! 2.1.3.2 PFT needs vernalization
+          ELSE
+
+             WHERE ( t2m_month(:) .LE. tcm_crit(j) )
+                regenerate(:,j) = un
+             ENDWHERE
+
+             ! Limited memory: after some time, the winter is forgotten and the PFT can no longer
+             ! produce seeds, hence, with time ::regenerate approaches 0
+             regenerate(:,j) = regenerate(:,j) * (tau_regenerate-dt)/tau_regenerate
+
+          ENDIF
+
+          !! 2.1.4 Plants that need vernalization die
+          !        Plants that need vernalization die after a few years if they don't
+          !        vernalize (even if they would not loose their leaves).
+          WHERE ( regenerate(:,j) .LE. regenerate_min )
+             adapted(:,j) = zero
+          ENDWHERE
+
+       !! 2.1 PFT except natual and agriculture vegetation
+       !      Should be developed if needed 
+       ELSE
+
+          adapted(:,j) = zero
+
+          regenerate(:,j) = zero
+
+       ENDIF ! PFT of natural or agriculture
+
+    ENDDO ! Loop over # PFTs
+
+  !! 3. Write history files
+
+    CALL histwrite_p (hist_id_stomate, 'ADAPTATION', itime, &
+         adapted, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'REGENERATION', itime, &
+         regenerate, npts*nvm, horipft_index)
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving constraints'
+
+  END SUBROUTINE constraints
+
+END MODULE lpj_constraints
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_cover.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_cover.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_cover.f90	(revision 5166)
@@ -0,0 +1,251 @@
+! =================================================================================================================================
+! MODULE       : lpj_cover
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Recalculate vegetation cover and LAI
+!!
+!!\n DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) : 
+!!        Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!        plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!        global vegetation model, Global Change Biology, 9, 161-185.\n
+!!        Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!        dynamics in the modelling of terrestrial ecosystems: comparing two
+!!        contrasting approaches within European climate space,
+!!        Global Ecology and Biogeography, 10, 621-637.\n
+!!
+!! SVN :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_cover
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes_soil
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC cover
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE     : lpj_cover
+!!
+!>\BRIEF          Recalculate vegetation cover and LAI
+!!
+!!\n DESCRIPTION : Veget_max is first renewed here according to newly calculated foliage biomass in this calculation step 
+!! Then, litter, soil carbon, and biomass are also recalcuted with taking into account the changes in Veget_max (i.e. delta_veg)
+!! Grid-scale fpc (foliage projected coverage) is calculated to obtain the shadede ground area by leaf's light capture
+!! Finally, grid-scale fpc is adjusted not to exceed 1.0
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::lai (leaf area index, @tex $(m^2 m^{-2})$ @endtex), 
+!! :: veget (fractional vegetation cover, unitless)
+!!
+!! REFERENCE(S)   : None
+!! 
+!! FLOWCHART :
+!! \latexonly 
+!!     \includegraphics[scale=0.5]{lpj_cover_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE cover (npts, cn_ind, ind, biomass, &
+       veget_max, veget_max_old, lai, litter_above, litter_below, carbon, DOC,turnover_daily, bm_to_litter,moist_soil)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                  :: npts             !! Domain size (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                :: cn_ind           !! Crown area 
+                                                                                    !! @tex $(m^2)$ @endtex per individual
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                :: ind              !! Number of individuals 
+                                                                                    !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                :: veget_max_old    !! "Maximal" coverage fraction of a PFT (LAI-> 
+                                                                                    !! infinity) on ground at beginning of time 
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)               :: moist_soil       !! moisture in soil for one pixel (m3/m3)
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)             :: lai                 !! Leaf area index OF AN INDIVIDUAL PLANT 
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements), INTENT(inout) :: litter_above    !! Metabolic and structural litter, above
+                                                                                       !! ground @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements), INTENT(inout) :: litter_below !! Metabolic and structural litter, below ground 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl), INTENT(inout)          :: carbon        !! Carbon pool: active, slow, or passive 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements), INTENT(inout) :: DOC   !! Dissolved Organic Carbon in soil
+                                                                                       !! The unit is given by m^3 of water
+                                                                                       !! @tex $(gC m{-3} of water) $ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! Biomass @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                  :: veget_max      !! "Maximal" coverage fraction of a PFT (LAI->
+                                                                                       !! infinity) on ground (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: turnover_daily !! Turnover rates (gC m^{-2} day^{-1})
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter   !! Conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} day^{-1})$ @endtex
+   
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                              :: i,j,k,m          !! Index (unitless)
+    REAL(r_std), DIMENSION(npts,nlitt,nelements)                :: dilu_lit_above   !! Above ground litter dilution @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nbdl,nelements)           :: dilu_lit_below   !! Below ground litter dilution @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,ncarb,nbdl)                     :: dilu_soil_carbon !! Soil Carbondilution 
+                                                                                    !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(nvm)                                 :: delta_veg        !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(nvm)                                 :: reduct           !! Conversion factors (unitless)
+    REAL(r_std)                                                 :: delta_veg_sum    !! Conversion factors (unitless)
+    REAL(r_std)                                                 :: diff             !! Conversion factors (unitless)
+    REAL(r_std)                                                 :: sr               !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: frac_nat         !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: sum_vegettree    !! Conversion factors (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: sum_vegetgrass   !! Conversion factors (unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: sum_veget_natveg !! Conversion factors (unitless)
+    REAL(r_std), SAVE, DIMENSION(0:nbdl)                        :: z_soil           !! Variable to store depth of the different
+                                                                                    !! soil layers (m)
+!_ ================================================================================================================================
+
+ !! 1. If the vegetation is dynamic, calculate new maximum vegetation cover for natural plants
+  
+    IF ( control%ok_dgvm ) THEN
+
+       !! 1.1  Calculate initial values of vegetation cover
+       frac_nat(:) = un
+       sum_veget_natveg(:) = zero
+       veget_max(:,ibare_sechiba) = un
+
+       DO j = 2,nvm ! loop over PFTs
+
+          IF ( natural(j) ) THEN
+	     
+             ! Summation of individual tree crown area to get total foliar projected coverage
+             veget_max(:,j) = ind(:,j) * cn_ind(:,j)
+             sum_veget_natveg(:) = sum_veget_natveg(:) + veget_max(:,j)
+
+          ELSE
+             
+             !fraction occupied by agriculture needs to be substracted for the DGVM
+             !this is used below to constrain veget for natural vegetation, see below
+             frac_nat(:) = frac_nat(:) - veget_max(:,j)
+
+          ENDIF
+
+       ENDDO ! loop over PFTs
+
+       DO i = 1, npts ! loop over grid points
+	  
+          ! Recalculation of vegetation projected coverage when ::frac_nat was below ::sum_veget_natveg
+          ! It means that non-natural vegetation will recover ::veget_max as natural vegetation
+          IF (sum_veget_natveg(i) .GT. frac_nat(i) .AND. frac_nat(i) .GT. min_stomate) THEN
+
+             DO j = 2,nvm ! loop over PFTs
+                IF( natural(j) ) THEN
+                   veget_max(i,j) =  veget_max(i,j) * frac_nat(i) / sum_veget_natveg(i)
+                ENDIF
+             ENDDO ! loop over PFTs
+
+          ENDIF
+       ENDDO ! loop over grid points
+	
+       ! Renew veget_max of bare soil as 0 to difference of veget_max (ibare_sechiba) 
+       ! to current veget_max
+       DO j = 2,nvm ! loop over PFTs
+          veget_max(:,ibare_sechiba) = veget_max(:,ibare_sechiba) - veget_max(:,j)
+       ENDDO ! loop over PFTs
+
+       veget_max(:,ibare_sechiba) = MAX( veget_max(:,ibare_sechiba), zero )
+       !! 1.1.1 Copy the depth of the different soil layers (number of layers=nbdl) 
+       !        previously calculated as variable diaglev in routines
+       !        sechiba.f90 and slowproc.f90  
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+       !! 1.2 Calculate carbon fluxes between PFTs to maintain mass balance
+       !      Recalculate the litter and soil carbon with taking into accout the change in 
+       !      veget_max (delta_veg)
+       DO i = 1, npts ! loop over grid points
+          
+          ! calculate the change in veget_max between previous time step and current time step
+          delta_veg(:) = veget_max(i,:)-veget_max_old(i,:)
+          delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.zero)
+
+          dilu_lit_above(i,:,:) = zero
+          dilu_lit_below(i,:,:,:) = zero
+          dilu_soil_carbon(i,:,:) = zero
+
+          DO j=1, nvm ! loop over PFTs
+             DO k=2,nbdl
+             IF ( delta_veg(j) < -min_stomate ) THEN 
+                dilu_lit_above(i,:,:) =  dilu_lit_above(i,:,:) + delta_veg(j) * litter_above(i,:,j,:) / delta_veg_sum
+                dilu_lit_below(i,:,:,:) =  dilu_lit_below(i,:,:,:) + delta_veg(j) * litter_below(i,:,j,:,:) / delta_veg_sum
+              DO m = 1,npool
+                dilu_soil_carbon(i,:,k) =  dilu_soil_carbon(i,:,k) + delta_veg(j) * (carbon(i,:,j,k)+ &
+                                        (DOC(:,j,k,ifree,m,icarbon) + DOC(:,j,k,iadsorbed,m,icarbon))* moist_soil(:,k) * (z_soil(k)-z_soil(k-1))) / delta_veg_sum
+              ENDDO
+             ENDIF
+             ENDDO
+              DO m =1,npool
+                dilu_soil_carbon(i,:,1) =  dilu_soil_carbon(i,:,1) + delta_veg(j) * (carbon(i,:,j,1)+ &
+                                        (DOC(:,j,1,ifree,m,icarbon) + DOC(:,j,1,iadsorbed,m,icarbon))* moist_soil(:,1) * (z_soil(1))) / delta_veg_sum
+              ENDDO
+          ENDDO ! loop over PFTs
+
+WRITE (numout,*) "litter_above_#1_cover_PFT6=",litter_above(:,:,6,:)
+WRITE (numout,*) "litter_above_#1_cover_PFT10=",litter_above(:,:,10,:)
+
+          DO j=1, nvm ! loop over PFTs
+             IF ( delta_veg(j) > min_stomate) THEN
+
+                ! Dilution of reservoirs
+                ! Recalculate the litter and soil carbon with taking into accout the change in 
+                ! veget_max (delta_veg)
+                ! Litter
+                litter_above(i,:,j,:)=(litter_above(i,:,j,:) * veget_max_old(i,j) + dilu_lit_above(i,:,:) * delta_veg(j)) / veget_max(i,j)
+                litter_below(i,:,j,:,:)=(litter_below(i,:,j,:,:) * veget_max_old(i,j) + dilu_lit_below(i,:,:,:) * delta_veg(j)) / veget_max(i,j)
+                ! Soil carbon
+                carbon(i,:,j,:)=(carbon(i,:,j,:) * veget_max_old(i,j) + dilu_soil_carbon(i,:,:) * delta_veg(j)) / veget_max(i,j)
+
+             ENDIF
+
+             IF((j.GE.2).AND.(veget_max_old(i,j).GT.min_stomate).AND.(veget_max(i,j).GT.min_stomate)) THEN
+
+                ! Correct biomass densities (i.e. also litter fall) to conserve mass 
+                ! since it's defined on veget_max
+                biomass(i,j,:,:) = biomass(i,j,:,:) * veget_max_old(i,j) / veget_max(i,j)
+                turnover_daily(i,j,:,:) = turnover_daily(i,j,:,:) * veget_max_old(i,j) / veget_max(i,j)
+                bm_to_litter(i,j,:,:) = bm_to_litter(i,j,:,:) * veget_max_old(i,j) / veget_max(i,j)
+
+             ENDIF
+
+          ENDDO ! loop over PFTs
+WRITE (numout,*) "litter_above_#2_cover_PFT6=",litter_above(:,:,6,:)
+WRITE (numout,*) "litter_above_#2_cover_PFT10=",litter_above(:,:,10,:)
+       ENDDO ! loop over grid points
+    ENDIF
+
+  END SUBROUTINE cover
+
+END MODULE lpj_cover
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_crown.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_crown.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_crown.f90	(revision 5166)
@@ -0,0 +1,203 @@
+! =================================================================================================================================
+! MODULE       : lpj_crown
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Calculate individual crown area from stem mass
+!!
+!! \n DESCRIPTION : Calculating crown area of individual tree by diameter and tree height
+!!
+!! REFERENCE(S) :
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!  dynamics in the modelling of terrestrial ecosystems: comparing two
+!!  contrasting approaches within European climate space,
+!!  Global Ecology and Biogeography, 10, 621-637.
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_crown
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+  
+  IMPLICIT NONE
+  
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC crown
+  
+CONTAINS
+  
+  
+!! ================================================================================================================================
+!! SUBROUTINE    : lpj_crown
+!!
+!>\BRIEF         Calculate individual crown area from stem mass
+!!
+!! DESCRIPTION   : Calculating crown area of individual tree by diameter and tree height
+!! which are also calculated internally within this program from stem mass and allometory.
+!! Calculations for diameter, height and crown area originate from eqns 1, 2, and 3 in 
+!! Appendix B, Smith et al. (2001) following Huang et al. 1992 and Zeide 1993.
+!! \latexonly
+!!  \input{lpj_crown1.tex}
+!!  \input{lpj_crown2.tex}
+!!  \input{lpj_crown3.tex}
+!! \endlatexonly
+!! \n
+!! where \f$k_{allom1}(=100.)\f$, \f$k_{allom2}(=40.)\f$, \f$k_{allom3}(=0.85)\f$ and \f$k_{rp}(=1.6)\f$ are 
+!! constants, \f$WD\f$ is wood density (\f$=2 \times 10^5\f$ gC m\f$^3\f$) and \f$CA_{max}\f$ is maximum 
+!! crown area (\f$=27.3\f$ m\f$^2\f$).
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::cn_ind (crown area per individual, @tex $m^2 $ @endtex) and ::height (m)
+!!
+!! REFERENCE(S)   :
+!! - Huang, S., Titus, S.J. and Wiens, D.P. (1992) Comparison of nonlinear heightâdiameter functions for major 
+!! Alberta tree species. Canadian Journal of Forest Research, 22, 1297â1304.\n
+!! - Zeide, B. (1993) Primary unit of the tree crown. Ecology, 74, 1598â1602.\n
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation dynamics in the modelling of 
+!! terrestrial ecosystems: comparing two contrasting approaches within European climate space,
+!! Global Ecology and Biogeography, 10, 621-637.\n
+!! 
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE crown &
+       &  (npts, PFTpresent, ind, biomass, woodmass_ind, veget_max, cn_ind, height)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                         :: npts              !! Domain size (unitless) 
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in)            :: PFTpresent        !! Is pft there (unitless)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)        :: ind               !! [DISPENSABLE] Density of individuals 
+                                                                           !! @tex $(m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: biomass !! [DISPENSABLE] Biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)        :: woodmass_ind      !! Woodmass of the individual, needed to calculate 
+                                                                           !! crownarea in lpj_crown (gC)
+
+    !! 0.2 Output variables
+  
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out)       :: cn_ind            !! Crown area per individual @tex $(m^{2})$ @endtex    
+
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(inout)     :: veget_max        !! [DISPENSABLE] "Maximal" coverage fraction of a PFT 
+                                                                          !! infinity) on ground (unitless)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(inout)     :: height           !! Height of vegetation (m)           
+
+    !! 0.4 Local variables
+	
+!   REAL(r_std),DIMENSION(npts)                       :: woodmass        !! Wood mass of an individual (gC)
+    INTEGER(i_std)                                    :: j               !! Index
+    REAL(r_std),DIMENSION(npts)                       :: dia             !! Stem diameter (m)
+    REAL(r_std),DIMENSION(nvm)                        :: height_presc_12 !! [DISPENSABLE] Prescribed height of each pfts (m)
+
+!_ ================================================================================================================================
+    
+  !! 1. Initializations
+    
+    !! 1.1 Check if DGVM is activated
+    IF (.NOT.control%ok_dgvm .AND. lpj_gap_const_mort) THEN
+       STOP 'crown: not to be called with static vegetation.'
+    ENDIF
+    
+    !! 1.2 Initialize output to zero
+    cn_ind(:,:) = zero
+
+    !! 1.3 Copy prescribed height to new variable**3 !![DISPENSABLE]
+    height_presc_12(1:nvm) = height_presc(1:nvm)     !![DISPENSABLE]
+    
+  !! 2. Calculate (or prescribe) crown area
+    
+    DO j = 2,nvm ! loop over PFTs
+       IF (is_tree(j)) THEN
+          
+          !! 2.1 Trees
+          IF (natural(j)) THEN
+
+             !! 2.1.1 Natural trees
+             !WHERE (PFTpresent(:,j) .AND.ind(:,j).GT.min_stomate)
+             WHERE (PFTpresent(:,j) .AND.woodmass_ind(:,j).GT.min_stomate)
+
+                !! 2.1.1.1 Calculate individual wood mass**2
+
+                !! SZ note that woodmass_ind needs to be defined on the individual, hence
+                !! biomass*veget_max/ind, not as stated here, correction MERGE 
+                !!         woodmass(:) = &
+                !! &         (biomass(:,j,isapabove,icarbon) + biomass(:,j,isapbelow,icarbon) &
+                !! &         +biomass(:,j,iheartabove,icarbon) + biomass(:,j,iheartbelow,icarbon))/ind(:,j)
+          
+                !! 2.1.1.2 Stem diameter from pipe model
+                !          Stem diameter (pipe model) is calculated by allometory (eqn 1, Appdx B, Smith et al. (2001))
+                !!!$          dia(:) = (woodmass(:)/(pipe_density*pi/4.*pipe_tune2)) &
+                dia(:) = (woodmass_ind(:,j)/(pipe_density*pi/4.*pipe_tune2)) &
+                 &       **(1./(2.+pipe_tune3))
+
+                !! 2.1.1.3 Individual tree height from pipe model
+                !          Individual tree height (eqn 2, Appdx B, Smith et al. (2001))
+                height(:,j) = pipe_tune2*(dia(:)**pipe_tune3)
+
+                !!!$SZ: The constraint on height has nothing to do with LPJ (for that purpose there's dia_max
+                !!!$ cannot see why this is necessary - it also blurrs the output, hence I leave it commented
+                !!!$ WHERE (height(:,j) > height_presc_12(j))
+                !!!$    dia(:) = (height_presc_12(j)/pipe_tune2)**(1./pipe_tune3)
+                !!!$    height(:,j) = height_presc_12(j)
+                !!!$ ENDWHERE
+
+                !! 2.1.1.4 Crown area of individual tree  
+                !          Calculate crown area, truncate crown area for trunks with large diameters 
+                ! crown area cannot exceed a certain value, prescribed through maxdia 
+                ! (eqn 3, Appdx B, Smith et al. (2001))
+                cn_ind(:,j) = pipe_tune1*MIN(dia(:),maxdia(j))**pipe_tune_exp_coeff
+
+             ENDWHERE
+          ELSE
+
+             !! 2.1.2 Agricultural tree
+             !        To be developped if needed
+             STOP 'crown: cannot treat agricultural trees.'
+          ENDIF
+       ELSE
+          
+       !! 2.2 Grasses
+          
+          WHERE (PFTpresent(:,j))
+
+             !! 2.2.1 Crown area of grass
+             !        An "individual" is 1 m^2 of grass
+             cn_ind(:,j) = un
+          ENDWHERE
+       ENDIF
+       
+       !! 2.3 Recalculate vegetation cover 
+       
+       !!!$SZ: since now all state variables are defined on veget_max it is very
+       !!!$ dangerous to change this several times in stomate_lpj, as then GPP, turnover and allocated 
+       !!!$ biomass are not defined on the same space! Hence, veget_max is now kept constant
+       !!!$ and updated at the end of stomate_lpj in lpj_cover.f90
+       !!!$ Eventually, this routine should only be called once at the beginning and the end of stomate_lpj
+       !!!$ or prefereably cn_ind made a saved state variable!
+       !!!$ IF (natural(j).AND.control%ok_dgvm) THEN
+       !!!$   veget_max(:,j) = ind(:,j) * cn_ind(:,j)
+       !!!$ ENDIF
+
+    ENDDO ! loop over PFTs
+
+  END SUBROUTINE crown
+
+END MODULE lpj_crown
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_establish.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_establish.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_establish.f90	(revision 5166)
@@ -0,0 +1,765 @@
+! =================================================================================================================================
+! MODULE       : lpj_establish
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Establish pft's
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: 
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!        plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!        global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Haxeltine, A. and I. C. Prentice (1996), BIOME3: An equilibrium
+!!        terrestrial biosphere model based on ecophysiological constraints, 
+!!        resource availability, and competition among plant functional types,
+!!        Global Biogeochemical Cycles, 10(4), 693-709.\n
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!        dynamics in the modelling of terrestrial ecosystems: comparing two
+!!        contrasting approaches within European climate space,
+!!        Global Ecology and Biogeography, 10, 621-637.\n
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_establish
+
+  ! modules used:
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+  PRIVATE
+  PUBLIC establish,establish_clear
+
+  LOGICAL, SAVE                          :: firstcall = .TRUE.           !! first call
+!$OMP THREADPRIVATE(firstcall)
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : fire_clear 
+!!
+!>\BRIEF       Set the firstcall flag to .TRUE. and activate initialization
+!_ ================================================================================================================================
+
+  SUBROUTINE establish_clear
+    firstcall = .TRUE.
+  END SUBROUTINE establish_clear
+
+
+! =================================================================================================================================
+! SUBROUTINE   : establish 
+!
+!>\BRIEF       Calculate sstablishment of new woody PFT and herbaceous PFTs
+!!
+!! DESCRIPTION : Establishments of new woody and herbaceous PFT are simulated. 
+!! Maximum establishment rate (0.12) declines due to competition for light (space).
+!! There are two establishment estimates: one for the for DGVM and one for the 
+!! static cases.\n
+!! In the case of DGVM, competitive process of establishment for the area of 
+!! available space is represented using more detailed description compared with static 
+!! one. Biomass and distribution of plant age are updated on the basis of changes 
+!! in number of individuals. Finally excess sapwood of is converted to heartwood.
+!!
+!! \latexonly
+!! \input{equation_lpj_establish.tex}
+!! \endlatexonly
+!! \n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)    :
+!! Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!    dynamics in the modelling of terrestrial ecosystems: comparing two
+!!    contrasting approaches within European climate space,
+!!    Global Ecology and Biogeography, 10, 621-637.
+!!
+!! FLOWCHART       : 
+!! \latexonly
+!! \includegraphics[scale = 0.7]{establish.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE establish (npts, dt, PFTpresent, regenerate, &
+       neighbours, resolution, need_adjacent, herbivores, &
+       precip_annual, gdd0, lm_lastyearmax, &
+       cn_ind, lai, avail_tree, avail_grass,  npp_longterm, &
+       leaf_age, leaf_frac, &
+       ind, biomass, age, everywhere, co2_to_bm,veget_max, woodmass_ind)
+ 
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size - number of pixels (dimensionless)    
+    REAL(r_std), INTENT(in)                                   :: dt              !! Time step of vegetation dynamics for stomate 
+                                                                                 !! (days)            
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                  :: PFTpresent      !! Is pft there (unitless)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: regenerate      !! Winter sufficiently cold (unitless)   
+    INTEGER(i_std), DIMENSION(npts,8), INTENT(in)             :: neighbours      !! indices of the 8 neighbours of each grid point 
+                                                                                 !! (unitless);  
+                                                                                 !! [1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW]  
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)                :: resolution      !! resolution at each grid point (m); 1=E-W, 2=N-S     
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                  :: need_adjacent   !! in order for this PFT to be introduced, does it
+                                                                                 !! have to be present in an adjacent grid box?  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: herbivores      !! time constant of probability of a leaf to 
+                                                                                 !! be eaten by a herbivore (days)     
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: precip_annual   !! annual precipitation (mm year^{-1}) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: gdd0            !! growing degree days (degree C)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lm_lastyearmax  !! last year's maximum leaf mass for each PFT 
+                                                                                 !! (gC m^{-2 })
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: cn_ind          !! crown area of individuals (m^2)        
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lai             !! leaf area index OF an individual plant 
+                                                                                 !! (m^2 m^{-2})           
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: avail_tree      !! space availability for trees (unitless)     
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: avail_grass     !! space availability for grasses (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: npp_longterm    !! longterm NPP, for each PFT (gC m^{-2})   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget_max       !! "maximal" coverage fraction of a PFT 
+                                                                                 !! (LAI -> infinity) on ground (unitless)
+    !! 0.2 Output variables
+    
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age        !! leaf age (days)     
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! fraction of leaves in leaf age class (unitless)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! Number of individuals (individuals m^{-2})          
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass   !! biomass (gC m^{-2 })     
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age             !! mean age (years)       
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! is the PFT everywhere in the grid box or very 
+                                                                                 !! localized (unitless)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm       !! biomass up take for establishment i.e. 
+                                                                                 !! pseudo-photosynthesis (gC m^{-2} day^{-1}) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: woodmass_ind    !! woodmass of the individual, needed to calculate
+                                                                                 !! crownarea in lpj_crownarea (gC m^{-2 })  
+
+    !! 0.4 Local variables
+
+    REAL(r_std)                                               :: tau_eatup       !! time during which a sapling can be entirely 
+                                                                                 !! eaten by herbivores (days) 
+    REAL(r_std), DIMENSION(npts,nvm)                          :: fpc_nat         !! new fpc, foliage projective cover: fractional
+                                                                                 !! coverage (unitless)       
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_climate_tree  !! maximum tree establishment rate, 
+                                                                                              !! based on climate only (unitless)  
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_climate_grass !! maximum grass establishment rate,
+                                                                                              !! based on climate only (unitless)
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_tree          !! maximum tree establishment rate, 
+                                                                                              !! based on climate and fpc 
+                                                                                              !! (unitless) 
+    REAL(r_std), DIMENSION(npts)                              :: estab_rate_max_grass         !! maximum grass establishment rate,
+                                                                                              !! based on climate and fpc 
+                                                                                              !! (unitless) 
+    REAL(r_std), DIMENSION(npts)                              :: sumfpc          !! total natural fpc (unitless)
+    REAL(r_std), DIMENSION(npts)                              :: fracnat         !! total fraction occupied by natural 
+                                                                                 !! vegetation (unitless)  
+    REAL(r_std), DIMENSION(npts)                              :: sumfpc_wood     !! total woody fpc (unitless)    
+    REAL(r_std), DIMENSION(npts)                              :: spacefight_tree !! for trees, measures the total concurrence for
+                                                                                 !! available space (unitless)      
+    REAL(r_std), DIMENSION(npts)                              :: spacefight_grass!! for grasses, measures the total concurrence 
+                                                                                 !! for available space (unitless)
+    REAL(r_std), DIMENSION(npts,nvm)                          :: d_ind           !! change in number of individuals per time step 
+                                                                                 !! (individuals m^{-2} day{-1})         
+    REAL(r_std), DIMENSION(npts)                              :: bm_new          !! biomass increase (gC m^{-2 })        
+    REAL(r_std), DIMENSION(npts)                              :: dia             !! stem diameter (m)    
+    REAL(r_std), DIMENSION(npts)                              :: b1              !! temporary variable           
+    REAL(r_std), DIMENSION(npts)                              :: sm2             !! new sap mass (gC m^{-2 })          
+    REAL(r_std), DIMENSION(npts)                              :: woodmass        !! woodmass of an individual (gC m^{-2})  
+    REAL(r_std), DIMENSION(npts)                              :: leaf_mass_young !! carbon mass in youngest leaf age class 
+                                                                                 !! (gC m^{-2})
+    REAL(r_std), DIMENSION(npts)                              :: sm_at           !! ratio of hw(above) to total hw, sm(above) to 
+                                                                                 !! total sm (unitless)         
+    REAL(r_std), DIMENSION(npts)                              :: factor          !! reduction factor for establishment if many 
+                                                                                 !! trees or grasses are present (unitless)  
+    REAL(r_std), DIMENSION(npts)                              :: total_bm_c      !! Total carbon mass for all pools (gC m^{-2})    
+    REAL(r_std), DIMENSION(npts,nelements)                    :: total_bm_sapl   !! Total sappling biomass for all pools 
+                                                                                 !! (gC m^{-2})  
+    INTEGER(i_std)                                            :: nfrontx         !! from how many sides is the grid box invaded
+                                                                                 !! (unitless?)   
+    INTEGER(i_std)                                            :: nfronty         !! from how many sides is the grid box invaded
+                                                                                 !! (unitless?)   
+   !LOGICAL, DIMENSION(npts)                                  :: many_new        !! daily establishment rate is large compared to 
+                                                                                 !! present number of individuals
+    REAL(r_std), DIMENSION(npts)                              :: vn              !! flow due to new individuals veget_max after 
+                                                                                 !! establishment, to get a proper estimate of 
+                                                                                 !! carbon and nitrogen 
+    REAL(r_std), DIMENSION(npts)                              :: lai_ind         !! lai on each PFT surface (m^2 m^{-2})   
+    INTEGER(i_std)                                            :: i,j,k,m         !! indices (unitless)       
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering establish'
+
+  !! 1. messages and initialization
+
+    ! Assumption: time durasion that sapling is completely eaten by hervioures is a half year?   
+    ! No reference
+    tau_eatup = one_year/2.
+
+    !! 1.1 First call only
+    IF ( firstcall ) THEN
+
+       WRITE(numout,*) 'establish:'
+
+       WRITE(numout,*) '   > time during which a sapling can be entirely eaten by herbivores (d): ', &
+            tau_eatup
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+  !! 2. recalculate fpc
+
+    IF (control%ok_dgvm) THEN
+       fracnat(:) = un
+
+       !! 2.1 Only natural part of the grid cell
+       do j = 2,nvm ! Loop over # PFTs
+          
+          IF ( .NOT. natural(j) ) THEN
+             fracnat(:) = fracnat(:) - veget_max(:,j)
+          ENDIF
+       ENDDO ! Loop over # PFTs
+       
+       sumfpc(:) = zero
+
+       !! 2.2 Total natural fpc on grid
+       !      The overall fractional coverage of a PFT in a grid is calculated here.
+       !      FPC is related to mean individual leaf area index by the Lambert-Beer law.
+       !      See Eq. (1) in tex file.\n
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( natural(j) ) THEN
+             WHERE(fracnat(:).GT.min_stomate)
+                WHERE (lai(:,j) == val_exp) 
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                ELSEWHERE
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) & 
+                        * ( un - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
+                ENDWHERE
+             ENDWHERE
+
+             WHERE ( PFTpresent(:,j) )
+                sumfpc(:) = sumfpc(:) + fpc_nat(:,j)
+             ENDWHERE
+          ELSE
+
+             fpc_nat(:,j) = zero
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+       
+       !! 2.3 Total woody fpc on grid and number of regenerative tree pfts
+       !      Total woody FPC increases by adding new FPC.
+       !      Under the condition that temperature in last winter is higher than a threshold, 
+       !      woody plants is exposed in higher competitive environment.
+       sumfpc_wood(:) = zero
+       spacefight_tree(:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( is_tree(j) .AND. natural(j) ) THEN
+
+             ! total woody fpc
+             WHERE ( PFTpresent(:,j) )
+                sumfpc_wood(:) = sumfpc_wood(:) + fpc_nat(:,j)
+             ENDWHERE
+
+             ! how many trees are competing? Count a PFT fully only if it is present
+             ! on the whole grid box.
+             WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit ) )
+                spacefight_tree(:) = spacefight_tree(:) + everywhere(:,j)
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+
+       !! 2.4 Total number of natural grasses on grid\n
+       !     Grass increment equals 'everywhere'\n
+       spacefight_grass(:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( .NOT. is_tree(j) .AND. natural(j) ) THEN
+
+             ! Count a PFT fully only if it is present on a grid.
+             WHERE ( PFTpresent(:,j) )
+                spacefight_grass(:) = spacefight_grass(:) + everywhere(:,j)
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+
+       !! 2.5 Maximum establishment rate, based on climate only\n
+       WHERE ( ( precip_annual(:) .GE. precip_crit ) .AND. ( gdd0(:) .GE. gdd_crit_estab ) )
+
+          estab_rate_max_climate_tree(:) = estab_max_tree ! 'estab_max_*'; see 'stomate_constants.f90'
+          estab_rate_max_climate_grass(:) = estab_max_grass
+
+       ELSEWHERE
+
+          estab_rate_max_climate_tree(:) = zero
+          estab_rate_max_climate_grass(:) = zero
+
+       ENDWHERE
+
+       !! 2.6 Reduce maximum tree establishment rate if many trees are present.
+       !      In the original DGVM, this is done using a step function which yields a
+       !      reduction by factor 4 if sumfpc_wood(i) .GT.  fpc_crit - 0.05.
+       !      This can lead to small oscillations (without consequences however).
+       !      Here, a steady linear transition is used between fpc_crit-0.075 and
+       !      fpc_crit-0.025.
+       !      factor(:) = 1. - 15. * ( sumfpc_wood(:) - (fpc_crit-.075))
+       !      factor(:) = MAX( 0.25_r_std, MIN( 1._r_std, factor(:)))
+       !      SZ modified according to Smith et al. 2001
+       !      See Eq. (2) in header
+       factor(:)=(un - exp(- establish_scal_fact * (un - sumfpc_wood(:))))*(un - sumfpc_wood(:))
+       estab_rate_max_tree(:) = estab_rate_max_climate_tree(:) * factor(:)
+
+       !! 2.7 Modulate grass establishment rate.
+       !      If canopy is not closed (fpc < fpc_crit-0.05), normal establishment.
+       !      If canopy is closed, establishment is reduced by a factor 4.
+       !      Factor is linear between these two bounds.
+       !      This is different from the original DGVM where a step function is
+       !      used at fpc_crit-0.05 (This can lead to small oscillations,
+       !      without consequences however).
+       !      factor(:) = 1. - 15. * ( sumfpc(:) - (fpc_crit-.05))
+       !      factor(:) = MAX( 0.25_r_std, MIN( 1._r_std, factor(:)))
+       !      estab_rate_max_grass(:) = estab_rate_max_climate_grass(:) * factor(:)
+       !      SZ modified to true LPJ formulation, grasses are only allowed in the
+       !      fpc fraction not occupied by trees..., 080806
+       !      estab_rate_max_grass(:)=MAX(0.98-sumfpc(:),zero)
+       !      See Eq. (3) in header
+       estab_rate_max_grass(:) = MAX(MIN(estab_rate_max_climate_grass(:), max_tree_coverage - sumfpc(:)),zero)
+
+       !! 2.8 Longterm grass NPP for competition between C4 and C3 grasses
+       !      to avoid equal veget_max, the idea is that more reestablishment
+       !      is possible for the more productive PFT
+       factor(:) = min_stomate
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( natural(j) .AND. .NOT.is_tree(j)) & 
+               factor(:) = factor(:) + npp_longterm(:,j) * &
+               lm_lastyearmax(:,j) * sla(j)
+       ENDDO ! Loop over # PFTs
+
+       !! 2.9 Establish natural PFTs
+       d_ind(:,:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( natural(j) ) THEN ! only for natural PFTs
+
+             !! 2.9.1 PFT expansion across the grid box. Not to be confused with areal coverage.
+             IF ( treat_expansion ) THEN
+
+                ! only treat plants that are regenerative and present and still can expand
+                DO i = 1, npts ! Loop over # pixels - domain size
+
+                   IF ( PFTpresent(i,j) .AND. &
+                        ( everywhere(i,j) .LT. un ) .AND. &
+                        ( regenerate(i,j) .GT. regenerate_crit ) ) THEN
+
+                      ! from how many sides is the grid box invaded (separate x and y directions
+                      ! because resolution may be strongly anisotropic)
+                      ! For the moment we only look into 4 direction but that can be expanded (JP) 
+                      nfrontx = 0
+                      IF ( neighbours(i,3) .GT. 0 ) THEN
+                         IF ( everywhere(neighbours(i,3),j) .GT. 1.-min_stomate ) nfrontx = nfrontx+1
+                      ENDIF
+                      IF ( neighbours(i,7) .GT. 0 ) THEN
+                         IF ( everywhere(neighbours(i,7),j) .GT. 1.-min_stomate ) nfrontx = nfrontx+1
+                      ENDIF
+
+                      nfronty = 0
+                      IF ( neighbours(i,1) .GT. 0 ) THEN
+                         IF ( everywhere(neighbours(i,1),j) .GT. 1.-min_stomate ) nfronty = nfronty+1
+                      ENDIF
+                      IF ( neighbours(i,5) .GT. 0 ) THEN
+                         IF ( everywhere(neighbours(i,5),j) .GT. 1.-min_stomate ) nfronty = nfronty+1
+                      ENDIF
+                      
+                      everywhere(i,j) = &
+                           everywhere(i,j) + migrate(j) * dt/one_year * &
+                           ( nfrontx / resolution(i,1) + nfronty / resolution(i,2) )
+                      
+                      IF ( .NOT. need_adjacent(i,j) ) THEN
+                         
+                         ! in that case, we also assume that the PFT expands from places within
+                         ! the grid box (e.g., oasis).
+                         ! What is this equation? No reference.
+                         everywhere(i,j) = &
+                              everywhere(i,j) + migrate(j) * dt/one_year * &
+                              2. * SQRT( pi*everywhere(i,j)/(resolution(i,1)*resolution(i,2)) )
+
+                      ENDIF
+
+                      everywhere(i,j) = MIN( everywhere(i,j), un )
+
+                   ENDIF
+
+                ENDDO ! Loop over # pixels - domain size
+
+             ENDIF ! treat expansion?
+
+             !! 2.9.2 Establishment rate
+             !      - Is lower if the PFT is only present in a small part of the grid box
+             !        (after its introduction), therefore multiplied by "everywhere".
+             !      - Is divided by the number of PFTs that compete ("spacefight").
+             !      - Is modulated by space availability (avail_tree, avail_grass).
+
+             !! 2.9.2.1 present and regenerative trees
+             IF ( is_tree(j) ) THEN
+
+                WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit ) )
+                   
+                   
+                   d_ind(:,j) = estab_rate_max_tree(:)*everywhere(:,j)/spacefight_tree(:) * &
+                        avail_tree(:) * dt/one_year
+
+                ENDWHERE
+
+             !! 2.9.2.2 present and regenerative grasses
+             ELSE
+
+                WHERE ( PFTpresent(:,j) .AND. ( regenerate(:,j) .GT. regenerate_crit )  & 
+                     .AND.factor(:).GT.min_stomate .AND. spacefight_grass(:).GT. min_stomate) 
+                   
+                   d_ind(:,j) = estab_rate_max_grass(:)*everywhere(:,j)/spacefight_grass(:) * &
+                        MAX(min_stomate,npp_longterm(:,j)*lm_lastyearmax(:,j)*sla(j)/factor(:)) * fracnat(:) * dt/one_year
+                   
+                ENDWHERE
+                
+             ENDIF  ! tree/grass
+             
+          ENDIF ! if natural
+       ENDDO  ! Loop over # PFTs
+       
+  !! 3. Lpj establishment in static case 
+
+    !     Lpj establishment in static case, SZ 080806, account for real LPJ dynamics in
+    !     prescribed vegetation, i.e. population dynamics within a given area of the grid cell.
+    ELSE 
+
+       d_ind(:,:) = zero
+
+       DO j = 2,nvm ! Loop over # PFTs
+
+          WHERE(ind(:,j)*cn_ind(:,j).GT.min_stomate)
+             lai_ind(:) = sla(j) * lm_lastyearmax(:,j)/(ind(:,j)*cn_ind(:,j))
+          ELSEWHERE
+             lai_ind(:) = zero
+          ENDWHERE
+
+          !! 3.1 For natural woody PFTs
+          IF ( natural(j) .AND. is_tree(j)) THEN 
+
+             ! See Eq. (4) in tex file.            
+             fpc_nat(:,j) =  MIN(un, cn_ind(:,j) * ind(:,j) * & 
+                  MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover ) )
+
+
+             WHERE (veget_max(:,j).GT.min_stomate.AND.ind(:,j).LE.2.)
+
+                !! 3.1.1 Only establish into growing stands 
+                !        Only establish into growing stands, ind can become very
+                !        large in the static mode because LAI is very low in poor 
+                !        growing conditions, favouring continuous establishment. 
+                !        To avoid this a maximum IND is set. BLARPP: This should be
+                !        replaced by a better stand density criteria.
+                factor(:)=(un - exp(-establish_scal_fact * (un - fpc_nat(:,j))))*(un - fpc_nat(:,j))
+
+                estab_rate_max_tree(:) = estab_max_tree * factor(:) 
+
+                !! 3.1.2 do establishment for natural PFTs\n
+                d_ind(:,j) = MAX( zero, estab_rate_max_tree(:) * dt/one_year)
+
+             ENDWHERE
+
+             !SZ: quickfix: to simulate even aged stand, uncomment the following lines...
+             !where (ind(:,j) .LE. min_stomate)
+             !d_ind(:,j) = 0.1 !MAX( 0.0, estab_rate_max_tree(:) * dt/one_year)
+             WHERE (veget_max(:,j).GT.min_stomate .AND. ind(:,j).EQ.zero)
+                d_ind(:,j) = ind_0_estab
+             ENDWHERE
+
+          !! 3.2 For natural grass PFTs
+          ELSEIF ( natural(j) .AND. .NOT.is_tree(j)) THEN 
+
+             WHERE (veget_max(:,j).GT.min_stomate)
+
+                fpc_nat(:,j) =  cn_ind(:,j) * ind(:,j) * & 
+                     MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
+
+                d_ind(:,j) = MAX(zero , (un - fpc_nat(:,j)) * dt/one_year )
+
+             ENDWHERE
+
+             WHERE (veget_max(:,j).GT.min_stomate .AND. ind(:,j).EQ. zero)
+                d_ind(:,j) = ind_0_estab 
+             ENDWHERE
+
+          ENDIF
+
+       ENDDO ! Loop over # PFTs
+
+    ENDIF ! DGVM OR NOT
+
+  !! 4. Biomass calculation
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN ! only for natural PFTs
+
+          !! 4.1 Herbivores reduce establishment rate
+          !      We suppose that saplings are vulnerable during a given time after establishment.
+          !      This is taken into account by preventively reducing the establishment rate.
+          IF ( ok_herbivores ) THEN
+
+             d_ind(:,j) = d_ind(:,j) * EXP( - tau_eatup/herbivores(:,j) )
+
+          ENDIF
+
+          !! 4.2 Total biomass.
+          !      Add biomass only if d_ind, over one year, is of the order of ind.
+          !      save old leaf mass to calculate leaf age
+          leaf_mass_young(:) = leaf_frac(:,j,1) * biomass(:,j,ileaf,icarbon)
+
+          ! total biomass of existing PFT to limit biomass added from establishment
+          total_bm_c(:) = zero
+
+          DO k = 1, nparts
+             total_bm_c(:) = total_bm_c(:) + biomass(:,j,k,icarbon)
+          ENDDO
+          IF(control%ok_dgvm) THEN
+             vn(:) = veget_max(:,j)
+          ELSE
+             vn(:) = un
+          ENDIF
+
+          total_bm_sapl(:,:)=zero
+          DO k = 1, nparts
+             WHERE(d_ind(:,j).GT.min_stomate.AND.vn(:).GT.min_stomate)
+
+                total_bm_sapl(:,icarbon) = total_bm_sapl(:,icarbon) + & 
+                     bm_sapl(j,k,icarbon) * d_ind(:,j) / vn(:)
+             ENDWHERE
+          ENDDO
+
+          !! 4.3 Woodmass calculation
+
+          !! 4.3.1 with DGVM
+          IF(control%ok_dgvm) THEN
+
+             ! SZ calculate new woodmass_ind and veget_max after establishment (needed for correct scaling!)
+             ! essential correction for MERGE!
+             IF(is_tree(j))THEN
+                DO i=1,npts ! Loop over # pixels - domain size
+                   IF((d_ind(i,j)+ind(i,j)).GT.min_stomate) THEN
+
+                      IF((total_bm_c(i).LE.min_stomate) .OR. (veget_max(i,j) .LE. min_stomate)) THEN
+
+                         ! new wood mass of PFT
+                         woodmass_ind(i,j) = &
+                              (((biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                              + biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon))*veget_max(i,j)) &
+                              + (bm_sapl(j,isapabove,icarbon) + bm_sapl(j,isapbelow,icarbon) &
+                              + bm_sapl(j,iheartabove,icarbon) + bm_sapl(j,iheartbelow,icarbon))*d_ind(i,j))/(ind(i,j) + d_ind(i,j))
+
+                      ELSE
+ 
+                         ! new biomass is added to the labile pool, hence there is no change 
+                         ! in CA associated with establishment
+                         woodmass_ind(i,j) = &
+                              & (biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                              & +biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon))*veget_max(i,j) &
+                              & /(ind(i,j) + d_ind(i,j))
+
+                      ENDIF
+
+                      ! new diameter of PFT
+                      dia(i) = (woodmass_ind(i,j)/(pipe_density*pi/4.*pipe_tune2)) &
+                           &                **(1./(2.+pipe_tune3))
+                      vn(i) = (ind(i,j) + d_ind(i,j))*pipe_tune1*MIN(dia(i),maxdia(j))**pipe_tune_exp_coeff
+
+                   ENDIF
+                ENDDO ! Loop over # pixels - domain size
+             ELSE ! for grasses, cnd=1, so the above calculation cancels
+                vn(:) = ind(:,j) + d_ind(:,j)
+             ENDIF
+
+          !! 4.3.2 without DGVM (static)\n
+          ELSE 
+             DO i=1,npts ! Loop over # pixels - domain size
+                IF(is_tree(j).AND.(d_ind(i,j)+ind(i,j)).GT.min_stomate) THEN
+                   IF(total_bm_c(i).LE.min_stomate) THEN
+
+                      ! new wood mass of PFT
+                      woodmass_ind(i,j) = &
+                           & (((biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                           & + biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon))) &
+                           & + (bm_sapl(j,isapabove,icarbon) + bm_sapl(j,isapbelow,icarbon) &
+                           & + bm_sapl(j,iheartabove,icarbon) + bm_sapl(j,iheartbelow,icarbon))*d_ind(i,j))/(ind(i,j)+d_ind(i,j))
+
+                   ELSE
+ 
+                      ! new biomass is added to the labile pool, hence there is no change 
+                      ! in CA associated with establishment
+                      woodmass_ind(i,j) = &
+                           & (biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) &
+                           & + biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon)) &
+                           & /(ind(i,j) + d_ind(i,j))
+
+                   ENDIF
+                ENDIF
+             ENDDO ! Loop over # pixels - domain size
+
+             vn(:) = un ! cannot change in static!, and veget_max implicit in d_ind
+
+          ENDIF
+
+          !! 4.4 total biomass of PFT added by establishment defined over veget_max ...
+          total_bm_sapl(:,:) = zero
+          DO k = 1, nparts ! Loop over # litter tissues (nparts=8); see 'stomate_constants.f90'
+             WHERE(d_ind(:,j).GT.min_stomate.AND.total_bm_c(:).GT.min_stomate.AND.vn(:).GT.min_stomate)
+
+                total_bm_sapl(:,icarbon) = total_bm_sapl(:,icarbon) + & 
+                     bm_sapl(j,k,icarbon) * d_ind(:,j) / vn(:)
+             ENDWHERE
+          ENDDO ! Loop over # litter tissues
+
+          !! 4.5 Update biomass at each component
+          DO k = 1, nparts ! Loop over # litter tissues
+
+             bm_new(:) = zero
+
+             ! first ever establishment, C flows
+             WHERE( d_ind(:,j).GT.min_stomate .AND. &
+                  total_bm_c(:).LE.min_stomate .AND. &
+                  vn(:).GT.min_stomate)
+                ! WHERE ( many_new(:) )
+
+                !bm_new(:) = d_ind(:,j) * bm_sapl(j,k) / veget_max (:,j)
+                bm_new(:) = d_ind(:,j) * bm_sapl(j,k,icarbon) / vn(:)
+
+                biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) + bm_new(:)
+
+                co2_to_bm(:,j) = co2_to_bm(:,j) + bm_new(:) / dt
+
+             ENDWHERE
+
+             ! establishment into existing population, C flows
+             WHERE(d_ind(:,j).GT.min_stomate.AND.total_bm_c(:).GT.min_stomate)
+
+                bm_new(:) = total_bm_sapl(:,icarbon) * biomass(:,j,k,icarbon) / total_bm_c(:)
+
+                biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) + bm_new(:)
+                co2_to_bm(:,j) = co2_to_bm(:,j) + bm_new(:) / dt
+
+             ENDWHERE
+          ENDDO ! Loop over # litter tissues
+
+          
+
+          !! 4.6 Decrease leaf age in youngest class if new leaf biomass is higher than old one.
+          WHERE ( d_ind(:,j) * bm_sapl(j,ileaf,icarbon) .GT. min_stomate )
+ 
+             ! reset leaf ages. Should do a real calculation like in the npp routine, 
+             ! but this case is rare and not worth messing around.
+             ! SZ 080806, added real calculation now, because otherwise leaf_age/leaf_frac
+             ! are not initialised for the calculation of vmax, and hence no growth at all.
+             ! logic follows that of stomate_npp.f90, just that it's been adjusted for the code here
+             leaf_age(:,j,1) = leaf_age(:,j,1) * leaf_mass_young(:) / &
+                  ( leaf_mass_young(:) + d_ind(:,j) * bm_sapl(j,ileaf,icarbon) )
+
+          ENDWHERE
+
+          leaf_mass_young(:) = leaf_mass_young(:) + d_ind(:,j) * bm_sapl(j,ileaf,icarbon)   
+
+          !! 4.7 Youngest class: new mass in youngest class divided by total new mass
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+             ! new age class fractions (fraction in youngest class increases)
+             leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf,icarbon)
+
+          ENDWHERE
+
+          !! 4.8 Other classes: old mass in leaf age class divided by new mass
+          DO m = 2, nleafages
+
+             WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+                leaf_frac(:,j,m) = leaf_frac(:,j,m) * & 
+                     ( biomass(:,j,ileaf,icarbon) + d_ind(:,j) * bm_sapl(j,ileaf,icarbon) ) /  biomass(:,j,ileaf,icarbon)
+
+             ENDWHERE
+
+          ENDDO
+
+          !! 4.9 Update age and number of individuals
+          WHERE ( d_ind(:,j) .GT. min_stomate )
+
+             age(:,j) = age(:,j) * ind(:,j) / ( ind(:,j) + d_ind(:,j) )
+
+             ind(:,j) = ind(:,j) + d_ind(:,j)
+
+          ENDWHERE
+
+          !! 4.10 Convert excess sapwood to heartwood
+          IF ( is_tree(j) ) THEN
+
+             sm2(:) = biomass(:,j,isapabove,icarbon) + biomass(:,j,isapbelow,icarbon)
+
+             WHERE ( ( d_ind(:,j) .GT. min_stomate ) .AND. &
+                  ( biomass(:,j,isapabove,icarbon) + biomass(:,j,isapbelow,icarbon) ) .GT. sm2(:) ) !!?? l.h.s. equals r.h.s ?
+
+                sm_at(:) = biomass(:,j,isapabove,icarbon) / &
+                   ( biomass(:,j,isapabove,icarbon) + biomass(:,j,isapbelow,icarbon) )
+
+                !SZ to clarify with Gerhard Krinner: This is theoretically inconsistent because 
+                ! the allocation to sapwood and leaves do not follow the LPJ logic in stomate_alloc.f90
+                ! hence imposing this here not only solves for the uneveness of age (mixing new and average individual)
+                ! but also corrects for the discrepancy between SLAVE and LPJ logic of allocation, thus leads to excess 
+                ! heartwood and thus carbon accumulation!
+                ! should be removed.
+                biomass(:,j,iheartabove,icarbon) = biomass(:,j,iheartabove,icarbon) + &
+                     ( biomass(:,j,isapabove,icarbon) - sm2(:) * sm_at(:) )
+                biomass(:,j,isapabove,icarbon) = sm2(:) * sm_at(:)
+
+                biomass(:,j,iheartbelow,icarbon) = biomass(:,j,iheartbelow,icarbon) + &
+                     ( biomass(:,j,isapbelow,icarbon) - sm2(:) * (un - sm_at) )
+                biomass(:,j,isapbelow,icarbon) = sm2(:) * (un - sm_at(:))
+
+             ENDWHERE
+
+          ENDIF ! tree
+
+       ENDIF ! natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 5. history
+
+    d_ind = d_ind / dt
+
+    CALL histwrite_p (hist_id_stomate, 'IND_ESTAB', itime, d_ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ESTABTREE', itime, estab_rate_max_tree, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'ESTABGRASS', itime, estab_rate_max_grass, npts, hori_index)
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving establish'
+
+  END SUBROUTINE establish
+
+END MODULE lpj_establish
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_fire.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_fire.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_fire.f90	(revision 5166)
@@ -0,0 +1,612 @@
+! =================================================================================================================================
+! MODULE        : lpj_fire
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Calculates the probability of fire and its effects on the carbon cycle
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN           :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_fire
+
+  ! modules used:
+
+  USE stomate_data
+  USE ioipsl_para 
+  USE pft_parameters
+  USE constantes
+  USE constantes_soil
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC fire,fire_clear
+
+  LOGICAL, SAVE                   :: firstcall = .TRUE.        !! first call 
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : fire_clear 
+!!
+!>\BRIEF        Set the firstcall flag to .TRUE. and activate initialization
+!! 
+!_ ================================================================================================================================
+
+  SUBROUTINE fire_clear
+    firstcall = .TRUE.
+  END SUBROUTINE fire_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE     : fire 
+!!
+!>\BRIEF          Calculate fire index and fraction of area burned by comparing 
+!! daily litter moisture with prescribed moisture of fire inhibition. If daily 
+!! moisture is below the precribed threshold, allow fire disturbance and 
+!! calculate CO_2 emissions from fire. The main algorithm follows Thonicke et al. 
+!! (2001)
+!!
+!! DESCRIPTION	: Fire occurs when the three basic prerequisites are met: 
+!! sufficient fuel on the ground, relatively dry fuel (fuel moisture lower than 
+!! the moisture of extinction), and presence of ignition sources.  The flag 
+!! ::disable_fire is used to use this fire module or not. While here in the module the 
+!! ignition source is not explicitely represented. It's assumed 
+!! that the ignition source is always available, i.e., if a sufficient amount 
+!! of dead fuel exists with a moisture content below the moisture of fire 
+!! inhibition, then both live and dead fuel will start to burn.\n
+!!
+!! The module completes the following tasks:
+!! 1. Calculates daily fire index, long term fire index and available ground 
+!! litter for burning.\n
+!! \latexonly
+!! \input{lpj_fire_1.tex}  
+!! \endlatexonly
+!! Where, m is the daily litter moisture, m_e is the moisture of extinction, p(m) 
+!! is probability of fire (i.e. the daily fire index).\n
+!! 
+!! \latexonly
+!! \input{lpj_fire_2.tex}  
+!! \endlatexonly
+!! Where, s is the long term fire index and A(s) is the annual fire fraction.\n
+!! 2. Calculates annual fire fraction, then transform to daily fraction in the 
+!! same time step of stomate.\n
+!! 3. Ground litter and grass live biomass (in growing season and except root and carbon 
+!! reserve pool) are  burned at full fire fraction.\n
+!! 4. Fire fraction for tree PFT are compromised by prescribed fire resistence.
+!! Tree live biomass are consumed using this compromised fire fraction and consumption
+!! fraction for different biomass parts. In the case of activation of dynamic 
+!! vegetation, tree individual density is updated after fire. \n 
+!! 5. For all types of fuel (either ground litter or live biomass) that are 
+!! burned, there is a certain fraction of âresidueâ that are not completely 
+!! burned. From this part of residue, there is further certain fraction that 
+!! goes to black carbon pool (very inert carbon pool that is part of geological
+!! carbon cycle), and the remaining part is transferred to (in case of biomass) or
+!! remains (in case of ground litter) as litter.\n
+!! 6. Update the biomass, litter or dead leaves pool after burning.
+!! 7. If the flag SPINUP_ANALYTIC is set to true, the matrix A is updated following
+!! Lardy (2011).
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::co2_fire or the carbon emitted into the atmosphere 
+!! by fire, including both living and dead biomass (gC m^{-2} dtslow^{-1})$ @endtex
+!!
+!! REFERENCES    :
+!! - Thonicke K., Venevsky S., Sitch S., and Cramer W. (2001) The role of fire 
+!! disturbance for global vegetation dynamics: coupling fire into a Dynamic 
+!! Global Vegetation Model, Global Ecology & Biogeography, 10, 661-677.
+!! - Kuhlbusch et al. JGR 101, 23651-23665, 1996
+!! - Kuhlbusch & Crutzen, GBC 9, 491-501, 1995
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART     : None
+!! \n 
+!_ ================================================================================================================================
+  
+  SUBROUTINE fire (npts, dt, litterpart, &
+       litterhum_daily, t2m_daily, lignin_struc_above,veget_max, &
+       fireindex, firelitter, biomass, ind, &
+       litter_above, dead_leaves, bm_to_litter, black_carbon, &
+       co2_fire, MatrixA)
+
+  !! 0. Variable and parameter declarations
+
+    !! 0.1 Input variables
+   
+    INTEGER(i_std), INTENT(in)                                   :: npts                !! Domain size - number of pixels 
+                                                                                        !! (unitless)   
+    REAL(r_std), INTENT(in)                                      :: dt                  !! Time step of the simulations for stomate 
+                                                                                        !! (days)   
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)           :: litterpart          !! [DISPENSABLE] Fraction of litter above 
+                                                                                        !! the ground belonging to different PFTs 
+                                                                                        !! ?? this variable is used but might be 
+                                                                                        !! redundant (with value of always 1) ?? 
+                                                                                        !! To check but probably litterpart to be 
+                                                                                        !! removed. Probably a residual from 
+                                                                                        !! nat/agri before merge   
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: litterhum_daily     !! Daily litter moisture (unitless, 0-1)   
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: t2m_daily           !! Daily 2 meter temperature (K)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                 :: lignin_struc_above        !! Ratio Lignin/Carbon in structural above 
+                                                                                        !! and below ground litter 
+                                                                                        !! @tex $(gC gC^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                 :: veget_max           !! Maximum fraction of vegetation type including 
+                                                                                        !! non-biological fraction (0-1, unitless) 
+
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                :: co2_fire            !! Carbon emitted into the atmosphere by 
+                                                                                        !! fire, including both living and dead 
+                                                                                        !! biomass 
+                                                                                        !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    !! 0.3 Modified variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)              :: fireindex           !! Probability of fire; in the code means 
+                                                                                        !! long term fire index (unitless, 0-1)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)              :: firelitter          !! Total natural litter 
+                                                                                        !! available for burning above the ground 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)  :: biomass        !! Biomass @tex $(gC m^{-2})$ @endtex
+    REAl(r_std), DIMENSION(npts,nvm), INTENT(inout)                   :: ind            !! Density of individuals 
+                                                                                        !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements), INTENT(inout) :: litter_above     !! Metabolic and structural litter, above
+                                                                                        !! and below ground 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)        :: dead_leaves         !! Dead leaves on ground, per PFT, 
+                                                                                        !! metabolic and structural 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: bm_to_litter     !! Biomass entering the litter pool 
+                                                                                        !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                  :: black_carbon        !! Black carbon on the ground 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(inout) :: MatrixA          !! Matrix containing the fluxes between the carbon pools
+                                                                                        !! here, it is called only if disable_fire = n
+                                                                                        !! once a day 
+                                                                                        !! @tex $(gC.m^2.day^{-1})$ @endtex
+   
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                                  :: fire_disturb       !! Actual fire disturbance fraction 
+                                                                                        !! after consideration of inherent fire 
+                                                                                        !! resistance of different PFTs 
+                                                                                        !! (unitless, 0-1)  
+    REAL(r_std), DIMENSION(npts,nvm)                              :: firedeath          !! In case of activation of dynamic 
+                                                                                        !! vegetation, the daily fraction of 
+                                                                                        !! burned individuals (unitless, 0-1)  
+    REAL(r_std), DIMENSION(npts)                                  :: moistlimit         !! Moisture for fire inhibition per PFT                                                                                         !! 
+                                                                                        !! (unitless, 0-1) ; temporary variable 
+                                                                                        !! for each PFT in the loop over #PFT ? 
+                                                                                        !! it's not fire inhibition, it's 
+                                                                                        !! "moisture of extinction" by the original
+                                                                                        !! reference paper, and a more "fire 
+                                                                                        !! professional name" it's better to change
+                                                                                        !! the name of moistlimit 
+    REAL(r_std), DIMENSION(npts)                                  :: litter             !! Total aboveground litter per PFT                                                                                         !! 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                              :: fireindex_daily    !! Daily fire index (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts, nvm)                             :: firefrac           !! Daily fire burning fraction on ground 
+                                                                                        !! (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts)                                  :: struc_residual     !! Fraction of structural litter not burned
+                                                                                        !! (thus residual), depending on strutural 
+                                                                                        !! litter lignin content  (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts)                                  :: residue            !! Fuel (either biomass or litter) not 
+                                                                                        !! burned  @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                                  :: bcfrac             !! Fraction of residue transformed into 
+                                                                                        !! black carbon (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts)                                  :: x                  !! Intermediate variable
+    REAL(r_std), DIMENSION(npts)                                  :: aff                !! Annual fire fraction (unitless, 0-1) 
+    INTEGER(i_std)                                                :: j,k,m,l            !! Indeces
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering fire'
+
+ !! 1. Initialization
+
+    IF ( firstcall ) THEN
+
+       !! 1.1 Fraction to CO_2
+       !      What fraction of the plant biomass compartment, if burned, is transformed 
+       !      into CO_2 released to the atmosphere?
+       !??! the fraction for heartabove seems too big, it's not clear if this value is correct. 
+
+       !! 1.2 print control messages
+       WRITE(numout,*) 'fire:'
+
+       WRITE(numout,*) '   > temporal inertia of fire probability (d): ',tau_fire
+
+       WRITE(numout,*) '   > fraction of burned biomass that becomes CO2:'
+       WRITE(numout,*) '     leaves: ', co2frac(ileaf)
+       WRITE(numout,*) '     sap above ground: ', co2frac(isapabove)
+       WRITE(numout,*) '     sap below ground: ', co2frac(isapbelow)
+       WRITE(numout,*) '     heartwood above ground: ', co2frac(iheartabove)
+       WRITE(numout,*) '     heartwood below ground: ', co2frac(iheartbelow)
+       WRITE(numout,*) '     roots: ', co2frac(iroot)
+       WRITE(numout,*) '     fruits: ', co2frac(ifruit)
+       WRITE(numout,*) '     carbohydrate reserve: ', co2frac(icarbres)
+
+       WRITE(numout,*) '   > critical litter quantity (gC/m**2): ',litter_crit
+       WRITE(numout,*) '   > We calculate a fire probability on agricultural ground, but'
+       WRITE(numout,*) '       the effective fire fraction is zero.'
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+    !! 1.4 Initialize output
+    co2_fire(:,:) = zero
+    firedeath(:,:) = zero
+    fireindex_daily(:,:) = zero
+    firefrac(:,:) = zero
+
+ !! 2. Determine fire probability
+ 
+    ! Calculate probability that crops are not burned for the moment
+    ! Calculate long-term aboveground litter
+ 
+    ! a long loop over PFT
+    DO j = 2,nvm !loop over #PFT
+
+       !! 2.1 Total above ground litter
+       !      Total litter above the ground for the PFT under consideration
+       litter(:) = litter_above(:,imetabolic,j,icarbon) + &
+            litter_above(:,istructural,j,icarbon)
+
+       !! 2.2 Calculate the PFT litter amount weighted by moisture 
+       ! If litter moisture is higher than moisture of extinction, fire is not possible.
+       moistlimit(:) = zero
+       WHERE ( (t2m_daily(:) .GT. ZeroCelsius) .AND. (litter(:) .GT. min_stomate) )
+       !?? the calculation here is redundant? as the part before flam(j) is 1?
+       !?? see first comment.. litterpart to be removed ?
+          moistlimit(:) = moistlimit(:) + &
+               ( litterpart(:,j,imetabolic)*litter_above(:,imetabolic,j,icarbon) + &
+               litterpart(:,j,istructural)*litter_above(:,istructural,j,icarbon)  ) / &
+               litter(:) * flam(j)
+
+       ENDWHERE
+       !! 2.3 Calculate daily fire index 
+       !      Calculate daily fire index
+       !      \latexonly
+       !        \input{lpj_fire_1.tex}  
+       !      \endlatexonly
+       !      Where, m is the daily litter moisture, m_e is the moisture of extinction, p(m) 
+       !      is probability of fire (i.e. the daily fire index).\n
+       WHERE ( moistlimit(:) .GT. min_stomate )
+          x(:) = litterhum_daily(:)/moistlimit(:)
+          fireindex_daily(:,j) = EXP( - pi * x(:) * x(:) )
+       ELSEWHERE
+          fireindex_daily(:,j) = zero
+       ENDWHERE
+
+       !! 2.4 Calculate long-term fire index 
+       !      Calculate long-term fire index which is the mean probability of fire
+       fireindex(:,j) = ((tau_fire - dt) * fireindex(:,j) + (dt) * fireindex_daily(:,j)) / tau_fire
+
+       !! 2.5 Calculate long term aboveground litter that are available for burning
+       firelitter(:,j) = &
+            ( ( tau_fire-dt ) * firelitter(:,j) + dt * litter(:) ) / tau_fire
+
+  !! 3. Calculate fire fraction from litter and fireindex
+
+       !! 3.1 Fire fraction from long term fire index for natural PFTs
+       !  Transform the annual fire fraction to daily fraction. This is done by assuming that
+       !  each day the fire fraction is the same. 
+       aff(:) = firefrac_func (npts, fireindex(:,j))
+
+       ! annual_fire_fraction = 1. - ( 1. - daily_fire_fraction )**365
+       ! Thus, daily_fire_fraction = 1. - ( 1. - annual_fire_fraction )**(1/365)
+       ! If annual firefrac<<1, then firefrac_daily = firefrac * dt/one_year
+       ! This approximation avoids numerical problems.
+       ! the variable 'un' is 1
+       IF(.NOT.disable_fire.AND.natural(j))THEN
+          WHERE ( aff(:) .GT. 0.1 )
+             firefrac(:,j) = un - ( un - aff(:) ) ** (dt/one_year)
+          ELSEWHERE
+             firefrac(:,j) = aff(:) * dt/one_year
+          ENDWHERE
+       ELSE
+          firefrac(:,j) = zero
+       ENDIF
+
+       ! No fire if litter is below critical value
+       WHERE ( firelitter(:,j) .LT. litter_crit )
+          firefrac(:,j) = zero
+       ENDWHERE
+
+       ! However, there is a minimum fire extent
+       firefrac(:,j) = MAX( 0.001_r_std * dt/one_year, firefrac(:,j) )
+
+       ! if FIRE_DISABLE flag is set no fire
+       IF (disable_fire) firefrac = zero
+       
+       !! 3.2 For agricultural ground, no fire is burned for the moment
+       IF ( .NOT. natural(j)) firefrac(:,j) = zero
+       
+  !! 4. Determine fire impact
+
+       ! Calculate fire disturbance fraction for each PFT, and fire emissions due 
+       ! to grasses.
+   
+       !! 4.1 Tree and grass live biomass 
+       ! Tree live biomass is not burned in fire. 
+       ! However, in the dynamic vegetation module, tree individual density 
+       ! will be updated after fire. The fraction of tree individuals that are 
+       ! supposed to die in fire is the fire fraction multiplied by the tree PFT fire 
+       ! resistance which reflect survivorship of different tree PFTs during fire.  
+       IF ( is_tree(j) ) THEN
+
+          !! 4.1.1 Disturban,ce factor for trees 
+          !        Trees are disturbed over the whole year. A resistance factor is  
+          !        used to reflect survivorship of different tree PFTs during fire. 
+          fire_disturb(:) = ( un - resist(j) ) * firefrac(:,j)
+
+       ELSE
+
+          !! 4.1.2 Disturbance factor for grasses 
+          !        Grass is not disturbed outside the growing season thus grass biomass 
+          !        is only burned during the growing season.
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+             fire_disturb(:) = ( un - resist(j) ) * firefrac(:,j)
+
+          ELSEWHERE
+
+             fire_disturb(:) = zero
+
+          ENDWHERE
+
+       ENDIF
+
+       !! 4.2 Burn live biomass
+       !      The burned part goes to either the atmposhere, or litter, or blackcarbon pool. 
+       DO k = 1, nparts
+
+          ! for tree PFT, all biomass compartments are burned.
+          ! for grass biomass compartments, all are burned except root and carbon reserve
+          ! IF concerning PFT is tree; OR (the PFT is grass, but not root or carbon reserve biomass); then it's burned.
+          IF ( .NOT. ( ( .NOT. is_tree(j) ) .AND. ( ( k.EQ.iroot ) .OR. ( k.EQ.icarbres ) ) ) ) THEN
+
+             !! 4.2.1 Fraction to the atmosphere.
+             co2_fire(:,j) =  co2_fire(:,j)+ biomass(:,j,k,icarbon) * fire_disturb(:) * co2frac(k) / dt
+
+             !! 4.2.2 Determine the residue
+             !        Residual is expressed in gC/m^2
+             residue(:) = biomass(:,j,k,icarbon) * fire_disturb(:) * ( un - co2frac(k) )
+
+             !! 4.2.2.1 Determine fraction of black carbon 
+             !          Only for plant parts above the ground, i.e. when co2_frac > 0. A small part of 
+             !          the residue, which can be expressed as a function of the fraction of volatilized 
+             !          carbon (assimilated to co2frac here), becomes black carbon, and thus withdrawn 
+             !          from the soil carbon cycle (added to the "geologic carbon cycle we don't care 
+             !          about here).
+             !             IF ( co2frac(k) .GT. min_stomate ) THEN
+             IF ( co2frac(k) .GT. zero ) THEN
+                bcfrac(:) = bcfrac_coeff(1) / ( bcfrac_coeff(2) ** ( bcfrac_coeff(3) - 100.*co2frac(k) ) + un )
+             ELSE
+                bcfrac(:) = zero
+             ENDIF
+
+             !! 4.2.2.2 Add fraction of the residue to the black carbon "reservoir"
+             black_carbon(:) = &
+                  black_carbon(:) + bcfrac(:) * residue(:)* veget_max(:,j)
+
+             !! 4.2.2.3 The rest (largest part) of the residue becomes litter.
+             bm_to_litter(:,j,k,icarbon) = bm_to_litter(:,j,k,icarbon) + residue(:) * ( 1 - bcfrac(:) )
+          ENDIF  ! not for grass roots
+
+       ENDDO
+
+      
+       !! 4.3 Update biomass pool after burning
+       
+       !! 4.3.1 Decrease biomass amount except for grass roots and carbon reserve.
+       DO m = 1, nelements ! Loop over # elements
+          
+          DO k = 1, nparts
+
+             ! **2
+             IF ( .NOT. ( ( .NOT. is_tree(j) ) .AND. ( ( k.EQ.iroot ) .OR. ( k.EQ.icarbres) ) ) ) THEN
+                
+                biomass(:,j,k,m) = ( un - fire_disturb(:) ) * biomass(:,j,k,m)
+                
+             ENDIF
+
+          ENDDO
+          
+       END DO ! End Loop over # elements
+
+
+       !! 4.3.2 If vegetation is dynamic, then decrease the density of tree individuals.
+       IF ( (control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) .AND. is_tree(j) ) THEN
+
+          firedeath(:,j) = fire_disturb(:) / dt
+
+          ind(:,j) = ( un - fire_disturb(:) ) * ind(:,j)
+
+       ENDIF
+
+    ENDDO      ! loop over #PFT
+
+  !! 5. Burn litter
+
+    !   All litter (either forest or grass) is burned throughout the whole year
+    !   Metabolic litter is totally burned. Burning fraction of structural litter is related 
+    !   with its lignin content. The burned part either goes to the atmosphere, or to the 
+    !   black carbon pool, or remains in litter as unburned residue.
+!WRITE (numout,*) "litter_above_#1_fire_PFT6=",litter_above(:,:,6,:)
+!WRITE (numout,*) "litter_above_#1_fire_PFT10=",litter_above(:,:,10,:)
+!WRITE (numout,*) "residue=",residue(:)
+    DO j = 2,nvm  !loop over #PFT
+
+       !! 5.1 Burn exposed metabolic litter
+       !      Exposed metabolic litter burns completely and goes directly into the atmosphere as CO2.
+
+       !! 5.1.1 CO2 flux from litter burning
+       !        Flux expressed in gC m^{-2}dtslow^{-1}
+       co2_fire(:,j) = co2_fire(:,j) + litter_above(:,imetabolic,j,icarbon) * &
+            firefrac(:,j) / dt
+       !! 5.1.2 Decrease metabolic litter
+         DO m = 1,nelements
+            litter_above(:,imetabolic,j,m) = litter_above(:,imetabolic,j,m) * &
+                 ( un - firefrac(:,j) )
+         ENDDO
+       !! 5.2 Burning exposed structural litter 
+       !      The fraction that goes to the atmosphere is related to its lignin content. The remaining unburned 
+       !      residues go to either black carbon pool, or remain as litter.
+
+       !! 5.2.1 Incomplete burning of exposed structural litter  
+       !        Fraction of structural litter that does not burn completly. This fraction depends on lignin 
+       !        content (lignin_struc).
+       struc_residual(:) = fire_resist_struct * lignin_struc_above(:,j) 
+
+       !! 5.2.2 CO2 flux from litter burning 
+       !  Flux expressed in gC m^{-2}dtslow^{-1}
+       co2_fire(:,j) = co2_fire(:,j) + &
+            litter_above(:,istructural,j,icarbon) * firefrac(:,j) * &
+            ( un - struc_residual(:) )/ dt
+       !! 5.2.3 Determine residue 
+       !        The residue is litter that undergoes fire, but is not transformed into CO2
+          IF (control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN
+             residue(:) = firefrac(:,j) * struc_residual(:)
+          ELSE
+              residue(:) = residue(:)+litter_above(:,istructural,j,icarbon) * firefrac(:,j) * &
+                  struc_residual(:)
+          
+          ENDIF
+       !! 5.2.4 Determine fraction of black carbon in the residue
+       !        Depends on volatilized fraction of carbon (see 4.3.2.1)
+       bcfrac(:) = bcfrac_coeff(1)/ ( bcfrac_coeff(2) ** ( bcfrac_coeff(3) - 100.*(un - struc_residual(:)) ) + un )
+
+       !! 5.2.5 Add this fraction of the residue to the black carbon "reservoir"
+       !        In gC m^{-2}
+       black_carbon(:) = &
+            black_carbon(:) + bcfrac(:) * residue(:)* veget_max(:,j)
+ 
+       !! 5.2.6 TResidue remaining litter
+       !        The rest (largest part) of the residue remains litter. Remaining 
+       !        litter is the sum of this and of the litter which has not undergone a fire.
+       WHERE (veget_max(:,j) .GT. min_stomate)
+       litter_above(:,istructural,j,icarbon) = &
+            litter_above(:,istructural,j,icarbon) * ( un - firefrac(:,j) ) + &
+            residue(:) * ( un - bcfrac(:) )
+       ENDWHERE
+       !! 5.2.7 Update matrix A for analytical spin-up (only if SPINUP_ANALYTIC is activated)
+
+       IF (spinup_analytic) THEN
+          
+          ! litter structural above
+          MatrixA(:,j,istructural_above,istructural_above) =  MatrixA(:,j,istructural_above,istructural_above) - firefrac(:,j) & 
+                                                                +  firefrac(:,j)* struc_residual(:)*( 1. - bcfrac(:))
+          ! litter_metabolic above
+          MatrixA(:,j,imetabolic_above,imetabolic_above) = MatrixA(:,j,imetabolic_above,imetabolic_above) - firefrac(:,j) 
+          !DS! This is the exact formulation. The above is a simplified formulation.
+          !          MatrixA(:,j,istructural_above,istructural_above) =  MatrixA(:,j,istructural_above,istructural_above)*(1. - firefrac(:,j) + &
+          !                                                             firefrac(:,j)* struc_residual(:)*( 1. - bcfrac(:)))
+          !          MatrixA(:,j,imetabolic_above,imetabolic_above) = MatrixA(:,j,imetabolic_above,imetabolic_above)*(1 - firefrac(:,j))
+          
+       ENDIF !(spinup_analytic)
+
+    ENDDO  !  loop over #PFT
+!WRITE (numout,*) "litter_above_#2_fire_PFT6=",litter_above(:,:,6,:)
+!WRITE (numout,*) "litter_above_#2_fire_PFT10=",litter_above(:,:,10,:)
+   
+   !! 5.3 Update exposed dead leaves (leaf litter) on the ground
+   !      Dead leaves are supposed to burn completely in fire even their structural part.
+    DO j = 2,nvm
+
+       DO k = 1, nlitt
+          dead_leaves(:,j,k) = dead_leaves(:,j,k) * ( un - firefrac(:,j) )
+       ENDDO
+
+    ENDDO
+
+  !! 6. write out history variables
+
+    ! output in 1/dtslow
+    firefrac(:,:) = firefrac(:,:) / dt
+    CALL histwrite_p (hist_id_stomate, 'FIREFRAC', itime, &
+         firefrac(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FIREDEATH', itime, &
+         firedeath(:,:), npts*nvm, horipft_index)
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving fire'
+
+  END SUBROUTINE fire
+
+
+!! ================================================================================================================================
+!! FUNCTION     : firefrac_func
+!!
+!>\BRIEF        Calculate the annual fire fraction using long term fire index
+!! 
+!! DESCRIPTION	: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : annual fire fraction (::firefrac_result)
+!!
+!! REFERENCES   :
+!! - Thonicke K., Venevsky S., Sitch S., and Cramer W. (2001) The role of fire 
+!! disturbance for global vegetation dynamics: coupling fire into a Dynamic 
+!! Global Vegetation Model, Global Ecology & Biogeography, 10, 661-677.\n
+!!
+!! FLOWCHART    : None
+!! \n 
+!_ ================================================================================================================================
+   
+  FUNCTION firefrac_func (npts, x) RESULT (firefrac_result)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                 :: npts             !! Domain size (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)   :: x                !! fire index (unitless, 0-1)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts)               :: firefrac_result  !! fire fraction (unitless, 0-1)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts)               :: xm1              !! intermediate variable
+!_ ================================================================================================================================
+
+!! 1. Function
+
+    xm1(:) = x(:) - 1.
+
+    ! this equation is from Thonicke et al. (2001) equation (9), it use the fire index as input to calculate annual fire fraction.
+    ! but with different parameters with the source literature.
+    !! \latexonly
+    !! \input{lpj_fire_2.tex}  
+    !! \endlatexonly
+    !! Where, s is the long term fire index and A(s) is the annual fire fraction.\n
+    !??! here we use a different parameter with K. Thonicke et al. (2001)
+    !??! it's not clear if these parameters are correct.
+    firefrac_result(:) = &
+         &     x(:) * EXP( xm1(:) / ( -firefrac_coeff(4)*xm1(:)*xm1(:)*xm1(:) + &
+         &     firefrac_coeff(3)*xm1(:)*xm1(:) + &
+         &     firefrac_coeff(2)*xm1(:) +  &      
+         &     firefrac_coeff(1) ) )
+
+  END FUNCTION firefrac_func
+
+END MODULE lpj_fire
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_gap.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_gap.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_gap.f90	(revision 5166)
@@ -0,0 +1,315 @@
+! =================================================================================================================================
+! MODULE       : lpj_gap
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Simulate mortality of individuals and update biomass, litter and 
+!! stand density of the PFT
+!!
+!!\n DESCRIPTION : Simulate mortality of individuals and update biomass, litter and 
+!! stand density of the PFT. This module differs from lpj_kill.f90 in that this 
+!! module kills individuals within a PFT and lpj_kill.f90 removes a PFT from a 
+!! gridbox
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) : 
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!         plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!         global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Waring, R. H. (1983). "Estimating forest growth and efficiency in relation 
+!!         to canopy leaf area." Advances in Ecological Research 13: 327-354.\n
+!! 
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_gap
+
+  ! modules used:
+
+  USE stomate_data
+  USE pft_parameters
+  USE ioipsl_para 
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC gap,gap_clear
+  
+  ! Variable declaration 
+
+  LOGICAL, SAVE             :: firstcall = .TRUE.                !! first call flag
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gap_clear
+!!
+!>\BRIEF        Set the firstcall flag back to .TRUE. to prepare for the next simulation.
+!_ ================================================================================================================================
+  
+  SUBROUTINE gap_clear
+    firstcall = .TRUE.
+  END SUBROUTINE gap_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : gap
+!!
+!>\BRIEF        Simulate tree and grass mortality, transfer dead biomass to litter and update stand density
+!!
+!! DESCRIPTION  : Calculate mortality of trees and grasses, transfer the dead biomass to litter pool,
+!! and update biomass pool and number of individuals. To get tree mortality, it's possible to choose either a 
+!! constant mortality rate; or to calculate the tree mortality rate based on it's growth efficiency, which is 
+!! defined as this year's net biomass increment per leaf area.\n
+!!
+!! When using growth efficiency mortality, first calculate the net biomass increment for the last year, then 
+!! calculate the growth efficiency and finally calculate the growth efficiency mortality.\n
+!!
+!! Eqation to calculate growth efficiency:
+!! \latexonly 
+!!     \input{gap1.tex}
+!! \endlatexonly
+!! Where $greff$ is growth efficiency, $\Delta$ is net biomass increment, 
+!! $C_{leaf} is last year's leaf biomass, and $SLA$ the specific leaf area. 
+!! 
+!!
+!! Eqation to calculate growth efficiency mortality:
+!! \latexonly 
+!!     \input{gap2.tex}
+!! \endlatexonly
+!! Where $mort_{greff}$ is the growth efficiency mortality, $greff$ is growth  
+!! efficiency, $k_{mort1}$ is asymptotic maximum mortality rate.
+!! 
+!! The name for variable ::availability is not well chosen. Actually the meaning of the variable is mortailty 
+!! rate derived from growth efficiency related mortality. ?? Suggestion: change the name "availability" to 
+!! "mortgref", which means "mortality caused by ".\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::biomass; biomass, ::ind density of individuals, ::bm_to_litter biomass transfer 
+!! to litter and ::mortality mortality (fraction of trees that is dying per time step)
+!!
+!! REFERENCE(S)   :
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!         plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!         global vegetation model, Global Change Biology, 9, 161-185.
+!! - Waring, R. H. (1983). "Estimating forest growth and efficiency in relation 
+!!         to canopy leaf area." Advances in Ecological Research 13: 327-354.
+!!
+!! FLOWCHART    : None
+!!\n
+!_ ================================================================================================================================
+  
+  SUBROUTINE gap (npts, dt, &
+       npp_longterm, turnover_longterm, lm_lastyearmax, &
+       PFTpresent, biomass, ind, bm_to_litter, mortality)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+    INTEGER(i_std), INTENT(in)                              :: npts                    !! Domain size (-)
+    REAL(r_std), INTENT(in)                                 :: dt                      !! Time step (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: npp_longterm            !! "Long term" (default 3-year) net primary
+                                                                                       !! productivity  
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover_longterm       !! "Long term" (default 3-year) turnover  
+                                                                                       !! rate @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: lm_lastyearmax          !! Last year's maximum leaf mass, for each 
+                                                                                       !! PFT @tex $(gC m^{-2})$ @endtex
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                :: PFTpresent              !! Is the pft present in the pixel
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(out)            :: mortality               !! Mortality (fraction of trees that is 
+                                                                                       !! dying per time step)
+
+    !! 0.3 Modified variables   
+    
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)  :: biomass       !! Biomass @tex $(gC m^{-2}) $@endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                   :: ind           !! Number of individuals 
+                                                                                       !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)  :: bm_to_litter  !! Biomass transfer to litter 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex  
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                            :: delta_biomass           !! Net biomass increase for the previous 
+                                                                                       !! year @tex $(gC m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts)                            :: dmortality              !! Dead biomass caused by mortality 
+                                                                                       !! @tex $(gC m^{-2}) $@endtex
+    REAL(r_std), DIMENSION(npts)                            :: vigour                  !! Growth efficiency, an indicator of tree 
+                                                                                       !! vitality, used to calculate mortality
+    REAL(r_std), DIMENSION(npts)                            :: availability            !! Mortality rate derived by growth 
+                                                                                       !! efficiency @tex $(year^{-1})$ @endtex 
+    INTEGER(i_std)                                          :: j,k,m                   !! Indices
+
+!_ ================================================================================================================================
+
+   IF ( firstcall ) THEN
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering gap',lpj_gap_const_mort
+
+    mortality(:,:) = zero
+
+    ! loop over #PFT
+    DO j = 2,nvm
+
+ !! 1. Tree mortality
+
+       IF ( is_tree(j) ) THEN 
+
+          !! 1.1 Use growth efficiency or constant mortality?
+          IF ( .NOT.  lpj_gap_const_mort  ) THEN
+
+             !! 1.1.1 Estimate net biomass increment
+             !        To calculate growth efficiency mortality, first estimate net biomass increment by 
+             !        subtracting turnover from last year's NPP.
+             WHERE ( PFTpresent(:,j) .AND. ( lm_lastyearmax(:,j) .GT. min_stomate ) )
+
+            !??! the following should be removed
+            ! note that npp_longterm is now actually longterm growth efficiency (NPP/LAI)
+            ! to be fair to deciduous trees
+            ! calculate net biomass increment
+             delta_biomass(:) = MAX( npp_longterm(:,j) - ( turnover_longterm(:,j,ileaf,icarbon) + &
+                  turnover_longterm(:,j,iroot,icarbon) + turnover_longterm(:,j,ifruit,icarbon) + & 
+                  turnover_longterm(:,j,isapabove,icarbon) + turnover_longterm(:,j,isapbelow,icarbon) ) ,zero)
+
+            !! 1.1.2 Calculate growth efficiency 
+            !        Calculate growth efficiency by dividing net biomass increment by last year's 
+            !        maximum LAI. (corresponding actually to the maximum LAI of the previous year)
+             vigour(:) = delta_biomass(:) / (lm_lastyearmax(:,j)*sla(j))
+
+             ELSEWHERE
+
+                vigour(:) = zero
+
+             ENDWHERE
+
+             !! 1.1.3 Calculate growth efficiency mortality rate
+             WHERE ( PFTpresent(:,j) )
+                
+                availability(:) = availability_fact / ( un + ref_greff * vigour(:) )
+                ! Scale mortality by timesteps per year
+                mortality(:,j) = MAX(min_avail,availability(:))  * dt/one_year  
+
+             ENDWHERE
+
+          ELSE  ! .NOT. lpj_gap_const_mort
+
+             !! 1.2 Use constant mortality accounting for the residence time of each tree PFT
+             WHERE ( PFTpresent(:,j) )
+
+                mortality(:,j) = dt/(residence_time(j)*one_year)
+
+             ENDWHERE
+
+          ENDIF ! .NOT.  lpj_gap_const_mort
+
+          !! 1.3 Mortality in DGVM
+          !      If the long term NPP is zero, all trees are killed
+          !??! This is this only applied in the DGVM maybe in order to make the DGVM respond faster and thus make the vegetation dynamics more dynamic?
+          !??! the link here with lpj_kill.f90 is still not clear and so would leave to who especially working on this. 
+          IF ( control%ok_dgvm ) THEN
+
+             WHERE ( PFTpresent(:,j) .AND. ( npp_longterm(:,j) .LE. min_stomate ) )
+
+                mortality(:,j) = un
+
+             ENDWHERE
+
+          ENDIF
+
+          !! 1.4 Update biomass and litter pools 
+          !    Update biomass and litter pool after dying and transfer recently died biomass to litter
+          
+          DO m = 1,nelements
+             DO k = 1, nparts
+                
+                WHERE ( PFTpresent(:,j) )
+                   
+                   dmortality(:) =  mortality(:,j) * biomass(:,j,k,m)
+                   bm_to_litter(:,j,k,m) = bm_to_litter(:,j,k,m) + dmortality(:)
+                   biomass(:,j,k,m) = biomass(:,j,k,m) - dmortality(:)
+
+                ENDWHERE
+
+             ENDDO
+          END DO
+
+          !! 1.5 In case of dynamic vegetation, update tree individual density
+          IF ( control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN
+
+             WHERE ( PFTpresent(:,j) )
+
+                ind(:,j) = ind(:,j) * ( un - mortality(:,j) )
+
+             ENDWHERE
+
+          ENDIF
+       ELSE 
+
+ !! 2. Grasses mortality
+
+          ! For grasses, if last year's NPP is very small (less than 10 gCm^{-2}year{-1})
+          ! the grasses completely die
+          IF ( .NOT.control%ok_dgvm .AND. .NOT.lpj_gap_const_mort) THEN
+
+             WHERE ( PFTpresent(:,j) .AND. ( npp_longterm(:,j) .LE. npp_longterm_init ) )
+
+                mortality(:,j) = un
+
+             ENDWHERE
+
+             ! Update biomass and litter pools
+             DO m = 1,nelements
+                DO k = 1, nparts
+
+                   WHERE ( PFTpresent(:,j) )
+                      
+                      dmortality(:) =  mortality(:,j) * biomass(:,j,k,m)
+                      
+                      bm_to_litter(:,j,k,m) = bm_to_litter(:,j,k,m) + dmortality(:)
+                      
+                      biomass(:,j,k,m) = biomass(:,j,k,m) - dmortality(:)
+                      
+                   ENDWHERE
+
+                ENDDO
+             END DO
+             
+          ENDIF
+
+       ENDIF   !IF ( is_tree(j) )
+
+    ENDDO      !loop over pfts
+
+ !! 3. Write to history files
+
+    ! output in fraction of trees that dies/day.
+    mortality(:,:) = mortality(:,:) / dt
+
+    CALL histwrite_p (hist_id_stomate, 'MORTALITY', itime, &
+         mortality, npts*nvm, horipft_index)
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving gap'
+
+  END SUBROUTINE gap
+
+END MODULE lpj_gap
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_kill.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_kill.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_kill.f90	(revision 5166)
@@ -0,0 +1,266 @@
+! =================================================================================================================================
+! MODULE       : lpj_kill
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Kills natural PFTs with low biomass and low number of individuals. 
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE lpj_kill
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC kill
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE  : kill
+!!
+!>\BRIEF       Kills natural pfts that have low biomass or low number of individuals, 
+!! returns biomass to litter pools,  and resets biomass to zero.  
+!!
+!! DESCRIPTION : Kills natural PFTS. The PFT vegetation characteristics are
+!! reinitialized. Kill is either done in DGVM mode or in non-DGVM mode
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): senescence, PFTpresent, cn_ind, ind, RIP_time, age, when_growthinit, 
+!! everywhere,beget, veget_max, npp_longterm, biomass, bm_to_litter, leaf_age, leaf_frac
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE kill (npts, whichroutine, lm_lastyearmax, &
+       ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+       lai, age, leaf_age, leaf_frac, npp_longterm, &
+       when_growthinit, everywhere, veget_max, bm_to_litter)
+
+ !! 0. Variable and parameter description
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size (unitless)
+    CHARACTER(LEN=10), INTENT(in)                             :: whichroutine    !! Message (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lai             !! [DISPENSABLE] leaf area index OF AN INDIVIDUAL PLANT 
+                                                                                 !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lm_lastyearmax  !! Last year's maximum leaf mass, for each PFT 
+                                                                                 !! @tex $(gC.m^{-2})$ @endtex
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: senescence      !! Is the plant senescent? (only for deciduous 
+                                                                                 !! trees - carbohydrate reserve) (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent      !! Is pft there (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: cn_ind          !! Crown area of individuals 
+                                                                                 !! @tex $(m^2)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! Number of individuals 
+                                                                                 !! @tex $(m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: RIP_time        !! How much time ago was the PFT eliminated for
+                                                                                 !! the last time (y)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age             !! Mean age (years)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit !! How many days ago was the beginning of the 
+                                                                                 !! growing season (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! Is the PFT everywhere in the grid box or very
+                                                                                 !! localized (after its introduction)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget_max       !! "Maximal" coverage fraction of a PFT (LAI -> 
+                                                                                 !! infinity) on ground (unitless;0-1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm    !! "Long term" (default = 3-year) net primary 
+                                                                                 !! productivity 
+                                                                                 !! @tex $(gC.m^{-2} year^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age        !! Leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! Fraction of leaves in leaf age class 
+                                                                                 !! (unitless;0-1)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass       !! Biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter  !! Conversion of biomass to litter 
+                                                                                      !! @tex $(gC.m^{-2} day^{-1})$ @endtex
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                            :: j,m             !! Indices       (unitless)
+    LOGICAL, DIMENSION(npts)                                  :: was_killed      !! Bookkeeping   (true/false)
+
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering kill'
+
+ !! 1. Kill PFTs
+
+    ! Kill plants if number of individuals or last year's leaf mass is close to zero.
+    ! the "was_killed" business is necessary for a more efficient code on the VPP processor
+    DO j = 2,nvm ! loop plant functional types
+
+       was_killed(:) = .FALSE.
+
+       IF ( natural(j) ) THEN
+
+          !! 1.1 Kill natural PFTs when DGVM is activated
+          IF ( control%ok_dgvm ) THEN
+             WHERE ( PFTpresent(:,j) .AND. &
+                  ( ( ind(:,j) .LT. min_stomate ) .OR. &
+                  ( lm_lastyearmax(:,j) .LT. min_stomate ) ) )
+             
+                was_killed(:) = .TRUE.
+             
+             ENDWHERE
+          
+          ELSE
+
+             !! 1.2 Kill natural PFTs when running STOMATE without DGVM
+
+             !! 1.2.1 Kill PFTs
+             WHERE ( PFTpresent(:,j) .AND. & 
+                  (biomass(:,j,icarbres,icarbon) .LE.zero .OR. & 
+                  biomass(:,j,iroot,icarbon).LT.-min_stomate .OR. biomass(:,j,ileaf,icarbon).LT.-min_stomate ).AND. & 
+                  ind(:,j).GT. zero)
+
+                was_killed(:) = .TRUE.
+
+             ENDWHERE
+
+             !! 1.2.2 Overwrite long-term NPP for grasses
+             IF(.NOT.is_tree(j).AND..NOT.lpj_gap_const_mort)THEN
+                WHERE ( was_killed(:) )
+
+                   npp_longterm(:,j) = 500.
+
+                ENDWHERE
+             ENDIF
+
+          ENDIF ! control%ok_dgvm
+
+          !! 1.3 Bookkeeping for PFTs that were killed
+          !      For PFTs that were killed, return biomass pools to litter 
+          !      and update biomass pools to zero
+          IF ( ANY( was_killed(:) ) ) THEN
+          
+             DO m = 1,nelements
+
+                WHERE ( was_killed(:) )
+
+                   bm_to_litter(:,j,ileaf,m) = bm_to_litter(:,j,ileaf,m) + biomass(:,j,ileaf,m)
+                   bm_to_litter(:,j,isapabove,m) = bm_to_litter(:,j,isapabove,m) + biomass(:,j,isapabove,m)
+                   bm_to_litter(:,j,isapbelow,m) = bm_to_litter(:,j,isapbelow,m) + biomass(:,j,isapbelow,m)
+                   bm_to_litter(:,j,iheartabove,m) = bm_to_litter(:,j,iheartabove,m) + &
+                                                     biomass(:,j,iheartabove,m)
+                   bm_to_litter(:,j,iheartbelow,m) = bm_to_litter(:,j,iheartbelow,m) + &
+                                                     biomass(:,j,iheartbelow,m)
+                   bm_to_litter(:,j,iroot,m) = bm_to_litter(:,j,iroot,m) + biomass(:,j,iroot,m)
+                   bm_to_litter(:,j,ifruit,m) = bm_to_litter(:,j,ifruit,m) + biomass(:,j,ifruit,m)
+                   bm_to_litter(:,j,icarbres,m) = bm_to_litter(:,j,icarbres,m) + biomass(:,j,icarbres,m)
+                   
+                   biomass(:,j,ileaf,m) = zero
+                   biomass(:,j,isapabove,m) = zero
+                   biomass(:,j,isapbelow,m) = zero
+                   biomass(:,j,iheartabove,m) = zero
+                   biomass(:,j,iheartbelow,m) = zero
+                   biomass(:,j,iroot,m) = zero
+                   biomass(:,j,ifruit,m) = zero
+                   biomass(:,j,icarbres,m) = zero
+
+                ENDWHERE   ! was_killed
+
+             END DO
+
+            !! 1.4 Update veget_max in DGVM
+            !      Update veget_max in DGVM for killed PFTs and reset RIP_time
+            IF (control%ok_dgvm) THEN
+
+                WHERE ( was_killed(:) )
+                   PFTpresent(:,j) = .FALSE.
+
+                   veget_max(:,j) = zero
+                   
+                   RIP_time(:,j) = zero
+
+                ENDWHERE  ! was_killed
+
+            ENDIF ! control%ok_dgvm
+
+            !! 1.5 Reinitialize vegetation characteristics in DGVM and STOMATE
+            !      Reinitialize number of individuals, crown area and age
+            WHERE ( was_killed(:) )
+
+                ind(:,j) = zero
+
+                cn_ind(:,j) = zero
+
+                senescence(:,j) = .FALSE.
+
+                age(:,j) = zero
+
+                ! SZ: why undef ??? this causes a delay in reestablishment
+                !when_growthinit(:,j) = undef
+                when_growthinit(:,j) = large_value 
+
+                everywhere(:,j) = zero
+
+!                veget(:,j) = zero
+!MM Ã  imposer ?!
+!                lai(:,j) = zero
+
+             ENDWHERE   ! was_killed
+
+             !! 1.6 Update leaf ages
+             DO m = 1, nleafages
+
+                WHERE ( was_killed(:) )
+
+                   leaf_age(:,j,m) = zero 
+                   leaf_frac(:,j,m) = zero 
+
+                ENDWHERE ! was_killed
+
+             ENDDO
+
+             !! 1.7 Print sub routine messages
+             IF ( bavard .GE. 2 ) THEN
+
+                WRITE(numout,*) 'kill: eliminated ',PFT_name(j)
+                WRITE(numout,*) '  at ',COUNT( was_killed(:) ),' points after '//whichroutine
+
+             ENDIF
+
+          ENDIF     ! PFT must be killed at at least one place
+
+       ENDIF       ! PFT is natural
+
+    ENDDO         ! loop over PFTs
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving kill'
+
+  END SUBROUTINE kill
+
+END MODULE lpj_kill
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_light.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_light.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_light.f90	(revision 5166)
@@ -0,0 +1,634 @@
+! =================================================================================================================================
+! MODULE       : lpj_light
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Light competition within a PFT
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE lpj_light
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE constantes
+  USE stomate_data
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC light, light_clear
+
+  LOGICAL, SAVE                                            :: firstcall = .TRUE.             !! first call
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : light_clear
+!!
+!>\BRIEF          Activation
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE light_clear
+    firstcall=.TRUE.
+  END SUBROUTINE light_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: light
+!!
+!>\BRIEF         Light competition within a PFT
+!!
+!! DESCRIPTION  : This module kills PFTs based on light competition
+!! 
+!! Here, fpc ("foilage projected cover") takes into account the minimum fraction
+!! of space covered by trees through branches etc. This is done to prevent strong relative
+!! changes of FPC from one day to another for deciduous trees at the beginning of their
+!! growing season, which would yield too strong cutbacks.\n
+!!
+!! fpc is now always calculated from lm_lastyearmax*sla, since the aim of this DGVM is 
+!! to represent community ecology effects; seasonal variations in establishment related to phenology
+!! may be relevant, but beyond the scope of a 1st generation DGVM.\n
+!!
+!! If agriculture is present, fpc can never reach 1.0 since natural veget_max < 1.0. To
+!! correct for this, ::ind must be recalculated to correspond to the natural density.
+!! since ::ind is expressed in m^{-2} grid cell, this can be achieved by dividing individual 
+!! density by the agricultural fraction.\n
+!!
+!! The flow in the routine is different for ::control%ok_dgvm. When ::control%ok_dgvm is true
+!! the following processes are considered:
+!!
+!! No competition between woody pfts (height of individuals is not considered).
+!! Exception: when one woody pft is overwhelming (i.e. fpc > fpc_crit). In that
+!! case, eliminate all other woody pfts and reduce dominant pft to fpc_crit.
+!! Age of individuals is not considered. In reality, light competition would more
+!! easily kill young individuals, thus increasing the mean age of the stand.
+!! Exclude agricultural pfts from competition.\n
+!!
+!! When ::control%ok_dgvm is false then light competition is calculated for the static case if the mortality is not 
+!! assumed to be constant. The following processes are considered: XXX
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ind, biomass, veget_lastlight, bm_to_litter, mortality
+!!
+!! REFERENCES   : 
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!! plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!! global vegetation model, Global Change Biology, 9, 161-185.\n
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE light (npts, dt, &
+       veget_max, fpc_max, PFTpresent, cn_ind, lai, maxfpc_lastyear, &
+       lm_lastyearmax, ind, biomass, veget_lastlight, bm_to_litter, mortality)
+
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                             :: npts                     !! Domain size (unitless)      
+    REAL(r_std), INTENT(in)                                :: dt                       !! Time step (days)      
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)               :: PFTpresent               !! TRUE if pft is present (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: cn_ind                   !! Crown area of individuals 
+                                                                                       !! @tex $(m^2)$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: lai                      !! Leaf area index OF AN INDIVIDUAL PLANT 
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: maxfpc_lastyear          !! Last year's maximum fpc for each natural 
+                                                                                       !! PFT(unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: lm_lastyearmax           !! Last year's maximum leafmass for each 
+                                                                                       !! natural PFT 
+                                                                                       !! @tex $(gC m^2 s^{-1})$ @endtex   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget_max                !! Last year's maximum fpc for each natural 
+                                                                                       !! PFT (unitless;0-1)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: fpc_max                  !! Last year's maximum fpc for each natural 
+                                                                                       !! PFT (unitless)    
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: ind                      !! Number of individuals 
+                                                                                       !! @tex $(m^{-2})$ @endtex    
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! Biomass @tex $(gCm^{-2})$ @endtex    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: veget_lastlight          !! Vegetation cover after last light 
+                                                                                       !! competition (unitless;0-1)     
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter   !! Biomass transfer to litter per timestep
+                                                                                       !! @tex $(gCm^{-2})$ @endtex    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: mortality                !! Fraction of individuals that died this 
+                                                                                       !! time step per dt (unitless;0-1)   
+
+    !! 0.4 Local variables
+
+    LOGICAL, PARAMETER                                     :: annual_increase = .TRUE. !! For diagnosis of fpc increase, compare 
+                                                                                       !! today's fpc to last year's  Maximum (T)
+                                                                                       !! or to fpc of last time step (F) 
+    INTEGER(i_std)                                         :: i,j,k,m                  !! Index (unitless)    
+    REAL(r_std), DIMENSION(npts)                           :: sumfpc                   !! Total natural fpc, sum of all the PFTs
+                                                                                       !! (unitless)   
+    REAL(r_std), DIMENSION(npts)                           :: fracnat                  !! Fraction of natural vegetation within a 
+                                                                                       !! grid cell (unitless;0-1)   
+    REAL(r_std)                                            :: sumfpc_wood              !! Total natural woody fpc (unitless)   
+    REAL(r_std)                                            :: sumdelta_fpc_wood        !! Change in total woody fpc (unitless)   
+    REAL(r_std)                                            :: maxfpc_wood              !! Maximum wood fpc (unitless)   
+    INTEGER(i_std)                                         :: optpft_wood              !! Which woody pft is maximum (unitless)   
+    REAL(r_std)                                            :: sumfpc_grass             !! Total natural grass fpc (unitless)   
+    REAL(r_std), DIMENSION(npts,nvm)                       :: fpc_nat                  !! This year's foliage projected cover on 
+                                                                                       !! natural part of the grid cell 
+                                                                                       !! @tex $(m^2)$ @endtex
+    REAL(r_std), DIMENSION(nvm)                            :: deltafpc                 !! fpc change within last year (unitless)    
+    REAL(r_std)                                            :: reduct                   !! Relative change of number of individuals
+                                                                                       !! for trees (ind)    
+    REAL(r_std), DIMENSION(nvm)                            :: survive                  !! Fraction of plants that survive 
+                                                                                       !! (unitless;0-1)     
+    REAL(r_std), DIMENSION(npts)                           :: fpc_real                 !! FPC for static mode (unitless)     
+    REAL(r_std), DIMENSION(npts)                           :: lai_ind                  !! FPC mortality for static mode     
+    REAL(r_std)                                            :: sumfpc_grass2            !! New total grass fpc     
+    REAL(r_std), DIMENSION(npts,nvm)                       :: light_death              !! Fraction of plants that dies each day 
+                                                                                       !! @tex $(day^{-1})$ @endtex     
+    REAL(r_std)                                            :: fpc_dec                  !! Relative change of number of individuals 
+                                                                                       !! for trees
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering light'
+
+    
+ !! 1. Write diagnostics to out_orchidee files
+  
+    IF ( firstcall ) THEN
+
+       WRITE(numout,*) 'light:'
+
+       WRITE(numout,*) '   > For trees, minimum fraction of crown area covered'
+       WRITE(numout,*) '       (due to its branches etc.)', min_cover
+
+       WRITE(numout,*) '   > for diagnosis of fpc increase, compare today''s fpc'
+       IF ( annual_increase ) THEN
+          WRITE(numout,*) '     to last year''s maximum.'
+       ELSE
+          WRITE(numout,*) '     to fpc of the last time step.'
+       ENDIF
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+!! 2. Light competition in DGVM
+
+    IF (control%ok_dgvm) THEN
+             
+       !! 2.1 Calculate natural part of the grid cell
+       fracnat(:) = un
+       DO j = 2,nvm
+          IF ( .NOT. natural(j) ) THEN
+             fracnat(:) = fracnat(:) - veget_max(:,j)
+          ENDIF
+       ENDDO
+       
+       !! 2.2 Calculate fpc on natural part of grid cell
+       fpc_nat(:,:) = zero
+       fpc_nat(:,ibare_sechiba) = un
+
+       DO j = 2, nvm ! loop over #PFTs
+
+
+          !! 2.2.1 Natural PFTs
+          IF ( natural(j) ) THEN
+   
+             !!?? it seems that the treatment below for trees and grasses are the same? so there is no necessity to use IF...ELSE...ENDIF structure?
+	     !!?? CODE SHOULD BE CLEANED UP BELOW
+
+             !! 2.2.1.1 Trees
+             IF ( is_tree(j) ) THEN
+
+                ! !! 2.1.1.1 trees: minimum cover due to stems, branches etc.
+                !          DO i = 1, npts
+                !             IF (lai(i,j) == val_exp) THEN
+                !                fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
+                !             ELSE
+                !                fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
+                !                     MAX( ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
+                !             ENDIF
+                !          ENDDO
+                !NV : modif from SZ version : fpc is based on veget_max, not veget.
+
+                WHERE(fracnat(:).GE.min_stomate)
+
+                   !            WHERE(LAI(:,j) == val_exp)
+                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                   !            ELSEWHERE
+                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * &
+                   !                    MAX( ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) ), min_cover )
+                   !            ENDWHERE
+
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                ENDWHERE
+
+             ELSE
+
+                !NV : modif from SZ version : fpc is based on veget_max, not veget.
+		!!?? DO GRASSES HAVE CROWNS?
+                
+                !! 2.2.1.1 Grasses
+                WHERE(fracnat(:).GE.min_stomate)
+
+                   !            WHERE(LAI(:,j) == val_exp)
+                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                   !            ELSEWHERE
+                   !               fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:) * &
+                   !                    ( 1._r_std - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
+                   !            ENDWHERE
+
+                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) / fracnat(:)
+                ENDWHERE
+
+!!!$                ! 2.1.1.2 bare ground 
+!!!$                IF (j == ibare_sechiba) THEN
+!!!$                   fpc_nat(:,j) = cn_ind(:,j) * ind(:,j) 
+!!!$
+!!!$                   ! 2.1.1.3 grasses
+!!!$                ELSE
+!!!$                   DO i = 1, npts
+!!!$                      IF (lai(i,j) == val_exp) THEN
+!!!$                         fpc_nat(i,j) = cn_ind(i,j) * ind(i,j)
+!!!$                      ELSE
+!!!$                         fpc_nat(i,j) = cn_ind(i,j) * ind(i,j) * &
+!!!$                              ( 1._r_std - exp( -lai(i,j) * ext_coeff(j) ) )
+!!!$                      ENDIF
+!!!$                   ENDDO
+!!!$                ENDIF
+
+             ENDIF  ! tree/grass
+
+          ELSE
+
+             !! 2.2.2 Agricultural PFTs
+             !        Agriculural PFTs are not present on natural part
+             fpc_nat(:,j) = zero
+
+          ENDIF    ! natural/agricultural
+
+       ENDDO
+
+       
+       !! 2.3 Total fpc for grid point
+       sumfpc(:) = zero
+       DO j = 2,nvm
+
+          !SZ bug correction MERGE: need to subtract agricultural area!
+          sumfpc(:) = sumfpc(:) + fpc_nat(:,j)
+       ENDDO
+
+       
+       !! 2.4 Light competition
+
+       light_death(:,:) = zero
+
+       DO i = 1, npts ! SZ why this loop and not a vector statement ?
+
+          !! 2.4.1 Dense canopy 
+          IF ( sumfpc(i) .GT. fpc_crit ) THEN
+
+             ! 2.4.1.1 fpc change for each pft
+             ! There are two possibilities: either we compare today's fpc with the fpc after the last
+             ! time step, or we compare it to last year's maximum fpc of that PFT. In the first case,
+             ! the fpc increase will be strong for seasonal PFTs at the beginning of the growing season.
+             ! As for trees, the cutback is proportional to this increase, this means that seasonal trees
+             ! will be disadvantaged compared to evergreen trees. In the original LPJ model, with its 
+             ! annual time step, the second method was used (this corresponds to annual_increase=.TRUE.)
+
+             IF ( annual_increase ) THEN
+                deltafpc(:) = MAX( (fpc_nat(i,:)-maxfpc_lastyear(i,:)),  zero )
+             ELSE
+                deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)),  zero )
+             ENDIF
+
+             !! 2.4.1.2 Default survival
+             survive(:) = un
+
+             
+             !! 2.4.1.3 Determine some characteristics of the fpc distribution
+             sumfpc_wood = zero
+             sumdelta_fpc_wood = zero
+             maxfpc_wood = zero
+             optpft_wood = 0
+             sumfpc_grass = zero
+
+             DO j = 2,nvm ! loop over #PFTs
+
+                !! 2.4.1.3.1 Natural pfts
+                IF ( natural(j) ) THEN
+
+                   !! 2.4.1.3.1.1 Trees
+                   IF ( is_tree(j) ) THEN
+
+                      ! total woody fpc
+                      sumfpc_wood = sumfpc_wood + fpc_nat(i,j)
+
+                      ! how much did the woody fpc increase
+                      sumdelta_fpc_wood = sumdelta_fpc_wood + deltafpc(j)
+
+                      ! which woody pft is preponderant
+                      IF ( fpc_nat(i,j) .GT. maxfpc_wood ) THEN
+
+                         optpft_wood = j
+
+                         maxfpc_wood = fpc_nat(i,j)
+
+                      ENDIF
+
+                   ELSE
+
+                      !! 2.4.1.3.1.2 Grasses
+                      ! total (natural) grass fpc
+                      sumfpc_grass = sumfpc_grass + fpc_nat(i,j)
+
+                   ENDIF   ! tree or grass
+
+                ENDIF   ! natural
+
+             ENDDO  ! loop over pfts
+
+             !! 2.4.1.4 Wood outcompetes grass
+             !          Light competition where wood outcompetes grasses
+             
+             !SZ             IF (sumfpc_wood .GE. fpc_crit ) THEN
+             !
+             !! 3.2.1 all allowed natural space is covered by wood:
+             !!       cut back trees to fpc_crit.
+             !!       Original DGVM: kill grasses. Modified: we let a very
+             !!       small fraction of grasses survive.
+             !
+
+             DO j = 2,nvm ! Loop over #PFTs
+
+                ! only present and natural pfts compete
+                IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
+
+                   !! 2.4.1.4.1 Trees
+                   IF ( is_tree(j) ) THEN
+
+                      ! no single woody pft is overwhelming
+                      ! (original DGVM: tree_mercy = 0.0 )
+                      ! The reduction rate is proportional to the ratio deltafpc/fpc.
+                      IF (sumfpc_wood .GE. fpc_crit .AND. fpc_nat(i,j) .GT. min_stomate .AND. & 
+                           sumdelta_fpc_wood .GT. min_stomate) THEN
+
+                         ! reduct = MIN( ( ( deltafpc(j)/sumdelta_fpc_wood * &
+                         !     (sumfpc_wood-fpc_crit) ) / fpc_nat(i,j) ), &
+                         !     ( 1._r_std - 0.01 ) ) ! (0.01 = tree_mercy previously)
+
+                         !!? difficult to fully understand but doesn't look so simple
+                         reduct = un - MIN((fpc_nat(i,j)-(sumfpc_wood-fpc_crit) & 
+                              * deltafpc(j)/sumdelta_fpc_wood)/fpc_nat(i,j), un )
+
+                      ELSE
+
+                         ! tree fpc didn't icrease or it started from nothing
+                         reduct = zero
+
+                      ENDIF
+                   ELSE
+
+                      !! 2.4.1.4.2 Grasses 
+                      !            Let a very small fraction survive (the sum of all
+                      !            grass individuals may make up a maximum cover of
+                      !            grass_mercy [for lai -> infinity]).
+                      !            In the original DGVM, grasses were killed in that case,
+                      !            corresponding to grass_mercy = 0.
+                      !
+
+                      IF(sumfpc_grass .GE. un-MIN(fpc_crit,sumfpc_wood).AND. & 
+                           sumfpc_grass.GE.min_stomate) THEN
+
+                         fpc_dec = (sumfpc_grass - un + MIN(fpc_crit,sumfpc_wood))*fpc_nat(i,j)/sumfpc_grass
+
+                         reduct = fpc_dec
+                      ELSE 
+                         reduct = zero
+                      ENDIF
+                   ENDIF   ! tree or grass
+
+                   survive(j) = un - reduct
+                ENDIF     ! pft there and natural
+
+             ENDDO       ! loop over pfts
+
+             !SZ
+!!!$          ELSE
+!!!$
+!!!$             !
+!!!$             ! 3.2.2 not too much wood so that grasses can subsist
+!!!$             !
+!!!$
+!!!$             ! new total grass fpc
+!!!$             sumfpc_grass2 = fpc_crit - sumfpc_wood
+!!!$
+!!!$             DO j = 2,nvm
+!!!$
+!!!$                ! only present and natural PFTs compete
+!!!$
+!!!$                IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
+!!!$
+!!!$                   IF ( is_tree(j) ) THEN
+!!!$
+!!!$                      ! no change for trees
+!!!$
+!!!$                      survive(j) = 1.0
+!!!$
+!!!$                   ELSE
+!!!$
+!!!$                      ! grass: fractional loss is the same for all grasses
+!!!$
+!!!$                      IF ( sumfpc_grass .GT. min_stomate ) THEN
+!!!$                         survive(j) = sumfpc_grass2 / sumfpc_grass
+!!!$                      ELSE
+!!!$                         survive(j)=  zero
+!!!$                      ENDIF
+!!!$
+!!!$                   ENDIF
+!!!$
+!!!$                ENDIF    ! pft there and natural
+!!!$
+!!!$             ENDDO       ! loop over pfts
+!!!$
+!!!$          ENDIF    ! sumfpc_wood > fpc_crit
+
+             
+             !! 2.4.1.5 Update biomass and litter pools
+             
+             DO j = 2,nvm ! Loop over #PFTs
+
+                ! Natural PFTs
+                IF ( PFTpresent(i,j) .AND. natural(j) ) THEN
+
+                   bm_to_litter(i,j,:,:) = bm_to_litter(i,j,:,:) + &
+                        biomass(i,j,:,:) * ( un - survive(j) )
+
+                   biomass(i,j,:,:) = biomass(i,j,:,:) * survive(j)
+
+                   !? We are in a section where ok_dgvm is already at TRUE: No need to test it again
+                   IF ( control%ok_dgvm ) THEN
+                      ind(i,j) = ind(i,j) * survive(j)
+                   ENDIF
+
+                   ! fraction of plants that dies each day. 
+                   ! exact formulation: light_death(i,j) = un - survive(j) / dt
+                   light_death(i,j) = ( un - survive(j) ) / dt
+
+                ENDIF      ! pft there and natural
+
+             ENDDO        ! loop over pfts
+
+          ENDIF      ! sumfpc > fpc_crit
+
+       ENDDO        ! loop over grid points
+
+       
+       !! 2.5 Recalculate fpc for natural PFTs
+       !      Recalculate fpc on natural part of the grid cell for next light competition
+       DO j = 2,nvm ! loop over #PFT
+
+          !! 2.5.1 Natural PFTs
+          IF ( natural(j) ) THEN
+ 
+             !! 2.5.1.1 Trees
+             IF ( is_tree(j) ) THEN
+
+                DO i = 1, npts
+
+                   !NVMODIF         
+                   !    IF (lai(i,j) == val_exp) THEN
+                   !                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+                   !             ELSE
+                   !                veget_lastlight(i,j) = &
+                   !                     cn_ind(i,j) * ind(i,j) * &
+                   !                     MAX( ( un - exp( -lai(i,j) * ext_coeff(j) ) ), min_cover )
+                   !             ENDIF
+                   !!                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j)
+ 
+                   IF (lai(i,j) == val_exp) THEN
+                      veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+                   ELSE
+                      veget_lastlight(i,j) = &
+                           cn_ind(i,j) * ind(i,j) * &
+                           MAX( ( un - EXP( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) ), min_cover )
+                   ENDIF
+                ENDDO
+
+             ELSE
+
+                !! 2.5.1.2 Grasses
+                DO i = 1, npts
+
+                   !NVMODIF         
+                   !            IF (lai(i,j) == val_exp) THEN
+                   !                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+                   !             ELSE
+                   !                veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
+                   !                     ( un - exp( -lai(i,j) * ext_coeff(j) ) )
+                   !             ENDIF
+                   !!veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+
+                   IF (lai(i,j) == val_exp) THEN
+                      veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) 
+                   ELSE
+                      veget_lastlight(i,j) = cn_ind(i,j) * ind(i,j) * &
+                           ( un - exp( - lm_lastyearmax(i,j) * sla(j) * ext_coeff(j) ) )
+                   ENDIF
+                ENDDO
+             ENDIF    ! tree/grass
+
+          ELSE
+
+             !! 2.5.2 Agricultural PFTs
+             !        Agricultural PFTs are not present on the natural part of the grid point
+             veget_lastlight(:,j) = zero
+
+          ENDIF  ! natural/agricultural
+
+       ENDDO ! # PFTs
+
+    ELSE ! control%ok_dgvm
+
+ !! 3. Light competition in stomate (without DGVM)
+
+       light_death(:,:) = zero
+
+       DO j = 2, nvm 
+
+          IF ( natural(j) ) THEN
+
+	     !! NUMBERING BELOW SHOULD BE 5.0 or 4.3
+             !! 2.1.1 natural PFTs, in the one PFT only case there needs to be no special case for grasses,
+             !! neither a redistribution of mortality (delta fpc)
+             
+             !! 3.1 XXX
+             WHERE( ind(:,j)*cn_ind(:,j) .GT. min_stomate ) 
+                lai_ind(:) = sla(j) * lm_lastyearmax(:,j) / ( ind(:,j) * cn_ind(:,j) )
+             ELSEWHERE
+                lai_ind(:) = zero
+             ENDWHERE
+
+             fpc_nat(:,j) =  cn_ind(:,j) * ind(:,j) * & 
+                  MAX( ( un - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
+
+             WHERE(fpc_nat(:,j).GT.fpc_max(:,j))
+
+                light_death(:,j) = MIN(un, un - fpc_max(:,j)/fpc_nat(:,j)) 
+
+             ENDWHERE
+
+             !! 3.2 Update biomass and litter pools
+             DO m = 1,nelements
+                DO k=1,nparts
+                   
+                   bm_to_litter(:,j,k,m) = bm_to_litter(:,j,k,m) + light_death(:,j)*biomass(:,j,k,m)
+                   biomass(:,j,k,m) = biomass(:,j,k,m) - light_death(:,j)*biomass(:,j,k,m)
+                   
+                ENDDO
+             END DO
+
+             !! 3.3 Update number of individuals
+             ind(:,j) = ind(:,j)-light_death(:,j)*ind(:,j)
+
+          ENDIF
+       ENDDO
+
+       light_death(:,:) = light_death(:,:)/dt
+
+    ENDIF ! control%ok_dgvm
+
+   
+ !! 4. Write history files
+
+    CALL histwrite_p (hist_id_stomate, 'LIGHT_DEATH', itime, &
+         light_death, npts*nvm, horipft_index)
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving light'
+
+  END SUBROUTINE light
+
+END MODULE lpj_light
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_pftinout.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_pftinout.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/lpj_pftinout.f90	(revision 5166)
@@ -0,0 +1,483 @@
+! =================================================================================================================================
+! MODULE       : lpj_pftinout
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Introduce and eliminate PFT's from pixel
+!!
+!! \n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S) : None 
+!!
+!! REFERENCE(S) :
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!        plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!        global vegetation model, Global Change Biology, 9, 161-185.\n
+!! - Thonicke, K., S. Venevsky, et al. (2001), The role of fire disturbance 
+!!        for global vegetation dynamics: coupling fire into a Dynamic Global
+!!        Vegetation Model, Global Ecology and Biogeography, 10, 661-677.\n
+!! - Haxeltine, A. and I. C. Prentice (1996), BIOME3: An equilibrium
+!!        terrestrial biosphere model based on ecophysiological constraints, 
+!!        resource availability, and competition among plant functional types,
+!!        Global Biogeochemical Cycles, 10(4), 693-709.\n
+!! - Smith, B., I. C. Prentice, et al. (2001), Representation of vegetation
+!!        dynamics in the modelling of terrestrial ecosystems: comparing two
+!!        contrasting approaches within European climate space,
+!!        Global Ecology and Biogeography, 10, 621-637.\n
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ==============================================================================================================================
+
+MODULE lpj_pftinout
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC pftinout,pftinout_clear
+
+  LOGICAL, SAVE                       :: firstcall = .TRUE.                !! first call
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE  : pftinout_clear
+!!
+!>\BRIEF       Set flag ::firstcall to true and initialize the variables
+!_ ================================================================================================================================
+
+  SUBROUTINE pftinout_clear
+    firstcall = .TRUE.
+  END SUBROUTINE pftinout_clear
+
+!! ================================================================================================================================ 
+!! SUBROUTINE  : pftinout
+!! 
+!>\BRIEF       Introduce and eliminate PFT's from pixel
+!!
+!! DESCRIPTION**3 : Introduction and elimination of PFTs on the basis of climate condition.
+!! For natural and woody PFTs the foliage projected coverage is calculated as follows:
+!! \latexonly
+!!  \input{equation_lpj_pftinout.tex}
+!! \endlatexonly
+!! \n
+!! where FPC is foliage projective cover (::fpc_nat), CN crown area (::cn_ind, 
+!! @tex $ m^{2} $ @endtex), IND number of individuals (::ind, @tex $ m^{-2} $ @endtex,
+!! FRAC total fraction occupied by natural vegetation (::fracnat),
+!! @tex $ LM_{rm max} $ @endtex maximum leaf mass in last year
+!! (::lm_lastyearmax, @tex $ g C m^{-2} $ @endtex), SLA specific leaf area (sla,
+!! @tex $ m^{2} (g C)^{-1} $ @endtex), and coff coefficient (::ext_coeff). ::ext_coeff 
+!! describes a property of the canopy (i.e. law of Lambert-Beer) and is defined in **2
+!!
+!! The foliage projective cover feeds into the calculation of the space available for 
+!! expansion of existing and dispersion of new PFTs within a gridbox. In turn, available
+!! space is use to calculate the number of individuals with a PFT. 
+!!
+!! Saplings are introduced under the condition that winter temperature is 
+!! moderate, plant age is older than 1.25, (and for some PFTs at least one adjacent grid 
+!! box exists for expansion), new saplings are introduced for narural PFT. In the simulation of 
+!! agricultural grassland, if target PFT does not exist in the gridbox, it is introduced 
+!! regardless of climate condition. When a new PFT is introduced CO_2 is taken from the
+!! atmosphere to account for CO_2 present in the seed and required by the germinated seeds
+!! to establish a sapling. These initial phases in ontology are not accounted for. However,
+!! by taking this small amount of CO2 from the atmosphere, mass balance closure for C is
+!! preserved. 
+!!
+!! PFTs are eliminated under the condition that they are no longer adapted to the critical 
+!! temperatures in winter. When a PFT is eliminated its number of indiviuals is set to zero and
+!! the rest of the elimination process is taken care of in lpj_kill.f90.
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: avail_tree (space availability for trees, unitless),   
+!! :: avail_grass (space availability for grasses, unitless), :: biomass (biomass, \f$gC m^{-2}\f$) 
+!! and :: ind (density of individuals, \f$m^{-2}\f$)    
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    :
+!! \latexonly
+!!   \includegraphics[scale = 0.6]{pftinout.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+
+
+
+
+
+  SUBROUTINE pftinout (npts, dt, adapted, regenerate, &
+       neighbours, veget_max, &
+       biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, &
+       PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, &
+       co2_to_bm, &
+       avail_tree, avail_grass)
+    
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size - number of pixels (unitless)            
+    REAL(r_std), INTENT(in)                                   :: dt              !! Time step of vegetation dynamics for stomate
+                                                                                 !! (days)               
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: adapted         !! Winter not too cold (unitless)   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: regenerate      !! Winter sufficiently cold (unitless)  
+    INTEGER(i_std), DIMENSION(npts,8), INTENT(in)             :: neighbours      !! Indices of the 8 neighbours of each grid point
+                                                                                 !! (unitless); 1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 
+                                                                                 !! 7=W, 8=NW       
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget_max       !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                                 !! infinity) on ground (unitless)        
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: avail_tree      !! Space availability for trees (unitless)   
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: avail_grass     !! Space availability for grasses (unitless)      
+
+
+    !! 0.3 Modified variables   
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass  !! Biomass (gC m^{-2})      
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! Density of individuals (m^{-2})
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: cn_ind          !! Crown area of individuals (m^2)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age             !! Mean age (years)            
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! Fraction of leaves in leaf age class (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm    !! "long term" net primary productivity 
+                                                                                 !! (gC m^{-2} year^{-1})   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: lm_lastyearmax  !! Last year's maximum leaf mass, for each PFT 
+                                                                                 !! (gC m^{-2})  
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: senescence      !! Plant senescent for deciduous trees; .FALSE. 
+                                                                                 !! if PFT is introduced or killed      
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent      !! PFT exists    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! is the PFT everywhere in the grid box or very 
+                                                                                 !! localized (unitless)  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit !! how many days ago was the beginning of the 
+                                                                                 !! growing season (days) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: need_adjacent   !! in order for this PFT to be introduced, does it
+                                                                                 !! have to be present in an adjacent grid box?   
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: RIP_time        !! How much time ago was the PFT eliminated for 
+                                                                                 !! the last time (years)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm       !! biomass uptaken (gC m^{-2} day^{-1})        
+ 
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                              :: avail           !! availability           
+    INTEGER(i_std)                                            :: i,j,m           !! indices      
+    REAL(r_std), DIMENSION(npts)                              :: sumfrac_wood    !! total woody vegetation cover     
+    INTEGER(i_std), DIMENSION(npts)                           :: n_present       !! number of adjacent grid cells where PFT is 
+                                                                                 !! ubiquitous        
+    LOGICAL, DIMENSION(npts)                                  :: can_introduce   !! we can introduce this PFT    
+    REAL(r_std), DIMENSION(npts)                              :: fracnat         !! no real need for dimension(ntps) except for 
+                                                                                 !! vectorisation          
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering pftinout'
+
+  !! 1. Messages    
+
+    IF ( firstcall ) THEN
+
+       WRITE(numout,*) 'pftinout: Minimum space availability: ', min_avail
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+  !! 2. Total woody fpc and space avaibility on grid
+
+    ! Only natural part of the grid cell\n
+    ! SZ bug correction MERGE: need to subtract agricultural area!
+    ! fraction of agricultural surface
+
+    !! 2.1 only natural PFT
+    fracnat(:) = un
+    DO j = 2,nvm ! Loop over # PFTs
+       IF ( .NOT. natural(j) ) THEN
+          fracnat(:) = fracnat(:) - veget_max(:,j)
+       ENDIF
+    ENDDO ! Loop over # PFTs
+
+    !! 2.2 Total woody fractional plant cover
+    sumfrac_wood(:) = zero
+    DO j = 2,nvm ! Loop over # PFTs
+       
+       ! SZ problem here: agriculture, not convinced that this representation of LPJ is correct
+       ! if agriculture is present, ind must be recalculated to correspond to the natural density...
+       ! since ind is per grid cell, can be achived by discounting for agricultura fraction
+       IF ( natural(j).AND.is_tree(j) ) THEN
+          WHERE(fracnat(:).GT.min_stomate) 
+                sumfrac_wood(:) = sumfrac_wood(:) + cn_ind(:,j) * ind(:,j) / fracnat(:) & 
+                     * ( un - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
+                !lai changed to lm_last
+          ENDWHERE
+       ENDIF
+    ENDDO ! Loop over # PFTs
+
+    !! 2.3 Space availability
+    avail_grass(:) = MAX( ( un - sumfrac_wood(:) ), min_avail )
+    avail_tree(:) = MAX( ( fpc_crit - sumfrac_wood(:) ), min_avail )
+
+  !! 3. Time since last elimination (y)
+
+    RIP_time = RIP_time + dt / one_year
+
+  !! 4. Agicultural PFTs
+
+    ! Agricultural PFTs are only present if they are prescribed
+    DO j = 2,nvm ! Loop over # PFTs
+       
+       IF ( .NOT. natural(j) ) THEN
+          
+          IF (bavard.GE.4) WRITE(numout,*) 'pftinout: Agricultural PFTs'
+          
+          !! 4.1 Agricultural trees
+          !      Agricultural trees are not treated for the moment
+          IF ( is_tree(j) ) THEN
+
+             WRITE(numout,*) 'pftinout: Agricultural trees not treated. We stop.'
+             STOP
+
+          !! 4.2 Initialization of agricultural grass lands
+          !      Initialize parameter values of prescribed agricultural PFTs
+          ELSE
+
+             DO i = 1, npts ! Loop over # pixels - domain size
+
+                IF ( ( veget_max(i,j) .GT. zero ) .AND. ( .NOT. PFTpresent(i,j) ) ) THEN
+
+                   ! prescribed, but not yet there.
+                   ind(i,j) = veget_max(i,j)
+                   biomass(i,j,:,:) = bm_sapl(j,:,:) * ind(i,j) /veget_max(i,j) 
+                   co2_to_bm(i,j) =  co2_to_bm(i,j) +SUM( biomass(i,j,:,icarbon) ) / dt
+                   PFTpresent(i,j) = .TRUE.
+                   everywhere(i,j) = un
+                   senescence(i,j) = .FALSE.
+                   age(i,j) = zero
+
+                ENDIF  ! prescribed, but PFT not yet present
+
+             ENDDO ! Loop over # pixels - domain size
+
+          ENDIF
+
+       ENDIF ! not natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 5 Eliminate PFTs
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       ! only for natural PFTs
+       IF ( natural(j) ) THEN
+
+          ! Number of individuals are set to zero in the condition of cold winter   
+          ! 'adapted_crit' critical value for being adapted = 1.-(1./euler); see 'stomate_constants.f90'
+          WHERE (  PFTpresent(:,j) .AND. ( adapted(:,j) .LT. adapted_crit ) )
+
+             ! PFT there, but not adapted any more (ex: winter too cold): kill
+             ! set number of individuals to zero - rest will be done in lpj_kill
+             ind(:,j) = zero
+
+          ENDWHERE
+
+       ENDIF ! natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 6. Introduce PFTs
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN
+
+          ! space availability for this PFT
+          IF ( is_tree(j) ) THEN
+             avail(:) = avail_tree(:)
+          ELSE
+             avail(:) = avail_grass(:)
+          ENDIF
+          
+          !! 6.1 Check if PFT not present but (adapted and regenerative)     
+          can_introduce(:) = .FALSE.
+          
+          DO i = 1, npts ! Loop over # pixels - domain size
+
+             IF ( .NOT. PFTpresent(i,j) .AND. &
+                  ( adapted(i,j) .GT. adapted_crit ) .AND. &
+                  ( regenerate(i,j) .GT. regenerate_crit )  ) THEN
+
+                ! Seed are available nearby
+                IF ( need_adjacent(i,j) ) THEN
+
+                   !! 6.1.1 Climate allows introduction of the PFT but dispersion requires the 
+                   !        presence of seeds. Seed are considered available if at least one
+                   !        neighbouring pixel is entirely invaded by the PFT. If that condition is
+                   !        satisfied, the PFT can establish in the new pixel.
+                   ! Count number of totally invaded neighbours.
+                   ! no loop so that it can vectorize
+                   n_present(i) = 0
+                   IF ( neighbours(i,1) .GT. 0 ) THEN
+                      IF ( everywhere(neighbours(i,1),j) .GE. un-min_stomate ) THEN
+                         n_present(i) = n_present(i)+1
+                      ENDIF
+                   ENDIF
+                   IF ( neighbours(i,3) .GT. 0 ) THEN
+                      IF ( everywhere(neighbours(i,3),j) .GE. un-min_stomate ) THEN
+                         n_present(i) = n_present(i)+1
+                      ENDIF
+                   ENDIF
+                   IF ( neighbours(i,5) .GT. 0 ) THEN
+                      IF ( everywhere(neighbours(i,5),j) .GE. un-min_stomate ) THEN
+                         n_present(i) = n_present(i)+1
+                      ENDIF
+                   ENDIF
+                   IF ( neighbours(i,7) .GT. 0 ) THEN
+                      IF ( everywhere(neighbours(i,7),j) .GE. un-min_stomate ) THEN
+                         n_present(i) = n_present(i)+1
+                      ENDIF
+                   ENDIF
+
+                   IF ( n_present(i) .GT. 0 ) THEN
+
+                      ! PFT is ubiquitous in at least one adjacent grid box
+                      can_introduce(i) = .TRUE.
+
+                   ENDIF
+
+                ELSE
+
+                   !! 6.1.2 No seed (trees) required for dispersion
+                   !        The PFT can establish without the presence of seed trees in 
+                   !        neighbouring pixels.
+                   can_introduce(i) = .TRUE.
+
+                ENDIF ! do we have to look at the neighbours?
+
+             ENDIF ! we'd like to introduce the PFT
+
+          ENDDO ! Loop over # pixels - domain size 
+
+          !! 6.2 Has the PFT been eliminated lately?
+          !      Additional test whether the PFT has been eliminated lately, i.e.
+          !      less than 1.25 years ago. Do not only take full years as success of
+          !      introduction, as introduction might depend on season.
+          WHERE ( RIP_time(:,j) .LT. RIP_time_min )
+
+             ! PFT was eliminated lately - cannot reintroduce
+             can_introduce(:) = .FALSE.
+
+          ENDWHERE
+
+          !! 6.3 Introduce that PFT where possible
+          !      "can_introduce" means that it either exists in neighbouring grid boxes 
+          !      or that we do not look at neighbours, that it has not been eliminated 
+          !      lately, and, of course, that the climate is good for that PFT.
+          WHERE ( can_introduce(:) )
+             
+             PFTpresent(:,j) = .TRUE.
+             
+             senescence(:,j) = .FALSE.
+             
+             ! introduce at least a few saplings, even if canopy is closed
+             ! initial density of individuals (ind_0) = 0.02, see 'stomate_constant.f90'
+             ind(:,j) = ind_0 * (dt/one_year) * avail(:)
+             
+             WHERE(veget_max(:,j) .GT. zero)
+                biomass(:,j,ileaf,icarbon) = bm_sapl(j,ileaf,icarbon) * ind(:,j) /veget_max(:,j)
+                biomass(:,j,isapabove,icarbon) = bm_sapl(j,isapabove,icarbon) * ind(:,j) /veget_max(:,j)
+                biomass(:,j,isapbelow,icarbon) = bm_sapl(j,isapbelow,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iheartabove,icarbon) = bm_sapl(j,iheartabove,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iheartbelow,icarbon) = bm_sapl(j,iheartbelow,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iroot,icarbon) = bm_sapl(j,iroot,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,ifruit,icarbon) = bm_sapl(j,ifruit,icarbon) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(:,j)/veget_max(:,j)
+             ELSEWHERE              
+                biomass(:,j,ileaf,icarbon) = bm_sapl(j,ileaf,icarbon) * ind(:,j)
+                biomass(:,j,isapabove,icarbon) = bm_sapl(j,isapabove,icarbon) * ind(:,j)
+                biomass(:,j,isapbelow,icarbon) = bm_sapl(j,isapbelow,icarbon) * ind(:,j)
+                biomass(:,j,iheartabove,icarbon) = bm_sapl(j,iheartabove,icarbon) * ind(:,j)
+                biomass(:,j,iheartbelow,icarbon) = bm_sapl(j,iheartbelow,icarbon) * ind(:,j)
+                biomass(:,j,iroot,icarbon) = bm_sapl(j,iroot,icarbon) * ind(:,j)
+                biomass(:,j,ifruit,icarbon) = bm_sapl(j,ifruit,icarbon) * ind(:,j)
+                biomass(:,j,icarbres,icarbon) = bm_sapl(j,icarbres,icarbon) * ind(:,j)
+             END WHERE
+            
+             co2_to_bm(:,j) = &
+                  co2_to_bm(:,j) / dt * &
+                  ( biomass(:,j,ileaf,icarbon) + biomass(:,j,isapabove,icarbon) + &
+                  biomass(:,j,isapbelow,icarbon) + biomass(:,j,iheartabove,icarbon) + &
+                  biomass(:,j,iheartbelow,icarbon) + biomass(:,j,iroot,icarbon) + &
+                  biomass(:,j,ifruit,icarbon) + biomass(:,j,icarbres,icarbon) )
+
+             when_growthinit(:,j) = large_value
+
+             age(:,j) = zero
+
+             ! all leaves are young
+             leaf_frac(:,j,1) = un
+
+             ! non-zero "long term" npp and last year's leaf mass for saplings -
+             ! so they won't be killed off by gap or kill
+             npp_longterm(:,j) = npp_longterm_init
+
+             lm_lastyearmax(:,j) = bm_sapl(j,ileaf,icarbon) * ind(:,j)
+
+          ENDWHERE    ! we can introduce the PFT
+
+          !! 6.4 Expansion of the PFT within the grid box 
+          !      PFT expansion/dispersion to a new grid box should not be confused with 
+          !      expansion in areal coverage
+          IF ( treat_expansion ) THEN
+
+             WHERE ( can_introduce(:) )
+
+                ! low value at the beginning
+                everywhere(:,j) = everywhere_init
+             ENDWHERE
+
+          ELSE
+
+             ! expansion is not treated
+             WHERE ( can_introduce(:) )
+                everywhere(:,j) = un
+             ENDWHERE
+
+          ENDIF ! treat expansion
+
+       ENDIF ! only natural PFTs
+
+    ENDDO ! Loop over # PFTs
+
+  !! 7. If a PFT has been present once in a grid box, we suppose that it will survive
+
+    !   If a PFT has been present once in a grid box, we suppose that it will survive
+    !   in isolated places (e.g., an oasis) within that grid box, even if it gets
+    !   officially eliminated from it later. That means that if climate becomes favorable
+    !   again, it will not need to get seeds from adjacent grid cells.
+    WHERE ( PFTpresent )
+       need_adjacent = .FALSE.
+    ENDWHERE
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving pftinout'
+
+  END SUBROUTINE pftinout
+
+END MODULE lpj_pftinout
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate.f90	(revision 5166)
@@ -0,0 +1,5451 @@
+! =================================================================================================================================
+! MODULE       : stomate
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Groups the subroutines that: (1) initialize all variables in 
+!! stomate, (2) read and write forcing files of stomate and the soil component,
+!! (3) aggregates and convert variables to handle the different time steps 
+!! between sechiba and stomate, (4) call subroutines that govern major stomate
+!! processes (litter, soil, and vegetation dynamics) and (5) structures these tasks 
+!! in stomate_main
+!!
+!!\n DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate
+
+  ! Modules used:
+  USE netcdf
+  USE defprec
+  USE grid
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE stomate_io
+  USE stomate_data
+  USE stomate_season
+  USE stomate_lpj
+  USE stomate_assimtemp
+  USE stomate_litter
+  USE stomate_vmax
+  USE stomate_soilcarbon
+  USE stomate_resp
+  USE mod_orchidee_para 
+  USE ioipsl_para 
+  USE matrix_resolution
+  
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PRIVATE
+  PUBLIC stomate_main,stomate_clear,init_forcing,forcing_read
+
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: biomass              !! Biomass per ground area @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(biomass)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: veget_cov_max        !! Maximal fractional coverage: maximum share of a pixel
+                                                                         !! taken by a PFT 
+!$OMP THREADPRIVATE(veget_cov_max)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: veget_cov_max_new    !! Updated maximal fractional coverage (unitless)
+!$OMP THREADPRIVATE(veget_cov_max_new)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: ind                  !! Vegetation density, number of individuals per unit 
+                                                                         !! ground area @tex $(m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(ind)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: age                  !! Age of PFT it normalized by biomass - can increase and
+                                                                         !! decrease - (years)
+!$OMP THREADPRIVATE(age)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: adapted              !! Winter too cold for PFT to survive (0-1, unitless)
+!$OMP THREADPRIVATE(adapted)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: regenerate           !! Winter sufficiently cold to produce viable seeds 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(regenerate)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: everywhere           !! Is the PFT everywhere in the grid box or very localized 
+                                                                         !! (after its intoduction)
+!$OMP THREADPRIVATE(everywhere)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: fireindex            !! Probability of fire (unitless)
+!$OMP THREADPRIVATE(fireindex)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: veget_lastlight      !! Vegetation fractions (on ground) after last light 
+                                                                         !! competition (unitless) 
+!$OMP THREADPRIVATE(veget_lastlight)
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:)   :: fpc_max              !! "maximal" coverage fraction of a grid box (LAI -> 
+                                                                         !! infinity) on ground. [??CHECK??] It's set to zero here, 
+                                                                         !! and then is used once in lpj_light.f90 to test if 
+                                                                         !! fpc_nat is greater than it. Something seems missing
+!$OMP THREADPRIVATE(fpc_max)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: PFTpresent           !! PFT exists (equivalent to veget > 0 for natural PFTs)
+!$OMP THREADPRIVATE(PFTpresent)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: senescence           !! The PFT is senescent
+!$OMP THREADPRIVATE(senescence)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: need_adjacent        !! This PFT needs to be in present in an adjacent gridbox 
+                                                                         !! if it is to be introduced in a new gridbox
+!$OMP THREADPRIVATE(need_adjacent)
+!--
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_daily         !! Daily plant available water -root profile weighted 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(humrel_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_week          !! "Weekly" plant available water -root profile weighted
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(humrel_week)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_month         !! "Monthly" plant available water -root profile weighted
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(humrel_month)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxhumrel_lastyear   !! Last year's max plant available water -root profile 
+                                                                         !! weighted (0-1, unitless)
+!$OMP THREADPRIVATE(maxhumrel_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxhumrel_thisyear   !! This year's max plant available water -root profile 
+                                                                         !! weighted (0-1, unitless) 
+!$OMP THREADPRIVATE(maxhumrel_thisyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: minhumrel_lastyear   !! Last year's min plant available water -root profile 
+                                                                         !! weighted (0-1, unitless)  
+!$OMP THREADPRIVATE(minhumrel_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: minhumrel_thisyear   !! This year's minimum plant available water -root profile
+                                                                         !! weighted (0-1, unitless)
+!$OMP THREADPRIVATE(minhumrel_thisyear)
+!---  
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_daily            !! Daily air temperature at 2 meter (K)
+!$OMP THREADPRIVATE(t2m_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_week             !! Mean "weekly" (default 7 days) air temperature at 2 
+                                                                         !! meter (K)  
+!$OMP THREADPRIVATE(t2m_week)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_month            !! Mean "monthly" (default 20 days) air temperature at 2 
+                                                                         !! meter (K)
+!$OMP THREADPRIVATE(t2m_month)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_longterm         !! Mean "Long term" (default 3 years) air temperature at 
+                                                                         !! 2 meter (K) 
+!$OMP THREADPRIVATE(t2m_longterm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_min_daily        !! Daily minimum air temperature at 2 meter (K)
+!$OMP THREADPRIVATE(t2m_min_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: tlong_ref            !! "Long term" (default 3 years) reference temperature at
+                                                                         !! 2 meter (K) 
+!$OMP THREADPRIVATE(tlong_ref)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: tsurf_daily          !! Daily surface temperatures (K)
+!$OMP THREADPRIVATE(tsurf_daily)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_daily         !! Daily precipitations sum @tex $(mm day^{-1})$ @endtex
+!$OMP THREADPRIVATE(precip_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_lastyear      !! Last year's annual precipitation sum 
+                                                                         !! @tex $??(mm year^{-1})$ @endtex
+!$OMP THREADPRIVATE(precip_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_thisyear      !! This year's annual precipitation sum 
+                                                                         !! @tex $??(mm year^{-1})$ @endtex 
+!$OMP THREADPRIVATE(precip_thisyear)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: soilhum_daily        !! Daily soil humidity (0-1, unitless)
+!$OMP THREADPRIVATE(soilhum_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: soilhum_month        !! Soil humidity - integrated over a month (0-1, unitless) 
+!$OMP THREADPRIVATE(soilhum_month)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: tsoil_daily          !! Daily soil temperatures (K)
+!$OMP THREADPRIVATE(tsoil_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: tsoil_month          !! Soil temperatures at each soil layer integrated over a
+                                                                         !! month (K) 
+!$OMP THREADPRIVATE(tsoil_month)
+!--- 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: litterhum_daily      !! Daily litter humidity (0-1, unitless)
+!$OMP THREADPRIVATE(litterhum_daily)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_moist_above  !! Moisture control of heterotrophic respiration  
+                                                                         !! (0-1, unitless) 
+!$OMP THREADPRIVATE(control_moist_above)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: control_moist_soil  !! Moisture control of heterotrophic respiration 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(control_moist_soil)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: moist_soil           !! Soil moiture (m3 H20 m-3 Soil) 
+!$OMP THREADPRIVATE(moist_soil)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: soil_mc_Cforcing    !! Soil moiture per soil type (m3 H20 m-3 Soil) 
+!$OMP THREADPRIVATE(soil_mc_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: floodout_Cforcing       !! flux out of floodplains
+!$OMP THREADPRIVATE(floodout_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: wat_flux0_Cforcing    !! Water flux in the first soil layers exported for soil C calculations
+!$OMP THREADPRIVATE(wat_flux0_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: wat_flux_Cforcing    !! Water flux in the soil layers exported for soil C calculations
+!$OMP THREADPRIVATE(wat_flux_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::runoff_per_soil_Cforcing   !! Runoff per soil type [mm]
+!$OMP THREADPRIVATE(runoff_per_soil_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::drainage_per_soil_Cforcing  !! Drainage per soil type [mm]
+!$OMP THREADPRIVATE(drainage_per_soil_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_topsoil_Cforcing    !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                              !! floodplains and from irrigation
+                                                                              !! @tex $(gC m^{-2} day{-1})$ @endtex
+!$OMP THREADPRIVATE(DOC_to_topsoil_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_subsoil_Cforcing    !! DOC inputs to bottom of the soil column, from returnflow
+                                                                              !! in swamps and lakes
+                                                                              !! @tex $(gC m^{-2} day{-1})$ @endtex
+!$OMP THREADPRIVATE(DOC_to_subsoil_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_temp_above   !! Temperature control of heterotrophic respiration at the 
+                                                                         !! different soil levels (0-1, unitless) 
+!$OMP THREADPRIVATE(control_temp_above)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:)  :: control_temp_soil   !! Temperature control of heterotrophic respiration at the
+                                                                         !! different soil levels (0-1,unitless)
+!$OMP THREADPRIVATE(control_temp_soil)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: control_moist_above_daily  !! Moisture control of heterotrophic respiration daily  
+                                                                             !! (0-1, unitless) 
+!$OMP THREADPRIVATE(control_moist_above_daily) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: control_temp_above_daily   !!Temperature control of heterotrophic respiration, above 
+                                                                           !! and below daily (0-1,unitless) 
+!$OMP THREADPRIVATE(control_temp_above_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_moist_soil_daily  !! Moisture control of heterotrophic respiration daily 
+                                                                         !! (0-1, unitless)
+!$OMP THREADPRIVATE(control_moist_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: moist_soil_daily     !! Soil moiture daily (m3 H20 m-3 Soil) 
+!$OMP THREADPRIVATE(moist_soil_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: soil_mc_Cforcing_daily   !! Soil moiture per soil type daily (m3 H20 m-3 Soil) 
+!$OMP THREADPRIVATE(soil_mc_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: floodout_Cforcing_daily       !! flux out of floodplains
+!$OMP THREADPRIVATE(floodout_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: wat_flux0_Cforcing_daily    !! Water flux in the first soil layers exported for soil C calculations
+!$OMP THREADPRIVATE(wat_flux0_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:):: wat_flux_Cforcing_daily    !! Water flux in the soil layers exported for soil C calculations
+!$OMP THREADPRIVATE(wat_flux_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) ::runoff_per_soil_Cforcing_daily   !! Runoff per soil type [mm]
+!$OMP THREADPRIVATE(runoff_per_soil_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) ::drainage_per_soil_Cforcing_daily  !! Drainage per soil type [mm]
+!$OMP THREADPRIVATE(drainage_per_soil_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: DOC_to_topsoil_Cforcing_daily    !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                                  !! floodplains and from irrigation
+                                                                                  !! @tex $(gC m^{-2} day{-1})$ @endtex
+!$OMP THREADPRIVATE(DOC_to_topsoil_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: DOC_to_subsoil_Cforcing_daily    !! DOC inputs to bottom of the soil column, from returnflow
+                                                                                  !! in swamps and lakes
+                                                                                  !! @tex $(gC m^{-2} day{-1})$ @endtex
+!$OMP THREADPRIVATE(DOC_to_subsoil_Cforcing_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_temp_soil_daily   !! Temperature control of heterotrophic respiration, above
+                                                                         !! and below daily (0-1, unitless)
+!$OMP THREADPRIVATE(control_temp_soil_daily)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_init_date        !! inital date for gdd count 
+!$OMP THREADPRIVATE(gdd_init_date)
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_from_growthinit  !! gdd from beginning of season (C)
+!$OMP THREADPRIVATE(gdd_from_growthinit)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: gdd0_lastyear        !! Last year's annual Growing Degree Days,
+                                                                         !! threshold 0 deg C (K) 
+!$OMP THREADPRIVATE(gdd0_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: gdd0_thisyear        !! This year's annual Growing Degree Days,
+                                                                         !! threshold 0 deg C (K)
+!$OMP THREADPRIVATE(gdd0_thisyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_m5_dormance      !! Growing degree days for onset of growing season, 
+                                                                         !! threshold -5 deg C (K)
+!$OMP THREADPRIVATE(gdd_m5_dormance)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_midwinter        !! Growing degree days for onset of growing season, 
+                                                                         !! since midwinter (K)
+!$OMP THREADPRIVATE(gdd_midwinter)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: ncd_dormance         !! Number of chilling days since leaves were lost (days) 
+!$OMP THREADPRIVATE(ncd_dormance)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: ngd_minus5           !! Number of growing days, threshold -5 deg C (days)
+!$OMP THREADPRIVATE(ngd_minus5)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: hum_min_dormance     !! Minimum moisture during dormance (0-1, unitless) 
+!$OMP THREADPRIVATE(hum_min_dormance)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gpp_daily            !! Daily gross primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+!$OMP THREADPRIVATE(gpp_daily) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gpp_week             !! Mean "weekly" (default 7 days) GPP  
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+!$OMP THREADPRIVATE(gpp_week)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxgppweek_lastyear  !! Last year's maximum "weekly" GPP  
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex 
+!$OMP THREADPRIVATE(maxgppweek_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxgppweek_thisyear  !! This year's maximum "weekly" GPP  
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex  
+!$OMP THREADPRIVATE(maxgppweek_thisyear)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: npp_daily            !! Daily net primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex 
+!$OMP THREADPRIVATE(npp_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: npp_longterm         !! "Long term" (default 3 years) net primary productivity 
+                                                                         !! per ground area  
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex   
+!$OMP THREADPRIVATE(npp_longterm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: npp_equil            !! Equilibrium NPP written to forcesoil 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(npp_equil)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: npp_tot              !! Total NPP written to forcesoil 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+!$OMP THREADPRIVATE(npp_tot)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: resp_maint_part_radia!! Maintenance respiration of different plant parts per 
+                                                                         !! total ground area at Sechiba time step  
+                                                                         !! @tex $(gC m^{-2} dtradia^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_maint_part_radia)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: resp_maint_part      !! Maintenance respiration of different plant parts per
+                                                                         !! total ground area at Stomate time step 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_maint_part)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_maint_radia     !! Maintenance respiration per ground area at Sechiba time
+                                                                         !! step   
+                                                                         !! @tex $(gC m^{-2} dtradia^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_maint_radia)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_maint_d         !! Maintenance respiration per ground area at Stomate time 
+                                                                         !! step  
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_maint_d)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_growth_d        !! Growth respiration per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_growth_d)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_hetero_d        !! Heterotrophic respiration per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+!$OMP THREADPRIVATE(resp_hetero_d)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_hetero_radia    !! Heterothrophic respiration per ground area at Sechiba
+                                                                         !! time step 
+                                                                         !! @tex $(gC m^{-2} dtradia^{-1})$ @endtex 
+!$OMP THREADPRIVATE(resp_hetero_radia)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)     :: turnover_time       !! Turnover time of grasses 
+                                                                         !! @tex $(dt_slow^{-1})$ @endtex 
+!$OMP THREADPRIVATE(turnover_time)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: turnover_daily      !! Senescence-driven turnover (better: mortality) of 
+                                                                         !! leaves and roots  
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+!$OMP THREADPRIVATE(turnover_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: turnover_littercalc !! Senescence-driven turnover (better: mortality) of 
+                                                                         !! leaves and roots at Sechiba time step 
+                                                                         !! @tex $(gC m^{-2} dtradia^{-1})$ @endtex 
+!$OMP THREADPRIVATE(turnover_littercalc)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: turnover_longterm   !! "Long term" (default 3 years) senescence-driven 
+                                                                         !! turnover (better: mortality) of leaves and roots 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(turnover_longterm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: bm_to_litter        !! Background (not senescence-driven) mortality of biomass
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+!$OMP THREADPRIVATE(bm_to_litter)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: bm_to_littercalc    !! conversion of biomass to litter per ground area at 
+                                                                         !! Sechiba time step 
+                                                                         !! @tex $(gC m^{-2} dtradia^{-1})$ @endtex 
+!$OMP THREADPRIVATE(bm_to_littercalc)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: dead_leaves          !! Metabolic and structural pools of dead leaves on ground
+                                                                         !! per PFT @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(dead_leaves)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: litter_above        !! Above ground metabolic and structural litter 
+                                                                         !! per ground area 
+                                                                         !! @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(litter_above)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:):: litter_below       !! Below ground metabolic and structural litter 
+                                                                         !! per ground area 
+                                                                         !! @tex $(gC m^{-2})$ @endtex 
+!!$OMP THREADPRIVATE(litter_below))
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:) :: litter_above_Cforcing        !! Above ground metabolic and structural litter 
+                                                                         !! per ground area 
+                                                                         !! @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(litter_above_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:,:):: litter_below_Cforcing       !! Below ground metabolic and structural litter 
+                                                                         !! per ground area 
+                                                                         !! @tex $(gC m^{-2})$ @endtex 
+!!$OMP THREADPRIVATE(litter_below_Cforcing))
+
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: litterpart           !! Fraction of litter above the ground belonging to 
+                                                                         !! different litter pools (unitless)
+!$OMP THREADPRIVATE(litterpart)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: firelitter           !! Total litter above the ground that could potentially 
+                                                                         !! burn @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(firelitter)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:,:) :: soilcarbon_input     !! Quantity of carbon going into DOC pools from litter
+                                                                         !! decomposition per ground area  at Sechiba time step 
+                                                                         !! @tex $(gC m^{-2} dtradia^{-1})$ @endtex 
+!$OMP THREADPRIVATE(soilcarbon_input)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:)  :: soilcarbon_input_daily !! Daily quantity of carbon going into DOC pools from
+                                                                           !! litter decomposition per ground area 
+                                                                           !! @tex $(gC m^{-2} day^{-1})$ @endtex 
+!$OMP THREADPRIVATE(soilcarbon_input_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:)  :: carbon             !! Soil carbon pools per ground area: active, slow, or 
+                                                                         !! passive, @tex $(gC m^{-2})$ @endtex 
+!$OMP THREADPRIVATE(carbon)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:,:)   :: DOC           !! Soil dissolved organic carbon free or adsorbed
+                                                                         !! detailled for each pools @tex $(gC m^{-2} of ground)$ @endtex
+!$OMP THREADPRIVATE(DOC)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: DOC_EXP_d             !! Soil dissolved organic carbon exported by drainage or runoff
+                                                                         !! @tex $(gCm^{-2} of ground)$ @endtex
+!$OMP THREADPRIVATE(DOC_EXP_d)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: lignin_struc_above   !! Ratio Lignine/Carbon in structural litter for above
+                                                                         !! ground compartments (unitless)
+!$OMP THREADPRIVATE(lignin_struc_above)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: lignin_struc_below   !! Ratio Lignine/Carbon in structural litter for below
+                                                                         !! ground compartments (unitless)
+!$OMP THREADPRIVATE(lignin_struc_below)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)    :: lignin_struc_above_Cforcing   !! Ratio Lignine/Carbon in structural litter for above
+                                                                         !! ground compartments (unitless)
+!$OMP THREADPRIVATE(lignin_struc_above_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:)  :: lignin_struc_below_Cforcing   !! Ratio Lignine/Carbon in structural litter for below
+                                                                         !! ground compartments (unitless)
+!$OMP THREADPRIVATE(lignin_struc_below_Cforcing)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: black_carbon         !! Black carbon on the ground 
+                                                                         !! @tex $(gC m^{-2})$ @endtex   
+!$OMP THREADPRIVATE(black_carbon)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: lm_lastyearmax       !! Last year's maximum leaf mass per ground area for each
+                                                                         !! PFT @tex $(gC m^{-2})$ @endtex  
+!$OMP THREADPRIVATE(lm_lastyearmax)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: lm_thisyearmax       !! This year's maximum leaf mass per ground area for each
+                                                                         !! PFT @tex $(gC m^{-2})$ @endtex  
+!$OMP THREADPRIVATE(lm_thisyearmax)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxfpc_lastyear      !! Last year's maximum fpc for each natural PFT, on ground
+                                                                         !! [??CHECK] fpc but this ones look ok (computed in 
+                                                                         !! season, used in light)?? 
+!$OMP THREADPRIVATE(maxfpc_lastyear)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxfpc_thisyear      !! This year's maximum fpc for each PFT, on ground (see 
+                                                                         !! stomate_season), [??CHECK] fpc but this ones look ok 
+                                                                         !! (computed in season, used in light)??
+!$OMP THREADPRIVATE(maxfpc_thisyear)
+!---
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: leaf_age             !! Age of different leaf classes (days)
+!$OMP THREADPRIVATE(leaf_age)
+  REAL(r_std), ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: leaf_frac            !! PFT fraction of leaf mass in leaf age class (0-1, 
+                                                                         !! unitless) 
+!$OMP THREADPRIVATE(leaf_frac)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: when_growthinit      !! Days since beginning of growing season (days)
+!$OMP THREADPRIVATE(when_growthinit)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: herbivores           !! Time constant of probability of a leaf to be eaten by a
+                                                                         !! herbivore (days)
+!$OMP THREADPRIVATE(herbivores)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: RIP_time             !! How much time ago was the PFT eliminated for the last 
+                                                                         !! time (year)
+!$OMP THREADPRIVATE(RIP_time)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: time_hum_min         !! Time elapsed since strongest moisture limitation (days) 
+!$OMP THREADPRIVATE(time_hum_min)
+!---
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: clay_fm              !! Soil clay content (0-1, unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: clay_fm_g            !! Soil clay content (0-1, unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: soil_ph_fm              !! Soil pH (0-14, pHunit), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: soil_ph_fm_g            !! Soil pH (0-14, pH unit), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: bulk_dens_fm         !! Soil bulk density (g cm-3), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: bulk_dens_fm_g       !! Soil bulk density (g cm-3), parallel computing
+
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: precip_fm            !! Daily precipitations sum @tex $(mm day^{-1})$ @endtex,
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: precip_fm_g          !! Daily precipitations sum @tex $(mm day^{-1})$ @endtex,
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: litterhum_daily_fm   !! Daily relative humidity of litter (0-1, unitless), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: litterhum_daily_fm_g !! Daily relative humidity of litter (0-1, unitless), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: t2m_daily_fm         !! Daily air temperature at 2 meter (K), parallel 
+                                                                         !! computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: t2m_daily_fm_g       !! Daily air temperature at 2 meter (K), parallel 
+                                                                         !! computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: t2m_min_daily_fm     !! Daily minimum air temperature at 2 meter (K), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: t2m_min_daily_fm_g   !! Daily minimum air temperature at 2 meter (K), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: tsurf_daily_fm       !! Daily surface temperatures (K), parallel 
+                                                                         !! computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:)         :: tsurf_daily_fm_g     !! Daily surface temperatures (K), parallel 
+                                                                         !! computing 
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: tsoil_daily_fm       !! Daily soil temperatures (K), parallel computing 
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: tsoil_daily_fm_g     !! Daily soil temperatures (K), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: soilhum_daily_fm     !! Daily soil humidity (0-1, unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: soilhum_daily_fm_g   !! Daily soil humidity (0-1, unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: humrel_daily_fm      !! Daily relative humidity of atmosphere (0-1, unitless), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: humrel_daily_fm_g    !! Daily relative humidity of atmosphere (0-1, unitless), 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: gpp_daily_fm         !! Daily gross primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex, 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: gpp_daily_fm_g       !! Daily gross primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} day^{-1})$ @endtex, 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: veget_fm             !! Vegetation coverage taking into account non-biological
+                                                                         !! coverage (unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: veget_fm_g           !! Vegetation coverage taking into account non-biological
+                                                                         !! coverage (unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: veget_max_fm         !! Maximum vegetation coverage taking into account 
+                                                                         !! non-biological coverage (unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: veget_max_fm_g       !! Maximum vegetation coverage taking into account none 
+                                                                         !! biological coverage (unitless), parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: lai_fm               !! Leaf area index @tex $@tex $(m^2 m^{-2})$ @endtex$ @endtex, 
+                                                                         !! parallel computing
+  REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)       :: lai_fm_g             !! Leaf area index @tex $@tex $(m^2 m^{-2})$ @endtex$ @endtex, 
+                                                                         !! parallel computing
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: co2_fire             !! Carbon emitted to the atmosphere by burning living 
+                                                                         !! and dead biomass 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex 
+!$OMP THREADPRIVATE(co2_fire)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: co2_to_bm_dgvm       !! Psuedo-photosynthesis,C used to provide seedlings with
+                                                                         !! an initial biomass, arbitrarily removed from the 
+                                                                         !! atmosphere  
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex 
+!$OMP THREADPRIVATE(co2_to_bm_dgvm)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: co2_flux_daily       !! Daily net CO2 flux between atmosphere and biosphere 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+                                                                         !! [??CHECK] sign convention?
+!$OMP THREADPRIVATE(co2_flux_daily)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: co2_flux_monthly     !! Monthly net CO2 flux between atmosphere and biosphere 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+                                                                         !! [??CHECK] sign convention? 
+!$OMP THREADPRIVATE(co2_flux_monthly)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: prod10               !! Wood products remaining in the 10 year-turnover pool 
+                                                                         !! after the annual release for each compartment 
+                                                                         !! @tex $(gC m^{-2})$ @endtex    
+                                                                         !! (0:10 input from year of land cover change),
+                                                                         !! dimension(#pixels,0:10 years
+!$OMP THREADPRIVATE(prod10)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: prod100              !! Wood products remaining in the 100 year-turnover pool
+                                                                         !! after the annual release for each compartment
+                                                                         !! @tex $(gC m^{-2})$ @endtex  
+                                                                         !! (0:100 input from year of land cover change), 
+                                                                         !! dimension(#pixels,0:100 years)
+!$OMP THREADPRIVATE(prod100)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: flux10               !! Wood decomposition from the 10 year-turnover pool 
+                                                                         !! compartments 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+                                                                         !! dimension(#pixels,0:10)  
+!$OMP THREADPRIVATE(flux10)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: flux100              !! Wood decomposition from the 100 year-turnover pool 
+                                                                         !! compartments 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+                                                                         !! dimension(#pixels,0:100)
+!$OMP THREADPRIVATE(flux100)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: convflux             !! Release during first year following land cover change 
+                                                                         !! (paper, burned, etc...) 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex  
+!$OMP THREADPRIVATE(convflux)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: cflux_prod10         !! Total annual release from the 10 year-turnover pool
+                                                                         !! sum of flux10  
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(cflux_prod10)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: cflux_prod100        !! Total annual release from the 100 year-turnover pool 
+                                                                         !! sum of flux100 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+!$OMP THREADPRIVATE(cflux_prod100)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: harvest_above        !! Harvest of above ground biomass for agriculture -not 
+                                                                         !! just from land use change 
+                                                                         !! @tex $(??gC m^{-2} dt_slow^{-1})$ @endtex
+!$OMP THREADPRIVATE(harvest_above)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: carb_mass_total      !! Total on-site and off-site C pool 
+                                                                         !! @tex $(??gC m^{-2})$ @endtex                        
+!$OMP THREADPRIVATE(carb_mass_total)
+!---
+  REAL(r_std),SAVE                               :: dt_days=zero         !! Time step of STOMATE (days) 
+!$OMP THREADPRIVATE(dt_days)
+  REAL(r_std),SAVE                               :: day_counter=zero     !! Time step each day sechiba (dtradia)   
+!$OMP THREADPRIVATE(day_counter)
+  INTEGER(i_std),SAVE                            :: date=0               !! Date (days) 
+!$OMP THREADPRIVATE(date)
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)   :: nforce               !! Number of states calculated for the soil forcing 
+                                                                         !! variables (unitless), dimension(::nparan*::nbyear) both 
+                                                                         !! given in the run definition file    
+!$OMP THREADPRIVATE(nforce)
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)   :: isf                  !! Index for number of time steps that can be stored in 
+                                                                         !! memory (unitless), dimension (#nsfm)
+!$OMP THREADPRIVATE(isf)
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)   :: nf_cumul             !! Number of years over which the average is calculated in
+                                                                         !! forcesoil when cumul flag is set, dimension (#nsft)
+                                                                         !! [??CHECK] definition the dimension is number of 
+                                                                         !! timesteps in a year?
+!$OMP THREADPRIVATE(nf_cumul)
+  INTEGER,PARAMETER                              :: r_typ = nf90_real4   !! Specify data format (server dependent)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:)          :: nf_written           !! Flag indicating whether the forcing data have been 
+                                                                         !! written
+!$OMP THREADPRIVATE(nf_written)
+!---
+  LOGICAL, SAVE                                  :: do_slow=.FALSE.      !! Flag that determines whether stomate_accu calculates
+                                                                         !! the sum(do_slow=.FALSE.) or the mean 
+                                                                         !! (do_slow=.TRUE.)
+!$OMP THREADPRIVATE(do_slow)
+  LOGICAL, SAVE                                  :: EndOfYear=.FALSE.    !! Update annual variables? This variable must be 
+                                                                         !! .TRUE. once a year
+!$OMP THREADPRIVATE(EndOfYear)
+  LOGICAL, SAVE                                  :: EndOfMonth=.FALSE.   !! Update monthly variables? This variable must be 
+                                                                         !!.TRUE. once a month 
+!$OMP THREADPRIVATE(EndOfMonth)
+  LOGICAL, SAVE                                  :: l_first_stomate = .TRUE.!! Is this the first call of stomate?
+!$OMP THREADPRIVATE(l_first_stomate)
+  LOGICAL, SAVE                                  :: cumul_forcing=.FALSE.!! flag for cumul of forcing if teststomate
+!$OMP THREADPRIVATE(cumul_forcing)
+  LOGICAL, SAVE                                  :: cumul_Cforcing=.FALSE.  !! Flag, if internal parameter cumul_Cforcing is 
+                                                                            !! TRUE then ::nbyear (defined in run definition 
+                                                                            !! file will be forced to 1 later in this module. If 
+                                                                            !! FALSE the mean over ::nbyear is written in forcesoil
+!$OMP THREADPRIVATE(cumul_Cforcing)
+!---   
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: harvest_above_monthly   !! [??CHECK] post-processing - should be removed?
+!$OMP THREADPRIVATE(harvest_above_monthly)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: cflux_prod_monthly      !! [??CHECK] post-processing - should be removed?
+!$OMP THREADPRIVATE(cflux_prod_monthly)
+!---
+  INTEGER(i_std), SAVE                               :: global_years        !! Global counter of years (year)
+!$OMP THREADPRIVATE(global_years)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)           :: ok_equilibrium      !! Logical array marking the points where the resolution is ok 
+                                                                            !! (true/false)
+!$OMP THREADPRIVATE(ok_equilibrium)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)           :: ok_equilibrium_g    !! Logical array marking the points where the resolution is ok 
+                                                                            !! (for parallelisation) (true/false)
+!$OMP THREADPRIVATE(ok_equilibrium_g)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:)           :: carbon_eq           !! Logical array to mark the carbon pools at equilibrium ? 
+                                                                            !! If true, the job stops. (true/false)
+!$OMP THREADPRIVATE(carbon_eq)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)       :: nbp_accu            !! Accumulated Net Biospheric Production over the year (gC.m^2 )
+!$OMP THREADPRIVATE(nbp_accu)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)       :: nbp_flux            !! Net Biospheric Production (gC.m^2.day^{-1})
+!$OMP THREADPRIVATE(nbp_flux)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:)       :: matrixA             !! Matrix containing the fluxes between the carbon pools
+                                                                            !! per sechiba time step 
+                                                                            !! @tex $(gC.m^2.day^{-1})$ @endtex
+!$OMP THREADPRIVATE(matrixA)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)         :: vectorB             !! Vector containing the litter increase per sechiba time step
+                                                                            !! @tex $(gC m^{-2})$ @endtex
+!$OMP THREADPRIVATE(vectorB)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: MatrixV             !! Matrix containing the accumulated values of matrixA 
+!$OMP THREADPRIVATE(MatrixV)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: VectorU             !! Matrix containing the accumulated values of VectorB
+!$OMP THREADPRIVATE(VectorU)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: MatrixW             !! Matrix containing the opposite of matrixA
+!$OMP THREADPRIVATE(MatrixW)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: previous_stock      !! Array containing the carbon stock calculated by the analytical
+                                                                            !! method in the previous resolution
+!$OMP THREADPRIVATE(previous_stock)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: current_stock       !! Array containing the carbon stock calculated by the analytical
+                                                                            !! method in the current resolution 
+!$OMP THREADPRIVATE(current_stock)
+  REAL(r_std), SAVE                                  :: eps_carbon          !! Stopping criterion for carbon pools (unitless,0-1)
+!$OMP THREADPRIVATE(eps_carbon)
+ 
+PUBLIC clay_fm, soil_ph_fm,bulk_dens_fm,humrel_daily_fm, litterhum_daily_fm, t2m_daily_fm, &
+   & t2m_min_daily_fm, tsurf_daily_fm, tsoil_daily_fm, soilhum_daily_fm, &
+   & precip_fm, gpp_daily_fm, veget_fm, veget_max_fm, lai_fm
+PUBLIC  dt_days, day_counter, date, do_slow, EndOfYear
+PUBLIC isf, nf_written
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_main
+!!
+!>\BRIEF        Manages variable initialisation, reading and writing forcing 
+!! files, aggregating data at stomate's time step (dt_slow), aggregating data
+!! at longer time scale (i.e. for phenology) and uses these forcing to calculate
+!! CO2 fluxes (NPP and respirations) and C-pools (litter, soil, biomass, ...)
+!!
+!! DESCRIPTION  : The subroutine manages 
+!! divers tasks:
+!! (1) Initializing all variables of stomate (first call)
+!! (2) Reading and writing forcing data (last call)
+!! (3) Adding CO2 fluxes to the IPCC history files
+!! (4) Converting the time steps of variables to maintain consistency between
+!! sechiba and stomate
+!! (5) Use these variables to call stomate_lpj, maint_respiration, littercalc,
+!! soilcarbon. The called subroutines handle: climate constraints 
+!! for PFTs, PFT dynamics, Phenology, Allocation, NPP (based on GPP and
+!! authothropic respiration), fire, mortality, vmax, assimilation temperatures,
+!! all turnover processes, light competition, sapling establishment, lai,  
+!! land cover change and litter and soil dynamics.
+!! (6) Use the spin-up method developed by Lardy (2011)(only if SPINUP_ANALYTIC 
+!! is set to TRUE).
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): deadleaf_cover, assim_param, lai, height, veget, 
+!! veget_max, veget_max_new, totfrac_nobio_new, resp_maint, 
+!! resp_hetero,resp_growth, co2_flux, fco2_lu.
+!!
+!! REFERENCES	: 
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!! \includegraphics[scale=0.5]{stomatemainflow.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+  
+SUBROUTINE stomate_main &
+       & (kjit, kjpij, kjpindex, dtradia, dt_slow, &
+       &  ldrestart_read, ldrestart_write, ldforcing_write, ldcarbon_write, &
+       &  index, lalo, neighbours, resolution, contfrac, totfrac_nobio, clay, &
+       &  t2m, t2m_min, temp_sol, stempdiag, &
+       &  humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, &
+       &  gpp, deadleaf_cover, assim_param, &
+       &  lai, frac_age, height, veget, veget_max, &
+       &  veget_max_new, totfrac_nobio_new, &
+       &  hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
+       &  co2_flux, fco2_lu, resp_maint,resp_hetero,resp_growth,soil_mc, soiltile, &
+       &  litter_mc,floodout, runoff, drainage, wat_flux0, wat_flux,bulk_dens, soil_ph,&
+       &  drainage_per_soil, runoff_per_soil, DOC_EXP_agg_d, &
+       &  DOC_to_topsoil, DOC_to_subsoil)
+    
+    IMPLICIT NONE
+
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                       :: kjit              !! Time step number (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpindex          !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std),INTENT(in)                       :: kjpij             !! Total size of the un-compressed grid (unitless)
+    REAL(r_std),INTENT(in)                          :: dtradia           !! Time step of SECHIBA (seconds)
+    REAL(r_std),INTENT(in)                          :: dt_slow           !! Time step of STOMATE (days)
+    LOGICAL,INTENT(in)                              :: ldrestart_read    !! Logical for _restart_ file to read
+    LOGICAL,INTENT(in)                              :: ldrestart_write   !! Flag to write restart file for stomate
+    LOGICAL,INTENT(in)                              :: ldforcing_write   !! Flag to write forcing file for main processes in 
+                                                                         !! stomate 
+    LOGICAL,INTENT(in)                              :: ldcarbon_write    !! Flag to write forcing file for soil processes in 
+                                                                         !! stomate 
+    INTEGER(i_std),INTENT(in)                       :: rest_id_stom      !! STOMATE's _Restart_ file identifier (unitless)
+    INTEGER(i_std),INTENT(in)                       :: hist_id_stom      !! STOMATE's _history_ file identifier (unitless)
+    INTEGER(i_std),INTENT(in)                       :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file identifier 
+                                                                         !! (unitless) 
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)   :: index             !! Indices of the pixels on the map. Stomate uses a 
+                                                                         !! reduced grid excluding oceans. ::index contains 
+                                                                         !! the indices of the terrestrial pixels only 
+                                                                         !! (unitless) 
+    INTEGER(i_std),DIMENSION(kjpindex,8),INTENT(in) :: neighbours        !! Neighoring grid points if land for the DGVM 
+                                                                         !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: lalo              !! Geographical coordinates (latitude,longitude) 
+                                                                         !! for pixels (degrees) 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)    :: resolution        !! Size in x an y of the grid (m) - surface area of 
+                                                                         !! the gridbox 
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)   :: contfrac          !! Fraction of continent in the grid cell (unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: totfrac_nobio     !! Fraction of grid cell covered by lakes, land 
+                                                                         !! ice, cities, ... (unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: clay              !! Clay fraction of soil (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(inout)   :: bulk_dens         !! Soil bulk density (g cm-3)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: soil_ph           !! Soil pH (0-14, pH unit)
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: humrel            !! Relative humidity ("moisture availability") 
+                                                                         !! (0-1, unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: t2m               !! 2 m air temperature (K)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: t2m_min           !! Minimum 2 m air temp. during forcing time step 
+                                                                         !! (K) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: temp_sol          !! Surface temperature (K)
+    REAL(r_std),DIMENSION(kjpindex,nbdl),INTENT(in) :: stempdiag         !! Soil humidity (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex,nbdl),INTENT(in) :: shumdiag          !! Relative soil moisture (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: litterhumdiag     !! Litter humidity (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: precip_rain       !! Rain precipitation  
+                                                                         !! @tex $(mm dt_slow^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: precip_snow       !! Snow precipitation  
+                                                                         !! @tex $(mm dt_slow^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: gpp               !! GPP of total ground area  
+                                                                         !! @tex $(gC m^{-2} time step^{-1})$ @endtex 
+                                                                         !! Calculated in sechiba, account for vegetation 
+                                                                         !! cover and effective time step to obtain ::gpp_d 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)  :: veget_max_new     !! New "maximal" coverage fraction of a PFT (LAI -> 
+                                                                         !! infinity) on ground only if EndOfYear is 
+                                                                         !! activated (unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)      :: totfrac_nobio_new !! New fraction of grid cell covered by lakes, land 
+                                                                         !! ice, cities, ... (unitless) 
+    INTEGER(i_std),INTENT(in)                       :: hist_id           !! ?? [DISPENSABLE] SECHIBA's _history_ file 
+                                                                         !! identifier 
+    INTEGER(i_std),INTENT(in)                       :: hist2_id          !! ?? [DISPENSABLE] SECHIBA's _history_ file 2 
+                                                                         !! identifier 
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(in)  :: soil_mc   !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltile  !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in):: litter_mc        !! litter moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)   :: floodout          !! flux out of floodplains
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)   :: runoff            !! Complete runoff
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)   :: drainage          !! Drainage
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(in)    :: wat_flux0           !! Water flux in the first soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm), INTENT(in)   :: wat_flux        !! Water flux in the soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)   :: runoff_per_soil     !! Runoff per soil type [mm]
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)   :: drainage_per_soil   !! Drainage per soil type [mm]
+    REAL(r_std),DIMENSION (kjpindex,nelements), INTENT(in)   :: DOC_to_topsoil  !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                                !! floodplains and from irrigation
+                                                                                !! @tex $(gC m^{-2} day{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex,nelements), INTENT(in)   :: DOC_to_subsoil  !! DOC inputs to bottom of the soil column, from returnflow
+                                                                                !! in swamps and lakes
+                                                                                !! @tex $(gC m^{-2} day{-1})$ @endtex
+    
+    !! 0.2 Output variables 
+
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)                             :: co2_flux          !! CO2 flux between atmosphere and biosphere per 
+                                                                                                     !! average ground area 
+                                                                                                     !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex  
+                                                                                                     !! [??CHECK] sign convention? 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out)                                 :: fco2_lu           !! CO2 flux between atmosphere and biosphere from 
+                                                                                                     !! land-use (without forest management)  
+                                                                                                     !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex  
+                                                                                                     !! [??CHECK] sign convention? 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)                             :: resp_maint        !! Maitenance component of autotrophic respiration in 
+                                                                                                     !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)                             :: resp_growth       !! Growth component of autotrophic respiration in 
+                                                                                                     !! @tex ($gC m^{-2} dt_slow^{-1}$) @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)                             :: resp_hetero       !! Heterotrophic respiration in  
+                                                                                                     !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex, nexp),INTENT(out)                           :: DOC_EXP_agg_d     !! DOC exports, diffrenet paths (nexp), in  
+                                                                                                     !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex  
+
+    !! 0.3 Modified
+   
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: lai            !! Leaf area inex @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)          :: veget          !! Fraction of vegetation type including 
+                                                                              !! non-biological fraction (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: veget_max      !! Maximum fraction of vegetation type including 
+                                                                              !! non-biological fraction (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(inout)       :: height         !! Height of vegetation (m)
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(inout) :: assim_param    !! min+max+opt temperatures (K) & vmax for 
+                                                                              !! photosynthesis  
+                                                                              !! @tex $(\mu mol m^{-2}s^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex),INTENT(inout)           :: deadleaf_cover !! Fraction of soil covered by dead leaves 
+                                                                              !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(inout):: frac_age    !! Age efficacity from STOMATE 
+
+    !! 0.4 local variables
+    
+    REAL(r_std)                                   :: day_counter_read         !! Day read in restart file (days)
+    REAL(r_std)                                   :: dt_days_read             !! STOMATE time step read in restart file (days)
+    INTEGER(i_std)                                :: l,k,ji, jv, i, j, m      !! indices    
+    INTEGER(i_std)                                :: date_read                !! STOMATE date read in restart file (days)
+    REAL(r_std),PARAMETER                         :: max_dt_days = 5.         !! Maximum STOMATE time step (days)
+    REAL(r_std)                                   :: hist_days                !! Writing frequency for history file (days)
+    REAL(r_std),DIMENSION(0:nbdl)                 :: z_soil                   !! Variable to store depth of the different soil 
+                                                                              !! layers (m) 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: rprof                    !! Coefficient of the exponential functions that 
+                                                                              !! relates root density to soil depth (unitless) 
+    REAL(r_std),DIMENSION(kjpindex)               :: cvegtot                  !! Total "vegetation" cover (unitless)
+    REAL(r_std),DIMENSION(kjpindex)               :: precip                   !! Total liquid and solid precipitation  
+                                                                              !! @tex $(??mm dt_slow^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_d                    !! Gross primary productivity per ground area 
+                                                                              !! @tex $(??gC m^{-2} dt_slow^{-1})$ @endtex  
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: gpp_daily_x              !! "Daily" gpp for teststomate  
+                                                                              !! @tex $(??gC m^{-2} dt_slow^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: resp_hetero_litter       !! Litter heterotrophic respiration per ground area 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex  
+                                                                              !! ??Same variable is also used to 
+                                                                              !! store heterotrophic respiration per ground area 
+                                                                              !! over ::dtradia?? 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: resp_hetero_soil         !! soil heterotrophic respiration  
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nexp, nelements)    :: DOC_EXP        !! Exported DOC through runoff, drainage, flood,
+                                                                              !! The unit is give by m^2 of
+                                                                              !! water @tex $(fC m{-2} of ground)$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: veget_cov                !! Fractional coverage: actually share of the pixel 
+                                                                              !! covered by a PFT (fraction of ground area), 
+                                                                              !! taking into account LAI ??(= grid scale fpc)?? 
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: vcmax                    !! Maximum rate of carboxylation
+                                                                              !! @tex $(\mumol m^{-2} s^{-1})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: vjmax                    !! Maximum rate of RUbp regeneration
+                                                                              !! @tex $(\mumol m^{-2} s^{-1})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: t_photo_min              !! Min temperature for photosynthesis (K)
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: t_photo_opt              !! Opt temperature for photosynthesis (K)
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: t_photo_max              !! Max temperature for photosynthesis (K)
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: control_moist_above_inst !! Moisture control of heterotrophic respiration  
+                                                                              !! (0-1, unitless)
+    REAL(r_std),DIMENSION(kjpindex,nbdl,nvm)     :: control_moist_soil_inst  !! Moisture control of heterotrophic respiration 
+                                                                              !! (0-1,unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nbdl)          :: moist_soil_inst          !! Soil moiture daily (m3 H20 m-3 Soil)  
+    REAL(r_std),DIMENSION(kjpindex,nbdl,nstm)     :: soil_mc_Cforcing_inst    !! Soil moiture per soil type daily (m3 H20 m-3 Soil)
+    REAL(r_std),DIMENSION (kjpindex)              :: floodout_Cforcing_inst   !! flux out of floodplains
+    REAL(r_std),DIMENSION (kjpindex,nstm)         :: wat_flux0_Cforcing_inst  !! Water flux in the first soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (kjpindex,nbdl,nstm)    :: wat_flux_Cforcing_inst   !! Water flux in the soil layers exported for soil C calculations
+    REAL(r_std),DIMENSION (kjpindex,nstm)         :: runoff_per_soil_Cforcing_inst            !! Runoff per soil type [mm]
+    REAL(r_std),DIMENSION (kjpindex,nstm)         :: drainage_per_soil_Cforcing_inst          !! Drainage per soil type [mm]
+    REAL(r_std),DIMENSION (kjpindex,nelements)    :: DOC_to_topsoil_Cforcing_inst  !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                                   !! floodplains and from irrigation
+                                                                                   !! @tex $(gC m^{-2} day{-1})$ @endtex
+    REAL(r_std),DIMENSION (kjpindex,nelements)    :: DOC_to_subsoil_Cforcing_inst  !! DOC inputs to bottom of the soil column, from returnflow
+                                                                                   !! in swamps and lakes
+                                                                                   !! @tex $(gC m^{-2} day{-1})$ @endtex
+
+    REAL(r_std),DIMENSION(kjpindex,nlitt)               :: control_temp_above_inst  !! Temperature control of heterotrophic  
+                                                                              !! respiration, above (0-1, unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nbdl,npool*2)        :: control_temp_soil_inst   !! Temperature control of heterotrophic 
+                                                                              !! respiration, below (0-1, unitless) 
+
+    REAL(r_std),DIMENSION(kjpindex,nvm,nbdl,npool,nelements) :: soilcarbon_input_inst   !! Quantity of carbon going into DOC pools from 
+                                                                              !! litter decomposition 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nbdl,npool,nelements) :: DOC_input_inst !! Quantity of carbon going into dissolved organic carbon pools from 
+                                                                              !! litter decomposition 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nmbcomp,nelements)   :: check_intern  !! Contains the components of the internal
+                                                                              !! mass balance chech for this routine
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nelements) :: closure_intern          !! Check closure of internal mass balance
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nelements) :: pool_start              !! Start and end pool of this routine
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(kjpindex,nvm,nelements) :: pool_end                !! Start and end pool of this routine
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex    
+    INTEGER(i_std)                                :: ier                      !! Check errors in netcdf call (unitless)
+    REAL(r_std),SAVE                              :: dt_forcesoil             !! Time step of soil forcing file (days)
+!$OMP THREADPRIVATE(dt_forcesoil)
+                                                                              !!?? Unit?
+    INTEGER(i_std),PARAMETER                      :: nparanmax=366            !! Maximum number of time steps per year for 
+                                                                              !! forcesoil 
+    INTEGER(i_std),SAVE                           :: nparan                   !! Number of time steps per year for forcesoil - 
+                                                                              !! read from run definition (unitless) 
+!$OMP THREADPRIVATE(nparan)
+    INTEGER(i_std),SAVE                           :: nbyear=1                 !! Number of years saved for forcesoil - read from 
+                                                                              !! run definition (unitless) 
+!$OMP THREADPRIVATE(nbyear)
+    INTEGER(i_std),SAVE                           :: iatt                     !! Time step of forcing of soil processes (iatt = 1 
+                                                                              !! to ::nparan*::nbyear) 
+!$OMP THREADPRIVATE(iatt)
+    INTEGER(i_std),SAVE                           :: iatt_old=1               !! Previous ::iatt
+!$OMP THREADPRIVATE(iatt_old)
+    REAL(r_std)                                   :: sf_time                  !! Intermediate variable to calculate current time 
+                                                                              !! step 
+    INTEGER(i_std)                                :: max_totsize              !! Memory management - maximum memory size (Mb)
+    INTEGER(i_std)                                :: totsize_1step            !! Memory management - memory required to store one 
+                                                                              !! time step on one processor (Mb) 
+    INTEGER(i_std)                                :: totsize_tmp              !! Memory management - memory required to store one 
+                                                                              !! time step on all processors(Mb) 
+    REAL(r_std)                                   :: xn                       !! How many times have we treated in this forcing 
+                                                                              !! state 
+    INTEGER(i_std),SAVE                           :: nsfm                     !! Number of time steps that can be stored in 
+                                                                              !! memory (unitless) 
+!$OMP THREADPRIVATE(nsfm)
+    INTEGER(i_std),SAVE                           :: nsft                     !! Number of time steps in a year (unitless)
+!$OMP THREADPRIVATE(nsft)
+   INTEGER(i_std),SAVE                            :: iisf                     !! Current pointer for teststomate (unitless)
+!$OMP THREADPRIVATE(iisf)
+    REAL(r_std), DIMENSION(kjpindex)              :: vartmp                   !! Temporary variable
+    CHARACTER(LEN=100), SAVE                      :: forcing_name             !! Name of forcing file 1
+!$OMP THREADPRIVATE(forcing_name)
+    CHARACTER(LEN=100), SAVE                      :: Cforcing_name            !! Name of forcing file 2
+!$OMP THREADPRIVATE(Cforcing_name)
+    INTEGER(i_std),SAVE                           :: Cforcing_id              !! File identifer of file 2
+!$OMP THREADPRIVATE(Cforcing_id)    
+    INTEGER(i_std),PARAMETER                      :: ndm = 11                 !! Maximum number of dimensions (unitless)
+    INTEGER(i_std)                                :: vid                      !! Variable identifer of netCDF (unitless)
+    INTEGER(i_std)                                :: nneigh                   !! Number of neighbouring pixels
+    INTEGER(i_std)                                :: direct                   !! ??
+    INTEGER(i_std),DIMENSION(ndm)                 :: d_id                     !! ??
+
+    REAL(r_std),DIMENSION(kjpindex,nvm)           :: t_root                   !! ??[DISPENSABLE] Root temperature (K) convolution 
+                                                                              !! of root and soil temperature profiles 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nparts)    :: coeff_maint              !! ??[DISPENSABLE]
+    REAL(r_std),DIMENSION(kjpindex,nparts)        :: t_maint_radia            !! ??[DISPENSABLE] Temperature which is pertinent 
+                                                                              !! for maintenance respiration (K) 
+    REAL(r_std),DIMENSION(kjpindex)               :: rpc                      !! ??[DISPENSABLE] Integration constant for root 
+                                                                              !! profile (unitless) 
+    REAL(r_std),DIMENSION(kjpindex)               :: tl                       !! ??[DISPENSABLE] long term annual mean 
+                                                                              !! temperature, C 
+    REAL(r_std),DIMENSION(kjpindex)               :: slope                    !! ??[DISPENSABLE] slope of maintenance respiration 
+                                                                              !! coefficient (1/K) 
+    INTEGER(i_std)                                :: iyear                    !! ??[DISPENSABLE]
+    REAL(r_std)                                   :: net_co2_flux_monthly     !! ??[DISPENSABLE]
+    REAL(r_std)                                   :: net_co2_flux_monthly_sum !! ??[DISPENSABLE]
+    INTEGER                                       :: ios                      !! ??[DISPENSABLE]
+    REAL(r_std)                                   :: trans_veg                !! ??[DISPENSABLE]
+    REAL(r_std)                                   :: tmp_day(1)               !! ??[DISPENSABLE]
+    INTEGER(i_std),SAVE                           :: lcanop                   !! ??[DISPENSABLE] soil level used for LAI
+!$OMP THREADPRIVATE(lcanop)
+    REAL(r_std),DIMENSION(nbp_glo)                :: clay_g                   !! Clay fraction of soil (0-1, unitless), parallel 
+                                                                              !! computing 
+    REAL(r_std),DIMENSION(nbp_glo)                :: bulk_dens_g              !! Soil bulk density (g cm-3),  parallel 
+                                                                              !!
+                                                                              !computing
+    REAL(r_std),DIMENSION(nbp_glo)                :: soil_ph_g                !! pH of soil (0-14, pH unit), parallel 
+                                                                              !! computing 
+    REAL(r_std),DIMENSION(nbp_glo,nstm)           :: soiltile_g              !! soil type, parallel computing
+    REAL(r_std),DIMENSION(nbp_glo,nvm)            :: veget_max_g              !! Maximum fraction of vegetation type including 
+                                                                              !! non-biological fraction (unitless),paralelle computing 
+
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:,:,:)  :: soilcarbon_input_g     !! Quantity of carbon going into DOC pools from 
+                                                                              !! litter decomposition  
+                                                                              !! @tex $(gC m^{-2} dtradia^{-1})$ @endtex, parallel 
+                                                                              !! computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: control_moist_above_g    !! Moisture control of heterotrophic respiration  
+                                                                              !! (0-1, unitless), parallel computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: control_moist_soil_g     !! Moisture control of heterotrophic respiration 
+                                                                              !! (0-1, unitless), parallel computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: moist_soil_g             !! Soil moiture (m3 H20 m-3 Soil) 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: soil_mc_Cforcing_g       !! Soil moiture per soil type (m3 H20 m-3 Soil) 
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)   :: floodout_Cforcing_g      !! flux out of floodplains
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: wat_flux0_Cforcing_g     !! Water flux in the first soil layers exported for soil C calculations
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: wat_flux_Cforcing_g     !! Water flux in the soil layers exported for soil C calculations
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::runoff_per_soil_Cforcing_g   !! Runoff per soil type [mm]
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) ::drainage_per_soil_Cforcing_g !! Drainage per soil type [mm]
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_topsoil_Cforcing_g           !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                              !! floodplains and from irrigation
+                                                                              !! @tex $(gC m^{-2} day{-1})$ @endtex
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_subsoil_Cforcing_g           !! DOC inputs to bottom of the soil column, from returnflow
+                                                                              !! in swamps and lakes
+                                                                              !! @tex $(gC m^{-2} day{-1})$ @endtex
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: control_temp_above_g     !! Temperature control of heterotrophic respiration
+                                                                              !! (0-1, unitless), parallel computing
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: control_temp_soil_g      !! Temperature control of heterotrophic respiration 
+                                                                              !! (0-1, unitless), parallel computing
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:)        :: npp_equil_g              !! Equilibrium NPP written to forcesoil 
+                                                                              !! @tex $(gC m^{-2} year^{-1})$ @endtex, parallel 
+                                                                              !! computing 
+   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:) :: litter_above_g        !! Above ground metabolic and structural litter 
+                                                                              !! per ground area 
+                                                                              !! @tex $(gC m^{-2})$ @endtex, parallel 
+                                                                              !! computing 
+ 
+   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:,:):: litter_below_g       !! Below ground metabolic and structural litter 
+                                                                              !! per ground area 
+                                                                              !! @tex $(gC m^{-2})$ @endtex, parallel 
+                                                                              !! computing 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)    :: lignin_struc_above_g    !! Ratio Lignine/Carbon in structural litter for above
+                                                                              !! ground compartments (unitless), parallel 
+                                                                              !! computing 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:)  :: lignin_struc_below_g    !! Ratio Lignine/Carbon in structural litter for below
+                                                                              !! ground compartments (unitless), parallel 
+                                                                              !! computing 
+
+
+    REAL(r_std)                                   :: net_cflux_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_cflux_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_harvest_above_monthly_sum !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_harvest_above_monthly_tot !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_biosp_prod_monthly_sum    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std)                                   :: net_biosp_prod_monthly_tot    !! AR5 output?? gC m2 month-1 (one variable for 
+                                                                                   !! reduce_sum and one for bcast??), parallel 
+                                                                                   !! computing 
+    REAL(r_std), DIMENSION(kjpindex,nvm,nbpools)  :: carbon_stock                  !! Array containing the carbon stock for each pool
+                                                                                   !! used by ORCHIDEE
+    INTEGER(i_std), SAVE                          :: spinup_period                 !! Period of years used to calculate the resolution of the system for the spinup analytic.
+                                                                                   !! This period correspond in most cases to the period of years of forcing data used  
+!_ ================================================================================================================================
+    
+  !! 1. Initialize variables
+
+    !! 1.1 Store current time step in a common variable
+    itime = kjit
+    
+    !![DISPENSABLE] 1.2 Copy the depth of the different soil layers from diaglev specified in slow_proc
+															
+    !! 1.3 PFT rooting depth across pixels, humescte is pre-defined 
+    ! (constantes_veg.f90). It is defined as the coefficient of an exponential 
+    ! function relating root density to depth 
+    DO j=1,nvm
+       rprof(:,j) = 1./humcste(j)
+    ENDDO
+    
+    !! 1.4 Initialize first call
+    ! Set growth respiration to zero
+    resp_growth=zero
+    IF (l_first_stomate) THEN
+       IF (long_print) THEN
+          WRITE (numout,*) ' l_first_stomate : call stomate_init'
+       ENDIF
+
+       !! 1.4.0 Parameters for spinup
+       !
+       eps_carbon = 0.01
+       !Config Key   = EPS_CARBON
+       !Config Desc  = Allowed error on carbon stock
+       !Config If    = SPINUP_ANALYTIC
+       !Config Def   = 0.01
+       !Config Help  = 
+       !Config Units = [%]   
+       CALL getin_p('EPS_CARBON',eps_carbon)       
+
+       !Config Key   = SPINUP_PERIOD 
+       !Config Desc  = Period to calulcate equilibrium during spinup analytic 
+       !Config If    = SPINUP_ANALYTIC 
+       !Config Def   = -1 
+       !Config Help  = Period corresponds in most cases to the number of years of forcing data used in the spinup. 
+       !Config Units = [years]    
+       spinup_period = -1 
+       CALL getin_p('SPINUP_PERIOD',spinup_period)        
+      
+       ! Check spinup_period values.  
+       ! For periods uptil 6 years, to obtain equilibrium, a bigger period have to be used  
+       ! and therefore spinup_period is adjusted to 10 years.  
+       IF (spinup_analytic) THEN 
+          IF (spinup_period <= 0) THEN 
+             WRITE(numout,*) 'Error in parameter spinup_period. This parameter must be > 0 : spinup_period=',spinup_period 
+             CALL ipslerr_p (3,'stomate_main', & 
+                  'Parameter spinup_period must be set to a positive integer.', & 
+                  'Set this parameter to the number of years of forcing data used for the spinup.', & 
+                  '')
+          ELSE IF (spinup_period <= 6) THEN 
+             ! Adjust to bigger period. The period must be a multiple of the original period.
+             WRITE( numout,*) 'Initial spinup_period =',spinup_period,' will be adjusted.' 
+             spinup_period = spinup_period*(INT(9/spinup_period)+1)
+          END IF 
+          WRITE(numout,*) 'Spinup analytic is activated using eps_carbon=',eps_carbon, ' and spinup_period=',spinup_period 
+       END IF
+
+       !! 1.4.0 Initialization of PFT specific parameters 
+       ! Initialization of PFT specific parameters that have no value
+       ! for the bare soil PFT i.e. fire resistance, flamability, maximum lai,
+       ! settings for growing degree days (GDD), settings for senescence, 
+       ! respiration coefficients, photosynthesis, etc.
+       ! [DISPENSABLE]
+       
+       !! 1.4.1 Allocate memory for all variables in stomate
+       ! Allocate memory for all variables in stomate, build new index
+       ! tables accounting for the PFTs, read and check flags and set file
+       ! identifier for restart and history files.
+       CALL stomate_init (kjpij, kjpindex, index, ldforcing_write, lalo, &
+            rest_id_stom, hist_id_stom, hist_id_stom_IPCC)
+
+       !! 1.4.2 Initialization of PFT specific parameters
+       ! Initialization of PFT specific parameters i.e. sla from leaf life, 
+       ! sapling characteristics (biomass), migration speed, critical diameter,
+       ! coldest tolerable temperature, critical values for phenology, maximum
+       ! life time of leaves, respiration coefficients and photosynthesis.
+       ! The subroutine also communicates settings read by stomate_constant_init.
+       CALL data (kjpindex, lalo)
+
+       !! 1.4.3 Initial conditions
+       
+       !! 1.4.3.1 Read initial values for STOMATE's variables from the _restart_ file
+       ! ??Shouldn't this be included in stomate_init?? Looks like an initialization!
+       co2_flux(:,:) = zero
+       fco2_lu(:) = zero
+       
+       ! Get values from _restart_ file. Note that only ::kjpindex, ::index, ::lalo 
+       ! and ::resolution are input variables, all others are output variables.
+       CALL readstart &
+            &        (kjpindex, index, lalo, resolution, &
+            &         day_counter_read, dt_days_read, date_read, &
+            &         ind, adapted, regenerate, &
+            &         humrel_daily, gdd_init_date, litterhum_daily, &
+            &         t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+            &         soilhum_daily, precip_daily, &
+            &         gpp_daily, npp_daily, turnover_daily, &
+            &         humrel_month, humrel_week, &
+            &         t2m_longterm, tlong_ref, t2m_month, t2m_week, &
+            &         tsoil_month, soilhum_month, fireindex, firelitter, &
+            &         maxhumrel_lastyear, maxhumrel_thisyear, &
+            &         minhumrel_lastyear, minhumrel_thisyear, &
+            &         maxgppweek_lastyear, maxgppweek_thisyear, &
+            &         gdd0_lastyear, gdd0_thisyear, &
+            &         precip_lastyear, precip_thisyear, &
+            &         gdd_m5_dormance,  gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+            &         PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+            &         maxfpc_lastyear, maxfpc_thisyear, &
+            &         turnover_longterm, gpp_week, biomass, resp_maint_part, &
+            &         leaf_age, leaf_frac, &
+            &         senescence, when_growthinit, age, &
+            &         resp_hetero_d, resp_maint_d, resp_growth_d, co2_fire, co2_to_bm_dgvm, &
+            &         veget_lastlight, everywhere, need_adjacent, RIP_time, &
+            &         time_hum_min, hum_min_dormance, &
+            &         litterpart, litter_above, litter_below, dead_leaves, &
+            &         carbon, DOC, DOC_EXP_d, black_carbon, lignin_struc_above, lignin_struc_below, turnover_time,&
+            &         prod10,prod100,flux10, flux100, &
+            &         convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total, &
+            &         global_years, ok_equilibrium, nbp_accu, nbp_flux, &
+            &         MatrixV, VectorU, previous_stock, current_stock)
+
+       !! 1.4.4 If the vegetation is dynamic
+       ! If the vegetation is dynamic, long-term reference temperature was 
+       ! read by the call above. If vegetation is static then the long-term 
+       ! reference temperature is a boundary condition and read here.  
+       CALL readbc (kjpindex, lalo, resolution, tlong_ref)
+       
+       !! 1.4.5 Check time step
+       
+       !! 1.4.5.1 Allow STOMATE's time step to change although this is dangerous
+       IF (dt_days /= dt_days_read) THEN
+          WRITE(numout,*) 'slow_processes: STOMATE time step changes:', &
+           & dt_days_read,' -> ',dt_days
+       ENDIF
+
+       !! 1.4.5.2 Time step has to be a multiple of a full day
+       IF ( ( dt_days-REAL(NINT(dt_days),r_std) ) > min_stomate ) THEN
+          WRITE(numout,*) 'slow_processes: STOMATE time step is not a mutiple of a full day:', &
+           & dt_days,' days.'
+          STOP
+       ENDIF
+
+       !! 1.4.5.3 upper limit to STOMATE's time step
+       IF ( dt_days > max_dt_days ) THEN
+          WRITE(numout,*) 'slow_processes: STOMATE time step exceeds the maximum value:', &
+           & dt_days,' days > ', max_dt_days, ' days.'  
+          STOP
+       ENDIF
+
+       !! 1.4.5.4 STOMATE time step must not be less than the forcing time step
+       IF ( dtradia > dt_days*one_day ) THEN
+          WRITE(numout,*) &
+            & 'slow_processes: STOMATE time step ::dt_days smaller than forcing time step ::dtradia'
+          STOP
+       ENDIF
+
+       !! 1.4.5.5 For teststomate : test day_counter
+       IF ( abs(day_counter - day_counter_read) > min_stomate ) THEN
+          WRITE(numout,*) 'slow_processes: STOMATE day counter changes:', &
+               day_counter_read,' -> ',day_counter
+       ENDIF
+
+       !! 1.4.5.6 Date check
+       IF (date /= date_read) THEN
+          WRITE(numout,*) 'Slow_processes: STOMATE date changes:', &
+               date_read,' -> ',date
+       ENDIF
+
+       !! 1.4.5.6 Final message on time step
+       WRITE(numout,*) 'Slow_processes, STOMATE time step (days): ', dt_days
+
+       !! 1.4.6 Write forcing file for stomate?
+       IF (ldforcing_write) THEN
+
+          !Config Key   = STOMATE_FORCING_NAME
+          !Config Desc  = Name of STOMATE's forcing file
+          !Config If    = OK_STOMATE
+          !Config Def   = NONE
+          !Config Help  = Name that will be given
+          !Config         to STOMATE's offline forcing file
+          !Config         Compatible with Nicolas Viovy's driver
+          !Config Units = [FILE]
+          forcing_name = stomate_forcing_name
+          CALL getin_p('STOMATE_FORCING_NAME',forcing_name)
+
+          IF ( TRIM(forcing_name) /= 'NONE' ) THEN
+             
+             !! 1.4.6.1 Calculate steps that can be stored in memory
+             ! Action for the root processor only (parallel computing)  
+             IF (is_root_prc) CALL SYSTEM ('rm -f '//TRIM(forcing_name))
+             WRITE(numout,*) 'writing a forcing file for STOMATE.'
+
+             !Config Key   = STOMATE_FORCING_MEMSIZE
+             !Config Desc  = Size of STOMATE forcing data in memory 
+             !Config If    = OK_STOMATE
+             !Config Def   = 50
+             !Config Help  = This variable determines how many
+             !Config         forcing states will be kept in memory.
+             !Config         Must be a compromise between memory
+             !Config         use and frequeny of disk access.
+             !Config Units = [MegaBytes]
+             max_totsize = 50
+             CALL getin_p('STOMATE_FORCING_MEMSIZE', max_totsize)      
+             max_totsize = max_totsize*1000000
+
+             totsize_1step = &
+                  &      SIZE(clay)*KIND(clay) &
+                  &     + SIZE(soil_ph)*KIND(soil_ph) &
+                  &      +SIZE(bulk_dens)*KIND(bulk_dens) &
+                  &           +SIZE(humrel_daily)*KIND(humrel_daily) &
+                  &     +SIZE(litterhum_daily)*KIND(litterhum_daily) &
+                  &     +SIZE(t2m_daily)*KIND(t2m_daily) &
+                  &     +SIZE(t2m_min_daily)*KIND(t2m_min_daily) &
+                  &     +SIZE(tsurf_daily)*KIND(tsurf_daily) &
+                  &     +SIZE(tsoil_daily)*KIND(tsoil_daily) &
+                  &     +SIZE(soilhum_daily)*KIND(soilhum_daily) &
+                  &     +SIZE(precip_daily)*KIND(precip_daily) &
+                  &     +SIZE(gpp_daily_x)*KIND(gpp_daily_x) &
+                  &     +SIZE(veget)*KIND(veget) &
+                  &     +SIZE(veget_max)*KIND(veget_max) &
+                  &     +SIZE(lai)*KIND(lai)
+             
+             ! Totsize_1step is the size on a single processor, sum
+             ! all processors and send to all processors
+             CALL reduce_sum(totsize_1step,totsize_tmp)
+             CALL bcast(totsize_tmp)
+             totsize_1step=totsize_tmp
+ 
+             ! Total number of forcing steps
+             nsft = INT(one_year/(dt_slow/one_day))
+
+             ! Number of forcing steps in memory
+             nsfm = MIN(nsft, &
+                  &       MAX(1,NINT( REAL(max_totsize,r_std) &
+                  &                  /REAL(totsize_1step,r_std))))
+            
+             
+	     !! 1.6.4.2 Allocate memory for variables containing forcing data  
+             ! and initialize variables (set to zero).
+             CALL init_forcing (kjpindex,nsfm,nsft)
+             
+             ! Indexing for writing forcing file
+             isf(:) = (/ (i,i=1,nsfm) /)
+             nf_written(:) = .FALSE.
+             nf_cumul(:) = 0
+             iisf = 0
+
+             !! 1.6.4.3 Create netcdf file
+             ! Create, define and populate a netcdf file containing the forcing data.
+             ! For the root processor only (parallel computing). NF90_ are functions
+             ! from and external library.  
+             IF (is_root_prc) THEN
+
+                ! Create new netCDF dataset
+                ier = NF90_CREATE (TRIM(forcing_name),NF90_SHARE,forcing_id)
+
+                ! Add variable attribute
+                ! Note ::iim_g and ::jjm_g are dimensions of the global field and 
+                ! ::nbp_glo is the number of global continental points
+                ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL,'dtradia',dtradia)
+                ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL,'dt_slow',dt_slow)
+                ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, &
+                     & 'nsft',REAL(nsft,r_std))
+                ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, &
+                     & 'kjpij',REAL(iim_g*jjm_g,r_std))
+                ier = NF90_PUT_ATT (forcing_id,NF90_GLOBAL, &
+                     & 'kjpindex',REAL(nbp_glo,r_std))
+ 
+                ! Add new dimension
+                ier = NF90_DEF_DIM (forcing_id,'points',nbp_glo,d_id(1))
+                ier = NF90_DEF_DIM (forcing_id,'layers',nbdl,d_id(2))
+                ier = NF90_DEF_DIM (forcing_id,'pft',nvm,d_id(3))
+                direct=2
+                ier = NF90_DEF_DIM (forcing_id,'direction',direct,d_id(4))
+                nneigh=8
+                ier = NF90_DEF_DIM (forcing_id,'nneigh',nneigh,d_id(5))
+                ier = NF90_DEF_DIM (forcing_id,'time',NF90_UNLIMITED,d_id(6))
+                ier = NF90_DEF_DIM (forcing_id,'nbparts',nparts,d_id(7))
+
+                ! Add new variable
+                ier = NF90_DEF_VAR (forcing_id,'points',    r_typ,d_id(1),vid)
+                ier = NF90_DEF_VAR (forcing_id,'layers',    r_typ,d_id(2),vid)
+                ier = NF90_DEF_VAR (forcing_id,'pft',       r_typ,d_id(3),vid)
+                ier = NF90_DEF_VAR (forcing_id,'direction', r_typ,d_id(4),vid)
+                ier = NF90_DEF_VAR (forcing_id,'nneigh',    r_typ,d_id(5),vid)
+                ier = NF90_DEF_VAR (forcing_id,'time',      r_typ,d_id(6),vid)
+                ier = NF90_DEF_VAR (forcing_id,'nbparts',   r_typ,d_id(7),vid)
+                ier = NF90_DEF_VAR (forcing_id,'index',     r_typ,d_id(1),vid)
+                ier = NF90_DEF_VAR (forcing_id,'contfrac',  r_typ,d_id(1),vid) 
+                ier = NF90_DEF_VAR (forcing_id,'lalo', &
+                     & r_typ,(/ d_id(1),d_id(4) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'neighbours', &
+                     & r_typ,(/ d_id(1),d_id(5) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'resolution', &
+                     & r_typ,(/ d_id(1),d_id(4) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'clay', &
+                     & r_typ,(/ d_id(1),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'bulk_dens', &
+                     & r_typ,(/ d_id(1),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'soil_ph', &
+                     & r_typ,(/ d_id(1),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'humrel', &
+                     & r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'litterhum', &
+                     & r_typ,(/ d_id(1),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'t2m', &
+                     & r_typ,(/ d_id(1),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'t2m_min', &
+                     & r_typ,(/ d_id(1),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'tsurf', &
+                     & r_typ,(/ d_id(1),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'tsoil', &
+                     & r_typ,(/ d_id(1),d_id(2),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'soilhum', &
+                     & r_typ,(/ d_id(1),d_id(2),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'precip', &
+                     & r_typ,(/ d_id(1),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'gpp', &
+                     & r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'veget', &
+                     & r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'veget_max', &
+                     & r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+                ier = NF90_DEF_VAR (forcing_id,'lai', &
+                     & r_typ,(/ d_id(1),d_id(3),d_id(6) /),vid)
+                ier = NF90_ENDDEF (forcing_id)
+                
+		! Given the name of a varaible, nf90_inq_varid finds the variable 
+                ! ID (::vid). Put data value(s) into variable ::vid
+                ier = NF90_INQ_VARID (forcing_id,'points',vid)
+                ier = NF90_PUT_VAR (forcing_id,vid, &
+                     & (/(REAL(i,r_std),i=1,nbp_glo) /))
+                ier = NF90_INQ_VARID (forcing_id,'layers',vid)
+                ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nbdl)/))
+                ier = NF90_INQ_VARID (forcing_id,'pft',vid)
+                ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nvm)/))
+                ier = NF90_INQ_VARID (forcing_id,'direction',vid)
+                ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,2)/))
+                ier = NF90_INQ_VARID (forcing_id,'nneigh',vid)
+                ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,8)/))
+                ier = NF90_INQ_VARID (forcing_id,'time',vid)
+                ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nsft)/))
+                ier = NF90_INQ_VARID (forcing_id,'nbparts',vid)
+                ier = NF90_PUT_VAR (forcing_id,vid,(/(REAL(i,r_std),i=1,nparts)/))
+                ier = NF90_INQ_VARID (forcing_id,'index',vid)  
+                ier = NF90_PUT_VAR (forcing_id,vid,REAL(index_g,r_std))
+                ier = NF90_INQ_VARID (forcing_id,'contfrac',vid)
+                ier = NF90_PUT_VAR (forcing_id,vid,REAL(contfrac_g,r_std))
+                ier = NF90_INQ_VARID (forcing_id,'lalo',vid)
+                ier = NF90_PUT_VAR (forcing_id,vid,lalo_g)
+                !ym attention a neighbours, a modifier plus tard      
+                ier = NF90_INQ_VARID (forcing_id,'neighbours',vid)
+                ier = NF90_PUT_VAR (forcing_id,vid,REAL(neighbours_g,r_std))
+                ier = NF90_INQ_VARID (forcing_id,'resolution',vid)
+                ier = NF90_PUT_VAR (forcing_id,vid,resolution_g)
+             ENDIF ! is_root_prc
+          ENDIF ! (forcing_name) /= 'NONE'
+       ENDIF ! ldforcing_write =.TRUE.
+       
+       !! 1.4.7 write forcing file for the soil?
+       IF (ldcarbon_write) THEN
+          
+          !! 1.4.7.1 Initialize
+          !Config Key   = STOMATE_CFORCING_NAME
+          !Config Desc  = Name of STOMATE's carbon forcing file
+          !Config If    = OK_STOMATE
+          !Config Def   = NONE
+          !Config Help  = Name that will be given to STOMATE's carbon
+          !Config         offline forcing file
+          !Config         Compatible with Nicolas Viovy's driver
+          !Config Units = [FILE]
+          Cforcing_name = stomate_Cforcing_name
+          CALL getin_p('STOMATE_CFORCING_NAME',Cforcing_name)
+
+          IF ( TRIM(Cforcing_name) /= 'NONE' ) THEN
+  
+             ! Time step of forcesoil
+             !Config Key   = FORCESOIL_STEP_PER_YEAR
+             !Config Desc  = Number of time steps per year for carbon spinup.
+             !Config If    = OK_STOMATE
+             !Config Def   = 365
+             !Config Help  = Number of time steps per year for carbon spinup.
+             !Config Units = [days, months, year]
+             nparan = 365
+             CALL getin_p('FORCESOIL_STEP_PER_YEAR', nparan)
+             
+             ! Correct if setting is out of bounds 
+             IF ( nparan < 1 ) nparan = 1
+
+             !Config Key   = FORCESOIL_NB_YEAR
+             !Config Desc  = Number of years saved for carbon spinup.
+             !Config If    = OK_STOMATE
+             !Config Def   = 1
+             !Config Help  = Number of years saved for carbon spinup. If internal parameter cumul_Cforcing is TRUE in stomate.f90
+             !Config         Then this parameter is forced to one.
+             !Config Units = [years]
+             CALL getin_p('FORCESOIL_NB_YEAR', nbyear)
+             
+             ! Set ::nbyear to 1. if ::cumul_Cforcing=.TRUE.
+             IF ( cumul_Cforcing ) THEN
+                CALL ipslerr_p (1,'stomate', &
+                     &          'Internal parameter cumul_Cforcing is TRUE in stomate.f90', &
+                     &          'Parameter FORCESOIL_NB_YEAR is therefore forced to 1.', &
+                     &          '::nbyear is thus set to 1.')
+                nbyear=1
+             ENDIF
+
+             ! Make use of ::nparan to calculate ::dt_forcesoil
+             dt_forcesoil = zero
+             nparan = nparan+1
+             DO WHILE ( dt_forcesoil < dt_slow/one_day )
+                nparan = nparan-1
+                IF ( nparan < 1 ) THEN
+                   STOP 'Problem with number of soil forcing time steps ::nparan < 1.'
+                ENDIF
+                dt_forcesoil = one_year/REAL(nparan,r_std)
+             ENDDO
+             IF ( nparan > nparanmax ) THEN
+                STOP 'Problem with number of soil forcing time steps ::nparan > ::nparanmax'
+             ENDIF
+             WRITE(numout,*) 'Time step of soil forcing (d): ',dt_forcesoil
+
+             ! Allocate memory for the forcing variables of soil dynamics
+             ALLOCATE( nforce(nparan*nbyear))
+             nforce(:) = 0
+             ALLOCATE(control_moist_above(kjpindex,nvm,nparan*nbyear)) 
+             ALLOCATE(control_moist_soil(kjpindex,nbdl,nvm,nparan*nbyear))
+             ALLOCATE(moist_soil(kjpindex,nbdl,nparan*nbyear))
+             ALLOCATE(soil_mc_Cforcing(kjpindex,nbdl,nstm,nparan*nbyear))
+             ALLOCATE(floodout_Cforcing(kjpindex,nparan*nbyear))
+             ALLOCATE(wat_flux0_Cforcing(kjpindex,nstm,nparan*nbyear))
+             ALLOCATE(wat_flux_Cforcing(kjpindex,nbdl,nstm,nparan*nbyear))
+             ALLOCATE(runoff_per_soil_Cforcing(kjpindex,nstm,nparan*nbyear))
+             ALLOCATE(drainage_per_soil_Cforcing(kjpindex,nstm,nparan*nbyear))
+             ALLOCATE(DOC_to_topsoil_Cforcing(kjpindex,nelements,nparan*nbyear))
+             ALLOCATE(DOC_to_subsoil_Cforcing(kjpindex,nelements,nparan*nbyear))
+             ALLOCATE(npp_equil(kjpindex,nparan*nbyear))
+             ALLOCATE(npp_tot(kjpindex))
+             ALLOCATE(control_temp_above(kjpindex,nlitt,nparan*nbyear))
+             ALLOCATE(control_temp_soil(kjpindex,nbdl,npool*2,nparan*nbyear))
+             ALLOCATE(soilcarbon_input(kjpindex,nvm,nbdl,npool,nelements,nparan*nbyear)) 
+             ALLOCATE(litter_above_Cforcing(kjpindex,nlitt,nvm,nelements,nparan*nbyear))  
+             ALLOCATE(litter_below_Cforcing(kjpindex,nlitt,nvm,nbdl,nelements,nparan*nbyear))
+             ALLOCATE(lignin_struc_above_Cforcing(kjpindex,nvm,nparan*nbyear))           
+             ALLOCATE(lignin_struc_below_Cforcing(kjpindex,nvm,nbdl,nparan*nbyear))
+
+             ! Initialize variables, set to zero
+             control_moist_above(:,:,:) = zero
+             control_moist_soil(:,:,:,:) = zero
+             moist_soil(:,:,:) = zero
+             soil_mc_Cforcing(:,:,:,:) = zero
+             floodout_Cforcing(:,:) = zero
+             wat_flux0_Cforcing(:,:,:) = zero
+             wat_flux_Cforcing(:,:,:,:) = zero
+             runoff_per_soil_Cforcing(:,:,:) = zero
+             drainage_per_soil_Cforcing(:,:,:) = zero
+             DOC_to_topsoil_Cforcing(:,:,:) = zero
+             DOC_to_subsoil_Cforcing(:,:,:) = zero
+             npp_equil(:,:) = zero
+             npp_tot(:) = zero
+             control_temp_above(:,:,:) = zero 
+             control_temp_soil(:,:,:,:) = zero
+             soilcarbon_input(:,:,:,:,:,:) = zero
+             litter_above_Cforcing(:,:,:,:,:) = zero
+             litter_below_Cforcing(:,:,:,:,:,:) = zero
+             lignin_struc_above_Cforcing(:,:,:) = zero
+             lignin_struc_below_Cforcing(:,:,:,:) = zero
+
+          ENDIF ! Cforcing_name) /= 'NONE'
+       ENDIF ! ::ldcarbon_write!.TRUE.
+       
+       !! 1.4.8 Calculate STOMATE's vegetation fractions from veget, veget_max
+       DO j=1,nvm
+          WHERE ((1.-totfrac_nobio(:)) > min_sechiba)       
+             ! Pixels with vegetation
+             veget_cov(:,j) = veget(:,j)/( 1.-totfrac_nobio(:) )
+             veget_cov_max(:,j) = veget_max(:,j)/( 1.-totfrac_nobio(:) )
+          ELSEWHERE
+             ! Pixels without vegetation
+             veget_cov(:,j) = zero
+             veget_cov_max(:,j) = zero
+          ENDWHERE
+       ENDDO ! Loop over PFTs
+       IF ( EndOfYear ) THEN
+          DO j=1,nvm
+             WHERE ((1.-totfrac_nobio_new(:)) > min_sechiba)
+                ! Update pixels with vegetation
+                veget_cov_max_new(:,j) = veget_max_new(:,j)/( 1.-totfrac_nobio_new(:) )
+             ELSEWHERE
+                ! Update pixels without vegetation
+                veget_cov_max_new(:,j) = zero
+             ENDWHERE
+          ENDDO
+       ENDIF
+       
+       !! 1.4.9 Initialize non-zero variables
+       IF (control%ok_stomate) THEN
+          CALL stomate_var_init &
+               &         (kjpindex, veget_cov_max, leaf_age, leaf_frac, &
+               &          tlong_ref, t2m_month, dead_leaves, &
+               &          veget, lai, deadleaf_cover, assim_param)
+          ! Initialize land cover change variable
+          ! ??Should be integrated in the subroutine?? 
+          harvest_above(:) = zero
+       ENDIF
+
+       !! 1.4.10 Update flag
+       l_first_stomate = .FALSE.
+      
+       RETURN ! Out of stomate main
+    ENDIF  ! First call
+
+
+    IF (bavard >= 4) THEN
+       WRITE(numout,*) 'DATE ',date,' ymds', year, month, day, sec, '-- stp --', itime, do_slow
+    ENDIF
+
+
+  !! 2. Prepares restart file for the next simulation
+
+    !! 2.1 Write restart file for stomate
+    IF (ldrestart_write) THEN
+       IF (long_print) THEN
+          WRITE (numout,*) &
+               &      ' Write a restart file for STOMATE'
+       ENDIF
+       CALL writerestart &
+            &         (kjpindex, index, &
+            &          day_counter, dt_days, date, &
+            &          ind, adapted, regenerate, &
+            &          humrel_daily, gdd_init_date, litterhum_daily, &
+            &          t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+            &          soilhum_daily, precip_daily, &
+            &          gpp_daily, npp_daily, turnover_daily, &
+            &          humrel_month, humrel_week, &
+            &          t2m_longterm, tlong_ref, t2m_month, t2m_week, &
+            &          tsoil_month, soilhum_month, fireindex, firelitter, &
+            &          maxhumrel_lastyear, maxhumrel_thisyear, &
+            &          minhumrel_lastyear, minhumrel_thisyear, &
+            &          maxgppweek_lastyear, maxgppweek_thisyear, &
+            &          gdd0_lastyear, gdd0_thisyear, &
+            &          precip_lastyear, precip_thisyear, &
+            &          gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+            &          PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+            &          maxfpc_lastyear, maxfpc_thisyear, &
+            &          turnover_longterm, gpp_week, biomass, resp_maint_part, &
+            &          leaf_age, leaf_frac, &
+            &          senescence, when_growthinit, age, &
+            &          resp_hetero_d, resp_maint_d, resp_growth_d, co2_fire, co2_to_bm_dgvm, &
+            &          veget_lastlight, everywhere, need_adjacent, &
+            &          RIP_time, &
+            &          time_hum_min, hum_min_dormance, &
+            &          litterpart, litter_above, litter_below, dead_leaves, &
+            &          carbon, DOC, DOC_EXP_d, black_carbon, lignin_struc_above, lignin_struc_below, turnover_time,&
+            &          prod10,prod100,flux10, flux100, &
+            &          convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total, &
+            &          global_years, ok_equilibrium, nbp_accu, nbp_flux, &
+            &          MatrixV, VectorU, previous_stock, current_stock)
+       
+       !! 2.2 Write file with variables that force general processes in stomate
+       IF (ldforcing_write .AND. TRIM(forcing_name) /= 'NONE' ) THEN  
+          CALL forcing_write(forcing_id,1,iisf)
+          ! Close forcing file
+          IF (is_root_prc) ier = NF90_CLOSE (forcing_id)
+          forcing_id=-1
+       ENDIF
+
+       !! 2.3 Collect variables that force the soil processes in stomate
+       IF (ldcarbon_write .AND. TRIM(Cforcing_name) /= 'NONE' ) THEN 
+          
+          !! 2.3.1 Collet variables 
+          WRITE(numout,*) &
+               &      'stomate: writing the forcing file for carbon spinup'
+          DO iatt = 1, nparan*nbyear
+             IF ( nforce(iatt) > 0 ) THEN
+                soilcarbon_input(:,:,:,:,:,iatt) = &
+                     & soilcarbon_input(:,:,:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                litter_above_Cforcing(:,:,:,:,iatt) = &
+                     & litter_above_Cforcing(:,:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                litter_below_Cforcing(:,:,:,:,:,iatt) = &
+                     & litter_below_Cforcing(:,:,:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                control_moist_above(:,:,iatt) = & 
+                     & control_moist_above(:,:,iatt)/REAL(nforce(iatt),r_std)
+                control_moist_soil(:,:,:,iatt) = &
+                     & control_moist_soil(:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                moist_soil(:,:,iatt) = &
+                     & moist_soil(:,:,iatt)/REAL(nforce(iatt),r_std)
+                soil_mc_Cforcing(:,:,:,iatt) = &
+                     & soil_mc_Cforcing(:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                floodout_Cforcing(:,iatt) = &
+                     & floodout_Cforcing(:,iatt)/REAL(nforce(iatt),r_std)
+                wat_flux0_Cforcing(:,:,iatt) = &
+                     & wat_flux0_Cforcing(:,:,iatt)/REAL(nforce(iatt),r_std)
+                wat_flux_Cforcing(:,:,:,iatt) = &
+                     & wat_flux_Cforcing(:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                runoff_per_soil_Cforcing(:,:,iatt) = &
+                     & runoff_per_soil_Cforcing(:,:,iatt)/REAL(nforce(iatt),r_std)
+                drainage_per_soil_Cforcing(:,:,iatt) = &
+                     & drainage_per_soil_Cforcing(:,:,iatt)/REAL(nforce(iatt),r_std)
+                DOC_to_topsoil_Cforcing(:,:,iatt) = &
+                     & DOC_to_topsoil_Cforcing(:,:,iatt)/REAL(nforce(iatt),r_std)
+                DOC_to_subsoil_Cforcing(:,:,iatt) = &
+                     & DOC_to_subsoil_Cforcing(:,:,iatt)/REAL(nforce(iatt),r_std)
+                control_temp_above(:,:,iatt) = & 
+                     & control_temp_above(:,:,iatt)/REAL(nforce(iatt),r_std) 
+                control_temp_soil(:,:,:,iatt) = &
+                     & control_temp_soil(:,:,:,iatt)/REAL(nforce(iatt),r_std)
+                npp_equil(:,iatt) = &
+                     & npp_equil(:,iatt)/REAL(nforce(iatt),r_std)
+                lignin_struc_above_Cforcing(:,:,iatt) = &
+                     & lignin_struc_above_Cforcing(:,:,iatt)/REAL(nforce(iatt),r_std)
+                lignin_struc_below_Cforcing(:,:,:,iatt) = &
+                     & lignin_struc_below_Cforcing(:,:,:,iatt)/REAL(nforce(iatt),r_std)
+             ELSE
+                WRITE(numout,*) &
+                     &         'We have no soil carbon forcing data for this time step:', &
+                     &         iatt
+                WRITE(numout,*) ' -> we set them to zero'
+                soilcarbon_input(:,:,:,:,:,iatt) = zero
+                litter_above_Cforcing(:,:,:,:,iatt) = zero
+                litter_below_Cforcing(:,:,:,:,:,iatt) = zero
+                control_moist_above(:,:,iatt) = zero
+                control_moist_soil(:,:,:,iatt) = zero
+                moist_soil(:,:,iatt) = zero
+                soil_mc_Cforcing(:,:,:,iatt) = zero
+                floodout_Cforcing(:,iatt) = zero
+                wat_flux0_Cforcing(:,:,iatt) = zero
+                wat_flux_Cforcing(:,:,:,iatt) = zero
+                runoff_per_soil_Cforcing(:,:,iatt) = zero
+                drainage_per_soil_Cforcing(:,:,iatt) = zero
+                DOC_to_topsoil_Cforcing(:,:,iatt) = zero
+                DOC_to_subsoil_Cforcing(:,:,iatt) = zero
+                control_temp_above(:,:,iatt) = zero
+                control_temp_soil(:,:,:,iatt) = zero
+                npp_equil(:,iatt) = zero
+                lignin_struc_above_Cforcing(:,:,iatt) = zero
+                lignin_struc_below_Cforcing(:,:,:,iatt) = zero
+             ENDIF
+          ENDDO
+
+          ! Allocate memory for parallel computing
+          IF (is_root_prc) THEN
+             ALLOCATE(soilcarbon_input_g(nbp_glo,nvm,nbdl,npool,nelements,nparan*nbyear))
+             ALLOCATE(control_moist_above_g(nbp_glo,nvm,nparan*nbyear))
+             ALLOCATE(control_moist_soil_g(nbp_glo,nbdl,nvm,nparan*nbyear))
+             ALLOCATE(moist_soil_g(nbp_glo,nbdl,nparan*nbyear))
+             ALLOCATE(soil_mc_Cforcing_g(nbp_glo,nbdl,nstm,nparan*nbyear))
+             ALLOCATE(floodout_Cforcing_g(nbp_glo,nparan*nbyear))
+             ALLOCATE(wat_flux0_Cforcing_g(nbp_glo,nstm,nparan*nbyear))
+             ALLOCATE(wat_flux_Cforcing_g(nbp_glo,nbdl,nstm,nparan*nbyear))
+             ALLOCATE(runoff_per_soil_Cforcing_g(nbp_glo,nstm,nparan*nbyear))
+             ALLOCATE(drainage_per_soil_Cforcing_g(nbp_glo,nstm,nparan*nbyear))
+             ALLOCATE(DOC_to_topsoil_Cforcing_g(nbp_glo,nelements,nparan*nbyear))
+             ALLOCATE(DOC_to_subsoil_Cforcing_g(nbp_glo,nelements,nparan*nbyear))
+             ALLOCATE(control_temp_above_g(nbp_glo,nlitt,nparan*nbyear))
+             ALLOCATE(control_temp_soil_g(nbp_glo,nbdl,npool*2,nparan*nbyear))
+             ALLOCATE(npp_equil_g(nbp_glo,nparan*nbyear))
+             ALLOCATE(litter_above_g(nbp_glo,nlitt,nvm,nelements,nparan*nbyear))
+             ALLOCATE(litter_below_g(nbp_glo,nlitt,nvm,nbdl,nelements,nparan*nbyear))
+             ALLOCATE(lignin_struc_above_g(nbp_glo,nvm,nparan*nbyear))
+             ALLOCATE(lignin_struc_below_g(nbp_glo,nvm,nbdl,nparan*nbyear))
+          ENDIF
+
+          ! Gather distributed variables
+          CALL gather(clay,clay_g)
+          CALL gather(control_moist_above,control_moist_above_g)
+          CALL gather(soil_ph,soil_ph_g)
+          CALL gather(bulk_dens, bulk_dens_g)
+          CALL gather(soiltile,soiltile_g)
+          CALL gather(veget_max,veget_max_g)
+          DO k= 1,nvm
+             DO i =1,npool
+                DO j=1,nbdl
+          CALL gather(soilcarbon_input(:,k,j,i,:,:),soilcarbon_input_g(:,k,j,i,:,:))
+                ENDDO
+             ENDDO
+          ENDDO
+          DO i =1,nlitt
+             DO j=1,nvm
+          CALL gather(litter_above_Cforcing(:,i,j,:,:),litter_above_g(:,i,j,:,:))
+             ENDDO
+          ENDDO
+          DO i =1,nlitt
+             DO j=1,nvm
+                DO k = 1,nbdl
+          CALL gather(litter_below_Cforcing(:,i,j,k,:,:),litter_below_g(:,i,j,k,:,:))
+                ENDDO
+             ENDDO
+          ENDDO
+          CALL gather(control_moist_soil,control_moist_soil_g)
+          CALL gather(moist_soil,moist_soil_g)
+          CALL gather(soil_mc_Cforcing,soil_mc_Cforcing_g)
+          CALL gather(floodout_Cforcing,floodout_Cforcing_g)
+          CALL gather(wat_flux0_Cforcing,wat_flux0_Cforcing_g)
+          DO j= 1, nbdl
+             DO i = 1, nstm
+          CALL gather(wat_flux_Cforcing(:,j,i,:),wat_flux_Cforcing_g(:,j,i,:))
+             ENDDO
+          ENDDO
+          CALL gather(runoff_per_soil_Cforcing,runoff_per_soil_Cforcing_g)
+          CALL gather(drainage_per_soil_Cforcing,drainage_per_soil_Cforcing_g)
+          CALL gather(DOC_to_topsoil_Cforcing,DOC_to_topsoil_Cforcing_g)
+          CALL gather(DOC_to_subsoil_Cforcing,DOC_to_subsoil_Cforcing_g)
+          DO k = 1, nlitt
+             CALL gather(control_temp_above(:,k,:),control_temp_above_g(:,k,:))
+          ENDDO
+          DO k = 1,2*npool
+             CALL gather(control_temp_soil(:,:,k,:),control_temp_soil_g(:,:,k,:))
+          ENDDO
+          CALL gather(npp_equil,npp_equil_g)
+          DO j=1,nvm
+             DO k = 1,nbdl
+          CALL gather(lignin_struc_below_Cforcing(:,j,k,:),lignin_struc_below_g(:,j,k,:))
+             ENDDO
+          ENDDO          
+          DO j=1,nvm
+          CALL gather(lignin_struc_above_Cforcing(:,j,:),lignin_struc_above_g(:,j,:))
+          ENDDO  
+
+         !! 2.3.2 Create netcdf
+          ! Create, define and populate a netcdf file containing the forcing data.
+          ! For the root processor only (parallel computing). NF90_ are functions
+          ! from and external library.  
+          IF (is_root_prc) THEN
+             WRITE (numout,*) 'Create Cforcing file : ',TRIM(Cforcing_name)
+             ! Create new netCDF dataset
+             ier = NF90_CREATE (TRIM(Cforcing_name),NF90_64BIT_OFFSET ,Cforcing_id)
+             IF (ier /= NF90_NOERR) THEN
+                WRITE (numout,*) 'Error in creating Cforcing file : ',TRIM(Cforcing_name)
+                CALL ipslerr_p (3,'stomate_main', &
+                     &        'PROBLEM creating Cforcing file', &
+                     &        NF90_STRERROR(ier),'')
+             END IF
+
+             ! Add variable attribute
+             ! Note ::nbp_glo is the number of global continental points
+             ier = NF90_PUT_ATT (Cforcing_id,NF90_GLOBAL, &
+                  &                        'kjpindex',REAL(nbp_glo,r_std))
+             ier = NF90_PUT_ATT (Cforcing_id,NF90_GLOBAL, &
+                  &                        'nparan',REAL(nparan,r_std))
+             ier = NF90_PUT_ATT (Cforcing_id,NF90_GLOBAL, &
+                  &                        'nbyear',REAL(nbyear,r_std))
+             
+             ! Add new dimension
+             ier = NF90_DEF_DIM (Cforcing_id,'points',nbp_glo,d_id(1))
+             ier = NF90_DEF_DIM (Cforcing_id,'carbtype',ncarb,d_id(2))
+             ier = NF90_DEF_DIM (Cforcing_id,'vegtype',nvm,d_id(3))
+             ier = NF90_DEF_DIM (Cforcing_id,'level',nlevs,d_id(4))
+             ier = NF90_DEF_DIM (Cforcing_id,'time_step',NF90_UNLIMITED,d_id(5))
+             ier = NF90_DEF_DIM (Cforcing_id,'solay',nbdl,d_id(6))
+             ier = NF90_DEF_DIM (Cforcing_id,'elements',nelements,d_id(7))
+             ier = NF90_DEF_DIM (Cforcing_id,'littertype',nlitt,d_id(8))
+             ier = NF90_DEF_DIM (Cforcing_id,'soiltype',nstm,d_id(9))
+             ier = NF90_DEF_DIM (Cforcing_id,'pooltype',npool,d_id(10))
+             ier = NF90_DEF_DIM (Cforcing_id,'dblepooltype',2*npool,d_id(11))
+             ! Add new variable
+             ier = NF90_DEF_VAR (Cforcing_id,'points',    r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'carbtype',  r_typ,d_id(2),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'vegtype',   r_typ,d_id(3),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'level',     r_typ,d_id(4),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'time_step', r_typ,d_id(5),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'solay',     r_typ,d_id(6),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'elements',  r_typ,d_id(7),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'littertype',r_typ,d_id(8),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'soiltype',  r_typ,d_id(9),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'pooltype',  r_typ,d_id(10),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'dblepooltype',  r_typ,d_id(11),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'index',     r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'clay',      r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'bulk_dens', r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'soil_ph',   r_typ,d_id(1),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'soiltile', r_typ, &
+                  &                        (/d_id(1),d_id(9) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'veget_max', r_typ, &
+                  &                        (/d_id(1),d_id(3) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'soilcarbon_input',r_typ, &
+                  &                        (/ d_id(1),d_id(3),d_id(6),d_id(10),d_id(7), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'control_moist_above',r_typ, & 
+                  &                        (/ d_id(1),d_id(3),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'control_moist_soil',r_typ, &
+                  &                        (/ d_id(1),d_id(6),d_id(3),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'moist_soil',r_typ, &
+                  &                        (/ d_id(1),d_id(6),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'soil_mc',r_typ, &
+                  &                        (/ d_id(1),d_id(6),d_id(9),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'floodout',r_typ, &
+                  &                        (/ d_id(1),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'wat_flux0',r_typ, &
+                  &                        (/ d_id(1),d_id(9), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'wat_flux',r_typ, &
+                  &                        (/ d_id(1),d_id(6),d_id(9), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'runoff_per_soil',r_typ, &
+                  &                        (/ d_id(1),d_id(9), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'drainage_per_soil',r_typ, &
+                  &                        (/ d_id(1),d_id(9), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'DOC_to_topsoil',r_typ, &
+                  &                        (/ d_id(1),d_id(7), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'DOC_to_subsoil',r_typ, &
+                  &                        (/ d_id(1),d_id(7), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'control_temp_above',r_typ, & 
+                  &                        (/ d_id(1),d_id(8),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'control_temp_soil',r_typ, &
+                  &                        (/ d_id(1),d_id(6),d_id(11),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'npp_equil',r_typ, &
+                  &                        (/ d_id(1),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'litter_above',r_typ, &
+                  &                        (/ d_id(1),d_id(8),d_id(3),d_id(7), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'litter_below',r_typ, &
+                  &                        (/ d_id(1),d_id(8),d_id(3),d_id(6),d_id(7), d_id(5) /),vid)             
+             ier = NF90_DEF_VAR (Cforcing_id,'lignin_struc_below',r_typ, &
+                  &                        (/ d_id(1),d_id(3),d_id(6), d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'lignin_struc_above',r_typ, &
+                  &                        (/ d_id(1),d_id(3), d_id(5) /),vid)
+             ier = NF90_ENDDEF (Cforcing_id)
+             ! Given the name of a varaible, nf90_inq_varid finds the variable 
+             ! ID (::vid). Put data value(s) into variable ::vid 
+             ier = NF90_INQ_VARID (Cforcing_id,'points',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nbp_glo)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'carbtype',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                        (/(REAL(i,r_std),i=1,ncarb)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'vegtype',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                            (/(REAL(i,r_std),i=1,nvm)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'level',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nlevs)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'time_step',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nparan*nbyear)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'solay',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nbdl)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'elements',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nelements)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'littertype',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nlitt)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'soiltype',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,nstm)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'pooltype',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,npool)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'dblepooltype',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, &
+                  &                          (/(REAL(i,r_std),i=1,2*npool)/))
+             ier = NF90_INQ_VARID (Cforcing_id,'index',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, REAL(index_g,r_std) )
+             ier = NF90_INQ_VARID (Cforcing_id,'clay',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, clay_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'bulk_dens',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, bulk_dens_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'soil_ph',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, soil_ph_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'soiltile',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, soiltile_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'veget_max',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, veget_max_g) 
+             ier = NF90_INQ_VARID (Cforcing_id,'soilcarbon_input',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, soilcarbon_input_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'control_moist_above',vid) 
+             ier = NF90_PUT_VAR (Cforcing_id,vid, control_moist_above_g ) 
+             ier = NF90_INQ_VARID (Cforcing_id,'control_moist_soil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, control_moist_soil_g ) 
+             ier = NF90_INQ_VARID (Cforcing_id,'moist_soil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, moist_soil_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'soil_mc',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, soil_mc_Cforcing_g) 
+             ier = NF90_INQ_VARID (Cforcing_id,'floodout',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, floodout_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'wat_flux0',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, wat_flux0_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'wat_flux',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, wat_flux_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'runoff_per_soil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, runoff_per_soil_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'drainage_per_soil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, drainage_per_soil_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'DOC_to_topsoil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, DOC_to_topsoil_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'DOC_to_subsoil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, DOC_to_subsoil_Cforcing_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'control_temp_above',vid) 
+             ier = NF90_PUT_VAR (Cforcing_id,vid, control_temp_above_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'control_temp_soil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, control_temp_soil_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'npp_equil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, npp_equil_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'litter_above',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, litter_above_g) 
+             ier = NF90_INQ_VARID (Cforcing_id,'litter_below',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, litter_below_g) 
+             ier = NF90_INQ_VARID (Cforcing_id,'lignin_struc_above',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, lignin_struc_above_g)
+             ier = NF90_INQ_VARID (Cforcing_id,'lignin_struc_below',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, lignin_struc_below_g) 
+            
+             ! Close netCDF
+             ier = NF90_CLOSE (Cforcing_id)
+             IF (ier /= NF90_NOERR) THEN
+                CALL ipslerr_p (3,'stomate_main', &
+                     &        'PROBLEM in closing Cforcing file', &
+                     &        NF90_STRERROR(ier),'')
+             END IF
+
+             Cforcing_id = -1
+          ENDIF
+          ! Clear memory
+          IF (is_root_prc) THEN
+             DEALLOCATE(soilcarbon_input_g)
+             DEALLOCATE(control_moist_above_g)
+             DEALLOCATE(control_moist_soil_g)
+             DEALLOCATE(moist_soil_g)
+             DEALLOCATE(soil_mc_Cforcing_g)
+             DEALLOCATE(floodout_Cforcing_g)
+             DEALLOCATE(wat_flux0_Cforcing_g)
+             DEALLOCATE(wat_flux_Cforcing_g)
+             DEALLOCATE(runoff_per_soil_Cforcing_g)
+             DEALLOCATE(drainage_per_soil_Cforcing_g)
+             DEALLOCATE(DOC_to_topsoil_Cforcing_g)
+             DEALLOCATE(DOC_to_subsoil_Cforcing_g)
+             DEALLOCATE(control_temp_above_g)
+             DEALLOCATE(control_temp_soil_g)
+             DEALLOCATE(npp_equil_g)
+             DEALLOCATE(litter_above_g)
+             DEALLOCATE(litter_below_g)
+             DEALLOCATE(lignin_struc_above_g)
+             DEALLOCATE(lignin_struc_below_g)
+
+          ENDIF
+       
+       ENDIF ! ldcarbon_write=.TRUE.
+       RETURN ! This routine is only called at the last time step to write a netcdf for forcesoil, 
+              ! the rest of the code does not need to be executed.
+    ENDIF  ! write restart-files
+    
+!! 3. Special treatment for some input arrays.
+    
+    !! 3.1 Sum of liquid and solid precipitation
+    precip(:) = ( precip_rain(:) + precip_snow(:) )*one_day/dtradia
+    
+    !! 3.2 Calculate STOMATE's vegetation fractions from veget and veget_max
+    DO j=1,nvm 
+       WHERE ((1.-totfrac_nobio(:)) > min_sechiba)
+          ! Pixels with vegetation
+          veget_cov(:,j) = veget(:,j)/( 1.-totfrac_nobio(:) )
+          veget_cov_max(:,j) = veget_max(:,j)/( 1.-totfrac_nobio(:) )
+       ELSEWHERE
+          ! Pixels without vegetation
+          veget_cov(:,j) = zero
+          veget_cov_max(:,j) = zero
+       ENDWHERE
+    ENDDO
+    IF ( EndOfYear ) THEN
+       DO j=1,nvm
+          WHERE ((1.-totfrac_nobio(:)) > min_sechiba)
+             ! Pixels with vegetation
+             veget_cov_max_new(:,j)=veget_max_new(:,j)/( 1.-totfrac_nobio(:) )
+          ELSEWHERE
+             ! Pixels without vegetation
+             veget_cov_max_new(:,j) = zero
+          ENDWHERE
+       ENDDO
+    ENDIF
+
+    !! 3.3 Adjust time step of GPP 
+    ! No GPP for bare soil
+    gpp_d(:,1) = zero
+    ! GPP per PFT
+    DO j = 2,nvm   
+       WHERE (veget_cov_max(:,j) > min_stomate)
+          ! The PFT is available on the pixel
+          gpp_d(:,j) =  gpp(:,j)/ veget_cov_max(:,j)* one_day/dtradia  
+       ELSEWHERE
+          ! The PFT is absent on the pixel
+          gpp_d(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !! 3.4 The first time step of the first day of the month  
+    ! implies that the month is over
+    IF ( day == 1 .AND. sec .LT. dtradia ) THEN
+       EndOfMonth=.TRUE.
+    ELSE
+       EndOfMonth=.FALSE.
+    ENDIF
+    
+
+  !! 4. Calculate variables for dt_slow (i.e. "daily")
+
+    ! Note: If dt_days /= 1, then variables 'xx_daily' (eg. half-daily or bi-daily) are by definition
+    ! not expressed on a daily basis. This is not a problem but could be
+    ! confusing
+
+    !! 4.1 Accumulate instantaneous variables (do_slow=.FALSE.) 
+    ! Accumulate instantaneous variables (do_slow=.FALSE.) and eventually 
+    ! calculate daily mean value (do_slow=.TRUE.) 
+    CALL stomate_accu (kjpindex, nvm, dt_slow, dtradia, &
+         & do_slow, humrel, humrel_daily)
+    CALL stomate_accu (kjpindex,    1, dt_slow, dtradia, &
+         & do_slow, litterhumdiag, litterhum_daily)
+    CALL stomate_accu (kjpindex,    1, dt_slow, dtradia, &
+         & do_slow, t2m, t2m_daily)
+    CALL stomate_accu (kjpindex,    1, dt_slow, dtradia, &
+         & do_slow, temp_sol, tsurf_daily)
+    CALL stomate_accu (kjpindex, nbdl, dt_slow, dtradia, &
+         & do_slow, stempdiag, tsoil_daily)
+    CALL stomate_accu (kjpindex, nbdl, dt_slow, dtradia, &
+         & do_slow, shumdiag, soilhum_daily)
+    CALL stomate_accu (kjpindex,    1, dt_slow, dtradia, &
+         & do_slow, precip, precip_daily)
+    CALL stomate_accu (kjpindex, nvm, dt_slow, dtradia, &
+         & do_slow, gpp_d, gpp_daily)
+   
+    !! 4.2 Daily minimum temperature
+    t2m_min_daily(:) = MIN( t2m_min(:), t2m_min_daily(:) )
+
+    !! 4.3 Calculate maintenance respiration
+    ! Note: lai is passed as input argument to overcome previous problems with 
+    ! natural and agricultural vegetation types. 
+    CALL maint_respiration &
+         & (kjpindex,dtradia,lai,t2m,tlong_ref,stempdiag,height,veget_cov_max, &
+         & rprof,biomass,resp_maint_part_radia)
+    
+    ! Aggregate maintenance respiration across the different plant parts 
+    resp_maint_radia(:,:) = zero
+    DO j=2,nvm
+       DO k= 1, nparts
+          resp_maint_radia(:,j) = resp_maint_radia(:,j) &
+               & + resp_maint_part_radia(:,j,k)
+       ENDDO
+    ENDDO
+    
+    ! Maintenance respiration separated by plant parts
+    resp_maint_part(:,:,:) = resp_maint_part(:,:,:) &
+         & + resp_maint_part_radia(:,:,:)
+
+    !! 4.4 Litter dynamics and litter heterothropic respiration 
+    ! Including: litter update, lignin content, PFT parts, litter decay,
+    ! litter heterotrophic respiration, dead leaf soil cover.
+    turnover_littercalc(:,:,:,:) = turnover_daily(:,:,:,:) * dtradia/one_day
+    bm_to_littercalc(:,:,:,:)    = bm_to_litter(:,:,:,:) * dtradia/one_day       
+
+
+    CALL littercalc (kjpindex, dtradia/one_day, &
+         turnover_littercalc, bm_to_littercalc, &
+         veget_cov_max, temp_sol, stempdiag, shumdiag, litterhumdiag, rprof, &
+         litterpart, litter_above, litter_below, dead_leaves, &
+         lignin_struc_above, lignin_struc_below, &
+         deadleaf_cover, resp_hetero_litter, &
+         control_temp_above_inst, control_temp_soil_inst, &
+         control_moist_above_inst, control_moist_soil_inst, &
+         matrixA, vectorB,litter_mc,soilcarbon_input_inst, soil_mc, soiltile, &
+         clay, bulk_dens, soil_ph, carbon)
+    
+    ! Heterothropic litter respiration during time step ::dtradia @tex $(gC m^{-2})$ @endtex
+    resp_hetero_litter(:,:) = resp_hetero_litter(:,:) * dtradia/one_day
+    
+    !! 4.5 Soil carbon dynamics and soil heterotrophic respiration
+    ! Note: there is no vertical discretisation in the soil for litter decay.
+    CALL soilcarbon (kjpindex, dtradia/one_day, clay, &
+         soilcarbon_input_inst, control_temp_soil_inst, control_moist_soil_inst, &
+         carbon, resp_hetero_soil,matrixA,litter_above,litter_below,&
+         shumdiag,DOC, moist_soil_inst,DOC_EXP, lignin_struc_above, &
+         lignin_struc_below, floodout, runoff_per_soil, drainage_per_soil, wat_flux0,&
+         wat_flux,bulk_dens,soil_ph, veget_cov_max, soil_mc, soiltile,&
+         DOC_to_topsoil, DOC_to_subsoil)
+    
+    ! Heterothropic soil respiration during time step ::dtradia @tex $(gC m^{-2})$ @endtex 
+    resp_hetero_soil(:,:) = resp_hetero_soil(:,:) * dtradia/one_day
+
+    ! Total heterothrophic respiration during time step ::dtradia @tex $(gC m^{-2})$ @endtex
+    resp_hetero_radia(:,:) = resp_hetero_litter(:,:) + resp_hetero_soil(:,:)
+    resp_hetero_d(:,:) = resp_hetero_d(:,:) + resp_hetero_radia(:,:)
+    ! Export of DOC during the time step ::dtradia @tex $(gC m^{-3})$ @endtex
+    DOC_EXP_d(:,:,:,:)=DOC_EXP_d(:,:,:,:)+DOC_EXP(:,:,:,:)* dtradia/one_day
+    
+    ! Accumulate DOC export per pixel and hydrological pathway for use as output variable
+    ! Aggregate from DOC_EXP_d
+    DO k=1,kjpindex
+       DO l=1, nexp
+          DOC_EXP_agg_d(k,l) = zero
+          DO m=1,13
+             IF (.NOT. ISNAN(DOC_EXP_d(k,m,l,icarbon))) THEN
+                IF ((DOC_EXP_d(k,m,l,icarbon) .GT. zero).AND.(DOC_EXP_d(k,m,l,icarbon) .LT. 1e6)) THEN 
+                   DOC_EXP_agg_d(k,l) = DOC_EXP_agg_d(k,l) + DOC_EXP_d(k,m,l,icarbon)
+                ELSE 
+                ! Do nothing
+                ENDIF
+             ELSE
+                !Do nothing
+             ENDIF
+          ENDDO !m=1,13
+          IF(ISNAN(DOC_EXP_agg_d(k,l))) WRITE(*,*) 'NaN in DOC_EXP_agg_d at position ', k,' for path ',l 
+       ENDDO ! l=1, nexp
+    ENDDO !k=1,kjpindex
+    
+    !! 4.6 Accumulate instantaneous variables (do_slow=.FALSE.) 
+    ! Accumulate instantaneous variables (do_slow=.FALSE.) and eventually 
+    ! calculate daily mean value (do_slow=.TRUE.) 
+    DO i= 1,nvm
+       CALL stomate_accu (kjpindex, 1, dt_slow, dtradia, &
+        & do_slow, control_moist_above_inst(:,i), & 
+        & control_moist_above_daily(:,i)) 
+       CALL stomate_accu (kjpindex, nbdl, dt_slow, dtradia, & 
+        & do_slow, control_moist_soil_inst(:,:,i),&
+        & control_moist_soil_daily(:,:,i))
+    ENDDO
+    CALL stomate_accu (kjpindex, nbdl, dt_slow, dtradia, &
+     & do_slow, moist_soil_inst,&
+     & moist_soil_daily)
+    DO i= 1,nstm
+       CALL stomate_accu (kjpindex, nbdl, dt_slow, dtradia, &
+        & do_slow, soil_mc(:,:,i),&
+        & soil_mc_Cforcing_daily(:,:,i))
+    ENDDO
+    CALL stomate_accu (kjpindex, nbdl, dt_slow, dtradia, &
+     & do_slow, floodout,&
+     & floodout_Cforcing_daily)
+    CALL stomate_accu (kjpindex, nstm, dt_slow, dtradia, &
+     & do_slow, wat_flux0,&
+     & wat_flux0_Cforcing_daily)
+    DO i= 1,nstm
+       CALL stomate_accu (kjpindex, nbdl, dt_slow, dtradia, &
+        & do_slow, wat_flux(:,:,i),&
+        & wat_flux_Cforcing_daily(:,:,i))
+    ENDDO
+    CALL stomate_accu (kjpindex, nstm, dt_slow, dtradia, &
+     & do_slow, runoff_per_soil,&
+     & runoff_per_soil_Cforcing_daily)
+    CALL stomate_accu (kjpindex, nstm, dt_slow, dtradia, &
+     & do_slow, drainage_per_soil,&
+     & drainage_per_soil_Cforcing_daily)
+    CALL stomate_accu (kjpindex, nelements, dt_slow, dtradia, &
+     & do_slow, DOC_to_topsoil,&
+     & DOC_to_topsoil_Cforcing_daily)
+    CALL stomate_accu (kjpindex, nelements, dt_slow, dtradia, &
+     & do_slow, DOC_to_subsoil,&
+     & DOC_to_subsoil_Cforcing_daily)
+    DO i = 1, nlitt
+       CALL stomate_accu (kjpindex, 1, dt_slow, dtradia, & 
+        & do_slow, control_temp_above_inst(:,i),  & 
+        & control_temp_above_daily(:,i))
+    ENDDO
+    DO i = 1,2*npool
+       CALL stomate_accu (kjpindex, nbdl, dt_slow, dtradia, &
+        & do_slow, control_temp_soil_inst(:,:,i),&
+        & control_temp_soil_daily(:,:,i))
+    ENDDO
+    DO j = 1,nbdl
+       DO i = 1,npool
+          DO k = 1, nelements
+          CALL stomate_accu (kjpindex, nvm, dt_slow, dtradia, &
+               & do_slow, soilcarbon_input_inst(:,:,j,i,k), soilcarbon_input_daily(:,:,j,i,k))
+          ENDDO
+       ENDDO
+    ENDDO
+!! 5. Daily processes - performed at the end of the day
+    
+    IF (do_slow) THEN
+
+       !! 5.1 Update lai
+       ! Use lai from stomate
+       ! ?? check if this is the only time control%ok_pheno is used??
+       ! ?? Looks like it is the only time. But this variables probably is defined 
+       ! in stomate_constants or something, in which case, it is difficult to track.
+       IF (control%ok_pheno) THEN
+          !! 5.1.1 Update LAI 
+          ! Set lai of bare soil to zero
+          lai(:,ibare_sechiba) = zero
+          ! lai for all PFTs
+          DO j = 2, nvm
+             lai(:,j) = biomass(:,j,ileaf,icarbon)*sla(j)
+          ENDDO
+          frac_age(:,:,:) = leaf_frac(:,:,:)
+       ELSE 
+          ! 5.1.2 Use a prescribed lai
+          ! WARNING: code in setlai is identical to the lines above
+          ! Update subroutine if LAI has to be forced 
+          CALL  setlai(kjpindex,lai) 
+          frac_age(:,:,:) = zero
+       ENDIF
+
+       !! 5.2 Calculate long-term "meteorological" and biological parameters
+       ! mainly in support of calculating phenology. If ::EndOfYear=.TRUE.
+       ! annual values are update (i.e. xx_lastyear).
+       CALL season &
+            &          (kjpindex, dt_days, EndOfYear, &
+            &           veget_cov, veget_cov_max, &
+            &           humrel_daily, t2m_daily, tsoil_daily, soilhum_daily, lalo, &
+            &           precip_daily, npp_daily, biomass, &
+            &           turnover_daily, gpp_daily, when_growthinit, &
+            &           maxhumrel_lastyear, maxhumrel_thisyear, &
+            &           minhumrel_lastyear, minhumrel_thisyear, &
+            &           maxgppweek_lastyear, maxgppweek_thisyear, &
+            &           gdd0_lastyear, gdd0_thisyear, &
+            &           precip_lastyear, precip_thisyear, &
+            &           lm_lastyearmax, lm_thisyearmax, &
+            &           maxfpc_lastyear, maxfpc_thisyear, &
+            &           humrel_month, humrel_week, t2m_longterm, &
+            &           tlong_ref, t2m_month, t2m_week, tsoil_month, soilhum_month, &
+            &           npp_longterm, turnover_longterm, gpp_week, &
+            &           gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+            &           time_hum_min, hum_min_dormance, gdd_init_date, &
+            &           gdd_from_growthinit, herbivores)
+       
+       !! 5.3 Use all processes included in stomate
+       IF (control%ok_stomate) THEN
+
+          !! 5.3.1  Activate stomate processes 
+          ! Activate stomate processes (the complete list of processes depends 
+          ! on whether the DGVM is used or not). Processes include: climate constraints 
+          ! for PFTs, PFT dynamics, Phenology, Allocation, NPP (based on GPP and
+          ! authothropic respiration), fire, mortality, vmax, assimilation temperatures,
+          ! all turnover processes, light competition, sapling establishment, lai and 
+          ! land cover change.
+          CALL StomateLpj &
+               &            (kjpindex, dt_days, EndOfYear, EndOfMonth, &
+               &             neighbours, resolution, &
+               &             clay, herbivores, &
+               &             tsurf_daily, tsoil_daily, t2m_daily, t2m_min_daily, &
+               &             litterhum_daily, soilhum_daily, &
+               &             maxhumrel_lastyear, minhumrel_lastyear, &
+               &             gdd0_lastyear, precip_lastyear, &
+               &             humrel_month, humrel_week, tlong_ref, t2m_month, t2m_week, &
+               &             tsoil_month, soilhum_month, &
+               &             gdd_m5_dormance,  gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+               &             turnover_longterm, gpp_daily, &
+               &             time_hum_min, maxfpc_lastyear, resp_maint_part,&
+               &             PFTpresent, age, fireindex, firelitter, &
+               &             leaf_age, leaf_frac, biomass, ind, adapted, regenerate, &
+               &             senescence, when_growthinit, litterpart, litter_above,litter_below, &
+               &             dead_leaves, carbon, DOC, DOC_EXP_d, black_carbon, lignin_struc_above, &
+               &             veget_cov_max, npp_longterm, lm_lastyearmax, &
+               &             veget_lastlight, everywhere, need_adjacent, RIP_time, &
+               &             lai, rprof,npp_daily, turnover_daily, turnover_time,&
+               &             soilcarbon_input_inst, &
+               &             co2_to_bm_dgvm, co2_fire, &
+               &             resp_hetero_d, resp_maint_d, resp_growth_d, &
+               &             height, deadleaf_cover, vcmax, vjmax, &
+               &             t_photo_min, t_photo_opt, t_photo_max,bm_to_litter,&
+               &             prod10, prod100, flux10, flux100, veget_cov_max_new,&
+               &             convflux, cflux_prod10, cflux_prod100, harvest_above, carb_mass_total, lcchange,&
+               &             fpc_max, matrixA,moist_soil_daily)
+
+          !! 5.3.2 Calculate the total CO2 flux from land use change
+          fco2_lu(:) = convflux(:) &
+               &             + cflux_prod10(:)  &
+               &             + cflux_prod100(:) &
+               &             + harvest_above(:)
+
+          !! 5.4 Calculate veget and veget_max
+          veget_max(:,:) = zero 
+          DO j = 1, nvm
+             veget_max(:,j) = veget_max(:,j) + &
+                  & veget_cov_max(:,j) * ( 1.-totfrac_nobio(:) )
+          ENDDO
+          
+          !! 5.5 Photosynthesis parameters
+          assim_param(:,:,ivcmax) = zero
+          assim_param(:,:,ivjmax) = zero
+          assim_param(:,:,itmin) = zero
+          assim_param(:,:,itopt) = zero
+          assim_param(:,:,itmax) = zero
+          DO j = 2,nvm
+             assim_param(:,j,ivcmax) = vcmax(:,j)
+          ENDDO
+          DO j = 2, nvm
+             assim_param(:,j,ivjmax) = vjmax(:,j)
+          ENDDO
+          DO j = 2, nvm
+             assim_param(:,j,itmin) = t_photo_min(:,j)
+          ENDDO
+          DO j = 2, nvm
+             assim_param(:,j,itopt) = t_photo_opt(:,j)
+          ENDDO
+          DO j = 2, nvm
+             assim_param(:,j,itmax) = t_photo_max(:,j)
+          ENDDO
+
+          !! 5.6 Update forcing variables for soil carbon
+          IF (ldcarbon_write  .AND. TRIM(Cforcing_name) /= 'NONE') THEN
+             npp_tot(:) = 0
+             DO j=2,nvm
+                npp_tot(:) = npp_tot(:) + npp_daily(:,j)
+             ENDDO
+             ! ::nbyear Number of years saved for carbon spinup
+             sf_time = MODULO(REAL(date,r_std)-1,one_year*REAL(nbyear,r_std))
+             iatt=FLOOR(sf_time/dt_forcesoil) + 1
+             IF (iatt == 0) iatt = iatt_old + 1
+             IF ((iatt<iatt_old) .and. (.not. cumul_Cforcing)) THEN
+                nforce(:)=0
+                soilcarbon_input(:,:,:,:,:,:) = zero
+                control_moist_above(:,:,:) = zero
+                control_moist_soil(:,:,:,:) = zero
+                moist_soil(:,:,:) = zero
+                soil_mc_Cforcing(:,:,:,:) = zero
+                floodout_Cforcing(:,:) = zero
+                wat_flux0_Cforcing(:,:,:) = zero
+                wat_flux_Cforcing(:,:,:,:) = zero
+                runoff_per_soil_Cforcing(:,:,:) = zero
+                drainage_per_soil_Cforcing(:,:,:) = zero
+                DOC_to_topsoil_Cforcing(:,:,:) = zero
+                DOC_to_subsoil_Cforcing(:,:,:) = zero
+                control_temp_above(:,:,:) = zero
+                control_temp_soil(:,:,:,:) = zero
+                litter_above_Cforcing(:,:,:,:,:) = zero
+                litter_below_Cforcing(:,:,:,:,:,:) = zero
+                npp_equil(:,:) = zero
+                lignin_struc_above_Cforcing(:,:,:) = zero
+                lignin_struc_below_Cforcing(:,:,:,:) = zero
+             ENDIF
+             iatt_old = iatt
+             ! Update forcing
+             nforce(iatt) = nforce(iatt)+1
+             soilcarbon_input(:,:,:,:,:,iatt) = soilcarbon_input(:,:,:,:,:,iatt) + soilcarbon_input_daily(:,:,:,:,:)
+             litter_above_Cforcing(:,:,:,:,iatt) = litter_above_Cforcing(:,:,:,:,iatt) + litter_above(:,:,:,:)
+             litter_below_Cforcing(:,:,:,:,:,iatt) = litter_below_Cforcing(:,:,:,:,:,iatt) + litter_below(:,:,:,:,:)
+             control_moist_above(:,:,iatt) = control_moist_above(:,:,iatt) + control_moist_above_daily(:,:) 
+             control_moist_soil(:,:,:,iatt) = control_moist_soil(:,:,:,iatt) + control_moist_soil_daily(:,:,:)
+             moist_soil(:,:,iatt) = moist_soil(:,:,iatt) + moist_soil_daily(:,:)
+             soil_mc_Cforcing(:,:,:,iatt) = soil_mc_Cforcing(:,:,:,iatt) + soil_mc_Cforcing_daily(:,:,:)
+             floodout_Cforcing(:,iatt) = floodout_Cforcing(:,iatt) + floodout_Cforcing_daily(:)
+             wat_flux0_Cforcing(:,:,iatt) = wat_flux0_Cforcing(:,:,iatt) + wat_flux0_Cforcing_daily(:,:)
+             wat_flux_Cforcing(:,:,:,iatt) = wat_flux_Cforcing(:,:,:,iatt) + wat_flux_Cforcing_daily(:,:,:)
+             runoff_per_soil_Cforcing(:,:,iatt) = runoff_per_soil_Cforcing(:,:,iatt) + runoff_per_soil_Cforcing_daily(:,:)
+             drainage_per_soil_Cforcing(:,:,iatt) = drainage_per_soil_Cforcing(:,:,iatt) + drainage_per_soil_Cforcing_daily(:,:)
+             DOC_to_topsoil_Cforcing(:,:,iatt) = DOC_to_topsoil_Cforcing(:,:,iatt) + DOC_to_topsoil_Cforcing_daily(:,:)
+             DOC_to_subsoil_Cforcing(:,:,iatt) = DOC_to_subsoil_Cforcing(:,:,iatt) + DOC_to_subsoil_Cforcing_daily(:,:)
+             control_temp_above(:,:,iatt) = control_temp_above(:,:,iatt) + control_temp_above_daily(:,:)
+             control_temp_soil(:,:,:,iatt) = control_temp_soil(:,:,:,iatt) + control_temp_soil_daily(:,:,:)
+             npp_equil(:,iatt) = npp_equil(:,iatt) + npp_tot(:)
+             lignin_struc_above_Cforcing(:,:,iatt) = lignin_struc_above_Cforcing(:,:,iatt) + lignin_struc_above(:,:)
+             lignin_struc_below_Cforcing(:,:,:,iatt) = lignin_struc_below_Cforcing(:,:,:,iatt) + lignin_struc_below(:,:,:)
+          ENDIF
+
+       ENDIF ! control%ok_stomate
+       
+       !! 5.8 Write forcing file if ::ldforcing_write=.TRUE.
+       ! Note: if STOMATE is run in coupled mode the forcing file is written
+       ! If run in stand-alone mode, the forcing file is read!
+       IF ( ldforcing_write .AND. TRIM(forcing_name) /= 'NONE' ) THEN
+          
+          !! 5.8.1 Convert GPP to sechiba time steps
+          ! GPP is multiplied by coverage to obtain forcing @tex $(gC m^{-2} dt_slow^{-1})$\f \end@tex $(m^2 m^{-2})$ @endtexonly
+          ! @tex$ m^{-2}$ @endtex remains in the units because ::veget_cov_max is a fraction, not a 
+          ! surface area. In sechiba values are ponderated by surface and frac_no_bio. 
+          ! At the beginning of stomate, the units are converted. 
+          ! When we use forcesoil we call sechiba_main and so we need the have the same units as in sechiba.
+          gpp_daily_x(:,:) = zero
+          DO j = 2, nvm             
+             gpp_daily_x(:,j) = gpp_daily_x(:,j) + &
+              & gpp_daily(:,j) * dt_slow / one_day * veget_cov_max(:,j)
+          ENDDO
+          
+          ! Bare soil moisture availability has not been treated
+          ! in STOMATE, update it here
+          humrel_daily(:,ibare_sechiba) = humrel(:,ibare_sechiba)   
+
+          ! Update index to store the next forcing step in memory
+          iisf = iisf+1
+
+          ! How many times have we treated this forcing state
+          xn = REAL(nf_cumul(isf(iisf)),r_std)
+          
+          !! 5.8.2 Cumulate forcing variables
+          ! Cumulate forcing variables (calculate average)
+          ! Note: precipitation is multiplied by dt_slow/one_day to be consistent with 
+          ! the units in sechiba
+          IF (cumul_forcing) THEN
+             clay_fm(:,iisf) = (xn*clay_fm(:,iisf)+clay(:))/(xn+1.)
+             soil_ph_fm(:,iisf) = (xn*soil_ph_fm(:,iisf)+soil_ph(:))/(xn+1.)
+             bulk_dens_fm(:,iisf) = (xn*bulk_dens_fm(:,iisf)+bulk_dens(:))/(xn+1.)
+             humrel_daily_fm(:,:,iisf) = &
+                  & (xn*humrel_daily_fm(:,:,iisf) + humrel_daily(:,:))/(xn+1.)
+             litterhum_daily_fm(:,iisf) = &
+                  & (xn*litterhum_daily_fm(:,iisf)+litterhum_daily(:))/(xn+1.)
+             t2m_daily_fm(:,iisf) = &
+                  & (xn*t2m_daily_fm(:,iisf)+t2m_daily(:))/(xn+1.)
+             t2m_min_daily_fm(:,iisf) = &
+                  & (xn*t2m_min_daily_fm(:,iisf)+t2m_min_daily(:))/(xn+1.)
+             tsurf_daily_fm(:,iisf) = &
+                  & (xn*tsurf_daily_fm(:,iisf)+tsurf_daily(:))/(xn+1.)
+             tsoil_daily_fm(:,:,iisf) = &
+                  & (xn*tsoil_daily_fm(:,:,iisf)+tsoil_daily(:,:))/(xn+1.)
+             soilhum_daily_fm(:,:,iisf) = &
+                  & (xn*soilhum_daily_fm(:,:,iisf)+soilhum_daily(:,:))/(xn+1.)
+             precip_fm(:,iisf) = &
+                  & (xn*precip_fm(:,iisf)+precip_daily(:)*dt_slow/one_day)/(xn+1.)
+             gpp_daily_fm(:,:,iisf) = &
+                  & (xn*gpp_daily_fm(:,:,iisf) + gpp_daily_x(:,:))/(xn+1.)
+             veget_fm(:,:,iisf) = &
+                  & (xn*veget_fm(:,:,iisf) + veget(:,:) )/(xn+1.)
+             veget_max_fm(:,:,iisf) = &
+                  & (xn*veget_max_fm(:,:,iisf) + veget_max(:,:) )/(xn+1.)
+             lai_fm(:,:,iisf) = &
+                  & (xn*lai_fm(:,:,iisf) + lai(:,:) )/(xn+1.)
+          ELSE
+             ! Here we just calculate the values
+             clay_fm(:,iisf) = clay(:)
+             soil_ph_fm(:,iisf) = soil_ph(:)
+             bulk_dens_fm(:,iisf) = bulk_dens(:)
+             humrel_daily_fm(:,:,iisf) = humrel_daily(:,:)
+             litterhum_daily_fm(:,iisf) = litterhum_daily(:)
+             t2m_daily_fm(:,iisf) = t2m_daily(:)
+             t2m_min_daily_fm(:,iisf) =t2m_min_daily(:)
+             tsurf_daily_fm(:,iisf) = tsurf_daily(:)
+             tsoil_daily_fm(:,:,iisf) =tsoil_daily(:,:)
+             soilhum_daily_fm(:,:,iisf) =soilhum_daily(:,:)
+             precip_fm(:,iisf) = precip_daily(:)
+             gpp_daily_fm(:,:,iisf) =gpp_daily_x(:,:)
+             veget_fm(:,:,iisf) = veget(:,:)
+             veget_max_fm(:,:,iisf) =veget_max(:,:)
+             lai_fm(:,:,iisf) =lai(:,:)
+          ENDIF
+          nf_cumul(isf(iisf)) = nf_cumul(isf(iisf))+1
+
+          ! 5.8.3 Do we have to write the forcing states?
+          IF (iisf == nsfm) THEN
+
+             !! 5.8.3.1 Write these forcing states
+             CALL forcing_write(forcing_id,1,nsfm)
+             ! determine which forcing states must be read
+             isf(1) = isf(nsfm)+1
+             IF ( isf(1) > nsft ) isf(1) = 1
+             DO iisf = 2, nsfm
+                isf(iisf) = isf(iisf-1)+1
+                IF (isf(iisf) > nsft)  isf(iisf) = 1
+             ENDDO
+
+             ! Read forcing variables - for debug use only
+             ! CALL forcing_read(forcing_id,nsfm)
+             iisf = 0
+
+          ENDIF
+
+       ENDIF
+
+
+       !! 5.9 Compute daily CO2 flux (AR5 output - not essential)
+       ! CO2 flux in @tex $gC m^{-2} s^{-1}$ @endtex (positive towards the atmosphere) is sum of:
+       ! (1) heterotrophic respiration from ground + (2) maintenance respiration 
+       ! from the plants + (3) growth respiration from the plants + (4) co2 
+       ! emissions from fire - (5) co2 taken up in the DGVM to establish 
+       ! saplings - (6) co2 taken up by photosyntyhesis
+       co2_flux_daily(:,:)=   &
+            & resp_maint_d(:,:) + resp_growth_d(:,:) + resp_hetero_d(:,:) + &
+            & co2_fire(:,:) - co2_to_bm_dgvm(:,:) - gpp_daily(:,:)
+       IF ( hist_id_stom_IPCC > 0 ) THEN
+          vartmp(:) = SUM(co2_flux_daily*veget_cov_max,dim=2)/1e3/one_day*contfrac
+          CALL histwrite_p (hist_id_stom_IPCC, "nep", itime, &
+               vartmp, kjpindex, hori_index)
+       ENDIF
+
+       ! See 5.9 for details on NEP + fire. At the monthly time step also 
+       ! harvest and land use change are calculated
+       co2_flux_monthly(:,:) = co2_flux_monthly(:,:) + co2_flux_daily(:,:)
+       harvest_above_monthly(:) = harvest_above_monthly(:) + harvest_above(:)
+       cflux_prod_monthly(:) = cflux_prod_monthly(:) + convflux(:) + & 
+        & cflux_prod10(:) + cflux_prod100(:)
+      
+       !! 5.10 Compute monthly CO2 fluxes 
+       IF ( EndOfMonth ) THEN
+          IF ( control%ok_stomate ) THEN
+             
+             !! 5.10.1 Write history file for monthly fluxes
+             CALL histwrite_p (hist_id_stomate, 'CO2FLUX', itime, &
+                  co2_flux_monthly, kjpindex*nvm, horipft_index)
+          ENDIF
+          !?? I (=VB) translated the French, but the whole stuff does not make sense to me.
+          ! If one deletes the montly cumulation,
+          ! one should not forget this change in resolution(:,1)*resolution(:,2)*contfrac(:)
+          ! Si on supprimer le cumul par mois, 
+          ! il ne faut pas oublier cette modif resolution(:,1)*resolution(:,2)*contfrac(:)
+          ! Should be supressed, this is post-processing 
+          DO j=2, nvm
+             co2_flux_monthly(:,j) = co2_flux_monthly(:,j)* &
+                  resolution(:,1)*resolution(:,2)*contfrac(:)
+          ENDDO
+
+          ! Should be supressed, this is post-processing
+          ! ?? How does it differ from co2_flux_monthly??
+          net_co2_flux_monthly = zero
+          DO ji=1,kjpindex
+             DO j=2,nvm
+                net_co2_flux_monthly = net_co2_flux_monthly + &
+                     &  co2_flux_monthly(ji,j)*veget_cov_max(ji,j)
+             ENDDO
+          ENDDO
+
+     
+          !! 5.10.2 Cumulative fluxes of land use cover change, harvest and net biosphere production
+          ! Parallel processing, gather the information from different processors. first argument is the lo
+          ! local variable, the second argument is the global variable. bcast send it to all processors.
+          net_cflux_prod_monthly_sum = &
+              &  SUM(cflux_prod_monthly(:)*resolution(:,1)*resolution(:,2)*contfrac(:))*1e-15
+          CALL reduce_sum(net_cflux_prod_monthly_sum,net_cflux_prod_monthly_tot)
+          CALL bcast(net_cflux_prod_monthly_tot)
+          net_harvest_above_monthly_sum = &
+             &   SUM(harvest_above_monthly(:)*resolution(:,1)*resolution(:,2)*contfrac(:))*1e-15
+          CALL reduce_sum(net_harvest_above_monthly_sum,net_harvest_above_monthly_tot)
+          CALL bcast(net_harvest_above_monthly_tot)
+          net_co2_flux_monthly = net_co2_flux_monthly*1e-15
+          CALL reduce_sum(net_co2_flux_monthly,net_co2_flux_monthly_sum)
+          CALL bcast(net_co2_flux_monthly_sum)
+          net_biosp_prod_monthly_tot =  &
+             & ( net_co2_flux_monthly_sum + net_cflux_prod_monthly_tot + &
+             & net_harvest_above_monthly_tot )
+          
+          WRITE(numout,9010) 'GLOBAL net_cflux_prod_monthly    (Peta gC/month)  = ',net_cflux_prod_monthly_tot
+          WRITE(numout,9010) 'GLOBAL net_harvest_above_monthly (Peta gC/month)  = ',net_harvest_above_monthly_tot
+          WRITE(numout,9010) 'GLOBAL net_co2_flux_monthly      (Peta gC/month)  = ',net_co2_flux_monthly_sum
+          WRITE(numout,9010) 'GLOBAL net_biosp_prod_monthly    (Peta gC/month)  = ',net_biosp_prod_monthly_tot
+
+9010  FORMAT(A52,F17.14)
+
+!! DELETE
+!!$          IF ( control%ok_stomate ) THEN
+!!$             vartmp(:)=net_co2_flux_monthly_sum
+!!$             CALL histwrite_p (hist_id_stomate, 'CO2FLUX_MONTHLY_SUM', itime, &
+!!$                  vartmp, kjpindex, hori_index )
+!!$          ENDIF
+!!$          IF (is_root_prc) THEN
+!!$             OPEN( unit=39,              &
+!!$                  file="stomate_co2flux.data", &
+!!$                  action="write",              &
+!!$                  position="append",           &
+!!$                  iostat=ios  )
+!!$             IF ( ios /= 0 ) THEN
+!!$                STOP "Erreur lors de la lecture/ecriture du fichier stomate_co2flux.data"
+!!$             ELSE
+!!$                WRITE(numout,*)
+!!$                WRITE(numout,*) "Ecriture du fichier stomate_co2flux.data"
+!!$                WRITE(numout,*)
+!!$             END IF
+!!$             WRITE(39,*) net_co2_flux_monthly_sum
+!!$             CLOSE( unit=39 )
+!!$          ENDIF
+          
+          ! Reset Monthly values
+          co2_flux_monthly(:,:) = zero
+          harvest_above_monthly(:) = zero
+          cflux_prod_monthly(:)    = zero
+
+       ENDIF ! Monthly processes - at the end of the month
+       
+       IF (spinup_analytic) THEN
+          nbp_accu(:) = nbp_accu(:) + (-SUM(co2_flux_daily(:,:) * veget_max(:,:),dim=2) - (convflux(:) + cflux_prod10(:) + &
+                    cflux_prod100(:))  - harvest_above(:))/1e3 
+       ENDIF
+
+       !! 5.11 Reset daily variables
+       humrel_daily(:,:) = zero
+       litterhum_daily(:) = zero
+       t2m_daily(:) = zero
+       t2m_min_daily(:) = large_value
+       tsurf_daily(:) = zero
+       tsoil_daily(:,:) = zero
+       soilhum_daily(:,:) = zero
+       precip_daily(:) = zero
+       gpp_daily(:,:) = zero
+       resp_maint_part(:,:,:)=zero
+       resp_hetero_d=zero
+       DOC_EXP_d(:,:,:,:) = zero
+       IF (bavard >= 3) THEN
+          WRITE(numout,*) 'stomate_main: daily processes done'
+       ENDIF
+
+    ENDIF  ! Daily processes - at the end of the day
+    
+  !! 6. Outputs from Stomate
+
+    ! co2_flux receives a value from STOMATE only if STOMATE is activated.
+    ! Otherwise, the calling hydrological module must do this itself.
+    IF ( control%ok_stomate ) THEN
+
+       !! 6.1 Respiration and fluxes
+       resp_maint(:,:) = resp_maint_radia(:,:)*veget_cov_max(:,:)
+       resp_maint(:,ibare_sechiba) = zero
+       resp_growth(:,:)= resp_growth_d(:,:)*veget_cov_max(:,:)*dtradia/one_day
+       resp_hetero(:,:) = resp_hetero_radia(:,:)*veget_cov_max(:,:)
+
+       !! 6.2 Derived CO2 fluxes
+       ! CO2 flux in gC m^{-2} s^{-1} (positive towards the atmosphere) is sum of:
+       ! (1) heterotrophic respiration from ground + (2) maintenance respiration 
+       ! from the plants + (3) growth respiration from the plants + (4) co2 
+       ! emissions from fire - (5) co2 taken up in the DGVM to establish 
+       ! saplings - (6) co2 taken up by photosyntyhesis
+       co2_flux(:,:) = resp_hetero(:,:) + resp_maint(:,:) + resp_growth(:,:) &
+            & + (co2_fire(:,:)-co2_to_bm_dgvm(:,:))*veget_cov_max(:,:)/one_day &
+            & - gpp(:,:)
+    ENDIF
+   
+  !! 7. Analytical spinup
+
+    IF (spinup_analytic) THEN
+
+       !! 7.1. Update V and U at sechiba time step
+       DO m = 2,nvm
+          DO j = 1,kjpindex 
+             ! V <- A * V
+             MatrixV(j,m,:,:) = MATMUL(matrixA(j,m,:,:),MatrixV(j,m,:,:))
+             ! U <- A*U + B
+             VectorU(j,m,:) = MATMUL(matrixA(j,m,:,:),VectorU(j,m,:)) + vectorB(j,m,:)
+          ENDDO ! loop pixels
+       ENDDO ! loop PFTS
+
+
+       !! 7.2. What happened at the end of the year ?
+       IF (EndOfYear) THEN
+
+          !
+          ! 7.2.1 Increase the years counter every EndOfyear
+          !
+          global_years = global_years + 1 
+
+
+          !
+          ! 7.2.3 Is global_years is a multiple of the period time ?
+          !
+
+          !
+          ! 3.2.1 When global_years is a multiple of the spinup_period, we calculate :
+          !       1) the mean nbp flux over the period. This value is restarted
+          !       2) we solve the matrix system by Gauss Jordan method
+          !       3) We test if a point is at equilibrium : if yes, we mark the point (ok_equilibrium array)
+          !       4) Then we reset the matrix 
+          !       5) We erase the carbon_stock calculated by ORCHIDEE by the one found by the method
+             IF( MOD(global_years, spinup_period) == 0 ) THEN 
+             WRITE(numout,*) 'Spinup analytic : Calculate if system is in equlibrium. global_years=',global_years
+             ! The number total of days during the forcing period is given by :
+               !    spinup_period*365 (we consider only the noleap calendar) 
+              nbp_flux(:) = nbp_accu(:) / ( spinup_period * 365.)
+             ! Reset the values
+             nbp_accu(:) = zero
+
+             carbon_stock(:,ibare_sechiba,:) = zero
+             ! Prepare the matrix for the resolution
+             ! Add a temporary matrix W which contains I-MatrixV
+             ! we should take the opposite of matrixV and add the identitiy : we solve (I-MatrixV)*C = VectorU
+             MatrixW(:,:,:,:) = moins_un * MatrixV(:,:,:,:)
+             DO jv = 1,nbpools
+                MatrixW(:,:,jv,jv) =  MatrixW(:,:,jv,jv) + un
+             ENDDO
+             carbon_stock(:,:,:) = VectorU(:,:,:)
+
+             !
+             !  Solve the linear system
+             !
+             DO m = 2,nvm
+                DO j = 1,kjpindex
+                   ! the solution will be stored in VectorU : so it should be restarted before
+                   ! loop over npts and nvm, so we solved npts*(nvm-1) (7,7) linear systems
+                   CALL gauss_jordan_method(nbpools,MatrixW(j,m,:,:),carbon_stock(j,m,:))
+                ENDDO ! loop pixels
+             ENDDO ! loop PFTS
+
+             ! Reset temporary matrixW
+             MatrixW(:,:,:,:) = zero 
+
+
+             previous_stock(:,:,:) = current_stock(:,:,:)
+             current_stock(:,:,:) = carbon_stock(:,:,:)  
+             ! The relative error is calculated over the passive carbon pool (sum over the pfts) over the pixel.
+             CALL error_L1_passive(kjpindex,nvm, nbpools, current_stock, previous_stock, veget_max, &
+                  &                eps_carbon, carbon_eq)   
+
+             !! ok_equilibrium is saved,
+             WHERE( carbon_eq(:) .AND. .NOT.(ok_equilibrium(:)) )
+                ok_equilibrium(:) = .TRUE.  
+             ENDWHERE
+
+             ! Reset matrixV for the pixel to the identity matrix and vectorU to zero
+             MatrixV(:,:,:,:) = zero
+             VectorU(:,:,:) = zero
+             DO jv = 1,nbpools
+                MatrixV(:,:,jv,jv) = un
+             END DO
+             WRITE(numout,*) 'Reset for matrixV and VectorU done'    
+
+             !! Write the values found in the standard outputs of ORCHIDEE
+             litter_above(:,istructural,:,icarbon) = carbon_stock(:,:,istructural_above) 
+             litter_below(:,istructural,:,1,icarbon) = carbon_stock(:,:,istructural_below_z1)
+             litter_below(:,istructural,:,2,icarbon) = carbon_stock(:,:,istructural_below_z2)
+             litter_below(:,istructural,:,3,icarbon) = carbon_stock(:,:,istructural_below_z3)
+             litter_below(:,istructural,:,4,icarbon) = carbon_stock(:,:,istructural_below_z4)
+             litter_below(:,istructural,:,5,icarbon) = carbon_stock(:,:,istructural_below_z5)
+             litter_below(:,istructural,:,6,icarbon) = carbon_stock(:,:,istructural_below_z6)
+             litter_below(:,istructural,:,7,icarbon) = carbon_stock(:,:,istructural_below_z7)
+             litter_below(:,istructural,:,8,icarbon) = carbon_stock(:,:,istructural_below_z8)
+             litter_below(:,istructural,:,9,icarbon) = carbon_stock(:,:,istructural_below_z9)
+             litter_below(:,istructural,:,10,icarbon) = carbon_stock(:,:,istructural_below_z10)
+             litter_below(:,istructural,:,11,icarbon) = carbon_stock(:,:,istructural_below_z11)
+             litter_above(:,imetabolic,:,icarbon) = carbon_stock(:,:,imetabolic_above)
+             litter_below(:,imetabolic,:,1,icarbon) = carbon_stock(:,:,imetabolic_below_z1)
+             litter_below(:,imetabolic,:,2,icarbon) = carbon_stock(:,:,imetabolic_below_z2)
+             litter_below(:,imetabolic,:,3,icarbon) = carbon_stock(:,:,imetabolic_below_z3)
+             litter_below(:,imetabolic,:,4,icarbon) = carbon_stock(:,:,imetabolic_below_z4)
+             litter_below(:,imetabolic,:,5,icarbon) = carbon_stock(:,:,imetabolic_below_z5)
+             litter_below(:,imetabolic,:,6,icarbon) = carbon_stock(:,:,imetabolic_below_z6)
+             litter_below(:,imetabolic,:,7,icarbon) = carbon_stock(:,:,imetabolic_below_z7)
+             litter_below(:,imetabolic,:,8,icarbon) = carbon_stock(:,:,imetabolic_below_z8)
+             litter_below(:,imetabolic,:,9,icarbon) = carbon_stock(:,:,imetabolic_below_z9)
+             litter_below(:,imetabolic,:,10,icarbon) = carbon_stock(:,:,imetabolic_below_z10)
+             litter_below(:,imetabolic,:,11,icarbon) = carbon_stock(:,:,imetabolic_below_z11)
+
+             carbon(:,iactive,:,1) = carbon_stock(:,:,iactive_pool_z1)
+             carbon(:,iactive,:,2) = carbon_stock(:,:,iactive_pool_z2)
+             carbon(:,iactive,:,3) = carbon_stock(:,:,iactive_pool_z3)
+             carbon(:,iactive,:,4) = carbon_stock(:,:,iactive_pool_z4)
+             carbon(:,iactive,:,5) = carbon_stock(:,:,iactive_pool_z5)
+             carbon(:,iactive,:,6) = carbon_stock(:,:,iactive_pool_z6)
+             carbon(:,iactive,:,7) = carbon_stock(:,:,iactive_pool_z7)
+             carbon(:,iactive,:,8) = carbon_stock(:,:,iactive_pool_z8)
+             carbon(:,iactive,:,9) = carbon_stock(:,:,iactive_pool_z9)
+             carbon(:,iactive,:,10) = carbon_stock(:,:,iactive_pool_z10)
+             carbon(:,iactive,:,11) = carbon_stock(:,:,iactive_pool_z11)
+
+             carbon(:,islow,:,1) = carbon_stock(:,:,islow_pool_z1)
+             carbon(:,islow,:,2) = carbon_stock(:,:,islow_pool_z2)
+             carbon(:,islow,:,3) = carbon_stock(:,:,islow_pool_z3)
+             carbon(:,islow,:,4) = carbon_stock(:,:,islow_pool_z4)
+             carbon(:,islow,:,5) = carbon_stock(:,:,islow_pool_z5)
+             carbon(:,islow,:,6) = carbon_stock(:,:,islow_pool_z6)
+             carbon(:,islow,:,7) = carbon_stock(:,:,islow_pool_z7)
+             carbon(:,islow,:,8) = carbon_stock(:,:,islow_pool_z8)
+             carbon(:,islow,:,9) = carbon_stock(:,:,islow_pool_z9)
+             carbon(:,islow,:,10) = carbon_stock(:,:,islow_pool_z10)
+             carbon(:,islow,:,11) = carbon_stock(:,:,islow_pool_z11)
+
+             carbon(:,ipassive,:,1) = carbon_stock(:,:,ipassive_pool_z1) 
+             carbon(:,ipassive,:,2) = carbon_stock(:,:,ipassive_pool_z2)
+             carbon(:,ipassive,:,3) = carbon_stock(:,:,ipassive_pool_z3)
+             carbon(:,ipassive,:,4) = carbon_stock(:,:,ipassive_pool_z4)
+             carbon(:,ipassive,:,5) = carbon_stock(:,:,ipassive_pool_z5)
+             carbon(:,ipassive,:,6) = carbon_stock(:,:,ipassive_pool_z6)
+             carbon(:,ipassive,:,7) = carbon_stock(:,:,ipassive_pool_z7)
+             carbon(:,ipassive,:,8) = carbon_stock(:,:,ipassive_pool_z8)
+             carbon(:,ipassive,:,9) = carbon_stock(:,:,ipassive_pool_z9)
+             carbon(:,ipassive,:,10) = carbon_stock(:,:,ipassive_pool_z10)
+             carbon(:,ipassive,:,11) = carbon_stock(:,:,ipassive_pool_z11)
+
+             DOC(:,:,1,ifree,imetabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z1_metabo)
+             DOC(:,:,2,ifree,imetabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z2_metabo)
+             DOC(:,:,3,ifree,imetabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z3_metabo)
+             DOC(:,:,4,ifree,imetabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z4_metabo)
+             DOC(:,:,5,ifree,imetabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z5_metabo)
+             DOC(:,:,6,ifree,imetabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z6_metabo)
+             DOC(:,:,7,ifree,imetabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z7_metabo)
+             DOC(:,:,8,ifree,imetabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z8_metabo)
+             DOC(:,:,9,ifree,imetabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z9_metabo)
+             DOC(:,:,10,ifree,imetabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z10_metabo)
+             DOC(:,:,11,ifree,imetabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z11_metabo)
+
+             DOC(:,:,1,iadsorbed,imetabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z1_metabo)
+             DOC(:,:,2,iadsorbed,imetabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z2_metabo)
+             DOC(:,:,3,iadsorbed,imetabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z3_metabo)
+             DOC(:,:,4,iadsorbed,imetabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z4_metabo)
+             DOC(:,:,5,iadsorbed,imetabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z5_metabo)
+             DOC(:,:,6,iadsorbed,imetabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z6_metabo)
+             DOC(:,:,7,iadsorbed,imetabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z7_metabo)
+             DOC(:,:,8,iadsorbed,imetabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z8_metabo)
+             DOC(:,:,9,iadsorbed,imetabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z9_metabo)
+             DOC(:,:,10,iadsorbed,imetabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z10_metabo)
+             DOC(:,:,11,iadsorbed,imetabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z11_metabo)
+
+             DOC(:,:,1,ifree,istrabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z1_strabo)
+             DOC(:,:,2,ifree,istrabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z2_strabo)
+             DOC(:,:,3,ifree,istrabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z3_strabo)
+             DOC(:,:,4,ifree,istrabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z4_strabo)
+             DOC(:,:,5,ifree,istrabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z5_strabo)
+             DOC(:,:,6,ifree,istrabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z6_strabo)
+             DOC(:,:,7,ifree,istrabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z7_strabo)
+             DOC(:,:,8,ifree,istrabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z8_strabo)
+             DOC(:,:,9,ifree,istrabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z9_strabo)
+             DOC(:,:,10,ifree,istrabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z10_strabo)
+             DOC(:,:,11,ifree,istrabo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z11_strabo)
+
+             DOC(:,:,1,iadsorbed,istrabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z1_strabo)
+             DOC(:,:,2,iadsorbed,istrabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z2_strabo)
+             DOC(:,:,3,iadsorbed,istrabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z3_strabo)
+             DOC(:,:,4,iadsorbed,istrabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z4_strabo)
+             DOC(:,:,5,iadsorbed,istrabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z5_strabo)
+             DOC(:,:,6,iadsorbed,istrabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z6_strabo)
+             DOC(:,:,7,iadsorbed,istrabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z7_strabo)
+             DOC(:,:,8,iadsorbed,istrabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z8_strabo)
+             DOC(:,:,9,iadsorbed,istrabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z9_strabo)
+             DOC(:,:,10,iadsorbed,istrabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z10_strabo)
+             DOC(:,:,11,iadsorbed,istrabo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z11_strabo)
+
+             DOC(:,:,1,ifree,imetbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z1_metbel)
+             DOC(:,:,2,ifree,imetbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z2_metbel)
+             DOC(:,:,3,ifree,imetbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z3_metbel)
+             DOC(:,:,4,ifree,imetbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z4_metbel)
+             DOC(:,:,5,ifree,imetbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z5_metbel)
+             DOC(:,:,6,ifree,imetbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z6_metbel)
+             DOC(:,:,7,ifree,imetbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z7_metbel)
+             DOC(:,:,8,ifree,imetbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z8_metbel)
+             DOC(:,:,9,ifree,imetbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z9_metbel)
+             DOC(:,:,10,ifree,imetbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z10_metbel)
+             DOC(:,:,11,ifree,imetbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z11_metbel)
+
+             DOC(:,:,1,iadsorbed,imetbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z1_metbel)
+             DOC(:,:,2,iadsorbed,imetbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z2_metbel)
+             DOC(:,:,3,iadsorbed,imetbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z3_metbel)
+             DOC(:,:,4,iadsorbed,imetbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z4_metbel)
+             DOC(:,:,5,iadsorbed,imetbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z5_metbel)
+             DOC(:,:,6,iadsorbed,imetbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z6_metbel)
+             DOC(:,:,7,iadsorbed,imetbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z7_metbel)
+             DOC(:,:,8,iadsorbed,imetbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z8_metbel)
+             DOC(:,:,9,iadsorbed,imetbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z9_metbel)
+             DOC(:,:,10,iadsorbed,imetbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z10_metbel)
+             DOC(:,:,11,iadsorbed,imetbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z11_metbel)
+
+             DOC(:,:,1,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z1_strbel)
+             DOC(:,:,2,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z2_strbel)
+             DOC(:,:,3,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z3_strbel)
+             DOC(:,:,4,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z4_strbel)
+             DOC(:,:,5,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z5_strbel)
+             DOC(:,:,6,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z6_strbel)
+             DOC(:,:,7,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z7_strbel)
+             DOC(:,:,8,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z8_strbel)
+             DOC(:,:,9,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z9_strbel)
+             DOC(:,:,10,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z10_strbel)
+             DOC(:,:,11,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z11_strbel)
+
+             DOC(:,:,1,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z1_strbel)
+             DOC(:,:,2,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z2_strbel)
+             DOC(:,:,3,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z3_strbel)
+             DOC(:,:,4,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z4_strbel)
+             DOC(:,:,5,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z5_strbel)
+             DOC(:,:,6,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z6_strbel)
+             DOC(:,:,7,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z7_strbel)
+             DOC(:,:,8,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z8_strbel)
+             DOC(:,:,9,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z9_strbel)
+             DOC(:,:,10,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z10_strbel)
+             DOC(:,:,11,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z11_strbel)
+
+             DOC(:,:,1,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z1_strbel)
+             DOC(:,:,2,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z2_strbel)
+             DOC(:,:,3,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z3_strbel)
+             DOC(:,:,4,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z4_strbel)
+             DOC(:,:,5,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z5_strbel)
+             DOC(:,:,6,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z6_strbel)
+             DOC(:,:,7,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z7_strbel)
+             DOC(:,:,8,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z8_strbel)
+             DOC(:,:,9,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z9_strbel)
+             DOC(:,:,10,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z10_strbel)
+             DOC(:,:,11,ifree,istrbel,icarbon) = carbon_stock(:,:,ifreedoc_pool_z11_strbel)
+
+             DOC(:,:,1,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z1_strbel)
+             DOC(:,:,2,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z2_strbel)
+             DOC(:,:,3,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z3_strbel)
+             DOC(:,:,4,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z4_strbel)
+             DOC(:,:,5,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z5_strbel)
+             DOC(:,:,6,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z6_strbel)
+             DOC(:,:,7,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z7_strbel)
+             DOC(:,:,8,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z8_strbel)
+             DOC(:,:,9,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z9_strbel)
+             DOC(:,:,10,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z10_strbel)
+             DOC(:,:,11,iadsorbed,istrbel,icarbon) = carbon_stock(:,:,iadsdoc_pool_z11_strbel)
+
+             DOC(:,:,1,ifree,islo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z1_slo)
+             DOC(:,:,2,ifree,islo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z2_slo)
+             DOC(:,:,3,ifree,islo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z3_slo)
+             DOC(:,:,4,ifree,islo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z4_slo)
+             DOC(:,:,5,ifree,islo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z5_slo)
+             DOC(:,:,6,ifree,islo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z6_slo)
+             DOC(:,:,7,ifree,islo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z7_slo)
+             DOC(:,:,8,ifree,islo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z8_slo)
+             DOC(:,:,9,ifree,islo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z9_slo)
+             DOC(:,:,10,ifree,islo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z10_slo)
+             DOC(:,:,11,ifree,islo,icarbon) = carbon_stock(:,:,ifreedoc_pool_z11_slo)
+
+             DOC(:,:,1,iadsorbed,islo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z1_slo)
+             DOC(:,:,2,iadsorbed,islo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z2_slo)
+             DOC(:,:,3,iadsorbed,islo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z3_slo)
+             DOC(:,:,4,iadsorbed,islo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z4_slo)
+             DOC(:,:,5,iadsorbed,islo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z5_slo)
+             DOC(:,:,6,iadsorbed,islo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z6_slo)
+             DOC(:,:,7,iadsorbed,islo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z7_slo)
+             DOC(:,:,8,iadsorbed,islo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z8_slo)
+             DOC(:,:,9,iadsorbed,islo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z9_slo)
+             DOC(:,:,10,iadsorbed,islo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z10_slo)
+             DOC(:,:,11,iadsorbed,islo,icarbon) = carbon_stock(:,:,iadsdoc_pool_z11_slo)
+
+             DOC(:,:,1,ifree,ipas,icarbon) = carbon_stock(:,:,ifreedoc_pool_z1_pas)
+             DOC(:,:,2,ifree,ipas,icarbon) = carbon_stock(:,:,ifreedoc_pool_z2_pas)
+             DOC(:,:,3,ifree,ipas,icarbon) = carbon_stock(:,:,ifreedoc_pool_z3_pas)
+             DOC(:,:,4,ifree,ipas,icarbon) = carbon_stock(:,:,ifreedoc_pool_z4_pas)
+             DOC(:,:,5,ifree,ipas,icarbon) = carbon_stock(:,:,ifreedoc_pool_z5_pas)
+             DOC(:,:,6,ifree,ipas,icarbon) = carbon_stock(:,:,ifreedoc_pool_z6_pas)
+             DOC(:,:,7,ifree,ipas,icarbon) = carbon_stock(:,:,ifreedoc_pool_z7_pas)
+             DOC(:,:,8,ifree,ipas,icarbon) = carbon_stock(:,:,ifreedoc_pool_z8_pas)
+             DOC(:,:,9,ifree,ipas,icarbon) = carbon_stock(:,:,ifreedoc_pool_z9_pas)
+             DOC(:,:,10,ifree,ipas,icarbon) = carbon_stock(:,:,ifreedoc_pool_z10_pas)
+             DOC(:,:,11,ifree,ipas,icarbon) = carbon_stock(:,:,ifreedoc_pool_z11_pas)
+
+             DOC(:,:,1,iadsorbed,ipas,icarbon) = carbon_stock(:,:,iadsdoc_pool_z1_pas)
+             DOC(:,:,2,iadsorbed,ipas,icarbon) = carbon_stock(:,:,iadsdoc_pool_z2_pas)
+             DOC(:,:,3,iadsorbed,ipas,icarbon) = carbon_stock(:,:,iadsdoc_pool_z3_pas)
+             DOC(:,:,4,iadsorbed,ipas,icarbon) = carbon_stock(:,:,iadsdoc_pool_z4_pas)
+             DOC(:,:,5,iadsorbed,ipas,icarbon) = carbon_stock(:,:,iadsdoc_pool_z5_pas)
+             DOC(:,:,6,iadsorbed,ipas,icarbon) = carbon_stock(:,:,iadsdoc_pool_z6_pas)
+             DOC(:,:,7,iadsorbed,ipas,icarbon) = carbon_stock(:,:,iadsdoc_pool_z7_pas)
+             DOC(:,:,8,iadsorbed,ipas,icarbon) = carbon_stock(:,:,iadsdoc_pool_z8_pas)
+             DOC(:,:,9,iadsorbed,ipas,icarbon) = carbon_stock(:,:,iadsdoc_pool_z9_pas)
+             DOC(:,:,10,iadsorbed,ipas,icarbon) = carbon_stock(:,:,iadsdoc_pool_z10_pas)
+             DOC(:,:,11,iadsorbed,ipas,icarbon) = carbon_stock(:,:,iadsdoc_pool_z11_pas)
+
+             !! Add for parallelisation 
+             IF (.NOT. ALLOCATED(ok_equilibrium_g)) THEN
+                IF(is_root_prc) THEN
+                   ALLOCATE(ok_equilibrium_g(nbp_glo),stat=ier)
+                   IF (ier /= 0) THEN
+                      WRITE(numout,*) ' error in memory allocation for ok_equilibrium_g.'
+                      STOP 'stomate_main'
+                   ENDIF
+                ELSE
+                   ALLOCATE(ok_equilibrium_g(0))
+                END IF
+             END IF ! IF (.NOT. ALLOCATED(ok_equilibrium_g))
+             CALL gather(ok_equilibrium,ok_equilibrium_g)
+
+             ! Final step, if all the points are at equilibrium, we can stop the job
+             IF(is_root_prc) THEN         
+                 IF(ALL(ok_equilibrium_g)) THEN 
+                    WRITE(numout,*) 'Spinup analytic : Equilibrium for carbon pools is reached' 
+                 ELSE 
+                    WRITE(numout,*) 'Spinup analytic : Equilibrium for carbon pools is not yet reached' 
+                 END IF
+             ENDIF
+
+             ENDIF ! ( MOD(global_years,spinup_period) == 0)
+
+       ENDIF ! (EndOfYear)
+
+    ENDIF !(spinup_analytic)
+   
+  !! 8. Messages
+    
+    IF ( (bavard >= 2).AND.EndOfYear.AND.do_slow) THEN
+       WRITE(numout,*) 'stomate: EndOfYear'
+    ENDIF
+    IF (bavard >= 4) WRITE(numout,*) 'Leaving stomate_main'
+    IF (long_print) WRITE (numout,*) ' stomate_main done '
+
+
+  END SUBROUTINE stomate_main
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_init
+!!
+!>\BRIEF        The routine is called only at the first simulation. At that 
+!! time settings and flags are read and checked for internal consistency and 
+!! memory is allocated for the variables in stomate.
+!!
+!! DESCRIPTION  : The routine reads the 
+!! following flags from the run definition file:
+!! -bavard (level of online diagnostic in stomate)\n
+!! -ipd (index of grid point for online diagnostics)\n
+!! -ok_herbivores (flag to activate herbivores)\n
+!! -treat_expansion (flag to activate PFT expansion across a pixel\n
+!! -harvest_agri (flag to harvest aboveground biomass from agricultural PFTs)\n
+!! \n
+!! Check for inconsistent setting between the following flags:
+!! -control%ok_stomate\n
+!! -control%ok_dgvm\n
+!! -control%ok_co2\n
+!! -ldforcing_write\n
+!! \n
+!! Memory is allocated for all the variables of stomate and new indexing tables 
+!! are build. New indexing tables are needed because a single pixel can conatin 
+!! several PFTs. The new indexing tables have separate indices for the different 
+!! PFTs. Similar index tables are build for land use cover change.\n
+!! \n
+!! Several global variables and land cover change variables are initialized to 
+!! zero.\n
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output 
+!! variables. However, the routine allocates memory and builds new indexing 
+!! variables for later use.\n 
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE stomate_init &
+       &  (kjpij, kjpindex, index, ldforcing_write, lalo, &
+       &   rest_id_stom, hist_id_stom, hist_id_stom_IPCC)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                    :: kjpij             !! Total size of the un-compressed grid, including 
+                                                                      !! oceans (unitless) 
+    INTEGER(i_std),INTENT(in)                    :: kjpindex          !! Domain size - number of terrestrial pixels 
+                                                                      !! (unitless) 
+    INTEGER(i_std),INTENT(in)                    :: rest_id_stom      !! STOMATE's _Restart_ file identifier
+    INTEGER(i_std),INTENT(in)                    :: hist_id_stom      !! STOMATE's _history_ file identifier
+    INTEGER(i_std),INTENT(in)                    :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file identifier 
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in):: index             !! Indices of the terrestrial pixels on the global 
+                                                                      !! map 
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in) :: lalo              !! Geogr. coordinates (latitude,longitude) (degrees)
+    LOGICAL,INTENT(in)                           :: ldforcing_write   !! Flag activates writing of _forcing_ file
+   
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    LOGICAL                                      :: l_error           !! Check errors in netcdf call
+    INTEGER(i_std)                               :: ier               !! Check errors in netcdf call
+    INTEGER(i_std)                               :: ji,j,ipd,l        !! Indices
+
+    REAL(r_std)                                  :: tmp_day(1)        !! ??[DISPENSABLE]
+    REAL(r_std)                                  :: zcanop            !! ??[DISPENSABLE] soil depth taken for canopy
+    REAL(r_std),DIMENSION(nbdl)                  :: zsoil             !! ??[DISPENSABLE] soil depths at diagnostic levels 
+!_ ================================================================================================================================
+    
+  !! 1. Online diagnostics
+
+    !Config Key   = BAVARD
+    !Config Desc  = level of online diagnostics in STOMATE (0-4)
+    !Config If    = OK_STOMATE
+    !Config Def   = 1
+    !Config Help  = With this variable, you can determine
+    !Config         how much online information STOMATE
+    !Config         gives during the run. 0 means
+    !Config         virtually no info.
+    !Config Units = [-]
+    !
+    ! By default, ::bavard is set to 1 in stomate_data
+    bavard = 1
+    ! Get ::bavard from run definition file
+    CALL getin_p('BAVARD', bavard)
+
+    IF ( kjpindex > 0 ) THEN
+       !Config  Key  = STOMATE_DIAGPT
+       !Config  Desc = Index of grid point for online diagnostics
+       !Config If    = OK_STOMATE
+       !Config  Def  = 1
+       !Config  Help = This is the index of the grid point which
+       !               will be used for online diagnostics.
+       !Config Units = [-]
+       ! By default ::ipd is set to 1
+       ipd = 1
+       ! Get ::ipd from run definition file
+       CALL getin_p('STOMATE_DIAGPT',ipd)
+       ipd = MIN( ipd, kjpindex )
+       WRITE(numout,*) 'Stomate: '
+       WRITE(numout,*) '  Index of grid point for online diagnostics: ',ipd
+       WRITE(numout,*) '  Lon, lat:',lalo(ipd,2),lalo(ipd,1)
+       WRITE(numout,*) '  Index of this point on GCM grid: ',index(ipd)
+       !
+    ENDIF
+    
+  !! 2. Check consistency of flags
+
+    IF ( ( .NOT. control%ok_stomate ) .AND. control%ok_dgvm ) THEN
+       WRITE(numout,*) 'Cannot do dynamical vegetation without STOMATE.'
+       WRITE(numout,*) 'Inconsistency between ::control%ok_stomate and ::control%ok_dgvm'
+       WRITE(numout,*) 'Stop: fatal error'
+       STOP
+    ENDIF
+
+    IF ((.NOT.control%ok_co2).AND.control%ok_stomate) THEN
+       WRITE(numout,*) 'Cannot call STOMATE without GPP.'
+       WRITE(numout,*) 'Inconsistency between ::control%ok_stomate and ::control%ok_co2'
+       WRITE(numout,*) 'Stop: fatal error'
+       STOP
+    ENDIF
+
+    IF ( ( .NOT. control%ok_co2 ) .AND. ldforcing_write ) THEN
+       WRITE(numout,*)'Cannot write forcing file if photosynthesis is not activated'
+       WRITE(numout,*)'Inconsistency between ::ldforcing_write and ::control%ok_co2'
+       WRITE(numout,*) 'Stop: fatal error'
+       STOP
+    ENDIF
+    
+  !! 3. Communicate settings
+    
+    WRITE(numout,*) 'stomate first call - overview of the activated flags:'
+    WRITE(numout,*) '  Photosynthesis: ', control%ok_co2
+    WRITE(numout,*) '  STOMATE: ', control%ok_stomate
+    WRITE(numout,*) '  LPJ: ', control%ok_dgvm
+    
+  !! 4. Allocate memory for STOMATE's variables
+
+    l_error = .FALSE.
+
+    ALLOCATE(veget_cov_max(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for veget_cov_max. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(veget_cov_max_new(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for veget_cov_max_new. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(ind(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ind. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(adapted(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for adapted. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(regenerate(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for regenerate. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(litterhum_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for litterhum_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_min_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_min_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tsurf_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for tsurf_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tsoil_daily(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for tsoil_daily. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(soilhum_daily(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soilhum_daily. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(precip_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for precip_daily. We stop. We need kjpindex words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gpp_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gpp_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(npp_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for npp_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_daily(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_daily. We stop. We need kjpindex*nvm*nparts*nelements words', &
+       &   kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_littercalc(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_littercalc. We stop. We need kjpindex*nvm*nparts*nelements words', & 
+        &  kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_month(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_month. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(humrel_week(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for humrel_week. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_longterm(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_longterm. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tlong_ref(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for tlong_ref. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_month(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_month. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(t2m_week(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for t2m_week. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(tsoil_month(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for tsoil_month. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(soilhum_month(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soilhum_month. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(fireindex(kjpindex,nvm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for fireindex. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(firelitter(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for firelitter. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxhumrel_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxhumrel_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxhumrel_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxhumrel_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(minhumrel_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for minhumrel_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(minhumrel_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for minhumrel_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxgppweek_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxgppweek_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxgppweek_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxgppweek_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd0_lastyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd0_lastyear. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd0_thisyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd0_thisyear. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_init_date(kjpindex,2),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_init_date. We stop. We need kjpindex*2 words',kjpindex,2
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_from_growthinit(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_from_growthinit. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(precip_lastyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for precip_lastyear. We stop. We need kjpindex*nvm words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(precip_thisyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for precip_thisyear. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_m5_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_m5_dormance. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gdd_midwinter(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gdd_midwinter. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(ncd_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ncd_dormance. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(ngd_minus5(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ngd_minus5. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(PFTpresent(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for PFTpresent. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(npp_longterm(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for npp_longterm. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lm_lastyearmax(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lm_lastyearmax. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lm_thisyearmax(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lm_thisyearmax. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxfpc_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxfpc_lastyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(maxfpc_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for maxfpc_thisyear. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(turnover_longterm(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_longterm. We stop. We need kjpindex*nvm*nparts*nelements words', & 
+       &    kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(gpp_week(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for gpp_week. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(biomass(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for biomass. We stop. We need kjpindex*nvm*nparts*nelements words', &
+       &    kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(senescence(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for senescence. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(when_growthinit(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for when_growthinit. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(age(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for age. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_hetero_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_hetero_d. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_hetero_radia(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_hetero_radia. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_d. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_growth_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_growth_d. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(co2_fire(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for co2_fire. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(co2_to_bm_dgvm(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for co2_to_bm_dgvm. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(veget_lastlight(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for veget_lastlight. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(everywhere(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for everywhere. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(need_adjacent(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for need_adjacent. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(leaf_age(kjpindex,nvm,nleafages),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for leaf_age. We stop. We need kjpindex*nvm*nleafages words', & 
+       &      kjpindex,nvm,nleafages
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(leaf_frac(kjpindex,nvm,nleafages),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for leaf_frac. We stop. We need kjpindex*nvm*nleafages words', & 
+       &      kjpindex,nvm,nleafages
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(RIP_time(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for RIP_time. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(time_hum_min(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for time_hum_min. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(hum_min_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for hum_min_dormance. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(litterpart(kjpindex,nvm,nlitt),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for litterpart. We stop. We need kjpindex*nvm*nlitt words',  &
+       &  kjpindex,nvm,nlitt
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(litter_above(kjpindex,nlitt,nvm,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for litter. We stop. We need kjpindex*nlitt*nvm*nelements words', & 
+       &    kjpindex,nlitt,nvm,nelements
+       STOP 'stomate_init'
+    ENDIF
+    ALLOCATE(litter_below(kjpindex,nlitt,nvm,nbdl,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for litter. We stop. We need kjpindex*nlitt*nvm*nbdl*nelements words', &
+       &    kjpindex,nlitt,nvm,nbdl,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(dead_leaves(kjpindex,nvm,nlitt),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for dead_leaves. We stop. We need kjpindex*nvm*nlitt words', & 
+       &   kjpindex,nvm,nlitt
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(carbon(kjpindex,ncarb,nvm,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for carbon. We stop. We need kjpindex*ncarb*nvm*nbdl words',kjpindex,ncarb,nvm,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(DOC(kjpindex,nvm,nbdl,ndoc,npool,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for DOC. We stop. We need kjpindex*nvm*nbdl*ndoc*npool*nelements words',kjpindex,nvm,nbdl,ndoc,npool,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(DOC_EXP_d(kjpindex,nvm,nexp,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for DOC_EXP_d. We stop. We need kjpindex*nvm*nexp*nelements words',kjpindex,nvm,nexp,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(black_carbon(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for black_carbon. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lignin_struc_above(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lignin_struc_above. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(lignin_struc_below(kjpindex,nvm,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for lignin_struc_below. We stop. We need kjpindex*nvm*nlevs words',kjpindex,nvm,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+
+    ALLOCATE(turnover_time(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for turnover_time. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(co2_flux_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for co2_flux_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(co2_flux_monthly(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for co2_flux_monthly. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (cflux_prod_monthly(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for cflux_prod_monthly. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+ 
+    ALLOCATE (harvest_above_monthly(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for harvest_above_monthly. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(bm_to_litter(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for bm_to_litter. We stop. We need kjpindex*nvm*nparts*nelements words', & 
+       &    kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(bm_to_littercalc(kjpindex,nvm,nparts,nelements),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for bm_to_littercalc. We stop. We need kjpindex*nvm*nparts*nelements words', &
+       &   kjpindex,nvm,nparts,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(herbivores(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for herbivores. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(hori_index(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for hori_index. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(horipft_index(kjpindex*nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horipft_index. We stop. We need kjpindex*nvm words',kjpindex*nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(horisoillayer_index(kjpindex*nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horisoillayer_index. We stop. We need kjpindex*nbdl words',kjpindex*nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_part_radia(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_part_radia. We stop. We need kjpindex*nvm*nparts words', &
+       &  kjpindex,nvm,nparts
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_radia(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_radia. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(resp_maint_part(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for resp_maint_part. We stop. We need kjpindex*nvm*nparts words', &
+       &    kjpindex,nvm,nparts
+       STOP 'stomate_init'
+    ENDIF
+    resp_maint_part(:,:,:) = zero
+
+    ALLOCATE (horip10_index(kjpindex*10), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip10_index. We stop. We need kjpindex*10 words',kjpindex,10
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (horip100_index(kjpindex*100), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip100_index. We stop. We need kjpindex*100 words',kjpindex,100
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (horip11_index(kjpindex*11), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip11_index. We stop. We need kjpindex*11 words',kjpindex,11
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (horip101_index(kjpindex*101), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for horip101_index. We stop. We need kjpindex*101 words',kjpindex,101
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (prod10(kjpindex,0:10), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for prod10. We stop. We need kjpindex*11 words',kjpindex,11
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (prod100(kjpindex,0:100), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for prod100. We stop. We need kjpindex*101 words',kjpindex,101
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (flux10(kjpindex,10), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux10. We stop. We need kjpindex*10 words',kjpindex,10
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (flux100(kjpindex,100), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for flux100. We stop. We need kjpindex*100 words',kjpindex,100
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (convflux(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for convflux. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (cflux_prod10(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for cflux_prod10. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (cflux_prod100(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for cflux_prod100. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (harvest_above(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for harvest_above. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (carb_mass_total(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for carb_mass_total. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (soilcarbon_input_daily(kjpindex,nvm,nbdl,npool,nelements), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soilcarbon_input_daily. We stop. We need kjpindex*ncarb*nvm words', & 
+       &    kjpindex,ncarb,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (control_temp_above_daily(kjpindex,nlitt), stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) 'Memory allocation error for control_temp_above_daily. We stop. We need kjpindex*nlitt words',kjpindex,nlitt 
+       STOP 'stomate_init' 
+    ENDIF
+
+    ALLOCATE (control_temp_soil_daily(kjpindex,nbdl,npool*2), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for control_temp_soil_daily. We stop. We need kjpindex*nbdl*npool words',kjpindex,nbdl,npool
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (control_moist_soil_daily(kjpindex,nbdl,nvm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for control_moist_soil_daily. We stop. We need kjpindex*nbdl*nvm words',kjpindex,nbdl,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (moist_soil_daily(kjpindex,nbdl), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for moist_soil_daily. We stop. We need kjpindex*nbdl words',kjpindex,nbdl
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (soil_mc_Cforcing_daily(kjpindex,nbdl,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for soil_mc_Cforcing_daily. We stop. We need kjpindex*nbdl*nstm words',kjpindex,nbdl,nstm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (floodout_Cforcing_daily(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for floodout_Cforcing_daily. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (wat_flux0_Cforcing_daily(kjpindex,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for wat_flux0_Cforcing_daily. We stop. We need kjpindex*nstm words',kjpindex,nstm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (wat_flux_Cforcing_daily(kjpindex,nbdl,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for wat_flux_Cforcing_daily. We stop. We need kjpindex*nbdl*nstm words',kjpindex,nbdl,nstm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (runoff_per_soil_Cforcing_daily(kjpindex,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for runoff_per_soil_Cforcing_daily. We stop. We need kjpindex*nstm words',kjpindex,nstm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (drainage_per_soil_Cforcing_daily(kjpindex,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for drainage_per_soil_Cforcing_daily. We stop. We need kjpindex*nstm words',kjpindex,nstm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (DOC_to_topsoil_Cforcing_daily(kjpindex,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for DOC_to_topsoil_Cforcing_daily. We stop. We need kjpindex*nelements words',kjpindex,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (DOC_to_subsoil_Cforcing_daily(kjpindex,nstm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for DOC_to_subsoil_Cforcing_daily. We stop. We need kjpindex*nelements words',kjpindex,nelements
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE (control_moist_above_daily(kjpindex,nvm), stat=ier) 
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN 
+       WRITE(numout,*) 'Memory allocation error for control_moist_above_daily. We stop. We need kjpindex*nvm words',kjpindex,nvm 
+       STOP 'stomate_init' 
+    ENDIF 
+
+    ALLOCATE (fpc_max(kjpindex,nvm), stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for fpc_max. We stop. We need kjpindex*nvm words',kjpindex,nvm
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(ok_equilibrium(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0) 
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for ok_equilibrium. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(carbon_eq(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for carbon_eq. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(nbp_accu(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for nbp_accu. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(nbp_flux(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for nbp_flux. We stop. We need kjpindex words',kjpindex
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(matrixA(kjpindex,nvm,nbpools,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for matrixA. We stop. We need kjpindex*nvm*nbpools*nbpools words',  & 
+       &     kjpindex, nvm, nbpools, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(vectorB(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for vectorB. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(VectorU(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for VectorU. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(MatrixV(kjpindex,nvm,nbpools,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for MatrixV. We stop. We need kjpindex*nvm*nbpools*nbpools words',  & 
+       &     kjpindex, nvm, nbpools, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(MatrixW(kjpindex,nvm,nbpools,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for MatrixW. We stop. We need kjpindex*nvm*nbpools*nbpools words',  & 
+       &     kjpindex, nvm, nbpools, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(previous_stock(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for previous_stock. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+
+    ALLOCATE(current_stock(kjpindex,nvm,nbpools),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for current_stock. We stop. We need kjpindex*nvm*nbpools words',  & 
+       &     kjpindex, nvm, nbpools
+       STOP 'stomate_init'
+    ENDIF
+    
+  !! 5. File definitions
+
+    ! Store history and restart files in common variables
+    hist_id_stomate = hist_id_stom
+    hist_id_stomate_IPCC = hist_id_stom_IPCC
+    rest_id_stomate = rest_id_stom
+    
+    ! In STOMATE reduced grids are used containing only terrestrial pixels.
+    ! Build a new indexing table for the vegetation fields separating 
+    ! between the different PFTs. Note that ::index has dimension (kjpindex) 
+    ! wheras ::indexpft has dimension (kjpindex*nvm). 
+
+    hori_index(:) = index(:)
+
+    DO j = 1, nvm
+       DO ji = 1, kjpindex
+          horipft_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+    DO j = 1, nbdl
+       DO ji = 1, kjpindex
+          horisoillayer_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    ! Similar index tables are build for the land cover change variables
+    DO j = 1, 10
+       DO ji = 1, kjpindex
+          horip10_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, 100
+       DO ji = 1, kjpindex
+          horip100_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, 11
+       DO ji = 1, kjpindex
+          horip11_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+    DO j = 1, 101
+       DO ji = 1, kjpindex
+          horip101_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij + offset_omp - offset_mpi
+       ENDDO
+    ENDDO
+
+  !! 6. Initialization of global and land cover change variables. 
+
+    ! All variables are cumulative variables. bm_to_litter is not and is therefore
+    ! excluded
+    !   bm_to_litter(:,:,:) = zero
+    turnover_daily(:,:,:,:) = zero
+    resp_hetero_d(:,:) = zero
+    co2_flux_daily(:,:) = zero
+    co2_flux_monthly(:,:) = zero
+    cflux_prod_monthly(:) = zero
+    harvest_above_monthly(:) = zero
+    control_moist_above_daily(:,:) = zero
+    control_moist_soil_daily(:,:,:) = zero
+    moist_soil_daily(:,:) = zero
+    soil_mc_Cforcing_daily(:,:,:) = zero
+    floodout_Cforcing_daily(:) = zero
+    wat_flux0_Cforcing_daily(:,:) = zero
+    wat_flux_Cforcing_daily(:,:,:) = zero
+    runoff_per_soil_Cforcing_daily(:,:) = zero
+    drainage_per_soil_Cforcing_daily(:,:) = zero
+    DOC_to_topsoil_Cforcing_daily(:,:) = zero
+    DOC_to_subsoil_Cforcing_daily(:,:) = zero
+    control_temp_above_daily(:,:) = zero
+    control_temp_soil_daily(:,:,:) = zero
+    soilcarbon_input_daily(:,:,:,:,:) = zero
+    DOC_EXP_d(:,:,:,:) = zero
+    ! Land cover change variables
+    prod10(:,:)  = zero
+    prod100(:,:) = zero
+    flux10(:,:)  = zero
+    flux100(:,:) = zero
+    convflux(:)  = zero
+    cflux_prod10(:) = zero
+    cflux_prod100(:) = zero
+    fpc_max(:,:)=zero
+    
+  END SUBROUTINE stomate_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_clear
+!!
+!>\BRIEF        Deallocate memory of the stomate variables.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_clear
+
+  !! 1. Deallocate all dynamics variables
+
+    IF (ALLOCATED(veget_cov_max)) DEALLOCATE(veget_cov_max)
+    IF (ALLOCATED(veget_cov_max_new)) DEALLOCATE(veget_cov_max_new)
+    IF (ALLOCATED(ind)) DEALLOCATE(ind)
+    IF (ALLOCATED(adapted)) DEALLOCATE(adapted)
+    IF (ALLOCATED(regenerate)) DEALLOCATE(regenerate)
+    IF (ALLOCATED(humrel_daily)) DEALLOCATE(humrel_daily)
+    IF (ALLOCATED(gdd_init_date)) DEALLOCATE(gdd_init_date)
+    IF (ALLOCATED(litterhum_daily)) DEALLOCATE(litterhum_daily)
+    IF (ALLOCATED(t2m_daily))  DEALLOCATE(t2m_daily)
+    IF (ALLOCATED(t2m_min_daily))  DEALLOCATE(t2m_min_daily)
+    IF (ALLOCATED(tsurf_daily))  DEALLOCATE(tsurf_daily)
+    IF (ALLOCATED(tsoil_daily)) DEALLOCATE(tsoil_daily)
+    IF (ALLOCATED(soilhum_daily)) DEALLOCATE(soilhum_daily)
+    IF (ALLOCATED(precip_daily)) DEALLOCATE(precip_daily)
+    IF (ALLOCATED(gpp_daily)) DEALLOCATE(gpp_daily)
+    IF (ALLOCATED(npp_daily)) DEALLOCATE(npp_daily)
+    IF (ALLOCATED(turnover_daily)) DEALLOCATE(turnover_daily)
+    IF (ALLOCATED(turnover_littercalc)) DEALLOCATE(turnover_littercalc)
+    IF (ALLOCATED(humrel_month)) DEALLOCATE(humrel_month)
+    IF (ALLOCATED(humrel_week)) DEALLOCATE(humrel_week)
+    IF (ALLOCATED(t2m_longterm)) DEALLOCATE(t2m_longterm)
+    IF (ALLOCATED(tlong_ref)) DEALLOCATE(tlong_ref)
+    IF (ALLOCATED(t2m_month)) DEALLOCATE(t2m_month)
+    IF (ALLOCATED(t2m_week)) DEALLOCATE(t2m_week)
+    IF (ALLOCATED(tsoil_month)) DEALLOCATE(tsoil_month)
+    IF (ALLOCATED(soilhum_month)) DEALLOCATE(soilhum_month)
+    IF (ALLOCATED(fireindex)) DEALLOCATE(fireindex)
+    IF (ALLOCATED(firelitter)) DEALLOCATE(firelitter)
+    IF (ALLOCATED(maxhumrel_lastyear)) DEALLOCATE(maxhumrel_lastyear)
+    IF (ALLOCATED(maxhumrel_thisyear)) DEALLOCATE(maxhumrel_thisyear)
+    IF (ALLOCATED(minhumrel_lastyear)) DEALLOCATE(minhumrel_lastyear)
+    IF (ALLOCATED(minhumrel_thisyear)) DEALLOCATE(minhumrel_thisyear)
+    IF (ALLOCATED(maxgppweek_lastyear)) DEALLOCATE(maxgppweek_lastyear)
+    IF (ALLOCATED(maxgppweek_thisyear)) DEALLOCATE(maxgppweek_thisyear)
+    IF (ALLOCATED(gdd0_lastyear)) DEALLOCATE(gdd0_lastyear)
+    IF (ALLOCATED(gdd0_thisyear)) DEALLOCATE(gdd0_thisyear)
+    IF (ALLOCATED(precip_lastyear)) DEALLOCATE(precip_lastyear)
+    IF (ALLOCATED(precip_thisyear)) DEALLOCATE(precip_thisyear)
+    IF (ALLOCATED(gdd_m5_dormance)) DEALLOCATE(gdd_m5_dormance)
+    IF (ALLOCATED(gdd_from_growthinit)) DEALLOCATE(gdd_from_growthinit)
+    IF (ALLOCATED(gdd_midwinter)) DEALLOCATE(gdd_midwinter)
+    IF (ALLOCATED(ncd_dormance)) DEALLOCATE(ncd_dormance)
+    IF (ALLOCATED(ngd_minus5))  DEALLOCATE(ngd_minus5)
+    IF (ALLOCATED(PFTpresent)) DEALLOCATE(PFTpresent)
+    IF (ALLOCATED(npp_longterm)) DEALLOCATE(npp_longterm)
+    IF (ALLOCATED(lm_lastyearmax)) DEALLOCATE(lm_lastyearmax)
+    IF (ALLOCATED(lm_thisyearmax)) DEALLOCATE(lm_thisyearmax)
+    IF (ALLOCATED(maxfpc_lastyear)) DEALLOCATE(maxfpc_lastyear)
+    IF (ALLOCATED(maxfpc_thisyear)) DEALLOCATE(maxfpc_thisyear)
+    IF (ALLOCATED(turnover_longterm)) DEALLOCATE(turnover_longterm)
+    IF (ALLOCATED(gpp_week)) DEALLOCATE(gpp_week)
+    IF (ALLOCATED(biomass)) DEALLOCATE(biomass)
+    IF (ALLOCATED(senescence)) DEALLOCATE(senescence)
+    IF (ALLOCATED(when_growthinit)) DEALLOCATE(when_growthinit)
+    IF (ALLOCATED(age))  DEALLOCATE(age)
+    IF (ALLOCATED(resp_hetero_d)) DEALLOCATE(resp_hetero_d)
+    IF (ALLOCATED(resp_hetero_radia)) DEALLOCATE(resp_hetero_radia)
+    IF (ALLOCATED(resp_maint_d)) DEALLOCATE(resp_maint_d)
+    IF (ALLOCATED(resp_growth_d)) DEALLOCATE(resp_growth_d)
+    IF (ALLOCATED(co2_fire)) DEALLOCATE(co2_fire)
+    IF (ALLOCATED(co2_to_bm_dgvm)) DEALLOCATE(co2_to_bm_dgvm)
+    IF (ALLOCATED(veget_lastlight)) DEALLOCATE(veget_lastlight)
+    IF (ALLOCATED(everywhere)) DEALLOCATE(everywhere)
+    IF (ALLOCATED(need_adjacent)) DEALLOCATE(need_adjacent)
+    IF (ALLOCATED(leaf_age)) DEALLOCATE(leaf_age)
+    IF (ALLOCATED(leaf_frac)) DEALLOCATE(leaf_frac)
+    IF (ALLOCATED(RIP_time)) DEALLOCATE(RIP_time)
+    IF (ALLOCATED(time_hum_min)) DEALLOCATE(time_hum_min)
+    IF (ALLOCATED(hum_min_dormance)) DEALLOCATE(hum_min_dormance)
+    IF (ALLOCATED(litterpart)) DEALLOCATE(litterpart)
+    IF (ALLOCATED(litter_above)) DEALLOCATE(litter_above)
+    IF (ALLOCATED(litter_below)) DEALLOCATE(litter_below)
+    IF (ALLOCATED(dead_leaves)) DEALLOCATE(dead_leaves)
+    IF (ALLOCATED(carbon)) DEALLOCATE(carbon)
+    IF (ALLOCATED(DOC)) DEALLOCATE(DOC)
+    IF (ALLOCATED(DOC_EXP_d)) DEALLOCATE(DOC_EXP_d)
+    IF (ALLOCATED(black_carbon)) DEALLOCATE(black_carbon)
+    IF (ALLOCATED(lignin_struc_above)) DEALLOCATE(lignin_struc_above)
+    IF (ALLOCATED(lignin_struc_below)) DEALLOCATE(lignin_struc_below)
+    IF (ALLOCATED(turnover_time)) DEALLOCATE(turnover_time)
+    IF (ALLOCATED(co2_flux_daily)) DEALLOCATE(co2_flux_daily)
+    IF (ALLOCATED(co2_flux_monthly)) DEALLOCATE(co2_flux_monthly)
+    IF (ALLOCATED(harvest_above_monthly)) DEALLOCATE (harvest_above_monthly)
+    IF (ALLOCATED(cflux_prod_monthly)) DEALLOCATE (cflux_prod_monthly)
+    IF (ALLOCATED(bm_to_litter)) DEALLOCATE(bm_to_litter)
+    IF (ALLOCATED(bm_to_littercalc)) DEALLOCATE(bm_to_littercalc)
+    IF (ALLOCATED(herbivores)) DEALLOCATE(herbivores)
+    IF (ALLOCATED(resp_maint_part_radia)) DEALLOCATE(resp_maint_part_radia)
+    IF (ALLOCATED(resp_maint_radia)) DEALLOCATE(resp_maint_radia)
+    IF (ALLOCATED(resp_maint_part)) DEALLOCATE(resp_maint_part)
+    IF (ALLOCATED(hori_index)) DEALLOCATE(hori_index)
+    IF (ALLOCATED(horipft_index)) DEALLOCATE(horipft_index)
+    IF (ALLOCATED(horisoillayer_index)) DEALLOCATE(horisoillayer_index)
+    IF (ALLOCATED(clay_fm)) DEALLOCATE(clay_fm)
+    IF (ALLOCATED(bulk_dens_fm)) DEALLOCATE(bulk_dens_fm)
+    IF (ALLOCATED(soil_ph_fm)) DEALLOCATE(soil_ph_fm)
+    IF (ALLOCATED(humrel_daily_fm)) DEALLOCATE(humrel_daily_fm)
+    IF (ALLOCATED(litterhum_daily_fm))  DEALLOCATE(litterhum_daily_fm)
+    IF (ALLOCATED(t2m_daily_fm))  DEALLOCATE(t2m_daily_fm)
+    IF (ALLOCATED(t2m_min_daily_fm))  DEALLOCATE(t2m_min_daily_fm)
+    IF (ALLOCATED(tsurf_daily_fm)) DEALLOCATE(tsurf_daily_fm)
+    IF (ALLOCATED(tsoil_daily_fm)) DEALLOCATE(tsoil_daily_fm)
+    IF (ALLOCATED(soilhum_daily_fm))  DEALLOCATE(soilhum_daily_fm)
+    IF (ALLOCATED(precip_fm)) DEALLOCATE(precip_fm)
+    IF (ALLOCATED(gpp_daily_fm))  DEALLOCATE(gpp_daily_fm)
+    IF (ALLOCATED(veget_fm)) DEALLOCATE(veget_fm)
+    IF (ALLOCATED(veget_max_fm)) DEALLOCATE(veget_max_fm)
+    IF (ALLOCATED(lai_fm))  DEALLOCATE(lai_fm)
+    !
+    IF (ALLOCATED(ok_equilibrium)) DEALLOCATE(ok_equilibrium)
+    IF (ALLOCATED(carbon_eq)) DEALLOCATE(carbon_eq)
+    IF (ALLOCATED(matrixA)) DEALLOCATE(matrixA)
+    IF (ALLOCATED(vectorB)) DEALLOCATE(vectorB)
+    IF (ALLOCATED(MatrixV)) DEALLOCATE(MatrixV)
+    IF (ALLOCATED(VectorU)) DEALLOCATE(VectorU)
+    IF (ALLOCATED(MatrixW)) DEALLOCATE(MatrixW)
+    IF (ALLOCATED(previous_stock)) DEALLOCATE(previous_stock)
+    IF (ALLOCATED(current_stock)) DEALLOCATE(current_stock) 
+    IF (ALLOCATED(nbp_accu)) DEALLOCATE(nbp_accu)
+    IF (ALLOCATED(nbp_flux)) DEALLOCATE(nbp_flux)
+
+    IF (is_root_prc) THEN
+       IF (ALLOCATED(clay_fm_g)) DEALLOCATE(clay_fm_g)
+       IF (ALLOCATED(soil_ph_fm_g)) DEALLOCATE(soil_ph_fm_g)
+       IF (ALLOCATED(humrel_daily_fm_g)) DEALLOCATE(humrel_daily_fm_g)
+       IF (ALLOCATED(litterhum_daily_fm_g))  DEALLOCATE(litterhum_daily_fm_g)
+       IF (ALLOCATED(t2m_daily_fm_g))  DEALLOCATE(t2m_daily_fm_g)
+       IF (ALLOCATED(t2m_min_daily_fm_g))  DEALLOCATE(t2m_min_daily_fm_g)
+       IF (ALLOCATED(tsurf_daily_fm_g)) DEALLOCATE(tsurf_daily_fm_g)
+       IF (ALLOCATED(tsoil_daily_fm_g)) DEALLOCATE(tsoil_daily_fm_g)
+       IF (ALLOCATED(soilhum_daily_fm_g))  DEALLOCATE(soilhum_daily_fm_g)
+       IF (ALLOCATED(precip_fm_g)) DEALLOCATE(precip_fm_g)
+       IF (ALLOCATED(gpp_daily_fm_g))  DEALLOCATE(gpp_daily_fm_g)
+       IF (ALLOCATED(veget_fm_g)) DEALLOCATE(veget_fm_g)
+       IF (ALLOCATED(veget_max_fm_g)) DEALLOCATE(veget_max_fm_g)
+       IF (ALLOCATED(lai_fm_g))  DEALLOCATE(lai_fm_g)
+       IF (ALLOCATED(ok_equilibrium_g)) DEALLOCATE(ok_equilibrium_g)
+    ENDIF
+
+    IF (ALLOCATED(isf)) DEALLOCATE(isf)
+    IF (ALLOCATED(nf_written)) DEALLOCATE(nf_written)
+    IF (ALLOCATED(nf_cumul)) DEALLOCATE(nf_cumul)
+    IF (ALLOCATED(nforce)) DEALLOCATE(nforce)
+    IF (ALLOCATED(control_moist_above)) DEALLOCATE(control_moist_above)
+    IF (ALLOCATED(control_moist_soil)) DEALLOCATE(control_moist_soil)
+    IF (ALLOCATED(moist_soil)) DEALLOCATE(moist_soil)
+    IF (ALLOCATED(soil_mc_Cforcing)) DEALLOCATE(soil_mc_Cforcing)
+    IF (ALLOCATED(floodout_Cforcing)) DEALLOCATE(floodout_Cforcing)
+    IF (ALLOCATED(wat_flux0_Cforcing)) DEALLOCATE(wat_flux0_Cforcing)
+    IF (ALLOCATED(wat_flux_Cforcing)) DEALLOCATE(wat_flux_Cforcing)
+    IF (ALLOCATED(runoff_per_soil_Cforcing)) DEALLOCATE(runoff_per_soil_Cforcing)
+    IF (ALLOCATED(drainage_per_soil_Cforcing)) DEALLOCATE(drainage_per_soil_Cforcing)
+    IF (ALLOCATED(DOC_to_topsoil_Cforcing)) DEALLOCATE(DOC_to_topsoil_Cforcing)
+    IF (ALLOCATED(DOC_to_subsoil_Cforcing)) DEALLOCATE(DOC_to_subsoil_Cforcing)
+    IF (ALLOCATED(control_temp_above)) DEALLOCATE(control_temp_above)
+    IF (ALLOCATED(control_temp_soil)) DEALLOCATE(control_temp_soil)
+    IF (ALLOCATED(soilcarbon_input)) DEALLOCATE(soilcarbon_input)
+    IF ( ALLOCATED (horip10_index)) DEALLOCATE (horip10_index)
+    IF ( ALLOCATED (horip100_index)) DEALLOCATE (horip100_index)
+    IF ( ALLOCATED (horip11_index)) DEALLOCATE (horip11_index)
+    IF ( ALLOCATED (horip101_index)) DEALLOCATE (horip101_index)
+    IF ( ALLOCATED (prod10)) DEALLOCATE (prod10)
+    IF ( ALLOCATED (prod100)) DEALLOCATE (prod100)
+    IF ( ALLOCATED (flux10)) DEALLOCATE (flux10)
+    IF ( ALLOCATED (flux100)) DEALLOCATE (flux100)
+    IF ( ALLOCATED (convflux)) DEALLOCATE (convflux)
+    IF ( ALLOCATED (cflux_prod10)) DEALLOCATE (cflux_prod10)
+    IF ( ALLOCATED (cflux_prod100)) DEALLOCATE (cflux_prod100)
+    IF ( ALLOCATED (harvest_above)) DEALLOCATE (harvest_above)
+    IF ( ALLOCATED (soilcarbon_input_daily)) DEALLOCATE (soilcarbon_input_daily)
+    IF ( ALLOCATED (control_temp_above_daily)) DEALLOCATE (control_temp_above_daily)
+    IF ( ALLOCATED (control_temp_soil_daily)) DEALLOCATE (control_temp_soil_daily)
+    IF ( ALLOCATED (control_moist_above_daily)) DEALLOCATE (control_moist_above_daily)
+    IF ( ALLOCATED (control_moist_soil_daily)) DEALLOCATE (control_moist_soil_daily)
+    IF ( ALLOCATED (moist_soil_daily)) DEALLOCATE (moist_soil_daily)
+    IF ( ALLOCATED (soil_mc_Cforcing_daily)) DEALLOCATE (soil_mc_Cforcing_daily)
+    IF (ALLOCATED(floodout_Cforcing_daily)) DEALLOCATE(floodout_Cforcing_daily)
+    IF (ALLOCATED(wat_flux0_Cforcing_daily)) DEALLOCATE(wat_flux0_Cforcing_daily)
+    IF (ALLOCATED(wat_flux_Cforcing_daily)) DEALLOCATE(wat_flux_Cforcing_daily)
+    IF (ALLOCATED(runoff_per_soil_Cforcing_daily)) DEALLOCATE(runoff_per_soil_Cforcing_daily)
+    IF (ALLOCATED(drainage_per_soil_Cforcing_daily)) DEALLOCATE(drainage_per_soil_Cforcing_daily)
+    IF (ALLOCATED(DOC_to_topsoil_Cforcing_daily)) DEALLOCATE(DOC_to_topsoil_Cforcing_daily)
+    IF (ALLOCATED(DOC_to_subsoil_Cforcing_daily)) DEALLOCATE(DOC_to_subsoil_Cforcing_daily)
+    IF ( ALLOCATED (fpc_max)) DEALLOCATE (fpc_max)
+    IF (ALLOCATED(litter_above_Cforcing)) DEALLOCATE(litter_above_Cforcing)
+    IF (ALLOCATED(litter_below_Cforcing)) DEALLOCATE(litter_below_Cforcing)
+    IF (ALLOCATED(lignin_struc_above_Cforcing)) DEALLOCATE(lignin_struc_above_Cforcing)
+    IF (ALLOCATED(lignin_struc_below_Cforcing)) DEALLOCATE(lignin_struc_below_Cforcing)
+ !! 2. reset l_first
+
+    l_first_stomate=.TRUE.
+
+ !! 3. call to clear functions
+
+    CALL get_reftemp_clear
+    CALL season_clear
+    CALL stomatelpj_clear
+    CALL littercalc_clear
+    CALL vmax_clear
+ 
+  END SUBROUTINE stomate_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_var_init
+!!
+!>\BRIEF        Initialize variables of stomate with a none-zero initial value.
+!! Subroutine is called only if ::ok_stomate = .TRUE. STOMATE diagnoses some 
+!! variables for SECHIBA : assim_param, deadleaf_cover, etc. These variables can 
+!! be recalculated from STOMATE's prognostic variables. Note that height is
+!! saved in SECHIBA.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): leaf age (::leaf_age) and fraction of leaves in leaf 
+!! age class (::leaf_frac). The maximum water on vegetation available for 
+!! interception, fraction of soil covered by dead leaves
+!! (::deadleaf_cover) and assimilation parameters (:: assim_param).
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_var_init &
+       &  (kjpindex, veget_cov_max, leaf_age, leaf_frac, &
+       &   tlong_ref, t2m_month, dead_leaves, &
+       &   veget, lai, deadleaf_cover, assim_param)
+
+
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                             :: kjpindex        !! Domain size - terrestrial pixels only
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)        :: veget           !! Fraction of pixel covered by PFT. Fraction 
+                                                                             !! accounts for none-biological land covers 
+                                                                             !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)        :: veget_cov_max   !! Fractional coverage: maximum share of the pixel 
+                                                                             !! covered by a PFT (unitless) 
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)            :: tlong_ref       !! "long term" 2 meter reference temperatures (K)
+    REAL(r_std),DIMENSION(kjpindex),INTENT(in)            :: t2m_month       !! Air temperature at 2 meter integrated over a 
+                                                                             !! month (K) 
+    REAL(r_std),DIMENSION(kjpindex,nvm,nlitt),INTENT(in)  :: dead_leaves     !! Metabolic and structural fraction of dead leaves 
+                                                                             !! per ground area 
+                                                                             !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)        :: lai             !! Leaf area index 
+                                                                             !! @tex $(m^2 m{-2})$ @endtex 
+    
+    !! 0.2 Modified variables
+
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(inout) :: leaf_age  !! Age of different leaf classes per PFT (days)
+    REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(inout) :: leaf_frac !! Fraction of leaves in leaf age class per PFT 
+
+    !! 0.3 Output variables
+
+    REAL(r_std),DIMENSION(kjpindex), INTENT (out)         :: deadleaf_cover  !! Fraction of soil covered by dead leaves 
+                                                                             !! (unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(out) :: assim_param    !! min+max+opt temperatures (K) & vmax for 
+                                                                            !! photosynthesis  
+                                                                            !! @tex $(\mumol m^{-2} s^{-1})$ @endtex
+    ! 0.4 Local variables
+   
+    REAL(r_std),PARAMETER                                 :: dt_0 = zero     !! Dummy time step, must be zero
+    REAL(r_std),DIMENSION(kjpindex,nvm)                   :: vcmax           !! Dummy vcmax 
+                                                                             !! @tex $(\mu mol m^{-2} s^{-1})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)                   :: vjmax           !! Dummy vjmax 
+                                                                             !! @tex $(\mu mol m^{-2} s^{-1})$ @endtex
+    REAL(r_std),DIMENSION(kjpindex,nvm)                   :: t_photo_min     !! Min temperature for photosynthesis (K)
+    REAL(r_std),DIMENSION(kjpindex,nvm)                   :: t_photo_opt     !! Opt temperature for photosynthesis (K)
+    REAL(r_std),DIMENSION(kjpindex,nvm)                   :: t_photo_max     !! Max temperature for photosynthesis (K)  
+    INTEGER(i_std)                                        :: j               !! Index (untiless)
+    
+!_ ================================================================================================================================   
+
+    ! Only if stomate is activated
+    IF (control%ok_stomate) THEN
+     
+  !! 1. photosynthesis parameters
+
+       !! 1.1 vcmax (stomate_vmax.f90)
+       CALL vmax (kjpindex, dt_0, leaf_age, leaf_frac, vcmax, vjmax)
+       
+       !! 1.2 assimilation temperatures (stomate_assimtemp.f90)
+       CALL assim_temp(kjpindex, tlong_ref, t2m_month, &
+            &                    t_photo_min, t_photo_opt, t_photo_max)
+       
+       !! 1.3 transform into nvm vegetation types
+       assim_param(:,:,ivcmax) = zero
+       DO j = 2, nvm
+          assim_param(:,j,ivcmax)=vcmax(:,j)
+       ENDDO
+       assim_param(:,:,ivjmax) = zero
+       DO j = 2, nvm
+          assim_param(:,j,ivjmax)=vjmax(:,j)
+       ENDDO
+       assim_param(:,:,itmin) = zero
+       DO j = 2, nvm
+          assim_param(:,j,itmin)=t_photo_min(:,j)
+       ENDDO
+       assim_param(:,:,itopt) = zero
+       DO j = 2, nvm
+          assim_param(:,j,itopt)=t_photo_opt(:,j)
+       ENDDO
+       assim_param(:,:,itmax) = zero
+       DO j = 2, nvm
+          assim_param(:,j,itmax)=t_photo_max(:,j)
+       ENDDO
+       
+  !! 2. Dead leaf cover (stomate_litter.f90)
+       
+       CALL deadleaf (kjpindex, veget_cov_max, dead_leaves, deadleaf_cover)     
+       
+    ENDIF ! ok_stomate = .TRUE.
+  
+  END SUBROUTINE stomate_var_init
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_accu
+!!
+!>\BRIEF        Accumulate a variable for the time period specified by 
+!! ::dt_tot or calculate the mean value over ::dt_tot.
+!! 
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): accumulated or mean variable ::field_out:: 
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE stomate_accu &
+       &  (npts, n_dim2, dt_tot, dt, ldmean, field_in, field_out)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+ 
+    INTEGER(i_std),INTENT(in)                        :: npts      !! Domain size (unitless)
+    INTEGER(i_std),INTENT(in)                        :: n_dim2    !! 2nd dimension (1 or nvm)
+    REAL(r_std),INTENT(in)                           :: dt_tot    !! Current time step (days)
+    REAL(r_std),INTENT(in)                           :: dt        !! Accumulated time step (days)
+    LOGICAL,INTENT(in)                               :: ldmean    !! Flag to calculate the mean over
+    REAL(r_std),DIMENSION(npts,n_dim2),INTENT(in)    :: field_in  !! Field that needs to be accumulated
+    
+    !! 0.2 Output variables
+    
+    !! 0.3 Modified variables
+
+    REAL(r_std),DIMENSION(npts,n_dim2),INTENT(inout) :: field_out !! Accumulated or mean field
+
+    !! 0.4 Local variables
+
+!_ ================================================================================================================================
+
+  !! 1. Accumulate field
+
+    field_out(:,:) = field_out(:,:)+field_in(:,:)*dt
+   
+  !! 2. Mean fields
+
+    IF (ldmean) THEN
+       field_out(:,:) = field_out(:,:)/dt_tot
+    ENDIF
+
+  END SUBROUTINE stomate_accu
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: init_forcing
+!!
+!>\BRIEF        Allocate memory for the variables containing the forcing data.
+!! The maximum size of the allocated memory is specified in run definition file
+!! (::max_totsize) and needs to be a compromise between charging the memory and 
+!! accessing disks to get the forcing data.
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): Strictly speaking the subroutine has no output 
+!! variables. However, the routine allocates memory for later use. 
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE init_forcing (kjpindex,nsfm,nsft)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    
+    INTEGER(i_std),INTENT(in) :: kjpindex !! Domain size - terrestrial pixels only (unitless)
+    INTEGER(i_std),INTENT(in) :: nsfm     !! Number of time steps that can be stored in memory (unitless)
+    INTEGER(i_std),INTENT(in) :: nsft     !! Number of time steps in a year (unitless)
+
+   !! 0.2 Output variables
+
+   !! 0.3 Modified variables
+
+   !! 0.4 Local variables
+
+    LOGICAL                   :: l_error  !! Check errors in netcdf call
+    INTEGER(i_std)            :: ier      !! Check errors in netcdf call
+!_ ================================================================================================================================
+    
+  !! 1. Allocate memory
+
+    ! Note ::nvm is number of PFTs and ::nbdl is number of soil layers
+    l_error = .FALSE.
+    ALLOCATE(clay_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables clay_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(soil_ph_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables soil_ph_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    l_error = .FALSE.
+    ALLOCATE(bulk_dens_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables bulk_dens_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+
+    ALLOCATE(humrel_daily_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables humrel_daily_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(litterhum_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables litterhum_daily_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(t2m_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables t2m_daily_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(t2m_min_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables t2m_min_daily_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(tsurf_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables tsurf_daily_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(tsoil_daily_fm(kjpindex,nbdl,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables tsoil_daily_fm ',kjpindex,nbdl,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(soilhum_daily_fm(kjpindex,nbdl,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables soilhum_daily_fm ',kjpindex,nbdl,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(precip_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables precip_fm ',kjpindex,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(gpp_daily_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables gpp_daily_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(veget_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(veget_max_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_max_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(lai_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables lai_fm ',kjpindex,nvm,nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(isf(nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables isf ',nsfm
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(nf_written(nsft),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables nf_written ',nsft
+       STOP 'init_forcing'
+    ENDIF
+    ALLOCATE(nf_cumul(nsft),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables nf_cumul ',nsft
+       STOP 'init_forcing'
+    ENDIF
+    
+  !! 2. Allocate memory for the root processor only (parallel computing)
+
+    ! Where, ::nbp_glo is the number of global continental points
+    IF (is_root_prc) THEN
+       ALLOCATE(clay_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables clay_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(soil_ph_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables soil_ph_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(bulk_dens_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables bulk_dens_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(humrel_daily_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables humrel_daily_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(litterhum_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables litterhum_daily_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(t2m_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables t2m_daily_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(t2m_min_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables t2m_min_daily_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(tsurf_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables tsurf_daily_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(tsoil_daily_fm_g(nbp_glo,nbdl,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables tsoil_daily_fm_g ',nbp_glo,nbdl,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(soilhum_daily_fm_g(nbp_glo,nbdl,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables soilhum_daily_fm_g ',nbp_glo,nbdl,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(precip_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables precip_fm_g ',nbp_glo,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(gpp_daily_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables gpp_daily_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(veget_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(veget_max_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables veget_max_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+       ALLOCATE(lai_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       IF (l_error) THEN
+          WRITE(numout,*) 'Problem with memory allocation: forcing variables lai_fm_g ',nbp_glo,nvm,nsfm
+          STOP 'init_forcing'
+       ENDIF
+    ELSE
+       ! Allocate memory for co-processors
+       ALLOCATE(clay_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(soil_ph_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(bulk_dens_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(humrel_daily_fm_g(0,nvm,nsfm),stat=ier)
+       ALLOCATE(litterhum_daily_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(t2m_daily_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(t2m_min_daily_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(tsurf_daily_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(tsoil_daily_fm_g(0,nbdl,nsfm),stat=ier)
+       ALLOCATE(soilhum_daily_fm_g(0,nbdl,nsfm),stat=ier)
+       ALLOCATE(precip_fm_g(0,nsfm),stat=ier)
+       ALLOCATE(gpp_daily_fm_g(0,nvm,nsfm),stat=ier)
+       ALLOCATE(veget_fm_g(0,nvm,nsfm),stat=ier)
+       ALLOCATE(veget_max_fm_g(0,nvm,nsfm),stat=ier)
+       ALLOCATE(lai_fm_g(0,nvm,nsfm),stat=ier)
+    ENDIF ! is_root_proc
+    
+    IF (l_error) THEN
+       WRITE(numout,*) 'Problem with memory allocation: forcing variables'
+       STOP 'init_forcing'
+    ENDIF
+
+  !! 3. Initilaize variables
+
+    CALL forcing_zero
+    
+  END SUBROUTINE init_forcing
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: forcing_zero
+!!
+!>\BRIEF        Initialize variables containing the forcing data; variables are 
+!! set to zero.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE forcing_zero
+    
+    clay_fm(:,:) = zero
+    soil_ph_fm(:,:) = zero
+    bulk_dens_fm(:,:) = zero
+    humrel_daily_fm(:,:,:) = zero
+    litterhum_daily_fm(:,:) = zero
+    t2m_daily_fm(:,:) = zero
+    t2m_min_daily_fm(:,:) = zero
+    tsurf_daily_fm(:,:) = zero
+    tsoil_daily_fm(:,:,:) = zero
+    soilhum_daily_fm(:,:,:) = zero
+    precip_fm(:,:) = zero
+    gpp_daily_fm(:,:,:) = zero
+    veget_fm(:,:,:) = zero
+    veget_max_fm(:,:,:) = zero
+    lai_fm(:,:,:) = zero
+    
+  END SUBROUTINE forcing_zero
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: forcing_write
+!!
+!>\BRIEF        Appends data values to a netCDF file containing the forcing 
+!! variables of the general processes in stomate.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): netCDF file
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE forcing_write(forcing_id,ibeg,iend)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)      :: forcing_id  !! File identifer of forcing file, assigned when netcdf is created
+    INTEGER(i_std),INTENT(in)      :: ibeg, iend  !! First and last time step to be written
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                 :: iisf        !! Index of isf where isf is the number of time steps that can be 
+                                                  !! stored in memory 
+    INTEGER(i_std)                 :: iblocks     !! Index of block that is written
+    INTEGER(i_std)                 :: nblocks     !! Number of blocks that needs to be written
+    INTEGER(i_std)                 :: ier         !! Check errors in netcdf call
+    INTEGER(i_std),DIMENSION(0:2)  :: ifirst      !! First block in memory - changes with iblocks
+    INTEGER(i_std),DIMENSION(0:2)  :: ilast       !! Last block in memory - changes with iblocks
+    INTEGER(i_std),PARAMETER       :: ndm = 11    !! Maximum number of dimensions
+    INTEGER(i_std),DIMENSION(ndm)  :: start       !! First block to write
+    INTEGER(i_std)                 :: ndim        !! Dimensions of forcing to be added to the netCDF
+    INTEGER(i_std),DIMENSION(ndm)  :: count_force !! Number of elements in each dimension  
+    INTEGER(i_std)                 :: vid         !! Variable identifer of netCDF
+!_ ================================================================================================================================
+    
+  !! 1. Determine number of blocks of forcing variables that are stored in memory
+
+    nblocks = 0
+    ifirst(:) = 1
+    ilast(:) = 1
+    DO iisf = ibeg, iend
+       IF (     (nblocks /= 0) &
+            &      .AND.(isf(iisf) == isf(ilast(nblocks))+1)) THEN
+          ! Last block found
+          ilast(nblocks) = iisf
+       ELSE
+          ! First block found
+          nblocks = nblocks+1
+          IF (nblocks > 2)  STOP 'Problem in forcing_write'
+          ifirst(nblocks) = iisf
+          ilast(nblocks) = iisf
+       ENDIF
+    ENDDO
+
+  !! 2. Gather distributed variables (parallel computing)
+
+    CALL gather(clay_fm,clay_fm_g)
+    CALL gather(soil_ph_fm,soil_ph_fm_g)
+    CALL gather(bulk_dens_fm,bulk_dens_fm_g)
+    CALL gather(humrel_daily_fm,humrel_daily_fm_g)
+    CALL gather(litterhum_daily_fm,litterhum_daily_fm_g)
+    CALL gather(t2m_daily_fm,t2m_daily_fm_g)
+    CALL gather(t2m_min_daily_fm,t2m_min_daily_fm_g)
+    CALL gather(tsurf_daily_fm,tsurf_daily_fm_g)
+    CALL gather(tsoil_daily_fm,tsoil_daily_fm_g)
+    CALL gather(soilhum_daily_fm,soilhum_daily_fm_g)
+    CALL gather(precip_fm,precip_fm_g)
+    CALL gather(gpp_daily_fm,gpp_daily_fm_g)
+    CALL gather(veget_fm,veget_fm_g)
+    CALL gather(veget_max_fm,veget_max_fm_g)
+    CALL gather(lai_fm,lai_fm_g)
+ 
+ !! 3. Append data to netCDF file
+   
+    IF (is_root_prc) THEN
+       ! The netCDF file has been created earlier in this module, a file ID is available 
+       ! and variables and dimensions have already been defined
+       DO iblocks = 1, nblocks
+          IF (ifirst(iblocks) /= ilast(iblocks)) THEN
+             ndim = 2
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(clay_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'clay',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid, &
+                  &              clay_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(soil_ph_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'soil_ph',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid, &
+                  &              soil_ph_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(bulk_dens_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'bulk_dens',vid)
+             ier = NF90_PUT_VAR (forcing_id,vid, &
+                  &              bulk_dens_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(humrel_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'humrel',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            humrel_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(litterhum_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'litterhum',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            litterhum_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(t2m_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'t2m',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            t2m_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(t2m_min_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'t2m_min',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            t2m_min_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(tsurf_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'tsurf',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            tsurf_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(tsoil_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'tsoil',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            tsoil_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(soilhum_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'soilhum',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            soilhum_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(precip_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'precip',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            precip_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  & start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(gpp_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'gpp',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            gpp_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(veget_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'veget',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            veget_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(veget_max_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'veget_max',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            veget_max_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(lai_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'lai',vid)
+             ier = NF90_PUT_VAR (forcing_id, vid, &
+                  &            lai_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+          ENDIF
+       ENDDO
+    ENDIF
+    
+  !! 4. Adjust flag of forcing file
+    nf_written(isf(:)) = .TRUE.
+
+  END SUBROUTINE forcing_write
+
+  
+!! ================================================================================================================================
+!! SUBROUTINE 	: forcing_read
+!!
+!>\BRIEF        Read forcing file.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE forcing_read(forcing_id,nsfm)
+   
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)  :: forcing_id           !! File identifer of forcing file, assigned when netcdf is created
+    INTEGER(i_std),INTENT(in)  :: nsfm                 !! Number of time steps stored in memory        
+    
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                 :: iisf              !! Index of isf where isf is the number of time steps that can be stored in 
+                                                        !! memory 
+    INTEGER(i_std)                 :: iblocks           !! Index of block that is written
+    INTEGER(i_std)                 :: nblocks           !! Number of blocks that needs to be written
+    INTEGER(i_std)                 :: ier               !! Check error of netcdf call
+    INTEGER(i_std),DIMENSION(0:2)  :: ifirst            !! First block in memory - changes with iblocks
+    INTEGER(i_std),DIMENSION(0:2)  :: ilast             !! Last block in memory - changes with iblocks
+    INTEGER(i_std),PARAMETER       :: ndm = 11          !! Maximum number of dimensions
+    INTEGER(i_std),DIMENSION(ndm)  :: start             !! First block to write
+    INTEGER(i_std)                 :: ndim              !! Dimensions of forcing to be added to the netCDF
+    INTEGER(i_std),DIMENSION(ndm)  :: count_force       !! Number of elements in each dimension
+    INTEGER(i_std)                 :: vid               !! Variable identifer of netCDF
+    LOGICAL, PARAMETER             :: check=.FALSE.     !! Flag for debugging 
+    LOGICAL                        :: a_er=.FALSE.      !! Error catching from netcdf file
+!_ ================================================================================================================================
+
+    IF (check) WRITE(numout,*) "forcing_read "
+    
+  !! 1. Set to zero if the corresponding forcing state
+
+    ! has not yet been written into the file  
+    DO iisf = 1, nsfm
+       IF (.NOT.nf_written(isf(iisf))) THEN
+          clay_fm(:,iisf) = zero
+          soil_ph_fm(:,iisf) = zero
+          bulk_dens_fm(:,iisf) = zero
+          humrel_daily_fm(:,:,iisf) = zero
+          litterhum_daily_fm(:,iisf) = zero
+          t2m_daily_fm(:,iisf) = zero
+          t2m_min_daily_fm(:,iisf) = zero
+          tsurf_daily_fm(:,iisf) = zero
+          tsoil_daily_fm(:,:,iisf) = zero
+          soilhum_daily_fm(:,:,iisf) = zero
+          precip_fm(:,iisf) = zero
+          gpp_daily_fm(:,:,iisf) = zero
+          veget_fm(:,:,iisf) = zero
+          veget_max_fm(:,:,iisf) = zero
+          lai_fm(:,:,iisf) = zero
+       ENDIF
+    ENDDO
+    
+  !! 2. determine blocks of forcing states that are contiguous in memory
+
+    nblocks = 0
+    ifirst(:) = 1
+    ilast(:) = 1
+    
+    DO iisf = 1, nsfm
+       IF (nf_written(isf(iisf))) THEN
+          IF (     (nblocks /= 0) &
+               &        .AND.(isf(iisf) == isf(ilast(nblocks))+1)) THEN
+
+             ! element is contiguous with last element found
+             ilast(nblocks) = iisf
+          ELSE
+
+             ! found first element of new block
+             nblocks = nblocks+1
+             IF (nblocks > 2)  STOP 'Problem in forcing_read'
+             
+             ifirst(nblocks) = iisf
+             ilast(nblocks) = iisf
+          ENDIF
+       ENDIF
+    ENDDO
+    IF (check) WRITE(numout,*) "forcing_read nblocks, ifirst, ilast",nblocks, ifirst, ilast
+    
+  !! 3. Read variable values
+
+    IF (is_root_prc) THEN
+       DO iblocks = 1, nblocks
+          IF (check) WRITE(numout,*) "forcing_read iblocks, ifirst(iblocks), ilast(iblocks)",iblocks, &
+               ifirst(iblocks), ilast(iblocks)
+          IF (ifirst(iblocks) /= ilast(iblocks)) THEN
+             a_er=.FALSE.
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(clay_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'clay',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            clay_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(soil_ph_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'soil_ph',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            soil_ph_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(bulk_dens_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'bulk_dens',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            bulk_dens_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(humrel_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'humrel',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            humrel_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(litterhum_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'litterhum',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              litterhum_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(t2m_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'t2m',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              t2m_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(t2m_min_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'t2m_min',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              t2m_min_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(tsurf_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'tsurf',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              tsurf_daily_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(tsoil_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'tsoil',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              tsoil_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(soilhum_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'soilhum',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              soilhum_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 2;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(precip_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'precip',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &              precip_fm_g(:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(gpp_daily_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'gpp',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            gpp_daily_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(veget_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'veget',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            veget_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(veget_max_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'veget_max',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            veget_max_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+
+             ndim = 3;
+             start(1:ndim) = 1; start(ndim) = isf(ifirst(iblocks));
+             count_force(1:ndim) = SHAPE(lai_fm_g)
+             count_force(ndim) = isf(ilast(iblocks))-isf(ifirst(iblocks))+1
+             ier = NF90_INQ_VARID (forcing_id,'lai',vid)
+             a_er = a_er.OR.(ier /= 0)
+             ier = NF90_GET_VAR (forcing_id, vid, &
+                  &            lai_fm_g(:,:,ifirst(iblocks):ilast(iblocks)), &
+                  &            start=start(1:ndim), count=count_force(1:ndim))
+             a_er = a_er.OR.(ier /= 0)
+             IF (a_er) THEN
+                CALL ipslerr_p (3,'forcing_read', &
+                     &        'PROBLEM when read forcing file', &
+                     &        '','')
+             ENDIF
+
+          ENDIF ! (ifirst(iblocks) /= ilast(iblocks))
+       ENDDO ! iblocks
+    ENDIF ! is_root_prc
+
+  !! 4. Distribute the variable over several processors
+
+    CALL scatter(clay_fm_g,clay_fm)
+    CALL scatter(soil_ph_fm_g,soil_ph_fm)
+    CALL scatter(bulk_dens_fm_g,bulk_dens_fm)
+    CALL scatter(humrel_daily_fm_g,humrel_daily_fm)
+    CALL scatter(litterhum_daily_fm_g,litterhum_daily_fm)
+    CALL scatter(t2m_daily_fm_g,t2m_daily_fm)
+    CALL scatter(t2m_min_daily_fm_g,t2m_min_daily_fm)
+    CALL scatter(tsurf_daily_fm_g,tsurf_daily_fm)
+    CALL scatter(tsoil_daily_fm_g,tsoil_daily_fm)
+    CALL scatter(soilhum_daily_fm_g,soilhum_daily_fm)
+    CALL scatter(precip_fm_g,precip_fm)
+    CALL scatter(gpp_daily_fm_g,gpp_daily_fm)
+    CALL scatter(veget_fm_g,veget_fm)
+    CALL scatter(veget_max_fm_g,veget_max_fm)
+    CALL scatter(lai_fm_g,lai_fm)
+  
+  END SUBROUTINE forcing_read
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: setlai
+!!
+!>\BRIEF        Routine to force the lai in STOMATE. The code in this routine
+!! simply CALCULATES lai and is therefore not functional. The routine should be 
+!! rewritten if one wants to force lai.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lai
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE setlai(npts,lai)
+
+  !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+
+    INTEGER(i_std),INTENT(in)                    :: npts !! Domain size - number of pixels (unitless)
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out)  :: lai  !! PFT leaf area index @tex $(m^{2} m^{-2})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                               :: j    !! index (unitless)
+!_ ================================================================================================================================
+    
+    !! 1. Set lai for bare soil to zero
+
+    lai(:,ibare_sechiba) = zero
+
+    !! 2. Multiply foliage biomass by sla to calculate lai for all PFTs and pixels
+
+    DO j=2,nvm
+       lai(:,j) = biomass(:,j,ileaf,icarbon)*sla(j)
+    ENDDO
+    
+  END SUBROUTINE setlai
+
+END MODULE stomate
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_alloc.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_alloc.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_alloc.f90	(revision 5166)
@@ -0,0 +1,699 @@
+! =================================================================================================================================
+! MODULE       : stomate_alloc
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Allocate net primary production to: carbon reserves, aboveground sapwood,
+!! belowground sapwood, root, fruits and leaves.      
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_alloc
+
+  ! Modules used:
+
+  USE ioipsl_para
+  USE pft_parameters
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+
+  IMPLICIT NONE
+
+  ! Private & public routines
+
+  PRIVATE
+  PUBLIC alloc,alloc_clear
+
+ ! Variables shared by all subroutines in this module
+
+  LOGICAL, SAVE                                             :: firstcall = .TRUE.  !! Is this the first call? (true/false) 
+!$OMP THREADPRIVATE(firstcall)
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : alloc_clear
+!!
+!>\BRIEF          Set the flag ::firstcall to .TRUE. and as such activate section 
+!! 1.1 of the subroutine alloc (see below).\n
+!!
+!_ ================================================================================================================================
+
+  SUBROUTINE alloc_clear
+    firstcall = .TRUE.
+  END SUBROUTINE alloc_clear
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: alloc
+!!
+!>\BRIEF         Allocate net primary production (= photosynthesis
+!! minus autothrophic respiration) to: carbon reserves, aboveground sapwood,
+!! belowground sapwood, root, fruits and leaves following Friedlingstein et al. (1999).
+!!
+!! DESCRIPTION (definitions, functional, design, flags):\n
+!! The philosophy underlying the scheme is that allocation patterns result from
+!! evolved responses that adjust carbon investments to facilitate capture of most
+!! limiting resources i.e. light, water and mineral nitrogen. The implemented scheme 
+!! calculates the limitation of light, water and nitrogen. However, nitrogen is not a 
+!! prognostic variable of the model and therefore soil temperature and soil moisture 
+!! are used as a proxy for soil nitrogen availability.\n
+!! Sharpe & Rykiel (1991) proposed a generic relationship between the allocation of 
+!! carbon to a given plant compartment and the availability of a particular resource:\n
+!! \latexonly 
+!!   \input{alloc1.tex}
+!! \endlatexonly
+!! \n
+!! where A is the allocation of biomass production (NPP) to a given compartment (either 
+!! leaves, stem, or roots). Xi and Yj are resource availabilities (e.g. light, water, 
+!! nutrient). For a given plant compartment, a resource can be of type X or Y. An increase 
+!! in a X-type resource will increase the allocation to compartment A. An increase in a 
+!! Y-type resource will, however, lead to a decrease in carbon allocation to that compartment. 
+!! In other words, Y-type resources are those for which uptake increases with increased 
+!! investment in the compartment in question. X-type resources, as a consequence of 
+!! trade-offs, are the opposite. For example, water is a Y-type resource for root allocation. 
+!! Water-limited conditions should promote carbon allocation to roots, which enhance water 
+!! uptake and hence minimize plant water stress. Negative relationships between investment 
+!! and uptake arise when increased investment in one compartment leads, as required for 
+!! conservation of mass, to decreased investment in a component involved in uptake of 
+!! that resource.\n
+!!
+!! The implemented scheme allocates carbon to the following components:\n
+!! - Carbon reserves;\n
+!! - Aboveground sapwood;\n
+!! - Belowground sapwood;\n
+!! - Roots;\n
+!! - Fruits/seeds and\n
+!! - Leaves.
+!! \n
+!!
+!! The allocation to fruits and seeds is simply a 10% "tax" of the total biomass 
+!! production.\n
+!! Following carbohydrate use to support budburst and initial growth, the 
+!! carbohydrate reserve is refilled. The daily amount of carbon allocated to the 
+!! reserve pool is proportional to leaf+root allocation (::LtoLSR and ::RtoLSR).\n
+!! Sapwood and root allocation (respectively ::StoLSR and ::RtoLSR) are proportional 
+!! to the estimated light and soil (water and nitrogen) stress (::Limit_L and 
+!! ::Limit_NtoW). Further, Sapwood allocation is separated in belowground sapwood 
+!! and aboveground sapwood making use of the parameter (:: alloc_sap_above_tree
+!! or ::alloc_sap_above_grass). For trees partitioning between above and 
+!! belowground compartments is a function of PFT age.\n 
+!! Leaf allocation (::LtoLSR) is calculated as the residual of root and sapwood 
+!! allocation (LtoLSR(:) = 1. - RtoLSR(:) - StoLSR(:).\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): :: f_alloc; fraction of NPP that is allocated to the 
+!! six different biomass compartments (leaves, roots, above and belowground wood, 
+!! carbohydrate reserves and fruits). DIMENSION(npts,nvm,nparts).
+!!
+!! REFERENCE(S)	:
+!! - Friedlingstein, P., G. Joel, C.B. Field, and Y. Fung (1999), Towards an allocation
+!! scheme for global terrestrial carbon models, Global Change Biology, 5, 755-770.\n
+!! - Sharpe, P.J.H., and Rykiel, E.J. (1991), Modelling integrated response of plants 
+!! to multiple stresses. In: Response of Plants to Multiple Stresses (eds Mooney, H.A., 
+!! Winner, W.E., Pell, E.J.), pp. 205-224, Academic Press, San Diego, CA.\n
+!! - Krinner G, Viovy N, de Noblet-Ducoudr N, Ogee J, Polcher J, Friedlingstein P,
+!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
+!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
+!! doi: 10.1029/2003GB002199.\n
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!!   \includegraphics[scale=0.5]{allocflow.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE alloc (npts, dt, &
+       lai, veget_max, senescence, when_growthinit, &
+       moiavail_week, tsoil_month, soilhum_month, &
+       biomass, age, leaf_age, leaf_frac, rprof, f_alloc)
+
+ !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                 :: npts			!! Domain size - number of grid cells 
+                                                                                        !! (unitless)
+    REAL(r_std), INTENT(in)                                    :: dt			!! Time step of the simulations for stomate
+                                                                                        !! (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: lai			!! PFT leaf area index 
+                                                                                        !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_max		!! PFT "Maximal" coverage fraction of a PFT 
+                                                                                        !! (= ind*cn_ind) 
+                                                                                        !! @tex $(m^2 m^{-2})$ @endtex
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                   :: senescence		!! Is the PFT senescent?  - only for 
+                                                                                        !! deciduous trees (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: when_growthinit	!! Days since beginning of growing season 
+                                                                                        !! (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_week		!! PFT moisture availability - integrated
+                                                                                        !! over a week (0-1, unitless) 
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: tsoil_month		!! PFT soil temperature - integrated over 
+                                                                                        !! a month (K) 
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: soilhum_month		!! PFT soil humidity - integrated over a 
+                                                                                        !! month (0-1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: age			!! PFT age (days)
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass		!! PFT total biomass 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age		!! PFT age of different leaf classes 
+                                                                                        !! (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac		!! PFT fraction of leaves in leaf age class
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: rprof                 !! [DISPENSABLE] PFT rooting depth - not 
+                                                                                        !! calculated in the current version of 
+                                                                                        !! the model (m) 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out)       :: f_alloc		!! PFT fraction of NPP that is allocated to
+                                                                                        !! the different components (0-1, unitless)
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(nvm)                                :: lai_happy		!! Lai threshold below which carbohydrate 
+                                                                                        !! reserve may be used 
+                                                                                        !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                               :: limit_L		!! Lights stress (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_N		!! Total nitrogen stress (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_N_temp		!! Stress from soil temperature on nitrogen
+                                                                                        !! mineralisation (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_N_hum		!! Stress from soil humidity on nitrogen 
+                                                                                        !! mineralisation (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_W		!! Soil water stress (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit_WorN		!! Most limiting factor in the soil: 
+                                                                                        !! nitrogen or water (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: limit			!! Most limiting factor: amongst limit_N, 
+                                                                                        !! limit_W and limit_L (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: t_nitrogen		!! Preliminairy soil temperature stress 
+                                                                                        !! used as a proxy for nitrogen stress (K)
+    REAL(r_std), DIMENSION(npts)                               :: h_nitrogen		!! Preliminairy soil humidity stress used 
+                                                                                        !! as a proxy for nitrogen stress 
+                                                                                        !! (unitless)  
+    REAL(r_std), DIMENSION(npts)                               :: rpc			!! Scaling factor for integrating vertical
+                                                                                        !!  soil profiles (unitless) 	
+    REAL(r_std), DIMENSION(npts)                               :: LtoLSR		!! Ratio between leaf-allocation and 
+                                                                                        !! (leaf+sapwood+root)-allocation 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: StoLSR		!! Ratio between sapwood-allocation and 
+                                                                                        !! (leaf+sapwood+root)-allocation 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: RtoLSR		!! Ratio between root-allocation and 
+                                                                                        !! (leaf+sapwood+root)-allocation 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: carb_rescale		!! Rescaling factor for allocation factors
+                                                                                        !! if carbon is allocated to carbohydrate 
+                                                                                        !! reserve (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: use_reserve		!! Mass of carbohydrate reserve used to 
+                                                                                        !! support growth 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                               :: transloc_leaf		!! Fraction of carbohydrate reserve used 
+                                                                                        !! (::use_reserve) to support leaf growth 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                               :: leaf_mass_young	!! Leaf biomass in youngest leaf age class 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lm_old		!! Variable to store leaf biomass from 
+                                                                                        !! previous time step 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std)                                                :: reserve_time		!! Maximum number of days during which 
+                                                                                        !! carbohydrate reserve may be used (days)
+    REAL(r_std), DIMENSION(npts,nvm)                           :: lai_around		!! lai on natural part of the grid cell, or
+                                                                                        !! of agricultural PFTs 
+                                                                                        !! @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                           :: veget_max_nat 	!! Vegetation cover of natural PFTs on the 
+                                                                                        !! grid cell (agriculture masked) 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: natveg_tot		!! Total natural vegetation cover on 
+                                                                                        !! natural part of the grid cell 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: lai_nat		!! Average LAI on natural part of the grid
+                                                                                        !! cell @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                               :: zdiff_min		!! [DISPENSABLE] intermediate array for 
+                                                                                        !! looking for minimum
+    REAL(r_std), DIMENSION(npts)                               :: alloc_sap_above	!! Prescribed fraction of sapwood 
+                                                                                        !! allocation to above ground sapwood 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), SAVE, DIMENSION(0:nbdl)                       :: z_soil		!! Variable to store depth of the different
+                                                                                        !! soil layers (m)
+!OMP THREADPRIVATE(z_soil)
+    INTEGER(i_std)                                             :: i,j,l,m		!! Indices (unitless)
+
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering alloc'
+
+!! 1. Initialize
+
+    !! 1.1 First call only
+    IF ( firstcall ) THEN
+
+       !
+       ! 1.1.0 Initialization
+       !
+       L0 = un - R0 - S0  
+       IF ((L0 .LT. zero) .OR. (S0 .EQ. un)) THEN
+          CALL ipslerr_p (3,'in module stomate_alloc', &
+               &           'Something wrong happened', &
+               &           'L0 negative or division by zero if S0 = 1', &
+               &           '(Check your parameters.)')
+       ENDIF
+
+       
+       !! 1.1.1 Copy the depth of the different soil layers (number of layers=nbdl) 
+       !        previously calculated as variable diaglev in routines sechiba.f90 and slowproc.f90  
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+       !! 1.1.2 Print flags and parameter settings
+       WRITE(numout,*) 'alloc:'
+       WRITE(numout,'(a,$)') '    > We'
+       IF ( .NOT. ok_minres ) WRITE(numout,'(a,$)') ' do NOT'
+       WRITE(numout,*) 'try to reach a minumum reservoir when severely stressed.'
+       WRITE(numout,*) '   > Time delay (days) to build leaf mass (::tau_leafinit): ', &
+            tau_leafinit
+       WRITE(numout,*) '   > Curvature of root mass with increasing soil depth (::z_nitrogen): ', &
+            z_nitrogen
+       WRITE(numout,*) '   > Sap allocation above the ground / total sap allocation (0-1, unitless): '
+       WRITE(numout,*) '       grasses (::alloc_sap_above_grass) :', alloc_sap_above_grass
+       WRITE(numout,*) '   > Default root alloc fraction (1; ::R0): ', R0
+       WRITE(numout,*) '   > Default sapwood alloc fraction (1; ::S0): ', S0
+       WRITE(numout,*) '   > Default fruit allocation (1, ::f_fruit): ', f_fruit
+       WRITE(numout,*) '   > Minimum (min_LtoLSR)/maximum (::max_LtoLSR)leaf alloc fraction (0-1, unitless): ',&
+            min_LtoLSR,max_LtoLSR
+       WRITE(numout,*) '   > Maximum time (days) the carbon reserve can be used:'
+       WRITE(numout,*) '       trees (reserve_time_tree):',reserve_time_tree
+       WRITE(numout,*) '       grasses (reserve_time_grass):',reserve_time_grass
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+
+    !! 1.2 Every call
+    !! 1.2.1 Reset output variable (::f_alloc)
+    f_alloc(:,:,:) = zero
+    f_alloc(:,:,icarbres) = un
+
+ 
+    !! 1.2.2 Proxy for soil nitrogen stress
+    !        Nitrogen availability and thus N-stress can not be calculated by the model. Water and
+    !        temperature stress are used as proxy under the assumption that microbial activity is 
+    !        determined by soil temperature and water availability. In turn, microbial activity is 
+    !         assumed to be an indicator for nitrogen mineralisation and thus its availability. 
+
+    !! 1.2.2.1 Convolution of nitrogen stress with root profile 
+    !          Here we calculate preliminary soil temperature and soil humidity stresses that will be used 
+    !          as proxies for nitrogen stress. Their calculation follows the nitrogen-uptake capacity of roots.
+    !          The capacity of roots to take up nitrogen is assumed to decrease exponentially with 
+    !          increasing soil depth. The curvature of the exponential function describing the 
+    !          nitrogen-uptake capacity of roots (= root mass * uptake capacity) is given by 
+    !          ::z_nitrogen. Strictly speaking its unit is meters (m). Despite its units this parameter 
+    !          has no physical meaning.
+    !          Because the roots are described by an exponential function but the soil depth is limited to
+    !          ::z_soil(nbdl), the root profile is truncated at ::z_soil(nbdl). For numerical reasons, 
+    !          the total capacity of the soil profile for nitrogen uptake should be 1. To this aim a scaling
+    !          factor (::rpc) is calculated as follows:\n
+    !          \latexonly
+    !            \input{alloc2.tex} 
+    !          \endlatexonly
+    !          Then temperature (::t_nitrogen) and humidity (::h_nitrogen) proxies for nitrogen stress are 
+    !          calculated using mean weighted (weighted by nitrogen uptake capacity) soil temperature (::tsoil_month)
+    !          or soil moisture (::soil_hum_month) (calculated in stomate_season.f90). 
+    !          \latexonly
+    !            \input{alloc3.tex} 
+    !          \endlatexonly
+    !          \latexonly
+    !            \input{alloc4.tex} 
+    !          \endlatexonly	
+    !          \n 
+		  
+    ! Scaling factor for integration
+    rpc(:) = un / ( un - EXP( -z_soil(nbdl) / z_nitrogen ) )
+
+    ! Integrate over # soil layers
+    t_nitrogen(:) = zero
+
+    DO l = 1, nbdl ! Loop over # soil layers
+
+       t_nitrogen(:) = &
+            t_nitrogen(:) + tsoil_month(:,l) * rpc(:) * &
+            ( EXP( -z_soil(l-1)/z_nitrogen ) - EXP( -z_soil(l)/z_nitrogen ) )
+
+    ENDDO ! Loop over # soil layers
+
+ 
+!!$    !! 1.2.2.2 Convolution for soil moisture
+!!$    !          Scaling factor for integration
+!!$    rpc(:) = 1. / ( 1. - EXP( -z_soil(nbdl) / z_nitrogen ) )
+
+    ! Integrate over # soil layers
+    h_nitrogen(:) = zero
+
+    DO l = 1, nbdl ! Loop over # soil layers
+
+       h_nitrogen(:) = &
+            h_nitrogen(:) + soilhum_month(:,l) * rpc(:) * &
+            ( EXP( -z_soil(l-1)/z_nitrogen ) - EXP( -z_soil(l)/z_nitrogen ) )
+
+    ENDDO ! Loop over # soil layers
+
+
+    !! 1.2.3 Separate between natural and agrigultural LAI
+    !        The model distinguishes different natural PFTs but does not contain information
+    !        on whether these PFTs are spatially separated or mixed. In line with the DGVM the 
+    !        models treats the natural PFT's as mixed. Therefore, the average LAI over the
+    !        natural PFTs is calculated to estimate light stress. Agricultural PFTs are spatially
+    !        separated. 
+    natveg_tot(:) = zero
+    lai_nat(:) = zero
+
+    DO j = 2, nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN
+          ! Mask agricultural vegetation
+          veget_max_nat(:,j) = veget_max(:,j)
+       ELSE
+          ! Mask natural vegetation
+          veget_max_nat(:,j) = zero
+       ENDIF
+
+       ! Sum up fraction of natural space covered by vegetation
+       natveg_tot(:) = natveg_tot(:) + veget_max_nat(:,j)
+
+       ! Sum up lai
+       lai_nat(:) = lai_nat(:) + veget_max_nat(:,j) * lai(:,j)
+
+    ENDDO ! Loop over # PFTs
+
+    DO j = 2, nvm ! Loop over # PFTs
+
+       IF ( natural(j) ) THEN
+
+          ! Use the mean LAI over all natural PFTs when estimating light stress 
+          ! on a specific natural PFT
+          lai_around(:,j) = lai_nat(:)
+       ELSE
+
+          ! Use the actual LAI (specific for that PFT) when estimating light
+          ! stress on a specific agricultural PFT
+          lai_around(:,j) = lai(:,j)
+       ENDIF
+
+    ENDDO ! Loop over # PFTs
+
+
+    !! 1.2.4 Calculate LAI threshold below which carbohydrate reserve is used.
+    !        Lai_max is a PFT-dependent parameter specified in stomate_constants.f90
+    lai_happy(:) = lai_max(:) * lai_max_to_happy
+
+ !! 2. Use carbohydrate reserve to support growth and update leaf age
+
+    ! Save old leaf mass, biomass got last updated in stomate_phenology.f90
+    lm_old(:,:) = biomass(:,:,ileaf,icarbon)
+
+    DO j = 2, nvm ! Loop over # PFTs 
+
+       !! 2.1 Calculate demand for carbohydrate reserve to support leaf and root growth.
+       !      Maximum time (days) since start of the growing season during which carbohydrate 
+       !      may be used
+       IF ( is_tree(j) ) THEN
+          reserve_time = reserve_time_tree
+       ELSE
+          reserve_time = reserve_time_grass
+       ENDIF
+
+       ! Growth is only supported by the use of carbohydrate reserves if the following 
+       ! conditions are  statisfied:\n
+       ! - PFT is not senescent;\n
+       ! - LAI must be low (i.e. below ::lai_happy) and\n
+       ! - Day of year of the simulation is in the beginning of the growing season.
+       WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. & 
+            ( .NOT. senescence(:,j) ) .AND. &
+            ( lai(:,j) .LT. lai_happy(j) ) .AND. &
+            ( when_growthinit(:,j) .LT. reserve_time ) ) 
+
+          ! Determine the mass from the carbohydrate reserve that can be used @tex $(gC m^{-2})$ @endtex. 
+          ! Satisfy the demand or use everything that is available 
+          ! (i.e. ::biomass(:,j,icarbres)). Distribute the demand evenly over the time 
+          ! required (::tau_leafinit) to develop a minimal canopy from reserves (::lai_happy). 
+          use_reserve(:) = &
+               MIN( biomass(:,j,icarbres,icarbon), &
+               deux * dt/tau_leafinit * lai_happy(j)/ sla(j) )
+
+          ! Distribute the reserve over leaves and fine roots.
+	  ! The part of the reserve going to the leaves is the ratio of default leaf allocation to default root and leaf allocation.
+	  ! The remaining of the reserve is alocated to the roots.
+          transloc_leaf(:) = L0/(L0+R0) * use_reserve(:)
+          biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) + transloc_leaf(:)
+          biomass(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) + ( use_reserve(:) - transloc_leaf(:) )
+
+          ! Adjust the carbohydrate reserve mass by accounting for the reserves allocated to leaves and roots during
+          ! this time step
+          biomass(:,j,icarbres,icarbon) = biomass(:,j,icarbres,icarbon) - use_reserve(:)
+
+       ELSEWHERE
+
+          transloc_leaf(:) = zero
+
+       ENDWHERE
+    
+       !! 2.2 Update leaf age
+       !! 2.2.1 Decrease leaf age in youngest class
+       !        Adjust the mass of the youngest leaves by the newly grown leaves
+       leaf_mass_young(:) = leaf_frac(:,j,1) * lm_old(:,j) + transloc_leaf(:)
+
+       WHERE ( ( transloc_leaf(:) .GT. min_stomate ) .AND. ( leaf_mass_young(:) .GT. min_stomate ) )
+          
+          ! Adjust leaf age by the ratio of leaf_mass_young (t-1)/leaf_mass_young (t) 
+          leaf_age(:,j,1) = MAX( zero, leaf_age(:,j,1) * ( leaf_mass_young(:) - transloc_leaf(:) ) / &
+               leaf_mass_young(:) )
+
+       ENDWHERE
+
+       !! 2.2.2 Update leaf mass fraction for the different age classes
+       !        Mass fraction in the youngest age class is calculated as the ratio between
+       !        the new mass in the youngest class and the total leaf biomass 
+       !        (inc. the new leaves)
+       WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+          
+          leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf,icarbon)
+
+       ENDWHERE
+
+
+       ! Mass fraction in the other classes is calculated as the ratio bewteen
+       ! the current mass in that age and the total leaf biomass 
+       ! (inc. the new leaves)\n
+       DO m = 2, nleafages ! Loop over # leaf age classes
+
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+             leaf_frac(:,j,m) = leaf_frac(:,j,m) * lm_old(:,j) / biomass(:,j,ileaf,icarbon)
+
+          ENDWHERE
+
+       ENDDO ! Loop over # leaf age classes
+
+    ENDDO ! loop over # PFTs
+
+ !! 3. Calculate allocatable fractions of biomass production (NPP) 
+     
+    ! Calculate fractions of biomass production (NPP) to be allocated to the different 
+    ! biomass components.\n
+    ! The fractions of NPP allocated (0-1, unitless) to the different compartments depend on the
+    ! availability of light, water, and nitrogen.
+    DO j = 2, nvm ! Loop over # PFTs
+
+       ! Reset values
+       RtoLSR(:) = zero
+       LtoLSR(:) = zero
+       StoLSR(:) = zero
+
+       ! For trees, partitioning between above and belowground sapwood biomass is a function 
+       ! of age. An older tree gets more allocation to the aboveground sapwoood than a younger tree.
+       ! For the other PFTs it is prescribed. 
+       ! ::alloc_min, ::alloc_max and ::demi_alloc are specified in stomate_constants.f90
+       IF ( is_tree(j) ) THEN
+
+          alloc_sap_above(:) = alloc_min(j)+(alloc_max(j)-alloc_min(j))*(un-EXP(-age(:,j)/demi_alloc(j)))
+       
+       ELSE
+          
+          alloc_sap_above(:) = alloc_sap_above_grass
+       
+       ENDIF
+
+
+       !! 3.1 Calculate light stress, water stress and proxy for nitrogen stress.\n
+       !      For the limiting factors a low value indicates a strong limitation
+       WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+          !! 3.1.1 Light stress
+          !        Light stress is a function of the mean lai on the natural part of the grid box 
+          !        and of the PFT-specific LAI for agricultural crops. In line with the DGVM, natural
+          !        PFTs in the same gridbox are treated as if they were spatially mixed whereas 
+          !        agricultural PFTs are considered to be spatially separated.
+          !        The calculation of the lights stress depends on the extinction coefficient (set to 0.5)
+          !        and of a mean LAI.
+          WHERE( lai_around(:,j) < max_possible_lai )
+
+             limit_L(:) = MAX( 0.1_r_std, EXP( -ext_coeff(j) * lai_around(:,j) ) )
+          
+          ELSEWHERE
+             
+             limit_L(:) = 0.1_r_std
+          
+          ENDWHERE
+
+          !! 3.1.2 Water stress
+          !        Water stress is calculated as the weekly moisture availability.
+          !        Weekly moisture availability is calculated in stomate_season.f90.
+          limit_W(:) = MAX( 0.1_r_std, MIN( un, moiavail_week(:,j) ) )
+
+
+          !! 3.1.3 Proxy for nitrogen stress
+          !         The proxy for nitrogen stress depends on monthly soil water availability
+          !         (::soilhum_month) and monthly soil temperature (::tsoil_month). See section
+          !         1.2.2 for details on how ::t_nitrogen and ::h_nitrogen were calculated.\n
+          !         Currently nitrogen-stress is calculated for both natural and agricultural PFTs.
+          !         Due to intense fertilization of agricultural PFTs this is a strong 
+          !         assumption for several agricultural regions in the world (US, Europe, India, ...)
+          !         Water stress on nitrogen mineralisation 
+          limit_N_hum(:) = MAX( undemi, MIN( un, h_nitrogen(:) ) )
+
+	  ! Temperature stress on nitrogen mineralisation using a Q10 decomposition model
+          ! where Q10 was set to 2
+          limit_N_temp(:) = 2.**((t_nitrogen(:) - ZeroCelsius - Nlim_tref )/Nlim_Q10)
+          limit_N_temp(:) = MAX( 0.1_r_std, MIN( un, limit_N_temp(:) ) )
+
+          ! Combine water and temperature factors to get total nitrogen stress
+          limit_N(:) = MAX( 0.1_r_std, MIN( un, limit_N_hum(:) * limit_N_temp(:) ) )
+
+          ! Take the most limiting factor among soil water and nitrogen 
+          limit_WorN(:) = MIN( limit_W(:), limit_N(:) )
+
+          ! Take the most limiting factor among aboveground (i.e. light) and belowground 
+          ! (i.e. water & nitrogen) limitations
+          limit(:) = MIN( limit_WorN(:), limit_L(:) )
+
+          !! 3.2 Calculate ratio between allocation to leaves, sapwood and roots
+          !      Partitioning between belowground and aboveground biomass components is assumed 
+          !      to be proportional to the ratio of belowground and aboveground stresses.\n
+          !      \latexonly 
+          !        \input{alloc1.tex} 
+          !      \endlatexonly
+          !      Root allocation is the default root allocation corrected by a normalized ratio of aboveground stress to total stress.
+	  !      The minimum root allocation is 0.15.
+          RtoLSR(:) = &
+               MAX( .15_r_std, &
+               R0 * trois * limit_L(:) / ( limit_L(:) + deux * limit_WorN(:) ) )
+
+          ! Sapwood allocation is the default sapwood allocation corrected by a normalized ratio of belowground stress to total stress.
+          StoLSR(:) = S0 * 3. * limit_WorN(:) / ( 2._r_std * limit_L(:) + limit_WorN(:) )
+
+          ! Leaf allocation is calculated as the remaining allocation fraction
+	  ! The range of variation of leaf allocation is constrained by ::min_LtoLSR and ::max_LtoLSR. 
+          LtoLSR(:) = un - RtoLSR(:) - StoLSR(:)
+          LtoLSR(:) = MAX( min_LtoLSR, MIN( max_LtoLSR, LtoLSR(:) ) )
+
+          ! Roots allocation is recalculated as the residual carbon after leaf allocation has been calculated. 
+          RtoLSR(:) = un - LtoLSR(:) - StoLSR(:)
+
+       ENDWHERE
+	   
+       ! Check whether allocation needs to be adjusted. If LAI exceeds maximum LAI 
+       ! (::lai_max), no addition carbon should be allocated to leaf biomass. Allocation is 
+       ! then partioned between root and sapwood biomass.
+       WHERE ( (biomass(:,j,ileaf,icarbon) .GT. min_stomate) .AND. (lai(:,j) .GT. lai_max(j)) )
+
+          StoLSR(:) = StoLSR(:) + LtoLSR(:)
+          LtoLSR(:) = zero
+
+       ENDWHERE
+
+       !! 3.3 Calculate the allocation fractions.
+       !      The allocation fractions (::f_alloc) are an output variable (0-1, unitless). f_alloc
+       !      has three dimensions (npts,nvm,nparts). Where ::npts is the number of grid cells, ::nvm is the 
+       !      number of PFTs and ::nparts the number of biomass components. Currently six biomass compartments
+       !      are distinguished: (1) Carbon reserves, (2) Aboveground sapwood, (3) Belowground 
+       !      sapwood, (4) Roots, (5) fruits/seeds and (6) Leaves.@tex $(gC m^{-2})$ @endtex \n
+       DO i = 1, npts ! Loop over grid cells 
+
+          IF ( biomass(i,j,ileaf,icarbon) .GT. min_stomate ) THEN
+      
+             IF ( senescence(i,j) ) THEN
+                
+                !! 3.3.1 Allocate all C to carbohydrate reserve
+                !        If the PFT is senescent allocate all C to carbohydrate reserve, 
+                !        then the allocation fraction to reserves is 1. 
+                f_alloc(i,j,icarbres) = un
+
+             ELSE
+
+                !! 3.3.2 Allocation during the growing season  
+                f_alloc(i,j,ifruit) = f_fruit
+
+
+                ! Allocation to the carbohydrate reserve is proportional to leaf and root 
+                ! allocation. If carbon is allocated to the carbohydrate reserve, rescaling 
+                ! of allocation factors is required to ensure carbon mass preservation.\n
+                ! Carbon is allocated to the carbohydrate reserve when the pool size of the 
+                ! reserve is less than the carbon needed to grow a canopy twice the size of 
+                ! the maximum LAI (::lai_max). Twice the size was used as a threshold because
+                ! the reserves needs to be sufficiently to grow a canopy and roots. In case 
+                ! the carbohydrate pool is full, there is no need to rescale the other
+                ! allocation factors.
+	        ! If there is no rescaling of the allocation factors (carbres=1, no carbon put
+		! to reserve), then fraction remaining after fruit allocation (1-fruit_alloc) 
+		! is distributed between leaf, root and sap (sap carbon also distributed between   
+		! sap_above and sap_below with factor alloc_sap_above).
+		! If carbon is allocated to the carbohydrate reserve, all these factors are 
+		! rescaled through carb_rescale, and an allocation fraction for carbohydrate pool 
+		! appears. carb_rescale depends on the parameter (::ecureuil). 
+                ! (::ecureuil) is the fraction of primary leaf and root allocation put into 
+                ! reserve, it is specified in stomate_constants.f90 and is either 0 or 1.
+                IF ( ( biomass(i,j,icarbres,icarbon)*sla(j) ) .LT. 2*lai_max(j) ) THEN
+                   carb_rescale(i) = un / ( un + ecureuil(j) * ( LtoLSR(i) + RtoLSR(i) ) )
+                ELSE
+                   carb_rescale(i) = un
+                ENDIF
+
+                f_alloc(i,j,ileaf) = LtoLSR(i) * ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,isapabove) = StoLSR(i) * alloc_sap_above(i) * &
+                     ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,isapbelow) = StoLSR(i) * ( un - alloc_sap_above(i) ) * &
+                     ( un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,iroot) = RtoLSR(i) * (un - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,icarbres) = ( un - carb_rescale(i) ) * ( un - f_alloc(i,j,ifruit) )
+
+             ENDIF  ! Is senescent?
+
+          ENDIF  ! There are leaves
+
+       ENDDO  ! Loop over # pixels - domain size
+
+    ENDDO  ! loop over # PFTs
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Leaving alloc'
+
+  END SUBROUTINE alloc
+
+END MODULE stomate_alloc
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_assimtemp.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_assimtemp.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_assimtemp.f90	(revision 5166)
@@ -0,0 +1,143 @@
+! =================================================================================================================================
+! MODULE 	: stomate_assimtemp
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        Calculate the photosynthesis temperatures.
+!!	
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN		:
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ =================================================================================================================================
+
+MODULE stomate_assimtemp
+
+  ! modules used:
+
+  USE pft_parameters
+  USE constantes 
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC assim_temp
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: assim_temp
+!!
+!>\BRIEF        This subroutine calculates the minimal, maximal and optimal 
+!! temperatures for photosynthesis. 
+!!
+!! \n DESCRIPTION (definitions, functional, design, flags): The temperatures are 
+!! calculated as second order polynomials of the long term reference temperature tlong_ref. 
+!!
+!! A climatological annual temperature is given as an input file of ORCHIDEE, at a 1.125Â°(lon)x1.121Â°(lat) spatial resolution. 
+!! This temperature was derived from a IIASA database (Leemans and Cramer, 1991).
+!! This initial climatological annual temperature is first interpolated at the spatial grid of the
+!! meteorological forcing fields in stomate_io.f90::get_reftemp (\f$tlong\_ref\f$).
+!! This long term reference temperature is then updated along the ORCHIDEE run at each stomate time step in stomate_season.f90.
+!! 
+!! The polynomial coefficients depend on the PFT and their values are defined in 
+!! stomate_constants.f90. Coefficients for degrees 1 and 2 of the polynomials are 
+!! zero, meaning the temperatures are just predefined constants (Wullschleger, 1993), except for C3
+!! grasses, which has been designed specifically for ORCHIDEE (no reference publication other than Krinner et al. (2005)).
+!!
+!! This routine is called once at the beginning by stomate_var_init and then at each stomate time step by stomateLpj.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): minimal (t_photo_min), maximal (t_photo_max) and 
+!! optimal temperatures (t_photo_opt) for photosynthesis
+!!
+!! REFERENCE(S)	: 
+!! - Krinner, G., Viovy, N., Noblet-Ducoudre, N. de, Ogee, J., Polcher, J., 
+!! Friedlingstein, P., Sitch, S., and Prentice, I. C (2005). A dynamic global 
+!! vegetation model for studies of the coupled atmosphere-biosphere system. 
+!! Global Biogeochem. Cycles, 19, GB1015
+!! - Leemans, R. and Cramer,W. (1991). The IIASA Database for Mean Monthly Values
+!! of Temperature, Precipitation, and Cloudiness on a Global Terrestrial Grid.
+!! Research Report, INTERNATIONAL INSTITUTE FOR APPLIED SYSTEMS ANALYSIS Laxenburg, Austria.
+!! International Standard Book Number 3-7045-0113-1. 
+!! - Wullschleger, S.D. (1993). Biochemical limitations to carbon assimilation in C\f$_3\f$ plants: 
+!! a retrospective analysis of the A/C\f$_i\f$ curves from 109 species. Journal of Experimental Botany, 44 (262), 907-920
+!!
+!! FLOWCHART    : None
+!!
+!! REVISION(S)	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE assim_temp (npts, tlong_ref, t2m_month, t_photo_min, t_photo_opt, t_photo_max)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                                  :: npts        !! Domain size    
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: tlong_ref   !! "long term" 2 meter reference temperatures (K)    
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: t2m_month   !! "monthly" 2-meter temperatures (K)
+
+    !
+    !! 0.2 Output variables 
+    !
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)               :: t_photo_min !! Minimum temperature for photosynthesis (K)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)               :: t_photo_opt !! Optimum temperature for photosynthesis (K)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)               :: t_photo_max !! Maximum temperature for photosynthesis (K)
+
+    !
+    !! 0.3 Modified variables
+    !
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std), DIMENSION(npts)                                :: tl          !! "Long term" 2 meter reference temperatures 
+                                                                               !! (degree C)    
+    INTEGER(i_std)                                              :: j           !! Index (unitless)
+
+!_ ================================================================================================================================
+
+    tl(:) = tlong_ref(:) - ZeroCelsius
+
+    DO j = 2,nvm	! Loop over # PFTs 
+
+       !
+       !! 1. Normal case
+       !
+
+       t_photo_min(:,j) = tphoto_min_c(j) + tphoto_min_b(j)*tl(:) + tphoto_min_a(j)*tl(:)*tl(:) + ZeroCelsius
+       t_photo_opt(:,j) = tphoto_opt_c(j) + tphoto_opt_b(j)*tl(:) + tphoto_opt_a(j)*tl(:)*tl(:) + ZeroCelsius
+       t_photo_max(:,j) = tphoto_max_c(j) + tphoto_max_b(j)*tl(:) + tphoto_max_a(j)*tl(:)*tl(:) + ZeroCelsius
+
+       !
+       !! 2. If the monthly temperature is too low, we set tmax < tmin.
+       !!    Therefore, photosynthesis will not be possible (we need tmin < t < tmax).
+       !     t2m_month is calculated at every stomate time step using a linear relaxation method, in stomate_season.f90 
+       !     (see section [27] in Krinner et al. (2005)).
+       !
+
+!! min_stomate is a constant defined in stomate_constants.f90 (= 1.E-8_r_std).
+       WHERE ( t2m_month(:) .LT. t_photo_min(:,j) )
+          t_photo_max(:,j) = t_photo_min(:,j) - min_stomate
+       ENDWHERE
+
+    ENDDO	! Loop over # PFTs
+
+  END SUBROUTINE assim_temp
+
+END MODULE stomate_assimtemp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_data.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_data.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_data.f90	(revision 5166)
@@ -0,0 +1,706 @@
+! =================================================================================================================================
+! MODULE 	: stomate_data
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         "stomate_data" module defines the values about the PFT parameters. It will print
+!! the values of the parameters for STOMATE in the standard outputs. 
+!!
+!!\n DESCRIPTION: None 
+!!
+!! RECENT CHANGE(S): Sonke Zaehle: Reich et al, 1992 find no statistically significant differences 
+!!                  between broadleaved and coniferous forests, specifically, the assumption that grasses grow 
+!!                  needles is not justified. Replacing the function with the one based on Reich et al. 1997. 
+!!                  Given that sla=100cm2/gDW at 9 months, sla is:
+!!                  sla=exp(5.615-0.46*ln(leaflon in months))
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_data
+
+  ! modules used:
+
+  USE constantes
+  USE pft_parameters
+  USE defprec
+  
+
+  IMPLICIT NONE
+
+  INTEGER(i_std),SAVE :: bavard=1                 !! Level of online diagnostics in STOMATE (0-4, unitless)
+!$OMP THREADPRIVATE(bavard)
+
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: hori_index     !! Move to Horizontal indices
+!$OMP THREADPRIVATE(hori_index)
+
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horipft_index  !! Horizontal + PFT indices
+!$OMP THREADPRIVATE(horipft_index)
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horisoillayer_index  !! Horizontal + soil layers indices
+!$OMP THREADPRIVATE(horisoillayer_index)
+
+  ! Land cover change
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip10_index   !! Horizontal + P10 indices
+!$OMP THREADPRIVATE(horip10_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip100_index  !! Horizontal + P100 indice
+!$OMP THREADPRIVATE(horip100_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip11_index   !! Horizontal + P11 indices
+!$OMP THREADPRIVATE(horip11_index)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip101_index  !! Horizontal + P101 indices
+!$OMP THREADPRIVATE(horip101_index)
+
+  INTEGER(i_std),SAVE :: itime                 !! time step
+!$OMP THREADPRIVATE(itime)
+  INTEGER(i_std),SAVE :: hist_id_stomate       !! STOMATE history file ID
+!$OMP THREADPRIVATE(hist_id_stomate)
+  INTEGER(i_std),SAVE :: hist_id_stomate_IPCC  !! STOMATE history file ID for IPCC output
+!$OMP THREADPRIVATE(hist_id_stomate_IPCC)
+  INTEGER(i_std),SAVE :: rest_id_stomate       !! STOMATE restart file ID
+!$OMP THREADPRIVATE(rest_id_stomate)
+
+  REAL(r_std),PARAMETER :: adapted_crit = 1. - ( 1. / euler ) !! critical value for being adapted (1-1/e) (unitless)
+  REAL(r_std),PARAMETER :: regenerate_crit = 1. / euler       !! critical value for being regenerative (1/e) (unitless)
+
+
+  ! private & public routines
+
+  PUBLIC data
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: data
+!!
+!>\BRIEF         This routine defines the values of the PFT parameters. It will print the values of the parameters for STOMATE
+!!               in the standard outputs of ORCHIDEE. 
+!!
+!! DESCRIPTION : This routine defines PFT parameters. It initializes the pheno_crit structure by tabulated parameters.\n
+!!               Some initializations are done for parameters. The SLA is calculated according *to* Reich et al (1992).\n
+!!               Another formulation by Reich et al(1997) could be used for the computation of the SLA.
+!!               The geographical coordinates might be used for defining some additional parameters
+!!               (e.g. frequency of anthropogenic fires, irrigation of agricultural surfaces, etc.). \n
+!!               For the moment, this possibility is not used. \n
+!!               The specifc leaf area (SLA) is calculated according Reich et al, 1992 by :
+!!               \latexonly
+!!               \input{stomate_data_SLA.tex}
+!!               \endlatexonly
+!!               The sapling (young) biomass for trees and for each compartment of biomass is calculated by :
+!!               \latexonly
+!!               \input{stomate_data_sapl_tree.tex}
+!!               \endlatexonly
+!!               The sapling biomass for grasses and for each compartment of biomass is calculated by :
+!!               \latexonly
+!!               \input{stomate_data_sapl_grass.tex}
+!!               \endlatexonly
+!!               The critical stem diameter is given by the following formula :
+!!               \latexonly
+!!               \input{stomate_data_stem_diameter.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): Sonke Zaehle: Reich et al, 1992 find no statistically significant differences 
+!!                  between broadleaved and coniferous forests, specifically, the assumption that grasses grow 
+!!                  needles is not justified. Replacing the function with the one based on Reich et al. 1997. 
+!!                  Given that sla=100cm2/gDW at 9 months, sla is:
+!!                  sla=exp(5.615-0.46*ln(leaflon in months)) 
+!!                   \latexonly
+!!                   \input{stomate_data_SLA_Reich_97.tex}
+!!                   \endlatexonly
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!! - Reich PB, Walters MB, Ellsworth DS, (1992), Leaf life-span in relation to leaf, plant and 
+!! stand characteristics among diverse ecosystems. Ecological Monographs, Vol 62, pp 365-392.
+!! - Reich PB, Walters MB, Ellsworth DS (1997) From tropics to tundra: global convergence in plant 
+!!  functioning. Proc Natl Acad Sci USA, 94:13730 13734
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE data (npts, lalo)
+
+
+    !! 0. Variables and parameter declaration
+
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                   :: npts    !! [DISPENSABLE] Domain size (unitless)
+    REAL(r_std),DIMENSION (npts,2), INTENT (in)  :: lalo    !! [DISPENSABLE] Geographical coordinates (latitude,longitude)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                               :: j       !! Index (unitless)
+    REAL(r_std)                                  :: alpha   !! alpha's : (unitless)
+    REAL(r_std)                                  :: dia     !! stem diameter (m)
+    REAL(r_std)                                  :: csa_sap !! Crown specific area sapling @tex $(m^2.ind^{-1})$ @endtex
+
+!_ ================================================================================================================================
+
+    IF ( bavard .GE. 1 ) WRITE(numout,*) 'data: PFT characteristics'
+
+    !- pheno_gdd_crit
+    pheno_gdd_crit(:,1) = pheno_gdd_crit_c(:)
+    pheno_gdd_crit(:,2) = pheno_gdd_crit_b(:)         
+    pheno_gdd_crit(:,3) = pheno_gdd_crit_a(:) 
+    !
+    !- senescence_temp
+    senescence_temp(:,1) = senescence_temp_c(:)
+    senescence_temp(:,2) = senescence_temp_b(:)
+    senescence_temp(:,3) = senescence_temp_a(:)
+    !
+    !- maint_resp_slope
+    maint_resp_slope(:,1) = maint_resp_slope_c(:)              
+    maint_resp_slope(:,2) = maint_resp_slope_b(:)
+    maint_resp_slope(:,3) = maint_resp_slope_a(:)
+    !
+    !-coeff_maint_zero
+    coeff_maint_zero(:,ileaf) = cm_zero_leaf(:)
+    coeff_maint_zero(:,isapabove) = cm_zero_sapabove(:)
+    coeff_maint_zero(:,isapbelow) = cm_zero_sapbelow(:)
+    coeff_maint_zero(:,iheartabove) = cm_zero_heartabove(:)
+    coeff_maint_zero(:,iheartbelow) = cm_zero_heartbelow(:)
+    coeff_maint_zero(:,iroot) = cm_zero_root(:)
+    coeff_maint_zero(:,ifruit) = cm_zero_fruit(:)
+    coeff_maint_zero(:,icarbres) = cm_zero_carbres(:)
+
+
+    IF ( bavard .GE. 1 ) WRITE(numout,*) 'data: PFT characteristics'
+
+    DO j = 2,nvm ! Loop over # PFTS 
+
+       IF ( bavard .GE. 1 ) WRITE(numout,'(a,i3,a,a)') '    > PFT#',j,': ', PFT_name(j)
+
+       !
+       ! 1 tree? (true/false)
+       !
+       IF ( bavard .GE. 1 ) WRITE(numout,*) '       tree: (::is_tree) ', is_tree(j)
+
+       !
+       ! 2 flamability (0-1, unitless)
+       !
+
+       IF ( bavard .GE. 1 ) WRITE(numout,*) '       litter flamability (::flam) :', flam(j)
+
+       !
+       ! 3 fire resistance (unitless)
+       !
+
+       IF ( bavard .GE. 1 ) WRITE(numout,*) '       fire resistance (::resist) :', resist(j)
+
+       !
+       ! 4 specific leaf area per mass carbon = 2 * sla / dry mass (m^2.gC^{-1})
+       !
+
+       ! SZ: Reich et al, 1992 find no statistically significant differences between broadleaved and coniferous
+       ! forests, specifically, the assumption that grasses grow needles is not justified. Replacing the function
+       ! with the one based on Reich et al. 1997. Given that sla=100cm2/gDW at 9 months, sla is:
+       ! sla=exp(5.615-0.46*ln(leaflon in months))
+
+       ! Oct 2010 : sla values are prescribed by values given by N.Viovy 
+
+       ! includes conversion from 
+       !!       sla(j) = 2. * 1e-4 * EXP(5.615 - 0.46 * log(12./leaflife_tab(j)))
+       !!\latexonly
+       !!\input{stomate_data_SLA.tex}
+       !!\endlatexonly
+!       IF ( leaf_tab(j) .EQ. 2 ) THEN
+!
+!          ! needle leaved tree
+!          sla(j) = 2. * ( 10. ** ( 2.29 - 0.4 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
+!
+!       ELSE
+!
+!          ! broad leaved tree or grass (Reich et al 1992)
+!          sla(j) = 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
+!
+!       ENDIF
+
+!!!$      IF ( leaf_tab(j) .EQ. 1 ) THEN
+!!!$
+!!!$        ! broad leaved tree
+!!!$
+!!!$        sla(j) = 2. * ( 10. ** ( 2.41 - 0.38 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
+!!!$
+!!!$      ELSE
+!!!$
+!!!$        ! needle leaved or grass (Reich et al 1992)
+!!!$
+!!!$        sla(j) = 2. * ( 10. ** ( 2.29 - 0.4 * LOG10(12./leaflife_tab(j)) ) ) *1e-4
+!!!$
+!!!$      ENDIF
+!!!$
+!!!$      IF ( ( leaf_tab(j) .EQ. 2 ) .AND. ( pheno_type_tab(j) .EQ. 2 ) ) THEN
+!!!$
+!!!$        ! summergreen needle leaf
+!!!$
+!!!$        sla(j) = 1.25 * sla(j)
+!!!$
+!!!$      ENDIF
+
+       IF ( bavard .GE. 1 ) WRITE(numout,*) '       specific leaf area (m**2/gC) (::sla):', sla(j), 12./leaflife_tab(j)
+
+       !
+       ! 5 sapling characteristics
+       !
+
+       IF ( is_tree(j) ) THEN
+
+          !> 5.1 trees
+
+          !!\latexonly
+          !!\input{stomate_data_sapl_tree.tex}
+          !!\endlatexonly
+
+          alpha = alpha_tree
+
+          bm_sapl(j,ileaf,icarbon) = &
+               &     ((bm_sapl_leaf(1)*pipe_tune1*(mass_ratio_heart_sap *bm_sapl_leaf(2)*sla(j)/(pi*pipe_k1)) & 
+               &     **bm_sapl_leaf(3))/sla(j))**bm_sapl_leaf(4)
+
+          IF ( pheno_type(j) .NE. 1 ) THEN
+             ! not evergreen
+             bm_sapl(j,icarbres,icarbon) = bm_sapl_carbres * bm_sapl(j,ileaf,icarbon)
+          ELSE
+             bm_sapl(j,icarbres,icarbon) = zero
+          ENDIF ! (pheno_type_tab(j) .NE. 1 )
+
+          csa_sap = bm_sapl(j,ileaf,icarbon) / ( pipe_k1 / sla(j) )
+
+          dia = (mass_ratio_heart_sap * csa_sap * dia_coeff(1) / pi ) ** dia_coeff(2)
+
+          bm_sapl(j,isapabove,icarbon) = &
+               bm_sapl_sapabove * pipe_density * csa_sap * pipe_tune2 * dia ** pipe_tune3
+          bm_sapl(j,isapbelow,icarbon) = bm_sapl(j,isapabove,icarbon)
+
+          bm_sapl(j,iheartabove,icarbon) = bm_sapl_heartabove * bm_sapl(j,isapabove,icarbon)
+          bm_sapl(j,iheartbelow,icarbon) = bm_sapl_heartbelow * bm_sapl(j,isapbelow,icarbon)
+
+       ELSE
+
+          !> 5.2 grasses
+
+          !!\latexonly
+          !!\input{stomate_data_sapl_grass.tex}
+          !!\endlatexonly
+
+          alpha = alpha_grass
+
+          IF ( natural(j) ) THEN
+             bm_sapl(j,ileaf,icarbon) = init_sapl_mass_leaf_nat / sla(j)
+          ELSE
+             bm_sapl(j,ileaf,icarbon) = init_sapl_mass_leaf_agri / sla(j)
+          ENDIF
+
+          bm_sapl(j,icarbres,icarbon) = init_sapl_mass_carbres *bm_sapl(j,ileaf,icarbon)
+
+          bm_sapl(j,isapabove,icarbon) = zero
+          bm_sapl(j,isapbelow,icarbon) = zero
+
+          bm_sapl(j,iheartabove,icarbon) = zero
+          bm_sapl(j,iheartbelow,icarbon) = zero
+
+       ENDIF !( is_tree(j) )
+
+       bm_sapl(j,iroot,icarbon) = init_sapl_mass_root * (1./alpha) * bm_sapl(j,ileaf,icarbon)
+
+       bm_sapl(j,ifruit,icarbon) = init_sapl_mass_fruit  * bm_sapl(j,ileaf,icarbon)
+
+       IF ( bavard .GE. 1 ) THEN
+          WRITE(numout,*) '       sapling biomass (gC):'
+          WRITE(numout,*) '         leaves: (::bm_sapl(j,ileaf,icarbon))',bm_sapl(j,ileaf,icarbon)
+          WRITE(numout,*) '         sap above ground: (::bm_sapl(j,ispabove,icarbon)):',bm_sapl(j,isapabove,icarbon)
+          WRITE(numout,*) '         sap below ground: (::bm_sapl(j,isapbelow,icarbon))',bm_sapl(j,isapbelow,icarbon)
+          WRITE(numout,*) '         heartwood above ground: (::bm_sapl(j,iheartabove,icarbon))',bm_sapl(j,iheartabove,icarbon)
+          WRITE(numout,*) '         heartwood below ground: (::bm_sapl(j,iheartbelow,icarbon))',bm_sapl(j,iheartbelow,icarbon)
+          WRITE(numout,*) '         roots: (::bm_sapl(j,iroot,icarbon))',bm_sapl(j,iroot,icarbon)
+          WRITE(numout,*) '         fruits: (::bm_sapl(j,ifruit,icarbon))',bm_sapl(j,ifruit,icarbon)
+          WRITE(numout,*) '         carbohydrate reserve: (::bm_sapl(j,icarbres,icarbon))',bm_sapl(j,icarbres,icarbon)
+       ENDIF !( bavard .GE. 1 ) 
+
+       !
+       ! 6 migration speed (m/year)
+       !
+
+       IF ( is_tree(j) ) THEN
+
+          migrate(j) = migrate_tree
+
+       ELSE
+
+          ! can be any value as grasses are, per *definition*, everywhere (big leaf).
+          migrate(j) = migrate_grass
+
+       ENDIF !( is_tree(j) )
+
+       IF ( bavard .GE. 1 ) WRITE(numout,*) '       migration speed (m/year): (::migrate(j))', migrate(j)
+
+       !
+       ! 7 critical stem diameter: beyond this diameter, the crown area no longer
+       !     increases (m)
+       !
+
+       IF ( is_tree(j) ) THEN
+
+          !!\latexonly
+          !!\input{stomate_data_stem_diameter.tex}
+          !!\endlatexonly
+
+          maxdia(j) = ( ( pipe_tune4 / ((pipe_tune2*pipe_tune3)/(maxdia_coeff(1)**pipe_tune3)) ) &
+               ** ( un / ( pipe_tune3 - un ) ) ) * maxdia_coeff(2)
+          cn_sapl(j) = cn_sapl_init !crown of individual tree, first year
+
+       ELSE
+
+          maxdia(j) = undef
+          cn_sapl(j)=1
+
+       ENDIF !( is_tree(j) )
+
+       IF ( bavard .GE. 1 ) WRITE(numout,*) '       critical stem diameter (m): (::maxdia(j))', maxdia(j)
+
+       !
+       ! 8 Coldest tolerable temperature (K)
+       !
+
+       IF ( ABS( tmin_crit(j) - undef ) .GT. min_stomate ) THEN
+          tmin_crit(j) = tmin_crit(j) + ZeroCelsius
+       ELSE
+          tmin_crit(j) = undef
+       ENDIF 
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       coldest tolerable temperature (K): (::tmin_crit(j))', tmin_crit(j)
+
+       !
+       ! 9 Maximum temperature of the coldest month: need to be below this temperature
+       !      for a certain time to regrow leaves next spring *(vernalization)* (K)
+       !
+
+       IF ( ABS ( tcm_crit(j) - undef ) .GT. min_stomate ) THEN
+          tcm_crit(j) = tcm_crit(j) + ZeroCelsius
+       ELSE
+          tcm_crit(j) = undef
+       ENDIF
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       vernalization temperature (K): (::tcm_crit(j))', tcm_crit(j)
+
+       !
+       ! 10 critical values for phenology
+       !
+
+       ! 10.1 model used
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       phenology model used: (::pheno_model(j)) ',pheno_model(j)
+
+       ! 10.2 growing degree days. What kind of gdd is meant (i.e. threshold 0 or -5 deg C
+       !        or whatever), depends on how this is used in stomate_phenology.
+
+
+       IF ( ( bavard .GE. 1 ) .AND. ( ALL(pheno_gdd_crit(j,:) .NE. undef) ) ) THEN
+          WRITE(numout,*) '         critical GDD is a function of long term T (C): (::gdd)'
+          WRITE(numout,*) '          ',pheno_gdd_crit(j,1), &
+               ' + T *',pheno_gdd_crit(j,2), &
+               ' + T^2 *',pheno_gdd_crit(j,3)
+       ENDIF
+
+       ! consistency check
+
+       IF ( ( ( pheno_model(j) .EQ. 'moigdd' ) .OR. &
+            ( pheno_model(j) .EQ. 'humgdd' )       ) .AND. &
+            ( ANY(pheno_gdd_crit(j,:) .EQ. undef) )                      ) THEN
+          STOP 'problem with phenology parameters, critical GDD. (::pheno_model)'
+       ENDIF
+
+       ! 10.3 number of growing days
+
+       IF ( ( bavard .GE. 1 ) .AND. ( ngd_crit(j) .NE. undef ) ) &
+            WRITE(numout,*) '         critical NGD: (::ngd_crit(j))', ngd_crit(j)
+
+       ! 10.4 critical temperature for ncd vs. gdd function in phenology (C)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( ncdgdd_temp(j) .NE. undef ) ) &
+            WRITE(numout,*) '         critical temperature for NCD vs. GDD (C): (::ncdgdd_temp(j))', &
+            ncdgdd_temp(j)
+
+       ! 10.5 humidity fractions (0-1, unitless)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( hum_frac(j) .NE. undef ) ) &
+            WRITE(numout,*) '         critical humidity fraction: (::hum_frac(j))', &
+            &  hum_frac(j)
+
+
+       ! 10.6 minimum time elapsed since moisture minimum (days)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( hum_min_time(j) .NE. undef ) ) &
+            WRITE(numout,*) '         time to wait after moisture min (d): (::hum_min_time(j))', &
+        &    hum_min_time(j)
+
+       !
+       ! 11 critical values for senescence
+       !
+
+       ! 11.1 type of senescence
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       type of senescence: (::senescence_type(j))',senescence_type(j)
+
+       ! 11.2 critical temperature for senescence (C)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( ALL(senescence_temp(j,:) .NE. undef) ) ) THEN
+          WRITE(numout,*) '         critical temperature for senescence (C) is'
+          WRITE(numout,*) '          a function of long term T (C): (::senescence_temp)'
+          WRITE(numout,*) '          ',senescence_temp(j,1), &
+               ' + T *',senescence_temp(j,2), &
+               ' + T^2 *',senescence_temp(j,3)
+       ENDIF
+
+       ! consistency check
+
+       IF ( ( ( senescence_type(j) .EQ. 'cold' ) .OR. &
+            ( senescence_type(j) .EQ. 'mixed' )      ) .AND. &
+            ( ANY(senescence_temp(j,:) .EQ. undef ) )           ) THEN
+          STOP 'problem with senescence parameters, temperature. (::senescence_type)'
+       ENDIF
+
+       ! 11.3 critical relative moisture availability for senescence
+
+       IF ( ( bavard .GE. 1 ) .AND. ( senescence_hum(j) .NE. undef ) ) &
+            WRITE(numout,*)  ' max. critical relative moisture availability for' 
+            WRITE(numout,*)  ' senescence: (::senescence_hum(j))',  &
+            & senescence_hum(j)
+
+       ! consistency check
+
+       IF ( ( ( senescence_type(j) .EQ. 'dry' ) .OR. &
+            ( senescence_type(j) .EQ. 'mixed' )     ) .AND. &
+            ( senescence_hum(j) .EQ. undef )                   ) THEN
+          STOP 'problem with senescence parameters, humidity.(::senescence_type)'
+       ENDIF
+
+       ! 14.3 relative moisture availability above which there is no moisture-related
+       !      senescence (0-1, unitless)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( nosenescence_hum(j) .NE. undef ) ) &
+            WRITE(numout,*) '         relative moisture availability above which there is' 
+            WRITE(numout,*) '             no moisture-related senescence: (::nosenescence_hum(j))', &
+            &  nosenescence_hum(j)
+
+       ! consistency check
+
+       IF ( ( ( senescence_type(j) .EQ. 'dry' ) .OR. &
+            ( senescence_type(j) .EQ. 'mixed' )     ) .AND. &
+            ( nosenescence_hum(j) .EQ. undef )                   ) THEN
+          STOP 'problem with senescence parameters, humidity. (::senescence_type)'
+       ENDIF
+
+       !
+       ! 12 sapwood -> heartwood conversion time (days)
+       !
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       sapwood -> heartwood conversion time (d): (::tau_sap(j))', tau_sap(j)
+
+       !
+       ! 13 fruit lifetime (days)
+       !
+
+       IF ( bavard .GE. 1 ) WRITE(numout,*) '       fruit lifetime (d): (::tau_fruit(j))', tau_fruit(j)
+
+       !
+       ! 14 length of leaf death (days)
+       !      For evergreen trees, this variable determines the lifetime of the leaves.
+       !      Note that it is different from the value given in leaflife_tab.
+       !
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       length of leaf death (d): (::leaffall(j))', leaffall(j)
+
+       !
+       ! 15 maximum lifetime of leaves (days)
+       !
+
+       IF ( ( bavard .GE. 1 ) .AND. ( leafagecrit(j) .NE. undef ) ) &
+            WRITE(numout,*) '       critical leaf age (d): (::leafagecrit(j))', leafagecrit(j)
+
+       !
+       ! 16 time constant for leaf age discretisation (days)
+       !
+
+       leaf_timecst(j) = leafagecrit(j) / REAL( nleafages,r_std )
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       time constant for leaf age discretisation (d): (::leaf_timecst(j))', &
+            leaf_timecst(j)
+
+       !
+       ! 17 minimum lai, initial (m^2.m^{-2})
+       !
+
+       IF ( is_tree(j) ) THEN
+          lai_initmin(j) = lai_initmin_tree
+       ELSE
+          lai_initmin(j) = lai_initmin_grass
+       ENDIF !( is_tree(j) )
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       initial LAI: (::lai_initmin(j))', lai_initmin(j)
+
+       !
+       ! 19 maximum LAI (m^2.m^{-2})
+       !
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       critical LAI above which no leaf allocation: (::lai_max(j))', lai_max(j)
+
+       !
+       ! 20 fraction of primary leaf and root allocation put into reserve (0-1, unitless)
+       !
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       reserve allocation factor: (::ecureuil(j))', ecureuil(j)
+
+       !
+       ! 21 maintenance respiration coefficient (g/g/day) at 0 deg C
+       !
+
+       IF ( bavard .GE. 1 ) THEN
+
+          WRITE(numout,*) '       maintenance respiration coefficient (g/g/day) at 0 deg C:'
+          WRITE(numout,*) '         . leaves: (::coeff_maint_zero(j,ileaf))',coeff_maint_zero(j,ileaf)
+          WRITE(numout,*) '         . sapwood above ground: (::coeff_maint_zero(j,isapabove)) ',&
+                        & coeff_maint_zero(j,isapabove)
+          WRITE(numout,*) '         . sapwood below ground: (::coeff_maint_zero(j,isapbelow))  ',&
+                       & coeff_maint_zero(j,isapbelow)
+          WRITE(numout,*) '         . heartwood above ground: (::coeff_maint_zero(j,iheartabove)) ',&
+                       & coeff_maint_zero(j,iheartabove)
+          WRITE(numout,*) '         . heartwood below ground: (::coeff_maint_zero(j,iheartbelow)) ',&
+                       & coeff_maint_zero(j,iheartbelow)
+          WRITE(numout,*) '         . roots: (::coeff_maint_zero(j,iroot))',coeff_maint_zero(j,iroot)
+          WRITE(numout,*) '         . fruits: (::coeff_maint_zero(j,ifruit)) ',coeff_maint_zero(j,ifruit)
+          WRITE(numout,*) '         . carbohydrate reserve: (::coeff_maint_zero(j,icarbres)) ',&
+                       & coeff_maint_zero(j,icarbres)
+
+       ENDIF !( bavard .GE. 1 )
+
+       !
+       ! 22 parameter for temperature sensitivity of maintenance respiration
+       !
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       temperature sensitivity of maintenance respiration (1/K) is'
+       WRITE(numout,*) '          a function of long term T (C): (::maint_resp_slope)'
+       WRITE(numout,*) '          ',maint_resp_slope(j,1),' + T *',maint_resp_slope(j,2), &
+            ' + T^2 *',maint_resp_slope(j,3)
+
+       !
+       ! 23 natural ?
+       !
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       Natural: (::natural(j))', natural(j)
+
+       !
+       ! 24 Vcmax et Vjmax (umol.m^{-2}.s^{-1}) 
+       !
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       Maximum rate of carboxylation: (::vcmax_opt(j))', vcmax_opt(j)
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       Maximum rate of RUbp regeneration: (::vjmax_opt(j))', vjmax_opt(j)
+
+       !
+       ! 25 constants for photosynthesis temperatures
+       !
+
+       IF ( bavard .GE. 1 ) THEN
+          WRITE(numout,*) '       min. temperature for photosynthesis as a function of long term T (C):'
+          WRITE(numout,*) '       (::tphoto_min_c(j))'
+          WRITE(numout,*) '          ',tphoto_min_c(j), &
+               ' + T*',tphoto_min_b(j), &
+               ' + T^2*',tphoto_min_a(j)
+          WRITE(numout,*) '       opt. temperature for photosynthesis as a function of long term T (C):' 
+          WRITE(numout,*) '       (::tphoto_opt_c(j))'
+          WRITE(numout,*) '          ',tphoto_opt_c(j), &
+               ' + T*',tphoto_opt_b(j), &
+               ' + T^2*',tphoto_opt_a(j)
+          WRITE(numout,*) '       max. temperature for photosynthesis as a function of long term T (C):' 
+          WRITE(numout,*)'        (::tphoto_max_c(j))'
+          WRITE(numout,*) '          ',tphoto_max_c(j), &
+               ' + T*',tphoto_max_b(j), &
+               ' + T^2*',tphoto_max_a(j)
+
+
+          !
+          ! 26 Properties
+          !
+
+          WRITE(numout,*) '       Slope of the gs/A relation: (::gsslope(j))', gsslope(j)
+          WRITE(numout,*) '       Intercept of the gs/A relation: (::gsoffset(j))', gsoffset(j)
+          WRITE(numout,*) '       C4 photosynthesis: (::is_c4(j))', is_c4(j)
+          WRITE(numout,*) '       Depth constant for root profile (m): (::1./humcste(j))', 1./humcste(j)
+
+       ENDIF !( bavard .GE. 1 ) 
+
+       !
+       ! 27 extinction coefficient of the Monsi and Saeki (1953) relationship 
+       !
+       IF ( bavard .GE. 1 ) THEN
+          WRITE(numout,*) '       extinction coefficient: (::ext_coeff(j))', ext_coeff(j)
+       ENDIF !( bavard .GE. 1 )
+
+    ENDDO ! Loop over # PFTS 
+
+    !
+    ! 29 time scales for phenology and other processes (in days)
+    !
+
+    tau_longterm = coeff_tau_longterm * one_year
+
+    IF ( bavard .GE. 1 ) THEN
+
+       WRITE(numout,*) '   > time scale for ''monthly'' moisture availability (d): (::tau_hum_month)', &
+            tau_hum_month
+       WRITE(numout,*) '   > time scale for ''weekly'' moisture availability (d): (::tau_hum_week)', &
+           tau_hum_week
+       WRITE(numout,*) '   > time scale for ''monthly'' 2 meter temperature (d): (::tau_t2m_month)', &
+            tau_t2m_month
+       WRITE(numout,*) '   > time scale for ''weekly'' 2 meter temperature (d): (::tau_t2m_week)', &
+            tau_t2m_week
+       WRITE(numout,*) '   > time scale for ''weekly'' GPP (d): (::tau_gpp_week)', &
+            tau_gpp_week
+       WRITE(numout,*) '   > time scale for ''monthly'' soil temperature (d): (::tau_tsoil_month)', &
+            tau_tsoil_month
+       WRITE(numout,*) '   > time scale for ''monthly'' soil humidity (d): (::tau_soilhum_month)', &
+            tau_soilhum_month
+       WRITE(numout,*) '   > time scale for vigour calculations (y): (::tau_longterm / one_year)', &
+            tau_longterm / one_year
+
+    ENDIF !( bavard .GE. 1 ) 
+
+    !
+    ! 30 fraction of allocatable biomass which is lost as growth respiration (0-1, unitless)
+    !
+
+    IF ( bavard .GE. 1 ) &
+         WRITE(numout,*) '   > growth respiration fraction: (::frac_growthresp)', frac_growthresp
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving data'
+
+  END SUBROUTINE data
+
+END MODULE stomate_data
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_io.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_io.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_io.f90	(revision 5166)
@@ -0,0 +1,3123 @@
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+! IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+MODULE stomate_io
+  !---------------------------------------------------------------------
+  !- Not all variables saved in the start files are absolutely necessary.
+  !- However, Sechiba's and Stomate's PFTs are not necessarily identical,
+  !- and for that case this information needs to be saved.
+  !---------------------------------------------------------------------
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE mod_orchidee_para
+  USE ioipsl_para 
+
+  !-
+  IMPLICIT NONE
+  !-
+  PRIVATE
+  PUBLIC readstart, writerestart, readbc,get_reftemp_clear
+  !-
+  ! first call?
+  !-
+  LOGICAL,SAVE :: firstcall = .TRUE.
+!$OMP THREADPRIVATE(firstcall)
+  !-
+  ! reference temperature (K)
+  !-
+  REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE :: trefe
+!$OMP THREADPRIVATE(trefe)
+  !-
+CONTAINS
+  !-
+  !===
+  !-
+  SUBROUTINE readstart &
+       & (npts, index, lalo, resolution, day_counter, dt_days, date, &
+       &  ind, adapted, regenerate, moiavail_daily, gdd_init_date, litterhum_daily, &
+       &  t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+       &  soilhum_daily, precip_daily, &
+       &  gpp_daily, npp_daily, turnover_daily, &
+       &  moiavail_month, moiavail_week, t2m_longterm, tlong_ref, &
+       &  t2m_month, t2m_week, tsoil_month, soilhum_month, &
+       &  fireindex, firelitter, &
+       &  maxmoiavail_lastyear, maxmoiavail_thisyear, &
+       &  minmoiavail_lastyear, minmoiavail_thisyear, &
+       &  maxgppweek_lastyear, maxgppweek_thisyear, &
+       &  gdd0_lastyear, gdd0_thisyear, precip_lastyear, precip_thisyear, &
+       &  gdd_m5_dormance,  gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       &  PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+       &  maxfpc_lastyear, maxfpc_thisyear, &
+       &  turnover_longterm, gpp_week, biomass, resp_maint_part, &
+       &  leaf_age, leaf_frac, senescence, when_growthinit, age, &
+       &  resp_hetero, resp_maint, resp_growth, co2_fire, co2_to_bm_dgvm, &
+       &  veget_lastlight, everywhere, need_adjacent, RIP_time, &
+       &  time_hum_min, hum_min_dormance, &
+       &  litterpart, litter_above, litter_below, dead_leaves, &
+       &  carbon, DOC, DOC_EXP, black_carbon, lignin_struc_above, lignin_struc_below, turnover_time, &
+       &  prod10,prod100,flux10, flux100, &
+       &  convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total, &
+       &  global_years, ok_equilibrium, nbp_accu, nbp_flux, &
+       &  MatrixV, VectorU, previous_stock, current_stock)
+
+    !---------------------------------------------------------------------
+    !- read start file
+    !---------------------------------------------------------------------
+    !-
+    ! 0 declarations
+    !-
+    ! 0.1 input
+    !-
+    ! Domain size
+    INTEGER(i_std),INTENT(in) :: npts
+    ! Indices of the points on the map
+    INTEGER(i_std),DIMENSION(npts),INTENT(in) :: index
+    ! Geogr. coordinates (latitude,longitude) (degrees)
+    REAL(r_std),DIMENSION(npts,2),INTENT(in) :: lalo
+    ! size in x an y of the grid (m)
+    REAL(r_std),DIMENSION(npts,2),INTENT(in) :: resolution
+    !-
+    ! 0.2 output
+    !-
+    ! counts time until next STOMATE time step
+    REAL(r_std),INTENT(out) :: day_counter
+    ! time step of STOMATE in days
+    REAL(r_std),INTENT(out) :: dt_days
+    ! date (d)
+    INTEGER(i_std),INTENT(out) :: date
+    ! density of individuals (1/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ind
+    ! Winter too cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: adapted
+    ! Winter sufficiently cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: regenerate
+    ! daily moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_daily
+    ! date for beginning of gdd count
+    REAL(r_std),DIMENSION(npts,2),INTENT(out) :: gdd_init_date
+    ! daily litter humidity
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: litterhum_daily
+    ! daily 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_daily
+    ! daily minimum 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_min_daily
+    ! daily surface temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: tsurf_daily
+    ! daily soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: tsoil_daily
+    ! daily soil humidity
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: soilhum_daily
+    ! daily precipitations (mm/day) (for phenology)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: precip_daily
+    ! daily gross primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gpp_daily
+    ! daily net primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: npp_daily
+    ! daily turnover rates (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out) :: turnover_daily
+    ! "monthly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_month
+    ! "weekly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_week
+    ! "long term" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_longterm
+    ! "monthly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_month
+    ! "weekly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: t2m_week
+    ! "monthly" soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: tsoil_month
+    ! "monthly" soil humidity
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: soilhum_month
+    ! Probability of fire
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: fireindex
+    ! Longer term total litter above the ground, gC/m**2 of ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: firelitter
+    ! last year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxmoiavail_lastyear
+    ! this year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxmoiavail_thisyear
+    ! last year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: minmoiavail_lastyear
+    ! this year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: minmoiavail_thisyear
+    ! last year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxgppweek_lastyear
+    ! this year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxgppweek_thisyear
+    ! last year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: gdd0_lastyear
+    ! this year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: gdd0_thisyear
+    ! last year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: precip_lastyear
+    ! this year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(out)      :: precip_thisyear
+    ! growing degree days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_m5_dormance
+    ! growing degree days, from begin of season
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_from_growthinit
+    ! growing degree days since midwinter (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_midwinter
+    ! number of chilling days since leaves were lost (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ncd_dormance
+    ! number of growing days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ngd_minus5
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out)    :: PFTpresent
+    ! "long term" net primary productivity (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: npp_longterm
+    ! last year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lm_lastyearmax
+    ! this year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lm_thisyearmax
+    ! last year's maximum fpc for each natural PFT, on ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxfpc_lastyear
+    ! this year's maximum fpc for each PFT,
+    ! on *total* ground (see stomate_season)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxfpc_thisyear
+    ! "long term" turnover rate (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out) :: turnover_longterm
+    ! "weekly" GPP (gC/day/(m**2 covered)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gpp_week
+    ! biomass (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out) :: biomass
+    ! maintenance resp (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(out) :: resp_maint_part
+    ! leaf age (days)
+    REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(out) :: leaf_age
+    ! fraction of leaves in leaf age class
+    REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(out) :: leaf_frac
+    ! is the plant senescent ? 
+    !(only for deciduous trees - carbohydrate reserve)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out) :: senescence
+    ! how many days ago was the beginning of the growing season
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: when_growthinit
+    ! mean age (years)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: age
+    ! heterotrophic respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: resp_hetero
+    ! maintenance respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: resp_maint
+    ! growth respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: resp_growth
+    ! carbon emitted into the atmosphere by fire (living and dead biomass)
+    ! (in gC/m**2/time step)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: co2_fire
+    ! biomass uptaken (gC/(m**2 of total ground)/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: co2_to_bm_dgvm
+    ! vegetation fractions (on ground) after last light competition
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: veget_lastlight
+    ! is the PFT everywhere in the grid box or very localized
+    ! (after its introduction)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: everywhere
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box?
+    LOGICAL,DIMENSION(npts,nvm),INTENT(out) :: need_adjacent
+    ! How much time ago was the PFT eliminated for the last time (y)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: RIP_time
+    ! time elapsed since strongest moisture availability (d)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: time_hum_min
+    ! minimum moisture during dormance
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: hum_min_dormance
+    ! fraction of litter above the ground belonging to different PFTs
+    ! separated for natural and agricultural PFTs.
+    REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(out) :: litterpart
+    ! metabolic and structural litter, natural and agricultural,
+    ! above ground (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nelements),INTENT(out):: litter_above
+    ! metabolic and structural litter, natural and agricultural,
+    ! below ground (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nbdl,nelements),INTENT(out):: litter_below
+    ! dead leaves on ground, per PFT, metabolic and structural,
+    ! in gC/(m**2 of ground)
+    REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(out) :: dead_leaves
+    ! carbon pool: active, slow, or passive, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,ncarb,nvm,nbdl),INTENT(out) :: carbon
+    ! dissoled organic carbon in soils: free or adsrobed (gC/m**3 of water)
+    REAL(r_std),DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements),INTENT(out) :: DOC
+    ! exported dissoled organic carbon in soils (gC/m**2 of ground/dt)
+    REAL(r_std),DIMENSION(npts,nvm,nexp,nelements),INTENT(out) :: DOC_EXP
+    ! black carbon on the ground (gC/(m**2 of total ground))
+    REAL(r_std),DIMENSION(npts),INTENT(out)                 :: black_carbon
+    ! ratio Lignine/Carbon in structural litter, above ground,(gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lignin_struc_above
+    ! ratio Lignine/Carbon in structural litter, below ground,(gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nbdl),INTENT(out) :: lignin_struc_below
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: turnover_time
+
+    ! For Spinup matrix resolution
+    INTEGER(i_std), INTENT(out) :: global_years   
+    LOGICAL, DIMENSION(npts), INTENT(out) :: ok_equilibrium
+    REAL(r_std), DIMENSION(npts), INTENT(out) :: nbp_accu  !! Accumulated Net Biospheric Production over the year
+    REAL(r_std), DIMENSION(npts), INTENT(out) :: nbp_flux  !! Net Biospheric Production over the year
+    !-
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(out) :: MatrixV
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: VectorU
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: previous_stock
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: current_stock    
+
+    !-
+    ! 0.3 not necessarily output
+    !-
+    ! "long term" reference 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(inout) :: tlong_ref
+    !-
+    ! 0.4 local
+    !-
+    ! date, real
+    REAL(r_std) :: date_real
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs), real
+    REAL(r_std),DIMENSION(npts,nvm) :: PFTpresent_real
+    ! is the plant senescent ?
+    ! (only for deciduous trees - carbohydrate reserve), real
+    REAL(r_std),DIMENSION(npts,nvm) :: senescence_real
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box? - real
+    REAL(r_std),DIMENSION(npts,nvm) :: need_adjacent_real
+    ! To store variables names for I/O
+    CHARACTER(LEN=80) :: var_name
+    ! string suffix indicating an index
+    CHARACTER(LEN=10) :: part_str
+    ! string suffix indicating litter type
+    CHARACTER(LEN=3),DIMENSION(nlitt) :: litter_str
+    ! temporary storage
+    REAL(r_std),DIMENSION(1) :: xtmp
+    ! index
+    INTEGER(i_std) :: j,k,l,m
+    ! reference temperature (K)
+    REAL(r_std),DIMENSION(npts) :: tref
+
+    CHARACTER(LEN=1),DIMENSION(nelements) :: element_str   !! string suffix indicating element
+    REAL(r_std), DIMENSION(1) :: temp_global_years
+    CHARACTER(LEN=10), DIMENSION(nbpools) :: pools_str
+    REAL(r_std), DIMENSION(npts) :: ok_equilibrium_real    
+
+    ! land cover change variables 
+    ! products remaining in the 10/100 year-turnover pool after the annual release for each compartment
+    ! (10 or 100 + 1 : input from year of land cover change)
+    REAL(r_std),DIMENSION(npts,0:10),INTENT(out)                           :: prod10
+    REAL(r_std),DIMENSION(npts,0:100),INTENT(out)                          :: prod100
+    ! annual release from the 10/100 year-turnover pool compartments
+    REAL(r_std),DIMENSION(npts,10),INTENT(out)                           :: flux10
+    REAL(r_std),DIMENSION(npts,100),INTENT(out)                          :: flux100
+    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: convflux
+    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: cflux_prod10
+    REAL(r_std), DIMENSION(npts), INTENT(out)                            :: cflux_prod100
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(out)         :: bm_to_litter
+    REAL(r_std),DIMENSION(npts),INTENT(out)                              :: carb_mass_total
+    !---------------------------------------------------------------------
+    IF (bavard >= 3) WRITE(numout,*) 'Entering readstart'
+    !-
+    ! 0 When the vegetation is dynamic,
+    !   the long-term reference temperature is prognostic.
+    !   In this case, it is read from the restart file.
+    !   If the corresponding field does not exist in the restart file,
+    !   read it from another file in order to initialize it correctly.
+    !-
+    CALL get_reftemp( npts, lalo, resolution, tref )
+    !-
+    ! 1 string definitions
+    !-
+    DO l=1,nlitt
+       IF     (l == imetabolic) THEN
+          litter_str(l) = 'met'
+       ELSEIF (l == istructural) THEN
+          litter_str(l) = 'str'
+       ELSE
+          STOP 'Define litter_str'
+       ENDIF
+    ENDDO
+    !-
+    !-
+    pools_str(1:nbpools) =(/'str_ab    ',&
+                            'strbe_z1  ','strbe_z2  ','strbe_z3  ','strbe_z4  ','strbe_z5  ','strbe_z6  ',&
+                            'strbe_z7  ','strbe_z8  ','strbe_z9  ','strbe_z10 ','strbe_z11 ',&
+                            'met_ab    ',&
+                            'metbe_z1  ','metbe_z2  ','metbe_z3  ','metbe_z4  ','metbe_z5  ','metbe_z6  ',&
+                            'metbe_z7  ','metbe_z8  ','metbe_z9  ','metbe_z10 ','metbe_z11 ',&
+                            'act_z1    ','act_z2    ','act_z3    ','act_z4    ','act_z5    ',&
+                            'act_z6    ','act_z7    ','act_z8    ','act_z9    ','act_z10   ','act_z11   ',&
+                            'slow_z1   ','slow_z2   ','slow_z3   ','slow_z4   ','slow_z5   ','slow_z6   ',&
+                            'slow_z7   ','slow_z8   ','slow_z9   ','slow_z10  ','slow_z11  ',&
+                            'pas_z1    ','pas_z2    ','pas_z3    ','pas_z4    ','pas_z5    ','pas_z6    ',&
+                            'pas_z7    ','pas_z8    ','pas_z9    ','pas_z10   ','pas_z11   ',&
+                            'free_z1_1 ','free_z2_1 ','free_z3_1 ','free_z4_1 ','free_z5_1 ','free_z6_1 ',&
+                            'free_z7_1 ','free_z8_1 ','free_z9_1 ','free_z10_1','free_z11_1',&
+                            'adso_z1_1 ','adso_z2_1 ','adso_z3_1 ','adso_z4_1 ','adso_z5_1 ','adso_z6_1 ',&
+                            'adso_z7_1 ','adso_z8_1 ','adso_z9_1 ','adso_z10_1','adso_z11_1',&
+                            'free_z1_2 ','free_z2_2 ','free_z3_2 ','free_z4_2 ','free_z5_2 ','free_z6_2 ',&
+                            'free_z7_2 ','free_z8_2 ','free_z9_2 ','free_z10_2','free_z11_2',&
+                            'adso_z1_2 ','adso_z2_2 ','adso_z3_2 ','adso_z4_2 ','adso_z5_2 ','adso_z6_2 ',&
+                            'adso_z7_2 ','adso_z8_2 ','adso_z9_2 ','adso_z10_2','adso_z11_2',&
+                            'free_z1_3 ','free_z2_3 ','free_z3_3 ','free_z4_3 ','free_z5_3 ','free_z6_3 ',&
+                            'free_z7_3 ','free_z8_3 ','free_z9_3 ','free_z10_3','free_z11_3',&
+                            'adso_z1_3 ','adso_z2_3 ','adso_z3_3 ','adso_z4_3 ','adso_z5_3 ','adso_z6_3 ',&
+                            'adso_z7_3 ','adso_z8_3 ','adso_z9_3 ','adso_z10_3','adso_z11_3',&
+                            'free_z1_4 ','free_z2_4 ','free_z3_4 ','free_z4_4 ','free_z5_4 ','free_z6_4 ',&
+                            'free_z7_4 ','free_z8_4 ','free_z9_4 ','free_z10_4','free_z11_4',&
+                            'adso_z1_4 ','adso_z2_4 ','adso_z3_4 ','adso_z4_4 ','adso_z5_4 ','adso_z6_4 ',&
+                            'adso_z7_4 ','adso_z8_4 ','adso_z9_4 ','adso_z10_4','adso_z11_4',&
+                            'free_z1_5 ','free_z2_5 ','free_z3_5 ','free_z4_5 ','free_z5_5 ','free_z6_5 ',&
+                            'free_z7_5 ','free_z8_5 ','free_z9_5 ','free_z10_5','free_z11_5',&
+                            'adso_z1_5 ','adso_z2_5 ','adso_z3_5 ','adso_z4_5 ','adso_z5_5 ','adso_z6_5 ',&
+                            'adso_z7_5 ','adso_z8_5 ','adso_z9_5 ','adso_z10_5','adso_z11_5',&
+                            'free_z1_6 ','free_z2_6 ','free_z3_6 ','free_z4_6 ','free_z5_6 ','free_z6_6 ',&
+                            'free_z7_6 ','free_z8_6 ','free_z9_6 ','free_z10_6','free_z11_6',&
+                            'adso_z1_6 ','adso_z2_6 ','adso_z3_6 ','adso_z4_6 ','adso_z5_6 ','adso_z6_6 ',&
+                            'adso_z7_6 ','adso_z8_6 ','adso_z9_6 ','adso_z10_6','adso_z11_6',&
+                            'free_z1_7 ','free_z2_7 ','free_z3_7 ','free_z4_7 ','free_z5_7 ','free_z6_7 ',&
+                            'free_z7_7 ','free_z8_7 ','free_z9_7 ','free_z10_7','free_z11_7',&
+                            'adso_z1_7 ','adso_z2_7 ','adso_z3_7 ','adso_z4_7 ','adso_z5_7 ','adso_z6_7 ',&
+                            'adso_z7_7 ','adso_z8_7 ','adso_z9_7 ','adso_z10_7','adso_z11_7'/)
+
+    !-
+    DO l=1,nelements
+       IF     (l == icarbon) THEN
+          element_str(l) = ''
+!!$       ELSEIF (l == initrogen) THEN
+!!$          element_str(l) = '_n'
+       ELSE
+          STOP 'Define element_str'
+       ENDIF
+    ENDDO
+    !-
+    ! 2 run control
+    !-
+    ! 2.1 day counter
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'day_counter'
+       CALL restget (rest_id_stomate, var_name, 1   , 1     , 1, itime, &
+            &                 .TRUE., xtmp)
+       day_counter = xtmp(1)
+       IF (day_counter == val_exp) day_counter = un
+    ENDIF
+    CALL bcast(day_counter)
+    !-
+    ! 2.2 time step of STOMATE in days
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'dt_days'
+       CALL restget (rest_id_stomate, var_name, 1   , 1     , 1, itime, &
+            &                 .TRUE., xtmp)
+       dt_days = xtmp(1)
+       IF (dt_days == val_exp) dt_days = un
+    ENDIF
+    CALL bcast(dt_days)
+    !-
+    ! 2.3 date
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'date'
+       CALL restget (rest_id_stomate, var_name, 1   , 1     , 1, itime, &
+            &                 .TRUE., xtmp)
+       date_real = xtmp(1)
+       IF (date_real == val_exp) date_real = zero
+       date = NINT(date_real)
+    ENDIF
+    CALL bcast(date)
+    !-
+    ! 3 daily meteorological variables
+    !-
+    moiavail_daily(:,:) = val_exp
+    var_name = 'moiavail_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., moiavail_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(moiavail_daily(:,:) == val_exp)) moiavail_daily(:,:) = zero
+    !-
+    gdd_init_date(:,:) = val_exp
+    var_name = 'gdd_init_date'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 2 , 1, itime, &
+         &              .TRUE., gdd_init_date, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_init_date(:,1) == val_exp)) gdd_init_date(:,1) = 365.
+    !-
+    litterhum_daily(:) = val_exp
+    var_name = 'litterhum_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., litterhum_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(litterhum_daily(:) == val_exp)) litterhum_daily(:) = zero
+    !-
+    t2m_daily(:) = val_exp
+    var_name = 't2m_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., t2m_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(t2m_daily(:) == val_exp)) t2m_daily(:) = zero
+    !-
+    t2m_min_daily(:) = val_exp
+    var_name = 't2m_min_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., t2m_min_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(t2m_min_daily(:) == val_exp)) t2m_min_daily(:) = large_value
+    !-
+    tsurf_daily(:) = val_exp
+    var_name = 'tsurf_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., tsurf_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(tsurf_daily(:) == val_exp)) tsurf_daily(:) = tref(:)
+    !-
+    tsoil_daily(:,:) = val_exp
+    var_name = 'tsoil_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nbdl, 1, itime, &
+         &                .TRUE., tsoil_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(tsoil_daily(:,:) == val_exp)) tsoil_daily(:,:) = zero
+    !-
+    soilhum_daily(:,:) = val_exp
+    var_name = 'soilhum_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nbdl, 1, itime, &
+         &                .TRUE., soilhum_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(soilhum_daily(:,:) == val_exp)) soilhum_daily(:,:) = zero
+    !-
+    precip_daily(:) = val_exp
+    var_name = 'precip_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., precip_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(precip_daily(:) == val_exp)) precip_daily(:) = zero
+    !-
+    ! 4 productivities
+    !-
+    gpp_daily(:,:) = val_exp
+    var_name = 'gpp_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gpp_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(gpp_daily(:,:) == val_exp)) gpp_daily(:,:) = zero
+    !-
+    npp_daily(:,:) = val_exp
+    var_name = 'npp_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., npp_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(npp_daily(:,:) == val_exp)) npp_daily(:,:) = zero
+    !-
+    turnover_daily(:,:,:,:) = val_exp
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'turnover_daily_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               &                .TRUE., turnover_daily(:,:,k,l), 'gather', nbp_glo, index_g)
+          IF (ALL(turnover_daily(:,:,k,l) == val_exp)) &
+               &       turnover_daily(:,:,k,l) = zero
+       ENDDO
+    END DO
+    !-
+    ! 5 monthly meteorological variables
+    !-
+    moiavail_month(:,:) = val_exp
+    var_name = 'moiavail_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., moiavail_month, 'gather', nbp_glo, index_g)
+    IF (ALL(moiavail_month(:,:) == val_exp)) moiavail_month(:,:) = zero
+    !-
+    moiavail_week(:,:) = val_exp
+    var_name = 'moiavail_week'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., moiavail_week, 'gather', nbp_glo, index_g)
+    IF (ALL(moiavail_week(:,:) == val_exp)) moiavail_week(:,:) = zero
+    !-
+    t2m_longterm(:) = val_exp
+    var_name = 't2m_longterm'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., t2m_longterm, 'gather', nbp_glo, index_g)
+    IF (ALL(t2m_longterm(:) == val_exp)) t2m_longterm(:) = tref(:)
+    !-
+    ! the long-term reference temperature is a prognostic variable
+    ! only in case the vegetation is dynamic
+    !-
+    IF (control%ok_dgvm) THEN
+       tlong_ref(:) = val_exp
+       var_name = 'tlong_ref'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            &                .TRUE., tlong_ref, 'gather', nbp_glo, index_g)
+       IF (ALL(tlong_ref(:) == val_exp)) tlong_ref(:) = tref(:)
+    ENDIF
+    !-
+    t2m_month(:) = val_exp
+    var_name = 't2m_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., t2m_month, 'gather', nbp_glo, index_g)
+    IF (ALL(t2m_month(:) == val_exp)) t2m_month(:) = tref(:)
+    !-
+    t2m_week(:) = val_exp
+    var_name = 't2m_week'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., t2m_week, 'gather', nbp_glo, index_g)
+    IF (ALL(t2m_week(:) == val_exp)) t2m_week(:) = tref(:)
+    !-
+    tsoil_month(:,:) = val_exp
+    var_name = 'tsoil_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nbdl, 1, itime, &
+         &              .TRUE., tsoil_month, 'gather', nbp_glo, index_g)
+
+    IF (ALL(tsoil_month(:,:) == val_exp)) THEN
+       DO l=1,nbdl
+          tsoil_month(:,l) = tref(:)
+       ENDDO
+    ENDIF
+    !-
+    soilhum_month(:,:) = val_exp
+    var_name = 'soilhum_month'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nbdl, 1, itime, &
+         &              .TRUE., soilhum_month, 'gather', nbp_glo, index_g)
+    IF (ALL(soilhum_month(:,:) == val_exp)) soilhum_month(:,:) = zero
+    !-
+    ! 6 fire probability
+    !-
+    fireindex(:,:) = val_exp
+    var_name = 'fireindex'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              .TRUE., fireindex, 'gather', nbp_glo, index_g)
+    IF (ALL(fireindex(:,:) == val_exp)) fireindex(:,:) = zero
+    !-
+    firelitter(:,:) = val_exp
+    var_name = 'firelitter'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              .TRUE., firelitter, 'gather', nbp_glo, index_g)
+    IF (ALL(firelitter(:,:) == val_exp)) firelitter(:,:) = zero
+    !-
+    ! 7 maximum and minimum moisture availabilities for tropic phenology
+    !-
+    maxmoiavail_lastyear(:,:) = val_exp
+    var_name = 'maxmoistr_last'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxmoiavail_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxmoiavail_lastyear(:,:) == val_exp)) &
+         &     maxmoiavail_lastyear(:,:) = zero
+    !-
+    maxmoiavail_thisyear(:,:) = val_exp
+    var_name = 'maxmoistr_this'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxmoiavail_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxmoiavail_thisyear(:,:) == val_exp)) &
+         &     maxmoiavail_thisyear(:,:) = zero
+    !-
+    minmoiavail_lastyear(:,:) = val_exp
+    var_name = 'minmoistr_last'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., minmoiavail_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(minmoiavail_lastyear(:,:) == val_exp)) &
+         &     minmoiavail_lastyear(:,:) = un
+    !-
+    minmoiavail_thisyear(:,:) = val_exp
+    var_name = 'minmoistr_this'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., minmoiavail_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL( minmoiavail_thisyear(:,:) == val_exp)) &
+         &     minmoiavail_thisyear(:,:) = un
+    !-
+    ! 8 maximum "weekly" GPP
+    !-
+    maxgppweek_lastyear(:,:) = val_exp
+    var_name = 'maxgppweek_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxgppweek_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxgppweek_lastyear(:,:) == val_exp)) &
+         &     maxgppweek_lastyear(:,:) = zero
+    !-
+    maxgppweek_thisyear(:,:) = val_exp
+    var_name = 'maxgppweek_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxgppweek_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxgppweek_thisyear(:,:) == val_exp)) &
+         &     maxgppweek_thisyear(:,:) = zero
+    !-
+    ! 9 annual GDD0
+    !-
+    gdd0_thisyear(:) = val_exp
+    var_name = 'gdd0_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., gdd0_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd0_thisyear(:) == val_exp)) gdd0_thisyear(:) = zero
+    !-
+    gdd0_lastyear(:) = val_exp
+    var_name = 'gdd0_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., gdd0_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd0_lastyear(:) == val_exp)) gdd0_lastyear(:) = gdd_crit_estab
+    !-
+    ! 10 annual precipitation
+    !-
+    precip_thisyear(:) = val_exp
+    var_name = 'precip_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., precip_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(precip_thisyear(:) == val_exp)) precip_thisyear(:) = zero
+    !-
+    precip_lastyear(:) = val_exp
+    var_name = 'precip_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., precip_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(precip_lastyear(:) == val_exp)) &
+         &     precip_lastyear(:) = precip_crit
+    !-
+    ! 11 derived "biometeorological" variables
+    !-
+    gdd_m5_dormance(:,:) = val_exp
+    var_name = 'gdd_m5_dormance'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gdd_m5_dormance, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_m5_dormance(:,:) == val_exp)) &
+         &     gdd_m5_dormance(:,:) = undef
+    !-
+    gdd_from_growthinit(:,:) = val_exp
+    var_name = 'gdd_from_growthinit'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gdd_from_growthinit, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_from_growthinit(:,:) == val_exp)) &
+         &     gdd_from_growthinit(:,:) = zero
+    !-
+    gdd_midwinter(:,:) = val_exp
+    var_name = 'gdd_midwinter'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gdd_midwinter, 'gather', nbp_glo, index_g)
+    IF (ALL(gdd_midwinter(:,:) == val_exp)) gdd_midwinter(:,:) = undef
+    !-
+    ncd_dormance(:,:) = val_exp
+    var_name = 'ncd_dormance'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., ncd_dormance, 'gather', nbp_glo, index_g)
+    IF (ALL(ncd_dormance(:,:) == val_exp)) ncd_dormance(:,:) = undef
+    !-
+    ngd_minus5(:,:) = val_exp
+    var_name = 'ngd_minus5'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., ngd_minus5, 'gather', nbp_glo, index_g)
+    IF (ALL(ngd_minus5(:,:) == val_exp)) ngd_minus5(:,:) = zero
+    !-
+    time_hum_min(:,:) = val_exp
+    var_name = 'time_hum_min'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., time_hum_min, 'gather', nbp_glo, index_g)
+    IF (ALL(time_hum_min(:,:) == val_exp)) time_hum_min(:,:) = undef
+    !-
+    hum_min_dormance(:,:) = val_exp
+    var_name = 'hum_min_dormance'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., hum_min_dormance, 'gather', nbp_glo, index_g)
+    IF (ALL(hum_min_dormance(:,:) == val_exp)) &
+         &     hum_min_dormance(:,:) = undef
+    !-
+    ! 12 Plant status
+    !-
+    PFTpresent_real(:,:) = val_exp
+    var_name = 'PFTpresent'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., PFTpresent_real, 'gather', nbp_glo, index_g)
+    IF (ALL(PFTpresent_real(:,:) == val_exp)) PFTpresent_real(:,:) = zero
+    WHERE (PFTpresent_real(:,:) >= .5)
+       PFTpresent = .TRUE.
+    ELSEWHERE
+       PFTpresent = .FALSE.
+    ENDWHERE
+    !-
+    ind(:,:) = val_exp
+    var_name = 'ind'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., ind, 'gather', nbp_glo, index_g)
+    IF (ALL(ind(:,:) == val_exp)) ind(:,:) = zero
+    !-
+    adapted(:,:) = val_exp
+    var_name = 'adapted'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., adapted, 'gather', nbp_glo, index_g)
+    IF (ALL(adapted(:,:) == val_exp)) adapted(:,:) = zero
+    !-
+    regenerate(:,:) = val_exp
+    var_name = 'regenerate'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., regenerate, 'gather', nbp_glo, index_g)
+    IF (ALL(regenerate(:,:) == val_exp)) regenerate(:,:) = zero
+    !-
+    npp_longterm(:,:) = val_exp
+    var_name = 'npp_longterm'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., npp_longterm, 'gather', nbp_glo, index_g)
+    IF (ALL(npp_longterm(:,:) == val_exp)) npp_longterm(:,:) = zero
+    !-
+    lm_lastyearmax(:,:) = val_exp
+    var_name = 'lm_lastyearmax'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., lm_lastyearmax, 'gather', nbp_glo, index_g)
+    IF (ALL(lm_lastyearmax(:,:) == val_exp)) lm_lastyearmax(:,:) = zero
+    !-
+    lm_thisyearmax(:,:) = val_exp
+    var_name = 'lm_thisyearmax'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., lm_thisyearmax, 'gather', nbp_glo, index_g)
+    IF (ALL(lm_thisyearmax(:,:) == val_exp)) lm_thisyearmax(:,:) = zero
+    !-
+    maxfpc_lastyear(:,:) = val_exp
+    var_name = 'maxfpc_lastyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxfpc_lastyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxfpc_lastyear(:,:) == val_exp)) maxfpc_lastyear(:,:) = zero
+    !-
+    maxfpc_thisyear(:,:) = val_exp
+    var_name = 'maxfpc_thisyear'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., maxfpc_thisyear, 'gather', nbp_glo, index_g)
+    IF (ALL(maxfpc_thisyear(:,:) == val_exp)) maxfpc_thisyear(:,:) = zero
+    !-
+    turnover_time(:,:) = val_exp
+    var_name = 'turnover_time'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., turnover_time, 'gather', nbp_glo, index_g)
+    IF ( ALL( turnover_time(:,:) == val_exp)) turnover_time(:,:) = 100.
+    !-
+    turnover_longterm(:,:,:,:) = val_exp
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF ( k < 10 ) part_str(1:1) = '0'
+          var_name = 'turnover_longterm_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               &              .TRUE., turnover_longterm(:,:,k,l), 'gather', nbp_glo, index_g)
+          IF (ALL(turnover_longterm(:,:,k,l) == val_exp)) &
+               &       turnover_longterm(:,:,k,l) = zero
+       ENDDO
+    END DO
+    !-
+    gpp_week(:,:) = val_exp
+    var_name = 'gpp_week'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., gpp_week, 'gather', nbp_glo, index_g)
+    IF (ALL(gpp_week(:,:) == val_exp)) gpp_week(:,:) = zero
+    !-
+    biomass(:,:,:,:) = val_exp
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF ( k < 10 ) part_str(1:1) = '0'
+          var_name = 'biomass_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               &                   .TRUE., biomass(:,:,k,l), 'gather', nbp_glo, index_g)
+          IF (ALL(biomass(:,:,k,l) == val_exp)) biomass(:,:,k,l) = zero
+       ENDDO
+    END DO
+    !-
+    resp_maint_part(:,:,:) = val_exp
+    DO k=1,nparts
+       WRITE(part_str,'(I2)') k
+       IF ( k < 10 ) part_str(1:1) = '0'
+       var_name = 'maint_resp_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., resp_maint_part(:,:,k), 'gather', nbp_glo, index_g)
+       IF (ALL(resp_maint_part(:,:,k) == val_exp)) resp_maint_part(:,:,k) = zero
+    ENDDO
+    !-
+    leaf_age(:,:,:) = val_exp
+    DO m=1,nleafages
+       WRITE (part_str,'(I2)') m
+       IF ( m < 10 ) part_str(1:1) = '0'
+       var_name = 'leaf_age_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., leaf_age(:,:,m), 'gather', nbp_glo, index_g)
+       IF (ALL(leaf_age(:,:,m) == val_exp)) leaf_age(:,:,m) = zero
+    ENDDO
+    !-
+    leaf_frac(:,:,:) = val_exp
+    DO m=1,nleafages
+       WRITE(part_str,'(I2)') m
+       IF ( m < 10 ) part_str(1:1) = '0'
+       var_name = 'leaf_frac_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                  .TRUE., leaf_frac(:,:,m), 'gather', nbp_glo, index_g)
+       IF (ALL(leaf_frac(:,:,m) == val_exp)) leaf_frac(:,:,m) = zero
+    ENDDO
+    !-
+    senescence_real(:,:) = val_exp
+    var_name = 'senescence'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., senescence_real, 'gather', nbp_glo, index_g)
+    IF (ALL(senescence_real(:,:) == val_exp)) senescence_real(:,:) = zero
+    WHERE ( senescence_real(:,:) >= .5 )
+       senescence = .TRUE.
+    ELSEWHERE
+       senescence = .FALSE.
+    ENDWHERE
+    !-
+    when_growthinit(:,:) = val_exp
+    var_name = 'when_growthinit'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., when_growthinit, 'gather', nbp_glo, index_g)
+    IF (ALL(when_growthinit(:,:) == val_exp)) &
+         &     when_growthinit(:,:) = zero
+    !-
+    age(:,:) = val_exp
+    var_name = 'age'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., age, 'gather', nbp_glo, index_g)
+    IF (ALL(age(:,:) == val_exp)) age(:,:) = zero
+    !-
+    ! 13 CO2
+    !-
+    resp_hetero(:,:) = val_exp
+    var_name = 'resp_hetero'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                .TRUE., resp_hetero, 'gather', nbp_glo, index_g)
+    IF (ALL(resp_hetero(:,:) == val_exp)) resp_hetero(:,:) = zero
+    !-
+    resp_maint(:,:) = val_exp
+    var_name = 'resp_maint'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., resp_maint, 'gather', nbp_glo, index_g)
+    IF (ALL(resp_maint(:,:) == val_exp)) resp_maint(:,:) = zero
+    !-
+    resp_growth(:,:) = val_exp
+    var_name = 'resp_growth'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., resp_growth, 'gather', nbp_glo, index_g)
+    IF (ALL(resp_growth(:,:) == val_exp)) resp_growth(:,:) = zero
+    !-
+    co2_fire(:,:) = val_exp
+    var_name = 'co2_fire'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &                .TRUE., co2_fire, 'gather', nbp_glo, index_g)
+    IF (ALL(co2_fire(:,:) == val_exp)) co2_fire(:,:) = zero
+    !-
+    co2_to_bm_dgvm(:,:) = val_exp
+    var_name = 'co2_to_bm_dgvm'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &                .TRUE., co2_to_bm_dgvm, 'gather', nbp_glo, index_g)
+    IF (ALL(co2_to_bm_dgvm(:,:) == val_exp)) co2_to_bm_dgvm(:,:) = zero
+    !-
+    ! 14 vegetation distribution after last light competition
+    !-
+    veget_lastlight(:,:) = val_exp
+    var_name = 'veget_lastlight'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., veget_lastlight, 'gather', nbp_glo, index_g)
+    IF (ALL(veget_lastlight(:,:) == val_exp)) veget_lastlight(:,:) = zero
+    !-
+    ! 15 establishment criteria
+    !-
+    everywhere(:,:) = val_exp
+    var_name = 'everywhere'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., everywhere, 'gather', nbp_glo, index_g)
+    IF (ALL(everywhere(:,:) == val_exp)) everywhere(:,:) = zero
+    !-
+    need_adjacent_real(:,:) = val_exp
+    var_name = 'need_adjacent'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., need_adjacent_real, 'gather', nbp_glo, index_g)
+    IF (ALL(need_adjacent_real(:,:) == val_exp)) &
+         &     need_adjacent_real(:,:) = zero
+    WHERE ( need_adjacent_real(:,:) >= .5 )
+       need_adjacent = .TRUE.
+    ELSEWHERE
+       need_adjacent = .FALSE.
+    ENDWHERE
+    !-
+    RIP_time(:,:) = val_exp
+    var_name = 'RIP_time'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                .TRUE., RIP_time, 'gather', nbp_glo, index_g)
+    IF (ALL(RIP_time(:,:) == val_exp)) RIP_time(:,:) = large_value
+    !-
+    ! 16 black carbon
+    !-
+    black_carbon(:) = val_exp
+    var_name = 'black_carbon'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &                .TRUE., black_carbon, 'gather', nbp_glo, index_g)
+    IF (ALL(black_carbon(:) == val_exp)) black_carbon(:) = zero
+    !-
+    ! 17 litter
+    !-
+    litterpart(:,:,:) = val_exp
+    DO l=1,nlitt
+       var_name = 'litterpart_'//litter_str(l)
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., litterpart(:,:,l), 'gather', nbp_glo, index_g)
+       IF (ALL(litterpart(:,:,l) == val_exp)) litterpart(:,:,l) = zero
+    ENDDO
+    !-
+    litter_above(:,:,:,:) = val_exp
+    DO k = 1,nelements 
+        DO m = 1,nvm 
+            WRITE (part_str, '(I2)') m 
+            IF (m<10) part_str(1:1)='0' 
+            var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_above'//element_str(k) 
+            CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, & 
+                 &                     .TRUE., litter_above(:,:,m,k), 'gather', nbp_glo, index_g) 
+           IF (ALL(litter_above(:,:,m,k) == val_exp)) litter_above(:,:,m,k) = zero 
+        ENDDO 
+  END DO 
+    !- 
+    litter_below(:,:,:,:,:) = val_exp
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z01'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,1,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,1,k) == val_exp)) litter_below(:,:,m,1,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z02'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,2,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,2,k) == val_exp)) litter_below(:,:,m,2,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z03'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,3,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,3,k) == val_exp)) litter_below(:,:,m,3,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z04'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,4,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,4,k) == val_exp)) litter_below(:,:,m,4,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z05'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,5,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,5,k) == val_exp)) litter_below(:,:,m,5,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z06'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,6,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,6,k) == val_exp)) litter_below(:,:,m,6,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z07'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,7,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,7,k) == val_exp)) litter_below(:,:,m,7,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z08'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,8,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,8,k) == val_exp)) litter_below(:,:,m,8,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z09'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,9,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,9,k) == val_exp)) litter_below(:,:,m,9,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z10'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,10,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,10,k) == val_exp)) litter_below(:,:,m,10,k) = zero
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z11'//element_str(k)
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+                  &                     .TRUE., litter_below(:,:,m,11,k), 'gather', nbp_glo, index_g)
+             IF (ALL(litter_below(:,:,m,11,k) == val_exp)) litter_below(:,:,m,11,k) = zero
+          ENDDO
+    END DO
+    !-
+    dead_leaves(:,:,:) = val_exp
+    DO l=1,nlitt
+       var_name = 'dead_leaves_'//litter_str(l)
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., dead_leaves(:,:,l), 'gather', nbp_glo, index_g)
+       IF (ALL(dead_leaves(:,:,l) == val_exp)) dead_leaves(:,:,l) = zero
+    ENDDO
+    !-
+   carbon(:,:,:,:) = val_exp
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z01_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,1), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,1) == val_exp)) carbon(:,:,m,1) = zero
+    ENDDO
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z02_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,2), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,2) == val_exp)) carbon(:,:,m,2) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z03_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,3), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,3) == val_exp)) carbon(:,:,m,3) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z04_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,4), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,4) == val_exp)) carbon(:,:,m,4) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z05_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,5), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,5) == val_exp)) carbon(:,:,m,5) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z06_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,6), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,6) == val_exp)) carbon(:,:,m,6) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z07_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,7), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,7) == val_exp)) carbon(:,:,m,7) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z08_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,8), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,8) == val_exp)) carbon(:,:,m,8) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z09_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,9), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,9) == val_exp)) carbon(:,:,m,9) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z10_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,10), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,10) == val_exp)) carbon(:,:,m,10) = zero
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z11_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+              &                   .TRUE., carbon(:,:,m,11), 'gather', nbp_glo, index_g)
+         IF (ALL(carbon(:,:,m,11) == val_exp)) carbon(:,:,m,11) = zero
+    ENDDO
+
+ DOC(:,:,:,:,:,:) = val_exp
+     DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z1_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,1,ifree,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,1,ifree,m,icarbon)== val_exp))DOC(:,:,1,ifree,m,icarbon) = zero
+
+         var_name = 'freedoc_z2_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,2,ifree,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,2,ifree,m,icarbon)== val_exp))DOC(:,:,2,ifree,m,icarbon) = zero
+
+         var_name = 'freedoc_z3_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,3,ifree,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,3,ifree,m,icarbon)== val_exp))DOC(:,:,3,ifree,m,icarbon) = zero
+
+         var_name = 'freedoc_z4_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,4,ifree,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,4,ifree,m,icarbon)== val_exp))DOC(:,:,4,ifree,m,icarbon) = zero
+
+         var_name = 'freedoc_z5_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,5,ifree,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,5,ifree,m,icarbon)== val_exp))DOC(:,:,5,ifree,m,icarbon) = zero
+
+         var_name = 'freedoc_z6_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,6,ifree,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,6,ifree,m,icarbon)== val_exp))DOC(:,:,6,ifree,m,icarbon) = zero
+
+         var_name = 'freedoc_z7_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,7,ifree,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,7,ifree,m,icarbon)== val_exp))DOC(:,:,7,ifree,m,icarbon) = zero
+
+         var_name = 'freedoc_z8_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,8,ifree,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,8,ifree,m,icarbon)== val_exp))DOC(:,:,8,ifree,m,icarbon) = zero
+
+         var_name = 'freedoc_z9_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,9,ifree,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,9,ifree,m,icarbon)== val_exp))DOC(:,:,9,ifree,m,icarbon) = zero
+
+         var_name = 'freedoc_z10_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,10,ifree,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,10,ifree,m,icarbon)== val_exp))DOC(:,:,10,ifree,m,icarbon) = zero
+
+         var_name = 'freedoc_z11_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,11,ifree,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,11,ifree,m,icarbon)== val_exp))DOC(:,:,11,ifree,m,icarbon) = zero
+
+         var_name = 'adsdoc_z1_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,1,iadsorbed,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,1,iadsorbed,m,icarbon)== val_exp))DOC(:,:,1,iadsorbed,m,icarbon) = zero
+
+         var_name = 'adsdoc_z2_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,2,iadsorbed,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,2,iadsorbed,m,icarbon)== val_exp))DOC(:,:,2,iadsorbed,m,icarbon) = zero
+
+         var_name = 'adsdoc_z3_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,3,iadsorbed,m,icarbon),'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,3,iadsorbed,m,icarbon)== val_exp))DOC(:,:,3,iadsorbed,m,icarbon) = zero
+
+         var_name = 'adsdoc_z4_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,4,iadsorbed,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,4,iadsorbed,m,icarbon)== val_exp))DOC(:,:,4,iadsorbed,m,icarbon) = zero
+
+         var_name = 'adsdoc_z5_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,5,iadsorbed,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,5,iadsorbed,m,icarbon)== val_exp))DOC(:,:,5,iadsorbed,m,icarbon) = zero
+
+         var_name = 'adsdoc_z6_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,6,iadsorbed,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,6,iadsorbed,m,icarbon)== val_exp))DOC(:,:,6,iadsorbed,m,icarbon) = zero
+
+         var_name = 'adsdoc_z7_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,7,iadsorbed,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,7,iadsorbed,m,icarbon)== val_exp))DOC(:,:,7,iadsorbed,m,icarbon) = zero
+
+         var_name = 'adsdoc_z8_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,8,iadsorbed,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,8,iadsorbed,m,icarbon)== val_exp))DOC(:,:,8,iadsorbed,m,icarbon) = zero
+
+         var_name = 'adsdoc_z9_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,9,iadsorbed,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,9,iadsorbed,m,icarbon)== val_exp))DOC(:,:,9,iadsorbed,m,icarbon) = zero
+
+         var_name = 'adsdoc_z10_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,10,iadsorbed,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,10,iadsorbed,m,icarbon)== val_exp))DOC(:,:,10,iadsorbed,m,icarbon) = zero
+
+         var_name = 'adsdoc_z11_'//part_str(1:LEN_TRIM(part_str))
+         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              &                   .TRUE., DOC(:,:,11,iadsorbed,m,icarbon), 'gather', nbp_glo, index_g)
+         IF (ALL(DOC(:,:,11,iadsorbed,m,icarbon)== val_exp))DOC(:,:,11,iadsorbed,m,icarbon) = zero
+     ENDDO
+
+!        DOC_EXP(:,:,:,:) = val_exp
+!         var_name = 'exp_doc_run'
+!         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+!              &                   .TRUE., DOC_EXP(:,:,irunoff,icarbon), 'gather', nbp_glo, index_g)
+!         IF (ALL(DOC_EXP(:,:,irunoff,icarbon)== val_exp))DOC_EXP(:,:,irunoff,icarbon) = zero
+!         var_name = 'exp_doc_flo'
+!         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+!              &                   .TRUE., DOC_EXP(:,:,iflooded,icarbon), 'gather', nbp_glo, index_g)
+!         IF (ALL(DOC_EXP(:,:,iflooded,icarbon)== val_exp))DOC_EXP(:,:,iflooded,icarbon) = zero
+!         var_name = 'exp_doc_dra'
+!         CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+!              &                   .TRUE., DOC_EXP(:,:,idrainage,icarbon), 'gather', nbp_glo, index_g)
+!         IF (ALL(DOC_EXP(:,:,idrainage,icarbon)== val_exp))DOC_EXP(:,:,idrainage,icarbon) = zero
+
+    !-
+    lignin_struc_above(:,:) = val_exp
+       var_name = 'lignin_struc_above'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_above(:,:), 'gather', nbp_glo, index_g) 
+       IF (ALL(lignin_struc_above(:,:) == val_exp)) lignin_struc_above(:,:) = zero 
+    !- 
+    lignin_struc_below(:,:,:) = val_exp
+       var_name = 'lig_struc_be_z01'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,1), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,1) == val_exp)) lignin_struc_below(:,:,1) = zero
+
+       var_name = 'lig_struc_be_z02'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,2), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,2) == val_exp)) lignin_struc_below(:,:,2) = zero
+
+       var_name = 'lig_struc_be_z03'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,3), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,3) == val_exp)) lignin_struc_below(:,:,3) = zero
+
+       var_name = 'lig_struc_be_z04'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,4), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,4) == val_exp)) lignin_struc_below(:,:,4) = zero
+    !-
+       var_name = 'lig_struc_be_z05'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,5), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,5) == val_exp)) lignin_struc_below(:,:,5) = zero
+
+       var_name = 'lig_struc_be_z06'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,6), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,6) == val_exp)) lignin_struc_below(:,:,6) = zero
+
+       var_name = 'lig_struc_be_z07'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,7), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,7) == val_exp)) lignin_struc_below(:,:,7) = zero
+
+       var_name = 'lig_struc_be_z08'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,8), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,8) == val_exp)) lignin_struc_below(:,:,8) = zero
+
+       var_name = 'lig_struc_be_z09'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,9), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,9) == val_exp)) lignin_struc_below(:,:,9) = zero
+
+       var_name = 'lig_struc_be_z10'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,10), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,10) == val_exp)) lignin_struc_below(:,:,10) = zero
+
+       var_name = 'lig_struc_be_z11'
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc_below(:,:,11), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc_below(:,:,11) == val_exp)) lignin_struc_below(:,:,11) = zero
+
+    !-
+    ! 18 land cover change
+    !-
+    prod10(:,:) = val_exp
+    var_name = 'prod10'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 11     , 1, itime, &
+         &                .TRUE., prod10, 'gather', nbp_glo, index_g)
+    IF (ALL(prod10(:,:) == val_exp)) prod10(:,:) = zero
+
+    prod100(:,:) = val_exp
+    var_name = 'prod100'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 101     , 1, itime, &
+         &                .TRUE., prod100, 'gather', nbp_glo, index_g)
+    IF (ALL(prod100(:,:) == val_exp)) prod100(:,:) = zero
+
+
+    flux10(:,:) = val_exp
+    var_name = 'flux10'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 10     , 1, itime, &
+         &                .TRUE., flux10, 'gather', nbp_glo, index_g)
+    IF (ALL(flux10(:,:) == val_exp)) flux10(:,:) = zero
+
+    flux100(:,:) = val_exp
+    var_name = 'flux100'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 100     , 1, itime, &
+         &                .TRUE., flux100, 'gather', nbp_glo, index_g)
+    IF (ALL(flux100(:,:) == val_exp)) flux100(:,:) = zero
+
+    convflux(:) = val_exp
+    var_name = 'convflux'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., convflux, 'gather', nbp_glo, index_g)
+    IF (ALL(convflux(:) == val_exp)) convflux(:) = zero
+
+    cflux_prod10(:) = val_exp
+    var_name = 'cflux_prod10'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., cflux_prod10, 'gather', nbp_glo, index_g)
+    IF (ALL(cflux_prod10(:) == val_exp)) cflux_prod10(:) = zero
+
+    cflux_prod100(:) = val_exp
+    var_name = 'cflux_prod100'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., cflux_prod100, 'gather', nbp_glo, index_g)
+    IF (ALL(cflux_prod100(:) == val_exp)) cflux_prod100(:) = zero
+
+    bm_to_litter(:,:,:,:) = val_exp
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF ( k < 10 ) part_str(1:1) = '0'
+          var_name = 'bm_to_litter_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+               &                .TRUE., bm_to_litter(:,:,k,l), 'gather', nbp_glo, index_g)
+          IF (ALL(bm_to_litter(:,:,k,l) == val_exp)) bm_to_litter(:,:,k,l) = zero
+       ENDDO
+    END DO
+
+    carb_mass_total(:) = val_exp
+    var_name = 'carb_mass_total'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., carb_mass_total, 'gather', nbp_glo, index_g)
+    IF (ALL(carb_mass_total(:) == val_exp)) carb_mass_total(:) = zero
+    !-
+    ! 19. Spinup
+    !-
+    IF (spinup_analytic) THEN
+
+       IF (is_root_prc) THEN
+          temp_global_years(1) = val_exp
+          var_name = 'Global_years'
+          CALL restget (rest_id_stomate, var_name, 1 ,1  , 1, itime, &
+               &                .TRUE., temp_global_years)
+          IF(temp_global_years(1) == val_exp) temp_global_years(1) = zero
+          global_years = INT(temp_global_years(1))
+       ENDIF
+       CALL bcast(global_years)
+
+       nbp_accu(:) = val_exp
+       var_name = 'nbp_sum'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            &              .TRUE., nbp_accu, 'gather', nbp_glo, index_g)
+       IF (ALL(nbp_accu(:) == val_exp)) nbp_accu(:) = zero    
+
+       nbp_flux(:) = val_exp
+       var_name = 'nbp_flux'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+            &              .TRUE., nbp_flux, 'gather', nbp_glo, index_g)
+       IF (ALL(nbp_flux(:) == val_exp)) nbp_flux(:) = zero     
+
+       !-
+       ok_equilibrium_real(:) = val_exp
+       var_name = 'ok_equilibrium'
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo , 1  , 1, itime, &
+            &                .TRUE., ok_equilibrium_real,'gather', nbp_glo, index_g)
+       IF (ALL(ok_equilibrium_real(:) == val_exp)) ok_equilibrium_real(:) = zero
+       WHERE(ok_equilibrium_real(:) >= 0.5) 
+          ok_equilibrium = .TRUE.
+       ELSEWHERE
+          ok_equilibrium = .FALSE.
+       ENDWHERE
+
+       MatrixV(:,:,:,:) = val_exp
+       DO k = 1,nbpools
+          DO j = 1,nbpools
+             WRITE(part_str,'(I2)') k
+             IF (k < 10) part_str(1:1) = '0'             
+             var_name = 'MatV_'//part_str(1:LEN_TRIM(part_str))//'_'//TRIM(pools_str(j))
+             CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+                  &                     .TRUE., MatrixV(:,:,k,j), 'gather', nbp_glo, index_g)
+          ENDDO
+       ENDDO
+       ! If nothing is found in the restart file, we initialize each submatrix by identity
+       IF (ALL(MatrixV(:,:,:,:) == val_exp))  THEN 
+          MatrixV(:,:,:,:) = zero
+          DO l = 1,nbpools
+             MatrixV(:,:,l,l) = un
+          END DO
+       END IF
+
+       VectorU(:,:,:)  = val_exp
+       DO k= 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0' 
+          var_name = 'Vector_U_'//part_str(1:LEN_TRIM(part_str))
+          CALL restget_p &
+               &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &     .TRUE., VectorU(:,:,k), 'gather', nbp_glo, index_g)
+          IF (ALL(VectorU(:,:,k) == val_exp))  VectorU(:,:,k) = zero
+       ENDDO
+       
+       previous_stock(:,:,:)  = val_exp
+       DO k= 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0' 
+          var_name = 'previous_stock_'//part_str(1:LEN_TRIM(part_str))
+          CALL restget_p &
+               &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &     .TRUE., previous_stock(:,:,k), 'gather', nbp_glo, index_g)
+          IF (ALL(previous_stock(:,:,k) == val_exp))  previous_stock(:,:,k) = undef_sechiba
+       ENDDO
+       
+       current_stock(:,:,:)  = val_exp
+       DO k= 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0' 
+          var_name = 'current_stock_'//part_str(1:LEN_TRIM(part_str))
+          CALL restget_p &
+               &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &     .TRUE., current_stock(:,:,k), 'gather', nbp_glo, index_g)
+          IF (ALL(current_stock(:,:,k) == val_exp))  current_stock(:,:,k) = zero
+       ENDDO
+          
+    ENDIF ! spinup_matrix_method
+
+    IF (bavard >= 4) WRITE(numout,*) 'Leaving readstart'
+    !-----------------------
+  END SUBROUTINE readstart
+  !-
+  !===
+  !-
+  SUBROUTINE writerestart &
+       & (npts, index, day_counter, dt_days, date, &
+       &  ind, adapted, regenerate, moiavail_daily, gdd_init_date, litterhum_daily, &
+       &  t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
+       &  soilhum_daily, precip_daily, gpp_daily, npp_daily, &
+       &  turnover_daily, moiavail_month, moiavail_week, &
+       &  t2m_longterm, tlong_ref, t2m_month, t2m_week, &
+       &  tsoil_month, soilhum_month, fireindex, firelitter, &
+       &  maxmoiavail_lastyear, maxmoiavail_thisyear, &
+       &  minmoiavail_lastyear, minmoiavail_thisyear, &
+       &  maxgppweek_lastyear, maxgppweek_thisyear, &
+       &  gdd0_lastyear, gdd0_thisyear, precip_lastyear, precip_thisyear, &
+       &  gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       &  PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
+       &  maxfpc_lastyear, maxfpc_thisyear, &
+       &  turnover_longterm, gpp_week, biomass, resp_maint_part, &
+       &  leaf_age, leaf_frac, senescence, when_growthinit, age, &
+       &  resp_hetero, resp_maint, resp_growth, co2_fire, co2_to_bm_dgvm, &
+       &  veget_lastlight, everywhere, need_adjacent, RIP_time, &
+       &  time_hum_min, hum_min_dormance, &
+       &  litterpart, litter_above, litter_below, dead_leaves, &
+       &  carbon, DOC, DOC_EXP, black_carbon, lignin_struc_above, lignin_struc_below, turnover_time, &
+       &  prod10,prod100 ,flux10, flux100, &
+       &  convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total, &
+       &  global_years, ok_equilibrium, nbp_accu, nbp_flux, &
+       &  MatrixV, VectorU, previous_stock, current_stock)
+
+    !---------------------------------------------------------------------
+    !- write restart file
+    !---------------------------------------------------------------------
+    !-
+    ! 0 declarations
+    !-
+    ! 0.1 input
+    !-
+    ! Domain size
+    INTEGER(i_std),INTENT(in) :: npts
+    ! Indices of the points on the map
+    INTEGER(i_std),DIMENSION(npts),INTENT(in) :: index
+    ! counts time until next STOMATE time step
+    REAL(r_std),INTENT(in) :: day_counter
+    ! time step of STOMATE in days
+    REAL(r_std),INTENT(in) :: dt_days
+    ! date (d)
+    INTEGER(i_std),INTENT(in) :: date
+    ! density of individuals (1/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ind
+    ! Winter too cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: adapted
+    ! Winter sufficiently cold? between 0 and 1
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: regenerate
+    ! daily moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_daily
+    ! gdd init date
+    REAL(r_std),DIMENSION(npts,2),INTENT(in) :: gdd_init_date
+    ! daily litter humidity
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: litterhum_daily
+    ! daily 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_daily
+    ! daily minimum 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_min_daily
+    ! daily surface temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: tsurf_daily
+    ! daily soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: tsoil_daily
+    ! daily soil humidity
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: soilhum_daily
+    ! daily precipitations (mm/day) (for phenology)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_daily
+    ! daily gross primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gpp_daily
+    ! daily net primary productivity (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: npp_daily
+    ! daily turnover rates (gC/m**2/day)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: turnover_daily
+    ! "monthly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_month
+    ! "weekly" moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_week
+    ! "long term" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_longterm
+    ! "long term" reference 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: tlong_ref
+    ! "monthly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_month
+    ! "weekly" 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_week
+    ! "monthly" soil temperatures (K)
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: tsoil_month
+    ! "monthly" soil humidity
+    REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: soilhum_month
+    ! Probability of fire
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: fireindex
+    ! Longer term total litter above the ground, gC/m**2 of ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: firelitter
+    ! last year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxmoiavail_lastyear
+    ! this year's maximum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxmoiavail_thisyear
+    ! last year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: minmoiavail_lastyear
+    ! this year's minimum moisture availability
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: minmoiavail_thisyear
+    ! last year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxgppweek_lastyear
+    ! this year's maximum weekly GPP
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxgppweek_thisyear
+    ! last year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: gdd0_lastyear
+    ! this year's annual GDD0
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: gdd0_thisyear
+    ! last year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_lastyear
+    ! this year's annual precipitation (mm/year)
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_thisyear
+    ! growing degree days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_m5_dormance
+    ! growing degree days, from begin of season (crops)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_from_growthinit
+    ! growing degree days since midwinter (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_midwinter
+    ! number of chilling days since leaves were lost (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ncd_dormance
+    ! number of growing days, threshold -5 deg C (for phenology)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ngd_minus5
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: PFTpresent
+    ! "long term" net primary productivity (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: npp_longterm
+    ! last year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: lm_lastyearmax
+    ! this year's maximum leaf mass, for each PFT (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: lm_thisyearmax
+    ! last year's maximum fpc for each natural PFT, on ground
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxfpc_lastyear
+    ! this year's maximum fpc for each PFT,
+    ! on *total* ground (see stomate_season)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxfpc_thisyear
+    ! "long term" turnover rate (gC/m**2/year)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: turnover_longterm
+    ! "weekly" GPP (gC/day/(m**2 covered)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gpp_week
+    ! biomass (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: biomass
+    ! maintenance respiration (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(in) :: resp_maint_part
+    ! leaf age (days)
+    REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(in) :: leaf_age
+    ! fraction of leaves in leaf age class
+    REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(in) :: leaf_frac
+    ! is the plant senescent ?
+    ! (only for deciduous trees - carbohydrate reserve)
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: senescence
+    ! how many days ago was the beginning of the growing season
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: when_growthinit
+    ! mean age (years)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: age
+    ! heterotrophic respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: resp_hetero
+    ! maintenance respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: resp_maint
+    ! growth respiration (gC/day/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: resp_growth
+    ! carbon emitted into the atmosphere by fire (living and dead biomass)
+    ! (in gC/m**2/time step)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: co2_fire
+    ! biomass uptaken (gC/(m**2 of total ground)/day)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: co2_to_bm_dgvm
+    ! vegetation fractions (on ground) after last light competition
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: veget_lastlight
+    ! is the PFT everywhere in the grid box or very localized
+    ! (after its introduction)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: everywhere
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box?
+    LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: need_adjacent
+    ! How much time ago was the PFT eliminated for the last time (y)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: RIP_time
+    ! time elapsed since strongest moisture availability (d)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: time_hum_min
+    ! minimum moisture during dormance
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: hum_min_dormance
+    ! fraction of litter above the ground belonging to different PFTs
+    REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(in) :: litterpart
+    ! metabolic and structural litter, above ground (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nelements),INTENT(in) :: litter_above
+    ! metabolic and structural litter, below ground (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nbdl,nelements),INTENT(in) :: litter_below
+    ! dead leaves on ground, per PFT, metabolic and structural,
+    ! in gC/(m**2 of ground)
+    REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(in) :: dead_leaves
+    ! carbon pool: active, slow, or passive, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,ncarb,nvm,nbdl),INTENT(in) :: carbon
+    ! exported dissoled organic carbon in soils (gC/m**3 of water/dt)
+    REAL(r_std),DIMENSION(npts,nvm,nexp,nelements),INTENT(out) :: DOC_EXP
+    ! dissoled organic carbon in soils: free or adsrobed (gC/m**2 of ground)
+    REAL(r_std),DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements),INTENT(out) :: DOC
+    ! black carbon on the ground (gC/(m**2 of total ground))
+    REAL(r_std),DIMENSION(npts),INTENT(in) :: black_carbon
+    ! ratio Lignine/Carbon in structural litter, above ground, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: lignin_struc_above
+    ! ratio Lignine/Carbon in structural litter, below ground, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nbdl),INTENT(in) :: lignin_struc_below
+
+    ! turnover_time of leaves
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: turnover_time
+
+    ! For Spinup matrix resolution
+    INTEGER(i_std), INTENT(in) :: global_years   
+    LOGICAL, DIMENSION(npts), INTENT(in) :: ok_equilibrium
+    REAL(r_std), DIMENSION(npts), INTENT(in) :: nbp_accu  !! Accumulated Net Biospheric Production over the year 
+    REAL(r_std), DIMENSION(npts), INTENT(in) :: nbp_flux  !! Net Biospheric Production over the year 
+    !-
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(in) :: MatrixV
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: VectorU
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: previous_stock
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: current_stock 
+
+    !-
+    ! 0.2 local
+    !-
+    ! date, real
+    REAL(r_std) :: date_real
+    ! PFT exists (equivalent to fpc_max > 0 for natural PFTs), real
+    REAL(r_std),DIMENSION(npts,nvm) :: PFTpresent_real
+    ! is the plant senescent ?
+    ! (only for deciduous trees - carbohydrate reserve), real
+    REAL(r_std),DIMENSION(npts,nvm) :: senescence_real
+    ! in order for this PFT to be introduced,
+    ! does it have to be present in an adjacent grid box? - real
+    REAL(r_std),DIMENSION(npts,nvm) :: need_adjacent_real
+    ! To store variables names for I/O
+    CHARACTER(LEN=80) :: var_name
+    ! string suffix indicating an index
+    CHARACTER(LEN=10) :: part_str
+    ! string suffix indicating litter type
+    CHARACTER(LEN=3),DIMENSION(nlitt) :: litter_str
+    ! temporary storage
+    REAL(r_std),DIMENSION(1) :: xtmp
+    ! index
+    INTEGER(i_std) :: j,k,l,m
+    CHARACTER(LEN=1),DIMENSION(nelements) :: element_str  !! string suffix indicating element
+    REAL(r_std), DIMENSION(1) :: temp_global_years
+    CHARACTER(LEN=10),DIMENSION(nbpools) :: pools_str
+    REAL(r_std), DIMENSION(npts) :: ok_equilibrium_real    
+
+    ! land cover change variables 
+    ! products remaining in the 10/100 year-turnover pool after the annual release for each compartment
+    ! (10 or 100 + 1 : input from year of land cover change)
+    REAL(r_std),DIMENSION(npts,0:10),INTENT(in)                           :: prod10
+    REAL(r_std),DIMENSION(npts,0:100),INTENT(in)                          :: prod100
+    ! annual release from the 10/100 year-turnover pool compartments
+    REAL(r_std),DIMENSION(npts,10),INTENT(in)                           :: flux10
+    REAL(r_std),DIMENSION(npts,100),INTENT(in)                          :: flux100
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: convflux
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: cflux_prod10
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: cflux_prod100
+    REAL(r_std),DIMENSION(npts,nvm,nparts,nelements),INTENT(in)         :: bm_to_litter
+    REAL(r_std),DIMENSION(npts),INTENT(in)                              :: carb_mass_total
+    !---------------------------------------------------------------------
+    IF (bavard >= 3) WRITE(numout,*) 'Entering writerestart'
+    !-
+    ! 1 string definitions
+    !-
+    DO l=1,nlitt
+       IF     (l == imetabolic) THEN
+          litter_str(l) = 'met'
+       ELSEIF (l == istructural) THEN
+          litter_str(l) = 'str'
+       ELSE
+          STOP 'Define litter_str'
+       ENDIF
+    ENDDO
+    !-
+    DO l=1,nelements
+       IF     (l == icarbon) THEN
+          element_str(l) = ''
+!!$       ELSEIF (l == initrogen) THEN
+!!$          element_str(l) = '_n'
+       ELSE
+          STOP 'Define element_str'
+       ENDIF
+    ENDDO
+    !-
+    pools_str(1:nbpools) =(/'str_ab    ',&
+                            'strbe_z1  ','strbe_z2  ','strbe_z3  ','strbe_z4  ','strbe_z5  ','strbe_z6  ',&
+                            'strbe_z7  ','strbe_z8  ','strbe_z9  ','strbe_z10 ','strbe_z11 ',&
+                            'met_ab    ',&
+                            'metbe_z1  ','metbe_z2  ','metbe_z3  ','metbe_z4  ','metbe_z5  ','metbe_z6  ',&
+                            'metbe_z7  ','metbe_z8  ','metbe_z9  ','metbe_z10 ','metbe_z11 ',&
+                            'act_z1    ','act_z2    ','act_z3    ','act_z4    ','act_z5    ',&
+                            'act_z6    ','act_z7    ','act_z8    ','act_z9    ','act_z10   ','act_z11   ',&
+                            'slow_z1   ','slow_z2   ','slow_z3   ','slow_z4   ','slow_z5   ','slow_z6   ',&
+                            'slow_z7   ','slow_z8   ','slow_z9   ','slow_z10  ','slow_z11  ',&
+                            'pas_z1    ','pas_z2    ','pas_z3    ','pas_z4    ','pas_z5    ','pas_z6    ',&
+                            'pas_z7    ','pas_z8    ','pas_z9    ','pas_z10   ','pas_z11   ',&
+                            'free_z1_1 ','free_z2_1 ','free_z3_1 ','free_z4_1 ','free_z5_1 ','free_z6_1 ',&
+                            'free_z7_1 ','free_z8_1 ','free_z9_1 ','free_z10_1','free_z11_1',&
+                            'adso_z1_1 ','adso_z2_1 ','adso_z3_1 ','adso_z4_1 ','adso_z5_1 ','adso_z6_1 ',&
+                            'adso_z7_1 ','adso_z8_1 ','adso_z9_1 ','adso_z10_1','adso_z11_1',&
+                            'free_z1_2 ','free_z2_2 ','free_z3_2 ','free_z4_2 ','free_z5_2 ','free_z6_2 ',&
+                            'free_z7_2 ','free_z8_2 ','free_z9_2 ','free_z10_2','free_z11_2',&
+                            'adso_z1_2 ','adso_z2_2 ','adso_z3_2 ','adso_z4_2 ','adso_z5_2 ','adso_z6_2 ',&
+                            'adso_z7_2 ','adso_z8_2 ','adso_z9_2 ','adso_z10_2','adso_z11_2',&
+                            'free_z1_3 ','free_z2_3 ','free_z3_3 ','free_z4_3 ','free_z5_3 ','free_z6_3 ',&
+                            'free_z7_3 ','free_z8_3 ','free_z9_3 ','free_z10_3','free_z11_3',&
+                            'adso_z1_3 ','adso_z2_3 ','adso_z3_3 ','adso_z4_3 ','adso_z5_3 ','adso_z6_3 ',&
+                            'adso_z7_3 ','adso_z8_3 ','adso_z9_3 ','adso_z10_3','adso_z11_3',&
+                            'free_z1_4 ','free_z2_4 ','free_z3_4 ','free_z4_4 ','free_z5_4 ','free_z6_4 ',&
+                            'free_z7_4 ','free_z8_4 ','free_z9_4 ','free_z10_4','free_z11_4',&
+                            'adso_z1_4 ','adso_z2_4 ','adso_z3_4 ','adso_z4_4 ','adso_z5_4 ','adso_z6_4 ',&
+                            'adso_z7_4 ','adso_z8_4 ','adso_z9_4 ','adso_z10_4','adso_z11_4',&
+                            'free_z1_5 ','free_z2_5 ','free_z3_5 ','free_z4_5 ','free_z5_5 ','free_z6_5 ',&
+                            'free_z7_5 ','free_z8_5 ','free_z9_5 ','free_z10_5','free_z11_5',&
+                            'adso_z1_5 ','adso_z2_5 ','adso_z3_5 ','adso_z4_5 ','adso_z5_5 ','adso_z6_5 ',&
+                            'adso_z7_5 ','adso_z8_5 ','adso_z9_5 ','adso_z10_5','adso_z11_5',&
+                            'free_z1_6 ','free_z2_6 ','free_z3_6 ','free_z4_6 ','free_z5_6 ','free_z6_6 ',&
+                            'free_z7_6 ','free_z8_6 ','free_z9_6 ','free_z10_6','free_z11_6',&
+                            'adso_z1_6 ','adso_z2_6 ','adso_z3_6 ','adso_z4_6 ','adso_z5_6 ','adso_z6_6 ',&
+                            'adso_z7_6 ','adso_z8_6 ','adso_z9_6 ','adso_z10_6','adso_z11_6',&
+                            'free_z1_7 ','free_z2_7 ','free_z3_7 ','free_z4_7 ','free_z5_7 ','free_z6_7 ',&
+                            'free_z7_7 ','free_z8_7 ','free_z9_7 ','free_z10_7','free_z11_7',&
+                            'adso_z1_7 ','adso_z2_7 ','adso_z3_7 ','adso_z4_7 ','adso_z5_7 ','adso_z6_7 ',&
+                            'adso_z7_7 ','adso_z8_7 ','adso_z9_7 ','adso_z10_7','adso_z11_7'/)
+    !-
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt_p ('UNITS','-')
+       CALL ioconf_setatt_p ('LONG_NAME',' ')
+    ENDIF
+    !-
+    ! 2 run control
+    !-
+    ! 2.1 day counter
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'day_counter'
+       xtmp(1) = day_counter
+       CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
+    ENDIF
+    !-
+    ! 2.2 time step of STOMATE in days
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'dt_days'
+       xtmp(1) = dt_days
+       CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
+    ENDIF
+    !-
+    ! 2.3 date
+    !-
+    IF (is_root_prc) THEN
+       var_name = 'date'
+       date_real = REAL(date,r_std)
+       xtmp(1) = date_real
+       CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
+    ENDIF
+    !-
+    ! 3 daily meteorological variables
+    !-
+    var_name = 'moiavail_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                moiavail_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd_init_date'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    2, 1, itime, &
+         &              gdd_init_date, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'litterhum_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                litterhum_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 't2m_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 't2m_min_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_min_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'tsurf_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                tsurf_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'tsoil_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
+         &                tsoil_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'soilhum_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
+         &                soilhum_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'precip_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                precip_daily, 'scatter', nbp_glo, index_g)
+    !-
+    ! 4 productivities
+    !-
+    var_name = 'gpp_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gpp_daily, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'npp_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                npp_daily, 'scatter', nbp_glo, index_g)
+    !-
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'turnover_daily_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                   turnover_daily(:,:,k,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    END DO
+    !-
+    ! 5 monthly meteorological variables
+    !-
+    var_name = 'moiavail_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                moiavail_month, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'moiavail_week'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                moiavail_week, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 't2m_longterm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_longterm, 'scatter', nbp_glo, index_g)
+    !-
+    IF (control%ok_dgvm) THEN
+       var_name = 'tlong_ref'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+            &                tlong_ref, 'scatter', nbp_glo, index_g)
+    ENDIF
+    !-
+    var_name = 't2m_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_month, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 't2m_week'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                t2m_week, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'tsoil_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
+         &                tsoil_month, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'soilhum_month'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
+         &                soilhum_month, 'scatter', nbp_glo, index_g)
+    !-
+    ! 6 fire probability
+    !-
+    var_name = 'fireindex'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                fireindex, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'firelitter'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                firelitter, 'scatter', nbp_glo, index_g)
+    !-
+    ! 7 maximum and minimum moisture availabilities for tropic phenology
+    !-
+    var_name = 'maxmoistr_last'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxmoiavail_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxmoistr_this'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxmoiavail_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'minmoistr_last'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                minmoiavail_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'minmoistr_this'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                minmoiavail_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 8 maximum "weekly" GPP
+    !-
+    var_name = 'maxgppweek_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxgppweek_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxgppweek_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxgppweek_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 9 annual GDD0
+    !-
+    var_name = 'gdd0_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                gdd0_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd0_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                gdd0_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 10 annual precipitation
+    !-
+    var_name = 'precip_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                precip_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'precip_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &                precip_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    ! 11 derived "biometeorological" variables
+    !-
+    var_name = 'gdd_m5_dormance'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gdd_m5_dormance, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd_from_growthinit'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &              gdd_from_growthinit, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'gdd_midwinter'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gdd_midwinter, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'ncd_dormance'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                ncd_dormance, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'ngd_minus5'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                ngd_minus5, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'time_hum_min'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                time_hum_min, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'hum_min_dormance'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                hum_min_dormance, 'scatter', nbp_glo, index_g)
+    !-
+    ! 12 Plant status
+    !-
+    var_name = 'PFTpresent'
+    WHERE ( PFTpresent(:,:) )
+       PFTpresent_real = un
+    ELSEWHERE
+       PFTpresent_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                PFTpresent_real, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'ind'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                ind, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'turnover_time'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                turnover_time, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'adapted'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                adapted, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'regenerate'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                regenerate, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'npp_longterm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                npp_longterm, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'lm_lastyearmax'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                lm_lastyearmax, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'lm_thisyearmax'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                lm_thisyearmax, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxfpc_lastyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxfpc_lastyear, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'maxfpc_thisyear'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                maxfpc_thisyear, 'scatter', nbp_glo, index_g)
+    !-
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'turnover_longterm_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                   turnover_longterm(:,:,k,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    END DO
+    !-
+    var_name = 'gpp_week'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                gpp_week, 'scatter', nbp_glo, index_g)
+    !-
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'biomass_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                   biomass(:,:,k,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    END DO
+    !-
+    DO k=1,nparts
+       WRITE(part_str,'(I2)') k
+       IF (k < 10) part_str(1:1) = '0'
+       var_name = 'maint_resp_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                   resp_maint_part(:,:,k), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO m=1,nleafages
+       WRITE(part_str,'(I2)') m
+       IF (m < 10) part_str(1:1) = '0'
+       var_name = 'leaf_age_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                  leaf_age(:,:,m), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO m=1,nleafages
+       WRITE(part_str,'(I2)') m
+       IF (m < 10) part_str(1:1) = '0'
+       var_name = 'leaf_frac_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                   leaf_frac(:,:,m), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    var_name = 'senescence'
+    WHERE ( senescence(:,:) )
+       senescence_real = un
+    ELSEWHERE
+       senescence_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                senescence_real, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'when_growthinit'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                when_growthinit, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'age'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &                age, 'scatter', nbp_glo, index_g)
+    !-
+    ! 13 CO2
+    !-
+    var_name = 'resp_hetero'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                resp_hetero, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'resp_maint'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                resp_maint, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'resp_growth'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                resp_growth, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'co2_fire'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,  nvm, 1, itime, &
+         &                co2_fire, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'co2_to_bm_dgvm'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                co2_to_bm_dgvm, 'scatter', nbp_glo, index_g)
+    !-
+    ! 14 vegetation distribution after last light competition
+    !-
+    var_name = 'veget_lastlight'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                veget_lastlight, 'scatter', nbp_glo, index_g)
+    !-
+    ! 15 establishment criteria
+    !-
+    var_name = 'everywhere'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                everywhere, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'need_adjacent'
+    WHERE (need_adjacent(:,:))
+       need_adjacent_real = un
+    ELSEWHERE
+       need_adjacent_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                need_adjacent_real, 'scatter', nbp_glo, index_g)
+    !-
+    var_name = 'RIP_time'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                RIP_time, 'scatter', nbp_glo, index_g)
+    !-
+    ! 16 black carbon
+    !-
+    var_name = 'black_carbon'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,    1, 1, itime, &
+         &                black_carbon, 'scatter', nbp_glo, index_g)
+    !-
+    ! 17 litter
+    !-
+    DO l=1,nlitt
+       var_name = 'litterpart_'//litter_str(l)
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo,  nvm, 1, itime, &
+            &                   litterpart(:,:,l), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO k = 1,nelements 
+       DO m = 1,nvm 
+          WRITE (part_str, '(I2)') m 
+          IF (m<10) part_str(1:1)='0' 
+          var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_above'//element_str(k) 
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, & 
+          &                     litter_above(:,:,m,k), 'scatter', nbp_glo, index_g) 
+       ENDDO 
+    END DO
+    !-
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z01'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,1,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z02'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,2,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z03'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,3,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z04'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,4,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z05'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,5,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z06'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,6,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z07'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,7,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z08'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,8,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z09'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,9,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z10'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,10,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    DO k = 1,nelements
+          DO m = 1,nvm
+             WRITE (part_str, '(I2)') m
+             IF (m<10) part_str(1:1)='0'
+             var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_below_z11'//element_str(k)
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+                  &                     litter_below(:,:,m,11,k), 'scatter', nbp_glo,index_g)
+          ENDDO
+    END DO
+
+    !-
+    DO l=1,nlitt
+       var_name = 'dead_leaves_'//litter_str(l)
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo,  nvm, 1, itime, &
+            &                   dead_leaves(:,:,l), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z01_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,1), 'scatter', nbp_glo, index_g)
+    ENDDO
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z02_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,2), 'scatter', nbp_glo, index_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z03_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,3), 'scatter', nbp_glo, index_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z04_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,4), 'scatter', nbp_glo, index_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z05_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,5), 'scatter', nbp_glo, index_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z06_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,6), 'scatter', nbp_glo, index_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z07_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,7), 'scatter', nbp_glo, index_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z07_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,7), 'scatter', nbp_glo, index_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z08_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,8), 'scatter', nbp_glo, index_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z09_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,9), 'scatter', nbp_glo, index_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z10_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,10), 'scatter', nbp_glo, index_g)
+    ENDDO
+
+    DO m=1,nvm
+         WRITE (part_str, '(I2)') m
+         IF (m<10) part_str(1:1)='0'
+         var_name = 'carbon_z11_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+              &                   carbon(:,:,m,11), 'scatter', nbp_glo, index_g)
+    ENDDO
+    DO m=1,npool
+         WRITE (part_str, '(I1)') m
+         var_name = 'freedoc_z1_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,1,ifree,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z2_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,2,ifree,m,icarbon), 'scatter', nbp_glo, index_g)
+
+         var_name = 'freedoc_z3_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,3,ifree,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z4_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,4,ifree,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z5_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,5,ifree,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z6_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,6,ifree,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z7_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,7,ifree,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z8_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,8,ifree,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z9_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,9,ifree,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z10_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,10,ifree,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'freedoc_z11_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,11,ifree,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z1_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,1,iadsorbed,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z2_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,2,iadsorbed,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z3_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,3,iadsorbed,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z4_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,4,iadsorbed,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z5_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,5,iadsorbed,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z6_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,6,iadsorbed,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z7_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,7,iadsorbed,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z8_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,8,iadsorbed,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z9_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,9,iadsorbed,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z10_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,10,iadsorbed,m,icarbon), 'scatter', nbp_glo, index_g)
+
+
+         var_name = 'adsdoc_z11_'//part_str(1:LEN_TRIM(part_str))
+         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+              & DOC(:,:,11,iadsorbed,m,icarbon), 'scatter', nbp_glo, index_g)
+    ENDDO
+
+!         var_name = 'exp_doc_run'
+!         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+!              & DOC_EXP(:,:,irunoff,icarbon), 'scatter', nbp_glo, index_g)
+!         var_name = 'exp_doc_flo'
+!         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+!              & DOC_EXP(:,:,iflooded,icarbon), 'scatter', nbp_glo, index_g)
+!         var_name = 'exp_doc_dra'
+!         CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
+!              & DOC_EXP(:,:,idrainage,icarbon), 'scatter', nbp_glo, index_g)
+    !-
+       var_name = 'lignin_struc_above'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_above(:,:), 'scatter', nbp_glo, index_g)
+       var_name = 'lig_struc_be_z01'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,1), 'scatter', nbp_glo, index_g)
+       var_name = 'lig_struc_be_z02'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,2), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z03'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,3), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z04'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,4), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z05'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,5), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z06'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,6), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z07'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,7), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z08'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,8), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z09'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,9), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z10'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,10), 'scatter', nbp_glo, index_g)
+
+       var_name = 'lig_struc_be_z11'
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc_below(:,:,11), 'scatter', nbp_glo, index_g)
+
+    !-
+    ! 18 land cover change
+    !-
+    var_name = 'prod10'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 11, 1, itime, &
+         &                prod10, 'scatter', nbp_glo, index_g)
+    var_name = 'prod100'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 101, 1, itime, &
+         &                prod100, 'scatter', nbp_glo, index_g)
+    var_name = 'flux10'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 10, 1, itime, &
+         &                flux10, 'scatter', nbp_glo, index_g)
+    var_name = 'flux100'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 100, 1, itime, &
+         &                flux100, 'scatter', nbp_glo, index_g)
+
+    var_name = 'convflux'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &              convflux, 'scatter', nbp_glo, index_g)
+    var_name = 'cflux_prod10'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &              cflux_prod10, 'scatter', nbp_glo, index_g)
+    var_name = 'cflux_prod100'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &              cflux_prod100, 'scatter', nbp_glo, index_g)
+    DO l = 1,nelements
+       DO k = 1,nparts
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0'
+          var_name = 'bm_to_litter_'//part_str(1:LEN_TRIM(part_str))//element_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                bm_to_litter(:,:,k,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    END DO
+
+    var_name = 'carb_mass_total'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+         &              carb_mass_total, 'scatter', nbp_glo, index_g)
+    !-
+    ! 19. Spinup
+    !-
+    IF (spinup_analytic) THEN
+
+       IF (is_root_prc) THEN
+          temp_global_years(1) = REAL(global_years)
+          var_name='Global_years'
+          CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, temp_global_years)
+       ENDIF
+       
+       var_name = 'nbp_sum'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+            &              nbp_accu, 'scatter', nbp_glo, index_g)
+
+       var_name = 'nbp_flux'
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+            &              nbp_flux, 'scatter', nbp_glo, index_g)
+
+       var_name = 'ok_equilibrium'
+       WHERE(ok_equilibrium(:))
+          ok_equilibrium_real = un
+       ELSEWHERE
+          ok_equilibrium_real = zero
+       ENDWHERE
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
+            &               ok_equilibrium_real, 'scatter', nbp_glo, index_g)
+       
+       DO k = 1,nbpools
+          DO j = 1,nbpools
+             WRITE(part_str,'(I2)') k
+             IF (k < 10) part_str(1:1) = '0'             
+             var_name = 'MatV_'//part_str(1:LEN_TRIM(part_str))//'_'//TRIM(pools_str(j))
+             CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+                  &                MatrixV(:,:,k,j), 'scatter', nbp_glo, index_g)
+          ENDDO
+       ENDDO
+          
+       DO k = 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0' 
+          var_name = 'Vector_U_'//part_str(1:LEN_TRIM(part_str))
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                VectorU(:,:,k), 'scatter', nbp_glo, index_g)
+       ENDDO
+          
+       DO k = 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0' 
+          var_name = 'previous_stock_'//part_str(1:LEN_TRIM(part_str))
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                previous_stock(:,:,k), 'scatter', nbp_glo, index_g)
+       ENDDO
+          
+       DO k = 1,nbpools
+          WRITE(part_str,'(I2)') k
+          IF (k < 10) part_str(1:1) = '0' 
+          var_name = 'current_stock_'//part_str(1:LEN_TRIM(part_str))
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+               &                current_stock(:,:,k), 'scatter', nbp_glo, index_g)
+       ENDDO
+       
+    ENDIF !(spinup_analytic)
+
+    IF (bavard >= 4) WRITE(numout,*) 'Leaving writerestart'
+    !--------------------------
+  END SUBROUTINE writerestart
+  !-
+  !===
+  !-
+  SUBROUTINE readbc (npts, lalo, resolution, tref)
+    !---------------------------------------------------------------------
+    !-
+    ! 0.1 input
+    !-
+    ! Domain size
+    INTEGER(i_std),INTENT(in) :: npts
+    ! Geogr. coordinates (latitude,longitude) (degrees)
+    REAL(r_std),DIMENSION (npts,2),INTENT(in) :: lalo
+    ! size in x an y of the grid (m)
+    REAL(r_std),DIMENSION (npts,2),INTENT(in) :: resolution
+    !-
+    ! 0.2 not necessarily output
+    !-
+    ! "long term" reference 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts),INTENT(inout) :: tref
+    !---------------------------------------------------------------------
+    !-
+    ! If the vegetation is static, then the long-term reference
+    ! temperature is a boundary condition.
+    !-
+    IF ( .NOT. control%ok_dgvm ) THEN
+       CALL get_reftemp (npts, lalo, resolution, tref)
+    ENDIF
+    !--------------------
+  END SUBROUTINE readbc
+  !-
+  !===
+  !-
+  SUBROUTINE get_reftemp_clear
+    !---------------------------------------------------------------------
+    firstcall=.TRUE.
+    IF (ALLOCATED (trefe)) DEALLOCATE( trefe )
+    !-------------------------------
+  END SUBROUTINE get_reftemp_clear
+  !-
+  !===
+  !-
+  SUBROUTINE get_reftemp (npts, lalo, resolution, tref_out)
+    !---------------------------------------------------------------------
+    !- read the long-term reference temperature from a boundary condition
+    !- file. If the vegetation is dynamic, this field is used to
+    !- initialize correctly the (prognostic) long-term reference
+    !- temperature (in the case it is not found in the restart file).
+    !- If the vegetation is static, the field read here is a real boundary
+    !- condition that is not modified by the model.
+    !---------------------------------------------------------------------
+    !-
+    ! 0 declarations
+    !-
+    ! 0.1 input
+    !-
+    ! Domain size
+    INTEGER(i_std),INTENT(in) :: npts
+    ! Geogr. coordinates (latitude,longitude) (degrees)
+    REAL(r_std),DIMENSION (npts,2),INTENT(in) :: lalo
+    ! size in x an y of the grid (m)
+    REAL(r_std),DIMENSION (npts,2),INTENT(in) :: resolution
+    !-
+    ! 0.2 output
+    !-
+    ! reference temperature (K)
+    REAL(r_std), DIMENSION(npts),INTENT(out) :: tref_out
+    !-
+    ! 0.3 local
+    !-
+    INTEGER(i_std),PARAMETER :: nbvmax=200
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: &
+         &  iml, jml, lml, tml, fid, ib, ip, jp, fopt, ilf, lastjp
+    REAL(r_std) :: lev(1), date, dt, coslat
+    INTEGER(i_std)                                 :: itau(1)
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: &
+         &  lat_rel, lon_rel, lat_ful, lon_ful, tref_file
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: &
+         &  loup_rel, lolow_rel, laup_rel, lalow_rel
+    REAL(r_std) :: lon_up, lon_low, lat_up, lat_low
+    REAL(r_std) :: ax, ay, sgn
+    REAL(r_std),DIMENSION(nbvmax) :: area
+    REAL(r_std),DIMENSION(nbvmax) :: tt
+    REAL(r_std) :: resx, resy
+    LOGICAL :: do_again
+    !---------------------------------------------------------------------
+    !-
+    ! 1 If this is the first call, calculate the reference temperature
+    !   and keep it in memory
+    !-
+    IF (firstcall) THEN
+       !---
+       !-- 1.1 only do this once
+       !---
+       firstcall = .FALSE.
+       !---
+       !-- 1.2 allocate the field
+       !---
+       ALLOCATE( trefe(npts) )
+       !---
+       !-- 1.3 read and interpolate the temperature file
+       !---
+       !-- Needs to be a configurable variable
+       !---
+       !Config Key   = REFTEMP_FILE
+       !Config Desc  = Name of file from which the reference temperature is read
+       !Config If    = OK_STOMATE
+       !Config Def   = reftemp.nc
+       !Config Help  = The name of the file to be opened to read
+       !Config         the reference surface temperature.
+       !Config         The data from this file is then interpolated
+       !Config         to the grid of of the model.
+       !Config         The aim is to get a reference temperature either
+       !Config         to initialize the corresponding prognostic model
+       !Config         variable correctly (ok_dgvm=TRUE) or to impose it
+       !Config         as boundary condition (ok_dgvm=FALSE)
+       !Config Units = [FILE]
+       !---
+       filename = 'reftemp.nc'
+       CALL getin_p('REFTEMP_FILE',filename)
+       !---
+       IF (is_root_prc) CALL flininfo(filename,iml, jml, lml, tml, fid)
+       CALL bcast(iml)
+       CALL bcast(jml)
+       CALL bcast(lml)
+       CALL bcast(tml)
+       !---
+       ALLOCATE (lat_rel(iml,jml))
+       ALLOCATE (lon_rel(iml,jml))
+       ALLOCATE (laup_rel(iml,jml))
+       ALLOCATE (loup_rel(iml,jml))
+       ALLOCATE (lalow_rel(iml,jml))
+       ALLOCATE (lolow_rel(iml,jml))
+       ALLOCATE (lat_ful(iml+2,jml+2))
+       ALLOCATE (lon_ful(iml+2,jml+2))
+       ALLOCATE (tref_file(iml,jml))
+       !---
+       IF (is_root_prc) CALL flinopen (filename, .FALSE., iml, jml, lml, &
+            &                                   lon_rel, lat_rel, lev, tml, itau, date, dt, fid)
+       CALL bcast(lon_rel)
+       CALL bcast(lat_rel)
+       CALL bcast(itau)
+       CALL bcast(date)
+       CALL bcast(dt)
+
+       !---
+       IF (is_root_prc) CALL flinget (fid, 'temperature', iml, jml, lml, tml, &
+            &                                  1, 1, tref_file)
+       CALL bcast(tref_file)
+       !---
+       IF (is_root_prc) CALL flinclo (fid)
+       !---
+       !-- Duplicate the border assuming we have a global grid
+       !-- going from west to east
+       !---
+       lon_ful(2:iml+1,2:jml+1) = lon_rel(1:iml,1:jml)
+       lat_ful(2:iml+1,2:jml+1) = lat_rel(1:iml,1:jml)
+       !---
+       IF ( lon_rel(iml,1) < lon_ful(2,2)) THEN
+          lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)
+          lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
+       ELSE
+          lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)-360
+          lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
+       ENDIF
+       !---
+       IF ( lon_rel(1,1) > lon_ful(iml+1,2)) THEN
+          lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)
+          lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
+       ELSE
+          lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)+360
+          lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
+       ENDIF
+       !---
+       sgn = lat_rel(1,1)/ABS(lat_rel(1,1))
+       lat_ful(2:iml+1,1) = sgn*180 - lat_rel(1:iml,1)
+       sgn = lat_rel(1,jml)/ABS(lat_rel(1,jml))
+       lat_ful(2:iml+1,jml+2) = sgn*180 - lat_rel(1:iml,jml)
+       lat_ful(1,1) = lat_ful(iml+1,1)
+       lat_ful(iml+2,1) = lat_ful(2,1)
+       lat_ful(1,jml+2) = lat_ful(iml+1,jml+2)
+       lat_ful(iml+2,jml+2) = lat_ful(2,jml+2)
+       !---
+       !-- Add the longitude lines to the top and bottom
+       !---
+       lon_ful(:,1) = lon_ful(:,2)
+       lon_ful(:,jml+2) = lon_ful(:,jml+1)
+       !---
+       !-- Get the upper and lower limits of each grid box
+       !---
+       DO ip=1,iml
+          DO jp=1,jml
+             loup_rel(ip,jp) = &
+                  &        MAX(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)), &
+                  &            0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
+             lolow_rel(ip,jp) = &
+                  &        MIN(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)), &
+                  &            0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
+             laup_rel(ip,jp) = &
+                  &        MAX(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)), &
+                  &            0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
+             lalow_rel(ip,jp) = &
+                  &        MIN(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)), &
+                  &            0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
+          ENDDO
+       ENDDO
+       !---
+       !-- Now we take each grid point and find out which values
+       !-- from the forcing we need to average
+       !---
+       DO ib=1,npts
+          !-----
+          resx = resolution(ib,1)
+          resy = resolution(ib,2)
+          !-----
+          do_again = .TRUE.
+          !-----
+          DO WHILE (do_again)
+             !-----
+             do_again = .FALSE.
+             !-------
+             !------ We find the 4 limits of the grid-box.
+             !------ As we transform the resolution of the model into longitudes
+             !------ and latitudes we do not have the problem of periodicity.
+             !------ coslat is a help variable here !
+             !-------
+             coslat = MAX(COS(lalo(ib,1)*pi/180.),mincos)*pi/180.*R_Earth
+             !-------
+             lon_up  = lalo(ib,2)+resx/(2.0*coslat)
+             lon_low = lalo(ib,2)-resx/(2.0*coslat)
+             !-------
+             coslat  = pi/180.*R_Earth
+             !-------
+             lat_up  = lalo(ib,1)+resy/(2.0*coslat)
+             lat_low = lalo(ib,1)-resy/(2.0*coslat)
+             !-------
+             !------ Find the grid boxes from the data that go into
+             !------ the model's boxes.
+             !------ We still work as if we had a regular grid !
+             !------ Well it needs to be localy regular so that
+             !------ the longitude at the latitude of the last found point
+             !------ is close to the one of the next point.
+             !-------
+             fopt = 0
+             lastjp = 1
+             DO ip=1,iml
+                !---------
+                !-------- Either the center of the data grid point is in the interval
+                !-------- of the model grid or the East and West limits of the data
+                !-------- grid point are on either sides of the border of the data grid
+                !---------
+                IF (      lon_rel(ip,lastjp) > lon_low &
+                     &            .AND. lon_rel(ip,lastjp) < lon_up &
+                     &             .OR. lolow_rel(ip,lastjp) < lon_low &
+                     &            .AND. loup_rel(ip,lastjp) > lon_low &
+                     &             .OR. lolow_rel(ip,lastjp) < lon_up &
+                     &            .AND. loup_rel(ip,lastjp) > lon_up ) THEN
+                   DO jp=1,jml
+                      !-------------
+                      !------------ Now that we have the longitude let us find the latitude
+                      !-------------
+                      IF (      lat_rel(ip,jp) > lat_low &
+                           &                 .AND. lat_rel(ip,jp) < lat_up &
+                           &                  .OR. lalow_rel(ip,jp) < lat_low &
+                           &                 .AND. laup_rel(ip,jp) > lat_low &
+                           &                  .OR. lalow_rel(ip,jp) < lat_up &
+                           &                 .AND. laup_rel(ip,jp) > lat_up) THEN
+                         lastjp = jp
+                         !---------------
+                         fopt = fopt + 1
+                         IF ( fopt > nbvmax) THEN
+                            WRITE(numout,*) &
+                                 &                       'Please increase nbvmax in subroutine get_reftemp',ib
+                            STOP
+                         ELSE
+                            !-----------------
+                            !---------------- Get the area of the fine grid in the model grid
+                            !-----------------
+                            coslat = MAX(COS(lat_rel(ip,jp)*pi/180.),mincos)
+                            ax =  ( MIN(lon_up,loup_rel(ip,jp)) &
+                                 &                       -MAX(lon_low,lolow_rel(ip,jp))) &
+                                 &                     *pi/180.*R_Earth*coslat
+                            ay =  ( MIN(lat_up,laup_rel(ip,jp)) &
+                                 &                       -MAX(lat_low,lalow_rel(ip,jp))) &
+                                 &                     *pi/180.*R_Earth
+                            area(fopt) = ax*ay
+                            tt(fopt) = tref_file(ip,jp)
+                         ENDIF
+                      ENDIF
+                   ENDDO
+                ENDIF
+             ENDDO
+             !-------
+             !------ Check that we found some points
+             !-------
+             trefe(ib) = zero
+             !-------
+             IF (fopt == 0) THEN
+                do_again = .TRUE.
+                !-------
+                !------ increase search radius
+                !-------
+                resx = resx*2.
+                resy = resy*2.
+                IF ( resx > 2.*pi*R_Earth .OR. resy > pi*R_Earth ) THEN
+                   STOP 'get_reftemp: found no point'
+                ENDIF
+             ELSE
+                sgn = zero
+                !-------
+                !------ Compute the average surface air temperature
+                !-------
+                DO ilf=1,fopt
+                   trefe(ib) = trefe(ib) + tt(ilf) * area(ilf)
+                   sgn = sgn + area(ilf)
+                ENDDO
+                !-------
+                !------ Normalize the surface
+                !-------
+                IF (sgn < min_sechiba) THEN
+                   do_again = .TRUE.
+                   !---------
+                   !-------- increase search radius
+                   !---------
+                   resx = resx * 2.
+                   resy = resy * 2.
+                   IF ( resx > 2.*pi*R_Earth .OR. resy > pi*R_Earth ) THEN
+                      STOP 'get_reftemp: found no point'
+                   ENDIF
+                ELSE
+                   trefe(ib) = trefe(ib) / sgn
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDDO
+       !-
+       ! transform into Kelvin
+       !-
+       trefe(:) = trefe(:) + ZeroCelsius
+       !-
+       ! deallocate
+       !-
+       DEALLOCATE (lat_rel)
+       DEALLOCATE (lon_rel)
+       DEALLOCATE (laup_rel)
+       DEALLOCATE (loup_rel)
+       DEALLOCATE (lalow_rel)
+       DEALLOCATE (lolow_rel)
+       DEALLOCATE (lat_ful)
+       DEALLOCATE (lon_ful)
+       DEALLOCATE (tref_file)
+    ENDIF
+    !-
+    ! 2 output the reference temperature
+    !-
+    tref_out(:) = trefe(:)
+    !-------------------------
+  END SUBROUTINE get_reftemp
+  !-
+  !===
+  !-
+END MODULE stomate_io
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_lcchange.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_lcchange.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_lcchange.f90	(revision 5166)
@@ -0,0 +1,388 @@
+! =================================================================================================================================
+! MODULE       : stomate_lcchange
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Impact of land cover change on carbon stocks
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE stomate_lcchange
+
+  ! modules used:
+  
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE constantes_soil
+  
+  IMPLICIT NONE
+  
+  PRIVATE
+  PUBLIC lcchange_main
+  
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : lcchange_main
+!!
+!>\BRIEF        Impact of land cover change on carbon stocks
+!!
+!! DESCRIPTION  : This subroutine is activated by 'LAND_COVER_CHANGE = y' in configuration file.
+!! In the case of 'LAND_COVER_CHANGE = y', the impact of land cover change on 
+!! carbon stocks is computed in this subroutine. The land cover change is written
+!! by the difference of new and previous "maximal" coverage fraction of a PFT. 
+!! On the basis of this difference, the amount of 'new establishment'/'biomass export',
+!! and increase/decrease of each component, are estimated.\n
+!!
+!! Main structure of lpj_establish.f90 is:
+!! 1. Initialization
+!! 2. Calculation of changes in carbon stocks and biomass by land cover change
+!! 3. Update 10 year- and 100 year-turnover pool contents
+!! 4. History
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : ::prod10, ::prod100, ::flux10, ::flux100,
+!!   :: cflux_prod10 and :: cflux_prod100 
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : 
+!! \latexonly 
+!!     \includegraphics[scale=0.5]{lcchange.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  
+  SUBROUTINE lcchange_main ( npts, dt_days, veget_max, veget_max_new,&
+       biomass, ind, age, PFTpresent, senescence, when_growthinit, everywhere, &        
+       co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, cn_ind,flux10,flux100, &
+       prod10,prod100,&
+       convflux,&
+       cflux_prod10,cflux_prod100, leaf_frac,&
+       npp_longterm, lm_lastyearmax, litter_above, litter_below,&
+       carbon,DOC,moist_soil)
+    
+    IMPLICIT NONE
+    
+  !! 0. Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+    
+    INTEGER, INTENT(in)                                       :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), INTENT(in)                                   :: dt_days          !! Time step of vegetation dynamics for stomate
+                                                                                  !! (days)
+    REAL(r_std), DIMENSION(nvm, nparts,nelements), INTENT(in) :: bm_sapl          !! biomass of sapling 
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)             :: moist_soil      !! moisture in soil for one pixel (m3/m3) 
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: convflux         !! release during first year following land cover
+                                                                                  !! change
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: cflux_prod10     !! total annual release from the 10 year-turnover
+                                                                                  !! pool @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts), INTENT(out)                 :: cflux_prod100    !! total annual release from the 100 year-
+                                                                                  !! turnover pool @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: turnover_daily   !! Turnover rates 
+                                                                                      !! @tex ($gC m^{-2} day^{-1}$) @endtex
+
+    !! 0.3 Modified variables   
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget_max        !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                                  !! infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget_max_new    !! new "maximal" coverage fraction of a PFT (LAI
+                                                                                  !! -> infinity) on ground
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass    !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind              !! Number of individuals @tex ($m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age              !! mean age (years)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: senescence       !! plant senescent (only for deciduous trees) Set
+                                                                                  !! to .FALSE. if PFT is introduced or killed
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent       !! Is pft there (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere       !! is the PFT everywhere in the grid box or very 
+                                                                                  !! localized (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit  !! how many days ago was the beginning of the 
+                                                                                  !! growing season (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm        !! biomass uptaken 
+                                                                                  !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! conversion of biomass to litter 
+                                                                                  !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: cn_ind           !! crown area of individuals 
+                                                                                  !! @tex ($m^{2}$) @endtex
+    REAL(r_std), DIMENSION(npts,0:10), INTENT(inout)          :: prod10           !! products remaining in the 10 year-turnover
+                                                                                  !! pool after the annual release for each 
+                                                                                  !! compartment (10 + 1 : input from year of land
+                                                                                  !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100), INTENT(inout)         :: prod100          !! products remaining in the 100 year-turnover
+                                                                                  !! pool after the annual release for each 
+                                                                                  !! compartment (100 + 1 : input from year of land
+                                                                                  !! cover change)
+    REAL(r_std), DIMENSION(npts,10), INTENT(inout)            :: flux10           !! annual release from the 10/100 year-turnover 
+                                                                                  !! pool compartments
+    REAL(r_std), DIMENSION(npts,100), INTENT(inout)           :: flux100          !! annual release from the 10/100 year-turnover
+                                                                                  !! pool compartments
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac        !! fraction of leaves in leaf age class 
+                                                                                  !! (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: lm_lastyearmax   !! last year's maximum leaf mass for each PFT 
+                                                                                  !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: npp_longterm     !! "long term" net primary productivity 
+                                                                                  !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std),DIMENSION(npts,nlitt,nvm, nelements), INTENT(inout):: litter_above !! metabolic and structural litter, above 
+                                                                                  !! ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nbdl,nelements), INTENT(inout):: litter_below !! metabolic and structural litter, below 
+                                                                                  !! ground @tex ($gC m^{-2}$) @endtex
+                                                                                  !@endtex
+    REAL(r_std),DIMENSION(npts,ncarb,nvm,nbdl), INTENT(inout) :: carbon           !! carbon pool: active, slow, or passive 
+                                                                                  !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements), INTENT(inout) :: DOC     !! Dissolved Organic Carbon in soil
+                                                                                       !! The unit is guven by m^3 of water
+                                                                                       !! @tex $(gC m{-3} of water)$ @endtex
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                            :: i, j, k, l, m    !! indices (unitless)
+    REAL(r_std),DIMENSION(npts,nelements)                     :: bm_new           !! biomass increase @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,nparts,nelements)              :: biomass_loss     !! biomass loss @tex ($gC m^{-2}$) @endtex
+    REAL(r_std)                                               :: above            !! aboveground biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,nlitt,nelements)               :: dilu_lit_above   !! Above ground litter dilution @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,nlitt,nbdl,nelements)          :: dilu_lit_below   !! Below ground litter dilution @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,ncarb,nbdl)                    :: dilu_soil_carbon !! Soil Carbondilution @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(nvm)                                :: delta_veg        !! changes in "maximal" coverage fraction of PFT 
+    REAL(r_std)                                               :: delta_veg_sum    !! sum of delta_veg
+    REAL(r_std),DIMENSION(npts,nvm)                           :: delta_ind        !! change in number of individuals  
+    REAL(r_std), SAVE, DIMENSION(0:nbdl)                      :: z_soil           !! Variable to store depth of the different
+                                                                                  !! soil layers (m)
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering lcchange_main'
+    
+  !! 1. initialization
+    
+    prod10(:,0)         = zero
+    prod100(:,0)        = zero   
+    above               = zero
+    convflux(:)         = zero
+    cflux_prod10(:)     = zero
+    cflux_prod100(:)    = zero
+    delta_ind(:,:)      = zero
+    delta_veg(:)        = zero
+       !! 1.1.1 Copy the depth of the different soil layers (number of layers=nbdl) 
+       !        previously calculated as variable diaglev in routines
+       !        sechiba.f90 and slowproc.f90  
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+    
+  !! 2. calculation of changes in carbon stocks and biomass by land cover change\n
+    
+    DO i = 1, npts ! Loop over # pixels - domain size
+       
+       !! 2.1 initialization of carbon stocks\n
+       delta_veg(:) = veget_max_new(i,:)-veget_max(i,:)
+       delta_veg_sum = SUM(delta_veg,MASK=delta_veg.LT.0.)
+       
+       dilu_lit_above(i,:,:) = zero
+       dilu_lit_below(i,:,:,:) = zero
+       dilu_soil_carbon(i,:,:) = zero
+       biomass_loss(i,:,:) = zero
+       
+       !! 2.2 if vegetation coverage decreases, compute dilution of litter, soil carbon, and biomass.\n
+
+
+       DO j=2, nvm
+          IF ( delta_veg(j) < -min_stomate ) THEN 
+             dilu_lit_above(i,:,:) = dilu_lit_above(i,:,:) + delta_veg(j)*litter_above(i,:,j,:) / delta_veg_sum
+             dilu_lit_below(i,:,:,:) = dilu_lit_below(i,:,:,:) + delta_veg(j)*litter_below(i,:,j,:,:) / delta_veg_sum
+             DO k=2,nbdl
+               DO m = 1,npool
+               dilu_soil_carbon(i,:,k) =  dilu_soil_carbon(i,:,k) + delta_veg(j) * (carbon(i,:,j,k) + &
+                                        (DOC(:,j,k,ifree,m,icarbon) + DOC(:,j,k,iadsorbed,m,icarbon))* moist_soil(:,k) * (z_soil(k)-z_soil(k-1))) / delta_veg_sum
+               ENDDO
+             ENDDO
+               DO m=1,npool
+               dilu_soil_carbon(i,:,1) =  dilu_soil_carbon(i,:,1) + delta_veg(j) * (carbon(i,:,j,1)+ &
+                                        (DOC(:,j,1,ifree,m,icarbon) + DOC(:,j,1,iadsorbed,m,icarbon))* moist_soil(:,1) * (z_soil(1))) / delta_veg_sum
+               ENDDO
+             biomass_loss(i,:,:) = biomass_loss(i,:,:) + biomass(i,j,:,:)*delta_veg(j) / delta_veg_sum
+          ENDIF
+       ENDDO
+       
+       !! 2.3 
+!WRITE (numout,*) "litter_above_#1_lc_PFT6=",litter_above(:,:,6,:)
+!WRITE (numout,*) "litter_above_#1_lc_PFT10=",litter_above(:,:,10,:)
+       DO j=2, nvm ! Loop over # PFTs
+
+          !! 2.3.1 The case that vegetation coverage of PFTj increases
+          IF ( delta_veg(j) > min_stomate) THEN
+
+             !! 2.3.1.1 Initial setting of new establishment
+             IF (veget_max(i,j) .LT. min_stomate) THEN 
+                IF (is_tree(j)) THEN
+
+                   ! cn_sapl(j)=0.5; stomate_data.f90
+                   cn_ind(i,j) = cn_sapl(j) 
+                ELSE
+                   cn_ind(i,j) = un
+                ENDIF
+                ind(i,j)= delta_veg(j) / cn_ind(i,j)
+                PFTpresent(i,j) = .TRUE.
+                everywhere(i,j) = 1.
+                senescence(i,j) = .FALSE.
+                age(i,j) = zero
+
+                ! large_value = 1.E33_r_std
+                when_growthinit(i,j) = large_value 
+                leaf_frac(i,j,1) = 1.0
+                npp_longterm(i,j) = npp_longterm_init
+                lm_lastyearmax(i,j) = bm_sapl(j,ileaf,icarbon) * ind(i,j)
+             ENDIF
+             IF ( cn_ind(i,j) > min_stomate ) THEN
+                delta_ind(i,j) = delta_veg(j) / cn_ind(i,j) 
+             ENDIF
+             
+             !! 2.3.1.2 Update of biomass in each each carbon stock component 
+             !!         Update of biomass in each each carbon stock component (leaf, sapabove, sapbelow,
+             !>         heartabove, heartbelow, root, fruit, and carbres)\n
+             DO k = 1, nparts ! loop over # carbon stock components, nparts = 8; stomate_constant.f90 
+                DO l = 1,nelements ! loop over # elements
+
+                   bm_new(i,l) = delta_ind(i,j) * bm_sapl(j,k,l) 
+                   IF (veget_max(i,j) .GT. min_stomate) THEN
+
+                      ! in the case that bm_new is overestimated compared with biomass?
+                      IF ((bm_new(i,l)/delta_veg(j)) > biomass(i,j,k,l)) THEN
+                         bm_new(i,l) = biomass(i,j,k,l)*delta_veg(j)
+                      ENDIF
+                   ENDIF
+                   biomass(i,j,k,l) = ( biomass(i,j,k,l) * veget_max(i,j) + bm_new(i,l) ) / veget_max_new(i,j)
+                   co2_to_bm(i,j) = co2_to_bm(i,j) + (bm_new(i,icarbon)* dt_days) / (one_year * veget_max_new(i,j))
+                END DO ! loop over # elements
+             ENDDO ! loop over # carbon stock components
+
+             !! 2.3.1.3 Calculation of dilution in litter, soil carbon, and  input of litter
+             !!        In this 'IF statement', dilu_* is zero. Formulas for litter and soil carbon
+             !!         could be shortend?? Are the following formulas correct?
+
+             ! Above ground litter
+             litter_above(i,:,j,:)=(litter_above(i,:,j,:) * veget_max(i,j) + &
+                  dilu_lit_above(i,:,:) * delta_veg(j)) / veget_max_new(i,j)
+
+             ! Below ground litter
+             litter_below(i,:,j,:,:)=(litter_below(i,:,j,:,:) * veget_max(i,j) + &
+                  dilu_lit_below(i,:,:,:) * delta_veg(j)) / veget_max_new(i,j)
+            
+             ! Soil carbon
+             carbon(i,:,j,:)=(carbon(i,:,j,:) * veget_max(i,j) + dilu_soil_carbon(i,:,:) * delta_veg(j)) / veget_max_new(i,j)
+
+             DO l = 1,nelements
+
+                ! Litter input
+                bm_to_litter(i,j,isapbelow,l) = bm_to_litter(i,j,isapbelow,l) + &
+                     &                         biomass_loss(i,isapbelow,l)*delta_veg(j) / veget_max_new(i,j)
+                bm_to_litter(i,j,iheartbelow,l) = bm_to_litter(i,j,iheartbelow,l) + biomass_loss(i,iheartbelow,l) *delta_veg(j) &
+                     &  / veget_max_new(i,j)
+                bm_to_litter(i,j,iroot,l) = bm_to_litter(i,j,iroot,l) + biomass_loss(i,iroot,l)*delta_veg(j) / veget_max_new(i,j)
+                bm_to_litter(i,j,ifruit,l) = bm_to_litter(i,j,ifruit,l) + biomass_loss(i,ifruit,l)*delta_veg(j) / veget_max_new(i,j)
+                bm_to_litter(i,j,icarbres,l) = bm_to_litter(i,j,icarbres,l) + &
+                     &                         biomass_loss(i,icarbres,l)   *delta_veg(j) / veget_max_new(i,j)
+                bm_to_litter(i,j,ileaf,l) = bm_to_litter(i,j,ileaf,l) + biomass_loss(i,ileaf,l)*delta_veg(j) / veget_max_new(i,j)
+
+             END DO
+
+             age(i,j)=age(i,j)*veget_max(i,j)/veget_max_new(i,j)
+             
+          !! 2.3.2 The case that vegetation coverage of PFTj is no change or decreases
+          ELSE 
+ 
+             !! 2.3.2.1 Biomass export
+             ! coeff_lcchange_*:  Coeff of biomass export for the year, decade, and century
+             above = biomass(i,j,isapabove,icarbon) + biomass(i,j,iheartabove,icarbon)
+             convflux(i)  = convflux(i)  - ( coeff_lcchange_1(j) * above * delta_veg(j) ) 
+             prod10(i,0)  = prod10(i,0)  - ( coeff_lcchange_10(j) * above * delta_veg(j) )
+             prod100(i,0) = prod100(i,0) - ( coeff_lcchange_100(j) * above * delta_veg(j) )
+             
+             !! 2.3.2.2 Total reduction
+             IF ( veget_max_new(i,j) .LT. min_stomate ) THEN 
+                
+                veget_max_new(i,j)= zero
+                ind(i,j) = zero
+                biomass(i,j,:,:) = zero
+                PFTpresent(i,j) = .FALSE.
+                senescence(i,j) = .FALSE.
+                age(i,j) = zero
+                when_growthinit(i,j) = undef
+                everywhere(i,j) = zero
+                carbon(i,:,j,:) = zero
+                litter_above(i,:,j,:) = zero
+                litter_below(i,:,j,:,:) = zero
+                bm_to_litter(i,j,:,:) = zero
+                turnover_daily(i,j,:,:) = zero
+                
+             ENDIF
+             
+          ENDIF ! End if PFT's coverage reduction
+          
+       ENDDO ! Loop over # PFTs
+!WRITE (numout,*) "litter_above_#2_lc_PFT6=",litter_above(:,:,6,:)
+!WRITE (numout,*) "litter_above_#2_lc_PFT10=",litter_above(:,:,10,:)
+       
+       !! 2.4 update 10 year-turnover pool content following flux emission
+       !!     (linear decay (10%) of the initial carbon input)
+       DO  l = 0, 8
+          m = 10 - l
+          cflux_prod10(i) =  cflux_prod10(i) + flux10(i,m)
+          prod10(i,m)     =  prod10(i,m-1)   - flux10(i,m-1)
+          flux10(i,m)     =  flux10(i,m-1)
+          
+          IF (prod10(i,m) .LT. 1.0) prod10(i,m) = zero
+       ENDDO
+       
+       cflux_prod10(i) = cflux_prod10(i) + flux10(i,1) 
+       flux10(i,1)     = 0.1 * prod10(i,0)
+       prod10(i,1)     = prod10(i,0)
+       
+       !! 2.5 update 100 year-turnover pool content following flux emission\n
+       DO   l = 0, 98
+          m = 100 - l
+          cflux_prod100(i)  =  cflux_prod100(i) + flux100(i,m)
+          prod100(i,m)      =  prod100(i,m-1)   - flux100(i,m-1)
+          flux100(i,m)      =  flux100(i,m-1)
+          
+          IF (prod100(i,m).LT.1.0) prod100(i,m) = zero
+       ENDDO
+       
+       cflux_prod100(i)  = cflux_prod100(i) + flux100(i,1) 
+       flux100(i,1)      = 0.01 * prod100(i,0)
+       prod100(i,1)      = prod100(i,0)
+       prod10(i,0)        = zero
+       prod100(i,0)       = zero 
+       
+    ENDDO ! Loop over # pixels - domain size
+    
+  !! 3. history
+    
+    veget_max(:,:) = veget_max_new(:,:)
+    convflux        = convflux/one_year*dt_days
+    cflux_prod10    = cflux_prod10/one_year*dt_days
+    cflux_prod100   = cflux_prod100/one_year*dt_days
+    
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving lcchange_main'
+    
+  END SUBROUTINE lcchange_main
+  
+END MODULE stomate_lcchange
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_litter.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_litter.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_litter.f90	(revision 5166)
@@ -0,0 +1,1946 @@
+! =================================================================================================================================
+! MODULE       : stomate_litter
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Update litter and lignine content after litter fall and 
+!! calculating litter decomposition.      
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_litter
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC littercalc,littercalc_clear, deadleaf
+
+
+
+  LOGICAL, SAVE                        :: firstcall = .TRUE.       !! first call
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : littercalc_calc
+!!
+!!\BRIEF        Set the flag ::firstcall to .TRUE. and as such activate section
+!! 1.1 of the subroutine littercalc (see below).
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE littercalc_clear
+    firstcall =.TRUE.
+  END SUBROUTINE littercalc_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : littercalc
+!!
+!!\BRIEF        Calculation of the litter decomposition and therefore of the 
+!! heterotrophic respiration from litter following Parton et al. (1987).
+!!
+!! DESCRIPTION  : The littercal routine splits the litter in 4 pools: 
+!! aboveground metaboblic, aboveground structural, belowground metabolic and 
+!! belowground structural. the fraction (F) of plant material going to metabolic 
+!! and structural is defined following Parton et al. (1987). The below ground
+!! litter is discretized over 11 layers (the same used by the CWRR hydrology
+!! scheme).
+!! \latexonly
+!! \input{littercalc1.tex}
+!! \endlatexonly
+!! \n
+!! where L is the lignin content of the plant carbon pools considered and CN 
+!! its CN ratio. L and CN are fixed parameters for each plant carbon pools,
+!! therefore it is the ratio between each plant carbon pool within a PFT, which
+!! controlled the part of the total litter, that will be considered as
+!! recalcitrant (i.e. structural litter) or labile (i.e. metabolic litter).\n  
+!! 
+!! The routine calculates the fraction of aboveground litter which is metabolic
+!! or structural (the litterpart variable) which is then used in lpj_fire.f90.\n 
+!! 
+!! In the section 2, the routine calculate the new plant material entering the
+!! litter pools by phenological death of plants organs (corresponding to the
+!! variable turnover) and by fire, herbivory and others non phenological causes
+!! (variable bm_to_litter). This calculation is first done for each PFT and then
+!! the values calculated for each PFT are added up. Following the same approach
+!! the lignin content of the total structural litter is calculated and will be
+!! then used as a factor control of the decomposition of the structural litter
+!! (lignin_struc) in the section 5.1.2. A test is performed to avoid that we add
+!! more lignin than structural litter. Finally, the variable litterpart is
+!! updated.\n
+!! 
+!! In the section 3 and 4 the temperature and the moisture controlling the
+!! decomposition are calculated for above and belowground. For aboveground
+!! litter, air temperature and litter moisture are calculated in sechiba and used 
+!! directly. For belowground, soil temperature and moisture are also calculated 
+!! in sechiba but are modulated as a function of the soil depth. The modulation 
+!! is a multiplying factor exponentially distributed between 0 (in depth) and 1
+!! in surface.\n  
+!! 
+!! Then, in the section 5 and 6, the routine calculates the structural litter decomposition 
+!! (C) following first order kinetics following Parton et al. (1987).
+!! \latexonly
+!! \input{littercalc2.tex}
+!! \endlatexonly
+!! \n
+!! with k the decomposition rate of the structural litter. 
+!! k corresponds to
+!! \latexonly
+!! \input{littercalc3.tex}
+!! \endlatexonly
+!! \n
+!! with littertau the turnover rate, T a function of the temperature and M a function of
+!! the moisture described below.\n
+!!  
+!! Then, the fraction of dead leaves (DL) composed by aboveground structural litter is
+!! calculated as following
+!! \latexonly
+!! \input{littercalc4.tex}
+!! \endlatexonly
+!! \n
+!! with k the decomposition rate of the structural litter previously
+!! described.\n
+!!
+!! In the section 5.1 and 6.1, the fraction of decomposed structural litter
+!! incorporated to the soil (Input) and its associated heterotrophic respiration are
+!! calculated. For structural litter, the C decomposed could go in the active
+!! soil carbon pool or in the slow carbon, as described in 
+!! stomate_soilcarbon.f90.\n
+!! \latexonly
+!! \input{littercalc5.tex}
+!! \endlatexonly
+!! \n
+!! with f a parameter describing the fraction of structural litter incorporated
+!! into the considered soil carbon pool, C the amount of litter decomposed and L 
+!! the amount of lignin in the litter. The litter decomposed which is not
+!! incorporated into the soil is respired.\n
+!!
+!! In the section 5.2 and 6.2, the fraction of decomposed metabolic litter
+!! incorporated to the soil and its associated heterotrophic respiration are
+!! calculated with the same approaches presented for 5.1 but no control factor
+!! depending on the lignin content are used.\n
+!! 
+!! In the section 7 the dead leaf cover is calculated through a call to the 
+!! deadleaf subroutine presented below.\n
+!!
+!! In the section 8, if the flag SPINUP_ANALYTIC is set to true, we fill MatrixA
+!! and VectorB following Lardy(2011).
+!!
+!! MAIN OUTPUT VARIABLES: ::deadleaf_cover, ::resp_hetero_litter, 
+!! ::control_temp, ::control_moist
+!!
+!! REFERENCES:
+!! - Parton, WJ, Schimel, DS, Cole, CV, and Ojima, DS. 1987. Analysis
+!! of factors controlling soil organic matter levels in Great Plains
+!! grasslands. Soil Science Society of America journal (USA)
+!! (51):1173-1179.
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART    :
+!! \latexonly
+!! \includegraphics(scale=0.5){littercalcflow.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE littercalc (npts, dt, &
+       turnover, bm_to_litter, &
+       veget_max, tsurf, tsoil, soilhum, litterhum, rprof, &
+       litterpart, litter_above, litter_below, dead_leaves, &
+       lignin_struc_above, lignin_struc_below, &
+       deadleaf_cover, resp_hetero_litter, &
+       control_temp_above, control_temp_soil, &
+       control_moist_above, control_moist_soil, MatrixA,&
+       VectorB,litter_mc,soilcarbon_input, soil_mc, soiltile, &
+       clay, bulk_dens, soil_ph, carbon)
+
+    !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                  :: npts                !! Domain size - number of grid pixels
+    REAL(r_std), INTENT(in)                                     :: dt                  !! Time step of the simulations for stomate
+                                                                                       !! @tex $(dtradia one\_day^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover          !! Turnover rates of plant biomass 
+                                                                                       !! @tex $(gC m^{-2} dt\_slow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: bm_to_litter      !! Conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} dt\_slow^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                   :: veget_max          !! PFT "Maximal" coverage fraction of a PFT 
+                                                                                       !! defined in the input vegetation map 
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: tsurf              !! Temperature (K) at the surface
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)                :: tsoil              !! Soil temperature (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)                :: soilhum            !! Daily soil humidity of each soil layer 
+                                                                                       !! (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: litterhum          !! Daily litter humidity (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                 :: rprof              !! PFT root depth as calculated in stomate.f90 from parameter 
+                                                                                       !! humcste which is root profile for different PFTs 
+                                                                                       !! in slowproc.f90 (m)
+    REAL(r_std),DIMENSION (npts,nstm), INTENT(in)                :: litter_mc          !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (npts,nbdl,nstm), INTENT(in)           :: soil_mc            !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (npts,nstm), INTENT (in)               :: soiltile           !! Fraction of each soil tile (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: clay               !! Clay fraction (unitless, 0-1) 
+    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)
+
+    REAL(r_std), DIMENSION(npts), INTENT(in)                     :: soil_ph            !! soil pH (pH unit, 0-14) 
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl), INTENT(in)      :: carbon             !! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts), INTENT(out)                    :: deadleaf_cover     !! Fraction of soil covered by dead leaves 
+                                                                                       !! over all PFTs (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                :: resp_hetero_litter !! Litter heterotrophic respiration. The unit
+                                                                                       !! is given by m^2 of ground.  
+                                                                                       !! @tex $(gC dtradia one\_day^{-1}) m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nbdl,npool*2), INTENT(out)       :: control_temp_soil  !! Temperature control of heterotrophic 
+                                                                                       !! respiration belowground,(0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nbdl,nvm), INTENT(out)           :: control_moist_soil !! Moisture control of heterotrophic 
+                                                                                       !! respiration aboveground(0.25-1,unitless)
+    REAL(r_std), DIMENSION(npts,nlitt), INTENT(out)              :: control_temp_above !! Temperature control of heterotrophic  
+                                                                                       !! respiration, above (0-1,  
+                                                                                       !! unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                :: control_moist_above!! Moisture control of heterotrophic  
+                                                                                       !! respiration aboveground(0.25-1, unitless) 
+
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(out) :: MatrixA          !! Matrix containing the fluxes between the
+                                                                                      !! carbon pools per sechiba time step 
+                                                                                      !! @tex $(gC.m^2.day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out)         :: VectorB          !! Vector containing the litter increase per
+                                                                                      !! sechiba time step
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    !! 0.3 Modified variables
+    
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)       :: litterpart         !! Fraction of litter above the ground 
+                                                                                      !! belonging to the different PFTs (0-1, 
+                                                                                      !! unitless)
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements), INTENT(inout) :: litter_above   !! Metabolic and structural litter,above ground
+                                                                                      !! The unit is given by m^2 of 
+                                                                                      !! ground @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements), INTENT(inout) ::litter_below  !! Metabolic and structural litter, below ground
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! ground @tex $(gC m^{-2} $ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)       :: dead_leaves        !! Dead leaves per ground unit area, per PFT,
+                                                                                      !! metabolic and structural in 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: lignin_struc_above  !! Ratio Lignin content in structural litter,
+                                                                                      !! above ground, (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nbdl), INTENT(inout)       :: lignin_struc_below  !! Ratio Lignin content in structural litter,
+                                                                                      !! below ground, (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,npool,nelements), INTENT(inout) :: soilcarbon_input !! Dissolved Organic Carbon input from litter decomposition
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! water @tex $(gC m^{-2})$ @endtex
+    !! 0.4 Local variables
+ 
+    REAL(r_std), SAVE, DIMENSION(nparts,nlitt)                  :: litterfrac         !! The fraction of leaves, wood, etc. that 
+                                                                                      !! goes into metabolic and structural 
+                                                                                      !! litterpools (0-1, unitless)
+!$OMP THREADPRIVATE(litterfrac)
+    REAL(r_std), SAVE, DIMENSION(0:nbdl)                        :: z_soil             !! Soil levels (m)
+!$OMP THREADPRIVATE(z_soil)
+                                                                                      !! profiles (unitless)
+    REAL(r_std), SAVE, DIMENSION(nlitt)                         :: litter_tau         !! Turnover time in litter pools (days)
+!$OMP THREADPRIVATE(litter_tau)
+    REAL(r_std), SAVE, DIMENSION(npool)                         :: pool_tau         !! Turnover time in litter and soil carbon pools (days)
+!$OMP THREADPRIVATE(pool_tau)
+    REAL(r_std), SAVE, DIMENSION(npool)                               :: DOC_tau          !! Residence time of DOC (days)    
+!$OMP THREADPRIVATE(DOC_tau)
+    REAL(r_std), SAVE, DIMENSION(nlitt,ncarb,nlevs)             :: frac_soil          !! Fraction of litter that goes into soil 
+                                                                                      !! (litter -> carbon, above and below). The
+                                                                                      !! remaining part goes to the atmosphere
+!$OMP THREADPRIVATE(frac_soil)
+    REAL(r_std), DIMENSION(npts)                                :: tsoil_decomp       !! Temperature used for decompostition in 
+                                                                                      !! soil (K)
+    REAL(r_std), DIMENSION(npts)                                :: soilhum_decomp     !! Humidity used for decompostition in soil
+                                                                                      !! (unitless)
+ !   REAL(r_std), SAVE, DIMENSION(npts)                          :: z_lit              !! Thickness of the above ground litter layer (mm)
+!!$OMP THREADPRIVATE(z_lit)
+
+    REAL(r_std), DIMENSION(npts)                                :: fd                 !! Fraction of structural or metabolic litter
+                                                                                      !! decomposed (unitless)
+    REAL(r_std), DIMENSION(npts,nelements)                      :: qd                 !! Quantity of structural or metabolic litter
+                                                                                      !! decomposed @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                            :: old_struc_above    !! Old structural litter, above ground 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbdl)                       :: old_struc_below    !! Old structural litter, below ground 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt, nelements)           :: litter_inc_PFT_above  !! Increase of litter, per PFT, metabolic and
+                                                                                      !! structural, above ground. The 
+                                                                                      !! unit is given by m^2 of ground.  
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nbdl,nelements)      :: litter_inc_PFT_below     !! Increase of litter, per PFT, metabolic and
+                                                                                      !! structural, above ground. The 
+                                                                                      !!unit is given by m^2 of ground.
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements)            :: litter_inc_above   !! Increase of metabolic and structural 
+                                                                                      !! litter, above ground. The unit 
+                                                                                      !! is given by m^2 of ground. 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements)       :: litter_inc_below   !! Increase of metabolic and structural 
+                                                                                      !! litter below ground. The unit
+                                                                                      !! is given by m^2 of ground
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+
+    REAL(r_std), DIMENSION(npts,nvm)                            :: lignin_struc_inc_above !! Lignin increase in structural litter, 
+                                                                                      !! above ground. The unit is given 
+                                                                                      !! by m^2 of ground. 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nbdl)                       :: lignin_struc_inc_below   !! Lignin increase in structural litter, 
+                                                                                      !! below ground. The unit is given
+                                                                                      !! by m^2 of ground
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements)            :: litter_pft         !! Metabolic and structural litter above the 
+                                                                                      !! ground per PFT
+    REAL(r_std), DIMENSION(npts)                                :: zdiff_min          !! Intermediate field for looking for minimum
+                                                                                      !! of what? this is not used in the code. 
+                                                                                      !! [??CHECK] could we delete it?
+    CHARACTER(LEN=10), DIMENSION(nlitt)                         :: litter_str         !! Messages to write output information about
+                                                                                      !! the litter
+    CHARACTER(LEN=22), DIMENSION(nparts)                        :: part_str           !! Messages to write output information about
+                                                                                      !! the plant
+    CHARACTER(LEN=7), DIMENSION(ncarb)                          :: carbon_str         !! Messages to write output information about
+                                                                                      !! the soil carbon
+    CHARACTER(LEN=5), DIMENSION(nlevs)                          :: level_str          !! Messages to write output information about
+                                                                                      !! the level (aboveground or belowground litter)
+    INTEGER(i_std)                                              :: i,j,k,l,m          !! Indices (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: Dif_coef           !! Diffusion coeficient used for bioturbation (m2 days-1)
+!!$OMP THREADPRIVATE(Dif_coef)
+
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements)       :: litter_flux        !! Belowground litter carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements)       :: litter_flux_old    !! Belowground litter carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f
+                                                                                      !! used for storage
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements)            :: litter_above_flux  !! Above litter carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f 
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements)            :: litter_above_flux_old  !! Above litter carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f
+                                                                                      !! used for storage
+    REAL(r_std), DIMENSION(npts)                                :: rpc                !! Scaling factor for integrating vertical soil 
+                                                                                      !! profiles (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)     :: check_intern       !! Contains the components of the internal
+                                                                                      !! mass balance chech for this routine
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)             :: closure_intern     !! Check closure of internal mass balance
+
+    REAL(r_std), DIMENSION(npts,nvm,nelements)             :: pool_start         !! Start and end pool of this routine 
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)             :: pool_end           !! End pool of this routine not corrected
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nelements)             :: pool_end_after           !! Start and end pool of this routine 
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nbdl)                      :: moist_soil         !! moisture in soil for one pixel (m3/m3)
+
+   ! REAL(r_std), DIMENSION(npts,nvm,nbdl)                       :: resp_hetero_litter_layer !! Litter heterotrophic respiration per layer. The unit
+                                                                                      !! is given by m^2 of ground by z.  
+                                                                                      !! @tex $(gC dtradia one\_day^{-1}) m^{-2} z^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements)  ::litter_below_old         !! Metabolic and structural litter, below ground
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! ground @tex $(gC m^{-2} $ @endtex used for storage
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements)  ::litter_below_old_buffer  !! Metabolic and structural litter, below ground
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! ground @tex $(gC m^{-2} $ @endtex used for storage
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements)       :: litter_above_old        !! Metabolic and structural litter,above ground
+                                                                                      !! The unit is given by m^2 of 
+                                                                                      !! ground @tex $(gC m^{-2})$ @endtex used for storage
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering littercalc'
+
+  !! 1. Initialisations of the different fields during the first call of the routine 
+    !! 1.0 Calculation of soil moisture
+    moist_soil(:,:) = zero
+      DO l = 1,nbdl
+          DO i = 1, nstm
+             moist_soil(:,l)= moist_soil(:,l) + soil_mc(:,l,i)*soiltile(:,i)
+          ENDDO
+      ENDDO
+
+    WHERE (bulk_dens(:) .LT. 500)
+    bulk_dens(:) = bulk_dens(:)*1e3
+    ENDWHERE
+
+    !! 1.1 Initialize check for mass balance closure
+    !  The mass balance is calculated at the end of this routine
+    !  in section 14. Initial biomass and harvest pool and all other
+    !  relevant pools were set to zero before calling this routine.
+    pool_start(:,:,:) = zero
+IF (control%ld_doc) THEN
+    DO m = 2, nvm
+       DO i = 1,nlitt
+          DO l = 1, nbdl
+                 pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
+                           ( litter_below(:,i,m,l,icarbon) ) * veget_max(:,m)
+          ENDDO
+       ENDDO
+    ENDDO
+
+    DO m = 2, nvm
+       DO i = 1,nlitt
+                 pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
+                           ( litter_above(:,i,m,icarbon) ) * veget_max(:,m)
+       ENDDO
+    ENDDO
+
+    DO m = 2, nvm
+       DO i = 1, nparts
+          pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
+                    (turnover(:,m,i,icarbon) + bm_to_litter(:,m,i,icarbon)) * veget_max(:,m)
+      ENDDO
+    ENDDO
+ENDIF
+    IF ( firstcall ) THEN
+
+       !! 1.2.1 litter fractions:
+       !!   what fraction of leaves, wood, etc. goes into metabolic and structural litterpools
+       DO k = 1, nparts
+
+          litterfrac(k,imetabolic) = metabolic_ref_frac - metabolic_LN_ratio * LC(k) * CN(k)
+          litterfrac(k,istructural) = un - litterfrac(k,imetabolic)
+
+       ENDDO
+
+       !! 1.2.2 residence times in litter pools (days)
+       litter_tau(imetabolic) = tau_metabolic * one_year      ! .5 years
+       litter_tau(istructural) = tau_struct * one_year     ! 3 years
+
+       pool_tau(imetabo) = tau_metabolic * one_year
+       pool_tau(istrabo) = tau_struct * one_year
+       pool_tau(imetbel) = tau_metabolic * one_year
+       pool_tau(istrbel) = tau_struct * one_year
+       pool_tau(iact) = carbon_tau_iactive * one_year
+       pool_tau(islo) = carbon_tau_islow * one_year
+       pool_tau(ipas) = carbon_tau_ipassive * one_year
+       DOC_tau(imetabo) = DOC_tau_labile * one_day
+       DOC_tau(istrabo) = DOC_tau_labile * one_day
+       DOC_tau(imetbel) = DOC_tau_labile * one_day
+       DOC_tau(istrbel) = DOC_tau_labile * one_day
+       DOC_tau(iact) = DOC_tau_labile * one_day
+       DOC_tau(islo) = DOC_tau_stable * one_day
+       DOC_tau(ipas) = DOC_tau_stable * one_day
+
+
+       !! 1.2.3 decomposition flux fraction that goes into soil
+       !       (litter -> carbon, above and below)
+       !       1-frac_soil goes into atmosphere
+       frac_soil(:,:,:) = zero
+
+       ! structural litter: lignin fraction goes into slow pool + respiration,
+       !                    rest into active pool + respiration
+       frac_soil(istructural,iactive,iabove) = frac_soil_struct_aa
+       frac_soil(istructural,iactive,ibelow) = frac_soil_struct_ab
+       frac_soil(istructural,islow,iabove) = frac_soil_struct_sa
+       frac_soil(istructural,islow,ibelow) = frac_soil_struct_sb
+
+       ! metabolic litter: all goes into active pool + respiration.
+       !   Nothing into slow or passive pool.
+       frac_soil(imetabolic,iactive,iabove) = frac_soil_metab_aa
+       frac_soil(imetabolic,iactive,ibelow) = frac_soil_metab_ab
+       
+       !! 1.3 soil levels
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+ 
+       !! 1.4 messages
+       litter_str(imetabolic) = 'metabolic'
+       litter_str(istructural) = 'structural'
+
+       carbon_str(iactive) = 'active'
+       carbon_str(islow) = 'slow'
+       carbon_str(ipassive) = 'passive'
+
+       level_str(iabove) = 'above'
+       level_str(ibelow) = 'below'
+
+       part_str(ileaf) = 'leaves'
+       part_str(isapabove) = 'sap above ground'
+       part_str(isapbelow) = 'sap below ground'
+       part_str(iheartabove) = 'heartwood above ground'
+       part_str(iheartbelow) = 'heartwood below ground'
+       part_str(iroot) = 'roots'
+       part_str(ifruit) = 'fruits'
+       part_str(icarbres) = 'carbohydrate reserve'
+
+       WRITE(numout,*) 'litter:'
+
+       WRITE(numout,*) '   > C/N ratios: '
+       DO k = 1, nparts
+          WRITE(numout,*) '       ', part_str(k), ': ',CN(k)
+       ENDDO
+
+       WRITE(numout,*) '   > Lignine/C ratios: '
+       DO k = 1, nparts
+          WRITE(numout,*) '       ', part_str(k), ': ',LC(k)
+       ENDDO
+
+       WRITE(numout,*) '   > fraction of compartment that goes into litter: '
+       DO k = 1, nparts
+          DO m = 1, nlitt
+             WRITE(numout,*) '       ', part_str(k), '-> ',litter_str(m), ':',litterfrac(k,m)
+          ENDDO
+       ENDDO
+
+       WRITE(numout,*) '   > minimal carbon residence time in litter pools (d):'
+       DO m = 1, nlitt
+          WRITE(numout,*) '       ',litter_str(m),':',litter_tau(m)
+       ENDDO
+
+       WRITE(numout,*) '   > litter decomposition flux fraction that really goes '
+       WRITE(numout,*) '     into carbon pools (rest into the atmosphere):'
+       DO m = 1, nlitt
+          DO l = 1, nlevs
+             DO k = 1, ncarb
+                WRITE(numout,*) '       ',litter_str(m),' ',level_str(l),' -> ',&
+                     carbon_str(k),':', frac_soil(m,k,l)
+             ENDDO
+          ENDDO
+       ENDDO
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+    !! 1.3 Initialization
+    litter_above_flux(:,:,:,:) = zero
+    litter_flux(:,:,:,:,:) = zero
+    litter_flux_old(:,:,:,:,:) = zero
+    old_struc_above(:,:) = zero
+    old_struc_below(:,:,:) = zero
+    litter_pft(:,:,:,:) = zero
+    Dif_coef(:) = (Dif/one_year)*dt 
+
+    
+    !! 1.3 litter above the ground per PFT.
+    DO j = 2, nvm ! Loop over # PFTs
+       DO k = 1, nlitt !Loop over litter pool
+          litter_pft(:,j,k,icarbon) = litterpart(:,j,k) * litter_above(:,k,j,icarbon)
+       ENDDO
+    ENDDO
+
+    
+    !! 1.4 set output to zero
+    deadleaf_cover(:) = zero
+    resp_hetero_litter(:,:) = zero
+    soilcarbon_input(:,:,:,:,:)= zero
+    !resp_hetero_litter_layer(:,:,:) = zero
+
+  !! 2. Add biomass to different litterpools (per m^2 of ground)
+    
+    !! 2.1 first, save old structural litter (needed for lignin fractions).
+    !     above
+       DO m = 2,nvm !Loop over PFTs
+
+          old_struc_above(:,m) = litter_above(:,istructural,m,icarbon)
+
+       ENDDO
+
+    !below
+    DO l = 1, nbdl !Loop over soil levels (below ground)
+       DO m = 2,nvm !Loop over PFTs
+
+          old_struc_below(:,m,l) = litter_below(:,istructural,m,l,icarbon)
+
+       ENDDO
+    ENDDO
+    
+    !! 2.2 update litter, dead leaves, and lignin content in structural litter
+    litter_inc_above(:,:,:,:) = zero
+    lignin_struc_inc_above(:,:) = zero
+    litter_inc_below(:,:,:,:,:) = zero
+    lignin_struc_inc_below(:,:,:) = zero
+    litter_inc_PFT_above(:,:,:,:) = zero
+    litter_inc_PFT_below(:,:,:,:,:) = zero
+
+
+    DO j = 2,nvm !Loop over PFTs
+
+       !! 2.2.1 litter
+       DO k = 1, nlitt    !Loop over litter pools (metabolic and structural)
+
+          !! 2.2.2 calculate litter increase (per m^2 of ground).
+          !       Only a given fracion of fruit turnover is directly coverted into litter.
+          !       Litter increase for each PFT, structural and metabolic, above/below. It must
+          !       be noted that the distribution of above ground litter is done within the soil layers
+          !       as a proportion of the layer size. But for the below ground layer it follows the root profile
+
+          ! For the first litter layer
+          litter_inc_PFT_above(:,j,k,icarbon) = &
+               litterfrac(ileaf,k) * bm_to_litter(:,j,ileaf,icarbon) + &
+               litterfrac(isapabove,k) * bm_to_litter(:,j,isapabove,icarbon) + &
+               litterfrac(iheartabove,k) * bm_to_litter(:,j,iheartabove,icarbon) + &
+               litterfrac(ifruit,k) * bm_to_litter(:,j,ifruit,icarbon) + &
+               litterfrac(icarbres,k) * bm_to_litter(:,j,icarbres,icarbon) + &
+               litterfrac(ileaf,k) * turnover(:,j,ileaf,icarbon) + &
+               litterfrac(isapabove,k) * turnover(:,j,isapabove,icarbon) + &
+               litterfrac(iheartabove,k) * turnover(:,j,iheartabove,icarbon) + &
+               litterfrac(ifruit,k) * turnover(:,j,ifruit,icarbon) + &
+               litterfrac(icarbres,k) * turnover(:,j,icarbres,icarbon) 
+
+             ! litter increase, met/struct, above
+             litter_inc_above(:,k,j,icarbon) = litter_inc_above(:,k,j,icarbon) + litter_inc_PFT_above(:,j,k,icarbon)
+
+          !! The function used for root profile is coming from stomate_npp.f90
+
+       rpc(:) = un /( ( un - EXP( -z_soil(nbdl) / rprof(:,j) )) ) 
+
+          DO l = 1, nbdl
+
+             litter_inc_PFT_below(:,j,k,l,icarbon) = &
+                  litterfrac(isapbelow,k) * bm_to_litter(:,j,isapbelow,icarbon) *  &
+               rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  litterfrac(iheartbelow,k) * bm_to_litter(:,j,iheartbelow,icarbon) * &
+               rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  litterfrac(iroot,k) * bm_to_litter(:,j,iroot,icarbon) * &
+               rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  litterfrac(isapbelow,k) * turnover(:,j,isapbelow,icarbon) * &
+               rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  litterfrac(iheartbelow,k) * turnover(:,j,iheartbelow,icarbon) * &
+               rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  litterfrac(iroot,k) * turnover(:,j,iroot,icarbon) * &
+               rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) )
+
+             ! litter increase, met/struct, below
+             litter_inc_below(:,k,j,l,icarbon) = litter_inc_below(:,k,j,l,icarbon) + litter_inc_PFT_below(:,j,k,l,icarbon)
+          ENDDO
+          !! 2.2.3 dead leaves, for soil cover.
+          dead_leaves(:,j,k) = &
+               dead_leaves(:,j,k) + &
+               litterfrac(ileaf,k) * ( bm_to_litter(:,j,ileaf,icarbon) + turnover(:,j,ileaf,icarbon) )
+
+          !! 2.2.4 lignin increase in structural litter
+          IF ( k .EQ. istructural ) THEN
+
+             lignin_struc_inc_above(:,j) = &
+                  lignin_struc_inc_above(:,j) + &
+                  LC(ileaf) * bm_to_litter(:,j,ileaf,icarbon) + &
+                  LC(isapabove) * bm_to_litter(:,j,isapabove,icarbon) + &
+                  LC(iheartabove) * bm_to_litter(:,j,iheartabove,icarbon) + &
+                  LC(ifruit) * bm_to_litter(:,j,ifruit,icarbon) + &
+                  LC(icarbres) * bm_to_litter(:,j,icarbres,icarbon) + &
+                  LC(ileaf) * turnover(:,j,ileaf,icarbon) + &
+                  LC(isapabove) * turnover(:,j,isapabove,icarbon) + &
+                  LC(iheartabove) * turnover(:,j,iheartabove,icarbon) + &
+                  LC(ifruit) * turnover(:,j,ifruit,icarbon) + &
+                  LC(icarbres) * turnover(:,j,icarbres,icarbon) 
+
+            !! The function used for root profile is coming from stomate_npp.f90
+            DO l = 1, nbdl
+
+               lignin_struc_inc_below(:,j,l) = &
+                  lignin_struc_inc_below(:,j,l) + &
+                  LC(isapbelow) * bm_to_litter(:,j,isapbelow,icarbon) * &
+                  rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  LC(iheartbelow) * bm_to_litter(:,j,iheartbelow,icarbon) * &
+                  rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  LC(iroot) * bm_to_litter(:,j,iroot,icarbon) * &
+                  rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  LC(isapbelow)*turnover(:,j,isapbelow,icarbon) * &
+                  rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  LC(iheartbelow)*turnover(:,j,iheartbelow,icarbon) * &
+                  rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) ) + &
+                  LC(iroot)*turnover(:,j,iroot,icarbon) * &
+                  rpc(:) * ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) )
+            ENDDO
+
+          ENDIF
+       ENDDO
+     ENDDO
+
+
+
+    !! 2.2.5 add new litter (struct/met, above/below)
+         litter_above(:,:,:,:) = litter_above(:,:,:,:) + litter_inc_above(:,:,:,:)
+         litter_below(:,:,:,:,:) = litter_below(:,:,:,:,:) + litter_inc_below(:,:,:,:,:)
+
+    !! 2.2.6 for security: can't add more lignin than structural litter (above/below)
+       DO m = 2,nvm !Lopp over PFTs
+
+          lignin_struc_inc_above(:,m) = &
+               MIN( lignin_struc_inc_above(:,m), litter_inc_above(:,istructural,m,icarbon) )
+
+       ENDDO
+
+    DO l = 1, nbdl !Loop over soil levels (below ground)
+       DO m = 2,nvm !Lopp over PFTs
+
+          lignin_struc_inc_below(:,m,l) = &
+               MIN( lignin_struc_inc_below(:,m,l), litter_inc_below(:,istructural,m,l,icarbon) )
+
+       ENDDO
+    ENDDO
+
+    !! 2.2.7.1 new lignin content: add old lignin and lignin increase, divide by 
+    !!       total structural litter (above)
+
+       DO m = 2,nvm !Loop over PFTs
+          WHERE( litter_above(:,istructural,m,icarbon) .GT. min_stomate )
+
+       !MM : Soenke modif
+       ! Best vectorization ?
+!!$       lignin_struc(:,:,:) = &
+!!$            ( lignin_struc(:,:,:)*old_struc(:,:,:) + lignin_struc_inc(:,:,:) ) / &
+!!$            litter(:,istructural,:,:,icarbon)
+
+             lignin_struc_above(:,m) = lignin_struc_above(:,m) * old_struc_above(:,m)
+             lignin_struc_above(:,m) = lignin_struc_above(:,m) + lignin_struc_inc_above(:,m)
+             lignin_struc_above(:,m) = lignin_struc_above(:,m) / litter_above(:,istructural,m,icarbon)
+          ELSEWHERE
+             lignin_struc_above(:,m) = zero
+          ENDWHERE
+       ENDDO
+
+    !! 2.2.7.2 new lignin content: add old lignin and lignin increase, divide by 
+    !!       total structural litter (below)
+    DO l = 1, nbdl !Loop over soil levels (below ground)
+       DO m = 2,nvm !Loop over PFTs
+          WHERE( litter_below(:,istructural,m,l,icarbon) .GT. min_stomate )
+
+       !MM : Soenke modif
+       ! Best vectorization ?
+!!$       lignin_struc(:,:,:) = &
+!!$            ( lignin_struc(:,:,:)*old_struc(:,:,:) + lignin_struc_inc(:,:,:)) / &
+!!$            litter(:,istructural,:,:,icarbon)
+
+             lignin_struc_below(:,m,l) = lignin_struc_below(:,m,l) * old_struc_below(:,m,l)
+             lignin_struc_below(:,m,l) = lignin_struc_below(:,m,l) + lignin_struc_inc_below(:,m,l)
+             lignin_struc_below(:,m,l) = lignin_struc_below(:,m,l) /litter_below(:,istructural,m,l,icarbon)
+          ELSEWHERE
+             lignin_struc_below(:,m,l) = zero
+          ENDWHERE
+       ENDDO
+    ENDDO
+
+    
+    !! 2.3 new litter fraction per PFT (for structural and metabolic litter, above
+    !!       the ground).
+       DO j = 2,nvm !Loop over PFTs
+         DO l =1,nlitt 
+         WHERE ( litter_above(:,l,j,icarbon) .GT. min_stomate )
+
+          litterpart(:,j,l) = &
+               ( litter_pft(:,j,l,icarbon) + litter_inc_PFT_above(:,j,l,icarbon) ) / litter_above(:,l,j,icarbon)
+
+         ELSEWHERE
+
+          litterpart(:,j,l) = zero
+
+         ENDWHERE
+         ENDDO
+       ENDDO
+  !! 3. Temperature control on decay: Factor between 0 and 1
+
+    !! 3.1 above: surface temperature 
+    DO j=1,nlitt
+       control_temp_above(:,j) = control_temp_func (npts, tsurf,litter_tau(j)) 
+    ENDDO         
+    !! 3.2 below: convolution of temperature and decomposer profiles
+    !!            (exponential decomposer profile supposed)
+   
+    !! 3.2.1 integrate over the nbdl levels
+    tsoil_decomp(:) = zero
+
+    DO l = 1, nbdl
+       DO j = 1,npool
+
+          tsoil_decomp(:) = tsoil(:,l) 
+
+          control_temp_soil(:,l,j) = control_temp_func (npts,tsoil_decomp,pool_tau(j))
+
+       ENDDO
+    ENDDO
+
+    DO l = 1, nbdl
+       DO j = 1,npool
+
+          tsoil_decomp(:) = tsoil(:,l)
+
+          control_temp_soil(:,l,npool+j) = control_temp_func(npts,tsoil_decomp,DOC_tau(j))
+
+       ENDDO
+    ENDDO
+
+  !! 4. Moisture control. Factor between 0 and 1
+
+    !! 4.1 above the ground: litter humidity 
+
+
+    soilhum_decomp(:) = zero
+    DO m= 2,nvm
+       !We used the sum over the 4 first layer as it is done to
+       !compute litterhum in hydrol.f90
+         soilhum_decomp(:) =soil_mc(:,1,pref_soil_veg(m))*(z_soil(1)/z_soil(4)) + &
+                            soil_mc(:,2,pref_soil_veg(m))*((z_soil(2)-z_soil(1))/z_soil(4)) + &
+                            soil_mc(:,3,pref_soil_veg(m))*((z_soil(3)-z_soil(2))/z_soil(4)) + &
+                            soil_mc(:,4,pref_soil_veg(m))*((z_soil(4)-z_soil(3))/z_soil(4))
+
+       IF (moist_func_Moyano) THEN
+        control_moist_above(:,m) = control_moist_func_moyano (npts, soilhum_decomp,bulk_dens, &
+                                                    clay, carbon, veget_max)
+       ELSE 
+         control_moist_above(:,m) = control_moist_func (npts,soilhum_decomp)
+       ENDIF
+    ENDDO
+    !! 4.2 below: soil humidity for each soil layers 
+
+    !! 4.2.1 integrate over the nbdl levels
+    soilhum_decomp(:) = zero
+
+    DO l = 1, nbdl !Loop over soil levels
+      DO m =2,nvm
+         soilhum_decomp(:) =soil_mc(:,l,pref_soil_veg(m))
+         IF (moist_func_Moyano) THEN
+         control_moist_soil(:,l,m) = control_moist_func_moyano (npts, soilhum_decomp,bulk_dens, &
+                                                  clay, carbon, veget_max)
+         ELSE
+         control_moist_soil(:,l,m) = control_moist_func (npts, soilhum_decomp)
+         ENDIF
+
+      ENDDO
+    ENDDO
+
+  !! 5. fluxes from above ground litter to carbon pools and respiration
+      DO m = 2,nvm !Loop over PFTs
+
+          !! 5.1 structural litter: goes into active and slow carbon pools + respiration
+
+          !! 5.1.1 total quantity of above ground structural litter which is decomposed
+
+      WHERE (soil_mc(:,1,pref_soil_veg(m)) .GT. zero)
+          fd(:) = dt/litter_tau(istructural) * &
+             control_temp_above(:,istructural) * control_moist_above(:,m) * exp( -litter_struct_coef * lignin_struc_above(:,m) ) 
+      ELSEWHERE
+          fd(:) = zero
+      ENDWHERE
+          DO k = 1,nelements
+
+             qd(:,k) = litter_above(:,istructural,m,k) * fd(:)
+
+          ENDDO
+
+          !! 5.1.2 decompose same fraction of structural part of dead leaves. Not exact
+          !!       as lignine content is not the same as that of the total structural litter.
+          dead_leaves(:,m,istructural) = dead_leaves(:,m,istructural) * ( un - fd(:) )
+
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m) = resp_hetero_litter(:,m) + &
+               ( 1. - frac_soil(istructural,iactive,iabove) ) * qd(:,icarbon) * &
+               ( 1. - lignin_struc_above(:,m) ) / dt
+
+
+          !resp_hetero_litter_layer(:,m,1) = resp_hetero_litter_layer(:,m,1) + &
+          !    ( 1. - frac_soil(istructural,iactive,iabove) ) * qd(:,icarbon) * &
+          !     ( 1. - lignin_struc_above(:,m) ) / dt
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m) = resp_hetero_litter(:,m) + &
+               ( 1. - frac_soil(istructural,islow,iabove) ) * qd(:,icarbon) * lignin_struc_above(:,m) / dt
+
+         ! resp_hetero_litter_layer(:,m,1) = resp_hetero_litter_layer(:,m,1) + &
+         !      ( 1. - frac_soil(istructural,islow,iabove) ) * qd(:,icarbon) *lignin_struc_above(:,m) / dt
+
+          !! 5.1.3 Calculation of the soilcarbon_input in gC m^-2 of water
+
+          DO k = 1, nelements
+
+             soilcarbon_input(:,m,1,istrabo,k) = (frac_soil(istructural,iactive,iabove) * ( 1. - lignin_struc_above(:,m) ) *  qd(:,k) + &
+                                  frac_soil(istructural,islow,iabove) *  qd(:,k) * lignin_struc_above(:,m) ) /dt 
+         ENDDO
+
+          litter_above(:,istructural,m,:) = litter_above(:,istructural,m,:) - qd(:,:)
+
+
+          
+          !! 5.2 above ground metabolic litter goes into active carbon pool + respiration
+         
+          !! 5.2.1 total quantity of aboveground metabolic litter that is decomposed
+      WHERE (soil_mc(:,1,pref_soil_veg(m)) .GT. zero)
+          fd(:) = dt/litter_tau(imetabolic) * control_temp_above(:,imetabolic) * control_moist_above(:,m)
+      ELSEWHERE
+          fd(:) = zero
+      ENDWHERE
+
+          DO k = 1,nelements
+          
+             qd(:,k) = litter_above(:,imetabolic,m,k) * fd(:)
+
+          ENDDO
+
+
+          !! 5.2.2 decompose same fraction of metabolic part of dead leaves.
+          dead_leaves(:,m,imetabolic) = dead_leaves(:,m,imetabolic) * ( 1. - fd(:) )
+
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m) = resp_hetero_litter(:,m) + &
+               ( 1. - frac_soil(imetabolic,iactive,iabove) ) * qd(:,icarbon) / dt
+
+         ! resp_hetero_litter_layer(:,m,1) = resp_hetero_litter_layer(:,m,1) + &
+         !      ( 1. - frac_soil(imetabolic,iactive,iabove) ) * qd(:,icarbon) / dt
+
+          !! 5.2.3 Calculation of the soilcarbon_input in gC m^-2 of water
+             ! For above ground litter we assume that the soilcarbon_input coming from AB
+             ! litter decomposition is directly incorporated into the 1st soil
+             ! layers
+
+          DO k = 1, nelements
+
+             soilcarbon_input(:,m,1,imetabo,k) = frac_soil(imetabolic,iactive,iabove) *  qd(:,k) / dt 
+
+         ENDDO
+
+          litter_above(:,imetabolic,m,:) = litter_above(:,imetabolic,m,:) - qd(:,:)
+
+      ENDDO
+
+!! 6. fluxes from below ground litter to carbon pools and respiration
+   DO l = 1,nbdl
+       DO m = 2,nvm !Loop over PFTs
+
+          !! 6.1 structural litter: goes into active and slow carbon pools respiration
+
+          !! 6.1.1 total quantity of below ground structural litter which is decomposed
+    WHERE (soil_mc(:,l,pref_soil_veg(m)) .GT. zero)
+          fd(:) = dt/litter_tau(istructural) * &
+               control_temp_soil(:,l,istrbel) * control_moist_soil(:,l,m) * exp(-litter_struct_coef * lignin_struc_below(:,m,l) )
+    ELSEWHERE
+          fd(:) = zero
+    ENDWHERE
+
+          DO k = 1,nelements
+
+             qd(:,k) = litter_below(:,istructural,m,l,k) * fd(:)
+
+          ENDDO
+
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m) = resp_hetero_litter(:,m) + &
+               ( 1. - frac_soil(istructural,iactive,ibelow) ) * qd(:,icarbon) * &
+               ( 1. - lignin_struc_below(:,m,l) ) / dt
+
+         ! resp_hetero_litter_layer(:,m,l) = resp_hetero_litter_layer(:,m,l) + &
+         !      ( 1. - frac_soil(istructural,iactive,ibelow) ) * qd(:,icarbon) * &
+         !      ( 1. - lignin_struc_below(:,m,l) ) / dt
+
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m) = resp_hetero_litter(:,m) + &
+               ( 1. - frac_soil(istructural,islow,ibelow) ) * qd(:,icarbon) * lignin_struc_below(:,m,l) / dt
+
+         ! resp_hetero_litter_layer(:,m,l) = resp_hetero_litter_layer(:,m,l) + &
+         !      ( 1. - frac_soil(istructural,islow,ibelow) ) * qd(:,icarbon) * lignin_struc_below(:,m,l) / dt
+
+          !! 6.1 Calculation of the soilcarbon_input in gC m^-2
+
+          DO k = 1, nelements
+
+
+                  soilcarbon_input(:,m,l,istrbel,k) = (frac_soil(istructural,iactive,ibelow) * ( 1. - lignin_struc_below(:,m,l) ) * qd(:,k) + & 
+                                             (frac_soil(istructural,islow,ibelow) * qd(:,k) * lignin_struc_below(:,m,l) )) / dt 
+         ENDDO
+
+      litter_below(:,istructural,m,l,:) = litter_below(:,istructural,m,l,:) - qd(:,:)
+
+          !! 6.2 below ground metabolic litter goes into active carbon pool + respiration
+
+          !! 6.2.1 total quantity of belowground metabolic litter that is decomposed
+    WHERE (soil_mc(:,l,pref_soil_veg(m)) .GT. zero)
+          fd(:) = dt/litter_tau(imetabolic) * control_temp_soil(:,l,imetbel) * control_moist_soil(:,l,m)
+    ELSEWHERE
+          fd(:) = zero
+    ENDWHERE
+
+          DO k = 1,nelements
+
+             qd(:,k) = litter_below(:,imetabolic,m,l,k) * fd(:)
+
+          ENDDO
+
+
+      !BE CAREFUL: Here resp_hetero_litter is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_litter is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+          resp_hetero_litter(:,m) = resp_hetero_litter(:,m) + &
+               ( 1. - frac_soil(imetabolic,iactive,ibelow) ) * qd(:,icarbon) /dt
+
+        !  resp_hetero_litter_layer(:,m,l) = resp_hetero_litter_layer(:,m,l) + &
+        !       ( 1. - frac_soil(imetabolic,iactive,ibelow) ) * qd(:,icarbon) /dt
+
+
+          !! 6.2.3 Calculation of the soilcarbon_input in gC m^-2 of water
+
+          DO k = 1, nelements
+                soilcarbon_input(:,m,l,imetbel,k) = frac_soil(imetabolic,iactive,ibelow) * qd(:,k) / dt 
+
+         ENDDO
+    
+      litter_below(:,imetabolic,m,l,:) = litter_below(:,imetabolic,m,l,:) - qd(:,:)
+
+       ENDDO
+   ENDDO
+
+
+  !! 7. Transport of particulate organic C (i.e. active, slow and passive
+  !! pools) following the second Fick's Law (OÂ¿Brien and Stout, 1978; Wynn
+  !! et al., 2005). Represent the bioturbation and is generally associated
+  !! with transport in the liquid phase like in the section 3.2.5 (Elzein
+  !! and Balesdent, 1995; Bruun et al., 2007; Braakhekke et al., 2011,
+  !! Guenet et al., 2013) 
+
+  ! Definition of the diffusion rate from Guenet et al., (2013) BG for the
+  ! moment but must depends on clay, ph organic C, or whatever...
+
+!   DO m =2,nvm
+!      DO k = 1, nelements
+!         DO j = 1,nlitt
+!            litter_above_flux(:,j,m,k) = Dif_coef(:)*dt*ABS(litter_above(:,j,m,k)/(z_litter*1e-3)-litter_below(:,j,m,1,k)/(z_litter*1e-3-z_soil(1)))
+!            ! BE CAREFUL: Here very important assumption we assume the above ground litter layers to be 10mm thick by default. 
+!
+!            litter_flux(:,j,m,1,k) = Dif_coef(:)*dt*ABS(litter_below(:,j,m,1,k)/(z_soil(1))-litter_below(:,j,m,2,k)/(z_soil(2)-z_soil(1)))/(z_soil(2)-z_soil(1))
+!
+!           DO l = 2, nbdl-1
+!            litter_flux(:,j,m,l,k) = Dif_coef(:)*dt*ABS(litter_below(:,j,m,l,k)/(z_soil(l)-z_soil(l-1))-litter_below(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)))/(z_soil(l+1)-z_soil(l))  
+!           ENDDO
+!
+!           WHERE ((litter_above(:,j,m,k)/(z_litter*1e-3) .LT. litter_below(:,j,m,1,k)/(z_soil(1))) )
+!            litter_above(:,j,m,k) = litter_above(:,j,m,k) + MIN(litter_below(:,j,m,1,k),litter_above_flux(:,j,m,k))
+!            litter_below(:,j,m,1,k) = litter_below(:,j,m,1,k) - MIN(litter_below(:,j,m,1,k),litter_above_flux(:,j,m,k))
+!           ELSEWHERE ((litter_above(:,j,m,k)/(z_litter*1e-3) .GT. litter_below(:,j,m,1,k)/(z_soil(1)))) 
+!            litter_above(:,j,m,k) = litter_above(:,j,m,k) - MIN(litter_above(:,j,m,k),litter_above_flux(:,j,m,k))
+!            litter_below(:,j,m,1,k) = litter_below(:,j,m,1,k) + MIN(litter_above(:,j,m,k),litter_above_flux(:,j,m,k))
+!           ELSEWHERE 
+!            litter_above(:,j,m,k) = litter_above(:,j,m,k)
+!            litter_below(:,j,m,1,k) = litter_below(:,j,m,1,k)
+!           ENDWHERE
+! 
+!           WHERE ((litter_below(:,j,m,1,k)/(z_soil(1)) .LT. litter_below(:,j,m,2,k)/(z_soil(2)-z_soil(1)))) 
+!            litter_below(:,j,m,1,k) = litter_below(:,j,m,1,k) + MIN(litter_below(:,j,m,2,k),litter_flux(:,j,m,1,k))
+!            litter_below(:,j,m,2,k) = litter_below(:,j,m,2,k) - MIN(litter_below(:,j,m,2,k),litter_flux(:,j,m,1,k))
+!           ELSEWHERE ((litter_below(:,j,m,1,k)/(z_soil(1)) .GT. litter_below(:,j,m,2,k)/(z_soil(2)-z_soil(1))) )
+!            litter_below(:,j,m,1,k) = litter_below(:,j,m,1,k) - MIN(litter_below(:,j,m,1,k),litter_flux(:,j,m,1,k))
+!            litter_below(:,j,m,2,k) = litter_below(:,j,m,2,k) + MIN(litter_below(:,j,m,1,k),litter_flux(:,j,m,1,k))
+!           ELSEWHERE 
+!            litter_below(:,j,m,1,k) = litter_below(:,j,m,1,k)
+!            litter_below(:,j,m,2,k) = litter_below(:,j,m,2,k)
+!           ENDWHERE
+!
+!
+ !     DO l= 2, nbdl-1 ! Loop over soil layers
+!
+!           WHERE ((litter_below(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .LT. litter_below(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l))) )
+!            litter_below(:,j,m,l,k) = litter_below(:,j,m,l,k) + MIN(litter_below(:,j,m,l+1,k),litter_flux(:,j,m,l,k))
+!            litter_below(:,j,m,l+1,k) = litter_below(:,j,m,l+1,k) - MIN(litter_below(:,j,m,l+1,k),litter_flux(:,j,m,l,k))
+!           ELSEWHERE ((litter_below(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .GT. litter_below(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l))) )
+!            litter_below(:,j,m,l,k) = litter_below(:,j,m,l,k) - MIN(litter_below(:,j,m,l,k),litter_flux(:,j,m,l,k))
+!            litter_below(:,j,m,l+1,k) = litter_below(:,j,m,l+1,k) + MIN(litter_below(:,j,m,l,k),litter_flux(:,j,m,l,k))
+!           ELSEWHERE
+!            litter_below(:,j,m,l,k) = litter_below(:,j,m,l,k)
+!           ENDWHERE
+!
+!          ENDDO ! End loop over elements
+!        ENDDO ! End loop over carbon pools
+!      ENDDO ! End loop over soil layers
+!
+!    ENDDO
+
+DO m =2,nvm
+
+litter_below_old(:,:,m,:,:)=zero
+litter_below_old_buffer(:,:,m,:,:)=zero
+litter_below_old(:,:,m,:,:)=litter_below(:,:,m,:,:)
+litter_above_old(:,:,m,:)=zero
+litter_above_old(:,:,m,:)=litter_above(:,:,m,:)
+      DO k = 1, nelements ! Loop over elements
+         DO j = 1,nlitt ! Loop over litter pools
+
+        litter_flux(:,j,m,1,k) = Dif_coef(:)*dt*ABS(litter_below_old(:,j,m,1,k)/(z_soil(1))-litter_below_old(:,j,m,2,k)/(z_soil(2)-z_soil(1)))/(z_soil(2)-z_soil(1))
+        litter_above_flux(:,j,m,k) = Dif_coef(:)*dt*ABS(litter_above(:,j,m,k)/(z_litter*1e-3)-litter_below(:,j,m,1,k)/(z_litter*1e-3-z_soil(1)))
+            ! BE CAREFUL: Here very important assumption we assume the above ground litter layers to be 10mm thick by default.
+
+      DO l= 2, nbdl-1 ! Loop over soil layers
+        litter_flux(:,j,m,l,k) = Dif_coef(:)*dt*ABS(litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1))-litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)))/(z_soil(l+1)-z_soil(l))
+      ENDDO
+        litter_flux_old(:,j,m,:,k) = litter_flux(:,j,m,:,k)
+        litter_above_flux_old(:,j,m,k) = litter_above_flux(:,j,m,k)
+
+       !Below we checked if in case that, in a given layer, you have diffusion in the above and below litters, both fluxes are not higher than the stocks of the given layer.
+           WHERE (litter_above_old(:,j,m,k)/(z_litter*1e-3) .LT. litter_below_old(:,j,m,1,k)/(z_soil(1)) .AND. &
+                  litter_below_old(:,j,m,2,k)/(z_soil(2)-z_soil(1)) .LT. litter_below_old(:,j,m,1,k)/(z_soil(1)) .AND. &
+                  litter_above_flux_old(:,j,m,k)+litter_flux_old(:,j,m,1,k) .GT. litter_below_old(:,j,m,1,k))
+            litter_above_flux(:,j,m,k) = litter_below_old(:,j,m,1,k)*(litter_above_flux_old(:,j,m,k)/(litter_above_flux_old(:,j,m,k)+litter_flux_old(:,j,m,1,k)))
+            litter_flux(:,j,m,1,k) = litter_below_old(:,j,m,1,k)*(litter_flux_old(:,j,m,1,k)/(litter_above_flux_old(:,j,m,k)+litter_flux_old(:,j,m,1,k)))
+           ELSEWHERE (litter_above_old(:,j,m,k)/(z_litter*1e-3) .GE. litter_below_old(:,j,m,1,k)/(z_soil(1)) .AND. &
+                      litter_below_old(:,j,m,2,k)/(z_soil(2)-z_soil(1)) .LT. litter_below_old(:,j,m,1,k)/(z_soil(1)) .AND. &
+                      litter_below_old(:,j,m,1,k) + litter_above_flux_old(:,j,m,k) - litter_flux_old(:,j,m,1,k) .LE. min_stomate)
+            litter_above_flux(:,j,m,k) = litter_above_flux_old(:,j,m,k)
+            litter_flux(:,j,m,1,k) = litter_below_old(:,j,m,1,k) + litter_above_flux_old(:,j,m,k)
+           ELSEWHERE (litter_above_old(:,j,m,k)/(z_litter*1e-3) .LT. litter_below_old(:,j,m,1,k)/(z_soil(1)) .AND. &
+                      litter_below_old(:,j,m,2,k)/(z_soil(2)-z_soil(1)) .GE. litter_below_old(:,j,m,1,k)/(z_soil(1)) .AND. &
+                      litter_below_old(:,j,m,1,k) - litter_above_flux_old(:,j,m,k) + litter_flux_old(:,j,m,1,k) .LE. min_stomate)
+            litter_above_flux(:,j,m,k) = litter_below_old(:,j,m,1,k) + litter_flux_old(:,j,m,1,k) 
+            litter_flux(:,j,m,1,k) = litter_flux_old(:,j,m,1,k)
+           ELSEWHERE
+            litter_above_flux(:,j,m,k) = litter_above_flux_old(:,j,m,k)
+            litter_flux(:,j,m,1,k) = litter_flux_old(:,j,m,1,k)
+           ENDWHERE
+
+
+      DO l =1, nbdl-2
+           WHERE (litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .LT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)) .AND. &
+                  litter_below_old(:,j,m,l+2,k)/(z_soil(l+2)-z_soil(l+1)) .LT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)) .AND. &
+                  litter_flux_old(:,j,m,l,k)+litter_flux_old(:,j,m,l+1,k) .GT. litter_below_old(:,j,m,l+1,k))
+            litter_flux(:,j,m,l,k) = litter_below_old(:,j,m,l+1,k)*(litter_flux_old(:,j,m,l,k)/(litter_flux_old(:,j,m,l,k)+litter_flux_old(:,j,m,l+1,k)))
+            litter_flux(:,j,m,l+1,k) = litter_below_old(:,j,m,l+1,k)*(litter_flux_old(:,j,m,l+1,k)/(litter_flux_old(:,j,m,l,k)+litter_flux_old(:,j,m,l+1,k)))
+           ELSEWHERE (litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .GE. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)) .AND. &
+                      litter_below_old(:,j,m,l+2,k)/(z_soil(l+2)-z_soil(l+1)) .LT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)) .AND. &
+                      litter_below_old(:,j,m,l+1,k) + litter_flux_old(:,j,m,l,k) - litter_flux_old(:,j,m,l+1,k) .LE. min_stomate)
+            litter_flux(:,j,m,l,k) = litter_flux_old(:,j,m,l,k)
+            litter_flux(:,j,m,l+1,k) = litter_below_old(:,j,m,l+1,k) + litter_flux_old(:,j,m,l,k)
+           ELSEWHERE (litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .LT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)) .AND. &
+                      litter_below_old(:,j,m,l+2,k)/(z_soil(l+2)-z_soil(l+1)) .GE. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l)) .AND. &
+                      litter_below_old(:,j,m,l+1,k) - litter_flux_old(:,j,m,l,k) + litter_flux_old(:,j,m,l+1,k) .LE. min_stomate)
+            litter_flux(:,j,m,l,k) = litter_below_old(:,j,m,l+1,k) + litter_flux_old(:,j,m,l+1,k)
+            litter_flux(:,j,m,l+1,k) = litter_flux_old(:,j,m,l+1,k)
+           ELSEWHERE
+            litter_flux(:,j,m,l,k) = litter_flux_old(:,j,m,l,k)
+            litter_flux(:,j,m,l+1,k) = litter_flux_old(:,j,m,l+1,k)
+           ENDWHERE
+      ENDDO
+
+          WHERE ((litter_above_old(:,j,m,k)/(z_litter*1e-3) .LT. litter_below_old(:,j,m,1,k)/(z_soil(1))) .AND. &
+                 ((litter_above_flux(:,j,m,k) - litter_below_old(:,j,m,1,k)) .GE. min_stomate))
+            litter_above(:,j,m,k) = litter_above_old(:,j,m,k) + litter_below_old(:,j,m,1,k) 
+            litter_below_old_buffer(:,j,m,1,k) = -litter_below_old(:,j,m,1,k) 
+            litter_below(:,j,m,1,k) = zero
+           ELSEWHERE ((litter_above_old(:,j,m,k)/(z_litter*1e-3) .LT. litter_below_old(:,j,m,1,k)/(z_soil(1))) .AND. &
+                  ((litter_below_old(:,j,m,1,k) - litter_above_flux(:,j,m,k)) .GT. min_stomate))
+            litter_above(:,j,m,k) = litter_above_old(:,j,m,k) + litter_above_flux(:,j,m,k) 
+            litter_below_old_buffer(:,j,m,1,k) =  - litter_above_flux(:,j,m,k)
+            litter_below(:,j,m,1,k) = litter_below_old(:,j,m,1,k) - litter_above_flux(:,j,m,k)
+           ELSEWHERE ((litter_above_old(:,j,m,k)/(z_litter*1e-3) .GT. litter_below_old(:,j,m,1,k)/(z_soil(1))) .AND. &
+                  ((litter_above_flux(:,j,m,k) - litter_above_old(:,j,m,k)) .GE. min_stomate))
+            litter_above(:,j,m,k) = zero 
+            litter_below_old_buffer(:,j,m,1,k) = litter_above_old(:,j,m,k)
+            litter_below(:,j,m,1,k) = litter_below_old(:,j,m,1,k) + litter_above_old(:,j,m,k)
+           ELSEWHERE ((litter_above_old(:,j,m,k)/(z_litter*1e-3) .GT. litter_below_old(:,j,m,1,k)/(z_soil(1))) .AND. &
+                  ((litter_above_old(:,j,m,k) - litter_above_flux(:,j,m,k)) .GT. min_stomate))
+            litter_above(:,j,m,k) = litter_above_old(:,j,m,k) - litter_above_flux(:,j,m,k)
+            litter_below_old_buffer(:,j,m,1,k) = litter_above_flux(:,j,m,k)
+            litter_below(:,j,m,1,k) = litter_below_old(:,j,m,1,k) + litter_above_flux(:,j,m,k)
+           ELSEWHERE
+            litter_above(:,j,m,k) = litter_above_old(:,j,m,k)
+            litter_below(:,j,m,1,k) = litter_below_old(:,j,m,1,k)
+           ENDWHERE
+
+      DO l= 1, nbdl-1 ! Loop over soil layers
+           WHERE ((litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .LT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l))) .AND. &
+                 ((litter_flux(:,j,m,l,k) - litter_below_old(:,j,m,l+1,k)) .GE. min_stomate))
+            litter_below(:,j,m,l,k) = litter_below_old(:,j,m,l,k) + litter_below_old(:,j,m,l+1,k) + litter_below_old_buffer(:,j,m,l,k)
+            litter_below_old_buffer(:,j,m,l+1,k) = -litter_below_old(:,j,m,l+1,k)
+            litter_below(:,j,m,l+1,k) = zero
+           ELSEWHERE ((litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .LT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l))) .AND. &
+                  ((litter_below_old(:,j,m,l+1,k) - litter_flux(:,j,m,l,k)) .GT. min_stomate))
+            litter_below(:,j,m,l,k) = litter_below_old(:,j,m,l,k) + litter_flux(:,j,m,l,k) + litter_below_old_buffer(:,j,m,l,k)
+            litter_below_old_buffer(:,j,m,l+1,k) =  - litter_flux(:,j,m,l,k)
+            litter_below(:,j,m,l+1,k) = litter_below_old(:,j,m,l+1,k) - litter_flux(:,j,m,l,k)
+           ELSEWHERE ((litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .GT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l))) .AND. &
+                  ((litter_flux(:,j,m,l,k) - litter_below_old(:,j,m,l,k)) .GE. min_stomate))
+            litter_below(:,j,m,l,k) = zero + litter_below_old_buffer(:,j,m,l,k)
+            litter_below_old_buffer(:,j,m,l+1,k) = litter_below_old(:,j,m,l,k)
+            litter_below(:,j,m,l+1,k) = litter_below_old(:,j,m,l+1,k) + litter_below_old(:,j,m,l,k)
+           ELSEWHERE ((litter_below_old(:,j,m,l,k)/(z_soil(l)-z_soil(l-1)) .GT. litter_below_old(:,j,m,l+1,k)/(z_soil(l+1)-z_soil(l))) .AND. &
+                  ((litter_below_old(:,j,m,l,k) - litter_flux(:,j,m,l,k)) .GT. min_stomate))
+            litter_below(:,j,m,l,k) = litter_below_old(:,j,m,l,k) - litter_flux(:,j,m,l,k) + litter_below_old_buffer(:,j,m,l,k)
+            litter_below_old_buffer(:,j,m,l+1,k) = litter_flux(:,j,m,l,k)
+            litter_below(:,j,m,l+1,k) = litter_below_old(:,j,m,l+1,k) + litter_flux(:,j,m,l,k)
+           ELSEWHERE
+            litter_below(:,j,m,l,k) = litter_below_old(:,j,m,l,k)
+            litter_below(:,j,m,l+1,k) = litter_below_old(:,j,m,l+1,k)
+           ENDWHERE
+        ENDDO ! End loop over soil layers
+      ENDDO ! End loop over litter pools
+    ENDDO ! End loop over elements
+ENDDO ! End loop over PFT
+
+  !! 8. calculate fraction of total soil covered by dead leaves
+
+    CALL deadleaf (npts, veget_max, dead_leaves, deadleaf_cover)
+
+!! 9. Check mass balance closure
+
+    !! 9.1 Calculate components of the mass balance
+    pool_end_after(:,:,:) = zero
+    pool_end(:,:,:) = zero
+IF (control%ld_doc) THEN
+    DO m = 2, nvm
+       DO i = 1,nlitt
+          DO l = 1, nbdl
+                 pool_end(:,m,icarbon) = pool_end(:,m,icarbon) + &
+                           ( litter_below(:,i,m,l,icarbon) ) * veget_max(:,m)
+          ENDDO
+       ENDDO
+    ENDDO
+
+    DO m = 2, nvm
+       DO i = 1,nlitt
+                 pool_end(:,m,icarbon) = pool_end(:,m,icarbon) + &
+                           ( litter_above(:,i,m,icarbon) ) * veget_max(:,m)
+       ENDDO
+    ENDDO
+
+
+    !! 9.2 Calculate mass balance
+    !  Note that soilcarbon is transfered to other pools but that the pool
+    !  was not updated. We should not account for it in ::pool_end
+
+WRITE(numout,*) " pool_start(:,m,icarbon) litter=",  pool_start(:,4,icarbon)
+WRITE(numout,*) " pool_end(:,m,icarbon) litter=",  pool_end(:,4,icarbon)
+
+    check_intern(:,:,:,:) = zero
+       check_intern(:,:,iatm2land,icarbon) = zero 
+
+    
+    check_intern(:,:,iland2atm,icarbon) = -un * resp_hetero_litter(:,:) * &
+         veget_max(:,:) * dt
+    
+
+    DO m = 1,nvm
+       DO l = 1, nbdl
+          check_intern(:,m,ilat2out,icarbon) = check_intern(:,m,ilat2out,icarbon) -un * &
+                      (soilcarbon_input(:,m,l,imetbel,icarbon)+soilcarbon_input(:,m,l,istrbel,icarbon)) * &
+                      veget_max(:,m) * dt
+      ENDDO
+    ENDDO
+    DO m = 1,nvm
+       check_intern(:,m,ilat2out,icarbon) = check_intern(:,m,ilat2out,icarbon) -un * &
+                   (soilcarbon_input(:,m,1,imetabo,icarbon)+soilcarbon_input(:,m,1,istrabo,icarbon)) * &
+                   veget_max(:,m) * dt
+    ENDDO
+
+    check_intern(:,:,ilat2in,icarbon) = zero
+    
+    check_intern(:,:,ipoolchange,icarbon) = -un * (pool_end(:,:,icarbon) - &
+         pool_start(:,:,icarbon))
+    
+    closure_intern = zero
+    DO i = 1,nmbcomp
+      closure_intern(:,:,icarbon) = closure_intern(:,:,icarbon) + &
+            check_intern(:,:,i,icarbon)
+    ENDDO
+
+    !! 9.3 Write verdict
+
+
+    !WRITE(numout,*) 'l=',l
+!    WRITE(numout,*) 'check_intern litter =',  check_intern(:,6,:,icarbon)
+    IF (SUM(SUM(closure_intern(:,:,icarbon),2),1) .LT. min_stomate .AND. &
+         SUM(SUM(closure_intern(:,:,icarbon),2),1) .GT. -min_stomate) THEN
+       WRITE(numout,*) 'Mass balance closure in stomate_litter.f90'
+    ELSE
+       WRITE(numout,*) 'Error: mass balance is not closed in stomate_litter.f90'
+       WRITE(numout,*) '   Difference is, ', SUM(SUM(closure_intern(:,:,icarbon),2),1)
+       WRITE(numout,*) '   Difference is, ', closure_intern(:,:,icarbon)
+    ENDIF
+ENDIF
+
+  !! 10. (Quasi-)Analytical Spin-up : Start filling MatrixA
+
+    IF (spinup_analytic) THEN
+
+       MatrixA(:,:,:,:) = zero
+       VectorB(:,:,:) = zero
+       
+       
+       DO m = 2,nvm
+
+          !- MatrixA : carbon fluxes leaving the litter
+          
+          MatrixA(:,m,istructural_above,istructural_above)= - dt/litter_tau(istructural) * & 
+              control_temp_above(:,istructural) * control_moist_above(:,m) * exp( -litter_struct_coef * lignin_struc_above(:,m) )           
+
+          MatrixA(:,m,istructural_below_z1,istructural_below_z1) = - dt/litter_tau(istructural) * &
+               control_temp_soil(:,1,istrbel) * control_moist_soil(:,1,m) * exp( -litter_struct_coef * lignin_struc_below(:,m,1) )
+
+          MatrixA(:,m,istructural_below_z2,istructural_below_z2) = -dt/litter_tau(istructural) * &
+               control_temp_soil(:,2,istrbel) * control_moist_soil(:,2,m) * exp(-litter_struct_coef * lignin_struc_below(:,m,2) )
+
+          MatrixA(:,m,istructural_below_z3,istructural_below_z3) = -dt/litter_tau(istructural) * &
+               control_temp_soil(:,3,istrbel) * control_moist_soil(:,3,m) * exp(-litter_struct_coef * lignin_struc_below(:,m,3) )
+
+          MatrixA(:,m,istructural_below_z4,istructural_below_z4) = -dt/litter_tau(istructural) * &
+               control_temp_soil(:,4,istrbel) * control_moist_soil(:,4,m) * exp(-litter_struct_coef * lignin_struc_below(:,m,4) )
+
+          MatrixA(:,m,istructural_below_z5,istructural_below_z5) = -dt/litter_tau(istructural) * &
+               control_temp_soil(:,5,istrbel) * control_moist_soil(:,5,m) * exp(-litter_struct_coef * lignin_struc_below(:,m,5) )
+
+          MatrixA(:,m,istructural_below_z6,istructural_below_z6) = -dt/litter_tau(istructural) * &
+               control_temp_soil(:,6,istrbel) * control_moist_soil(:,6,m) * exp(-litter_struct_coef * lignin_struc_below(:,m,6) )
+
+          MatrixA(:,m,istructural_below_z7,istructural_below_z7) = -dt/litter_tau(istructural) * &
+               control_temp_soil(:,7,istrbel) * control_moist_soil(:,7,m) * exp(-litter_struct_coef * lignin_struc_below(:,m,7) )
+
+          MatrixA(:,m,istructural_below_z8,istructural_below_z8) = -dt/litter_tau(istructural) * &
+               control_temp_soil(:,8,istrbel) * control_moist_soil(:,8,m) * exp(-litter_struct_coef * lignin_struc_below(:,m,8) )
+
+          MatrixA(:,m,istructural_below_z9,istructural_below_z9) = -dt/litter_tau(istructural) * &
+               control_temp_soil(:,9,istrbel) * control_moist_soil(:,9,m) * exp(-litter_struct_coef * lignin_struc_below(:,m,9) )
+
+          MatrixA(:,m,istructural_below_z10,istructural_below_z10) = -dt/litter_tau(istructural) * &
+               control_temp_soil(:,10,istrbel) * control_moist_soil(:,10,m) * exp(-litter_struct_coef * lignin_struc_below(:,m,10) )
+
+          MatrixA(:,m,istructural_below_z11,istructural_below_z11) = -dt/litter_tau(istructural) * &
+               control_temp_soil(:,11,istrbel) * control_moist_soil(:,11,m) * exp(-litter_struct_coef * lignin_struc_below(:,m,11) )
+          
+
+          MatrixA(:,m,imetabolic_above,imetabolic_above) = - dt/litter_tau(imetabolic) * &  
+              control_temp_above(:,imetabolic) * control_moist_above(:,m)          
+
+          MatrixA(:,m,imetabolic_below_z1,imetabolic_below_z1) = - dt/litter_tau(imetabolic) * & 
+               control_temp_soil(:,1,imetbel) * control_moist_soil(:,1,m)
+
+          MatrixA(:,m,imetabolic_below_z2,imetabolic_below_z2) = -dt/litter_tau(imetabolic) * &
+               control_temp_soil(:,2,imetbel) * control_moist_soil(:,2,m)
+
+          MatrixA(:,m,imetabolic_below_z3,imetabolic_below_z3) = -dt/litter_tau(imetabolic) * &
+               control_temp_soil(:,3,imetbel) * control_moist_soil(:,3,m)
+
+          MatrixA(:,m,imetabolic_below_z4,imetabolic_below_z4) = -dt/litter_tau(imetabolic) * &
+               control_temp_soil(:,4,imetbel) * control_moist_soil(:,4,m)
+
+          MatrixA(:,m,imetabolic_below_z5,imetabolic_below_z5) = -dt/litter_tau(imetabolic) * &
+               control_temp_soil(:,5,imetbel) * control_moist_soil(:,5,m)
+
+          MatrixA(:,m,imetabolic_below_z6,imetabolic_below_z6) = -dt/litter_tau(imetabolic) * &
+               control_temp_soil(:,6,imetbel) * control_moist_soil(:,6,m)
+
+          MatrixA(:,m,imetabolic_below_z7,imetabolic_below_z7) = -dt/litter_tau(imetabolic) * &
+               control_temp_soil(:,7,imetbel) * control_moist_soil(:,7,m)
+
+          MatrixA(:,m,imetabolic_below_z8,imetabolic_below_z8) = -dt/litter_tau(imetabolic) * &
+               control_temp_soil(:,8,imetbel) * control_moist_soil(:,8,m)
+
+          MatrixA(:,m,imetabolic_below_z9,imetabolic_below_z9) = -dt/litter_tau(imetabolic) * &
+               control_temp_soil(:,9,imetbel) * control_moist_soil(:,9,m)
+
+          MatrixA(:,m,imetabolic_below_z10,imetabolic_below_z10) = -dt/litter_tau(imetabolic) * &
+               control_temp_soil(:,10,imetbel) * control_moist_soil(:,10,m)
+
+          MatrixA(:,m,imetabolic_below_z11,imetabolic_below_z11) = -dt/litter_tau(imetabolic) * &
+               control_temp_soil(:,11,imetbel) * control_moist_soil(:,11,m)
+
+          
+          
+          !- MatrixA : carbon fluxes between the litter and the pools (the rest of the matrix is filled in stomate_soilcarbon.f90)
+          
+          MatrixA(:,m,iactive_pool_z1,istructural_above) = frac_soil(istructural,iactive,iabove) * & 
+                dt/litter_tau(istructural) * &                     
+                control_temp_above(:,istructural) * control_moist_above(:,m) * &  
+                exp( -litter_struct_coef * lignin_struc_above(:,m) ) * & 
+                ( 1. - lignin_struc_above(:,m) ) 
+          
+          MatrixA(:,m,iactive_pool_z1,istructural_below_z1) = frac_soil(istructural,iactive,ibelow) * &
+               dt/litter_tau(istructural) * &                     
+               control_temp_soil(:,1,istrbel) * control_moist_soil(:,1,m) * & 
+               exp( -litter_struct_coef * lignin_struc_below(:,m,1) ) * &
+               ( 1. - lignin_struc_below(:,m,1) ) 
+
+          MatrixA(:,m,iactive_pool_z2,istructural_below_z2) = frac_soil(istructural,iactive,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,2,istrbel) * control_moist_soil(:,2,m) * &     
+               exp( -litter_struct_coef * lignin_struc_below(:,m,2) ) * &
+               ( 1. - lignin_struc_below(:,m,2) )
+
+          MatrixA(:,m,iactive_pool_z3,istructural_below_z3) = frac_soil(istructural,iactive,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,3,istrbel) * control_moist_soil(:,3,m) * &     
+               exp( -litter_struct_coef * lignin_struc_below(:,m,3) ) * &
+               ( 1. - lignin_struc_below(:,m,3) )
+
+          MatrixA(:,m,iactive_pool_z4,istructural_below_z4) = frac_soil(istructural,iactive,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,4,istrbel) * control_moist_soil(:,4,m) * &     
+               exp( -litter_struct_coef * lignin_struc_below(:,m,4) ) * &
+               ( 1. - lignin_struc_below(:,m,4) )
+          
+          MatrixA(:,m,iactive_pool_z5,istructural_below_z5) = frac_soil(istructural,iactive,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,5,istrbel) * control_moist_soil(:,5,m) * &     
+               exp( -litter_struct_coef * lignin_struc_below(:,m,5) ) * &
+               ( 1. - lignin_struc_below(:,m,5) )
+
+          MatrixA(:,m,iactive_pool_z6,istructural_below_z6) = frac_soil(istructural,iactive,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,6,istrbel) * control_moist_soil(:,6,m) * &     
+               exp( -litter_struct_coef * lignin_struc_below(:,m,6) ) * &
+               ( 1. - lignin_struc_below(:,m,6) )
+
+          MatrixA(:,m,iactive_pool_z7,istructural_below_z7) = frac_soil(istructural,iactive,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,7,istrbel) * control_moist_soil(:,7,m) * &     
+               exp( -litter_struct_coef * lignin_struc_below(:,m,7) ) * &
+               ( 1. - lignin_struc_below(:,m,7) )
+
+          MatrixA(:,m,iactive_pool_z8,istructural_below_z8) = frac_soil(istructural,iactive,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,8,istrbel) * control_moist_soil(:,8,m) * &     
+               exp( -litter_struct_coef * lignin_struc_below(:,m,8) ) * &
+               ( 1. - lignin_struc_below(:,m,8) )
+
+          MatrixA(:,m,iactive_pool_z9,istructural_below_z9) = frac_soil(istructural,iactive,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,9,istrbel) * control_moist_soil(:,9,m) * &     
+               exp( -litter_struct_coef * lignin_struc_below(:,m,9) ) * &
+               ( 1. - lignin_struc_below(:,m,9) )
+
+          MatrixA(:,m,iactive_pool_z10,istructural_below_z10) = frac_soil(istructural,iactive,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,10,istrbel) * control_moist_soil(:,10,m) * &     
+               exp( -litter_struct_coef * lignin_struc_below(:,m,10) ) * &
+               ( 1. - lignin_struc_below(:,m,10) )
+
+          MatrixA(:,m,iactive_pool_z11,istructural_below_z11) = frac_soil(istructural,iactive,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,11,istrbel) * control_moist_soil(:,11,m) * &     
+               exp( -litter_struct_coef * lignin_struc_below(:,m,11) ) * &
+               ( 1. - lignin_struc_below(:,m,11) )
+
+          MatrixA(:,m,iactive_pool_z1,imetabolic_above) =  frac_soil(imetabolic,iactive,iabove) * & 
+               dt/litter_tau(imetabolic) * control_temp_above(:,imetabolic) * control_moist_above(:,m)
+          
+          MatrixA(:,m,iactive_pool_z1,imetabolic_below_z1) =  frac_soil(imetabolic,iactive,ibelow) * &
+               dt/litter_tau(imetabolic) * control_temp_soil(:,1,imetbel) * control_moist_soil(:,1,m)
+
+          MatrixA(:,m,iactive_pool_z2,imetabolic_below_z2) = frac_soil(imetabolic,iactive,ibelow) * &
+               dt/litter_tau(imetabolic) * control_temp_soil(:,2,imetbel) * control_moist_soil(:,2,m)
+
+          MatrixA(:,m,iactive_pool_z3,imetabolic_below_z3) = frac_soil(imetabolic,iactive,ibelow) * &
+               dt/litter_tau(imetabolic) * control_temp_soil(:,3,imetbel) * control_moist_soil(:,3,m)
+
+          MatrixA(:,m,iactive_pool_z4,imetabolic_below_z4) = frac_soil(imetabolic,iactive,ibelow) * &
+               dt/litter_tau(imetabolic) * control_temp_soil(:,4,imetbel) * control_moist_soil(:,4,m)
+
+          MatrixA(:,m,iactive_pool_z5,imetabolic_below_z5) = frac_soil(imetabolic,iactive,ibelow) * &
+               dt/litter_tau(imetabolic) * control_temp_soil(:,5,imetbel) * control_moist_soil(:,5,m) 
+
+          MatrixA(:,m,iactive_pool_z6,imetabolic_below_z6) = frac_soil(imetabolic,iactive,ibelow) * &
+               dt/litter_tau(imetabolic) * control_temp_soil(:,6,imetbel) * control_moist_soil(:,6,m) 
+
+          MatrixA(:,m,iactive_pool_z7,imetabolic_below_z7) = frac_soil(imetabolic,iactive,ibelow) * &
+               dt/litter_tau(imetabolic) * control_temp_soil(:,7,imetbel) * control_moist_soil(:,7,m)
+ 
+          MatrixA(:,m,iactive_pool_z8,imetabolic_below_z8) = frac_soil(imetabolic,iactive,ibelow) * &
+               dt/litter_tau(imetabolic) * control_temp_soil(:,8,imetbel) * control_moist_soil(:,8,m)
+ 
+          MatrixA(:,m,iactive_pool_z9,imetabolic_below_z9) = frac_soil(imetabolic,iactive,ibelow) * &
+               dt/litter_tau(imetabolic) * control_temp_soil(:,9,imetbel) * control_moist_soil(:,9,m) 
+
+          MatrixA(:,m,iactive_pool_z10,imetabolic_below_z10) = frac_soil(imetabolic,iactive,ibelow) * &
+               dt/litter_tau(imetabolic) * control_temp_soil(:,10,imetbel) * control_moist_soil(:,10,m)
+
+          MatrixA(:,m,iactive_pool_z11,imetabolic_below_z11) = frac_soil(imetabolic,iactive,ibelow) * &
+               dt/litter_tau(imetabolic) * control_temp_soil(:,11,imetbel) * control_moist_soil(:,11,m)
+          
+
+          MatrixA(:,m,islow_pool_z1,istructural_above) = frac_soil(istructural,islow,iabove) * & 
+               dt/litter_tau(istructural) * &                    
+               control_temp_above(:,istructural) * control_moist_above(:,m) * & 
+               exp( -litter_struct_coef * lignin_struc_above(:,m) )* & 
+               lignin_struc_above(:,m)
+          
+          MatrixA(:,m,islow_pool_z1,istructural_below_z1) = frac_soil(istructural,islow,ibelow) * &
+               dt/litter_tau(istructural) * &   
+               control_temp_soil(:,1,istrbel) * control_moist_soil(:,1,m) *  &
+                  exp( -litter_struct_coef * lignin_struc_below(:,m,1) )* &
+                  lignin_struc_below(:,m,1) 
+          
+
+          MatrixA(:,m,islow_pool_z2,istructural_below_z2) = frac_soil(istructural,islow,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,2,istrbel) * control_moist_soil(:,2,m) *  &
+                  exp( -litter_struct_coef * lignin_struc_below(:,m,2) )* &
+                  lignin_struc_below(:,m,2)
+
+          MatrixA(:,m,islow_pool_z3,istructural_below_z3) = frac_soil(istructural,islow,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,3,istrbel) * control_moist_soil(:,3,m) *  &
+                  exp( -litter_struct_coef * lignin_struc_below(:,m,3) )* &
+                  lignin_struc_below(:,m,3)
+
+          MatrixA(:,m,islow_pool_z4,istructural_below_z4) = frac_soil(istructural,islow,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,4,istrbel) * control_moist_soil(:,4,m) *  &
+                  exp( -litter_struct_coef * lignin_struc_below(:,m,4) )* &
+                  lignin_struc_below(:,m,4)
+
+          MatrixA(:,m,islow_pool_z5,istructural_below_z5) = frac_soil(istructural,islow,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,5,istrbel) * control_moist_soil(:,5,m) *  &
+                  exp( -litter_struct_coef * lignin_struc_below(:,m,5) )* &
+                  lignin_struc_below(:,m,5)
+
+          MatrixA(:,m,islow_pool_z6,istructural_below_z6) = frac_soil(istructural,islow,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,6,istrbel) * control_moist_soil(:,6,m) *  &
+                  exp( -litter_struct_coef * lignin_struc_below(:,m,6) )* &
+                  lignin_struc_below(:,m,6)
+
+          MatrixA(:,m,islow_pool_z7,istructural_below_z7) = frac_soil(istructural,islow,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,7,istrbel) * control_moist_soil(:,7,m) *  &
+                  exp( -litter_struct_coef * lignin_struc_below(:,m,7) )* &
+                  lignin_struc_below(:,m,7)
+
+          MatrixA(:,m,islow_pool_z8,istructural_below_z8) = frac_soil(istructural,islow,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,8,istrbel) * control_moist_soil(:,8,m) *  &
+                  exp( -litter_struct_coef * lignin_struc_below(:,m,8) )* &
+                  lignin_struc_below(:,m,8)
+
+          MatrixA(:,m,islow_pool_z9,istructural_below_z9) = frac_soil(istructural,islow,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,9,istrbel) * control_moist_soil(:,9,m) *  &
+                  exp( -litter_struct_coef * lignin_struc_below(:,m,9) )* &
+                  lignin_struc_below(:,m,9)
+
+          MatrixA(:,m,islow_pool_z10,istructural_below_z10) = frac_soil(istructural,islow,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,10,istrbel) * control_moist_soil(:,10,m) *  &
+                  exp( -litter_struct_coef * lignin_struc_below(:,m,10) )* &
+                  lignin_struc_below(:,m,10)
+
+          MatrixA(:,m,islow_pool_z11,istructural_below_z11) = frac_soil(istructural,islow,ibelow) * &
+               dt/litter_tau(istructural) * &
+               control_temp_soil(:,11,istrbel) * control_moist_soil(:,11,m) *  &
+                  exp( -litter_struct_coef * lignin_struc_below(:,m,11) )* &
+                  lignin_struc_below(:,m,11)            
+          
+          !- VectorB : carbon input -
+
+          VectorB(:,m,istructural_above) = litter_inc_PFT_above(:,m,istructural,icarbon)          
+          VectorB(:,m,istructural_below_z1) = litter_inc_PFT_below(:,m,istructural,1,icarbon)
+          VectorB(:,m,istructural_below_z2) = litter_inc_PFT_below(:,m,istructural,2,icarbon)
+          VectorB(:,m,istructural_below_z3) = litter_inc_PFT_below(:,m,istructural,3,icarbon)
+          VectorB(:,m,istructural_below_z4) = litter_inc_PFT_below(:,m,istructural,4,icarbon)
+          VectorB(:,m,istructural_below_z5) = litter_inc_PFT_below(:,m,istructural,5,icarbon)
+          VectorB(:,m,istructural_below_z6) = litter_inc_PFT_below(:,m,istructural,6,icarbon)
+          VectorB(:,m,istructural_below_z7) = litter_inc_PFT_below(:,m,istructural,7,icarbon)
+          VectorB(:,m,istructural_below_z8) = litter_inc_PFT_below(:,m,istructural,8,icarbon)
+          VectorB(:,m,istructural_below_z9) = litter_inc_PFT_below(:,m,istructural,9,icarbon)
+          VectorB(:,m,istructural_below_z10) = litter_inc_PFT_below(:,m,istructural,10,icarbon)
+          VectorB(:,m,istructural_below_z11) = litter_inc_PFT_below(:,m,istructural,11,icarbon)
+          VectorB(:,m,imetabolic_above) = litter_inc_PFT_above(:,m,imetabolic,icarbon) 
+          VectorB(:,m,imetabolic_below_z1) = litter_inc_PFT_below(:,m,imetabolic,1,icarbon)
+          VectorB(:,m,imetabolic_below_z2) = litter_inc_PFT_below(:,m,imetabolic,2,icarbon)
+          VectorB(:,m,imetabolic_below_z3) = litter_inc_PFT_below(:,m,imetabolic,3,icarbon)
+          VectorB(:,m,imetabolic_below_z4) = litter_inc_PFT_below(:,m,imetabolic,4,icarbon)
+          VectorB(:,m,imetabolic_below_z5) = litter_inc_PFT_below(:,m,imetabolic,5,icarbon)
+          VectorB(:,m,imetabolic_below_z6) = litter_inc_PFT_below(:,m,imetabolic,6,icarbon)
+          VectorB(:,m,imetabolic_below_z7) = litter_inc_PFT_below(:,m,imetabolic,7,icarbon)
+          VectorB(:,m,imetabolic_below_z8) = litter_inc_PFT_below(:,m,imetabolic,8,icarbon)
+          VectorB(:,m,imetabolic_below_z9) = litter_inc_PFT_below(:,m,imetabolic,9,icarbon)
+          VectorB(:,m,imetabolic_below_z10) = litter_inc_PFT_below(:,m,imetabolic,10,icarbon)
+          VectorB(:,m,imetabolic_below_z11) = litter_inc_PFT_below(:,m,imetabolic,11,icarbon)          
+          IF (bavard.GE.4) WRITE(numout,*) 'We filled MatrixA and VectorB' 
+          
+       ENDDO ! Loop over # PFTs
+          
+    ENDIF ! spinup analytic 
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving littercalc'
+
+  END SUBROUTINE littercalc
+
+
+!! ==============================================================================================================================\n
+!! SUBROUTINE   : deadleaf
+!!
+!>\BRIEF        This routine calculates the deadleafcover. 
+!!
+!! DESCRIPTION  : It first calculates the lai corresponding to the dead leaves (LAI) using 
+!! the dead leaves carbon content (DL) the specific leaf area (sla) and the 
+!! maximal coverage fraction of a PFT (vegetmax) using the following equations:
+!! \latexonly
+!! \input{deadleaf1.tex}
+!! \endlatexonly
+!! \n
+!! Then, the dead leaf cover (DLC) is calculated as following:\n
+!! \latexonly
+!! \input{deadleaf2.tex}
+!! \endlatexonly
+!! \n
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE: ::deadleaf_cover
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE deadleaf (npts, veget_max, dead_leaves, deadleaf_cover)
+
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                          :: npts           !! Domain size - number of grid pixels (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)  :: dead_leaves    !! Dead leaves per ground unit area, per PFT, 
+                                                                          !! metabolic and structural  
+                                                                          !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)          :: veget_max      !! PFT "Maximal" coverage fraction of a PFT defined in 
+                                                                          !! the input vegetation map 
+                                                                          !! @tex $(m^2 m^{-2})$ @endtex 
+    
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts), INTENT(out)           :: deadleaf_cover !! Fraction of soil covered by dead leaves over all PFTs
+                                                                          !! (0-1, unitless)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                        :: dead_lai       !! LAI of dead leaves @tex $(m^2 m^{-2})$ @endtex
+    INTEGER(i_std)                                      :: j              !! Index (unitless)
+!_ ================================================================================================================================
+    
+  !! 1. LAI of dead leaves
+  
+    dead_lai(:) = zero
+
+    DO j = 2,nvm !Loop over PFTs
+       dead_lai(:) = dead_lai(:) + ( dead_leaves(:,j,imetabolic) + dead_leaves(:,j,istructural) ) * sla(j) &
+            * veget_max(:,j)
+    ENDDO
+
+  !! 2. fraction of soil covered by dead leaves
+
+    deadleaf_cover(:) = un - exp( - 0.5 * dead_lai(:) )
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving deadleaf'
+
+  END SUBROUTINE deadleaf
+
+
+!! ================================================================================================================================
+!! FUNCTION     : control_moist_func_moyano
+!!
+!>\BRIEF        Calculate moisture control for litter and soild C decomposition
+!!
+!! DESCRIPTION  : Calculate moisture control factor applied
+!! to litter decomposition and to soil carbon decomposition in
+!! stomate_soilcarbon.f90 using the following equation: \n
+!! \latexonly
+!! \input{control_moist_func1.tex}
+!! \endlatexonly
+!! \n
+!! with M the moisture control factor and soilmoisutre, the soil moisture 
+!! calculated in sechiba.
+!! Then, the function is ranged between 0.25 and 1:\n
+!! \latexonly
+!! \input{control_moist_func2.tex}
+!! \endlatexonly
+!! \n
+!! RECENT CHANGE(S) : None
+!!
+!! RETURN VALUE : ::moistfunc_result
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  FUNCTION control_moist_func_moyano (npts, moist_in,bulk_dens, clay, carbon,veget_max) RESULT (moistfunc_result)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)               :: npts                !! Domain size - number of grid pixel (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in) :: moist_in            !! relative humidity (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: clay               !! Clay fraction (unitless, 0-1) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: bulk_dens          !! Variable local of bulk density for the moment must change in the futur (kg m-3)
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl), INTENT(in)     :: carbon             !! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                  :: veget_max          !! Maximum fraction of vegetation type including 
+                                                                                      !! non-biological fraction (unitless)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts)          :: moistfunc_result    !! Moisture control factor (0-1, unitless)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+   REAL(r_std), DIMENSION(npts)           :: total_soc              !! Total soil organic carbon for a grid pixel (g-C g-1 soil)
+   INTEGER(i_std)                         :: k,i,j                  !! Indices
+   INTEGER, PARAMETER                     :: nummoist = 120         !! We used numoist then divived by 100. because to calculate the function
+                                                                    !! we need to predict PRsr for all the possible soil moisture values
+   REAL(r_std), DIMENSION(npts,nummoist)  :: PRsr                   !! Proportional response or soil respiration at moist_in 
+   REAL(r_std), DIMENSION(npts,nummoist)  :: SR                     !! Soil respiration at moist_in to facilitate the understanding regarding 
+                                                                    !! the Moyano et al paper we keep the same nomenclature than in the paper
+                                                                    !! but **BE CAREFUL** it does not correspond to the variable resp_hetero_soil
+                                                                    !! or resp_hetero_litter in ORCHIDEE
+   REAL(r_std), SAVE, DIMENSION(0:nbdl)   :: z_soil                 !! Soil levels (m)
+!$OMP THREADPRIVATE(z_soil)
+   REAL(r_std), DIMENSION(npts,nummoist)  :: moistfunc              !! An intermediate variable to calculate the Moisture control factor
+   INTEGER(i_std)                         :: ind                    !! A local variable to know what is the index of the max value for the statistical function
+   INTEGER(i_std), DIMENSION(npts)        :: ind_i                  !! A local variable to know what is the index of the max value for the 
+                                                                    !! statistical function at each points
+   REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: moistfunc_below_1 !! A allocatable variable to store the value of moistfunc that are below the max value
+                                                                       !! to then rescale at is it done in Moyano et al. 2012 BG
+!$OMP THREADPRIVATE(moistfunc_below_1)
+   INTEGER(i_std)                         :: ier                    !! Check errors in netcdf call (unitless)
+   LOGICAL                                :: l_error                !! Check errors in netcdf call
+
+!_ ================================================================================================================================
+
+       !! 1.3 soil levels
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+    ! In Moyano et al. 2012 BG, the function obtained is based on soil 
+    ! incubations were litter is generally manually removed, therefore we used 
+    ! only the variable carbon corresponding to the soil organic carbon even
+    ! if some litter (metabolic litter) is not easy to remove manually since it
+    ! corresponds to roots exudates. Therefore, we probably underestimate a bit
+    ! the soil organic carbon compared to what is used in Moyano et al., 2012
+    ! BG.
+
+ PRsr(:,:) = zero
+ SR(:,:) = zero
+ moistfunc(:,:) = zero
+    l_error = .FALSE.
+
+    total_soc(:) = zero
+    DO k = 1,nvm
+       DO j = 1,nbdl
+       total_soc(:) =  total_soc(:) + &
+                      ((carbon(:,iactive,k,j)*veget_max(:,k) + &
+                       carbon(:,islow,k,j)*veget_max(:,k) + &
+                       carbon(:,ipassive,k,j)*veget_max(:,k))* &
+                       ((z_soil(j)-z_soil(j-1))/z_soil(nbdl))) / &
+                      (bulk_dens(:) ) 
+       ENDDO
+    ENDDO
+
+     DO k = 1,nummoist
+
+        PRsr(:,k) = 1.11066-0.83344*(k/100.) + 1.48095*((k/100.)**2) - 1.02959*((k/100.)**3) + 0.07995*clay(:) + 1.27892*total_soc(:)
+
+     ENDDO
+
+        SR(:,1)=PRsr(:,1)
+     DO k=2,nummoist
+        SR(:,k)= SR(:,k-1)* PRsr(:,k)
+     ENDDO
+
+     DO i = 1,npts
+         DO k= 1, nummoist
+                moistfunc(i,k) = SR(i,k)/MAXVAL(SR(i,:))
+         ENDDO
+    ENDDO
+
+       ind_i(:) = MAXLOC(moistfunc(:,:),DIM=2)
+
+     DO i = 1,npts
+         ind=ind_i(i)
+
+    ALLOCATE(moistfunc_below_1(npts,ind),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    IF (l_error) THEN
+       WRITE(numout,*) 'Memory allocation error for moistfunc_below_1. '
+    ENDIF
+
+         DO k= 1,ind
+            moistfunc_below_1(i,k)= moistfunc(i,k)
+         ENDDO
+
+         DO k= 1,ind           
+            moistfunc(i,k)=moistfunc(i,k) - MINVAL(moistfunc_below_1(i,:))
+         ENDDO
+
+         DO k= 1,ind
+            moistfunc_below_1(i,k)= moistfunc(i,k)
+         ENDDO
+
+         DO k=1,ind
+
+            moistfunc(i,k)=moistfunc(i,k)/MAXVAL(moistfunc_below_1(i,:))
+         ENDDO
+
+    IF (ALLOCATED(moistfunc_below_1)) DEALLOCATE(moistfunc_below_1)
+
+    ENDDO
+    DO i=1,npts
+               IF (NINT(moist_in(i)) .GT. zero) THEN
+               moistfunc_result(i) = moistfunc(i,NINT(moist_in(i)*100))
+               ELSE
+               moistfunc_result(i) = zero
+               ENDIF
+    ENDDO
+
+  END FUNCTION control_moist_func_moyano
+
+!! ================================================================================================================================
+!! FUNCTION     : control_moist_func
+!!
+!>\BRIEF        Calculate moisture control for litter and soild C decomposition
+!!
+!! DESCRIPTION  : Calculate moisture control factor applied
+!! to litter decomposition and to soil carbon decomposition in
+!! stomate_soilcarbon.f90 using the following equation: \n
+!! \latexonly
+!! \input{control_moist_func1.tex}
+!! \endlatexonly
+!! \n
+!! with M the moisture control factor and soilmoisutre, the soil moisture 
+!! calculated in sechiba.
+!! Then, the function is ranged between 0.25 and 1:\n
+!! \latexonly
+!! \input{control_moist_func2.tex}
+!! \endlatexonly
+!! \n
+!! RECENT CHANGE(S) : None
+!!
+!! RETURN VALUE : ::moistfunc_result
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION control_moist_func (npts, moist_in) RESULT (moistfunc_result)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)               :: npts                !! Domain size - number of grid pixel (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in) :: moist_in            !! relative humidity (unitless)
+
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts)          :: moistfunc_result    !! Moisture control factor (0-1, unitless)
+
+    !! 0.3 Modified variables
+
+
+!_ ================================================================================================================================
+
+
+          moistfunc_result(:) = -moist_coeff(1) * moist_in(:) * moist_in(:) + moist_coeff(2)* moist_in(:) - moist_coeff(3)
+          moistfunc_result(:) = MAX( 0.25_r_std, MIN( un, moistfunc_result(:) ) )
+    
+  END FUNCTION control_moist_func
+
+!! ================================================================================================================================
+!! FUNCTION     : control_temp_func
+!!
+!>\BRIEF        Calculate temperature control for litter and soild C decomposition
+!!
+!! DESCRIPTION  : Calculate temperature control factor applied
+!! to litter decomposition and to soil carbon decomposition in
+!! stomate_soilcarbon.f90 using the following equation: \n
+!! \latexonly
+!! \input{control_temp_func1.tex}
+!! \endlatexonly
+!! \n
+!! with T the temperature control factor, temp the temperature in Kelvin of 
+!! the air (for aboveground litter) or of the soil (for belowground litter 
+!! and soil)
+!! Then, the function is limited in its maximal range to 1:\n
+!! \latexonly
+!! \input{control_temp_func2.tex}
+!! \endlatexonly
+!! \n
+!! RECENT CHANGE(S) : None
+!!
+!! RETURN VALUE: ::tempfunc_result
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+
+  FUNCTION control_temp_func (npts, temp_in,tau) RESULT (tempfunc_result)
+
+  !! 0. Variable and parameter declaration
+    
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                 :: npts            !! Domain size - number of land pixels (unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)   :: temp_in         !! Temperature (K)
+    REAL(r_std), INTENT(in)                    :: tau             !! residence time of the pool considered (days)
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts)               :: tempfunc_result !! Temperature control factor (0-1, unitless)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts)               :: Ea              !! Activation Energy 
+    REAL(r_std), DIMENSION(npts)               :: Q10_soil        !! Q10 values calculated based on Ea
+!_ ================================================================================================================================
+
+    ! This relationship is based on a reanalysis of the data published by LefÃšvre et al. 2014 in global change biology 
+    ! We use MAX(cent,(temp_in(:)-ZeroCelsius)*(temp_in(:)-ZeroCelsius)))) because for values between -10 and 10 degC
+    ! the Q10 values are close to infinity 
+    Ea(:)=a_term_Q10_soil*log(tau) + b_term_Q10_soil
+    Q10_soil(:)=exp((dix*Ea(:))/(R*MAX(cent,(temp_in(:)-ZeroCelsius)*(temp_in(:)-ZeroCelsius))))
+    tempfunc_result(:) = exp( log(Q10_soil(:)) * ( temp_in(:) - (ZeroCelsius+tsoil_ref)) / Q10 )
+    tempfunc_result(:) = MIN( un, tempfunc_result(:) )
+  END FUNCTION control_temp_func
+
+END MODULE stomate_litter
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_lpj.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_lpj.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_lpj.f90	(revision 5166)
@@ -0,0 +1,1369 @@
+! ================================================================================================================================
+! MODULE       : stomate_lpj
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Main entry point for daily processes in STOMATE and LPJ (phenology, 
+!! allocation, npp_calc, kill, turn, light, establish, crown, cover, lcchange)
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! SVN          :
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_lpj
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE grid
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE lpj_constraints
+  USE lpj_pftinout
+  USE lpj_kill
+  USE lpj_crown
+  USE lpj_fire
+  USE lpj_gap
+  USE lpj_light
+  USE lpj_establish
+  USE lpj_cover
+  USE stomate_prescribe
+  USE stomate_phenology
+  USE stomate_alloc
+  USE stomate_npp
+  USE stomate_turnover
+  USE stomate_litter
+  USE stomate_soilcarbon
+  USE stomate_vmax
+  USE stomate_assimtemp
+  USE stomate_lcchange
+!  USE Orch_Write_field_p
+
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC StomateLpj,StomateLpj_clear
+
+  LOGICAL, SAVE                         :: firstcall = .TRUE.             !! first call
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : StomateLpj_clear
+!!
+!>\BRIEF        Re-initialisation of variable
+!!
+!! DESCRIPTION  : This subroutine reinitializes variables. To be used if we want to relaunch 
+!! ORCHIDEE but the routine is not used in current version.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE StomateLpj_clear
+
+    CALL prescribe_clear
+    CALL phenology_clear
+    CALL npp_calc_clear
+    CALL turn_clear
+    CALL soilcarbon_clear
+    CALL constraints_clear
+    CALL establish_clear
+    CALL fire_clear
+    CALL gap_clear
+    CALL light_clear
+    CALL pftinout_clear
+    CALL alloc_clear
+  END SUBROUTINE StomateLpj_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : StomateLPJ
+!!
+!>\BRIEF        Main entry point for daily processes in STOMATE and LPJ, structures the call sequence 
+!!              to the different processes such as dispersion, establishment, competition and mortality of PFT's.
+!! 
+!! DESCRIPTION  : This routine is the main entry point to all processes calculated on a 
+!! daily time step. Is mainly devoted to call the different STOMATE and LPJ routines 
+!! depending of the ok_dgvm (is dynamic veg used) and lpj_constant_mortality (is background mortality used).
+!! It also prepares the cumulative 
+!! fluxes or pools (e.g TOTAL_M TOTAL_BM_LITTER etc...)
+!!
+!! This routine makes frequent use of "weekly", "monthly" and "long term" variables. Quotion is used because
+!! by default "weekly" denotes 7 days, by default "monthly" denotes 20 days and by default "Long term" denotes
+!! 3 years. dtslow refers to 24 hours (1 day).
+!!
+!!
+!! RECENT CHANGE(S) : None
+!! 
+!! MAIN OUTPUT VARIABLE(S): All variables related to stomate and required for LPJ dynamic vegetation mode.
+!!
+!! REFERENCE(S) : 
+!! - Krinner, G., N. Viovy, N. de Noblet-DucoudrÃ©, J. OgeÃ©, J. Polcher, P. Friedlingstein, P. Ciais, S. Sitch, 
+!! and I. C. Prentice. 2005. A dynamic global vegetation model for studies of the coupled atmosphere-biosphere 
+!! system. Global Biogeochemical Cycles 19:GB1015, doi:1010.1029/2003GB002199.
+!! - Sitch, S., B. Smith, I. C. Prentice, A. Arneth, A. Bondeau, W. Cramer, J. O. Kaplan, S. Levis, W. Lucht, 
+!! M. T. Sykes, K. Thonicke, and S. Venevsky. 2003. Evaluation of ecosystem dynamics, plant geography and 
+!! terrestrial carbon cycling in the LPJ dynamic global vegetation model. Global Change Biology 9:161-185.
+!!
+!! FLOWCHART    : Update with existing flowchart from N Viovy (Jan 19, 2012)
+!! \n
+!_ ================================================================================================================================
+ 
+  SUBROUTINE StomateLpj (npts, dt_days, EndOfYear, EndOfMonth, &
+       neighbours, resolution, &
+       clay, herbivores, &
+       tsurf_daily, tsoil_daily, t2m_daily, t2m_min_daily, &
+       litterhum_daily, soilhum_daily, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       gdd0_lastyear, precip_lastyear, &
+       moiavail_month, moiavail_week, tlong_ref, t2m_month, t2m_week, &
+       tsoil_month, soilhum_month, &
+       gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       turnover_longterm, gpp_daily, &
+       time_hum_min, maxfpc_lastyear, resp_maint_part, &
+       PFTpresent, age, fireindex, firelitter, &
+       leaf_age, leaf_frac, biomass, ind, adapted, regenerate, &
+       senescence, when_growthinit, &
+       litterpart, litter_above, litter_below, dead_leaves, carbon, DOC, DOC_EXP, black_carbon, lignin_struc_above, &
+       veget_max, npp_longterm, lm_lastyearmax, veget_lastlight, &
+       everywhere, need_adjacent, RIP_time, &
+       lai, rprof,npp_daily, turnover_daily, turnover_time,&
+       soilcarbon_input, co2_to_bm, co2_fire, resp_hetero, resp_maint, resp_growth, &
+       height, deadleaf_cover, vcmax, vjmax, &
+       t_photo_min, t_photo_opt, t_photo_max,bm_to_litter, &
+       prod10,prod100,flux10, flux100, veget_max_new, &
+       convflux,cflux_prod10,cflux_prod100, harvest_above, carb_mass_total, lcchange, &
+       fpc_max, MatrixA,moist_soil)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 input
+
+    INTEGER(i_std), INTENT(in)                                 :: npts                 !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                                    :: dt_days              !! Time step of Stomate (days)
+    INTEGER(i_std), DIMENSION(npts,8), INTENT(in)              :: neighbours           !! Indices of the 8 neighbours of each grid 
+                                                                                       !! point [1=N, 2=NE, 3=E, 4=SE,
+                                                                                       !!  5=S, 6=SW, 7=W, 8=NW] 
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)                 :: resolution           !! Resolution at each grid point (m)  
+                                                                                       !! [1=E-W, 2=N-S] 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: clay                 !! Clay fraction (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: herbivores           !! Time constant of probability of a leaf to 
+                                                                                       !! be eaten by a herbivore (days) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: tsurf_daily          !! Daily surface temperatures (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: tsoil_daily          !! Daily soil temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_daily            !! Daily 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_min_daily        !! Daily minimum 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: litterhum_daily      !! Daily litter humidity (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: soilhum_daily        !! Daily soil humidity (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: maxmoiavail_lastyear !! Last year's maximum moisture availability 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: minmoiavail_lastyear !! Last year's minimum moisture availability 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: gdd0_lastyear        !! Last year's GDD0 (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: precip_lastyear      !! Lastyear's precipitation 
+                                                                                       !! @tex $(mm year^{-1})$ @endtex
+										       !! to determine if establishment possible
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_month       !! "Monthly" moisture availability (0 to 1, 
+                                                                                       !! unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_week        !! "Weekly" moisture availability 
+                                                                                       !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: tlong_ref            !! "Long term" 2 meter reference 
+                                                                                       !! temperatures (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_month            !! "Monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_week             !! "Weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: tsoil_month          !! "Monthly" soil temperatures (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)              :: soilhum_month        !! "Monthly" soil humidity
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: gdd_m5_dormance      !! Growing degree days (K), threshold -5 deg 
+                                                                                       !! C (for phenology) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: gdd_from_growthinit  !! growing degree days, since growthinit for crops
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: gdd_midwinter        !! Growing degree days (K), since midwinter 
+                                                                                       !! (for phenology) - this is written to the history files 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: ncd_dormance         !! Number of chilling days (days), since 
+                                                                                       !! leaves were lost (for phenology) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: ngd_minus5           !! Number of growing days (days), threshold 
+                                                                                       !! -5 deg C (for phenology) 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)        :: turnover_longterm    !! "Long term" turnover rate  
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: gpp_daily            !! Daily gross primary productivity  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: time_hum_min         !! Time elapsed since strongest moisture 
+                                                                                       !! availability (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: maxfpc_lastyear      !! Last year's maximum foliage projected
+                                                                                       !! coverage for each natural PFT,
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)        :: resp_maint_part      !! Maintenance respiration of different 
+                                                                                       !! plant parts  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: fpc_max              !! "Maximal" coverage fraction of a PFT (LAI 
+                                                                                       !! -> infinity) on ground  
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    LOGICAL, INTENT(in)                                        :: lcchange             !! Land cover change flag
+    LOGICAL, INTENT(in)                                        :: EndOfYear            !! Flag set on the last day of the year used 
+                                                                                       !! to update "yearly variables". This 
+                                                                                       !! variable must be .TRUE. once a year
+    LOGICAL, INTENT(in)                                        :: EndOfMonth           !! Flag set at end of each month to update 
+                                                                                       !! monthly variable 
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,npool,nelements), INTENT(in) :: soilcarbon_input      !! Amount of carbon going into the DOC pools from litter decomposition \f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)             :: moist_soil            !! moisture in soil for one pixel (m3/m3)
+
+  !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: npp_daily            !! Net primary productivity 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: turnover_daily       !! Turnover rates 
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: co2_to_bm            !! CO2 taken up from atmosphere when 
+                                                                                       !! introducing a new PFT (introduced for 
+                                                                                       !! carbon balance closure) 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: co2_fire             !! Carbon emitted into the atmosphere by 
+                                                                                       !! fire (living and dead biomass)  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: resp_hetero          !! Heterotrophic respiration
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: resp_maint           !! Maintenance respiration  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: resp_growth          !! Growth respiration  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                :: deadleaf_cover       !! Fraction of soil covered by dead leaves 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax                !! Maximum rate of carboxylation 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vjmax                !! Maximum rate of RUbp regeneration  
+                                                                                       !! @tex $(\mumol CO_2 m^{-2}s^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: t_photo_min          !! Minimum temperature for photosynthesis 
+                                                                                       !! (C) This is not K because it is a scalar.
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: t_photo_opt          !! Optimum temperature for photosynthesis 
+                                                                                       !! (C) This is not K because it is a scalar.
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: t_photo_max          !! Maximum temperature for photosynthesis 
+                                                                                       !! (C) This is not K because it is a scalar.
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out):: bm_to_litter      !! Conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+
+    !! 0.3 Modified variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: height               !! Height of vegetation (m) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: lai                  !! Leaf area index OF AN INDIVIDUAL PLANT,
+										       !! where a PFT contains n indentical plants
+										       !! i.e., using the mean individual approach 
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: rprof                !! Prescribed root depth (m) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)                :: PFTpresent           !! Tab indicating which PFTs are present in 
+                                                                                       !! each pixel 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: age                  !! Age (years)    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: fireindex            !! Probability of fire (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: firelitter           !! Longer term litter above the ground that 
+                                                                                       !! can be burned, @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age             !! Leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac            !! Fraction of leaves in leaf age class, 
+                                                                                       !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! Biomass @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: ind                  !! Density of individuals 
+                                                                                       !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: adapted              !! Adaptation of PFT (killed if too cold) 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: regenerate           !! "Fitness": Winter sufficiently cold for 
+                                                                                       !! PFT regeneration ? (0 to 1, unitless) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)                :: senescence           !! Flag for setting senescence stage (only 
+                                                                                       !! for deciduous trees) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: when_growthinit      !! How many days ago was the beginning of 
+                                                                                       !! the growing season (days) 
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)      :: litterpart           !! Fraction of litter above the ground 
+                                                                                       !! belonging to different PFTs
+                                                                                       !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(npts,nlitt,nvm, nelements), INTENT(inout):: litter_above    !! Metabolic and structural litter, above ground 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements), INTENT(inout):: litter_below !! Metabolic and structural litter, below ground
+                                                                                       !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)      :: dead_leaves          !! Dead leaves on ground, per PFT, metabolic 
+                                                                                       !! and structural,  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl), INTENT(inout) :: carbon               !! Carbon pool: active, slow, or passive, 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements), INTENT(inout) :: DOC   !! Dissolved Organic Carbon in soil
+                                                                                       !! The unit is given by m^2 of ground
+                                                                                       !! @tex $(gC m{-2} of ground)$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nexp,nelements), INTENT(inout) :: DOC_EXP          !! Exported Dissolved Organic Carbon from soil
+                                                                                       !! The unit is given by m^2 of ground
+                                                                                       !! @tex $(gC m{-2} of ground) $ @endtex
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                :: black_carbon         !! Black carbon on the ground 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: lignin_struc_above   !! Ratio of Lignin/Carbon in structural 
+                                                                                       !! litter, above ground,  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: veget_max            !! "Maximal" coverage fraction of a PFT (LAI 
+                                                                                       !! -> infinity) on ground 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: npp_longterm         !! "Long term" mean yearly primary 
+                                                                                       !! productivity 
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: lm_lastyearmax       !! Last year's maximum leaf mass, for each 
+                                                                                       !! PFT @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: veget_lastlight      !! Vegetation fractions (on ground) after 
+                                                                                       !! last light competition  
+                                                                                       !! @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: everywhere           !! Is the PFT everywhere in the grid box or 
+                                                                                       !! very localized (after its introduction) 
+                                                                                       !! (unitless) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)                :: need_adjacent        !! In order for this PFT to be introduced, 
+                                                                                       !! does it have to be present in an 
+                                                                                       !! adjacent grid box? 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: RIP_time             !! How much time ago was the PFT eliminated 
+                                                                                       !! for the last time (y) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: turnover_time        !! Turnover_time of leaves for grasses 
+                                                                                       !! (days)
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(inout)             :: veget_max_new        !! New "maximal" coverage fraction of a PFT 
+                                                                                       !! (LAI -> infinity) (unitless) 
+    REAL(r_std),DIMENSION(npts,0:10), INTENT(inout)            :: prod10               !! Products remaining in the 10
+                                                                                       !! year-turnover pool after the annual 
+                                                                                       !! release for each compartment (10
+                                                                                       !! + 1 : input from year of land cover 
+                                                                                       !! change) @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,0:100), INTENT(inout)           :: prod100              !! Products remaining in the 100 
+                                                                                       !! year-turnover pool after the annual 
+                                                                                       !! release for each compartment (100 
+                                                                                       !! + 1 : input from year of land cover 
+                                                                                       !! change) @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,10), INTENT(inout)              :: flux10               !! Annual release from the 10
+                                                                                       !! year-turnover pool compartments  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts,100), INTENT(inout)             :: flux100              !! Annual release from the 100 
+                                                                                       !! year-turnover pool compartments  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts), INTENT(inout)                 :: convflux             !! Release during first year following land 
+                                                                                       !! cover change @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts), INTENT(inout)                 :: cflux_prod10         !! Total annual release from the 10 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts), INTENT(inout)                 :: cflux_prod100        !! Total annual release from the 100 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                :: harvest_above        !! Harvest above ground biomass for 
+                                                                                       !! agriculture @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                :: carb_mass_total      !! Carbon Mass total (soil, litter, veg) 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex  
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(inout) :: MatrixA         !! Matrix containing the fluxes  
+                                                                                       !! between the carbon pools
+                                                                                       !! per sechiba time step 
+                                                                                       !! @tex $(gC.m^2.day^{-1})$ @endtex
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: tot_bm_to_litter    !! Total conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: tot_live_biomass    !! Total living biomass  
+                                                                                       !! @tex $(gC m{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements)           :: bm_alloc            !! Biomass increase, i.e. NPP per plant part 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                  :: tot_turnover        !! Total turnover rate  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nbdl)                       :: tot_litter_soil_carb!! Total soil and litter carbon  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nbdl)                       :: tot_litter_carb     !! Total litter carbon 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nbdl)                       :: tot_soil_carb       !! Total soil carbon  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts)                                :: carb_mass_variation !! Carbon Mass variation  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: cn_ind              !! Crown area of individuals 
+                                                                                       !! @tex $(m^{2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: woodmass_ind        !! Woodmass of individuals (gC) 
+    REAL(r_std), DIMENSION(npts,nvm,nparts)                     :: f_alloc             !! Fraction that goes into plant part 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: avail_tree          !! Space availability for trees 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: avail_grass         !! Space availability for grasses 
+                                                                                       !! (0 to 1, unitless) 
+    INTEGER                                                     :: j,l,k,i
+    REAL(r_std),DIMENSION(npts)                                 :: prod10_total        !! Total products remaining in the pool 
+                                                                                       !! after the annual release 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts)                                 :: prod100_total       !! Total products remaining in the pool 
+                                                                                       !! after the annual release 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(npts)                                 :: cflux_prod_total    !! Total flux from conflux and the 10/100 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(npts,nvm)                             :: veget_max_old       !! "Maximal" coverage fraction of a PFT  
+                                                                                       !! (LAI-> infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: mortality           !! Fraction of individual dying this time 
+                                                                                       !! step (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts)                                :: vartmp              !! Temporary variable used to add history
+    REAL(r_std), DIMENSION(npts,nbdl)                           :: var_tmp             !! Temporary variable used to add history
+    REAL(r_std), DIMENSION(npts,nvm)                            :: tmp_var             !! Temporary variable used to add history
+    REAL(r_std), DIMENSION(npts,nvm)                            :: histvar             !! History variables
+    REAL(r_std), SAVE, DIMENSION(0:nbdl)                        :: z_soil              !! Variable to store depth of the different
+                                                                                       !! soil layers (m)
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering stomate_lpj'
+
+  
+  !! 1. Initializations
+    
+    !! 1.1 Initialize variables to zero
+    co2_to_bm(:,:) = zero
+    co2_fire(:,:) = zero
+    npp_daily(:,:) = zero
+    resp_maint(:,:) = zero
+    resp_growth(:,:) = zero
+    harvest_above(:) = zero
+    bm_to_litter(:,:,:,:) = zero
+    cn_ind(:,:) = zero
+    woodmass_ind(:,:) = zero
+    turnover_daily(:,:,:,:) = zero
+
+       !! 1.1.1 Copy the depth of the different soil layers (number of layers=nbdl) 
+       !        previously calculated as variable diaglev in routines sechiba.f90 and slowproc.f90  
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+    
+    !! 1.2  Initialize variables to veget_max
+    veget_max_old(:,:) = veget_max(:,:)
+
+    !! 1.3 Calculate some vegetation characteristics
+    
+    !! 1.3.1 Calculate some vegetation characteristics 
+    !        Calculate cn_ind (individual crown mass) and individual height from
+    !        state variables if running DGVM or dynamic mortality in static cover mode
+    !??        Explain (maybe in the header once) why you mulitply with veget_max in the DGVM
+    !??        and why you don't multiply with veget_max in stomate.
+    IF ( control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN
+       IF(control%ok_dgvm) THEN
+          WHERE (ind(:,:).GT.min_stomate)
+             woodmass_ind(:,:) = &
+                  ((biomass(:,:,isapabove,icarbon)+biomass(:,:,isapbelow,icarbon) &
+                  +biomass(:,:,iheartabove,icarbon)+biomass(:,:,iheartbelow,icarbon)) & 
+                  *veget_max(:,:))/ind(:,:)
+          ENDWHERE
+       ELSE
+          WHERE (ind(:,:).GT.min_stomate)
+             woodmass_ind(:,:) = &
+                  (biomass(:,:,isapabove,icarbon)+biomass(:,:,isapbelow,icarbon) &
+                  +biomass(:,:,iheartabove,icarbon)+biomass(:,:,iheartbelow,icarbon))/ind(:,:)
+          ENDWHERE
+       ENDIF
+
+       CALL crown (npts,  PFTpresent, &
+            ind, biomass, woodmass_ind, &
+            veget_max, cn_ind, height)
+    ENDIF
+
+    !! 1.3.2 Prescribe characteristics if the vegetation is not dynamic
+    !        IF the DGVM is not activated, the density of individuals and their crown
+    !        areas don't matter, but they should be defined for the case we switch on
+    !        the DGVM afterwards. At the first call, if the DGVM is not activated, 
+    !        impose a minimum biomass for prescribed PFTs and declare them present.
+    CALL prescribe (npts, &
+         veget_max, dt_days, PFTpresent, everywhere, when_growthinit, &
+         biomass, leaf_frac, ind, cn_ind, co2_to_bm)
+
+
+  !! 2. Climatic constraints for PFT presence and regenerativeness
+
+    !   Call this even when DGVM is not activated so that "adapted" and "regenerate"
+    !   are kept up to date for the moment when the DGVM is activated.
+    CALL constraints (npts, dt_days, &
+         t2m_month, t2m_min_daily,when_growthinit, &
+         adapted, regenerate)
+
+    
+  !! 3. Determine introduction and elimination of PTS based on climate criteria
+ 
+    IF ( control%ok_dgvm ) THEN
+      
+       !! 3.1 Calculate introduction and elimination
+       CALL pftinout (npts, dt_days, adapted, regenerate, &
+            neighbours, veget_max, &
+            biomass, ind, cn_ind, age, leaf_frac, npp_longterm, lm_lastyearmax, senescence, &
+            PFTpresent, everywhere, when_growthinit, need_adjacent, RIP_time, &
+            co2_to_bm, &
+            avail_tree, avail_grass)
+
+       !! 3.2 Reset attributes for eliminated PFTs.
+       !     This also kills PFTs that had 0 leafmass during the last year. The message
+       !     "... after pftinout" is misleading in this case.
+       CALL kill (npts, 'pftinout  ', lm_lastyearmax, &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_max, bm_to_litter)
+
+       
+       !! 3.3 Calculate new crown area and diameter 
+       !      Calculate new crown area, diameter and maximum vegetation cover**[No longer used in the subroutine]
+       !      unsure whether this is really required
+       !      - in theory this could ONLY be done at the END of stomate_lpj
+       !      calculate woodmass of individual tree
+       WHERE ((ind(:,:).GT.min_stomate))
+          WHERE  ( veget_max(:,:) .GT. min_stomate)
+             woodmass_ind(:,:) = &
+                  ((biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) &
+                  + biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon))*veget_max(:,:))/ind(:,:)
+          ELSEWHERE
+             woodmass_ind(:,:) =(biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) &
+                  + biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon))/ind(:,:)
+          ENDWHERE
+
+       ENDWHERE
+       
+       ! Calculate crown area and diameter for all PFTs (including the newly established)
+       CALL crown (npts, PFTpresent, &
+            ind, biomass, woodmass_ind, &
+            veget_max, cn_ind, height)
+
+    ENDIF
+    
+  !! 4. Phenology
+
+    !! 4.1 Write values to history file
+    !      Current values for ::when_growthinit 
+    CALL histwrite_p (hist_id_stomate, 'WHEN_GROWTHINIT', itime, when_growthinit, npts*nvm, horipft_index)
+
+    ! Set and write values for ::PFTpresent
+    WHERE(PFTpresent)
+       histvar=un
+    ELSEWHERE
+       histvar=zero
+    ENDWHERE
+    CALL histwrite_p (hist_id_stomate, 'PFTPRESENT', itime, histvar, npts*nvm, horipft_index)
+
+    ! Set and write values for gdd_midwinter
+    WHERE(gdd_midwinter.EQ.undef)
+       histvar=val_exp
+    ELSEWHERE
+       histvar=gdd_midwinter
+    ENDWHERE
+    CALL histwrite_p (hist_id_stomate, 'GDD_MIDWINTER', itime, histvar, npts*nvm, horipft_index)
+
+    ! Set and write values for gdd_m5_dormance
+    WHERE(gdd_m5_dormance.EQ.undef)
+       histvar=val_exp
+    ELSEWHERE
+       histvar=gdd_m5_dormance
+    ENDWHERE
+    CALL histwrite_p (hist_id_stomate, 'GDD_M5_DORMANCE', itime, histvar, npts*nvm, horipft_index)
+
+    ! Set and write values for ncd_dormance
+    WHERE(ncd_dormance.EQ.undef)
+       histvar=val_exp
+    ELSEWHERE
+       histvar=ncd_dormance
+    ENDWHERE
+    CALL histwrite_p (hist_id_stomate, 'NCD_DORMANCE', itime, histvar, npts*nvm, horipft_index)
+
+    !! 4.2 Calculate phenology
+    CALL phenology (npts, dt_days, PFTpresent, &
+         veget_max, &
+         tlong_ref, t2m_month, t2m_week, gpp_daily, &
+         maxmoiavail_lastyear, minmoiavail_lastyear, &
+         moiavail_month, moiavail_week, &
+         gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+         senescence, time_hum_min, &
+         biomass, leaf_frac, leaf_age, &
+         when_growthinit, co2_to_bm)
+    
+  !! 5. Allocate C to different plant parts
+    
+    CALL alloc (npts, dt_days, &
+         lai, veget_max, senescence, when_growthinit, &
+         moiavail_week, tsoil_month, soilhum_month, &
+         biomass, age, leaf_age, leaf_frac, rprof, f_alloc)
+
+  !! 6. NPP, maintenance and growth respiration
+
+    !! 6.1 Calculate NPP and respiration terms
+    CALL npp_calc (npts, dt_days, &
+         PFTpresent, &
+         tlong_ref, t2m_daily, tsoil_daily, lai, rprof, &
+         gpp_daily, f_alloc, bm_alloc, resp_maint_part,&
+         biomass, leaf_age, leaf_frac, age, &
+         resp_maint, resp_growth, npp_daily)
+
+    !! 6.2 Kill slow growing PFTs in DGVM or STOMATE with constant mortality
+    IF ( control%ok_dgvm .OR. .NOT.lpj_gap_const_mort) THEN
+       CALL kill (npts, 'npp       ', lm_lastyearmax,  &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_max, bm_to_litter)
+
+       !! 6.2.1 Update wood biomass      
+       !        For the DGVM
+       IF(control%ok_dgvm) THEN
+          WHERE (ind(:,:).GT.min_stomate)
+             woodmass_ind(:,:) = &
+                  ((biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) &
+                  + biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon)) & 
+                  *veget_max(:,:))/ind(:,:)
+          ENDWHERE
+
+       ! For all pixels with individuals
+       ELSE
+          WHERE (ind(:,:).GT.min_stomate)
+             woodmass_ind(:,:) = &
+                  (biomass(:,:,isapabove,icarbon) + biomass(:,:,isapbelow,icarbon) &
+                  + biomass(:,:,iheartabove,icarbon) + biomass(:,:,iheartbelow,icarbon))/ind(:,:)
+          ENDWHERE
+       ENDIF ! control%ok_dgvm
+
+       !! 6.2.2 New crown area and maximum vegetation cover after growth
+       CALL crown (npts, PFTpresent, &
+            ind, biomass, woodmass_ind,&
+            veget_max, cn_ind, height)
+
+    ENDIF ! control%ok_dgvm
+    
+  !! 7. fire
+
+    !! 7.1. Burn PFTs
+    CALL fire (npts, dt_days, litterpart, &
+         litterhum_daily, t2m_daily, lignin_struc_above, veget_max, &
+         fireindex, firelitter, biomass, ind, &
+         litter_above, dead_leaves, bm_to_litter, black_carbon, &
+         co2_fire, MatrixA)
+
+    !! 7.2 Kill PFTs in DGVM
+    IF ( control%ok_dgvm ) THEN
+
+       ! reset attributes for eliminated PFTs
+       CALL kill (npts, 'fire      ', lm_lastyearmax, &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_max, bm_to_litter)
+
+    ENDIF ! control%ok_dgvm
+ 
+  !! 8. Tree mortality
+
+    ! Does not depend on age, therefore does not change crown area.
+    CALL gap (npts, dt_days, &
+         npp_longterm, turnover_longterm, lm_lastyearmax, &
+         PFTpresent, biomass, ind, bm_to_litter, mortality)
+
+    IF ( control%ok_dgvm ) THEN
+
+       ! reset attributes for eliminated PFTs
+       CALL kill (npts, 'gap       ', lm_lastyearmax, &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_max, bm_to_litter)
+
+    ENDIF
+
+  !! 9. Calculate vcmax, vjmax and photosynthesis temperatures
+
+    CALL vmax (npts, dt_days, &
+         leaf_age, leaf_frac, &
+         vcmax, vjmax)
+
+    CALL assim_temp (npts, tlong_ref, t2m_month, &
+         t_photo_min, t_photo_opt, t_photo_max)
+
+  !! 10. Leaf senescence, new lai and other turnover processes
+
+    CALL turn (npts, dt_days, PFTpresent, &
+         herbivores, &
+         maxmoiavail_lastyear, minmoiavail_lastyear, &
+         moiavail_week,  moiavail_month,tlong_ref, t2m_month, t2m_week, veget_max, &
+         gdd_from_growthinit, leaf_age, leaf_frac, age, lai, biomass, &
+         turnover_daily, senescence,turnover_time)
+
+    !! 11. Light competition
+    
+    !! If not using constant mortality then kill with light competition
+!    IF ( control%ok_dgvm .OR. .NOT.(lpj_gap_const_mort) ) THEN
+    IF ( control%ok_dgvm ) THEN
+ 
+       !! 11.1 Light competition
+       CALL light (npts, dt_days, &
+            veget_max, fpc_max, PFTpresent, cn_ind, lai, maxfpc_lastyear, &
+            lm_lastyearmax, ind, biomass, veget_lastlight, bm_to_litter, mortality)
+       
+       !! 11.2 Reset attributes for eliminated PFTs
+       CALL kill (npts, 'light     ', lm_lastyearmax, &
+            ind, PFTpresent, cn_ind, biomass, senescence, RIP_time, &
+            lai, age, leaf_age, leaf_frac, npp_longterm, &
+            when_growthinit, everywhere, veget_max, bm_to_litter)
+
+    ENDIF
+
+    
+  !! 12. Establishment of saplings
+    
+    IF ( control%ok_dgvm .OR. .NOT.lpj_gap_const_mort ) THEN
+
+       !! 12.1 Establish new plants
+       CALL establish (npts, dt_days, PFTpresent, regenerate, &
+            neighbours, resolution, need_adjacent, herbivores, &
+            precip_lastyear, gdd0_lastyear, lm_lastyearmax, &
+            cn_ind, lai, avail_tree, avail_grass, npp_longterm, &
+            leaf_age, leaf_frac, &
+            ind, biomass, age, everywhere, co2_to_bm, veget_max, woodmass_ind)
+
+       !! 12.2 Calculate new crown area (and maximum vegetation cover)
+       CALL crown (npts, PFTpresent, &
+            ind, biomass, woodmass_ind, &
+            veget_max, cn_ind, height)
+
+    ENDIF
+
+  !! 13. Calculate final LAI and vegetation cover
+    
+    CALL cover (npts, cn_ind, ind, biomass, &
+         veget_max, veget_max_old, lai, &
+         litter_above, litter_below, carbon, DOC, turnover_daily, &
+         bm_to_litter,moist_soil)
+
+  !! 14. Update litter pools to account for harvest
+ 
+    ! the whole litter stuff:
+    !    litter update, lignin content, PFT parts, litter decay, 
+    !    litter heterotrophic respiration, dead leaf soil cover.
+    !    No vertical discretisation in the soil for litter decay.\n
+    ! added by shilong for harvest
+    IF(harvest_agri) THEN
+       CALL harvest(npts, dt_days, veget_max, &
+            bm_to_litter, turnover_daily, &
+            harvest_above)
+    ENDIF
+
+  !! 15. Land cover change
+
+    !shilong adde turnover_daily
+    IF(EndOfYear) THEN
+       IF (lcchange) THEN
+          CALL lcchange_main (npts, dt_days, veget_max, veget_max_new, &
+               biomass, ind, age, PFTpresent, senescence, when_growthinit, everywhere, &
+               co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, cn_ind,flux10,flux100, &
+!!$               prod10,prod100,prod10_total,prod100_total,&
+!!$               convflux,cflux_prod_total,cflux_prod10,cflux_prod100,leaf_frac,&
+               prod10,prod100,convflux,cflux_prod10,cflux_prod100,leaf_frac,&
+               npp_longterm, lm_lastyearmax, litter_above, litter_below, carbon, DOC,moist_soil)
+       ENDIF
+    ENDIF
+    !MM dÃ©placement pour initialisation correcte des grandeurs cumulÃ©es :
+    cflux_prod_total(:) = convflux(:) + cflux_prod10(:) + cflux_prod100(:)
+    prod10_total(:)=SUM(prod10,dim=2)
+    prod100_total(:)=SUM(prod100,dim=2)
+    
+  !! 16. Total heterotrophic respiration
+
+    tot_soil_carb(:,:,:) = zero
+    tot_litter_carb(:,:,:) = zero
+    DO j=2,nvm
+          !tot_litter_carb(:,j,1) = tot_litter_carb(:,j,1) + &
+          !     &          litter_above(:,istructural,j,icarbon) + litter_above(:,imetabolic,j,icarbon)
+       DO l=1,nbdl
+          tot_litter_carb(:,j,l) = tot_litter_carb(:,j,l) + &
+               &          litter_below(:,istructural,j,l,icarbon) + litter_below(:,imetabolic,j,l,icarbon)
+      ENDDO
+
+       DO l=1,nbdl
+
+          tot_soil_carb(:,j,l) = tot_soil_carb(:,j,l) + (carbon(:,iactive,j,l) + &
+               &          carbon(:,islow,j,l) + carbon(:,ipassive,j,l)) 
+       ENDDO
+
+     DO k =1,npool
+       DO l=1,nbdl
+
+          tot_soil_carb(:,j,l) = tot_soil_carb(:,j,l) + &
+               &          (DOC(:,j,l,ifree,k,icarbon) + DOC(:,j,l,iadsorbed,k,icarbon))
+       ENDDO
+
+    ENDDO
+
+    ENDDO 
+
+    tot_litter_soil_carb(:,:,:) = tot_litter_carb(:,:,:) + tot_soil_carb(:,:,:)
+
+!!$     DO k = 1, nelements ! Loop over # elements
+!!$        tot_live_biomass(:,:,k) = biomass(:,:,ileaf,k) + biomass(:,:,isapabove,k) + biomass(:,:,isapbelow,k) +&
+!!$             &                    biomass(:,:,iheartabove,k) + biomass(:,:,iheartbelow,k) + &
+!!$             &                    biomass(:,:,iroot,k) + biomass(:,:,ifruit,k) + biomass(:,:,icarbres,k)
+!!$    END DO ! Loop over # elements
+
+    tot_live_biomass(:,:,:) = biomass(:,:,ileaf,:) + biomass(:,:,isapabove,:) + biomass(:,:,isapbelow,:) +&
+             &                    biomass(:,:,iheartabove,:) + biomass(:,:,iheartbelow,:) + &
+             &                    biomass(:,:,iroot,:) + biomass(:,:,ifruit,:) + biomass(:,:,icarbres,:)
+
+
+    tot_turnover(:,:,:) = turnover_daily(:,:,ileaf,:) + turnover_daily(:,:,isapabove,:) + &
+         &         turnover_daily(:,:,isapbelow,:) + turnover_daily(:,:,iheartabove,:) + &
+         &         turnover_daily(:,:,iheartbelow,:) + turnover_daily(:,:,iroot,:) + &
+         &         turnover_daily(:,:,ifruit,:) + turnover_daily(:,:,icarbres,:)
+
+    tot_bm_to_litter(:,:,:) = bm_to_litter(:,:,ileaf,:) + bm_to_litter(:,:,isapabove,:) +&
+         &             bm_to_litter(:,:,isapbelow,:) + bm_to_litter(:,:,iheartbelow,:) +&
+         &             bm_to_litter(:,:,iheartabove,:) + bm_to_litter(:,:,iroot,:) + &
+         &             bm_to_litter(:,:,ifruit,:) + bm_to_litter(:,:,icarbres,:)
+
+    carb_mass_variation(:)=-carb_mass_total(:)
+  DO k=1,nvm
+    DO l= 1,nbdl
+      carb_mass_total(:)=carb_mass_total(:)+ tot_live_biomass(:,k,icarbon)*veget_max(:,k)+&
+           &                 (tot_litter_carb(:,k,l)+tot_soil_carb(:,k,l))*veget_max(:,k)*(z_soil(l)/dpu_max) + &
+           &                 (prod10_total + prod100_total)
+    ENDDO
+  ENDDO
+    carb_mass_variation(:)=carb_mass_total(:)+carb_mass_variation(:)
+    
+  !! 17. Write history
+
+    CALL histwrite_p (hist_id_stomate, 'RESOLUTION_X', itime, &
+         resolution(:,1), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'RESOLUTION_Y', itime, &
+         resolution(:,2), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CONTFRAC', itime, &
+         contfrac(:), npts, hori_index)
+
+
+    CALL histwrite_p (hist_id_stomate, 'LITTER_STR_AB', itime, &
+         litter_above(:,istructural,:,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LITTER_MET_AB', itime, &
+         litter_above(:,imetabolic,:,icarbon), npts*nvm, horipft_index)
+
+ var_tmp(:,:)=zero
+
+ DO l= 1,nvm
+   var_tmp(:,1)=var_tmp(:,1)+litter_below(:,istructural,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+
+ DO j= 2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+litter_below(:,istructural,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'LITTER_STR_BE', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+ DO l= 1,nvm   
+   var_tmp(:,1)=var_tmp(:,1)+litter_below(:,imetabolic,l,1,icarbon)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+litter_below(:,imetabolic,l,j,icarbon)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'LITTER_MET_BE', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+
+    CALL histwrite_p (hist_id_stomate, 'DEADLEAF_COVER', itime, &
+         deadleaf_cover, npts, hori_index)
+ var_tmp(:,:)=zero
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+tot_litter_soil_carb(:,l,1)*veget_max(:,l)/z_soil(1)
+ ENDDO
+
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+tot_litter_soil_carb(:,l,j)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'TOTAL_SOIL_CARB', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,iactive,l,1)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j=2,nbdl
+   DO l= 1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,iactive,l,j)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'CARBON_ACTIVE', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,islow,l,1)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j= 2,nbdl
+   DO l=1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,islow,l,j)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'CARBON_SLOW', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+ DO l= 1,nvm
+  var_tmp(:,1)=var_tmp(:,1)+carbon(:,ipassive,l,1)*veget_max(:,l)/z_soil(1)
+ ENDDO
+ DO j= 2,nbdl
+   DO l=1,nvm
+    var_tmp(:,j)=var_tmp(:,j)+carbon(:,ipassive,l,j)*veget_max(:,l)/(z_soil(j)-z_soil(j-1))
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'CARBON_PASSIVE', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ var_tmp(:,:)=zero
+
+   DO l=1,nvm
+     DO k= 1,npool
+    var_tmp(:,1)=var_tmp(:,1)+DOC(:,l,1,ifree,k,icarbon)*veget_max(:,l)/ &
+                              (z_soil(1))
+     ENDDO
+   ENDDO
+
+ DO j= 2,nbdl
+   DO l=1,nvm
+     DO k= 1,npool
+    var_tmp(:,j)=var_tmp(:,j)+DOC(:,l,j,ifree,k,icarbon)*veget_max(:,l)/ &
+                              (z_soil(j)-z_soil(j-1))
+     ENDDO
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'FREE_DOC', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+ 
+
+ var_tmp(:,:)=zero
+   DO l=1,nvm
+     DO k=1,npool
+    var_tmp(:,1)=var_tmp(:,1)+DOC(:,l,1,iadsorbed,k,icarbon)*veget_max(:,l)/ &
+                              (z_soil(1))
+   
+     ENDDO
+   ENDDO
+
+ DO j= 2,nbdl
+   DO l=1,nvm
+     DO k=1,npool
+    var_tmp(:,j)=var_tmp(:,j)+DOC(:,l,j,iadsorbed,k,icarbon)*veget_max(:,l)/ &
+                              (z_soil(j)-z_soil(j-1))
+
+     ENDDO
+   ENDDO
+ ENDDO
+    CALL histwrite_p (hist_id_stomate, 'ADSORBED_DOC', itime, &
+         var_tmp(:,:), npts*nbdl, horisoillayer_index)
+
+    CALL histwrite_p (hist_id_stomate, 'EXPORTED_DOC_RUNOFF', itime, &
+         DOC_EXP(:,:,irunoff,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'EXPORTED_DOC_DRAIN', itime, &
+         DOC_EXP(:,:,idrainage,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'EXPORTED_DOC_FLOOD', itime, &
+         DOC_EXP(:,:,iflooded,icarbon), npts*nvm, horipft_index)
+!    DO l=1,nvm
+!    tmp_var(:,j)=(DOC_EXP(:,l,iflooded, icarbon)+DOC_EXP(:,l,irunoff,icarbon))
+!    ENDDO
+!    CALL histwrite_p (hist_id_stomate, 'EXPORTED_DOC_STOCK', itime, &
+!         tmp_var(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'T2M_MONTH', itime, &
+         t2m_month, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'T2M_WEEK', itime, &
+         t2m_week, npts, hori_index)
+
+    CALL histwrite_p (hist_id_stomate, 'HET_RESP', itime, &
+         resp_hetero(:,:), npts*nvm, horipft_index)
+
+    CALL histwrite_p (hist_id_stomate, 'BLACK_CARBON', itime, &
+         black_carbon, npts, hori_index)
+
+    CALL histwrite_p (hist_id_stomate, 'FIREINDEX', itime, &
+         fireindex(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LITTERHUM', itime, &
+         litterhum_daily, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CO2_FIRE', itime, &
+         co2_fire, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'CO2_TAKEN', itime, &
+         co2_to_bm, npts*nvm, horipft_index)
+    ! land cover change
+    CALL histwrite_p (hist_id_stomate, 'CONVFLUX', itime, &
+         convflux, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CFLUX_PROD10', itime, &
+         cflux_prod10, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CFLUX_PROD100', itime, &
+         cflux_prod100, npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'HARVEST_ABOVE', itime, &
+         harvest_above, npts, hori_index)
+
+    CALL histwrite_p (hist_id_stomate, 'LAI', itime, &
+         lai, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'VEGET_MAX', itime, &
+         veget_max, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'NPP', itime, &
+         npp_daily, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'GPP', itime, &
+         gpp_daily, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'IND', itime, &
+         ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'CN_IND', itime, &
+         cn_ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'WOODMASS_IND', itime, &
+         woodmass_ind, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'TOTAL_M', itime, &
+         tot_live_biomass(:,:,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LEAF_M', itime, &
+         biomass(:,:,ileaf,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_M_AB', itime, &
+         biomass(:,:,isapabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_M_BE', itime, &
+         biomass(:,:,isapbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEART_M_AB', itime, &
+         biomass(:,:,iheartabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEART_M_BE', itime, &
+         biomass(:,:,iheartbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ROOT_M', itime, &
+         biomass(:,:,iroot,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FRUIT_M', itime, &
+         biomass(:,:,ifruit,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'RESERVE_M', itime, &
+         biomass(:,:,icarbres,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'TOTAL_TURN', itime, &
+         tot_turnover(:,:,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LEAF_TURN', itime, &
+         turnover_daily(:,:,ileaf,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_AB_TURN', itime, &
+         turnover_daily(:,:,isapabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ROOT_TURN', itime, &
+         turnover_daily(:,:,iroot,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FRUIT_TURN', itime, &
+         turnover_daily(:,:,ifruit,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'TOTAL_BM_LITTER', itime, &
+         tot_bm_to_litter(:,:,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'LEAF_BM_LITTER', itime, &
+         bm_to_litter(:,:,ileaf,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_AB_BM_LITTER', itime, &
+         bm_to_litter(:,:,isapabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'SAP_BE_BM_LITTER', itime, &
+         bm_to_litter(:,:,isapbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEART_AB_BM_LITTER', itime, &
+         bm_to_litter(:,:,iheartabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEART_BE_BM_LITTER', itime, &
+         bm_to_litter(:,:,iheartbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'ROOT_BM_LITTER', itime, &
+         bm_to_litter(:,:,iroot,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'FRUIT_BM_LITTER', itime, &
+         bm_to_litter(:,:,ifruit,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'RESERVE_BM_LITTER', itime, &
+         bm_to_litter(:,:,icarbres,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'MAINT_RESP', itime, &
+         resp_maint, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'GROWTH_RESP', itime, &
+         resp_growth, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AGE', itime, &
+         age, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HEIGHT', itime, &
+         height, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'MOISTRESS', itime, &
+         moiavail_week, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'VCMAX', itime, &
+         vcmax, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'TURNOVER_TIME', itime, &
+         turnover_time, npts*nvm, horipft_index)
+    ! land cover change
+    CALL histwrite_p (hist_id_stomate, 'PROD10', itime, &
+         prod10, npts*11, horip11_index)
+    CALL histwrite_p (hist_id_stomate, 'PROD100', itime, &
+         prod100, npts*101, horip101_index)
+    CALL histwrite_p (hist_id_stomate, 'FLUX10', itime, &
+         flux10, npts*10, horip10_index)
+    CALL histwrite_p (hist_id_stomate, 'FLUX100', itime, &
+         flux100, npts*100, horip100_index)
+
+    IF ( hist_id_stomate_IPCC > 0 ) THEN
+       vartmp(:)=SUM(tot_live_biomass(:,:,icarbon)*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cVeg", itime, &
+            vartmp, npts, hori_index)
+       DO l=1,nbdl
+            var_tmp(:,l)=SUM(tot_litter_carb(:,:,l)*veget_max,dim=2)/1e3*contfrac
+       ENDDO
+             vartmp(:)=vartmp(:)+var_tmp(:,1)*(z_soil(1)/dpu_max)
+
+       DO l=2,nbdl
+             vartmp(:)=vartmp(:)+var_tmp(:,l)*((z_soil(l)-z_soil(l-1))/dpu_max)
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "cLitter", itime, &
+            vartmp, npts, hori_index)
+       DO l=1,nbdl
+            var_tmp(:,l)=SUM(tot_soil_carb(:,:,l)*veget_max,dim=2)/1e3*contfrac
+       ENDDO
+             vartmp(:)=vartmp(:)+var_tmp(:,1)*(z_soil(1)/dpu_max)
+
+       DO l=2,nbdl
+             vartmp(:)=vartmp(:)+var_tmp(:,l)*((z_soil(l)-z_soil(l-1))/dpu_max)
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "cSoil", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=(prod10_total + prod100_total)/1e3
+       CALL histwrite_p (hist_id_stomate_IPCC, "cProduct", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=carb_mass_variation/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cMassVariation", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(lai*veget_max,dim=2)*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "lai", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(gpp_daily*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "gpp", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM((resp_maint+resp_growth)*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "ra", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(npp_daily*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "npp", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_hetero*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "rh", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2_fire*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "fFire", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=harvest_above/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "fHarvest", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=cflux_prod_total/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "fLuc", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=(SUM((gpp_daily-(resp_maint+resp_growth+resp_hetero)-co2_fire) &
+            &        *veget_max,dim=2)-cflux_prod_total-harvest_above)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "nbp", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM((tot_bm_to_litter(:,:,icarbon) + tot_turnover(:,:,icarbon))*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "fVegLitter", itime, &
+            vartmp, npts, hori_index)
+       DO l=2,nbdl
+        DO k=1,nvm
+         DO j=1,4 !just the litter pools are used
+          vartmp(:)=SUM(soilcarbon_input(:,k,l,j,icarbon)*veget_max(:,k)*((z_soil(l)-z_soil(l-1))/dpu_max))/1e3/one_day*contfrac
+         ENDDO
+        ENDDO
+       ENDDO
+        DO k=1,nvm
+         DO j=1,4 !just the litter pools are used
+          vartmp(:)=vartmp(:) + SUM(soilcarbon_input(:,k,1,j,icarbon)*veget_max(:,k)*((z_soil(1))/dpu_max))/1e3/one_day*contfrac
+         ENDDO
+        ENDDO
+
+       CALL histwrite_p (hist_id_stomate_IPCC, "fLitterSoil", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(biomass(:,:,ileaf,icarbon)*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cLeaf", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM((biomass(:,:,isapabove,icarbon)+biomass(:,:,iheartabove,icarbon))*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cWood", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(( biomass(:,:,iroot,icarbon) + biomass(:,:,isapbelow,icarbon) + biomass(:,:,iheartbelow,icarbon) ) &
+            &        *veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cRoot", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(( biomass(:,:,icarbres,icarbon) + biomass(:,:,ifruit,icarbon))*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cMisc", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM((litter_above(:,istructural,:,icarbon)+litter_above(:,imetabolic,:,icarbon))*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cLitterAbove", itime, &
+            vartmp, npts, hori_index)
+
+       vartmp(:)=0
+       DO l=2,nbdl
+        DO k=1,nvm
+         DO j=1,nlitt
+          vartmp(:)=SUM(litter_below(:,j,k,l,icarbon)*veget_max(:,k)*((z_soil(l)-z_soil(l-1))/dpu_max))/1e3/one_day*contfrac
+         ENDDO
+        ENDDO
+       ENDDO
+        DO k=1,nvm
+         DO j=1,nlitt
+          vartmp(:)=vartmp(:) + SUM(litter_below(:,j,k,1,icarbon)*veget_max(:,k)*((z_soil(1))/dpu_max))/1e3/one_day*contfrac
+         ENDDO
+        ENDDO
+
+       CALL histwrite_p (hist_id_stomate_IPCC, "cLitterBelow", itime, &
+            vartmp, npts, hori_index)
+       DO l=2,nbdl
+          vartmp(:)=SUM(carbon(:,iactive,:,l)*((z_soil(l)-z_soil(l-1))/dpu_max)*veget_max,dim=2)/1e3*contfrac
+       ENDDO
+          vartmp(:)=vartmp(:) + SUM(carbon(:,iactive,:,1)*(z_soil(1)/dpu_max)*veget_max,dim=2)/1e3*contfrac
+
+       CALL histwrite_p (hist_id_stomate_IPCC, "cSoilFast", itime, &
+            vartmp, npts, hori_index)
+       DO l=2,nbdl
+          vartmp(:)=SUM(carbon(:,islow,:,l)*((z_soil(l)-z_soil(l-1))/dpu_max)*veget_max,dim=2)/1e3*contfrac
+       ENDDO
+          vartmp(:)=vartmp(:) + SUM(carbon(:,islow,:,1)*(z_soil(1)/dpu_max)*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cSoilMedium", itime, &
+            vartmp, npts, hori_index)
+       DO l=2,nbdl
+          vartmp(:)=SUM(carbon(:,ipassive,:,l)*((z_soil(l)-z_soil(l-1))/dpu_max)*veget_max,dim=2)/1e3*contfrac
+       ENDDO
+          vartmp(:)=vartmp(:) + SUM(carbon(:,ipassive,:,1)*(z_soil(1)/dpu_max)*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "cSoilSlow", itime, &
+            vartmp, npts, hori_index)
+       DO j=1,nvm
+          histvar(:,j)=veget_max(:,j)*contfrac(:)*100
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "landCoverFrac", itime, &
+            histvar, npts*nvm, horipft_index)
+       !-
+       vartmp(:)=zero
+       DO j = 2,nvm
+          IF (is_deciduous(j)) THEN
+             vartmp(:) = vartmp(:) + veget_max(:,j)*contfrac*100
+          ENDIF
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "treeFracPrimDec", itime, &
+            vartmp, npts, hori_index)
+       !-
+       vartmp(:)=zero
+       DO j = 2,nvm
+          IF (is_evergreen(j)) THEN
+             vartmp(:) = vartmp(:) + veget_max(:,j)*contfrac*100
+          ENDIF
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "treeFracPrimEver", itime, &
+            vartmp, npts, hori_index)
+       !-
+       vartmp(:)=zero
+       DO j = 2,nvm
+          IF ( .NOT.(is_c4(j)) ) THEN
+             vartmp(:) = vartmp(:) + veget_max(:,j)*contfrac*100
+          ENDIF
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "c3PftFrac", itime, &
+            vartmp, npts, hori_index)
+       !-
+       vartmp(:)=zero
+       DO j = 2,nvm
+          IF ( is_c4(j) ) THEN
+             vartmp(:) = vartmp(:) + veget_max(:,j)*contfrac*100
+          ENDIF
+       ENDDO
+       CALL histwrite_p (hist_id_stomate_IPCC, "c4PftFrac", itime, &
+            vartmp, npts, hori_index)
+       !-
+       vartmp(:)=SUM(resp_growth*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "rGrowth", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_maint*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "rMaint", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(bm_alloc(:,:,ileaf,icarbon)*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "nppLeaf", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(bm_alloc(:,:,isapabove,icarbon)*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "nppWood", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(( bm_alloc(:,:,isapbelow,icarbon) + bm_alloc(:,:,iroot,icarbon) )*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite_p (hist_id_stomate_IPCC, "nppRoot", itime, &
+            vartmp, npts, hori_index)
+
+       CALL histwrite_p (hist_id_stomate_IPCC, 'RESOLUTION_X', itime, &
+            resolution(:,1), npts, hori_index)
+       CALL histwrite_p (hist_id_stomate_IPCC, 'RESOLUTION_Y', itime, &
+            resolution(:,2), npts, hori_index)
+       CALL histwrite_p (hist_id_stomate_IPCC, 'CONTFRAC', itime, &
+            contfrac(:), npts, hori_index)
+
+    ENDIF
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving stomate_lpj'
+
+  END SUBROUTINE StomateLpj
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : harvest
+!!
+!>\BRIEF        Harvest of croplands
+!!
+!! DESCRIPTION  : To take into account biomass harvest from crop (mainly to take 
+!! into account for the reduced litter input and then decreased soil carbon. it is a 
+!! constant (40\%) fraction of above ground biomass.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::harvest_above the harvested biomass
+!!
+!! REFERENCE(S) :
+!! - Piao, S., P. Ciais, P. Friedlingstein, N. de Noblet-Ducoudre, P. Cadule, N. Viovy, and T. Wang. 2009. 
+!!   Spatiotemporal patterns of terrestrial carbon cycle during the 20th century. Global Biogeochemical 
+!!   Cycles 23:doi:10.1029/2008GB003339.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE harvest(npts, dt_days, veget_max, &
+       bm_to_litter, turnover_daily, &
+       harvest_above)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                    :: npts            !! Domain size (unitless) 
+    REAL(r_std), INTENT(in)                                :: dt_days         !! Time step (days)                               
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget_max       !! new "maximal" coverage fraction of a PFT (LAI -> 
+                                                                              !! infinity) on ground @tex $(m^2 m^{-2})$ @endtex 
+    
+   !! 0.2 Output variables
+   
+   !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: bm_to_litter !! [DISPENSABLE] conversion of biomass to litter 
+                                                                                     !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: turnover_daily   !! Turnover rates 
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: harvest_above    !! harvest above ground biomass for agriculture 
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                         :: i, j, k, l, m    !! indices                       
+    REAL(r_std)                                            :: above_old        !! biomass of previous time step 
+                                                                               !! @tex $(gC m^{-2})$ @endtex 
+!_ ================================================================================================================================
+
+  !! 1. Yearly initialisation
+
+    above_old             = zero
+    harvest_above         = zero
+
+    DO i = 1, npts
+       DO j = 1,nvm
+          IF (.NOT. natural(j)) THEN
+             above_old = turnover_daily(i,j,ileaf,icarbon) + turnover_daily(i,j,isapabove,icarbon) + &
+                  &       turnover_daily(i,j,iheartabove,icarbon) + turnover_daily(i,j,ifruit,icarbon) + &
+                  &       turnover_daily(i,j,icarbres,icarbon) + turnover_daily(i,j,isapbelow,icarbon) + &
+                  &       turnover_daily(i,j,iheartbelow,icarbon) + turnover_daily(i,j,iroot,icarbon)
+
+             turnover_daily(i,j,ileaf,icarbon) = turnover_daily(i,j,ileaf,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,isapabove,icarbon) = turnover_daily(i,j,isapabove,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,isapbelow,icarbon) = turnover_daily(i,j,isapbelow,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,iheartabove,icarbon) = turnover_daily(i,j,iheartabove,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,iheartbelow,icarbon) = turnover_daily(i,j,iheartbelow,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,iroot,icarbon) = turnover_daily(i,j,iroot,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,ifruit,icarbon) = turnover_daily(i,j,ifruit,icarbon)*frac_turnover_daily
+             turnover_daily(i,j,icarbres,icarbon) = turnover_daily(i,j,icarbres,icarbon)*frac_turnover_daily
+             harvest_above(i)  = harvest_above(i) + veget_max(i,j) * above_old *(un - frac_turnover_daily)
+          ENDIF
+       ENDDO
+    ENDDO
+
+!!$    harvest_above = harvest_above
+  END SUBROUTINE harvest
+END MODULE stomate_lpj
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_npp.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_npp.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_npp.f90	(revision 5166)
@@ -0,0 +1,606 @@
+! =================================================================================================================================
+! MODULE          : stomate_npp
+!
+! CONTACT         : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE         : IPSL (2006)
+!                 This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF          This modules calculates NPP: Maintenance and growth respiration
+!!
+!!\n DESCRIPTION: We calculate first the maintenance respiration. This is substracted from the
+!!                allocatable biomass (and from the present biomass if the GPP is too low).\n
+!!                Of the rest, a part is lost as growth respiration, while the other part is
+!!                effectively allocated.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_npp
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC npp_calc,npp_calc_clear
+
+  LOGICAL, SAVE                                              :: firstcall = .TRUE.         !! first call
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: npp_calc_clear
+!!
+!>\BRIEF        : Set the flag ::firstcall to .TRUE. and as such activate section 
+!! 1.1 of the subroutine npp_calc (see below).\n
+!_ ================================================================================================================================
+
+  SUBROUTINE npp_calc_clear
+    firstcall=.TRUE.
+  END SUBROUTINE npp_calc_clear
+
+
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE	: npp_calc
+!!
+!>\BRIEF        Calculate NPP as the difference between GPP and respiration (= growth + maintenance respiration).
+!!              Update biomass of all compartments after calculating respiration and allocation.
+!!
+!!
+!! DESCRIPTION  : NPP is calculated from three components: Gross Primary Productivity (GPP), maintenance respiration 
+!! and growth respiration (all in @tex $ gC.m^{-2}dt^{-1} $ @endtex), following the convention that positive fluxes denote 
+!! fluxes plants to the atmosphere. GPP is the input variable from which, in the end, NPP or total allocatable biomass 
+!! @tex $(gC.m^{-2}dt^{-1}))$ @endtex is calculated. Net primary production is then calculated as:\n	
+!! NPP = GPP - growth_resp - maint-resp   [eq. 1]\n   
+!!	
+!! The calculation of maintenance respiration is done in routine stomate_resp.f90. Maintenance respiration is calculated for 
+!! the whole plant and is therefore removed from the total allocatable biomass. In order to prevent all allocatable biomass 
+!! from being used for maintenance respiration, a limit fraction of total allocatable biomass, tax_max, is defined (in 
+!! variables declaration). If maintenance respiration exceeds tax_max (::bm_tax_max), the maximum allowed allocatable biomass
+!! will be respired and the remaining respiration, required in excess of tax_max, is taken out from tissues already present in
+!! the plant (biomass).\n  
+!! 
+!! After total allocatable biomass has been updated by removing maintenance respiration, total allocatable biomass is distributed 
+!! to all plant compartments according to the f_alloc fractions calculated in stomate_alloc.f90.\n
+!!
+!! Growth respiration is calculated as a fraction of allocatable biomass for each part of the plant. The fraction coefficient 
+!! ::frac_growth_resp is defined in stomate_constants.f90 and is currently set to be the same for all plant compartments. 
+!! Allocatable biomass of all plant compartments are updated by removing what is lost through growth respiration. Net allocatable
+!! biomass (total allocatable biomass after maintenance and growth respiration) is added to the current biomass for  each plant 
+!! compartment.
+!!
+!! Finally, leaf age and plant age are updated. Leaf age is described with the concept of "leaf age classes". A number of leaf 
+!! age classes (nleafages) is defined in stomate_constants.f90. Each leaf age class contains a fraction (::leaf_frac) of the 
+!! total leaf biomass. When new biomass is added to leaves, the age of the biomass in the youngest leaf age class is decreased. 
+!! The fractions of leaves in the other leaf ages classes are also updated as the total biomass has increased. Plant age is 
+!! updated first by increasing the age of the previous biomass by one time step, and then by adjusting this age as the average 
+!! of the ages of the previous and the new biomass.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::npp
+!!
+!! REFERENCE(S)	: 
+!! - F.W.T.Penning De Vries, A.H.M. Brunsting, H.H. Van Laar. 1974. Products, requirements and efficiency of biosynthesis a 
+!! quantitative approach. Journal of Theoretical Biology, Volume 45, Issue 2, June 1974, Pages 339-377.
+!! 
+!! FLOWCHART : 
+!! \latexonly
+!! \includegraphics[scale=0.14]{stomate_npp_flow.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE npp_calc (npts, dt, &
+       PFTpresent, &
+       tlong_ref, t2m, tsoil, lai, rprof, &
+       gpp, f_alloc, bm_alloc, resp_maint_part,&
+       biomass, leaf_age, leaf_frac, age, &
+       resp_maint, resp_growth, npp)
+   
+!! 0 Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), INTENT(in)                                   :: dt               !! Time step (days)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                  :: PFTpresent       !! PFT exists (true/false)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: tlong_ref        !! Long term annual mean 2 meter reference 
+                                                                                  !! Temperature (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                  :: t2m              !! Temperature at 2 meter (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)             :: tsoil            !! Soil temperature of each soil layer (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: lai              !! PFT leaf area index (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: rprof            !! PFT root depth as calculated in stomate.f90
+                                                                                  !! from root profile parameter humcste (m) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: gpp              !! PFT gross primary productivity 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)       :: f_alloc          !! Fraction of total allocatable biomass that 
+                                                                                  !! goes into each plant part (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)       :: resp_maint_part  !! Maintenance respiration of different plant 
+                                                                                  !! parts @tex $(gC.m^{-2}dt^{-1})$ @endtex
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: resp_maint       !! PFT maintenance respiration 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex		    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: resp_growth      !! PFT growth respiration 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex				
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)             :: npp              !! PFT net primary productivity 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex		
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: bm_alloc    !! PFT biomass increase, i.e. NPP per plant part 
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex		
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass   !! PFT total biomass of each plant part 
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_age         !! PFT age of different leaf age classes (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac        !! PFT fraction of total leaves in leaf age 
+                                                                                  !! class (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: age              !! PFT age (years)
+
+    !! 0.4 Local variables
+
+    REAL(r_std), SAVE, DIMENSION(0:nbdl)                      :: z_soil           !! Soil levels  representing soil depth (m)				
+!$OMP THREADPRIVATE(z_soil)
+    REAL(r_std), DIMENSION(npts,nvm)                          :: t_root           !! Root temperature (convolution of root and 
+                                                                                  !! soil temperature profiles)(K)
+    REAL(r_std), DIMENSION(npts,nvm,nparts)                   :: coeff_maint      !! PFT maintenance respiration coefficients of 
+                                                                                  !! different plant compartments at 0 deg C 
+                                                                                  !! @tex $(g.g^{-1}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nparts)                       :: t_maint          !! Temperature which is pertinent for maintenance
+                                                                                  !! respiration, which is air/root temperature for
+                                                                                  !! above/below-ground compartments (K)
+    REAL(r_std), DIMENSION(npts)                              :: rpc              !! Scaling factor for integrating vertical soil 
+                                                                                  !! profiles (unitless)
+    REAL(r_std), DIMENSION(npts)                              :: tl               !! Long term annual mean temperature (C)
+    REAL(r_std), DIMENSION(npts)                              :: slope            !! Slope of maintenance respiration coefficient
+                                                                                  !! (1/K)
+    REAL(r_std), DIMENSION(npts,nparts)                       :: resp_growth_part !! Growth respiration of different plant parts
+                                                                                  !! @tex $(gC.m^{-2}dt^{-1})$ @endtex		
+    REAL(r_std), DIMENSION(npts,nvm)                          :: bm_alloc_tot     !! Allocatable biomass for the whole plant
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                              :: bm_add           !! Biomass increase @tex $(gC.m^{-2})$ @endtex		
+    REAL(r_std), DIMENSION(npts)                              :: bm_new           !! New biomass @tex $(gC.m^{-2})$ @endtex	
+    REAL(r_std), DIMENSION(npts,nvm)                          :: leaf_mass_young  !! Leaf mass in youngest age class 
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex		
+    REAL(r_std), DIMENSION(npts,nvm)                          :: lm_old           !! Leaf mass after maintenance respiration 
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex			
+    REAL(r_std), DIMENSION(npts,nvm)                          :: bm_create        !! Biomass created when biomass<0 because of dark
+                                                                                  !! respiration @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)                              :: bm_tax_max       !! Maximum part of allocatable biomass used for 
+                                                                                  !! respiration @tex $(gC.m^{-2})$ @endtex	
+    REAL(r_std), DIMENSION(npts)                              :: bm_pump          !! Biomass that remains to be taken away 
+                                                                                  !! @tex $(gC.m^{-2})$ @endtex
+    INTEGER(i_std)                                            :: i,j,k,l,m        !! Indeces(unitless)
+
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering npp'
+    
+ !! 1. Initializations
+    
+    !! 1.1 First call
+    IF ( firstcall ) THEN
+
+       !! 1.1.1 Soil levels
+       !  Get the depth of the different soil layers (number of layers=nbdl) 
+       !  previously calculated as variable diaglev in routines sechiba.f90 and slowproc.f90  
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+       !! 1.1.2 Output message
+       !  Write message including value used for tax_max 	
+       WRITE(numout,*) 'npp:'
+
+       WRITE(numout,*) '   > max. fraction of allocatable biomass used for'// &
+            ' maint. resp.:', tax_max
+
+       firstcall = .FALSE.
+
+    ENDIF ! End if first call
+
+    !! 1.2 Set output variables to zero
+    bm_alloc(:,:,:,:) = zero
+    resp_maint(:,:) = zero
+    resp_growth(:,:) = zero
+    npp(:,:) = zero
+
+!![BEGIN DISPENSABLE] between 'begin dispensable' and 'end dispensable', section can be removed. coefficients and temperatures are
+!! calculated here but not used anymore since maintenance respiration temperature is now done in stomate_resp.f90
+    
+    !! 1.3 Root temperature
+    !  Calculate root temperature as the convolution of root and temperature profiles
+    !  assuming an exponential root profile.
+    DO j = 2,nvm	! Loop over # PFTs
+
+       !! 1.3.1 Calculate the integration constant ::rpc 
+       !  rpc is an integration constant such that the integral of the root profile is 'one' (scaling factor)
+       !  z_soil(nbdl) are the depths of the different layers
+       !  rprof is the root depth. For now it is prescribed for each pft in routine stomate.f90 as the inverse of the 
+       !  root profile parameter humcste (defined in constantes_veg.f90)
+       rpc(:) = un / ( un - EXP( -z_soil(nbdl) / rprof(:,j) ) )
+
+       ! 1.3.2 integrate over the # of soil layers (nbdl levels)
+
+       t_root(:,j) = zero
+
+       DO l = 1, nbdl	! Loop over # of soil layers 
+
+          t_root(:,j) = &
+               t_root(:,j) + tsoil(:,l) * rpc(:) * &
+               ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) )
+
+       ENDDO	! End of loop over # of soil layers
+
+    ENDDO	! End of loop over # PFTs
+
+    !! 1.4 Total allocatable biomass
+    ! total allocatable biomass during this time step determined from GPP.
+    ! GPP was calculated as CO2 assimilation in enerbil.f90
+    bm_alloc_tot(:,:) = gpp(:,:) * dt
+
+    
+ !! 2. Calculate maintenance respiration coefficients  	
+
+    DO j = 2,nvm ! Loop over # of PFTs
+
+       
+       !! 2.1 Temperatures used for calculating the maintenance respiration for the different plant parts.
+       !      - for above-ground parts, we use 2-meters air temperature, (::t2m)
+       !      - for below-ground parts, we use root temperature calculated in section 1.3 of this routine 
+       !        as a convolution of root and temperature profiles 
+
+       !! 2.1.1 Aboveground biomass
+       t_maint(:,ileaf) = t2m(:)
+       t_maint(:,isapabove) = t2m(:)
+       t_maint(:,ifruit) = t2m(:)
+
+       !! 2.1.2 Belowground biomass
+       t_maint(:,isapbelow) = t_root(:,j)
+       t_maint(:,iroot) = t_root(:,j)
+
+       !! 2.1.3 Heartwood biomass
+       !        Heartwood does does not respire. Any temperature could have been set [code cleaning: set t(heartwood) to undef to 'undef']
+       t_maint(:,iheartbelow) = t_root(:,j)
+       t_maint(:,iheartabove) = t2m(:)
+
+       !! 2.1.4 Reserve biomass
+       !        Use aboveground temperature for trees and belowground temeperature for grasses
+       IF ( is_tree(j) ) THEN
+          t_maint(:,icarbres) = t2m(:)
+       ELSE
+          t_maint(:,icarbres) = t_root(:,j)
+       ENDIF
+
+       
+       !! 2.2 Calculate slope and coeff_maint
+       !      Maintenance respiration is a fraction of biomass defined by the coefficient 
+       !      coeff_maint. Coeff_maint is defined through a linear relationship with temperature
+       !      which slope is the coefficient 'slope' and which intercept is 'coeff_maint_zero'.
+       !      Coeff_maint_zero is defined in stomate_data.f90. 
+       !      Slope is calculated here through a second-degree polynomial equation that makes it
+       !     dependent on the long term temperature (to represent adaptation of the ecosystem).
+       !      in stomate_resp.f90 both coefficients (slope and coeff_maint_resp) depend on:
+       !      - the long term 2-m temperature (tlong_ref) converted to celsius 
+       !      - the relevant temperatures used for the different plant parts as defined in section 2.1
+       !      - parameters maint_resp_slope and coef_maint_zero defined in stomate_constants.f90 
+       !        (cm_zero_plantpartname)
+       tl(:) = tlong_ref(:) - ZeroCelsius
+       slope(:) = maint_resp_slope(j,1) + tl(:) * maint_resp_slope(j,2) + &
+            tl(:)*tl(:) * maint_resp_slope(j,3)
+
+       DO k = 1, nparts
+
+          coeff_maint(:,j,k) = &
+               MAX( coeff_maint_zero(j,k) * &
+               ( un + slope(:) * (t_maint(:,k)-ZeroCelsius) ), zero )
+
+       ENDDO	! Loop over # of plant parts
+
+    ENDDO	! Loop over # of PFTs
+
+![END DISPENSABLE]  
+ 
+ !! 3. Calculate maintenance and growth respiration
+
+    ! First, total maintenance respiration for the whole plant is calculated by summing maintenance 
+    ! respiration of the different plant compartments. Then, maintenance respiration is subtracted 
+    ! from whole-plant allocatable biomass (up to a maximum fraction of the total allocatable biomass). 
+    ! Growth respiration is then calculated for each plant compartment as a fraction of remaining 
+    ! allocatable biomass for this compartment. NPP is calculated by substracting total autotrophic 
+    ! respiration from GPP i.e. NPP = GPP - maintenance resp - growth resp.
+    DO j = 2,nvm	! Loop over # of PFTs
+
+![BEGIN DISPENSABLE]     
+       !! 3.1 Maintenance respiration of the different plant compartments
+![END DISPENSABLE]       
+
+       !! 3.1 Maintenance respiration of the different plant parts
+       !      Maintenance respiration of the different plant parts is calculated in 
+       !      stomate_resp.f90 as a function of the plant's temperature, 
+       !      the long term temperature and plant coefficients 
+       !      VPP killer:
+       ! [BEGIN DISPENSABLE]      resp_maint(:,j) = SUM( resp_maint_part(:,:), DIM=2 ) [END DISPENSABLE]
+       resp_maint(:,j) = zero
+
+       !  Following the calculation of hourly maintenance respiration, verify that 
+       !  the PFT has not been killed after calcul of resp_maint_part in stomate.
+       DO k= 1, nparts
+          WHERE (PFTpresent(:,j))
+             resp_maint(:,j) = resp_maint(:,j) + resp_maint_part(:,j,k)
+          ENDWHERE
+       ENDDO
+       
+       !! 3.2 Substract maintenance respiration from allocatable biomass
+       !      The total maintenance respiration calculated in 3.2 is substracted  from the newly 
+       !      produced allocatable biomass (bm_alloc_tot). However, ensure that not all allocatable 
+       !      biomass is removed by setting a maximum to the fraction of allocatable biomass used 
+       !      for maintenance respiration: tax_max. If the maintenance respiration is larger than 
+       !      tax_max,the amount tax_max is taken from allocatable biomass, and the remaining of 
+       !      maintenance respiration is taken from the tissues themselves (biomass). We suppose 
+       !      that respiration is not dependent on leaf age -> therefore the leaf age structure is 
+       !      not changed. 
+       !      The maximum fraction of allocatable biomass used for respiration is defined as tax_max. 
+       !      The value of tax_max is set in the declarations section (0.4 Local variables) of this
+       !      routine
+       bm_tax_max(:) = tax_max * bm_alloc_tot(:,j)
+
+       DO i = 1, npts	! Loop over # of pixels
+
+          ! If there is enough allocatable biomass to cover maintenance respiration, 
+	  ! then biomass associated with maintenance respiration is removed from allocatable biomass
+          IF ( ( bm_alloc_tot(i,j) .GT. zero ) .AND. &
+               ( ( resp_maint(i,j) * dt ) .LT. bm_tax_max(i) ) ) THEN	
+	
+             bm_alloc_tot(i,j) = bm_alloc_tot(i,j) - resp_maint(i,j) * dt
+
+             ! [BEGIN DISPENSABLE] Same as current line except that zero became min_stomate 
+             ! Shilong        ELSEIF ( resp_maint(i,j) .GT. zero ) THEN [END DISPENSABLE] 
+
+          ! If there is not enough allocatable biomass to cover maintenance respiration, the  
+          ! - maximum allowed allocatable biomass (bm_tax_max) is removed from allocatable biomass.
+          ELSEIF ( resp_maint(i,j) .GT. min_stomate ) THEN
+	     
+             bm_alloc_tot(i,j) = bm_alloc_tot(i,j) - bm_tax_max(i)
+
+             ! ::bm_pump is the amount of maintenance respiration that exceeds the maximum allocatable biomass
+	     ! This amount of biomass still needs to be respired and will be removed from tissues biomass of each
+	     ! plant compartment
+             bm_pump(i) = resp_maint(i,j) * dt - bm_tax_max(i)
+
+             ! The biomass is removed from each plant compartment tissues as the ratio of the maintenance		
+             ! respiration of the plant compartment to the total maintenance respiration (resp_maint_part/resp_maint)
+             biomass(i,j,ileaf,icarbon) = biomass(i,j,ileaf,icarbon) - &
+                  bm_pump(i) * resp_maint_part(i,j,ileaf) / resp_maint(i,j)
+             biomass(i,j,isapabove,icarbon) = biomass(i,j,isapabove,icarbon) - &
+                  bm_pump(i) * resp_maint_part(i,j,isapabove) / resp_maint(i,j)
+             biomass(i,j,isapbelow,icarbon) = biomass(i,j,isapbelow,icarbon) - &
+                  bm_pump(i) * resp_maint_part(i,j,isapbelow) / resp_maint(i,j)
+             biomass(i,j,iroot,icarbon) = biomass(i,j,iroot,icarbon) - &
+                  bm_pump(i) * resp_maint_part(i,j,iroot) / resp_maint(i,j)
+             biomass(i,j,ifruit,icarbon) = biomass(i,j,ifruit,icarbon) - &
+                  bm_pump(i) * resp_maint_part(i,j,ifruit) / resp_maint(i,j)
+             biomass(i,j,icarbres,icarbon) = biomass(i,j,icarbres,icarbon) - &
+                  bm_pump(i) * resp_maint_part(i,j,icarbres) / resp_maint(i,j)
+
+          ENDIF	! End if there is enough allocatable biomass to cover maintenance respiration
+
+       ENDDO   ! Fortran95: WHERE - ELSEWHERE construct
+
+       
+       !! 3.3 Allocate allocatable biomass to different plant compartments.
+       !      The amount of allocatable biomass of each compartment is a fraction according f_alloc of total 
+       !      allocatable biomass (the f_alloc of the different plant parts are calculated in stomate_alloc.f90)
+       DO k = 1, nparts
+          bm_alloc(:,j,k,icarbon) = f_alloc(:,j,k) * bm_alloc_tot(:,j)
+       ENDDO
+
+       
+       !! 3.4 Calculate growth respiration of each plant compartment.
+       !      Growth respiration of a plant compartment is a fraction of the allocatable biomass remaining after
+       !      maintenance respiration losses have been taken into account. The fraction of allocatable biomass 
+       !      removed for growth respiration is the same for all plant compartments and is defined by the parameter
+       !      frac_growth_resp in stomate_constants.f90. Allocatable biomass ::bm_alloc is updated as a result of 
+       !      the removal of growth resp.
+       resp_growth_part(:,:) = frac_growthresp * bm_alloc(:,j,:,icarbon) / dt
+       bm_alloc(:,j,:,icarbon) = ( un - frac_growthresp ) * bm_alloc(:,j,:,icarbon)
+
+       
+       !! 3.5 Total growth respiration 
+       !      Calculate total growth respiration of the plant as the sum of growth respiration of all plant parts	
+       resp_growth(:,j) = zero
+
+       DO k = 1, nparts
+          resp_growth(:,j) = resp_growth(:,j) + resp_growth_part(:,k)
+       ENDDO
+
+    ENDDO ! # End Loop over # of PFTs
+
+    
+ !! 4. Update the biomass with newly allocated biomass after respiration
+ 
+    !  Save the old leaf biomass for later. "old" leaf mass is leaf mass after maintenance respiration in the case 
+    !  where maintenance respiration has required taking biomass from tissues in section 3.3 
+    lm_old(:,:) = biomass(:,:,ileaf,icarbon)
+    biomass(:,:,:,:) = biomass(:,:,:,:) + bm_alloc(:,:,:,:)
+
+    
+ !! 5. Deal with negative biomasses
+    
+    !  Biomass can become negative in some rare cases, as the GPP can be negative. This corresponds to very 
+    !  situations that can be seen as the 'creation' of a seed ('virtual photosynthesis'). In this case, we set
+    !  biomass to some small value min_stomate. For carbon budget to remain balanced, this creation of matter (carbon) 
+    !  is taken into account by decreasing the autotrophic respiration by the same amount that has been added to biomass 
+    !  for it to become positive. In this case, maintenance respiration can become negative in extreme cases (desertsÉ)!!
+
+    DO k = 1, nparts	! Loop over # of plant parts
+
+       DO j = 2,nvm	! Loop over # of PFTs
+
+          WHERE ( biomass(:,j,k,icarbon) .LT. zero )
+
+             bm_create(:,j) = min_stomate - biomass(:,j,k,icarbon)
+             
+             biomass(:,j,k,icarbon) = biomass(:,j,k,icarbon) + bm_create(:,j)
+             
+             resp_maint(:,j) = resp_maint(:,j) - bm_create(:,j) / dt
+
+          ENDWHERE
+
+       ENDDO	! Loop over # of PFTs
+
+    ENDDO	! Loop over # plant parts
+
+    
+ !! 6. Calculate NPP (See Eq 1 in header)
+    
+    !  Calculate the NPP @tex $(gC.m^{-2}dt^{-1})$ @endtex as the difference between GPP
+    !  and autotrophic respiration (maintenance and growth respirations)
+    DO j = 2,nvm	! Loop over # PFTs
+       npp(:,j) = gpp(:,j) - resp_growth(:,j) - resp_maint(:,j)
+    ENDDO	! Loop over # PFTs
+
+    
+ !! 7. Update leaf age
+
+    !  Leaf age is needed for calculation of turnover and vmax in stomate_turnover.f90 and stomate_vmax.f90 routines. 
+    !  Leaf biomass is distributed according to its age into several "age classes" with age class=1 representing the
+    !  youngest class, and consisting of the most newly allocated leaf biomass 
+    
+    !! 7.1 Update quantity and age of the leaf biomass in the youngest class
+    !      The new amount of leaf biomass in the youngest age class (leaf_mass_young) is the sum of :
+    !      - the leaf biomass that was already in the youngest age class (leaf_frac(:,j,1) * lm_old(:,j)) with the 
+    !        leaf age given in leaf_age(:,j,1) 
+    !      - and the new biomass allocated to leaves (bm_alloc(:,j,ileaf)) with a leaf age of zero.
+    DO j = 2,nvm
+       leaf_mass_young(:,j) = leaf_frac(:,j,1) * lm_old(:,j) + bm_alloc(:,j,ileaf,icarbon)
+    ENDDO
+
+    ! The age of the updated youngest age class is the average of the ages of its 2 components: bm_alloc(leaf) of age
+    ! '0', and leaf_frac*lm_old(=leaf_mass_young-bm_alloc) of age 'leaf_age(:,j,1)' 
+    DO j = 2,nvm
+       WHERE ( ( bm_alloc(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+         ( leaf_mass_young(:,j) .GT. zero ) )
+
+          leaf_age(:,j,1) = MAX ( zero, &
+               & leaf_age(:,j,1) * &
+               & ( leaf_mass_young(:,j) - bm_alloc(:,j,ileaf,icarbon) ) / &
+               & leaf_mass_young(:,j) )
+          
+       ENDWHERE
+    ENDDO
+
+    !! 7.2 Update leaf age
+    !      Update fractions of leaf biomass in each age class (fraction in youngest class increases)
+
+    !! 7.2.1 Update age of youngest leaves
+    !        For age class 1 (youngest class), because we have added biomass to the youngest class, we need to update
+    !        the fraction of total leaf biomass that belongs to the youngest age class : updated mass in class divided
+    !        by new total leaf mass
+    DO j = 2,nvm
+       WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+          leaf_frac(:,j,1) = leaf_mass_young(:,j) / biomass(:,j,ileaf,icarbon)
+
+       ENDWHERE
+    ENDDO
+
+    !! 7.2.2 Update age of other age classes
+    !        Because the total leaf biomass has changed, we need to update the fraction of leaves in each age class:
+    !        mass in leaf age class (from previous fraction of leaves in this class and previous total leaf biomass) 
+    !        divided by new total mass
+    DO m = 2, nleafages	! Loop over # leaf age classes
+
+       DO j = 2,nvm	! Loop over # PFTs
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. min_stomate )
+
+             leaf_frac(:,j,m) = leaf_frac(:,j,m) * lm_old(:,j) / biomass(:,j,ileaf,icarbon)
+
+          ENDWHERE
+       ENDDO
+
+    ENDDO	! Loop over # leaf age classes
+
+ !! 8. Update whole-plant age 
+    
+    !! 8.1 PFT age
+    !      At every time step, increase age of the biomass that was already present at previous time step. 
+    !      Age is expressed in years, and the time step 'dt' in days so age increase is: dt divided by number 
+    !      of days in a year.
+    WHERE ( PFTpresent(:,:) )
+
+       age(:,:) = age(:,:) + dt/one_year
+
+    ELSEWHERE
+
+       age(:,:) = zero
+
+    ENDWHERE
+
+    !! 8.2 Age of grasses and crops
+    !  For grasses and crops, biomass with age 0 has been added to the whole plant with age 'age'. New biomass is the sum of 
+    !  the current total biomass in all plant parts (bm_new), bm_new(:) = SUM( biomass(:,j,:), DIM=2 ). The biomass that has 
+    !  just been added is the sum of the allocatable biomass of all plant parts (bm_add), its age is zero. bm_add(:) = 
+    !  SUM( bm_alloc(:,j,:), DIM=2 ). Before allocation, the plant biomass is bm_new-bm_add, its age is "age(:,j)". The age of
+    !  the new biomass is the average of the ages of previous and added biomass.
+    !  For trees, age is treated in "establish" if vegetation is dynamic, and in turnover routines if it is static (in this 
+    !  case, only the age of the heartwood is accounted for).
+    DO j = 2,nvm
+
+       IF ( .NOT. is_tree(j) ) THEN
+
+          bm_new(:) = biomass(:,j,ileaf,icarbon) + biomass(:,j,isapabove,icarbon) + &
+               biomass(:,j,iroot,icarbon) + biomass(:,j,ifruit,icarbon)
+          bm_add(:) = bm_alloc(:,j,ileaf,icarbon) + bm_alloc(:,j,isapabove,icarbon) + &
+               bm_alloc(:,j,iroot,icarbon) + bm_alloc(:,j,ifruit,icarbon)
+
+          WHERE ( ( bm_new(:) .GT. zero ) .AND. ( bm_add(:) .GT. zero ) )
+             age(:,j) = age(:,j) * ( bm_new(:) - bm_add(:) ) / bm_new(:)
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+ !! 9. Write history files
+
+    ! Save in history file the variables describing the biomass allocated to the plant parts
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_LEAF', itime, &
+         bm_alloc(:,:,ileaf,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_SAP_AB', itime, &
+         bm_alloc(:,:,isapabove,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_SAP_BE', itime, &
+         bm_alloc(:,:,isapbelow,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_ROOT', itime, &
+         bm_alloc(:,:,iroot,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_FRUIT', itime, &
+         bm_alloc(:,:,ifruit,icarbon), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'BM_ALLOC_RES', itime, &
+         bm_alloc(:,:,icarbres,icarbon), npts*nvm, horipft_index)
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving npp'
+
+  END SUBROUTINE npp_calc
+
+END MODULE stomate_npp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_phenology.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_phenology.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_phenology.f90	(revision 5166)
@@ -0,0 +1,1670 @@
+! =================================================================================================================================
+! MODULE        : stomate_phenology
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module manages the beginning of the growing season (leaf onset).
+!!      
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN          :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ =================================================================================================================================
+
+MODULE stomate_phenology
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC phenology,phenology_clear
+
+  ! first call
+  LOGICAL, SAVE                                              :: firstcall = .TRUE.
+!$OMP THREADPRIVATE(firstcall)
+  LOGICAL, SAVE                                              :: firstcall_hum = .TRUE.
+!$OMP THREADPRIVATE(firstcall_hum)
+  LOGICAL, SAVE                                              :: firstcall_moi = .TRUE.
+!$OMP THREADPRIVATE(firstcall_moi)
+  LOGICAL, SAVE                                              :: firstcall_humgdd = .TRUE.
+!$OMP THREADPRIVATE(firstcall_humgdd)
+  LOGICAL, SAVE                                              :: firstcall_moigdd = .TRUE.
+!$OMP THREADPRIVATE(firstcall_moigdd)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : phenology_clear
+!!
+!>\BRIEF          Flags setting   
+!!
+!! DESCRIPTION  : This subroutine sets flags 
+!!                ::firstcall, ::firstcall_hum, ::firstcall_moi, ::firstcall_humgdd, 
+!!                ::firstcall_moigdd to .TRUE., and therefore activates section 1.1 of each 
+!!                subroutine which writes messages to the output. \n
+!!                This subroutine is called at the beginning of ::stomateLpj_clear in the 
+!!                ::stomate_lpj module.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::firstcall, ::firstcall_hum, ::firstcall_moi, ::firstcall_humgdd, 
+!!                ::firstcall_moigdd
+!!
+!! REFERENCE(S)  : None
+!!
+!! FLOWCHART     : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE phenology_clear
+    firstcall=.TRUE.
+    firstcall_hum=.TRUE.
+    firstcall_moi = .TRUE.
+    firstcall_humgdd = .TRUE.
+    firstcall_moigdd = .TRUE.
+  END SUBROUTINE phenology_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : phenology
+!!
+!>\BRIEF          This subroutine controls the detection of the beginning of the growing season 
+!!                (if dormancy has been long enough), leaf onset, given favourable biometeorological 
+!!                conditions, and leaf growth and biomass allocation when leaf biomass is low (i.e. 
+!!                at the start of the growing season.
+!!
+!! DESCRIPTION  : This subroutine is called by the module ::stomate_lpj and deals with the beginning of the  
+!!                growing season. First it is established whether the beginning of the growing season is
+!!                allowed. This occurs if the dormance period has been long enough (i.e. greater 
+!!                than a minimum PFT-dependent threshold, specified by ::lowgpp_time), 
+!!                AND if the last beginning of the growing season was a sufficiently long time ago 
+!!                (i.e. when the growing season length is greater than a minimum threshold, specified
+!!                by ::min_growthinit_time, which is defined in this module to be 300 days. \n
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                ::lowgpp_time is set for each PFT in ::stomate_data from a table of all
+!!                PFT values (::lowgpp_time_tab), which is defined in ::stomate_constants. \n
+!!                The growing season length is given by ::when_growthinit, which increases
+!!                by the stomate time-step at each call to this phenology module, except for when
+!!                leaf onset is detected, when it is set to 0. \n
+!!                If these two conditions are met, leaf onset occurs if the biometeorological 
+!!                conditions are also met. This is determined by the leaf onset models, which are
+!!                biome-specific. Each PFT is looped over (ignoring bare soil).
+!!                The onset phenology model is selected, (according to the parameter 
+!!                ::pheno_model, which is initialised in stomate_data), and called. \n
+!!                There are six leaf onset phenology models currently being used by ORCHIDEE. 
+!!                These are: 'hum' and 'moi', which are based exclusively on moisture conditions,
+!!                'humgdd' and 'moigdd', which are based on both temperature and moisture conditions,
+!!                'ncdgdd', which is based on a "chilling" requirement for leaf onset, and 
+!!                'ngd', which is based on the number of growing days since the temperature was 
+!!                above a certain threshold, to account for the end of soil frost.
+!!                Those models which are based mostly on temperature conditions are used for
+!!                temperate and boreal biomes, and those which include a moisture condition are used
+!!                for tropical biomes. More detail on the biometeorological conditions is provided
+!!                in the sections on the individual onset models. \n
+!!                The moisture conditions are based on the concept of plant "moisture availability".
+!!                This is based on the soil humidity (relative soil moisture), but is moderated by
+!!                the root density profile, as per the equation:
+!!                \latexonly
+!!                \input{phenology_moiavail_eqn1.tex}
+!!                \endlatexonly
+!!                \n
+!!                Although some studies have shown that the length of the photoperiod is important
+!!                in determining onset (and senescence) dates, this is not considered in the current
+!!                versions of the onset models (Krinner et al., 2005). \n
+!!                If conditions are favourable, leaf onset occurs (::begin_leaves is set to TRUE), 
+!!                ::when_growthinit is set to 0.0, and the growing season has begun. \n
+!!                Following the detection of leaf onset, biomass is allocated from the carbohydrate 
+!!                reserves equally to the leaves and roots IF the leaf biomass is lower than a minimum
+!!                threshold, which is calculated in this subroutine from the parameter
+!!                ::lai_initmin, divided by the specific leaf area (both of which are
+!!                PFT-dependent and set in ::stomate_constants). \n
+!!                Finally, if biomass is required to be allocated from the carbohydrate reserve 
+!!                because the leaf biomass is too low, the leaf age and leaf age distribution is 
+!!                re-set. In this case the youngest age class fraction is set to 1 and all other   
+!!                leaf age class fractions are set to 0. All leaf ages are set to 0. If there is 
+!!                no biomass in the carbohydrate reserve, leaf onset will not occur and the PFT
+!!                will disappear from the grid cell (Krinner et al., 2005). \n
+!!                This subrouting is called in ::stomate_lpj.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::biomass, 
+!!                        ::when_growthinit,
+!!                        ::leaf age distribution
+!!                        ::leaf fraction
+!!
+!! REFERENCE(S) :
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{phenology_flowchart.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE phenology (npts, dt, PFTpresent, &
+       veget_max, &
+       tlong_ref, t2m_month, t2m_week, gpp, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       moiavail_month, moiavail_week, &
+       gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       senescence, time_hum_min, &
+       biomass, leaf_frac, leaf_age, &
+       when_growthinit, co2_to_bm)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                                          :: npts                 !! Domain size - number of grid 
+                                                                                                !! cells (unitless) 
+    REAL(r_std), INTENT(in)                                             :: dt                   !! time step (dt_days)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                            :: PFTpresent           !! PFT exists (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: veget_max            !! "maximal" coverage fraction of a 
+                                                                                                !! PFT (LAI -> infinity) on ground 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: tlong_ref            !! "long term" 2 meter reference 
+                                                                                                !! temperatures (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: t2m_month            !! "monthly" 2-meter temperatures 
+                                                                                                !! (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                            :: t2m_week             !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: gpp                  !! daily gross primary productivity 
+                                                                                                !! @tex ($gC m^{-2} of 
+                                                                                                !! ground/day$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: maxmoiavail_lastyear !! last year's maximum moisture 
+                                                                                                !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: minmoiavail_lastyear !! last year's minimum moisture 
+                                                                                                !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: moiavail_month       !! "monthly" moisture availability 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: moiavail_week        !! "weekly" moisture availability 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: gdd_m5_dormance      !! growing degree days above a 
+                                                                                                !! threshold of -5 deg C (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                     :: gdd_midwinter        !! growing degree days, since 
+                                                                                                !! midwinter (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: ncd_dormance         !! number of chilling days since 
+                                                                                                !! leaves were lost (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: ngd_minus5           !! number of growing days above a 
+                                                                                                !! threshold of -5 deg C (days) 
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                            :: senescence           !! is the plant senescent? (only 
+                                                                                                !! for deciduous trees - 
+                                                                                                !! carbohydrate reserve) 
+                                                                                                !! (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: time_hum_min         !! time elapsed since strongest 
+                                                                                                !! moisture availability (days) 
+
+    !
+    !! 0.2 Ouput variables 
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout)    :: biomass              !! biomass @tex ($gC m^{-2} of 
+                                                                                                !! ground$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)           :: leaf_frac            !! fraction of leaves in leaf age 
+                                                                                                !! class (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)           :: leaf_age             !! leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                     :: when_growthinit      !! how many days since the 
+                                                                                                !! beginning of the growing season 
+                                                                                                !! (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                     :: co2_to_bm            !! co2 taken up by carbohydrate 
+                                                                                                !! reserve at the beginning of the 
+                                                                                                !! growing season @tex ($gC m^{-2} 
+                                                                                                !! of total ground/day$) @endtex 
+                                                                                                ! NV passge 2D
+    !
+    !! 0.4 Local variables
+    !
+    LOGICAL, DIMENSION(npts,nvm)                                        :: allow_initpheno      !! are we allowed to decalre the 
+                                                                                                !! beginning of the growing 
+                                                                                                !! season? (true/false) 
+    REAL(r_std), DIMENSION(npts)                                        :: bm_wanted            !! biomass we would like to have 
+                                                                                                !! @tex ($gC m^{-2} of ground$) 
+                                                                                                !! @endtex 
+    REAL(r_std), DIMENSION(npts)                                        :: bm_use               !! biomass we use (from 
+                                                                                                !! carbohydrate reserve or from 
+                                                                                                !! atmosphere) @tex ($gC m^{-2} of 
+                                                                                                !! ground$) @endtex
+    REAL(r_std), DIMENSION(npts)                                        :: lm_min               !! minimum leaf mass @tex ($gC 
+                                                                                                !! m^{-2} of ground$) @endtex 
+    LOGICAL(r_std), DIMENSION(npts)                                     :: age_reset            !! does the leaf age distribution 
+                                                                                                !! have to be reset? (true/false) 
+    INTEGER(i_std)                                                      :: i,j,m                !! indices (unitless)
+    LOGICAL, DIMENSION(npts,nvm)                                        :: begin_leaves         !! signal to start putting leaves 
+                                                                                                !! on (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm)                                    :: histvar              !! controls the history output 
+                                                                                                !! level - 0: nothing is written; 
+                                                                                                !! 10: everything is written 
+                                                                                                !! (0-10, unitless) 
+
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering phenology'
+
+    !
+    !! 1. first call - output message giving the setting of the ::always_init
+    !!    and ::min_growthinit_time parameters.
+    !
+
+    IF ( firstcall ) THEN
+
+       WRITE(numout,*) 'phenology:'
+
+       WRITE(numout,*) '   > take carbon from atmosphere if carbohydrate' // &
+            ' reserve too small (::always_init): ', always_init
+
+       WRITE(numout,*) '   > minimum time since last beginning of a growing' // &
+            ' season (d) (::min_growthinit_time): ', min_growthinit_time
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+    !
+    !! 2. Detection of the beginning of the growing season.
+    !
+
+    !
+    !! 2.1 allow detection of the beginning of the growing season if dormance was
+    !!     long enough (i.e. when ::time_lowgpp, which is calculated in ::stomate_season, 
+    !!     is above a certain PFT-dependent threshold, ::lowgpp_time, 
+    !!     which is given in ::stomate_constants),
+    !!     AND the last beginning of growing season was a sufficiently long time ago 
+    !!     (i.e. when ::when_growthinit, which is calculated in this module, 
+    !!     is greater than ::min_growthinit_time, which is declared at the beginning of this module).
+    !!     If these conditions are met, allow_initpheno is set to TRUE. Each PFT is looped over.
+    !
+
+    allow_initpheno(:,1) = .FALSE.
+    DO j = 2,nvm
+
+       WHERE ( when_growthinit(:,j) .GT. min_growthinit_time )
+          allow_initpheno(:,j) = .TRUE.
+       ELSEWHERE
+          allow_initpheno(:,j) = .FALSE.
+       ENDWHERE
+
+    ENDDO
+
+    WHERE(allow_initpheno)
+       histvar=un
+    ELSEWHERE
+       histvar=zero
+    ENDWHERE
+    CALL histwrite_p (hist_id_stomate, 'ALLOW_INITPHENO', itime, histvar, npts*nvm, horipft_index)
+
+    !
+    !! 2.2 increase the ::when_growthinit counter, which gives the number of days since the beginning of the growing season.
+    !!     Needed for allocation and for the detection of the beginning of the growing season.
+    !
+
+    when_growthinit(:,:) = when_growthinit(:,:) + dt
+
+    !
+    !! 3. Leaf onset.
+    !!    Check biometeorological conditions using the onset phenological models, 
+    !!    which are different for each PFT group (i.e. grass versus tropical etc. 
+    !!    See below for more detail on the different models and which PFTs use each model).
+    !
+
+    !! - By default: phenology does not start (::begin_leaves set to FALSE).
+    begin_leaves(:,:) = .FALSE.
+
+    !! - The onset phenology model is selected, (according to the parameter ::pheno_model, 
+    !! which is initialised in stomate_data), and called.
+    !! Each PFT is looped over (ignoring bare soil). 
+    !! If conditions are favourable, begin_leaves is set to TRUE.
+    
+    ! parameter used in all the differents models of phenology 
+    t_always = ZeroCelsius + t_always_add
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       SELECT CASE ( pheno_model(j) )
+
+       CASE ( 'hum' )
+
+          CALL pheno_hum (npts, j, PFTpresent, allow_initpheno, &
+               moiavail_month, moiavail_week, &
+               maxmoiavail_lastyear, minmoiavail_lastyear, &
+               begin_leaves)
+
+       CASE ( 'moi' )
+
+          CALL pheno_moi (npts, j, PFTpresent, allow_initpheno, &
+               time_hum_min, &
+               moiavail_month, moiavail_week, &
+               begin_leaves)
+
+
+       CASE ( 'ncdgdd' )
+
+          CALL pheno_ncdgdd (npts, j, PFTpresent, allow_initpheno, &
+               ncd_dormance, gdd_midwinter, &
+               t2m_month, t2m_week, begin_leaves)
+
+       CASE ( 'ngd' )
+
+          CALL pheno_ngd (npts, j, PFTpresent, allow_initpheno, ngd_minus5, &
+               t2m_month, t2m_week, begin_leaves)
+
+       CASE ( 'humgdd' )
+
+          CALL pheno_humgdd (npts, j, PFTpresent, allow_initpheno, gdd_m5_dormance, &
+               maxmoiavail_lastyear, minmoiavail_lastyear, &
+               tlong_ref, t2m_month, t2m_week, &
+               moiavail_week, moiavail_month, &
+               begin_leaves)
+
+       CASE ( 'moigdd' )
+
+          CALL pheno_moigdd (npts, j, PFTpresent, allow_initpheno, gdd_m5_dormance, &
+               time_hum_min, &
+               tlong_ref, t2m_month, t2m_week, &
+               moiavail_week, moiavail_month, &
+               begin_leaves)
+
+       CASE ( 'none' )
+
+          ! no action
+
+       CASE default
+
+          WRITE(numout,*) 'phenology: don''t know how to treat this PFT.'
+          WRITE(numout,*) '  number: (::j)',j
+          WRITE(numout,*) '  phenology model (::pheno_model(j)) : ',pheno_model(j)
+          STOP
+
+       END SELECT
+
+    ENDDO
+
+    WHERE(begin_leaves)
+       histvar=un
+    ELSEWHERE
+       histvar=zero
+    ENDWHERE
+    CALL histwrite_p (hist_id_stomate, 'BEGIN_LEAVES', itime, histvar, npts*nvm, horipft_index)
+
+    !
+    !! 4. Leaf growth and biomass allocation when leaf biomass is low.
+    !!   Leaves start to grow if biometeorological conditions are favourable (::begin_leaves == TRUE) and if
+    !!   leaf growth is allowed (::allow_initpheno == TRUE).
+    !!   PFTs and then grid cells are looped over.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       age_reset(:) = .FALSE.
+
+       DO i = 1, npts
+
+          IF ( begin_leaves(i,j) ) THEN
+
+             !! 4.1 First minimum biomass is calculated using the following equation:
+             !!     \latexonly
+             !!     \input{phenology_lm_min_eqn2.tex}
+             !!     \endlatexonly
+             !!     \n
+
+             lm_min(i) = lai_initmin(j) / sla(j)
+
+             !! 4.2 If leaf biomass is lower than the minimum biomass then biomass must be allocated from the carbohydrate 
+             !!     reserves to leaves and roots.
+
+             IF ( biomass(i,j,ileaf,icarbon) .LT. lm_min(i) ) THEN
+
+                !
+                !! 4.2.1 Determine how much biomass is available to use
+                !!       First calculate how much biomass is wanted/required 
+                !!       (::bm_wanted = 2 x the minimum leaf biomass).
+                !
+
+                bm_wanted(i) = 2. * lm_min(i)
+
+                !! 4.2.2 If the biomass in the carbohydrate reserves is less than the required biomass
+                !!       take the required amount of carbon from the atmosphere and put it into the
+                !!       carbohydrate reserve. This only occurs if the parameter ::always_init 
+                !!       (set at beginning of this ::subroutine) is TRUE. Default is FALSE. 
+
+                IF ( always_init .AND. ( biomass(i,j,icarbres,icarbon) .LT. bm_wanted(i) ) ) THEN
+                   !NV passage 2D
+                   co2_to_bm(i,j) = co2_to_bm(i,j) + ( bm_wanted(i) - biomass(i,j,icarbres,icarbon) ) / dt
+
+                   biomass(i,j,icarbres,icarbon) = bm_wanted(i)
+
+                ENDIF
+                
+                !! 4.2.3 The biomass available to use is set to be the minimum of the biomass of the carbohydrate reservoir (if 
+                !! carbon not taken from the atmosphere), and the wanted biomass.
+                bm_use(i) = MIN( biomass(i,j,icarbres,icarbon), bm_wanted(i) )
+
+                !
+                !! 4.2.4 divide the biomass which is available to use equally between the leaves and roots.
+                !
+
+                biomass(i,j,ileaf,icarbon) = biomass(i,j,ileaf,icarbon) + bm_use(i) / 2.
+
+                biomass(i,j,iroot,icarbon) = biomass(i,j,iroot,icarbon) + bm_use(i) / 2.
+
+                !
+                !! 4.2.5 decrease carbohydrate reservoir biomass by the amount that's been allocated to the leaves and roots
+                !
+
+                biomass(i,j,icarbres,icarbon) = biomass(i,j,icarbres,icarbon) - bm_use(i)
+
+                !
+                !! 4.2.6 set reset leaf age distribution (::age_reset) flag. Default is TRUE.
+                !     (done later for better vectorization)
+                !
+
+                age_reset(i) = .TRUE.
+
+             ENDIF  ! leaf mass is very low
+
+             !
+             !! 4.3 reset when_growthinit counter: start of the growing season
+             !
+
+             when_growthinit(i,j) = zero
+
+          ENDIF    ! start of the growing season
+
+       ENDDO      ! loop over grid points
+
+       !
+       !! 4.4 reset leaf age distribution where necessary (i.e. when age_reset is TRUE)
+       !!     simply say that everything is in the youngest age class
+       !
+
+       !! 4.4.1 fractions - set the youngest age class fraction to 1 and all other leaf age class fractions to 0.
+
+       WHERE ( age_reset(:) )
+          leaf_frac(:,j,1) = un
+       ENDWHERE
+       DO m = 2, nleafages
+          WHERE ( age_reset(:) )
+             leaf_frac(:,j,m) = zero
+          ENDWHERE
+       ENDDO
+
+       !! 4.4.2 ages - set all leaf ages to 0.
+
+       DO m = 1, nleafages
+          WHERE ( age_reset(:) )
+             leaf_age(:,j,m) = zero
+          ENDWHERE
+       ENDDO
+
+    ENDDO        ! loop over # PFTs
+
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving phenology'
+
+  END SUBROUTINE phenology
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_hum 
+!!
+!>\BRIEF          The 'hum' onset model initiate leaf onset based exclusively on moisture 
+!!                availability criteria. 
+!!                Currently no PFTs are assigned to this onset model.
+!!
+!! DESCRIPTION  : This model is for tropical biomes, where temperatures are high but moisture
+!!                might be a limiting factor on growth. It is based on leaf onset model 4a in 
+!!                Botta et al. (2000), which adopts the approach of Le Roux (1995). \n
+!!                Leaf onset occurs if the monthly moisture availability is still quite
+!!                low (i.e. lower than the weekly availability), but the weekly availability is 
+!!                higher than the critical threshold ::availability_crit (as it reacts faster), 
+!!                which indicates the weekly moisture availability is increasing.
+!!                OR if the monthly moisture availability is high enough (i.e. above the 
+!!                threshold value ::moiavail_always), leaf onset is initiated if this has not 
+!!                already happened. This allows vegetation in arid areas to respond to rapidly
+!!                changing soil moisture conditions (Krinner et al., 2005). \n
+!!                The critical weekly moisture availability threshold (::availability_crit), is
+!!                calculated in this subroutine, and is a function of last year's maximum and
+!!                minimum moisture availability and the PFT-dependent parameter
+!!                ::hum_frac, which specifies how much of last year's available 
+!!                moisture is required for leaf onset, as per the equation:
+!!                \latexonly
+!!                \input{phenology_moi_availcrit_eqn3.tex}
+!!                \endlatexonly
+!!                \n
+!!                ::hum_frac is set for each PFT in ::stomate_data from a table
+!!                which contains all the PFT values (::hum_frac_tab) in ::stomate_constants. \n
+!!                Last year's maximum and minimum moisture availability and the monthly and 
+!!                weekly moisture availability are  
+!!                The ::pheno_hum subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start.
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Le Roux, X. (1995), Etude et modelisation des echanges d'eau et d'energie
+!! sol-vegetation-atmosphere dans une savane humide, PhD Thesis, University
+!! Pierre et Marie Curie, Paris, France.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_hum.png}
+!! \endlatexonly
+!! \n             
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_hum (npts, j, PFTpresent, allow_initpheno, &
+       moiavail_month, moiavail_week, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declarations
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                                             :: npts                  !! Domain size - number of 
+                                                                                                    !! grid cells (unitless) 
+    INTEGER(i_std), INTENT(in)                                             :: j                     !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                               :: PFTpresent            !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                               :: allow_initpheno       !! are we allowed to 
+                                                                                                    !! declare the beginning of 
+                                                                                                    !! the growing season? 
+                                                                                                    !! (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                           :: moiavail_month        !! "monthly" moisture 
+                                                                                                    !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                           :: moiavail_week         !! "weekly" moisture 
+                                                                                                    !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                           :: maxmoiavail_lastyear  !! last year's maximum 
+                                                                                                    !! moisture availability 
+                                                                                                    !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                           :: minmoiavail_lastyear  !! last year's minimum 
+                                                                                                    !! moisture availability 
+                                                                                                    !! (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)                            :: begin_leaves          !! signal to start putting 
+                                                                                                    !! leaves on (true/false) 
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                                            :: moiavail_always       !! critical monthly 
+                                                                                                    !! moisture availability - set 
+                                                                                                    !! for tree or grass 
+                                                                                                    !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                                           :: availability_crit     !! critical weekly moisture 
+                                                                                                    !! availability (0-1, unitless)
+    INTEGER(i_std)                                                         :: i                     !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering hum'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of onset model and the moisture availability 
+    !!     parameters for tree and grass
+    !
+
+    IF ( firstcall_hum ) THEN
+
+       WRITE(numout,*) 'pheno_hum:'
+       WRITE(numout,*) '   > moisture availability above which moisture tendency doesn''t matter: '
+       WRITE(numout,*) '         trees (::moiavail_always_tree): ', moiavail_always_tree
+       WRITE(numout,*) '         grasses (::moiavail_always_grass):', moiavail_always_grass
+
+       firstcall_hum = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.3 check the critical value ::hum_frac is defined. If not, stop.
+    !
+
+    IF ( hum_frac(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'hum: hum_frac is undefined for PFT (::j)',j
+       WRITE(numout,*) 'We stop.'
+       STOP
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical monthly moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(j) ) THEN
+       moiavail_always = moiavail_always_tree
+    ELSE
+       moiavail_always = moiavail_always_grass
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !! The PFT has to be there and start of growing season must be allowed
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) ) THEN
+
+          !! 2.1 Calculate the critical weekly moisture availability: depends linearly on the last year 
+          !! minimum and maximum moisture availabilities, and on the parameter ::hum_frac.
+
+          availability_crit(i) = minmoiavail_lastyear(i,j) + hum_frac(j) * &
+               ( maxmoiavail_lastyear(i,j) - minmoiavail_lastyear(i,j) )
+
+          !! 2.2 Determine if growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     Leaf onset occurs if the monthly moisture availability is still quite
+          !!     low (i.e. lower than the weekly availability), but the weekly availability is 
+          !!     already higher than the critical threshold ::availability_crit (as it reacts faster), 
+          !!     which indicates the weekly moisture availability is increasing.
+          !!     OR if the monthly moisture availability is high enough (i.e. above the threshold value 
+          !!     ::moiavail_always), leaf onset is initiated if this has not already happened.
+
+          IF ( ( ( moiavail_week(i,j)  .GE. availability_crit(i) ) .AND. &
+               ( moiavail_month(i,j) .LT. moiavail_week(i,j) )   ) .OR. &
+               ( moiavail_month(i,j) .GE. moiavail_always )                ) THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving hum'
+
+  END SUBROUTINE pheno_hum
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_moi
+!!
+!>\BRIEF          The 'moi' onset model (::pheno_moi) initiates leaf onset based exclusively 
+!!                on moisture availability criteria. 
+!!                It is very similar to the 'hum' onset model but instead of the weekly moisture 
+!!                availability being higher than a constant threshold, the condition is that the 
+!!                moisture minimum happened a sufficiently long time ago. 
+!!                Currently PFT 3 (Tropical Broad-leaved Raingreen) is assigned to this model.
+!!
+!! DESCRIPTION  : This model is for tropical biomes, where temperatures are high but moisture
+!!                might be a limiting factor on growth. It is based on leaf onset model 4b in 
+!!                Botta et al. (2000).
+!!                Leaf onset begins if the plant moisture availability minimum was a sufficiently  
+!!                time ago, as specified by the PFT-dependent parameter ::hum_min_time 
+!!                AND if the "monthly" moisture availability is lower than the "weekly"
+!!                availability (indicating that soil moisture is increasing).
+!!                OR if the monthly moisture availability is high enough (i.e. above the threshold 
+!!                value ::moiavail_always), leaf onset is initiated if this has not already 
+!!                happened. \n
+!!                ::hum_min_time is set for each PFT in ::stomate_data, and is 
+!!                defined in the table ::hum_min_time_tab in ::stomate_constants. \n
+!!                ::moiavail_always is defined for both tree and grass in this subroutine 
+!!                (set to 1. and 0.6 respectively). \n
+!!                The ::pheno_moi subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!        
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start.
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_moi.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_moi (npts, j, PFTpresent, allow_initpheno, &
+       time_hum_min, &
+       moiavail_month, moiavail_week, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts            !! Domain size - number of grid cells (unitless)
+    INTEGER(i_std), INTENT(in)                               :: j               !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to declare the beginning of the 
+                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: time_hum_min    !! time elapsed since strongest moisture 
+                                                                                !! availability (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_month  !! "monthly" moisture availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_week   !! "weekly" moisture availability (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves    !! signal to start putting leaves on (true/false)
+
+    !
+    !! 0.3 Modified variables
+    !
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    INTEGER(i_std)                                           :: i                               !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering moi'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of onset model and the moisture availability 
+    !!     parameters for tree and grass
+    !
+
+    IF ( firstcall_moi ) THEN
+
+       WRITE(numout,*) 'pheno_moi:'
+       WRITE(numout,*) '   > moisture availability above which moisture tendency doesn''t matter: '
+       WRITE(numout,*) '         trees (::moiavail_always_tree):', moiavail_always_tree
+       WRITE(numout,*) '         grasses (::moiavail_always_grass):', moiavail_always_grass
+
+       firstcall_moi = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.3 check the critical value ::hum_min_time is definded. If not, stop
+    !
+
+    IF ( hum_min_time(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'moi: hum_min_time is undefined for PFT (::j) ',j
+       WRITE(numout,*) 'We stop.'
+       STOP
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical monthly moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(j) ) THEN
+       moiavail_always = moiavail_always_tree
+    ELSE
+       moiavail_always = moiavail_always_grass
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !! The PFT has to be there and start of growing season must be allowed.
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) ) THEN
+          
+          !! 2.1 Determine if growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     The favorable season starts if the moisture minimum (::time_hum_min) was a sufficiently long 
+          !!     time ago, i.e. greater than the threshold specified by the parameter ::hum_min_time 
+          !!     and if the "monthly" moisture availability is lower than the "weekly"
+          !!     availability (indicating that soil moisture is increasing).
+          !!     OR if the monthly moisture availability is high enough (i.e. above the threshold value 
+          !!     ::moiavail_always), initiate the growing season if this has not happened yet.
+
+          IF  ( ( ( moiavail_week(i,j) .GT. moiavail_month(i,j) ) .AND. &
+               ( time_hum_min(i,j) .GT. hum_min_time(j) )    ) .OR. &
+               ( moiavail_month(i,j) .GE. moiavail_always )                     ) THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving moi'
+
+  END SUBROUTINE pheno_moi
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_humgdd
+!!
+!>\BRIEF          The 'humgdd' onset model initiates leaf onset based on mixed conditions of 
+!!                temperature and moisture availability criteria. 
+!!                Currently no PFTs are assigned to this onset model. 
+!!
+!! DESCRIPTION  : In this model the Growing Degree Day (GDD) model (Chuine, 2000) is combined 
+!!                with the 'hum' onset model (::pheno_hum), which has previously been described,
+!!                in order to account for dependence on both temperature and moisture conditions 
+!!                in warmer climates. \n. 
+!!                The GDD model specifies that daily temperatures above a threshold of -5  
+!!                degrees C are summed, minus this threshold, giving the GDD, starting from 
+!!                the beginning of the dormancy period (::time_lowgpp>0), i.e. since the leaves 
+!!                were lost. \n.
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                Leaf onset begins when the a PFT-dependent GDD-threshold is reached.
+!!                In addition there are temperature and moisture conditions.
+!!                The temperature condition specifies that the monthly temperature has to be 
+!!                higher than a constant threshold (::t_always) OR
+!!                the weekly temperature is higher than the monthly temperature.
+!!                There has to be at least some moisture. The moisture condition 
+!!                is exactly the same as the 'hum' onset model (::pheno_hum), which has already
+!!                been described. \n
+!!                The GDD (::gdd_m5_dormance) is calculated in ::stomate_season. GDD is set to 
+!!                undef if beginning of the growing season detected, i.e. when there is GPP 
+!!                (::time_lowgpp>0).
+!!                The parameter ::t_always is defined as 10 degrees C in this subroutine, 
+!!                as are the parameters ::moisture_avail_tree and ::moisture_avail_grass 
+!!                (set to 1 and 0.6 respectively), which are used in the moisture condition 
+!!                (see ::pheno_moi onset model description). \n
+!!                The PFT-dependent GDD threshold (::gdd_crit) is calculated as in the onset 
+!!                model ::pheno_humgdd, using the equation:
+!!                \latexonly
+!!                \input{phenology_hummoigdd_gddcrit_eqn4.tex}
+!!                \endlatexonly
+!!                \n
+!!                The three GDDcrit parameters (::gdd(j,*)) are set for each PFT in 
+!!                ::stomate_data, and three tables defining each of the three critical GDD
+!!                parameters for each PFT is given in ::gdd_crit1_tab, ::gdd_crit2_tab and 
+!!                ::gdd_crit3_tab in ::stomate_constants. \n
+!!                The ::pheno_humgdd subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGES: None
+!!                
+!! MAIN OUTPUT VARIABLES: ::begin_leaves - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Chuine, I (2000), A unified model for the budburst of trees, Journal of 
+!! Theoretical Biology, 207, 337-347.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_humgdd.png}
+!! \endlatexonly
+!! \n             
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_humgdd (npts, j, PFTpresent, allow_initpheno, gdd, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       tlong_ref, t2m_month, t2m_week, &
+       moiavail_week, moiavail_month, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts                    !! Domain size - number of grid cells 
+                                                                                        !! (unitless) 
+    INTEGER(i_std), INTENT(in)                               :: j                       !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent              !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno         !! are we allowed to declare the beginning 
+                                                                                        !! of the growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: gdd                     !! growing degree days, calculated since 
+                                                                                        !! leaves have fallen (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: maxmoiavail_lastyear    !! last year's maximum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: minmoiavail_lastyear    !! last year's minimum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: tlong_ref               !! "long term" 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month               !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week                !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_week           !! "weekly" moisture availability 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_month          !! "monthly" moisture availability 
+                                                                                        !! (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves            !! signal to start putting leaves on 
+                                                                                        !! (true/false) 
+
+    !
+    !! 0.3 Modified variables
+    !
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                             :: moiavail_crit                   !! critical moisture availability 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                             :: tl                              !! long term temperature (C)
+    REAL(r_std), DIMENSION(npts)                             :: gdd_crit                        !! critical GDD (C)
+    INTEGER(i_std)                                           :: i                               !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering humgdd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of the onset model, the values of the  
+    !!     moisture availability parameters for tree and grass, and the value of the 
+    !!     critical monthly temperature.
+    !
+
+    IF ( firstcall_humgdd ) THEN
+
+       WRITE(numout,*) 'pheno_humgdd:'
+       WRITE(numout,*) '   > moisture availability above which moisture tendency doesn''t matter: '
+       WRITE(numout,*) '         trees (::moiavail_always_tree): ', moiavail_always_tree
+       WRITE(numout,*) '         grasses (::moiavail_always_grass): ', moiavail_always_grass
+       WRITE(numout,*) '   > monthly temp. above which temp. tendency doesn''t matter: ', &
+            t_always
+
+       firstcall_humgdd = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.3 check the critical values ::gdd and ::pheno_crit_hum_frac are defined.
+    !!     If not, stop.
+    !
+
+    IF ( ANY(pheno_gdd_crit(j,:) .EQ. undef) ) THEN
+
+       WRITE(numout,*) 'humgdd: pheno_gdd_crit is undefined for PFT (::j) ',j
+       WRITE(numout,*) 'We stop.'
+       STOP
+
+    ENDIF
+
+    IF ( hum_frac(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'humgdd: hum_frac is undefined for PFT (::j) ',j
+       WRITE(numout,*) 'We stop.'
+       STOP
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(j) ) THEN
+       moiavail_always = moiavail_always_tree
+    ELSE
+       moiavail_always = moiavail_always_grass
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !!   The PFT has to be there, start of growing season must be allowed, 
+    !!   and GDD has to be defined.
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) .AND. &
+            ( gdd(i,j) .NE. undef )                           ) THEN
+
+          !! 2.1 Calculate the critical weekly moisture availability: depends linearly on the last year 
+          !! minimum and maximum moisture availabilities, and on the parameter ::hum_frac.,
+          !! (as in the ::pheno_hum model), as per the equation:
+
+          moiavail_crit(i) = minmoiavail_lastyear(i,j) + hum_frac(j) * &
+               ( maxmoiavail_lastyear(i,j) - minmoiavail_lastyear(i,j) )
+
+          !! 2.2 Calculate the critical GDD (::gdd_crit), which is a function of the PFT-dependent 
+          !!     critical GDD and the "long term" 2 meter air temperatures.  
+
+          tl(i) =  tlong_ref(i) - ZeroCelsius
+          gdd_crit(i) = pheno_gdd_crit(j,1) + tl(i)*pheno_gdd_crit(j,2) + &
+               tl(i)*tl(i)*pheno_gdd_crit(j,3)
+          
+          !! 2.3 Determine if the growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     - Has the critical gdd been reached and is the temperature increasing?
+          !!     - Is there at least some humidity/moisture availability?
+          !!     This occurs if the critical gdd (::gdd_crit) has been reached 
+          !!     AND that is temperature increasing, which is true either if the monthly
+          !!     temperature being higher than the threshold ::t_always, OR if the weekly
+          !!     temperature is higher than the monthly, 
+          !!     AND finally that there is sufficient moisture availability, which is 
+          !!     the same condition as for the ::pheno_hum onset model.
+
+          IF ( ( gdd(i,j) .GE. gdd_crit(i) ) .AND. &
+               ( ( t2m_week(i) .GT. t2m_month(i) ) .OR. &
+               ( t2m_month(i) .GT. t_always )          ) .AND. &
+               ( ( ( moiavail_week(i,j)  .GE. moiavail_crit(i) ) .AND. &
+               ( moiavail_month(i,j) .LT. moiavail_crit(i) )        ) .OR. &
+               ( moiavail_month(i,j) .GE. moiavail_always )                   ) )  THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! End loop over grid points
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving humgdd'
+
+  END SUBROUTINE pheno_humgdd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_moigdd
+!!
+!>\BRIEF          The 'moigdd' onset model initiates leaf onset based on mixed temperature 
+!!                and moisture availability criteria.
+!!                Currently PFTs 10 - 13 (C3 and C4 grass, and C3 and C4 agriculture) 
+!!                are assigned to this model. 
+!!
+!! DESCRIPTION  : This onset model combines the GDD model (Chuine, 2000), as described for 
+!!                the 'humgdd' onset model (::pheno_humgdd), and the 'moi' model, in order 
+!!                to account for dependence on both temperature and moisture conditions in
+!!                warmer climates. \n
+!!                Leaf onset begins when the a PFT-dependent GDD threshold is reached.
+!!                In addition there are temperature and moisture conditions.
+!!                The temperature condition specifies that the monthly temperature has to be 
+!!                higher than a constant threshold (::t_always) OR
+!!                the weekly temperature is higher than the monthly temperature.
+!!                There has to be at least some moisture. The moisture condition 
+!!                is exactly the same as the 'moi' onset model (::pheno_moi), which has
+!!                already been described. \n
+!!                GDD is set to undef if beginning of the growing season detected.
+!!                As in the ::pheno_humgdd model, the parameter ::t_always is defined as 
+!!                10 degrees C in this subroutine, as are the parameters ::moisture_avail_tree
+!!                and ::moisture_avail_grass (set to 1 and 0.6 respectively), which are used
+!!                in the moisture condition (see ::pheno_moi onset model description). \n
+!!                The PFT-dependent GDD threshold (::gdd_crit) is calculated as in the onset 
+!!                model ::pheno_humgdd, using the equation:
+!!                \latexonly
+!!                \input{phenology_hummoigdd_gddcrit_eqn4.tex}
+!!                \endlatexonly
+!!                \n
+!!                where i and j are the grid cell and PFT respectively.
+!!                The three GDDcrit parameters (::gdd(j,*)) are set for each PFT in 
+!!                ::stomate_data, and three tables defining each of the three critical GDD
+!!                parameters for each PFT is given in ::gdd_crit1_tab, ::gdd_crit2_tab and 
+!!                ::gdd_crit3_tab in ::stomate_constants. \n
+!!                The ::pheno_moigdd subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!                
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Chuine, I (2000), A unified model for the budburst of trees, Journal of 
+!! Theoretical Biology, 207, 337-347.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_moigdd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_moigdd (npts, j, PFTpresent, allow_initpheno, gdd, &
+       time_hum_min, &
+       tlong_ref, t2m_month, t2m_week, &
+       moiavail_week, moiavail_month, &
+       begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts            !! Domain size - number of grid cells (unitless)
+    INTEGER(i_std), INTENT(in)                               :: j               !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to decalre the beginning of the 
+                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: gdd             !! growing degree days, calculated since leaves 
+                                                                                !! have fallen (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: time_hum_min    !! time elapsed since strongest moisture 
+                                                                                !! availability (days) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: tlong_ref       !! "long term" 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month       !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week        !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_week   !! "weekly" moisture availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: moiavail_month  !! "monthly" moisture availability (0-1, unitless)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves    !! signal to start putting leaves on (true/false)
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                             :: tl                              !! long term temperature (C)
+    REAL(r_std), DIMENSION(npts)                             :: gdd_crit                        !! critical GDD (C)
+    INTEGER(i_std)                                           :: i                               !! index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering moigdd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 first call - outputs the name of the onset model, the values of the  
+    !!     moisture availability parameters for tree and grass, and the value of the 
+    !!     critical monthly temperature.
+    !
+
+    IF ( firstcall_moigdd ) THEN
+
+       WRITE(numout,*) 'pheno_moigdd:'
+       WRITE(numout,*) '   > moisture availability above which moisture tendency doesn''t matter: '
+       WRITE(numout,*) '         trees (::moiavail_always_tree) :', moiavail_always_tree
+       WRITE(numout,*) '         grasses (::moiavail_always_grass) :', moiavail_always_grass
+       WRITE(numout,*) '   > monthly temp. above which temp. tendency doesn''t matter (::t_always): ', &
+            t_always
+
+       firstcall_moigdd = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.3 check the critical values ::gdd and ::pheno_crit_hum_min_time are defined.
+    !!     If not, stop.
+    !
+
+    IF ( ANY(pheno_gdd_crit(j,:) .EQ. undef) ) THEN
+
+       WRITE(numout,*) 'moigdd: pheno_gdd_crit is undefined for PFT',j
+       WRITE(numout,*) 'We stop.'
+       STOP
+
+    ENDIF
+
+    IF ( hum_min_time(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'moigdd: hum_min_time is undefined for PFT',j
+       WRITE(numout,*) 'We stop.'
+       STOP
+
+    ENDIF
+
+    !
+    !! 1.4 set the critical moisture availability above which we always detect the beginning of the
+    !!     growing season - set as the moisture availability for trees or grass.
+    !
+
+    IF ( is_tree(j) ) THEN
+       moiavail_always = moiavail_always_tree
+    ELSE
+       moiavail_always = moiavail_always_grass
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !!    The PFT has to be there, the start of growing season must be allowed, 
+    !!    and GDD has to be defined.
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) .AND. &
+            ( gdd(i,j) .NE. undef )                           ) THEN
+          
+          !! 2.1 Calculate the critical GDD (::gdd_crit), which is a function of the PFT-dependent 
+          !!     critical GDD and the "long term" 2 meter air temperatures 
+          
+          tl(i) = tlong_ref(i) - ZeroCelsius
+          gdd_crit(i) = pheno_gdd_crit(j,1) + tl(i)*pheno_gdd_crit(j,2) + &
+               tl(i)*tl(i)*pheno_gdd_crit(j,3)
+
+          !! 2.2 Determine if the growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     This occurs if the critical gdd (::gdd_crit) has been reached 
+          !!     AND that is temperature increasing, which is true either if the monthly
+          !!     temperature being higher than the threshold ::t_always, OR if the weekly
+          !!     temperature is higher than the monthly, 
+          !!     AND finally that there is sufficient moisture availability, which is 
+          !!     the same condition as for the ::pheno_moi onset model.
+     
+          IF ( ( gdd(i,j) .GE. gdd_crit(i) ) .AND. &
+               ( ( t2m_week(i) .GT. t2m_month(i) ) .OR. &
+               ( t2m_month(i) .GT. t_always )          ) .AND. &
+               ( ( ( time_hum_min(i,j) .GT. hum_min_time(j) ) .AND. &
+               ( moiavail_week(i,j) .GT. moiavail_month(i,j) )            ) .OR. &
+               ( moiavail_month(i,j) .GE. moiavail_always )                         ) )  THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving moigdd'
+
+  END SUBROUTINE pheno_moigdd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_ncdgdd
+!!
+!>\BRIEF          The Number of Chilling Days - Growing Degree Day (NCD-GDD) model initiates 
+!!                leaf onset if a certain relationship between the number of chilling days (NCD) 
+!!                since leaves were lost, and the growing degree days (GDD) since midwinter, is 
+!!                fulfilled. 
+!!                Currently PFT 6 (Temperate Broad-leaved Summergreen) and PFT 8 (Boreal Broad-
+!!                leaved Summergreen) are assigned to this model.
+!! 
+!! DESCRIPTION  : Experiments have shown that some
+!!                species have a "chilling" requirement, i.e. their physiology needs cold 
+!!                temperatures to trigger the mechanism that will allow the following budburst 
+!!                (e.g. Orlandi et al., 2004). 
+!!                An increase in chilling days, defined as a day with a daily mean air
+!!                temperature below a PFT-dependent threshold, reduces a plant's GDD demand 
+!!                (Cannell and Smith, 1986; Murray et al., (1989); Botta et al., 2000).
+!!                The GDD threshold therefore decreases as NCD 
+!!                increases, using the following empirical negative explonential law:
+!!                \latexonly
+!!                \input{phenology_ncdgdd_gddmin_eqn5.tex}
+!!                \endlatexonly
+!!                \n
+!!                The constants used have been calibrated against data CHECK FOR REFERENCE OR PERSON WHO DID UPDATE.
+!!                Leaf onset begins if the GDD is higher than the calculated minimum GDD
+!!                (dependent upon NCD) AND if the weekly temperature is higher than the monthly 
+!!                temperature. This is to ensure the temperature is increasing. \n
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                The NCD (::ncd_dormance) is calculated in ::stomate_season as  
+!!                the number of days with a temperature below a PFT-dependent constant threshold
+!!                (::ncdgdd_temp), starting from the beginning of the dormancy period
+!!                (::time_lowgpp>0), i.e. since the leaves were lost. \n
+!!                The growing degree day sum of the temperatures higher than 
+!!                ::ncdgdd_temp (GDD) since midwinter (::gdd_midwinter) 
+!!                is also calculated in ::stomate_season.
+!!                Midwinter is detected if the monthly temperature is lower than the weekly
+!!                temperature AND  the monthly temperature is lower than the long-term
+!!                temperature. ::gdd_minter is therefore set to 0 at the beginning of midwinter
+!!                and increased with each temperature greater than the PFT-dependent threshold.
+!!                When midsummer is detected (the opposite of the above conditions), 
+!!                ::gdd_midwinter is set to undef.
+!!                CHECK! WHEN TO START OF DORMANCY BEEN MODIFIED FROM BOTTA- ADD IN?
+!!                The ::pheno_ncdgdd subroutine is called in the subroutine ::phenology. 
+!!
+!! RECENT CHANGE(S): None
+!!                
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) :
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347.
+!! - Cannell, M.J.R. and R.I. Smith (1986), Climatic warming, spring budburst and
+!! frost damage on trees, Journal of Applied Ecology, 23, 177-191.
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!! - Murray, M.B., G.R. Cannell and R.I. Smith (1989), Date of budburst of fifteen 
+!! tree species in Britain following climatic warming, Journal of Applied Ecology,
+!! 26, 693-700.
+!! - Orlandi, F., H. Garcia-Mozo, L.V. Ezquerra, B. Romano, E. Dominquez, C. Galan,
+!! and M. Fornaciari (2004), Phenological olive chilling requirements in Umbria
+!! (Italy) and Andalusia (Spain), Plant Biosystems, 138, 111-116. 
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_ncdgdd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_ncdgdd (npts, j, PFTpresent, allow_initpheno, &
+       ncd_dormance, gdd_midwinter, &
+       t2m_month, t2m_week, begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts            !! Domain size - number of grid cells (unitless)
+    INTEGER(i_std), INTENT(in)                               :: j               !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to declare the beginning of the 
+                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: ncd_dormance    !! number of chilling days since leaves were lost 
+                                                                                !! (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)          :: gdd_midwinter   !! growing degree days since midwinter (C)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month       !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week        !! "weekly" 2-meter temperatures (K)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves    !! signal to start putting leaves on (true/false)
+
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                           :: i               !! index (unitless)
+    REAL(r_std)                                              :: gdd_min         !! critical gdd (C)
+
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering ncdgdd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.2 check the critical value ::ncdgdd_temp is defined.
+    !!     If not, stop.
+    !
+
+    IF ( ncdgdd_temp(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'ncdgdd: ncdgdd_temp is undefined for PFT (::j) ',j
+       WRITE(numout,*) 'We stop.'
+       STOP
+
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.    
+    !!    PFT has to be there and start of growing season must be allowed.
+    !
+
+    DO i = 1, npts ! loop over grid points
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) .AND. &
+            ( gdd_midwinter(i,j) .NE. undef ) .AND. &
+            ( ncd_dormance(i,j) .NE. undef )                  ) THEN
+
+          !! 2.1 Calculate the critical gdd, which is related to ::ncd_dormance
+          !!     using an empirical negative exponential law as described above.           
+
+          gdd_min = ( gddncd_ref / exp(gddncd_curve*ncd_dormance(i,j)) - gddncd_offset )
+
+          !! 2.2 Determine if the growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     This occurs if the critical GDD been reached AND the temperatures are increasing.
+          !!     If the growing season has started, ::gdd_midwinter is set to "undef". 
+
+          IF ( ( gdd_midwinter(i,j) .GE. gdd_min ) .AND. &
+               ( t2m_week(i) .GT. t2m_month(i) ) ) THEN
+             begin_leaves(i,j) = .TRUE.
+             gdd_midwinter(i,j)=undef
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving ncdgdd'
+
+  END SUBROUTINE pheno_ncdgdd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : pheno_ngd
+!!
+!>\BRIEF          The Number of Growing Days (NGD) leaf onset model initiates leaf onset if the NGD, 
+!!                defined as the number of days with temperature above a constant threshold, 
+!!                exceeds a critical value.
+!!                Currently PFT 9 (Boreal Leedleleaf Summergreen) is assigned to this model. 
+!!
+!! DESCRIPTION    The NGD model is a variant of the GDD model. The model was proposed by Botta et
+!!                al. (2000) for boreal and arctic biomes, and is designed to estimate 
+!!                leaf onset after the end of soil frost. 
+!!                The NDG (::ngd_minus5) is the number of days with a daily mean air 
+!!                temperature of greater than -5 degrees C, 
+!!                starting from the beginning of the dormancy period (i.e. time since the leaves 
+!!                were lost/GPP below a certain threshold).
+!!                Leaf onset begins if the NGD is higher than the PFT-dependent constant threshold, 
+!!                ::ngd,  AND if the weekly temperature is higher than the monthly 
+!!                temperature. \n
+!!                The dormancy time-length is represented by the variable 
+!!                ::time_lowgpp, which is calculated in ::stomate_season. It is increased by 
+!!                the stomate time step when the weekly GPP is lower than a threshold. Otherwise
+!!                it is set to zero. \n
+!!                ::ngd_minus5 is also calculated in ::stomate_season. It is initialised at the
+!!                beginning of the dormancy period (::time_lowgpp>0), and increased by the 
+!!                stomate time step when the temperature > -5 degrees C. \n
+!!                ::ngd is set for each PFT in ::stomate_data, and a 
+!!                table defining the minimum NGD for each PFT is given in ::ngd_crit_tab
+!!                in ::stomate_constants. \n
+!!                The ::pheno_ngd subroutine is called in the subroutine ::phenology.      
+!!
+!! RECENT CHANGE(S): None
+!!                
+!! MAIN OUTPUT VARIABLE(S): ::begin_leaves - specifies whether leaf growth can start
+!!
+!! REFERENCE(S) : 
+!! - Botta, A., N. Viovy, P. Ciais, P. Friedlingstein and P. Monfray (2000), 
+!! A global prognostic scheme of leaf onset using satellite data,
+!! Global Change Biology, 207, 337-347. 
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{pheno_ngd.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE pheno_ngd (npts, j, PFTpresent, allow_initpheno, ngd, &
+       t2m_month, t2m_week, begin_leaves)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                               :: npts            !! Domain size - number of grid cells (unitless)
+    INTEGER(i_std), INTENT(in)                               :: j               !! PFT index (unitless)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: PFTpresent      !! PFT exists (true/false)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                 :: allow_initpheno !! are we allowed to declare the beginning of the 
+                                                                                !! growing season? (true/false) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)             :: ngd             !! growing degree days (C)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_month       !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                 :: t2m_week        !! "weekly" 2-meter temperatures (K)
+
+    !
+    !! 0.2 Output variables
+    !
+
+    !
+    !! 0.3 Modified variables
+    !
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)              :: begin_leaves    !! signal to start putting leaves on (true/false)
+
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                           :: i               !! index (unitless)
+
+    !! =========================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering ngd'
+
+    !
+    !! 1. Initializations
+    !
+
+    !
+    !! 1.1 initialize output
+    !
+
+    begin_leaves(:,j) = .FALSE.
+
+    !
+    !! 1.2 check the critical value ::ngd_crit is defined.
+    !!     If not, stop.
+    !
+
+    IF ( ngd_crit(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'ngd: ngd_crit is undefined for PFT (::j) ',j
+       WRITE(numout,*) 'We stop.'
+       STOP
+
+    ENDIF
+
+    !
+    !! 2. Check if biometeorological conditions are favourable for leaf growth.
+    !!    PFT has to be there and start of growing season must be allowed.
+    !
+
+    DO i = 1, npts
+
+       IF ( PFTpresent(i,j) .AND. allow_initpheno(i,j) ) THEN
+
+          !! 2.1 Determine if the growing season should start (if so, ::begin_leaves set to TRUE).
+          !!     This occurs if the critical NGD has been reached AND are temperatures increasing.
+
+          IF ( ( ngd(i,j) .GE. ngd_crit(j) ) .AND. &
+               ( t2m_week(i) .GT. t2m_month(i) )        ) THEN
+             begin_leaves(i,j) = .TRUE.
+          ENDIF
+
+       ENDIF        ! PFT there and start of growing season allowed
+
+    ENDDO ! end loop over grid points
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving ngd'
+
+  END SUBROUTINE pheno_ngd
+
+END MODULE stomate_phenology
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_prescribe.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_prescribe.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_prescribe.f90	(revision 5166)
@@ -0,0 +1,347 @@
+! =================================================================================================================================
+! MODULE       : stomate_prescribe
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF         Initialize and update density, crown area.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_prescribe
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC prescribe,prescribe_clear
+
+    ! first call
+    LOGICAL, SAVE                                              :: firstcall = .TRUE.
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+! =================================================================================================================================
+!! SUBROUTINE   : prescribe_clear
+!!
+!>\BRIEF        : Set the firstcall flag back to .TRUE. to prepare for the next simulation.
+!_=================================================================================================================================
+
+  SUBROUTINE prescribe_clear
+    firstcall=.TRUE.
+  END SUBROUTINE prescribe_clear
+
+!! ================================================================================================================================
+!! SUBROUTINE   : prescribe
+!!
+!>\BRIEF         Works only with static vegetation and agricultural PFT. Initialize biomass,
+!!               density, crown area in the first call and update them in the following.
+!!
+!! DESCRIPTION (functional, design, flags): \n
+!! This module works only with static vegetation and agricultural PFT.
+!! In the first call, initialize density of individuals, biomass, crown area,
+!! and leaf age distribution to some reasonable value. In the following calls,
+!! these variables are updated.
+!!
+!! To fulfill these purposes, pipe model are used:
+!! \latexonly 
+!!     \input{prescribe1.tex}
+!!     \input{prescribe2.tex}
+!! \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLES(S): ::ind, ::cn_ind, ::leaf_frac
+!!
+!! REFERENCES   :
+!! - Krinner, G., N. Viovy, et al. (2005). "A dynamic global vegetation model 
+!!   for studies of the coupled atmosphere-biosphere system." Global 
+!!   Biogeochemical Cycles 19: GB1015, doi:1010.1029/2003GB002199.
+!! - Sitch, S., B. Smith, et al. (2003), Evaluation of ecosystem dynamics,
+!!   plant geography and terrestrial carbon cycling in the LPJ dynamic 
+!!   global vegetation model, Global Change Biology, 9, 161-185.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+ SUBROUTINE prescribe (npts, &
+                        veget_max, dt, PFTpresent, everywhere, when_growthinit, &
+                        biomass, leaf_frac, ind, cn_ind, co2_to_bm)
+
+!! 0. Parameters and variables declaration
+
+   !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)              :: veget_max       !! "maximal" coverage fraction of a PFT (LAI -> infinity) on ground (unitless;0-1)
+    REAL(r_std), INTENT(in)                                   :: dt              !! time step (dt_days)
+    !! 0.2 Output variables 
+
+    !! 0.3 Modified variables
+
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)               :: PFTpresent      !! PFT present (0 or 1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: everywhere      !! is the PFT everywhere in the grid box or very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: when_growthinit !! how many days ago was the beginning of the growing season (days)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass   !! biomass (gC/(m^2 of ground))
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout) :: leaf_frac       !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: ind             !! density of individuals (1/(m^2 of ground))
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: cn_ind          !! crown area per individual (m^2)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: co2_to_bm       !! co2 taken up by carbohydrate 
+                                                                                 !! reserve at the beginning of the
+                                                                                 !! growing season @tex ($gC m^{-2} 
+                                                                                 !! of total ground/day$) @endtex 
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts)                              :: dia             !! stem diameter (m)
+    REAL(r_std), DIMENSION(npts)                              :: woodmass        !! woodmass (gC/(m^2 of ground))
+    REAL(r_std), DIMENSION(npts)                              :: woodmass_ind    !! woodmass of an individual (gC)
+    INTEGER(i_std)                                            :: i,j             !! index (unitless)
+
+!_ ================================================================================================================================
+
+    DO j = 2,nvm
+
+      ! only when the DGVM is not activated or agricultural PFT.
+
+      IF ( ( .NOT. control%ok_dgvm .AND. lpj_gap_const_mort ) .OR. ( .NOT. natural(j) ) ) THEN
+
+        !
+        !! 1.Update crown area
+        !
+
+        cn_ind(:,j) = zero
+
+        IF ( is_tree(j) ) THEN
+
+          !
+          !! 1.1 treat for trees
+          !
+
+          dia(:) = zero
+
+          DO i = 1, npts ! loop over grid points
+
+            IF ( veget_max(i,j) .GT. zero ) THEN
+
+              !! 1.1.1 calculate wood mass on an area basis, which include sapwood and heartwood aboveground and belowground.
+
+              woodmass(i) = (biomass(i,j,isapabove,icarbon) + biomass(i,j,isapbelow,icarbon) + &
+                   biomass(i,j,iheartabove,icarbon) + biomass(i,j,iheartbelow,icarbon)) * veget_max(i,j)  
+
+              IF ( woodmass(i) .GT. min_stomate ) THEN
+
+                !! 1.1.2 calculate critical individual density
+!?? the logic for 1.1.3 and 1.1.2 is strange, it should be the case that first to calculate critical woodmass per individual,
+!?? then calculate critical density.
+
+
+                ! how to derive the following equation:
+                ! first, TreeHeight=pipe_tune2 * Diameter^{pipe_tune3}
+                ! we assume the tree is an ideal cylinder, so it volume is: Volume = pi*(Dia/2)^2*Height = pi/4 * Dia * pipe_tune2*Dia^{pipe_tune3} 
+                !                                                                  = pi/4 * pipe_tune2 * Dia^{2+pipe_tune3}
+                ! last, the woodmass_per_individual = pipe_density * Volume = pipe_density*pi/4.*pipe_tune2 * Dia^{2+pipe_tune3}             
+                ind(i,j) = woodmass(i) / &
+                           ( pipe_density*pi/4.*pipe_tune2 * maxdia(j)**(2.+pipe_tune3) )
+
+                !! 1.1.3 individual biomass corresponding to this critical density of individuals
+
+                woodmass_ind(i) = woodmass(i) / ind(i,j)
+
+                !! 1.1.4 calculate stem diameter per individual tree
+
+                dia(i) = ( woodmass_ind(i) / ( pipe_density * pi/4. * pipe_tune2 ) ) ** &
+                         ( un / ( 2. + pipe_tune3 ) )
+
+                !! 1.1.5 calculate provisional tree crown area for per individual tree
+
+                ! equation: CrownArea=pipe_tune1 * Diameter^{1.6}
+                cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** pipe_tune_exp_coeff
+
+                !! 1.1.6 If total tree crown area for this tree PFT exceeds its veget_max, tree density is recalculated.
+
+                IF ( cn_ind(i,j) * ind(i,j) .GT. 1.002* veget_max(i,j) ) THEN
+
+                  ind(i,j) = veget_max(i,j) / cn_ind(i,j)
+
+                ELSE
+
+                   ind(i,j) = ( veget_max(i,j) / &
+                        &     ( pipe_tune1 * (woodmass(i)/(pipe_density*pi/4.*pipe_tune2)) &
+                        &     **(pipe_tune_exp_coeff/(2.+pipe_tune3)) ) ) &
+                        &     ** (1./(1.-(pipe_tune_exp_coeff/(2.+pipe_tune3))))
+                   
+
+                  woodmass_ind(i) = woodmass(i) / ind(i,j)
+
+                  dia(i) = ( woodmass_ind(i) / ( pipe_density * pi/4. * pipe_tune2 ) ) ** &
+                           ( un / ( 2. + pipe_tune3 ) )
+
+                  ! final crown area
+                  cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** pipe_tune_exp_coeff
+
+                ENDIF
+
+              ELSE !woodmas=0  => impose some value
+
+                dia(:) = maxdia(j)
+
+                cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** pipe_tune_exp_coeff
+
+              ENDIF ! IF ( woodmass(i) .GT. min_stomate )
+
+            ENDIF    ! veget_max .GT. 0.
+
+          ENDDO      ! loop over grid points
+
+        ELSE !grass
+
+          !
+          !! 1.2 grasses: crown area always set to 1m**2
+          !
+
+          WHERE ( veget_max(:,j) .GT. zero )
+            cn_ind(:,j) = un
+          ENDWHERE
+
+        ENDIF   !IF ( is_tree(j) )
+
+        !
+        !! 2 density of individuals
+        !
+        
+        WHERE ( veget_max(:,j) .GT. zero )
+
+          ind(:,j) = veget_max(:,j) / cn_ind(:,j)  
+
+        ELSEWHERE
+
+          ind(:,j) = zero
+
+        ENDWHERE
+
+      ENDIF     ! IF ( ( .NOT. control%ok_dgvm .AND. lpj_gap_const_mort ) .OR. ( .NOT. natural(j) ) )
+
+    ENDDO       ! loop over PFTs
+
+    !
+    !!? it's better to move the code for first call at the beginning of the module.
+    !! 2 If it's the first call for this module, 
+    !
+
+    IF (( firstcall ) .AND. (TRIM(stom_restname_in) == 'NONE')) THEN
+
+      WRITE(numout,*) 'prescribe:'
+
+      ! impose some biomass if zero and PFT prescribed
+
+      WRITE(numout,*) '   > Imposing initial biomass for prescribed trees, '// &
+                      'initial reserve mass for prescribed grasses.'
+      WRITE(numout,*) '   > Declaring prescribed PFTs present.'
+
+      DO j = 2,nvm ! loop over PFTs
+        DO i = 1, npts ! loop over grid points
+
+          ! is vegetation static or PFT agricultural?
+          ! Static vegetation or agricultural PFT
+          IF ( ( .NOT. control%ok_dgvm ) .OR. &
+               ( ( .NOT. natural(j) ) .AND. ( veget_max(i,j) .GT. min_stomate ) ) ) THEN
+
+            !
+            !! 2.1 if tree biomass is extremely small, prescribe the biomass by assuming they have sapling biomass, which is a constant in the model.
+            !!     then set all the leaf age as 1.
+            !
+            ! if tree PFT and biomass too small, prescribe the biomass to a value.
+            IF ( is_tree(j) .AND. &
+                 ( veget_max(i,j) .GT. min_stomate ) .AND. &
+                 ( SUM( biomass(i,j,:,icarbon) ) .LE. min_stomate ) ) THEN
+               !!? here the code is redundant, as "veget_max(i,j) .GT. min_stomate" is already met in the above if condition.
+               IF (veget_max(i,j) .GT. min_stomate) THEN
+                  biomass(i,j,:,:) = (bm_sapl_rescale * bm_sapl(j,:,:) * ind(i,j)) / veget_max(i,j)
+               ELSE
+                  biomass(i,j,:,:) = zero
+               ENDIF
+
+              ! set leaf age classes
+              leaf_frac(i,j,:) = zero
+              leaf_frac(i,j,1) = un
+
+              ! set time since last beginning of growing season
+              when_growthinit(i,j) = large_value
+
+              ! seasonal trees: no leaves at beginning
+
+              IF ( pheno_model(j) .NE. 'none' ) THEN
+
+                biomass(i,j,ileaf,icarbon) = zero
+                leaf_frac(i,j,1) = zero
+
+              ENDIF
+
+              co2_to_bm(i,j) = co2_to_bm(i,j) + ( SUM(biomass(i,j,:,icarbon))  / dt )
+            ENDIF
+
+            !
+            !! 2.2 for grasses, set only the carbon reserve pool to "sapling" carbon reserve pool.
+            !!     and set all leaf age to 1.
+
+            IF ( ( .NOT. is_tree(j) ) .AND. &
+                 ( veget_max(i,j) .GT. min_stomate ) .AND. &
+                 ( SUM( biomass(i,j,:,icarbon) ) .LE. min_stomate ) ) THEN
+
+              biomass(i,j,icarbres,:) = bm_sapl(j,icarbres,:) * ind(i,j) / veget_max(i,j)
+
+              ! set leaf age classes
+              leaf_frac(i,j,:) = zero
+              leaf_frac(i,j,1) = un
+
+              ! set time since last beginning of growing season
+              when_growthinit(i,j) = large_value
+
+              co2_to_bm(i,j) = co2_to_bm(i,j) + ( biomass(i,j,icarbres,icarbon)  / dt )
+            ENDIF
+
+            !
+            !! 2.3 declare all PFTs with positive veget_max as present everywhere in that grid box
+            !
+
+            IF ( veget_max(i,j) .GT. min_stomate ) THEN
+              PFTpresent(i,j) = .TRUE.
+              everywhere(i,j) = un
+            ENDIF
+
+          ENDIF   ! not control%ok_dgvm  or agricultural
+
+        ENDDO ! loop over grid points
+      ENDDO ! loop over PFTs
+
+      firstcall = .FALSE.
+
+    ENDIF
+
+  END SUBROUTINE prescribe
+
+END MODULE stomate_prescribe
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_resp.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_resp.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_resp.f90	(revision 5166)
@@ -0,0 +1,368 @@
+! =================================================================================================================================
+! MODULE           : stomate_resp
+!
+! CONTACT          : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE          : IPSL (2006)
+!                  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF           Calculates maintenance respiration for different plant components
+!!
+!!\n DESCRIPTION   : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	   :
+!!- McCree KJ. An equation for the respiration of white clover plants grown under controlled conditions. 
+!! In: Setlik I, editor. Prediction and measurement of photosynthetic productivity. Wageningen, The Netherlands: Pudoc; 1970. p. 221-229.
+!! - Krinner G, Viovy N, de Noblet-Ducoudre N, Ogee J, Polcher J, Friedlingstein P,
+!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
+!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
+!! doi: 10.1029/2003GB002199.\n
+!! Ruimy A., Dedieu G., Saugier B. (1996), TURC: A diagnostic model
+!! of continental gross primary productivity and net primary productivity,
+!! Global Biogeochemical Cycles, 10, 269-285.\n
+
+!! SVN :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+ 
+MODULE stomate_resp
+
+  ! modules used:
+  USE stomate_data
+  USE pft_parameters
+  USE constantes  
+  USE constantes_soil 
+
+  IMPLICIT NONE
+
+  ! private & public routines
+  PRIVATE
+  PUBLIC maint_respiration,maint_respiration_clear
+
+  LOGICAL, SAVE                                              :: firstcall = .TRUE.                 !! first call
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: maint_respiration_clear
+!!
+!>\BRIEF        : Set the flag ::firstcall to .TRUE. and as such activate section 
+!!                1.1 of the subroutine maint_respiration (see below).
+!_ ================================================================================================================================
+
+  SUBROUTINE maint_respiration_clear
+    firstcall=.TRUE.
+  END SUBROUTINE maint_respiration_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: maint_respiration
+!!
+!>\BRIEF         Calculate PFT maintenance respiration of each living plant part by 
+!! multiplying the biomass of plant part by maintenance respiration coefficient which
+!! depends on long term mean annual temperature. PFT maintenance respiration is carbon flux 
+!! with the units @tex $(gC.m^{-2}dt^{-1})$ @endtex, and the convention is from plants to the 
+!! atmosphere.
+!!
+!! DESCRIPTION : The maintenance respiration of each plant part for each PFT is the biomass of the plant 
+!! part multiplied by maintenance respiration coefficient. The biomass allocation to different 
+!! plant parts is done in routine stomate_alloc.f90. The maintenance respiration coefficient is 
+!! calculated in this routine.\n
+!!
+!! The maintenance respiration coefficient is the fraction of biomass that is lost during 
+!! each time step, which increases linearly with temperature (2-meter air temperature for aboveground plant
+!! tissues; root-zone temperature for below-ground tissues). Air temperature is an input forcing variable. 
+!! Root-zone temperature is a convolution of root and soil temperature profiles and also calculated 
+!! in this routine.\n
+!!
+!! The calculation of maintenance respiration coefficient (fraction of biomass respired) depends linearly
+!! on temperature:
+!! - the relevant temperature for different plant parts (air temperature or root-zone temperature)\n
+!! - intercept: prescribed maintenance respiration coefficients at 0 Degree Celsius for 
+!!   different plant parts for each PFT in routine stomate_constants.f90\n
+!! - slope: calculated with a quadratic polynomial with the multi-annual mean air temperature 
+!! (the constants are in routine stomate_constants.f90) as follows\n 
+!!    \latexonly
+!!      \input{resp3.tex} 
+!!    \endlatexonly
+!!   Where, maint_resp_slope1, maint_resp_slope2, maint_resp_slope3 are constant in stomate_constants.f90.
+!!   Then coeff_maint is calculated as follows:\n
+!!    \latexonly
+!!      \input{resp4.tex} 
+!!    \endlatexonly  
+!! If the calculation result is negative, maintenance respiration coefficient will take the value 0.
+!! Therefore the maintenance respiration will also be 0.\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): PFT maintenance respiration of different plant parts (::resp_maint_part_radia)
+!!
+!! REFERENCE(S)	:
+!! McCree KJ. An equation for the respiration of white clover plants grown under controlled conditions. In: 
+!! Setlik I, editor. Prediction and measurement of photosynthetic productivity. Wageningen, 
+!! The Netherlands: Pudoc; 1970. p. 221-229.
+!! Krinner G, Viovy N, de Noblet-Ducoudre N, Ogee J, Polcher J, Friedlingstein P,
+!! Ciais P, Sitch S, Prentice I C (2005) A dynamic global vegetation model for studies
+!! of the coupled atmosphere-biosphere system. Global Biogeochemical Cycles, 19, GB1015,
+!! doi: 10.1029/2003GB002199.\n
+!! Ruimy A., Dedieu G., Saugier B. (1996), TURC: A diagnostic model
+!! of continental gross primary productivity and net primary productivity,
+!! Global Biogeochemical Cycles, 10, 269-285.\n
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE maint_respiration ( npts,dt,lai, t2m,tlong_ref,stempdiag,height,veget_max,&
+       rprof,biomass,resp_maint_part_radia)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+
+    INTEGER(i_std), INTENT(in)                         :: npts      !! Domain size - number of grid cells (unitless)
+    REAL(r_std), INTENT(in)                            :: dt        !! Time step of the simulations (seconds)
+    REAL(r_std), DIMENSION(npts), INTENT(in)           :: t2m       !! 2 meter air temperature - forcing variable (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)           :: tlong_ref !! Long term annual mean 2 meter reference air temperatures 
+                                                                    !! calculated in stomate_season.f90 (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT (in)     :: stempdiag !! Soil temperature of each soil layer (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)       :: height    !! height of vegetation (m)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)       :: veget_max !! PFT "maximal" coverage fraction of a PFT (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)       :: rprof     !! PFT root depth as calculated in stomate.f90 from parameter 
+                                                                    !! humcste which is root profile for different PFTs 
+                                                                    !! in slowproc.f90 (m)
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements),INTENT(in) :: biomass   !! PFT total biomass calculated in stomate_alloc.f90 
+                                                                    !! @tex $(gC.m^{-2})$ @endtex
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out) :: resp_maint_part_radia !! PFT maintenance respiration of different plant
+                                                                                  !! parts @tex $(gC.m^{-2}dt^{-1} )$ @endtex
+
+    !! 0.3 Modified variables
+ 
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts,nvm)        :: lai                  !! PFT leaf area index @tex $(m^2 m^{-2})$ @endtex
+    REAL(r_std), SAVE, DIMENSION(0:nbdl)    :: z_soil               !! Variable to store depth of the different soil layers (m)
+!$OMP THREADPRIVATE(z_soil)
+    REAL(r_std), DIMENSION(npts,nvm)        :: t_root               !! PFT root temperature (convolution of root and soil 
+                                                                    !! temperature profiles) (K)
+    REAL(r_std), DIMENSION(npts,nvm,nparts) :: coeff_maint          !! PFT maintenance respiration coefficients of different 
+                                                                    !! plant compartments at 0 deg C 
+                                                                    !! @tex $(g.g^{-1}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nparts)     :: t_maint              !! [DISPENSABLE] Temperature which is pertinent for maintenance
+                                                                    !! respiration - not used here (K)
+    REAL(r_std), DIMENSION(npts)            :: rpc                  !! Scaling factor for integrating vertical soil 
+                                                                    !! profiles (unitless)
+    REAL(r_std), DIMENSION(npts,nparts)     :: t_maint_radia        !! Temperature which is pertinent for maintenance respiration, 
+                                                                    !! which is air/root temperature for above/below-ground 
+                                                                    !! compartments (K) 
+    REAL(r_std), DIMENSION(npts)            :: tl                   !! Long term reference temperature in degrees Celcius 
+                                                                    !! (= tlong_ref - 273.15) (C)
+    REAL(r_std), DIMENSION(npts)            :: slope                !! slope of the temperature dependence of maintenance 
+                                                                    !! respiration coefficient (1/K)
+    INTEGER(i_std)                          :: i,j,k,l,m            !! Indeces (unitless)
+
+!_ ================================================================================================================================
+    
+    
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering respiration'
+    
+ !! 1. Initializations
+    
+    IF ( firstcall ) THEN
+
+       !! 1.1. Soil levels (first call only)
+       !       Set the depth of the different soil layers (number of layers: nbdl) 
+       !       previously calculated as variable diaglev in routines sechiba.f90 and slowproc.f90
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+       !! 1.1.2. Write message
+       !         Notify user of the start of this subroutine
+       WRITE(numout,*) 'respiration:'
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+    
+    
+    !! 1.2. Calculate root temperature
+    !       Calculate root temperature as the convolution of root and soil temperature profiles
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! 1.2.1 Calculate rpc
+       !  - rpc is an integration constant to make the integral over the root profile is equal 'one', 
+       !    calculated as follows:\n
+       !  \latexonly
+       !    \input{resp1.tex} 
+       !  \endlatexonly
+       rpc(:) = un / ( un - EXP( -z_soil(nbdl) / rprof(:,j) ) )
+
+       !! 1.2.2 Calculate root temperature
+       !        - Integrate root profile temperature (K) over soil layers (number of layers = nbdl)
+       !          with rpc and soil temperature (K) of each soil layer as follows:\n
+       !        \latexonly
+       !          \input{resp2.tex} 
+       !        \endlatexonly
+       !        Where, stempdiag is diagnostic temperature profile of soil (K)\n
+       t_root(:,j) = zero
+
+       DO l = 1, nbdl ! Loop over # soil layers
+
+          t_root(:,j) = &
+               t_root(:,j) + stempdiag(:,l) * rpc(:) * &
+               ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) )
+
+       ENDDO ! Loop over # soil layers
+
+    ENDDO ! Loop over # PFTs
+
+ !! 2. Define maintenance respiration coefficients
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! 2.1 Temperature for maintenanace respiration
+       !      Temperature which is used to calculate maintenance respiration for different plant compartments
+       !      (above- and belowground)\n
+       !      - for aboveground parts, we use 2-meter air temperature, t2m\n
+       !      - for belowground parts, we use root temperature calculated in section 1.2 of this subroutine\n
+       
+       ! 2.1.1 Aboveground biomass
+       t_maint_radia(:,ileaf) = t2m(:)
+       t_maint_radia(:,isapabove) = t2m(:)
+       t_maint_radia(:,ifruit) = t2m(:)
+
+       ! 2.1.2 Belowground biomass
+       t_maint_radia(:,isapbelow) = t_root(:,j)
+       t_maint_radia(:,iroot) = t_root(:,j)
+
+       !! 2.1.3 Heartwood biomass
+       !        Heartwood does does not respire. Any temperature could have been set  [code cleaning: set t(heartwood) to undef to 'undef']
+
+       t_maint_radia(:,iheartbelow) = t_root(:,j)
+       t_maint_radia(:,iheartabove) = t2m(:)
+
+       !! 2.1.4 Reserve biomass
+       !        Use aboveground temperature for trees and belowground temeperature for grasses
+       IF ( is_tree(j) ) THEN
+          t_maint_radia(:,icarbres) = t2m(:)
+       ELSE
+          t_maint_radia(:,icarbres) = t_root(:,j)
+       ENDIF
+
+       
+       !! 2.2 Calculate maintenance respiration coefficients (coeff_maint)
+       !      Maintenance respiration is a fraction of biomass defined by the coefficient 
+       !      coeff_maint [Mc Cree, 1969]. Coeff_maint is defined through a linear relationship of temperature [Ruimy et al, 1996]
+       !      which slope is the coefficient 'slope' and which intercept is 'coeff_maint_zero'.
+       !     - Coeff_maint_zero is defined in defined in stomate_constants.f90 (cm_zero_plantpartname)
+       !     - Slope is calculated here through a second-degree polynomial [Krinner et al, 2005] 
+       !    equation that makes it dependent on the long term temperature (to represent adaptation
+       !    of the ecosystem to long term temperature).
+       !         \latexonly
+       !           \input{resp3.tex} 
+       !         \endlatexonly
+       !        Where, maint_resp_slope1, maint_resp_slope2, maint_resp_slope3 are constant in stomate_constants.f90.
+       !        Then coeff_maint is calculated as follows:\n
+       !         \latexonly
+       !           \input{resp4.tex} 
+       !         \endlatexonly
+       ! If the calculation result is negative, coeff_maint will take the value 0.\n	
+       tl(:) = tlong_ref(:) - ZeroCelsius
+       slope(:) = maint_resp_slope(j,1) + tl(:) * maint_resp_slope(j,2) + &
+            tl(:)*tl(:) * maint_resp_slope(j,3)
+
+       DO k = 1, nparts ! Loop over # plant parts
+
+          coeff_maint(:,j,k) = &
+               MAX( (coeff_maint_zero(j,k)*dt/one_day) * &
+               ( un + slope(:) * (t_maint_radia(:,k)-ZeroCelsius) ), zero )
+
+       ENDDO ! Loop over # plant parts
+
+    ENDDO ! Loop over # PFTs
+    
+ !! 3. Calculate maintenance respiration
+
+    ! The maintenance respiration @tex $(gC.m^{-2}dt^{-1})$ @endtex of each plant compartment for each PFT is 
+    ! the biomass @tex $(gC.m^{-2})$ @endtex of the plant part multiplied by maintenance respiration 
+    ! coefficient @tex $(g.g^{-1}dt^{-1})$ @endtex, except that the maintenance respiration of leaves is 
+    ! corrected by leaf area index (LAI) as follows:\n
+    ! \latexonly     
+    !   \input{resp5.tex} 
+    ! \endlatexonly
+
+    ! ibare_sechiba = 1, which means the there is only bare soil but not any PFT, consequently no LAI and
+    !  maintenance respiration
+    lai(:,ibare_sechiba) = zero
+    resp_maint_part_radia(:,ibare_sechiba,:) = zero
+    
+    DO j = 2,nvm ! Loop over # PFTs
+       
+       ! 3.1 Maintenance respiration of the different plant parts
+       lai(:,j) = biomass(:,j,ileaf,icarbon) * sla(j)
+
+       DO k = 1, nparts ! Loop over # plant parts
+
+          IF ( k .EQ. ileaf ) THEN
+
+             ! Leaves: respiration depends on leaf mass AND LAI.
+!!$                WHERE ( (biomass(:,j,ileaf) > min_stomate) .AND. (lai(:,j) > 0.0) .AND. (lai(:,j) < val_exp) )
+!!$                resp_maint_part_radia(:,j,k) = coeff_maint(:,j,k) * biomass(:,j,k) * &
+!!$                        ( .3*lai(:,j) + 1.4*(1.-exp(-.5*lai(:,j))) ) / lai(:,j)
+!!$             ELSEWHERE
+!!$                resp_maint_part_radia(:,j,k) = 0.0
+!!$             ENDWHERE
+             DO i = 1, npts ! Loop over # pixels
+                IF ( (biomass(i,j,ileaf,icarbon) > min_stomate) .AND. (lai(i,j) > min_stomate) ) THEN
+
+!$                         IF (lai(i,j) < 100._r_std) THEN
+!$                            resp_maint_part_radia(i,j,k) = coeff_maint(i,j,k) * biomass(i,j,k,icarbon) * &
+!$                                 ( .3*lai(i,j) + 1.4*(1.-exp(-.5*lai(i,j))) ) / lai(i,j)
+!$                         ELSE
+!$                            resp_maint_part_radia(i,j,k) = coeff_maint(i,j,k) * biomass(i,j,k,icarbon) * &
+!$                                 ( .3*lai(i,j) + 1.4 ) / lai(i,j)
+!$                         ENDIF
+
+                   ! Maintenance respiration is calculated as a fraction of biomass as defined by coeff_maint and 
+                   ! is adjusted for the nitrogen effect through a third factor depending on LAI. The hypothesis 
+                   ! here is that the vcmax (i.e. the nitrogen distribution) in the canopy decreases exponentially 
+                   ! with LAI following the Beer-Lambert law with an asymptote defining the minimum of the function
+                   ! at 30% of the LAI. The 1.4 parameter is an integration constant.
+                   ! This method is also used in diffuco_trans_co2 2.4.1 for scaling vmax based on nitrogen reduction 
+                   ! in the canopy.
+
+                   resp_maint_part_radia(i,j,k) = coeff_maint(i,j,k) * biomass(i,j,k,icarbon) * &
+                        ( maint_resp_min_vmax*lai(i,j) + maint_resp_coeff*(un - exp(-ext_coeff(j)*lai(i,j))) ) / lai(i,j)
+                ELSE
+                   resp_maint_part_radia(i,j,k) = zero
+                ENDIF
+             ENDDO ! Loop over # pixels
+          ELSE
+
+             resp_maint_part_radia(:,j,k) = coeff_maint(:,j,k) * biomass(:,j,k,icarbon)
+
+          ENDIF
+
+       ENDDO ! Loop over # plant parts
+
+       ! 3.2 Total maintenance respiration of the plant
+       !     VPP killer:
+       !     resp_maint(:,j) = SUM( resp_maint_part(:,:), DIM=2 )
+
+    ENDDO ! Loop over # PFTs
+
+!    IF (bavard.GE.4) WRITE(numout,*) 'Leaving maintenance respiration'	
+
+  END SUBROUTINE maint_respiration
+
+END MODULE stomate_resp
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_season.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_season.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_season.f90	(revision 5166)
@@ -0,0 +1,1458 @@
+! =================================================================================================================================
+! MODULE        : stomate_season
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module calculates long-term meteorological parameters from daily temperatures
+!! and precipitations (essentially for phenology). 
+!!      
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN          :
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ =================================================================================================================================
+
+MODULE stomate_season
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters 
+  USE solar
+  USE grid
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC season,season_clear
+
+  LOGICAL, SAVE                                          :: firstcall = .TRUE.  !! first call (true/false)
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : season_clear
+!!
+!>\BRIEF          Flag setting 
+!!
+!! DESCRIPTION  : This subroutine sets flags ::firstcall, to .TRUE., and therefore activates   
+!!                section 1.1 of the ::season subroutine which writes messages to the output. \n
+!!                This subroutine is called at the end of the subroutine ::stomate_clear, in the 
+!!                module ::stomate.
+!!
+!! RECENT CHANGE(S):None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::firstcall
+!!
+!! REFERENCE(S)  : None 
+!!
+!! FLOWCHART     : None
+!! \n             
+!_ =================================================================================================================================
+
+  SUBROUTINE season_clear
+    firstcall=.TRUE.
+  END SUBROUTINE season_clear
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : season
+!!
+!>\BRIEF          This subroutine calculates many of the long-term biometeorological variables
+!!                needed in the phenology subroutines and in the calculation of long-term vegetation
+!!                dynamics in the LPJ DGVM. 
+!!
+!! DESCRIPTION    This subroutine is called by the module ::stomate before LPJ, and mainly deals  
+!!                with the calculation of long-term meteorological variables, carbon fluxes and 
+!!                vegetation-related variables that are used to calculate vegetation dynamics 
+!!                in the stomate modules relating to the phenology and to the longer-term 
+!!                changes in vegetation type and fractional cover in the LPJ DGVM modules. \n
+!!                In sections 2 to 5, longer-term meteorological variables are calculated. The
+!!                long-term moisture availabilities are used in the leaf onset and senescence
+!!                phenological models ::stomate_phenology and ::stomate_turnover that require
+!!                a moisture condition. The long term temperatures are also required for phenology
+!!                but in addition they are used in calculations of C flux and the presence and
+!!                establishment of vegetation patterns on a longer timescale in the LPJ DGVM modules.
+!!                Finally the monthly soil humidity/relative soil moisture is used in the C
+!!                allocation module ::stomate_alloc. \n
+!!                Sections 12 to 14 also calculate long-term variables of C fluxes, including NPP,
+!!                turnover and GPP. The first two are used to calculate long-term vegetation 
+!!                dynamics and land cover change in the LPJ DVGM modules. The weekly GPP is used
+!!                to determine the dormancy onset and time-length, as described below. \n
+!!                The long-term variables described above are are used in certain vegetation
+!!                dynamics processes in order to maintain consistency with the basic hypotheses of the 
+!!                parameterisations of LPJ, which operates on a one year time step (Krinner et al., 2005).
+!!                In order to reduce the computer memory requirements, short-term variables (e.g. daily
+!!                temperatures) are not stored for averaging over a longer period. Instead
+!!                the long-term variables (e.g. monthly temperature) are calculated at each time step
+!!                using a linear relaxation method, following the equation:
+!!                \latexonly
+!!                \input{season_lin_relax_eqn1.tex}
+!!                \endlatexonly
+!!                \n 
+!!                The long-term variables are therefore updated on a daily basis. This method allows for 
+!!                smooth temporal variation of the long-term variables which are used to calculate 
+!!                vegetation dynamics (Krinner et al., 2005). \n
+!!                Sections 6 to 11 calculate the variables required for to determine leaf onset in
+!!                the module ::stomate_phenology. 
+!!                These include :
+!!                - the dormance onset and time-length, when GPP is below a certain threshold \n
+!!                - the growing degree days (GDD), which is the sum of daily temperatures greater than
+!!                -5 degrees C, either since the onset of the dormancy period, or since midwinter \n
+!!                - the number of chilling days, which is the number of days with a daily temperature
+!!                lower than a PFT-dependent threshold since the beginning of the dormancy period \n
+!!                - the number of growing days, which is the the number of days with a temperature
+!!                greater than -5 degrees C since the onset of the dormancy period \n
+!!                - the time since the minimum moisture availability in the dormancy period. \n
+!!                These variables are used to determine the conditions needed for the start of the
+!!                leaf growing season. The specific models to which they correspond are given below. \n
+!!                Sections 15 to 20 are used to update the maximum/minimum or the sum of various 
+!!                meteorological and biological variables during the year that are required for
+!!                calculating either leaf onset or longer-term vegetation dynamics the following year. \n
+!!                At the end of the year, these variables are updated from "thisyear" to "lastyear", 
+!!                in Section 21 of this subroutine, for use the following year. \n
+!!                Finally the probably amount of herbivore consumption is calculated in Section 22,
+!!                following McNaughton et al. (1989).
+!!
+!! RECENT CHANGE(S): None
+!!                
+!! MAIN OUTPUT VARIABLE(S): :: herbivores,
+!!                        :: maxmoiavail_lastyear, :: maxmoiavail_thisyear, 
+!!                        :: minmoiavail_lastyear, :: minmoiavail_thisyear, 
+!!                        :: maxgppweek_lastyear, :: maxgppweek_thisyear, 
+!!                        :: gdd0_lastyear, :: gdd0_thisyear, 
+!!                        :: precip_lastyear, :: precip_thisyear, 
+!!                        :: lm_lastyearmax, :: lm_thisyearmax, 
+!!                        :: maxfpc_lastyear, :: maxfpc_thisyear, 
+!!                        :: moiavail_month, :: moiavail_week, 
+!!                        :: t2m_longterm, :: tlong_ref, :: t2m_month, :: t2m_week, 
+!!                        :: tsoil_month, :: soilhum_month, 
+!!                        :: npp_longterm, :: turnover_longterm, :: gpp_week, 
+!!                        :: gdd_m5_dormance, :: gdd_midwinter, 
+!!                        :: ncd_dormance, :: ngd_minus5, :: time_lowgpp, 
+!!                        :: time_hum_min, :: hum_min_dormance 
+!!      
+!! REFERENCES   : 
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199.
+!! - McNaughton, S.J., M. Oesterheld, D.A. Frank and K.J. Williams (1989), 
+!! Ecosystem-level patterns of primary productivity and herbivory in terrestrial
+!! habitats, Nature, 341, 142-144.
+!!                       
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale = 1]{season_flowchart_part1.png}
+!! \includegraphics[scale = 1]{season_flowchart_part2.png}
+!! \includegraphics[scale = 1]{season_flowchart_part3.png}
+!! \endlatexonly
+!! \n   
+!_ =================================================================================================================================
+
+  SUBROUTINE season (npts, dt, EndOfYear, veget, veget_max, &
+       moiavail_daily, t2m_daily, tsoil_daily, soilhum_daily, lalo,  &
+       precip_daily, npp_daily, biomass, turnover_daily, gpp_daily, when_growthinit, &
+       maxmoiavail_lastyear, maxmoiavail_thisyear, &
+       minmoiavail_lastyear, minmoiavail_thisyear, &
+       maxgppweek_lastyear, maxgppweek_thisyear, &
+       gdd0_lastyear, gdd0_thisyear, &
+       precip_lastyear, precip_thisyear, &
+       lm_lastyearmax, lm_thisyearmax, &
+       maxfpc_lastyear, maxfpc_thisyear, &
+       moiavail_month, moiavail_week, t2m_longterm, tlong_ref, t2m_month, t2m_week, &
+       tsoil_month, soilhum_month, &
+       npp_longterm, turnover_longterm, gpp_week, &
+       gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
+       time_hum_min, hum_min_dormance, gdd_init_date , & 
+       gdd_from_growthinit, herbivores)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                             :: npts              !! Domain size - number of grid cells (unitless)
+    REAL(r_std), INTENT(in)                                :: dt                !! time step in days (dt_days)
+    LOGICAL, INTENT(in)                                    :: EndOfYear         !! update yearly variables? (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget             !! coverage fraction of a PFT. Here: fraction of 
+                                                                                !! total ground. (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget_max         !! "maximal" coverage fraction of a PFT (for LAI -> 
+                                                                                !! infinity) (0-1, unitless)Here: fraction of 
+                                                                                !! total ground. 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: moiavail_daily    !! Daily moisture availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: t2m_daily         !! Daily 2 meter temperature (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)          :: tsoil_daily       !! Daily soil temperature (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)          :: soilhum_daily     !! Daily soil humidity (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)             :: lalo              !!  array of lat/lon
+    REAL(r_std), DIMENSION(npts), INTENT(in)               :: precip_daily      !! Daily mean precipitation @tex ($mm day^{-1}$) 
+                                                                                !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: npp_daily         !! daily net primary productivity @tex ($gC m^{-2} 
+                                                                                !! day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: biomass     !! biomass @tex ($gC m^{-2} of ground$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover_daily  !! Turnover rates @tex ($gC m^{-2} day^{-1}$) 
+                                                                                !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: gpp_daily         !! daily gross primary productivity  
+                                                                                !! (Here: @tex $gC m^{-2} of total ground 
+                                                                                !! day^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: when_growthinit   !! how many days ago was the beginning of the 
+                                                                                !! growing season (days) 
+
+    !
+    !! 0.2 Output variables 
+    ! (diagnostic)
+    !
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)          :: herbivores        !! time constant of probability of a leaf to be 
+                                                                                !! eaten by a herbivore (days) 
+
+    !
+    !! 0.3 Modified variables
+    !
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxmoiavail_lastyear      !! last year's maximum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxmoiavail_thisyear      !! this year's maximum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: minmoiavail_lastyear      !! last year's minimum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: minmoiavail_thisyear      !! this year's minimum moisture 
+                                                                                        !! availability (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxgppweek_lastyear       !! last year's maximum weekly GPP 
+                                                                                        !! @tex ($gC m^{-2} week^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxgppweek_thisyear       !! this year's maximum weekly GPP 
+                                                                                        !! @tex ($gC m^{-2} week^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: gdd0_lastyear             !! last year's annual GDD0 (C)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: gdd0_thisyear             !! this year's annual GDD0 (C)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: precip_lastyear           !! last year's annual precipitation 
+                                                                                        !! @tex ($mm year^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: precip_thisyear           !! this year's annual precipitation 
+                                                                                        !! @tex ($mm year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: lm_lastyearmax            !! last year's maximum leaf mass, for each 
+                                                                                        !! PFT @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: lm_thisyearmax            !! this year's maximum leaf mass, for each 
+                                                                                        !! PFT @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxfpc_lastyear           !! last year's maximum fpc for each PFT, on 
+                                                                                        !! ground (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: maxfpc_thisyear           !! this year's maximum fpc for each PFT, on 
+                                                                                        !! ground (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: moiavail_month            !! "monthly" moisture availability 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: moiavail_week             !! "weekly" moisture availability 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: t2m_longterm              !! "long term" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: tlong_ref                 !! "long term" reference 2-meter 
+                                                                                        !! temperatures (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: t2m_month                 !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(inout)            :: t2m_week                  !! "weekly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(inout)       :: tsoil_month               !! "monthly" soil temperatures (K)
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(inout)       :: soilhum_month             !! "monthly" soil humidity (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: npp_longterm              !! "long term" net primary productivity 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: turnover_longterm !! "long term" turnover rate 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gpp_week                  !! "weekly" GPP @tex ($gC m^{-2} day^{-1}$) 
+                                                                                        !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gdd_m5_dormance           !! growing degree days above threshold -5 
+                                                                                        !! deg. C (C) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gdd_midwinter             !! growing degree days since midwinter (C)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: ncd_dormance              !! number of chilling days since leaves 
+                                                                                        !! were lost (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: ngd_minus5                !! number of growing days (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: time_hum_min              !! time elapsed since strongest moisture 
+                                                                                        !! availability (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: hum_min_dormance          !! minimum moisture during dormance 
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,2), INTENT(inout)          :: gdd_init_date             !! inital date for gdd count
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: gdd_from_growthinit       !! growing degree days, threshold 0 deg. C 
+                                                                                        !! since beginning of season
+
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                          :: j                        !! indices (unitless)
+    REAL(r_std)                                             :: ncd_max                  !! maximum ncd (to avoid floating point 
+                                                                                        !! underflows) (days) 
+    REAL(r_std), DIMENSION(npts)                            :: sumfpc_nat               !! sum of natural fpcs (0-1, unitless)
+                                                                                        !! [DISPENSABLE] 
+    REAL(r_std), DIMENSION(npts,nvm)                        :: weighttot                !! weight of biomass @tex ($gC m^{-2}$) 
+                                                                                        !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                        :: nlflong_nat              !! natural long-term leaf NPP 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                        :: green_age                !! residence time of green tissue (years)
+    REAL(r_std), DIMENSION(npts)                            :: consumption              !! herbivore consumption 
+                                                                                        !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts)                            :: fracnat                  !! fraction of each gridcell occupied by 
+                                                                                        !! natural vegetation (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                            :: solad                    !! maximal radation during current day 
+                                                                                        !! (clear sky condition)
+    REAL(r_std), DIMENSION(npts)                            :: solai                    !! maximal radation during current day
+                                                                                        !! (clear sky condition)
+    REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:)            :: cloud                    !! cloud fraction
+!$OMP THREADPRIVATE(cloud)
+
+!_ =================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering season'
+
+    !
+    !! 1. Initializations
+    !! 1.1 Calculate ::ncd_max - the maximum possible NCD (number of chilling days) as:
+    !!     \latexonly
+    !!     \input{season_ncdmax_eqn2.tex}
+    !!     \endlatexonly
+    !!     \n
+    !!     where one_year is 1 year in seconds (defined in ::constantes).
+    !
+    ncd_max = ncd_max_year * one_year
+
+    IF ( firstcall ) THEN
+
+       !
+       !! 1.2 first call - output message giving the setting of the ::gppfrac_dormance,
+       !!     ::hvc1, ::hvc2 and ::leaf_frac (as a percentage) parameters which are 
+       !!     defined at the beginning of this subroutine. Also outputs the value of 
+       !!     ::ncd_max.
+       !
+
+       IF ( bavard .GE. 1 ) THEN
+
+          WRITE(numout,*) 'season: '
+
+          WRITE(numout,*) '   > maximum GPP/GGP_max ratio for dormance (::gppfrac_dormance) :',gppfrac_dormance !*
+
+          WRITE(numout,*) '   > maximum possible ncd(days) (::ncd_max) : ',ncd_max !*
+
+          WRITE(numout,*) '   > herbivore consumption C (gC/m2/d) as a function of NPP (gC/m2/d): (::hvc1) (::hvc2)' !*
+          WRITE(numout,*) '     C=',hvc1,' * NPP^',hvc2
+          WRITE(numout,*) '   > for herbivores, suppose that (::leaf_frac_hvc)',leaf_frac_hvc*100., &
+               '% of NPP is allocated to leaves'
+
+       ENDIF
+
+       !
+       !! 1.3 Check whether longer-term meteorological and phenology-related variables are not initialized
+       !!     to less than zero. If the following meteorological variables are less than ::min_stomate which is set 
+       !!     to 1.E-8 in ::grid, then they are set to the current daily value. If the phenology-
+       !!     related variables are less than ::min_stomate, they are set to "undef". 
+       !!     Warning messages are output in each case, and are also output if "long-term" C fluxes GPP,
+       !!     NPP and turnover are less than ::min_stomate.
+       !
+
+       !! 1.3.1 moisture availabilities (i.e. relative soil moisture, including the root soil profile):
+
+       !! 1.3.1.1 "monthly" (::moiavail_month)
+       !MM PAS PARALLELISE!!
+       IF ( ABS( SUM( moiavail_month(:,2:nvm) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them it today's moisture availability
+          WRITE(numout,*) 'Warning! We have to initialize the ''monthly'' moisture availabilities. '
+          moiavail_month(:,:) = moiavail_daily(:,:)
+
+       ENDIF
+
+       !! 1.3.1.2 "weekly" (::moiavail_week)
+
+       IF ( ABS( SUM( moiavail_week(:,2:nvm) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them it today's moisture availability
+          WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' moisture availabilities. '
+          moiavail_week(:,:) = moiavail_daily(:,:)
+
+       ENDIF
+
+       !! 1.3.2 2-meter temperatures:
+
+       !! 1.3.2.1 "long term" (::t2m_longterm)
+
+       IF ( ABS( SUM( t2m_longterm(:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's temperature
+          WRITE(numout,*) 'Warning! We have to initialize the ''long term'' 2m temperatures.'
+          t2m_longterm(:) = t2m_daily(:)
+
+       ENDIF
+
+       !! 1.3.2.2 "monthly" (::t2m_month)
+
+       IF ( ABS( SUM( t2m_month(:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's temperature
+          WRITE(numout,*) 'Warning! We have to initialize the ''monthly'' 2m temperatures.'
+          t2m_month(:) = t2m_daily(:)
+
+       ENDIF
+
+       !! 1.3.2.3 "weekly" (::2m_week)
+
+       IF ( ABS( SUM( t2m_week(:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's temperature
+          WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' 2m temperatures.'
+          t2m_week(:) = t2m_daily(:)
+
+       ENDIF
+
+       !! 1.3.3 "monthly" soil temperatures (::tsoil_month):
+       !MM PAS PARALLELISE!!
+       IF ( ABS( SUM( tsoil_month(:,:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's temperature
+          WRITE(numout,*) 'Warning!'// &
+               ' We have to initialize the ''monthly'' soil temperatures.'
+          tsoil_month(:,:) = tsoil_daily(:,:)
+
+       ENDIF
+
+       !! 1.3.4 "monthly" soil humidity (::soilhum_month):
+       IF ( ABS( SUM( soilhum_month(:,:) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to today's humidity
+          WRITE(numout,*) 'Warning!'// &
+               ' We have to initialize the ''monthly'' soil humidity.'
+          soilhum_month(:,:) = soilhum_daily(:,:)
+
+       ENDIF
+
+       !! 1.3.5 growing degree days, threshold -5 deg C (::gdd_m5_dormance):
+       IF ( ABS( SUM( gdd_m5_dormance(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Growing degree days (-5 deg) are initialized to ''undef''.'
+          gdd_m5_dormance(:,:) = undef
+       ENDIF
+
+       !! 1.3.6 growing degree days since midwinter (::gdd_midwinter):
+       IF ( ABS( SUM( gdd_midwinter(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Growing degree days since midwinter' // &
+               ' are initialized to ''undef''.'
+          gdd_midwinter(:,:) = undef
+       ENDIF
+
+       !! 1.3.7 number of chilling days since leaves were lost (::ncd_dormance):
+       IF ( ABS( SUM( ncd_dormance(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Number of chilling days is initialized to ''undef''.'
+          ncd_dormance(:,:) = undef
+       ENDIF
+
+       !! 1.3.8 number of growing days, threshold -5 deg C (::ngd_minus5):
+       IF ( ABS( SUM( ngd_minus5(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Number of growing days (-5 deg) is initialized to 0.'
+       ENDIF
+
+       !! 1.3.9 "long term" npp (::npp_longterm):
+       IF ( ABS( SUM( npp_longterm(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Long term NPP is initialized to 0.'
+       ENDIF
+
+       !! 1.3.10 "long term" turnover (::turnover_longterm):
+       IF ( ABS( SUM( turnover_longterm(:,2:nvm,:,:) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Long term turnover is initialized to 0.'
+       ENDIF
+
+       !! 1.3.11 "weekly" GPP (::gpp_week):
+       IF ( ABS( SUM( gpp_week(:,2:nvm) ) ) .LT. min_stomate ) THEN
+          WRITE(numout,*) 'Warning! Weekly GPP is initialized to 0.'
+       ENDIF
+
+       !! 1.3.12 minimum moisture availabilities (::minmoiavail_thisyear)
+       !!        In this case, if the minimum moisture
+       !!        is less than ::min_stomate, the variable is set to ::large_value,
+       !!        which is defined in ::stomate_constants as 1.E33_r_std:
+       IF ( ABS( SUM( minmoiavail_thisyear(:,2:nvm) ) ) .LT. min_stomate ) THEN
+
+          ! in this case, set them to a very high value
+          WRITE(numout,*) 'Warning! We have to initialize this year''s minimum '// &
+               'moisture availabilities.'
+          minmoiavail_thisyear(:,:) = large_value
+
+       ENDIF
+
+       ALLOCATE(cloud(npts))
+       cloud(:) = zero
+       !
+       !! 1.4 reset firstcall flag
+       !
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+    ! determine min yearly clear sky radiation (solstice) as beginning for gdd count
+    CALL downward_solar_flux (npts, lalo(:,1),calendar_str,julian_diff,12.,cloud,1,solad,solai)
+
+    WHERE (solad(:) .LT. gdd_init_date(:,2))
+       gdd_init_date(:,1)= julian_diff
+       gdd_init_date(:,2)= solad(:)
+    ENDWHERE
+
+
+    !
+    !! NOTE: Sections 2. to 5. compute slowly-varying, "long-term" (i.e. weekly/monthly)
+    !! input variables using a linear relaxation method, following the equation:
+    !! \latexonly
+    !! \input{season_lin_relax_eqn1.tex}
+    !! \endlatexonly
+    !! \n 
+    !! as described in the introduction to this subroutine (see Krinner et al., 2005).  
+    !! The time constant in the above equation is given for each of the variables
+    !! described.
+    !
+
+    !
+    !! 2. Moisture availability (relative soil moisture, including the root profile) :
+    !!    The time constants (as in the above equation) for these calculations are 
+    !!    given by the parameters ::tau_hum_month (for the monthly
+    !!    calculation) or ::tau_hum_week (for the weekly),
+    !!    which are set in ::stomate_data to be 20 and 7 days respectively.
+    !!    If the moisture availability is less than zero, it is set to zero. 
+    !!    These variables are mostly used in the phenological leaf onset and senescence
+    !!    models in the modules ::stomate_phenology and ::stomate_turnover, 
+    !!    respectively. They are used in models which require a moisture limitation
+    !!    condition. These are the 'hum', 'moi', 'humgdd' and 'moigdd' onset models,
+    !!    and the 'mixed' and 'dry' (weekly only) senescence models. In addition,
+    !!    the weekly moisture availability is used to calculate the limitation
+    !!    on the fraction of NPP allocated to different compartments in the module
+    !!    ::stomate_alloc. 
+    !
+
+    !
+    !! 2.1 "monthly" (::moiavail_month)
+    !
+
+    moiavail_month = ( moiavail_month * ( tau_hum_month - dt ) + &
+         moiavail_daily * dt ) / tau_hum_month
+
+    DO j = 2,nvm  ! Loop over # PFTs
+       WHERE ( ABS(moiavail_month(:,j)) .LT. EPSILON(zero) )
+          moiavail_month(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 2.2 "weekly" (::moiavail_week)
+    !
+
+    moiavail_week = ( moiavail_week * ( tau_hum_week - dt ) + &
+         moiavail_daily * dt ) / tau_hum_week
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(moiavail_week(:,j)) .LT. EPSILON(zero) ) 
+          moiavail_week(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 3. 2-meter temperatures
+    !!    The time constants for the "long-term", "monthly" and "weekly" 2-meter
+    !!    temperatures are given by the parameters ::tau_longterm, 
+    !!    ::tau_t2m_month, and ::tau_t2m_week,
+    !!    which are set in ::stomate_data to be 3 * one year (in seconds, as 
+    !!    described above) and 20 and 7 days respectively.
+    !!    If the temperature is less than zero, it is set to zero.
+    !!    In addition the "long term" temperature is written to the history file. \n
+    !!    These variables are used in many different modules of STOMATE. The 
+    !!    "long-term" temperature is used to calculate the long-term reference
+    !!    temperature which is used in many modules as described below. 
+    !!    The "monthly" and "weekly" temperature is used in the modules 
+    !!    ::stomate_phenology and ::stomate_turnover for the onset and senescence 
+    !!    phenological models which require a temperature condition. In addition
+    !!    the "monthly" temperature is used in ::lpj_constraints to determine 
+    !!    the presence and regeneration of the vegetation and in the module
+    !!    ::stomate_assimtemp to calculate photosynthesis temperatures.
+    !
+    
+    !
+    !! 3.1 "long-term" (::t2m_longterm) 
+    !
+
+    t2m_longterm = ( t2m_longterm * ( tau_longterm - dt ) + &
+         t2m_daily * dt ) / tau_longterm
+
+    WHERE ( ABS(t2m_longterm(:)) .LT. EPSILON(zero) ) 
+       t2m_longterm(:) = zero
+    ENDWHERE
+
+    CALL histwrite_p (hist_id_stomate, 'T2M_LONGTERM', itime, &
+         t2m_longterm, npts, hori_index)
+    !
+    !! 3.2 "long-term reference" (::tlong_ref) 
+    !!      This variable is calculated using the "long term" 2-meter temperature 
+    !!      (::t2m_longerm) using the equation:
+    !!      \latexonly
+    !!      \input{season_t2m_long_ref_eqn3.tex}
+    !!      \endlatexonly
+    !!      \n
+    !!      This temperature is used for re-calculating PFT-specific variables such as
+    !!      critical photosynthesis temperatures of critical GDDs for phenology. This
+    !!      means that if the reference temperature varies, the PFTs adapt to them.
+    !!      Therefore the reference temperature can vary only if the vegetation is not
+    !!      static, i.e. if the LPJ-DVM is used. It is also used in many STOMATE modules,
+    !!      including ::stomate_npp, ::stomate_resp, ::stomate_phenology, 
+    !!      and ::stomate_turnover.  
+    !
+
+!!$    IF (control%ok_dgvm) THEN
+    tlong_ref(:) = MAX( tlong_ref_min, MIN( tlong_ref_max, t2m_longterm(:) ) )
+!!$    ENDIF
+    !
+    !! 3.3 "monthly" (::t2m_month)
+    !
+
+    t2m_month = ( t2m_month * ( tau_t2m_month - dt ) + &
+         t2m_daily * dt ) / tau_t2m_month
+
+    WHERE ( ABS(t2m_month(:)) .LT. EPSILON(zero) )
+       t2m_month(:) = zero
+    ENDWHERE
+
+    !
+    !! 3.4 "weekly" (::t2m_week)
+    !
+
+    t2m_week = ( t2m_week * ( tau_t2m_week - dt ) + &
+         t2m_daily * dt ) / tau_t2m_week
+
+    WHERE ( ABS(t2m_week(:)) .LT. EPSILON(zero) )
+       t2m_week(:) = zero
+    ENDWHERE
+
+    !
+    !! 4. "monthly" soil temperatures (::tsoil_month)
+    !!    The time constant is given by the parameter ::tau_tsoil_month, 
+    !!    which is set in ::stomate_data to be 20 days.
+    !!    If the monthly soil temperature is less than zero, it is set to zero. \n
+    !!    This variable is used in the ::stomate_allocation module.
+    !
+
+    tsoil_month = ( tsoil_month * ( tau_tsoil_month - dt ) + &
+         tsoil_daily(:,:) * dt ) / tau_tsoil_month
+
+    WHERE ( ABS(tsoil_month(:,:)) .LT. EPSILON(zero) )
+       tsoil_month(:,:) = zero
+    ENDWHERE
+
+    !
+    !! 5. ''monthly'' soil humidity (or relative soil moisture - ::soilhum_month) 
+    !!    The time constant is given by the parameter ::tau_soilhum_month, 
+    !!    which is set in ::stomate_data to be 20 days.
+    !!    If the monthly soil humidity is less than zero, it is set to zero.
+    !
+
+    soilhum_month = ( soilhum_month * ( tau_soilhum_month - dt ) + &
+         soilhum_daily * dt ) / tau_soilhum_month
+
+    WHERE ( ABS(soilhum_month(:,:)) .LT. EPSILON(zero) )
+       soilhum_month(:,:) = zero
+    ENDWHERE
+
+    !
+    !! 6. Calculate the dormance time-length (::time_lowgpp).
+    !!    The dormancy time-length is increased by the stomate time step when   
+    !!    the weekly GPP is below one of two thresholds, 
+    !!    OR if the growing season started more than 2 years ago AND the amount of biomass
+    !!    in the carbohydrate reserve is 4 times as much as the leaf biomass.
+    !!    i.e. the plant is declared dormant if it is accumulating carbohydrates but not 
+    !!    using them, so that the beginning of the growing season can be detected .
+    !     This last condition was added by Nicolas Viovy.
+    !!    - NV: special case (3rd condition)
+    !!    Otherwise, set ::time_lowgpp to zero. \n
+    !!    The weekly GPP must be below either the parameter ::min_gpp_allowed, which is set at 
+    !!    the beginning of this subroutine to be 0.3gC/m^2/year, 
+    !!    OR it must be less than last year's maximum weekly GPP multiplied by the
+    !!    maximal ratio of GPP to maximum GPP (::gppfrac_dormance), which is set to 0.2 at the 
+    !!    beginning of this subroutine. \n
+    !!    This variable is used in the ::stomate_phenology module to allow the detection of the
+    !!    beginning of the vegetation growing season for different onset models.
+    !!    Each PFT is looped over.
+    !
+    !NVMODIF
+!!$    DO j = 2,nvm ! Loop over # PFTs
+!!$       WHERE ( ( gpp_week(:,j) .LT. min_gpp_allowed ) .OR. & 
+!!$            ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. &
+!!$            ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. &
+!!$            ( biomass(:,j,icarbres,icarbon) .GT. biomass(:,j,ileaf,icarbon)*4. ) ) )
+!!$          !       WHERE ( ( gpp_week(:,j) .EQ. zero ) .OR. & 
+!!$          !            ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. &
+!!$          !            ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. &
+!!$          !            ( biomass(:,j,icarbres,icarbon) .GT. biomass(:,j,ileaf,icarbon)*4. ) ) )
+!!$       
+!!$          time_lowgpp(:,j) = time_lowgpp(:,j) + dt
+!!$          
+!!$       ELSEWHERE
+!!$          
+!!$          time_lowgpp(:,j) = zero
+!!$
+!!$       ENDWHERE
+!!$    ENDDO
+
+    !
+    !! 7. Calculate the growing degree days (GDD - ::gdd_m5_dormance).
+    !!    This variable is the GDD sum of the temperatures higher than -5 degrees C.
+    !!    It is inititalised to 0 at the beginning of the dormancy period (i.e.
+    !!    when ::time_lowgpp>0), and is set to "undef" when there is GPP 
+    !!    (::time_lowgpp=0), as it is not used during the growing season. \n 
+    !!    ::gdd_m5_dormance is further scaled by (::tau_gdd -dt / ::tau_gdd), 
+    !!    - ::tau_gdd is set to 40. in the module ::stomate_constants. \n
+    !     Nicolas Viovy - not sure why this is...
+    !!    This variable is used in the ::stomate_phenology module for the 
+    !!    'humgdd' and 'moigdd' leaf onset models. \n
+    !!    Each PFT is looped over but ::gdd_m5_dormance is only calculated for 
+    !!    those PFTs for which a critical GDD is defined, i.e. those which are 
+    !!    assigned to the 'humgdd' or 'moigdd' models. \n
+    !!    Finally if GDD sum is less than zero, then it is set to zero. 
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF (.NOT. natural(j)) THEN
+          ! reset counter: start of the growing season
+          WHERE ((when_growthinit(:,j) .EQ. zero))
+	     gdd_from_growthinit(:,j) = zero
+	  ENDWHERE
+          ! increase gdd counter
+          WHERE ( t2m_daily(:) .GT. (ZeroCelsius)  )
+             gdd_from_growthinit(:,j) = gdd_from_growthinit(:,j) + &
+                                 dt * ( t2m_daily(:) - (ZeroCelsius) )
+          ENDWHERE
+       ELSE
+          gdd_from_growthinit(:,j) = undef
+       ENDIF
+
+       ! only for PFTs for which critical gdd is defined
+       ! gdd_m5_dormance is set to 0 at the end of the growing season. It is set to undef
+       ! at the beginning of the growing season.
+
+       IF ( ALL(pheno_gdd_crit(j,:) .NE. undef) ) THEN
+
+          !
+          !! 7.1 set to zero if undefined and there is no GPP
+          !
+
+          WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+
+             gdd_m5_dormance(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 7.2 set to undef if there is GPP
+          !
+
+          WHERE ( when_growthinit(:,j) .EQ. zero )
+
+             gdd_m5_dormance(:,j) = undef
+
+          ENDWHERE
+
+          !
+          !! 7.3 normal update as described above where ::gdd_m5_dormance is defined (not set to "undef").
+          !
+
+          WHERE ( ( t2m_daily(:) .GT. ( ZeroCelsius - gdd_threshold ) ) .AND. &
+               ( gdd_m5_dormance(:,j) .NE. undef )           )
+             gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) + &
+                  dt * ( t2m_daily(:) - ( ZeroCelsius - gdd_threshold ) )
+          ENDWHERE
+
+          WHERE ( gdd_m5_dormance(:,j) .NE. undef ) 
+             gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) * &
+                  ( tau_gdd - dt ) / tau_gdd
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 7.4 Set to zero if GDD is less than zero.
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(gdd_m5_dormance(:,j)) .LT. EPSILON(zero) )
+          gdd_m5_dormance(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 8. Calculate the growing degree days (GDD) since midwinter (::gdd_midwinter)
+    !!    This variable represents the GDD sum of temperatures higher than a PFT-dependent
+    !!    threshold (::ncdgdd_temp), since midwinter.
+    !!    Midwinter is detected if the monthly temperature (::t2m_month) is lower than the weekly 
+    !!    temperature (::t2m_week) AND if the monthly temperature is lower than the long-term 
+    !!    temperature (t2m_longterm). These variables were calculated earlier in this subroutine. \n
+    !!    ::gdd_midwinter is initialised to 0.0 when midwinter is detected, and from then on 
+    !!    increased with each temperature greater than ::ncdgdd_temp, which is defined
+    !!    in the module ::stomate_constants. \n
+    !!    ::gdd_midwinter is set to "undef" when midsummer is detected, following the opposite
+    !!    conditions to those used to define midwinter. \n
+    !!    The variable is used in the ::stomate_phenology module for the leaf onset model 'ncdgdd'.
+    !!    Each PFT is looped over but the ::gdd_midwinter is only calculated for those
+    !!    PFTs for which a critical 'ncdgdd' temperature is defined, i.e. those which are 
+    !!    assigned to the 'ncdgdd' model. \n
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       ! only for PFTs for which ncdgdd_crittemp is defined
+
+       IF ( ncdgdd_temp(j) .NE. undef ) THEN
+
+          !
+          !! 8.1 set to 0 if undef and if we detect "midwinter"
+          !
+
+!!$          WHERE ( ( gdd_midwinter(:,j) .EQ. undef ) .AND. &
+!!$               ( t2m_month(:) .LT. t2m_week(:) ) .AND. &
+!!$               ( t2m_month(:) .LT. t2m_longterm(:) )    )
+          WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+
+             gdd_midwinter(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 8.2 set to undef if we detect "midsummer"
+          !
+
+          WHERE ( ( t2m_month(:) .GT. t2m_week(:) ) .AND. &
+               ( t2m_month(:) .GT. t2m_longterm(:) )    )
+
+             gdd_midwinter(:,j) = undef
+
+          ENDWHERE
+
+          !
+          !! 8.3 normal update as described above
+          !
+
+          WHERE ( ( gdd_midwinter(:,j) .NE. undef ) .AND. &
+               ( t2m_daily(:) .GT. ncdgdd_temp(j)+ZeroCelsius ) )
+
+             gdd_midwinter(:,j) = &
+                  gdd_midwinter(:,j) + &
+                  dt * ( t2m_daily(:) - ( ncdgdd_temp(j)+ZeroCelsius ) )
+
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 9. Calculate the number of chilling days (NCD) since leaves were lost (::ncd_dormance).
+    !!    This variable is initialised to 0 at the beginning of the dormancy period (::time_lowgpp>0)
+    !!    and increased by the stomate time step when the daily temperature is lower than the 
+    !!    PFT-dependent threshold ::ncdgdd_temp, which is defined for each PFT 
+    !!    in a table (::ncdgdd_temp_tab) in the module ::stomate_data. \n
+    !!    It is set to "undef" when there is GPP (::time_lowgpp=0) as it is not needed during
+    !!    the growing season. \n
+    !!    The variable is used in the ::stomate_phenology module for the leaf onset model 'ncdgdd'.
+    !!    Each PFT is looped over but the ::ncd_dormance is only calculated for those
+    !!    PFTs for which a critical 'ncdgdd' temperature is defined, i.e. those which are 
+    !!    assigned to the 'ncdgdd' model.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( ncdgdd_temp(j) .NE. undef ) THEN
+
+          !
+          !! 9.1 set to zero if undefined and there is no GPP
+          !
+
+          WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+
+             ncd_dormance(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 9.2 set to undef if there is GPP
+          !
+
+          WHERE ( when_growthinit(:,j) .EQ. zero )
+
+             ncd_dormance(:,j) = undef
+
+          ENDWHERE
+
+          !
+          !! 9.3 normal update, as described above, where ::ncd_dormance is defined
+          !
+
+          WHERE ( ( ncd_dormance(:,j) .NE. undef ) .AND. &
+               ( t2m_daily(:) .LE. ncdgdd_temp(j)+ZeroCelsius ) )
+
+             ncd_dormance(:,j) = MIN( ncd_dormance(:,j) + dt, ncd_max )
+
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! 10. Calculate the number of growing days (NGD) since leaves were lost (::ngd_minus5).
+    !!     This variable is initialised to 0 at the beginning of the dormancy period (::time_lowgpp>0)
+    !!     and increased by the stomate time step when the daily temperature is higher than the threshold
+    !!     -5 degrees C. \n    
+    !!     ::ngd_minus5 is further scaled by (::tau_ngd -dt / ::tau_ngd), 
+    !!     - ::tau_ngd is set to 50. in the module ::stomate_constants. \n
+    !      Nicolas Viovy - not sure why this is...
+    !!     The variable is used in the ::stomate_phenology module for the leaf onset model 'ngd'.
+    !!     Each PFT is looped over.
+    !!     If the NGD is less than zero, it is set to zero.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !
+       !! 10.1 Where there is GPP (i.e. ::time_lowgpp=0), set NGD to 0. 
+       !!      This means that we only take into account NGDs when the leaves are off
+       !
+
+       WHERE (gdd_init_date(:,1) .EQ. julian_diff)
+          ngd_minus5(:,j) = zero
+       ENDWHERE
+
+       !
+       !! 10.2 normal update, as described above.
+       !
+
+       WHERE ( t2m_daily(:) .GT. (ZeroCelsius - gdd_threshold) )
+          ngd_minus5(:,j) = ngd_minus5(:,j) + dt
+       ENDWHERE
+
+       ngd_minus5(:,j) = ngd_minus5(:,j) * ( tau_ngd - dt ) / tau_ngd
+
+    ENDDO
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(ngd_minus5(:,j)) .LT. EPSILON(zero) )
+          ngd_minus5(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 11. Calculate the minimum humidity/relative soil moisture since dormance began (::hum_min_dormance) 
+    !!     and the time elapsed since this minimum (::time_hum_min). \n
+    !!     The minimum moisture availability occurs when the monthly moisture availability, which is updated 
+    !!     daily earlier in this subroutine as previously described, is at a minimum during the dormancy period.
+    !!     Therefore the ::hum_min_dormance is initialised to the monthly moisture availability 
+    !!     at the beginning of the dormancy period (i.e. if it was previously set to undefined and the
+    !!     ::time_lowgpp>0) AND then whenever the monthly moisture availability is less than it has previously
+    !!     been. \n
+    !!     Consequently, the time counter (::time_hum_min) is initialised to 0 at the beginning of the dormancy  
+    !!     period (i.e. if it was previously set to undefined and the ::time_lowgpp>0) AND when the minimum 
+    !!     moisture availability is reached, and is increased by the stomate time step every day throughout
+    !!     the dormancy period. \n
+    !!     ::time_hum_min is used in the ::stomate_phenology module for the leaf onset models 'moi' and 'moigdd'.
+    !!     Each PFT is looped over but the two variables are only calculated for those
+    !!     PFTs for which the critical parameter ::hum_min_time is defined, i.e.   
+    !!     those which are assigned to the 'moi' or 'moigdd' models.
+    !
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( hum_min_time(j) .NE. undef ) THEN
+
+          !
+          !! 11.1 initialize if undefined and there is no GPP
+          !
+
+          WHERE (when_growthinit(:,j) .EQ. zero)
+
+             time_hum_min(:,j) = zero
+             hum_min_dormance(:,j) = moiavail_month(:,j)
+
+          ENDWHERE
+
+          !
+          !! 11.3 normal update, as described above, where ::time_hum_min and ::hum_min_dormance are defined
+          !
+
+          !! 11.3.1 increase time counter by the stomate time step
+
+          WHERE ( hum_min_dormance(:,j) .NE. undef )
+
+             time_hum_min(:,j) = time_hum_min(:,j) + dt
+
+          ENDWHERE
+
+          !! 11.3.2 set time counter to zero if minimum is reached
+
+          WHERE (( hum_min_dormance(:,j) .NE. undef ) .AND. &
+               ( moiavail_month(:,j) .LE. hum_min_dormance(:,j) ) )
+
+             hum_min_dormance(:,j) = moiavail_month(:,j)
+             time_hum_min(:,j) = zero
+
+          ENDWHERE
+
+       ENDIF
+
+    ENDDO
+
+    !
+    !! NOTE: Sections 12. to 14. compute slowly-varying, "long-term" (i.e. weekly/monthly)
+    !! C fluxes (NPP, turnover, GPP) using the same linear relaxation method as in 
+    !! Sections 2. and 5. and described in the introduction to this section, as given 
+    !! by the following equation:
+    !! \latexonly
+    !! \input{season_lin_relax_eqn1.tex}
+    !! \endlatexonly
+    !! \n 
+    !! The following variables are calculated using the above equation, and the time constant 
+    !! is given for each. 
+    !
+
+    !
+    !! 12. Update the "long term" NPP. (::npp_daily in gC/m^2/day, ::npp_longterm in gC/m^2/year.)
+    !!     The time constant is given by the parameter ::tau_longterm, 
+    !!     which is set in ::stomate_data to be 3 * one year (in seconds, as 
+    !!     described above). If the ::npp_longterm is less than zero then set it to zero. \n
+    !!     ::npp_longterm is used in ::stomate_lpj in the calculation of long-term
+    !!     vegetation dynamics and in ::stomate_lcchange in the calculation of 
+    !!     land cover change. It is also used to calculate diagnose the hebivory activity in 
+    !!     Section 22 of this subroutine.
+    !
+
+    npp_longterm = ( npp_longterm * ( tau_longterm - dt ) + &
+         (npp_daily*one_year) * dt                          ) / &
+         tau_longterm
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(npp_longterm(:,j)) .LT. EPSILON(zero) )
+          npp_longterm(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 13. Update the "long term" turnover rates (in gC/m^2/year).
+    !!     The time constant is given by the parameter ::tau_longterm, 
+    !!     which is set in ::stomate_data to be 3 * one year (in seconds, as 
+    !!     described above). If the ::turnover_longterm is less than zero then set it to zero.\n
+    !!     ::turnover_longterm is used in ::stomate_lpj and :: lpg_gap in the calculation 
+    !!     of long-term vegetation dynamics.
+    !
+
+    turnover_longterm(:,:,:,:) = ( turnover_longterm(:,:,:,:) * ( tau_longterm - dt ) + &
+         (turnover_daily(:,:,:,:)*one_year) * dt                          ) / &
+         tau_longterm
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(turnover_longterm(:,j,:,:)) .LT. EPSILON(zero) )
+          turnover_longterm(:,j,:,:) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 14. Update the "weekly" GPP (where there is vegetation), otherwise set to zero.
+    !!     The time constant is given by the parameter ::tau_gpp_week, 
+    !!     which is set in ::stomate_data to be 7 days. If the ::gpp_week is 
+    !!     less than zero then set it to zero. \n
+    !!     ::gpp_week is used to update the annual maximum weekly GPP (::maxgppweek_thisyear)
+    !!     in Section 16 of this subroutine, which is then used to update the variable
+    !!     ::maxgppweek_lastyear in Section 21 of this subroutine. Both ::gpp_week and 
+    !!     ::maxgppweek_lastyear are used in Section 6 of this subroutine to calculate
+    !!     the onset and time-length of the dormancy period. 
+    !      Note: Used to be weekly GPP divided by veget_max, i.e. per ground covered, but not anymore.
+    !
+
+    WHERE ( veget_max .GT. zero )
+
+       gpp_week = ( gpp_week * ( tau_gpp_week - dt ) + &
+            gpp_daily * dt ) / tau_gpp_week
+
+    ELSEWHERE
+
+       gpp_week = zero
+
+    ENDWHERE
+
+    DO j = 2,nvm ! Loop over # PFTs
+       WHERE ( ABS(gpp_week(:,j)) .LT. EPSILON(zero) )
+          gpp_week(:,j) = zero
+       ENDWHERE
+    ENDDO
+
+    !
+    !! 15. Update the maximum and minimum moisture availabilities (::maxmoiavail_thisyear 
+    !!     and ::minmoiavail_thisyear). If the daily moisture availability, ::moiavail_daily,
+    !!     which was calculated earlier in this subroutine, is greater or less than the current
+    !!     value of the maximum or minimum moisture availability, then set the value for the maximum
+    !!     or minimum to the current daily value respectively. \n
+    !!     ::maxmoiavail_thisyear and ::minmoiavail_thisyear are used to update the variables 
+    !!     ::maxmoiavail_lastyear and ::minmoiavail_lastyear in Section 21 of this subroutine, 
+    !!     which are used in the module ::stomate_phenology for the leaf onset models 'hum' and 
+    !!     'humgdd', and in the module ::stomate_turnover for the leaf senescence models 'dry' 
+    !!     and 'mixed'.
+    !
+
+    WHERE ( moiavail_daily .GT. maxmoiavail_thisyear )
+       maxmoiavail_thisyear = moiavail_daily
+    ENDWHERE
+
+    WHERE ( moiavail_daily .LT. minmoiavail_thisyear )
+       minmoiavail_thisyear = moiavail_daily
+    ENDWHERE
+
+    !
+    !! 16. Update the annual maximum weekly GPP (::maxgppweek_thisyear), if the weekly GPP
+    !!     is greater than the current value of the annual maximum weekly GPP.
+    !!     The use of this variable is described in Section 14.
+    !
+
+    WHERE ( gpp_week .GT. maxgppweek_thisyear )
+       maxgppweek_thisyear = gpp_week
+    ENDWHERE
+
+    !
+    !! 17. Update the annual GDD0 by adding the current daily 2-meter temperature 
+    !!     (multiplied by the stomate time step, which is one day), if it is greater
+    !!     than zero degrees C. \n
+    !!     This variable is mostly used in the module ::lpj_establish.
+    !
+
+    WHERE ( t2m_daily .GT. ZeroCelsius )
+       gdd0_thisyear = gdd0_thisyear + dt * ( t2m_daily - ZeroCelsius )
+    ENDWHERE
+
+    !
+    !! 18. Update the annual precipitation by adding the current daily precipitation
+    !!     amount (multiplied by the stomate time step, which is usually one day). \n
+    !
+
+    precip_thisyear = precip_thisyear + dt * precip_daily
+
+    
+!
+    !! 19. Update the annual maximum leaf mass for each PFT (::lm_thisyearmax) and the maximum fractional
+    !!     plant cover if the LPJ DGVM is activated.       
+    !
+    
+    !
+    !! 19.1 If the LPJ DGVM is activated first the fraction of natural vegetation (::fracnat), i.e. non-
+    !!      agricultural vegetation (PFTs 2-11) is calculated for each PFT. Each PFT is looped over.
+    !
+    IF(control%ok_dgvm ) THEN
+
+       fracnat(:) = un
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( .NOT. natural(j) ) THEN
+             fracnat(:) = fracnat(:) - veget_max(:,j)
+          ENDIF
+       ENDDO
+
+    ENDIF
+
+    !
+    !! 19.2 If LPJ and STOMATE are activated, first the maximum fractional plant cover needs to be updated, 
+    !!      and then this year's leaf biomass. Each PFT is looped over.
+    !!      Both are updated according to the linear relaxation method described above. 
+    !!      \latexonly
+    !!      \input{season_lin_relax_eqn1.tex}
+    !!      \endlatexonly
+    !!      \n
+    !!      The time constant for this process is set as one year (in seconds) divided by the parameter
+    !!      ::leaflife_tab, which gives the leaf lifetime in years and is set for each PFT in the module 
+    !!      ::stomate_constants. Each PFT is looped over. \n
+    !
+
+    IF ( control%ok_stomate ) THEN
+       IF(control%ok_dgvm ) THEN
+          DO j=2,nvm ! Loop over # PFTs
+
+             !
+             !! 19.2.1 Calculate maximum fractional plant cover (::maxfpc_lastyear).
+             !!        If natural vegetation is present in the grid cell, and the leaf
+             !!        biomass is greater than three-quarters of last year's leaf biomass, the maximum fractional plant
+             !!        cover for last year is updated. \n 
+             !!        The short-term variable (Xs in the above equation) that is being used to update the long-term 
+             !!        maximum fractional plant cover is the fractional cover of natural vegetation, specified as 
+             !!        ::veget/::fracnat. Last year's value is then set to be this year's value.
+             !
+
+             IF ( natural(j) .AND. control%ok_dgvm ) THEN
+
+                WHERE ( fracnat(:) .GT. min_stomate .AND. biomass(:,j,ileaf,icarbon).GT. lm_lastyearmax(:,j)*0.75 )
+                   maxfpc_lastyear(:,j) = ( maxfpc_lastyear(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
+                        veget(:,j) / fracnat(:) * dt ) / (one_year/leaflife_tab(j))
+                ENDWHERE
+                maxfpc_thisyear(:,j) = maxfpc_lastyear(:,j) ! just to initialise value
+
+             ENDIF
+
+!NV : correct initialization
+!!$             WHERE(biomass(:,j,ileaf,icarbon).GT. lm_lastyearmax(:,j)*0.75)
+!!$                lm_lastyearmax(:,j) = ( lm_lastyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
+!!$                     biomass(:,j,ileaf,icarbon) * dt ) / (one_year/leaflife_tab(j))
+!!$             ENDWHERE
+!!$             lm_thisyearmax(:,j)=lm_lastyearmax(:,j) ! just to initialise value
+
+             
+             !
+             !! 19.2.2 Update this year's leaf biomass (::lm_thisyearmax).
+             !!        The short-term variable (Xs in the above equation) that is being used to update the long-term 
+             !!        this year's leaf biomass is the leaf biomass pool (::biomass(i,j,ileaf).
+             !
+             WHERE (lm_thisyearmax(:,j) .GT. min_stomate)
+                WHERE(biomass(:,j,ileaf,icarbon).GT. lm_thisyearmax(:,j)*0.75)
+                   lm_thisyearmax(:,j) = ( lm_thisyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
+                        biomass(:,j,ileaf,icarbon) * dt ) / (one_year/leaflife_tab(j))
+                ENDWHERE
+             ELSEWHERE
+                lm_thisyearmax(:,j) =biomass(:,j,ileaf,icarbon)
+             ENDWHERE
+
+          ENDDO
+
+       ELSE
+          
+          !
+          !! 19.3 If LPJ DGVM is not activated but STOMATE is, the maximum leaf mass is set to be the same  
+          !!      as the leaf biomass (::biomass(i,j,ileaf), without a change in the maximum fractional plant cover. 
+          !
+          DO j = 2,nvm ! Loop over # PFTs
+             WHERE ( biomass(:,j,ileaf,icarbon) .GT. lm_thisyearmax(:,j) )
+                lm_thisyearmax(:,j) = biomass(:,j,ileaf,icarbon)
+             ENDWHERE
+          ENDDO
+
+       ENDIF !(control%ok_dgvm)
+    ELSE
+
+          !
+          !! 19.4 If STOMATE is not activated, the maximum leaf biomass is set to be the maximum possible 
+          !!      LAI of the PFT.
+          !
+
+       DO j = 2,nvm ! Loop over # PFTs
+          lm_thisyearmax(:,j) = lai_max(j)  / sla(j)
+       ENDDO
+
+    ENDIF  !(control%ok_stomate)
+
+    !
+    !! 20. Update the annual maximum fractional plant cover for each PFT if the current fractional cover 
+    !!     (::veget), is larger than the current maximum value.
+    !!     ::veget is defined as fraction of total ground. Therefore, maxfpc_thisyear has the same unit.
+    !
+
+    WHERE ( veget(:,:) .GT. maxfpc_thisyear(:,:) )
+       maxfpc_thisyear(:,:) = veget(:,:)
+    ENDWHERE
+
+    !
+    !! 21. At the end of the every year, last year's maximum and minimum moisture availability,
+    !!     annual GDD0, annual precipitation, annual max weekly GPP, and maximum leaf mass are 
+    !!     updated with the value calculated for the current year, and then their value reset.
+    !!     Either to zero for the maximum variables, or to ::large_value (set to be 1.E33 in ::
+    !!     the module ::stomate_constants) for the minimum variable ::minmoiavail_thisyear.
+    !
+
+    IF ( EndOfYear ) THEN
+
+       !
+       !! 21.1 Update last year's values. \n
+       !!      The variables ::maxmoiavail_lastyear, ::minmoiavail_lastyear and ::maxgppweek_lastyear  
+       !!      are updated using the relaxation method:
+       !!      \latexonly
+       !!      \input{season_lin_relax_eqn1.tex}
+       !!      \endlatexonly
+       !!      \n
+       !!      where Xs is this year's value, dt (Delta-t) is set to 1 (year), and the time constant (tau) !??
+       !!      is set by the parameter ::tau_climatology, which is set to 20 years at the beginning 
+       !!      of this subroutine. \n
+       !!      The other variables (::gdd0_lastyear, ::precip_lastyear, ::lm_lastyearmax and 
+       !!      ::maxfpc_lastyear) are just replaced with this year's value.
+       !
+       !NVMODIF
+       maxmoiavail_lastyear(:,:) = (maxmoiavail_lastyear(:,:)*(tau_climatology-1)+ maxmoiavail_thisyear(:,:))/tau_climatology
+       minmoiavail_lastyear(:,:) = (minmoiavail_lastyear(:,:)*(tau_climatology-1)+ minmoiavail_thisyear(:,:))/tau_climatology
+       maxgppweek_lastyear(:,:) =( maxgppweek_lastyear(:,:)*(tau_climatology-1)+ maxgppweek_thisyear(:,:))/tau_climatology
+       !       maxmoiavail_lastyear(:,:) = maxmoiavail_thisyear(:,:)
+       !       minmoiavail_lastyear(:,:) = minmoiavail_thisyear(:,:)
+       !       maxgppweek_lastyear(:,:) = maxgppweek_thisyear(:,:)
+       
+       gdd0_lastyear(:) = gdd0_thisyear(:)
+
+       precip_lastyear(:) = precip_thisyear(:)
+
+       lm_lastyearmax(:,:) = lm_thisyearmax(:,:)
+
+       maxfpc_lastyear(:,:) = maxfpc_thisyear(:,:)
+
+       !
+       !! 21.2 Reset new values for the "this year" variables. \n
+       !!      The maximum variables are set to zero and the minimum variable ::minmoiavail_thisyear
+       !!      is set to ::large_value (set to be 1.E33 in the module ::stomate_constants).
+       !
+
+       maxmoiavail_thisyear(:,:) = zero
+       minmoiavail_thisyear(:,:) = large_value
+
+       maxgppweek_thisyear(:,:) = zero
+
+       gdd0_thisyear(:) = zero
+
+       precip_thisyear(:) = zero
+
+       lm_thisyearmax(:,:) = zero
+
+       maxfpc_thisyear(:,:) = zero
+
+       !
+       ! 21.3 Special treatment for maxfpc. !?? 
+       !! 21.3 Set the maximum fractional plant cover for non-natural vegetation 
+       !!      (i.e. agricultural C3 and C4 - PFT 12 and 13) vegetation for last year to be zero.
+       !
+
+       !
+       ! 21.3.1 Only take into account natural PFTs
+       !
+
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( .NOT. natural(j) ) THEN
+             maxfpc_lastyear(:,j) = zero
+          ENDIF
+       ENDDO
+
+       ! 21.3.2 In Stomate, veget is defined as a fraction of ground, not as a fraction 
+       !        of total ground. maxfpc_lastyear will be compared to veget in lpj_light.
+       !        Therefore, we have to transform maxfpc_lastyear.
+
+
+       ! 21.3.3 The sum of the maxfpc_lastyear for natural PFT must not exceed fpc_crit (=.95).
+       !        However, it can slightly exceed this value as not all PFTs reach their maximum 
+       !        fpc at the same time. Therefore, if sum(maxfpc_lastyear) for the natural PFTs
+       !        exceeds fpc_crit, we scale the values of maxfpc_lastyear so that the sum is
+       !        fpc_crit.
+
+!!$       ! calculate the sum of maxfpc_lastyear
+!!$       sumfpc_nat(:) = zero
+!!$       DO j = 2,nvm ! Loop over # PFTs
+!!$          sumfpc_nat(:) = sumfpc_nat(:) + maxfpc_lastyear(:,j)
+!!$       ENDDO
+!!$
+!!$       ! scale so that the new sum is fpc_crit
+!!$       DO j = 2,nvm ! Loop over # PFTs 
+!!$          WHERE ( sumfpc_nat(:) .GT. fpc_crit )
+!!$             maxfpc_lastyear(:,j) = maxfpc_lastyear(:,j) * (fpc_crit/sumfpc_nat(:))
+!!$          ENDWHERE
+!!$       ENDDO
+
+    ENDIF  ! EndOfYear
+
+    !
+    !! 22. Diagnose herbivore activity (::herbivores), determined as probability for a leaf to be
+    !!     eaten in a day (follows McNaughton et al., 1989). \n
+    !!     The amount of herbivore activity is used in the modules ::lpj_establish  
+    !!     and ::stomate_turnover.
+    !
+
+    !
+    !! 22.1 First calculate the mean long-term leaf NPP in grid box, mean residence
+    !!      time (years) of green tissue to give the biomass available for herbivore consumption.
+    !!      Each PFT is looped over, though the calculation is only made for
+    !!      natural vegetation (PFTs 2-11).
+    !
+
+    nlflong_nat(:,:) = zero
+    weighttot(:,:) = zero
+    green_age(:,:) = zero
+    !
+    DO j = 2,nvm ! Loop over # PFTs
+       !
+       IF ( natural(j) ) THEN
+          !
+          !! 22.1.1 Calculate the total weight of the leaves (::weighttot) as last year's leaf biomass
+          !
+          weighttot(:,j) = lm_lastyearmax(:,j)
+          
+          !
+          !! 22.1.2 Calculate the mean long-term leaf NPP as the long-term NPP calculated in Section 12 of 
+          !!        this subroutine weighted by the leaf fraction (::leaf_frac), which is defined to be 0.33
+          !!        at the beginning of this subroutine.
+          !
+          nlflong_nat(:,j) = npp_longterm(:,j) * leaf_frac_hvc
+          
+          !
+          !! 22.1.3 Calculate the mean residence time of the green tissue (::green_age) 
+          !!        This is calculated as the sum of 6 months 
+          !!        for natural seasonal vegetation (i.e. PFTs 3, 6, 8-11), and 2 years for evergreen 
+          !!        (PFTs 2, 4, 5, 8), multiplied by last year's leaf biomass for each PFT, divided by the 
+          !!        total weight of the leaves for all PFTs.
+          !         This is a crude approximation.  !!?? By whom?
+          !!        The difference between seasonal and evergreen vegetation is determined by the parameter
+          !!        ::pheno_model, which specifies the onset model of the PFT.
+ 
+          !
+          IF ( pheno_model(j) .EQ. 'none' ) THEN
+             green_age(:,j) = green_age_ever * lm_lastyearmax(:,j)
+          ELSE
+             green_age(:,j) = green_age_dec * lm_lastyearmax(:,j)
+          ENDIF
+          !
+       ENDIF
+       !
+    ENDDO
+    !
+    WHERE ( weighttot(:,:) .GT. zero )
+       green_age(:,:) = green_age(:,:) / weighttot(:,:)
+    ELSEWHERE
+       green_age(:,:) = un
+    ENDWHERE
+
+    !
+    !! 22.2 McNaughton et al. (1989) give herbivore consumption as a function of mean, long-term leaf NPP.
+    !!      as it gives an estimate of the edible biomass. The consumption of biomass by herbivores and the 
+    !!      resultant herbivore activity are calculated following the equations:
+    !!      \latexonly
+    !!      \input{season_consumption_eqn4.tex}
+    !!      \endlatexonly
+    !!      \n 
+    !!      and 
+    !!      \latexonly
+    !!      \input{season_herbivore_eqn5.tex}
+    !!      \endlatexonly
+    !!      \n 
+    !       
+
+    DO j = 2,nvm ! Loop over # PFTs
+       !
+       IF ( natural(j) ) THEN
+          !
+          WHERE ( nlflong_nat(:,j) .GT. zero )
+             consumption(:) = hvc1 * nlflong_nat(:,j) ** hvc2
+             herbivores(:,j) = one_year * green_age(:,j) * nlflong_nat(:,j) / consumption(:)
+          ELSEWHERE
+             herbivores(:,j) = 100000.
+          ENDWHERE
+          !
+       ELSE
+          !
+          herbivores(:,j) = 100000.
+          !
+       ENDIF
+       !
+    ENDDO
+    herbivores(:,ibare_sechiba) = zero
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving season'
+
+  END SUBROUTINE season
+
+END MODULE stomate_season
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_soilcarbon.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_soilcarbon.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_soilcarbon.f90	(revision 5166)
@@ -0,0 +1,2071 @@
+
+! MODULE       : stomate_soilcarbon
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Calculate soil dynamics largely following the Century model
+!
+!!	
+!!\n DESCRIPTION: 11 layers discretization: Layers 1-11 are soil layers
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN		:
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_soilcarbon
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE pft_parameters_var
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC soilcarbon,soilcarbon_clear
+
+  ! Variables shared by all subroutines in this module
+  
+  LOGICAL, SAVE    :: firstcall = .TRUE.   !! Is this the first call? (true/false)
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : soilcarbon_clear
+!!
+!>\BRIEF        Set the flag ::firstcall to .TRUE. and as such activate sections 1.1.2 and 1.2 of the subroutine soilcarbon 
+!! (see below).
+!! 
+!_ ================================================================================================================================
+  
+  SUBROUTINE soilcarbon_clear
+    firstcall=.TRUE.
+  ENDSUBROUTINE soilcarbon_clear
+
+
+!! ================================================================================================================================
+!!  SUBROUTINE   : soilcarbon
+!!
+!>\BRIEF        Computes the soil respiration and carbon stocks, essentially 
+!! following Parton et al. (1987).
+!!
+!! DESCRIPTION	: The soil is divided into 3 carbon pools, with different 
+!! characteristic turnover times : active (1-5 years), slow (20-40 years) 
+!! and passive (200-1500 years).\n
+!! There are three types of carbon transferred in the soil:\n
+!! - carbon input in active and slow pools from litter decomposition,\n
+!! - carbon fluxes between the three pools,\n
+!! - carbon losses from the pools to the atmosphere, i.e., soil respiration.\n
+!!
+!! The subroutine performs the following tasks:\n
+!!
+!! Section 1.\n
+!! The flux fractions (f) between carbon pools are defined based on Parton et 
+!! al. (1987). The fractions are constants, except for the flux fraction from
+!! the active pool to the slow pool, which depends on the clay content,\n
+!! \latexonly
+!! \input{soilcarbon_eq1.tex}
+!! \endlatexonly\n
+!! In addition, to each pool is assigned a constant turnover time.\n
+!!
+!! Section 2.\n
+!! The carbon input, calculated in the stomate_litter module, is added to the 
+!! carbon stock of the different pools.\n
+!!
+!! Section 3.\n
+!! First, the outgoing carbon flux of each pool is calculated. It is 
+!! proportional to the product of the carbon stock and the ratio between the 
+!! iteration time step and the residence time:\n
+!! \latexonly
+!! \input{soilcarbon_eq2.tex}
+!! \endlatexonly
+!! ,\n
+!! Note that in the case of crops, the additional multiplicative factor 
+!! integrates the faster decomposition due to tillage (following Gervois et 
+!! al. (2008)).
+!! In addition, the flux from the active pool depends on the clay content:\n
+!! \latexonly
+!! \input{soilcarbon_eq3.tex}
+!! \endlatexonly
+!! ,\n
+!! Each pool is then cut from the carbon amount corresponding to each outgoing
+!! flux:\n
+!! \latexonly
+!! \input{soilcarbon_eq4.tex}
+!! \endlatexonly\n
+!! Second, the flux fractions lost to the atmosphere is calculated in each pool
+!! by subtracting from 1 the pool-to-pool flux fractions. The soil respiration 
+!! is then the summed contribution of all the pools,\n
+!! \latexonly
+!! \input{soilcarbon_eq5.tex}
+!! \endlatexonly\n
+!! Finally, each carbon pool accumulates the contribution of the other pools:
+!! \latexonly
+!! \input{soilcarbon_eq6.tex}
+!! \endlatexonly
+!!
+!! Section 4.\n
+!! If the flag SPINUP_ANALYTIC is set to true, the matrix A is updated following
+!! Lardy (2011).
+!!
+!! RECENT CHANGE(S): None
+!! 
+!! MAIN OUTPUTS VARIABLE(S): carbon, resp_hetero_soil
+!!
+!! REFERENCE(S)   :
+!! - Parton, W.J., D.S. Schimel, C.V. Cole, and D.S. Ojima. 1987. Analysis of 
+!! factors controlling soil organic matter levels in Great Plains grasslands. 
+!! Soil Sci. Soc. Am. J., 51, 1173-1179.
+!! - Gervois, S., P. Ciais, N. de Noblet-Ducoudre, N. Brisson, N. Vuichard, 
+!! and N. Viovy (2008), Carbon and water balance of European croplands 
+!! throughout the 20th century, Global Biogeochem. Cycles, 22, GB2022, 
+!! doi:10.1029/2007GB003018.
+!! - Lardy, R, et al., A new method to determine soil organic carbon equilibrium,
+!! Environmental Modelling & Software (2011), doi:10.1016|j.envsoft.2011.05.016
+!!
+!! FLOWCHART    :
+!! \latexonly
+!! \includegraphics[scale=0.5]{soilcarbon_flowchart.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE soilcarbon (npts, dt, clay, &
+       soilcarbon_input, control_temp_soil, control_moist_soil, &
+       carbon, &
+       resp_hetero_soil, &
+       MatrixA,litter_above,litter_below,&
+       soilhum, DOC, moist_soil, DOC_EXP, &
+       lignin_struc_above, lignin_struc_below, &
+       floodout, runoff_per_soil, drainage_per_soil, wat_flux0, wat_flux,&
+       bulk_dens, soil_ph, veget_max, soil_mc, soiltile, &
+       DOC_to_topsoil, DOC_to_subsoil)
+
+!! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables
+    
+    INTEGER(i_std), INTENT(in)                                        :: npts                  !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                                           :: dt                    !! Time step \f$(dtradia one_day^{-1})$\f
+    REAL(r_std), DIMENSION(npts), INTENT(in)                          :: clay                  !! Clay fraction (unitless, 0-1) 
+    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)
+
+    REAL(r_std), DIMENSION(npts), INTENT(in)                          :: soil_ph               !! soil pH (pH unit, 0-14) 
+    REAL(r_std), DIMENSION(npts,nbdl,npool*2), INTENT(in)             :: control_temp_soil     !! Temperature control of heterotrophic respiration (unitless: 0->1)
+    REAL(r_std), DIMENSION(npts,nbdl,nvm), INTENT(in)                 :: control_moist_soil    !! Moisture control of heterotrophic respiration (unitless: 0.25->1)
+
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nelements), INTENT(in)      :: litter_above          !! Metabolic and structural litter,above ground
+                                                                                               !! The unit is given by m^2 of ground
+                                                                                               !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nbdl,nelements), INTENT(in) ::litter_below           !! Metabolic and structural litter, below ground
+                                                                                               !! The unit is given by m^2 of
+                                                                                               !! ground @tex $(gC m^{-2}) $ @endtex
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(in)                     :: soilhum               !! Daily soil humidity of each soil layer 
+                                                                                               !! (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                      :: lignin_struc_above    !! Ratio Lignin content in structural litter,
+                                                                                               !! above ground, (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nbdl), INTENT(in)                 :: lignin_struc_below    !! Ratio Lignin content in structural litter,
+                                                                                               !! below ground, (0-1, unitless)
+    REAL(r_std),DIMENSION (npts), INTENT (in)                         :: floodout              !! flux out of floodplains
+    REAL(r_std),DIMENSION (npts,nstm), INTENT (in)                    :: runoff_per_soil       !! Runoff per soil type [mm]
+    REAL(r_std),DIMENSION (npts,nstm), INTENT (in)                    :: drainage_per_soil     !! Drainage per soil type [mm]
+    REAL(r_std),DIMENSION (npts,nstm), INTENT(in)                     :: wat_flux0             !! Water flux in the first soil layers exported for soil C calculations(mm)
+    REAL(r_std),DIMENSION (npts,nslm,nstm), INTENT(in)                :: wat_flux              !! Water flux in the soil layers exported for soil C calculations(mm)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in)                        :: veget_max             !! PFT "Maximal" coverage fraction of a PFT 
+                                                                                               !! defined in the input vegetation map 
+                                                                                               !! @tex $(m^2 m^{-2})$ @endtex 
+                                                                                               !! The unit is given by m^2 of
+                                                                                               !! water @tex $(gC m{-2} of water)$ @endtex
+    REAL(r_std),DIMENSION (npts,nbdl,nstm), INTENT(in)                :: soil_mc               !! soil moisture content \f($m^3 \times m^3$)\f
+    REAL(r_std),DIMENSION (npts,nstm), INTENT (in)                    :: soiltile              !! Fraction of each soil tile (0-1, unitless)
+
+    REAL(r_std),DIMENSION (npts,nelements), INTENT(in)                :: DOC_to_topsoil        !! DOC inputs to top of the soil column, from reinfiltration on
+                                                                                               !! floodplains and from irrigation
+                                                                                               !! @tex $(gC m^{-2} day{-1})$ @endtex
+    REAL(r_std),DIMENSION (npts,nelements), INTENT(in)                :: DOC_to_subsoil        !! DOC inputs to bottom of the soil column, from returnflow
+                                                                                               !! in swamps and lakes
+                                                                                               !! @tex $(gC m^{-2} day{-1})$ @endtex
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)                :: resp_hetero_soil           !! Soil heterotrophic respiration \f$(gC m^{-2} (dtradia one_day^{-1})^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nexp,nelements), INTENT(out) :: DOC_EXP                    !! Exported DOC through runoff, drainage, flood,
+                                                                                               !! The unit is given by m^2 of
+                                                                                               !! ground \f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nbdl), INTENT(out)               :: moist_soil                !! moisture in soil for one pixel (m3/m3)
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,npool,nelements), INTENT(inout)      :: soilcarbon_input    !! Amount of carbon going into the carbon pools 
+                                                                                          !! from litter decomposition \f$(gC m^{-2} day^{-1})$\f    
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl), INTENT(inout)                :: carbon   !! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements), INTENT(inout) :: DOC      !! Dissolved Organic Carbon in soil
+                                                                                          !! The unit is given by m^2 of
+                                                                                          !! ground @tex $(gC m{-2} of ground)$ @endtex
+
+    REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(inout)           :: MatrixA  !! Matrix containing the fluxes between the carbon pools
+                                                                                          !! per sechiba time step 
+                                                                                          !! @tex $(gC.m^2.day^{-1})$ @endtex
+
+    !! 0.4 Local variables
+    REAL(r_std), SAVE, DIMENSION(ncarb)                           :: carbon_tau       !! Residence time in carbon pools (years)
+!$OMP THREADPRIVATE(carbon_tau)
+    REAL(r_std), DIMENSION(npts,ncarb,ncarb)                      :: frac_carb        !! Flux fractions between carbon pools 
+                                                                                      !! (second index=origin, third index=destination) 
+                                                                                      !! (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,ncarb,nelements,nbdl)             :: fluxtot          !! Total flux out of carbon pools \f$(gC m^{2})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,npool)                   :: fluxtot_DOC      !! Total flux out of dissolved organic carbon pools \f$(gC m^{2}ground)$\f
+    REAL(r_std), DIMENSION(npts,npool,ncarb,nelements,nbdl)       :: flux             !! Fluxes between carbon pools \f$(gC m^{2})$\f
+    CHARACTER(LEN=7), DIMENSION(ncarb)                            :: carbon_str       !! Name of the carbon pools for informative outputs (unitless)
+    REAL(r_std), SAVE, DIMENSION(ncarb)                           :: priming_param    !! parmater controlling the sensitvity of priming effect on  each pools to the amount of LOM
+!$OMP THREADPRIVATE(priming_param)
+    REAL(r_std), SAVE, DIMENSION(npool)                           :: DOC_tau          !! Residence time of DOC (days)
+!$OMP THREADPRIVATE(DOC_tau)
+    REAL(r_std), DIMENSION(npts,nvm,nbdl)                         :: litter_tot       !! total litter (gC/m**2 of ground)
+    REAL(r_std), DIMENSION(npts,nvm,nbdl)                         :: LOM              !! total labile organic matter that could induce the decompostion rate
+                                                                                      !! (gC/m**2 of ground)
+    INTEGER(i_std)                                                :: k,kk,m,j,l,i,kkk !! Indices (unitless)
+    REAL(r_std),DIMENSION(0:nbdl)                                 :: z_soil           !! Soil levels (m)
+    REAL(r_std), DIMENSION(npts,nvm, nbdl,npool,nelements)        :: DOC_RE           !! Adsoprtion Desorption flux of DOC (mmol C/kg)
+    REAL(r_std), DIMENSION(npts,nvm, nbdl,npool,nelements)        :: DOC_FLUX         !! DOC flux between layers in f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm, nbdl,npool,nelements)        :: DOC_FLUX_DIFF    !! DOC flux by diffusion between layers in f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm, nbdl,npool,nelements)        :: DOC_FLUX_DIFF_old !! DOC flux by diffusion between layers in f$(gC m^{-2} day^{-1})$\f for storage
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: DOC_RUN          !! DOC lost with runoff in f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: DOC_FLOOD        !! DOC lost with flooding in f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: DOC_DRAIN        !! DOC lost with drainage in f$(gC m^{-2} day^{-1})$\f
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements)    :: DOC_old          !! Dissolved Organic Carbon in soil
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! ground @tex $(gC m{-2} of ground)$ @endtex variable used for storage
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements)    :: DOC_old2         !! Dissolved Organic Carbon in soil
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! ground @tex $(gC m{-2} of ground)$ @endtex variable used for storage
+    REAL(r_std), DIMENSION(npts,nvm,nbdl,ndoc,npool,nelements)    :: DOC_old_buffer   !! Dissolved Organic Carbon in soil
+                                                                                      !! The unit is given by m^2 of
+                                                                                      !! ground @tex $(gC m{-2} of ground)$ @endtex variable used for storage
+
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl)                   :: carbon_old       !! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f used for storage
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl)                   :: carbon_old_buffer!! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f used for storage
+    REAL(r_std), DIMENSION(npts)                                  :: Qmax             !! Maximum adsorption capacity for DOC in the Langmuir equation (mg kgÂ¿1)
+    REAL(r_std), DIMENSION(npts,nbdl)                             :: Kd               !! distribution coefficient between DOC adsorbed and DOC free (unitless [0-1])
+    REAL(r_std), DIMENSION(npts,nbdl)                             :: b                !! desorption term of the Initial Mass (IM) isotherm (mmol C/kg)
+    REAL(r_std), DIMENSION(npts,nbdl)                             :: IM               !! sorption affinity of the Initial Mass (IM) isotherm (unitless)
+
+    REAL(r_std), DIMENSION(npts)                                  :: Dif_coef         !! Diffusion coeficient used for bioturbation (m2 dt-1)
+
+    REAL(r_std), DIMENSION(npts)                                  :: Dif_DOC          !! Diffusion coeficient used for DOC diffusion (m2 dt-1)
+
+    REAL(r_std), DIMENSION(npts)                                  :: CUE_coef         !! Partition coefficient for DOC decomposed between CO2 and POC (unitless, 0-1)
+                                                                                    
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl)                   :: carbon_flux      !! Soil carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f
+    REAL(r_std), DIMENSION(npts,ncarb,nvm,nbdl)                   :: carbon_flux_old  !! Soil carbon flux within pools towards the soil column\f$(gC m^{2} dt^{-1})$\f
+                                                                                      !!
+                                                                                      !used
+                                                                                      !for
+                                                                                      !storage
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements)            :: check_intern     !! Contains the components of the internal
+                                                                              !! mass balance chech for this routine
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: closure_intern   !! Check closure of internal mass balance
+
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: pool_start       !! Start and end pool of this routine 
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: pool_end         !! Start and end pool of this routine 
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nelements)                    :: pool_end_after    !! Start and end pool of this routine after mass balance correction 
+                                                                                      !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex 
+!_ ================================================================================================================================
+
+    !! bavard is the level of diagnostic information, 0 (none) to 4 (full)
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering soilcarbon' 
+
+!! 1. Initializations
+
+    !! 1.0 Calculation of soil moisture
+    moist_soil(:,:) = zero
+      DO l = 1,nbdl
+          DO i = 1, nstm
+             moist_soil(:,l)= moist_soil(:,l) + soil_mc(:,l,i)*soiltile(:,i)
+          ENDDO
+      ENDDO
+!! 1.3 soil levels
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+    !! 1.1 Initialize check for mass balance closure
+    !  The mass balance is calculated at the end of this routine
+    !  in section 14. Initial biomass and harvest pool and all other
+    !  relevant pools were set to zero before calling this routine.
+    pool_start(:,:,:) = zero
+IF (control%ld_doc) THEN
+!Starting carbon pool
+    DO m = 1, nvm
+       DO i = 1,ncarb
+          DO l = 1, nbdl
+                 pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
+                           ( carbon(:,i,m,l) ) * veget_max(:,m)
+          ENDDO
+       ENDDO
+    ENDDO
+
+!Starting DOC pool
+    DO m = 1, nvm
+       DO i = 1,npool
+          DO l = 1, nbdl
+             DO j = 1, ndoc
+                    pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
+                              ( DOC(:,m,l,j,i,icarbon)) * veget_max(:,m)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
+
+!Starting litter below pool
+    DO m = 1,nvm
+       DO l = 1, nbdl
+          pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
+                      (soilcarbon_input(:,m,l,imetbel,icarbon)+soilcarbon_input(:,m,l,istrbel,icarbon)+ &
+                      soilcarbon_input(:,m,l,imetabo,icarbon)+soilcarbon_input(:,m,l,istrabo,icarbon)) * &
+                      veget_max(:,m) * dt
+      ENDDO
+    ENDDO
+
+!Starting litter above pool
+    DO m = 1,nvm
+          WHERE (veget_max(:,m) .GT. zero)
+       pool_start(:,m,icarbon) = pool_start(:,m,icarbon) + &
+             DOC_to_topsoil(:,icarbon)*dt/veget_max(:,m) + &
+             DOC_to_subsoil(:,icarbon)*dt/veget_max(:,m)
+          ELSEWHERE
+       pool_start(:,m,icarbon) = pool_start(:,m,icarbon) 
+          ENDWHERE
+    ENDDO
+ENDIF
+
+    !! 1.2 Get soil "constants"
+    !! 1.2.1 Flux fractions between carbon pools: depend on clay content, recalculated each time
+    ! From active pool: depends on clay content
+    frac_carb(:,iactive,iactive) = zero
+    frac_carb(:,iactive,islow) = metabolic_ref_frac - active_to_pass_clay_frac*clay(:)
+    frac_carb(:,iactive,ipassive) = un - frac_carb(:,iactive,islow)
+    ! 1.2.1.2 from slow pool
+    frac_carb(:,islow,islow) = zero
+    frac_carb(:,islow,iactive) = frac_carb_sa
+    frac_carb(:,islow,ipassive) = un - frac_carb(:,islow,iactive) 
+    ! From passive pool
+    frac_carb(:,ipassive,ipassive) = zero
+    frac_carb(:,ipassive,iactive) = frac_carb_pa
+    frac_carb(:,ipassive,islow) = un - frac_carb(:,ipassive,iactive)
+
+    ! 1.2.1.3 Initialization
+    carbon_flux(:,:,:,:) =  zero
+    carbon_flux_old(:,:,:,:) =  zero
+    IF ( firstcall ) THEN
+
+        !! 1.2.2 Residence times in carbon pools (in year converted in days)
+        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
+        carbon_tau(islow) = carbon_tau_islow * one_year          ! See Guenet et al., (In prep)
+        carbon_tau(ipassive) = carbon_tau_ipassive * one_year    
+
+        priming_param(iactive)=priming_param_iactive  !Priming parameter for mineralization obtained from optimization of SOM-FOM-DEP see Guenet et al., (In prep)
+        priming_param(islow)=priming_param_islow
+        priming_param(ipassive)=priming_param_ipassive
+
+        ! The values of DOC_tau are coming from Kalbitz et al 2003 Geoderma
+        ! (already in days) 
+        DOC_tau(imetabo) = DOC_tau_labile 
+        DOC_tau(istrabo) = DOC_tau_labile 
+        DOC_tau(imetbel) = DOC_tau_labile  
+        DOC_tau(istrbel) = DOC_tau_labile  
+        DOC_tau(iact) = DOC_tau_labile  
+        DOC_tau(islo) = DOC_tau_stable  
+        DOC_tau(ipas) = DOC_tau_stable  
+
+       !! 1.3 soil levels
+        !! 1.4 Messages : display the residence times  
+        carbon_str(iactive) = 'active'
+        carbon_str(islow) = 'slow'
+        carbon_str(ipassive) = 'passive'
+        
+        WRITE(numout,*) 'soilcarbon:'
+        
+        WRITE(numout,*) '   > minimal carbon residence time in carbon pools (d):'
+        DO k = 1, ncarb ! Loop over carbon pools
+          WRITE(numout,*) '(1, ::carbon_str(k)):',carbon_str(k),' : (1, ::carbon_tau(k)):',carbon_tau(k)
+        ENDDO
+        
+        WRITE(numout,*) '   > flux fractions between carbon pools: depend on clay content'
+        firstcall = .FALSE.
+        
+    ENDIF
+
+    !! 1.5 Initialization
+    !! 1.5.1 Initialization of parameters
+        Dif_coef(:) = (Dif/one_year)*dt
+        Dif_DOC(:)=D_DOC*dt        !We divided by one_year  
+                                   !because the unit of the Dif
+                                   !parameter is m2 yr-1 and the time stept of the model
+                                   !is dt (1/48, by default, i.e. the fraction
+                                   !of 30 min expressed in days) 
+        CUE_coef(:)=CUE
+
+    !! 1.5.2 Set soil respiration and DOC fluxes to zero
+    resp_hetero_soil(:,:) = zero
+    !resp_hetero_soil_layer(:,:,:) = zero
+    DOC_EXP(:,:,:,:) = zero
+    DOC_RE(:,:,:,:,:) = zero
+    DOC_FLUX(:,:,:,:,:) = zero
+    DOC_FLUX_DIFF(:,:,:,:,:) = zero
+    DOC_FLUX_DIFF_old(:,:,:,:,:) = zero
+    DOC_RUN(:,:,:)= zero
+    DOC_FLOOD(:,:,:)= zero
+    DOC_DRAIN(:,:,:)= zero
+    fluxtot(:,:,:,:)= zero
+    fluxtot_DOC(:,:,:,:) = zero
+    litter_tot(:,:,:) = zero
+    ! bulk_density must be in kg m-3 and is generally given in g cm-3
+    WHERE (bulk_dens(:) .LT. 500)
+    bulk_dens(:) = bulk_dens(:)*1e3
+    ENDWHERE
+
+!! 2. Fluxes between carbon reservoirs, and to the atmosphere (respiration) \n
+    !! 2.2 Input from litter to DOC and from reinflitration in floodplains
+    !! For the variables DOC_to_topsoil and DOC_to_subsoil we multiplied by
+    !veget_max because it is not defined per PFT and therefore we redistribute
+    !it following veget_max. Moreover we assume the all the DOC coming from
+    !floodplains reinfiltration is going to DOC coming from the active pool.
+    DO m = 2, nvm
+       DO l = 1,nbdl
+
+          DOC(:,m,l,ifree,imetabo,icarbon) = DOC(:,m,l,ifree,imetabo,icarbon) + soilcarbon_input(:,m,l,imetabo,icarbon)*dt 
+          DOC(:,m,l,ifree,istrabo,icarbon) = DOC(:,m,l,ifree,istrabo,icarbon) + soilcarbon_input(:,m,l,istrabo,icarbon)*dt
+          DOC(:,m,l,ifree,imetbel,icarbon) = DOC(:,m,l,ifree,imetbel,icarbon) + soilcarbon_input(:,m,l,imetbel,icarbon)*dt
+          DOC(:,m,l,ifree,istrbel,icarbon) = DOC(:,m,l,ifree,istrbel,icarbon) + soilcarbon_input(:,m,l,istrbel,icarbon)*dt
+
+       ENDDO
+          WHERE (veget_max(:,m) .GT. zero)
+          DOC(:,m,1,ifree,iact,icarbon) = DOC(:,m,1,ifree,iact,icarbon) + DOC_to_topsoil(:,icarbon)*dt/veget_max(:,m)
+          DOC(:,m,nbdl,ifree,iact,icarbon) = DOC(:,m,nbdl,ifree,iact,icarbon) + DOC_to_subsoil(:,icarbon)*dt/veget_max(:,m)
+          ELSEWHERE
+          DOC(:,m,1,ifree,iact,icarbon) = DOC(:,m,1,ifree,iact,icarbon) 
+          DOC(:,m,nbdl,ifree,iact,icarbon) = DOC(:,m,nbdl,ifree,iact,icarbon)
+          ENDWHERE
+    ENDDO
+
+    !! 2.3. Calculate fluxes
+    DO m = 2,nvm
+      !calculate total litter available
+      litter_tot(:,m,1)=litter_above(:,imetabolic,m,icarbon)+litter_above(:,istructural,m,icarbon)
+    
+      DO l = 1, nbdl
+      litter_tot(:,m,l)=litter_tot(:,m,l) + litter_below(:,imetabolic,m,l,icarbon)+litter_below(:,istructural,m,l,icarbon)
+      ENDDO
+   ENDDO
+
+    DO m = 2,nvm ! Loop over #Â PFTs
+
+
+      !! 2.3.1. Flux out of pools
+
+      DO k = 1, ncarb ! Loop over carbon pools from which the flux comes
+
+        DO l = 1, nbdl !Loop over soil layers
+
+         ! Determine total flux out of pool
+         ! S.L. Piao 2006/05/05 - for crop multiply tillage factor of decomposition
+         ! Not crop
+         
+
+          IF (k == iactive) THEN
+             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)
+          ELSEIF (k == islow) THEN
+             LOM(:,m,l) = litter_tot(:,m,l) + carbon(:,iactive,m,l) + DOC(:,m,l,ifree,iact,icarbon) + &
+                          DOC(:,m,l,ifree,imetabo,icarbon) + DOC(:,m,l,ifree,istrabo,icarbon) + DOC(:,m,l,ifree,imetbel,icarbon) + DOC(:,m,l,ifree,istrbel,icarbon)
+          ELSEIF (k == ipassive) THEN
+             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) + &
+                          DOC(:,m,l,ifree,imetabo,icarbon) + DOC(:,m,l,ifree,istrabo,icarbon) + DOC(:,m,l,ifree,imetbel,icarbon) + DOC(:,m,l,ifree,istrbel,icarbon)
+          ELSE
+             WRITE(numout,*) "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
+             WRITE(numout,*) "BE CAREFUL SOMETHING STRANGE HAPPENS"
+             WRITE(numout,*) "IN STOMATE_SOILCARBON FOR LOM CALCULATION"
+             WRITE(numout,*) "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
+
+          ENDIF
+
+       WHERE ((soil_mc(:,l,pref_soil_veg(m)) .GT. zero) .AND. (natural(m)))
+               fluxtot(:,k,icarbon,l) =(dt/carbon_tau(k))*(un-exp(-priming_param(k)*LOM(:,m,l))) * carbon(:,k,m,l) * &
+                    control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4)
+            ! C3 crop
+       ELSEWHERE ((soil_mc(:,l,pref_soil_veg(m)) .GT. zero) .AND.( (.NOT. natural(m)) .AND. (.NOT. is_c4(m)) ))
+               fluxtot(:,k,icarbon,l) =(dt/carbon_tau(k))*(un-exp(-priming_param(k)*LOM(:,m,l))) * carbon(:,k,m,l) * &
+                    control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4) * flux_tot_coeff(1)
+            ! C4 crop
+       ELSEWHERE ((soil_mc(:,l,pref_soil_veg(m)) .GT. zero) .AND.( (.NOT. natural(m)) .AND. (is_c4(m)) )) 
+               fluxtot(:,k,icarbon,l) =(dt/carbon_tau(k))*(un-exp(-priming_param(k)*LOM(:,m,l))) * carbon(:,k,m,l) * &
+                    control_moist_soil(:,l,m) * control_temp_soil(:,l,k+4) * flux_tot_coeff(2)
+       ELSEWHERE
+               fluxtot(:,k,icarbon,l) = zero
+       ENDWHERE
+
+          ! END - S.L. Piao 2006/05/05 - for crop multiply tillage factor of decomposition
+
+          ! Carbon flux from active pools depends on clay content
+          IF ( k .EQ. iactive ) THEN
+              fluxtot(:,k,icarbon,l) = fluxtot(:,k,icarbon,l) * ( un - flux_tot_coeff(3) * clay(:) )
+          ENDIF
+        ENDDO ! End of loop over soil layers
+
+      ENDDO ! End of loop over carbon pools
+     
+      !! 2.3.2 respiration
+      !BE CAREFUL: Here resp_hetero_soil is divided by dt to have a value which corresponds to
+      ! the sechiba time step but then in stomate.f90 resp_hetero_soil is multiplied by dt.
+      ! Perhaps it could be simplified. Moreover, we must totally adapt the routines to the dtradia/one_day
+      ! time step and avoid some constructions that could create bug during future developments.
+      !
+      DO l = 1,nbdl !Loop over soil layers
+         resp_hetero_soil(:,m) = resp_hetero_soil(:,m)+&
+            ( (CUE_coef(:)) * fluxtot(:,iactive,icarbon,l) + &
+            (CUE_coef(:)) * fluxtot(:,islow,icarbon,l) + &
+            (CUE_coef(:))* fluxtot(:,ipassive,icarbon,l)  ) / dt
+
+      ENDDO !End loop over soil layers
+
+      !! 2.3.3 DOC calculation
+      !! 2.3.3.1 DOC decomposition
+      ! In the Kalbitz et al., 2003 Geoderma as well
+      ! as in Qualls and Haines 1992 SSAJ
+      ! the equation are defined with exponential but for the time
+      ! step we used we can approximate the values with 1st order kinetics.
+
+     DO j = 1,npool  !Loop over pools
+       DO l = 1,nbdl !Loop over soil layers
+        WHERE (soil_mc(:,l,pref_soil_veg(m)) .GT. zero) 
+                 fluxtot_DOC(:,m,l,j) = (dt/DOC_tau(j))* &
+                                         DOC(:,m,l,ifree,j,icarbon)*control_temp_soil(:,l,npool+j)
+         ELSEWHERE
+                 fluxtot_DOC(:,m,l,j) = zero
+         ENDWHERE
+
+          resp_hetero_soil(:,m) = resp_hetero_soil(:,m)+&
+             (CUE_coef(:))*fluxtot_DOC(:,m,l,j)/dt
+
+      ENDDO !End loop over soil layers!
+     ENDDO !End loop over soil pool!
+
+      !! 2.3.4 Pools update
+      !! 2.3.4.1 For POC
+      DO l= 1, nbdl ! Loop over soil layers
+
+       carbon(:,iactive,m,l) = carbon(:,iactive,m,l)+ &
+                               frac_carb(:,ipassive,iactive)*(un - CUE_coef(:))*fluxtot_DOC(:,m,l,ipas) + &
+                               frac_carb(:,islow,iactive)*(un - CUE_coef(:))*fluxtot_DOC(:,m,l,islo) + &
+                               (un - CUE_coef(:))*fluxtot_DOC(:,m,l,imetbel) + &
+                               (un - CUE_coef(:))*fluxtot_DOC(:,m,l,istrbel) * (un - lignin_struc_below(:,m,l)) + &
+                               (un - CUE_coef(:))*fluxtot_DOC(:,m,l,imetabo) + &
+                               (un - CUE_coef(:))*fluxtot_DOC(:,m,l,istrabo) * (un - lignin_struc_above(:,m))
+
+       carbon(:,islow,m,l) = carbon(:,islow,m,l)+ &
+                               frac_carb(:,ipassive,islow)*(un - CUE_coef(:))*fluxtot_DOC(:,m,l,ipas) + &
+                               frac_carb(:,iactive,islow)*(un - CUE_coef(:))*fluxtot_DOC(:,m,l,iact) + &
+                               (un - CUE_coef(:))*fluxtot_DOC(:,m,l,istrbel) *lignin_struc_below(:,m,l) + &
+                               (un - CUE_coef(:))*fluxtot_DOC(:,m,l,istrabo) *lignin_struc_above(:,m)
+       carbon(:,ipassive,m,l) = carbon(:,ipassive,m,l)+ &
+                               frac_carb(:,iactive,ipassive)*(un - CUE_coef(:))*fluxtot_DOC(:,m,l,iact) + &
+                               frac_carb(:,islow,ipassive)*(un - CUE_coef(:))*fluxtot_DOC(:,m,l,islo)
+
+      ENDDO ! End loop over soil layers
+
+      DO k = 1, ncarb ! Loop over carbon pools from which the flux comes
+        DO l = 1, nbdl !Loop over soil layers
+
+         carbon(:,k,m,l) = carbon(:,k,m,l) - fluxtot(:,k,icarbon,l)
+
+        ENDDO ! End of loop over soil layers
+      ENDDO ! End of loop over carbon pools
+
+      !! 2.3.4.2 For DOC
+      DO l = 1,nbdl !Loop over soil layers
+         DO kk = 1,nelements !Loop over elements
+           !For Active pool
+
+           DOC(:,m,l,ifree,iact,kk) = DOC(:,m,l,ifree,iact,kk) + (un - CUE_coef(:)) * fluxtot(:,iactive,kk,l)
+
+           !For Slow pool    
+
+           DOC(:,m,l,ifree,islo,kk) = DOC(:,m,l,ifree,islo,kk) + (un - CUE_coef(:)) * fluxtot(:,islow,kk,l)
+
+           !For Passive pool
+
+           DOC(:,m,l,ifree,ipas,kk) = DOC(:,m,l,ifree,ipas,kk) + (un - CUE_coef(:)) * fluxtot(:,ipassive,kk,l)
+
+      ENDDO !End loop over elements
+    ENDDO !End loop over soil layers
+
+     DO j = 1,npool  !Loop over pools
+       DO l = 1,nbdl !Loop over soil layers
+
+          DOC(:,m,l,ifree,j,icarbon) = DOC(:,m,l,ifree,j,icarbon) - fluxtot_DOC(:,m,l,j)
+
+       ENDDO !End loop over soil layers!
+     ENDDO !End loop over soil pool!
+
+      !! 2.3.5 Adsorption/resorption of DOC using linear Mass isotherm assuming
+      !that DOC from native soil is zero (b parameters in Nodvin et al., 1986,
+      !Soil Science)
+      !For the moment, fixed parameters taken from Kaiser and others,1996, b in mg/g soil
+Kd(:,:)=kd_ads
+!IM(:,)=m_ads
+!b(:,:)=b_ads
+
+   DO l = 1,nbdl
+         ! IM, b or Kd calculating following the statistical model obtained in 
+         ! Camino Serrano et al. in prep
+         Kd(:,l) = 0.001225841-0.000212346*soil_ph(:)+0.003739918*clay(:)
+   ENDDO
+
+! Calculation of amount adsorbed/desorbed based on 
+! Ota et al., 2013 JGR
+    DO l = 1,nbdl !Loop over soil layers
+         DO kk = 1,nelements !Loop over elements
+             DO kkk = 1,npool !Loop over soil and litter pool
+                DOC_RE(:,m,l,kkk,kk) = MAX(zero,Kd(:,l))*DOC(:,m,l,ifree,kkk,kk)*bulk_dens(:)
+            ENDDO !End loop over soil and litter pool
+         ENDDO !End loop over elements
+    ENDDO !End loop over soil layers
+
+DOC_old(:,m,:,:,:,:)= zero
+DOC_old(:,m,:,:,:,:)=DOC(:,m,:,:,:,:)
+      DO l = 1,nbdl !Loop over soil layers
+          DO kk = 1,nelements !Loop over elements
+             DO kkk = 1,npool !Loop over soil and litter pool
+                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)))
+               !To avoid adsorbing more DOC than existing (when there is not enough free carbon)
+                   DOC(:,m,l,iadsorbed,kkk,kk)= DOC_old(:,m,l,iadsorbed,kkk,kk)+ DOC_old(:,m,l,ifree,kkk,kk)
+                   DOC(:,m,l,ifree,kkk,kk)= zero           
+                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)))
+               !To avoid desorbing more DOC than existing (when there is not enough adsorbed carbon)
+                   DOC(:,m,l,iadsorbed,kkk,kk)= zero 
+                   DOC(:,m,l,ifree,kkk,kk)= DOC_old(:,m,l,iadsorbed,kkk,kk)+ DOC_old(:,m,l,ifree,kkk,kk)        
+                ELSEWHERE ((DOC_RE(:,m,l,kkk,kk)-DOC_old(:,m,l,iadsorbed,kkk,kk)) .NE. zero) 
+                !The normal functioning of the distribution coefficient to reach equilibrium between DOC adsorbed and DOC free   
+                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))  
+                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))
+                ELSEWHERE
+                DOC(:,m,l,ifree,kkk,kk)=DOC_old(:,m,l,ifree,kkk,kk)
+                DOC(:,m,l,iadsorbed,kkk,kk)= DOC_old(:,m,l,iadsorbed,kkk,kk)
+                ENDWHERE
+              ENDDO !End loop over soil and litter pool
+          ENDDO !End loop over elements
+    ENDDO !End loop over soil layers
+
+
+      !! 2.3.6 Transport of DOC with the water fluxes following Futter et al.,
+      ! (2007) Water ressources research. 
+
+      !! 2.3.6.1 Change DOC free from gC m-2 of soil to g C m^-3 of water  
+       DO kk = 1, nelements !Loop over elements
+
+            DO k = 1, npool ! Loop over soil and litter pools
+
+           WHERE( soil_mc(:,1,pref_soil_veg(m)) .GT. zero)
+
+             DOC(:,m,1,ifree,k,kk) = DOC(:,m,1,ifree,k,kk) / (z_soil(1)*soil_mc(:,1,pref_soil_veg(m)))
+
+           ELSEWHERE
+             DOC(:,m,1,ifree,k,kk) = DOC(:,m,1,ifree,k,kk)
+           ENDWHERE
+
+            ENDDO ! End loop over soil and litter pools
+
+       ENDDO !End loop over elements
+
+      DO l = 2,nbdl !Loop over soil layers
+
+       DO kk = 1, nelements !Loop over elements
+
+            DO k = 1, npool ! Loop over soil and litter pools
+
+           WHERE( soil_mc(:,l,pref_soil_veg(m)) .GT. zero)
+
+             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)))
+
+           ELSEWHERE
+             DOC(:,m,l,ifree,k,kk) = DOC(:,m,l,ifree,k,kk)
+           ENDWHERE
+
+            ENDDO ! End loop over soil and litter pools
+
+       ENDDO !End loop over elements
+
+     ENDDO !End loop over soil layers 
+     ! DOC fluxes between layers calculated (we multiplied by
+      ! 1E-3 to convert from kg/m2 to m3/m2)
+      ! Be careful we multiply by dt because the unit is per day in hydrol.f90 
+       DO l = 1,nbdl-1 !Loop over soil layers
+          DO kk = 1,nelements !Loop over elements
+               DO kkk = 1,npool !Loop over soil and litter pool
+
+                  WHERE ((wat_flux(:,l,pref_soil_veg(m)) .GT. 0.) .AND. (soil_mc(:,l,pref_soil_veg(m)) .GT. zero))
+                  DOC_FLUX(:,m,l,kkk,kk) = DOC(:,m,l,ifree,kkk,kk)*wat_flux(:,l,pref_soil_veg(m))*1E-3*dt
+                  ELSEWHERE ((wat_flux(:,l,pref_soil_veg(m)) .LT. 0.) .AND. (soil_mc(:,l,pref_soil_veg(m)) .GT. zero))
+                  DOC_FLUX(:,m,l,kkk,kk) = DOC(:,m,l+1,ifree,kkk,kk)*abs(wat_flux(:,l,pref_soil_veg(m)))*1E-3*dt
+                  ELSEWHERE 
+                  DOC_FLUX(:,m,l,kkk,kk) = zero
+                  ENDWHERE
+ 
+               ENDDO !End loop over soil and litter pool
+           ENDDO !End loop over elements
+      ENDDO !End loop over soil layers
+
+         !For the last layer
+          DO kk = 1,nelements !Loop over elements
+               DO kkk = 1,npool !Loop over soil and litter pool
+                  
+                  WHERE ((wat_flux(:,nbdl,pref_soil_veg(m)) .GT. 0.) .AND. (soil_mc(:,nbdl,pref_soil_veg(m)) .GT. zero))
+                  DOC_FLUX(:,m,nbdl,kkk,kk) = DOC(:,m,nbdl,ifree,kkk,kk)*wat_flux(:,nbdl,pref_soil_veg(m))*1E-3*dt
+                  ELSEWHERE 
+                  DOC_FLUX(:,m,nbdl,kkk,kk) = zero
+                  ENDWHERE
+               ENDDO !End loop over soil and litter pool
+           ENDDO !End loop over elements
+
+      !! 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
+      !For the first layer
+
+        DO k = 1, npool ! Loop over soil and litter pools
+           DO kk = 1,nelements !Loop over elements
+            WHERE(soil_mc(:,1,pref_soil_veg(m)) .GT. zero)              
+             DOC(:,m,1,ifree,k,kk)=DOC(:,m,1,ifree,k,kk) * soil_mc(:,1,pref_soil_veg(m)) * z_soil(1)
+            ELSEWHERE
+             DOC(:,m,1,ifree,k,kk)=DOC(:,m,1,ifree,k,kk) 
+            ENDWHERE      
+           ENDDO !End loop over elements
+        ENDDO ! End loop over soil and litter pools
+
+      !For the other layers
+
+     DO l= 2, nbdl ! Loop over soil layers
+        DO k = 1, npool ! Loop over soil and litter pools
+           DO kk = 1,nelements !Loop over elements
+            WHERE(soil_mc(:,l,pref_soil_veg(m)) .GT. zero)
+              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))
+            ELSEWHERE
+              DOC(:,m,l,ifree,k,kk)=DOC(:,m,l,ifree,k,kk) 
+            ENDWHERE
+           ENDDO !End loop over elements
+        ENDDO ! End loop over soil and litter pools
+      ENDDO ! End loop over soil layers
+
+       ! DOC update
+           !For the first layer
+DOC_old(:,m,:,:,:,:)= zero
+DOC_old(:,m,:,:,:,:)=DOC(:,m,:,:,:,:)
+
+        DO kk = 1,nelements !Loop over elements
+               DO kkk = 1,npool !Loop over soil and litter pool
+              
+                  WHERE (wat_flux(:,1,pref_soil_veg(m)) .GT. 0.) 
+                   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)) 
+                  ELSEWHERE (wat_flux(:,1,pref_soil_veg(m)) .LT. 0.) 
+                   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))
+                  ELSEWHERE
+                   DOC(:,m,1,ifree,kkk,kk) = DOC_old(:,m,1,ifree,kkk,kk)
+                  ENDWHERE
+ 
+               ENDDO !End loop over soil and litter pool
+           ENDDO !End loop over elements
+
+      ! For the other layers
+     DO l = 2,nbdl-1 !Loop over soil layers
+     DO kk = 1,nelements !Loop over elements
+            DO kkk = 1,npool !Loop over soil and litter pool
+                 WHERE ((wat_flux(:,l,pref_soil_veg(m)) .GT. 0.) .AND. (wat_flux(:,l-1,pref_soil_veg(m)) .GT. 0.))
+                  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))
+                 ELSEWHERE ((wat_flux(:,l,pref_soil_veg(m)) .LT. 0.) .AND. (wat_flux(:,l-1,pref_soil_veg(m)) .LT. 0.))
+                  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))
+                 ELSEWHERE ((wat_flux(:,l,pref_soil_veg(m)) .GT. 0.) .AND. (wat_flux(:,l-1,pref_soil_veg(m)) .LT. 0.))
+                  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))
+                 ELSEWHERE ((wat_flux(:,l,pref_soil_veg(m)) .LT. 0.) .AND. (wat_flux(:,l-1,pref_soil_veg(m)) .GT. 0.))
+                  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))
+                 ELSEWHERE 
+                  DOC(:,m,l,ifree,kkk,kk) = DOC_old(:,m,l,ifree,kkk,kk)
+                 ENDWHERE
+
+           ENDDO !End loop over soil and litter pool
+        ENDDO !End loop over elements
+      ENDDO !End loop over soil layers
+
+         !For the last layer
+         DO kk = 1,nelements !Loop over elements
+            DO kkk = 1,npool !Loop over soil and litter pool
+                  WHERE (wat_flux(:,nbdl-1,pref_soil_veg(m)) .GT. 0.)
+                  DOC(:,m,nbdl,ifree,kkk,kk) = DOC_old(:,m,nbdl,ifree,kkk,kk) + MIN(DOC_FLUX(:,m,nbdl-1,kkk,kk),DOC_old(:,m,nbdl-1,ifree,kkk,kk))
+                 ELSEWHERE (wat_flux(:,nbdl-1,pref_soil_veg(m)) .LT. 0.)
+                  DOC(:,m,nbdl,ifree,kkk,kk) = DOC_old(:,m,nbdl,ifree,kkk,kk) - MIN(DOC_FLUX(:,m,nbdl-1,kkk,kk),DOC_old(:,m,nbdl,ifree,kkk,kk))
+                 ELSEWHERE
+                  DOC(:,m,nbdl,ifree,kkk,kk) = DOC_old(:,m,nbdl,ifree,kkk,kk)
+                 ENDWHERE
+
+           ENDDO !End loop over soil and litter pool
+        ENDDO !End loop over elements
+
+       !! 2.3.8 DOC transport by diffusion
+       !! 2.3.8.1 Calculation of the DOC fluxes by diffusion
+       ! Here we use the DOC concentration in the soil and not in water to
+       ! stabilize the calcul of
+       ! water distribution is continuous in the soil column (no dry places)
+
+DOC_old2(:,m,:,:,:,:)=zero
+DOC_old_buffer(:,m,:,:,:,:)=zero
+DOC_old2(:,m,:,:,:,:)=DOC(:,m,:,:,:,:)
+
+     DO kkk = 1, npool ! Loop over soil and litter pools
+       DO kk = 1, nelements ! Loop over elements
+               
+        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))
+
+      DO l= 2, nbdl-1 ! Loop over soil layers
+        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))
+      ENDDO
+
+       !Below we checked if in case that, in a given layer, you have diffusion
+       !in the above and below litters, both fluxes are not higher than the
+       !stocks of the given layer.
+      DO l =1, nbdl-2
+           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. &
+                  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. &
+                  DOC_FLUX_DIFF(:,m,l,kkk,kk) + DOC_FLUX_DIFF(:,m,l+1,kkk,kk) .GT. DOC_old2(:,m,l+1,ifree,kkk,kk))
+            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)))
+            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)))
+           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. &
+                      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. &
+                      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)
+            DOC_FLUX_DIFF(:,m,l,kkk,kk) = DOC_FLUX_DIFF(:,m,l,kkk,kk)
+            DOC_FLUX_DIFF(:,m,l+1,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_FLUX_DIFF(:,m,l,kkk,kk)
+           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. &
+                      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. &
+                      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)
+            DOC_FLUX_DIFF(:,m,l,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_FLUX_DIFF(:,m,l+1,kkk,kk)
+            DOC_FLUX_DIFF(:,m,l+1,kkk,kk) = DOC_FLUX_DIFF(:,m,l+1,kkk,kk)
+           ELSEWHERE
+            DOC_FLUX_DIFF(:,m,l,kkk,kk) = DOC_FLUX_DIFF(:,m,l,kkk,kk)
+            DOC_FLUX_DIFF(:,m,l+1,kkk,kk) = DOC_FLUX_DIFF(:,m,l+1,kkk,kk)
+           ENDWHERE
+      ENDDO
+
+      DO l= 1, nbdl-1 ! Loop over soil layers
+           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. &
+                 ((DOC_FLUX_DIFF(:,m,l,kkk,kk) - DOC_old2(:,m,l+1,ifree,kkk,kk)) .GE. min_stomate))
+            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)
+            DOC_old_buffer(:,m,l+1,ifree,kkk,kk) = - DOC_old2(:,m,l+1,ifree,kkk,kk) 
+            DOC(:,m,l+1,ifree,kkk,kk) = zero
+           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. &
+                  ((DOC_old2(:,m,l+1,ifree,kkk,kk) - DOC_FLUX_DIFF(:,m,l,kkk,kk)) .GT. min_stomate))
+            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)
+            DOC_old_buffer(:,m,l+1,ifree,kkk,kk) =  - DOC_FLUX_DIFF(:,m,l,kkk,kk)
+            DOC(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) - DOC_FLUX_DIFF(:,m,l,kkk,kk)
+           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. &
+                  ((DOC_FLUX_DIFF(:,m,l,kkk,kk) - DOC_old2(:,m,l,ifree,kkk,kk)) .GE. min_stomate))
+            DOC(:,m,l,ifree,kkk,kk) = zero + DOC_old_buffer(:,m,l,ifree,kkk,kk)
+            DOC_old_buffer(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l,ifree,kkk,kk)
+            DOC(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_old2(:,m,l,ifree,kkk,kk)
+           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. &
+                  ((DOC_old2(:,m,l,ifree,kkk,kk) - DOC_FLUX_DIFF(:,m,l,kkk,kk)) .GT. min_stomate))
+            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)
+            DOC_old_buffer(:,m,l+1,ifree,kkk,kk) = DOC_FLUX_DIFF(:,m,l,kkk,kk)
+            DOC(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk) + DOC_FLUX_DIFF(:,m,l,kkk,kk)
+           ELSEWHERE
+            DOC(:,m,l,ifree,kkk,kk) = DOC_old2(:,m,l,ifree,kkk,kk)
+            DOC(:,m,l+1,ifree,kkk,kk) = DOC_old2(:,m,l+1,ifree,kkk,kk)
+           ENDWHERE
+        ENDDO ! End loop over soil layers
+       ENDDO ! End loop over elements
+      ENDDO ! End loop over DOC pools
+
+        !! 2.3.9 DOC export 
+        !! Calculate total DOC going out of the system (the factor 1E-3 is
+        !! applied to convert runoff, floodout, drainage from kg/m2 to m3/m2) 
+        !! We assume that runoff and floodout affects the first layer of soil
+        !! and drainage only the last layer. 
+        !! Drainage and runoff are given by soil type by hydrol.f90 but not floodout (it is a weighed mean) explaining why 
+        !! the calculation is a bit different between DOC_RUN and DOC_FLOOD. Moreover, floodout is computed as evaporation-precipitation,
+        !! so it represent an export to the rivers only if floodout is negative explaing why we have to multiply by -un.
+        !! Be careful we do not * by dt because it is already done in hydrol.f90
+         DO kk = 1,nelements !Loop over elements
+            DO kkk = 1,npool !Loop over soil and litter pool
+               !DOC lost through runoff for the first layer
+                 WHERE (soil_mc(:,1,pref_soil_veg(m)) .GT. zero)
+                 DOC_RUN(:,m,kk) = DOC_RUN(:,m,kk) + MIN(DOC(:,m,1,ifree,kkk,kk),&
+                                                         DOC(:,m,1,ifree,kkk,kk)*runoff_per_soil(:,pref_soil_veg(m))*1E-3/(z_soil(1) * soil_mc(:,1,pref_soil_veg(m))))
+                 ELSEWHERE
+                 DOC_RUN(:,m,kk) = DOC_RUN(:,m,kk)
+                 ENDWHERE
+
+                 WHERE ((soil_mc(:,1,pref_soil_veg(m)) .GT. zero) .AND. (floodout(:) .LT. zero))
+                 DOC_FLOOD(:,m,kk) = DOC_FLOOD(:,m,kk) + MIN(DOC(:,m,1,ifree,kkk,kk),&
+                                                                 DOC(:,m,1,ifree,kkk,kk)*moins_un*floodout(:)*1E-3/(z_soil(1) * moist_soil(:,1)))
+                 ELSEWHERE
+                 DOC_FLOOD(:,m,kk) = DOC_FLOOD(:,m,kk)
+                 ENDWHERE
+
+                 WHERE (soil_mc(:,nbdl,pref_soil_veg(m)) .GT. zero)
+                 DOC_DRAIN(:,m,kk) = DOC_DRAIN(:,m,kk) + MIN(DOC(:,m,nbdl,ifree,kkk,kk),&
+                                                             DOC(:,m,nbdl,ifree,kkk,kk)*drainage_per_soil(:,pref_soil_veg(m))*1E-3/((z_soil(nbdl)-z_soil(nbdl-1)) * soil_mc(:,nbdl,pref_soil_veg(m))))
+                 ELSEWHERE
+                 DOC_DRAIN(:,m,kk) = DOC_DRAIN(:,m,kk)
+                 ENDWHERE
+
+           ENDDO !End loop over soil and litter pool
+        ENDDO !End loop over elements
+
+         DO kk = 1,nelements !Loop over elements
+             DOC_EXP(:,m,irunoff,kk) = DOC_RUN(:,m,kk)/dt
+             DOC_EXP(:,m,iflooded,kk) = DOC_FLOOD(:,m,kk)/dt
+             DOC_EXP(:,m,idrainage,kk) = DOC_DRAIN(:,m,kk)/dt
+        ENDDO !End loop over elements
+! We substract runoff, floodout and drainage from DOC pools
+    DO kkk = 1,npool !Loop over soil and litter pool    
+          DO kk = 1, nelements
+
+!For the first layer
+           WHERE (soil_mc(:,1,pref_soil_veg(m)) .GT. zero)
+           DOC(:,m,1,ifree,kkk,kk) = DOC(:,m,1,ifree,kkk,kk) -  &
+                                       MIN(DOC(:,m,1,ifree,kkk,kk),&
+                                           DOC(:,m,1,ifree,kkk,kk)*runoff_per_soil(:,pref_soil_veg(m))*1E-3/(z_soil(1) * soil_mc(:,1,pref_soil_veg(m))))
+
+           ELSEWHERE
+           DOC(:,m,1,ifree,kkk,kk) = DOC(:,m,1,ifree,kkk,kk)
+           ENDWHERE
+
+           WHERE ((soil_mc(:,1,pref_soil_veg(m)) .GT. zero) .AND. (floodout(:) .LT. zero))
+           DOC(:,m,1,ifree,kkk,kk) = DOC(:,m,1,ifree,kkk,kk) -  &
+                                      MIN(DOC(:,m,1,ifree,kkk,kk),&
+                                           DOC(:,m,1,ifree,kkk,kk)*moins_un*floodout(:)*1E-3/(z_soil(1) * moist_soil(:,1)))
+
+           ELSEWHERE
+           DOC(:,m,1,ifree,kkk,kk) = DOC(:,m,1,ifree,kkk,kk)
+           ENDWHERE
+
+!For the last layer
+           WHERE (soil_mc(:,nbdl,pref_soil_veg(m)) .GT. zero)
+           DOC(:,m,nbdl,ifree,kkk,kk) = DOC(:,m,nbdl,ifree,kkk,kk) - &
+                                        MIN (DOC(:,m,nbdl,ifree,kkk,kk),&
+                                            DOC(:,m,nbdl,ifree,kkk,kk)*drainage_per_soil(:,pref_soil_veg(m))*1E-3/((z_soil(nbdl)-z_soil(nbdl-1)) * soil_mc(:,nbdl,pref_soil_veg(m))))
+           ELSEWHERE
+           DOC(:,m,nbdl,ifree,kkk,kk) = DOC(:,m,nbdl,ifree,kkk,kk)
+           ENDWHERE
+         ENDDO ! End loop over elements
+    ENDDO !End loop over soil and litter pool
+
+      !! 2.3.10 Transport of particulate organic C (i.e. active, slow and passive
+      !! pools) following the second Fick's Law (OÂ¿Brien and Stout, 1978; Wynn
+      !! et al., 2005). Represent the bioturbation and is generally associated
+      !! with transport  plant debris (Elzein and Balesdent, 1995; Bruun et al., 
+      !! 2007; Braakhekke et al., 2011, Guenet et al., 2013) 
+
+      ! Definition of the diffusion rate from Guenet et al., (2013) BG for the
+      ! moment but must depends on clay, ph organic C, or whatever...
+      
+
+carbon_old(:,:,m,:)=zero
+carbon_old_buffer(:,:,m,:)=zero
+carbon_old(:,:,m,:)=carbon(:,:,m,:)
+
+     DO kk = 1, ncarb ! Loop over soil and litter pools
+
+        carbon_flux(:,kk,m,1) = Dif_coef(:)*dt*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))
+
+      DO l= 2, nbdl-1 ! Loop over soil layers
+        carbon_flux(:,kk,m,l) = Dif_coef(:)*dt*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))
+      ENDDO
+        carbon_flux_old(:,kk,m,:) = carbon_flux(:,kk,m,:)
+
+       !Below we checked if in case that, in a given layer, you have diffusion
+       !in the above and below litters, both fluxes are not higher than the
+       !stocks of the given layer.
+
+      DO l =1, nbdl-2
+           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. &
+                  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. &
+                  carbon_flux(:,kk,m,l)+carbon_flux(:,kk,m,l+1) .GT. carbon_old(:,kk,m,l+1))
+            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)))
+            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)))
+           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. &
+                      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. &
+                      carbon_old(:,kk,m,l+1) + carbon_flux(:,kk,m,l) - carbon_flux(:,kk,m,l+1) .LE. min_stomate)
+            carbon_flux(:,kk,m,l) = carbon_flux(:,kk,m,l)
+            carbon_flux(:,kk,m,l+1) = carbon_old(:,kk,m,l+1) + carbon_flux(:,kk,m,l)
+           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. &
+                      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. &
+                      carbon_old(:,kk,m,l+1) - carbon_flux(:,kk,m,l) + carbon_flux(:,kk,m,l+1) .LE. min_stomate)
+            carbon_flux(:,kk,m,l) = carbon_old(:,kk,m,l+1) + carbon_flux(:,kk,m,l+1)
+            carbon_flux(:,kk,m,l+1) = carbon_flux(:,kk,m,l+1)
+           ELSEWHERE
+            carbon_flux(:,kk,m,l) = carbon_flux(:,kk,m,l)
+            carbon_flux(:,kk,m,l+1) = carbon_flux(:,kk,m,l+1)
+           ENDWHERE
+      ENDDO
+
+      DO l= 1, nbdl-1 ! Loop over soil layers
+           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. &
+                 ((carbon_flux(:,kk,m,l) - carbon_old(:,kk,m,l+1)) .GE. min_stomate))
+            carbon(:,kk,m,l) = carbon_old(:,kk,m,l) + carbon_old(:,kk,m,l+1) + carbon_old_buffer(:,kk,m,l)
+            carbon_old_buffer(:,kk,m,l+1) = -carbon_old(:,kk,m,l+1) 
+            carbon(:,kk,m,l+1) = zero
+           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. &
+                  ((carbon_old(:,kk,m,l+1) - carbon_flux(:,kk,m,l)) .GT. min_stomate))
+            carbon(:,kk,m,l) = carbon_old(:,kk,m,l) + carbon_flux(:,kk,m,l) + carbon_old_buffer(:,kk,m,l)
+            carbon_old_buffer(:,kk,m,l+1) =  - carbon_flux(:,kk,m,l)
+            carbon(:,kk,m,l+1) = carbon_old(:,kk,m,l+1) - carbon_flux(:,kk,m,l)
+           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. &
+                  ((carbon_flux(:,kk,m,l) - carbon_old(:,kk,m,l)) .GE. min_stomate))
+            carbon(:,kk,m,l) =zero + carbon_old_buffer(:,kk,m,l)
+            carbon_old_buffer(:,kk,m,l+1) = carbon_old(:,kk,m,l)
+            carbon(:,kk,m,l+1) = carbon_old(:,kk,m,l+1) + carbon_old(:,kk,m,l)
+           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. &
+                  ((carbon_old(:,kk,m,l) - carbon_flux(:,kk,m,l)) .GT. min_stomate))
+            carbon(:,kk,m,l) = carbon_old(:,kk,m,l) - carbon_flux(:,kk,m,l) + carbon_old_buffer(:,kk,m,l)
+            carbon_old_buffer(:,kk,m,l+1) = carbon_flux(:,kk,m,l)
+            carbon(:,kk,m,l+1) = carbon_old(:,kk,m,l+1) + carbon_flux(:,kk,m,l)
+           ELSEWHERE
+            carbon(:,kk,m,l) = carbon_old(:,kk,m,l)
+            carbon(:,kk,m,l+1) = carbon_old(:,kk,m,l+1)
+           ENDWHERE
+        ENDDO ! End loop over soil layers
+
+
+
+      ENDDO ! End loop over carbon pools
+  ENDDO ! End loop over PFTs
+
+!! 3. Check mass balance closure
+IF (control%ld_doc) THEN    
+    !! 3.1 Calculate components of the mass balance
+    pool_end(:,:,:) = zero 
+
+!Ending carbon pool
+    DO m = 1, nvm
+       DO i = 1,ncarb
+          DO l = 1, nbdl
+                 pool_end(:,m,icarbon) = pool_end(:,m,icarbon) + &
+                           ( carbon(:,i,m,l)* veget_max(:,m) ) 
+          ENDDO
+       ENDDO
+    ENDDO
+
+!Ending DOC pool
+    DO m = 1, nvm
+       DO i = 1,npool
+          DO l = 1, nbdl
+             DO j = 1, ndoc
+                    pool_end(:,m,icarbon) = pool_end(:,m,icarbon) + &
+                              ( DOC(:,m,l,j,i,icarbon) * veget_max(:,m)) 
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
+WRITE(numout,*) " pool_start(:,m,icarbon) soil=",  pool_start(:,4,icarbon)
+WRITE(numout,*) " pool_end(:,m,icarbon) soil=",  pool_end(:,4,icarbon)
+
+ !! 3.2 Calculate mass balance
+    !  Note that soilcarbon is transfered to other pools but that the pool
+    !  was not updated. We should not account for it in ::pool_end
+    check_intern(:,:,:,:) = zero
+    check_intern(:,:,iatm2land,icarbon) = zero
+
+    
+    check_intern(:,:,iland2atm,icarbon) = -un * resp_hetero_soil(:,:) * &
+         veget_max(:,:) * dt 
+    check_intern(:,:,ilat2out,icarbon) = -un * (DOC_EXP(:,:,irunoff,icarbon)+ &
+         DOC_EXP(:,:,iflooded,icarbon)+ DOC_EXP(:,:,idrainage,icarbon)) * veget_max(:,:) * dt
+    check_intern(:,:,ilat2in,icarbon) = un * zero
+    check_intern(:,:,ipoolchange,icarbon) = -un * (pool_end(:,:,icarbon) - &
+         pool_start(:,:,icarbon))
+    
+
+    closure_intern = zero
+
+    DO i = 1,nmbcomp
+       closure_intern(:,:,icarbon) = closure_intern(:,:,icarbon) + &
+           check_intern(:,:,i,icarbon)
+    ENDDO
+
+!! 3.3 Write verdict
+    IF (SUM(SUM(closure_intern(:,:,icarbon),2),1) .LT. min_stomate .AND. &
+         SUM(SUM(closure_intern(:,:,icarbon),2),1) .GT. -min_stomate) THEN
+       WRITE(numout,*) 'Mass balance closure in stomate_soilcarbon.f90'
+    ELSE
+       WRITE(numout,*) 'Error: mass balance is not closed in stomate_soilcarbon.f90'
+       WRITE(numout,*) '   Difference is, ', SUM(SUM(closure_intern(:,:,icarbon),2),1) 
+   ENDIF
+ENDIF
+
+ !! 4. (Quasi-)Analytical Spin-up
+    
+    !! 4.1.1 Finish to fill MatrixA with fluxes between soil pools
+    
+    IF (spinup_analytic) THEN
+
+       DO m = 2,nvm 
+
+          ! flux leaving the active pools
+          MatrixA(:,m,iactive_pool_z1,iactive_pool_z1) = moins_un * &
+               dt/carbon_tau(iactive) * (1-exp(-priming_param(iactive)*LOM(:,m,1)))*&
+               control_moist_soil(:,1,m) * control_temp_soil(:,1,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:))
+
+          MatrixA(:,m,iactive_pool_z2,iactive_pool_z2) = moins_un * &
+               dt/carbon_tau(iactive) * (1-exp(-priming_param(iactive)*LOM(:,m,2)))*&
+               control_moist_soil(:,2,m) * control_temp_soil(:,2,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:))
+
+          MatrixA(:,m,iactive_pool_z3,iactive_pool_z3) = moins_un * &
+               dt/carbon_tau(iactive) * (1-exp(-priming_param(iactive)*LOM(:,m,3)))*&
+               control_moist_soil(:,3,m) * control_temp_soil(:,3,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:))
+
+          MatrixA(:,m,iactive_pool_z4,iactive_pool_z4) = moins_un * &
+               dt/carbon_tau(iactive) * (1-exp(-priming_param(iactive)*LOM(:,m,4)))*&
+               control_moist_soil(:,4,m) * control_temp_soil(:,4,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:))
+
+          MatrixA(:,m,iactive_pool_z5,iactive_pool_z5) = moins_un * &
+               dt/carbon_tau(iactive) * (1-exp(-priming_param(iactive)*LOM(:,m,5)))*&
+               control_moist_soil(:,5,m) * control_temp_soil(:,5,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:))
+
+          MatrixA(:,m,iactive_pool_z6,iactive_pool_z6) = moins_un * &
+               dt/carbon_tau(iactive) * (1-exp(-priming_param(iactive)*LOM(:,m,6)))*&
+               control_moist_soil(:,6,m) * control_temp_soil(:,6,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:))
+
+          MatrixA(:,m,iactive_pool_z7,iactive_pool_z7) = moins_un * &
+               dt/carbon_tau(iactive) * (1-exp(-priming_param(iactive)*LOM(:,m,7)))*&
+               control_moist_soil(:,7,m) * control_temp_soil(:,7,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:))
+
+          MatrixA(:,m,iactive_pool_z8,iactive_pool_z8) = moins_un * &
+               dt/carbon_tau(iactive) * (1-exp(-priming_param(iactive)*LOM(:,m,8)))*&
+               control_moist_soil(:,8,m) * control_temp_soil(:,8,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:))
+
+          MatrixA(:,m,iactive_pool_z9,iactive_pool_z9) = moins_un * &
+               dt/carbon_tau(iactive) * (1-exp(-priming_param(iactive)*LOM(:,m,9)))*&
+               control_moist_soil(:,9,m) * control_temp_soil(:,9,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:))
+
+          MatrixA(:,m,iactive_pool_z10,iactive_pool_z10) = moins_un * &
+               dt/carbon_tau(iactive) * (1-exp(-priming_param(iactive)*LOM(:,m,10)))*&
+               control_moist_soil(:,10,m) * control_temp_soil(:,10,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:))
+
+          MatrixA(:,m,iactive_pool_z11,iactive_pool_z11) = moins_un * &
+               dt/carbon_tau(iactive) * (1-exp(-priming_param(iactive)*LOM(:,m,11)))*&
+               control_moist_soil(:,11,m) * control_temp_soil(:,11,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:))
+
+
+
+          ! flux received by the active pool from the slow pool
+          MatrixA(:,m,iactive_pool_z1,islow_pool_z1) = frac_carb(:,islow,iactive)*dt/carbon_tau(islow) * &
+               control_moist_soil(:,1,m) * control_temp_soil(:,1,islo)*(1-exp(-priming_param(islow)*LOM(:,m,1)))
+
+          MatrixA(:,m,iactive_pool_z2,islow_pool_z2) = frac_carb(:,islow,iactive)*dt/carbon_tau(islow) * &
+               control_moist_soil(:,2,m) * control_temp_soil(:,2,islo)*(1-exp(-priming_param(islow)*LOM(:,m,2)))
+
+          MatrixA(:,m,iactive_pool_z3,islow_pool_z3) = frac_carb(:,islow,iactive)*dt/carbon_tau(islow) * &
+               control_moist_soil(:,3,m) * control_temp_soil(:,3,islo)*(1-exp(-priming_param(islow)*LOM(:,m,3)))
+
+          MatrixA(:,m,iactive_pool_z4,islow_pool_z4) = frac_carb(:,islow,iactive)*dt/carbon_tau(islow) * &
+               control_moist_soil(:,4,m) * control_temp_soil(:,4,islo)*(1-exp(-priming_param(islow)*LOM(:,m,4)))
+
+          MatrixA(:,m,iactive_pool_z5,islow_pool_z5) = frac_carb(:,islow,iactive)*dt/carbon_tau(islow) * &
+               control_moist_soil(:,5,m) * control_temp_soil(:,5,islo)*(1-exp(-priming_param(islow)*LOM(:,m,5)))
+
+          MatrixA(:,m,iactive_pool_z6,islow_pool_z6) = frac_carb(:,islow,iactive)*dt/carbon_tau(islow) * &
+               control_moist_soil(:,6,m) * control_temp_soil(:,6,islo)*(1-exp(-priming_param(islow)*LOM(:,m,6)))
+
+          MatrixA(:,m,iactive_pool_z7,islow_pool_z7) = frac_carb(:,islow,iactive)*dt/carbon_tau(islow) * &
+               control_moist_soil(:,7,m) * control_temp_soil(:,7,islo)*(1-exp(-priming_param(islow)*LOM(:,m,7)))
+
+          MatrixA(:,m,iactive_pool_z8,islow_pool_z8) = frac_carb(:,islow,iactive)*dt/carbon_tau(islow) * &
+               control_moist_soil(:,8,m) * control_temp_soil(:,8,islo)*(1-exp(-priming_param(islow)*LOM(:,m,8)))
+
+          MatrixA(:,m,iactive_pool_z9,islow_pool_z9) = frac_carb(:,islow,iactive)*dt/carbon_tau(islow) * &
+               control_moist_soil(:,9,m) * control_temp_soil(:,9,islo)*(1-exp(-priming_param(islow)*LOM(:,m,9)))
+
+          MatrixA(:,m,iactive_pool_z10,islow_pool_z10) = frac_carb(:,islow,iactive)*dt/carbon_tau(islow) * &
+               control_moist_soil(:,10,m) * control_temp_soil(:,10,islo)*(1-exp(-priming_param(islow)*LOM(:,m,10)))
+
+          MatrixA(:,m,iactive_pool_z11,islow_pool_z11) = frac_carb(:,islow,iactive)*dt/carbon_tau(islow) * &
+               control_moist_soil(:,11,m) * control_temp_soil(:,11,islo)*(1-exp(-priming_param(islow)*LOM(:,m,11)))
+
+          ! flux received by the active pool from the passive pool
+          MatrixA(:,m,iactive_pool_z1,ipassive_pool_z1) = frac_carb(:,ipassive,iactive)*dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,1,m) * control_temp_soil(:,1,islo)*(1-exp(-priming_param(islow)*LOM(:,m,1)))
+
+          MatrixA(:,m,iactive_pool_z2,ipassive_pool_z2) = frac_carb(:,ipassive,iactive)*dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,2,m) * control_temp_soil(:,2,islo)*(1-exp(-priming_param(islow)*LOM(:,m,2)))
+
+          MatrixA(:,m,iactive_pool_z3,ipassive_pool_z3) = frac_carb(:,ipassive,iactive)*dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,3,m) * control_temp_soil(:,3,islo)*(1-exp(-priming_param(islow)*LOM(:,m,3)))
+
+          MatrixA(:,m,iactive_pool_z4,ipassive_pool_z4) = frac_carb(:,ipassive,iactive)*dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,4,m) * control_temp_soil(:,4,islo)*(1-exp(-priming_param(islow)*LOM(:,m,4)))
+
+          MatrixA(:,m,iactive_pool_z5,ipassive_pool_z5) = frac_carb(:,ipassive,iactive)*dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,5,m) * control_temp_soil(:,5,islo)*(1-exp(-priming_param(islow)*LOM(:,m,5)))
+
+          MatrixA(:,m,iactive_pool_z6,ipassive_pool_z6) = frac_carb(:,ipassive,iactive)*dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,6,m) * control_temp_soil(:,6,islo)*(1-exp(-priming_param(islow)*LOM(:,m,6)))
+
+          MatrixA(:,m,iactive_pool_z7,ipassive_pool_z7) = frac_carb(:,ipassive,iactive)*dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,7,m) * control_temp_soil(:,7,islo)*(1-exp(-priming_param(islow)*LOM(:,m,7)))
+
+          MatrixA(:,m,iactive_pool_z8,ipassive_pool_z8) = frac_carb(:,ipassive,iactive)*dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,8,m) * control_temp_soil(:,8,islo)*(1-exp(-priming_param(islow)*LOM(:,m,8)))
+
+          MatrixA(:,m,iactive_pool_z9,ipassive_pool_z9) = frac_carb(:,ipassive,iactive)*dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,9,m) * control_temp_soil(:,9,islo)*(1-exp(-priming_param(islow)*LOM(:,m,9)))
+
+          MatrixA(:,m,iactive_pool_z10,ipassive_pool_z10) = frac_carb(:,ipassive,iactive)*dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,10,m) * control_temp_soil(:,10,islo)*(1-exp(-priming_param(islow)*LOM(:,m,10)))
+
+          MatrixA(:,m,iactive_pool_z11,ipassive_pool_z11) = frac_carb(:,ipassive,iactive)*dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,11,m) * control_temp_soil(:,11,islo)*(1-exp(-priming_param(islow)*LOM(:,m,11)))
+
+          ! flux received by the slow pool from the active pool
+          MatrixA(:,m,islow_pool_z1,iactive_pool_z1) = frac_carb(:,iactive,islow) *&
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,1,m) * control_temp_soil(:,1,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:) * (1-exp(-priming_param(iactive)*LOM(:,m,1))))
+
+          MatrixA(:,m,islow_pool_z2,iactive_pool_z2) = frac_carb(:,iactive,islow) *&
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,2,m) * control_temp_soil(:,2,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:) * (1-exp(-priming_param(iactive)*LOM(:,m,2))))
+
+          MatrixA(:,m,islow_pool_z3,iactive_pool_z3) = frac_carb(:,iactive,islow) *&
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,3,m) * control_temp_soil(:,3,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:) * (1-exp(-priming_param(iactive)*LOM(:,m,3))))
+
+          MatrixA(:,m,islow_pool_z4,iactive_pool_z4) = frac_carb(:,iactive,islow) *&
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,4,m) * control_temp_soil(:,4,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:) * (1-exp(-priming_param(iactive)*LOM(:,m,4))))
+
+          MatrixA(:,m,islow_pool_z5,iactive_pool_z5) = frac_carb(:,iactive,islow) *&
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,5,m) * control_temp_soil(:,5,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:) * (1-exp(-priming_param(iactive)*LOM(:,m,5))))
+
+          MatrixA(:,m,islow_pool_z6,iactive_pool_z6) = frac_carb(:,iactive,islow) *&
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,6,m) * control_temp_soil(:,6,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:) * (1-exp(-priming_param(iactive)*LOM(:,m,6))))
+
+          MatrixA(:,m,islow_pool_z7,iactive_pool_z7) = frac_carb(:,iactive,islow) *&
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,7,m) * control_temp_soil(:,7,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:) * (1-exp(-priming_param(iactive)*LOM(:,m,7))))
+
+          MatrixA(:,m,islow_pool_z8,iactive_pool_z8) = frac_carb(:,iactive,islow) *&
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,8,m) * control_temp_soil(:,8,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:) * (1-exp(-priming_param(iactive)*LOM(:,m,8))))
+
+          MatrixA(:,m,islow_pool_z9,iactive_pool_z9) = frac_carb(:,iactive,islow) *&
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,9,m) * control_temp_soil(:,9,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:) * (1-exp(-priming_param(iactive)*LOM(:,m,9))))
+
+          MatrixA(:,m,islow_pool_z10,iactive_pool_z10) = frac_carb(:,iactive,islow) *&
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,10,m) * control_temp_soil(:,10,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:) * (1-exp(-priming_param(iactive)*LOM(:,m,10))))
+
+          MatrixA(:,m,islow_pool_z11,iactive_pool_z11) = frac_carb(:,iactive,islow) *&
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,11,m) * control_temp_soil(:,11,iact) * &
+               ( 1. - flux_tot_coeff(3) * clay(:) * (1-exp(-priming_param(iactive)*LOM(:,m,11))))
+
+          ! flux leaving the slow pool
+          MatrixA(:,m,islow_pool_z1,islow_pool_z1) = moins_un * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,1,m) * control_temp_soil(:,1,islo) * (1-exp(-priming_param(islow)*LOM(:,m,1)))
+
+          MatrixA(:,m,islow_pool_z2,islow_pool_z2) = moins_un * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,2,m) * control_temp_soil(:,2,islo) * (1-exp(-priming_param(islow)*LOM(:,m,2)))
+
+          MatrixA(:,m,islow_pool_z3,islow_pool_z3) = moins_un * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,3,m) * control_temp_soil(:,3,islo) * (1-exp(-priming_param(islow)*LOM(:,m,3)))
+
+          MatrixA(:,m,islow_pool_z4,islow_pool_z4) = moins_un * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,4,m) * control_temp_soil(:,4,islo) * (1-exp(-priming_param(islow)*LOM(:,m,4)))
+
+          MatrixA(:,m,islow_pool_z5,islow_pool_z5) = moins_un * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,5,m) * control_temp_soil(:,5,islo) * (1-exp(-priming_param(islow)*LOM(:,m,5)))
+
+          MatrixA(:,m,islow_pool_z6,islow_pool_z6) = moins_un * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,6,m) * control_temp_soil(:,6,islo) * (1-exp(-priming_param(islow)*LOM(:,m,6)))
+
+          MatrixA(:,m,islow_pool_z7,islow_pool_z7) = moins_un * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,7,m) * control_temp_soil(:,7,islo) * (1-exp(-priming_param(islow)*LOM(:,m,7)))
+
+          MatrixA(:,m,islow_pool_z8,islow_pool_z8) = moins_un * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,8,m) * control_temp_soil(:,8,islo) * (1-exp(-priming_param(islow)*LOM(:,m,8)))
+
+          MatrixA(:,m,islow_pool_z9,islow_pool_z9) = moins_un * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,9,m) * control_temp_soil(:,9,islo) * (1-exp(-priming_param(islow)*LOM(:,m,9)))
+
+          MatrixA(:,m,islow_pool_z10,islow_pool_z10) = moins_un * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,10,m) * control_temp_soil(:,10,islo) * (1-exp(-priming_param(islow)*LOM(:,m,10)))
+
+          MatrixA(:,m,islow_pool_z11,islow_pool_z11) = moins_un * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,11,m) * control_temp_soil(:,11,islo) * (1-exp(-priming_param(islow)*LOM(:,m,11)))
+
+          ! flux received by the passive pool from the active pool
+          MatrixA(:,m,ipassive_pool_z1,iactive_pool_z1) = frac_carb(:,iactive,ipassive)* &
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,1,m) * control_temp_soil(:,1,iact) *&
+               ( 1. - flux_tot_coeff(3) * clay(:) ) * (1-exp(-priming_param(iactive)*LOM(:,m,1)))
+
+          MatrixA(:,m,ipassive_pool_z2,iactive_pool_z2) = frac_carb(:,iactive,ipassive)* &
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,2,m) * control_temp_soil(:,2,iact) *&
+               ( 1. - flux_tot_coeff(3) * clay(:) ) * (1-exp(-priming_param(iactive)*LOM(:,m,2)))
+
+          MatrixA(:,m,ipassive_pool_z3,iactive_pool_z3) = frac_carb(:,iactive,ipassive)* &
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,3,m) * control_temp_soil(:,3,iact) *&
+               ( 1. - flux_tot_coeff(3) * clay(:) ) * (1-exp(-priming_param(iactive)*LOM(:,m,3)))
+
+          MatrixA(:,m,ipassive_pool_z4,iactive_pool_z4) =frac_carb(:,iactive,ipassive)* &
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,4,m) * control_temp_soil(:,4,iact) *&
+               ( 1. - flux_tot_coeff(3) * clay(:) ) * (1-exp(-priming_param(iactive)*LOM(:,m,4)))
+
+          MatrixA(:,m,ipassive_pool_z5,iactive_pool_z5) = frac_carb(:,iactive,ipassive)* &
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,5,m) * control_temp_soil(:,5,iact) *&
+               ( 1. - flux_tot_coeff(3) * clay(:) ) * (1-exp(-priming_param(iactive)*LOM(:,m,5)))
+
+          MatrixA(:,m,ipassive_pool_z6,iactive_pool_z6) = frac_carb(:,iactive,ipassive)* &
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,6,m) * control_temp_soil(:,6,iact) *&
+               ( 1. - flux_tot_coeff(3) * clay(:) ) * (1-exp(-priming_param(iactive)*LOM(:,m,6)))
+
+          MatrixA(:,m,ipassive_pool_z7,iactive_pool_z7) = frac_carb(:,iactive,ipassive)* &
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,7,m) * control_temp_soil(:,7,iact) *&
+               ( 1. - flux_tot_coeff(3) * clay(:) ) * (1-exp(-priming_param(iactive)*LOM(:,m,7)))
+
+          MatrixA(:,m,ipassive_pool_z8,iactive_pool_z8) = frac_carb(:,iactive,ipassive)* &
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,8,m) * control_temp_soil(:,8,iact) *&
+               ( 1. - flux_tot_coeff(3) * clay(:) ) * (1-exp(-priming_param(iactive)*LOM(:,m,8)))
+
+          MatrixA(:,m,ipassive_pool_z9,iactive_pool_z9) = frac_carb(:,iactive,ipassive)* &
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,9,m) * control_temp_soil(:,9,iact) *&
+               ( 1. - flux_tot_coeff(3) * clay(:) ) * (1-exp(-priming_param(iactive)*LOM(:,m,9)))
+
+          MatrixA(:,m,ipassive_pool_z10,iactive_pool_z10) = frac_carb(:,iactive,ipassive)* &
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,10,m) * control_temp_soil(:,10,iact) *&
+               ( 1. - flux_tot_coeff(3) * clay(:) ) * (1-exp(-priming_param(iactive)*LOM(:,m,10)))
+
+          MatrixA(:,m,ipassive_pool_z11,iactive_pool_z11) = frac_carb(:,iactive,ipassive)* &
+               dt/carbon_tau(iactive) * &
+               control_moist_soil(:,11,m) * control_temp_soil(:,11,iact) *&
+               ( 1. - flux_tot_coeff(3) * clay(:) ) * (1-exp(-priming_param(iactive)*LOM(:,m,11)))
+
+          ! flux received by the passive pool from the slow pool
+          MatrixA(:,m,ipassive_pool_z1,islow_pool_z1) =  frac_carb(:,islow,ipassive) * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,1,m) * control_temp_soil(:,1,islo) * (1-exp(-priming_param(islow)*LOM(:,m,1)))
+
+          MatrixA(:,m,ipassive_pool_z2,islow_pool_z2) = frac_carb(:,islow,ipassive) * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,2,m) * control_temp_soil(:,2,islo) * (1-exp(-priming_param(islow)*LOM(:,m,2)))
+
+          MatrixA(:,m,ipassive_pool_z3,islow_pool_z3) = frac_carb(:,islow,ipassive) * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,3,m) * control_temp_soil(:,3,islo) * (1-exp(-priming_param(islow)*LOM(:,m,3)))
+
+          MatrixA(:,m,ipassive_pool_z4,islow_pool_z4) = frac_carb(:,islow,ipassive) * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,4,m) * control_temp_soil(:,4,islo) * (1-exp(-priming_param(islow)*LOM(:,m,4)))
+
+          MatrixA(:,m,ipassive_pool_z5,islow_pool_z5) = frac_carb(:,islow,ipassive) * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,5,m) * control_temp_soil(:,5,islo) * (1-exp(-priming_param(islow)*LOM(:,m,5)))
+
+          MatrixA(:,m,ipassive_pool_z6,islow_pool_z6) = frac_carb(:,islow,ipassive) * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,6,m) * control_temp_soil(:,6,islo) * (1-exp(-priming_param(islow)*LOM(:,m,6)))
+
+          MatrixA(:,m,ipassive_pool_z7,islow_pool_z7) = frac_carb(:,islow,ipassive) * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,7,m) * control_temp_soil(:,7,islo) * (1-exp(-priming_param(islow)*LOM(:,m,7)))
+
+          MatrixA(:,m,ipassive_pool_z8,islow_pool_z8) = frac_carb(:,islow,ipassive) * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,8,m) * control_temp_soil(:,8,islo) * (1-exp(-priming_param(islow)*LOM(:,m,8)))
+
+          MatrixA(:,m,ipassive_pool_z9,islow_pool_z9) = frac_carb(:,islow,ipassive) * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,9,m) * control_temp_soil(:,9,islo) * (1-exp(-priming_param(islow)*LOM(:,m,9)))
+
+          MatrixA(:,m,ipassive_pool_z10,islow_pool_z10) = frac_carb(:,islow,ipassive) * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,10,m) * control_temp_soil(:,10,islo) * (1-exp(-priming_param(islow)*LOM(:,m,10)))
+
+          MatrixA(:,m,ipassive_pool_z11,islow_pool_z11) = frac_carb(:,islow,ipassive) * &
+               dt/carbon_tau(islow) * &
+               control_moist_soil(:,11,m) * control_temp_soil(:,11,islo) * (1-exp(-priming_param(islow)*LOM(:,m,11)))
+
+          ! flux leaving the passive pool
+          MatrixA(:,m,ipassive_pool_z1,ipassive_pool_z1) =  moins_un * &
+               dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,1,m) * control_temp_soil(:,1,ipas) * (1-exp(-priming_param(ipassive)*LOM(:,m,1)))    
+
+          MatrixA(:,m,ipassive_pool_z2,ipassive_pool_z2) =  moins_un * &
+               dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,2,m) * control_temp_soil(:,2,ipas) * (1-exp(-priming_param(ipassive)*LOM(:,m,2)))
+
+          MatrixA(:,m,ipassive_pool_z3,ipassive_pool_z3) =  moins_un * &
+               dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,3,m) * control_temp_soil(:,3,ipas) * (1-exp(-priming_param(ipassive)*LOM(:,m,3)))
+
+          MatrixA(:,m,ipassive_pool_z4,ipassive_pool_z4) =  moins_un * &
+               dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,4,m) * control_temp_soil(:,4,ipas) * (1-exp(-priming_param(ipassive)*LOM(:,m,4)))
+
+          MatrixA(:,m,ipassive_pool_z5,ipassive_pool_z5) =  moins_un * &
+               dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,5,m) * control_temp_soil(:,5,ipas) * (1-exp(-priming_param(ipassive)*LOM(:,m,5)))
+
+          MatrixA(:,m,ipassive_pool_z6,ipassive_pool_z6) =  moins_un * &
+               dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,6,m) * control_temp_soil(:,6,ipas) * (1-exp(-priming_param(ipassive)*LOM(:,m,6)))
+
+          MatrixA(:,m,ipassive_pool_z7,ipassive_pool_z7) =  moins_un * &
+               dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,7,m) * control_temp_soil(:,7,ipas) * (1-exp(-priming_param(ipassive)*LOM(:,m,7)))
+
+          MatrixA(:,m,ipassive_pool_z8,ipassive_pool_z8) =  moins_un * &
+               dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,8,m) * control_temp_soil(:,8,ipas) * (1-exp(-priming_param(ipassive)*LOM(:,m,8)))
+
+          MatrixA(:,m,ipassive_pool_z9,ipassive_pool_z9) =  moins_un * &
+               dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,9,m) * control_temp_soil(:,9,ipas) * (1-exp(-priming_param(ipassive)*LOM(:,m,9)))
+
+          MatrixA(:,m,ipassive_pool_z10,ipassive_pool_z10) =  moins_un * &
+               dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,10,m) * control_temp_soil(:,10,ipas) *  (1-exp(-priming_param(ipassive)*LOM(:,m,10))) 
+
+          MatrixA(:,m,ipassive_pool_z11,ipassive_pool_z11) =  moins_un * &
+               dt/carbon_tau(ipassive) * &
+               control_moist_soil(:,11,m) * control_temp_soil(:,11,ipas) * (1-exp(-priming_param(ipassive)*LOM(:,m,11)))
+
+
+          IF ( (.NOT. natural(m)) .AND. (.NOT. is_c4(m)) ) THEN ! C3crop
+
+             ! flux leaving the active pool
+             MatrixA(:,m,iactive_pool_z1,iactive_pool_z1) = MatrixA(:,m,iactive_pool_z1,iactive_pool_z1) * &
+                  flux_tot_coeff(1)  
+
+             MatrixA(:,m,iactive_pool_z2,iactive_pool_z2) = MatrixA(:,m,iactive_pool_z2,iactive_pool_z2) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z3,iactive_pool_z3) = MatrixA(:,m,iactive_pool_z3,iactive_pool_z3) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z4,iactive_pool_z4) = MatrixA(:,m,iactive_pool_z4,iactive_pool_z4) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z5,iactive_pool_z5) = MatrixA(:,m,iactive_pool_z5,iactive_pool_z5) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z6,iactive_pool_z6) = MatrixA(:,m,iactive_pool_z6,iactive_pool_z6) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z7,iactive_pool_z7) = MatrixA(:,m,iactive_pool_z7,iactive_pool_z7) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z8,iactive_pool_z8) = MatrixA(:,m,iactive_pool_z8,iactive_pool_z8) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z9,iactive_pool_z9) = MatrixA(:,m,iactive_pool_z9,iactive_pool_z9) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z10,iactive_pool_z10) = MatrixA(:,m,iactive_pool_z10,iactive_pool_z10) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z11,iactive_pool_z11) = MatrixA(:,m,iactive_pool_z11,iactive_pool_z11) * &
+                  flux_tot_coeff(1)
+
+             ! flux received by the active pool from the slow pool
+             MatrixA(:,m,iactive_pool_z1,islow_pool_z1)= MatrixA(:,m,iactive_pool_z1,islow_pool_z1) * &
+                  flux_tot_coeff(1) 
+
+             MatrixA(:,m,iactive_pool_z2,islow_pool_z2)= MatrixA(:,m,iactive_pool_z2,islow_pool_z2) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z3,islow_pool_z3)= MatrixA(:,m,iactive_pool_z3,islow_pool_z3) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z4,islow_pool_z4)= MatrixA(:,m,iactive_pool_z4,islow_pool_z4) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z5,islow_pool_z5)= MatrixA(:,m,iactive_pool_z5,islow_pool_z5) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z6,islow_pool_z6)= MatrixA(:,m,iactive_pool_z6,islow_pool_z6) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z7,islow_pool_z7)= MatrixA(:,m,iactive_pool_z7,islow_pool_z7) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z8,islow_pool_z8)= MatrixA(:,m,iactive_pool_z8,islow_pool_z8) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z9,islow_pool_z9)= MatrixA(:,m,iactive_pool_z9,islow_pool_z9) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z10,islow_pool_z10)= MatrixA(:,m,iactive_pool_z10,islow_pool_z10) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z11,islow_pool_z11)= MatrixA(:,m,iactive_pool_z11,islow_pool_z11) * &
+                  flux_tot_coeff(1)
+
+             ! flux received by the active pool from the passive pool
+             MatrixA(:,m,iactive_pool_z1,ipassive_pool_z1) = MatrixA(:,m,iactive_pool_z1,ipassive_pool_z1) * &
+                  flux_tot_coeff(1)    
+
+             MatrixA(:,m,iactive_pool_z2,ipassive_pool_z2)= MatrixA(:,m,iactive_pool_z2,ipassive_pool_z2) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z3,ipassive_pool_z3)= MatrixA(:,m,iactive_pool_z3,ipassive_pool_z3) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z4,ipassive_pool_z4)= MatrixA(:,m,iactive_pool_z4,ipassive_pool_z4) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z5,ipassive_pool_z5)= MatrixA(:,m,iactive_pool_z5,ipassive_pool_z5) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z6,ipassive_pool_z6)= MatrixA(:,m,iactive_pool_z6,ipassive_pool_z6) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z7,ipassive_pool_z7)= MatrixA(:,m,iactive_pool_z7,ipassive_pool_z7) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z8,ipassive_pool_z8)= MatrixA(:,m,iactive_pool_z8,ipassive_pool_z8) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z9,ipassive_pool_z9)= MatrixA(:,m,iactive_pool_z9,ipassive_pool_z9) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z10,ipassive_pool_z10)= MatrixA(:,m,iactive_pool_z10,ipassive_pool_z10) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z11,ipassive_pool_z11)= MatrixA(:,m,iactive_pool_z11,ipassive_pool_z11) * &
+                  flux_tot_coeff(1)
+
+             ! flux received by the slow pool from the active pool
+             MatrixA(:,m,islow_pool_z1,iactive_pool_z1) =  MatrixA(:,m,islow_pool_z1,iactive_pool_z1) * &
+                  flux_tot_coeff(1) 
+
+             MatrixA(:,m,iactive_pool_z2,islow_pool_z2)= MatrixA(:,m,iactive_pool_z2,islow_pool_z2) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z3,islow_pool_z3)= MatrixA(:,m,iactive_pool_z3,islow_pool_z3) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z4,islow_pool_z4)= MatrixA(:,m,iactive_pool_z4,islow_pool_z4) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z5,islow_pool_z5)= MatrixA(:,m,iactive_pool_z5,islow_pool_z5) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z6,islow_pool_z6)= MatrixA(:,m,iactive_pool_z6,islow_pool_z6) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z7,islow_pool_z7)= MatrixA(:,m,iactive_pool_z7,islow_pool_z7) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z8,islow_pool_z8)= MatrixA(:,m,iactive_pool_z8,islow_pool_z8) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z9,islow_pool_z9)= MatrixA(:,m,iactive_pool_z9,islow_pool_z9) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z10,islow_pool_z10)= MatrixA(:,m,iactive_pool_z10,islow_pool_z10) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,iactive_pool_z11,islow_pool_z11)= MatrixA(:,m,iactive_pool_z11,islow_pool_z11) * &
+                  flux_tot_coeff(1)
+
+             ! flux leaving the slow pool
+             MatrixA(:,m,islow_pool_z1,islow_pool_z1) = MatrixA(:,m,islow_pool_z1,islow_pool_z1) * &
+                  flux_tot_coeff(1)     
+
+             MatrixA(:,m,islow_pool_z2,islow_pool_z2)= MatrixA(:,m,islow_pool_z2,islow_pool_z2) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,islow_pool_z3,islow_pool_z3)= MatrixA(:,m,islow_pool_z3,islow_pool_z3) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,islow_pool_z4,islow_pool_z4)= MatrixA(:,m,islow_pool_z4,islow_pool_z4) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,islow_pool_z5,islow_pool_z5)= MatrixA(:,m,islow_pool_z5,islow_pool_z5) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,islow_pool_z6,islow_pool_z6)= MatrixA(:,m,islow_pool_z6,islow_pool_z6) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,islow_pool_z7,islow_pool_z7)= MatrixA(:,m,islow_pool_z7,islow_pool_z7) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,islow_pool_z8,islow_pool_z8)= MatrixA(:,m,islow_pool_z8,islow_pool_z8) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,islow_pool_z9,islow_pool_z9)= MatrixA(:,m,islow_pool_z9,islow_pool_z9) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,islow_pool_z10,islow_pool_z10)= MatrixA(:,m,islow_pool_z10,islow_pool_z10) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,islow_pool_z11,islow_pool_z11)= MatrixA(:,m,islow_pool_z11,islow_pool_z11) * &
+                  flux_tot_coeff(1)
+
+             ! flux received by the passive pool from the active pool
+             MatrixA(:,m,ipassive_pool_z1,iactive_pool_z1) = MatrixA(:,m,ipassive_pool_z1,iactive_pool_z1) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z2,iactive_pool_z2)= MatrixA(:,m,ipassive_pool_z2,iactive_pool_z2) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z3,iactive_pool_z3)= MatrixA(:,m,ipassive_pool_z3,iactive_pool_z3) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z4,iactive_pool_z4)= MatrixA(:,m,ipassive_pool_z4,iactive_pool_z4) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z5,iactive_pool_z5)= MatrixA(:,m,ipassive_pool_z5,iactive_pool_z5) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z6,iactive_pool_z6)= MatrixA(:,m,ipassive_pool_z6,iactive_pool_z6) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z7,iactive_pool_z7)= MatrixA(:,m,ipassive_pool_z7,iactive_pool_z7) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z8,iactive_pool_z8)= MatrixA(:,m,ipassive_pool_z8,iactive_pool_z8) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z9,iactive_pool_z9)= MatrixA(:,m,ipassive_pool_z9,iactive_pool_z9) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z10,iactive_pool_z10)= MatrixA(:,m,ipassive_pool_z10,iactive_pool_z10) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z11,iactive_pool_z11)= MatrixA(:,m,ipassive_pool_z11,iactive_pool_z11) * &
+                  flux_tot_coeff(1)
+
+             ! flux received by the passive pool from the slow pool
+             MatrixA(:,m,ipassive_pool_z1,islow_pool_z1) = MatrixA(:,m,ipassive_pool_z1,islow_pool_z1) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z2,islow_pool_z2)= MatrixA(:,m,ipassive_pool_z2,islow_pool_z2) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z3,islow_pool_z3)= MatrixA(:,m,ipassive_pool_z3,islow_pool_z3) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z4,islow_pool_z4)= MatrixA(:,m,ipassive_pool_z4,islow_pool_z4) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z5,islow_pool_z5)= MatrixA(:,m,ipassive_pool_z5,islow_pool_z5) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z6,islow_pool_z6)= MatrixA(:,m,ipassive_pool_z6,islow_pool_z6) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z7,islow_pool_z7)= MatrixA(:,m,ipassive_pool_z7,islow_pool_z7) * &
+                  flux_tot_coeff(1)
+ 
+             MatrixA(:,m,ipassive_pool_z8,islow_pool_z8)= MatrixA(:,m,ipassive_pool_z8,islow_pool_z8) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z9,islow_pool_z9)= MatrixA(:,m,ipassive_pool_z9,islow_pool_z9) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z10,islow_pool_z10)= MatrixA(:,m,ipassive_pool_z10,islow_pool_z10) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z11,islow_pool_z11)= MatrixA(:,m,ipassive_pool_z11,islow_pool_z11) * &
+                  flux_tot_coeff(1)
+
+             ! flux leaving the passive pool
+             MatrixA(:,m,ipassive_pool_z1,ipassive_pool_z1)= MatrixA(:,m,ipassive_pool_z1,ipassive_pool_z1) *&
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z2,ipassive_pool_z2)= MatrixA(:,m,ipassive_pool_z2,ipassive_pool_z2) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z3,ipassive_pool_z3)= MatrixA(:,m,ipassive_pool_z3,ipassive_pool_z3) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z4,ipassive_pool_z4)= MatrixA(:,m,ipassive_pool_z4,ipassive_pool_z4) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z5,ipassive_pool_z5)= MatrixA(:,m,ipassive_pool_z5,ipassive_pool_z5) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z6,ipassive_pool_z6)= MatrixA(:,m,ipassive_pool_z6,ipassive_pool_z6) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z7,ipassive_pool_z7)= MatrixA(:,m,ipassive_pool_z7,ipassive_pool_z7) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z8,ipassive_pool_z8)= MatrixA(:,m,ipassive_pool_z8,ipassive_pool_z8) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z9,ipassive_pool_z9)= MatrixA(:,m,ipassive_pool_z9,ipassive_pool_z9) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z10,ipassive_pool_z10)= MatrixA(:,m,ipassive_pool_z10,ipassive_pool_z10) * &
+                  flux_tot_coeff(1)
+
+             MatrixA(:,m,ipassive_pool_z11,ipassive_pool_z11)= MatrixA(:,m,ipassive_pool_z11,ipassive_pool_z11) * &
+                  flux_tot_coeff(1)
+
+          ENDIF ! (.NOT. natural(m)) .AND. (.NOT. is_c4(m)) 
+
+
+          IF ( (.NOT. natural(m)) .AND. is_c4(m) ) THEN ! C4crop
+
+            ! flux leaving the active pool
+             MatrixA(:,m,iactive_pool_z1,iactive_pool_z1) = MatrixA(:,m,iactive_pool_z1,iactive_pool_z1) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z2,iactive_pool_z2) = MatrixA(:,m,iactive_pool_z2,iactive_pool_z2) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z3,iactive_pool_z3) = MatrixA(:,m,iactive_pool_z3,iactive_pool_z3) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z4,iactive_pool_z4) = MatrixA(:,m,iactive_pool_z4,iactive_pool_z4) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z5,iactive_pool_z5) = MatrixA(:,m,iactive_pool_z5,iactive_pool_z5) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z6,iactive_pool_z6) = MatrixA(:,m,iactive_pool_z6,iactive_pool_z6) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z7,iactive_pool_z7) = MatrixA(:,m,iactive_pool_z7,iactive_pool_z7) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z8,iactive_pool_z8) = MatrixA(:,m,iactive_pool_z8,iactive_pool_z8) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z9,iactive_pool_z9) = MatrixA(:,m,iactive_pool_z9,iactive_pool_z9) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z10,iactive_pool_z10) = MatrixA(:,m,iactive_pool_z10,iactive_pool_z10) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z11,iactive_pool_z11) = MatrixA(:,m,iactive_pool_z11,iactive_pool_z11) * &
+                  flux_tot_coeff(2)
+
+             ! flux received by the active pool from the slow pool
+             MatrixA(:,m,iactive_pool_z1,islow_pool_z1)= MatrixA(:,m,iactive_pool_z1,islow_pool_z1) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z2,islow_pool_z2)= MatrixA(:,m,iactive_pool_z2,islow_pool_z2) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z3,islow_pool_z3)= MatrixA(:,m,iactive_pool_z3,islow_pool_z3) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z4,islow_pool_z4)= MatrixA(:,m,iactive_pool_z4,islow_pool_z4) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z5,islow_pool_z5)= MatrixA(:,m,iactive_pool_z5,islow_pool_z5) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z6,islow_pool_z6)= MatrixA(:,m,iactive_pool_z6,islow_pool_z6) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z7,islow_pool_z7)= MatrixA(:,m,iactive_pool_z7,islow_pool_z7) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z8,islow_pool_z8)= MatrixA(:,m,iactive_pool_z8,islow_pool_z8) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z9,islow_pool_z9)= MatrixA(:,m,iactive_pool_z9,islow_pool_z9) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z10,islow_pool_z10)= MatrixA(:,m,iactive_pool_z10,islow_pool_z10) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z11,islow_pool_z11)= MatrixA(:,m,iactive_pool_z11,islow_pool_z11) * &
+                  flux_tot_coeff(2)
+
+             ! flux received by the active pool from the passive pool
+             MatrixA(:,m,iactive_pool_z1,ipassive_pool_z1) = MatrixA(:,m,iactive_pool_z1,ipassive_pool_z1) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z2,ipassive_pool_z2)= MatrixA(:,m,iactive_pool_z2,ipassive_pool_z2) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z3,ipassive_pool_z3)= MatrixA(:,m,iactive_pool_z3,ipassive_pool_z3) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z4,ipassive_pool_z4)= MatrixA(:,m,iactive_pool_z4,ipassive_pool_z4) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z5,ipassive_pool_z5)= MatrixA(:,m,iactive_pool_z5,ipassive_pool_z5) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z6,ipassive_pool_z6)= MatrixA(:,m,iactive_pool_z6,ipassive_pool_z6) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z7,ipassive_pool_z7)= MatrixA(:,m,iactive_pool_z7,ipassive_pool_z7) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z8,ipassive_pool_z8)= MatrixA(:,m,iactive_pool_z8,ipassive_pool_z8) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z9,ipassive_pool_z9)= MatrixA(:,m,iactive_pool_z9,ipassive_pool_z9) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z10,ipassive_pool_z10)= MatrixA(:,m,iactive_pool_z10,ipassive_pool_z10) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z11,ipassive_pool_z11)= MatrixA(:,m,iactive_pool_z11,ipassive_pool_z11) * &
+                  flux_tot_coeff(2)
+
+             ! flux received by the slow pool from the active pool
+             MatrixA(:,m,islow_pool_z1,iactive_pool_z1) = MatrixA(:,m,islow_pool_z1,iactive_pool_z1) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z2,islow_pool_z2)= MatrixA(:,m,iactive_pool_z2,islow_pool_z2) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z3,islow_pool_z3)= MatrixA(:,m,iactive_pool_z3,islow_pool_z3) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z4,islow_pool_z4)= MatrixA(:,m,iactive_pool_z4,islow_pool_z4) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z5,islow_pool_z5)= MatrixA(:,m,iactive_pool_z5,islow_pool_z5) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z6,islow_pool_z6)= MatrixA(:,m,iactive_pool_z6,islow_pool_z6) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z7,islow_pool_z7)= MatrixA(:,m,iactive_pool_z7,islow_pool_z7) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z8,islow_pool_z8)= MatrixA(:,m,iactive_pool_z8,islow_pool_z8) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z9,islow_pool_z9)= MatrixA(:,m,iactive_pool_z9,islow_pool_z9) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z10,islow_pool_z10)= MatrixA(:,m,iactive_pool_z10,islow_pool_z10) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,iactive_pool_z11,islow_pool_z11)= MatrixA(:,m,iactive_pool_z11,islow_pool_z11) * &
+                  flux_tot_coeff(2)
+
+             ! flux leaving the slow pool
+             MatrixA(:,m,islow_pool_z1,islow_pool_z1) = MatrixA(:,m,islow_pool_z1,islow_pool_z1) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,islow_pool_z2,islow_pool_z2)= MatrixA(:,m,islow_pool_z2,islow_pool_z2) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,islow_pool_z3,islow_pool_z3)= MatrixA(:,m,islow_pool_z3,islow_pool_z3) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,islow_pool_z4,islow_pool_z4)= MatrixA(:,m,islow_pool_z4,islow_pool_z4) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,islow_pool_z5,islow_pool_z5)= MatrixA(:,m,islow_pool_z5,islow_pool_z5) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,islow_pool_z6,islow_pool_z6)= MatrixA(:,m,islow_pool_z6,islow_pool_z6) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,islow_pool_z7,islow_pool_z7)= MatrixA(:,m,islow_pool_z7,islow_pool_z7) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,islow_pool_z8,islow_pool_z8)= MatrixA(:,m,islow_pool_z8,islow_pool_z8) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,islow_pool_z9,islow_pool_z9)= MatrixA(:,m,islow_pool_z9,islow_pool_z9) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,islow_pool_z10,islow_pool_z10)= MatrixA(:,m,islow_pool_z10,islow_pool_z10) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,islow_pool_z11,islow_pool_z11)= MatrixA(:,m,islow_pool_z11,islow_pool_z11) * &
+                  flux_tot_coeff(2)
+
+             ! flux received by the passive pool from the active pool
+             MatrixA(:,m,ipassive_pool_z1,iactive_pool_z1) = MatrixA(:,m,ipassive_pool_z1,iactive_pool_z1) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z2,iactive_pool_z2)= MatrixA(:,m,ipassive_pool_z2,iactive_pool_z2) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z3,iactive_pool_z3)= MatrixA(:,m,ipassive_pool_z3,iactive_pool_z3) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z4,iactive_pool_z4)= MatrixA(:,m,ipassive_pool_z4,iactive_pool_z4) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z5,iactive_pool_z5)= MatrixA(:,m,ipassive_pool_z5,iactive_pool_z5) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z6,iactive_pool_z6)= MatrixA(:,m,ipassive_pool_z6,iactive_pool_z6) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z7,iactive_pool_z7)= MatrixA(:,m,ipassive_pool_z7,iactive_pool_z7) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z8,iactive_pool_z8)= MatrixA(:,m,ipassive_pool_z8,iactive_pool_z8) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z9,iactive_pool_z9)= MatrixA(:,m,ipassive_pool_z9,iactive_pool_z9) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z10,iactive_pool_z10)= MatrixA(:,m,ipassive_pool_z10,iactive_pool_z10) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z11,iactive_pool_z11)= MatrixA(:,m,ipassive_pool_z11,iactive_pool_z11) * &
+                  flux_tot_coeff(2)
+
+             ! flux received by the passive pool from the slow pool
+             MatrixA(:,m,ipassive_pool_z1,islow_pool_z1) = MatrixA(:,m,ipassive_pool_z1,islow_pool_z1) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z2,islow_pool_z2)= MatrixA(:,m,ipassive_pool_z2,islow_pool_z2) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z3,islow_pool_z3)= MatrixA(:,m,ipassive_pool_z3,islow_pool_z3) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z4,islow_pool_z4)= MatrixA(:,m,ipassive_pool_z4,islow_pool_z4) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z5,islow_pool_z5)= MatrixA(:,m,ipassive_pool_z5,islow_pool_z5) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z6,islow_pool_z6)= MatrixA(:,m,ipassive_pool_z6,islow_pool_z6) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z7,islow_pool_z7)= MatrixA(:,m,ipassive_pool_z7,islow_pool_z7) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z8,islow_pool_z8)= MatrixA(:,m,ipassive_pool_z8,islow_pool_z8) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z9,islow_pool_z9)= MatrixA(:,m,ipassive_pool_z9,islow_pool_z9) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z10,islow_pool_z10)= MatrixA(:,m,ipassive_pool_z10,islow_pool_z10) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z11,islow_pool_z11)= MatrixA(:,m,ipassive_pool_z11,islow_pool_z11) * &
+                  flux_tot_coeff(2)
+
+             ! flux leaving the passive pool
+             MatrixA(:,m,ipassive_pool_z1,ipassive_pool_z1)= MatrixA(:,m,ipassive_pool_z1,ipassive_pool_z1) *&
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z2,ipassive_pool_z2)= MatrixA(:,m,ipassive_pool_z2,ipassive_pool_z2) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z3,ipassive_pool_z3)= MatrixA(:,m,ipassive_pool_z3,ipassive_pool_z3) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z4,ipassive_pool_z4)= MatrixA(:,m,ipassive_pool_z4,ipassive_pool_z4) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z5,ipassive_pool_z5)= MatrixA(:,m,ipassive_pool_z5,ipassive_pool_z5) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z6,ipassive_pool_z6)= MatrixA(:,m,ipassive_pool_z6,ipassive_pool_z6) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z7,ipassive_pool_z7)= MatrixA(:,m,ipassive_pool_z7,ipassive_pool_z7) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z8,ipassive_pool_z8)= MatrixA(:,m,ipassive_pool_z8,ipassive_pool_z8) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z9,ipassive_pool_z9)= MatrixA(:,m,ipassive_pool_z9,ipassive_pool_z9) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z10,ipassive_pool_z10)= MatrixA(:,m,ipassive_pool_z10,ipassive_pool_z10) * &
+                  flux_tot_coeff(2)
+
+             MatrixA(:,m,ipassive_pool_z11,ipassive_pool_z11)= MatrixA(:,m,ipassive_pool_z11,ipassive_pool_z11) * &
+                  flux_tot_coeff(2)
+
+
+          ENDIF ! (.NOT. natural(m)) .AND. is_c4(m) 
+
+          IF (bavard.GE.4) WRITE(numout,*)'Finish to fill MatrixA'
+
+       ENDDO ! Loop over # PFTS
+
+
+       ! 4.2 Add Identity for each submatrix(7,7) 
+
+       DO j = 1,nbpools
+          MatrixA(:,:,j,j) = MatrixA(:,:,j,j) + un 
+       ENDDO
+
+    ENDIF ! (spinup_analytic)
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving soilcarbon'
+    
+  END SUBROUTINE soilcarbon
+
+END MODULE stomate_soilcarbon
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_turnover.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_turnover.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_turnover.f90	(revision 5166)
@@ -0,0 +1,841 @@
+! =================================================================================================================================
+! MODULE       : stomate_turnover.f90
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module manages the end of the growing season and calculates herbivory and turnover of leaves, fruits, fine roots.
+!! 
+!!\n DESCRIPTION: This subroutine calculates leaf senescence due to climatic conditions or as a 
+!! function of leaf age and new LAI, and subsequent turnover of the different plant biomass compartments (sections 1 to 6), 
+!! herbivory (section 7), fruit turnover for trees (section 8) and sapwood conversion (section 9). 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_turnover
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC turn, turn_clear
+
+  LOGICAL, SAVE                          :: firstcall = .TRUE.           !! first call (true/false)
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : turn_clear
+!!
+!>\BRIEF        Set flag ::firstcall to .TRUE., and therefore activate section 1 
+!!              of subroutine turn which writes a message to the output.
+!!                
+!_ ================================================================================================================================
+
+  SUBROUTINE turn_clear
+    firstcall=.TRUE.
+  END SUBROUTINE turn_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : turn
+!!
+!>\BRIEF         Calculate turnover of leaves, roots, fruits and sapwood due to aging or climatic 
+!!               induced senescence. Calculate herbivory.
+!!
+!! DESCRIPTION : This subroutine determines the turnover of leaves and fine roots (and stems for grasses)
+!! and simulates following processes:
+!! 1. Mean leaf age is calculated from leaf ages of separate leaf age classes. Should actually 
+!!    be recalculated at the end of the routine, but it does not change too fast. The mean leaf 
+!!    age is calculated using the following equation:
+!!    \latexonly
+!!    \input{turnover_lma_update_eqn1.tex}
+!!    \endlatexonly
+!!    \n 
+!! 2. Meteorological senescence: the detection of the end of the growing season and shedding 
+!!    of leaves, fruits and fine roots due to unfavourable meteorological conditions.
+!!    The model distinguishes three different types of "climatic" leaf senescence, that do not 
+!!    change the age structure: sensitivity to cold temperatures, to lack of water, or both. 
+!!    If meteorological conditions are fulfilled, a flag ::senescence is set to TRUE. Note
+!!    that evergreen species do not experience climatic senescence.
+!!    Climatic senescence is triggered by sensitivity to cold temperatures where the critical 
+!!    temperature for senescence is calculated using the following equation:
+!!    \latexonly
+!!    \input{turnover_temp_crit_eqn2.tex}
+!!    \endlatexonly
+!!    \n
+!!    Climatic senescence is triggered by sensitivity to lack of water availability where the 
+!!    moisture availability critical level is calculated using the following equation:
+!!    \latexonly
+!!    \input{turnover_moist_crit_eqn3.tex}
+!!    \endlatexonly
+!!    \n
+!!    Climatic senescence is triggered by sensitivity to temperature or to lack of water where
+!!    critical temperature and moisture availability are calculated as above.\n
+!!    Trees in climatic senescence lose their fine roots at the same rate as they lose their leaves. 
+!!    The rate of biomass loss of both fine roots and leaves is presribed through the equation:
+!!    \latexonly
+!!    \input{turnover_clim_senes_biomass_eqn4.tex}
+!!    \endlatexonly
+!!    \n
+!!    with ::leaffall(j) a PFT-dependent time constant which is given in 
+!!    ::stomate_constants. In grasses, leaf senescence is extended to the whole plant 
+!!    (all carbon pools) except to its carbohydrate reserve.    
+!! 3. Senescence due to aging: the loss of leaves, fruits and  biomass due to aging
+!!    At a certain age, leaves fall off, even if the climate would allow a green plant
+!!    all year round. Even if the meteorological conditions are favorable for leaf maintenance,
+!!    plants, and in particular, evergreen trees, have to renew their leaves simply because the 
+!!    old leaves become inefficient. Roots, fruits (and stems for grasses) follow leaves. 
+!!    The ??senescence?? rate varies with leaf age. Note that plant is not declared senescent 
+!!    in this case (wchich is important for allocation: if the plant loses leaves because of 
+!!    their age, it can renew them). The leaf turnover rate due to aging of leaves is calculated
+!!    using the following equation:
+!!    \latexonly
+!!    \input{turnover_age_senes_biomass_eqn5.tex}
+!!    \endlatexonly
+!!    \n
+!!    Drop all leaves if there is a very low leaf mass during senescence. After this, the biomass 
+!!    of different carbon pools both for trees and grasses is set to zero and the mean leaf age 
+!!    is reset to zero. Finally, the leaf fraction and leaf age of the different leaf age classes 
+!!    is set to zero. For deciduous trees: next to leaves, also fruits and fine roots are dropped.
+!!    For grasses: all aboveground carbon pools, except the carbohydrate reserves are affected:
+!! 4. Update the leaf biomass, leaf age class fraction and the LAI
+!!    Older leaves will fall more frequently than younger leaves and therefore the leaf age 
+!!    distribution needs to be recalculated after turnover. The fraction of biomass in each 
+!!    leaf class is updated using the following equation:
+!!    \latexonly
+!!    \input{turnover_update_LeafAgeDistribution_eqn6.tex}
+!!    \endlatexonly
+!!    \n
+!! 5. Simulate herbivory activity and update leaf and fruits biomass. Herbivore activity 
+!!    affects the biomass of leaves and fruits as well as stalks (only for grasses).
+!!    However, herbivores do not modify leaf age structure.
+!! 6. Calculates fruit turnover for trees. Trees simply lose their fruits with a time 
+!!    constant ::tau_fruit(j), that is set to 90 days for all PFTs in ::stomate_constants 
+!! 7. Convert sapwood to heartwood for trees and update heart and softwood above and 
+!!    belowground biomass. Sapwood biomass is converted into heartwood biomass 
+!!    with a time constant tau ::tau_sap(j) of 1 year. Note that this biomass conversion 
+!!    is not added to "turnover" as the biomass is not lost. For the updated heartwood, 
+!!    the sum of new heartwood above and new heartwood below after converting sapwood to 
+!!    heartwood, is saved as ::hw_new(:). Creation of new heartwood decreases the age of 
+!!    the plant ??carbon?? with a factor that is determined by: old heartwood ::hw_old(:) 
+!!    divided by the new heartwood ::hw_new(:)
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLES: ::Biomass of leaves, fruits, fine roots and sapwood above (latter for grasses only), 
+!!                        ::Update LAI, ::Update leaf age distribution with new leaf age class fraction 
+!!
+!! REFERENCE(S) : 
+!! - Krinner, G., N. Viovy, N. de Noblet-Ducoudre, J. Ogee, J. Polcher, P. 
+!! Friedlingstein, P. Ciais, S. Sitch and I.C. Prentice (2005), A dynamic global
+!! vegetation model for studies of the coupled atmosphere-biosphere system, Global
+!! Biogeochemical Cycles, 19, doi:10.1029/2003GB002199. 
+!! - McNaughton, S. J., M. Oesterheld, D. A. Frank and K. J. Williams (1989), 
+!! Ecosystem-level patterns of primary productivity and herbivory in terrestrial habitats, 
+!! Nature, 341, 142-144, 1989. 
+!! - Sitch, S., C. Huntingford, N. Gedney, P. E. Levy, M. Lomas, S. L. Piao, , Betts, R., Ciais, P., Cox, P., 
+!! Friedlingstein, P., Jones, C. D., Prentice, I. C. and F. I. Woodward : Evaluation of the terrestrial carbon  
+!! cycle, future plant geography and climate-carbon cycle feedbacks using 5 dynamic global vegetation 
+!! models (dgvms), Global Change Biology, 14(9), 2015â2039, 2008. 
+!!
+!! FLOWCHART    : 
+!! \latexonly
+!! \includegraphics[scale=0.5]{turnover_flowchart_1.png}
+!! \includegraphics[scale=0.5]{turnover_flowchart_2.png}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE turn (npts, dt, PFTpresent, &
+       herbivores, &
+       maxmoiavail_lastyear, minmoiavail_lastyear, &
+       moiavail_week, moiavail_month, tlong_ref, t2m_month, t2m_week, veget_max, &
+       gdd_from_growthinit, leaf_age, leaf_frac, age, lai, biomass, &
+       turnover, senescence,turnover_time)
+
+    !! 0. Variable and parameter declaration
+
+    !! 0.1 Input variables 
+
+    INTEGER(i_std), INTENT(in)                                 :: npts                 !! Domain size - number of grid cells 
+                                                                                       !! (unitless) 
+    REAL(r_std), INTENT(in)                                    :: dt                   !! time step (dt_days)
+    LOGICAL, DIMENSION(npts,nvm), INTENT(in)                   :: PFTpresent           !! PFT exists (true/false)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: herbivores           !! time constant of probability of a leaf to 
+                                                                                       !! be eaten by a herbivore (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: maxmoiavail_lastyear !! last year's maximum moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: minmoiavail_lastyear !! last year's minimum moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_week        !! "weekly" moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: moiavail_month       !! "monthly" moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: tlong_ref            !! "long term" 2 meter reference 
+                                                                                       !! temperatures (K) 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_month            !! "monthly" 2-meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                   :: t2m_week             !! "weekly" 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_max            !! "maximal" coverage fraction of a PFT (LAI 
+                                                                                       !! -> infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: gdd_from_growthinit  !! gdd senescence for crop
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: turnover         !! Turnover @tex ($gC m^{-2}$) @endtex
+    LOGICAL, DIMENSION(npts,nvm), INTENT(out)                  :: senescence           !! is the plant senescent? (true/false) 
+                                                                                       !! (interesting only for deciduous trees: 
+                                                                                       !! carbohydrate reserve) 
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age             !! age of the leaves (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac            !! fraction of leaves in leaf age class 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: age                  !! age (years)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: lai                  !! leaf area index @tex ($m^2 m^{-2}$) 
+                                                                                       !! @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout) :: biomass        !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)            :: turnover_time        !! turnover_time of grasses (days)
+
+    !! 0.4 Local  variables
+
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_meanage         !! mean age of the leaves (days)
+    REAL(r_std), DIMENSION(npts)                               :: dturnover            !! Intermediate variable for turnover ??
+                                                                                       !! @tex ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: moiavail_crit        !! critical moisture availability, function 
+                                                                                       !! of last year's moisture availability 
+                                                                                       !! (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                               :: tl                   !! long term annual mean temperature, (C)
+    REAL(r_std), DIMENSION(npts)                               :: t_crit               !! critical senescence temperature, function 
+                                                                                       !! of long term annual temperature (K) 
+    LOGICAL, DIMENSION(npts)                                   :: shed_rest            !! shed the remaining leaves? (true/false)
+    REAL(r_std), DIMENSION(npts)                               :: sapconv              !! Sapwood conversion @tex ($gC m^{-2}$) 
+                                                                                       !! @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: hw_old               !! old heartwood mass @tex ($gC m^{-2}$) 
+                                                                                       !! @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: hw_new               !! new heartwood mass @tex ($gC m^{-2}$) 
+                                                                                       !! @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: lm_old               !! old leaf mass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nleafages)                     :: delta_lm             !! leaf mass change for each age class @tex 
+                                                                                       !! ($gC m^{-2}$) @endtex 
+    REAL(r_std), DIMENSION(npts)                               :: turnover_rate        !! turnover rate (unitless) 
+    REAL(r_std), DIMENSION(npts,nvm)                           :: leaf_age_crit        !! critical leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm)                           :: new_turnover_time    !! instantaneous turnover time (days)
+    INTEGER(i_std)                                             :: j,m,k                !! Index (unitless)
+
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering turnover'
+
+    !! 1. first call - output messages
+
+    IF ( firstcall ) THEN
+
+       WRITE(numout,*) 'turnover:'
+
+       WRITE(numout,*) ' > minimum mean leaf age for senescence (days) (::min_leaf_age_for_senescence) : '&
+            ,min_leaf_age_for_senescence
+
+       firstcall = .FALSE.
+
+
+    ENDIF
+
+    !! 2. Initializations 
+
+    !! 2.1 set output to zero
+    turnover(:,:,:,:) = zero
+    new_turnover_time(:,:) = zero
+    senescence(:,:) = .FALSE.
+
+    !! 2.2 Recalculate mean leaf age
+    !      Mean leaf age is recalculated from leaf ages of separate leaf age classes. Should actually be recalculated at the 
+    !      end of this routine, but it does not change too fast.
+    !      The mean leaf age is calculated using the following equation:
+    !      \latexonly
+    !      \input{turnover_lma_update_eqn1.tex}
+    !      \endlatexonly
+    !      \n
+    leaf_meanage(:,:) = zero
+
+    DO m = 1, nleafages
+       leaf_meanage(:,:) = leaf_meanage(:,:) + leaf_age(:,:,m) * leaf_frac(:,:,m)
+    ENDDO
+
+    !! 3. Climatic senescence
+
+    !     Three different types of "climatic" leaf senescence,
+    !     that do not change the age structure. 
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! 3.1 Determine if there is climatic senescence. 
+       !      The climatic senescence can be of three types:
+       !      sensitivity to cold temperatures, to lack of water, or both. If meteorological conditions are 
+       !      fulfilled, a flag senescence is set to TRUE.
+       !      Evergreen species do not experience climatic senescence.
+
+       SELECT CASE ( senescence_type(j) )
+
+
+       CASE ('crop' )!for crop senescence is based on a GDD criterium as in crop models
+	  WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+               ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+               ( gdd_from_growthinit(:,j) .GT.  gdd_senescence(j)))
+             senescence(:,j) = .TRUE.
+          ENDWHERE
+
+       CASE ( 'cold' )
+
+          !! 3.1.1 Summergreen species: Climatic senescence is triggered by sensitivity to cold temperatures
+          !        Climatic senescence is triggered by sensitivity to cold temperatures as follows: 
+          !        If biomass is large enough (i.e. when it is greater than zero), 
+          !        AND (i.e. when leaf mean age is above a certain PFT-dependent treshold ::min_leaf_age_for_senescence,
+          !        which is given in ::stomate_constants),      
+          !        AND the monthly temperature is low enough (i.e. when monthly temperature ::t2m_month(:) is below a critical 
+          !        temperature ::t_crit(:), which is calculated in this module),
+          !        AND the temperature tendency is negative (i.e. when weekly temperatures ::t2m_week(:) are lower than monthly 
+          !        temperatures ::t2m_month(:))
+          !        If these conditions are met, senescence is set to TRUE.
+          !
+          !        The critical temperature for senescence is calculated using the following equation:
+          !        \latexonly
+          !        \input{turnover_temp_crit_eqn2.tex}
+          !        \endlatexonly
+          !        \n
+          !
+          ! Critical temperature for senescence may depend on long term annual mean temperature
+          tl(:) = tlong_ref(:) - ZeroCelsius
+          t_crit(:) = ZeroCelsius + senescence_temp(j,1) + &
+               tl(:) * senescence_temp(j,2) + &
+               tl(:)*tl(:) * senescence_temp(j,3)
+
+          WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+               ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+               ( t2m_month(:) .LT. t_crit(:) ) .AND. ( t2m_week(:) .LT. t2m_month(:) ) )
+
+             senescence(:,j) = .TRUE.
+
+          ENDWHERE
+
+       CASE ( 'dry' )
+
+          !! 3.1.2 Raingreen species: Climatic senescence is triggered by sensitivity to lack of water availability 
+          !        Climatic senescence is triggered by sensitivity to lack of water availability as follows:  
+          !        If biomass is large enough (i.e. when it is greater than zero), 
+          !        AND (i.e. when leaf mean age is above a certain PFT-dependent treshold ::min_leaf_age_for_senescence,
+          !        which is given in ::stomate_constants),      
+          !        AND the moisture availability drops below a critical level (i.e. when weekly moisture availability 
+          !        ::moiavail_week(:,j) is below a critical moisture availability ::moiavail_crit(:),
+          !        which is calculated in this module), 
+          !        If these conditions are met, senescence is set to TRUE.
+          !
+          !        The moisture availability critical level is calculated using the following equation:
+          !        \latexonly
+          !        \input{turnover_moist_crit_eqn3.tex}
+          !        \endlatexonly
+          !        \n
+          moiavail_crit(:) = &
+               MIN( MAX( minmoiavail_lastyear(:,j) + hum_frac(j) * &
+               ( maxmoiavail_lastyear(:,j) - minmoiavail_lastyear(:,j) ), &
+               senescence_hum(j) ), &
+               nosenescence_hum(j) )
+
+          WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+               ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+               ( moiavail_week(:,j) .LT. moiavail_crit(:) ) )
+
+             senescence(:,j) = .TRUE.
+
+          ENDWHERE
+
+       CASE ( 'mixed' )
+
+          !! 3.1.3 Mixed criterion: Climatic senescence is triggered by sensitivity to temperature or to lack of water  
+          !        Climatic senescence is triggered by sensitivity to temperature or to lack of water availability as follows:
+          !        If biomass is large enough (i.e. when it is greater than zero), 
+          !        AND (i.e. when leaf mean age is above a certain PFT-dependent treshold ::min_leaf_age_for_senescence,
+          !        which is given in ::stomate_constants),      
+          !        AND the moisture availability drops below a critical level (i.e. when weekly moisture availability 
+          !        ::moiavail_week(:,j) is below a critical moisture availability ::moiavail_crit(:), calculated in this module), 
+          !        OR 
+          !        the monthly temperature is low enough (i.e. when monthly temperature ::t2m_month(:) is below a critical 
+          !        temperature ::t_crit(:), calculated in this module),
+          !        AND the temperature tendency is negative (i.e. when weekly temperatures ::t2m_week(:) are lower than 
+          !        monthly temperatures ::t2m_month(:)).
+          !        If these conditions are met, senescence is set to TRUE.
+          moiavail_crit(:) = &
+               MIN( MAX( minmoiavail_lastyear(:,j) + hum_frac(j) * &
+               (maxmoiavail_lastyear(:,j) - minmoiavail_lastyear(:,j) ), &
+               senescence_hum(j) ), &
+               nosenescence_hum(j) )
+
+          tl(:) = tlong_ref(:) - ZeroCelsius
+          t_crit(:) = ZeroCelsius + senescence_temp(j,1) + &
+               tl(:) * senescence_temp(j,2) + &
+               tl(:)*tl(:) * senescence_temp(j,3)
+
+          IF ( is_tree(j) ) THEN
+             ! critical temperature for senescence may depend on long term annual mean temperature
+             WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+                  ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+                  ( ( moiavail_week(:,j) .LT. moiavail_crit(:) ) .OR. &
+                  ( ( t2m_month(:) .LT. t_crit(:) ) .AND. ( t2m_week(:) .LT. t2m_month(:) ) ) ) )
+                senescence(:,j) = .TRUE.
+             ENDWHERE
+          ELSE
+
+            turnover_time(:,j) = max_turnover_time(j)
+
+            WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+                 ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+                 ( ( moiavail_week(:,j) .LT. moiavail_crit(:) )))
+                turnover_time(:,j) = max_turnover_time(j) * &
+                     (1.-   (1.- (moiavail_week(:,j)/  moiavail_crit(:)))**2)		
+            ENDWHERE
+
+            WHERE ( turnover_time(:,j) .LT. min_turnover_time(j) )		 
+	       turnover_time(:,j) = min_turnover_time(j)			 
+            ENDWHERE 									 
+
+            WHERE ((( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. &
+                ( leaf_meanage(:,j) .GT. min_leaf_age_for_senescence(j) ) .AND. &
+                ((t2m_month(:) .LT. t_crit(:)) .AND. (lai(:,j) .GT. lai_max(j)/4.) .OR. &
+                (t2m_month(:) .LT. ZeroCelsius)) .AND. ( t2m_week(:) .LT. t2m_month(:) )))
+               turnover_time(:,j)= leaffall(j) 
+            ENDWHERE
+            
+         ENDIF
+
+
+       !! Evergreen species do not experience climatic senescence
+       CASE ( 'none' )
+
+          
+       !! In case no climatic senescence type is recognized.
+       CASE default
+
+          WRITE(numout,*) '  turnover: don''t know how to treat this PFT.'
+          WRITE(numout,*) '  number (::j) : ',j
+          WRITE(numout,*) '  senescence type (::senescence_type(j)) : ',senescence_type(j)
+
+          STOP
+
+       END SELECT
+
+       !! 3.2 Drop leaves and roots, plus stems and fruits for grasses
+
+       IF ( is_tree(j) ) THEN
+
+          !! 3.2.1 Trees in climatic senescence lose their fine roots at the same rate as they lose their leaves. 
+          !        The rate of biomass loss of both fine roots and leaves is presribed through the equation:
+          !        \latexonly
+          !        \input{turnover_clim_senes_biomass_eqn4.tex}
+          !        \endlatexonly
+          !        \n
+          !         with ::leaffall(j) a PFT-dependent time constant which is given in ::stomate_constants),
+          WHERE ( senescence(:,j) )
+
+             turnover(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) * dt / leaffall(j)
+             turnover(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) * dt / leaffall(j)
+
+          ENDWHERE
+
+       ELSE
+
+          !! 3.2.2 In grasses, leaf senescence is extended to the whole plant 
+          !        In grasses, leaf senescence is extended to the whole plant (all carbon pools) except to its
+          !        carbohydrate reserve.      
+
+          IF (senescence_type(j) .EQ. 'crop') THEN
+             ! 3.2.2.1 crops with 'crop' phenological model
+             WHERE ( senescence(:,j) )
+                turnover(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) * dt / leaffall(j)
+                turnover(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) * dt / leaffall(j)
+                turnover(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) * dt / leaffall(j)
+                turnover(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) * dt /leaffall(j)
+             ENDWHERE
+          ELSE
+          ! 3.2.2.2 grass or crops based on 'mixed' phenological model
+             WHERE (turnover_time(:,j) .LT. max_turnover_time(j)) 
+                turnover(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) * dt / turnover_time(:,j)
+                turnover(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) * dt / turnover_time(:,j)
+                turnover(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) * dt / turnover_time(:,j) 
+                turnover(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) * dt / turnover_time(:,j)
+             ENDWHERE
+          ENDIF
+       ENDIF      ! tree/grass
+       biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - turnover(:,j,ileaf,icarbon)
+       biomass(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) - turnover(:,j,isapabove,icarbon)
+       biomass(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) - turnover(:,j,iroot,icarbon)
+       biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - turnover(:,j,ifruit,icarbon)
+    ENDDO        ! loop over PFTs
+
+    !! 4. Leaf fall
+    !     At a certain age, leaves fall off, even if the climate would allow a green plant
+    !     all year round. Even if the meteorological conditions are favorable for leaf maintenance,
+    !     plants, and in particular, evergreen trees, have to renew their leaves simply because the 
+    !     old leaves become inefficient.   
+    !     Roots, fruits (and stems) follow leaves. The decay rate varies with leaf age.
+    !     Note that plant is not declared senescent in this case (wchich is important for allocation:
+    !     if the plant loses leaves because of their age, it can renew them).
+    !
+    !     The leaf turnover rate due to aging of leaves is calculated using the following equation:
+    !     \latexonly
+    !     \input{turnover_age_senes_biomass_eqn5.tex}
+    !     \endlatexonly
+    !     \n
+    DO j = 2,nvm ! Loop over # PFTs
+
+       !! save old leaf mass
+       lm_old(:) = biomass(:,j,ileaf,icarbon)
+
+       !! initialize leaf mass change in age class
+       delta_lm(:,:) = zero
+
+       IF ( is_tree(j) .OR. (.NOT. natural(j)) ) THEN
+
+          !! 4.1 Trees: leaves, roots, fruits roots and fruits follow leaves.
+
+          !! 4.1.1 Critical age: prescribed for trees
+          leaf_age_crit(:,j) = leafagecrit(j)
+
+       ELSE
+
+          !! 4.2 Grasses: leaves, roots, fruits, sap follow leaves.
+
+          !! 4.2.1 Critical leaf age depends on long-term temperature
+          !        Critical leaf age depends on long-term temperature
+          !        generally, lower turnover in cooler climates.
+          leaf_age_crit(:,j) = &
+               MIN( leafagecrit(j) * leaf_age_crit_coeff(1) , &
+               MAX( leafagecrit(j) * leaf_age_crit_coeff(2) , &
+               leafagecrit(j) - leaf_age_crit_coeff(3) * &
+               ( tlong_ref(:)-ZeroCelsius - leaf_age_crit_tref ) ) )
+
+       END IF
+          
+       ! 4.2.2 Loop over leaf age classes
+       DO m = 1, nleafages
+
+          turnover_rate(:) = zero
+
+          WHERE ( leaf_age(:,j,m) .GT. leaf_age_crit(:,j)/2. )
+
+             turnover_rate(:) =  &
+                  MIN( 0.99_r_std, dt / ( leaf_age_crit(:,j) * &
+                  ( leaf_age_crit(:,j) / leaf_age(:,j,m) )**quatre ) )
+
+          ENDWHERE
+          
+          dturnover(:) = biomass(:,j,ileaf,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+          turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + dturnover(:)
+          biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - dturnover(:)
+
+          ! save leaf mass change
+          delta_lm(:,m) = - dturnover(:)
+          
+          dturnover(:) = biomass(:,j,iroot,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+          turnover(:,j,iroot,icarbon) = turnover(:,j,iroot,icarbon) + dturnover(:)
+          biomass(:,j,iroot,icarbon) = biomass(:,j,iroot,icarbon) - dturnover(:)
+          
+          dturnover(:) = biomass(:,j,ifruit,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+          turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + dturnover(:)
+          biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - dturnover(:)
+          
+          IF (.NOT. is_tree(j)) THEN
+             dturnover(:) = biomass(:,j,isapabove,icarbon) * leaf_frac(:,j,m) * turnover_rate(:)
+             turnover(:,j,isapabove,icarbon) = turnover(:,j,isapabove,icarbon) + dturnover(:)
+             biomass(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) - dturnover(:)
+          ENDIF
+          
+       ENDDO
+
+       !! 4.3 Recalculate the fraction of leaf biomass in each leaf age class.
+       !      Older leaves will fall more fast than younger leaves and therefore 
+       !      the leaf age distribution needs to be recalculated after turnover. 
+       !      The fraction of biomass in each leaf class is updated using the following equation:
+       !      \latexonly
+       !      \input{turnover_update_LeafAgeDistribution_eqn6.tex}
+       !      \endlatexonly
+       !      \n
+       !
+       !      new fraction = new leaf mass of that fraction / new total leaf mass
+       !                   = (old fraction*old total leaf mass ::lm_old(:) + biomass change of that fraction ::delta_lm(:,m)  ) /
+       !                     new total leaf mass ::biomass(:,j,ileaf
+       DO m = 1, nleafages
+          
+          WHERE ( biomass(:,j,ileaf,icarbon) .GT. zero )
+             leaf_frac(:,j,m) = ( leaf_frac(:,j,m)*lm_old(:) + delta_lm(:,m) ) / biomass(:,j,ileaf,icarbon)
+          ELSEWHERE
+             leaf_frac(:,j,m) = zero
+          ENDWHERE
+        
+       ENDDO
+       
+    ENDDO         ! loop over PFTs
+
+    !! 5. New (provisional) LAI 
+    !     ::lai(:,j) is determined from the leaf biomass ::biomass(:,j,ileaf,icarbon) and the 
+    !     specific leaf surface :: sla(j) (m^2 gC^{-1})
+    !     The leaf area index is updated using the following equation:
+    !     \latexonly
+    !     \input{turnover_update_LAI_eqn7.tex}
+    !     \endlatexonly
+    !     \n
+
+    !    lai(:,ibare_sechiba) = zero
+    !    DO j = 2, nvm ! Loop over # PFTs
+    !        lai(:,j) = biomass(:,j,ileaf,icarbon) * sla(j)
+    !    ENDDO
+
+    !! 6. Definitely drop all leaves if there is a very low leaf mass during senescence.
+
+    !     Both for deciduous trees and grasses same conditions are checked:
+    !     If biomass is large enough (i.e. when it is greater than zero), 
+    !     AND when senescence is set to true
+    !     AND the leaf biomass drops below a critical minimum biomass level (i.e. when it is lower than half
+    !     the minimum initial LAI ::lai_initmin(j) divided by the specific leaf area ::sla(j),
+    !     ::lai_initmin(j) is set to 0.3 in stomate_data.f90 and sla is a constant that is set to 0.015366 m2/gC), 
+    !     If these conditions are met, the flag ::shed_rest(:) is set to TRUE.
+    !
+    !     After this, the biomass of different carbon pools both for trees and grasses is set to zero
+    !     and the mean leaf age is reset to zero.
+    !     Finally, the leaf fraction and leaf age of the different leaf age classes is set to zero.
+    DO j = 2,nvm ! Loop over # PFTs
+
+       shed_rest(:) = .FALSE.
+
+       !! 6.1 For deciduous trees: next to leaves, also fruits and fine roots are dropped 
+       !      For deciduous trees: next to leaves, also fruits and fine roots are dropped: fruit ::biomass(:,j,ifruit) 
+       !      and fine root ::biomass(:,j,iroot) carbon pools are set to zero.
+       IF ( is_tree(j) .AND. ( senescence_type(j) .NE. 'none' ) ) THEN
+
+          ! check whether we shed the remaining leaves
+          WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. senescence(:,j) .AND. &
+               ( biomass(:,j,ileaf,icarbon) .LT. (lai_initmin(j) / 2.)/sla(j) )             )
+
+             shed_rest(:) = .TRUE.
+
+             turnover(:,j,ileaf,icarbon)  = turnover(:,j,ileaf,icarbon) + biomass(:,j,ileaf,icarbon)
+             turnover(:,j,iroot,icarbon)  = turnover(:,j,iroot,icarbon) + biomass(:,j,iroot,icarbon)
+             turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + biomass(:,j,ifruit,icarbon)
+
+             biomass(:,j,ileaf,icarbon)  = zero
+             biomass(:,j,iroot,icarbon)  = zero
+             biomass(:,j,ifruit,icarbon) = zero
+
+             ! reset leaf age
+             leaf_meanage(:,j) = zero
+
+          ENDWHERE
+
+       ENDIF
+
+       !! 6.2 For grasses: all aboveground carbon pools, except the carbohydrate reserves are affected: 
+       !      For grasses: all aboveground carbon pools, except the carbohydrate reserves are affected: 
+       !      fruit ::biomass(:,j,ifruit,icarbon), fine root ::biomass(:,j,iroot,icarbon) and sapwood above 
+       !      ::biomass(:,j,isapabove,icarbon) carbon pools are set to zero. 
+       IF ( .NOT. is_tree(j) ) THEN
+
+          ! Shed the remaining leaves if LAI very low.
+          WHERE ( ( biomass(:,j,ileaf,icarbon) .GT. zero ) .AND. senescence(:,j) .AND. &
+               (  biomass(:,j,ileaf,icarbon) .LT. (lai_initmin(j) / 2.)/sla(j) ))
+
+             shed_rest(:) = .TRUE.
+
+             turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + biomass(:,j,ileaf,icarbon)
+             turnover(:,j,isapabove,icarbon) = turnover(:,j,isapabove,icarbon) + biomass(:,j,isapabove,icarbon)
+             turnover(:,j,iroot,icarbon) = turnover(:,j,iroot,icarbon) + biomass(:,j,iroot,icarbon)
+             turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + biomass(:,j,ifruit,icarbon)
+
+             biomass(:,j,ileaf,icarbon) = zero
+             biomass(:,j,isapabove,icarbon) = zero
+             biomass(:,j,iroot,icarbon) = zero
+             biomass(:,j,ifruit,icarbon) = zero
+
+             ! reset leaf age
+             leaf_meanage(:,j) = zero
+
+          ENDWHERE
+
+       ENDIF
+
+       !! 6.3 Reset the leaf age structure: the leaf fraction and leaf age of the different leaf age classes is set to zero.
+      
+       DO m = 1, nleafages
+
+          WHERE ( shed_rest(:) )
+
+             leaf_age(:,j,m) = zero
+             leaf_frac(:,j,m) = zero
+
+          ENDWHERE
+
+       ENDDO
+
+    ENDDO          ! loop over PFTs
+    
+    !! 7. Herbivore activity: elephants, cows, gazelles but no lions.
+ 
+    !     Herbivore activity affects the biomass of leaves and fruits as well 
+    !     as stalks (only for grasses). Herbivore activity does not modify leaf 
+    !     age structure. Herbivores ::herbivores(:,j) is the time constant of 
+    !     probability of a leaf to be eaten by a herbivore, and is calculated in 
+    !     ::stomate_season. following Mc Naughton et al. [1989].
+
+    IF ( ok_herbivores ) THEN
+
+       ! If the herbivore activity is allowed (if ::ok_herbivores is true, which is set in run.def), 
+       ! remove the amount of biomass consumed by herbivory from the leaf biomass ::biomass(:,j,ileaf,icarbon) and 
+       ! the fruit biomass ::biomass(:,j,ifruit,icarbon).
+       ! The daily amount consumed equals the biomass multiplied by 1 day divided by the time constant ::herbivores(:,j).
+       DO j = 2,nvm ! Loop over # PFTs
+
+          IF ( is_tree(j) ) THEN
+
+             !! For trees: only the leaves and fruit carbon pools are affected
+
+             WHERE (biomass(:,j,ileaf,icarbon) .GT. zero)
+                ! added by shilong
+                WHERE (herbivores(:,j).GT. zero)
+                   dturnover(:) = biomass(:,j,ileaf,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + dturnover(:)
+                   biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - dturnover(:)
+
+                   dturnover(:) = biomass(:,j,ifruit,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + dturnover(:)
+                   biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - dturnover(:)
+                ENDWHERE
+             ENDWHERE
+
+          ELSE
+
+             ! For grasses: all aboveground carbon pools are affected: leaves, fruits and sapwood above
+             WHERE ( biomass(:,j,ileaf,icarbon) .GT. zero )
+                ! added by shilong
+                WHERE (herbivores(:,j) .GT. zero)
+                   dturnover(:) = biomass(:,j,ileaf,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,ileaf,icarbon) = turnover(:,j,ileaf,icarbon) + dturnover(:)
+                   biomass(:,j,ileaf,icarbon) = biomass(:,j,ileaf,icarbon) - dturnover(:)
+
+                   dturnover(:) = biomass(:,j,isapabove,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,isapabove,icarbon) = turnover(:,j,isapabove,icarbon) + dturnover(:)
+                   biomass(:,j,isapabove,icarbon) = biomass(:,j,isapabove,icarbon) - dturnover(:)
+
+                   dturnover(:) = biomass(:,j,ifruit,icarbon) * dt / herbivores(:,j)
+                   turnover(:,j,ifruit,icarbon) = turnover(:,j,ifruit,icarbon) + dturnover(:)
+                   biomass(:,j,ifruit,icarbon) = biomass(:,j,ifruit,icarbon) - dturnover(:)
+                ENDWHERE
+
+             ENDWHERE
+
+          ENDIF  ! tree/grass?
+
+       ENDDO    ! loop over PFTs
+
+    ENDIF ! end herbivores
+
+    !! 8. Fruit turnover for trees
+
+    !     Fruit turnover for trees: trees simply lose their fruits with a time constant ::tau_fruit(j), 
+    !     that is set to 90 days for all PFTs in ::stomate_constants
+
+    DO k = 1,nelements 
+       DO j = 2,nvm ! Loop over # PFTs
+          IF ( is_tree(j) ) THEN
+
+             dturnover(:) = biomass(:,j,ifruit,k) * dt / tau_fruit(j)
+             turnover(:,j,ifruit,k) = turnover(:,j,ifruit,k) + dturnover(:)
+             biomass(:,j,ifruit,k) = biomass(:,j,ifruit,k) - dturnover(:)
+             
+          ENDIF
+       ENDDO       ! loop over PFTs
+    END DO
+
+    !! 9 Conversion of sapwood to heartwood both for aboveground and belowground sapwood and heartwood.
+
+    !   Following LPJ (Sitch et al., 2003), sapwood biomass is converted into heartwood biomass 
+    !   with a time constant tau ::tau_sap(j) of 1 year.
+    !   Note that this biomass conversion is not added to "turnover" as the biomass is not lost!
+    DO j = 2,nvm ! Loop over # PFTs
+
+       IF ( is_tree(j) ) THEN
+
+          !! For the recalculation of age in 9.2 (in case the vegetation is not dynamic ie. ::control%ok_dgvm is FALSE), 
+          !! the heartwood above and below is stored in ::hw_old(:).
+          IF ( .NOT. control%ok_dgvm ) THEN
+             hw_old(:) = biomass(:,j,iheartabove,icarbon) + biomass(:,j,iheartbelow,icarbon)
+          ENDIF
+
+          !! 9.1 Calculate the rate of sapwood to heartwood conversion 
+          !      Calculate the rate of sapwood to heartwood conversion with the time constant ::tau_sap(j) 
+          !      and update aboveground and belowground sapwood ::biomass(:,j,isapabove) and ::biomass(:,j,isapbelow)
+          !      and heartwood ::biomass(:,j,iheartabove) and ::biomass(:,j,iheartbelow).
+
+          DO k = 1,nelements
+
+             ! Above the ground
+             sapconv(:) = biomass(:,j,isapabove,k) * dt / tau_sap(j)
+             biomass(:,j,isapabove,k) = biomass(:,j,isapabove,k) - sapconv(:)
+             biomass(:,j,iheartabove,k) =  biomass(:,j,iheartabove,k) + sapconv(:)
+             
+             ! Below the ground
+             sapconv(:) = biomass(:,j,isapbelow,k) * dt / tau_sap(j)
+             biomass(:,j,isapbelow,k) = biomass(:,j,isapbelow,k) - sapconv(:)
+             biomass(:,j,iheartbelow,k) =  biomass(:,j,iheartbelow,k) + sapconv(:)
+
+          END DO
+
+          !! 9.2 If the vegetation is not dynamic, the age of the plant is decreased. 
+          !      The updated heartwood, the sum of new heartwood above and new heartwood below after 
+          !      converting sapwood to heartwood, is saved as ::hw_new(:) .
+          !      Creation of new heartwood decreases the age of the plant with a factor that is determined by: 
+          !      old heartwood ::hw_old(:) divided by the new heartwood ::hw_new(:)
+          IF ( .NOT. control%ok_dgvm ) THEN
+
+             hw_new(:) = biomass(:,j,iheartabove,icarbon) + biomass(:,j,iheartbelow,icarbon)
+
+             WHERE ( hw_new(:) .GT. zero )
+
+                age(:,j) = age(:,j) * hw_old(:)/hw_new(:)
+
+             ENDWHERE
+
+          ENDIF
+
+       ENDIF
+
+    ENDDO       ! loop over PFTs
+
+
+    ! Write mean leaf age and time constant of probability of a leaf to be eaten by a herbivore 
+    ! to the stomate output file.
+    CALL histwrite_p (hist_id_stomate, 'LEAF_AGE', itime, &
+         leaf_meanage, npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'HERBIVORES', itime, &
+         herbivores, npts*nvm, horipft_index)
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving turnover'
+
+  END SUBROUTINE turn
+
+END MODULE stomate_turnover
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_vmax.f90
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_vmax.f90	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/src_stomate/stomate_vmax.f90	(revision 5166)
@@ -0,0 +1,352 @@
+! =================================================================================================================================
+! MODULE 	: stomate_vmax
+!
+! CONTACT	: orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      	: IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        calculates the leaf efficiency.
+!!	
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN		:
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ =================================================================================================================================
+
+MODULE stomate_vmax
+
+  ! modules used:
+
+  USE ioipsl_para
+  USE stomate_data
+  USE constantes
+  USE pft_parameters
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC vmax, vmax_clear
+
+  ! first call
+  LOGICAL, SAVE                                              :: firstcall = .TRUE.
+!$OMP THREADPRIVATE(firstcall)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE	: vmax_clear
+!!
+!>\BRIEF	  Flag setting 
+!!
+!!\n DESCRIPTION: This subroutine sets flags ::firstcall, to .TRUE., and therefore activates   
+!!		  section 1.1 of the ::vmax subroutine which writes messages to the output. \n
+!!		  This subroutine is called at the end of the subroutine ::stomate_clear, in the 
+!!		  module ::stomate.
+!!
+!! RECENT CHANGE(S):None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::firstcall
+!!
+!! REFERENCE(S)  : None 
+!!
+!! FLOWCHART     : None
+!! \n		  
+!_ =================================================================================================================================
+
+  SUBROUTINE vmax_clear
+    firstcall=.TRUE.
+  END SUBROUTINE vmax_clear
+
+
+
+!! ================================================================================================================================
+!! SUBROUTINE    : vmax
+!!
+!>\BRIEF         This subroutine computes vjmax and vcmax photosynthesis parameters 
+!! given optimal vjmax and vcmax parameter values and a leaf age-related efficiency.
+!!
+!! DESCRIPTION (functional, design, flags): 
+!! Leaf age classes are introduced to take into account the fact that photosynthetic activity depends on leaf age
+!! (Ishida et al., 1999). There are \f$nleafages\f$ classes (constant defined in stomate_constants.f90).
+!! This subroutine first calculates the new age of each leaf age-class based on fraction of leaf 
+!! that goes from one to another class.                                              
+!! Then calculation of the new fraction of leaf in each class is performed.      
+!! Last, leaf efficiency is calculated for each PFT and for each leaf age class.
+!! vcmax and vjmax are defined as vcmax_opt and vjmax_opt weighted by a mean leaf
+!! efficiency. vjmax_opt and vcmax_opt are PFT-dependent constants defined in stomate_constants.f90.
+!!
+!! This routine is called once at the beginning by stomate_var_init and then at each stomate time step by stomateLpj.
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): vcmax and vjmax
+!!
+!! REFERENCE(S)	: 
+!! - Ishida, A., A. Uemura, N. Koike, Y. Matsumoto, and A. Lai Hoe (1999),
+!! Interactive effects of leaf age and self-shading on leaf structure, photosynthetic
+!! capacity and chlorophyll fluorescence in the rain forest tree,
+!! dryobalanops aromatica, Tree Physiol., 19, 741-747
+!!
+!! FLOWCHART    : None
+!!
+!! REVISION(S)	: None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE vmax (npts, dt, &
+       leaf_age, leaf_frac, &
+       vcmax, vjmax)
+
+    !
+    !! 0. Variable and parameter declaration
+    !
+
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                                 :: npts                    !! Domain size (unitless)
+    REAL(r_std), INTENT(in)                                    :: dt                      !! time step of stomate (days)
+
+    !
+    !! 0.2 Output variables 
+    !
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vcmax                   !! Maximum rate of carboxylation 
+                                                                                          !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)              :: vjmax                   !! Maximum rate of RUbp regeneration 
+                                                                                          !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+
+    !
+    !! 0.3 Modified variables
+    !
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_age                !! Leaf age (days)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(inout)  :: leaf_frac               !! fraction of leaves in leaf age 
+                                                                                          !! classes 
+                                                                                          !! (unitless)
+
+    !
+    !! 0.4 Local variables
+    !
+    REAL(r_std), DIMENSION(npts)                               :: leaf_efficiency         !! leaf efficiency (vcmax/vcmax_opt)
+                                                                                          !! (unitless)
+    REAL(r_std), DIMENSION(npts,nvm,nleafages)                 :: d_leaf_frac             !! turnover between age classes
+                                                                                          !! (unitless)
+    REAL(r_std), DIMENSION(npts,nleafages)                     :: leaf_age_new            !! new leaf age (days)
+    REAL(r_std), DIMENSION(npts)                               :: sumfrac                 !! sum of leaf age fractions, 
+                                                                                          !! for normalization
+                                                                                          !! (unitless)
+    REAL(r_std), DIMENSION(npts)                               :: rel_age                 !! relative leaf age (age/critical age)
+                                                                                          !! (unitless)
+    INTEGER(i_std)                                             :: j,m                     !! indices (unitless)
+
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering vmax'
+
+    !
+    !! 1 Initialization
+    !
+
+    !
+    !! 1.1 first call: info about flags and parameters.
+    !
+
+    IF ( firstcall ) THEN
+
+       WRITE(numout,*) 'vmax:'
+
+       WRITE(numout,*) '   > offset (minimum vcmax/vmax_opt):' , vmax_offset
+       WRITE(numout,*) '   > relative leaf age at which vmax reaches vcmax_opt:', leafage_firstmax 
+       WRITE(numout,*) '   > relative leaf age at which vmax falls below vcmax_opt:', leafage_lastmax
+       WRITE(numout,*) '   > relative leaf age at which vmax reaches its minimum:', leafage_old
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+    !
+    !! 1.2 initialize output
+    !
+
+    vcmax(:,:) = zero
+    vjmax(:,:) = zero
+
+    !
+    !! 2 leaf age: general increase and turnover between age classes.
+    !
+
+    !
+    !! 2.1 increase leaf age
+    !
+!
+!! The age of the leaves in each leaf-age-class increases by 1 time step.
+    DO m = 1, nleafages	! Loop over # leaf age classes 
+       DO j = 2,nvm	! Loop over # PFTs
+          WHERE ( leaf_frac(:,j,m) .GT. min_stomate )
+
+             leaf_age(:,j,m) = leaf_age(:,j,m) + dt
+             
+          ENDWHERE
+       ENDDO	! Loop over # PFTs 
+
+    ENDDO	! Loop over # leaf age classes
+
+    !
+    !! 2.2 turnover between leaf age classes
+    !     d_leaf_frac(:,:,m) = what leaves m-1 and goes into m
+    !
+
+    DO j = 2,nvm	! Loop over # PFTs
+
+       !! 2.2.1 fluxes
+
+       !! nothing goes into first age class
+       d_leaf_frac(:,j,1) = zero
+
+       !! for others age classes (what goes from m-1 to m)
+       DO m = 2, nleafages 
+!! leaf_timecst is defined in stomate_constants.f90 as the quotient of the critical leaf age per the number of age classes.
+!! The critical leaf age is a PFT-dependent constant defined in stomate_constants.f90, that represents the leaf life span.
+!! This time constant (leaf_timecst) determines the turnover between the nleafages different leaf age classes
+!! (see section [118] in Krinner et al. (2005)).
+          d_leaf_frac(:,j,m) = leaf_frac(:,j,m-1) * dt/leaf_timecst(j)
+
+       ENDDO
+
+       !! 2.2.2 new leaf age in class
+       !!       new age = ( old age * (old fraction - fractional loss) + fractional increase * age of the source class ) / new fraction
+       !!       The leaf age of the youngest class (m=1) is updated into stomate_alloc          
+       leaf_age_new(:,:) = zero
+
+       DO m = 2, nleafages-1       ! Loop over age classes
+	!! For all age classes except first and last 
+          WHERE ( d_leaf_frac(:,j,m) .GT. min_stomate )
+
+             leaf_age_new(:,m) = ( ( (leaf_frac(:,j,m)- d_leaf_frac(:,j,m+1)) * leaf_age(:,j,m) )  + &
+                  ( d_leaf_frac(:,j,m) * leaf_age(:,j,m-1) ) ) / &
+                  ( leaf_frac(:,j,m) + d_leaf_frac(:,j,m)- d_leaf_frac(:,j,m+1) )
+
+          ENDWHERE
+
+       ENDDO       ! Loop over age classes
+
+	!! For last age class, there is no leaf fraction leaving the class. 
+
+       WHERE ( d_leaf_frac(:,j,nleafages) .GT. min_stomate )
+
+          leaf_age_new(:,nleafages) = ( ( leaf_frac(:,j,nleafages) * leaf_age(:,j,nleafages) )  + &
+               ( d_leaf_frac(:,j,nleafages) * leaf_age(:,j,nleafages-1) ) ) / &
+               ( leaf_frac(:,j,nleafages) + d_leaf_frac(:,j,nleafages) )
+
+       ENDWHERE
+
+       DO m = 2, nleafages       ! Loop over age classes
+
+          WHERE ( d_leaf_frac(:,j,m) .GT. min_stomate )
+
+             leaf_age(:,j,m) = leaf_age_new(:,m)
+
+          ENDWHERE
+
+       ENDDO       ! Loop over age classes
+
+       !! 2.2.3 calculate new fraction
+
+       DO m = 2, nleafages       ! Loop over age classes
+
+          ! where the change comes from
+          leaf_frac(:,j,m-1) = leaf_frac(:,j,m-1) - d_leaf_frac(:,j,m)
+
+          ! where it goes to
+          leaf_frac(:,j,m) = leaf_frac(:,j,m) + d_leaf_frac(:,j,m)
+
+       ENDDO       ! Loop over age classes
+
+       !! 2.2.4 renormalize fractions in order to prevent accumulation 
+       !       of numerical errors
+
+       ! correct small negative values
+
+       DO m = 1, nleafages
+          leaf_frac(:,j,m) = MAX( zero, leaf_frac(:,j,m) )
+       ENDDO
+
+       ! total of fractions, should be very close to one where there is leaf mass
+
+       sumfrac(:) = zero
+
+       DO m = 1, nleafages       ! Loop over age classes
+
+          sumfrac(:) = sumfrac(:) + leaf_frac(:,j,m)
+
+       ENDDO       ! Loop over age classes
+
+       ! normalize
+
+       DO m = 1, nleafages       ! Loop over age classes
+
+          WHERE ( sumfrac(:) .GT. min_stomate )
+
+             leaf_frac(:,j,m) = leaf_frac(:,j,m) / sumfrac(:) 
+
+          ELSEWHERE
+
+             leaf_frac(:,j,m) = zero
+
+          ENDWHERE
+
+       ENDDO       ! Loop over age classes
+
+    ENDDO         ! Loop over PFTs
+
+    !
+    !! 3 calculate vmax as a function of the age
+    !
+
+    DO j = 2,nvm
+
+       vcmax(:,j) = zero
+       vjmax(:,j) = zero
+
+       ! sum up over the different age classes
+
+       DO m = 1, nleafages       ! Loop over age classes
+
+          !
+          !! 3.1 efficiency in each of the age classes
+          !!     it varies from vmax_offset to 1 
+          !!     linearly increases from vmax_offset to 1 for 0 < rel_age < leafage_firstmax
+          !!     is 1 when leafage_firstmax < rel_age < leafage_lastmax
+          !!     linearly decreases from 1 to vmax_offset for leafage_lastmax < rel_age < leafage_firstmax
+          !!     vmax_offset for rel_age >= leafage_old
+          !!     (Ishida et al., 1999)
+
+          rel_age(:) = leaf_age(:,j,m) / leafagecrit(j)
+
+          leaf_efficiency(:) = MAX( vmax_offset, MIN( un, &
+               vmax_offset + (un - vmax_offset) * rel_age(:) / leafage_firstmax, &
+               un - (un - vmax_offset) * ( rel_age(:) - leafage_lastmax ) / &
+               ( leafage_old - leafage_lastmax ) ) )
+
+          !
+          !! 3.2 add to mean vmax
+          !
+
+          vcmax(:,j) = vcmax(:,j) + vcmax_opt(j) * leaf_efficiency(:) * leaf_frac(:,j,m)
+          vjmax(:,j) = vjmax(:,j) + vjmax_opt(j) * leaf_efficiency(:) * leaf_frac(:,j,m)
+
+       ENDDO     ! loop over age classes
+
+    ENDDO       ! loop over PFTs
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving vmax'
+
+  END SUBROUTINE vmax
+
+END MODULE stomate_vmax
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/COPYRIGHT.txt
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/COPYRIGHT.txt	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/COPYRIGHT.txt	(revision 5166)
@@ -0,0 +1,109 @@
+!------------------------------------------------------------------------------!
+!              Flexible Configuration Management Software License              !
+!                                                                              !
+!     Please read this Software Licence as you will be bound by its terms      !
+!                           if you use the Software                            !
+!------------------------------------------------------------------------------!
+
+The Licensor:
+-------------
+
+The Met Office of FitzRoy Road, Exeter EX1 3PB, United Kingdom
+--------------------------------------------------------------------------------
+
+1. Licence.
+-----------
+
+The Met Office grants you a non-exclusive, royalty free; world-wide,
+transferable Licence to use, modify, copy and distribute the Flexible
+Configuration Management software ("the software") accompanying this License
+providing:
+
+a. you undertake to provide to the Met Office a copy of any modifications made
+   by you on the same terms contained within this licence agreement;
+
+b. modified files carry prominent notices stating that you changed the files
+   and the date of change;
+
+c. distribution of original or modified files is made free of charge under the
+   terms of this Licence;
+
+d. the appropriate copyright notices, the above copyright notice and a
+   disclaimer of warranty is included with the distribution.
+
+2. Ownership.
+-------------
+
+The Flexible Configuration Management software is Crown copyright and is
+reproduced with the permission of Met Office under delegated authority from
+the Controller of HMSO. The software and documentation are provided to you to
+allow you to exercise your rights under this License, which is granted to you.
+
+3. Duration.
+------------
+
+This license will remain in effect until terminated.
+ 
+4. Termination.
+---------------
+
+You may terminate this license at any time by removing all copies of the
+software from your system.  This License will terminate immediately without
+notice from us if you fail to comply with any of the provisions of this
+License or in the event of your breaching the terms of this licence you are
+given notice that the license has been terminated.  Upon termination you will
+delete all copies of the software and any related documentation.
+
+5. Disclaimer of Warranty.
+--------------------------
+
+a. THE MET OFFICE DISCLAIMS ALL WARRANTIES, REPRESENTATIONS AND PROMISES,
+   INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF SATISFACTORY QUALITY
+   AND FIT FOR THE PURPOSE.  NEITHER DOES THE MET OFFICE MAKE ANY
+   REPRESENTATIONS AS TO COMPATABILITY WITH YOUR OPERATING SYSTEMS AND
+   PLATFORMS.
+
+b. In no event does the Met Office warrant that the software or related
+   documentation will satisfy your requirements, that the software and
+   documentation will be without errors or defects or that the operation of
+   the software will be uninterrupted.
+
+c. IN NO EVENT WILL THE MET OFFICE BE LIABLE FOR ANY OTHER DAMAGES, INCLUDING
+   BUT NOT LIMITED TO DAMAGES FOR LOSS OF PROFITS DATA OR USE OF THE SOFTWARE
+   OR FOR ANY INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES, EVEN IF THE MET
+   OFFICE HAS BEEN SPECIFICALLY ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+6. General Provisions.
+----------------------
+
+a. You will not do anything, relating to this software that will bring the Met
+   Office into disrepute.
+
+b. You will not use the name of the Met Office or any other contributor to
+   endorse or promote any products derived from the software without the
+   written permission of the Met Office.
+
+7. Acknowledgements.
+--------------------
+
+The Fortran 9X Interface Generator found in file
+./src/lib/Ecmwf/Fortran90_stuff.pm is adapted from a script developed at ECMWF
+and is provided by kind permission of ECMWF under the same terms of this
+Licence.
+
+8. Entire Agreement.
+--------------------
+
+This License constitutes the entire agreement between us with respect to your
+rights or warranties for using the software and related documentation.  If any
+provision of this agreement is determined to be invalid or unenforceable the
+remaining provisions shall continue in full force.
+
+9. Governing Law.
+-----------------
+
+This Agreement is governed by and construed in accordance with the Laws of
+England.
+
+--------------------------------------------------------------------------------
+                                               © British Crown copyright 2006-7.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/LICENSE.html
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/LICENSE.html	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/LICENSE.html	(revision 5166)
@@ -0,0 +1,150 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+
+<html>
+<head>
+  <title>Flexible Configuration Management Software License</title>
+  <meta name="copyright" content="&copy; British Crown Copyright">
+  <style type="text/css">
+  <!--
+  body {
+    font: normal normal 10pt Arial, sans-serif;
+  }
+
+  h1 {
+    text-align: center;
+    text-decoration: underline;
+    font: normal bold 14pt Arial, sans-serif;
+  }
+
+  h2 {
+    text-align: left;
+    text-decoration: none;
+    font: normal normal 14pt Arial, sans-serif;
+  }
+
+  h3 {
+    text-align: left;
+    text-decoration: none;
+    font: normal bold 10pt Arial, sans-serif;
+  }
+
+  .copyright {
+    text-align: right;
+    font: normal bold 11pt Arial, sans-serif;
+  }
+
+  ol li {
+    list-style: lower-alpha;
+  }
+  //-->
+  </style>
+</head>
+
+<body>
+  <h1>Flexible Configuration Management Software License</h1>
+
+  <h1>Please read this Software Licence as you will be bound by its terms if
+  you use the Software</h1>
+
+  <h2>The Licensor:</h2>
+
+  <h2>The Met Office of FitzRoy Road, Exeter EX1 3PB, United Kingdom</h2>
+
+  <h3>1. Licence.</h3>
+
+  <p>The Met Office grants you a non-exclusive, royalty free; world-wide,
+  transferable Licence to use, modify, copy and distribute the Flexible
+  Configuration Management software ("the software") accompanying this License
+  providing:</p>
+
+  <ol>
+    <li>you undertake to provide to the Met Office a copy of any modifications
+    made by you on the same terms contained within this licence agreement;</li>
+
+    <li>modified files carry prominent notices stating that you changed the
+    files and the date of change;</li>
+
+    <li>distribution of original or modified files is made free of charge under
+    the terms of this Licence;</li>
+
+    <li>the appropriate copyright notices, the above copyright notice and a
+    disclaimer of warranty is included with the distribution.</li>
+  </ol>
+
+  <h3>2. Ownership.</h3>
+
+  <p>The Flexible Configuration Management software is Crown copyright and is
+  reproduced with the permission of Met Office under delegated authority from
+  the Controller of HMSO. The software and documentation are provided to you to
+  allow you to exercise your rights under this License, which is granted to
+  you.</p>
+
+  <h3>3. Duration.</h3>
+
+  <p>This license will remain in effect until terminated.</p>
+
+  <h3>4. Termination.</h3>
+
+  <p>You may terminate this license at any time by removing all copies of the
+  software from your system. This License will terminate immediately without
+  notice from us if you fail to comply with any of the provisions of this
+  License or in the event of your breaching the terms of this licence you are
+  given notice that the license has been terminated. Upon termination you will
+  delete all copies of the software and any related documentation.</p>
+
+  <h3>5. Disclaimer of Warranty.</h3>
+
+  <ol>
+    <li>THE MET OFFICE DISCLAIMS ALL WARRANTIES, REPRESENTATIONS AND PROMISES,
+    INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF SATISFACTORY QUALITY
+    AND FIT FOR THE PURPOSE. NEITHER DOES THE MET OFFICE MAKE ANY
+    REPRESENTATIONS AS TO COMPATABILITY WITH YOUR OPERATING SYSTEMS AND
+    PLATFORMS.</li>
+
+    <li>In no event does the Met Office warrant that the software or related
+    documentation will satisfy your requirements, that the software and
+    documentation will be without errors or defects or that the operation of
+    the software will be uninterrupted.</li>
+
+    <li>IN NO EVENT WILL THE MET OFFICE BE LIABLE FOR ANY OTHER DAMAGES,
+    INCLUDING BUT NOT LIMITED TO DAMAGES FOR LOSS OF PROFITS DATA OR USE OF THE
+    SOFTWARE OR FOR ANY INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES, EVEN IF
+    THE MET OFFICE HAS BEEN SPECIFICALLY ADVISED OF THE POSSIBILITY OF SUCH
+    DAMAGES.</li>
+  </ol>
+
+  <h3>6. General Provisions.</h3>
+
+  <ol>
+    <li>You will not do anything, relating to this software that will bring the
+    Met Office into disrepute.</li>
+
+    <li>You will not use the name of the Met Office or any other contributor to
+    endorse or promote any products derived from the software without the
+    written permission of the Met Office.</li>
+  </ol>
+
+  <h3>7. Acknowledgements.</h3>
+
+  <p>The Fortran 9X Interface Generator found in file
+  ./src/lib/Ecmwf/Fortran90_stuff.pm is adapted from a script developed at
+  ECMWF and is provided by kind permission of ECMWF under the same terms of
+  this Licence.</p>
+
+  <h3>8. Entire Agreement.</h3>
+
+  <p>This License constitutes the entire agreement between us with respect to
+  your rights or warranties for using the software and related documentation.
+  If any provision of this agreement is determined to be invalid or
+  unenforceable the remaining provisions shall continue in full force.</p>
+
+  <h3>9. Governing Law.</h3>
+
+  <p>This Agreement is governed by and construed in accordance with the Laws of
+  England.</p>
+
+  <div class="copyright">
+    <p>&copy; British Crown copyright 2006-7.</p>
+  </div>
+</body>
+</html>
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/README
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/README	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/README	(revision 5166)
@@ -0,0 +1,4 @@
+FCM release 1-2 created from revision 2131
+
+For further details please refer to the release notes
+which can be found in the directory doc/release_notes.
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm	(revision 5166)
@@ -0,0 +1,794 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm
+#
+# SYNOPSIS
+#   fcm SUBCOMMAND [OPTIONS...] ARGS...
+#
+# DESCRIPTION
+#   The fcm command is the frontend of the FCM system. The first argument to the
+#   command must be a recognised subcommand. See "fcm help" for a full list of
+#   functionalities.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas:
+use warnings;
+use strict;
+
+# Standard modules:
+use File::Basename;
+use File::Spec;
+use Getopt::Long;
+use Cwd;
+
+# FCM component modules:
+use lib File::Spec->catfile (dirname (dirname ($0)), 'lib');
+use Fcm::Config;
+use Fcm::Extract;
+use Fcm::Build;
+use Fcm::Util;
+
+BEGIN {
+  eval {
+    require Fcm::Cm;
+    import Fcm::Cm;
+
+    require Fcm::CmUrl;
+    import Fcm::CmUrl;
+  }
+}
+
+# Function declaration:
+sub cmp_ext_cfg;
+sub invoke_build_system;
+sub invoke_extract_system;
+sub invoke_cfg_printer;
+sub invoke_cm_system;
+sub invoke_www_browser;
+sub invoke_help;
+
+# ------------------------------------------------------------------------------
+
+my $prog      = basename $0;
+my $year      = (localtime)[5] + 1900;
+my $copyright = <<EOF;
+
+(C) Crown copyright $year Met Office. All rights reserved.
+EOF
+
+# List of sub-commands recognised by FCM
+my %subcommand = (
+  HLP => [qw/help ? h/],
+  BLD => [qw/build bld/],
+  EXT => [qw/extract ext/],
+  CFG => [qw/cfg/],
+  GUI => [qw/gui/],
+  CM  => [qw/
+    branch    br
+    conflicts cf
+    add
+    blame     praise annotate ann
+    cat
+    checkout  co
+    cleanup
+    commit    ci
+    copy      cp
+    delete    del    remove   rm
+    diff      di
+    export
+    import
+    info
+    list      ls
+    lock
+    log
+    merge
+    mkdir
+    mkpatch
+    move      mv     rename   ren
+    propdel   pdel   pd
+    propedit  pedit  pe
+    propget   pget   pg
+    proplist  plist  pl
+    propset   pset   ps
+    resolved
+    revert
+    status    stat   st
+    switch    sw
+    unlock
+    update    up
+  /],
+  CMP => [qw/cmp-ext-cfg/],
+  WWW => [qw/www trac/],
+);
+
+# Get configuration settings
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# Determine the functionality of this invocation of the command
+my $function = @ARGV ? shift @ARGV : '';
+
+# Run command accordingly
+if (grep {$_ eq $function} @{ $subcommand{BLD} }) {
+  invoke_build_system;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{EXT} }) {
+  invoke_extract_system;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{CFG} }) {
+  invoke_cfg_printer;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{GUI} }) {
+  &run_command (['fcm_gui', @ARGV], METHOD => 'exec');
+
+} elsif (grep {$_ eq $function} @{ $subcommand{CM} }) {
+  invoke_cm_system;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{CMP} }) {
+  cmp_ext_cfg;
+
+} elsif (grep {$_ eq $function} @{ $subcommand{WWW} }) {
+  invoke_www_browser;
+
+} elsif ($function =~ /^\s*$/ or grep {$_ eq $function} @{ $subcommand{HLP} }) {
+  invoke_help;
+
+} else {
+  w_report 'Unknown command: ', $function;
+  e_report 'Type "', $prog, ' help" for usage';
+}
+
+exit;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfg = &main::cfg ();
+#
+# DESCRIPTION
+#   Return the $config variable.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  return $config;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &cmp_ext_cfg ();
+#
+# DESCRIPTION
+#   Compare two similar extract configuration files.
+# ------------------------------------------------------------------------------
+
+sub cmp_ext_cfg {
+  # Check options
+  # ----------------------------------------------------------------------------
+  my ($wiki, $verbose);
+
+  GetOptions ('wiki|w=s' => \$wiki, 'verbose|v' => \$verbose);
+
+  # Check arguments
+  # ----------------------------------------------------------------------------
+  e_report $prog, ' ', $function,
+           ': 2 extract config files must be specified, abort.'
+    if @ARGV < 2;
+
+  # Invoke 2 new instances of the Fcm::Extract class
+  # ----------------------------------------------------------------------------
+  my (@cfg, $rc);
+  for my $i (0 .. 1) {
+    $cfg[$i] = Fcm::Extract->new (CFG_SRC => $ARGV[$i]);
+
+    # Read the extract configuration file
+    $rc = $cfg[$i]->decipher_cfg;
+    $rc = $cfg[$i]->expand_cfg if $rc;
+
+    last if not $rc;
+  }
+
+  # Throw error if command has failed
+  # ----------------------------------------------------------------------------
+  e_report $prog, ' ', $function,
+           ': cannot read extract configuration file, abort' if not $rc;
+
+  # Get list of URLs
+  # ----------------------------------------------------------------------------
+  my @urls = ();
+  for my $i (0 .. 1) {
+    # List of branches in each extract configuration file
+    my @branches = $cfg[$i]->branches;
+
+    for my $branch (@branches) {
+      # Ignore declarations of local directories
+      next if $branch->type eq 'user';
+
+      # List of SRC declarations in each branch
+      my %dirs = $branch->dirs;
+
+      for my $dir (values %dirs) {
+        # Set up a new instance of Fcm::CmUrl object for each SRC declaration
+        my $cm_url = Fcm::CmUrl->new (
+          URL => $dir . ($branch->version ? '@' . $branch->version : ''),
+        );
+
+        $urls[$i]{$cm_url->branch_url}{$dir} = $cm_url;
+      }
+    }
+  }
+
+  # Compare
+  # ----------------------------------------------------------------------------
+  my %log;
+  for my $i (0 .. 1) {
+    # Compare the first file with the second one and then vice versa
+    my $j = ($i == 0) ? 1 : 0;
+
+    for my $branch (sort keys %{ $urls[$i] }) {
+      if (exists $urls[$j]{$branch}) {
+        # Same REPOS declarations in both files
+        for my $dir (sort keys %{ $urls[$i]{$branch} }) {
+          if (exists $urls[$j]{$branch}{$dir}) {
+            # Same SRC declarations in both files, only need to compare once
+            next if $i == 1;
+
+            my $this_url = $urls[$i]{$branch}{$dir};
+            my $that_url = $urls[$j]{$branch}{$dir};
+
+            # Check whether their last changed revisions are the same
+            my $this_rev = $this_url->svninfo (FLAG => 'Last Changed Rev');
+            my $that_rev = $that_url->svninfo (FLAG => 'Last Changed Rev');
+
+            # Make sure last changed revisions differ
+            next if $this_rev eq $that_rev;
+
+            # Not interested in the log before the minimum revision
+            my $min_rev = ($this_url->pegrev > $that_url->pegrev)
+                          ? $that_url->pegrev : $this_url->pegrev;
+
+            $this_rev = $min_rev if $this_rev < $min_rev;
+            $that_rev = $min_rev if $that_rev < $min_rev;
+
+            # Get list of changed revisions using the commit log
+            my $u   = ($this_rev > $that_rev) ? $this_url : $that_url;
+            my %revs = $u->svnlog (REV => [$this_rev, $that_rev]);
+
+            for my $rev (keys %revs) {
+              # Check if revision is already in the list
+              next if exists $log{$branch}{$rev};
+
+              # Not interested in the minimum revision
+              next if $rev == $min_rev;
+
+              # Get list of changed paths. Accept this revision only if it
+              # contains changes in the current branch
+              my %paths  = %{ $revs{$rev}{paths} };
+
+              for my $path (keys %paths) {
+                my $change_url = Fcm::CmUrl->new (URL => $u->root . $path);
+
+                if ($change_url->branch eq $u->branch) {
+                  $log{$branch}{$rev} = $u;
+                  last;
+                }
+              }
+            }
+
+          } else {
+            # Report SRC declaration in one file but not in another
+            print $urls[$i]{$branch}{$dir}->url_peg, ':', "\n";
+            print '  in    : ', $ARGV[$i], "\n";
+            print '  not in: ', $ARGV[$j], "\n\n";
+          }
+        }
+
+      } else {
+        # Report REPOS declaration in one file but not in another
+        print $branch, ':', "\n";
+        print '  in    : ', $ARGV[$i], "\n";
+        print '  not in: ', $ARGV[$j], "\n\n";
+      }
+    }
+  }
+
+  # Report modifications
+  # ----------------------------------------------------------------------------
+  print 'Revisions at which declared source directories are modified:', "\n\n"
+    if keys %log;
+
+  if (defined $wiki) {
+    # Output in wiki format
+    my $wiki_url  = Fcm::CmUrl->new (URL => &expand_url_keyword (URL => $wiki));
+    my $base_trac = $wiki
+                    ? &get_browser_url (URL => $wiki_url->project_url)
+                    : $wiki_url;
+    $base_trac    = $wiki_url if not $base_trac;
+
+    for my $branch (sort keys %log) {
+      # Name of the branch
+      my $branch_trac = &get_browser_url (URL => $branch);
+      $branch_trac =~ s#^$base_trac(?:/*|$)#source:#;
+
+      print '[', $branch_trac, ']:', "\n";
+
+      # Revision table
+      for my $rev (sort {$b <=> $a} keys %{ $log{$branch} }) {
+        print $log{$branch}{$rev}->display_svnlog ($rev, $base_trac), "\n";
+      }
+
+      print "\n";
+    }
+
+  } else {
+    my $separator = '-' x 80 . "\n";
+
+    for my $branch (sort keys %log) {
+      # Output in plain text format
+      print $branch, ':', "\n";
+
+      if ($verbose or &cfg->verbose > 1) {
+        # Verbose mode, print revision log
+        for my $rev (sort {$b <=> $a} keys %{ $log{$branch} }) {
+          print $separator, $log{$branch}{$rev}->display_svnlog ($rev), "\n";
+        }
+
+      } else {
+        # Normal mode, print list of revisions
+        print join (' ', sort {$b <=> $a} keys %{ $log{$branch} }), "\n";
+      }
+
+      print $separator, "\n";
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_build_system ();
+#
+# DESCRIPTION
+#   Invoke the build system.
+# ------------------------------------------------------------------------------
+
+sub invoke_build_system {
+  my ($archive, $full, $ignore_lock, $jobs, $stage, @targets, $verbose);
+
+  GetOptions (
+    'archive|a'   => \$archive,     # switch on archive mode?
+    'full|f'      => \$full,        # full build?
+    'ignore-lock' => \$ignore_lock, # ignore lock file?
+    'jobs|j=i'    => \$jobs,        # number of parallel jobs in make
+    'stage|s=s'   => \$stage,       # build up to and including this stage
+    'targets|t=s' => \@targets,     # make targets
+    'verbose|v=i' => \$verbose,     # verbose level
+  );
+
+  # Verbose level
+  $config->verbose ($verbose) if defined $verbose;
+
+  # Invoke a new instance of the Fcm::Build class
+  my $bld = Fcm::Build->new (CFG_SRC  => @ARGV ? join (' ', @ARGV) : cwd ());
+
+  # Perform build
+  $bld->build (
+    ARCHIVE     => $archive,
+    FULL        => $full,
+    IGNORE_LOCK => $ignore_lock,
+    JOBS        => $jobs ? $jobs : 1,
+    STAGE       => $stage ? $stage : 5,
+    TARGETS     => (@targets ? [split (/:/, join (':', @targets))] : [qw/all/]),
+  );
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_extract_system ();
+#
+# DESCRIPTION
+#   Invoke the extract system.
+# ------------------------------------------------------------------------------
+
+sub invoke_extract_system {
+  my ($full, $ignore_lock, $verbose);
+
+  GetOptions (
+    'full|f'      => \$full,        # full extract?
+    'ignore-lock' => \$ignore_lock, # ignore lock file?
+    'verbose|v=i' => \$verbose,     # verbose level
+  );
+
+  $config->verbose ($verbose) if defined $verbose;
+
+  # Invoke a new instance of the Fcm::Extract class
+  my $ext = Fcm::Extract->new (CFG_SRC => @ARGV ? join (' ', @ARGV) : cwd ());
+
+  # Perform extract
+  $ext->extract (FULL => $full, IGNORE_LOCK => $ignore_lock);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_cfg_printer ();
+#
+# DESCRIPTION
+#   Invoke the CFG file pretty printer.
+# ------------------------------------------------------------------------------
+
+sub invoke_cfg_printer {
+
+  use Fcm::CfgFile;
+
+  my $out_file;
+  GetOptions (
+    'output|o=s'  => \$out_file,  # output file for print
+  );
+
+  my $file = join (' ', @ARGV);
+  e_report $prog, ' ', $function, ': file not specified, abort.' if ! $file;
+
+  # Invoke a new Fcm::CfgFile instance
+  my $cfg = Fcm::CfgFile->new (SRC => $file);
+
+  # Read the cfg file
+  my $read = $cfg->read_cfg;
+  e_report if not $read;
+
+  # Pretty print CFG file
+  $cfg->print_cfg ($out_file);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_cm_system ();
+#
+# DESCRIPTION
+#   Invoke a code management system command.
+# ------------------------------------------------------------------------------
+
+sub invoke_cm_system {
+
+  &cm_command ($function);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_www_browser ();
+#
+# DESCRIPTION
+#   Invoke a web browser on the specified PATH.
+# ------------------------------------------------------------------------------
+
+sub invoke_www_browser {
+
+  # Options
+  my ($browser);
+  GetOptions (
+    'browser|b=s' => \$browser, # browser command
+  );
+
+  $browser = &cfg->setting (qw/MISC WEB_BROWSER/) unless $browser;
+
+  # Arguments
+  my ($arg) = @ARGV ? $ARGV[0] : (&is_wc () ? '.' : '');
+  e_report $prog, ' ', $function,
+           ': input URL not specified and . not a working copy, abort.'
+    if not $arg;
+
+  # Local PATH?
+  $arg = &expand_tilde ($arg);
+  $arg = &get_url_of_wc ($arg) if -e $arg;
+
+  # Expand URL and revision keywords
+  my $www_url = &expand_url_keyword (URL => $arg);
+  my $rev     = 'HEAD';
+
+  if ($www_url =~ m#^(\w+://\S+)@(\S+)$#) {
+    $www_url = $1;
+    $rev     = $2;
+  }
+
+  $rev = &expand_rev_keyword (URL => $www_url, REV => $rev, HEAD => 1)
+    unless uc ($rev) eq 'HEAD';
+
+  # Get web browser URL
+  $www_url = &get_browser_url (URL => $www_url);
+  die 'WWW URL not defined for "', $arg, '", abort' unless $www_url;
+
+  $www_url = $www_url . '?rev=' . $rev;
+
+  # Execute command
+  my @command = (split (/\s+/, $browser), $www_url);
+  &run_command (\@command, METHOD => 'exec', PRINT => 1);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_help ();
+#
+# DESCRIPTION
+#   Invoke help.
+# ------------------------------------------------------------------------------
+
+sub invoke_help {
+
+  my $cmd = @ARGV ? shift @ARGV : undef;
+
+  if ($cmd) {
+    if (grep {$_ eq $cmd} @{ $subcommand{BLD} }) {
+      print <<EOF;
+$prog $cmd: invoke the build system.
+usage: $prog $cmd [OPTIONS...] [CFGFILE]
+
+  The path to a CFG file may be provided. Otherwise, the build system
+  searches the default locations for a bld cfg file.
+
+  If no option is specified, the options "-s 5 -t all -j 1 -v 1" are assumed.
+
+  If the option for full build is specified, the sub-directories created by
+  previous builds will be removed, so that the current build can start cleanly.
+
+  The -s option can be used to limit the actions performed by the build system
+  up to a named stage. The stages are:
+    "1", "s" or "setup"                - stage 1, setup
+    "2", "pp" or "pre_process"         - stage 2, pre-process
+    "3", "gd" or "generate_dependency" - stage 3, generate dependency
+    "4", "gi" or "generate_interface"  - stage 4, generate Fortran 9X interface
+    "5", "m", "make"                   - stage 5, make
+
+  If a colon separated list of targets is specified using the -t option, the
+  default targets specified in the configuration file will not be used.
+
+  If archive mode is switched on, build sub-directories that are only used
+  in the build process will be archived to TAR files. The default is off.
+
+  If specified, the verbose level must be an integer greater than 0. Verbose
+  level 0 is the quiet mode. Increasing the verbose level will increase the
+  amount of diagnostic output.
+
+  When a build is invoked, it sets up a lock file in the build root directory.
+  The lock is normally removed at the end of the build. While the lock file is
+  in place, othe build commands invoked in the same root directory will fail.
+  If you need to bypass this check for whatever reason, you can invoke the
+  build system with the --ignore-lock option.
+
+Valid options:
+  -a [--archive]     : archive build sub-directories?
+  -f [--full]        : full build
+  --ignore-lock      : ignore lock files in build root directory
+  -j [--jobs] arg    : number of parallel jobs that "make" can handle
+  -s [--stage] arg   : perform build up to a named stage
+  -t [--targets] arg : build a colon (:) separated list of targets
+  -v [--verbose] arg : verbose level
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{EXT} }) {
+      print <<EOF;
+$prog $cmd: invoke the extract system.
+usage: $prog $cmd [OPTIONS...] [CFGFILE]
+
+  The path to a CFG file may be provided. Otherwise, the extract system
+  searches the default locations for an ext cfg file.
+
+  If no option is specified, the system will attempt an incremental extract
+  where appropriate.
+
+  If specified, the verbose level must be an integer greater than 0. Verbose
+  level 0 is the quiet mode. Increasing the verbose level will increase the
+  amount of diagnostic output.
+
+  When an extract is invoked, it sets up a lock file in the extract destination
+  root directory. The lock is normally removed at the end of the extract. While
+  the lock file is in place, othe extract commands invoked in the same
+  destination root directory will fail. If you need to bypass this check for
+  whatever reason, you can invoke the extract system with the --ignore-lock
+  option.
+
+Valid options:
+  -f [--full]        : perform a full/clean extract
+  --ignore-lock      : ignore lock files in build root directory
+  -v [--verbose] arg : verbose level
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{CFG} }) {
+      print <<EOF;
+$prog $cmd: invoke the CFG file pretty printer.
+usage: $prog $cmd [OPTIONS...] FILE
+
+  If no option is specified, the output will be sent to standard output.
+
+Valid options:
+  -o [--output] arg : send output to a file as specified by arg.
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{GUI} }) {
+      print <<EOF;
+$prog $cmd: invoke the GUI wrapper for CM commands.
+usage: $prog $cmd DIR
+
+  The optional argument DIR modifies the initial working directory.
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{CM} }) {
+      @ARGV = qw(--help);
+      cm_command ($cmd);
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{CMP} }) {
+      print <<EOF;
+$prog $cmd: compare two similar extract configuration files.
+usage: $prog $cmd [OPTIONS...] CFG1 CFG2
+
+  Compares the extract configurations of two similar extract configuration
+  files CFG1 and CFG2.
+
+Valid options:
+  -v [--verbose]  : print revision tables in verbose mode. In particular,
+                    display the change log of each revision.
+  -w [--wiki] arg : print revision tables in wiki format. The argument to this
+                    option must be the Subversion URL or FCM URL keyword of a
+                    FCM project associated with the intended Trac system. This
+                    option overrides the -v option.
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{WWW} }) {
+      print <<EOF;
+$prog $cmd: invoke the web repository browser on a Subversion URL.
+usage: $prog $cmd [OPTIONS...] [PATH]
+
+  If PATH is specified, it must be a FCM URL keyword, a Subversion URL or the
+  PATH to a local working copy. If not specified, the current working directory
+  is assumed to be a working copy. If the --browser option is specified, the
+  specified web browser command is used to launch the repository browser.
+  Otherwise, it attempts to use the default browser from the configuration
+  setting.
+
+Valid options:
+  -b [--browser] arg : specify a command arg for the web browser.
+$copyright
+EOF
+
+    } elsif (grep {$_ eq $cmd} @{ $subcommand{HLP} }) {
+      print <<EOF;
+help (?, h): Describe the usage of $prog or its subcommands.
+usage: $prog help [SUBCOMMAND...]
+$copyright
+EOF
+
+      &run_command ([qw/svn help/, $cmd, @ARGV], PRINT => 1);
+
+    } else {
+      warn $prog, ' help: "', $cmd, '" not recognised';
+      $cmd = undef;
+    }
+  }
+
+  if (not $cmd) {
+    # Get output from "svn help"
+    my @lines = &run_command (
+      [qw/svn help/], DEVNULL => 1, METHOD => 'qx', ERROR => 'ignore',
+    );
+
+    # Get release number, (and revision number from revision number file)
+    my $release  = &cfg->setting ('RELEASE');
+    my $rev_file = &cfg->setting ('REV_FILE');
+
+    if (-r $rev_file) {
+      open FILE, '<', $rev_file;
+      my $rev = readline 'FILE';
+      close FILE;
+
+      chomp $rev;
+      $release .= '-dev (r' . $rev . ')' if $rev;
+    }
+
+    # Print common help
+    print <<EOF;
+usage: $prog <subcommand> [options] [args]
+Flexible configuration management system, release $release.
+Type "$prog help <subcommand>" for help on a specific subcommand.
+
+Available subcommands:
+  help       (h, ?) - help
+  build      (bld)  - build system
+EOF
+
+    # The following are only available on platforms with "svn" installed
+    if (@lines) {
+      print <<EOF;
+  branch     (br)   - cm system: branch info & creation
+  cfg               - CFG file pretty printer
+  cmp-ext-cfg       - compare two similar extract configuration files
+  conflicts  (cf)   - cm system: resolve conflicts
+  extract    (ext)  - extract system
+  mkpatch           - create patches from specified revisions of a URL
+  trac       (www)  - cm system: browse a path using the web browser
+  <SVN COMMANDS>    - any Subversion sub-commands
+EOF
+    }
+
+    # Print FCM copyright notice
+    print $copyright;
+
+    # Print output from "svn help"
+    if (@lines) {
+      print "\n";
+      &print_command ([qw/svn help/]);
+      print @lines;
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ans = &main::get_input (MESSAGE => $mesg, TYPE => $type, DEFAULT => $def);
+#
+# DESCRIPTION
+#   Get an input string from the user and return it as $ans. MESSAGE is the
+#   main message printed on screen to prompt the user for an input.  If TYPE is
+#   'YN', print message to prompt user to enter either 'y' or 'n'. If TYPE is
+#   'YNA', then 'a' is given as a third option. If DEFAULT is set, print message
+#   to inform user that the return value will be set to the $def (if nothing is
+#   entered).
+# ------------------------------------------------------------------------------
+
+sub get_input {
+  my %args = @_;
+  my $type  = exists $args{TYPE}    ? $args{TYPE}    : '';
+  my $mesg  = exists $args{MESSAGE} ? $args{MESSAGE} : '';
+  my $def   = exists $args{DEFAULT} ? $args{DEFAULT} : '';
+
+  my $ans;
+
+  while (1) {
+    # Print the prompt
+    print $mesg;
+    print "\n", 'Enter "y" or "n"' if uc ($type) eq 'YN';
+    print "\n", 'Enter "y", "n" or "a"' if uc ($type) eq 'YNA';
+    print ' (or just press <return> for "', $def, '")' if $def;
+    print ': ';
+
+    # Get answer from STDIN
+    $ans = <STDIN>;
+    chomp $ans;
+
+    # Set answer to default, if necessary
+    $ans = $def if ($def and not $ans);
+
+    if ($type =~ /^yna?$/i) {
+      # For YN and YNA type dialog boxes,
+      # check that the answer is in the correct form
+      my $pat = (uc ($type) eq 'YN' ? 'y|n' : 'y|n|a');
+      last if $ans =~ /^(?:$pat)/i;
+
+    } else {
+      last;
+    }
+  }
+
+  return $ans;
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_graphic_diff
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_graphic_diff	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_graphic_diff	(revision 5166)
@@ -0,0 +1,90 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_graphic_diff
+#
+# SYNOPSIS
+#   fcm_graphic_diff [-u] [-L OLD_DESC] [-L NEW_DESC] OLD NEW
+#
+# DESCRIPTION
+#   Wrapper script which invokes a graphical diff tool. Its interface is
+#   compatible with the "svn diff" command and can be used in combination with
+#   its "--diff-cmd" option. The command prints the OLD_DESC and NEW_DESC if
+#   they are both set. The two arguments OLD and NEW must be set and are the
+#   files to compare. The graphical diff tool invoked depends on the value of
+#   the FCM_GRAPHIC_DIFF environment variable. The command exits if the
+#   environment variable is not set.
+#
+# COPYRIGHT
+#   This program is part of the FCM system.
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas:
+use warnings;
+use strict;
+
+use Getopt::Long;
+
+# ------------------------------------------------------------------------------
+
+my ($u, @label);
+GetOptions ('u' => \$u, 'L=s' => \@label);
+
+# Check existence of files
+for my $i (0 .. 1) {
+  die $ARGV[$i], ': not found, abort' unless $ARGV[$i] and -f $ARGV[$i];
+}
+
+my ($old, $new) = @ARGV;
+
+if ($old =~ m#.svn/empty-file$#) {
+  print 'Skipping new file', "\n\n";
+
+} elsif ($new =~ m#.svn/empty-file$#) {
+  print 'Skipping deleted file', "\n\n";
+
+} elsif (-z $old) {
+  print 'Skipping as old file is empty (or does not exist)', "\n\n";
+
+} elsif (-z $new) {
+  print 'Skipping as new file is empty (or deleted)', "\n\n";
+
+} elsif (-B $new) {
+  print 'Skipping binary file', "\n\n";
+
+} else {
+  # Print descriptions of files
+  if (@label >= 2) {
+    print '--- ', $label[0], "\n", '+++ ', $label[1], "\n\n";
+  }
+
+  # FCM_GRAPHIC_DIFF is the graphical diff tool command
+  my $cmd = (exists $ENV{FCM_GRAPHIC_DIFF} ? $ENV{FCM_GRAPHIC_DIFF} : 'xxdiff');
+
+  if ($cmd) {
+    my @options = ();
+
+    # Set options for labels if appropriate
+    if (@label >= 2) {
+      if ($cmd eq 'tkdiff') {
+        # Use tkdiff
+        @options = ('-L', $label[0], '-L', $label[1]);
+
+      } elsif ($cmd eq 'xxdiff') {
+        # Use xxdiff
+        @options = ('--title1', $label[0], '--title2', $label[1]);
+      }
+    }
+
+    # Execute the command
+    my @command = ($cmd, @options, $old, $new);
+    exec (@command) or die 'Cannot execute: ', join (' ', @command);
+  }
+
+  exit;
+}
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_gui
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_gui	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_gui	(revision 5166)
@@ -0,0 +1,1321 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_gui
+#
+# SYNOPSIS
+#   fcm_gui [DIR]
+#
+# DESCRIPTION
+#   The fcm_gui command is a simple graphical user interface for some of the
+#   commands of the FCM system. The optional argument DIR modifies the initial
+#   working directory.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas
+use warnings;
+use strict;
+
+# Standard modules
+use File::Basename;
+use File::Spec::Functions;
+use Cwd;
+use Tk;
+use Tk::ROText;
+
+# FCM component modules:
+use lib catfile (dirname (dirname ($0)), 'lib');
+use Fcm::Config;
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+
+# Argument
+if (@ARGV) {
+  my $dir = shift @ARGV;
+  chdir $dir if -d $dir;
+}
+
+# Get configuration settings
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# ------------------------------------------------------------------------------
+
+# FCM subcommands
+my @subcmds = qw/CHECKOUT BRANCH STATUS DIFF ADD DELETE MERGE CONFLICTS COMMIT
+                 UPDATE SWITCH/;
+
+# Subcommands allowed when CWD is not a WC
+my @nwc_subcmds = qw/CHECKOUT BRANCH/;
+
+# Subcommands allowed, when CWD is a WC
+my @wc_subcmds = qw/STATUS BRANCH DIFF ADD DELETE MERGE CONFLICTS COMMIT UPDATE
+                    SWITCH/;
+
+# Subcommands that apply to WC only
+my @wco_subcmds = qw/BRANCH STATUS DIFF ADD DELETE MERGE CONFLICTS COMMIT UPDATE
+                     SWITCH/;
+
+# Subcommands that apply to top level WC only
+my @wcto_subcmds = qw/BRANCH MERGE COMMIT UPDATE SWITCH/;
+
+# Selected subcommand
+my $selsubcmd = '';
+
+# Selected subcommand is running?
+my $cmdrunning = 0;
+
+# PID of running subcommand
+my $cmdpid = undef;
+
+# List of subcommand frames
+my %subcmd_f;
+
+# List of subcommand buttons
+my %subcmd_b;
+
+# List of subcommand button help strings
+my %subcmd_help = (
+  BRANCH    => 'list information about, create or delete a branch.',
+  CHECKOUT  => 'check out a working copy from a repository.',
+  STATUS    => 'print the status of working copy files and directories.',
+  DIFF      => 'display the differences in modified files.',
+  ADD       => 'put files and directories under version control.',
+  DELETE    => 'remove files and directories from version control.',
+  MERGE     => 'merge changes into your working copy.',
+  CONFLICTS => 'use "xxdiff" to resolve any conflicts within your working copy.',
+  COMMIT    => 'send changes from your working copy to the repository.',
+  UPDATE    => 'bring changes from the repository into your working copy.',
+  SWITCH    => 'update your working copy to a different URL.',
+);
+
+for (keys %subcmd_help) {
+  $subcmd_help{$_} = 'Select the "' . lc ($_) . '" sub-command - ' .
+                     $subcmd_help{$_};
+}
+
+# List of subcommand button bindings (key name and underline position)
+my %subcmd_bind = (
+  BRANCH    => {KEY => '<Alt-Key-b>', U => 0},
+  CHECKOUT  => {KEY => '<Alt-Key-o>', U => 5},
+  STATUS    => {KEY => '<Alt-Key-s>', U => 0},
+  DIFF      => {KEY => '<Alt-Key-d>', U => 0},
+  ADD       => {KEY => '<Alt-Key-a>', U => 0},
+  DELETE    => {KEY => '<Alt-Key-t>', U => 4},
+  MERGE     => {KEY => '<Alt-Key-m>', U => 0},
+  CONFLICTS => {KEY => '<Alt-Key-f>', U => 3},
+  COMMIT    => {KEY => '<Alt-Key-c>', U => 0},
+  UPDATE    => {KEY => '<Alt-Key-u>', U => 0},
+  SWITCH    => {KEY => '<Alt-Key-w>', U => 1},
+);
+
+# List of subcommand variables
+my %subcmdvar = (
+  CWD       => cwd (),
+  WCT       => '',
+  CWD_URL   => '',
+  WCT_URL   => '',
+
+  BRANCH    => {
+    OPT     => 'info',
+    URL     => '',
+    NAME    => '',
+    TYPE    => 'DEV',
+    REVFLAG => 'NORMAL',
+    REV     => '',
+    TICKET  => '',
+    SRCTYPE => 'trunk',
+    S_CHD   => 0,
+    S_SIB   => 0,
+    S_OTH   => 0,
+    VERBOSE => 0,
+    OTHER   => '',
+  },
+
+  CHECKOUT  => {
+    URL     => '',
+    REV     => 'HEAD',
+    PATH    => '',
+    OTHER   => '',
+  },
+
+  STATUS    => {
+    USEWCT  => 0,
+    UPDATE  => 0,
+    VERBOSE => 0,
+    OTHER   => '',
+  },
+
+  DIFF      => {
+    USEWCT  => 0,
+    GRAPHIC => 1,
+    BRANCH  => 0,
+    URL     => '',
+    OTHER   => '',
+  },
+
+  ADD       => {
+    USEWCT  => 0,
+    CHECK   => 1,
+    OTHER   => '',
+  },
+
+  DELETE    => {
+    USEWCT  => 0,
+    CHECK   => 1,
+    OTHER   => '',
+  },
+
+  MERGE     => {
+    USEWCT  => 1,
+    SRC     => '',
+    MODE    => 'automatic',
+    DRYRUN  => 0,
+    VERBOSE => 0,
+    REV     => '',
+    OTHER   => '',
+  },
+
+  CONFLICTS => {
+    USEWCT  => 0,
+    OTHER   => '',
+  },
+
+  COMMIT    => {
+    USEWCT  => 1,
+    DRYRUN  => 0,
+    OTHER   => '',
+  },
+
+  UPDATE    => {
+    USEWCT  => 1,
+    OTHER   => '',
+  },
+
+  SWITCH    => {
+    USEWCT  => 1,
+    URL     => '',
+    OTHER   => '',
+  },
+);
+
+# List of action buttons
+my %action_b;
+
+# List of action button help strings
+my %action_help = (
+  QUIT  => 'Quit fcm gui',
+  HELP  => 'Print help to the output text box for the selected sub-command',
+  CLEAR => 'Clear the output text box',
+  RUN   => 'Run the selected sub-command',
+);
+
+# List of action button bindings
+my %action_bind = (
+  QUIT  => {KEY => '<Control-Key-q>', U => undef},
+  HELP  => {KEY => '<F1>'           , U => undef},
+  CLEAR => {KEY => '<Alt-Key-l>'    , U => 1},
+  RUN   => {KEY => '<Alt-Key-r>'    , U => 0},
+);
+
+# List of branch subcommand options
+my %branch_opt = (
+  INFO   => undef,
+  CREATE => undef,
+  DELETE => undef,
+  LIST   => undef,
+);
+
+# List of branch create types
+my %branch_type = (
+  'DEV'         => undef,
+  'DEV::SHARE'  => undef,
+  'TEST'        => undef,
+  'TEST::SHARE' => undef,
+  'PKG'         => undef,
+  'PKG::SHARE'  => undef,
+  'PKG::CONFIG' => undef,
+  'PKG::REL'    => undef,
+);
+
+# List of branch create source type
+my %branch_srctype = (
+  TRUNK  => undef,
+  BRANCH => undef,
+);
+
+# List of branch create revision prefix option
+my %branch_revflag = (
+  NORMAL => undef,
+  NUMBER => undef,
+  NONE   => undef,
+);
+
+# List of branch info/delete options
+my %branch_info_opt = (
+  S_CHD   => 'Show children',
+  S_SIB   => 'Show siblings',
+  S_OTH   => 'Show other',
+  VERBOSE => 'Print extra information',
+);
+
+# Text in the status bar
+my $statustext = '';
+
+# ------------------------------------------------------------------------------
+
+my $mw = MainWindow->new ();
+
+my $mw_title = 'FCM GUI';
+$mw->title ($mw_title);
+
+# Frame containing subcommand selection buttons
+my $top_f = $mw->Frame ()->grid (
+  '-row'    => 0,
+  '-column' => 0,
+  '-sticky' => 'w',
+);
+
+# Frame containing subcommand options
+my $mid_f = $mw->Frame ()->grid (
+  '-row'    => 1,
+  '-column' => 0,
+  '-sticky' => 'ew',
+);
+
+# Frame containing action buttons
+my $bot_f = $mw->Frame ()->grid (
+  '-row'    => 2,
+  '-column' => 0,
+  '-sticky' => 'ew',
+);
+
+# Text box to display output
+my $out_t  = $mw->Scrolled ('ROText', '-scrollbars' => 'osow')->grid (
+  '-row'    => 3,
+  '-column' => 0,
+  '-sticky' => 'news',
+);
+
+# Text box - allow scroll with mouse wheel
+$out_t->bind (
+  '<4>' => sub {
+    $_[0]->yview ('scroll', -1, 'units') unless $Tk::strictMotif;
+  },
+);
+
+$out_t->bind (
+  '<5>' => sub {
+    $_[0]->yview ('scroll', +1, 'units') unless $Tk::strictMotif;
+  },
+);
+
+# Status bar
+$mw->Label (
+  '-textvariable' => \$statustext,
+  '-relief'       => 'groove',
+)->grid (
+  '-row'    => 4,
+  '-column' => 0,
+  '-sticky' => 'ews',
+);
+
+# Main window grid configure
+{
+  my ($cols, $rows) = $mw->gridSize ();
+  $mw->gridColumnconfigure ($_, '-weight' => 1) for (0 .. $cols - 1);
+  $mw->gridRowconfigure    ( 3, '-weight' => 1);
+}
+
+# Frame grid configure
+{
+  my ($cols, $rows) = $mid_f->gridSize ();
+  $bot_f->gridColumnconfigure (3, '-weight' => 1);
+}
+
+$mid_f->gridRowconfigure    (0, '-weight' => 1);
+$mid_f->gridColumnconfigure (0, '-weight' => 1);
+
+# ------------------------------------------------------------------------------
+
+# Buttons to select subcommands
+{
+  my $col = 0;
+  for my $name (@subcmds) {
+    $subcmd_b{$name} = $top_f->Button (
+      '-text'    => uc (substr ($name, 0, 1)) . lc (substr ($name, 1)),
+      '-command' => [\&button_clicked, $name],
+      '-width'   => 8,
+    )->grid (
+      '-row'    => 0,
+      '-column' => $col++,
+      '-sticky' => 'w',
+    );
+
+    $subcmd_b{$name}->bind ('<Enter>', sub {$statustext = $subcmd_help{$name}});
+    $subcmd_b{$name}->bind ('<Leave>', sub {$statustext = ''});
+
+    $subcmd_b{$name}->configure ('-underline' => $subcmd_bind{$name}{U})
+      if defined $subcmd_bind{$name}{U};
+
+    $mw->bind ($subcmd_bind{$name}{KEY}, sub {$subcmd_b{$name}->invoke});
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+# Frames to contain subcommands options
+{
+  my %row = ();
+
+  for my $name (@subcmds) {
+    $subcmd_f{$name} = $mid_f->Frame ();
+    $subcmd_f{$name}->gridColumnconfigure (1, '-weight' => 1);
+
+    $row{$name} = 0;
+
+    # Widgets common to all sub-commands
+    $subcmd_f{$name}->Label ('-text' => 'Current working directory: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Label ('-textvariable' => \($subcmdvar{CWD}))->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'w',
+    );
+  }
+
+  # Widgets common to all sub-commands that apply to working copies
+  for my $name (@wco_subcmds) {
+    my @labtxts = (
+      'Corresponding URL: ',
+      'Working copy top: ',
+      'Corresponding URL: ',
+    );
+    my @varrefs = \(
+      $subcmdvar{URL_CWD},
+      $subcmdvar{WCT},
+      $subcmdvar{URL_WCT},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Label ('-text' => $labtxts[$i])->grid (
+        '-row'    => $row{$name},
+        '-column' => 0,
+        '-sticky' => 'w',
+      );
+      $subcmd_f{$name}->Label ('-textvariable' => $varrefs[$i])->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+    }
+
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Apply sub-command to working copy top',
+      '-variable' => \($subcmdvar{$name}{USEWCT}),
+      '-state'    => (grep ({$_ eq $name} @wcto_subcmds) ? 'disabled' : 'normal'),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Branch sub-command
+  {
+    my $name = 'BRANCH';
+
+    # Radio buttons to select the sub-option of the branch sub-command
+    my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    my $col = 0;
+    for my $key (sort keys %branch_opt) {
+      my $opt = lc $key;
+
+      $branch_opt{$key} = $opt_f->Radiobutton (
+        '-text'     => $opt,
+        '-value'    => $opt,
+        '-variable' => \($subcmdvar{$name}{OPT}),
+        '-state'    => 'normal',
+      )->grid (
+        '-row'      => 0,
+        '-column'   => $col++,
+        '-sticky'   => 'w',
+      );
+    }
+
+    # Label and entry box for specifying URL
+    $subcmd_f{$name}->Label ('-text' => 'URL: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry box for specifying create branch name
+    $subcmd_f{$name}->Label (
+      '-text' => 'Branch name (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{NAME}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry box for specifying create branch source revision
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source revision (create/list only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{REV}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and radio buttons box for specifying create branch type
+    $subcmd_f{$name}->Label (
+      '-text' => 'Branch type (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_type) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{TYPE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and radio buttons box for specifying create source type
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source type (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_srctype) {
+        my $txt = lc $key;
+        my $opt = lc $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{SRCTYPE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and radio buttons box for specifying create prefix option
+    $subcmd_f{$name}->Label (
+      '-text' => 'Prefix option (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_revflag) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{REVFLAG}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and entry box for specifying ticket number
+    $subcmd_f{$name}->Label (
+      '-text' => 'Related Trac ticket(s) (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{TICKET}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Check button for info/delete
+    # --show-children, --show-siblings, --show-other, --verbose
+    $subcmd_f{$name}->Label (
+      '-text' => 'Options for info/delete only: ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+
+      for my $key (sort keys %branch_info_opt) {
+        $opt_f->Checkbutton (
+          '-text'     => $branch_info_opt{$key},
+          '-variable' => \($subcmdvar{$name}{$key}),
+        )->grid (
+          '-row'    => 0,
+          '-column' => $col++,
+          '-sticky' => 'w',
+        );
+      }
+    }
+  }
+
+  # Widget for the Checkout sub-command
+  {
+    my $name = 'CHECKOUT';
+
+    # Label and entry boxes for specifying URL and revision
+    my @labtxts = (
+      'URL: ',
+      'Revision: ',
+      'Path: ',
+    );
+    my @varrefs = \(
+      $subcmdvar{$name}{URL},
+      $subcmdvar{$name}{REV},
+      $subcmdvar{$name}{PATH},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Label ('-text' => $labtxts[$i])->grid (
+        '-row'    => $row{$name},
+        '-column' => 0,
+        '-sticky' => 'w',
+      );
+      $subcmd_f{$name}->Entry (
+        '-textvariable' => $varrefs[$i],
+      )->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'ew',
+      );
+    }
+  }
+
+  # Widget for the Status sub-command
+  {
+    my $name = 'STATUS';
+
+    # Checkbuttons for various options
+    my @labtxts = (
+      'Display update information',
+      'Print extra information',
+    );
+    my @varrefs = \(
+      $subcmdvar{$name}{UPDATE},
+      $subcmdvar{$name}{VERBOSE},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Checkbutton (
+        '-text'     => $labtxts[$i],
+        '-variable' => $varrefs[$i],
+      )->grid (
+        '-row'        => $row{$name}++,
+        '-column'     => 0,
+        '-columnspan' => 2,
+        '-sticky'     => 'w',
+      );
+    }
+  }
+
+  # Widget for the Diff sub-command
+  {
+    my $name = 'DIFF';
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Use xxdiff to display differences',
+      '-variable' => \($subcmdvar{$name}{GRAPHIC}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    my $entry;
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Show differences relative to the base of the branch',
+      '-variable' => \($subcmdvar{$name}{BRANCH}),
+      '-command'  => sub {
+        $entry->configure (
+          '-state' => ($subcmdvar{$name}{BRANCH} ? 'normal' : 'disabled'),
+        );
+      },
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    $subcmd_f{$name}->Label ('-text' => 'Branch URL')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    $entry = $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+      '-state'        => ($subcmdvar{$name}{BRANCH} ? 'normal' : 'disabled'),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widget for the Add/Delete sub-command
+  for my $name (qw/ADD DELETE/) {
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Check for files or directories not under version control',
+      '-variable' => \($subcmdvar{$name}{CHECK}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Merge sub-command
+  {
+    my $name = 'MERGE';
+
+    # Label and radio buttons box for specifying merge mode
+    $subcmd_f{$name}->Label (
+      '-text' => 'Mode: ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (qw/automatic custom reverse/) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{MODE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Check buttons for dry-run
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Dry run',
+      '-variable' => \($subcmdvar{$name}{DRYRUN}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    # Check buttons for verbose mode
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Print extra information',
+      '-variable' => \($subcmdvar{$name}{VERBOSE}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    # Label and entry boxes for specifying merge source
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source (automatic/custom only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{SRC}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry boxes for specifying merge revision (range)
+    $subcmd_f{$name}->Label (
+      '-text' => 'Revision (custom/reverse only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{REV}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widget for the Commit sub-command
+  {
+    my $name = 'COMMIT';
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Dry run',
+      '-variable' => \($subcmdvar{$name}{DRYRUN}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Switch sub-command
+  {
+    my $name = 'SWITCH';
+
+    # Label and entry boxes for specifying switch URL
+    $subcmd_f{$name}->Label ('-text' => 'URL: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widgets common to all sub-commands
+  for my $name (@subcmds) {
+    $subcmd_f{$name}->Label ('-text' => 'Other options: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{OTHER}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+# Buttons to perform main actions
+{
+  my $col = 0;
+  for my $name (qw/QUIT HELP CLEAR RUN/) {
+    $action_b{$name} = $bot_f->Button (
+      '-text'    => uc (substr ($name, 0, 1)) . lc (substr ($name, 1)),
+      '-command' => [\&button_clicked, $name],
+      '-width'   => 8,
+    )->grid (
+      '-row'    => 0,
+      '-column' => $col++,
+      '-sticky' => ($name eq 'RUN' ? 'ew' : 'w'),
+    );
+
+    $action_b{$name}->bind ('<Enter>', sub {$statustext = $action_help{$name}});
+    $action_b{$name}->bind ('<Leave>', sub {$statustext = ''});
+
+    $action_b{$name}->configure ('-underline' => $action_bind{$name}{U})
+      if defined $action_bind{$name}{U};
+
+    $mw->bind ($action_bind{$name}{KEY}, sub {$action_b{$name}->invoke});
+  }
+}
+
+&change_cwd ($subcmdvar{CWD});
+
+# ------------------------------------------------------------------------------
+
+# Handle the situation when the user attempts to quit the window while a
+# sub-command is running
+
+$mw->protocol ('WM_DELETE_WINDOW', sub {
+  if (defined $cmdpid) {
+    my $ans = $mw->messageBox (
+      '-title'   => $mw_title,
+      '-message' => $selsubcmd . ' is still running. Really quit?',
+      '-type'    => 'YesNo',
+      '-default' => 'No',
+    );
+
+    if ($ans eq 'Yes') {
+      kill 9, $cmdpid; # Need to kill the sub-process before quitting
+
+    } else {
+      return; # Do not quit
+    }
+  }
+
+  exit;
+});
+
+MainLoop;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfg = &main::cfg ();
+#
+# DESCRIPTION
+#   Return the $config variable.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  return $config;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &change_cwd ($dir);
+#
+# DESCRIPTION
+#   Change current working directory to $dir
+# ------------------------------------------------------------------------------
+
+sub change_cwd {
+  my $dir = $_[0];
+  my @allowed_subcmds = (&is_wc ($dir) ? @wc_subcmds : @nwc_subcmds);
+
+  for my $subcmd (@subcmds) {
+    if (grep {$_ eq $subcmd} @allowed_subcmds) {
+      $subcmd_b{$subcmd}->configure ('-state' => 'normal');
+
+    } else {
+      $subcmd_b{$subcmd}->configure ('-state' => 'disabled');
+    }
+  }
+
+  &display_subcmd_frame ($allowed_subcmds[0])
+    if not grep {$_ eq $selsubcmd} @allowed_subcmds;
+
+  chdir $dir;
+  $subcmdvar{CWD} = $dir;
+
+  if (&is_wc ($dir)) {
+    $subcmdvar{WCT}     = &get_wct ($dir);
+    $subcmdvar{URL_CWD} = &get_url_of_wc ($dir);
+    $subcmdvar{URL_WCT} = &get_url_of_wc ($subcmdvar{WCT});
+
+    $branch_opt{INFO}  ->configure ('-state' => 'normal');
+    $branch_opt{DELETE}->configure ('-state' => 'normal');
+    $subcmdvar{BRANCH}{OPT} = 'info';
+
+  } else {
+    $branch_opt{INFO}  ->configure ('-state' => 'disabled');
+    $branch_opt{DELETE}->configure ('-state' => 'disabled');
+    $subcmdvar{BRANCH}{OPT} = 'create';
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &button_clicked ($name);
+#
+# DESCRIPTION
+#   Call back function to handle a click on a command button named $name.
+# ------------------------------------------------------------------------------
+
+sub button_clicked {
+  my $name = $_[0];
+
+  if (grep {$_ eq $name} keys %subcmd_b) {
+    &display_subcmd_frame ($name);
+
+  } elsif ($name eq 'CLEAR') {
+    $out_t->delete ('1.0', 'end');
+
+  } elsif ($name eq 'QUIT') {
+    exit;
+
+  } elsif ($name eq 'HELP') {
+    &invoke_cmd ('help ' . lc ($selsubcmd));
+
+  } elsif ($name eq 'RUN') {
+    &invoke_cmd (&setup_cmd ($selsubcmd));
+
+  } else {
+    $out_t->insert ('end', $name . ': function to be implemented' . "\n");
+    $out_t->yviewMoveto (1);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &display_subcmd_frame ($name);
+#
+# DESCRIPTION
+#   Change selected subcommand to $name, and display the frame containing the
+#   widgets for configuring the options and arguments of that subcommand.
+# ------------------------------------------------------------------------------
+
+sub display_subcmd_frame {
+  my $name = $_[0];
+
+  if ($selsubcmd ne $name and not $cmdrunning) {
+    $subcmd_b{$name     }->configure ('-relief' => 'sunken');
+    $subcmd_b{$selsubcmd}->configure ('-relief' => 'raised') if $selsubcmd;
+
+    $subcmd_f{$name     }->grid ('-sticky' => 'new');
+    $subcmd_f{$selsubcmd}->gridForget if $selsubcmd;
+
+    $selsubcmd = $name;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $pos = &get_wm_pos ();
+#
+# DESCRIPTION
+#   Returns the position part of the geometry string of the main window.
+# ------------------------------------------------------------------------------
+
+sub get_wm_pos {
+  my $geometry = $mw->geometry ();
+  $geometry =~ /^=?(?:\d+x\d+)?([+-]\d+[+-]\d+)$/;
+  return $1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $command = &setup_cmd ($name);
+#
+# DESCRIPTION
+#   Setup the the system command for the sub-command $name.
+# ------------------------------------------------------------------------------
+
+sub setup_cmd {
+  my $name = $_[0];
+  my $cmd  = '';
+
+  if ($name eq 'BRANCH') {
+    $cmd .= lc ($name);
+    if ($subcmdvar{$name}{OPT} eq 'create') {
+      $cmd .= ' -c --svn-non-interactive';
+      $cmd .= ' -n '     . $subcmdvar{$name}{NAME} if $subcmdvar{$name}{NAME};
+      $cmd .= ' -t '     . $subcmdvar{$name}{TYPE};
+      $cmd .= ' --rev-flag ' . $subcmdvar{$name}{REVFLAG};
+      $cmd .= ' -r ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+      $cmd .= ' -k ' . $subcmdvar{$name}{TICKET} if $subcmdvar{$name}{TICKET};
+      $cmd .= ' --branch-of-branch ' if $subcmdvar{$name}{SRCTYPE} eq 'branch';
+
+    } elsif ($subcmdvar{$name}{OPT} eq 'delete') {
+      $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+      $cmd .= ' -d --svn-non-interactive';
+
+    } elsif ($subcmdvar{$name}{OPT} eq 'list') {
+      $cmd .= ' -l';
+      $cmd .= ' -r ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+
+    } else {
+      $cmd .= ' -i';
+      $cmd .= ' --show-children' if $subcmdvar{$name}{S_CHD};
+      $cmd .= ' --show-siblings' if $subcmdvar{$name}{S_SIB};
+      $cmd .= ' --show-other'    if $subcmdvar{$name}{S_OTH};
+      $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+    }
+    $cmd .= ' ' . $subcmdvar{$name}{URL}   if $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'CHECKOUT') {
+    $cmd .= lc ($name);
+    $cmd .= ' -r' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+    $cmd .= ' ' . $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{PATH} if $subcmdvar{$name}{PATH};
+
+  } elsif ($name eq 'STATUS') {
+    $cmd .= lc ($name);
+    $cmd .= ' -u' if $subcmdvar{$name}{UPDATE};
+    $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'DIFF') {
+    $cmd .= lc ($name);
+    $cmd .= ' -g' if $subcmdvar{$name}{GRAPHIC};
+
+    if ($subcmdvar{$name}{BRANCH}) {
+      $cmd .= ' -b';
+      $cmd .= ' ' . $subcmdvar{$name}{URL} if $subcmdvar{$name}{URL};
+    }
+
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'ADD' or $name eq 'DELETE') {
+    $cmd .= lc ($name);
+    $cmd .= ' -c' if $subcmdvar{$name}{CHECK};
+    $cmd .= ' --non-interactive'
+      if $name eq 'DELETE' and not $subcmdvar{$name}{CHECK};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'MERGE') {
+    $cmd .= lc ($name);
+
+    if ($subcmdvar{$name}{MODE} ne 'automatic') {
+      $cmd .= ' --' . $subcmdvar{$name}{MODE};
+      $cmd .= ' --revision ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+    }
+
+    $cmd .= ' --dry-run' if $subcmdvar{$name}{DRYRUN};
+    $cmd .= ' -v'        if $subcmdvar{$name}{VERBOSE};
+    $cmd .= ' ' . $subcmdvar{$name}{SRC}   if $subcmdvar{$name}{SRC};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'CONFLICTS') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'COMMIT') {
+    $cmd .= lc ($name);
+    $cmd .= ' --dry-run' if $subcmdvar{$name}{DRYRUN};
+    $cmd .= ' --svn-non-interactive';
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'SWITCH') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{URL}   if $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'UPDATE') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  }
+
+  return $cmd;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_cmd ($cmd);
+#
+# DESCRIPTION
+#   Invoke the command $cmd.
+# ------------------------------------------------------------------------------
+
+sub invoke_cmd {
+  my $cmd      = $_[0];
+  return unless $cmd;
+
+  my $disp_cmd = 'fcm ' . $cmd;
+  $cmd         = (index ($cmd, 'help ') == 0)
+                 ? $disp_cmd
+                 : ('fcm_gui_internal ' . &get_wm_pos () . ' ' . $cmd);
+
+  # Change directory to working copy top if necessary
+  if ($subcmdvar{$selsubcmd}{USEWCT} and $subcmdvar{WCT} ne $subcmdvar{CWD}) {
+    chdir $subcmdvar{WCT};
+    $out_t->insert ('end', 'cd ' . $subcmdvar{WCT} . "\n");
+    $out_t->yviewMoveto (1);
+  }
+
+  # Report start of command
+  $out_t->insert ('end', timestamp_command ($disp_cmd, 'Start'));
+  $out_t->yviewMoveto (1);
+
+  # Open the command as a pipe
+  if ($cmdpid = open CMD, '-|', $cmd . ' 2>&1') {
+    # Disable all action buttons
+    $action_b{$_}->configure ('-state' => 'disabled') for (keys %action_b);
+    $cmdrunning = 1;
+
+    # Set up a file event to read output from the command
+    $mw->fileevent (\*CMD, readable => sub {
+      if (sysread CMD, my ($buf), 1024) {
+        # Insert text into the output text box as it becomes available
+        $out_t->insert ('end', $buf);
+        $out_t->yviewMoveto (1);
+
+      } else {
+        # Delete the file event and close the file when the command finishes
+        $mw->fileevent(\*CMD, readable => '');
+        close CMD;
+        $cmdpid = undef;
+
+        # Check return status
+        if ($?) {
+          $out_t->insert (
+            'end', '"' . $disp_cmd . '" failed (' . $? . ')' . "\n",
+          );
+          $out_t->yviewMoveto (1);
+        }
+
+        # Report end of command
+        $out_t->insert ('end', timestamp_command ($disp_cmd, 'End'));
+        $out_t->yviewMoveto (1);
+
+        # Change back to CWD if necessary
+        if ($subcmdvar{$selsubcmd}{USEWCT} and
+            $subcmdvar{WCT} ne $subcmdvar{CWD}) {
+          chdir $subcmdvar{CWD};
+          $out_t->insert ('end', 'cd ' . $subcmdvar{CWD} . "\n");
+          $out_t->yviewMoveto (1);
+        }
+
+        # Enable all action buttons again
+        $action_b{$_}->configure ('-state' => 'normal') for (keys %action_b);
+        $cmdrunning = 0;
+
+        # If the command is "checkout", change directory to working copy
+        if (lc ($selsubcmd) eq 'checkout') {
+          my $url = expand_url_keyword (URL => $subcmdvar{CHECKOUT}{URL});
+          my $dir = $subcmdvar{CHECKOUT}{PATH}
+                  ? $subcmdvar{CHECKOUT}{PATH}
+                  : basename $url;
+          $dir    = File::Spec->rel2abs ($dir);
+          &change_cwd ($dir);
+
+        # If the command is "switch", change URL
+        } elsif (lc ($selsubcmd) eq 'switch') {
+          $subcmdvar{URL_CWD} = &get_url_of_wc ($subcmdvar{CWD}, 1);
+          $subcmdvar{URL_WCT} = &get_url_of_wc ($subcmdvar{WCT}, 1);
+        }
+      }
+      1;
+    });
+
+  } else {
+    $mw->messageBox (
+      '-title'   => 'Error',
+      '-message' => 'Error running "' . $cmd . '"',
+      '-icon'    => 'error',
+    );
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_gui_internal
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_gui_internal	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_gui_internal	(revision 5166)
@@ -0,0 +1,272 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_gui_internal
+#
+# SYNOPSIS
+#   fcm_gui_internal POS FUNCTION
+#
+# DESCRIPTION
+#   The fcm_gui_internal command is part of a simple graphical user interface
+#   for some of the commands of the FCM system. The argument POS is a geometry
+#   string used by the &Main::get_input method to determine the location of the
+#   pop up window. The argument FUNCTION must be a keyword recognised by the
+#   &Fcm::Cm::cm_command function.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas
+use warnings;
+use strict;
+
+# Standard modules
+use Tk;
+use File::Basename;
+use File::Spec::Functions;
+
+# FCM component modules:
+use lib catfile (dirname (dirname ($0)), 'lib');
+use Fcm::Cm;
+use Fcm::Config;
+
+# ------------------------------------------------------------------------------
+
+# Get configuration settings
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+my $pos      = shift @ARGV;
+my $function = shift @ARGV;
+cm_command $function;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfg = &main::cfg ();
+#
+# DESCRIPTION
+#   Return the $config variable.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  return $config;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ans = &main::get_input (
+#     TITLE   => $title,
+#     MESSAGE => $mesg,
+#     TYPE    => $type,
+#     DEFAULT => $def,
+#   );
+#
+# DESCRIPTION
+#   Get an input string from the user and return it as $ans. If TYPE is 'YN', a
+#   'YesNo' type message box will be displayed to prompt the user to click
+#   either the 'yes' or 'no' button. If TYPE is 'YNA', then an 'all' button is
+#   provided as a third option. Otherwise, a dialog box with an entry box for
+#   the user to type in a string will be displayed. TITLE is the title of the
+#   dialog box, and MESSAGE is the main message of the dialog box. If DEFAULT is
+#   set, $ans is set to the default value when the dialog box is invoked.
+# ------------------------------------------------------------------------------
+
+sub get_input {
+  my %args  = @_;
+  my $title = exists $args{TITLE}   ? $args{TITLE}   : '';
+  my $mesg  = exists $args{MESSAGE} ? $args{MESSAGE} : '';
+  my $type  = exists $args{TYPE}    ? $args{TYPE}    : '';
+  my $def   = exists $args{DEFAULT} ? $args{DEFAULT} : '';
+  my $ans   = '';
+
+  # Create a main window
+  my $mw = MainWindow->new;
+  $mw->title ($title);
+
+  # Define the default which applies if the dialog box is just closed or
+  # the user selects 'cancel'
+  $ans = $def ? $def : '';
+
+  if ($type =~ /^yn/i) {
+    # Create a yes-no(-all) dialog box
+
+    # If TYPE is YNA then add a third button: 'all'
+    my $buttons;
+    if ($type =~ /a$/i) {
+      $buttons = 3;
+
+    } else {
+      $buttons = 2;
+    }
+
+    # Message of the dialog box
+    $mw->Label ('-text' => $mesg)->grid (
+      '-row'        => 0,
+      '-column'     => 0,
+      '-columnspan' => $buttons,
+      '-padx'       => 10,
+      '-pady'       => 10,
+    );
+
+    # The "yes" button
+    my $y_b = $mw->Button (
+      '-text'      => 'Yes',
+      '-underline' => 0,
+      '-command'   => sub {$ans = 'y'; $mw->destroy},
+    )->grid (
+      '-row'    => 1,
+      '-column' => 0,
+      '-padx'   => 5,
+      '-pady'   => 5,
+    );
+
+    # The "no" button
+    my $n_b = $mw->Button (
+      '-text'      => 'No',
+      '-underline' => 0,
+      '-command'   => sub {$ans = 'n'; $mw->destroy},
+    )->grid (
+      '-row'    => 1,
+      '-column' => 1,
+      '-padx'   => 5,
+      '-pady'   => 5,
+    );
+
+    # The "all" button
+    my $a_b;
+    if ($buttons == 3) {
+      $a_b = $mw->Button (
+        '-text'      => 'All',
+        '-underline' => 0,
+        '-command'   => sub {$ans = 'a'; $mw->destroy},
+      )->grid (
+        '-row'    => 1,
+        '-column' => 2,
+        '-padx'   => 5,
+        '-pady'   => 5,
+      );
+    }
+
+    # Keyboard binding
+    if ($buttons == 3) {
+      $mw->bind ('<Key>' => sub {
+	if ($Tk::event->K eq 'Y' or $Tk::event->K eq 'y') {
+	  $y_b->invoke;
+
+	} elsif ($Tk::event->K eq 'N' or $Tk::event->K eq 'n') {
+	  $n_b->invoke;
+
+	} elsif ($Tk::event->K eq 'A' or $Tk::event->K eq 'a') {
+	  $a_b->invoke;
+	}
+      });
+
+    } else {
+      $mw->bind ('<Key>' => sub {
+	if ($Tk::event->K eq 'Y' or $Tk::event->K eq 'y') {
+	  $y_b->invoke;
+
+	} elsif ($Tk::event->K eq 'N' or $Tk::event->K eq 'n') {
+	  $n_b->invoke;
+	}
+      });
+    }
+
+    # Handle the situation when the user attempts to quit the window
+    $mw->protocol ('WM_DELETE_WINDOW', sub {
+      $ans = $def if $def;
+      $mw->destroy;
+    });
+
+  } else {
+    # Create a dialog box to obtain an input string
+
+    # Message of the dialog box
+    $mw->Label ('-text' => $mesg)->grid (
+      '-row'    => 0,
+      '-column' => 0,
+      '-padx'   => 5,
+      '-pady'   => 5,
+    );
+
+    # Entry box for the user to type in the input string
+    my $entry   = $ans;
+    my $input_e = $mw->Entry (
+      '-textvariable'    => \$entry,
+      '-width'           => 40,
+    )->grid (
+      '-row'    => 0,
+      '-column' => 1,
+      '-sticky' => 'ew',
+      '-padx'   => 5,
+      '-pady'   => 5,
+    );
+
+    my $b_f = $mw->Frame->grid (
+      '-row'        => 1,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'e',
+    );
+
+    # An OK button to accept the input string
+    my $ok_b = $b_f->Button (
+      '-text' => 'OK',
+      '-command' => sub {$ans = $entry; $mw->destroy},
+    )->grid (
+      '-row'        => 0,
+      '-column'     => 0,
+      '-padx'       => 5,
+      '-pady'       => 5,
+    );
+
+    # A Cancel button to reject the input string
+    my $cancel_b = $b_f->Button (
+      '-text' => 'Cancel',
+      '-command' => sub {$ans = undef; $mw->destroy},
+    )->grid (
+      '-row'        => 0,
+      '-column'     => 1,
+      '-padx'       => 5,
+      '-pady'       => 5,
+    );
+
+    # Keyboard binding
+    $mw->bind ('<Key>' => sub {
+      if ($Tk::event->K eq 'Return' or $Tk::event->K eq 'KP_Enter') {
+        $ok_b->invoke;
+
+      } elsif ($Tk::event->K eq 'Escape') {
+        $cancel_b->invoke;
+      }
+    });
+
+    # Allow the entry box to expand
+    $mw->gridColumnconfigure (1, '-weight' => 1);
+
+    # Set initial focus on the entry box
+    $input_e->focus;
+    $input_e->icursor ('end');
+  }
+
+  $mw->geometry ($pos);
+
+  # Switch on "always on top" property for $mw
+  $mw->property (
+    qw/set _NET_WM_STATE ATOM/,
+    32,
+    ['_NET_WM_STATE_STAYS_ON_TOP'],
+    ($mw->toplevel->wrapper)[0],
+  );
+
+  MainLoop;
+
+  return $ans;
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_internal
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_internal	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_internal	(revision 5166)
@@ -0,0 +1,581 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_internal
+#
+# SYNOPSIS
+#   fcm_internal SUBCOMMAND ARGS
+#
+# DESCRIPTION
+#   The fcm_internal command is a frontend for some of the internal commands of
+#   the FCM build system. The subcommand can be "compile", "load" or "archive"
+#   for invoking the compiler, loader and library archiver respectively. If
+#   "compile" is specified, it can be suffixed with ":TYPE" to specify the
+#   nature of the source file. If TYPE is not specified, it is set to F by
+#   default (for Fortran source). For compile and load, the other arguments are
+#   the 1) name of the container package of the source file, 2) the path to the
+#   source file and 3) the target name after compiling or loading the source
+#   file. For compile, the 4th argument is a flag to indicate whether
+#   pre-processing is required for compiling the source file. For load, the 4th
+#   and the rest of the arguments is a list of object files that cannot be
+#   archived into the temporary load library and must be linked into the target
+#   through the linker command. (E.g. Fortran BLOCKDATA program units must be
+#   linked this way.) If archive is specified, the first argument should be the
+#   name of the library archive target and the rest should be the object files
+#   to be included in the archive. This command is invoked via the build system
+#   and should never be called directly by the user.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas:
+use warnings;
+use strict;
+
+# FCM component modules
+use Fcm::Timer;
+
+# Function declarations
+sub catfile;
+sub basename;
+sub dirname;
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %unusual_tool_name = ();
+
+# ------------------------------------------------------------------------------
+
+MAIN: {
+  # Name of program
+  my $this = basename $0;
+
+  # Arguments
+  my $subcommand = shift @ARGV;
+  my ($function, $type) = split /:/, $subcommand; 
+  my ($srcpackage, $src, $target, $requirepp, @objects, @blockdata);
+  
+  if ($subcommand eq 'archive') {
+    ($target, @objects) = @ARGV;
+
+  } elsif ($subcommand eq 'load') {
+    ($srcpackage, $src, $target, @blockdata) = @ARGV;
+
+  } else {
+    ($srcpackage, $src, $target, $requirepp) = @ARGV;
+  }
+
+  # Set up hash reference for all the required information
+  my %info = (
+    SRCPACKAGE => $srcpackage,
+    SRC        => $src,
+    TYPE       => $type,
+    TARGET     => $target,
+    REQUIREPP  => $requirepp,
+    OBJECTS    => \@objects,
+    BLOCKDATA  => \@blockdata,
+  );
+
+  # Get list of unusual tools
+  my $i = 0;
+  while (my $label = &get_env ('FCM_UNUSUAL_TOOL_LABEL' . $i)) {
+    my $value = &get_env ('FCM_UNUSUAL_TOOL_VALUE' . $i);
+    $unusual_tool_name{$label} = $value;
+    $i++;
+  }
+
+  # Invoke the action
+  my $rc = 0;
+  if ($function eq 'compile') {
+    $rc = &compile (\%info);
+
+  } elsif ($function eq 'load') {
+    $rc = &load (\%info);
+
+  } elsif ($function eq 'archive') {
+    $rc = &archive (\%info);
+
+  } else {
+    print STDERR $this, ': incorrect usage, abort';
+    $rc = 1;
+  }
+
+  # Throw error if action failed
+  if ($rc) {
+    print STDERR $this, ' ', $function, ' failed (', $rc, ')', "\n";
+    exit 1;
+
+  } else {
+    exit;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &compile (\%info);
+#
+# DESCRIPTION
+#   This method invokes the correct compiler with the correct options to
+#   compile the source file into the required target. The argument $info is a
+#   hash reference set up in MAIN. The following environment variables are
+#   used, where * is the source file type (F for Fortran, and C for C/C++):
+# 
+#   *C          - compiler command
+#   *C_OUTPUT   - *C option to specify the name of the output file
+#   *C_DEFINE   - *C option to declare a pre-processor def
+#   *C_INCLUDE  - *C option to declare an include directory
+#   *C_COMPILE  - *C option to ask the compiler to perform compile only
+#   *CFLAGS     - *C user options
+#   *PPKEYS     - list of pre-processor defs (may have sub-package suffix)
+#   FCM_VERBOSE - verbose level
+#   FCM_OBJDIR  - destination directory of object file
+#   FCM_TMPDIR  - temporary destination directory of object file
+# ------------------------------------------------------------------------------
+
+sub compile {
+  my $info = shift;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  my @command = ();
+
+  # Only support C and Fortran source files at the moment
+  my $type = $info->{TYPE};
+  $type    = ($info->{SRC} =~ /\.c(\w+)?$/i) ? 'C' : 'F' if not $type;
+
+  # Compiler
+  push @command, &get_env ($type . 'C', 1);
+
+  # Compile output target (typical -o option)
+  push @command, &get_env ($type . 'C_OUTPUT', 1), $info->{TARGET};
+
+  # Pre-processor definition macros
+  if ($info->{REQUIREPP}) {
+    my @ppkeys = split /\s+/, &select_flags ($info, $type . 'PPKEYS');
+    my $defopt = &get_env ($type . 'C_DEFINE', 1);
+
+    push @command, (map {$defopt . $_} @ppkeys);
+  }
+
+  # Include search path
+  my $incopt  = &get_env ($type . 'C_INCLUDE', 1);
+  my @incpath = split /:/, &get_env ('FCM_INCPATH');
+  push @command, (map {$incopt . $_} @incpath);
+
+  # Other compiler flags
+  my $flags = &select_flags ($info, $type . 'FLAGS');
+  push @command, $flags if $flags;
+
+  my $compile_only = &get_env ($type . 'C_COMPILE');
+  if ($flags !~ /(?:^|\s)$compile_only\b/) {
+    push @command, &get_env ($type . 'C_COMPILE');
+  }
+
+  # Name of source file
+  push @command, $info->{SRC};
+
+  # Execute command
+  my $objdir = &get_env ('FCM_OBJDIR', 1);
+  my $tmpdir = &get_env ('FCM_TMPDIR', 1);
+  chdir $tmpdir;
+
+  my $command = join ' ', @command;
+  if ($verbose > 1) {
+    print 'cd ', $tmpdir, "\n";
+    print &timestamp_command ($command, 'Start');
+
+  } elsif ($verbose) {
+    print $command, "\n";
+  }
+
+  my $rc = system $command;
+
+  print &timestamp_command ($command, 'End  ') if $verbose > 1;
+
+  # Move temporary output to correct location on success
+  # Otherwise, remove temporary output
+  if ($rc) { # error
+    unlink $info->{TARGET};
+
+  } else {   # success
+    print 'mv ', $info->{TARGET}, ' ', $objdir, "\n" if $verbose > 1;
+    rename $info->{TARGET}, &catfile ($objdir, $info->{TARGET});
+  }
+
+  # Move any Fortran module definition files to the INC directory
+  my @modfiles = <*.mod *.MOD>;
+  for my $file (@modfiles) {
+    rename $file, &catfile ($incpath[0], $file);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &load (\%info);
+#
+# DESCRIPTION
+#   This method invokes the correct loader with the correct options to link
+#   the main program object into an executable. The argument $info is a hash
+#   reference set up in MAIN. The following environment variables are used:
+# 
+#   LD           - linker command
+#   LD_OUTPUT    - LD option to specify the name of the output file
+#   LD_LIBSEARCH - LD option to declare a directory in the library search path
+#   LD_LIBLINK   - LD option to declare an object library
+#   LDFLAGS      - LD user options
+#   FCM_VERBOSE  - verbose level
+#   FCM_LIBDIR   - destination directory of object libraries
+#   FCM_OBJDIR   - destination directory of object files
+#   FCM_BINDIR   - destination directory of executable file
+#   FCM_TMPDIR   - temporary destination directory of executable file
+# ------------------------------------------------------------------------------
+
+sub load {
+  my $info = shift;
+
+  my $rc = 0;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  # Create temporary object library
+  (my $name   = $info->{TARGET}) =~ s/\.\S+$//;
+  my $libname = '__fcm__' . $name;
+  my $lib     = 'lib' . $libname . '.a';
+  my $libfile = catfile (&get_env ('FCM_LIBDIR', 1), $lib);
+  $rc = &archive ({TARGET => $lib});
+
+  unless ($rc) {
+    my @command = ();
+
+    # Linker
+    push @command, &select_flags ($info, 'LD');
+
+    # Linker output target (typical -o option)
+    push @command, &get_env ('LD_OUTPUT', 1), $info->{TARGET};
+
+    # Name of main object file
+    my $mainobj = (basename ($info->{SRC}) eq $info->{SRC})
+                  ? catfile (&get_env ('FCM_OBJDIR'), $info->{SRC})
+                  : $info->{SRC};
+    push @command, $mainobj;
+
+    # Link with Fortran BLOCKDATA objects if necessary
+    if (@{ $info->{BLOCKDATA} }) {
+      my @blockdata = @{ $info->{BLOCKDATA} };
+      my @objpath   = split /:/, &get_env ('FCM_OBJPATH');
+
+      # Search each BLOCKDATA object file from the object search path
+      for my $file (@blockdata) {
+        for my $dir (@objpath) {
+          my $full = catfile ($dir, $file);
+
+          if (-r $full) {
+            $file = $full;
+            last;
+          }
+        }
+
+        push @command, $file;
+      }
+    }
+
+    # Library search path
+    my $libopt  = &get_env ('LD_LIBSEARCH', 1);
+    my @libpath = split /:/, &get_env ('FCM_LIBPATH');
+    push @command, (map {$libopt . $_} @libpath);
+
+    # Link with temporary object library if it exists
+    push @command, &get_env ('LD_LIBLINK', 1) . $libname if -f $libfile;
+
+    # Other linker flags
+    my $flags = &select_flags ($info, 'LDFLAGS');
+    push @command, $flags;
+
+    # Execute command
+    my $tmpdir = &get_env ('FCM_TMPDIR', 1);
+    my $bindir = &get_env ('FCM_BINDIR', 1);
+    chdir $tmpdir;
+
+    my $command = join ' ', @command;
+    if ($verbose > 1) {
+      print 'cd ', $tmpdir, "\n";
+      print &timestamp_command ($command, 'Start');
+
+    } elsif ($verbose) {
+      print $command, "\n";
+    }
+
+    $rc = system $command;
+
+    print &timestamp_command ($command, 'End  ') if $verbose > 1;
+
+    # Move temporary output to correct location on success
+    # Otherwise, remove temporary output
+    if ($rc) { # error
+      unlink $info->{TARGET};
+
+    } else {   # success
+      print 'mv ', $info->{TARGET}, ' ', $bindir, "\n" if $verbose > 1;
+      rename $info->{TARGET}, &catfile ($bindir, $info->{TARGET});
+    }
+  }
+
+  # Remove the temporary object library
+  unlink $libfile if -f $libfile;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &archive (\%info);
+#
+# DESCRIPTION
+#   This method invokes the library archiver to create an object library. The
+#   argument $info is a hash reference set up in MAIN. The following
+#   environment variables are used:
+# 
+#   AR           - archiver command
+#   ARFLAGS      - AR options to update/create an object library
+#   FCM_VERBOSE  - verbose level
+#   FCM_LIBDIR   - destination directory of object libraries
+#   FCM_OBJPATH  - search path of object files
+#   FCM_OBJDIR   - destination directory of object files
+#   FCM_TMPDIR   - temporary destination directory of executable file
+# ------------------------------------------------------------------------------
+
+sub archive {
+  my $info = shift;
+
+  my $rc = 0;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  # Set up the archive command
+  my $lib     = &basename ($info->{TARGET});
+  my $tmplib  = &catfile (&get_env ('FCM_TMPDIR', 1), $lib);
+  my @ar_cmd  = ();
+  push @ar_cmd, (&get_env ('AR', 1), &get_env ('ARFLAGS', 1));
+  push @ar_cmd, $tmplib;
+
+  # Get object directories and their files
+  my %objdir;
+  if (exists $info->{OBJECTS}) {
+    # List of objects set in the argument, sort into directory/file list
+    for my $name (@{ $info->{OBJECTS} }) {
+      my $dir = (&dirname ($name) eq '.')
+                ? &get_env ('FCM_OBJDIR', 1) : &dirname ($name);
+      $objdir{$dir}{&basename ($name)} = 1;
+    }
+
+  } else {
+    # Objects not listed in argument, search object path for all files
+    my @objpath  = split /:/, &get_env ('FCM_OBJPATH', 1);
+    my %objbase  = ();
+
+    # Get registered objects into a hash (keys = objects, values = 1)
+    my %objects = map {($_, 1)} split (/\s+/, &get_env ('OBJECTS'));
+
+    # Seach object path for all files
+    for my $dir (@objpath) {
+      next unless -d $dir;
+
+      chdir $dir;
+
+      # Use all files from each directory in the object search path
+      for ((glob ('*'))) {
+        next unless exists $objects{$_}; # consider registered objects only
+        $objdir{$dir}{$_} = 1 unless exists $objbase{$_};
+        $objbase{$_} = 1;
+      }
+    }
+  }
+
+  for my $dir (keys %objdir) {
+    next unless -d $dir;
+
+    # Go to each object directory and executes the library archive command 
+    chdir $dir;
+    my $command = join ' ', (@ar_cmd, sort keys %{ $objdir{$dir} });
+
+    if ($verbose > 1) {
+      print 'cd ', $dir, "\n";
+      print &timestamp_command ($command, 'Start');
+
+    } else {
+      print $command, "\n" if exists $info->{OBJECTS};
+    }
+
+    $rc = system $command;
+
+    print &timestamp_command ($command, 'End  ')
+      if $verbose > 1;
+    last if $rc;
+  }
+
+  # Move temporary output to correct location on success
+  # Otherwise, remove temporary output
+  if ($rc) { # error
+    unlink $tmplib;
+
+  } else {   # success
+    my $libdir = &get_env ('FCM_LIBDIR', 1);
+
+    print 'mv ', $tmplib, ' ', $libdir, "\n" if $verbose > 1;
+    rename $tmplib, &catfile ($libdir, $lib);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flags = &select_flags (\%info, $set);
+#
+# DESCRIPTION
+#   This function selects the correct compiler/linker flags for the current
+#   sub-package from the environment variable prefix $set. The argument $info
+#   is a hash reference set up in MAIN.
+# ------------------------------------------------------------------------------
+
+sub select_flags {
+  my ($info, $set) = @_;
+
+  (my $srcroot = &basename ($info->{SRC})) =~ s/\.\S+$//;
+  my @names    = ($set);
+  push @names, split (/__/, $info->{SRCPACKAGE} . '__' . $srcroot);
+
+  my $string   = '';
+  while (@names) {
+    my $name = join '__', @names;
+    my $var  = &get_env ($name);
+
+    if (defined $var) {
+      $string = $var;
+      last;
+
+    } else {
+      pop @names;
+    }
+  }
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $variable = &get_env ($name);
+#   $variable = &get_env ($name, $compulsory);
+#
+# DESCRIPTION
+#   This internal method gets a variable from $ENV{$name}. If $compulsory is
+#   set to true, it throws an error if the variable is a not set or is an empty
+#   string. Otherwise, it returns C<undef> if the variable is not set.
+# ------------------------------------------------------------------------------
+
+sub get_env {
+  (my $name, my $compulsory) = @_;
+  my $string;
+
+  if ($name =~ /^\w+$/) {
+    # $name contains only word characters, variable is exported normally
+    die 'The environment variable "', $name, '" must be set, abort'
+      if $compulsory and not exists $ENV{$name};
+
+    $string = exists $ENV{$name} ? $ENV{$name} : undef;
+
+  } else {
+    # $name contains unusual characters
+    die 'The environment variable "', $name, '" must be set, abort'
+      if $compulsory and not exists $unusual_tool_name{$name};
+
+    $string = exists $unusual_tool_name{$name}
+              ? $unusual_tool_name{$name} : undef;
+  }
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = &catfile (@paths);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Spec module.
+# ------------------------------------------------------------------------------
+
+sub catfile {
+  my @names = split (m!/!, join ('/', @_));
+  my $path  = shift @names;
+
+  for my $name (@names) {
+    $path .= '/' . $name if $name;
+  }
+
+  return $path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $basename = &basename ($path);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Basename module.
+# ------------------------------------------------------------------------------
+
+sub basename {
+  my $name = $_[0];
+
+  $name =~ s{/*$}{}; # remove trailing slashes
+
+  if ($name =~ m#.*/([^/]+)$#) {
+    return $1;
+
+  } else {
+    return $name;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dirname = &dirname ($path);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Basename module.
+# ------------------------------------------------------------------------------
+
+sub dirname {
+  my $name = $_[0];
+
+  if ($name =~ m#^/+$#) {
+    return '/'; # dirname of root is root
+
+  } else {
+    $name =~ s{/*$}{}; # remove trailing slashes
+
+    if ($name =~ m#^(.*)/[^/]+$#) {
+      my $dir = $1;
+      $dir =~ s{/*$}{}; # remove trailing slashes
+      return $dir;
+
+    } else {
+      return '.';
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_setup_konqueror
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_setup_konqueror	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_setup_konqueror	(revision 5166)
@@ -0,0 +1,44 @@
+#!/usr/bin/ksh
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_setup_konqueror
+#
+# SYNOPSIS
+#   fcm_setup_konqueror
+#
+# DESCRIPTION
+#   Set up Konqueror to use "fcm gui".
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Check number of arguments
+script=$(basename $0)
+usage="$script: no argument required"
+if (( $# != 0 )); then
+  echo "$usage, abort..." >&2
+  exit 1
+fi
+
+filename=fcm_gui.desktop
+
+file=$(dirname $0)
+file=${file%/bin}/etc/$filename
+
+if [[ ! -f $file ]]; then
+  echo "$script: $file not found, abort..." >&2
+  exit 1
+fi
+
+dir=$HOME/.kde/share/applnk/.hidden
+mkdir -p $dir
+cd $dir
+rm -f $filename             # Always remove.
+ln -s $file .
+
+echo "$script: finished"
+
+#EOF
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_update_version_dir.pl
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_update_version_dir.pl	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/bin/fcm_update_version_dir.pl	(revision 5166)
@@ -0,0 +1,302 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_update_version_dir.pl
+#
+# SYNOPSIS
+#   fcm_update_version_dir.pl [OPTIONS] [CFGFILE]
+#
+# DESCRIPTION
+#   See $usage for detail.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Standard pragmas
+use strict;
+use warnings;
+
+# Standard modules
+use Getopt::Long;
+use Cwd;
+use File::Basename;
+use File::Path;
+use File::Spec;
+
+# FCM component modules:
+use lib File::Spec->catfile (dirname (dirname ($0)), 'lib');
+use Fcm::Config;
+use Fcm::Util;
+
+# Usage
+# ------------------------------------------------------------------------------
+my $this  = basename $0;
+my $usage = <<EOF;
+NAME
+  $this
+
+SYNOPSIS
+  $this [OPTIONS] [CFGFILE]
+
+DESCRIPTION
+  Update the version directories for a list of relative paths in the source
+  repository URL.
+
+OPTIONS
+  -d [--dest] arg: Specify a destination for the extraction. If not specified,
+                   the command extracts to the current working directory.
+  -h [--help]    : Print help and exit.
+  -f [--full]    : Specify the full mode. If not specified, the command runs
+                   in incremental mode.
+  -u [--url]  arg: Specify the source repository URL. No default.
+
+ARGUMENTS
+  A configuration file may be given to this command, or it will attempt to
+  read from the standard input. Each line in the configuration must contain
+  a relative path that resides under the given source repository URL. (Empty
+  lines and lines beginning with a "#" are ignored.) Optionally, each
+  relative path may be followed by a list of space separated "conditions".
+  Each condition is a conditional operator (>, >=, <, <=, == or !=) followed
+  by a revision number or the keyword HEAD. The command uses the revision
+  log to determine the revisions at which the relative path has been updated
+  in the source repository URL. If these revisions also satisfy the
+  "conditions" set by the user, they will be considered in the extraction.
+  In full mode, everything is re-extracted. In incremental mode, the version
+  directories are only updated if they do not already exist.
+
+COPYRIGHT
+  This program is part of the FCM system.
+  (C) Crown copyright Met Office. All rights reserved.
+  For further details please refer to the file COPYRIGHT.txt
+  which you should have received as part of this distribution.
+EOF
+
+# Options
+# ------------------------------------------------------------------------------
+my ($dest, $full, $help, $url);
+GetOptions (
+  'dest|d=s' => \$dest,
+  'full|f'   => \$full,
+  'help'     => \$help,
+  'url|u=s'  => \$url,
+);
+
+if ($help) {
+  print $usage;
+  exit;
+}
+
+$dest = cwd () unless $dest;
+
+die 'An URL must be specified with the --url option, abort' unless $url;
+
+# Arguments
+# ------------------------------------------------------------------------------
+if (@ARGV) {
+  die 'Cannot read: ', $ARGV[0], ', abort' unless -f $ARGV[0] and -r $ARGV[0];
+}
+
+# Get configuration settings
+# ------------------------------------------------------------------------------
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# Expand URL keyword
+$url = &expand_url_keyword (URL => $url);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfg = &main::cfg ();
+#
+# DESCRIPTION
+#   Return the $config variable.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  return $config;
+}
+
+# ------------------------------------------------------------------------------
+
+MAIN: {
+  my $date = localtime;
+  print $this, ': started on ', $date, "\n";
+
+  my %dirs;
+
+  # Read input (file) for a list directories and update conditions
+  while (<>) {
+    chomp;
+
+    # Ignore empty and comment lines
+    next if /^\s*(?:#|$)/;
+
+    # Each line must contain a relative path, and optionally a list of
+    # space delimited conditions
+    my @words = split /\s+/;
+    my $dir   = shift @words;
+
+    # Check that the conditions are valid
+    my @conditions;
+    for my $word (@words) {
+      if ($word =~ /^([<>]=?|[!=]=)(.+)$/i) {
+        # Condition must be a conditional operator followed by a revision
+        my ($operator, $rev) = ($1, $2);
+        $rev = &expand_rev_keyword (REV => $rev, URL => $url, HEAD => 1);
+        push @conditions, $operator . $rev;
+
+      } else {
+        print STDERR 'Warning: ignore unknown syntax for update condition: ',
+                     $word, "\n";
+      }
+    }
+
+    # Add directory and its conditions to a hash
+    if ($dir =~ s#/\*$##) { # Directory finishes with wildcard
+
+      # Run "svn ls" in recursive mode
+      my $dirurl  = join ('/', ($url, $dir));
+      my @files   = &run_command ([qw/svn ls -R/, $dirurl], METHOD => 'qx');
+
+      # Find directories containing regular files
+      while (my $file = shift @files) {
+	# Skip directories
+	next if $file =~ m#/$#;
+
+	# Get "dirname" of regular file and add to hash
+	my $subdir = join ('/', ($dir, dirname ($file)));
+	$dirs{$subdir} = \@conditions;
+      }
+
+    } else {
+      $dirs{$dir} = \@conditions;
+    }
+
+  }
+
+  # Update each directory, if required
+  for my $dir (sort keys %dirs) {
+    # Use "svn log" to determine the revisions that need to be updated
+    my %allversions;
+    {
+      my $command = 'svn log -q ' . join ('/', ($url, $dir));
+      my @log     = &run_command (
+        [qw/svn log -q/, join ('/', ($url, $dir))], METHOD => 'qx',
+      );
+      @log        = grep /^r\d+/, @log;
+
+      # Assign a sequential "version" number to each sub-directory
+      my $version = scalar @log;
+      for (@log) {
+        m/^r(\d+)/;
+        $allversions{$1} = 'v' . $version--;
+      }
+    }
+    my %versions = %allversions;
+
+    # Extract only revisions matching the conditions
+    if (@{ $dirs{$dir} }) {
+      my @conditions = @{ $dirs{$dir} };
+
+      for my $condition (@conditions) {
+        for my $rev (keys %versions) {
+          delete $versions{$rev} unless eval ($rev . $condition);
+        }
+      }
+    }
+
+    # Destination directory
+    my $dirpath = File::Spec->catfile ($dest, $dir);
+
+    if (-d $dirpath) {
+      if ($full or not keys %versions) {
+        # Remove destination directory top, in full mode
+        # or if there are no matching revisions
+        &run_command ([qw/rm -rf/, $dirpath], PRINT => 1);
+
+      } else {
+        # Delete excluded revisions if they exist, in incremental mode
+        if (opendir DIR, $dirpath) {
+          while (my $rev = readdir 'DIR') {
+            next unless $rev =~ /^\d+$/;
+
+            if (not grep {$_ eq $rev} keys %versions) {
+              my @command = (qw/rm -rf/, File::Spec->catfile ($dirpath, $rev));
+              &run_command (\@command, PRINT => 1);
+
+              # Remove "version" symlink
+              my $verlink = File::Spec->catfile ($dirpath, $allversions{$rev});
+              unlink $verlink if -l $verlink;
+            }
+          }
+          closedir DIR;
+        }
+      }
+    }
+
+    # Create container directory of destination if it does not already exist
+    if (keys %versions and not -d $dirpath) {
+      print '-> mkdir -p ', $dirpath, "\n";
+      my $rc = mkpath $dirpath;
+      die 'mkdir -p ', $dirpath, ' failed' unless $rc;
+    }
+
+    # Update each version directory that needs updating
+    for my $rev (keys %versions) {
+      my $revpath = File::Spec->catfile ($dest, $dir, $rev);
+
+      # Create version directory if it does not exist
+      if (not -e $revpath) {
+        # Use "svn export" to create the version directory
+        my @command = (
+          qw/svn export -q -r/,
+          $rev,
+          join ('/', ($url, $dir)),
+          $revpath,
+        );
+
+        &run_command (\@command, PRINT => 1);
+
+        # Run GenScr_GenRule on any component directories
+        # This can be removed once old versions of the SCSUI are no longer used
+	if ($dir =~ m#(?:^|/)components/#) {
+          my @command = (
+            "GenScr_GenRule",
+            File::Spec->catfile ($revpath, join ('.', (basename ($dir), "rule")))
+          );
+
+          &run_command (\@command, PRINT => 1);
+	}
+      }
+
+      # Create "version" symlink if necessary
+      my $verlink = File::Spec->catfile ($dest, $dir, $versions{$rev});
+      symlink $rev, $verlink unless -l $verlink;
+    }
+
+    # Symbolic link to the "latest" version directory
+    my $headlink = File::Spec->catfile ($dest, $dir, 'latest');
+    my $headrev  = 0;
+    for my $rev (keys %versions) {
+      $headrev = $rev if $rev > $headrev;
+    }
+
+    if (-l $headlink) {
+      # Remove old symbolic link if there is no revision to update or if it
+      # does not point to the correct version directory
+      my $org = readlink $headlink;
+      unlink $headlink if (! $headrev or $org ne $headrev);
+    }
+
+    # (Re-)create the "latest" symbolic link, if necessary
+    symlink $headrev, $headlink if ($headrev and not -l $headlink);
+  }
+
+  $date = localtime;
+  print $this, ': finished normally on ', $date, "\n";
+}
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/etc/fcm.cfg.eg
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/etc/fcm.cfg.eg	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/etc/fcm.cfg.eg	(revision 5166)
@@ -0,0 +1,266 @@
+# ------------------------------------------------------------------------------
+# FCM central configuration file
+# ------------------------------------------------------------------------------
+
+# ------------------------------------------------------------------------------
+# Standard repository locations
+# ------------------------------------------------------------------------------
+
+# AMV repository
+set::url::amv                svn://fcm7/AMV_svn/AMV
+
+set::trac::amv               http://fcm7/projects/AMV/browser/AMV
+
+# ANCIL repository
+set::url::ancil              svn://fcm8/ANCIL_svn/ANCIL
+
+set::trac::ancil             http://fcm8/projects/ANCIL/browser/ANCIL
+
+# ATSR repository
+set::url::atsr               svn://fcm7/ATSR_svn/ATSR
+
+set::trac::atsr              http://fcm7/projects/ATSR/browser/ATSR
+
+# CICE repository
+set::url::cice               svn://fcm3/CICE_svn/CICE
+
+set::trac::cice              http://fcm3/projects/CICE/browser/CICE
+
+# CVC repository
+set::url::cvc_admin          svn://fcm6/CVC_svn/Admin
+set::url::bullseye           svn://fcm6/CVC_svn/Bullseye
+set::url::cat                svn://fcm6/CVC_svn/CAT
+set::url::deicing            svn://fcm6/CVC_svn/Deicing
+set::url::ea                 svn://fcm6/CVC_svn/EA  
+set::url::ensemble           svn://fcm6/CVC_svn/Ensemble
+set::url::gales              svn://fcm6/CVC_svn/Gales
+set::url::ifv                svn://fcm6/CVC_svn/IFV
+set::url::mogreps            svn://fcm6/CVC_svn/MOGREPS
+set::url::openroad           svn://fcm6/CVC_svn/OpenRoad
+set::url::powertable         svn://fcm6/CVC_svn/PowerTable
+set::url::qnh                svn://fcm6/CVC_svn/QNH
+
+set::trac::cvc_admin         http://fcm6/projects/CVC/browser/Admin
+set::trac::bullseye          http://fcm6/projects/CVC/browser/Bullseye
+set::trac::cat               http://fcm6/projects/CVC/browser/CAT
+set::trac::deicing           http://fcm6/projects/CVC/browser/Deicing
+set::trac::ea                http://fcm6/projects/CVC/browser/EA
+set::trac::ensemble          http://fcm6/projects/CVC/browser/Ensemble
+set::trac::gales             http://fcm6/projects/CVC/browser/Gales
+set::trac::ifv               http://fcm6/projects/CVC/browser/IFV
+set::trac::mogreps           http://fcm6/projects/CVC/browser/MOGREPS
+set::trac::openroad          http://fcm6/projects/CVC/browser/OpenRoad
+set::trac::powertable        http://fcm6/projects/CVC/browser/PowerTable
+set::trac::qnh               http://fcm6/projects/CVC/browser/QNH
+
+# DA repository
+set::url::da                 svn://fcm5/DA_svn/DA
+
+set::trac::da                http://fcm5/projects/DA/browser/DA
+
+# ENS repository
+set::url::ens                svn://fcm9/ENS_svn/ENS
+
+set::trac::ens               http://fcm9/projects/ENS/browser/ENS
+
+# FCM repository
+set::url::fcm                svn://fcm1/FCM_svn/FCM
+set::url::fcm_admin          svn://fcm1/FCM_svn/Admin
+
+set::trac::fcm               http://fcm1/projects/FCM/browser/FCM
+set::trac::fcm_admin         http://fcm1/projects/FCM/browser/Admin
+
+# FLUME repository
+set::url::flume_metadata     svn://fcm2/FLUME_svn/metadata
+
+set::trac::flume_metadata    http://fcm2/projects/FLUME/browser/metadata
+
+# GEN repository
+set::url::gen                svn://fcm1/GEN_svn/GEN
+
+set::trac::gen               http://fcm1/projects/GEN/browser/GEN
+
+# LEM repository
+set::url::lem                svn://fcm2/LEM_svn/LEM
+
+set::trac::lem               http://fcm2/projects/LEM/browser/LEM
+
+# LINK repository
+set::url::link               svn://fcm1/LINK_svn/LINK
+
+set::trac::link              http://fcm1/projects/LINK/browser/LINK
+
+# NEMO repository
+set::url::nemosys            svn://fcm3/NEMO_svn/NEMOSYS
+
+set::trac::nemosys           http://fcm3/projects/NEMO/browser/NEMOSYS
+
+# NWPWEB repository
+set::url::www_nwp            svn://fcm1/NWPWEB_svn/www_nwp
+
+set::trac::www_nwp           http://fcm1/projects/NWPWEB_svn/browser/www_nwp
+
+# obsmon repository
+set::url::obsmon_dc          svn://fcm4/obsmon_svn/DC
+set::url::obsmon_rtm         svn://fcm4/obsmon_svn/RTM
+
+set::trac::obsmon_dc         http://fcm4/projects/obsmon/browser/DC
+set::trac::obsmon_rtm        http://fcm4/projects/obsmon/browser/RTM
+
+# OCN repository
+set::url::polcoms            svn://fcm3/OCN_svn/POLCOMS
+
+set::trac::polcoms           http://fcm3/projects/OCN/browser/POLCOMS
+
+# OPFC repository
+set::url::opfc               svn://fcm9/OPFC_svn/OPFC
+
+set::trac::opfc              http://fcm9/projects/OPFC/browser/OPFC
+
+# OPS repository
+set::url::ops                svn://fcm4/OPS_svn/OPS
+set::url::ops_admin          svn://fcm4/OPS_svn/Admin
+set::url::ops_data           svn://fcm4/OPS_svn/Data
+
+set::trac::ops               http://fcm4/projects/OPS/browser/OPS
+set::trac::ops_admin         http://fcm4/projects/OPS/browser/Admin
+set::trac::ops_data          http://fcm4/projects/OPS/browser/Data
+
+# OSTIA repository
+set::url::ostia              svn://fcm3/OSTIA_svn/OSTIA
+
+set::trac::ostia             http://fcm3/projects/OSTIA/browser/OSTIA
+
+# PF repository
+set::url::pf                 svn://fcm5/PF_svn/PF
+
+set::trac::pf                http://fcm5/projects/PF/browser/PF
+
+# PostProc repository
+set::url::pp                 svn://fcm9/PostProc_svn/PostProc
+set::url::ppancil            svn://fcm9/PostProc_svn/PostProcAncil
+
+set::trac::pp                http://fcm9/projects/PostProc/browser/PostProc
+set::trac::ppancil           http://fcm9/projects/PostProc/browser/PostProcAncil
+
+# PRISM repository
+set::url::oasis4             svn://fcm2/PRISM_svn/oasis4
+
+set::trac::oasis4            http://fcm2/projects/PRISM/browser/oasis4
+
+# radarnet repository
+set::url::radarnet4          svn://fcm9/radarnet_svn/radarnet4
+
+set::trac::radarnet4         http://fcm7/projects/radarnet/browser/radarnet4
+
+# ROPP repository
+set::url::ropp_doc           svn://fcm7/ROPP_svn/ropp_doc
+set::url::ropp_src           svn://fcm7/ROPP_svn/ropp_src
+set::url::ropp_test          svn://fcm7/ROPP_svn/ropp_test
+set::url::ropp_web           svn://fcm7/ROPP_svn/ropp_web
+
+set::trac::ropp_doc          http://fcm7/projects/ROPP/browser/ropp_doc
+set::trac::ropp_src          http://fcm7/projects/ROPP/browser/ropp_src
+set::trac::ropp_test         http://fcm7/projects/ROPP/browser/ropp_test
+set::trac::ropp_web          http://fcm7/projects/ROPP/browser/ropp_web
+
+# RTTOV repository
+set::url::rttov8             svn://fcm7/RTTOV_svn/RTTOV8
+set::url::rttov9             svn://fcm7/RTTOV_svn/RTTOV9
+
+set::trac::rttov8            http://fcm7/projects/RTTOV/browser/RTTOV8
+set::trac::rttov9            http://fcm7/projects/RTTOV/browser/RTTOV9
+
+# SAUtils repository
+set::url::autoscat_global      svn://fcm7/SAUtils_svn/AUTOSCAT_Global
+set::url::autoscat_nae         svn://fcm7/SAUtils_svn/AUTOSCAT_NAE
+set::url::gpsiwv_mon           svn://fcm7/SAUtils_svn/GPSIWV_Mon
+set::url::gpsro_mon            svn://fcm7/SAUtils_svn/GPSRO_Mon
+set::url::iasi_mon             svn://fcm7/SAUtils_svn/IASI_Mon
+set::url::metstrike            svn://fcm7/SAUtils_svn/METSTRIKE
+set::url::scatwind_mon         svn://fcm7/SAUtils_svn/Scatwind_Mon
+
+set::trac::autoscat_global     http://fcm7/projects/SAUtils/browser/AUTOSCAT_Global
+set::trac::autoscat_nae        http://fcm7/projects/SAUtils/browser/AUTOSCAT_NAE
+set::trac::gpsiwv_mon          http://fcm7/projects/SAUtils/browser/GPSIWV_Mon
+set::trac::gpsro_mon           http://fcm7/projects/SAUtils/browser/GPSRO_Mon
+set::trac::iasi_mon            http://fcm7/projects/SAUtils/browser/IASI_Mon
+set::trac::metstrike           http://fcm7/projects/SAUtils/browser/METSTRIKE
+set::trac::scatwind_mon        http://fcm7/projects/SAUtils/browser/Scatwind_Mon
+
+# SBV repository
+set::url::sbv                svn://fcm6/SBV_svn/SBV
+set::url::sbv_admin          svn://fcm6/SBV_svn/Admin
+
+set::trac::sbv               http://fcm6/projects/SBV/browser/SBV
+set::trac::sbv_admin         http://fcm6/projects/SBV/browser/Admin
+
+# SCS repository
+set::url::scs                svn://fcm1/SCS_svn/SCS
+set::url::tik                svn://fcm1/SCS_svn/TIK
+set::url::tt                 svn://fcm1/SCS_svn/TT
+
+set::trac::scs               http://fcm1/projects/SCS/browser/SCS
+set::trac::tik               http://fcm1/projects/SCS/browser/TIK
+set::trac::tt                http://fcm1/projects/SCS/browser/TT
+
+# SPS repository
+set::url::sps                svn://fcm7/SPS_svn/SPS
+set::url::sps_archive        svn://fcm7/SPS_svn/Archive
+
+set::trac::sps               http://fcm7/projects/SPS/browser/SPS
+set::trac::sps_archive       http://fcm7/projects/SPS/browser/Archive
+
+# SURF repository
+set::url::surf               svn://fcm8/SURF_svn/SURF
+
+set::trac::surf              http://fcm8/projects/SURF/browser/SURF
+
+# test repository
+set::url::test               svn://fcm1/test_svn/OPS
+
+set::trac::test              http://fcm1/projects/test/browser/OPS
+
+# tutorial repository
+set::url::tutorial           svn://fcm1/tutorial_svn/tutorial
+
+set::trac::tutorial          http://fcm1/projects/tutorial/browser/tutorial
+
+# TRUI repository
+set::url::trui               svn://fcm1/TRUI_svn/TRUI
+
+set::trac::trui              http://fcm1/projects/TRUI/browser/TRUI
+
+# UM repository
+set::url::um                 svn://fcm2/UM_svn/UM
+set::url::um_admin           svn://fcm2/UM_svn/Admin
+set::url::gcom               svn://fcm2/UM_svn/GCOM
+
+set::trac::um                http://fcm2/projects/UM/browser/UM
+set::trac::um_admin          http://fcm2/projects/UM/browser/Admin
+set::trac::gcom              http://fcm2/projects/UM/browser/GCOM
+
+# UM tutorial repository
+set::url::um_tutorial        svn://fcm2/UM_TUTORIAL_svn/UM
+
+set::trac::um_tutorial       http://fcm2/projects/UM_TUTORIAL/browser/UM
+
+# VAR repository
+set::url::var                svn://fcm5/VAR_svn/VAR
+set::url::var_admin          svn://fcm5/VAR_svn/Admin
+set::url::var_data           svn://fcm5/VAR_svn/Data
+
+set::trac::var               http://fcm5/projects/VAR/browser/VAR
+set::trac::var_admin         http://fcm5/projects/VAR/browser/Admin
+set::trac::var_data          http://fcm5/projects/VAR/browser/Data
+
+# VER repository
+set::url::ver                svn://fcm6/VER_svn/VER
+set::url::ver_admin          svn://fcm6/VER_svn/Admin
+set::url::ver_archive        svn://fcm6/VER_svn/Archive
+
+set::trac::ver               http://fcm6/projects/VER/browser/VER
+set::trac::ver_admin         http://fcm6/projects/VER/browser/Admin
+set::trac::ver_archive       http://fcm6/projects/VER/browser/Archive
+
+# EOF
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/etc/fcm_gui.desktop
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/etc/fcm_gui.desktop	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/etc/fcm_gui.desktop	(revision 5166)
@@ -0,0 +1,13 @@
+[Desktop Entry]
+Comment=
+Exec=fcm gui %f
+Hidden=false
+Icon=wizard
+MimeType=inode/directory
+Name=FCM GUI
+Path=
+Terminal=0
+TerminalOptions=
+Type=Application
+X-KDE-SubstituteUID=false
+X-KDE-Username=
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Ecmwf/Fortran90_stuff.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Ecmwf/Fortran90_stuff.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Ecmwf/Fortran90_stuff.pm	(revision 5166)
@@ -0,0 +1,2736 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Ecmwf::Fortran90_stuff
+#
+# DESCRIPTION
+#   This is a module for analysing Fortran 9X code. It is used by the FCM
+#   system to generate interface blocks for Fortran 9X free source files.
+#
+# ABOUT THIS MODULE:
+#   The original version of this module was developed by the European Centre
+#   for Medium-Range Weather Forecasts (ECMWF). This version has been modified
+#   by UK Met Office to become part of the FCM system.
+# ------------------------------------------------------------------------------
+
+package Ecmwf::Fortran90_stuff;
+
+# Standard pragmas
+use strict;
+use warnings;
+
+# Standard modules
+require Exporter;
+
+our @ISA      = qw(Exporter);
+our @EXPORT   = qw(study setup_parse pre_tidy remove_macro expcont 
+                   process_include_files tidy tidy_decl getvars 
+		   find_unused_vars remove_unused_vars doctor_viol
+		   fix_doctor_viol various cont_lines f90_indent
+		   writefile readfile create_interface_block
+		   add_interface_blocks change_var_names insert_hook
+		   remake_arg_decl remove_some_comments parse_prog_unit
+		   get_calls_inc);
+
+# ------------------------------------------------------------------------------
+
+# Module variables
+
+my $fname = '';
+
+# ------------------------------------------------------------------------------
+# SYNPOSIS
+#   $file = &Ecmwf::Fortran90_stuff::fname ();
+#   &Ecmwf::Fortran90_stuff::fname ($file);
+#
+# DESCRIPTION
+#   This function returns the value in the module variable $fname, which is the
+#   name of the input Fortran source file from FCM. If an argument exists, the
+#   value of $fname is set to the value of the argument.
+#
+# ------------------------------------------------------------------------------
+
+sub fname {
+  $fname = $_[0] if @_;
+  return $fname;
+}
+
+#==========================================================================
+sub study{
+# Study statements and put attributes into array $statements
+# Attributes assigned:
+# $href->{content}       - What statement it is
+# $href->{decl}       - true if declaration,
+#                       5 means statement function
+#                       4 means USE statement,
+#                       2 means type decleration
+#                       3 means FORMAT statement
+#                       1 means the rest
+# $href->{in_contain} - true while in internal procedure(s)
+# $href->{exec}       - true if executable statement
+#                     - 2 means first executable statement in program unit
+#                     - 3 means last executable statement in program unit
+#                     - 23 means first and last executable statement in program unit
+# $href->{prog_unit}  - program unit number (numbered from 0)
+# $href->{number}     - statement number (numbered from 0)
+ 
+# Further attributes will be assigned later (action attributes)
+
+  my($statements,$prog_info) = @_;
+
+  our ($name,$nest_par);
+  my ($unit_name,@args,$prog_unit,$href,@punit,$current_punit);
+  my ($content,$decl,$exec);
+  my($type_def)=0;
+  my($unit_count)=-1;
+  @punit=();
+  $current_punit='';
+  my $number=-1;
+  my $in_contain=0;
+  my $in_interface=0;
+  my $contain_host='';
+  my $current_unit_name='';
+  our($study_called);
+#  if(! $study_called) {
+#    $$prog_info{has_interface_block}=0;
+#  }
+# Initial "parsing" loop
+
+  foreach $href (@$statements) {
+    $href->{in_contain}=$in_contain;
+    $href->{contain_host}=$contain_host if($in_contain);
+    $number++;
+    $_=$href->{statement};
+    $content='unknown';
+    my $content2='';
+    $decl=0;
+    $exec=0;
+
+    if($type_def) {
+ #     $href->{content}='typedef';
+    }
+    
+# Comment
+CRACK:    {
+      if(/^\s*(?:!|$)/) {
+	$content='comment';
+	last CRACK;
+      }
+
+      $_ = uc unless /^#/;
+      s/^\s*//;
+      s/\!.*\n/\n/g; # Remove trailing comments in all lines
+#      print "AA $_";
+ 
+# Program name statement 
+      if($content eq 'unknown' and ! $in_interface) {
+	$prog_unit=&parse_prog_unit(\$unit_name,\@args);
+	if($prog_unit) {
+          $current_unit_name=$unit_name;
+	  $content=uc($prog_unit);
+	  push(@punit,$prog_unit);
+	  $current_punit=$prog_unit;
+	  $unit_count++;
+	  if(! $study_called) {
+	    $$prog_info{'unit_name'}[$unit_count]=uc($unit_name);
+	    $$prog_info{'unit_name'}[$unit_count]=uc($unit_name);
+#	  $$prog_info{'tokens'}[$unit_count]=[];
+	    if($prog_unit eq 'module') {
+	      $$prog_info{'is_module'}=1;
+	      $$prog_info{'module_name'}=$unit_name;
+	    }
+	  }
+	  last CRACK;
+	}
+      }
+      if($content eq 'unknown') {
+	$decl=0;
+	$exec=1;
+# Executable constructs
+	&study_exec(\$content,$prog_info,\$study_called);
+	if($content eq 'IF') {
+	  s/^IF\s*$nest_par\s*//;
+	  &study_exec(\$content2,$prog_info,\$study_called);
+	}
+      }
+      
+
+      if($content eq 'unknown') {
+# Specification statemnts
+	$exec=0;
+	$decl=1;
+	if(/^USE\b/) {
+	  $content='USE';
+	  $decl=4;
+	}
+	elsif(/^INTEGER\b/) {
+	  $content='INTEGER';
+	  $decl=2;
+	}
+	elsif(/^REAL\b/) {
+	  $content='REAL';
+	  $decl=2;
+	}
+	elsif(/^LOGICAL\b/) {
+	  $content='LOGICAL';
+	  $decl=2;
+	}
+	elsif(/^CHARACTER\b/) {
+	  $content='CHARACTER';
+	  $decl=2;
+	}
+	elsif(/^DOUBLE\s*PRECISION\b/) {
+	  $content='DOUBLE PRECISION';
+	  $decl=2;
+	}
+	elsif(/^COMPLEX\b/) {
+	  $content='COMPLEX';
+	  $decl=2;
+	}
+	elsif(/^TYPE *\(/) {
+	  $content='type_decl';
+	  $decl=2;
+	}
+	elsif(/^ALLOCATABLE\b/) {
+	  $content='ALLOCATABLE';
+	}
+	elsif(/^COMMON\b/) {
+	  $content='COMMON';
+	}
+	elsif(/^DATA\b/) {
+	  $content='DATA';
+	}
+	elsif(/^DIMENSION\b/) {
+	  $content='DIMENSION';
+	}
+	elsif(/^EQUIVALENCE\b/) {
+	  $content='EQUIVALENCE';
+	}
+	elsif(/^EXTERNAL\b/) {
+	  $content='EXTERNAL';
+	}
+	elsif(/^\d+\s+FORMAT\b/) {
+	  $content='FORMAT';
+	  $decl=3;
+	}
+	elsif(/^IMPLICIT\b\s+NONE\b/) {
+	  $content='IMPLICIT NONE';
+	}
+	elsif(/^IMPLICIT\b/) {
+	  $content='IMPLICIT';
+	}
+	elsif(/^INTENT\b/) {
+	  $content='INTENT';
+	}
+	elsif(/^INTRINSIC\b/) {
+	  $content='INTRINSIC';
+	}
+	elsif(/^NAMELIST\b/) {
+	  $content='NAMELIST';
+	}
+	elsif(/^OPTIONAL\b/) {
+	  $content='OPTIONAL';
+	}
+	elsif(/^PARAMETER\b/) {
+	  $content='PARAMETER';
+          $decl = 2;
+	}
+	elsif(/^POINTER\b/) {
+	  $content='POINTER';
+	}
+	elsif(/^PUBLIC\b/) {
+	  $content='PUBLIC';
+	}
+	elsif(/^PRIVATE\b/) {
+	  $content='PRIVATE';
+	}
+	elsif(/^SAVE\b/) {
+	  $content='SAVE';
+	}
+	elsif(/^TARGET\b/) {
+	  $content='TARGET';
+	}
+	elsif(/^SEQUENCE\b/) {
+	  $content='SEQUENCE';
+	}
+	elsif(/^INTERFACE\b/) {
+	  $content='INTERFACE';
+	  if(! $study_called) {
+	    $$prog_info{has_interface_block}=1;
+	    $in_interface=1;
+	  }
+	}
+	elsif(/^END ?INTERFACE\b/) {
+	  $content='END INTERFACE';
+	    $in_interface=0;
+	}
+	elsif(/^TYPE *[^\( ]/i) {
+	  $content='type_def';
+	  $type_def=1;
+	}
+	elsif(/^END\s*TYPE\b/){
+	  $content='type_def';
+	  $type_def=0;
+	}
+        elsif( $in_interface ) {
+          if(/^MODULE PROCEDURE\b/) {
+            $content='MODULE PROCEDURE';
+          }
+        }
+      }
+# Other constructs
+      if($content eq 'unknown') {
+	$decl=0;
+	$exec=0;
+	
+	if(/^CONTAINS\b/) {
+	  $content='CONTAINS';
+	  $in_contain=1;
+          $contain_host=uc($current_unit_name);
+	  if(! $study_called) {
+	    $$prog_info{has_contain}=1;
+	    $$prog_info{containing}=1;
+	  }
+	}
+	elsif(/^(?:INCLUDE|#include)\b/) {
+	  $content='include';
+	  if(! $study_called) {
+	    $$prog_info{has_include}=1;
+	  }
+	}
+	elsif(/^\#/) {
+	  $content='cpp';
+	}
+	elsif(/^\@/) {
+	  $content='compiler_directive';
+	}
+	
+	else{
+	  if(/^END\b/ and ! $in_interface) {
+	    $prog_unit=pop(@punit);
+	    $content='END '.uc($prog_unit);
+	    if($in_contain) {
+	      unless(@punit) {
+		$unit_count=0;
+		$href->{in_contain}=0;
+		$in_contain=0;
+	      }
+	    }
+	  }
+	} 
+      }
+    }
+    
+    if($in_interface and $content ne 'INTERFACE') {
+      $content='in_interface';
+      $exec=0;
+      $decl=1;
+    }
+
+#    print "BB $unit_count $content $_";
+    if($content  eq 'unknown') {
+      print STDERR $fname, ': failed to crack statement starting at line ',
+                   $href->{first_line}, ', - syntax error?', "\n";
+      print STDERR ' ', $_, "\n";
+#      print STDERR "study_called $study_called in_interface $in_interface \n";
+#      print STDERR Dumper($statements);
+      #die "Failed in study";
+    }
+#    unless($content eq 'comment') {
+#      my @tmpvar=/\b$name\b/g;
+#      my $i=0;
+#      foreach my $tmp (@tmpvar){ 
+#	$href->{'tokens'}[$i]=$tmp;
+#	$i++;
+#	if(! $study_called and $unit_count > -1) {
+#	  $$prog_info{'token_hash'}[$unit_count]{$tmp}++;
+#	}
+#      }
+#    }
+               
+    $href->{content}=$content;
+    $href->{content2}=$content2 if($content2);
+    $href->{decl}=$decl;
+    $href->{exec}=$exec;
+#    $href->{type_decl}=$type_decl;
+    $href->{prog_unit}=$unit_count;
+    $href->{number}=$number;
+    unless($content eq 'comment') {
+      $href->{multi_line} = 1 if(tr/\n// > 1);
+    }
+  }
+
+
+# Find first executable statement in each program unit
+# Also repair statement functions wrongly assigned as executable
+  my $prev_unit_count=-2;
+  my $stat_func_suspicion=0;
+  my @lastexec=();
+
+  foreach $href (@$statements) {
+    $exec=$href->{exec};
+    $unit_count=$href->{prog_unit};
+    if($exec) {
+      if($unit_count > $prev_unit_count) {
+	$content=$href->{content};
+	if($content eq 'array_assign') {
+	  $stat_func_suspicion=1;
+	  $_=$href->{statement};
+	  if(/^\s*$name\s*\(\s*:/){
+	    $stat_func_suspicion=0;
+#	    print " A $_";
+	   } 
+	  elsif(/^\s*$name\s*\(\s*$name\s*:/){
+	    $stat_func_suspicion=0;
+#	    print " B $_";
+	  } 
+	  elsif(/^\s*$name\s*\(\s*\d+/){
+	    $stat_func_suspicion=0;
+#	    print " C $_";
+	  }
+	  else {
+	    $href->{exec}=0;
+	    $href->{decl}=5;
+	    $href->{content}='statmf';
+#	    print " D $_";
+	    next;
+	  }
+	}
+	$href->{exec}=2;
+	$prev_unit_count=$unit_count;
+	$content=$href->{content};
+      }
+      $lastexec[$unit_count]=$href->{number}  unless ($unit_count < 0);  
+# No prog_unit assigned, include file?
+    }
+  }
+
+# Assign last executable statement
+  if(@lastexec) {
+    foreach my $last (@lastexec) {
+      if(defined ($last)) {
+	if($$statements[$last]->{exec} == 1) {
+	  $$statements[$last]->{exec}=3;
+	}
+	else{
+	  $$statements[$last]->{exec}=23;
+	}      
+      }
+    }
+  }
+# Consistency checks
+  my $fail=0;
+  my $prev_exec=0;
+  $prev_unit_count=-1;
+  foreach $href (@$statements) {
+    $content=$href->{content};
+    next if($content eq 'comment');
+    $unit_count=$href->{prog_unit};
+    $exec=$href->{exec};
+    $decl=$href->{decl};
+    if($unit_count == $prev_unit_count) {
+      if($decl and $prev_exec) {
+	unless ($content eq 'FORMAT' | $content eq 'DATA' ) {
+          die $fname, ': declaration after executable statement', "\n",
+              $href->{first_line}, ' ', $href->{statement}, "\n";
+	}
+      }
+    }
+    $prev_unit_count=$unit_count;
+    $prev_exec=$exec;
+  }
+
+  $study_called=1;
+}
+
+#==========================================================================
+sub study_exec{
+  my($content,$prog_info,$study_called) = @_;
+  our ($name,$nest_par);
+  if(/^(\w+\s*:\s*)*IF\s*$nest_par\s*THEN/) {
+    $$content='IF_construct';
+  }
+  elsif(/^ELSE\s*IF\s*\(/) {
+    $$content='ELSEIF';
+  }
+  elsif(/^ELSE\b\s*($name)*/) {
+    $$content='ELSE';
+  }
+  elsif(/^END\s*IF\b\s*($name)*/) {
+    $$content='ENDIF';
+  }
+  elsif(/^(?:\d+\s+)?($name\s*:\s*)*DO(\s+WHILE)?\b/) {
+    $$content='DO';
+  }
+  elsif(/^(?:\d+\s+)?END\s*DO\b/) {
+    $$content='ENDDO';
+  }
+  elsif(/^(?:\d+\s+)?ALLOCATE\b/) {
+    $$content='ALLOCATE';
+  }
+  elsif(/^ASSIGN\b/) {
+    $$content='ASIGN';
+  }
+  elsif(/^(?:\d+\s+)?BACKSPACE\b/) {
+    $$content='BACKSPACE';
+  }
+  elsif(/^(?:\d+\s+)?CALL\b/) {
+    $$content='CALL';
+    if(!$$study_called) {
+      $$prog_info{no_calls}++;
+    }
+  }
+  elsif(/^(?:\d+\s+)?CLOSE\b/) {
+    $$content='CLOSE';
+  }
+  elsif(/^(?:\d+\s+)?CONTINUE\b/) {
+    $$content='CONTINUE';
+  }
+  elsif(/^(?:\d+\s+)?CYCLE\b/) {
+    $$content='CYCLE';
+  }
+  elsif(/^(?:\d+\s+)?DEALLOCATE\b/) {
+    $$content='DEALLOCATE';
+  }
+  elsif(/^ENDFILE\b/) {
+    $$content='ENDFILE';
+  }
+  elsif(/^(?:\d+\s+)?EXIT\b/) {
+    $$content='EXIT';
+  }
+  elsif(/^(?:\d+\s+)?GO\s*TO\b/) {
+    $$content='GOTO';
+  }
+  elsif(/^(?:\d+\s+)?IF\s*\(/) {
+    $$content='IF';
+  }
+  elsif(/^(?:\d+\s+)?INQUIRE\b/) {
+    $$content='INQUIRE';
+  }
+  elsif(/^(?:\d+\s+)?NULLIFY\b/) {
+    $$content='NULLIFY';
+  }
+  elsif(/^(?:\d+\s+)?OPEN\b/) {
+    $$content='OPEN';
+  }
+  elsif(/^(?:\d+\s+)?PAUSE\b/) {
+    $$content='PAUSE';
+  }
+  elsif(/^(?:\d+\s+)?PRINT\b/) {
+    $$content='PRINT';
+  }
+  elsif(/^(?:\d+\s+)?(?:READ|BUFFER\s*IN)\b/) {
+    $$content='READ';
+  }
+  elsif(/^(?:\d+\s+)?RETURN\b/) {
+    $$content='RETURN';
+  }
+  elsif(/^(?:\d+\s+)?REWIND\b/) {
+    $$content='REWIND';
+  }
+  elsif(/^(?:\d+\s+)?STOP\b/) {
+    $$content='STOP';
+  }
+  elsif(/^(?:\d+\s+)?(?:WRITE|BUFFER\s*OUT)\s*\(/) {
+    $$content='WRITE';
+  }
+  elsif(/^(?:\d+\s+)?($name\s*:\s*)*SELECT\s*CASE\b/) {
+    $$content='SELECT CASE';
+  }
+  elsif(/^(?:\d+\s+)?CASE\b/) {
+    $$content='CASE';
+  }
+  elsif(/^(?:\d+\s+)?END\s*SELECT\b/) {
+    $$content='END SELECT';
+  }
+  elsif(/^(?:\d+\s+)?WHERE\s*$nest_par\s*$name.*=/) {
+    $$content='WHERE';
+  }
+  elsif(/^(?:\d+\s+)?WHERE\s*\(/) {
+    $$content='WHERE_construct';
+  }
+  elsif(/^ELSE\s*WHERE\b/) {
+    $$content='ELSEWHERE';
+  }
+  elsif(/^END\s*WHERE\b/) {
+    $$content='ENDWHERE';
+  }
+  elsif(/^(?:\d+\s+)?FORALL\s*\(/) {
+    $$content='FORALL';
+  }
+  elsif(/^END\s*FORALL\b/) {
+    $$content='ENDFORALL';
+  }
+  elsif(/^(?:\d+\s+)?$name(?:\s*%\s*$name)*\s*=/o) {
+    $$content='scal_assign';
+  }
+  elsif(/^(?:\d+\s+)?$name(?:\s*$nest_par)*(?:\s*%\s*$name(?:\s*$nest_par)?)*\s*=/o) {
+    $$content='array_assign';
+  }
+}
+#===================================================================================
+sub pre_tidy {
+
+# Initial tidying to make the rest work
+
+  my($lines)=@_;
+  foreach (@$lines) {
+
+# Substitute tab with four blanks
+    s/\t/    /g;
+    s/^ *INTEGER /INTEGER_M /i;
+    s/^ *REAL /REAL_B /i;
+  }
+}
+#==========================================================================
+sub remove_macro {
+
+# Remove INTEGER_M, _ONE_ etc. macros and replace by expanded statement
+
+  my($lines)=@_;
+
+  my($im)=1; # Until I start checking include files
+  my($ia)=0;
+  my($ib)=0;
+  my($rb)=1; # Until I start checking include files
+  my($is)=0;
+  my($rh)=0;
+  my($rm)=0;
+  my(@pars,$string);
+  for (@$lines) {
+    next if(/^ *$/ | /^ *!/);
+# The following two substitutions should be restored at end of processing
+    s/(\'[^!]*)!+(.*\')/$1\£$2/;   # Protect against mischief 
+    s/(["][^!]*)!+(.*["])/$1\£$2/;      # Protect against mischief
+    $im=$im+/JPIM\b/i unless($im);
+    $rb=$rb+/JPRB\b/i unless($rb);
+    $rm=$rm+/JPRM\b/i unless($rm);
+    $im=$im+s/\bINTEGER_M\b/INTEGER(KIND=JPIM)/o;
+    $ia=$ia+s/\bINTEGER_A\b/INTEGER(KIND=JPIA)/o;
+    $ib=$ib+s/\bINTEGER_B\b/INTEGER(KIND=JPIB)/o;
+    $is=$is+s/\bINTEGER_S\b/INTEGER(KIND=JPIS)/o;
+    $rb=$rb+s/\bREAL_B\b/REAL(KIND=JPRB)/o;
+    $rh=$rh+s/\bREAL_H\b/REAL(KIND=JPRH)/o;
+    $rm=$rm+s/\bREAL_M\b/REAL(KIND=JPRM)/o;
+    $rb=$rb+s/\b_ZERO_\b/0.0_JPRB/og;
+    $rb=$rb+s/\b_ONE_\b/1.0_JPRB/og;
+    $rb=$rb+s/\b_TWO_\b/2.0_JPRB/og;
+    $rb=$rb+s/\b_HALF_\b/0.5_JPRB/og;
+  }
+  @pars=();
+  push(@pars,"JPIM") if $im;
+  push(@pars,"JPRB") if $rb;
+  push(@pars,"JPRM") if $rm;
+  push(@pars,"JPIA") if $ia;
+  push(@pars,"JPIB") if $ib;
+  push(@pars,"JPIS") if $is;
+  ($string=join('     ,',@pars))=~s/ *$//;
+  for (@$lines) {
+    next unless (/^\#/);
+    if(@pars) {
+      s/^#include +"tsmbkind.h"/USE PARKIND1  ,ONLY : $string/ ;
+    }
+    else {
+      s/^#include +"tsmbkind.h"//;
+    }
+#    if($rh) {
+      s/^#include +"hugekind.h"/USE PARKIND2  ,ONLY : JPRH/ ;
+#    }
+#    else {
+#      s/^#include +"hugekind.h"// ;
+#    }
+  }
+}
+
+#==========================================================================
+sub readfile  {
+# Read file 
+  my($fname)=@_;
+  my(@lines);
+  if(!open(INFIL,$fname)) {
+    print STDERR "Can't open $fname for reading\n";
+    die("Can't open $fname for reading\n");
+  }
+  @lines=<INFIL>;
+  close INFIL;
+  (@lines);
+}
+
+#==========================================================================
+sub writefile  {
+# Write file
+  my($fname,$lines)=@_;
+  if(!open(OUTFIL,">".$fname)) {
+    print STDERR "Can't open $fname for writing\n";
+    exit;
+  }
+  print OUTFIL @$lines;
+  close OUTFIL;
+}
+
+#==========================================================================
+sub expcont {
+#
+# Expand continuation lines into statements for free-format Fortran while
+# maintaining line-breaking and all comments
+# Put statements onto array of references to anonymous hashes as key 'statement'
+# Also put into the hash the linenumber of first line of statement as key 'first_line'
+  my ($lines, $statements) = @_;
+  my ($statm, $first_line);
+
+  my $prev        = 0;
+  my $line_number = 0;
+
+  for (@$lines) {
+    $line_number++;
+
+    s/^([^'"]*)(?:\s*!.*)$/$1/; # Remove trailing comments
+
+    s/^(\s*)&(.*)$/$1$2/s;
+
+    if (!/^\s*!.*$/ && /^.+?&(?:\s*!.*)*\s*$/) {
+      s/(.+?)&(.+)/$1\n/s;
+
+      $statm     .= $_;
+      $first_line = $line_number unless $prev;
+      $prev       = 1;
+      next;
+
+    } elsif ($prev && /^\s*(?:!|$)/) { # ignore blank/comment lines
+      next;
+
+    } else {
+      s/!.*?$//;
+
+      $statm     .= $_;
+      push @$statements, {
+        'statement'  => $statm,
+        'first_line' => $prev ? $first_line : $line_number,
+      };
+
+      $statm = "";
+      $prev  = 0;
+    }
+  }
+}
+#==========================================================================
+
+sub cont_lines {
+#
+# Put back continuation character in correct place and execute delayed actions
+#
+  my($statements,$lines,$line_hash) = @_;
+  my(@temp,$i,$iup,$href);
+
+
+# Put back continuation characters and split statements into lines as they were
+  @$lines=();
+  @$line_hash=();
+  foreach $href (@$statements) {
+    $_=$href->{statement};
+    if (/\n.*\n/){                      # This is a multi-line statement
+      @temp=split /\n/;                 # Split statement into lines (removes EOL)
+      $iup=scalar(@temp);               # Number of lines in statement
+      for ($i=0;$i < $iup;$i++) {       # Loop through lines
+	$_=$temp[$i];
+	if($i == 0 ){                   # First line
+	  if(/^([^!]+)(!.*)$/) {        # Line has trailing comment
+	    s/^([^!]+)(!.*)$/$1&$2\n/;  # Put back & at end of line before comment
+	  }
+	  else {                        # No trailing comment
+	    s/^([^!]+)$/$1&\n/;         # Put back & and EOL at end of line
+	  }	    
+	}
+	elsif ($i == ($iup-1)) {        # Last line
+	  s/^( *)(.*)$/$1& $2 \n/;      # Put back & at beginning of line
+	}
+	else {                          # Other lines
+	  if (/^ *!/) {                 # Line is comment line
+	    $_=$_."\n";                 # Restore EOL for comments
+	  }
+	  else {
+	    if(/^( *)([^!]*)(!.*)$/) {  # Line has trailing comment
+	      s/^( *)([^!]*)(!.*)*$/$1& $2&$3\n/;  # & at beginning and end of line
+	    }
+	    else {                      # No trailing comment
+	      s/^( *)([^!]*)$/$1& $2&\n/; # & at beggining and end of line
+	    }	 
+	  }  
+	}
+	if($i == 0        && exists $href->{pre_insert}) {
+	  my @templines=split('\n',$href->{pre_insert});
+	  foreach my $tline (@templines) {
+	    my $rec={};
+	    $rec->{'content'}='unknown';
+	    $rec->{'line'}=$tline."\n";
+	    push(@$lines,$rec->{'line'});
+	    push(@$line_hash,$rec);
+	  }
+	}
+	unless(exists $href->{remove}) {
+	  my $rec={};
+	  $rec->{'line'}=$_;
+	  if($i == 0) {
+	    $rec->{'content'}=$href->{content};
+	  }
+	  else {
+	    $rec->{'content'}='cont_line';
+	  }
+	  push(@$lines,$rec->{'line'});
+	  push(@$line_hash,$rec);
+	}
+	if($i == ($iup-1) && exists $href->{post_insert}) {
+	  my @templines=split('\n',$href->{post_insert});
+	  foreach my $tline (@templines) {
+	    my $rec={};
+	    $rec->{'content'}='unknown';
+	    $rec->{'line'}=$tline."\n";
+	    push(@$lines,$rec->{'line'});
+	    push(@$line_hash,$rec);
+	  }
+	}
+      }
+    }
+    else {  # Not multiline statement
+      if(exists $href->{pre_insert}) {
+	my @templines=split('\n',$href->{pre_insert});
+	foreach my $tline (@templines) {
+	  my $rec={};
+	  $rec->{'content'}='unknown';
+	  $rec->{'line'}=$tline."\n";
+	  push(@$lines,$rec->{'line'});
+	  push(@$line_hash,$rec);
+	}
+      }
+      unless(exists $href->{remove}) {
+	my $rec={};
+	$rec->{'line'}=$_;
+	$rec->{'content'}=$href->{content};
+	push(@$lines,$rec->{'line'});
+	push(@$line_hash,$rec);
+#	print $rec;
+      }
+      if(exists $href->{post_insert}) {
+	my @templines=split('\n',$href->{post_insert});
+	foreach my $tline (@templines) {
+	  my $rec={};
+	  $rec->{'content'}='unknown';
+	  $rec->{'line'}=$tline."\n";
+	  push(@$lines,$rec->{'line'});
+	  push(@$line_hash,$rec);
+	}
+      }
+    }
+  }
+}
+#==========================================================================
+sub getvars {
+# Return list of locally declared variables with type and scope information
+# 
+  my($statements,$prog_info,$vars,$use_vars) = @_;
+  my ($test,$type,@vars1,$func,$prog_unit,$dum,$tmp_name,@pu_args);
+  my ($preserve,$rank,$href);
+  our($nest_par,$name);
+
+  %$vars=();
+  $func="";
+  $prog_unit=0;
+  %$use_vars=();
+  foreach $href (@$statements) {
+    next if($href->{content} eq 'comment');           # Skip comments
+    next if($href->{exec});                        # Don't look in executable statements
+    next if($$prog_info{is_module} and ! $href->{in_contain}); # Unless inside CONTAIN skip module 
+    $prog_unit=$href->{prog_unit};
+    if($href->{content} eq 'FUNCTION') {
+      $_=$href->{statement};
+      my $dum=&parse_prog_unit(\$func,\@pu_args);          # Get name of FUNCTION
+#      print "GETVARS FUNCTION $func \n";
+      $func=uc($func);
+    }
+    if($href->{decl} == 2 or $href->{content} eq 'EXTERNAL'){  # Real parse starts
+      $_=$href->{statement};
+      $_=uc($_);                                   # Upcase to avoid /.../i
+      s/^ *//;                                     # remove leading blanks
+      if($href->{decl} == 2) {
+	$type=lc(substr($href->{content},0,1));
+      }
+      else {
+	$type='e';
+      }
+      s/\!.*\n/\n/g;                               # Remove trailing comments in all lines
+      $preserve=$_;
+      s/(.+)::(.+)/$2/s;                           #REAL(KIND=JPRB) :: zsig(:) -> zsig(:),
+      s/^EXTERNAL (.+)$/$1/;
+      s/\s+//g;                                    # Remove all white-space
+      if($href->{content} eq 'CHARACTER') {
+	s/($name)\*\d+/$1/g;
+	s/($name)\*$nest_par/$1/g;
+	s/($name)$nest_par\*\w+/$1/g;
+      }
+      s#=\(/.+/\)##;      # ZVAL(1:2)=(/1.0,2.0/) -> ZVAL(1:2)
+#?      s/=[^,\n]+//g;
+      s/$nest_par//g;     # ISEC3(SIZE(NSEC3)),ISEC4(SIZE(NSEC4)) -> ISEC3,ISEC4
+      s/=\w+//g;          # ZVAL=1.0 -> ZVAL
+      s@/.*/@@;           # What?
+      @vars1=split(',',$_);
+      for(@vars1) {
+	next unless /^$name$/;          # A bit of security
+	if($preserve =~ /\b$_\b *\(/ | $preserve =~ /DIMENSION/) {
+	  $rank=1;        # Variable is array
+	}
+	else {
+	  $rank=0;        # Variable is scalar
+	}
+	if($_ eq $func) {
+	  $$vars{$_}{type_spec}="f";
+	} 
+	else {
+	  if($href->{content} eq 'FUNCTION') {
+	    $$vars{$_}{type_spec}='f';
+	  }
+	  else {
+	    $$vars{$_}{type_spec}=$type;
+	  }
+	}
+	$$vars{$_}{scope}=$prog_unit;
+	$$vars{$_}{rank}=$rank;
+	$$vars{$_}{usage}='local';
+      }
+    }
+# Perhaps the variable is really a statement function?
+    if($href->{decl} == 5) {
+      $_=$href->{statement};
+      s/\s+//g;                                    # Remove all white-space
+      /^($name)\((.+)\)=/i;
+      my $tvar=uc($1);
+      my @stmf_args=split(',',$2);
+      if (exists($$vars{$tvar})) {
+	$$vars{$tvar}{type_spec}='s';
+#	print "STATMF OK $tvar \n ";
+      }
+      for (@stmf_args) {
+	if (exists($$vars{$_})) {
+	  $$vars{$_}{type_spec}='s';
+#	  print "STATMF ARG OK $_ \n ";
+	}
+      }
+    }
+  }
+# Perhaps instead the variable is a declaration of an external function?
+  my @extract=();                  # Extract part of statements for efficiency
+  foreach $href (@$statements) {
+    if($href->{exec}) {                 # Function call must be in executable stat.
+      next if($href->{content} eq 'CALL'); # A call can't contain an undeclared function
+      push(@extract,$href->{statement});
+    }
+  }
+  
+  foreach my $var (keys (%$vars)) {
+    next if($$vars{$var}{rank} > 0);   # Can't be a function if rank > 0
+    next if($$vars{$var}{type_spec} eq 's' | $$vars{$var}{type_spec} eq 'f');
+    my $dec_unit=$$vars{$var}{scope};
+    my $regex1=qr/\b$var\b\s*\(/i;      # As var's rank=0 this could be function call
+    for(@extract) {
+      if(/${regex1}/) {
+	s/\!.*\n/\n/g;                       # Remove trailing comments in all lines
+	s/\s+//g;                            # Remove all white-space
+	if(/${regex1}/) {
+	  if($$vars{$var}{type_spec} eq 'c') {   # Avoid CLVAR(1:3) etc.
+	    next if(/${regex1}\s*(\d+|$name)*\s*:\s*(\d+|$name)*\s*\)/);
+	  }
+#	  print "TYPE changed to function $var $_ \n";
+	  $$vars{$var}{type_spec}='f';
+	  last;
+	}
+      }
+    }
+  }
+# ---------------------------------------------------------------------
+# Assign  "usage" in Doctor sense to variable (default usage is 'local')
+# 
+  foreach $href (@$statements) {
+# Is the varaible a dummy argument
+    if($href->{content} eq 'FUNCTION' or $href->{content} eq 'SUBROUTINE') {
+      $_=$href->{statement};
+      @pu_args=();
+      my $dum=&parse_prog_unit(\$func,\@pu_args);   # Get arguments
+      for(@pu_args) {
+	if( exists $$vars{$_} ) {
+	  if($$vars{$_}{scope} == $href->{prog_unit}) {
+	    $$vars{$_}{usage}='arg';
+	  }
+
+	} else {
+          print STDERR "Argument $_ has not got a corresponding declaration " .
+                       "statement\n";
+          print STDERR "Bailing out at this point\n";
+          die "Bailing out";
+	}
+      }
+    }
+# Does the variable appear in a NAMELIST
+# We want to distinguish this for more lenient Doctor check
+    if($href->{content} eq 'NAMELIST') {
+      $_=$href->{statement};
+      s/\!.*\n/\n/g;     # Remove trailing comments in all lines
+      s/\s+//g;          # Remove all white-space
+      m:NAMELIST/\w+/(.+):;
+      my @namvars=split(',',uc($1));
+      for (@namvars) {
+	if( exists $$vars{$_} ) {
+	  if($$vars{$_}{scope} == $href->{prog_unit}) {
+	    $$vars{$_}{usage}='namvar';
+	  }
+	}
+      }
+    }
+    if(exists $href->{inc_statm}) { # We also have to look in include files
+      my $incs=$href->{inc_statm};
+      foreach my $hrefi (@$incs) {
+	if($hrefi->{content} eq 'NAMELIST') {
+	  $_=$hrefi->{statement};
+	  s/\!.*\n/\n/g;     # Remove trailing comments in all lines
+	  s/\s+//g;          # Remove all white-space
+	m:NAMELIST/\w+/(.+):;
+	  my @namvars=split(',',uc($1));
+	  for (@namvars) {
+	    if( exists $$vars{$_} ) {
+	      if($$vars{$_}{scope} == $href->{prog_unit}) {
+		$$vars{$_}{usage}='namvar';
+	      }
+	    }
+	  }
+	}
+      }
+    }
+  }
+# -----------------------------------------------------------------------------
+# Find use variables
+  my %use_count=();
+  foreach $href (@$statements) {
+    if($href->{content} eq 'USE') {
+      $prog_unit=$href->{prog_unit};
+      $_=$href->{statement};
+      s/\!.*\n/\n/g;                               # Remove trailing comments in all lines
+      s/\s+//g;                                    # Remove all white-space
+      $_=uc($_);                                   # Upcase to avoid /.../i
+      if(/^USE($name),ONLY:(.+)$/){
+	my $modname=$1;
+	if( exists $use_count{$modname}) {
+	  if($prog_unit == $use_count{$modname}) {
+	    print STDERR "-> $href->{statement}";
+            print STDERR "USE $modname appears more than once in program unit $prog_unit \n\n";
+
+	  }
+	}
+	$use_count{$modname} = $prog_unit;
+	my @usevars = split /,/ ,$2;
+	my %usevars=();
+	foreach my $usevar (@usevars) {
+	  $usevars{$usevar}++;
+	  $$use_vars{$usevar}{module}=$modname;
+	  $$use_vars{$usevar}{scope}=$prog_unit;
+	  $$use_vars{$usevar}{count}++;
+	}
+	foreach my $usevar (keys (%usevars)) {
+	  if($usevars{$usevar} >1) {
+	    print STDERR "DUPLICATE USE ONLY VARIABLE ",
+	    "$modname $usevar $prog_unit \n";
+	    $_=$href->{statement};
+	    s/\b$usevar\b//i;
+	    s/,\s*,/,/;
+	    s/,\s*\n$/\n/;
+	    s/\n *\n/\n/;
+	    s/^(.+:\s*),/$1/;
+	    $href->{statement}=$_;
+	  }
+	}
+      }
+      else {
+#	print "WARNING:USE without ONLY \n";
+      }
+    }
+  }
+}
+#==========================================================================
+sub find_unused_vars {
+# Find declared variables not used
+  my($statements,$vars,$unused_vars,$use_vars,$unused_use_vars) = @_;
+  my ($var,@tokens,$href);
+  @tokens=();
+# Find all tokens in file
+  foreach $href (@$statements) {
+    next if($href->{content} eq 'comment');
+    if(exists $href->{inc_statm}) {  # Look also in include files
+      my $incs=$href->{inc_statm};
+      foreach my $hrefi (@$incs) {
+	die "FUV $href->{content} $href->{statement}" unless exists $hrefi->{statement};
+	$_=$hrefi->{statement};
+	if(/\b[a-zA-Z]\w*\b/) {
+	  push(@tokens,/\b[a-zA-Z]\w*\b/g);
+	}
+      }
+    }
+    else {
+      $_=$href->{statement};
+      push(@tokens,/\b[a-zA-Z]\w*\b/g);
+    }
+  }
+  @tokens= map {uc} @tokens; # Upcase array of tokens, the variables are upper-case
+
+# Find out how many times the variable appears in array tokens
+  foreach $var (keys (%$vars)) {
+    $$vars{$var}{uses}=0;
+  }
+  foreach $var (keys (%$use_vars)) {
+    $$use_vars{$var}{uses}=0;
+  }
+  for (@tokens) {
+    if(exists($$vars{$_})){
+      $$vars{$_}{uses}++; 
+    }
+    if(exists($$use_vars{$_})){
+      $$use_vars{$_}{uses}++; 
+    }
+  }
+# If it appears only one time (which must be in a declaration) it is unused
+  @$unused_vars=();
+  foreach $var (keys (%$vars)) {
+    push(@$unused_vars,$var) if($$vars{$var}{uses} < 2);
+  }
+  @$unused_use_vars=();
+  foreach $var (keys (%$use_vars)) {
+    push(@$unused_use_vars,$var) if($$use_vars{$var}{uses} < 2);
+  }
+}
+#==========================================================================
+sub remove_unused_vars {
+# Does what it says on the tin
+  my($statements,$unused_vars,$unused_use_vars) = @_;
+  my ($var,$href);
+  our $nest_par;
+  for (@$unused_vars) {
+    $var=$_;
+    foreach $href (@$statements) {
+      $_=$href->{statement};
+      next unless(($href->{decl}) | ($href->{content} eq 'comment'));
+      if($href->{content} eq 'comment') {
+	next unless(/^ *!\$OMP/);
+      }
+      if(/\b$var\b/i) {
+#	print $_;
+	
+	if(/\b$var\b *\(/i) {
+#	  print "ZYZ $var $_";
+	  s/\b$var\b *$nest_par *(=\s*\(\/.*\/\))*//si;
+#	  print "ZZZ $var $_";
+	}
+	s/\b$var\b\s*=\s*\d+(\.\d*)*//i;
+	s/\b$var\b *(\* *\d+)*//i if($href->{content} eq 'CHARACTER') ;
+	s/\b$var\b//i; 
+#	print $_;
+        s/^.+:: *\n$//;
+        s/^.+:: *\!.*\n$//;
+#	print $_;
+        s/,\s*,/,/;
+#	print $_;
+	s/, *\n$/\n/;
+#	print $_;
+        s/(::\s*),(.+)$/$1$2/s;
+        s/\n *\n/\n/;
+        s/\n *!.*\n/\n/;
+	s/, *\n$/\n/;
+# Remove "empty" lines
+        s/^.+::\s*$//;
+        s/^.+::\s*=.*$//;
+        s/^.+::\s*!.*$//;
+#	print $_;
+        s/^CHARACTER *\*\d+ *\n$//i if($href->{content} eq 'CHARACTER') ;
+	$href->{statement}=$_;
+      }
+    }
+  }
+  for (@$unused_use_vars) {
+    $var=$_;
+    foreach $href (@$statements) {
+      next unless($href->{decl} == 4);
+      $_=$href->{statement};
+      next if(/PARKIND/); #I am sure this could be done betterh
+
+      if(/\b$var\b/i) {
+	s/\b$var\b//i;
+        s/,\s*,/,/;
+        s/,\s*\n$/\n/;
+        s/\n *\n/\n/;
+	s/^(.+:\s*),/$1/;
+	s/^.+:\s*$//;
+	$href->{statement}=$_;
+      }
+    }
+  }
+}
+#==========================================================================
+sub tidy_decl {
+# Tidy up declarions
+  my($statements) = @_;
+  my($href,$content);
+
+  foreach $href (@$statements) {
+    next unless($href->{decl} == 2);
+    $_=$href->{statement};
+    $content=$href->{content};
+    
+    if($content eq 'CHARACTER') {
+      s/CHARACTER *\* *(\w+)/CHARACTER \(LEN = $1\)/i; 
+      s/CHARACTER *\* *\(\*\)/CHARACTER \(LEN = \*\)/i;
+      s/CHARACTER *\* *\( *(\w+) *\)/CHARACTER \(LEN = $1)/i;
+    }
+    if($content eq 'INTEGER') {
+      if(/^ *INTEGER[^\(]/i) {
+	s/INTEGER\b/INTEGER(KIND=JPIM)/;
+      }
+    }
+    unless (/::/) {
+      s/^( *LOGICAL )/$1:: /i;
+      s/^( *INTEGER\(KIND=JPI\w\) )/$1:: /;
+      s/^( *REAL\(KIND=JPR\w\) )/$1:: /;
+      if(/^ *CHARACTER/i) {
+	if( s/^( *CHARACTER *\( *LEN *= *\w+ *\))/$1 :: /i) {
+	  $href->{statement}=$_;
+	  next;
+	}
+	if(s/^( *CHARACTER *\( *LEN *= *\* *\))/$1 :: /i) {
+	  $href->{statement}=$_;
+	  next;
+	}
+	s/^( *CHARACTER )/$1:: /i;
+      }
+    }
+    $href->{statement}=$_;
+  }
+}
+#==========================================================================
+
+sub doctor_viol {
+# Find Doctor violations
+
+  my($vars,$fix_doc) = @_;
+  my ($var,$type,$zz,$prog_unit,$usage);
+  %$fix_doc=();
+
+  foreach $var (keys (%$vars)) {
+    $type=$$vars{$var}{type_spec};
+    $prog_unit=$$vars{$var}{scope};
+    $usage=$$vars{$var}{usage};
+#    print "DOC $var $type $prog_unit $usage \n";
+    if($zz=&doc_char($type,$usage,$var)) {
+#      print "DOCTOR VIOL - ",$var," $type $zz $prog_unit\n";
+      $$fix_doc{$var}=$zz.'_'.$var.','.$prog_unit
+    }
+  }  
+}
+#==========================================================================
+
+sub fix_doctor_viol {
+# Fix Doctor violations
+  my($statements,$fix_doc) = @_;
+  my($doc_viol,$repl,$prog_unit,$cur_prog_unit,@allowed,$href,$content);
+  my($tmp_name,@pu_args);
+
+  @allowed=('NRGRI'); # Hack
+
+  VIOL:foreach $doc_viol (keys (%$fix_doc)) {
+    # Let's allow some violations
+    for (@allowed){ 
+      next VIOL if($doc_viol eq $_);
+    }
+
+    ($repl,$prog_unit)=split(',',$$fix_doc{$doc_viol});
+
+    print "FIX $repl $prog_unit \n";
+    foreach $href (@$statements) {
+      $content=$href->{content};
+      $_=$href->{statement};
+      if($href->{content} eq 'comment') {
+	next unless(/^ *!\$OMP/);
+      }
+      $cur_prog_unit=$href->{prog_unit};
+      if($prog_unit == $cur_prog_unit) {  # Could be fine in other program units
+	if(/\b$doc_viol\b/i) {
+	  s/%$doc_viol\b/_X_$doc_viol/ig; # Protect type-components
+	  s/\b$doc_viol\b/$repl/ig;
+	  s/_X_$doc_viol\b/%$doc_viol/ig; # Restore type-components
+	}
+      }
+      $href->{statement}=$_;
+    }
+  }
+  
+}
+#==========================================================================
+sub various{
+# 
+  my($statements,$prog_info,$vars) = @_;
+  my($punit,@args,$tmp_name,$cont,$statm);
+  my($href,$exec);
+  our $nest_par;
+#------------------------------------------------------------------
+# Remove unneccesary RETURN statement
+  foreach $href (@$statements) {
+    $cont=$href->{content};
+    if($cont eq 'RETURN') {
+      if($href->{exec} == 3) {   # $href->{exec} == 3 means last executable statement
+	$href->{remove} = 1;     # Post remove line for later
+      }
+    }
+  }
+
+
+# Make sure all CALL MPL_... has a CDSTRING argument
+  foreach $href (@$statements) {
+    $cont=$href->{content};
+    if($href->{content} eq 'CALL' ) {
+      $_=$href->{statement};
+      if(/^\s*CALL\s+MPL_/i) {
+	next if(/^\s*CALL\s+MPL_ABORT/i);
+	next if(/^\s*CALL\s+MPL_WRITE/i);
+	next if(/^\s*CALL\s+MPL_READ/i);
+	next if(/^\s*CALL\s+MPL_OPEN/i);
+	next if(/^\s*CALL\s+MPL_CLOSE/i);
+	next if(/^\s*CALL\s+MPL_INIT/i);
+	next if(/^\s*CALL\s+MPL_GROUPS_CREATE/i);
+	next if(/^\s*CALL\s+MPL_BUFFER_METHOD/i);
+	next if(/^\s*CALL\s+MPL_IOINIT/i);
+	next if(/^\s*CALL\s+MPL_CART_COORD/i);
+#	print "CDSTRING=$$prog_info{'unit_name'}[$href->{prog_unit}]: \n";
+	unless(/CDSTRING\s*=/i) {
+	  s/\)(\s)$/,CDSTRING=\'$$prog_info{'unit_name'}[$href->{prog_unit}]:\'\)$1/;
+	  $href->{statement}=$_;
+	}
+      }
+    }
+  }
+	
+
+
+#------------------------------------------------------------------
+# Add Standard Modification Line
+
+  my $start=0;
+  foreach $href (@$statements) {
+    $cont=$href->{content};
+    if($cont eq 'comment') {
+      $_=$href->{statement};
+      if($start) {                        # Found header - look for end of mod lines
+	if(/^ *$/ || /^! *------------------------/) {
+	  $href->{pre_insert} = "!        M.Hamrud      01-Oct-2003 CY28 Cleaning\n";
+	  last;
+	}
+	next;
+      }
+      $start=1 if(/^! +Modifications/i) ;  # This how the header should look
+      next;
+    }
+    last if($href->{exec});                # We have failed - bail out
+  }
+
+# Change subroutine and call multi-line statements so that the comma
+# beetwen variables comes at the end of the line
+  my @lines=();
+  foreach $href (@$statements) {
+    if(exists $href->{multi_line}) {
+      $cont=$href->{content};
+      if($cont eq 'SUBROUTINE' | $cont eq 'CALL' ) {
+	$statm=$href->{statement};
+	@lines=split "\n", $statm;
+	@lines = reverse @lines;
+	my $append_comma=0;
+	for (@lines) {
+#	  print "A $append_comma $_ \n";
+	  next if(/^ *!/);
+	  if($append_comma) {
+	    if(/\S *!.*$/) {
+	      s/(\S)( *!.*)$/$1,$2/;
+	    }
+	    else {
+	      s/(\S) *$/$1,/;
+	    }
+	  }
+	  $append_comma=s/^ *,//;
+#	  print "B $append_comma $_ \n";
+	}
+	@lines = reverse @lines;
+	$statm=join  "\n",@lines;
+	$statm=$statm."\n";
+	$href->{statement}=$statm;
+      }
+    }
+  }
+  our $name;
+  foreach $href (@$statements) {
+    if($href->{content} eq 'USE') {
+      $_=$href->{statement};
+      unless(/^\s*USE\s+$name\s*,\s*ONLY\s*:/i){
+	print $_;
+	print "WARNING:USE without ONLY \n";
+      }
+    }
+  }    
+}
+#==========================================================================
+sub insert_hook{
+# 
+  my($statements,$prog_info,$vars) = @_;
+  my($punit,@args,$tmp_name,$cont,$statm);
+  my($href,$exec);
+  our $nest_par;
+#------------------------------------------------------------------
+# Add HOOK function
+  my $unit_name='';
+  my $last_use=0;
+  my $hook_status=0;
+  my $in_contain=0;
+  my $prev_prog=0;
+  my ($decl,$remember);
+  foreach $href (@$statements) {
+    $cont=$href->{content};
+    next if($cont eq 'comment');
+
+    $decl=$href->{decl};
+    $exec=$href->{exec};
+    $in_contain=$href->{in_contain};
+    if(! $in_contain and $href->{prog_unit} > $prev_prog) {
+      $hook_status=0;
+      $prev_prog=$href->{prog_unit};
+      print "resetting hook status \n";
+    }
+
+    if($cont eq 'FUNCTION' or $cont eq 'SUBROUTINE' or 
+       $cont eq 'PROGRAM'){ # Need name of routine
+      $_=$href->{statement};
+      &parse_prog_unit(\$unit_name,\@args);
+      $unit_name=uc($unit_name);
+# If in module pre-pend module name
+      $unit_name=$$prog_info{module_name}.':'.$unit_name if($$prog_info{is_module}); 
+      $remember=0;
+    }
+
+    if($hook_status == 0) {   # $hook_status == 0 means we have not done anything yet
+      if($cont eq 'USE') {    # Add USE YOMHOOK as second use statement
+	$href->{post_insert}="USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\n";
+	$hook_status=1;
+      }
+      elsif($cont eq 'IMPLICIT NONE') { # No previous USE, add USE YOMHOOK before IMPLICIT NONE
+	$href->{pre_insert} ="USE PARKIND1  ,ONLY : JPRB\n".
+	  "USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\n";
+	$hook_status=1;
+      } 
+    }
+    $remember=$href->{number} if($decl == 2); 
+
+#   Use statement added ($hook_status == 1), now insert HOOK switch on statement
+#   before first executable statement in program unit ($exec == 2)
+    if($hook_status == 1 && $exec == 2) {
+      if($remember) {
+	$$statements[$remember]->{post_insert}="REAL(KIND=JPRB) :: ZHOOK_HANDLE\n";
+	$href->{pre_insert}="IF (LHOOK) CALL DR_HOOK(\'${unit_name}\',0,ZHOOK_HANDLE)\n";
+      }
+      else {
+	$href->{pre_insert}="REAL(KIND=JPRB) :: ZHOOK_HANDLE\n".
+	    "IF (LHOOK) CALL DR_HOOK(\'${unit_name}\',0,ZHOOK_HANDLE)\n";
+      }   
+      if($cont eq 'IF') {
+	if($href->{content2} eq 'RETURN') {
+	  $_=$href->{statement};
+	  s/(\s*IF\s*$nest_par).*\n/$1/i;
+	  s/\)$/ .AND. LHOOK\)/;
+	  $href->{pre_insert}=$href->{pre_insert}."$_ CALL DR_HOOK(\'${unit_name}\',1,ZHOOK_HANDLE)\n";
+	}
+      }
+      $hook_status=2;
+    }
+#   Hook switched on($hook_status == 2), switch off after last executable statement
+#   ($exec == 3)
+    elsif($hook_status == 2) {
+      if($exec == 3 or $exec == 23) {
+	$href->{post_insert}="IF (LHOOK) CALL DR_HOOK(\'${unit_name}\',1,ZHOOK_HANDLE)\n";
+	$hook_status=3;
+      }
+      elsif($cont eq 'RETURN') {
+	$href->{pre_insert}="IF (LHOOK) CALL DR_HOOK(\'${unit_name}\',1,ZHOOK_HANDLE)\n";
+      }
+      elsif($cont eq 'IF') {
+	if($href->{content2} eq 'RETURN') {
+	  $_=$href->{statement};
+	  s/(\s*IF\s*$nest_par).*\n/$1/i;
+	  s/\)$/ .AND. LHOOK\)/;
+	  $href->{pre_insert}="$_ CALL DR_HOOK(\'${unit_name}\',1,ZHOOK_HANDLE)\n";
+	}
+      }	
+    }
+    $hook_status=1 if($in_contain && $hook_status==3); # Reset hook status in CONTAIN region
+  }
+  die "Adding HOOK function failed " if($hook_status == 2);
+}
+#==========================================================================
+
+sub doc_char{
+# Returns suggested prefix in case of DOCTOR violation (otherwise null string)
+  my($type,$usage,$var) = @_;
+  my $prefix="";
+# INTEGER variables
+  if( $type eq "i") {
+    if($usage eq "arg") {
+      $prefix="K" unless($var=~/^K/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="I" unless($var=~/^[IJ]/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="N" unless($var=~/^[MN]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="I" unless($var=~/^[MNIJ]/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+# REAL variables
+  elsif( $type eq "r") {
+    if($usage eq "arg") {
+      $prefix="P" unless($var=~/^P/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="Z" unless($var=~/^Z|^PP/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="R" if ($var=~/^[ZPIJKLMNCY]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="Z" if ($var=~/^[PIJKLMNCY]/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+#LOGICAL variables
+  elsif( $type eq "l") {
+    if($usage eq "arg") {
+      $prefix="LD" unless($var=~/^LD/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="LL" unless($var=~/^LL/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="L" unless($var=~/^L[^LD]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="LL" unless($var=~/^L/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+#CHARACTER variables
+  elsif( $type eq "c") {
+    if($usage eq "arg") {
+      $prefix="CD" unless($var=~/^CD/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="CL" unless($var=~/^CL/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="C" unless($var=~/^C[^LD]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="CL" unless($var=~/^C/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+# USER DEFINED TYPES
+  elsif( $type eq 't') {
+    if($usage eq "arg") {
+      $prefix="YD" unless($var=~/^YD/i);
+    }
+    elsif($usage eq "local") {
+      $prefix="YL" unless($var=~/^YL/i);
+    }
+    elsif($usage eq "module") {
+      $prefix="Y" unless($var=~/^Y[^LD]/i);
+    }
+    elsif($usage eq "namvar") {
+      $prefix="YL" unless($var=~/^Y/i);
+    }
+    else { 
+      die "Unknown usage";
+    }
+  }
+# FUNCTION/EXTERNAL declarations
+  elsif( $type eq 'f' || $type eq 'e' || $type eq 's') {
+# Everything is OK
+  }
+  else {
+    die "Unknown type $type"
+  }
+  ($prefix);
+}
+#==========================================================================
+     
+sub parse_prog_unit {
+  # Find out type (return), name ($$unit_name) and arguments (@$args)
+  # from a program unit statement ($_)
+  my ($unit_name, $args) = @_;
+  $$unit_name = '';
+  @$args      = ();
+
+  my $type = '';
+
+  our ($name, $type_spec, $attribute);
+
+  if (/^\s*(MODULE|PROGRAM|BLOCK\s*DATA)\s+($name)\s*$/io) {
+    $type       = lc ($1);
+    $$unit_name = $2;
+
+    # Remove space from "block data"
+    $type       =~ s/\s*//;
+
+  } elsif (/^\s*(?:$attribute)?\s*(SUBROUTINE)\s+($name)\b/io or
+           /^\s*(?:$attribute)?\s*(?:$type_spec)?\s*(FUNCTION)\s+($name)\b/io) {
+    $type       = lc ($1);
+    $$unit_name = $2;
+
+    # Get arguments/keywords from SUBROUTINE/FUNCTION
+    if(/^[^\(]+\([^\)]+\)/) {
+      my $tstatm = $_;
+
+      # Remove trailing comment
+      $tstatm =~ s/\!.*\n/\n/g;
+
+      # Remove space characters
+      $tstatm =~ s/\s//g;
+
+      # Add the RESULT clause to the argument/keyword list
+      $tstatm =~ s/\)result\((\w+\))$/,$1/i if $type eq 'function';
+
+      # Remove the parenthesis around the argument list
+      $tstatm =~ s/.+\((.+)\)/$1/;
+
+      @$args = split (',', uc ($tstatm));
+
+      # For FUNCTION, add its name to the list if necessary
+      push @$args, uc ($$unit_name)
+        if $type eq 'function' and not grep {$_ eq uc ($$unit_name)} @$args;
+    }
+  }
+
+  return $type;
+}
+
+#==========================================================================
+
+sub setup_parse {
+  # Set up some "global" variables that helps with parsing statements
+
+  # Pattern for nested parenthesis
+  our $nest_par;
+  $nest_par = qr/\((?:(?>[^()]+)|(??{$nest_par}))*\)/; #Camel p214
+
+  # Patterns for variable name and natural digit
+  our $name='[a-zA-Z]\w*';
+  our $digit_string='\d+';
+  our $type_name=$name;
+
+  # Patterns for specification
+  our $specification_expr='(?:'.$name.'|'.$digit_string.')'; # Simplification
+  our $type_param_value='(?:\*|'.$specification_expr.')';
+
+  # Patterns for length/kind attributes
+  our $char_selector='LEN *= *'.$type_param_value; # Simplification
+  our $kind_selector='\( *KIND *= *'.$name.' *\)';    # Simplification
+
+  # Pattern for type specification
+  our $type_spec='INTEGER *(?:'.$kind_selector.')?|REAL *(?:'.$kind_selector.
+    ')?|DOUBLE PRECISION|COMPLEX *(?:'.$kind_selector.')?|CHARACTER *'.
+    $char_selector.'|LOGICAL *(?:'.$kind_selector.')?|TYPE\s*\(\s*'.$type_name.
+    '\s*\)';
+
+  # Pattern for function/subroutine attribute
+  our $attribute = 'ELEMENTAL|(?:RECURSIVE(?:\s+PURE)?|PURE(?:\s+RECURSIVE)?)';
+
+  return;
+}
+
+#==========================================================================
+
+sub f90_indent {
+# Indent free-format F90 program to our standards
+  my($line_hash,$lines)=@_;
+  my($delta)='  '; 
+  my($cur_indent)='';
+  @$lines=();
+  foreach my $href (@$line_hash) {
+    $_=$href->{line};
+    if($href->{content} eq 'comment') {
+      push(@$lines,$_);
+      next;
+    }
+    s/^ *//; # Remove current indentation
+    my($post_chg)=0;
+    my($pre_chg)=0;
+    my($cont_line)='';
+    exit if (! exists $href->{content});
+    if($href->{content} eq 'DO') {
+      $post_chg=1 unless /^DO\s+\d/;
+    }
+    elsif($href->{content} eq 'ENDDO') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'IF_construct') {
+      $post_chg=1;
+    }
+    elsif($href->{content} eq 'ELSEIF') {
+      $post_chg=1;
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ELSE') {
+      $post_chg=1;
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ENDIF') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ENDIF') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'WHERE_construct') {
+      $post_chg=1;
+    }
+    elsif($href->{content} eq 'ELSEWHERE') {
+      $post_chg=1;
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ENDWHERE') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'ENDIF') {
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'SELECT CASE') {
+      $post_chg=1;
+    }
+    elsif($href->{content} eq 'CASE') {
+      $post_chg=1;
+      $pre_chg=1;
+    }
+    elsif($href->{content} eq 'END SELECT') {
+      $pre_chg=1;
+    }
+    $cont_line=' ' if($href->{content} eq 'cont_line');
+    if( $pre_chg ) {
+      unless($cur_indent=~s/^$delta//o) {
+	print STDERR $_;
+	die  "f90_indent: something wrong, indent negative\n";;
+      }
+    }
+#    print "$cur_indent$cont_line$_";
+    
+    $_=$cur_indent.$cont_line.$_;
+    push(@$lines,$_);
+    $cur_indent.=$delta if( $post_chg );
+  }
+
+  if(! ($cur_indent eq '')) {
+    die "f90_indent: something wrong, indent=XX${cur_indent}XX\n";
+  }
+}
+
+#==========================================================================
+
+sub tidy {
+# Straigthforward tidiyng of statements
+  my($statements) = @_;
+  my($href,$content);
+  foreach $href (@$statements) {
+    $_=$href->{statement};
+    $content=$href->{content};
+# Substitute tab with four blanks
+    s/\t/    /g;
+    if($content eq 'comment') {
+# Substitute empty comment line with empty line
+      s/^[!] *\n$/\n/;
+      $href->{statement}=$_;
+      next;
+    }
+    if($href->{exec}) {
+      if($content eq 'ENDDO') {
+	s/\bEND DO\b/ENDDO/i;
+	$href->{statement}=$_;
+	next;
+      }
+      if($content eq 'ENDIF') {
+	s/\bEND IF\b/ENDIF/i;
+	$href->{statement}=$_;
+	next;
+      }
+      if($content eq 'ENDWHERE') {
+	s/\bEND WHERE\b/ENDWHERE/i;
+	$href->{statement}=$_;
+	next;
+      }
+
+      s/\bELSE IF\b/ELSEIF/i  if($content eq 'ELSEIF');
+
+      if(/\./) {
+	s/ *\.EQ\. */ == /gi;
+	s/ *\.NE\. */ \/= /gi;
+	s/ *\.LT\. */ < /gi;
+	s/ *\.LE\. */ <= /gi;
+	s/ *\.GT\. */ > /gi;
+	s/ *\.GE\. */ >= /gi;
+      }
+
+#
+      s/\bA?MAX[01]\b/MAX/gi;
+      s/\bA?MIN[01]\b/MIN/gi;
+      s/\bAMOD\b/MOD/gi;
+      s/\bALOG\b/LOG/gi;
+      s/\bALOG10\b/LOG10/gi;
+#      s/\bI(SIGN *\()/$1/gi; # Goes wrong in larcinad etc.
+      s/\bFLOAT\b/REAL/g;
+      s/\bfloat\b/real/g;
+    }
+    
+    $href->{statement}=$_;
+  }
+}
+
+#==========================================================================
+
+sub process_include_files {
+# Read include files and put reference to the anonomys array
+# holding the array of "statement" hashes in $href->{inc_statm}
+  my($statements,$prog_info,$inc_statements) = @_;
+  my ($content,$fname,$href);
+  return unless ($$prog_info{has_include});
+  my @lines=();
+  foreach $href (@$statements) {
+    $content=$href->{content};
+    if($content eq 'include'){
+      $_=$href->{statement};
+      /["](\S+)["]/;
+      $fname=$1;
+      &get_inc_lines($fname,\@lines);
+# Macro-removal
+      &remove_macro(\@lines);
+# Expand lines into statements and put refernce to this
+# array of hashes into $href->{inc_statm}
+      my @inc_statms=();
+      my $dum={};
+      &expcont(\@lines,\@inc_statms);
+      $href->{inc_statm}=[@inc_statms];
+      my $incs=$href->{inc_statm};
+# Study the read in file and add more attributes
+      &study($incs);
+#      print Dumper($incs,$dum);
+      
+    }
+  }
+}
+#==========================================================================
+sub get_inc_lines{
+# Recurcivly get lines from include files, flatten into array of lines
+  my ($fname,$lines) = @_;
+  my ($VPATH,@vpath,@tmp_lines);
+
+  $VPATH=$ENV{VPATH} or die "VPATH not defined ";
+# IFS VPATH /tmp/27/ifs/function:/tmp/27/ifs/common:/tmp/27/ifs/interface:/tmp/27/ifs/namelist:/tmp/27/ifsaux/include:/tmp/27/trans/interface:/tmp/27/obsort/interface:/tmp/27/ifs/ald_inc/function:/tmp/27/ifs/ald_inc/interface:/tmp/27/ifs/ald_inc/namelist
+  @vpath=split(":",$VPATH);
+# Look for include file in VPATH
+  foreach my $path (@vpath) {
+    my $ffname=$path.'/'.$fname;
+    if( -f $ffname) {
+# Read lines from include file
+      @tmp_lines = &readfile($ffname);
+#      print "$ffname \n";
+      for (@tmp_lines) {
+	if(/^\#include\b/){
+	  /["](\S+)["]/;
+	  my $fname2=$1;
+	  &get_inc_lines($fname2,$lines);
+	}
+	else {
+	  push(@$lines,$_);
+	}
+      }
+      last;
+    }
+  }
+  die "Include file $fname not found in VPATH=$VPATH " unless(@$lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &create_interface_block (\@statements, \@interface_block);
+#
+# DESCRIPTION
+#   This function analyses the Fortran statements in \@statements and returns
+#   an interface block in \@interface_block.
+# ------------------------------------------------------------------------------
+
+sub create_interface_block {
+  # Create a "minimal" interface block for subroutines
+  my  ($statements, $interface_block) = @_;
+  my  (%pu_args, %tokens);
+  our ($name, $nest_par);
+
+  @$interface_block = ();
+
+  my @tokens_in_lines = (); # List of tokens in each line
+
+  # Gather information needed to create interface block for routine
+  for my $href (@$statements) {
+    last if $href->{exec}; # exit loop at beginning of executable statements
+
+    # Get arguments of subroutine or function
+    if ($href->{content} eq 'SUBROUTINE' or $href->{content} eq 'FUNCTION') {
+      my $func;
+      my @pu_args;
+      $_ = $href->{statement};
+      &parse_prog_unit (\$func, \@pu_args);
+      $pu_args{uc ($_)} = 1 for @pu_args;
+      next;
+    }
+
+    # Get tokens from lines where arguments are present
+    # Inspect only type declaration statements
+    next unless $href->{decl} == 2;
+
+    my $statement = uc $href->{statement};
+    $statement =~ s/!.*$//; # Remove trailing comment
+
+    my @line_tokens = ();
+    if ($statement =~ s/^(.*?):://) {
+      # New style declaration statement contains "::"
+
+      # Tokens in specification part
+      my $spec = $1;
+      my @tokens = ($spec =~ /\b$name\b/g);
+      shift @tokens; # Remove leading token
+
+      for (@tokens) {
+        push @line_tokens, $_
+          unless /^(?:KIND|LEN|ALLOCATABLE|POINTER|TARGET|DIMENSION|OPTIONAL|
+                  SAVE|INTENT|IN|OUT|INOUT|PARAMETER)$/x;
+      }
+
+      # Tokens in declaration part
+      push @line_tokens, ($statement =~ /\b$name\b/g);
+
+    } else {
+      # Old style declaration statement does not contain "::"
+      @line_tokens = ($statement =~ /\b$name\b/g);
+      shift @line_tokens; # Remove leading token
+    }
+
+    push @tokens_in_lines, \@line_tokens;
+
+    # Check whether each token matches an argument
+    for my $token (@line_tokens) {
+      if (exists $pu_args{$token}) {
+        $tokens{$_} = 1 for @line_tokens;
+        last;
+      }
+    }
+  }
+
+  # Parse statements one more time to ensure all required tokens are included
+  for (@tokens_in_lines) {
+    my @line_tokens = @{ $_ };
+
+    # Check whether line contains an essential token
+    for my $token (@line_tokens) {
+      if (exists $tokens{$token}) {
+        $tokens{$_} = 1 for @line_tokens;
+        last;
+      }
+    }
+  }
+
+  # Create the interface block
+  for my $href (@$statements) {
+    my %myhref  = %$href;
+    my $content = $myhref{content};
+
+    # Ignore comment, executable statements and items in CONTAINS block
+    next if $content eq 'comment';
+    next if $myhref{exec};
+    next if $myhref{in_contain};
+
+    # Delete existing pre- and post -inserts
+    delete $myhref{pre_insert}  if exists $myhref{pre_insert};
+    delete $myhref{post_insert} if exists $myhref{post_insert};
+
+    # Put SUBROUTINE/FUNCTION statement into interface block
+    if ($content =~ /^(?:SUBROUTINE|FUNCTION)$/) {
+      $myhref{pre_insert} = 'INTERFACE' . "\n"; # Insert INTERFACE statement
+      push @$interface_block, \%myhref;
+    }
+
+    # Add USE statement in interface block, if necessary
+    if($myhref{decl} == 4) {
+      $_ = uc $myhref{statement};
+      tr/ \n//d;
+
+      if(/^USE$name,ONLY:(.+)$/) {
+        # USE statement with ONLY, check token to see if it is necessary
+	my @line_tokens = /\b$name\b/g;
+
+	for (@line_tokens) {
+	  if (exists $tokens{$_}) {
+	    push @$interface_block, \%myhref;
+	    last;
+	  }
+	}
+
+      } else {
+        # Always add USE statement without ONLY
+	push @$interface_block, \%myhref;
+      }  
+    }
+
+    if ($myhref{decl} == 1 or $myhref{decl} == 2) {
+      $_ = uc ($myhref{statement});
+      s/\s*!.*$//;
+
+      if ($content eq 'INTEGER' or $content eq 'PARAMETER') {
+        # INTEGER and PARAMETER may be used for dimensioning
+	my @line_tokens = /\b$name\b/g;
+
+	for (@line_tokens) {
+	  if (exists $tokens{$_}) {
+	    push @$interface_block, \%myhref;
+	    last;
+	  }
+	}
+      } else {
+        # Add line only if an argument is present
+	s/$nest_par//g;
+	my @line_tokens = /\b$name\b/g;
+
+	for (@line_tokens) {
+	  if (exists $pu_args{$_}) {
+	    push @$interface_block, \%myhref;
+	    last;
+	  }
+	}
+      }
+    }
+
+    # Add END statement to interface block
+    if ($content =~ /^END\s+(?:SUBROUTINE|FUNCTION)/) {
+      $myhref{post_insert} = 'END INTERFACE' . "\n";
+      push @$interface_block, \%myhref;
+    }
+  }
+
+  # Beautify the interface block
+  for my $href (@$interface_block) {
+    $_ = $href->{statement};
+
+    s/\!.*\n/\n/g; # Remove trailing comments
+    s/ +/ /g;      # Only one space
+    s/\n *\n/\n/g; # Remove empty lines
+    s/\n *\n/\n/g; # Remove empty lines again
+    s/ +\n/\n/g;   # No trailing spaces
+
+    $href->{statement} = $_;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub change_var_names{
+  my($statements) = @_;
+  foreach my $href (@$statements) {
+    $_=$href->{statement};
+    s/\bVAZX\b/YVAZX/ig;
+    s/\bPVAZX\b/YDVAZX/ig;
+    s/\bVAZG\b/YVAZG/ig;
+    s/\bPVAZG\b/YDVAZG/ig;
+    s/\bSCALP_DV\b/YSCALP/ig;
+    s/\bRSCALP_DV\b/YRSCALP/ig;
+    s/\bSCALPSQRT_DV\b/YSCALPSQRT/ig;
+    s/\bRSCALPSQRT_DV\b/YRSCALPSQRT/ig;
+    s/\bPYBAR\b/YDYBAR/ig;
+    s/\bPSBAR\b/YDSBAR/ig;
+    s/\bVCGLPC\b/YVCGLPC/ig;
+    s/\bVCGLEV\b/YVCGLEV/ig;
+    s/\bSKFROT\b/YSKFROT/ig;
+    s/\bSKFMAT\b/YSKFMAT/ig;
+    s/\bSTATE_VECTOR_4D\b/YSTATE_VECTOR_4D/ig;
+    s/\bVAZX0\b/YVAZX0/ig;
+    s/\bVAZG0\b/YVAZG0/ig;
+    s/\bRSPFORCE\b/YSPFORCE/ig;
+    $href->{statement}=$_;
+  }
+}
+# =========================================================================
+sub remake_arg_decl{
+  my($statements,$prog_info) = @_;
+  my($href,$content,@pu_args,$func,%tokens);
+  my($left,$right,%arghash,$dim);
+  our($nest_par,$name);
+
+  my $dims='';
+# Crack existing dummy declarations, build hash arghash
+  foreach $href (@$statements) {
+    last if($href->{prog_unit} >0);
+    if($href->{content} eq 'SUBROUTINE') {   # Get arguments of subroutine
+      $_=$href->{statement};
+      my $dum=&parse_prog_unit(\$func,\@pu_args);
+#      print Dumper(\@pu_args);
+      for(@pu_args) {
+	$_=uc($_);
+	$arghash{$_}{other}='';
+	$arghash{$_}{dimuse}=0;
+	$arghash{$_}{intent}='';
+	$arghash{$_}{used}=0;
+	$arghash{$_}{set}=0;
+	$arghash{$_}{reallyset}=0;
+	$arghash{$_}{type}='';
+	$arghash{$_}{comment}='';
+	$arghash{$_}{inif}=0;
+      }
+      next;
+    }
+    if($href->{decl} == 2) {
+      $_=$href->{statement};
+      my $comment='';
+      $comment=$1 if(/.*(\!.*)$/);
+      s/\!.*\n/\n/g;                        # Remove trailing comments in all lines
+      $_=uc($_);
+      s/\s//g;
+      if(/^(.+)::(.+)$/){
+	$left=$1;
+	$right=$2;
+	$_=$right;
+	s/$nest_par//g;
+	s/($name)\*\w+/$1/g;
+#	print "XX  $_ \n";
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/) {
+#	    print "ARG $arg $left $_ \n";
+	    $arghash{$arg}{linedec}=$href->{number};
+	    $arghash{$arg}{comment}=$comment;
+	    my @locdec =split ',',$left;
+	    my $i=0;
+	    foreach my $locdec (@locdec) {
+	      if($i == 0) {
+		$arghash{$arg}{type}=$locdec;
+	      }
+	      elsif($locdec=~/\bINTENT/) {
+		$arghash{$arg}{intent}=','.$locdec;
+	      }
+	      else {
+		$arghash{$arg}{other}=$arghash{$arg}{other}.','.$locdec;
+	      }
+	      $i++;
+	    }
+	    if($right=~/\b$arg\b(\*\w+)/) {
+	      $dim=$1;
+	    }
+	    elsif($right=~/\b$arg\b($nest_par\*$nest_par)/) {
+	      $dim=$1;
+	    }
+	    elsif($right=~/\b$arg\b($nest_par\*\w+)/) {
+	      $dim=$1;
+	    }
+	    elsif($right=~/\b$arg\b(\*$nest_par)/) {
+	      $dim=$1;
+	    }
+	    elsif($right=~/\b$arg\b($nest_par)/) {
+	      $dim=$1;
+	    }
+	    else {
+	      $dim='';
+	    }
+	    $arghash{$arg}{dim}=$dim;
+	    $dims=$dims.$dim
+	      }
+	}
+	foreach my $arg (@pu_args) {  # Is arg. used for dimensioning other args?
+	  if($dims=~/\b$arg\b/i) {
+	    $arghash{$arg}{dimuse}=1;
+	  }
+	}  
+      }
+    }
+  }
+  my $insert_line=0;
+  foreach $href (@$statements) {
+    last if($href->{prog_unit} >0);
+    if($href->{decl} == 2 or $href->{content} eq 'PARAMETER') {                 
+      $_=uc($href->{statement});
+      next unless /\bPARAMETER\b/;
+      my @tmpvar=/\b$name\b/g;
+      foreach my $token (@tmpvar) {
+	if($dims=~/\b$token\b/) {
+	  $insert_line=$href->{number};
+	}
+      }
+    }
+  }
+      
+# Gather info to decide INTENT status
+  my $inif=0;
+  my @inif_stack=();
+  my $cur_inif=0;
+  foreach $href (@$statements) {
+    last if($href->{prog_unit} >0);
+    if($href->{exec}) {
+      if($href->{content} eq 'ENDIF') {
+	$inif--;
+	$cur_inif=pop @inif_stack;
+	next;
+      }
+      elsif($href->{content} eq 'ELSEIF' or $href->{content} eq 'ELSE') {
+	$cur_inif=pop @inif_stack;
+	$cur_inif=$href->{number};
+	push @inif_stack,$cur_inif;
+      }
+      my ($left,$right);
+      $_=$href->{statement};
+      s/\!.*\n/\n/g;                        # Remove trailing comments in all lines
+      my %setnow=();
+      foreach my $arg (@pu_args) {
+	$setnow{$arg}=0;
+	$setnow{$arg}=1 if($arghash{$arg}{reallyset});
+	unless ($setnow{$arg}) {
+	  foreach my $xx (@inif_stack) {
+	    $setnow{$arg}=1 if($xx == $arghash{$arg}{inif});
+	  }
+	}
+      }
+      
+      if($href->{content} eq 'scal_assign' or $href->{content} eq 'array_assign') {
+	s/\s//g;
+	($left,$right)=/^(.+)=(.+)$/;
+	$_=$right;
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/i) {
+	    $arghash{$arg}{used}=1 unless $setnow{$arg};
+	  }
+	}
+	$_=$left;
+	if(/($nest_par)/) {
+	  $_=$1;
+	  foreach my $arg (@pu_args) {
+	    if(/\b$arg\b/i) {
+	      $arghash{$arg}{used}=1 unless $setnow{$arg};
+	    }
+	  }
+	}
+	$_=$left;
+	foreach my $arg (@pu_args) {
+	  if(/^$arg\b/i) {
+	    $arghash{$arg}{set}=1;
+	    $arghash{$arg}{inif}=$cur_inif;
+	    $arghash{$arg}{reallyset}=1 unless($inif);
+	  }
+	}
+      }
+      elsif($href->{content} eq 'IF' ) {
+	if($href->{content2} eq 'scal_assign' or $href->{content2} eq 'array_assign' or 
+	   $href->{content2} eq 'CALL') {
+	  s/\n//g;
+	  ($left,$right)=/^\s*(IF\b\s*$nest_par)(.+)/i;
+	  $_=$left;
+	  foreach my $arg (@pu_args) {
+	    if(/\b$arg\b/i) {
+	      $arghash{$arg}{used}=1 unless $setnow{$arg};
+	    }
+	  }
+	  $_=$right;
+	  if($href->{content2} eq 'CALL') {
+	    my $statement=$right;
+	    my $inifx=1;
+	    &propag_arg(\$statement,\%arghash,\$inifx,\%setnow);
+	  }
+	  else {
+	    s/\s//g;
+	    ($left,$right)=/^(.+)=(.+)$/;
+	    $_=$right;
+	    foreach my $arg (@pu_args) {
+	      if(/\b$arg\b/i) {
+		$arghash{$arg}{used}=1 unless $setnow{$arg};
+	      }
+	    }
+	    $_=$left;
+	    if(/($nest_par)/) {
+	      $_=$1;
+	      foreach my $arg (@pu_args) {
+		if(/\b$arg\b/i) {
+		  $arghash{$arg}{used}=1 unless $setnow{$arg};
+		}
+	      }
+	    }
+	    $_=$left;
+	    foreach my $arg (@pu_args) {
+	      if(/^$arg\b/i) {
+		$arghash{$arg}{inif}=$cur_inif;
+		$arghash{$arg}{set}=1;
+	      }
+	    }
+	  }
+	}
+	else {
+	  foreach my $arg (@pu_args) {
+	    if(/\b$arg\b/i) {
+	      $arghash{$arg}{used}=1 unless $setnow{$arg};
+	    }
+	  }
+	}
+      }
+      elsif($href->{content} eq 'WHERE' ) {
+	s/\s//g;
+	($left,$right)=/^(WHERE$nest_par)(.+)/i;
+	$_=$left;
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/i) {
+	    $arghash{$arg}{used}=1 unless $setnow{$arg};
+	  }
+	}
+	$_=$right;
+	($left,$right)=/^(.+)=(.+)$/;
+	$_=$right;
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/i) {
+	    $arghash{$arg}{used}=1 unless $setnow{$arg};
+	  }
+	}
+	$_=$left;
+	foreach my $arg (@pu_args) {
+	  if(/^$arg\b/i) {
+	    $arghash{$arg}{inif}=$cur_inif;
+	    $arghash{$arg}{set}=1;
+	  }
+	}
+      }
+      elsif($href->{content} eq 'CALL') {
+	my $statement=$_;
+	&propag_arg(\$statement,\%arghash,\$inif);
+      }
+      else{
+	foreach my $arg (@pu_args) {
+	  if(/\b$arg\b/i) {
+	    $arghash{$arg}{used}=1 unless $setnow{$arg};
+	  }
+	}
+      }
+      if($href->{content} eq 'IF_construct') {
+	$inif++;
+	$cur_inif=$href->{number};
+	push @inif_stack,$cur_inif;
+      }
+    }	  
+  }
+
+# Create INTENT statemant based on gathered info
+  foreach my $arg (@pu_args) {
+    if($arghash{$arg}{linedec}) {
+      if($arghash{$arg}{nointent}) {
+	unless($arghash{$arg}{intent}) {
+	  $arghash{$arg}{intent}=' ';
+	  $arghash{$arg}{comment}='! UNDETERMINED INTENT';
+	}
+      }
+      else{
+	my $intent='';
+	$intent='IN' if($arghash{$arg}{used} or $arghash{$arg}{dimuse});
+	$intent=$intent.'OUT' if($arghash{$arg}{set});
+	if($intent) {
+	  if($arghash{$arg}{intent} and $intent eq 'OUT') {
+	    $intent='INOUT' if $arghash{$arg}{intent}=~/INOUT/i;
+	  }
+	  $arghash{$arg}{intent}=',INTENT('.$intent.')';
+	}
+	else {
+	  $arghash{$arg}{intent}=' ';
+	  $arghash{$arg}{comment}='! Argument NOT used';
+	}
+      }
+    }
+  }
+
+# Remove existing argument declarations
+  foreach my $arg (@pu_args) {
+    if($arghash{$arg}{linedec}) {
+      $_=$$statements[$arghash{$arg}{linedec}]->{statement};
+      #   print "BEFORE $arg $_";
+      if(/.*::\s*\b$arg\b\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*$nest_par\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*\*\s*\w+\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*\*\s*$nest_par\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*$nest_par\s*\*\s*\w+\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      elsif(/.*::\s*\b$arg\b\s*$nest_par\s*\*\s*$nest_par\s*(\!.*\n)*$/i) {
+	$_='';
+      }
+      else{
+	/^(.*::)(.*)$/s;
+	my $left=$1;
+	$_=$2;
+	s/\b$arg\b\s*$nest_par//i;
+	s/\b$arg\b\s*\*\s*\w+//i;
+	s/\b$arg\b\s*\*\s*$nest_par//i;
+	s/\b$arg\b//i;
+	s/,\s*,/,/;
+	s/,(\s*)$/$1/;
+	s/\n\s*\n/\n/g;
+	$_=$left.$_;
+	s/::\s*,/::/;
+      }
+ #   print "AFTER $arg $_\n";
+      $$statements[$arghash{$arg}{linedec}]->{statement}=$_; 
+    }
+  }
+
+ # Write out
+
+  my $newdecl='';
+  my $linedec;
+  foreach my $arg (@pu_args) {
+    if($arghash{$arg}{linedec}) {
+      if($arghash{$arg}{other} and ! $arghash{$arg}{dim}) {
+	$arghash{$arg}{other}=~s/\s//g;
+	if($arghash{$arg}{other}=~/^,DIMENSION($nest_par)$/i) {
+	  $arghash{$arg}{other}='';
+	  $arghash{$arg}{dim}=$1;
+	}
+      }
+      if($arghash{$arg}{dimuse}) { # Put declerations of args first
+	$linedec=sprintf "%-18s%s%-14s%s%s%s%s %s",
+	$arghash{$arg}{type},$arghash{$arg}{other},$arghash{$arg}{intent},
+	    ' :: ',$arg,$arghash{$arg}{dim},$arghash{$arg}{comment},"\n";
+	$newdecl=$newdecl.$linedec;
+      }
+    }
+  }
+  foreach my $arg (@pu_args) {
+    if($arghash{$arg}{linedec}) {
+      unless($arghash{$arg}{dimuse}) {
+	$linedec=sprintf "%-18s%s%-14s%s%s%s %s%s",
+	$arghash{$arg}{type},$arghash{$arg}{other},$arghash{$arg}{intent},
+	    ' :: ',$arg,$arghash{$arg}{dim},$arghash{$arg}{comment},"\n";
+	$newdecl=$newdecl.$linedec;
+      }
+    }
+  }
+#  print "INSERT_LINE $insert_line \n";
+  if($insert_line) {
+    $$statements[$insert_line]->{post_insert}=$newdecl;
+  }
+  else{
+    foreach $href (@$statements) {
+      if($href->{decl} == 2) {                 
+	$href->{pre_insert}=$newdecl;
+	last;
+      }
+    }
+  }
+
+#  print $newdecl;
+#  print Dumper(\%arghash);
+}
+
+sub propag_arg{
+  my ($statement,$arghash,$inif,$setnow) = @_;
+  our ($name,$nest_par);
+  my (%argpos);
+  $_=$$statement;
+  s/^\s*CALL\s+($name)//i;
+  my $called=lc($1);
+  s/\s//g;
+  s/^\((.*)\)$/$1/s;
+  my @inpars=/$nest_par/g;
+  s/$nest_par//g;
+  s/($name)%$name/$1/g;
+  $_=uc($_);
+#  print "PROPAG $called $_ ££ @inpars \n";
+  my @call_args=split ',' , $_;
+  my $i=0;
+  my $interesting=0;
+  %argpos=();
+  foreach my $call (@call_args) {
+    
+#    print "CALL $called $call \n" ;
+    if($call=~/(.+)=(.+)/) {
+      $call=$2; #This just by-passes the problem
+    }
+    if(exists $$arghash{$call}) {
+      if(exists $argpos{$call}) {
+	push @{$argpos{$call}},$i;
+      }
+      else {
+	my @i=($i);
+	$argpos{$call}=[@i];
+      }
+      $interesting=1;
+    }
+    $i++;
+  }
+  if($interesting) {
+    my $fname='/tmp/intblocks/'.$called.'.intfb.h';
+    if( -f $fname ) {
+      my @dumargs=();
+      my $unit_name;
+      print "FILE $fname FOUND \n";
+      my @lines = &readfile($fname);
+      my @loc_statements=(); 
+      &expcont(\@lines,\@loc_statements);
+      foreach my $href (@loc_statements) {
+	$_=$href->{statement};
+	if(/^\s*SUBROUTINE/i) {
+	  my $dum=&parse_prog_unit(\$unit_name,\@dumargs);
+	  next;
+	}
+	if(/::/) {
+	  s/\s//g;
+	  foreach my $arg (keys (%argpos)) {
+	    my $set_before=$$setnow{$arg};
+	    foreach my $i (@{$argpos{$arg}}){
+	      if(/::$dumargs[$i]/) {
+		if(/INTENT\(IN\)/i) {
+		  $$arghash{$arg}{used}=1 unless $set_before;
+		}
+		elsif(/INTENT\(OUT\)/i) {
+		  $$arghash{$arg}{set}=1;
+		  $$setnow{$arg}=1 unless($$inif);
+		}
+		elsif(/INTENT\(INOUT\)/i) {
+		  $$arghash{$arg}{set}=1;
+		  $$arghash{$arg}{used}=1 unless $set_before;;
+		  $$arghash{$arg}{reallyset}=1 unless($$inif);
+		}
+		elsif(/\! UNDETERMINED INTENT/) {
+		  $$arghash{$arg}{nointent}=1;
+		}
+	      }
+	    }
+	  }
+	}
+      }
+    }
+    else {
+      foreach my $arg (keys (%argpos)) {
+	$$arghash{$arg}{nointent}=1;
+      }
+    }
+  }
+  for (@inpars) {
+    foreach my $arg (keys (%$arghash)) {
+      if(exists $$arghash{$arg}) {
+	if(/\b$arg\b/i) {
+	  $$arghash{$arg}{used}=1 unless $$setnow{$arg};
+	}
+      }
+    }
+  }
+}
+  
+sub add_interface_blocks {
+# Add interface block for called routines
+  use File::Find;
+  my($statements,$prog_info) = @_;
+  my($href,$call);
+  our($name,$nest_par);
+  our(@call_names,@call_names_found,%call_names);
+
+  return unless ($$prog_info{no_calls}); # Skip if there are no calls
+  @call_names=();
+  %call_names=();
+
+  my $last_decl=0;
+  my $in_intfblk=0;
+  my %already_in=();
+  ST:foreach $href (@$statements) {
+    last if($href->{prog_unit} > 0);  # Only consider first program unit (no contains)
+    if($href->{content} eq 'INTERFACE') {
+      $in_intfblk=1;
+      next;
+    }
+    if($href->{content} eq 'END INTERFACE') {
+      $in_intfblk=0;
+      next;
+    }
+    if($in_intfblk) {
+      $_=$href->{statement};
+      s/\#include\s*\"(\w+)\.h\"\s*$/$1/;
+      $_=lc($_);
+      $already_in{$_}++;
+      next;
+    }
+    
+# Find last declaration
+    if($href->{decl}) {
+      next if($href->{content} eq 'FORMAT');
+      next if($href->{content} eq 'DATA');
+      $last_decl = $href->{number} ;
+    }
+# Find calls
+    next unless($href->{exec});
+    if($href->{content} eq 'CALL' or 
+       (exists  $href->{content2} and$ href->{content2} eq 'CALL') ) {
+      $_=$href->{statement};
+      /\s*\bCALL\b\s*($name)/i;
+      my $call=lc($1);
+      next if($already_in{$call}); # Exclude already existing interface block
+      next if($call eq 'packmsg'); # A couple of special exceptions
+      next if($call eq 'unpkmsg');
+      $call_names{$call}++;
+    }
+  }
+  
+
+# Check that routine exists in IFS
+  @call_names_found=();
+  find(\&calls_wanted,'/tmp/27/ifs/');
+#  find(\&calls_wanted,'/home/mats/work/cy28/ifs/');
+#  find(\&calls_wanted,'/tmp/27/trans/');
+  @call_names_found=sort(@call_names_found);
+#  print "P2 @call_names_found \n";
+  @call_names=@call_names_found;
+
+# Contruct include block
+  my $block='';
+  for (@call_names) {
+    $block=$block.'#include "'.$_.'.intfb.h"'."\n";
+  }
+#  print $block;
+
+  my $clean=0;
+  if(@call_names) {
+    if($$prog_info{has_interface_block}) {
+      foreach $href (@$statements) {
+# Add interface block to routine that already has INTERFACE statement
+	if($href->{content} eq 'END INTERFACE'){
+	  if($href->{post_insert}) {
+	    $href->{post_insert}=$href->{post_insert}."\n".$block;
+	  }
+	  else {
+	    $href->{post_insert}="\n".$block;
+	  }	    
+	  last;
+	}
+      }
+    }
+# Add interface block to routine that does not have previous INTERFACE statement
+    else {
+      $href=@$statements[$last_decl];
+      if($href->{post_insert}) {
+	$href->{post_insert}=$href->{post_insert}."\n".$block;
+      }
+      else {
+	$href->{post_insert}="\n".$block;
+      }	    
+    }
+# Remove from EXTERNAL statement where interface block has been added
+    foreach $href (@$statements) {
+      if($href->{content} eq 'EXTERNAL') {
+	$_=$href->{statement};
+	foreach my $ext (@call_names) {
+	  s/\b$ext\b//i;
+	}
+	s/,\s*,/,/g;
+	s/^(\s*EXTERNAL\s*),/$1/i;
+	s/^(\s*EXTERNAL.*),\s*$/$1/i;
+	s/^\s*EXTERNAL\s*,*\s*$//i;
+	$href->{statement}=$_;	
+      }
+    }
+  }
+}
+#======================================================================================
+sub calls_wanted {
+  # Used by Find as called from add_interface_blocks
+  our(%call_names,@call_names_found);
+  return unless (/^(\w+)\.F90$/);
+  my $call=$1;
+  if($call_names{$call}) {
+    push(@call_names_found,$call);
+  }    
+}
+sub remove_some_comments{
+  my($statements) = @_;
+  my $prev_empty=0;
+  foreach my $href (@$statements) {
+    if($href->{content} eq 'comment'){
+      $_=$href->{statement};
+      if(/^\s*$/) {
+	if($prev_empty) {
+	  s/\s*//;
+	  $href->{statement}=$_;
+	}
+	else {
+	  $prev_empty=1;
+	} 
+	next;
+      }
+      $prev_empty=0;
+      s/^\s*![\s\*]*\bLOCAL\s+(INTEGER|REAL|LOGICAL|CHARACTER)\s+(SCALARS|ARRAYS).*\n$//i;
+      s/^\s*![\s\*]*\bDUMMY\s+(INTEGER|REAL|LOGICAL|CHARACTER)\s+(SCALARS|ARRAYS).*\n$//i;
+      s/^\s*![\s\*]*\bLOCAL\s+(INTEGER|REAL|LOGICAL|CHARACTER).*\n$//i;
+      s/^\s*![\s\*]*\bDUMMY\b\s*$//i;
+      s/^\s*![\s\*]*\bLOCAL\b\s*$//i;
+      s/^\s*![\s\*]*\bLOCAL\b:\s*$//i;
+      s/^\s*![\s\*]*\bLOCAL ARRAYS\b[\s\*]*$//i;
+      s/^\s*![\s\*]*\bLOCAL SCALARS\b\s*$//i;
+      s/^\s*![\s\*]*\s*\d\.\d+\s*\bLOCAL ARRAYS\b\s*$//i;
+      s/^\s*![\s\*]*\s*=== LOCAL ARRAYS ===\s*$//i;
+      $href->{statement}=$_;
+    }
+    else {
+      $prev_empty=0;
+    }
+  }
+}      
+sub get_calls_inc {
+  my($statements,$calls,$intfb) = @_;
+  foreach my $href (@$statements) {
+    if($href->{content} eq 'CALL') {
+      $_=$href->{statement};
+      /^\s*CALL\s+([A-Z]\w*)/i;
+      $$calls{lc($1)}++;
+    }
+    elsif($href->{content} eq 'IF') {
+      if($href->{content2} eq 'CALL') {
+	$_=$href->{statement};
+	/\bCALL\s+([A-Z]\w*)/i;
+	$$calls{lc($1)}++;
+      }
+    }
+    elsif($href->{content} eq 'include') {
+      $_=$href->{statement};
+      $$intfb{$1}=1 if(/["](\S+)\.intfb\.h["]/);
+      $$intfb{$1}=2 if(/["](\S+)\.h["]/); # For old-style interface blocks
+    }
+  }
+}
+
+1;
+      
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Build.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Build.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Build.pm	(revision 5166)
@@ -0,0 +1,2428 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Build
+#
+# DESCRIPTION
+#   The main purpose of this class is to process the build configuration,
+#   generate the required files for the build and invoke make to create the
+#   build.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Build;
+
+# Standard pragma
+use strict;
+use warnings;
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Path;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::CfgFile;
+use Fcm::SrcPackage;
+use Fcm::BuildTask;
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $bld = Fcm::Build->new (
+#     CONFIG  => $config,
+#     CFG_SRC => $cfg_src,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Build class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   CFG_SRC    - source path to the build configuration file
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $cfg    = exists $args{CFG_SRC} ? $args{CFG_SRC} : undef;
+  my $config = exists $args{CONFIG}  ? $args{CONFIG}  : &main::cfg;
+
+  my $self  = {
+    CONFIG   => $config,            # configuration settings
+    CFG      => Fcm::CfgFile->new ( # bld cfg
+      TYPE   => 'bld',              # config file type
+      SRC    => $cfg,               # source path of the bld cfg
+      CONFIG => $config,            # configuration settings
+    ),
+    NAME     => '',                 # name of this build
+    DIR      => {                   # directory tree of this build
+      ROOT    => '',                # root directory of this build
+    },
+    PATH     => {},                 # search paths of this build
+    SEARCH   => 1,                  # search for source directories in src/?
+    SRCDIR   => {},                 # source directories of this build
+    PP       => {},                 # pre-process flags
+    PACKAGE  => {},                 # source directory packages of this build
+    TARGET   => [],                 # targets of this build
+    USE      => [],                 # list of inherited builds
+    INHERIT  => {                   # inheritance flags
+      SRCDIR => 1,                  # inherit source directories?
+      PP     => 1,                  # inherit pre-process flags?
+      TARGET => 0,                  # inherit targets?
+    },
+    LIB      => {'' => ''},         # name of libraries
+    LOCK     => undef,              # lock file
+  };
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->DESTROY;
+#
+# DESCRIPTION
+#   This method is called automatically when a Fcm::Build object is
+#   destroyed.
+# ------------------------------------------------------------------------------
+
+sub DESTROY {
+  my $self = shift;
+
+  # Remove the lock if it is set
+  unlink $self->{LOCK} if $self->{LOCK} and -e $self->{LOCK};
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $bld->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile = $bld->cfg;
+#
+# DESCRIPTION
+#   This method returns a reference to a Fcm::CfgFile instance for the build
+#   configuration file.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  my $self = shift;
+
+  return $self->{CFG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %allpcks = $bld->allpcks ();
+#
+# DESCRIPTION
+#   This method returns a hash table with keys representing all the packages
+#   declared in the current build. The value of each element in the hash is a
+#   reference to a list of children of the current package.
+# ------------------------------------------------------------------------------
+
+sub allpcks {
+  my $self        = shift;
+  my %allpcks = ();
+
+  for my $pckname (keys %{ $self->{PACKAGE} }) {
+    $allpcks{$pckname} = [];
+  }
+
+  for my $pckname (keys %{ $self->{PACKAGE} }) {
+    my @names = split /__/, $pckname;
+
+    my $cur = $pckname;
+    while ($cur) {
+      pop @names;
+      my $depend = @names ? join '__', @names : '';
+      $allpcks{$depend} = [] unless exists $allpcks{$depend};
+
+      push @{ $allpcks{$depend} }, $cur
+        unless grep {$_ eq $cur} @{ $allpcks{$depend} };
+
+      $cur = $depend;
+    }
+  }
+
+  return %allpcks;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $bld->build (
+#     [ARCHIVE     => $archive,]
+#     [FULL        => $full,]
+#     [IGNORE_LOCK => $ignore_lock,]
+#     [JOBS        => $jobs,]
+#     [STAGE       => $stage,]
+#     [TARGETS     => \@targets,]
+#   );
+#
+# DESCRIPTION
+#   This method performs a build based on the current configuration. The
+#   method returns 1 on success.
+#
+# ARGUMENTS
+#   ARCHIVE      - If set to "true", invoke the "archive" mode. Most build files
+#                  and directories created by this build will be archived using
+#                  the "tar" command. If not set, the default is not to invoke
+#                  the "archive" mode.
+#   FULL         - If set to "true", invoke the build in "full" mode. Build files
+#                  and directories created by previous builds in the same
+#                  location will be removed before the current build is
+#                  performed. If not set, the default is to perform the build
+#                  in "incremental" mode.
+#   IGNORE_LOCK  - If set to "true", it ignores any lock files that may exist in
+#                  the build root directory. 
+#   JOBS         - Specify number of jobs that can be handled by "make". If set,
+#                  the value must be a natural integer. If not set, the default
+#                  value is 1 (i.e. run "make" in serial mode).
+#   STAGE        - If set, it should be an integer number or a recognised
+#                  keyword or abbreviation. If set, the build is performed up
+#                  to the named stage. If not set, the default is to perform
+#                  all stages of the build. Allowed values are:
+#                  1, setup or s
+#                  2, pre_process or pp
+#                  3, generate_dependency or gd
+#                  4, generate_interface or gi
+#                  5, all, a, make or m
+#   TARGETS      - Specify targets to be built. If set, these targets will be
+#                  built instead of the ones specified in the build
+#                  configuration file.
+# ------------------------------------------------------------------------------
+
+sub build {
+  my $self = shift;
+  my %args = @_;
+
+  # Process arguments
+  my $archive     = exists $args{ARCHIVE}     ? $args{ARCHIVE}     : 0;
+  my $full        = exists $args{FULL}        ? $args{FULL}        : 0;
+  my $ignore_lock = exists $args{IGNORE_LOCK} ? $args{IGNORE_LOCK} : 0;
+  my $jobs        = exists $args{JOBS}        ? $args{JOBS}        : 1;
+  my $stage       = exists $args{STAGE}       ? $args{STAGE}       : 5;
+  my $targets     = exists $args{TARGETS}     ? $args{TARGETS}     : [qw/all/];
+
+  # Resolve named stages
+  $stage = 5 unless $stage;
+  if ($stage !~ /^\d$/) {
+    my %stagenames = (
+      'S(?:ETUP)?'                      => 1,
+      'P(?:RE)?_?P(?:ROCESS)?'          => 2,
+      'G(?:ENERATE)?_?D(?:ENPENDENCY)?' => 3,
+      'G(?:ENERATE)?_?I(?:NTERFACE)?'   => 4,
+      '(?:A(?:LL)|M(?:AKE)?)'           => 5,
+    );
+
+    for my $name (keys %stagenames) {
+      if ($stage =~ /$name/i) {
+        $stage = $stagenames{$name};
+        last;
+      }
+    }
+
+    if ($stage !~ /^\d$/) {
+      w_report 'Warning: invalid build stage: ', $stage, ', default to "5"';
+      $stage = 5;
+    }
+  }
+
+  # Get verbose mode
+  my $verbose = $self->config->verbose;
+
+  # Stage 1: setup
+  my $date = localtime;
+  print 'Build command started on ', $date, '.', "\n" if $verbose;
+  my $otime = time;
+
+  print '->Setup              : start', "\n" if $verbose;
+  my $stime = time;
+
+  # Read configurations
+  my $rc = $self->decipher_cfg;
+
+  # Check directories are set
+  $rc = $self->check_dir if $rc;
+
+  # Check for lock files
+  $rc = $self->check_lock if $rc and not $ignore_lock;
+
+  # Set a lock file
+  $rc = $self->_set_lock if $rc;
+
+  # Create build root directory if necessary
+  $rc = $self->_create_build_dir if $rc;
+
+  # Set up directory inheritance
+  $rc = $self->_setup_dir (FULL => $full) if $rc;
+
+  # Set up source directories, targets, etc
+  $rc = $self->_update_bld_info if $rc;
+
+  # Set up PP flag cache
+  $rc = $self->_update_pp_info if $rc;
+
+  # Set up build tools cache
+  $rc = $self->_update_tool_info if $rc;
+
+  # Set up regenerate make rule cache
+  $rc = $self->_update_regen_rule_info if $rc;
+
+  my $ftime = time;
+  my $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+  print '->Setup              : ', $ftime - $stime, ' ', $s_str, "\n";
+
+  # Stage 2: Pre-process
+  if ($rc and $stage >= 2) {
+    print '->Pre-process        : start', "\n" if $verbose;
+    my $stime = time;
+
+    $rc = $self->_pre_process;
+
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Pre-process        : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  # Stage 3: Scan dependency and write make rules
+  if ($rc and $stage >= 3) {
+    print '->Scan dependency    : start', "\n" if $verbose;
+    my $stime = time;
+
+    $rc = $self->_scan_dependency;
+    $rc = $self->_write_make_rules if $rc;
+    $rc = $self->_write_makefile if $rc;
+
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Scan dependency    : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  # Stage 4: Generate Fortran 9x interface block
+  if ($rc and $stage >= 4) {
+    print '->Generate interface : start', "\n" if $verbose;
+    my $stime = time;
+
+    $rc = $self->_generate_f9x_interface;
+
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Generate interface : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  # Stage 5: Make the build
+  if ($rc and $stage >= 5) {
+    print '->Make               : start', "\n" if $verbose;
+    my $stime = time;
+
+    $rc = $self->_invoke_make (
+      TARGETS => $targets,
+      JOBS    => $jobs,
+      ARCHIVE => $archive,
+    );
+
+    # Remove empty build directories
+    $rc = $self->_remove_empty_dirs () if $rc;
+
+    # Create TAR archives if necessary
+    $rc = $self->_tar_build_dirs () if $rc and $archive;
+
+    # Create run time environment script if necessary
+    $rc = $self->_create_runenv_script () if $rc;
+
+    # Create exclude dependency configurations for libraries
+    $rc = $self->_create_lib_excl_dep () if $rc;
+
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Make               : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  if ($verbose) {
+    $s_str = $ftime - $otime > 1 ? 'seconds' : 'second';
+    print '->TOTAL              : ', $ftime - $otime, ' ', $s_str, "\n";
+  }
+
+  $date = localtime;
+  if ($rc) {
+    print 'Build command finished on ', $date, '.', "\n" if $verbose;
+
+  } else {
+    e_report 'Build command failed on ', $date, '.';
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $bld->decipher_cfg ();
+#
+# DESCRIPTION
+#   This method deciphers the build configuration file and assigns the
+#   configurations to the variables of the current build.
+# ------------------------------------------------------------------------------
+
+sub decipher_cfg {
+  my $self = shift;
+
+  my $read = $self->cfg->read_cfg;
+
+  # Check config file type
+  if ($read) {
+    if ($self->cfg->type ne 'bld') {
+      w_report 'Error: ', $self->cfg->src, ': not a build config file.';
+      return;
+    }
+
+  } else {
+    return;
+  }
+
+  my %cfg_label = %{ $self->config->setting ('CFG_LABEL') };
+  my %tools     = %{ $self->config->setting ('TOOL') };
+
+  # Get lines from cfg file
+  my @cfg_lines  = $self->cfg->lines;
+
+  LINE: for my $line (@cfg_lines) {
+    # Label and value of each line
+    my $label = $line->{LABEL};
+    my $value = $line->{VALUE};
+
+    next LINE unless $label; # ignore blank or comment line
+
+    # Strip out BLD prefix from all labels
+    my $prefix = $cfg_label{BDECLARE} . '::';
+    $label = substr ($label, length ($prefix))
+      if index (uc ($label), $prefix) == 0;
+
+    next LINE unless $label; # ignore blank or comment line
+
+    # Configuration file type/version, ignore
+    next LINE if uc $label eq $cfg_label{CFGFILE}{TYPE};
+    next LINE if uc $label eq $cfg_label{CFGFILE}{VERSION};
+
+    # User variable, ignore
+    next LINE if index (uc ($label), '%') == 0;
+
+    # Build name
+    if (uc $label eq $cfg_label{NAME}) {
+      $self->{NAME} = $value;
+      next LINE;
+    }
+
+    # Build directory tree
+    $prefix = $cfg_label{DIR} . '::';
+    if (index (uc ($label), $prefix) == 0) {
+      my $name = substr uc ($label), length ($prefix);
+      $self->{DIR}{$name} = expand_tilde $value;
+      next LINE;
+    }
+
+    # Source directory
+    $prefix = $cfg_label{SRCDIR} . '::';
+    if (index (uc ($label), $prefix) == 0) {
+      my $name = substr $label, length ($prefix);
+      $name    =~ s/::/__/g;
+      $self->{SRCDIR}{$name} = expand_tilde $value;
+      next LINE;
+    }
+
+    # Automatic source directory search?
+    if (uc $label eq $cfg_label{SEARCH_SRC}) {
+      $self->{SEARCH} = $value;
+      next LINE;
+    }
+
+    # Pre-process flag, directory/file requires pre-processing before all tasks
+    $prefix = $cfg_label{PP};
+    if (index (uc ($label), $prefix) == 0) {
+      my @flds = split /::/, $label;
+      my $name = uc shift @flds;
+      $name    = join '__', ($name, @flds) if @flds;
+      $self->{PP}{$name} = $value;
+      next LINE;
+    }
+
+    # Specify name of top level or package library
+    $prefix = $cfg_label{LIB};
+    if (index (uc ($label), $prefix) == 0) {
+      my @flds = split /::/, $label;
+      shift @flds;
+      my $name = @flds ? join ('__', @flds) : '';
+      $self->{LIB}{$name} = $value;
+
+      next LINE;
+    }
+
+    # Specify extra executable dependencies and BLOCKDATA dependency
+    for my $name (qw/EXE_DEP BLOCKDATA/) {
+      $prefix = $cfg_label{$name};
+
+      if (index (uc ($label), $prefix) == 0) {
+        my @flds = split /::/, $label;
+        shift @flds;
+        my $target = @flds ? $flds[0] : '';
+        my @deps   = split /\s+/, $value;
+
+        # If $value is a null string, set executable to depend on all objects
+        if (not @deps) {
+          if ($name eq 'BLOCKDATA') {
+
+            # Label not recognised
+            w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
+                     ': "', $label, '" declaration must have a value';
+            next LINE;
+
+          } else {
+            push @deps, '';
+          }
+        }
+
+        for my $dep (@deps) {
+          $dep =~ s/::/__/g;
+
+          $self->config->assign_setting (
+            LABELS => [$name, $target, $dep],
+            VALUE  => 1,
+          );
+        }
+
+        next LINE;
+      }
+    }
+
+    # Build target
+    if (uc $label eq $cfg_label{TARGET}) {
+      push @{ $self->{TARGET} }, split (/\s+/, $value);
+      next LINE;
+    }
+
+    # Rename a main program target
+    $prefix = $cfg_label{EXE_NAME};
+    if (index (uc ($label), $prefix) == 0) {
+      my @flds = split /::/, $label;
+      shift @flds;
+      my $name = shift @flds;
+
+      if ($name and $value) {
+        $self->config->assign_setting (
+          LABELS => ['EXE_NAME', $name],
+          VALUE  => $value,
+        );
+
+        next LINE;
+      }
+    }
+
+    # Build tool
+    $prefix = $cfg_label{TOOL} . '::';
+    if (index (uc ($label), $prefix) == 0) {
+      my $name = substr $label, length ($prefix);
+      my @flds = split /::/, $name;
+
+      $name = uc (shift @flds);
+
+      if (exists $tools{$name}) {
+        $name = join '__', ($name, @flds) if @flds;
+
+        $self->config->assign_setting (
+          LABELS => ['TOOL', $name],
+          VALUE  => $value,
+        );
+        next LINE;
+      }
+    }
+
+    # File name extension and type
+    for my $name (qw/INFILE_EXT OUTFILE_EXT/) {
+      $prefix = $cfg_label{$name};
+      if (index (uc ($label), $prefix) == 0) {
+        my $key = (split /::/, $label)[1];
+        $key    = uc $key if $name eq 'OUTFILE_EXT';
+
+        my $val = ($name eq 'INFILE_EXT') ? uc $value : $value;
+
+        $self->config->assign_setting (
+          LABELS => [$name, $key],
+          VALUE  => $val,
+        );
+        next LINE;
+      }
+    }
+
+    # Dependency scan exclusion
+    $prefix = $cfg_label{EXCL_DEP};
+    if (index (uc ($label), $prefix) == 0) {
+      my @flds = split /::/, $label;
+      shift @flds;
+
+      my $pk = @flds ? join ('__', @flds) : '';
+      $self->config->assign_setting (
+        LABELS => ['EXCL_DEP', uc ($value), $pk],
+        VALUE  => 1,
+      );
+      next LINE;
+    }
+
+    # Use (inherit from) another build
+    if (uc $label eq $cfg_label{USE}) {
+      my $use = Fcm::Build->new (
+        CONFIG  => $self->config,
+        CFG_SRC => expand_tilde ($value),
+      );
+      $use->decipher_cfg;
+      $use->check_dir;
+      push @{ $self->{USE} }, $use;
+      next LINE;
+    }
+
+    # Inheritance flag
+    $prefix = $cfg_label{INHERIT} . '::';
+    if (index (uc ($label), $prefix) == 0) {
+      my $name = substr $label, length ($prefix);
+      my @flds = split /::/, $name;
+
+      $name = uc (shift @flds);
+
+      for my $flag (qw/SRCDIR PP LIB TARGET/) {
+        if ($name eq $cfg_label{$flag}) {
+          $name = @flds ? join ('__', ($flag, @flds)) : $flag;
+          $self->{INHERIT}{$name} = $value;
+          next LINE;
+        }
+      }
+    }
+
+    # Label not recognised
+    w_report 'ERROR: ', $line->{SRC}, ': LINE ', $line->{NUMBER}, ': label "',
+             $label, '" not recognised';
+    return;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $bld->check_dir ();
+#
+# DESCRIPTION
+#   This method checks whether the build directories are set correctly.
+# ------------------------------------------------------------------------------
+
+sub check_dir {
+  my $self = shift;
+
+  # Make sure build root directory is set
+  if (not $self->{DIR}{ROOT}) {
+    w_report 'Error: build root directory not set.';
+    return;
+  }
+
+  # Set value of build sub-directories if necessary
+  for my $name (keys %{ $self->config->setting ('DIR') }) {
+    next if $self->{DIR}{$name};
+
+    $self->{DIR}{$name} = catfile (
+      $self->{DIR}{ROOT},
+      $self->config->setting ('DIR', $name),
+    );
+  }
+
+  # Search src/ sub-directory if necessary
+  if ($self->{SEARCH} and -d $self->{DIR}{SRC}) {
+    my %dir = find_srcdir ($self->{DIR}{SRC});
+    for my $name (keys %dir) {
+      $self->{SRCDIR}{$name} = $dir{$name} unless $self->{SRCDIR}{$name};
+    }
+  }
+
+  # Expand source directory paths if necessary
+  for my $name (keys %{ $self->{SRCDIR} }) {
+    if ($self->{SRCDIR}{$name} =~ /^\w/) {
+      my $src_search  = catfile $self->{DIR}{SRC} , $self->{SRCDIR}{$name};
+      my $root_search = catfile $self->{DIR}{ROOT}, $self->{SRCDIR}{$name};
+
+      if ($self->{DIR}{SRC} and -d $src_search) {
+        $self->{SRCDIR}{$name} = $src_search;
+
+      } elsif (-d $root_search) {
+        $self->{SRCDIR}{$name} = $root_search;
+
+      } else {
+        w_report 'Warning: cannot locate declared source directory: ',
+                 $self->{SRCDIR}{$name};
+        next;
+      }
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $bld->check_lock ();
+#
+# DESCRIPTION
+#   This method checks whether a lock is set in the current build.
+# ------------------------------------------------------------------------------
+
+sub check_lock {
+  my $self = shift;
+
+  my $rootdir  = $self->{DIR}{ROOT};
+  my $lock_ext = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_EXT/));
+  my $lock_bld = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_BLD/));
+
+  # Always throw error if extract lock exists
+  if (-e $lock_ext) {
+    w_report 'ERROR: extract lock file exists: ', $lock_ext, ',';
+    w_report '       an extract may be running at ', $rootdir, ', abort.';
+    return;
+  }
+
+  # Always throw error if build lock exists
+  if (-e $lock_bld) {
+    w_report 'ERROR: build lock file exists: ', $lock_bld, ',';
+    w_report '       a build may be running at ', $rootdir, ', abort.';
+    return;
+  }
+
+  # Check locks in inherited build
+  for my $use (@{ $self->{USE} }) {
+    return unless $use->check_lock;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_set_lock ();
+#
+# DESCRIPTION
+#   This method sets a lock is set in the current build.
+# ------------------------------------------------------------------------------
+
+sub _set_lock {
+  my $self = shift;
+
+  $self->{LOCK} = catfile (
+    $self->{DIR}{ROOT}, $self->config->setting (qw/MISC LOCK_BLD/),
+  );
+
+  &touch_file ($self->{LOCK});
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_setup_dir (FULL => $full);
+#
+# DESCRIPTION
+#   This internal method sets up the build directories.
+# ------------------------------------------------------------------------------
+
+sub _setup_dir {
+  my $self = shift;
+  my %args = @_;
+
+  my $full = exists $args{FULL} ? $args{FULL} : 0;
+
+  my $tar      = $self->config->setting (qw/OUTFILE_EXT TAR/);
+  my @tar_dirs = split /,/, $self->config->setting (qw/TAR_DIRS/);
+  my $verbose  = $self->config->verbose;
+
+  if ($full) {
+    # Remove sub-directories/archives created from previous builds
+    for my $name (qw/BIN BLD DONE ETC FLAGS INC LIB PPSRC OBJ TMP/) {
+      &run_command ([qw/rm -rf/, $self->{DIR}{$name}], PRINT => $verbose)
+        if -d $self->{DIR}{$name};
+
+      &run_command ([qw/rm -f/, $self->{DIR}{$name} . $tar], PRINT => $verbose)
+        if -f $self->{DIR}{$name} . $tar;
+    }
+
+    # Remove cache
+    my @files;
+    if (-d $self->{DIR}{CACHE} and opendir DIR, $self->{DIR}{CACHE}) {
+      @files = grep {$_ ne '.' and $_ ne '..'} readdir 'DIR';
+      closedir DIR;
+    }
+
+    my $extension = '\\' . $self->config->setting (qw/CACHE PCKFILE/) . '|' .
+                    '\\' . $self->config->setting (qw/CACHE PCKPPDEPEND/) . '|' .
+                    '\\' . $self->config->setting (qw/CACHE PCKDEPEND/);
+
+
+    for my $file (@files) {
+      next unless $file eq $self->config->setting (qw/CACHE BLDTOOL/) or
+                  $file eq $self->config->setting (qw/CACHE PPOPTION/) or
+                  $file eq $self->config->setting (qw/CACHE EXE_DEP/) or
+                  $file =~ /$extension$/;
+
+      my $path = File::Spec->catfile ($self->{DIR}{CACHE}, $file);
+      &run_command ([qw/rm -f/, $path], PRINT => $verbose);
+    }
+
+  } else {
+    # Extract archives if necessary
+    for my $name (@tar_dirs) {
+      my $tar_file = $self->{DIR}{$name} . $tar;
+
+      if (-f $tar_file) {
+        &run_command ([qw/tar -x -f/, $tar_file], PRINT => $verbose > 1);
+        &run_command ([qw/rm -f/, $tar_file], PRINT => $verbose > 1);
+      }
+    }
+  }
+
+  # Set up search paths
+  for my $name (keys %{ $self->{DIR} }) {
+    $self->{PATH}{$name} = [$self->_get_inherited_paths ($name)];
+
+    $self->config->assign_setting (
+      LABELS => ['PATH', $name],
+      VALUE  => $self->{PATH}{$name},
+    )
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_bld_info ();
+#
+# DESCRIPTION
+#   This internal method sets up the inheritance relationship for source
+#   directories and targets, and other configurations required by the build.
+# ------------------------------------------------------------------------------
+
+sub _update_bld_info {
+  my $self = shift;
+
+  # Set up build targets
+  $self->{TARGET} = [$self->_get_inherited_items ('TARGET')];
+
+  # Set up PP switches
+  $self->{PP} = {$self->_get_inherited_items ('PP')};
+
+  # Set up source directory packages for this build
+  my %srcdir = $self->_get_inherited_items ('SRCDIR');
+  for my $name (keys %srcdir) {
+    my $package = Fcm::SrcPackage->new (
+      CONFIG     => $self->config,
+      NAME       => $name,
+      CURRENT    => exists $self->{SRCDIR}{$name},
+      REQUIREPP  => $self->_require_pp ($name),
+      SEARCHPATH => [$self->_get_inherited_srcdirs ($name)],
+    );
+
+    $package->update_file_info ();
+
+    $self->{PACKAGE}{$name} = $package;
+  }
+
+  # Set up runtime dependency scan patterns
+  my %dep_pattern = %{ $self->config->setting ('DEP_PATTERN') };
+  for my $key (keys %dep_pattern) {
+    my $pattern = $dep_pattern{$key};
+
+    while ($pattern =~ /##([\w:]+)##/g) {
+      my $match = $1;
+      my $val   = $self->config->setting (split (/::/, $match));
+
+      last unless defined $val;
+      $val =~ s/\./\\./;
+
+      $pattern =~ s/##$match##/$val/;
+    }
+
+    $self->config->assign_setting (
+      LABELS => ['DEP_PATTERN', $key],
+      VALUE  => $pattern,
+    ) unless $pattern eq $dep_pattern{$key};
+  }
+
+  # Set up top level library name
+  {
+    $self->{LIB} = {$self->_get_inherited_items ('LIB')};
+
+    my $lib = $self->{LIB}{''};
+    $lib    = ($self->{NAME} ? $self->{NAME} : 'fcm_default') unless $lib;
+    $self->{LIB}{''} = $lib;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_regen_rule_info ();
+#
+# DESCRIPTION
+#   This internal method compares the current EXE_DEP, BLOCKDATA and EXE_NAME
+#   declarations and the previous. If changed, the REGEN_MAKERULE flag will be
+#   set to true and the cache will be updated.
+# ------------------------------------------------------------------------------
+
+sub _update_regen_rule_info {
+  my $self = shift;
+
+  # Look for an extra executable dependency cache file
+  my $cachebase = $self->config->setting (qw/CACHE EXE_DEP/);
+  my $incache   = find_file_in_path $cachebase, $self->{PATH}{CACHE};
+
+  my $uptodate = 0;
+  my @inlines  = ();
+
+  # Read cache if it exists
+  if ($incache and -r $incache) {
+    my $incfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $incache);
+    $incfg->read_cfg;
+
+    @inlines  = $incfg->lines;
+    $uptodate = 1;
+  }
+
+  # Prepare output lines
+  my $outcfg = Fcm::CfgFile->new (CONFIG => $self->config);
+  $outcfg->add_line (COMMENT => 'EXE_DEP cache');
+
+  # List of extra executable dependencies
+  my %exe_dep   = %{ $self->config->setting ('EXE_DEP') };
+  for my $target (sort keys %exe_dep) {
+    $outcfg->add_line (
+      LABEL => ($target ? 'OBJECTS__' . $target : 'OBJECTS'),
+      VALUE => join (' ', sort keys %{ $exe_dep{$target} }),
+    );
+  }
+
+  # List of BLOCKDATA dependencies
+  my %blockdata = %{ $self->config->setting ('BLOCKDATA') };
+  for my $target (sort keys %blockdata) {
+    $outcfg->add_line (
+      LABEL => ($target ? 'BLOCKDATA__' . $target : 'BLOCKDATA'),
+      VALUE => join (' ', sort keys %{ $blockdata{$target} }),
+    );
+  }
+
+  # List of EXE_NAME
+  my %exe_name = %{ $self->config->setting ('EXE_NAME') };
+  for my $target (sort keys %exe_name) {
+    $outcfg->add_line (
+      LABEL => 'EXE_NAME__' . $target,
+      VALUE => $exe_name{$target},
+    );
+  }
+
+  # Compare cache with current output
+  my @outlines = $outcfg->lines ();
+
+  $uptodate = 0 if @inlines != @outlines;
+
+  if ($uptodate) {
+    for my $i (0 .. $#outlines) {
+      next unless $inlines[$i]->{LABEL} and $outlines[$i]->{LABEL};
+
+      if ($inlines[$i]->{LABEL} ne $outlines[$i]->{LABEL} or
+          $inlines[$i]->{VALUE} ne $outlines[$i]->{VALUE}) {
+        $uptodate = 0;
+        last;
+      }
+    }
+  }
+
+  # Update cache if it is out of date
+  $outcfg->print_cfg (catfile ($self->{DIR}{CACHE}, $cachebase))
+    unless $uptodate;
+
+  # If out to date, set regenerate make rule flag to true
+  $self->config->assign_setting (
+    LABELS => [qw/REGEN_MAKERULE/],
+    VALUE  => ! $uptodate,
+  );
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_pp_info ();
+#
+# DESCRIPTION
+#   This internal method compares the current set of pre-processor options
+#   with that of the previous build using a "cache" file. If some
+#   pre-processor options have changed, the method updates the cache file and
+#   remove the "make" rules for the appropriate source packages.
+# ------------------------------------------------------------------------------
+
+sub _update_pp_info {
+  my $self = shift;
+
+  # Look for a PP option cache file
+  my $cachebase = $self->config->setting (qw/CACHE PPOPTION/);
+  my $incache   = find_file_in_path $cachebase, $self->{PATH}{CACHE};
+
+  my @chgpp = ();
+  my %newpp = %{ $self->{PP} };
+
+  # Read config if exists, otherwise marked all current PP flags as "changed"
+  if ($incache and -r $incache) {
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $incache);
+    $cfg->read_cfg;
+
+    my @lines   = $cfg->lines;
+    my %oldpp = ();
+
+    for my $line (@lines) {
+      next unless $line->{LABEL};
+
+      $oldpp{$line->{LABEL}} = $line->{VALUE};
+    }
+
+    # Compare new and old, mark as "changed" if changed or does not exist in old
+    @chgpp = (grep {
+      exists $oldpp{$_} ? $oldpp{$_} ne $newpp{$_} : 1;
+    } keys %newpp);
+
+    # Compare old and new, mark as "changed" if not exist in new
+    push @chgpp, (grep {not exists $newpp{$_}} keys %oldpp);
+
+  } else {
+    @chgpp = keys %newpp;
+  }
+
+  if (@chgpp) {
+    for my $name (@chgpp) {
+      for my $package (values %{ $self->{PACKAGE} }) {
+        next if $package->newpp;
+
+        if (('PP__' . $package->name) =~ /^$name(?:__|$)/) {
+          $package->current (1);
+          $package->newpp   (1);
+        }
+      }
+    }
+
+    # Update the PP cache file if necessary
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+    for my $name (keys %newpp) {
+      $cfg->add_line (LABEL => $name, VALUE => $newpp{$name});
+    }
+    $cfg->add_line unless $cfg->lines;
+
+    $cfg->print_cfg (catfile ($self->{DIR}{CACHE}, $cachebase));
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_tool_info ();
+#
+# DESCRIPTION
+#   This internal method compares the current set of build tools with that of
+#   the previous build using a "cache" file. If some build tools have changed,
+#   the method updates the cache file and (the time stamps of) dummy "flags"
+#   files to denote changes in build tools from the previous build.
+# ------------------------------------------------------------------------------
+
+sub _update_tool_info {
+  my $self = shift;
+
+  # Look for a build tool cache file
+  my $cachebase = $self->config->setting (qw/CACHE BLDTOOL/);
+  my $incache   = find_file_in_path $cachebase, $self->{PATH}{CACHE};
+
+  my @chgtool = ();
+  my %newtool = %{ $self->config->setting ('TOOL') };
+
+  # Read config if exists, otherwise marked all current tools as "changed"
+  if ($incache and -r $incache) {
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $incache);
+    $cfg->read_cfg;
+
+    my @lines   = $cfg->lines;
+    my %oldtool = ();
+
+    for my $line (@lines) {
+      next unless $line->{LABEL};
+
+      $oldtool{$line->{LABEL}} = $line->{VALUE};
+    }
+
+    # Compare new and old, mark as "changed" if changed or does not exist in old
+    @chgtool = (grep {
+      exists $oldtool{$_} ? $oldtool{$_} ne $newtool{$_} : 1;
+    } keys %newtool);
+
+    # Compare old and new, mark as "changed" if not exist in new
+    push @chgtool, (grep {not exists $newtool{$_}} keys %oldtool);
+
+  } else {
+    @chgtool = keys %newtool;
+  }
+
+  if (@chgtool) {
+    # Update the time stamps of dummy files for changed tools
+    $self->_create_build_dir ('FLAGS');
+
+    my $ext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+    for my $name (@chgtool) {
+      my $file = catfile $self->{DIR}{FLAGS}, $name . $ext;
+
+      # Create/touch the file
+      touch_file $file or croak 'Unable to update: ', $file, ', abort';
+
+      print 'Updated: ', $file, "\n" if $self->config->verbose > 2;
+    }
+
+    # Update the build tool cache file if necessary
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+    for my $name (keys %newtool) {
+      $cfg->add_line (LABEL => $name, VALUE => $newtool{$name});
+    }
+
+    $cfg->print_cfg (catfile ($self->{PATH}{CACHE}->[0], $cachebase));
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_pre_process ();
+#
+# DESCRIPTION
+#   This internal method obtains a list of source files that require
+#   pre-processing in the source packages of this build, and attempts to
+#   pre-process them. The method returns 1 on success.
+# ------------------------------------------------------------------------------
+
+sub _pre_process {
+  my $self = shift;
+
+  # Go through source packages/files to see if PP is required
+  my @srcfiles = ();
+  for my $package (values %{ $self->{PACKAGE} }) {
+    next unless $package->requirepp;
+
+    $package->scan_dependency (HEADER_ONLY => 1);
+
+    push @srcfiles, grep ({$_->is_type_or (qw/FPP C/)} $package->srcfile);
+  }
+
+  return 1 unless @srcfiles;
+
+  my %task     = ();
+  my $flagsext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+  my $pdoneext = $self->config->setting (qw/OUTFILE_EXT PDONE/);
+
+  # Set up tasks for each source file
+  for my $srcfile (@srcfiles) {
+    my $command  = $srcfile->is_type ('FPP') ? 'FPP' : 'CPP';
+    my @pck_list = $srcfile->get_package_list;
+    my @pknames  = split '__', pop (@pck_list);
+
+    # Set up a PP build task for each source file
+    my $target    = $srcfile->base . $pdoneext;
+    my $ppkeyname = join ('__', ($command . 'KEYS' , @pknames)) . $flagsext;
+    my $flagsname = join ('__', ($command . 'FLAGS', @pknames)) . $flagsext;
+
+    # Issue warning for duplicated tasks
+    if (exists $task{$target}) {
+      w_report 'Warning: ', $target, ': unable to create task for: ',
+               $srcfile->src, ': task already exists for: ',
+               $task{$target}->srcfile->src;
+      next;
+    }
+
+    $task{$target} = Fcm::BuildTask->new (
+      CONFIG     => $self->config,
+      TARGET     => $target,
+      TARGETPATH => $self->{PATH}{DONE},
+      SRCFILE    => $srcfile,
+      DEPENDENCY => [$ppkeyname, $flagsname, ($srcfile->dep ('H'))],
+      ACTIONTYPE => 'PP',
+    );
+
+    # Set up update ppkeys/flags build tasks for each source file/package
+    for my $i (0 .. $#pknames) {
+      my $name  = join '__', @pknames [0 .. $i];     # package name
+      my $dname = join '__', @pknames [0 .. $i - 1]; # dependent package name
+
+      for my $flag (qw/KEYS FLAGS/) {
+        my $fullflag = $command . $flag;
+        my $target   = join '__', ($fullflag, $name);
+        my $depend   = $dname ? join '__', ($fullflag, $dname) : $fullflag;
+
+        $target .= $flagsext;
+        $depend .= $flagsext;
+
+        next if exists $task{$target};
+
+        $task{$target} = Fcm::BuildTask->new (
+          CONFIG     => $self->config,
+          TARGET     => $target,
+          TARGETPATH => $self->{PATH}{FLAGS},
+          DEPENDENCY => [$depend],
+          ACTIONTYPE => 'UPDATE',
+        );
+      }
+    }
+  }
+
+  # Set up update global ppkeys/flags build tasks
+  for my $command (qw/CPP FPP/) {
+    for my $flag ('', qw/KEYS FLAGS/) {
+      my $target = $command . $flag . $flagsext;
+
+      $task{$target} = Fcm::BuildTask->new (
+        CONFIG     => $self->config,
+        TARGET     => $target,
+        TARGETPATH => $self->{PATH}{FLAGS},
+        ACTIONTYPE => 'UPDATE',
+      );
+    }
+  }
+
+  # Set up build tasks to copy all header files
+  for my $package (values %{ $self->{PACKAGE} }) {
+    my @files = grep {$_->is_type (qw/CPP INCLUDE/)} $package->srcfile;
+
+    # Author's note: may also want to issue warning for duplicated tasks
+
+    for my $file (@files) {
+      $task{$file->base} = Fcm::BuildTask->new (
+        CONFIG     => $self->config,
+        TARGET     => $file->base,
+        TARGETPATH => $self->{PATH}{INC},
+        SRCFILE    => $file,
+        DEPENDENCY => [$file->dep ('H')],
+        ACTIONTYPE => 'COPY',
+      );
+    }
+  }
+
+  # Build all PP tasks
+  my $count = 0;
+
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'PP';
+
+    my $rc = $task->action (TASKLIST => \%task);
+    $count++ if $rc;
+  }
+
+  print 'Number of pre-processed files: ', $count, "\n"
+    if $self->config->verbose and $count;
+
+  # Change path and file type of pre-processed source files
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'PP';
+
+    # Remove header dependencies from source file
+    my %dep = $task->srcfile->dep ();
+    for my $key (keys %dep) {
+      delete $dep{$key} if $dep{$key} eq 'H';
+    }
+    $task->srcfile->dep (\%dep);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_generate_f9x_interface ();
+#
+# DESCRIPTION
+#   This internal method obtains a list of Fortran 9X source files in the
+#   source packages of this build, and attempts to generate an interface block
+#   file for each of the Fortran 9X source files. The method returns 1 on
+#   success.
+# ------------------------------------------------------------------------------
+
+sub _generate_f9x_interface {
+  my $self = shift;
+
+  # Go through source packages/files for Fortran 9x source files with
+  # standalone subroutines or functions
+  my @srcfiles = ();
+  for my $package (values %{ $self->{PACKAGE} }) {
+    next unless $package->current;
+
+    push @srcfiles, grep {
+      $_->is_type_or (qw/FORTRAN9X FPP9X/) and
+      uc ($_->select_tool ('GENINTERFACE')) ne 'NONE' and
+      not $_->is_type_or (qw/PROGRAM MODULE INCLUDE/)
+    } $package->srcfile;
+  }
+
+  my $flagsext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+  my $pdoneext = $self->config->setting (qw/OUTFILE_EXT PDONE/);
+
+  # Set up build task to generate interface files for all selected Fortran 9x
+  # sources
+  my %task         = ();
+  for my $srcfile (@srcfiles) {
+    my $target  = $srcfile->interfacebase . $pdoneext;
+    my @pknames = split '__', ($srcfile->get_package_list)[-1];
+    my $flag    = join ('__', ('GENINTERFACE', @pknames)) . $flagsext;
+
+    $task{$target} = Fcm::BuildTask->new (
+      CONFIG     => $self->config,
+      TARGET     => $target,
+      TARGETPATH => $self->{PATH}{DONE},
+      SRCFILE    => $srcfile,
+      DEPENDENCY => [$flag],
+      ACTIONTYPE => 'GENINTERFACE',
+    );
+
+    # Set up build tasks for each source file/package flags file for interface
+    # generator tool
+    for my $i (0 .. $#pknames) {
+      my $name   = join '__', @pknames [0 .. $i];     # package name
+      my $dname  = join '__', @pknames [0 .. $i - 1]; # dependent package name
+
+      my $target = join '__', ('GENINTERFACE', $name);
+      my $depend = $dname ? join '__', ('GENINTERFACE', $dname) : 'GENINTERFACE';
+
+      $target .= $flagsext;
+      $depend .= $flagsext;
+
+      next if exists $task{$target};
+
+      $task{$target} = Fcm::BuildTask->new (
+        CONFIG     => $self->config,
+        TARGET     => $target,
+        TARGETPATH => $self->{PATH}{FLAGS},
+        DEPENDENCY => [$depend],
+        ACTIONTYPE => 'UPDATE',
+      );
+    }
+  }
+
+  # Set up build task to update the flags file for interface generator tool
+  {
+    my $target     = 'GENINTERFACE' . $flagsext;
+    $task{$target} = Fcm::BuildTask->new (
+      CONFIG     => $self->config,
+      TARGET     => $target,
+      TARGETPATH => $self->{PATH}{FLAGS},
+      ACTIONTYPE => 'UPDATE',
+    );
+  }
+
+  my $count = 0;
+
+  # Performs task
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'GENINTERFACE';
+
+    my $rc = $task->action (TASKLIST => \%task);
+    $count++ if $rc;
+  }
+
+  print 'Number of generated interfaces: ', $count, "\n"
+    if $self->config->verbose and $count;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_scan_dependency ();
+#
+# DESCRIPTION
+#   This internal method goes through each source package to obtain dependency
+#   information from their source files. It returns 1 on success.
+# ------------------------------------------------------------------------------
+
+sub _scan_dependency {
+  my $self = shift;
+
+  # Go through source packages/files
+  my $count = 0;
+
+  for my $package (values %{ $self->{PACKAGE} }) {
+    my $rc = $package->scan_dependency;
+    $count++ if $rc;
+  }
+
+  print 'Scanned files in ', $count, ' package(s) for dependency', "\n"
+    if $self->config->verbose and $count;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_set_targets ();
+#
+# DESCRIPTION
+#   This internal method determines the default targets to be built.
+# ------------------------------------------------------------------------------
+
+sub _set_targets {
+  my $self = shift;
+
+  # Targets of the build
+  if (not @{ $self->{TARGET} }) {
+    # Build targets not specified by user, default to building all main programs
+    my @programs = ();
+
+    # Get all main programs from all packages
+    for my $package (values %{ $self->{PACKAGE} }) {
+      my @srcfiles = grep {$_->exebase} $package->srcfile;
+
+      for (@srcfiles) {
+        push @programs, $_->exebase;
+      }
+    }
+
+    @programs = sort (@programs);
+
+    if (@programs) {
+      # Build main programs, if there are any
+      @{ $self->{TARGET} } = @programs;
+
+    } else {
+      # No main program in source tree, build the default library
+      @{ $self->{TARGET} } = (
+        'lib' . $self->{LIB}{''} . $self->config->setting (qw/OUTFILE_EXT LIB/),
+      );
+    }
+  }
+
+  return @{ $self->{TARGET} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_write_make_rules ();
+#
+# DESCRIPTION
+#   This internal method writes the included make rules if necessary.
+# ------------------------------------------------------------------------------
+
+sub _write_make_rules {
+  my $self   = shift;
+  my $return = 1;
+
+  # Get list of all packages
+  my %allpcks = $self->allpcks;
+
+  # Get list of types that cannot have duplicated targets
+  my @no_duplicated_target_types = split (
+    /,/, $self->config->setting ('NO_DUPLICATED_TARGET_TYPE'),
+  );
+
+  my $unusual = 0;
+  my $count   = 0;
+  my %targets;
+  for my $name (sort keys %allpcks) {
+    # Check whether package is an actual package of the build
+    my $package  = exists $self->{PACKAGE}{$name} ? $self->{PACKAGE}{$name} : '';
+
+    # Regenerate make rules if this flag is set to true
+    my $regen_mk;
+
+    # Register non-word package name
+    if (not $name =~ /^\w*$/) {
+      $self->config->assign_setting (
+        LABELS => ['FCM_PCK_OBJECTS', $name],
+        VALUE  => 'FCM_PCK_OBJECTS' . $unusual++,
+      );
+
+      # Set regenerate make rule flag to true
+      $regen_mk = 1;
+    }
+
+    # Cycle loop if not an actual package of the build
+    next unless $package;
+
+    # Check whether make rule for each source package needs updating. Yes if:
+    # 1. package name contains non-word characters
+    # 2. the config setting REGEN_MAKERULE is set to true
+    # 3. package is current and the make rule for the package is out of date
+    $regen_mk = (
+      $regen_mk or
+      $self->config->setting ('REGEN_MAKERULE') or
+      ($package->current and not $package->makerule_uptodate)
+    );
+
+    # Update make rule for source package, if necessary
+    $count += $package->write_makerule () if $regen_mk;
+
+    # Check for duplicated rules
+    for my $srcfile (sort $package->srcfile) {
+      next unless $srcfile->type;
+
+      my %rules = $srcfile->required_rules;
+
+      for my $key (sort keys %rules) {
+        if (exists $targets{$key}) {
+          # Duplicated target: warning for most file types
+          my $status = 'WARNING';
+
+          # Duplicated target: error for the following file types
+          if (@no_duplicated_target_types and
+              $srcfile->is_type_or (@no_duplicated_target_types) and
+              $targets{$key}->is_type_or (@no_duplicated_target_types)) {
+            $status = 'ERROR';
+            $return = 0;
+          }
+
+          # Report the warning/error
+          w_report $status, ': ', $key, ': duplicated targets for building:';
+          w_report '       ', $targets{$key}->src;
+          w_report '       ', $srcfile->src;
+
+        } else {
+          $targets{$key} = $srcfile;
+        }
+      }
+    }
+  }
+
+  # Diagnostic
+  print 'Updated make rules for ', $count, ' package(s).', "\n"
+    if $count and $self->config->verbose;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_write_makefile ();
+#
+# DESCRIPTION
+#   This internal method writes the "Makefile" for this build.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile {
+  my $self = shift;
+
+  # Makefile header
+  # ----------------------------------------------------------------------------
+  my $makefile = '# Automatic Makefile' . "\n\n";
+
+  # Name of the build
+  $makefile .= 'FCM_BUILD_NAME = ' . $self->{NAME} . "\n" if $self->{NAME};
+  
+  # Location of FCM config file
+  $makefile .= 'FCM_BLD_CFG = ' . $self->cfg->src . "\n";
+
+  # Targets of the build
+  $makefile .= 'FCM_BLD_TARGETS = ' . join (' ', ($self->_set_targets)) . "\n\n";
+
+  # Perl library
+  # ----------------------------------------------------------------------------
+  {
+    my $libdir  = dirname (dirname ($INC{'Fcm/Build.pm'}));
+    my @libpath = split /:/, ($ENV{PERL5LIB} ? $ENV{PERL5LIB} : '');
+
+    if (not grep (m/$libdir/, @libpath)) {
+      $makefile .= 'export PERL5LIB := ' . $libdir;
+      $makefile .= ':$(PERL5LIB)' if exists $ENV{PERL5LIB};
+      $makefile .= "\n\n";
+    }
+  }
+
+  # Build directories
+  # ----------------------------------------------------------------------------
+  my @keys    = ('ROOT', sort grep {$_ ne 'ROOT'} keys (%{ $self->{DIR} }));
+  my $rootdir = $self->{DIR}{ROOT};
+
+  # Build sub-directories
+  for my $name (@keys) {
+    my $dir = $self->{DIR}{$name};
+    $dir    =~ s/^$rootdir/\$(FCM_ROOTDIR)/ unless $name eq 'ROOT';
+
+    $makefile .= 'export FCM_' . $name . 'DIR = ' . $dir . "\n";
+  }
+
+  $makefile .= "\n";
+
+  # Build sub-directory paths
+  for my $name (@keys) {
+    my @path = @{ $self->{PATH}{$name} };
+    shift @path;
+
+    $makefile .= 'export FCM_' . $name . 'PATH = ' .
+                 join (':', ('$(FCM_' . $name . 'DIR)', @path)) . "\n";
+  }
+
+  $makefile .= "\n";
+
+  # Build tools
+  # ----------------------------------------------------------------------------
+  # List of build tools
+  my $tool          = $self->config->setting ('TOOL');
+
+  # List of tools local to FCM, (will not be exported)
+  my %localtool     = map {($_, 1)} split (    # map into a hash table
+    /,/, $self->config->setting ('LOCALTOOL'), # split comma separated list
+  );
+
+  # Export required tools
+  my $unusual_count = 0;
+  for my $name (sort keys %$tool) {
+    # Ignore local tools
+    my $topname = (split (/__/, $name))[0];
+    next if exists $localtool{$topname};
+
+    if ($name =~ /^\w+$/) {
+      # Tools with normal name, just export it as an environment variable
+      $makefile .= 'export ' . $name . ' = ' . $tool->{$name} . "\n";
+
+    } else {
+      # Tools with unusual characters, export using a label/value pair
+      $makefile .= 'export FCM_UNUSUAL_TOOL_LABEL' . $unusual_count . ' = ' .
+                   $name . "\n";
+      $makefile .= 'export FCM_UNUSUAL_TOOL_VALUE' . $unusual_count . ' = ' .
+                   $tool->{$name} . "\n";
+      $unusual_count++;
+    }
+  }
+
+  $makefile .= "\n";
+
+  # Verbose mode
+  # ----------------------------------------------------------------------------
+  $makefile .= 'export FCM_VERBOSE ?= ' . $self->config->verbose . "\n\n";
+
+  # VPATH
+  # ----------------------------------------------------------------------------
+  # $name is internal name of build sub-directories
+  # $type is the type of files
+  for my $name (sort keys %{ $self->config->setting ('VPATH') }) {
+    my @types = split /,/, $self->config->setting ('VPATH', $name);
+
+    for my $type (sort @types) {
+      # If $type is EMPTY, it is a file with no file name extension
+      if (uc ($type) eq 'EMPTY') {
+        $makefile .= 'vpath % $(FCM_' . $name . 'PATH)' . "\n";
+
+      } elsif ($type =~ s/^(in|out)://i) {
+        if (uc ($1) eq 'IN') {
+          # If $type begins with IN:<type>, it is a list of file extensions that
+          # can be found under the INFILE_EXT hash in the configuration setting,
+          # with <type> matching a keyword in the values of the hash.
+          my %infile_ext = %{ $self->config->setting ('INFILE_EXT') };
+
+          for my $ext (sort keys %infile_ext) {
+            $makefile .= 'vpath %.' . $ext . ' $(FCM_' . $name . 'PATH)' . "\n"
+              if grep {$_ eq $type} split /::/, $infile_ext{$ext};
+          }
+
+        } else {
+          # If $type begins with OUT:<type>, it is the value of a hash element
+          # in the OUTFILE_EXT hash in the configuration setting, with <type>
+          # matching the key.
+          my $ext    = $self->config->setting ('OUTFILE_EXT', $type);
+          $makefile .= 'vpath %' . $ext . ' $(FCM_' . $name . 'PATH)' . "\n";
+        }
+
+      } else {
+        # Otherwise, $type is a VPATH pattern recognised by "make".
+        $makefile .= 'vpath ' . $type . ' $(FCM_' . $name . 'PATH)' . "\n";
+      }
+    }
+  }
+
+  # VPATH for dummy files
+  $makefile .= 'vpath %.dummy $(FCM_DONEDIR)' . "\n";
+  $makefile .= "\n";
+
+  # Default targets
+  # ----------------------------------------------------------------------------
+  $makefile .= '.PHONY : all clean' . "\n\n";
+  $makefile .= 'all : $(FCM_BLD_TARGETS)' . "\n\n";
+  $makefile .= 'clean : ' . "\n";
+  $makefile .= "\t" . 'rm -rf';
+  for my $dir (qw/BIN LIB OBJ DONE/) {
+    $makefile .= ' $(FCM_' . $dir . 'DIR)' if exists $self->{DIR}{$dir};
+  }
+  $makefile .= "\n";
+  $makefile .= "\t" . 'rm -f lib__*' .
+               $self->config->setting (qw/OUTFILE_EXT LIB/) .
+               ' *' . $self->config->setting (qw/OUTFILE_EXT OBJ/) . "\n";
+  $makefile .= "\n";
+
+  # Targets for copy dummy
+  $makefile .= $self->config->setting (qw/MISC CPDUMMY/) . ' :' . "\n";
+  $makefile .= "\t" . 'touch $@' . "\n\n";
+
+  # Targets for all (non-main-program) objects and libraries
+  # ----------------------------------------------------------------------------
+  my %allpcks = $self->allpcks;
+  for my $key (reverse sort keys %allpcks) {
+    # Objects variable
+    my $var;
+    if ($self->config->setting ('FCM_PCK_OBJECTS', $key)) {
+      # Package name contains unusual characters, use predefined variable
+      $var = $self->config->setting ('FCM_PCK_OBJECTS', $key);
+
+    } else {
+      # Normal package name, prefix the package name with "OBJECTS__"
+      # Top level package, simply set to "OBJECTS"
+      $var = $key ? join ('__', ('OBJECTS', $key)) : 'OBJECTS';
+    }
+
+    # Export top level OBJECTS variable
+    # but keep sub-package OBJECTS variables local to the Makefile
+    $makefile .= ($var eq 'OBJECTS' ? 'export ' : '') . $var . ' =';
+
+    # Add objects from children
+    if (@{ $allpcks{$key} }) {
+      # List of sub-packages of current package
+      my @deps   = map {
+        if ($self->config->setting ('FCM_PCK_OBJECTS', $_)) {
+          # Package name contains unusual characters, use predefined variable
+          '$(' . $self->config->setting ('FCM_PCK_OBJECTS', $_) . ')';
+
+        } else {
+          # Normal package name, prefix the package name with "OBJECTS__"
+          '$(OBJECTS__' . $_ . ')';
+        }
+      } @{ $allpcks{$key} };
+
+      $makefile .= ' ' . join (' ', sort @deps);
+    }
+
+    # Add its own objects
+    if (exists $self->{PACKAGE}{$key}) {
+      # List of source files in the current package
+      my @files = sort {$a->base cmp $b->base} $self->{PACKAGE}{$key}->srcfile;
+
+      for my $file (@files) {
+        # Consider compilable source files only
+        next unless $file->objbase;
+
+        # Ignore main programs and Fortran BLOCKDATA program units
+        next if $file->is_type_or (qw/PROGRAM BLOCKDATA/);
+
+        # Add to object list
+        $makefile .= ' ' . $file->objbase;
+      }
+    }
+
+    $makefile .= "\n\n";
+
+    # Library target
+    my $lib = exists ($self->{LIB}{$key}) ? $self->{LIB}{$key} : $key;
+    $lib    = 'lib' . $lib . $self->config->setting (qw/OUTFILE_EXT LIB/);
+
+    $makefile .= $lib . ' : $(' . $var . ')' . "\n";
+    $makefile .= "\t" . 'fcm_internal archive $@ $(^F)' . "\n\n";
+  }
+
+  # Targets for top level and package flags files and dummy dependencies
+  my %src_tool   = %{ $self->config->setting ('SRC_TOOL') };
+  my %flags_tool = (LD => '', LDFLAGS => '');
+
+  for my $key (keys %src_tool) {
+    $flags_tool{$src_tool{$key}{FLAGS}} = $src_tool{$key}{COMPILER}
+      if exists $src_tool{$key}{FLAGS};
+
+    $flags_tool{$src_tool{$key}{PPKEYS}} = ''
+      if exists $src_tool{$key}{PPKEYS};
+  }
+
+  my $ext = $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+  for my $name (sort keys %flags_tool) {
+    # Flags files for tool command
+    if ($flags_tool{$name}) {
+      $makefile .= $flags_tool{$name} . $ext . ' :' . "\n";
+      $makefile .= "\t" . 'touch ' . catfile ('$(FCM_FLAGSDIR)', '$@') . "\n\n";
+    }
+
+    # Top level flags files
+    $makefile .= $name . $ext . ' :';
+    $makefile .= ' ' . $flags_tool{$name} . $ext if $flags_tool{$name};
+    $makefile .= "\n\t" . 'touch ' . catfile ('$(FCM_FLAGSDIR)', '$@') . "\n\n";
+
+    # Package level flags files
+    for my $key (sort keys %allpcks) {
+      next unless @{ $allpcks{$key} }; # ignore packages without children
+
+      my $depend  = $key ? join '__', ($name, $key) : $name;
+      my @targets = sort map {$name . '__' . $_ . $ext} @{ $allpcks{$key} };
+
+      $makefile .= join (' ', @targets) . ' : ' . $depend . $ext . "\n";
+      $makefile .= "\t" . 'touch ' . catfile ('$(FCM_FLAGSDIR)', '$@') .
+                   "\n\n";
+    }
+  }
+
+  # Include source package make rules
+  # ----------------------------------------------------------------------------
+  for my $package (sort {$a->name cmp $b->name} values %{ $self->{PACKAGE} }) {
+    my $mkbase = $package->name . $self->config->setting (qw/OUTFILE_EXT MK/);
+    my $mkfile = find_file_in_path ($mkbase, $self->{PATH}{BLD});
+
+    if ($mkfile) {
+      if (index ($mkfile, $self->{DIR}{BLD}) == 0) {
+        $mkfile = catfile '$(FCM_BLDDIR)',
+                  substr ($mkfile, length ($self->{DIR}{BLD}) + 1);
+
+      } elsif (index ($mkfile, $self->{DIR}{ROOT}) == 0) {
+        $mkfile = catfile '$(FCM_ROOTDIR)',
+                  substr ($mkfile, length ($self->{DIR}{ROOT}) + 1);
+      }
+
+      $makefile .= 'include ' . $mkfile . "\n";
+
+    } else {
+      my $pck = join ('::', split (/__/, $package->name));
+      w_report 'Warning: no make rule file for source package: ', $pck;
+    }
+  }
+
+  $makefile .= "\n" . '# EOF' . "\n";
+
+  # Print Makefile
+  # ----------------------------------------------------------------------------
+  $self->_create_build_dir ('BLD');
+  my $out = catfile (
+    $self->{DIR}{BLD}, $self->config->setting (qw/MISC MAKEFILE/),
+  );
+
+  # Check whether an old file exists, if so compare current contents with it
+  my $old = '';
+
+  if (-r $out) {
+    open OLD, '<', $out or croak 'Cannot open "', $out, '" (', $!, '), abort';
+    my @lines = readline 'OLD';
+    close OLD;
+
+    $old = join ('', @lines);
+  }
+
+  # Update Makefile if changed
+  if ($old ne $makefile) {
+    open OUT, '>', $out or croak 'Cannot open "', $out, '" (', $!, '), abort';
+    print OUT $makefile;
+    close OUT or croak 'Cannot close "', $out, '" (', $!, '), abort';
+
+    print 'Updated Makefile: ', $out, "\n" if $self->config->verbose;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_invoke_make (
+#     TARGETS => \@targets,
+#     JOBS    => $jobs,
+#     ARCHIVE => $archive,
+#   );
+#
+# DESCRIPTION
+#   This internal method invokes the "make" command to make the build.
+#
+# ARGUMENTS
+#   TARGETS - Specify targets to be built. If set, these targets will be built
+#             instead of the ones specified in the build configuration file.
+#   JOBS    - Specify number of jobs that can be handled by "make". If set,
+#             the value must be a natural integer. If not set, the default
+#             value is 1 (i.e. run "make" in serial mode).
+#   ARCHIVE - If set to "true", invoke the "archive" mode. Most build files and
+#             directories created by this build will be archived using the
+#             "tar" command. If not set, the default is not to invoke the
+#             "archive" mode.
+# ------------------------------------------------------------------------------
+
+sub _invoke_make {
+  my $self = shift;
+  my %args = @_;
+
+  # Build the make command from the specified targets
+  my @targets  = exists $args{TARGETS} ? @{ $args{TARGETS} } : qw/all/;
+  my $jobs     = exists $args{JOBS}    ? $args{JOBS}         : 1;
+  my $archive  = exists $args{ARCHIVE} ? $args{ARCHIVE}      : 0;
+  my $verbose  = $self->config->verbose;
+
+  # Create the required build directories
+  for my $dir (qw/BIN DONE ETC INC FLAGS LIB OBJ TMP/) {
+    $self->_create_build_dir ($dir);
+  }  
+
+  my @commands = ();
+  my @make_cmd = ($self->config->setting (qw/TOOL MAKE/));
+  push @make_cmd, split (/\s+/, $self->config->setting (qw/TOOL MAKEFLAGS/));
+  push @make_cmd, $self->config->setting (qw/TOOL MAKE_SILENT/)
+    unless $verbose > 2;
+
+  if ($jobs > 1) { # multi-process "make"
+    my $make_job = $self->config->setting (qw/TOOL MAKE_JOB/);
+
+    # Setup the "make" commands for each target
+    while (my $target = shift @targets) {
+      if ($target eq 'clean') { # Do not run "clean" in parallel
+        push @commands, [@make_cmd, $target];
+
+      } else {
+        push @commands, [@make_cmd, $make_job, $jobs, $target];
+      }
+    }
+
+  } else { # single process "make"
+
+    # Setup the "make" command
+    push @commands, [@make_cmd, @targets];
+
+  }
+  
+  # Run the make command
+  my $rc  = 0;
+  my $cwd = cwd;
+  print 'cd ', $self->{DIR}{BLD}, "\n" if $verbose > 2;
+  chdir $self->{DIR}{BLD};
+  while (my $cmd = shift @commands) {
+    $| = 1; # flush STDOUT before running "make"
+    print timestamp_command (&get_command_string ($cmd)) if $verbose > 2;
+    $| = 0;
+    &run_command ($cmd, ERROR => 'warn', RC => \$rc);
+    print timestamp_command (&get_command_string ($cmd), 'End') if $verbose > 2;
+    last if $rc;
+  }
+  print 'cd ', $cwd, "\n" if $verbose > 2;
+  chdir $cwd;
+
+  return $rc ? undef : 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_remove_empty_dirs ();
+#
+# DESCRIPTION
+#   This internal method removes empty build directories.
+# ------------------------------------------------------------------------------
+
+sub _remove_empty_dirs {
+  my $self = shift;
+
+  for my $name (qw/BIN CACHE DONE ETC FLAGS INC LIB PPSRC OBJ TMP/) {
+    opendir DIR, $self->{DIR}{$name};
+    my @files = readdir DIR;
+    @files    = grep !/^\.\.?$/, @files;
+    closedir DIR;
+
+    if (not @files) {
+      print 'Remove directory: ', $self->{DIR}{$name}, "\n"
+        if $self->config->verbose > 1;
+      rmdir $self->{DIR}{$name};
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_tar_build_dirs ();
+#
+# DESCRIPTION
+#   This internal method creates TAR archives for selected build directories.
+# ------------------------------------------------------------------------------
+
+sub _tar_build_dirs {
+  my $self = shift;
+
+  # Create TAR archives if necessary
+  my $cwd = cwd;
+
+  my $tar      = $self->config->setting (qw/OUTFILE_EXT TAR/);
+  my @tar_dirs = split /,/, $self->config->setting (qw/TAR_DIRS/);
+  my $verbose  = $self->config->verbose;
+
+  for my $name (@tar_dirs) {
+    my $dir = $self->{DIR}{$name};
+
+    if (-d $dir) {
+      my $base = basename ($dir);
+      print 'cd ', dirname ($dir), "\n" if $verbose > 2;
+      chdir dirname ($dir);
+
+      my $rc = &run_command (
+        [qw/tar -c -f/, $base . $tar, $base],
+        PRINT => $verbose > 1, ERROR => 'warn',
+      );
+
+      &run_command ([qw/rm -rf/, $base], PRINT => $verbose > 1) if not $rc;
+    }
+  }
+
+  print 'cd ', $cwd, "\n" if $verbose > 2;
+  chdir $cwd;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_create_runenv_script ();
+#
+# DESCRIPTION
+#   This internal method creates the runtime environment script if necessary.
+# ------------------------------------------------------------------------------
+
+sub _create_runenv_script {
+  my $self = shift;
+
+  # More diagnostic on how to use the build
+  my @bin_dirs = grep {-d} @{ $self->{PATH}{BIN} };
+  my $etc_dir  = -d $self->{DIR}{ETC} ? $self->{DIR}{ETC} : undef;
+
+  if (@bin_dirs or $etc_dir) {
+    # Create a runtime environment script if necessary
+    my $run_env_sh_base = $self->config->setting (qw/MISC RUN_ENV_SH/);
+    my $run_env_sh      = catfile $self->{DIR}{ROOT}, $run_env_sh_base;
+
+    open FILE, '>', $run_env_sh
+      or croak $run_env_sh, ': cannot open (', $!, '), abort';
+    print FILE '#!/usr/bin/ksh', "\n";
+    print FILE 'export PATH=', join (':', @bin_dirs), ':$PATH', "\n"
+      if @bin_dirs;
+    print FILE 'export FCM_ETCDIR=', $self->{DIR}{ETC}, "\n" if $etc_dir;
+    close FILE or croak $run_env_sh, ': cannot close (', $!, '), abort';
+
+    # Create symbolic link in bin/ sub-directory for backward compatibility
+    if (-d $self->{DIR}{BIN}) {
+      my $file = catfile ($self->{DIR}{BIN}, $run_env_sh_base);
+      
+      # Remove old link if necessary
+      unlink $file if -l $file and readlink ($file) ne $run_env_sh;
+
+      # Create the new link
+      symlink $run_env_sh, $file if not -l $file;
+    }
+
+    # Information on the location/usage of the runtime environment script
+    if ($self->config->verbose > 1 and $run_env_sh) {
+      print '# ', '-' x 78, "\n";
+      print '# To use this build, source the following shell script:', "\n";
+      print '. ', $run_env_sh, "\n";
+      print '# ', '-' x 78, "\n";
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_create_lib_excl_dep ();
+#
+# DESCRIPTION
+#   This internal method creates a set of exclude dependency configurations for
+#   libraries of this build.
+# ------------------------------------------------------------------------------
+
+sub _create_lib_excl_dep {
+  my $self = shift;
+
+  if (-d $self->{DIR}{LIB}) {
+    $self->_create_build_dir ('ETC');
+    
+    my %allpcks  = $self->allpcks;
+    my $cfgext   = $self->config->setting (qw/OUTFILE_EXT CFG/);
+    my %cfglabel = %{ $self->config->setting ('CFG_LABEL') };
+
+    for my $key (reverse sort keys %allpcks) {
+      my $outcfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+      # Include configurations from sub-packages
+      for my $subpck (@{ $allpcks{$key} }) {
+        my $base = 'lib' . $subpck . $cfgext;
+        ($base = $self->{LIB}{$subpck}) =~ s/\.\w+$/$cfgext/
+          if exists ($self->{LIB}{$subpck});
+        my $file = catfile ('$HERE', $base);
+
+        $outcfg->add_line (LABEL => $cfglabel{INC}, VALUE => $file)
+          if -r catfile ($self->{DIR}{ETC}, $base);;
+      }
+
+      # Exclude dependency for source files in current package
+      if (exists $self->{PACKAGE}{$key}) {
+        my @srcfiles = $self->{PACKAGE}{$key}->srcfile;
+
+        for my $srcfile (@srcfiles) {
+          if ($srcfile->is_type ('INCLUDE')) {
+            if ($srcfile->is_type ('CPP')) {
+              $outcfg->add_line (
+                LABEL => $cfglabel{EXCL_DEP},
+                VALUE => 'H::' . $srcfile->base,
+              );
+
+            } elsif ($srcfile->is_type ('INTERFACE')) {
+              $outcfg->add_line (
+                LABEL => $cfglabel{EXCL_DEP},
+                VALUE => 'INTERFACE::' . $srcfile->base,
+              );
+
+            } else {
+              $outcfg->add_line (
+                LABEL => $cfglabel{EXCL_DEP},
+                VALUE => 'INC::' . $srcfile->base,
+              );
+            }
+
+          } elsif ($srcfile->is_type ('SOURCE')) {
+            next if $srcfile->is_type_or (qw/PROGRAM BLOCKDATA/);
+
+            if ($srcfile->is_type ('FORTRAN')) {
+              if ($srcfile->is_type (qw/FORTRAN MODULE/)) {
+                $outcfg->add_line (
+                  LABEL => $cfglabel{EXCL_DEP},
+                  VALUE => 'USE::' . $srcfile->root,
+                );
+
+              } else {
+                $outcfg->add_line (
+                  LABEL => $cfglabel{EXCL_DEP},
+                  VALUE => 'INTERFACE::' . $srcfile->interfacebase,
+                ) if $srcfile->interfacebase;
+
+                $outcfg->add_line (
+                  LABEL => $cfglabel{EXCL_DEP},
+                  VALUE => 'OBJ::' . $srcfile->root,
+                );
+              }
+
+            } else {
+              $outcfg->add_line (
+                LABEL => $cfglabel{EXCL_DEP},
+                VALUE => 'OBJ::' . $srcfile->root,
+              );
+            }
+          }
+        }
+      }
+
+      # Name of configuration file, follows the name of library
+      my $outbase ='lib' . $key . $cfgext;
+      ($outbase = $self->{LIB}{$key}) =~ s/\.\w+$/$cfgext/
+        if exists ($self->{LIB}{$key});
+      my $outfile = catfile ($self->{DIR}{ETC}, $outbase);
+
+      # Write to configuration file
+      $outcfg->print_cfg ($outfile);
+    }
+
+    # Information on the location/usage of the exclude dependency configurations
+    if ($self->config->verbose > 1) {
+      my $etcdir = $self->{DIR}{ETC};
+      print '# ', '-' x 78, "\n";
+      print <<EOF;
+# To use a library archive of this build in another FCM build, you need to
+# include in the new build configuration the corresponding configuration file
+# that has the relevant exclude dependency information. These configurations
+# files can be found in $etcdir.
+EOF
+      print '# ', '-' x 78, "\n";
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_create_build_dir ();
+#   $self->_create_build_dir ($label);
+#
+# DESCRIPTION
+#   This internal method creates a build directory. If $label is specified,
+#   the method will attempt to create a named sub-directory according to
+#   $label. Otherwise, the method attempts to create the build root
+#   directory. Returns the name of the directory if it is created successfully
+#   or if it already exists.
+# ------------------------------------------------------------------------------
+
+sub _create_build_dir {
+  my $self  = shift;
+  my $label = $_[0] ? uc $_[0] : 'ROOT';
+
+  my $dir = undef;
+
+  # Make sure the variable is set
+  if ($self->{DIR}{$label}) {
+    $dir = $self->{DIR}{$label};
+
+    # Expand relative path if necessary
+    $dir = catfile $self->{DIR}{ROOT}, $dir if $dir =~ /^\w/;
+
+  } else {
+    if ($label eq 'ROOT') {
+      w_report 'Error: build root directory not set.';
+      return;
+
+    } elsif ($self->config->setting ('DIR', $label)) {
+      $dir = catfile $self->{DIR}{ROOT}, $self->config->setting ('DIR', $label);
+
+    } else {
+      carp 'Directory label "', $label, '" not recognised';
+      return undef;
+    }
+  }
+
+  # Set up the bld directory, if required
+  if (not -d $dir) {
+    print 'Make directory: ', $dir, "\n" if $self->config->verbose > 1;
+    mkpath $dir or croak 'Cannot create directory "', $dir, '"';
+  }
+
+  $self->{DIR}{$label} = $dir unless $self->{DIR}{$label};
+
+  return $dir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_inherited_paths ($name);
+#
+# DESCRIPTION
+#   This recursive internal method returns a list containing the search path
+#   for a build directory named by the internal label $name. (Please note that
+#   a build directory will only be placed into the search path if the
+#   directory exists.)
+# ------------------------------------------------------------------------------
+
+sub _get_inherited_paths {
+  my $self = shift;
+  my $name = shift;
+
+  return () unless $name and exists $self->{DIR}{$name};
+
+  my @path = ();
+
+  # Recursively inherit the search path for a this type of build directory
+  for my $use (@{ $self->{USE} }) {
+    my @cur_path = $use->_get_inherited_paths ($name);
+    unshift @path, @cur_path;
+  }
+
+  # Place the path of the current build in the front
+  unshift @path, $self->{DIR}{$name};
+
+  return @path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_inherited_srcdirs ($name);
+#
+# DESCRIPTION
+#   This recursive internal method returns a list containing the search path
+#   for a source directory named by the internal package label $name. (Please
+#   note that a source directory will only be placed into the search path if
+#   the directory exists.)
+# ------------------------------------------------------------------------------
+
+sub _get_inherited_srcdirs {
+  my $self = shift;
+  my $name = shift;
+
+  return () unless $name;
+
+  my @path = ();
+
+  # Recursively inherit the search path for this source directory
+  my $key = 'SRCDIR__' . $name;
+  if ($self->_inherit_ok ($key)) {
+    for my $use (@{ $self->{USE} }) {
+      my @cur_path = $use->_get_inherited_srcdirs ($name);
+      unshift @path, @cur_path;
+    }
+  }
+
+  # Place the path of the current source in the front
+  unshift @path, $self->{SRCDIR}{$name}
+    if exists $self->{SRCDIR}{$name} and -d $self->{SRCDIR}{$name};
+
+  return @path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_inherited_items ($type);
+#
+# DESCRIPTION
+#   This recursive internal method returns a list containing an inherited
+#   build item of the type $type. (Depending of $type, the returned list can
+#   be an array or a hash.)
+# ------------------------------------------------------------------------------
+
+sub _get_inherited_items {
+  my $self = shift;
+  my $type = shift;
+
+  return () if not exists $self->{$type};
+
+  if (ref $self->{$type} eq 'ARRAY') {
+
+    my @items = ();
+
+    # Recursively inherit from used builds
+    if ($self->{INHERIT}{$type}) {
+      for my $use (@{ $self->{USE} }) {
+        my @cur_items = $use->_get_inherited_items ($type);
+
+        for my $item (@cur_items) {
+          my $type_item = $type . '__' . $item;
+
+          # Check inheritance option of current item
+          next unless $self->_inherit_ok ($type_item);
+
+          # The statement ensures that there is no duplication
+          push @items, $item unless grep {$_ eq $item} @items;
+        }
+      }
+    }
+
+    # Items in current build
+    if (@{ $self->{$type} }) {
+      for my $item (@{ $self->{$type} }) {
+        # The statement ensures that there is no duplication
+        push @items, $item unless grep {$_ eq $item} @items;
+      }
+    }
+
+    return @items;
+
+  } elsif (ref $self->{$type} eq 'HASH') {
+
+    my %items = ();
+
+    # Recursively inherit from used builds
+    if ($self->{INHERIT}{$type}) {
+      for my $use (@{ $self->{USE} }) {
+        my %cur_items = $use->_get_inherited_items ($type);
+
+        for my $name (keys %cur_items) {
+          my $type_name = $type . '__' . $name;
+
+          # Check inheritance option of current item
+          next unless $self->_inherit_ok ($type_name);
+
+          # "Closer" ancestors overrides more "distant" ones
+          $items{$name} = $cur_items{$name};
+        }
+      }
+    }
+
+    # Items in current build
+    if (%{ $self->{$type} }) {
+      for my $name (keys %{ $self->{$type} }) {
+        # Settings in current build override inherited settings
+        $items{$name} = $self->{$type}{$name};
+      }
+    }
+
+    return %items;
+
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_require_pp ($name);
+#
+# DESCRIPTION
+#   This internal method returns true if source package $name requires
+#   pre-processing.
+# ------------------------------------------------------------------------------
+
+sub _require_pp {
+  my $self = shift;
+  my $name = $_[0];
+
+  my $rc    = 0;
+  my @names = 'PP';
+  push @names, (split /__/, $name);
+
+  # Check whether pre-process flag exists, going up the source package hierarchy
+  do {
+    my $cur_name = join '__', @names;
+    if (exists $self->{PP}{$cur_name}) {
+      $rc = $self->{PP}{$cur_name};
+      return $rc;
+    }
+  } while pop @names;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_inherit_ok ($name);
+#
+# DESCRIPTION
+#   This internal method returns true if it is OK to inherit an item specified
+#   by $name, (where $name is a double underscore "__" delimited positional
+#   list of source package names).
+# ------------------------------------------------------------------------------
+
+sub _inherit_ok {
+  my $self  = shift;
+  my $name  = $_[0];
+
+  my $rc    = 1;
+  my @names = split /__/, $name;
+
+  # Check whether INHERIT flag exists, going up the source package hierarchy
+  do {
+    my $cur_name = join '__', @names;
+    if (exists $self->{INHERIT}{$cur_name}) {
+      $rc = $self->{INHERIT}{$cur_name};
+      return $rc;
+    }
+  } while pop @names;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/BuildTask.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/BuildTask.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/BuildTask.pm	(revision 5166)
@@ -0,0 +1,406 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::BuildTask
+#
+# DESCRIPTION
+#   This class hosts information of a build task in the FCM build system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::BuildTask;
+
+# Standard pragma
+use strict;
+use warnings;
+
+# Standard modules
+use Carp;
+use File::Compare;
+use File::Basename;
+use File::Path;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $task = Fcm::BuildTask->new (
+#     CONFIG     => $config,
+#     TARGET     => $target,
+#     TARGETPATH => \@targetpath,
+#     SRCFILE    => $srcfile,
+#     DEPENDENCY => \@dependency,
+#     TASKTYPE   => $tasktype,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::BuildTask class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   TARGET     - target name for this task
+#   TARGETPATH - search path for the target
+#   SRCFILE    - reference to input Fcm::SrcFile instance
+#   DEPENDENCY - list of dependencies for this target
+#   TASKTYPE   - type of task to build the target
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self  = {
+    CONFIG      => exists $args{CONFIG}     ? $args{CONFIG}     : &main::cfg,
+    TARGET      => exists $args{TARGET}     ? $args{TARGET}     : undef,
+    TARGETPATH  => exists $args{TARGETPATH} ? $args{TARGETPATH} : [],
+    SRCFILE     => exists $args{SRCFILE}    ? $args{SRCFILE}    : undef,
+    DEPENDENCY  => exists $args{DEPENDENCY} ? $args{DEPENDENCY} : [],
+    ACTIONTYPE  => exists $args{ACTIONTYPE} ? $args{ACTIONTYPE} : undef,
+
+    OUTPUT      => undef,
+    OUTPUTMTIME => undef,
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $task->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcfile = $task->srcfile;
+#   $task->srcfile ($srcfile);
+#
+# DESCRIPTION
+#   This method returns the reference to the input Fcm::SrcFile instance
+#   associated with this task. If an argument is specified, the reference is
+#   modified to the value given by the argument.
+# ------------------------------------------------------------------------------
+
+sub srcfile {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SRCFILE} = $_[0];
+  }
+
+  return $self->{SRCFILE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $actiontype = $task->actiontype;
+#   $task->actiontype ($actiontype);
+#
+# DESCRIPTION
+#   This method returns the action type of this task. If an argument is
+#   specified, the action type of this task is set to the value of the
+#   argument.
+# ------------------------------------------------------------------------------
+
+sub actiontype {
+  my $self = shift;
+
+  if (@_) {
+    $self->{ACTIONTYPE} = $_[0];
+  }
+
+  return $self->{ACTIONTYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $output = $task->output;
+#   $task->output ($output);
+#
+# DESCRIPTION
+#   This method returns the name of the output file after the task has been
+#   performed successfully. If an argument is specified, it sets the output
+#   file (and its last modified time) to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub output {
+  my $self = shift;
+
+  if (@_) {
+    $self->{OUTPUT}      = $_[0];
+    $self->{OUTPUTMTIME} = (stat $self->{OUTPUT}) [9];
+  }
+
+  return $self->{OUTPUT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $time = $task->outputmtime;
+#
+# DESCRIPTION
+#   This method returns the modified time of the output file.
+# ------------------------------------------------------------------------------
+
+sub outputmtime {
+  my $self = shift;
+
+  return $self->{OUTPUTMTIME};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $task->action (TASKLIST => \%tasklist);
+#
+# DESCRIPTION
+#   This method performs the task action and sets the output accordingly. The
+#   argument TASKLIST must be a reference to a hash containing the other tasks
+#   of the build, which this task may depend on. The keys of the hash must the
+#   name of the target names of the tasks, and the values of the hash must be
+#   the references to the corresponding Fcm::BuildTask instances. The method
+#   returns true if the task has been performed to create a new version of the
+#   target.
+# ------------------------------------------------------------------------------
+
+sub action {
+  my $self     = shift;
+  my %args     = @_;
+  my $tasklist = exists $args{TASKLIST} ? $args{TASKLIST} : {};
+
+  return unless $self->actiontype;
+
+  my $uptodate     = 1;
+  my $dep_uptodate = 1;
+
+  # Check if dependencies are up to date
+  # ----------------------------------------------------------------------------
+  for my $depend (@{ $self->{DEPENDENCY} }) {
+    if (exists $tasklist->{$depend}) {
+      if (not $tasklist->{$depend}->output) {
+        # Dependency task output is not set, performs its task action
+        if ($tasklist->{$depend}->action (TASKLIST => $tasklist)) {
+          $uptodate     = 0;
+          $dep_uptodate = 0;
+        }
+      }
+
+    } elsif ($self->config->verbose > 1) {
+      w_report 'Warning: Task for "', $depend,
+               '" does not exist, may be required by ', $self->{TARGET};
+    }
+  }
+
+  # Check if the target exists in the search path
+  # ----------------------------------------------------------------------------
+  if (@{ $self->{TARGETPATH} }) {
+    my $output = find_file_in_path ($self->{TARGET}, $self->{TARGETPATH});
+    $self->output ($output) if $output;
+  }
+
+  # Target is out of date if it does not exist
+  if ($uptodate) {
+    $uptodate = 0 if not $self->output;
+  }
+
+  # Check if current target is older than its dependencies
+  # ----------------------------------------------------------------------------
+  if ($uptodate) {
+    for my $depend (@{ $self->{DEPENDENCY} }) {
+      next unless exists $tasklist->{$depend};
+
+      if ($tasklist->{$depend}->outputmtime > $self->outputmtime) {
+        $uptodate     = 0;
+        $dep_uptodate = 0;
+      }
+    }
+
+    if ($uptodate and ref $self->srcfile) {
+      $uptodate = 0 if $self->srcfile->mtime > $self->outputmtime;
+    }
+  }
+
+  if ($uptodate) {
+    # Current target and its dependencies are up to date
+    # --------------------------------------------------------------------------
+    if ($self->actiontype eq 'PP') {
+      # "done" file up to date, set name of pre-processed source file
+      # ------------------------------------------------------------------------
+      my $base     = $self->srcfile->root . lc ($self->srcfile->ext);
+      my @pck_list = $self->srcfile->get_package_list;
+      pop @pck_list;
+      my @pknames  = split '__', pop (@pck_list);
+      my @path     = map {
+        catfile ($_, @pknames);
+      } @{ $self->config->setting (qw/PATH PPSRC/) };
+      my $oldfile = find_file_in_path ($base, \@path);
+      $self->srcfile->ppsrc ($oldfile);
+    }
+
+  } else {
+    # Perform action is not up to date
+    # --------------------------------------------------------------------------
+    # (For GENINTERFACE and PP, perform action if "done" file not up to date)
+    my $new_output = @{ $self->{TARGETPATH} }
+                     ? catfile ($self->{TARGETPATH}[0], $self->{TARGET})
+                     : $self->{TARGET};
+
+    # Create destination container directory if necessary
+    my $destdir = dirname $new_output;
+
+    if (not -d $destdir) {
+      print 'Make directory: ', $destdir, "\n" if $self->config->verbose > 2;
+      mkpath $destdir;
+    }
+
+    # List of actions
+    if ($self->actiontype eq 'UPDATE') {
+      # Action is UPDATE: Update file
+      # ------------------------------------------------------------------------
+      print 'Update: ', $new_output, "\n" if $self->config->verbose > 2;
+      touch_file $new_output
+        or croak 'Unable to update "', $new_output, '", abort';
+      $self->output ($new_output);
+
+    } elsif ($self->actiontype eq 'COPY') {
+      # Action is COPY: copy file to destination if necessary
+      # ------------------------------------------------------------------------
+      my $copy_required = ($dep_uptodate and $self->output and -r $self->output)
+                          ? compare ($self->output, $self->srcfile->src)
+                          : 1;
+
+      if ($copy_required) {
+        # Set up copy command
+        &run_command (
+          ['cp', $self->srcfile->src, $destdir],
+          TIME => $self->config->verbose > 2,
+        );
+
+        $self->output ($new_output);
+
+      } else {
+        $uptodate = 1;
+      }
+
+    } elsif ($self->actiontype eq 'PP' or $self->actiontype eq 'GENINTERFACE') {
+      # Action is PP or GENINTERFACE: process file
+      # ------------------------------------------------------------------------
+      my ($newlines, $base, @path);
+
+      if ($self->actiontype eq 'PP') {
+        # Invoke the pre-processor on the source file
+        # ----------------------------------------------------------------------
+        # Get lines in the pre-processed source
+        $newlines = $self->srcfile->pre_process;
+        $base     = $self->srcfile->root . lc ($self->srcfile->ext);
+
+        # Get search path for the existing pre-processed file
+        my @pck_list = $self->srcfile->get_package_list;
+        pop @pck_list;
+        my @pknames  = split '__', pop (@pck_list);
+        @path        = map {
+          catfile ($_, @pknames);
+        } @{ $self->config->setting (qw/PATH PPSRC/) };
+
+      } else { # if ($self->actiontype eq 'GENINTERFACE')
+        # Invoke the interface generator
+        # ----------------------------------------------------------------------
+        # Get new interface lines
+        $newlines = $self->srcfile->gen_interface;
+
+        # Get search path for the existing interface file
+        $base     = $self->srcfile->interfacebase;
+        @path     = @{ $self->config->setting (qw/PATH INC/) },
+      }
+
+
+      # If pre-processed or interface file exists,
+      # compare its content with new lines to see if it has been updated
+      my $update_required = 1;
+      my $oldfile = find_file_in_path ($base, \@path);
+
+      if ($oldfile and -r $oldfile) {
+        # Read old file
+        open FILE, '<', $oldfile;
+        my @oldlines = readline 'FILE';
+        close FILE;
+
+        # Compare old contents and new contents
+        if (@oldlines eq @$newlines) {
+          $update_required = grep {
+            $oldlines[$_] ne $newlines->[$_];
+          } (0 .. $#oldlines);
+        }
+      }
+
+      if ($update_required) {
+        # Update the pre-processed source or interface file
+        # ----------------------------------------------------------------------
+        # Determine container directory of the  pre-processed or interface file
+        my $newfile = @path ? catfile ($path[0], $base) : $base;
+
+        # Create the container directory if necessary
+        if (not -d $path[0]) {
+          print 'Make directory: ', $path[0], "\n"
+            if $self->config->verbose > 1;
+          mkpath $path[0];
+        }
+
+        # Update the pre-processor or interface file
+        open FILE, '>', $newfile
+          or croak 'Cannot write to "', $newfile, '" (', $!, '), abort';
+        print FILE @$newlines;
+        close FILE
+          or croak 'Cannot write to "', $newfile, '" (', $!, '), abort';
+        print 'Generated: ', $newfile, "\n" if $self->config->verbose > 1;
+
+        # Set the name of the pre-processed file
+        $self->srcfile->ppsrc ($newfile) if $self->actiontype eq 'PP';
+
+        # Set the "current" flag of the container source package to "true"
+        $self->srcfile->srcpackage->current (1);
+
+      } else {
+        # Content in pre-processed source or interface file is up to date
+        # ----------------------------------------------------------------------
+        $uptodate = 1;
+
+        # Set the name of the pre-processed file
+        $self->srcfile->ppsrc ($oldfile) if $self->actiontype eq 'PP';
+      }
+
+      # Update the "done" file
+      print 'Update: ', $new_output, "\n" if $self->config->verbose > 2;
+      touch_file $new_output
+        or croak 'Unable to update "', $new_output, '", abort';
+      $self->output ($new_output);
+
+    } else {
+      carp 'Action type "', $self->actiontype, "' not supported";
+    }
+  }
+
+  return not $uptodate;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CfgFile.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CfgFile.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CfgFile.pm	(revision 5166)
@@ -0,0 +1,861 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CfgFile
+#
+# DESCRIPTION
+#   This class is used for reading and writing FCM config files. A FCM config
+#   file is a line-based text file that provides information on how to perform
+#   a particular task using the FCM system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CfgFile;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Basename;
+use File::Path;
+use File::Spec;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::Util;
+
+# Local module variables
+my $expand_type   = 'bld|ext'; # config file type that needs variable expansions
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile = Fcm::CfgFile->new (CONFIG=> $config, SRC => $src, TYPE => $type);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CfgFile class.
+#
+# ARGUMENTS
+#   CONFIG - reference to a Fcm::Config instance
+#   SRC    - configuration file source
+#   TYPE   - type of expected configuration file
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG     => exists $args{CONFIG} ? $args{CONFIG} : &main::cfg,
+    SRC        => exists $args{SRC}    ? $args{SRC}    : undef,
+    TYPE       => exists $args{TYPE}   ? $args{TYPE}   : undef,
+
+    # Version of the configuration file
+    VERSION    => undef,
+
+    # List of references to hash tables for each line in the file
+    LINES      => [],
+
+    # Actual source of configuration file
+    ACTUAL_SRC => undef,
+    PEGREV     => undef,
+  };
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $cfgfile->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $src = $cfgfile->src ();
+#   $cfgfile->src ($src);
+#
+# DESCRIPTION
+#   This method returns the specified source of the configuration file. If an
+#   argument is specified, the source of the configuration file is modified to
+#   the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub src {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SRC} = shift;
+  }
+
+  return $self->{SRC};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $src = $cfgfile->actual_src ();
+#
+# DESCRIPTION
+#   This method returns the actual source of the configuration file. If an
+#   argument is specified, the source of the configuration file is modified to
+#   the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub actual_src {
+  my $self = shift;
+
+  return $self->{ACTUAL_SRC};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cfgfile->pegrev ();
+#
+# DESCRIPTION
+#   This method returns the peg revision of the configuration file.
+# ------------------------------------------------------------------------------
+
+sub pegrev {
+  my $self = shift;
+
+  return $self->{PEGREV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $cfgfile->type ();
+#   $cfgfile->type ($type);
+#
+# DESCRIPTION
+#   This method returns the configuration file type. If an argument is
+#   specified, the type is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub type {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TYPE} = shift;
+  }
+
+  return $self->{TYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version = $cfgfile->version ();
+#
+# DESCRIPTION
+#   This method returns the version of the configuration file.
+# ------------------------------------------------------------------------------
+
+sub version {
+  my $self = shift;
+
+  return $self->{VERSION};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @lines = $cfgfile->lines ();
+#
+# DESCRIPTION
+#   This method returns an array containing all "lines" in the configuration
+#   file. Each "line" is a reference to a hash table with the following keys:
+#
+#   SRC     - the source of the configuration file
+#   NUMBER  - the line number in the source
+#   LABEL   - the label of the of the configuration line
+#   VALUE   - the value of the configuration line
+#   COMMENT - comment in the configuration line
+# ------------------------------------------------------------------------------
+
+sub lines {
+  my $self = shift;
+
+  return @{ $self->{LINES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $line = $cfgfile->line ($line_number);
+#
+# DESCRIPTION
+#   This method return a "line" at $line_number in the configuration file. A
+#   "line" is a reference to a hash table with the following keys:
+#
+#   SRC     - the source of the configuration file
+#   NUMBER  - the line number in the source
+#   LABEL   - the label of the of the configuration line
+#   VALUE   - the value of the configuration line
+#   COMMENT - comment in the configuration line
+# ------------------------------------------------------------------------------
+
+sub line {
+  my $self     = shift;
+  my $line_num = shift;
+
+  if (exists $self->{LINES}[$line_num]) {
+    return $self->{LINES}[$line_num]; # returns a ref to a label:value pair hash
+
+  } else {
+    return undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile->add_line (
+#     LABEL   => $label,
+#     VALUE   => $value,
+#     COMMENT => $comment,
+#     SRC     => $src,
+#     NUMBER  => $line_number
+#   );
+#
+# DESCRIPTION
+#   This method adds a "line" to the configuration file. LABEL is the
+#   configuration line label. VALUE is the configuration line value. COMMENT
+#   is the comment in the line. VALUE should only be specified if LABEL is
+#   specified. COMMENT can be specified without LABEL. In such case, the whole
+#   line is a comment line. A blank line is inserted if no argument is
+#   specified. SRC can be specified to indicate the name of the source file
+#   from which this line is obtained. If not specified, the source file of the
+#   current configuration file is used. NUMBER can be specified to indicate
+#   the line number of the source file from which this line is obtained.
+# ------------------------------------------------------------------------------
+
+sub add_line {
+  my $self = shift;
+  my %args = @_;
+
+  my $line = {
+    SRC     => exists $args{SRC    } ? $args{SRC    } : $self->actual_src,
+    NUMBER  => exists $args{NUMBER } ? $args{NUMBER } : 0,
+    LABEL   => exists $args{LABEL  } ? $args{LABEL  } : '',
+    VALUE   => exists $args{VALUE  } ? $args{VALUE  } : '',
+    COMMENT => exists $args{COMMENT} ? $args{COMMENT} : '',
+  };
+
+  push @{ $self->{LINES} }, $line;
+
+  return $line;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile->add_comment_block ($line1, [$line2, ...]);
+#
+# DESCRIPTION
+#   This method adds a comment block to the configuration file. Each argument
+#   represents a line in the comment block.
+# ------------------------------------------------------------------------------
+
+sub add_comment_block {
+  my $self = shift;
+
+  $self->add_line (COMMENT => '-' x 78,);
+
+  while (my $line = shift @_) {
+    $self->add_line (COMMENT => $line,)
+  }
+
+  $self->add_line (COMMENT => '-' x 78,);
+  $self->add_line;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile->add_header ();
+#
+# DESCRIPTION
+#   This method adds a header to the configuration file, with its type and
+#   type version. It returns 1 on success.
+# ------------------------------------------------------------------------------
+
+sub add_header {
+  my $self = shift;
+
+  return undef unless $self->{TYPE};
+
+  $self->{VERSION} = $self->config->setting ('CFG_VERSION', uc ($self->{TYPE}))
+    if not $self->{VERSION};
+
+  $self->add_comment_block ('File header');
+
+  $self->add_line (
+    LABEL => $self->config->setting (qw/CFG_LABEL CFGFILE TYPE/),
+    VALUE => $self->{TYPE},
+  );
+
+  $self->add_line (
+    LABEL => $self->config->setting (qw/CFG_LABEL CFGFILE VERSION/),
+    VALUE => $self->{VERSION},
+  );
+
+  $self->add_line;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $exist = $cfg->label_exists ($label);
+#   @lines = $cfg->label_exists ($label);
+#
+# DESCRIPTION
+#   This method returns the (number of) "lines" with their LABEL matching the
+#   argument $label.
+# ------------------------------------------------------------------------------
+
+sub label_exists {
+  my $self  = shift;
+  my $label = shift;
+
+  return grep {$_->{LABEL} eq $label} @{ $self->{LINES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mtime = $cfgfile->mtime ();
+#
+# DESCRIPTION
+#   This method returns the modified time of the configuration file source.
+# ------------------------------------------------------------------------------
+
+sub mtime {
+  my $self  = shift;
+  my $mtime = undef;
+
+  if (-f $self->{SRC}) {
+    $mtime = (stat $self->{SRC})[9];
+  }
+
+  return $mtime;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $read = $cfgfile->read_cfg ();
+#
+# DESCRIPTION
+#   This method reads the current configuration file. It returns the number of
+#   lines read from the config file, or "undef" if it fails. The result is
+#   placed in the LINES array of the current instance, and can be accessed via
+#   the "lines" method.
+# ------------------------------------------------------------------------------
+
+sub read_cfg {
+  my $self = shift;
+
+  my @lines = $self->_get_cfg_lines;
+
+  # List of CFG labels
+  my %cfg_labels = %{ $self->config->setting ('CFG_LABEL') };
+
+  # List of CFG types that need INC declarations expansion
+  my %exp_inc    = ();
+  for (split (/,/, $self->config->setting ('CFG_EXP_INC'))) {
+    $exp_inc{uc ($_)} = 1;
+  }
+
+  # List of CFG labels that are reserved keywords
+  my %cfg_keywords = ();
+  for (split (/,/, $self->config->setting ('CFG_KEYWORD'))) {
+    $cfg_keywords{$cfg_labels{$_}} = 1;
+  }
+
+  # Loop each line, to separate lines into label : value pairs
+  my $cont = undef;
+  my $here = undef;
+  for my $line_num (1 .. @lines) {
+    my $line = $lines[$line_num - 1];
+    chomp $line;
+
+    my $label   = '';
+    my $value   = '';
+    my $comment = '';
+
+    # If this line is a continuation, set $start to point to the line that
+    # starts this continuation. Otherwise, set $start to undef
+    my $start   = defined ($cont) ? $self->line ($cont) : undef;
+
+    if ($line =~ /^(\s*#.*)$/) { # comment line
+      $comment = $1;
+
+    } elsif ($line =~ /\S/) {    # non-blank line
+      if (defined $cont) {
+        # Previous line has a continuation mark
+        $value = $line;
+
+        # Separate value and comment
+        if ($value =~ s/((?:\s+|^)#\s+.*)$//) {
+          $comment = $1;
+        }
+
+        # Remove leading spaces
+        $value =~ s/^\s*\\?//;
+
+        # Expand environment variables
+        $value = $self->_expand_variable ($value, 1) if $value;
+
+        # Expand internal variables
+        $value = $self->_expand_variable ($value) if $value;
+
+        # Get "line" that begins the current continuation
+        ($start->{VALUE} .= $value) =~ s/\\$//;
+
+      } else {
+        # Previous line does not have a continuation mark
+        if ($line =~ /^\s*(\S+)(?:\s+(.*))?$/) {
+          # Check line contains a valid label:value pair
+          $label = $1;
+          $value = defined ($2) ? $2 : '';
+
+          # Separate value and comment
+          if ($value =~ s/((?:\s+|^)#\s+.*)$//) {
+            $comment = $1;
+          }
+
+          # Remove trailing spaces
+          $value =~ s/\s+$//;
+
+          # Value begins with $HERE?
+          $here  = ($value =~ /\$\{?HERE\}?(?:[^A-Z_]|$)/);
+
+          # Expand environment variables
+          $value = $self->_expand_variable ($value, 1) if $value;
+
+          # Expand internal variables
+          $value = $self->_expand_variable ($value) if $value;
+        }
+      }
+
+      # Determine whether current line ends with a continuation mark
+      if ($value =~ s/\\$//) {
+        $cont = scalar ($self->lines) unless $cont;
+
+      } else {
+        $cont = undef;
+      }
+    }
+
+    if (exists $exp_inc{uc ($self->type)} and
+        uc ($start ? $start->{LABEL} : $label) eq $cfg_labels{INC} and
+        not defined $cont) {
+      # Current configuration file requires expansion of INC declarations
+      # The start/current line is an INC declaration
+      # The current line is not a continuation or is the end of the continuation
+
+      # Get lines from an "include" configuration file
+      my $src = ($start ? $start->{VALUE} : $value);
+      $src   .= '@' . $self->pegrev if $here and $self->pegrev;
+
+      if ($src) {
+        # Invoke a new instance to read the source
+        my $cfg = Fcm::CfgFile->new (
+          SRC    => expand_tilde ($src),
+          TYPE   => $self->type,
+          CONFIG => $self->config,
+        );
+
+        $cfg->read_cfg;
+
+        # Add lines to the "LINES" array in the current configuration file
+        $comment = 'INC ' . $src . ' ';
+        $self->add_line (
+          COMMENT => $comment . '# Start',
+          NUMBER  => ($start ? $start->{NUMBER} : $line_num),
+        );
+        $self->add_line (%{ $_ }) for (($cfg->lines));
+        $self->add_line (COMMENT => $comment . '# End');
+
+      } else {
+        $self->add_line (NUMBER  => $line_num);
+        w_report 'Warning: ', $self->actual_src, ': line ', $line_num,
+                 ': empty INC declaration.' if $self->config->verbose > 2;
+      }
+
+    } else {
+      # Push label:value pair into "LINES" array
+      $self->add_line (
+        LABEL   => $label,
+        VALUE   => ($label ? $value : ''),
+        COMMENT => $comment,
+        NUMBER  => $line_num,
+      );
+    }
+
+    next if defined $cont; # current line not a continuation
+
+    my $slabel = ($start ? $start->{LABEL} : $label);
+    my $svalue = ($start ? $start->{VALUE} : $value);
+    next unless $slabel;
+
+    # Check config file type and version
+    if (uc ($slabel) eq $cfg_labels{CFGFILE}{TYPE}) {
+      $self->type ($svalue);
+
+    } elsif (uc ($slabel) eq $cfg_labels{CFGFILE}{VERSION}) {
+      $self->version ($svalue);
+    }
+
+    # Set internal variable
+    $slabel =~ s/^\%//; # Remove leading "%" from label
+
+    $self->config->assign_variable (
+      LABEL => $slabel,
+      VALUE => $svalue,
+    ) unless exists $cfg_keywords{$slabel};
+  }
+
+  return $self->lines;
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $cfgfile->print_cfg ($file);
+#
+# DESCRIPTION
+#   This method prints the content of current configuration file. If no
+#   argument is specified, it prints output to the standard output. If $file
+#   is specified, and is a writable file name, the output is sent to the file.
+#   If the file already exists, its content is compared to the current output.
+#   Nothing will be written if the content is unchanged. Otherwise, for typed
+#   configuration files, the existing file is renamed using a prefix that
+#   contains its last modified time. The method returns 1 if there is no
+#   error.
+# ------------------------------------------------------------------------------
+
+sub print_cfg {
+  my $self = shift;
+  my $file = shift;
+
+  # Count maximum number of characters in the labels, (for pretty printing)
+  my $max_label_len = 0;
+  for my $line (@{ $self->{LINES} }) {
+    next unless $line->{LABEL};
+    my $label_len  = length $line->{LABEL};
+    $max_label_len = $label_len if $label_len > $max_label_len;
+  }
+
+  # Output string
+  my $out = '';
+
+  # Append each line of the config file to the output string
+  for my $line (@{ $self->{LINES} }) {
+    my $label   = $line->{LABEL};
+    my $value   = $line->{VALUE};
+    my $comment = $line->{COMMENT};
+
+    if ($label) {
+      # Line up label/value for pretty printing
+      $label   = $label . ' ' x ($max_label_len - length ($label));
+      $comment =~ s/^\s+/ / if $comment;
+
+      $out .= $label;
+      $out .= ' ' . $value if defined $value;
+
+    } else {
+      # Make sure comments begin with a "#"
+      $comment = '# ' . $comment if $comment and $comment !~ /^\s*($|#)/;
+      $comment =~ s/^\s*//;
+    }
+
+    $out .= $comment if $comment;
+    $out .= "\n";
+  }
+
+  if ($out) {
+
+    my $old_select = select;
+
+    # Open file if necessary
+    if ($file) {
+      # Make sure the host directory exists and is writable
+      my $dirname = dirname $file;
+      if (not -d $dirname) {
+        print 'Make directory: ', $dirname, "\n" if $self->config->verbose;
+        mkpath $dirname;
+      }
+      croak 'Cannot write to config file directory: "', $dirname, '", abort'
+        unless -d $dirname and -w $dirname;
+
+      # If config file already exists, make sure it is writable
+      if (-f $file) {
+        if (-r $file) {
+          # Read old config file to see if content has changed
+          open IN, '<', $file;
+          my $in_lines = '';
+          while (my $line = <IN>) {
+            $in_lines .= $line;
+          }
+          close IN;
+
+          # Return if content is up-to-date
+          if ($in_lines eq $out) {
+            print 'No change in ', lc ($self->{TYPE}), ' cfg: ', $file,
+                  "\n" if $self->config->verbose > 1 and $self->{TYPE};
+            return;
+          }
+        }
+
+        if (-w $file) {
+          if ($self->{TYPE}) {
+            # Existing config file writable, rename it using its time stamp
+            my $mtime = (stat $file)[9];
+            my ($sec, $min, $hour, $mday, $mon, $year) = (gmtime $mtime)[0 .. 5];
+            my $timestamp = sprintf '%4d%2.2d%2.2d_%2.2d%2.2d%2.2d_',
+                            $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
+            my $oldfile   = catfile $dirname, $timestamp . basename ($file);
+            rename $file, $oldfile;
+            print 'Renamed existing ', lc ($self->{TYPE}), ' cfg: ',
+                  $oldfile, "\n" if $self->config->verbose > 1;
+          }
+        } else {
+          # Existing config file not writable, throw an error
+          croak 'Config file "', $file, '" not writable, abort';
+        }
+      }
+
+      # Open file and select file handle
+      open OUT, '>', $file
+        or croak 'Cannot write to config file "', $file, '" (', $!, '), abort';
+      select OUT;
+    }
+
+    # Print output
+    print $out;
+
+    # Close file if necessary
+    if ($file) {
+      select $old_select;
+      close OUT;
+
+      if ($self->{TYPE} and $self->config->verbose > 1) {
+        print 'Generated ', lc ($self->{TYPE}), ' cfg: ', $file, "\n";
+      } elsif ($self->config->verbose > 2) {
+        print 'Generated cfg: ', $file, "\n";
+      }
+    }
+
+  } else {
+
+    # Warn if nothing to print
+    my $warning = 'Empty configuration';
+    $warning   .= ' - nothing written to file: "' . $file . '"' if $file;
+    carp $warning if $self->{TYPE};
+
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @lines = $self->_get_cfg_lines ();
+#
+# DESCRIPTION
+#   This internal method reads from a configuration file residing in a
+#   Subversion repository or in the normal file system.
+# ------------------------------------------------------------------------------
+
+sub _get_cfg_lines {
+  my $self  = shift;
+  my @lines = ();
+
+  my $verbose = $self->config->verbose;
+
+  # Expand URL keywords if necessary
+  {
+    my $src = expand_url_keyword (URL => $self->src, CFG => $self->config);
+    $self->src ($src) if $src ne $self->src;
+  }
+
+  if (&is_url ($self->src)) {
+    # Config file resides in a SVN repository
+    # --------------------------------------------------------------------------
+    # Set URL source and version
+    my $src = $self->src;
+    my $rev = 'HEAD';
+
+    # Extract version from source if it exists
+    if ($src =~ s/@(.+)$//) {
+      $rev = $1;
+    }
+
+    # Expand revision keyword, if required
+    $rev = expand_rev_keyword (REV => $rev, URL => $src, HEAD => 1);
+
+    # Check whether URL is a config file
+    my $rc;
+    my @cmd = (qw/svn cat/, $src . '@' . $rev);
+    @lines = &run_command (
+      \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+    );
+
+    # Error in "svn cat" command
+    if ($rc) {
+      # See whether specified config file is a known type
+      my %cfgname = %{ $self->config->setting ('CFG_NAME') };
+      my $key     = uc $self->type;
+      my $file    = exists $cfgname{$key} ? $cfgname{$key} : '';
+
+      # If config file is a known type, specified URL may be a directory
+      if ($file) {
+        # Check whether a config file with a default name exists in the URL
+        my $sep  = $self->config->setting (qw/MISC DIR_SEPARATOR/);
+        my $path = $src . $sep . $file;
+        my @cmd  = (qw/svn cat/, $path . '@' . $rev);
+
+        @lines = &run_command (
+          \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+        );
+
+        # Check whether a config file with a default name exists under the "cfg"
+        # sub-directory of the URL
+        if ($rc) {
+          my $cfgdir = $self->config->setting (qw/DIR CFG/);
+          $path   = $src . $sep . $cfgdir . $sep . $file;
+          my @cmd = (qw/svn cat/, $path . '@' . $rev);
+
+          @lines  = &run_command (
+            \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+          );
+        }
+
+        $src = $path unless $rc;
+      }
+    }
+
+    if ($rc) {
+      # Error in "svn cat"
+      croak 'Unable to locate config file from "', $self->src, '", abort';
+
+    } else {
+      # Print diagnostic, if necessary
+      if ($verbose and $self->type and $self->type =~ /$expand_type/) {
+        print '# Config file (', $self->type, '): ', $src;
+        print '@', $rev if $rev;
+        print "\n";
+      }
+    }
+
+    # Record the actual source location
+    $self->{PEGREV    } = $rev;
+    $self->{ACTUAL_SRC} = $src;
+
+  } else {
+    # Config file resides in the normal file system
+    # --------------------------------------------------------------------------
+    my $src = $self->src;
+
+    if (-d $src) { # Source is a directory
+      croak 'Config file "', $src, '" is a directory, abort' if not $self->type;
+
+      # Get name of the config file by looking at the type
+      my %cfgname = %{ $self->config->setting ('CFG_NAME') };
+      my $key     = uc $self->type;
+      my $file    = exists $cfgname{$key} ? $cfgname{$key} : '';
+
+      if ($file) {
+        my $cfgdir = $self->config->setting (qw/DIR CFG/);
+
+        # Check whether a config file with a default name exists in the
+        # specified path, then check whether a config file with a default name
+        # exists under the "cfg" sub-directory of the specified path
+        if (-f catfile $self->src, $file) {
+          $src = catfile $self->src, $file;
+
+        } elsif (-f catfile ($self->src, $cfgdir, $file)) {
+          $src = catfile $self->src, $cfgdir, $file;
+
+        } else {
+          croak 'Unable to locate config file from "', $self->src, '", abort';
+        }
+
+      } else {
+        croak 'Unknown config file type "', $self->type, '", abort';
+      }
+    }
+
+    if (-r $src) {
+      open FILE, '<', $src;
+      print '# Config file (', $self->type, '): ', $src, "\n"
+        if $verbose and $self->type and $self->type =~ /$expand_type/;
+
+      @lines = readline 'FILE';
+      close FILE;
+
+    } else {
+      croak 'Unable to read config file "', $src, '", abort';
+    }
+
+    # Record the actual source location
+    $self->{ACTUAL_SRC} = $src;
+  }
+
+  return @lines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_expand_variable ($string[, $env]);
+#
+# DESCRIPTION
+#   This internal method expands variables in $string. If $env is specified
+#   and is true, it expands environment variables. Otherwise, it expands
+#   local variables.
+# ------------------------------------------------------------------------------
+
+sub _expand_variable {
+  my ($self, $string, $env) = @_;
+
+  # Pattern for environment/local variable
+  my $pattern = $env ? '\$\{?([A-Z][A-Z0-9_]+)\}?' : '%\{?([\w:]+)\}?';
+
+  while ($string and $string =~ /$pattern/) {
+    my $var_label = $1; # variable label
+
+    # Get variable value from environment or local configuration
+    my $variable = $env
+                   ? (exists $ENV{$var_label} ? $ENV{$var_label} : undef)
+                   : $self->config->variable ($var_label);
+
+    $variable = dirname ($self->actual_src)
+      if $env and $var_label eq 'HERE' and not defined $variable;
+
+    # Substitute match with value of variable
+    if (defined $variable) {
+      $string =~ s/$pattern/$variable/;
+
+    } else {
+      w_report 'Warning: ', $self->actual_src, ': variable "',
+               ($env ? '$' : '%'), $var_label, '" not expanded.';
+      last;
+    }
+  }
+
+  return $string;
+}
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Cm.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Cm.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Cm.pm	(revision 5166)
@@ -0,0 +1,2243 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Cm
+#
+# DESCRIPTION
+#   This module contains the FCM code management functionalities and wrappers
+#   to Subversion commands.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Cm;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+our (@ISA, @EXPORT, @EXPORT_OK);
+use Getopt::Long;
+use File::Basename;
+use File::Path;
+use File::Spec;
+use File::Temp qw/tempfile/;
+use Cwd;
+
+# FCM component modules
+use Fcm::CmBranch;
+use Fcm::CmUrl;
+use Fcm::Util;
+
+sub cm_command;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(
+  cm_command
+);
+
+# Function declaration:
+sub cm_add;
+sub cm_branch;
+sub cm_commit;
+sub cm_conflicts;
+sub cm_delete;
+sub cm_diff;
+sub cm_merge;
+sub cm_mkpatch;
+sub cm_svn;
+sub cm_switch;
+sub _construct_branch_url;
+
+# ------------------------------------------------------------------------------
+
+my @subcommand_url = qw/
+  blame     praise annotate ann
+  branch    br
+  cat
+  checkout  co
+  copy      cp
+  delete    del    remove   rm
+  diff      di
+  export
+  import
+  info
+  list      ls
+  lock
+  log
+  merge
+  mkdir
+  mkpatch
+  move      mv     rename   ren
+  propdel   pdel   pd
+  propedit  pedit  pe
+  propget   pget   pg
+  proplist  plist  pl
+  propset   pset   ps
+  switch    sw
+  unlock
+/; # List of subcommands that accept URL inputs
+
+my @subcommand_rev = qw/
+  blame     praise annotate ann
+  branch    br
+  cat
+  checkout  co
+  copy      cp
+  diff      di
+  export
+  info
+  list      ls
+  log
+  merge
+  mkpatch
+  move      mv     rename   ren
+  propdel   pdel   pd
+  propedit  pedit  pe
+  propget   pget   pg
+  proplist  plist  pl
+  propset   pset   ps
+  switch    sw
+  update    up
+/; # List of subcommands that accept revision inputs
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &cm_command ($function);
+#
+# DESCRIPTION
+#   This is the generic FCM code management wrapper. It calls the correct FCM
+#   code management function or a wrapper to a Subversion command based on the
+#   value of the argument $function.
+# ------------------------------------------------------------------------------
+
+sub cm_command {
+
+  my ($function) = shift @_;
+
+  # Expand URL keywords if necessary
+  if (grep {$_ eq $function} @subcommand_url) {
+    for my $arg (@ARGV) {
+      my $var = expand_url_keyword (URL => $arg);
+      $arg = $var if $arg ne $var;
+    }
+  }
+
+  # Expand revision keywords (for -r or --revision options) if necessary
+  if (grep {$_ eq $function} @subcommand_rev) {
+    my @new_argv = ();
+
+    while (defined (my $arg = shift @ARGV)) {
+      if ($arg eq '--revision') {
+        # Long --revision option, must be followed by a space before the
+        # revision argument
+        push @new_argv, $arg;
+
+      } elsif ($arg =~ s/^-r//) {
+        # Short -r option, may be followed by the revision argument with or
+        # without a space in between
+        push @new_argv, '--revision';
+        unshift @ARGV, $arg if $arg;
+
+      } else {
+        # Other option or argument
+        push @new_argv, $arg;
+        next;
+      }
+
+      # First revision number/keyword
+      my $rev1 = '';
+
+      # Get the next argument from the list
+      $arg = shift @ARGV;
+
+      if (index ($arg, '{') == 0) {
+        # A revision date argument may contain a space. Therefore, it may need
+        # the next argument(s) from the list
+        while (index ($arg, '}') == -1) {
+          my $shift = shift @ARGV;
+          last unless $shift;
+          $arg     .= ' ' . $shift;
+        }
+
+        $arg  =~ s/^(\{.+?\})//;
+        $rev1 = $1;
+
+      } else {
+        # Other revision argument
+        $arg  =~ s/^(\S+?)(?::|$)//;
+        $rev1 = $1;
+      }
+
+      # The rest of $arg is the second revision number/keyword
+      my $rev2 = $arg;
+      $rev2 =~ s/^:*//;
+
+      # A revision date argument may contain a space. Therefore, it may need
+      # the next argument(s) from the list
+      if (index ($rev2, '{') == 0) {
+        while (index ($rev2, '}') == -1) {
+          my $shift = shift @ARGV;
+          last unless $shift;
+          $rev2    .= ' ' . $shift;
+        }
+      }
+
+      # Expand revision keyword if necessary
+      if ($rev1 !~ /^(?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\})$/i or
+          $rev2 !~ /^(?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\})$/i) {
+        # Find out the associated URLs by inspecting the argument list
+        my $url1 = '';
+        my $url2 = '';
+
+        for (@new_argv, @ARGV) {
+          my $arg = Fcm::CmUrl->new (URL => $_);
+          next unless $arg->is_url;
+
+          if ($url1) {
+            $url2 = $arg->url_peg;
+            last;
+
+          } else {
+            $url1 = $arg->url_peg;
+          }
+        }
+
+        # Argument list does not contain a URL, try "svn info" on WC
+        $url1 = &get_url_of_wc () if not $url1;
+        $url2 = $url1 if not $url2;
+
+        # Expand 1st revision keyword if necessary
+        $rev1 = expand_rev_keyword (REV => $rev1, URL => $url1)
+          if $rev1 !~ /^(?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\})$/i;
+
+        # Expand 2nd revision keyword if necessary
+        $rev2 = expand_rev_keyword (REV => $rev2, URL => $url2)
+          if $rev2 and $rev2 !~ /^(?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\})$/i;
+      }
+
+      # Append revision argument to argument list
+      push @new_argv, ($rev2 ? $rev1 . ':' . $rev2 : $rev1);
+    }
+
+    @ARGV = @new_argv;
+  }
+
+  # Expand revision keywords (for peg revision TARGET@REVSION) if necessary
+  for (@ARGV) {
+    if (m#^(\w+://\S+)@(\S+)$#) {
+      my $url = $1;
+      my $rev = $2;
+
+      my $new_rev = expand_rev_keyword (URL => $url, REV => $rev, HEAD => 1);
+
+      $_ = $url . '@' . $new_rev if $new_rev ne $rev;
+    }
+  }
+
+  # List of special sub-commands recognised by FCM
+  my %subcommand = (
+    ADD       => [qw/add/],
+    BRANCH    => [qw/branch br/],
+    COMMIT    => [qw/commit ci/],
+    CONFLICTS => [qw/conflicts cf/],
+    CHECKOUT  => [qw/checkout co/],
+    DELETE    => [qw/delete del remove rm/],
+    DIFF      => [qw/diff di/],
+    MERGE     => [qw/merge/],
+    MKPATCH   => [qw/mkpatch/],
+    SWITCH    => [qw/switch sw/],
+  );
+
+  if (grep {$_ eq $function} @{ $subcommand{ADD} }) {
+    cm_add;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{BRANCH} }) {
+    cm_branch;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{CHECKOUT} }) {
+    # Check whether the last argument is a PATH.
+    # If so, check whether it is a working copy.
+    # Otherwise, check whether the current directory is a working copy.
+    # If current working direcory (or PATH) is a working copy, fail the command.
+    if (@ARGV) {
+      my $arg  = Fcm::CmUrl->new (URL => $ARGV [-1]);
+      my $path = $arg->is_url ? cwd () : $ARGV [-1];
+
+      e_report $path, ': already a working copy, abort checkout.'
+        if &is_wc ($path);
+    }
+
+    # Invoke checkout
+    cm_svn ('checkout');
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{COMMIT} }) {
+    cm_commit;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{CONFLICTS} }) {
+    cm_conflicts;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{DELETE} }) {
+    cm_delete;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{DIFF} }) {
+    cm_diff;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{MERGE} }) {
+    cm_merge;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{MKPATCH} }) {
+    cm_mkpatch;
+
+  } elsif (grep {$_ eq $function} @{ $subcommand{SWITCH} }) {
+    cm_switch;
+
+  } else {
+    cm_svn ($function);
+  }
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_add ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn add". It adds an extra functionality to check
+#   for any files or directories reported by "svn status" as not under version
+#   control, and to prompt the user whether these files or directories should
+#   be added.
+# ------------------------------------------------------------------------------
+
+sub cm_add {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+usage: fcm add [options] [args]
+
+Valid options:
+  -c [--check]  : Check for any files or directories reported by svn status as
+                  not under version control and add them.
+  <SVN options> : Standard options to svn add as described below ...
+
+EOF
+
+    &run_command ([qw/svn add --help/], PRINT => 1, METHOD => 'exec');
+  }
+
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--check -c)) {
+    # The --check option is specified, add any new files
+    # Execute "svn status", print lines starting with a "?"
+    my $pat    = '^\?.{4}\s*';
+    my @status = grep /$pat.*/, &run_command ([qw/svn status/], METHOD => 'qx');
+    print @status if @status;
+
+    # Get list of "?" files
+    my @files  = map {chomp; s/$pat//; $_} @status;
+    my $reply  = '';
+
+    # Execute "add" command depending on user reply
+    for my $file (@files) {
+      # Get a user reply, unless previous reply is "a" for "all"
+      $reply = &main::get_input (
+        TITLE   => 'fcm add',
+        MESSAGE => "Add file '$file'?",
+        TYPE    => 'yna',
+        DEFAULT => 'n',
+      ) unless $reply eq "a";
+
+      # Add current $file if reply is "y" for "yes" or "a" for "all"
+      &run_command ([qw/svn add/, $file]) if $reply =~ /^[ya]$/;
+    }
+
+  } else {
+    # The --check option is not specified, just call "svn add"
+    cm_svn ("add");
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_branch ();
+#
+# DESCRIPTION
+#   This is a FCM command to check information, create or delete a branch in
+#   a Subversion repository.
+# ------------------------------------------------------------------------------
+
+sub cm_branch {
+  my $usage = <<EOF;
+branch: Create, delete or display information of a branch
+usage: 1. fcm branch [--info] [OPTIONS] [TARGET]
+       2. fcm branch --delete [OPTIONS] [TARGET]
+       3. fcm branch --create [OPTIONS] [SOURCE]
+       4. fcm branch --list   [OPTIONS] [SOURCE]
+
+  1. --info or -i: Display information about a branch. This is the default
+     option if --create, --delete and --list are not specified.
+
+  2. --delete or -d: Delete a branch.
+
+  3. --create or -c: Create a new branch from SOURCE. The --name option must be
+     used to specify a short name for the new branch.
+
+  4. --list or -l: List all the branches owned by the current user in SOURCE. If
+     the --user option is specified with a list of users, list all the branches
+     owned by these users instead of the current user.
+
+  TARGET (and SOURCE) can be an URL or a Subversion working copy. Otherwise,
+  the current working directory must be a working copy. For --info and
+  --delete, the specified URL (or the URL of the working copy) must be a URL
+  under a valid branch in a standard FCM project. For --create and --list, it
+  must be a URL under a standard FCM project.
+
+Valid options with --info and --delete:
+  -v [--verbose]        : Print extra information.
+  -a [--show-all]       : Set --show-children, --show-other and --show-siblings.
+  --show-children       : Report children of the current branch.
+  --show-other          : Report custom/ reverse merges into the current branch.
+  --show-siblings       : Report merges with siblings of the current branch.
+
+Valid options with --delete and --create:
+  --non-interactive     : Do no interactive prompting. This option implies
+                          --svn-non-interactive.
+  --password arg        : Specify a password for write access to the repository.
+  --svn-non-interactive : Do no interactive prompting at commit time. This
+                          option is implied by --non-interactive.
+
+Valid options with --create and --list:
+  -r [--revision] arg   : Specify the operative revision of the SOURCE for
+                          creating the branch.
+
+Valid options with --create:
+  --branch-of-branch    : If this option is specified and the SOURCE is a
+                          branch, it will create a new branch from the SOURCE
+                          branch. Otherwise, the branch is created from the
+                          trunk.
+  -k [--ticket] arg     : Specify one (or more) Trac ticket. If specified, the
+                          command will add to the commit log the line "Relates
+                          to ticket #<ticket>". Multiple tickets can be set by
+                          specifying this option multiple times, or by
+                          specifying the tickets in a comma-separated list.
+  -n [--name] arg       : Specify a short name for the branch, which should
+                          contain only word characters, i.e. [A-Za-z0-9_].
+  --rev-flag arg        : Specify a flag for determining the prefix of the
+                          branch name. The flag can be the the string "NORMAL",
+                          "NUMBER" or "NONE".  "NORMAL" is the default
+                          behaviour, in which the branch name will be prefixed
+                          with a Subversion revision number if the revision is
+                          not associated with a registered FCM revision
+                          keyword. If the revision is registered with a FCM
+                          revision keyword, the keyword will be used in place
+                          of the number. If "NUMBER" is specified, the branch
+                          name will always be prefixed with a Subversion
+                          revision number. If "NONE" is specified, the branch
+                          name will not be prefixed by a revision number or
+                          keyword.
+  -t [--type] arg       : Specify the type of the branch to be created. It must
+                          be one of the following:
+                            DEV::USER   - a development branch for the user
+                            DEV::SHARE  - a shared development branch
+                            DEV         - same as DEV::USER
+                            TEST::USER  - a test branch for the user
+                            TEST::SHARE - a shared test branch
+                            TEST        - same as TEST::USER
+                            PKG::USER   - a package branch for the user
+                            PKG::SHARE  - a shared package branch
+                            PKG::CONFIG - a configuration branch
+                            PKG::REL    - a release branch
+                            PKG         - same as PKG::USER
+                            CONFIG      - same as PKG::CONFIG
+                            REL         - same as PKG::REL
+                            SHARE       - same as DEV::SHARE
+                            USER        - same as DEV::USER
+                          If not specified, the default is to create a
+                          development branch for the current user, i.e.
+                          DEV::USER.
+
+Valid options with --list:
+  -u [--user] arg       : Specify a colon-separated list of users. List branches
+                          owned by these users instead of the current user.
+  -v [--verbose]        : Print Subversion URL instead of FCM URL keywords.
+EOF
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print $usage;
+    return 1;
+  }
+
+  # Process command line options
+  # ----------------------------------------------------------------------------
+  my (
+    $info,
+    $delete,
+    $create,
+    $list,
+    $branch_of_branch,
+    $name,
+    $non_interactive,
+    $password,
+    $rev,
+    $rev_flag,
+    $show_all,
+    $show_children,
+    $show_other,
+    $show_siblings,
+    $svn_non_interactive,
+    @tickets,
+    $type,
+    @userlist,
+    $verbose,
+  );
+  GetOptions (
+    'info|i'              => \$info,
+    'delete|d'            => \$delete,
+    'create|c'            => \$create,
+    'list|l'              => \$list,
+    'branch-of-branch'    => \$branch_of_branch,
+    'name|n=s'            => \$name,
+    'non-interactive'     => \$non_interactive,
+    'password=s'          => \$password,
+    'revision|r=s'        => \$rev,
+    'rev-flag=s'          => \$rev_flag,
+    'show-all|a'          => \$show_all,
+    'show-children'       => \$show_children,
+    'show-other'          => \$show_other,
+    'show-siblings'       => \$show_siblings,
+    'svn-non-interactive' => \$svn_non_interactive,
+    'ticket|k=s'          => \@tickets,
+    'type|t=s'            => \$type,
+    'user|u=s'            => \@userlist,
+    'verbose|v'           => \$verbose,
+  );
+
+  my $num_options = 0;
+  $num_options++ if defined $info;
+  $num_options++ if defined $delete;
+  $num_options++ if defined $create;
+  $num_options++ if defined $list;
+
+  # Report invalid usage
+  # ----------------------------------------------------------------------------
+  e_report $usage if $num_options > 1;
+
+  # Get URL of repository or branch
+  # ----------------------------------------------------------------------------
+  my $url;
+  if ($ARGV[0]) {
+    $url = Fcm::CmUrl->new (URL => $ARGV[0]);
+
+    if (not $url->is_url) {
+      # An argument is specified and is not a URL
+      # Assume that it is a path with a working copy
+      if (&is_wc ($ARGV[0])) {
+        $url = Fcm::CmUrl->new (URL => &get_url_of_wc ($ARGV[0]));
+
+      } else {
+        e_report $ARGV[0], ': is not a working copy, abort.';
+      }
+    }
+
+  } else {
+    # An argument is not specified
+    # Assume that the current directory is a working copy
+    if (&is_wc ()) {
+      $url = Fcm::CmUrl->new (URL => &get_url_of_wc ());
+
+    } else {
+      e_report 'The current directory is not a working copy, please specify a ',
+               'URL or a path to a working copy, abort.';
+    }
+  }
+
+  # Ensure $url->url_peg is a URL of a standard FCM project
+  e_report $url->url_peg, ': not a URL of a standard FCM project, abort.'
+    if not $url->project_url;
+
+  if ($create) {
+    # The --create option is specified, create a branch
+    # --------------------------------------------------------------------------
+
+    # Check branch type flags
+    if ($type) {
+      $type = uc ($type);
+
+      if ($type =~ /^(USER|SHARE)$/) {
+        $type = 'DEV::' . $1;
+
+      } elsif ($type =~ /^(CONFIG|REL)$/) {
+        $type = 'PKG::' . $1;
+
+      } elsif ($type =~ /^(DEV|TEST|PKG)$/) {
+        $type = $1 . '::USER';
+
+      } elsif ($type !~ /^(?:DEV|TEST|PKG)::(?:USER|SHARE)$/ and
+               $type !~ /^PKG::(?:CONFIG|REL)/) {
+        e_report $type, ': is not a valid type flag, abort.';
+      }
+
+    } else {
+      $type = 'DEV::USER';
+    }
+
+    # Check branch name
+    e_report 'The option --name must be used to specify a branch name, abort.'
+      if not $name;
+
+    e_report $name, ': invalid characters in name, abort.' if $name !~ /^\w+$/;
+
+    # Check revision flag is valid
+    if ($rev_flag) {
+      $rev_flag = uc ($rev_flag);
+
+      e_report $rev_flag, ': invalid argument to the --rev-flag option, abort.'
+        if $rev_flag !~ /^(?:NORMAL|NUMBER|NONE)$/;
+
+    } else {
+      $rev_flag = 'NORMAL';
+    }
+
+    # Handle multiple tickets
+    @tickets = split (/,/, join (',', @tickets));
+    s/^#// for (@tickets);
+    @tickets = sort {$a <=> $b} @tickets;
+
+    # Determine whether to create a branch of a branch
+    $url->branch ('trunk') unless $branch_of_branch;
+
+    # Create the branch
+    my $branch = Fcm::CmBranch->new;
+    $branch->create (
+      SRC                 => $url,
+      TYPE                => $type,
+      NAME                => $name,
+      PASSWORD            => $password,
+      REV_FLAG            => $rev_flag,
+      TICKET              => \@tickets,
+      REV                 => $rev,
+      NON_INTERACTIVE     => $non_interactive,
+      SVN_NON_INTERACTIVE => $svn_non_interactive,
+    );
+
+  } elsif ($list) {
+    # The option --list is specified
+    # List branches owned by current or specified users
+    # --------------------------------------------------------------------------
+    # Get URL of the project "branches/" sub-directory
+    $url->subdir ('');
+    $url->branch ('');
+    my @list = map {$_, 1} $url->branch_list ($rev);
+
+    if (@userlist) {
+      # Sort list of users
+      @userlist = sort (split /:/, join (':', @userlist));
+
+    } else {
+      # No user specified, add currrent user to list
+      push @userlist, $ENV{LOGNAME} unless @userlist;
+    }
+
+    # Filter branches matching user list
+    my @branches;
+    for my $branch (@list) {
+      next unless $branch =~ m#/([^/]+)/[^/]+/*$#;
+
+      my $user = $1;
+
+      push @branches, $branch if grep {$user eq $_} @userlist;
+    }
+
+    # Output, number of branches found
+    print scalar (@branches), ' ',
+          (scalar (@branches) > 1 ? 'branches' : 'branch'), ' found for ',
+          join (', ', @userlist), ' in ', $url->project_url_peg,
+          ($rev ? (' at r', $rev) : ()), "\n";
+
+    if (@branches) {
+      # Output the URL of each branch
+      if (not $verbose) {
+        my $project = $url->project_url;
+        my $keyword = &get_url_keyword (URL => $project);
+        @branches = map {s#^$project/+branches#$keyword-br#; $_} @branches
+          if defined $keyword;
+      }
+      @branches = map {$_ . "\n"} sort @branches;
+      print @branches;
+
+    } else {
+      # No branch found, exit with an error code
+      exit 1;
+    }
+
+  } else {
+    # The option --info or --delete is specified
+    # Report branch information (and/or delete a branch)
+    # --------------------------------------------------------------------------
+    # Set verbose level
+    &main::cfg->verbose ($verbose ? 1 : 0);
+
+    # Set up the branch, report any error
+    my $branch = Fcm::CmBranch->new (URL => $url->url_peg);
+    e_report $branch->url_peg, ': not a branch, abort.' unless $branch->branch;
+
+    e_report $branch->url_peg, ': does not exist, abort.'
+      unless $branch->url_exists;
+
+    # Remove the sub-directory part of the URL
+    $branch->subdir ('');
+
+    # Report branch info
+    $branch->display_info (
+      SHOW_CHILDREN => ($show_all || $show_children),
+      SHOW_OTHER    => ($show_all || $show_other   ),
+      SHOW_SIBLINGS => ($show_all || $show_siblings),
+    );
+
+    # Delete branch if --delete is specified
+    $branch->del (
+      PASSWORD            => $password,
+      NON_INTERACTIVE     => $non_interactive,
+      SVN_NON_INTERACTIVE => $svn_non_interactive,
+    ) if $delete;
+  }
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_commit ();
+#
+# DESCRIPTION
+#   This is a FCM wrapper to the "svn commit" command.
+# ------------------------------------------------------------------------------
+
+sub cm_commit {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+commit (ci): Send changes from your working copy to the repository.
+usage: fcm commit [PATH]
+
+  Invoke your favourite editor to prompt you for a commit log message. Send
+  changes from your working copy to the repository. Update your working copy
+  following the commit.
+
+Valid options:
+  --dry-run             : Allows you to add to the commit message without
+                          committing.
+  --svn-non-interactive : Do no interactive prompting at commit time.
+  --password arg        : Specify a password ARG.
+EOF
+    return 1;
+  }
+
+  my ($dry_run, $svn_non_interactive, $password);
+  GetOptions (
+    'dry-run'             => \$dry_run,
+    'svn-non-interactive' => \$svn_non_interactive,
+    'password'            => \$password,
+  );
+
+  # The remaining argument is the path to a working copy
+  my ($path) = @ARGV;
+
+  if ($path) {
+    # Check that specified path exists
+    e_report $path, ': does not exist, abort.' if not -e $path;
+
+  } else {
+    # No argument specified, use current working directory
+    $path = cwd ();
+  }
+
+  # Make sure we are in a working copy
+  e_report $path, ': not a working copy, abort.' if not &is_wc ($path);
+
+  # Make sure we are at the top level of the working copy
+  # (otherwise we might miss any template commit message)
+  my $dir = &get_wct ($path);
+
+  if ($dir ne cwd ()) {
+    chdir $dir or die 'Cannot change directory to: ', $dir;
+    print 'Committing changes from ', $dir, ' ...', "\n";
+  }
+
+  # Get update status of working copy
+  # Check working copy files are not in conflict, missing, or out of date
+  my @status = &run_command ([qw/svn status --show-updates/], METHOD => 'qx');
+  unless (defined $dry_run) {
+    my (@conflict, @missing, @outdate);
+
+    for (@status) {
+      if (/^C/) {
+        push @conflict, $_;
+        next;
+      }
+
+      if (/^!/) {
+        push @missing, $_;
+        next;
+      }
+
+      if (/^.{7}\*/) {
+        push @outdate, $_;
+        next;
+      }
+
+      # Check that all files which have been added have the svn:executable
+      # property set correctly (in case the developer adds a script before they
+      # remember to set the execute bit)
+      next unless /^A.{7} *\d+ +(.*)/;
+      my $file = $1;
+
+      next unless -f $file;
+      my @command = (-x $file)
+                    ? (qw/svn propset -q svn:executable */, $file)
+                    : (qw/svn propdel -q svn:executable/  , $file);
+      &run_command (\@command);
+    }
+
+    # Abort commit if files are in conflict, missing, or out of date
+    if (@conflict or @missing or @outdate) {
+      w_report 'File(s) in conflict:', "\n", @conflict if @conflict;
+      w_report 'File(s) missing:'    , "\n", @missing  if @missing;
+      w_report 'File(s) out of date:', "\n", @outdate  if @outdate;
+      e_report 'Abort commit.';
+    }
+  }
+
+  # Read in any existing message
+  my $ci_mesg = Fcm::CmCommitMessage->new ();
+  $ci_mesg->read_file;
+
+  # Execute "svn status" for a list of changed items
+  @status = grep !/^\?/, &run_command ([qw/svn status/], METHOD => 'qx');
+
+  # Abort if there is no change in the working copy
+  if (not @status) {
+    print 'No change in working copy, abort.', "\n";
+    return;
+  }
+
+  # Get associated URL of current working copy
+  my $url = Fcm::CmUrl->new (URL => &get_url_of_wc ());
+
+  # Include URL, or project, branch and sub-directory info in @status
+  unshift @status, "\n";
+
+  if ($url->project and $url->branch) {
+    unshift @status, (
+      '[Project: ' . $url->project                           . ']' . "\n",
+      '[Branch : ' . $url->branch                            . ']' . "\n",
+      '[Sub-dir: ' . ($url->subdir ? $url->subdir : '<top>') . ']' . "\n",
+    );
+
+  } else {
+    unshift @status, '[URL: ' . $url->url . ']' . "\n";
+  }
+
+  # Use a temporary file to store the final commit log message
+  $ci_mesg->ignore_mesg (@status);
+  my $logfile = $ci_mesg->edit_file (TEMP => 1);
+
+  # Check with the user to see if he/she wants to go ahead
+  my $reply = 'n';
+  if (not defined $dry_run) {
+    # Add extra warning for trunk commit
+    my $mesg = $url->is_trunk
+      ? "\n" .
+        '*** WARNING: YOU ARE COMMITTING TO THE TRUNK.' . "\n" .
+        '*** Please ensure that your change conforms to your project\'s ' .
+        'working practices.' . "\n\n"
+      : '';
+    $mesg   .= 'Would you like to commit this change?';
+
+    # Prompt the user
+    $reply = &main::get_input (
+      TITLE   => 'fcm commit',
+      MESSAGE => $mesg,
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+  }
+
+  if ($reply eq 'y') {
+    # Commit the change if user replies "y" for "yes"
+    my @command = (
+      qw/svn commit -F/, $logfile,
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+    );
+    my $rc;
+    &run_command (\@command, RC => \$rc, ERROR => 'warn');
+
+    if ($rc) {
+      # Commit failed
+      # Write temporary commit log content to commit log message file
+      $ci_mesg->write_file;
+
+      # Fail the command
+      e_report;
+    }
+
+    # Remove commit message file
+    unlink $ci_mesg->file;
+
+    # Update the working copy
+    print 'Performing update to make sure your working copy is at this new ',
+          'revision ...', "\n";
+    &run_command ([qw/svn update/]);
+
+  } else {
+    # Abort commit if dry run or user replies "n" for "no"
+    w_report 'Commit aborted by user.' unless $dry_run;
+
+    # Write temporary commit log content to commit log message file
+    $ci_mesg->write_file;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_conflicts ();
+#
+# DESCRIPTION
+#   This is a FCM command for resolving conflicts within working copy using a
+#   graphical merge tool.
+# ------------------------------------------------------------------------------
+
+sub cm_conflicts {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+conflicts: Use graphical tool to resolve any conflicts within your working copy.
+usage: fcm conflicts [PATH]
+
+  Invoke the xxdiff graphical merge tool to help you resolve conflicts in your
+  working copy. It prompts you to run "svn resolved" each time you have
+  resolved the conflicts in a file.
+EOF
+    return 1;
+  }
+
+  # Path to the working copy
+  my $path = $ARGV[0];
+  $path    = cwd () if not $path;
+
+  # Check for any files with conflicts
+  my @status = grep /^C.{4} *(.*)/, &run_command (
+    [qw/svn st/, ($path eq cwd () ? () : $path)], METHOD => 'qx',
+  );
+  my @files  = map {m/^C.{4} *(.*)/; $1} @status;
+
+  # Save current working directory
+  my $topdir = cwd ();
+
+  for my $file (@files) {
+    # Print name of file in conflicts
+    print "Conflicts in file: $file\n";
+
+    # Determine directory and base name of file in conflicts
+    my $base = basename $file;
+    my $dir  = dirname $file;
+
+    # Change to container directory of file in conflicts
+    chdir File::Spec->catfile ($topdir, $dir) or die "Directory change to $dir failed";
+
+    # Use "svn info" to determine conflict marker files
+    my @info = &run_command ([qw/svn info/, $base], METHOD => 'qx');
+
+    # Ignore if $base is a binary file
+    if (-B $base) {
+      w_report $base,
+               ': ignoring binary file, please resolve conflicts manually.';
+      next;
+    }
+
+    # Get conflicts markers files
+    my ($older, $mine, $yours);
+
+    for (@info) {
+      $older = $1 if (/^Conflict Previous Base File: (.*)/);
+      $mine  = $1 if (/^Conflict Previous Working File: (.*)/);
+      $yours = $1 if (/^Conflict Current Base File: (.*)/);
+    }
+
+    if ((stat $base)[9] > (stat $mine)[9]) {
+      # If $base is newer, it may contain saved changes
+      my $reply = &main::get_input (
+        TITLE   => 'fcm conflicts',
+        MESSAGE => 'Existing changes in ' . $base . ' will be overwritten.' .
+                   "\n" . 'Do you wish to continue?',
+        TYPE    => 'yn',
+        DEFAULT => 'n',
+      );
+
+      next if $reply ne 'y';
+    }
+
+    # Launch "xxdiff" to allow user to perform graphical merging
+    my $xxdiffrc;
+    my @command  = (qw/xxdiff -m -M/, $base, qw/-O -X/, $mine, $older, $yours);
+    my ($decision) = &run_command (
+      \@command, METHOD => 'qx', RC => \$xxdiffrc, ERROR => 'ignore',
+    );
+    die &get_command_string (\@command), ' failed' if $xxdiffrc and ! $decision;
+    chomp $decision;
+
+    # Perform different actions depending on the user's decision
+    if ($decision eq "NODECISION") {
+      print "No decision taken\n";
+
+    } elsif ($decision eq "MERGED" and $xxdiffrc != 0) {
+      print "Merge conflicts were not all resolved\n";
+
+    } else {
+      # User has MERGED, ACCEPTED or REJECTED all changes
+      if ($decision eq "MERGED") {
+        print "All merge conflicts resolved\n";
+
+      } else {
+        print "You have chosen to $decision all the changes\n";
+      }
+
+      # Prompt user to run "svn resolved" on the file
+      my $reply = &main::get_input (
+        TITLE   => 'fcm conflicts',
+        MESSAGE => 'Would you like to run "svn resolved"?',
+        TYPE    => 'yn',
+        DEFAULT => 'n',
+      );
+
+      # If reply is "yes"...
+      &run_command ([qw/svn resolved/, $base]) if $reply eq 'y';
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_delete ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn delete". It adds an extra functionality to check
+#   for any files or directories reported by "svn status" as missing, and to
+#   prompt the user whether these files or directories should be deleted.
+# ------------------------------------------------------------------------------
+
+sub cm_delete {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+usage: fcm delete [options] [args]
+
+Valid options:
+  -c [--check]  : Check for any files or directories reported by svn status as
+                  missing and delete them.
+  <SVN options> : Standard options to svn delete as described below ...
+
+EOF
+
+    &run_command ([qw/svn delete --help/], PRINT => 1, METHOD => 'exec');
+  }
+
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--check -c)) {
+    # The --check option is specified, delete any missing files
+    # Execute "svn status", print lines starting with a "!"
+    my $pat    = '^!.{4}\s*';
+    my @status = grep /$pat.*/, &run_command ([qw/svn status/], METHOD => 'qx');
+    print @status if @status;
+
+    # Get list of "!" files
+    my @files  = map {chomp; s/$pat//; $_} @status;
+    my $reply  = '';
+
+    # Execute "delete" command depending on user reply
+    for my $file (@files) {
+      # Get a user reply, unless previous reply is "a" for "all"
+      $reply = &main::get_input (
+        TITLE   => 'fcm delete',
+        MESSAGE => "Delete file '$file'?",
+        TYPE    => 'yna',
+        DEFAULT => 'n',
+      ) unless $reply eq "a";
+
+      # Delete current $file if reply is "y" for "yes" or "a" for "all"
+      &run_command ([qw/svn delete/, $file]) if $reply =~ /^[ya]$/;
+    }
+
+  } else {
+    # The --check option is not specified, just call "svn delete"
+    cm_svn ("delete");
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_diff ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn diff". It adds two extra functionalities. The
+#   first one allows the command to show differences relative to the base of
+#   the branch. The second one allows differences to be displayed via a
+#   graphical tool.
+# ------------------------------------------------------------------------------
+
+sub cm_diff {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+usage: 1. fcm diff --branch [OPTIONS] [TARGET]
+       2. fcm diff [OPTIONS] [ARGS]
+
+  1. --branch or -b: Show differences relative to the base of the target branch,
+     i.e. the changes available for merging from the target branch into its
+     parent. If TARGET is specified, it must either be a URL or a working copy.
+     Otherwise, the target is the the current directory which must be a working
+     copy. The target URL must be a branch in a standard FCM project.
+
+  2. See description of "svn diff" below.
+
+Valid options:
+  -g [--graphical] : Use a graphical diff tool to display the differences. This
+                     option should not be used in combination with --diff-cmd.
+  <SVN options>    : Standard options to "svn diff" as described below.
+
+Valid options with --branch:
+  --diff-cmd arg        : As described below in the help for "svn diff".
+  -g [--graphical]      : As described above.
+  -t [--trac]           : If TARGET is a URL, use Trac to display the diff.
+  --wiki                : If TARGET is a URL, print Trac link for the diff.
+  -x [--extensions] arg : As described below in the help for "svn diff".
+
+EOF
+
+    &run_command ([qw/svn diff --help/], PRINT => 1, METHOD => 'exec');
+  }
+
+  # Set up environment for graphical diff
+  # Use environment variable if set, otherwise use default setting
+  my $env = 'FCM_GRAPHIC_DIFF';
+  $ENV{$env} = &main::cfg->setting (qw/TOOL GRAPHIC_DIFF/)
+    unless exists $ENV{$env} or not &main::cfg->setting (qw/TOOL GRAPHIC_DIFF/);
+
+  # Check for the --branch options
+  # ----------------------------------------------------------------------------
+  my $branch = grep {$_ eq '-b' or $_ eq '--branch'} @ARGV;
+
+  if (not $branch) {
+    # The --branch option not specified, just call "svn diff"
+    # Convert the --graphical to qw/--diff-cmd fcm_graphical_diff/
+    @ARGV = map {
+      ($_ eq '-g' or $_ eq '--graphical')
+      ? (qw/--diff-cmd fcm_graphic_diff/)
+      : $_
+    } @ARGV;
+
+    # Execute the command
+    cm_svn ('diff');
+  }
+
+  # The --branch option is specified
+  # ----------------------------------------------------------------------------
+
+  # Determine whether the --graphical option is specified,
+  # if so set the appropriate command
+  # ----------------------------------------------------------------------------
+  my ($diff_cmd, $extensions, $graphical, $trac, $wiki);
+  GetOptions (
+    'b|branch'       => \$branch,
+    'diff-cmd=s'     => \$diff_cmd,
+    'x|extensions=s' => \$extensions,
+    'g|graphical'    => \$graphical,
+    't|trac'         => \$trac,
+    'wiki'           => \$wiki,
+  );
+
+  my @diff_cmd = ();
+  
+  if ($graphical) {
+    @diff_cmd = (qw/--diff-cmd fcm_graphic_diff/);
+
+  } elsif ($diff_cmd) {
+    @diff_cmd = ('--diff-cmd', $diff_cmd);
+
+    push @diff_cmd, '--extensions', split (/\s+/, $extensions) if $extensions;
+  }
+
+  # The remaining argument should either be a URL or a PATH
+  my ($url_arg, $path_arg);
+
+  if (@ARGV) {
+    my $arg = Fcm::CmUrl->new (URL => $ARGV[0]);
+
+    if ($arg->is_url) {
+      $url_arg = $ARGV[0];
+
+    } else {
+      $path_arg = $ARGV[0];
+    }
+  }
+
+  # Get repository and branch information
+  # ----------------------------------------------------------------------------
+  my ($url, $path);
+  if (defined $url_arg) {
+    # If a URL is specified, get repository and branch information from it
+    $url = Fcm::CmBranch->new (URL => $url_arg);
+
+  } else {
+    # Get repository and branch information from the specified path or the
+    # current directory if it is a working copy
+    $path = $path_arg ? $path_arg : cwd ();
+    e_report $path, ': not a working copy, abort.' unless &is_wc ($path);
+
+    $url  = Fcm::CmBranch->new (URL => &get_url_of_wc ($path));
+  }
+
+  # Check that URL is a standard FCM branch
+  e_report $url->url_peg, ': not a standard FCM branch, abort.'
+    unless $url->is_branch;
+
+  # Save and remove sub-directory part of the URL
+  my $subdir = $url->subdir ();
+  $url->subdir ('');
+
+  # Check that $url exists
+  e_report $url->url_peg, ': not a valid URL, abort.' unless $url->url_exists;
+
+  # Compare current branch with its parent
+  # ----------------------------------------------------------------------------
+  my $parent = Fcm::CmBranch->new (URL => $url->parent->url);
+  $parent->pegrev ($url->pegrev) if $url->pegrev;
+
+  e_report $parent->url, ': branch parent no longer exists',
+           ($parent->pegrev ? ' at ' . $parent->pegrev : ''), ', abort.'
+    unless $parent->url_exists;
+
+  my $base = $parent->base_of_merge_from ($url);
+
+  # Ensure the correct diff (syntax) is displayed
+  # ----------------------------------------------------------------------------
+  # Reinstate the sub-tree part into the URL
+  $url->subdir ($subdir);
+  $base->subdir ($subdir);
+
+  # Ensure the branch URL has a peg revision
+  $url->pegrev ($url->svninfo (FLAG => 'Last Changed Rev')) if not $url->pegrev;
+
+  if ($trac or $wiki) {
+    # Trac/wiki
+    # --------------------------------------------------------------------------
+    if (not $url_arg) {
+      if (&run_command ([qw/svn status/], METHOD => 'qx')) {
+        w_report 'WARNING: the working copy at "', ($path_arg ? $path_arg : '.'),
+                 '" contains local changes, which cannot be displayed in Trac.';
+      }
+    }
+
+    # Trac wiki syntax
+    my $wiki_syntax = 'diff:' . $base->path_peg . '//' . $url->path_peg;
+
+    if ($wiki) {
+      # Print Trac wiki syntax only
+      print $wiki_syntax, "\n";
+
+    } else { # if $trac
+      # Use Trac to view "diff"
+      my $browser  = &main::cfg->setting (qw/MISC WEB_BROWSER/);
+      die 'ERROR: web browser not set, abort' if not $browser;
+
+      my $trac_url = &get_browser_url (URL => $url->project_url);
+      e_report 'ERROR: ', $url->project_url,
+               ': not associated with a Trac URL, abort.'
+        if not $trac_url;
+
+      $trac_url =~ s#/browser/.*$#/intertrac/$wiki_syntax#;
+
+      &run_command ([$browser, $trac_url], METHOD => 'exec', PRINT => 1);
+    }
+
+  } else {
+    # Execute the "diff" command
+    # --------------------------------------------------------------------------
+    my @command = (
+      qw/svn diff/, @diff_cmd,
+      '--old', $base->url_peg,
+      '--new', ($url_arg ? $url->url_peg : ($path_arg ? $path_arg : '.')),
+    );
+    &run_command (\@command, PRINT => 1);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_merge ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn merge".
+# ------------------------------------------------------------------------------
+
+sub cm_merge {
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print <<EOF;
+merge: Merge changes from a source into your working copy.
+usage: 1. fcm merge SOURCE
+       2. fcm merge --custom  --revision N[:M] SOURCE
+          fcm merge --custom  URL[\@REV1] URL[\@REV2]
+       3. fcm merge --reverse --revision [M:]N
+
+  1. If neither --custom nor --reverse is specified, the command merges changes
+     automatically from SOURCE into your working copy. SOURCE must be a valid
+     URL[\@REV] of a branch in a standard FCM project. The base of the merge
+     will be calculated automatically based on the common ancestor and latest
+     merge information between the SOURCE and the branch of the working copy.
+
+  2. If --custom is specified, the command can be used in two forms.
+  
+     In the first form, it performs a custom merge from the specified
+     changeset(s) of SOURCE into your working copy. SOURCE must be a valid
+     URL[\@REV] of a branch in a standard FCM project. If a single revision is
+     specified, the merge delta is (N - 1):N of SOURCE. Otherwise, the merge
+     delta, is N:M of SOURCE, where N < M.
+     
+     In the second form, it performs a custom merge using the delta between the
+     two specified branch URLs. For each URL, if a peg revision is not
+     specified, the command will peg the URL with its last changed revision.
+
+  3. If --reverse is specified, the command performs a reverse merge of the
+     changeset(s) specified by the --revision option. If a single revision is
+     specified, the merge delta is N:(N - 1). Otherwise, the merge delta is
+     M:N, where M > N. Note that you do not have to specify a SOURCE for a
+     reverse merge, because the SOURCE should always be the branch your working
+     copy is pointing to.
+  
+  The command provide a commit log message template following the merge.
+
+Valid options:
+  --dry-run          : Try operation but make no changes.
+  --non-interactive  : Do no interactive prompting.
+  -r [--revision] arg: Specify a (range of) revision number(s).
+  --verbose          : Print extra information.
+EOF
+    return 1;
+  }
+
+  # Options
+  # ----------------------------------------------------------------------------
+  my ($custom, $dry_run, $non_interactive, $reverse, $rev, $verbose);
+  GetOptions (
+    'custom'          => \$custom,
+    'dry-run'         => \$dry_run,
+    'non-interactive' => \$non_interactive,
+    'reverse'         => \$reverse,
+    'revision|r=s'    => \$rev,
+    'verbose|v'       => \$verbose,
+  );
+
+  # Find out the URL of the working copy
+  # ----------------------------------------------------------------------------
+  my ($target, $wct);
+  if (&is_wc ()) {
+    $wct = &get_wct ();
+
+    if ($wct ne cwd ()) {
+      print 'Change directory to top of working copy: ', $wct, "\n";
+      chdir $wct or die 'Cannot change directory to: ', $wct;
+    }
+
+    $target = Fcm::CmBranch->new (URL => &get_url_of_wc ($wct));
+
+  } else {
+    e_report 'The current directory is not a working copy, abort.';
+  }
+
+  e_report 'Your working copy URL does not exist at the HEAD revision, abort.'
+    unless $target->url_exists;
+
+  # The target must be at the top of a branch
+  # $subdir will be used later to determine whether the merge is allowed or not
+  my $subdir = $target->subdir;
+  $target->subdir ('') if $subdir;
+
+  # Check for any local modifications
+  # ----------------------------------------------------------------------------
+  return
+    if ! ($dry_run or $non_interactive) and &_abort_modified_wc ('fcm merge');
+
+  # Determine the SOURCE URL
+  # ----------------------------------------------------------------------------
+  my $source;
+
+  if ($reverse) {
+    # Reverse merge, the SOURCE is the the working copy URL
+    $source = Fcm::CmBranch->new (URL => $target->url);
+
+  } else {
+    # Automatic/custom merge, argument 1 is the SOURCE of the merge
+    my $source_url = shift (@ARGV);
+    e_report 'Error: argument 1 must be the URL/name of a source branch in ',
+             'automatic/custom mode, abort.'
+      if not $source_url;
+
+    $source = &_construct_branch_url ($source_url, $target);
+  }
+
+  # Parse the revision option
+  # ----------------------------------------------------------------------------
+  my @revs;
+  if ($reverse or $custom) {
+    if ($reverse and not $rev) {
+      e_report 'Error: a revision (range) must be specified with ',
+               '--revision in reverse mode, abort.'
+    }
+
+    @revs = split (/:/, $rev) if $rev;
+  }
+
+  # Determine the merge delta and the commit log message
+  # ----------------------------------------------------------------------------
+  my (@delta, $mesg);
+  my $separator = '-' x 80 . "\n";
+
+  if ($reverse) {
+    # Reverse merge
+    # --------------------------------------------------------------------------
+    if (@revs == 1) {
+      $revs[1] = ($revs[0] - 1);
+
+    } else {
+      @revs = sort {$b <=> $a} @revs;
+    }
+
+    $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev'))
+      unless $source->pegrev;
+    $source->subdir ($subdir);
+
+    # "Delta" of the "svn merge" command
+    @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg);
+
+    # Template message
+    $mesg = 'Reversed r' . $revs[0] .
+            (($revs[1] < $revs[0] - 1) ? ':' . $revs[1] : '') . ' of ' .
+            $source->path . "\n";
+
+  } elsif ($custom) {
+    # Custom merge
+    # --------------------------------------------------------------------------
+    if (@revs) {
+      # Revision specified
+      # ------------------------------------------------------------------------
+      # Only one revision N specified, use (N - 1):N as the delta
+      unshift @revs, ($revs[0] - 1) if @revs == 1;
+
+      $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev'))
+        unless $source->pegrev;
+      $source->subdir ($subdir);
+      $target->subdir ($subdir);
+
+      # "Delta" of the "svn merge" command
+      @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg);
+
+      # Template message
+      $mesg = 'Custom merge into ' . $target->path . ': r' . $revs[1] .
+              ' cf. r' . $revs[0] . ' of ' . $source->path_peg . "\n";
+
+    } else {
+      # Revision not specified
+      # ------------------------------------------------------------------------
+      # Get second source URL
+      my $source2_url = shift (@ARGV);
+      e_report 'Error: argument 2 must be the URL/name of a source branch in ',
+               'custom mode when --revision is not specified, abort.'
+        if not $source2_url;
+
+      my $source2 = &_construct_branch_url ($source2_url, $target);
+
+      $source->pegrev  ($source->svninfo  (FLAG => 'Last Changed Rev'))
+        unless $source->pegrev;
+      $source2->pegrev ($source2->svninfo (FLAG => 'Last Changed Rev'))
+        unless $source2->pegrev;
+      $source->subdir  ($subdir);
+      $source2->subdir ($subdir);
+      $target->subdir  ($subdir);
+
+      # "Delta" of the "svn merge" command
+      @delta = ($source->url_peg, $source2->url_peg);
+
+      # Template message
+      $mesg = 'Custom merge into ' . $target->path . ': ' . $source->path_peg .
+              ' cf. ' . $source2->path_peg . "\n";
+    }
+
+  } else {
+    # Automatic merge
+    # --------------------------------------------------------------------------
+    # Check to ensure source branch is not the same as the target branch
+    e_report 'Error: cannot merge ', $source->branch,
+             ' to its own working copy, abort.'
+      if $source->branch eq $target->branch;
+
+    # Only allow the merge if the source and target are "directly related"
+    # --------------------------------------------------------------------------
+    my $anc = $target->ancestor ($source);
+    e_report 'Error: source and target are not directly related' unless
+      ($anc->url eq $target->url and $anc->url_peg eq $source->parent->url_peg)
+      or
+      ($anc->url eq $source->url and $anc->url_peg eq $target->parent->url_peg)
+      or
+      ($anc->url eq $source->parent->url and $anc->url eq $target->parent->url);
+
+    # Check for available merges from the source
+    # --------------------------------------------------------------------------
+    my @revs = $target->avail_merge_from ($source, 1);
+
+    if (@revs) {
+      print 'Available Merge', (@revs > 1 ? 's' : ''), ' From ',
+            $source->path_peg, ':';
+
+      if ($verbose) {
+        # Verbose mode, print log messages of available merges
+        print "\n";
+
+        for (@revs) {
+          print $separator, $source->display_svnlog ($_);
+        }
+
+        print $separator;
+
+      } else {
+        # Normal mode, list revisions of available merges
+        print ' ', join (' ', @revs), "\n";
+      }
+
+    } else {
+      w_report 'No merge available from ', $source->path_peg, ', abort.';
+      return;
+    }
+
+    # If more than one merge available, prompt user to enter a revision number
+    # to merge from, default to $revs [0]
+    # --------------------------------------------------------------------------
+    my $reply = ($non_interactive or @revs == 1) ? $revs[0] : &main::get_input (
+      TITLE   => 'fcm merge',
+      MESSAGE => 'Please enter the revision you wish to merge from',
+      DEFAULT => $revs [0],
+    );
+
+    if (not defined ($reply)) {
+      w_report 'Merge aborted by user.';
+      return;
+    }
+
+    # Expand revision keyword if necessary
+    if ($reply) {
+      $reply = expand_rev_keyword (REV => $reply, URL => $target->project_url);
+    }
+
+    # Check that the reply is a number in the available merges list
+    e_report $reply, ': not a revision in the list of available merges.'
+      unless (grep {$_ == $reply} @revs);
+
+    $source->pegrev ($1) if ($reply =~ /^(\d+)/);
+
+    # If the working copy top is pointing to a sub-directory of a branch,
+    # we need to check whether the merge will result in losing changes made in
+    # other sub-directories of the source.
+    if ($subdir and not $target->allow_subdir_merge_from ($source, $subdir)) {
+      e_report 'SOURCE contains changes outside the current sub-directory.', "\n",
+               'Please use a full tree for the merge, abort.';
+    }
+
+    # Calculate the base of the merge
+    my $base = $target->base_of_merge_from ($source);
+
+    # $source and $base must take into account the sub-directory
+    my $s = Fcm::CmBranch->new (URL => $source->url_peg);
+    my $b = Fcm::CmBranch->new (URL => $base->url_peg);
+
+    $s->subdir ($subdir) if $subdir;
+    $b->subdir ($subdir) if $subdir;
+
+    # Diagnostic
+    print 'About to merge in changes from ', $s->path_peg, ' compared with ',
+          $b->path_peg, "\n";
+
+    # Delta of the "svn merge" command
+    @delta = ($b->url_peg, $s->url_peg);
+
+    # Template message
+    $mesg = 'Merged into ' . $target->path . ': ' . $source->path_peg .
+            ' cf. ' . $base->path_peg . "\n";
+  }
+
+  # Run "svn merge" in "--dry-run" mode to see the result
+  # ----------------------------------------------------------------------------
+  my @out   = &run_command (
+    [qw/svn merge --dry-run/, @delta],
+    METHOD => 'qx', PRINT => ($dry_run and $verbose),
+  );
+
+  # Abort merge if it will result in no change
+  if (not @out) {
+    print 'This merge will not result in any change, abort.', "\n";
+    return;
+  }
+
+  # Report result of "svn merge --dry-run"
+  if (not $non_interactive) {
+    print 'This merge will result in the following change',
+          (@out > 1 ? 's' : ''), ':', "\n";
+    print $separator, @out, $separator;
+  }
+
+  return if $dry_run;
+
+  # Prompt the user to see if (s)he would like to go ahead
+  # ----------------------------------------------------------------------------
+  my $reply = $non_interactive ? 'y' : &main::get_input (
+    TITLE   => 'fcm merge',
+    MESSAGE => 'Would you like to go ahead with the merge?',
+    TYPE    => 'yn',
+    DEFAULT => 'n',
+  );
+
+  # Go ahead with merge only if user replies "y"
+  if ($reply eq "y") {
+    print "Performing merge ...\n";
+    &run_command ([qw/svn merge/, @delta], PRINT => $verbose);
+
+  } else {
+    w_report 'Merge aborted by user.';
+    return;
+  }
+
+  # Prepare the commit log
+  # ----------------------------------------------------------------------------
+  # Read in any existing message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->read_file;
+  $ci_mesg->auto_mesg ($mesg, ($ci_mesg->auto_mesg));
+  $ci_mesg->write_file;
+
+  if ($verbose) {
+    print <<EOF;
+${separator}The following line has been added to your commit message file:
+$mesg
+EOF
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_mkpatch ();
+#
+# DESCRIPTION
+#   This is a FCM command to create a patching script from particular revisions
+#   of a URL.
+# ------------------------------------------------------------------------------
+
+sub cm_mkpatch {
+  my $usage = <<EOF;
+mkpatch: Create patches from specified revisions of a URL
+usage: fcm mkpatch [OPTIONS] URL [OUTDIR]
+
+  URL must be the URL of a branch in a FCM project. If the URL is a
+  sub-directory of a branch, it will use the root of the branch.
+
+  Create patches from specified revisions of the specified URL. If OUTDIR is
+  specified, the output is sent to OUTDIR. Otherwise, the output will be sent
+  to a default location in the current directory (\$PWD/fcm-mkpatch-out). The
+  output directory will contain the patch for each revision as well as a script
+  for importing the patch.
+
+  If a revision is specified with the --revision option, it will attempt to
+  create a patch based on the changes at that revision. If a revision is not
+  specified, it will attempt to create a patch based on the changes at the HEAD
+  revision. If a revision range is specified, it will attempt to create a patch
+  for each revision in that range (including the change in the lower range)
+  where changes have taken place in the URL. No output will be written if there
+  is no change in the given revision (range).
+
+  The --exclude option can be used to exclude a path in the URL. The specified
+  path must be a relative path of the URL. Glob patterns such as * and ? are
+  acceptable. Changes in an excluded path will not be considered in the patch.
+  A changeset containing changes only in the excluded path will not be
+  considered at all.
+
+  The --organisation option can be used to specify the name of your
+  organisation. The command will attempt to parse the commit log message for
+  each revision in the patch. It will remove all merge templates, replace links
+  to Trac tickets with a simple string, and add information about the original
+  changeset. If you specify the name of your organisation, it will replace Trac
+  ticket links such as "ticket:123" to "Original \$organisation ticket 123",
+  and report the orginal changeset with a message such as "Original
+  \$organisation changeset 1000". Otherwise, it will report without the
+  organisation name, e.g. "Original ticket 123" and "Original  changeset 1000".
+
+Valid options:
+  --exclude       arg : Exclude a path in the URL. Multiple paths can be
+                        specified by using a colon-separated list of paths, or
+                        by specifying this option multiple times.
+  --organisation  arg : Specify the name of your organisation.
+  -r [--revision] arg : Specify a revision number or a revision number range.
+EOF
+
+  # Print usage message if requested
+  if (defined ($ARGV[0]) and grep {$_ eq $ARGV[0]} qw(--help -h)) {
+    print $usage;
+    return 1;
+  }
+
+  # Process command line options and arguments
+  # ----------------------------------------------------------------------------
+  my (@exclude, $organisation, $revision);
+  GetOptions (
+    'exclude=s'      => \@exclude,
+    'organisation=s' => \$organisation,
+    'r|revision=s'   => \$revision,
+  );
+
+  # Excluded paths, convert glob into regular patterns
+  @exclude = split (/:/, join (':', @exclude));
+  for (@exclude) {
+    s#\*#[^/]*#; # match any number of non-slash character
+    s#\?#[^/]#;  # match a non-slash character
+    s#/*$##;     # remove trailing slash
+  }
+
+  # Organisation prefix
+  $organisation = $organisation ? $organisation : 'original';
+
+  # Make sure revision option is set correctly
+  my @revs = $revision ? split (/:/, $revision) : ();
+  @revs    = @revs [0, 1] if @revs > 2;
+
+  # Arguments
+  my ($u, $outdir) = @ARGV;
+
+  if (not $u) {
+    print $usage;
+    return 1;
+  }
+
+  my $url = Fcm::CmUrl->new (URL => $u);
+  e_report $u, ': URL is not a URL, abort.' if not $url->is_url;
+  e_report $u, ': URL does not exist, abort.' if not $url->url_exists;
+  e_report $u, ': URL is not a valid branch in a FCM project, abort.'
+    if not $url->branch;
+
+  $url->subdir ('');
+
+  if (@revs) {
+    # If HEAD revision is given, convert it into a number
+    # --------------------------------------------------------------------------
+    for my $rev (@revs) {
+      $rev = $url->svninfo (FLAG => 'Revision') if uc ($rev) eq 'HEAD';
+    }
+
+  } else {
+    # If no revision is given, use the HEAD
+    # --------------------------------------------------------------------------
+    $revs[0] = $url->svninfo (FLAG => 'Revision');
+  }
+
+  $revs[1] = $revs[0] if @revs == 1;
+
+  # Check that output directory is set
+  # ----------------------------------------------------------------------------
+  $outdir = File::Spec->catfile (cwd (), 'fcm-mkpatch-out') if not $outdir;
+
+  if (-e $outdir) {
+    # Ask user to confirm removal of old output directory if it exists
+    my $reply = &main::get_input (
+      TITLE   => 'fcm mkpatch',
+      MESSAGE => 'Output location ' . $outdir . ' exists. OK to overwrite?',
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+
+    if ($reply ne 'y') {
+      w_report 'fcm mkpatch: command aborted by user.';
+      return 1;
+    }
+
+    rmtree $outdir or die $outdir, ': cannot remove';
+  }
+
+  # (Re-)create output directory
+  mkpath $outdir or die $outdir, ': cannot create';
+  print 'Output directory: ', $outdir, "\n";
+
+  # Get and process log of URL
+  # ----------------------------------------------------------------------------
+  my @script     = (); # output script, from the log
+  my %log        = $url->svnlog (REV => \@revs);
+  my $url_path   = $url->path;
+  my $file_count = 0;
+
+  for my $rev (sort {$a <=> $b} keys %log) {
+    # Look at the changed paths for each revision
+    my @paths;
+
+    # Skip excluded paths if necessary
+    PATH: for my $path (sort keys %{ $log{$rev}{paths} }) {
+      for my $exclude (@exclude) {
+        (my $file = $path) =~ s#^$url_path/*##;
+
+        next PATH if $file =~ m#^$exclude(?:/*|$)#;
+      }
+
+      push @paths, $path;
+    }
+
+    next unless @paths;
+
+    # Parse commit log message
+    my @msg = split /\n/, $log{$rev}{msg};
+    for (@msg) {
+      # Re-instate line break
+      $_ .= "\n";
+
+      # Remove line if it matches a merge template
+      $_ = '' if /^Reversed r\d+(?::\d+)? of \S+$/;
+      $_ = '' if /^Custom merge into \S+:.+$/;
+      $_ = '' if /^Merged into \S+: \S+ cf\. \S+$/;
+
+      # Modify Trac ticket link
+      s/(?:#|ticket:)(\d+)/[$organisation ticket $1]/g;
+
+      # Modify Trac changeset link
+      s/(?:r|changeset:)(\d+)/[$organisation changeset $1]/g;
+      s/\[(\d+)\]/[$organisation changeset $1]/g;
+    }
+
+    push @msg, '[' . $organisation . ' changeset ' . $rev . ']' . "\n";
+
+    # Write commit log message in a file
+    my $f_revlog = File::Spec->catfile ($outdir, $rev . '-log');
+    open FILE, '>', $f_revlog or die $f_revlog, ': cannot open (', $!, ')';
+    print FILE @msg;
+    close FILE or die $f_revlog, ': cannot close (', $!, ')';
+
+    # Create a directory for this revision in the output directory
+    my $outdir_rev = File::Spec->catfile ($outdir, $rev);
+    mkpath $outdir_rev or die $outdir_rev, ': cannot create';
+
+    # Handle modified/copy/new path, export the path, + script to copy/add it
+    for my $path (@paths) {
+      next unless $log{$rev}{paths}{$path}{action} =~ /^[AMR]$/;
+
+      (my $file = $path) =~ s#^$url_path/*##;
+
+      # Download the file using "svn export"
+      my $patch    = File::Spec->catfile ($outdir_rev, $file_count++);
+      my $url_file = $url->url . '/' . $file . '@' . $rev;
+      &run_command ([qw/svn export -q -r/, $rev, $url_file, $patch]);
+
+      (my $patch_path = $patch) =~ s#^$outdir/*##;
+
+      # Script to copy the file, if required
+      my $is_newfile = 0;
+      if ($log{$rev}{paths}{$path}{action} eq 'A') {
+        if (exists $log{$rev}{paths}{$path}{'copyfrom-path'}) {
+          # History exists for this file
+          my $copyfrom_path = $log{$rev}{paths}{$path}{'copyfrom-path'};
+          my $copyfrom_rev  = $log{$rev}{paths}{$path}{'copyfrom-rev'};
+
+          # Check whether file is copied from a file under the specified URL
+          # It is likely to be a new file if it is copied from outside of the
+          # specified URL.
+          $is_newfile = not ($copyfrom_path =~ s#^$url_path/*##);
+
+          if ($is_newfile) {
+            # File copied from outside of the specified URL
+            # If it is copied from a branch, follow its history, stop on copy
+            my $cp_url = Fcm::CmUrl->new (
+              URL => $url->root . $copyfrom_path . '@' . $copyfrom_rev,
+            );
+
+            # Log of the copied file
+            my %cp_log = $cp_url->svnlog (STOP_ON_COPY => 1);
+
+            # "First" revision of the copied file
+            my $cp_rev = (sort {$a <=> $b} keys %cp_log) [0];
+            my %attrib = exists $cp_log{$cp_rev}{paths}{$cp_url->path}
+                         ? %{ $cp_log{$cp_rev}{paths}{$cp_url->path} } : ();
+
+            # Check whether the "first" revision is copied from elsewhere.
+            if (exists $attrib{'copyfrom-path'}) {
+              # Check whether source exists in the current branch
+              my $cp_cp_url = Fcm::CmUrl->new (
+                URL => $url->root . $attrib{'copyfrom-path'} . '@' .
+                       $attrib{'copyfrom-rev'},
+              );
+
+              $cp_cp_url->branch ($url->branch);
+
+              # If source exists in current branch, set up copy from the source
+              if ($cp_cp_url->url_exists ($rev - 1)) {
+                $is_newfile     = 0;
+                (my $cp_cp_path = $cp_cp_url->path) =~ s#^$url_path/*##;
+
+                push @script, 'svn copy ' . $cp_cp_path .  ' ' . $file;
+              }
+            }
+
+          } else {
+            # File copied from a location under the specified URL
+            # Script to copy file
+            push @script, 'svn copy ' . $copyfrom_path .  ' ' . $file;
+          }
+
+        } else {
+          # History does not exist, must be a new file
+          $is_newfile = 1;
+        }
+      }
+
+      # Copy the "patch" into the file
+      push @script, 'cp -r ${fcm_patch_dir}/' . $patch_path . ' ' . $file;
+
+      # Script to add the file, if required
+      push @script, 'svn add ' . $file
+        if $log{$rev}{paths}{$path}{action} eq 'A' and $is_newfile;
+    }
+
+    # Handle deleted path, script to delete it
+    for my $path (@paths) {
+      next unless $log{$rev}{paths}{$path}{action} eq 'D';
+
+      (my $file = $path) =~ s#^$url_path/*##;
+
+      push @script, 'svn delete ' . $file;
+    }
+
+    # Script to commit the change
+    push @script, 'svn commit -F ${fcm_patch_dir}/' . $rev . '-log';
+    push @script, '';
+  }
+
+  # Write the script if necessary. Otherwise remove output directory
+  # ----------------------------------------------------------------------------
+  if (@script) {
+    # Add line break to each line in @script
+    @script = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")} @script;
+
+    # Write script to output
+    my $out = File::Spec->catfile ($outdir, 'fcm-import-patch');
+    open FILE, '>', $out or die $out, ': cannot open (', $!, ')';
+
+    # Script header
+    print FILE <<EOF;
+#!/bin/sh
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm-import-patch
+#
+# SYNOPSIS
+#   fcm-import-patch TARGET
+#
+# DESCRIPTION
+#   This script is generated automatically by the "fcm mkpatch" command,
+#   together with the revision "patches" it creates. The script imports the
+#   patches into TARGET, which must either be a URL or a working copy of a
+#   valid project tree that can accept the import of the patches.
+#
+#   Patch created from $organisation URL: $u
+# ------------------------------------------------------------------------------
+
+this=`basename \$0`
+
+# Check argument
+target=\$1
+
+# First argument must be a URL or working copy
+if [[ -z \$target ]]; then
+  echo "\$this: the first argument must be a URL or a working copy, abort." >&2
+  exit 1
+fi
+
+if [[ \$target == svn://*  || \$target == svn+ssh://* || \\
+      \$target == http://* || \$target == https://*   || \\
+      \$target == file://* ]]; then
+  # A URL, checkout a working copy in a temporary location
+  fcm_tmp_dir=`mktemp -d \$TMPDIR/\$0.XXXXXX`
+  fcm_working_copy=\$fcm_tmp_dir
+  svn checkout -q \$target \$fcm_working_copy || exit 1
+
+else
+  # A working copy, check that it does not have local changes
+  status=`svn status \$target`
+
+  if [[ -n \$status ]]; then
+    echo "\$target: working copy contains changes, abort." >&2
+    exit 1
+  fi
+
+  fcm_working_copy=\$target
+fi
+
+# Location of the patches, base on the location of this script
+cd `dirname \$0` || exit 1
+fcm_patch_dir=\$PWD
+
+# Change directory to the working copy
+cd \$fcm_working_copy || exit 1
+
+# Commands to apply patches
+EOF
+
+    # Script content
+    print FILE @script;
+
+    # Script footer
+    print FILE <<EOF;
+# Remove temporary working copy, if necessary
+if [[ -d \$fcm_tmp_dir && -w \$fcm_tmp_dir ]]; then
+  rm -rf \$fcm_tmp_dir
+fi
+
+echo "\$this: finished normally."
+#EOF
+EOF
+
+    close FILE or die $out, ': cannot close (', $!, ')';
+
+    # Add executable permission
+    chmod 0755, $out;
+
+    # Diagnostic
+    print $outdir, ': patch generated.', "\n";
+
+  } else {
+    # Remove output directory
+    rmtree $outdir or die $outdir, ': cannot remove';
+
+    # Diagnostic
+    w_report 'No patch is required, abort.';
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_svn ();
+#
+# DESCRIPTION
+#   This is a generic wrapper for all "other" Subversion commands.
+# ------------------------------------------------------------------------------
+
+sub cm_svn {
+  &run_command (
+    ['svn', @_, @ARGV],
+    PRINT => ($_[0] ne 'cat' and not grep {$_ eq '--xml'} @ARGV),
+    METHOD => 'exec',
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_switch ();
+#
+# DESCRIPTION
+#   This is a wrapper for the Subversion "switch" command.
+# ------------------------------------------------------------------------------
+
+sub cm_switch {
+  if (grep {$_ eq '-h' or $_ eq '--help'} @ARGV or not @ARGV) {
+    # Print usage message if requested
+    print <<EOF;
+usage: 1. switch URL [PATH]
+       2. switch --relocate FROM TO [PATH...]
+
+Note: if --relocate is not specified, "fcm switch" will only support the
+      options --non-interactive, -r [--revision] and -q [--quiet].
+
+EOF
+
+    &run_command ([qw/svn switch --help/], PRINT => 1, METHOD => 'exec');
+
+  } elsif (grep {$_ eq '--relocate'} @ARGV) {
+    # If "--relocate" is specified, call the command "as is"
+    cm_svn ('switch');
+  }
+
+  # "--help" and "--relocate" not specified, implement custom switch command
+
+  # Get command line options
+  my ($non_interactive, $rev, $quiet);
+  GetOptions (
+    'non-interactive' => \$non_interactive,
+    'revision|r=s'    => \$rev,
+    'quiet|q'         => \$quiet,
+  );
+
+  # The remaining arguments
+  $rev = 'HEAD' if not $rev;
+
+  # The remaining arguments
+  my ($newurl_arg, $path) = @ARGV;
+
+  # Make sure we are in a working copy
+  if ($path) {
+    e_report $path, ': does not exist, abort.' if not -e $path;
+
+  } else {
+    $path = cwd ();
+  }
+
+  e_report $path, ': not a working copy, abort.' if not &is_wc ($path);
+
+  # Make sure we are at the top level of the working copy
+  my $dir = &get_wct ($path);
+
+  # Check for merge template in the commit log file in the working copy
+  my $ci_mesg = Fcm::CmCommitMessage->new (DIR => $dir);
+  $ci_mesg->read_file;
+  e_report (
+    (($path eq $dir) ? $ci_mesg->base : $ci_mesg->file),
+    ': merge template exists, please remove it before running switch, abort.',
+  ) if $ci_mesg->auto_mesg;
+
+  # Check for any local modifications
+  return if ! $non_interactive and &_abort_modified_wc ('fcm switch', $dir);
+
+  # Get current URL information associated with the working copy
+  my $oldurl = Fcm::CmBranch->new (URL => &get_url_of_wc ($dir));
+
+  # Analyse new URL
+  my $newurl = &_construct_branch_url ($newurl_arg, $oldurl);
+
+  # Construct the switch command
+  my @command = (
+    qw/svn switch/,
+    ($non_interactive ? '--non-interactive' : ()),
+    ($rev             ? ('-r', $rev)        : ()),
+    ($quiet           ? '--quiet'           : ()),
+    $newurl->url,
+    ($dir eq cwd () ? () : $dir),
+  );
+
+  # Execute the command
+  &run_command (\@command, METHOD => 'exec', PRINT => 1);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $source = &_construct_branch_url ($src_url, $target);
+#
+# DESCRIPTION
+#   The function takes a string $src_url, which is normally the SOURCE URL
+#   argument for "merge" and "switch", and a target, which is an instance of a
+#   Fcm::CmBranch object with a valid URL of a standard FCM branch. It returns
+#   an instance of a Fcm::CmBranch object that represents a valid URL for
+#   $src_url.
+# ------------------------------------------------------------------------------
+
+sub _construct_branch_url {
+  my ($src_url, $target) = @_;
+
+  my $source = Fcm::CmBranch->new (URL => $src_url);
+
+  if (not $source->is_url) {
+    # Not a full URL, construct full URL based on current URL
+    $source->url_peg ($target->url_peg);
+
+    my $path    = '';
+    my $project = $target->project;
+
+    # Construct the branch URL
+    if ($src_url =~ m#^/*$project/(?:trunk|branches|tags)$#) {
+      # Argument contains the full path under the repository root
+      $path = $src_url;
+
+    } elsif ($src_url =~ m#^/*trunk/*(?:@\d+)?$# or
+             $src_url =~ m#^/*(?:trunk|branches|tags)/+#) {
+      # Argument contains the full branch name
+      $src_url =~ s#^/*##;
+      $path    = $target->project_path . '/' . $src_url;
+
+    } else {
+      # Argument contains the shorter branch name
+      $src_url =~ s#^/*##;
+      $path    = $target->project_path . '/branches/' . $src_url;
+    }
+
+    $source->path_peg ($path);
+  }
+
+  # Replace source sub-directory with the target sub-directory
+  $source->subdir ($target->subdir);
+
+  # Ensure that the branch name exists
+  e_report $src_url, ': not a valid URL, abort.'
+    if not $source->url_exists;
+
+  # Ensure that the branch name is valid
+  e_report $src_url, ': not a standard branch in a FCM project, abort.'
+    if not $source->branch;
+
+  # Ensure that the source and target URLs are in the same project
+  e_report 'Source and target URLs are in different projects, abort.'
+    if $source->project_url ne $target->project_url;
+
+  return $source;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &_abort_modified_wc ($title, [$wc]);
+#
+# DESCRIPTION
+#   The function checks for any local modifications in a working copy and
+#   prompts the user whether he/she wants to continue with the command. $title
+#   is the title of the current command. If $wc is specified, it must be the
+#   path to a working copy. Otherwise, the current working directory is used.
+# ------------------------------------------------------------------------------
+
+sub _abort_modified_wc {
+  my ($title, $wc) = @_;
+
+  my @status = &run_command ([qw/svn status/, ($wc ? $wc : ())], METHOD => 'qx');
+
+  if (@status) {
+    print 'You have local modifications:', "\n", @status;
+    my $reply = &main::get_input (
+      TITLE   => $title,
+      MESSAGE => 'Are you sure you want to continue?',
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+
+    # Abort if user gives any reply other than "y"
+    if ($reply ne 'y') {
+      w_report $title, ': command aborted by user.';
+      return 1;
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmBranch.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmBranch.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmBranch.pm	(revision 5166)
@@ -0,0 +1,1199 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmBranch
+#
+# DESCRIPTION
+#   This class contains methods for manipulating a branch. It is a sub-class of
+#   Fcm::CmUrl, and inherits all methods from that class.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmBranch;
+@ISA = qw(Fcm::CmUrl);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+
+# FCM component modules
+use Fcm::CmCommitMessage;
+use Fcm::CmUrl;
+use Fcm::Util qw/run_command e_report w_report get_rev_keyword svn_date/;
+
+my @properties = (
+  'CREATE_REV',  # revision at which the branch is created
+  'DELETE_REV',  # revision at which the branch is deleted
+  'PARENT',      # reference to parent branch Fcm::CmBranch
+  'ANCESTOR',    # list of common ancestors with other branches
+                 # key = URL, value = ancestor Fcm::CmBranch
+  'LAST_MERGE',  # list of last merges from branches
+                 # key = URL@REV, value = [TARGET, UPPER, LOWER]
+  'AVAIL_MERGE', # list of available revisions for merging
+                 # key = URL@REV, value = [REV ...]
+  'CHILDREN',    # list of children of this branch
+  'SIBLINGS',    # list of siblings of this branch
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch = Fcm::CmBranch->new (
+#     CONFIG  => $config,
+#     URL     => $url,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmBranch class.
+#
+# ARGUMENTS
+#   CONFIG - reference to a Fcm::Config instance
+#   URL    - URL of a branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::CmUrl->new (%args);
+
+  $self->{$_} = undef for (@properties);
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_branch->url_peg;
+#   $cm_branch->url_peg ($url);
+#
+# DESCRIPTION
+#   This method returns/sets the current URL.
+# ------------------------------------------------------------------------------
+
+sub url_peg {
+  my $self = shift;
+
+  if (@_) {
+    if (! $self->{URL} or $_[0] ne $self->{URL}) {
+      # Re-set URL and other essential variables in the SUPER-class
+      $self->SUPER::url_peg (@_);
+
+      # Re-set essential variables
+      $self->{$_} = undef for (@properties);
+    }
+  }
+
+  return $self->{URL};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_branch->create_rev;
+#
+# DESCRIPTION
+#   This method returns the revision at which the branch was created.
+# ------------------------------------------------------------------------------
+
+sub create_rev {
+  my $self = shift;
+
+  if (not $self->{CREATE_REV}) {
+    return unless $self->url_exists ($self->pegrev);
+
+    # Use "svn log" to find out the first revision of the branch
+    my %log = $self->svnlog (STOP_ON_COPY => 1);
+
+    # Look at log in ascending order
+    my $rev   = (sort {$a <=> $b} keys %log) [0];
+    my $paths = $log{$rev}{paths};
+
+    # Get revision when URL is first added to the repository
+    if (exists $paths->{$self->branch_path}) {
+      $self->{CREATE_REV} = $rev if $paths->{$self->branch_path}{action} eq 'A';
+    }
+  }
+
+  return $self->{CREATE_REV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $parent = $cm_branch->parent;
+#
+# DESCRIPTION
+#   This method returns the parent (a Fcm::CmBranch object) of the current
+#   branch.
+# ------------------------------------------------------------------------------
+
+sub parent {
+  my $self = shift;
+
+  if (not $self->{PARENT}) {
+    # Use the log to find out the parent revision
+    my %log = $self->svnlog (REV => $self->create_rev);
+
+    if (exists $log{paths}{$self->branch_path}) {
+      my $path = $log{paths}{$self->branch_path};
+
+      if ($path->{action} eq 'A') {
+        if (exists $path->{'copyfrom-path'}) {
+          # Current branch is copied from somewhere, set the source as the parent
+          my $url = $self->root .  $path->{'copyfrom-path'};
+          my $rev = $path->{'copyfrom-rev'};
+          $self->{PARENT} = Fcm::CmBranch->new (URL => $url . '@' . $rev);
+
+        } else {
+          # Current branch is not copied from somewhere
+          $self->{PARENT} = $self;
+        }
+      }
+    }
+  }
+
+  return $self->{PARENT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_branch->delete_rev;
+#
+# DESCRIPTION
+#   This method returns the revision at which the branch was deleted.
+# ------------------------------------------------------------------------------
+
+sub delete_rev {
+  my $self = shift;
+
+  if (not $self->{DELETE_REV}) {
+    return if $self->url_exists ('HEAD');
+
+    # Container of the current URL
+    (my $dir_url = $self->branch_url) =~ s#/+[^/]+/*$##;
+
+    # Use "svn log" on the container between a revision where the branch exists
+    # and the HEAD
+    my $dir = Fcm::CmUrl->new (URL => $dir_url);
+    my %log = $dir->svnlog (
+      REV => ['HEAD', ($self->pegrev ? $self->pegrev : $self->create_rev)],
+    );
+
+    # Go through the log to see when branch no longer exists
+    for my $rev (sort {$a <=> $b} keys %log) {
+      next unless exists $log{$rev}{paths}{$self->branch_path} and
+                  $log{$rev}{paths}{$self->branch_path}{action} eq 'D';
+
+      $self->{DELETE_REV} = $rev;
+      last;
+    }
+  }
+
+  return $self->{DELETE_REV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->is_child_of ($branch);
+#
+# DESCRIPTION
+#   This method returns true if the current branch is a child of $branch.
+# ------------------------------------------------------------------------------
+
+sub is_child_of {
+  my ($self, $branch) = @_;
+
+  # The trunk cannot be a child branch
+  return if $self->is_trunk;
+
+  # If $branch is a branch, use name of $self to see when it is created
+  if ($branch->is_branch and $self->url =~ m#/r(\d+)_[^/]+/*$#) {
+    my $rev = $1;
+
+    # $self can only be a child if it is copied from a revision > the create
+    # revision of $branch
+    return if $rev < $branch->create_rev;
+  }
+
+  return if $self->parent->url ne $branch->url;
+
+  # If $branch is a branch, ensure that it is created before $self
+  return if $branch->is_branch and $self->create_rev <= $branch->create_rev;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->is_sibling_of ($branch);
+#
+# DESCRIPTION
+#   This method returns true if the current branch is a sibling of $branch.
+# ------------------------------------------------------------------------------
+
+sub is_sibling_of {
+  my ($self, $branch) = @_;
+
+  # The trunk cannot be a sibling branch
+  return if $branch->is_trunk;
+
+  return if $self->parent->url ne $branch->parent->url;
+
+  # If the parent is a branch, ensure they are actually the same branch
+  return if $branch->parent->is_branch and
+            $self->parent->create_rev != $branch->parent->create_rev;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_relatives ($relation);
+#
+# DESCRIPTION
+#   This method sets the $self->{$relation} variable by inspecting the list of
+#   branches at the current revision of the current branch. $relation can be
+#   either "CHILDREN" or "SIBLINGS".
+# ------------------------------------------------------------------------------
+
+sub _get_relatives {
+  my ($self, $relation) = @_;
+
+  my @branch_list = $self->branch_list;
+
+  $self->{$relation} = [];
+
+  # If we are searching for CHILDREN, get list of SIBLINGS, and vice versa
+  my $other = ($relation eq 'CHILDREN' ? 'SIBLINGS' : 'CHILDREN');
+  my %other_list;
+  if ($self->{$other}) {
+    %other_list = map {$_->url, 1} @{ $self->{$other} };
+  }
+
+  for my $u (@branch_list) {
+    # Ignore URL of current branch and its parent
+    next if $u eq $self->url;
+    next if $self->is_branch and $u eq $self->parent->url;
+
+    # Ignore if URL is a branch detected to be another type of relative
+    next if exists $other_list{$u};
+
+    # Construct new Fcm::CmBranch object from branch URL
+    my $url = $u . ($self->pegrev ? '@' . $self->pegrev : '');
+    my $branch = Fcm::CmBranch->new (URL => $url);
+
+    # Test whether $branch is a relative we are looking for
+    if ($relation eq 'CHILDREN') {
+      push @{ $self->{$relation} }, $branch if $branch->is_child_of ($self);
+
+    } else {
+      push @{ $self->{$relation} }, $branch if $branch->is_sibling_of ($self);
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @children = $cm_branch->children;
+#
+# DESCRIPTION
+#   This method returns a list of children (Fcm::CmBranch objects) of the
+#   current branch that exists in the current revision.
+# ------------------------------------------------------------------------------
+
+sub children {
+  my $self = shift;
+
+  $self->_get_relatives ('CHILDREN') if not $self->{CHILDREN};
+
+  return @{ $self->{CHILDREN} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @siblings = $cm_branch->siblings;
+#
+# DESCRIPTION
+#   This method returns a list of siblings (Fcm::CmBranch objects) of the
+#   current branch that exists in the current revision.
+# ------------------------------------------------------------------------------
+
+sub siblings {
+  my $self = shift;
+
+  $self->_get_relatives ('SIBLINGS') if not $self->{SIBLINGS};
+
+  return @{ $self->{SIBLINGS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ancestor = $cm_branch->ancestor ($branch);
+#
+# DESCRIPTION
+#   This method returns the common ancestor (a Fcm::CmBranch object) of a
+#   specified $branch and the current branch. The argument $branch must be a
+#   Fcm::CmBranch object. Both the current branch and $branch are assumed to be
+#   in the same project.
+# ------------------------------------------------------------------------------
+
+sub ancestor {
+  my ($self, $branch) = @_;
+
+  if (not exists $self->{ANCESTOR}{$branch->url_peg}) {
+    if ($self->url_peg eq $branch->url_peg) {
+      $self->{ANCESTOR}{$branch->url_peg} = $self;
+
+    } else {
+      # Get family tree of current branch, from trunk to current branch
+      my @this_family = ($self);
+      while (not $this_family [0]->is_trunk) {
+        unshift @this_family, $this_family [0]->parent;
+      }
+
+      # Get family tree of $branch, from trunk to $branch
+      my @that_family = ($branch);
+      while (not $that_family [0]->is_trunk) {
+        unshift @that_family, $that_family [0]->parent;
+      }
+
+      # Find common ancestor from list of parents
+      my $ancestor = undef;
+
+      while (not $ancestor) {
+        # $this and $that should both start as some revisions on the trunk.
+        # Walk down a generation each time it loops around.
+        my $this = shift @this_family;
+        my $that = shift @that_family;
+
+        if ($this->url eq $that->url) {
+          if ($this->is_trunk or $this->create_rev eq $that->create_rev) {
+            # $this and $that are the same branch
+            if (@this_family and @that_family) {
+              # More generations in both branches, try comparing the next
+              # generations.
+              next;
+
+            } else {
+              # End of lineage in one of the branches, ancestor is at the lower
+              # revision of the current URL.
+              if ($this->pegrev and $that->pegrev) {
+                $ancestor = $this->pegrev < $that->pegrev ? $this : $that;
+
+              } else {
+                $ancestor = $this->pegrev ? $this : $that;
+              }
+            }
+
+          } else {
+            # Despite the same URL, $this and $that are different branches as
+            # they are created at different revisions. The ancestor must be the
+            # parent with the lower revision. (This should not occur at the
+            # start.)
+            $ancestor = $this->parent->pegrev < $that->parent->pegrev
+                        ? $this->parent : $that->parent;
+          }
+
+        } else {
+          # Different URLs, ancestor must be the parent with the lower revision.
+          # (This should not occur at the start.)
+          $ancestor = $this->parent->pegrev < $that->parent->pegrev
+                      ? $this->parent : $that->parent;
+        }
+      }
+
+      $self->{ANCESTOR}{$branch->url_peg} = $ancestor;
+    }
+  }
+
+  return $self->{ANCESTOR}{$branch->url_peg};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($target, $upper, $lower) = $cm_branch->last_merge_from (
+#     $branch, $stop_on_copy,
+#   );
+#
+# DESCRIPTION
+#   This method returns a 3-element list with information of the last merge
+#   into the current branch from a specified $branch. The first element in the
+#   list $target (a Fcm::CmBranch object) is the target at which the merge was
+#   performed. (This can be the current branch or a parent branch up to the
+#   common ancestor with the specified $branch.) The second and third elements,
+#   $upper and $lower, (both Fcm::CmBranch objects), are the upper and lower
+#   ends of the source delta. If there is no merge from $branch into the
+#   current branch from their common ancestor to the current revision, this
+#   method will return an empty list. If $stop_on_copy is specified, it ignores
+#   merges from parents of $branch, and merges into parents of the current
+#   branch.
+# ------------------------------------------------------------------------------
+
+sub last_merge_from {
+  my ($self, $branch, $stop_on_copy) = @_;
+
+  if (not exists $self->{LAST_MERGE}{$branch->url_peg}) {
+    # Get "log" of current branch down to the common ancestor
+    my %log = $self->svnlog (
+      REV => [
+       ($self->pegrev ? $self->pegrev : 'HEAD'),
+       $self->ancestor ($branch)->pegrev,
+      ],
+
+      STOP_ON_COPY => $stop_on_copy,
+    );
+
+    my $cr = $self;
+
+    # Go down the revision log, checking for merge template messages
+    REV: for my $rev (sort {$b <=> $a} keys %log) {
+      # Loop each line of the log message at each revision
+      my @msg = split /\n/, $log{$rev}{msg};
+
+      # Also consider merges into parents of current branch
+      $cr = $cr->parent if ($cr->is_branch and $rev < $cr->create_rev);
+
+      for (@msg) {
+        # Ignore unless log message matches a merge template
+        next unless /Merged into \S+: (\S+) cf\. (\S+)/;
+
+        # Upper $1 and lower $2 ends of the source delta
+        my $u_path = $1;
+        my $l_path = $2;
+
+        # Add the root directory to the paths if necessary
+        $u_path = '/' . $u_path if substr ($u_path, 0, 1) ne '/';
+        $l_path = '/' . $l_path if substr ($l_path, 0, 1) ne '/';
+
+        # Only consider merges with specified branch (and its parent)
+        (my $path = $u_path) =~ s/@(\d+)$//;
+        my $u_rev = $1;
+
+        my $br = $branch;
+        $br    = $br->parent while (
+          $br->is_branch and $u_rev < $br->create_rev and not $stop_on_copy
+        );
+
+        next unless $br->branch_path eq $path;
+
+        # If $br is a parent of branch, ignore those merges with the parent
+        # above the branch point of the current branch
+        next if $br->pegrev and $br->pegrev < $u_rev;
+
+        # Set the return values
+        $self->{LAST_MERGE}{$branch->url_peg} = [
+          Fcm::CmBranch->new (URL => $cr->url . '@' . $rev), # target
+          Fcm::CmBranch->new (URL => $self->root . $u_path), # delta upper
+          Fcm::CmBranch->new (URL => $self->root . $l_path), # delta lower
+        ];
+
+        last REV;
+      }
+    }
+  }
+
+  return (exists $self->{LAST_MERGE}{$branch->url_peg}
+          ? @{ $self->{LAST_MERGE}{$branch->url_peg} } : ());
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @revs = $cm_branch->avail_merge_from ($branch[, $stop_on_copy]);
+#
+# DESCRIPTION
+#   This method returns a list of revisions of a specified $branch, which are
+#   available for merging into the current branch. If $stop_on_copy is
+#   specified, it will not list available merges from the parents of $branch.
+# ------------------------------------------------------------------------------
+
+sub avail_merge_from {
+  my ($self, $branch, $stop_on_copy) = @_;
+
+  if (not exists $self->{AVAIL_MERGE}{$branch->url_peg}) {
+    # Find out the revision of the upper delta at the last merge from $branch
+    # If no merge is found, use revision of common ancestor with $branch
+    my @last_merge = $self->last_merge_from ($branch);
+    my $rev        = $self->ancestor ($branch)->pegrev;
+    $rev           = $last_merge [1]->pegrev
+      if @last_merge and $last_merge [1]->pegrev > $rev;
+
+    # Get the "log" of the $branch down to $rev
+    my %log = $branch->svnlog (
+      REV          => [($branch->pegrev ? $branch->pegrev : 'HEAD'), $rev],
+      STOP_ON_COPY => $stop_on_copy,
+    );
+
+    # No need to include $rev itself, as it has already been merged
+    delete $log{$rev};
+
+    # No need to include the branch create revision
+    delete $log{$branch->create_rev}
+      if $branch->is_branch and exists $log{$branch->create_rev};
+
+    if (keys %log) {
+      # Check whether there is a latest merge from $self into $branch, if so,
+      # all revisions of $branch below that merge should become unavailable
+      my @last_merge_into = $branch->last_merge_from ($self);
+
+      if (@last_merge_into) {
+        for my $rev (keys %log) {
+          delete $log{$rev} if $rev < $last_merge_into [0]->pegrev;
+        }
+      }
+    }
+
+    # Available merges include all revisions above the branch creation revision
+    # or the revision of the last merge
+    $self->{AVAIL_MERGE}{$branch->url_peg} = [sort {$b <=> $a} keys %log];
+  }
+
+  return @{ $self->{AVAIL_MERGE}{$branch->url_peg} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $lower = $cm_branch->base_of_merge_from ($branch);
+#
+# DESCRIPTION
+#   This method returns the lower delta (a Fcm::CmBranch object) for the next
+#   merge from $branch.
+# ------------------------------------------------------------------------------
+
+sub base_of_merge_from {
+  my ($self, $branch) = @_;
+
+  # Base is the ancestor if there is no merge between $self and $branch
+  my $return = $self->ancestor ($branch);
+
+  # Get configuration for the last merge from $branch to $self
+  my @merge_from = $self->last_merge_from ($branch);
+
+  # Use the upper delta of the last merge from $branch, as all revisions below
+  # that have already been merged into the $self
+  $return = $merge_from [1]
+    if @merge_from and $merge_from [1]->pegrev > $return->pegrev;
+
+  # Get configuration for the last merge from $self to $branch
+  my @merge_into = $branch->last_merge_from ($self);
+
+  # Use the upper delta of the last merge from $self, as the current revision
+  # of $branch already contains changes of $self up to the peg revision of the
+  # upper delta
+  $return = $merge_into [1]
+    if @merge_into and $merge_into [0]->pegrev > $return->pegrev;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->allow_subdir_merge_from ($branch, $subdir);
+#
+# DESCRIPTION
+#   This method returns true if a merge from the sub-directory $subdir in
+#   $branch  is allowed - i.e. it does not result in losing changes made in
+#   $branch outside of $subdir.
+# ------------------------------------------------------------------------------
+
+sub allow_subdir_merge_from {
+  my ($self, $branch, $subdir) = @_;
+
+  # Get revision at last merge from $branch or ancestor
+  my @merge_from = $self->last_merge_from ($branch);
+  my $last       = @merge_from ? $merge_from [1] : $self->ancestor ($branch);
+  my $rev        = $last->pegrev;
+
+  if ($branch->pegrev > $rev) {
+    # Inspect log from revision at last merge/ancestor to current revision
+    my %log = $branch->svnlog (REV => [$branch->pegrev, $rev + 1]);
+    my $br  = $branch;
+
+    # Check whether there are changes outside of $subdir
+    for my $rev (sort {$b <=> $a} keys %log) {
+      $br = $br->parent if $br->is_branch and $rev < $br->create_rev;
+
+      for my $path (keys %{ $log{$rev}{paths} }) {
+        next if $path eq $br->branch_path; # Ignore branch creation
+
+        my $p_subdir = substr ($path, length ($br->branch_path) + 1);
+
+        return if $p_subdir !~ m#^$subdir(?:/|$)#;
+      }
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->create (
+#     SRC                  => $src,
+#     TYPE                 => $type,
+#     NAME                 => $name,
+#     [PASSWORD            => $password,]
+#     [REV_FLAG            => $rev_flag,]
+#     [TICKET              => \@tickets,]
+#     [REV                 => $rev,]
+#     [NON_INTERACTIVE     => 1,]
+#     [SVN_NON_INTERACTIVE => 1,]
+#   );
+#
+# DESCRIPTION
+#   This method creates a branch in a Subversion repository.
+#
+# OPTIONS
+#   SRC                 - reference to a Fcm::CmUrl object.
+#   TYPE                - Specify the branch type. See help in "fcm branch" for
+#                         further information.
+#   NAME                - specify the name of the branch.
+#   NON_INTERACTIVE     - Do no interactive prompting, set SVN_NON_INTERACTIVE
+#                         to true automatically.
+#   PASSWORD            - specify the password for commit access.
+#   REV                 - specify the operative revision of the source.
+#   REV_FLAG            - A flag to specify the behaviour of the prefix to the
+#                         branch name. See help in "fcm branch" for further
+#                         information.
+#   SVN_NON_INTERACTIVE - Do no interactive prompting when running svn commit,
+#                         etc. This option is implied by NON_INTERACTIVE.
+#   TICKET              - Specify one or more related tickets for the branch.
+# ------------------------------------------------------------------------------
+
+sub create {
+  my $self = shift;
+  my %args = @_;
+
+  # Options
+  # ----------------------------------------------------------------------------
+  # Compulsory options
+  my $src  = $args{SRC};
+  my $type = $args{TYPE};
+  my $name = $args{NAME};
+
+  # Other options
+  my $rev_flag        = $args{REV_FLAG}        ? $args{REV_FLAG}    : 'NORMAL';
+  my @tickets         = exists $args{TICKET}   ? @{ $args{TICKET} } : ();
+  my $password        = exists $args{PASSWORD} ? $args{PASSWORD}    : undef;
+  my $orev            = exists $args{REV}      ? $args{REV}         : 'HEAD';
+
+  my $non_interactive     = exists $args{NON_INTERACTIVE}
+                            ? $args{NON_INTERACTIVE} : 0;
+  my $svn_non_interactive = exists $args{SVN_NON_INTERACTIVE}
+                            ? $args{SVN_NON_INTERACTIVE} : 0;
+  $svn_non_interactive    = $non_interactive ? 1 : $svn_non_interactive;
+
+  # Analyse the source URL
+  # ----------------------------------------------------------------------------
+  # Create branch from the trunk by default
+  $src->branch ('trunk') if not $src->branch;
+
+  # Remove "sub-directory" part from source URL
+  $src->subdir ('')      if $src->subdir;
+
+  # Remove "peg revision" part because it does not work with "svn copy"
+  $src->pegrev ('')      if $src->pegrev;
+
+  # Find out the URL and the last changed revision of the specified URL at the
+  # specified operative revision
+  my $url = $src->svninfo (FLAG => 'URL', REV => $orev);
+  e_report $src->url, ': cannot determine the operative URL at revision ',
+           $orev, ', abort.' if not $url;
+
+  $src->url ($url) if $url ne $src->url;
+
+  my $rev = $src->svninfo (FLAG => 'Last Changed Rev', REV => $orev);
+  e_report $src->url, ': cannot determine the last changed rev at revision',
+           $orev, ', abort.' if not $rev;
+
+  # Warn user if last changed revision is not the specified revision
+  w_report 'Warning: branch will be created from revision ', $rev,
+           ', i.e. the last changed rev.'
+    unless $orev and $orev eq $rev;
+
+  # Determine the sub-directory names of the branch
+  # ----------------------------------------------------------------------------
+  my @branch_dirs = ('branches');
+
+  # Split branch type flags into a hash table
+  my %type_flags = ();
+  $type_flags{$_} = 1 for ((split /::/, $type));
+
+  # Branch sub-directory 1, development, test or package
+  for my $flag (qw/DEV TEST PKG/) {
+    if (exists $type_flags{$flag}) {
+      push @branch_dirs, lc ($flag);
+      last;
+    }
+  }
+
+  # Branch sub-directory 2, user, share, configuration or release
+  if (exists $type_flags{USER}) {
+    my $userid = getlogin;
+    $userid    = $ENV{LOGNAME} unless $userid;
+    $userid    = $ENV{USER}    unless $userid;
+    die 'Unable to determine your user ID, abort' unless $userid;
+
+    push @branch_dirs, $userid;
+
+  } else {
+    for my $flag (qw/SHARE CONFIG REL/) {
+      if (exists $type_flags{$flag}) {
+        push @branch_dirs, uc (substr $flag, 0, 1) . lc (substr $flag, 1);
+        last;
+      }
+    }
+  }
+
+  # Branch sub-directory 3, branch name
+  # Prefix branch name with revision number/keyword if necessary
+  my $prefix = '';
+  if ($rev_flag ne 'NONE') {
+    $prefix = $rev;
+
+    # Attempt to replace revision number with a revision keyword if necessary
+    $prefix = &get_rev_keyword (
+      REV => $rev,
+      URL => $src->url_peg,
+    ) if $rev_flag eq 'NORMAL';
+
+    # $prefix is still a revision number, add "r" in front of it
+    $prefix = 'r' . $prefix if $prefix eq $rev;
+
+    # Add an underscore before the branch name
+    $prefix.= '_';
+  }
+
+  # Branch name
+  push @branch_dirs, $prefix . $name;
+
+  # Check whether the branch already exists, fail if so
+  # ----------------------------------------------------------------------------
+  # Construct the URL of the branch
+  $self->project_url ($src->project_url);
+  $self->branch  (join ('/', @branch_dirs));
+
+  # Check that branch does not already exists
+  e_report $self->url, ': branch already exists, abort.' if $self->url_exists;
+
+  # Message for the commit log
+  # ----------------------------------------------------------------------------
+  my @message = ('Created ' . $self->branch_path .  ' from ' .
+                 $src->branch_path . '@' . $rev . '.' . "\n");
+
+  # Add related Trac ticket links to commit log if set
+  if (@tickets) {
+    my $ticket_mesg = 'Relates to ticket' . (@tickets > 1 ? 's' : '');
+
+    while (my $ticket = shift @tickets) {
+      $ticket_mesg .= ' #' . $ticket;
+      $ticket_mesg .= (@tickets > 1 ? ',' : ' and') if @tickets >= 1;
+    }
+
+    push @message, $ticket_mesg . ".\n";
+  }
+
+  # Create a temporary file for the commit log message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->auto_mesg (@message);
+  $ci_mesg->ignore_mesg ('A' . ' ' x 4 . $self->url . "\n");
+  my $logfile = $ci_mesg->edit_file (TEMP => 1, BATCH => $non_interactive);
+
+  # Check with the user to see if he/she wants to go ahead
+  # ----------------------------------------------------------------------------
+  if (not $non_interactive) {
+    my $reply = &main::get_input (
+      TITLE   => 'fcm branch',
+      MESSAGE => 'Would you like to go ahead and create this branch?',
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+
+    return unless $reply eq 'y';
+  }
+
+  # Ensure existence of container sub-directories of the branch
+  # ----------------------------------------------------------------------------
+  for my $i (0 .. $#branch_dirs - 1) {
+    my $subdir     = join ('/', @branch_dirs[0 .. $i]);
+    my $subdir_url = Fcm::CmUrl->new (URL => $src->project_url . '/' . $subdir);
+
+    # Check whether each sub-directory of the branch already exists,
+    # if sub-directory does not exist, create it
+    next if $subdir_url->url_exists;
+
+    print 'Creating sub-directory: ', $subdir, "\n";
+
+    my @command = (
+      qw/svn mkdir/,
+      '-m', 'Created ' . $subdir . ' directory.',
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+
+      $subdir_url->url,
+    );
+    &run_command (\@command);
+  }
+
+  # Create the branch
+  # ----------------------------------------------------------------------------
+  {
+    print 'Creating branch ', $self->url, ' ...', "\n";
+    my @command = (
+      qw/svn copy/,
+      '-r', $rev,
+      '-F', $logfile,
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+
+      $src->url, $self->url,
+    );
+    &run_command (\@command);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->delete (
+#     [NON_INTERACTIVE     => 1,]
+#     [PASSWORD            => $password,]
+#     [SVN_NON_INTERACTIVE => 1,]
+#   );
+#
+# DESCRIPTION
+#   This method deletes the current branch from the Subversion repository.
+#
+# OPTIONS
+#   NON_INTERACTIVE     - Do no interactive prompting, set SVN_NON_INTERACTIVE
+#                         to true automatically.
+#   PASSWORD            - specify the password for commit access.
+#   SVN_NON_INTERACTIVE - Do no interactive prompting when running svn commit,
+#                         etc. This option is implied by NON_INTERACTIVE.
+# ------------------------------------------------------------------------------
+
+sub del {
+  my $self = shift;
+  my %args = @_;
+
+  # Options
+  # ----------------------------------------------------------------------------
+  my $password            = exists $args{PASSWORD} ? $args{PASSWORD} : undef;
+  my $non_interactive     = exists $args{NON_INTERACTIVE}
+                            ? $args{NON_INTERACTIVE} : 0;
+  my $svn_non_interactive = exists $args{SVN_NON_INTERACTIVE}
+                            ? $args{SVN_NON_INTERACTIVE} : 0;
+  $svn_non_interactive    = $non_interactive ? 1 : $svn_non_interactive;
+
+  # Ensure URL is a branch
+  # ----------------------------------------------------------------------------
+  e_report $self->url_peg, ': not a branch, abort.' if not $self->is_branch;
+
+  # Message for the commit log
+  # ----------------------------------------------------------------------------
+  my @message = ('Deleted ' . $self->branch_path . '.' . "\n");
+
+  # Create a temporary file for the commit log message
+  my $ci_mesg = Fcm::CmCommitMessage->new ();
+  $ci_mesg->auto_mesg (@message);
+  $ci_mesg->ignore_mesg ('D' . ' ' x 4 . $self->url . "\n");
+  my $logfile = $ci_mesg->edit_file (TEMP => 1, BATCH => $non_interactive);
+
+  # Check with the user to see if he/she wants to go ahead
+  # ----------------------------------------------------------------------------
+  if (not $non_interactive) {
+    my $reply = &main::get_input (
+      TITLE   => 'fcm branch',
+      MESSAGE => 'Would you like to go ahead and delete this branch?',
+      TYPE    => 'yn',
+      DEFAULT => 'n',
+    );
+
+    return unless $reply eq 'y';
+  }
+
+  # Delete branch if answer is "y" for "yes"
+  # ----------------------------------------------------------------------------
+  print 'Deleting branch ', $self->url, ' ...', "\n";
+  my @command = (
+    qw/svn delete/,
+    '-F', $logfile,
+    (defined $password    ? ('--password', $password) : ()),
+    ($svn_non_interactive ? '--non-interactive'       : ()),
+
+    $self->url,
+  );
+  &run_command (\@command);
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->display_info (
+#     [SHOW_CHILDREN => 1],
+#     [SHOW_OTHER    => 1]
+#     [SHOW_SIBLINGS => 1]
+#   );
+#
+# DESCRIPTION
+#   This method displays information of the current branch. If SHOW_CHILDREN is
+#   set, it shows information of all current children branches of the current
+#   branch. If SHOW_SIBLINGS is set, it shows information of siblings that have
+#   been merged recently with the current branch. If SHOW_OTHER is set, it shows
+#   information of custom/reverse merges.
+# ------------------------------------------------------------------------------
+
+sub display_info {
+  my $self = shift;
+  my %args = @_;
+
+  # Arguments
+  # ----------------------------------------------------------------------------
+  my $show_children = exists $args{SHOW_CHILDREN} ? $args{SHOW_CHILDREN} : 0;
+  my $show_other    = exists $args{SHOW_OTHER   } ? $args{SHOW_OTHER}    : 0;
+  my $show_siblings = exists $args{SHOW_SIBLINGS} ? $args{SHOW_SIBLINGS} : 0;
+
+  # Useful variables
+  # ----------------------------------------------------------------------------
+  my $separator  = '-' x 80 . "\n";
+  my $separator2 = '  ' . '-' x 78 . "\n";
+
+  # Print "info" as returned by "svn info"
+  # ----------------------------------------------------------------------------
+  for my $key ('URL', 'Repository Root', 'Revision', 'Last Changed Author',
+               'Last Changed Rev', 'Last Changed Date') {
+    print $key, ': ', $self->svninfo (FLAG => $key), "\n"
+      if $self->svninfo (FLAG => $key);
+  }
+
+  if ($self->config->verbose) {
+    # Verbose mode, print log message at last changed revision
+    my %log = $self->svnlog (REV => $self->svninfo (FLAG => 'Last Changed Rev'));
+    my @log = split /\n/, $log{msg};
+    print 'Last Changed Log:', "\n\n", map ({'  ' . $_ . "\n"} @log), "\n";
+  }
+
+  if ($self->is_branch) {
+    # Print create information
+    # --------------------------------------------------------------------------
+    my %log = $self->svnlog (REV => $self->create_rev);
+
+    print $separator;
+    print 'Branch Create Author: ', $log{author}, "\n" if $log{author};
+    print 'Branch Create Rev: ', $self->create_rev, "\n";
+    print 'Branch Create Date: ', &svn_date ($log{date}), "\n";
+
+    if ($self->config->verbose) {
+      # Verbose mode, print log message at last create revision
+      my @log = split /\n/, $log{msg};
+      print 'Branch Create Log:', "\n\n", map ({'  ' . $_ . "\n"} @log), "\n";
+    }
+
+    # Print delete information if branch no longer exists
+    # --------------------------------------------------------------------------
+    print 'Branch Delete Rev: ', $self->delete_rev, "\n" if $self->delete_rev;
+
+    # Report merges into/from the parent
+    # --------------------------------------------------------------------------
+    # Print the URL@REV of the parent branch
+    print $separator, 'Branch Parent: ', $self->parent->url_peg, "\n";
+
+    # Set up a new object for the parent at the current revision
+    # --------------------------------------------------------------------------
+    my $p_url  = $self->parent->url;
+    $p_url    .= '@' . $self->pegrev if $self->pegrev;
+    my $parent = Fcm::CmBranch->new (URL => $p_url);
+
+    if (not $parent->url_exists) {
+      print 'Branch parent deleted.', "\n";
+      return;
+    }
+
+    # Report merges into/from the parent
+    # --------------------------------------------------------------------------
+    print $self->_report_merges ($parent, 'Parent');
+  }
+
+  # Report merges with siblings
+  # ----------------------------------------------------------------------------
+  if ($show_siblings) {
+    # Report number of sibling branches found
+    print $separator, 'Seaching for siblings ... ';
+    my @siblings = $self->siblings;
+    print scalar (@siblings), ' ', (@siblings> 1 ? 'siblings' : 'sibling'),
+          ' found.', "\n";
+
+    # Report branch name and merge information only if there are recent merges
+    my $out = '';
+    for my $sibling (@siblings) {
+      my $string = $self->_report_merges ($sibling, 'Sibling');
+
+      $out .= $separator2 . '  ' . $sibling->url . "\n" . $string if $string;
+    }
+
+    if (@siblings) {
+      if ($out) {
+        print 'Merges with existing siblings:', "\n", $out;
+
+      } else {
+        print 'No merges with existing siblings.', "\n";
+      }
+    }
+  }
+
+  # Report children
+  # ----------------------------------------------------------------------------
+  if ($show_children) {
+    # Report number of child branches found
+    print $separator, 'Seaching for children ... ';
+    my @children = $self->children;
+    print scalar (@children), ' ', (@children > 1 ? 'children' : 'child'),
+          ' found.', "\n";
+
+    # Report children if they exist
+    print 'Current children:', "\n" if @children;
+
+    for my $child (@children) {
+      print $separator2, '  ', $child->url, "\n";
+      print '  Child Create Rev: ', $child->create_rev, "\n";
+      print $self->_report_merges ($child, 'Child');
+    }
+  }
+
+  # Report custom/reverse merges into the branch
+  # ----------------------------------------------------------------------------
+  if ($show_other) {
+    my %log = $self->svnlog (STOP_ON_COPY => 1);
+    my @out;
+
+    # Go down the revision log, checking for merge template messages
+    REV: for my $rev (sort {$b <=> $a} keys %log) {
+      # Loop each line of the log message at each revision
+      my @msg = split /\n/, $log{$rev}{msg};
+
+      for (@msg) {
+        # Ignore unless log message matches a merge template
+        if (/^Reversed r\d+(:\d+)? of \S+$/ or
+            s/^(Custom merge) into \S+(:.+)$/$1$2/) {
+          push @out, ('r' . $rev . ': ' . $_) . "\n";
+        }
+      }
+    }
+
+    print $separator, 'Other merges:', "\n", @out if @out;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_report_merges ($branch, $relation);
+#
+# DESCRIPTION
+#   This method returns a string for displaying merge information with a
+#   branch, the $relation of which can be a Parent, a Sibling or a Child.
+# ------------------------------------------------------------------------------
+
+sub _report_merges {
+  my ($self, $branch, $relation) = @_;
+
+  my $indent    = ($relation eq 'Parent') ? '' : '  ';
+  my $separator = ($relation eq 'Parent') ? ('-' x 80) : ('  ' . '-' x 78);
+  $separator   .= "\n";
+
+  my $return = '';
+
+  # Report last merges into/from the $branch
+  # ----------------------------------------------------------------------------
+  my %merge  = (
+    'Last Merge From ' . $relation . ':'
+    => [$self->last_merge_from ($branch, 1)],
+    'Last Merge Into ' . $relation . ':'
+    => [$branch->last_merge_from ($self, 1)],
+  );
+
+  if ($self->config->verbose) {
+    # Verbose mode, print the log of the merge
+    for my $key (keys %merge) {
+      next if not @{ $merge{$key} };
+
+      # From: target (0) is self, upper delta (1) is $branch
+      # Into: target (0) is $branch, upper delta (1) is self
+      my $t = ($key =~ /From/) ? $self : $branch;
+
+      $return .= $indent . $key . "\n";
+      $return .= $separator . $t->display_svnlog ($merge{$key}[0]->pegrev);
+    }
+
+  } else {
+    # Normal mode, print in simplified form (rREV Parent@REV)
+    for my $key (keys %merge) {
+      next if not @{ $merge{$key} };
+
+      # From: target (0) is self, upper delta (1) is $branch
+      # Into: target (0) is $branch, upper delta (1) is self
+      $return .= $indent . $key . ' r' . $merge{$key}[0]->pegrev . ' ' .
+                 $merge{$key}[1]->path_peg . ' cf. ' .
+                 $merge{$key}[2]->path_peg . "\n";
+    }
+  }
+
+  if ($relation eq 'Sibling') {
+    # For sibling, do not report further if there is no recent merge
+    my @values = values %merge;
+
+    return $return unless (@{ $values[0] } or @{ $values[1] });
+  }
+
+  # Report available merges into/from the $branch
+  # ----------------------------------------------------------------------------
+  my %avail = (
+    'Merges Avail From ' . $relation . ':'
+    => ($self->delete_rev ? [] : [$self->avail_merge_from ($branch, 1)]),
+    'Merges Avail Into ' . $relation . ':'
+    => [$branch->avail_merge_from ($self, 1)],
+  );
+
+  if ($self->config->verbose) {
+    # Verbose mode, print the log of each revision
+    for my $key (keys %avail) {
+      next unless @{ $avail{$key} };
+
+      $return .= $indent . $key . "\n";
+
+      my $s = ($key =~ /From/) ? $branch: $self;
+
+      for my $rev (@{ $avail{$key} }) {
+        $return .= $separator . $s->display_svnlog ($rev);
+      }
+    }
+
+  } else {
+    # Normal mode, print only the revisions
+    for my $key (keys %avail) {
+      next unless @{ $avail{$key} };
+
+      $return .= $indent . $key . ' ' . join (' ', @{ $avail{$key} }) . "\n";
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmCommitMessage.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmCommitMessage.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmCommitMessage.pm	(revision 5166)
@@ -0,0 +1,395 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmCommitMessage
+#
+# DESCRIPTION
+#   This class contains methods to read, write and edit the commit message file
+#   in a working copy.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmCommitMessage;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Spec;
+use File::Temp qw/tempfile/;
+
+# FCM component modules
+use Fcm::Util qw/e_report run_command/;
+
+# Commit log delimiter messages
+my $ignore_line = '--This line, and those below, will be ignored--';
+my $auto_line   = '--This line will be ignored and those below will be ' .
+                  'inserted automatically--';
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ci_mesg = Fcm::CmCommitMessage->new (
+#     CONFIG  => $config,
+#     DIR     => $dir,
+#     BASE    => $base,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmCommitMessageFile class.
+#
+# ARGUMENTS
+#   CONFIG - reference to a Fcm::Config instance
+#   DIR    - directory containing the commit message file
+#   BASE   - base name of the commit message file
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG => (exists $args{CONFIG} ? $args{CONFIG} : &main::cfg),
+    DIR    => (exists $args{DIR}    ? $args{DIR}    : cwd),
+    BASE   => (exists $args{BASE}   ? $args{BASE}   : '#commit_message#'),
+    USER_M => [],
+    AUTO_M => [],
+    IGNORE => [],
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $ci_mesg->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $ci_mesg->dir;
+#   $ci_mesg->dir ($dir);
+#
+# DESCRIPTION
+#   This method returns the directory container of the commit message file. If
+#   an argument is specified, the directory is reset using the value of the
+#   argument. (It does nothing is the directory does not already exist.)
+# ------------------------------------------------------------------------------
+
+sub dir {
+  my $self = shift;
+
+  if (@_) {
+    my $dir = shift;
+    $self->{DIR} = $dir if -d $dir;
+  }
+
+  return $self->{DIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $ci_mesg->base;
+#   $ci_mesg->base ($base);
+#
+# DESCRIPTION
+#   This method returns the base name of the commit message file. If an
+#   argument is specified, the file is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub base {
+  my $self = shift;
+
+  if (@_) {
+    $self->{BASE} = shift;
+  }
+
+  return $self->{BASE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $ci_mesg->file;
+#   $ci_mesg->file ($file);
+#
+# DESCRIPTION
+#   This method returns the full name of the commit message file. If an
+#   argument is specified, the file is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub file {
+  my $self = shift;
+
+  if (@_) {
+    my $file      = shift;
+    $self->{DIR}  = dirname  ($file);
+    $self->{BASE} = basename ($file);
+  }
+
+  return File::Spec->catfile ($self->{DIR}, $self->{BASE});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @mesg = $ci_mesg->user_mesg;
+#   $ci_mesg->user_mesg (@mesg);
+#
+# DESCRIPTION
+#   This method returns the user defined commit message. If an argument is
+#   specified, the message is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub user_mesg {
+  my $self = shift;
+
+  if (@_) {
+    @{ $self->{USER_M} } = @_;
+  }
+
+  return @{ $self->{USER_M} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @mesg = $ci_mesg->auto_mesg;
+#   $ci_mesg->auto_mesg (@mesg);
+#
+# DESCRIPTION
+#   This method returns the automatically inserted commit message. If an
+#   argument is specified, the message is reset using the value of the
+#   argument.
+# ------------------------------------------------------------------------------
+
+sub auto_mesg {
+  my $self = shift;
+
+  if (@_) {
+    @{ $self->{AUTO_M} } = @_;
+  }
+
+  return @{ $self->{AUTO_M} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @mesg = $ci_mesg->ignore_mesg;
+#   $ci_mesg->ignore_mesg (@mesg);
+#
+# DESCRIPTION
+#   This method returns the ignored part of a commit message. If an argument is
+#   specified, the message is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub ignore_mesg {
+  my $self = shift;
+
+  if (@_) {
+    @{ $self->{IGNORE} } = @_;
+  }
+
+  return @{ $self->{IGNORE} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($user, $auto) = $ci_mesg->read_file ();
+#
+# DESCRIPTION
+#   This function reads from the commit log message file. It resets the user
+#   and the automatic messages after reading the file. It returns the message
+#   back in two array references.
+# ------------------------------------------------------------------------------
+
+sub read_file {
+  my $self = shift;
+
+  my @user = ();
+  my @auto = ();
+  my $file = $self->file;
+
+  if (-r $file) {
+    open FILE, '<', $file or croak 'Cannot open ', $file, '(', $!, '), abort';
+
+    my $in_auto = 0;
+    while (<FILE>) {
+      last if index ($_, $ignore_line) == 0; # ignore after the ignore delimiter
+
+      if (index ($_, $auto_line) == 0) {
+        # Beginning of the automatically inserted message delimiter
+        $in_auto = 1;
+        next;
+      }
+
+      if ($in_auto) {
+        push @auto, $_;
+
+      } else {
+        push @user, $_;
+      }
+    }
+
+    close FILE;
+
+    $self->user_mesg (@user);
+    $self->auto_mesg (@auto);
+  }
+
+  return (\@user, \@auto);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ci_mesg->write_file ();
+#
+# DESCRIPTION
+#   This function writes to the commit log message file based on the content of
+#   the user defined message, and the automatically inserted message.
+# ------------------------------------------------------------------------------
+
+sub write_file {
+  my $self = shift;
+  my %args = @_;
+
+  my @user = $self->user_mesg;
+  my @auto = $self->auto_mesg;
+  my $file = $self->file;
+
+  open FILE, '>', $file or die 'Cannot open ', $file, '(', $!, '), abort';
+  print FILE @user;
+  print FILE $auto_line, "\n", @auto if @auto;
+  close FILE or croak 'Cannot close ', $file, '(', $!, '), abort';
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $ci_mesg->edit_file ([TEMP => 1,] [BATCH => 1,]);
+#
+# DESCRIPTION
+#   This function normally triggers an editor for editing the commit message.
+#   If TEMP is set, it edits a temporary file. Otherwise, it edits the current
+#   commit message file. It resets the user defined message on success. Returns
+#   the name of the commit log file. Do not start the editor if BATCH is set.
+# ------------------------------------------------------------------------------
+
+sub edit_file {
+  my $self  = shift;
+  my %args  = @_;
+  my $temp  = exists $args{TEMP}  ? $args{TEMP}  : 0;
+  my $batch = exists $args{BATCH} ? $args{BATCH} : 0;
+
+  my @user   = $self->user_mesg;
+  my @auto   = $self->auto_mesg;
+  my @ignore = $self->ignore_mesg;
+  my $file   = $self->file;
+
+  if ($temp) {
+    my $fh;
+    ($fh, $file) = tempfile (SUFFIX => ".fcm", UNLINK => 1);
+    close $fh;
+  }
+
+  # Add original or code driven message and status information to the file
+  my $select = select;
+  open FILE, '>', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  select FILE;
+
+  print @user;
+  print (@auto || @user ? '' : "\n");
+  print $auto_line, "\n", @auto, "\n" if @auto;
+  print $ignore_line, "\n\n";
+  print @ignore if @ignore;
+
+  close FILE or die 'Cannot close ', $file, ' (', $!, '), abort';
+  select $select;
+
+  if (not $batch) {
+    # Select editor
+    my $editor = 'nedit';
+    
+    if ($ENV{'SVN_EDITOR'}) {
+      $editor = $ENV{'SVN_EDITOR'};
+
+    } elsif ($ENV{'VISUAL'}) {
+      $editor = $ENV{'VISUAL'};
+
+    } elsif ($ENV{'EDITOR'}) {
+      $editor = $ENV{'EDITOR'};
+    }
+
+    # Execute command to start the editor
+    print 'Starting ', $editor, ' to edit commit message ...', "\n";
+    &run_command ([split (/\s+/, $editor), $file]);
+  }
+
+  # Read the edited file, and extract user log message from it
+  open FILE, '<', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  my (@log);
+  my $in_auto    = 0;
+  my $in_ignored = 0;
+
+  while (<FILE>) {
+    if (index ($_, $auto_line) == 0) {
+      $in_auto = 1;
+
+    } elsif (index ($_, $ignore_line) == 0) {
+      $in_ignored = 1;
+      last;
+
+    } else {
+      next if $in_auto;
+      push @log, $_;
+    }
+  }
+
+  close FILE;
+
+  # Ensure auto and ignored lines are not altered
+  e_report 'Error: the line "', $auto_line, '" has been altered, abort.'
+    if @auto and not $in_auto;
+
+  e_report 'Error: the line "', $ignore_line, '" has been altered, abort.'
+    if not $in_ignored;
+
+  # Check for empty commit log
+  e_report 'Error: log message unchanged or not specified, abort.'
+    if join (' ', (@log, @auto)) =~ /^\s*$/;
+
+  # Echo the commit message to standard output
+  my $separator = '-' x 80 . "\n";
+  print 'Commit message is as follows:', "\n";
+  print $separator, @log, @auto, $ignore_line, "\n", @ignore, $separator;
+
+  open FILE, '>', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  print FILE @log, @auto;
+  close FILE or croak 'Cannot close ', $file, ' (', $!, '), abort';
+
+  # Reset the array for the user specified log message
+  $self->user_mesg (@log);
+
+  return $file;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmUrl.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmUrl.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/CmUrl.pm	(revision 5166)
@@ -0,0 +1,1138 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmUrl
+#
+# DESCRIPTION
+#   This class contains methods for manipulating a Subversion URL in a standard
+#   FCM project.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmUrl;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+use HTTP::Date;
+use XML::DOM;
+
+# FCM component modules
+use Fcm::Util qw/run_command svn_date get_browser_url/;
+
+# Revision pattern
+my $rev_pattern = '\d+|HEAD|BASE|COMMITTED|PREV|\{.+\}';
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_url = Fcm::CmUrl->new (
+#     CONFIG  => $config,
+#     URL     => $url,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmUrl class.
+#
+# ARGUMENTS
+#   CONFIG - reference to a Fcm::Config instance
+#   URL    - URL of a branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG      => (exists $args{CONFIG} ? $args{CONFIG} : &main::cfg),
+    URL         => (exists $args{URL}    ? $args{URL}    : ''),
+    ANALYSED    => undef,
+    PROJECT     => undef,
+    BRANCH      => undef,
+    SUBDIR      => undef,
+    PEGREV      => undef,
+    LIST        => undef,
+    RLIST       => undef,
+    LOG         => undef,
+    LOG_RANGE   => undef,
+    INFO        => undef,
+    BRANCH_LIST => undef, # list of branches in current project
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $cm_url->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->url_peg;
+#   $cm_url->url_peg ($url);
+#
+# DESCRIPTION
+#   This method returns/sets the current URL@PEG.
+# ------------------------------------------------------------------------------
+
+sub url_peg {
+  my $self = shift;
+
+  if (@_) {
+    if (! $self->{URL} or $_[0] ne $self->{URL}) {
+      # Re-set URL
+      $self->{URL} = shift;
+
+      # Re-set essential variables
+      $self->{$_}  = undef for (qw/ANALYSED RLIST LIST INFO LOG LOG_RANGE/);
+    }
+  }
+
+  return $self->{URL};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_url ();
+#
+# DESCRIPTION
+#   Returns true if current url is a valid Subversion URL.
+# ------------------------------------------------------------------------------
+
+sub is_url {
+  my $self = shift;
+
+  # This should handle URL beginning with svn://, http:// and svn+ssh://
+  return ($self->url_peg =~ m#^[\+\w]+://#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->url_exists ([$rev]);
+#
+# DESCRIPTION
+#   Returns true if current url exists (at operative revision $rev) in a
+#   Subversion repository.
+# ------------------------------------------------------------------------------
+
+sub url_exists {
+  my ($self, $rev) = @_;
+
+  my $exists = $self->svnlist (REV => $rev);
+
+  return defined ($exists);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $cm_url->svninfo ([FLAG => $flag], [REV => $rev]);
+#
+# DESCRIPTION
+#   Returns the value of $flag, where $flag is a field returned by "svn info".
+#   (If $flag is not set, default to "URL".) Otherwise returns an empty string.
+#   If REV is specified, it will be used as the operative revision.
+# ------------------------------------------------------------------------------
+
+sub svninfo {
+  my $self = shift;
+  my %args = @_;
+
+  my $flag = exists $args{FLAG} ? $args{FLAG} : 'URL';
+  my $rev  = exists $args{REV}  ? $args{REV}  : undef;
+
+  $rev = ($self->pegrev ? $self->pegrev : 'HEAD') if not $rev;
+
+  return if not $self->is_url;
+
+  # Get "info" for the specified revision if necessary
+  if (not exists $self->{INFO}{$rev}) {
+    # Invoke "svn info" command
+    my @info = &run_command (
+      [qw/svn info -r/, $rev, $self->url_peg],
+      PRINT   => $self->config->verbose > 2,
+      METHOD  => 'qx',
+      DEVNULL => 1,
+      ERROR   => 'ignore',
+    );
+
+    # Store selected information
+    for (@info) {
+      chomp;
+
+      if (/^(.+?):\s*(.+)$/) {
+        $self->{INFO}{$rev}{$1} = $2;
+      }
+    }
+  }
+
+  my $return = exists $self->{INFO}{$rev}{$flag}
+               ? $self->{INFO}{$rev}{$flag} : undef;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %logs = $cm_url->svnlog (
+#     [REV          => $rev,]
+#     [REV          => \@revs,] # reference to a 2-element array
+#     [STOP_ON_COPY => 1,]
+#   );
+#
+# DESCRIPTION
+#   Returns the logs for the current URL. If REV is a range of revisions or not
+#   specified, return a hash where the keys are revision numbers and the values
+#   are the entries (which are hash references). If a single REV is specified,
+#   return the entry (a hash reference) at the specified REV. Each entry in the
+#   returned list is a hash reference, with the following structure:
+#
+#   $entry = {
+#     author => $author,              # the commit author
+#     date   => $date,                # the commit date (in seconds since epoch)
+#     msg    => $msg,                 # the log message
+#     paths  => {                     # list of changed paths
+#       $path1  => {                  # a changed path
+#         copyfrom-path => $frompath, # copy-from-path
+#         copyfrom-rev  => $fromrev,  # copy-from-revision
+#         action        => $action,   # action status code
+#       },
+#       ...     => { ... },           # ... more changed paths ...
+#     },
+#   }
+# ------------------------------------------------------------------------------
+
+sub svnlog {
+  my $self = shift;
+  my %args = @_;
+
+  my $stop_on_copy  = exists $args{STOP_ON_COPY} ? $args{STOP_ON_COPY} : 0;
+  my $rev_arg       = exists $args{REV}          ? $args{REV}          : 0;
+
+  my @revs;
+
+  # Get revision options
+  # ----------------------------------------------------------------------------
+  if ($rev_arg) {
+    if (ref ($rev_arg)) {
+      # Revsion option is an array, a range of revisions specified?
+      ($revs [0], $revs [1]) = @$rev_arg;
+
+    } else {
+      # A single revision specified
+      $revs [0] = $rev_arg;
+    }
+
+    # Expand 'HEAD' revision
+    for my $rev (@revs) {
+      next unless uc ($rev) eq 'HEAD';
+      $rev = $self->svninfo (FLAG => 'Revision', REV => 'HEAD');
+    }
+
+  } else {
+    # No revision option specified, get log for all revisions
+    $revs [0] = $self->svninfo (FLAG => 'Revision');
+    $revs [1] = 1;
+  }
+
+  $revs [1] = $revs [0] if not $revs [1];
+  @revs     = sort {$b <=> $a} @revs;
+
+  # Check whether a "svn log" run is necessary
+  # ----------------------------------------------------------------------------
+  my $need_update = ! ($revs [0] == $revs [1] and exists $self->{LOG}{$revs [0]});
+  my @ranges      = @revs;
+  if ($need_update and $self->{LOG_RANGE}) {
+    my %log_range = %{ $self->{LOG_RANGE} };
+
+    if ($stop_on_copy) {
+      $ranges [1] = $log_range{UPPER} if $ranges [1] >= $log_range{LOWER_SOC};
+
+    } else {
+      $ranges [1] = $log_range{UPPER} if $ranges [1] >= $log_range{LOWER};
+    }
+  }
+
+  $need_update = 0 if $ranges [0] < $ranges [1];
+
+  if ($need_update) {
+    # Invoke "svn log" command for all revisions of the current branch
+    # --------------------------------------------------------------------------
+    my @command = (
+      qw/svn log --xml -v/, ($stop_on_copy ? '--stop-on-copy' : ()),
+      '-r' . join (':', @ranges),
+      $self->url,
+    );
+
+    my $rc;
+    my @xml = &run_command (
+      \@command,
+      PRINT   => $self->config->verbose > 2,
+      METHOD  => 'qx',
+      DEVNULL => 1,
+      ERROR   => 'ignore',
+      RC      => \$rc,
+    );
+
+    # Parse the XML
+    # --------------------------------------------------------------------------
+    if (not $rc) {
+      my $parser = XML::DOM::Parser->new;
+      my $doc    = $parser->parse (join ('', @xml));
+
+      my $entry_list = $doc->getElementsByTagName ('logentry');
+
+      # Record the author, date, message and path change for each revision
+      for my $i (0 .. $entry_list->getLength - 1) {
+        # Select current entry from node list
+        my $entry = $entry_list->item ($i);
+        my %this = ();
+
+        # Revision is an attribute of the entry node
+        my $rev   = $entry->getAttributeNode ('revision')->getValue;
+
+        # Author, date and log message are children elements of the entry node
+        for my $key (qw/author date msg/) {
+          # Get data of each node, also convert date to seconds since epoch
+          my $node    = $entry->getElementsByTagName ($key)->item (0);
+          my $data    = ($node and $node->getFirstChild)
+                        ? $node->getFirstChild->getData : '';
+          $this{$key} = ($key eq 'date' ? str2time ($data) : $data);
+        }
+
+        # Path nodes are grand children elements of the entry node
+        my $paths = $entry->getElementsByTagName ('path');
+
+        for my $p (0 .. $paths->getLength - 1) {
+          # Select current path node from node list
+          my $node = $paths->item ($p);
+
+          # Get data from the path node
+          my $path = $node->getFirstChild->getData;
+          $this{paths}{$path} = {};
+
+          # Action, copyfrom-path and copyfrom-rev are attributes of path nodes
+          for my $key (qw/action copyfrom-path copyfrom-rev/) {
+            next unless $node->getAttributeNode ($key); # ensure attribute exists
+
+            $this{paths}{$path}{$key} = $node->getAttributeNode ($key)->getValue;
+          }
+        }
+
+        $self->{LOG}{$rev} = \%this;
+      }
+    }
+
+    # Update the range cache
+    # --------------------------------------------------------------------------
+    # Upper end of the range
+    $self->{LOG_RANGE}{UPPER} = $ranges [0]
+      if ! $self->{LOG_RANGE}{UPPER} or $ranges [0] > $self->{LOG_RANGE}{UPPER};
+
+    # Lower end of the range, need to take into account the stop-on-copy option
+    if ($stop_on_copy) {
+      # Lower end of the range with stop-on-copy option
+      $self->{LOG_RANGE}{LOWER_SOC} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER_SOC} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER_SOC};
+
+      my $low = (sort {$a <=> $b} keys %{ $self->{LOG} }) [0];
+      $self->{LOG_RANGE}{LOWER} = $low
+        if ! $self->{LOG_RANGE}{LOWER} or $low < $self->{LOG_RANGE}{LOWER};
+
+    } else {
+      # Lower end of the range without the stop-on-copy option
+      $self->{LOG_RANGE}{LOWER} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER};
+
+      $self->{LOG_RANGE}{LOWER_SOC} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER_SOC} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER_SOC};
+    }
+  }
+
+  my %return = ();
+
+  if (! $rev_arg or ref ($rev_arg)) {
+    # REV is an array, return log entries if they are within range
+    for my $rev (sort {$b <=> $a} keys %{ $self->{LOG} }) {
+      next if $rev > $revs [0] or $revs [1] > $rev;
+
+      $return{$rev} = $self->{LOG}{$rev};
+
+      if ($stop_on_copy) {
+        last if exists $self->{LOG}{$rev}{paths}{$self->branch_path} and
+           $self->{LOG}{$rev}{paths}{$self->branch_path}{action} eq 'A';
+      }
+    }
+
+  } else {
+    # REV is a scalar, return log of the specified revision if it exists
+    %return = %{ $self->{LOG}{$revs [0]} } if exists $self->{LOG}{$revs [0]};
+  }
+
+  return %return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $cm_branch->display_svnlog ($rev, [$wiki]);
+#
+# DESCRIPTION
+#   This method returns a string for displaying the log of the current branch
+#   at a $rev. If $wiki is set, returns a string for displaying in a Trac wiki
+#   table.  The value of $wiki should be the Subversion URL of a FCM project
+#   associated with the intended Trac system.
+# ------------------------------------------------------------------------------
+
+sub display_svnlog {
+  my ($self, $rev, $wiki) = @_;
+  my $return = '';
+
+  my %log = $self->svnlog (REV => $rev);
+
+  if ($wiki) {
+    # Output in Trac wiki format
+    # --------------------------------------------------------------------------
+    $return .= '|| ' . &svn_date ($log{date}) . ' || ' . $log{author} . ' || ';
+
+    my $trac_url = &get_browser_url (URL => $self->url);
+
+    # Get list of tickets from log
+    my @tickets;
+    while ($log{msg} =~ /(?:#|ticket:)(\d+)/g) {
+      push @tickets, $1;
+    }
+    @tickets = sort {$a <=> $b} @tickets;
+
+    if ($trac_url =~ m#^$wiki(?:/*|$)#) {
+      # URL is in the specified $wiki, use Trac link
+      $return .= '[' . $rev . '] ||';
+
+      for my $ticket (@tickets) {
+        $return .= ' #' . $ticket;
+      }
+
+      $return .= ' ||';
+
+    } else {
+      # URL is not in the specified $wiki, use full URL
+      my $rev_url = $trac_url;
+      $rev_url    =~ s#/browser/.*$##;
+      $rev_url   .= '/changeset/' . $rev;
+      $return    .= '[' . $rev_url . ' ' . $rev . '] ||';
+
+      my $ticket_url = $trac_url;
+      $ticket_url    =~ s#/browser/.*$#/ticket/#;
+
+      for my $ticket (@tickets) {
+        $return .= ' [' . $ticket_url . $ticket . ' ' . $ticket . ']';
+      }
+
+      $return .= ' ||';
+    }
+
+  } else {
+    # Output in plain text format
+    # --------------------------------------------------------------------------
+    my @msg  = split /\n/, $log{msg};
+    my $line = (@msg > 1 ? ' lines' : ' line');
+
+    $return .= join (
+      ' | ',
+      ('r' . $rev, $log{author}, &svn_date ($log{date}), scalar (@msg) . $line),
+    );
+    $return .= "\n\n";
+    $return .= $log{msg};
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @list = $cm_url->svnlist ([REV => $rev], [RECURSIVE => 1]);
+#
+# DESCRIPTION
+#   The method returns a list of paths as returned by "svn list". If RECURSIVE
+#   is set, "svn list" is invoked with the "-R" option.
+# ------------------------------------------------------------------------------
+
+sub svnlist {
+  my $self = shift;
+  my %args = @_;
+
+  my $recursive = exists $args{RECURSIVE} ? $args{RECURSIVE} : 0;
+  my $rev       = exists $args{REV}       ? $args{REV}       : undef;
+  my $key       = $recursive ? 'RLIST' : 'LIST';
+
+  # Find out last changed revision of the current URL
+  $rev = $self->svninfo (FLAG => 'Last Changed Rev', REV => $rev);
+  return () if not $rev;
+
+  # Get directory listing for the current URL at the last changed revision
+  if (not exists $self->{$key}{$rev}) {
+    my $rc;
+
+    my @list = map {chomp; $_} &run_command (
+      [qw/svn list -r/, $rev, ($recursive ? '-R' : ()), $self->url_peg],
+      METHOD => 'qx', ERROR => 'ignore', DEVNULL => 1, RC => \$rc,
+    );
+
+    $self->{$key}{$rev} = $rc ? undef : \@list;
+  }
+
+  return (defined ($self->{$key}{$rev}) ? @{ $self->{$key}{$rev} } : undef);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @list = $cm_url->branch_list ($rev);
+#
+# DESCRIPTION
+#   The method returns a list of branches in the current project, assuming the
+#   FCM naming convention. If $rev if specified, it returns the list of
+#   branches at $rev.
+# ------------------------------------------------------------------------------
+
+sub branch_list {
+  my ($self, $rev) = @_;
+
+  # Current URL must be a valid FCM project
+  return if not $self->project;
+
+  # Find out last changed revision of the current URL
+  $rev = $self->svninfo (FLAG => 'Revision', REV => $rev);
+  return () if not $rev;
+
+  if (not exists $self->{BRANCH_LIST}{$rev}) {
+    $self->{BRANCH_LIST}{$rev} = [];
+
+    # Get URL of the project "branches/" sub-directory
+    my $url = Fcm::CmUrl->new (URL => $self->project_url . '/branches');
+
+    # List three levels underneath "branches/"
+    # First level, i.e. dev, test, pkg, etc
+    my @list1 = map {$url->url . '/' . $_} $url->svnlist (REV => $rev);
+    @list1    = grep m#/$#, @list1;
+
+    # Second level, i.e. user name, Shared, Rel or Config
+    my @list2;
+    for (@list1) {
+      my $u    = Fcm::CmUrl->new (URL => $_);
+      my @list = $u->svnlist (REV => $rev);
+
+      push @list2, map {$u->url . $_} @list;
+    }
+
+    # Third level, branch name
+    for (@list2) {
+      my $u    = Fcm::CmUrl->new (URL => $_);
+      my @list = map {s#/*$##; $_} $u->svnlist (REV => $rev);
+
+      push @{ $self->{BRANCH_LIST}{$rev} }, map {$u->url . $_} @list;
+    }
+  }
+
+  return @{ $self->{BRANCH_LIST}{$rev} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_analyse_url ();
+#
+# DESCRIPTION
+#   The method analyses the current URL, breaking it up into the project
+#   (substring of URL up to the slash before "trunk", "branches" or "tags"),
+#   branch name ("trunk", "branches/<type>/<id>/<name>" or "tags/<name>") and
+#   the sub-directory below the top of the project sub-tree. It re-sets the
+#   corresponding interal variables.
+# ------------------------------------------------------------------------------
+
+sub _analyse_url {
+  my $self = shift;
+  my ($url, $project, $branch, $subdir, $pegrev);
+
+  # Check that URL is set
+  $url    = $self->url_peg;
+  return if not $url;
+  return if not $self->is_url;
+
+  # Extract from URL the peg revision
+  $pegrev = $1 if $url =~ s/@($rev_pattern)$//i;
+
+  if ($url =~ m#^(.*?)/+(trunk|branches|tags)(?:/+(.*))?/*$#) {
+    # URL is under the "trunk", a branch or a tag
+    $project                 = $1;
+    my ($branch_id, $remain) = ($2, $3);
+
+    $remain = '' if not defined $remain;
+
+    if ($branch_id eq 'trunk') {
+      # URL under the "trunk"
+      $branch = 'trunk';
+
+    } else {
+      # URL under a branch or a tag
+      $branch = $branch_id;
+
+      # Assume "3 sub-directories", FCM branch naming convention
+      for (1 .. 3) {
+        if ($remain =~ s#^([^/]+)(?:/+|$)##) {
+          $branch .=  '/' . $1;
+
+        } else {
+          $branch = undef;
+          last;
+        }
+      }
+    }
+
+    $subdir = $remain ? $remain : '' if $branch;
+
+  } else {
+    # URL is at some level above the "trunk", a branch or a tag
+    # Use "svn ls" to determine whether it is a project URL
+    my @list = $self->svnlist (REV => ($pegrev ? $pegrev : 'HEAD'));
+    my %lines = map {chomp $_; ($_, 1)} @list;
+
+    # A project URL should have the "trunk", "branches" and "tags" directories
+    ($project = $url) =~ s#/*$##
+      if $lines{'trunk/'} and $lines{'branches/'} and $lines{'tags/'};
+  }
+
+  $self->{PROJECT}  = $project;
+  $self->{BRANCH}   = $branch;
+  $self->{SUBDIR}   = $subdir;
+  $self->{PEGREV}   = $pegrev;
+  $self->{ANALYSED} = 1;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->root ();
+#
+# DESCRIPTION
+#   The method returns the repository root of the current URL.
+# ------------------------------------------------------------------------------
+
+sub root {
+  my $self = shift;
+
+  return $self->svninfo (FLAG => 'Repository Root');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->project_url_peg ();
+#   $cm_url->project_url_peg ($url);
+#
+# DESCRIPTION
+#   The method returns the URL@PEG of the "project" part of the current URL. If
+#   an argument is specified, the URL of the "project" part and the peg
+#   revision of the current URL are re-set.
+# ------------------------------------------------------------------------------
+
+sub project_url_peg {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project_url_peg or $url ne $self->project_url_peg) {
+      my $pegrev = ($url =~ s/@($rev_pattern)$//i) ? $1 : '';
+
+      $url .= '/' . $self->branch if $self->branch;
+      $url .= '/' . $self->subdir if $self->subdir;
+      $url .= '@' . $pegrev       if $pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PROJECT} . ($self->pegrev ? '@' . $self->pegrev : '');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->project_url ();
+#   $cm_url->project_url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL of the "project" part of the current URL. If an
+#   argument is specified, the URL of the "project" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub project_url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->project_url or $url ne $self->project_url) {
+      $url .= '/' . $self->branch if $self->branch;
+      $url .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PROJECT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->project_path ();
+#   $cm_url->project_path ($path);
+#
+# DESCRIPTION
+#   The method returns the path of the "project" part of the current URL. If an
+#   argument is specified, the path of the "project" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub project_path {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project_path or $path ne $self->project_path) {
+      $path .= '/' . $self->branch if $self->branch;
+      $path .= '/' . $self->subdir if $self->subdir;
+
+      $self->path ($path);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->{PROJECT}, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $cm_url->project ();
+#   $cm_url->project ($name);
+#
+# DESCRIPTION
+#   The method returns the basename of the "project" part of the current URL.
+#   If an argument is specified, the basename of the "project" part of the
+#   current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub project {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project or $name ne $self->project) {
+      my $url = '';
+      if ($self->project) {
+        $url =  $self->project;
+        $url =~ s#/[^/]+$##;
+
+      } else {
+        $url =  $self->root;
+      }
+
+      $url .=  '/' . $name;
+      $url .=  '/' . $self->branch if $self->branch;
+      $url .=  '/' . $self->subdir if $self->subdir;
+      $url .=  '@' . $self->pegrev if $self->pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  my $name = $self->{PROJECT};
+  $name =~ s#^.*/([^/]+)$#$1# if $name;
+
+  return $name;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->branch_url_peg ();
+#   $cm_url->branch_url_peg ($url);
+#
+# DESCRIPTION
+#   The method returns the URL@PEG of the "branch" part of the current URL. If
+#   an argument is specified, the URL@PEG of the "branch" part of the current
+#   URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_url_peg {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_url_peg or $url ne $self->branch_url_peg) {
+      my $pegrev = ($url =~ s/@($rev_pattern)$//i) ? $1 : '';
+
+      $url .= '/' . $self->subdir if $self->subdir;
+      $url .= '@' . $pegrev       if $pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_url . '/' . $self->branch .
+         ($self->pegrev ? '@' . $self->pegrev : '');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->branch_url ();
+#   $cm_url->branch_url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL of the "branch" part of the current URL. If an
+#   argument is specified, the URL of the "branch" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_url or $url ne $self->branch_url) {
+      $url .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_url . '/' . $self->branch;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->branch_path ();
+#   $cm_url->branch_path ($path);
+#
+# DESCRIPTION
+#   The method returns the path of the "branch" part of the current URL. If an
+#   argument is specified, the path of the "branch" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_path {
+  my $self = shift;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_path or $path ne $self->branch_path) {
+      $path .= '/' . $self->subdir if $self->subdir;
+
+      $self->path ($path);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_path . '/' . $self->branch;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch = $cm_url->branch ();
+#   $cm_url->branch ($branch);
+#
+# DESCRIPTION
+#   The method returns the "branch" part of the current URL. If an argument is
+#   specified, the "branch" part of the current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub branch {
+  my $self = shift;
+
+  if (@_) {
+    my $branch = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch or $branch ne $self->branch) {
+      my $url = $self->project_url;
+      $url   .= '/' . $branch;
+      $url   .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{BRANCH};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_trunk ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) the trunk.
+# ------------------------------------------------------------------------------
+
+sub is_trunk {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch eq 'trunk');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_branch ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) a branch.
+# ------------------------------------------------------------------------------
+
+sub is_branch {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch =~ m#^branches/#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_tag ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) a tag.
+# ------------------------------------------------------------------------------
+
+sub is_tag {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch =~ m#^tags/#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $subdir = $cm_url->subdir ();
+#   $cm_url->subdir ($subdir);
+#
+# DESCRIPTION
+#   The method returns the "subdir" part of the current URL. If an argument is
+#   specified, the "subdir" part of the current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub subdir {
+  my $self = shift;
+
+  if (@_) {
+    my $subdir = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->subdir or $subdir ne $self->subdir) {
+      my $url = $self->project_url;
+      $url   .= '/' . $self->branch if $self->branch;
+      $url   .= '/' . $subdir if $subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{SUBDIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->url ();
+#   $cm_url->url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL without the "peg revision" part. If an argument
+#   is specified, the URL is re-set without modifying the "peg revision" part.
+# ------------------------------------------------------------------------------
+
+sub url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url    =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL if necessary
+    if (! $self->url or $url ne $self->url) {
+      $self->url_peg ($url . ($self->pegrev ? '@' . $self->pegrev : ''));
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  (my $url = $self->url_peg) =~ s/@($rev_pattern)$//i;
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->path ();
+#   $cm_url->path ($path);
+#
+# DESCRIPTION
+#   The method returns the "path" part of the URL (i.e. URL without the
+#   "root" part). If an argument is specified, the "path" part of the URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub path {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+    $path    =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->path or $path ne $self->path) {
+      my $url = ($root . (substr ($path, 0, 1) eq '/' ? '' : '/') . $path);
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->url, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->path_peg ();
+#   $cm_url->path_peg ($path);
+#
+# DESCRIPTION
+#   The method returns the PATH@PEG part of the URL (i.e. URL without the
+#   "root" part). If an argument is specified, the PATH@PEG part of the URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub path_peg {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->path_peg or $path ne $self->path_peg) {
+      my $url = ($root . (substr ($path, 0, 1) eq '/' ? '' : '/') . $path);
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->url_peg, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_url->pegrev ();
+#   $cm_url->pegrev ($rev);
+#
+# DESCRIPTION
+#   The method returns the "peg revision" part of the current URL. If an
+#   argument is specified, the "peg revision" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub pegrev {
+  my $self = shift;
+
+  if (@_) {
+    my $pegrev = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->pegrev or $pegrev ne $self->pegrev) {
+      $self->url_peg ($self->url . ($pegrev ? '@' . $pegrev : ''));
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PEGREV};
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Config.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Config.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Config.pm	(revision 5166)
@@ -0,0 +1,735 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Config
+#
+# DESCRIPTION
+#   This is a class for reading and processing central and user configuration
+#   settings for FCM.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Config;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use File::Basename;
+use File::Spec::Functions;
+use FindBin;
+use POSIX qw/setlocale LC_ALL/;
+
+# FCM component modules
+use Fcm::CfgFile;
+
+# Other declarations:
+sub _get_hash_value;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = Fcm::Config->new (VERBOSE => $verbose);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Config class.
+#
+# ARGUMENTS
+#   VERBOSE - Set the verbose level of diagnostic output
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  # Ensure that all subsequent Subversion output is in UK English
+  if (setlocale (LC_ALL, 'en_GB')) {
+    $ENV{LANG} = 'en_GB';
+  }
+
+  # Location of the central/user configuration file
+  my $cntl_config = catfile (dirname ($FindBin::Bin), 'etc', 'fcm.cfg');
+  $cntl_config    = catfile $FindBin::Bin, 'fcm.cfg' unless -r $cntl_config;
+  my $user_config = exists $ENV{HOME} ? catfile $ENV{HOME}, '.fcm' : '';
+
+  # Verbose mode
+  my $verbose     = exists $ENV{FCM_VERBOSE} ? $ENV{FCM_VERBOSE} : 1;
+
+  my $self = {
+    CNTL_CONFIG => -r $cntl_config ? $cntl_config : '',
+    USER_CONFIG => -r $user_config ? $user_config : '',
+    VERBOSE     => exists $args{VERBOSE} ? $args{VERBOSE} : $verbose,
+    VARIABLE    => {},
+
+    # Primary settings
+    SETTING => {
+      # Release identifier/version
+      RELEASE  => '1.2',
+
+      # Location of file with the last changed revision of the FCM trunk
+      REV_FILE => catfile (dirname ($FindBin::Bin), 'etc', 'fcm_rev'),
+
+      # Default names of known FCM configuration files
+      CFG_NAME => {
+        BLD        => 'bld.cfg',      # bld cfg
+        EXT        => 'ext.cfg',      # ext cfg
+        SRCPACKAGE => '@PACKAGE.cfg', # source package cfg
+      },
+
+      # Latest version of known FCM configuration files
+      CFG_VERSION => {
+        BLD        => '1.0', # bld cfg
+        EXT        => '1.0', # ext cfg
+        SRCPACKAGE => '1.0', # source package cfg
+      },
+
+      # Labels for all types of FCM configuration files
+      CFG_LABEL => {
+        CFGFILE => {
+          TYPE    => 'CFG::TYPE',       # config file type
+          VERSION => 'CFG::VERSION',    # version of config file syntax
+        },
+
+        # Labels for central/user internal config setting
+        SETTING    => 'SET',
+
+        # Labels for ext and bld cfg
+        USE        => 'USE',            # use (inherit from) another ext/bld
+        SRCDIR     => 'SRC',            # prefix, source directory
+
+        # Labels for bld and pck cfg
+        TARGET     => 'TARGET',         # BLD: targets of current build
+                                        # PCK: target name of source file
+
+        # Labels for bld cfg
+        NAME        => 'NAME',          # build name
+        DIR         => 'DIR',           # prefix, build directory
+        PP          => 'PP',            # prefix, pre-process?
+        LIB         => 'LIB',           # declare name of a library
+        SEARCH_SRC  => 'SEARCH_SRC',    # search src/ sub-directory?
+        EXE_NAME    => 'EXE_NAME',      # rename a main program target
+        TOOL        => 'TOOL',          # prefix, build tool
+        INHERIT     => 'INHERIT',       # prefix, inheritance flag
+        EXCL_DEP    => 'EXCL_DEP',      # exclude these automatic dependencies
+        INFILE_EXT  => 'INFILE_EXT',    # input file name extension and type
+        OUTFILE_EXT => 'OUTFILE_EXT',   # output file type and name extension
+        EXE_DEP     => 'EXE_DEP',       # extra executable dependencies
+        BLOCKDATA   => 'BLOCKDATA',     # BLOCKDATA dependencies
+
+        # Labels for ext cfg
+        DEST       => {                 # local extract destinations
+          ROOTDIR  => 'DEST::ROOTDIR',  # top directory for this extract
+          SRCDIR   => 'DEST::SRCDIR',   # extracted source directory
+          CFGDIR   => 'DEST::CFGDIR',   # generated configuration directory
+          CACHEDIR => 'DEST::CACHEDIR', # cache directory for fast extract
+          BLD_CFG  => 'DEST::BLD_CFG',  # generated bld cfg file
+          EXT_CFG  => 'DEST::EXT_CFG',  # generated ext cfg file
+        },
+        RDEST      => {                 # remote extract destionations
+          MACHINE  => 'RDEST::MACHINE', # name of remote machine
+          LOGNAME  => 'RDEST::LOGNAME', # user logname on remote machine
+          ROOTDIR  => 'RDEST::ROOTDIR', # top directory for this extract
+          SRCDIR   => 'RDEST::SRCDIR',  # extracted source directory
+          CFGDIR   => 'RDEST::CFGDIR',  # generated configuration directory
+          BLD_CFG  => 'RDEST::BLD_CFG', # generated bld cfg file
+          EXT_CFG  => 'RDEST::EXT_CFG', # generated ext cfg file
+        },
+        INC        => 'INC',            # "include" settings in another cfg file
+        BDECLARE   => 'BLD',            # declare entries for build system
+        OVERRIDE   => 'OVERRIDE',       # set conflict override option
+        REPOS      => 'REPOS',          # set repos loc for a project branch
+        VERSION    => 'VERSION',        # set version for a project branch
+        EXPSRCDIR  => 'EXPSRC',         # prefix, expandable source directory
+        MIRROR     => 'MIRROR',         # mirror tool
+
+        # Labels for pck cfg
+        TYPE       => 'TYPE',           # type of source file/build task
+        SCAN       => 'SCAN',           # scan source file for dependency
+        INTNAME    => 'INTNAME',        # internal name of source file
+        DEP        => 'DEP',            # source file/build task dependencies
+      },
+
+      # Keywords in known FCM configuration files
+      CFG_KEYWORD => 'USE,INC,TARGET,EXCL_DEP',
+
+      # Types of "inc" statements expandable CFG files
+      CFG_EXP_INC => 'BLD,EXT,FCM',
+
+      # Standard sub-directories for extract/build
+      DIR => {
+        BIN    => 'bin',    # executable
+        BLD    => 'bld',    # build
+        CACHE  => '.cache', # cache
+        CFG    => 'cfg',    # configuration
+        DONE   => 'done',   # "done"
+        ETC    => 'etc',    # miscellaneous items
+        FLAGS  => 'flags',  # "flags"
+        INC    => 'inc',    # include
+        LIB    => 'lib',    # library
+        OBJ    => 'obj',    # object
+        PPSRC  => 'ppsrc',  # pre-processed source
+        SRC    => 'src',    # source
+        TMP    => 'tmp',    # temporary directory
+      },
+
+      # Build commands and options (i.e. tools)
+      TOOL => {
+        SHELL        => '/usr/bin/ksh',    # Default shell
+
+        CPP          => 'cpp',             # C pre-processor
+        CPPFLAGS     => '-C',              # CPP flags
+        CPP_INCLUDE  => '-I',              # CPP flag, specify "include" path
+        CPP_DEFINE   => '-D',              # CPP flag, define macro
+        CPPKEYS      => '',                # CPP keys (definition macro)
+
+        CC           => 'cc',              # C compiler
+        CFLAGS       => '',                # CC flags
+        CC_COMPILE   => '-c',              # CC flag, compile only
+        CC_OUTPUT    => '-o',              # CC flag, specify output file name
+        CC_INCLUDE   => '-I',              # CC flag, specify "include" path
+        CC_DEFINE    => '-D',              # CC flag, define macro
+
+        FPP          => 'cpp',             # Fortran pre-processor
+        FPPFLAGS     => '-P -traditional', # FPP flags
+        FPP_INCLUDE  => '-I',              # FPP flag, specify "include" path
+        FPP_DEFINE   => '-D',              # FPP flag, define macro
+        FPPKEYS      => '',                # FPP keys (definition macro)
+
+        FC           => 'f90',             # Fortran compiler
+        FFLAGS       => '',                # FC flags
+        FC_COMPILE   => '-c',              # FC flag, compile only
+        FC_OUTPUT    => '-o',              # FC flag, specify output file name
+        FC_INCLUDE   => '-I',              # FC flag, specify "include" path
+        FC_DEFINE    => '-D',              # FC flag, define macro
+
+        LD           => 'ld',              # linker
+        LDFLAGS      => '',                # LD flags
+        LD_OUTPUT    => '-o',              # LD flag, specify output file name
+        LD_LIBSEARCH => '-L',              # LD flag, specify "library" path
+        LD_LIBLINK   => '-l',              # LD flag, specify link library
+
+        AR           => 'ar',              # library archiver
+        ARFLAGS      => 'rs',              # AR flags
+
+        MAKE         => 'make',            # make command
+        MAKEFLAGS    => '',                # make flags
+        MAKE_SILENT  => '-s',              # make flag, silent diagnostic
+        MAKE_JOB     => '-j',              # make flag, number of jobs
+
+        INTERFACE    => 'file',            # name interface after file/program
+        GENINTERFACE => 'ECMWF',           # Fortran 9x interface generator
+
+        MIRROR       => 'rsync',           # extract mirroring tool
+        REMOTE_SHELL => 'remsh',           # command to invoke the remote shell
+        GRAPHIC_DIFF => 'xxdiff',          # graphical diff tool
+      },
+
+      # List of tools that are local to FCM, (will not be exported to a Makefile)
+      LOCALTOOL => 'CPP,CPPFLAGS,CPP_INCLUDE,CPP_DEFINE,FPP,FPPFLAGS,' .
+                   'FPP_INCLUDE,FPP_DEFINE,GRAPHIC_DIFF,MAKE,MAKEFLAGS,' .
+                   'MAKE_SILENT,MAKE_JOB,INTERFACE,GENINTERFACE,MIRROR,' .
+                   'REMOTE_SHELL',
+
+      # Supported tools for compilable source
+      SRC_TOOL => {
+        FORTRAN => {
+          COMPILER => 'FC',
+          FLAGS    => 'FFLAGS',
+          OUTPUT   => 'FC_OUTPUT',
+          INCLUDE  => 'FC_INCLUDE',
+        },
+
+        FPP     => {
+          COMPILER => 'FC',
+          FLAGS    => 'FFLAGS',
+          PPKEYS   => 'FPPKEYS',
+          OUTPUT   => 'FC_OUTPUT',
+          INCLUDE  => 'FC_INCLUDE',
+          DEFINE   => 'FC_DEFINE',
+        },
+
+        C       => {
+          COMPILER => 'CC',
+          FLAGS    => 'CFLAGS',
+          PPKEYS   => 'CPPKEYS',
+          OUTPUT   => 'CC_OUTPUT',
+          INCLUDE  => 'CC_INCLUDE',
+          DEFINE   => 'CC_DEFINE',
+        },
+      },
+
+      # Cache file names/extensions
+      CACHE => {
+        EXTCONFIG   => '.config',       # ext cache, commit version info
+        PCKFILE     => '.pck_file',     # bld cache, source package list
+        PCKPPDEPEND => '.pck_ppdepend', # bld cache, source package PP dependency
+        PCKDEPEND   => '.pck_depend',   # bld cache, source package dependency
+        BLDTOOL     => '.bld_tool',     # bld cache, build tool list
+        PPOPTION    => '.bld_pp',       # bld cache, PP option
+        EXE_DEP     => '.exe_dep',      # bld cache, executable extra dependency
+      },
+
+      # Input file name extension and type
+      # (may overlap with output and vpath, see below)
+      INFILE_EXT => {
+        # General extensions
+        'f'    => 'FORTRAN::SOURCE',
+        'for'  => 'FORTRAN::SOURCE',
+        'ftn'  => 'FORTRAN::SOURCE',
+        'f77'  => 'FORTRAN::SOURCE',
+        'f90'  => 'FORTRAN::FORTRAN9X::SOURCE',
+        'f95'  => 'FORTRAN::FORTRAN9X::SOURCE',
+        'F'    => 'FPP::SOURCE',
+        'FOR'  => 'FPP::SOURCE',
+        'FTN'  => 'FPP::SOURCE',
+        'F77'  => 'FPP::SOURCE',
+        'F90'  => 'FPP::FPP9X::SOURCE',
+        'F95'  => 'FPP::FPP9X::SOURCE',
+        'c'    => 'C::SOURCE',
+        'cpp'  => 'C::C++::SOURCE',
+        'h'    => 'CPP::INCLUDE',
+        'o'    => 'BINARY::OBJ',
+        'obj'  => 'BINARY::OBJ',
+        'exe'  => 'BINARY::EXE',
+        'a'    => 'BINARY::LIB',
+        'sh'   => 'SHELL::SCRIPT',
+        'ksh'  => 'SHELL::SCRIPT',
+        'bash' => 'SHELL::SCRIPT',
+        'csh'  => 'SHELL::SCRIPT',
+        'pl'   => 'PERL::SCRIPT',
+        'pm'   => 'PERL::SCRIPT',
+        'py'   => 'PYTHON::SCRIPT',
+        'tcl'  => 'TCL::SCRIPT',
+        'pro'  => 'PVWAVE::SCRIPT',
+
+        # Local extensions
+        'cfg'       => 'CFGFILE',
+        'h90'       => 'CPP::INCLUDE',
+        'inc'       => 'FORTRAN::FORTRAN9X::INCLUDE',
+        'interface' => 'FORTRAN::FORTRAN9X::INCLUDE::INTERFACE',
+      },
+
+      # Input file name pattern and type
+      INFILE_PAT => {
+        '\w+Scr_\w+'              => 'SHELL::SCRIPT',
+        '\w+Comp_\w+'             => 'SHELL::SCRIPT::GENTASK',
+        '\w+(?:IF|Interface)_\w+' => 'SHELL::SCRIPT::GENIF',
+        '\w+Suite_\w+'            => 'SHELL::SCRIPT::GENSUITE',
+        '\w+List_\w+'             => 'SHELL::SCRIPT::GENLIST',
+        '\w+Sql_\w+'              => 'SCRIPT::SQL',
+      },
+
+      # Input text file pattern and type
+      INFILE_TXT => {
+        '(?:[ck]|ba)?sh'  => 'SHELL::SCRIPT',
+        'perl'            => 'PERL::SCRIPT',
+        'python'          => 'PYTHON::SCRIPT',
+        'tcl(?:sh)?|wish' => 'TCL::SCRIPT',
+      },
+
+      # Ignore input files matching the following names (comma-separated list)
+      INFILE_IGNORE => 'fcm_env.ksh',
+
+      # Output file type and extension
+      # (may overlap with input (above) and vpath (below))
+      OUTFILE_EXT => {
+        CFG       => '.cfg',       # FCM configuration file
+        DONE      => '.done',      # "done" files for compiled source
+        ETC       => '.etc',       # "etc" dummy file
+        EXE       => '.exe',       # binary executables
+        FLAGS     => '.flags',     # "flags" files, compiler flags config
+        IDONE     => '.idone',     # "done" files for included source
+        INTERFACE => '.interface', # interface for F90 subroutines/functions
+        LIB       => '.a',         # archive object library
+        MK        => '.mk',        # dependency files, Makefile fragments
+        MOD       => '.mod',       # compiled Fortran module information files
+        OBJ       => '.o',         # compiled object files
+        PDONE     => '.pdone',     # "done" files for pre-processed files
+        TAR       => '.tar',       # TAR archive
+      },
+
+      # VPATH, each value must be a comma separate list
+      # EMPTY      translates to %
+      # IN:<FLAG>  translates to any key in {INFILE_EXT} if the value contains
+      #            the word in <FLAG>
+      # OUT:<FLAG> translates to {OUTFILE_EXT}{<FLAG>}
+      VPATH   => {
+        BIN   => 'EMPTY,OUT:EXE,IN:SCRIPT',
+        BLD   => 'OUT:MK',
+        DONE  => 'OUT:DONE,OUT:IDONE,OUT:ETC',
+        FLAGS => 'OUT:FLAGS',
+        INC   => 'IN:INCLUDE',
+        LIB   => 'OUT:LIB',
+        OBJ   => 'OUT:OBJ',
+      },
+
+      # Dependency scan types for pre-processing
+      PP_DEP_TYPE => {
+        FPP => 'H',
+        CPP => 'H',
+        C   => 'H',
+      },
+
+      # Dependency scan types
+      DEP_TYPE => {
+        FORTRAN => 'USE::INTERFACE::INC::OBJ',
+        FPP     => 'USE::INTERFACE::INC::H::OBJ',
+        CPP     => 'H::OBJ',
+        C       => 'H::OBJ',
+        SCRIPT  => 'EXE',
+      },
+
+      # Dependency pattern for each type
+      DEP_PATTERN => {
+        H         => q/^#\s*include\s*['"](\S+)['"]/,
+        USE       => q/^\s*use\s+(\w+)/,
+        INTERFACE => q/^#?\s*include\s+['"](\S+##OUTFILE_EXT::INTERFACE##)['"]/,
+        INC       => q/^\s*include\s+['"](\S+)['"]/,
+        OBJ       => q#^\s*(?:/\*|!)\s*depends\s*on\s*:\s*(\S+)#,
+        EXE       => q/^\s*(?:#|;)\s*(?:calls|list|if|interface)\s*:\s*(\S+)/,
+      },
+
+      # Types that always need to be built
+      ALWAYS_BUILD_TYPE => 'PVWAVE,GENLIST,SQL',
+
+      # Types that cannot have duplicated targets
+      NO_DUPLICATED_TARGET_TYPE => '',
+
+      # Excluded dependency
+      EXCL_DEP => {
+        # Fortran intrinsic modules
+        'USE::ISO_C_BINDING'            => {'' => 1},
+        'USE::IEEE_EXCEPTIONS'          => {'' => 1},
+        'USE::IEEE_ARITHMETIC'          => {'' => 1},
+        'USE::IEEE_FEATURES'            => {'' => 1},
+
+        # Fortran intrinsic subroutines
+        'OBJ::CPU_TIME'                 => {'' => 1},
+        'OBJ::GET_COMMAND'              => {'' => 1},
+        'OBJ::GET_COMMAND_ARGUMENT'     => {'' => 1},
+        'OBJ::GET_ENVIRONMENT_VARIABLE' => {'' => 1},
+        'OBJ::MOVE_ALLOC'               => {'' => 1},
+        'OBJ::MVBITS'                   => {'' => 1},
+        'OBJ::RANDOM_NUMBER'            => {'' => 1},
+        'OBJ::RANDOM_SEED'              => {'' => 1},
+        'OBJ::SYSTEM_CLOCK'             => {'' => 1},
+
+        # Dummy statements
+        'OBJ::NONE'                     => {'' => 1},
+        'EXE::NONE'                     => {'' => 1},
+      },
+
+      # Extra executable dependencies
+      EXE_DEP => {},
+
+      # Fortran BLOCKDATA dependencies
+      BLOCKDATA => {},
+
+      # Rename main program targets
+      EXE_NAME => {},
+
+      # Build sub-directories that can be archived by "tar"
+      TAR_DIRS => 'BLD,CACHE,DONE,FLAGS,INC,PPSRC,OBJ',
+
+      # Misc
+      MISC => {
+        CPDUMMY       => '$(FCM_DONEDIR)/FCM_CP.dummy',
+                                         # build system "copy" dummy target
+        DIR_SEPARATOR => '/',            # repository directory separator
+        EXPURL_PREFIX => 'fcm:',         # expandable URL keyword prefix
+        LOCK_BLD      => 'fcm.bld.lock', # build lock file
+        LOCK_EXT      => 'fcm.ext.lock', # extract lock file
+        MAKEFILE      => 'Makefile',     # name of Makefile
+        RUN_ENV_SH    => 'fcm_env.ksh',  # bld runtime environment shell script
+        WEB_BROWSER   => 'firefox',      # web browser
+      },
+
+      # URL, revision, and Trac URL keywords
+      URL      => {},
+      REVISION => {},
+      TRAC     => {},
+    },
+  };
+
+  # Backward compatibility: the REPOS setting is equivalent to the URL setting
+  $self->{SETTING}{REPOS} = $self->{SETTING}{URL};
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $config->central_config ();
+#   $config->central_config ($file);
+#
+# DESCRIPTION
+#   This method returns the path name of the central configuration file. If an
+#   argument $file is specified, the path name of the central configuration
+#   file is set to its value.
+# ------------------------------------------------------------------------------
+
+sub central_config {
+  my $self = shift;
+
+  if (@_) {
+    $self->{CNTL_CONFIG} = $_[0];
+  }
+
+  return $self->{CNTL_CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $config->user_config ();
+#   $config->user_config ($file);
+#
+# DESCRIPTION
+#   This method returns the path name of the user configuration file. If an
+#   argument $file is specified, the path name of the user configuration file
+#   is set to its value.
+# ------------------------------------------------------------------------------
+
+sub user_config {
+  my $self = shift;
+
+  if (@_) {
+    $self->{USER_CONFIG} = $_[0];
+  }
+
+  return $self->{USER_CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mode = $config->verbose ();
+#   $config->verbose ($mode);
+#
+# DESCRIPTION
+#   This method returns the diagnostic verbose level. If an argument $mode is
+#   specified, the diagnostic verbose level is set to its value.
+# ------------------------------------------------------------------------------
+
+sub verbose {
+  my $self = shift;
+
+  if (@_) {
+    $self->{VERBOSE} = $_[0];
+  }
+
+  return $self->{VERBOSE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $setting = $config->setting (arg, [...]);
+#
+# DESCRIPTION
+#   This method returns an item under the SETTING hash table. The depth within
+#   the hash table is given by the list of arguments, which should match with
+#   the keys in the multi-dimension SETTING hash table.
+# ------------------------------------------------------------------------------
+
+sub setting {
+  my $self = shift;
+
+  if (@_) {
+    my $label   = shift;
+    my $setting = $self->{SETTING};
+    return _get_hash_value ($setting->{$label}, @_) if exists $setting->{$label};
+  }
+
+  return undef;
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config->assign_setting (
+#     LABELS => \@labels, # setting labels
+#     VALUE  => $value,   # setting value
+#   );
+#
+# DESCRIPTION
+#   This method assigns a VALUE to a SETTING specified by the names in LABEL.
+# ------------------------------------------------------------------------------
+
+sub assign_setting {
+  my $self = shift;
+  my %args = @_;
+
+  my @labels = exists $args{LABELS} ? @{ $args{LABELS} } : ();
+  my $value  = exists $args{VALUE}  ? $args{VALUE}       : undef;
+
+  my $setting = $self->{SETTING};
+  while (defined (my $label = shift @labels)) {
+    if (exists $setting->{$label}) {
+      if (ref $setting->{$label}) {
+        $setting = $setting->{$label};
+
+      } else {
+        $setting->{$label} = $value;
+        last;
+      }
+
+    } else {
+      if (@labels) {
+        $setting->{$label} = {};
+        $setting           = $setting->{$label};
+
+      } else {
+        $setting->{$label} = $value;
+      }
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $variable = $config->variable ([arg]);
+#
+# DESCRIPTION
+#   If arg is set, this method returns the value of a variable named arg. If
+#   arg is not set, this method returns the VARIABLE hash.
+# ------------------------------------------------------------------------------
+
+sub variable {
+  my $self     = shift;
+
+  my $variable = $self->{VARIABLE};
+
+  if (@_) {
+    my $label   = shift;
+    return exists $variable->{$label} ? $variable->{$label} : undef;
+
+  } else {
+    return %{ $variable };
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config->assign_variable (
+#     LABEL => $label, # variable label
+#     VALUE => $value, # variable value
+#   );
+#
+# DESCRIPTION
+#   This method assigns a VALUE to a VARIABLE named by LABEL.
+# ------------------------------------------------------------------------------
+
+sub assign_variable {
+  my $self = shift;
+  my %args = @_;
+
+  my $label = exists $args{LABEL} ? $args{LABEL} : undef;
+  my $value = exists $args{VALUE} ? $args{VALUE} : undef;
+
+  if ($label) {
+    $self->{VARIABLE}{$label} = $value;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config->get_config ();
+#
+# DESCRIPTION
+#   This method reads the configuration settings from the central and the user
+#   configuration files.
+# ------------------------------------------------------------------------------
+
+sub get_config {
+  my $self = shift;
+
+  $self->_read_config_file ($self->{CNTL_CONFIG}) if $self->{CNTL_CONFIG};  
+  $self->_read_config_file ($self->{USER_CONFIG}) if $self->{USER_CONFIG};
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config->_read_config_file ();
+#
+# DESCRIPTION
+#   This internal method reads a configuration file and assign values to the
+#   attributes of the current instance.
+# ------------------------------------------------------------------------------
+
+sub _read_config_file {
+  my $self        = shift;
+  my $config_file = $_[0];
+
+  return undef unless -r $config_file;
+
+  my $cfgfile = Fcm::CfgFile->new (SRC => $config_file, TYPE => 'FCM');
+  $cfgfile->read_cfg ();
+  my @lines = $cfgfile->lines ();
+
+  LINE: for my $line (@lines) {
+    my $label = $line->{LABEL};
+    my $value = $line->{VALUE};
+
+    next unless $label;
+
+    # "Environment variables" start with $
+    if ($label =~ s/^\$([A-Za-z_]\w*)$/$1/) {
+      $ENV{$label} = $value;
+      next LINE;
+    }
+
+    # "Settings variables" start with "set::"
+    my @tags = map {uc $_} split (/::/, $label);
+    if ($tags[0] eq uc $self->{SETTING}{CFG_LABEL}{SETTING}) {
+      shift @tags;
+      $self->assign_setting (LABELS => \@tags, VALUE => $value);
+      next LINE;
+    }
+
+    # Not a standard setting variable, put in internal variable list
+    $label =~ s/^\%//;
+    $self->assign_variable (LABEL => $label, VALUE => $value);
+  }
+
+  1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ref = _get_hash_value (arg1, arg2, ...);
+#
+# DESCRIPTION
+#   This internal method recursively gets a value from a multi-dimensional
+#   hash.
+# ------------------------------------------------------------------------------
+
+sub _get_hash_value {
+  my $value = shift;
+
+  while (defined (my $arg = shift)) {
+    if (exists $value->{$arg}) {
+      $value = $value->{$arg};
+
+    } else {
+      return undef;
+    }
+  }
+
+  return $value;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Extract.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Extract.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Extract.pm	(revision 5166)
@@ -0,0 +1,1768 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Extract
+#
+# DESCRIPTION
+#   This class contains methods for carrying out the various tasks that are
+#   required to extract code from the FCM Subversion repository for feeding
+#   into the prototype build system. At the end of the extract, it writes a
+#   build configuration file for feeding into the build system.  If the code
+#   is to be built on a remote machine, it is mirrored to the remote machine
+#   using a "rdist" or "rsync" interface.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Extract;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+use File::Spec::Functions;
+use File::Basename;
+use File::Path;
+use File::Compare;
+
+# FCM component modules
+use Fcm::CfgFile;
+use Fcm::ReposBranch;
+use Fcm::SrcDirLayer;
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext = Fcm::Extract->new (
+#     CONFIG    => $config,
+#     CFG_SRC   => $cfg_src,
+#     EXTRACTED => $extracted,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Extract class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   CFG_SRC    - source path to the extract configuration file
+#   EXTRACTED  - is it a pre-extracted object?
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $cfg       = exists $args{CFG_SRC}   ? $args{CFG_SRC}   : undef;
+  my $extracted = exists $args{EXTRACTED} ? $args{EXTRACTED} : undef;
+  my $config    = exists $args{CONFIG}    ? $args{CONFIG}    : &main::cfg;
+
+  my $self = {
+    CONFIG     => $config,            # configuration settings
+    CFG        => Fcm::CfgFile->new ( # ext cfg for this extract
+      SRC      => $cfg,               # source path of the config file
+      TYPE     => 'ext',              # config file type
+      CONFIG   => $config,            # configuration settings
+    ),
+    DEST       => {                   # destination info for this extract
+      ROOTDIR  => undef,              # destination root directory
+      CACHEDIR => undef,              # extract cache directory
+      CFGDIR   => undef,              # destination configuration directory
+      SRCDIR   => undef,              # destination source directory
+      BLD_CFG  => undef,              # bld cfg for the build system
+      EXT_CFG  => undef,              # ext cfg for subsequent extract
+    },
+    RDEST      => {                   # remote destination information
+      MACHINE  => undef,              # destination machine
+      LOGNAME  => undef,              # remote login name
+      ROOTDIR  => undef,              # destination root directory
+      CFGDIR   => undef,              # destination configuration directory
+      SRCDIR   => undef,              # destination source directory
+      BLD_CFG  => undef,              # bld cfg for the build system
+      EXT_CFG  => undef,              # ext cfg for subsequent extract
+    },
+    BDECLARE   => [],                 # list of declared bld cfg entries
+    OVERRIDE   => 0,                  # override conflicting patches?
+    EXTRACTED  => $extracted,         # is the current object pre-extracted?
+    USE        => [],                 # list of re-used extracts
+    BRANCHES   => [],                 # list of repository branch info
+    SRCDIRS    => {},                 # list of source directory extract info
+    LOCK       => undef,              # lock file
+  };
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->DESTROY;
+#
+# DESCRIPTION
+#   This method is called automatically when a Fcm::Extract object is
+#   destroyed.
+# ------------------------------------------------------------------------------
+
+sub DESTROY {
+  my $self = shift;
+
+  # Remove the lock if it is set
+  unlink $self->{LOCK} if $self->{LOCK} and -e $self->{LOCK};
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $ext->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile = $ext->cfg;
+#   $ext->cfg ($cfgfile);
+#
+# DESCRIPTION
+#   This method returns a reference to a Fcm::CfgFile instance for the extract
+#   configuration file.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  my $self = shift;
+
+  return $self->{CFG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dest = $ext->dest ([$name]);
+#
+# DESCRIPTION
+#   This method returns a hash containing the extract destination information
+#   (local) if no argument is specified. If $name is specified, it returns the
+#   named hash element if it exists.
+# ------------------------------------------------------------------------------
+
+sub dest {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+    $name    = uc $name;
+
+    if (exists $self->{DEST}{$name}) {
+      return $self->{DEST}{$name};
+    }
+  }
+
+  return %{ $self->{DEST} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rdest = $ext->rdest ([$name]);
+#
+# DESCRIPTION
+#   This method returns a hash containing the extract destination information
+#   (remote) if no argument is specified. If $name is specified, it returns the
+#   named hash element if it exists.
+# ------------------------------------------------------------------------------
+
+sub rdest {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+    $name    = uc $name;
+
+    if (exists $self->{RDEST}{$name}) {
+      return $self->{RDEST}{$name};
+    }
+  }
+
+  return %{ $self->{RDEST} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @bdeclare = $ext->bdeclare ();
+#
+# DESCRIPTION
+#   This method returns a list containing the build configuration file entries.
+# ------------------------------------------------------------------------------
+
+sub bdeclare {
+  my $self = shift;
+
+  return @{ $self->{BDECLARE} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @branches = $ext->branches ([$index]);
+#
+# DESCRIPTION
+#   This method returns a list of references to Fcm::ReposBranch instances. If
+#   $index is specified, it returns the numbered item in the list.
+# ------------------------------------------------------------------------------
+
+sub branches {
+  my $self = shift;
+
+  if (@_) {
+    my $index = $_[0];
+    return exists $self->{BRANCHES}[$index] ? $self->{BRANCHES}[$index] : undef;
+  }
+
+  return @{ $self->{BRANCHES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %srcdirs = $ext->srcdirs ([$name]);
+#
+# DESCRIPTION
+#   This method returns a hash of source directories to be processed by this
+#   extract. If $name is specified, a named element of the hash is returned
+#   instead.
+# ------------------------------------------------------------------------------
+
+sub srcdirs {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+    $name    = uc $name;
+
+    return exists $self->{SRCDIRS}{$name} ? $self->{SRCDIRS}{$name} : undef;
+  }
+
+  return %{ $self->{SRCDIRS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $ext->extract ([FULL => 1], [IGNORE_LOCK => 1]);
+#
+# DESCRIPTION
+#   This is the main class method. It performs an extract using the current
+#   configuration. If FULL is set to true, it runs in full mode. Otherwise, it
+#   runs in incremental mode. If IGNORE_LOCK is set to true, it ignores any lock
+#   files that may exist in the extract destination root directory.
+# ------------------------------------------------------------------------------
+
+sub extract {
+  my $self = shift;
+  my %args = @_;
+
+  my $full        = exists $args{FULL}        ? $args{FULL}        : 0;
+  my $ignore_lock = exists $args{IGNORE_LOCK} ? $args{IGNORE_LOCK} : 0;
+
+  my $verbose = $self->config->verbose;
+
+  my $date = localtime;
+  print 'Extract started on ', $date, '.', "\n" if $verbose;
+  my $otime = time;
+
+  my $rc;
+  $rc = $self->decipher_cfg;
+
+  print '->Extract: start', "\n" if $verbose;
+  my $stime = time;
+
+  $rc = $self->check_dest               if $rc;
+  $rc = $self->check_lock               if $rc and not $ignore_lock;
+  $rc = $self->_set_lock                if $rc;
+  $rc = $self->expand_cfg               if $rc;
+  $rc = $self->_create_dest_dir ($full) if $rc;
+  $rc = $self->create_dir_stack         if $rc;
+  $rc = $self->_extract_src             if $rc;
+
+  $rc = $self->_sort_bdeclare if $rc;
+  $rc = $self->_write_ext_cfg if $rc;
+  $rc = $self->_write_bld_cfg if $rc;
+
+  my $ftime = time;
+  my $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+  print '->Extract: ', $ftime - $stime, ' ', $s_str, "\n";
+
+  if ($rc and $self->{RDEST}{MACHINE}) {
+    print '->Mirror : start', "\n" if $verbose;
+    $stime = time;
+    $rc = $self->_mirror_extract;
+    $ftime = time;
+    $s_str = $ftime - $stime > 1 ? 'seconds' : 'second';
+    print '->Mirror : ', $ftime - $stime, ' ', $s_str, "\n";
+  }
+
+  if ($verbose) {
+    $s_str = $ftime - $otime > 1 ? 'seconds' : 'second';
+    print '->TOTAL  : ', $ftime - $otime, ' ', $s_str, "\n";
+  }
+
+  $date = localtime;
+  if ($rc) {
+    print 'Extract command finished on ', $date, '.', "\n" if $verbose;
+
+  } else {
+    e_report 'Extract command failed on ', $date, '.';
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->decipher_cfg ();
+#
+# DESCRIPTION
+#   This method deciphers the extract configuration file.
+# ------------------------------------------------------------------------------
+
+sub decipher_cfg {
+  my $self = shift;
+
+  return unless $self->cfg->src;
+
+  # Read config file
+  my $read = $self->cfg->read_cfg;
+
+  # Check config file type
+  if ($read) {
+    if ($self->cfg->type ne 'ext') {
+      w_report 'Error: ', $self->cfg->src, ': not an extract config file';
+      return;
+    }
+
+  } else {
+    return;
+  }
+
+  my %cfg_labels = %{ $self->config->setting ('CFG_LABEL') };
+
+  # Extract information from each line of the config file
+  my @lines    = $self->cfg->lines;
+  LINE: for my $line (@lines) {
+    my $label = $line->{LABEL};
+    my $value = $line->{VALUE};
+
+    next LINE unless $label;
+
+    # Configuration file type/version, ignore
+    for my $my_label (keys %{ $cfg_labels{CFGFILE} }) {
+      next LINE if uc ($label) eq uc ($cfg_labels{CFGFILE}{$my_label});
+    }
+
+    # Include another file, processed already, ignore this line
+    next LINE if uc ($label) eq $cfg_labels{INC};
+
+    # User variable, ignore
+    next LINE if index (uc ($label), '%') == 0;
+
+    # Local destination directories, config file, etc
+    for my $my_label (keys %{ $cfg_labels{DEST} }) {
+      if (uc ($label) eq uc ($cfg_labels{DEST}{$my_label})) {
+        $self->{DEST}{$my_label} = &expand_tilde ($value);
+        next LINE;
+      }
+    }
+
+    # Remote machine, logname, destination directories, config file, etc
+    for my $my_label (keys %{ $cfg_labels{RDEST} }) {
+      if (uc ($label) eq uc ($cfg_labels{RDEST}{$my_label})) {
+        $self->{RDEST}{$my_label} = $value;
+        next LINE;
+      }
+    }
+
+    # "USE" statements
+    if (uc ($label) eq uc ($cfg_labels{USE})) {
+      my $exists = grep {$_->cfg->src eq $value} @{ $self->{USE} };
+
+      # Initialise new Fcm::Extract object if not already exists
+      unless ($exists) {
+        my $extract = Fcm::Extract->new (
+          CONFIG    => $self->config,
+          CFG_SRC   => expand_tilde ($value),
+          EXTRACTED => 1,
+        );
+
+        $extract->decipher_cfg;
+        $extract->check_dest;
+        $extract->expand_cfg ();
+        push @{ $self->{USE} }, $extract;
+      }
+      next LINE;
+    }
+
+    # "Override" setting
+    if (uc ($label) eq uc ($cfg_labels{OVERRIDE})) {
+      $self->{OVERRIDE} = $value;
+      next LINE;
+    }
+
+    # "Mirror" command
+    if (uc ($label) eq uc ($cfg_labels{MIRROR})) {
+      $self->config->assign_setting (
+        LABELS => [qw/TOOL MIRROR/],
+        VALUE  => $value,
+      );
+      next LINE;
+    }
+
+    # Declared bld cfg entries
+    {
+      my $prefix = $cfg_labels{BDECLARE} . '::';
+
+      if (index (uc ($label), $prefix) == 0) {
+        my $name = substr $label, length ($prefix);
+
+        if ($name) {
+          push @{ $self->{BDECLARE} }, {LABEL => $name, VALUE => $value,};
+          next LINE;
+        }
+      }
+    }
+
+    # Repository, version and source directories
+    for my $my_label (qw/REPOS VERSION SRCDIR EXPSRCDIR/) {
+      my $prefix  = $cfg_labels{$my_label} . '::';
+
+      if (index (uc ($label), $prefix) == 0) {
+        my $name    = substr $label, length ($prefix);
+
+        # Detemine package and tag
+        my @names   = split /::/, $name;
+        my $tag     = pop @names;
+        my $pckroot = $names[0];
+        my $pck     = join '::', @names;
+
+        # Check that $tag and $pckroot are defined
+        last if not $tag;
+        last if not $pckroot;
+
+        # Check whether branch already exists
+        my @branches = grep {
+          $_->package eq $pckroot and $_->tag eq $tag
+        } @{ $self->{BRANCHES} };
+
+        my $branch   = undef;
+
+        if (@branches) { # If so, set $branch to point to existing branch
+          $branch = shift @branches;
+
+        } else {         # If not, create new branch
+          $branch = Fcm::ReposBranch->new (
+            CONFIG  => $self->config,
+            PACKAGE => $pckroot,
+            TAG     => $tag,
+          );
+
+          push @{ $self->{BRANCHES} }, $branch;
+        }
+
+        # Check package name for source directory declarations
+        if ($my_label eq 'SRCDIR' or $my_label eq 'EXPSRCDIR') {
+          if ($pck eq $pckroot and $value !~ m#^/#) {
+            # Sub-package name not set and source directory quoted as a relative
+            # path, determine package name from path name
+            my @subpck = File::Spec->splitdir ($value);
+            $pck       = join '::', ($pckroot, @subpck);
+          }
+        }
+
+        # Assign the value accordingly
+        if ($my_label eq 'REPOS') {          # Repository location
+          $branch->repos ($value);
+
+        } elsif ($my_label eq 'VERSION') {   # Version used
+          $branch->version ($value);
+
+        } elsif ($my_label eq 'SRCDIR') {    # Source directory used
+          $branch->dir ($pck, $value);
+
+        } elsif ($my_label eq 'EXPSRCDIR') { # Expandable source directory
+          $branch->expdir ($pck, $value);
+        }
+
+        next LINE;
+      }
+    }
+
+    # Label not recognised
+    w_report 'ERROR: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
+             ': label "', $label, '" not recognised';
+    return;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->check_dest ();
+#
+# DESCRIPTION
+#   This method checks that the extract destionations are set correctly.
+# ------------------------------------------------------------------------------
+
+sub check_dest {
+  my $self = shift;
+
+  my %subdir  = %{ $self->config->setting ('DIR') };
+  my %cfgname = %{ $self->config->setting ('CFG_NAME') };
+
+  # Default destination settings
+  my $dest = $self->{DEST};
+  if ($dest->{ROOTDIR}) {
+    unless ($dest->{SRCDIR}) {   # Location of extracted source
+      $dest->{SRCDIR} = catfile $dest->{ROOTDIR}, $subdir{SRC};
+    }
+    unless ($dest->{CFGDIR}) {   # Location of configuration files
+      $dest->{CFGDIR} = catfile $dest->{ROOTDIR}, $subdir{CFG};
+    }
+    unless ($dest->{CACHEDIR}) { # Location of cache
+      $dest->{CACHEDIR} = catfile $dest->{ROOTDIR}, $subdir{CACHE};
+    }
+    unless ($dest->{BLD_CFG}) {  # Location of (output) bld cfg
+      $dest->{BLD_CFG} = catfile $dest->{CFGDIR}, $cfgname{BLD};
+    }
+    unless ($dest->{EXT_CFG}) {  # Location of (output) ext cfg
+      $dest->{EXT_CFG} = catfile $dest->{CFGDIR}, $cfgname{EXT};
+    }
+  } else {
+    w_report 'Error: ', $self->cfg->src,
+             ': destination root directory not set.';
+    return;
+  }
+
+  # Default remote destination settings
+  if ($self->{RDEST}{MACHINE}) {
+
+    # Use local logname as remote logname if it is not set
+    $self->{RDEST}{LOGNAME} = getlogin      unless $self->{RDEST}{LOGNAME};
+    $self->{RDEST}{LOGNAME} = $ENV{LOGNAME} unless $self->{RDEST}{LOGNAME};
+    $self->{RDEST}{LOGNAME} = $ENV{USER}    unless $self->{RDEST}{LOGNAME};
+
+    unless ($self->{RDEST}{LOGNAME}) {
+      w_report 'Error: ', $self->cfg->src,
+               ': cannot determine your remote logname.';
+      return;
+    }
+
+    # Make sure remote destination root directory is set
+    unless ($self->{RDEST}{ROOTDIR}) {
+      w_report 'Error: ', $self->cfg->src,
+               ': remote destination root directory not set.';
+      return;
+    }
+
+    # Make sure remote destination source directory is set
+    $self->{RDEST}{SRCDIR} = catfile $self->{RDEST}{ROOTDIR}, $subdir{SRC}
+      unless $self->{RDEST}{SRCDIR};
+
+    # Make sure remote destination configuration directory is set
+    $self->{RDEST}{CFGDIR} = catfile $self->{RDEST}{ROOTDIR}, $subdir{CFG}
+      unless $self->{RDEST}{CFGDIR};
+
+    # Make sure remote bld cfg is set
+    $self->{RDEST}{BLD_CFG} = catfile $self->{RDEST}{CFGDIR}, $cfgname{BLD}
+      unless $self->{RDEST}{BLD_CFG};
+
+    # Make sure remote ext cfg is set
+    $self->{RDEST}{EXT_CFG} = catfile $self->{RDEST}{CFGDIR}, $cfgname{EXT}
+      unless $self->{RDEST}{EXT_CFG};
+
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->check_lock ();
+#
+# DESCRIPTION
+#   This method checks whether a lock is set in the current extract.
+# ------------------------------------------------------------------------------
+
+sub check_lock {
+  my $self = shift;
+
+  my $rootdir  = $self->{DEST}{ROOTDIR};
+  my $lock_ext = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_EXT/));
+  my $lock_bld = catfile ($rootdir, $self->config->setting (qw/MISC LOCK_BLD/));
+
+  # Always throw error if extract lock exists
+  if (-e $lock_ext) {
+    w_report 'ERROR: extract lock file exists: ', $lock_ext, ',';
+    w_report '       an extract may be running at ', $rootdir, ', abort.';
+    return;
+  }
+
+  # Throw error if current object is not a "used" pre-extracted object and
+  # a build lock exists
+  if ((not $self->{EXTRACTED}) and -e $lock_bld) {
+    w_report 'ERROR: build lock file exists: ', $lock_bld, ',';
+    w_report '       a build may be running at ', $rootdir, ', abort.';
+    return;
+  }
+
+  # Check locks in inherited extract
+  for my $use (@{ $self->{USE} }) {
+    return unless $use->check_lock;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_set_lock ();
+#
+# DESCRIPTION
+#   This method sets a lock is set in the current extract.
+# ------------------------------------------------------------------------------
+
+sub _set_lock {
+  my $self = shift;
+
+  $self->{LOCK} = catfile (
+    $self->{DEST}{ROOTDIR}, $self->config->setting (qw/MISC LOCK_EXT/),
+  );
+
+  &touch_file ($self->{LOCK});
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->expand_cfg ();
+#
+# DESCRIPTION
+#   This method expands the settings of the extract configuration.
+# ------------------------------------------------------------------------------
+
+sub expand_cfg {
+  my $self = shift;
+
+  # Establish a set of source directories from the "base repository"
+  my %base_branches = ();
+
+  # Inherit "base" set of source directories from re-used extracts
+  my @uses = @{ $self->{USE} };
+
+  for my $use (@uses) {
+    my @branches = $use->branches;
+
+    for my $branch (@branches) {
+      my $package              = $branch->package;
+      $base_branches{$package} = $branch unless exists $base_branches{$package};
+    }
+  }
+
+  for my $branch (@{ $self->{BRANCHES} }) {
+    # Expand URL keywords if necessary
+    if ($branch->repos) {
+      my $repos = expand_url_keyword (
+        URL => $branch->repos,
+        CFG => $self->config,
+      );
+      $branch->repos ($repos) if $repos ne $branch->repos;
+    }
+
+    # Check that repository type and version are set
+    if ($branch->repos and &is_url ($branch->repos)) {
+      $branch->type    ('svn')  unless $branch->type;
+      $branch->version ('head') unless $branch->version;
+
+    } else {
+      $branch->type    ('user') unless $branch->type;
+      $branch->version ('user') unless $branch->version;
+    }
+
+    $branch->expand_version_tag; # Work out revision number a version tag
+    $branch->expand_path;        # Expand relative path to full path
+    $branch->expand_all;         # Search sub-directories
+
+    my $package = $branch->package;
+
+    if (exists $base_branches{$package}) {
+      # A base branch for this package exists
+
+      # If current branch has no source directory, use the set provided by the
+      # base branch
+      my %dirs = $branch->dirs;
+      $branch->add_base_dirs ($base_branches{$package}) unless keys %dirs;
+
+    } else {
+      # This package does not yet have a base branch, set this branch as base
+      $base_branches{$package} = $branch;
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_create_dest_dir ($full);
+#
+# DESCRIPTION
+#   This internal method (re-)creates all the destination directories if
+#   necessary. If $full is set to true, it removes existing directories/files
+#   in the destination directories.
+# ------------------------------------------------------------------------------
+
+sub _create_dest_dir {
+  my ($self, $full) = @_;
+
+  my $verbose = $self->config->verbose;
+
+  # Remove previous extract if "FULL" flag is set
+  if ($full) {
+    # Remove extracted source
+    if (-d $self->{DEST}{SRCDIR} and -w $self->{DEST}{SRCDIR}) {
+      print 'Remove directory: ', $self->{DEST}{SRCDIR}, "\n" if $verbose;
+      my $removed = rmtree $self->{DEST}{SRCDIR};
+      w_report 'WARNING: ', $self->{DEST}{SRCDIR}, ': cannot remove.'
+        if not $removed;
+    }
+
+    # Remove cache
+    my @files;
+    if (-d $self->{DEST}{CACHEDIR} and opendir DIR, $self->{DEST}{CACHEDIR}) {
+      @files = grep {$_ ne '.' and $_ ne '..'} readdir 'DIR';
+      closedir DIR;
+    }
+
+    for my $file (@files) {
+      my $path = File::Spec->catfile ($self->{DEST}{CACHEDIR}, $file);
+
+      next unless $file eq $self->config->setting (qw/CACHE EXTCONFIG/) or
+                  -d $path;
+
+      print 'Remove: ', $path, "\n" if $verbose;
+      my $removed = rmtree $path;
+      w_report 'WARNING: ', $path, ': cannot remove.' if not $removed;
+    }
+  }
+
+  # Create extract destinations if necessary
+  for my $my_label (qw/ROOTDIR CACHEDIR CFGDIR SRCDIR/) {
+    my $dirname = $self->{DEST}{$my_label};
+
+    # Create directory if it does not already exist
+    if (not -d $dirname) {
+      print 'Make directory: ', $dirname, "\n" if $verbose > 1;
+      mkpath $dirname;
+    }
+
+    unless (-d $dirname and -w $dirname) {
+      w_report 'ERROR: ', $dirname, ': cannot write to destination.';
+      return;
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext->create_dir_stack (
+#     USE => $use, # Is this a pre-extracted configuration?
+#   );
+#
+# DESCRIPTION
+#   This method creates a hash of source directories to be processed. If the
+#   flag USE is set to true, the source directories are assumed processed and
+#   extracted.
+# ------------------------------------------------------------------------------
+
+sub create_dir_stack {
+  my $self = shift;
+  my %args = @_;
+  my $extracted = exists $args{USE} ? $args{USE} : undef;
+
+  # Inherit from USE ext cfg
+  if (@{ $self->{USE} } > 0) {
+    for my $use (@{ $self->{USE} }) {
+      $use->create_dir_stack (USE => 1);
+      my %use_srcdirs = $use->srcdirs;
+
+      while (my ($key, $value) = each %use_srcdirs) {
+        $self->{SRCDIRS}{$key} = $value;
+
+        # Re-set destination to current destination
+        my @path = split (/::/, $key);
+        $self->{SRCDIRS}{$key}{DEST} = catfile ($self->{DEST}{SRCDIR}, @path);
+      }
+    }
+  }
+
+  # Build stack from current ext cfg
+  for my $branch (@{ $self->{BRANCHES} }) {
+    my %branch_dirs = $branch->dirs;
+
+    for my $dir (keys %branch_dirs) {
+      # Check whether source directory is already in the list
+      if (not exists $self->{SRCDIRS}{$dir}) { # if not, create it
+        $self->{SRCDIRS}{$dir} = {
+          DEST  => catfile ($self->{DEST}{SRCDIR}, split (/::/, $dir)),
+          STACK => [],
+          FILES => {},
+        };
+      }
+
+      my $stack = $self->{SRCDIRS}{$dir}{STACK}; # copy reference
+
+      # Create a new layer in the input stack
+      my $layer = Fcm::SrcDirLayer->new (
+        CONFIG    => $self->config,
+        NAME      => $dir,
+        PACKAGE   => $branch->package,
+        TAG       => $branch->tag,
+        LOCATION  => $branch->dir ($dir),
+        REPOSROOT => $branch->repos,
+        VERSION   => $branch->version,
+        TYPE      => $branch->type,
+        EXTRACTED => $extracted ? $self->{SRCDIRS}{$dir}{DEST} : undef,
+      );
+
+      # Check whether layer is already in the stack
+      my $exist = grep {
+        $_->location eq $layer->location and $_->version  eq $layer->version;
+      } @{ $stack };
+
+      if (not $exist) {
+        # If not already exist, put layer into stack
+
+        # Note: user stack always comes last
+        if (! $layer->user and exists $stack->[-1] and $stack->[-1]->user) {
+          my $lastlayer = pop @{ $stack };
+          push @{ $stack }, $layer;
+          $layer = $lastlayer;
+        }
+
+        push @{ $stack }, $layer;
+
+      } elsif ($layer->user) {
+
+        # User layer already exists, overwrite it
+        $stack->[-1] = $layer;
+
+      }
+    }
+  }
+
+  # Read content of "commit cache" file if it exists
+  my $cachedir = $self->{DEST}{CACHEDIR};
+  my $cfgbase  = $self->config->setting (qw/CACHE EXTCONFIG/);
+  my $cfgfile  = catfile $cachedir, $cfgbase;
+  my %config_lines = ();
+  if (-r $cfgfile) {
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $cfgfile,);
+    $cfg->read_cfg;
+    my @lines = $cfg->lines;
+
+    for my $line (@lines) {
+      $config_lines{$line->{LABEL}} = $line->{VALUE};
+    }
+  }
+
+  my %new_config_lines;
+
+  # Compare each layer to base layer, discard unnecessary layers
+  for my $srcdir (keys %{ $self->{SRCDIRS} }) {
+    my @stack = ();
+
+    while (my $layer = shift @{ $self->{SRCDIRS}{$srcdir}{STACK} }) {
+      if ($layer->user) {
+        # User directory, check that the declared location exists
+        if (not -d $layer->location) {
+          w_report 'Error: declared source directory ', $layer->location,
+                   ' does not exists ';
+          return;
+        }
+
+        # Always override repository code
+        push @stack, $layer;
+
+      } else {
+        unless ($layer->extracted and $layer->commit) {
+
+          my $key = join '::', ($srcdir, $layer->location, $layer->version);
+
+          # See if commit version information is cached
+          if (keys %config_lines) {
+            if (exists $config_lines{$key}) {
+              $layer->commit ($config_lines{$key});
+            }
+          }
+
+          # Check source directory for commit version, if necessary
+          $layer->get_commit unless $layer->commit;
+          if (not $layer->commit) {
+            w_report 'Error: cannot determine the last changed revision of ',
+                     $layer->location;
+            return;
+          }
+
+          # Set cache directory for layer
+          my $tag_ver = $layer->tag . '__' . $layer->commit;
+          $layer->cachedir (catfile $cachedir, split (/::/, $srcdir), $tag_ver);
+
+          # New line in cache config file
+          $new_config_lines{$key} = $layer->commit;
+        }
+
+        # Push this layer in the stack:
+        # 1. it has a different version compared to the top layer
+        # 2. it is the top layer (base line code)
+        if (@stack > 0) {
+          push @stack, $layer if $layer->commit != $stack[0]->commit;
+
+        } else {
+          push @stack, $layer;
+        }
+
+      }
+    }
+
+    $self->{SRCDIRS}{$srcdir}{STACK} = \@stack;
+
+  }
+
+  # Write "commit cache" file
+  if (not $extracted) {
+    mkpath $cachedir if not -d $cachedir;
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config,);
+
+    while ((my $label, my $value) = each %new_config_lines) {
+      $cfg->add_line (LABEL => $label, VALUE => $value,);
+    }
+
+    $cfg->print_cfg ($cfgfile);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_extract_src ();
+#
+# DESCRIPTION
+#   This internal method performs the extract of the source directories and
+#   files if necessary.
+# ------------------------------------------------------------------------------
+
+sub _extract_src {
+  my $self = shift;
+
+  my $verbose = $self->config->verbose;
+  my %v_count = (
+    CREATED_DIRS    => 0,
+    IGNORED_SUBDIRS => 0,
+    UPDATED_FILES   => 0,
+    REMOVED_FILES   => 0,
+  );
+
+  my $cachedir = $self->{DEST}{CACHEDIR};
+
+  # Go through the "stack" of each source directory
+  # Extract the source directories/files if required
+
+  for my $srcdir (values %{ $self->{SRCDIRS} }) {
+
+    # Check if destionation exists and is not a directory
+    if (-f $srcdir->{DEST}) {
+      w_report $srcdir->{DEST},
+               ': destination exists and is not a directory, abort.';
+      return;
+    }
+
+    my %base_files   = (); # list of files in the base layer
+    my %used_files   = (); # keys = file basenames, values = layer reference
+    $srcdir->{FILES} = \%used_files;
+    my @destpath     = (); # search path for source directory destinations
+ 
+    for my $layer (@{ $srcdir->{STACK} }) {
+      # Update the cache for each layer of the stack if necessary
+      $layer->update_cache unless $layer->extracted or -d $layer->localdir;
+
+      # Search path for extract destinations of this source directory
+      unshift @destpath, $layer->extracted
+        if $layer->extracted and not grep {$_ eq $layer->extracted} @destpath;
+ 
+      # Get list of files in the cache or local directory
+      for my $file (($layer->get_files)) {
+        if (exists $base_files{$file}) {
+          # File exists in the base, compare current version with base version,
+          # discard if not changed
+          my $base_file = catfile $base_files{$file}->localdir, $file;
+          my $used_file = catfile $used_files{$file}->localdir, $file;
+          my $this_file = catfile $layer->localdir, $file;
+
+          if (compare ($base_file, $this_file)) { # Differs
+            if ($base_files{$file} eq $used_files{$file}) {
+              # Base and used are the same layer, use current layer
+              $used_files{$file} = $layer;
+
+            } elsif (compare ($used_file, $this_file) == 0) {
+              # Changes in used and this are the same, no update required
+
+              # Print a message at verbose mode 2 or above
+              if ($verbose > 1) {
+                print &_print_override_mesg (
+                  FILE   => $file,
+                  LAYER0 => $base_files{$file},
+                  LAYER1 => $used_files{$file},
+                  LAYER2 => $layer,
+                );
+                print '  Same modifications, use the source in URL 1.', "\n";
+              }
+
+            } elsif ($self->{OVERRIDE}) {
+              # Base and used are different, and used is not the same as this
+              # Override mode, use current layer
+
+              # Print override mode message
+              if ($verbose) {
+                print &_print_override_mesg (
+                  FILE   => $file,
+                  LAYER0 => $base_files{$file},
+                  LAYER1 => $used_files{$file},
+                  LAYER2 => $layer,
+                );
+                print '  ', $file, ' in URL 2 overrides that in URL 1.', "\n";
+              }
+
+              $used_files{$file} = $layer;
+
+            } else {
+              # Base and used are different, and used is not the same as this
+              # Non-override mode, fail the extract
+              w_report &_print_override_mesg (
+                FILE   => $file,
+                LAYER0 => $base_files{$file},
+                LAYER1 => $used_files{$file},
+                LAYER2 => $layer,
+              );
+              w_report '  Override mode is false, file in URL 1 cannot ',
+                       'override file in URL 2, abort.';
+              return;
+            }
+          }
+ 
+        } else {
+          # The first time the file is found
+          $base_files{$file} = $layer;
+          $used_files{$file} = $layer;
+        }
+      }
+    }
+
+    # Add current destination to the beginning of the destination search path
+    unshift @destpath, $srcdir->{DEST} if -d $srcdir->{DEST};
+
+    for my $file (keys %used_files) {
+      # Ignore sub-directories
+      if (-d catfile $used_files{$file}->localdir, $file) {
+        # Print diagnostic
+        if ($verbose > 1) {
+          print 'Ignore subdirectory: ', $file, "\n";
+          print '                Src: ', $used_files{$file}->location;
+          print '@', $used_files{$file}->version unless $used_files{$file}->user;
+          print "\n";
+        }
+        $v_count{IGNORED_SUBDIRS}++;
+        next;
+      }
+
+      # Determine whether file has changed, compared with the destination
+      my $diff = 1;
+      for my $dir (@destpath) {
+        my $old = catfile ($dir, $file);
+
+        if (-f $old) {
+          my $new = catfile ($used_files{$file}->localdir, $file);
+          $diff   = compare $old, $new;
+          last;
+        }
+      }
+
+      if ($diff) { # copy if differs
+        # Create extract destination, if required
+        if (not -d $srcdir->{DEST}) {
+          print 'Create directory: ', $srcdir->{DEST}, "\n" if $verbose > 1;
+          my $mkdirs = mkpath $srcdir->{DEST};
+
+          if (! -d $srcdir->{DEST} or ! -w $srcdir->{DEST}) {
+            w_report $srcdir->{DEST}, ': not a writable directory, abort.';
+            return;
+          }
+
+          $v_count{CREATED_DIRS} += $mkdirs;
+        }
+
+        # Set up the copy command
+        my @cmd = (
+          'cp',
+          catfile ($used_files{$file}->localdir, $file),
+          $srcdir->{DEST},
+        );
+
+        my $dest_file = catfile ($srcdir->{DEST}, $file);
+
+        # Print diagnostic
+        if ($verbose > 1) {
+          print 'Update: ', $dest_file, "\n";
+          print '   Src: ', $used_files{$file}->location;
+          print '@', $used_files{$file}->version unless $used_files{$file}->user;
+          print "\n";
+        }
+
+        # Remove old file if it exists
+        unlink $dest_file if -f $dest_file;
+
+        # Execute the copy command
+        &run_command (\@cmd, TIME => $self->config->verbose > 2);
+
+        $v_count{UPDATED_FILES}++;
+      }
+
+    }
+
+    # Check that the destination directory does not contain any removed files
+    opendir DIR, $srcdir->{DEST};
+    my @dest_files = readdir DIR;
+    closedir DIR;
+
+    while (my $file = shift @dest_files) {
+      next if $file =~ /^\.\.?/;                   # ignore hidden files
+      next if -d catfile ($srcdir->{DEST}, $file); # ignore sub-directories
+
+      # Check if the file exists in any of the versions
+      my $exists = 0;
+      for my $layer (@{ $srcdir->{STACK} }) {
+        if (-f catfile ($layer->localdir, $file)) {
+          $exists = 1;
+          last;
+        }
+      }
+
+      # File exists in destination but not in any versions...
+      if (not $exists) {
+        my @cmd = (
+          qw/rm -f/,
+          catfile ($srcdir->{DEST}, $file),
+        );
+
+        # Print diagnostic
+        print 'Remove: ', catfile ($srcdir->{DEST}, $file), "\n"
+          if $verbose > 1;
+
+        # Execute the command
+        &run_command (\@cmd, TIME => $self->config->verbose > 2);
+
+        $v_count{REMOVED_FILES}++;
+      }
+    }
+  }
+
+  if ($verbose) {
+    my %v_label = (
+      CREATED_DIRS    => 'Number of directories created    : ',
+      IGNORED_SUBDIRS => 'Number of ignored sub-directories: ',
+      UPDATED_FILES   => 'Number of updated files          : ',
+      REMOVED_FILES   => 'Number of removed files          : ',
+    );
+    for my $key (qw/CREATED_DIRS IGNORED_SUBDIRS UPDATED_FILES REMOVED_FILES/) {
+      print $v_label{$key}, $v_count{$key}, "\n" if $v_count{$key};
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = _print_override_mesg (
+#     FILE => $file,
+#     LAYER0 => $layer0,
+#     LAYER1 => $layer1,
+#     LAYER2 => $layer2,
+#   );
+#
+# DESCRIPTION
+#   This internal method returns a string containing an override mode message.
+#
+# ARGUMENTS
+#   FILE   - name of the source file
+#   LAYER0 - base location
+#   LAYER1 - source location overridden by LOC2
+#   LAYER2 - source location overriding LOC1
+# ------------------------------------------------------------------------------
+
+sub _print_override_mesg {
+  my %args = @_;
+
+  my $string = $args{FILE};
+  $string .= ': modified in both URL 1 and URL 2, relative to BASE:';
+  $string .= "\n";
+  $string .= '  BASE : ' . $args{LAYER0}->location;
+  $string .= '@' . $args{LAYER0}->version unless $args{LAYER0}->user;
+  $string .= "\n";
+  $string .= '  URL 1: ' . $args{LAYER1}->location;
+  $string .= '@' . $args{LAYER1}->version unless $args{LAYER1}->user;
+  $string .= "\n";
+  $string .= '  URL 2: ' . $args{LAYER2}->location;
+  $string .= '@' . $args{LAYER2}->version unless $args{LAYER2}->user;
+  $string .= "\n";
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_sort_bdeclare ();
+#
+# DESCRIPTION
+#   This internal method sorts the declared build configuration entries,
+#   filtering out repeated entries.
+# ------------------------------------------------------------------------------
+
+sub _sort_bdeclare {
+  my $self = shift;
+
+  # Get list of build configuration labels that can be declared multiple times
+  my %cfg_labels   = %{ $self->config->setting ('CFG_LABEL') };
+  my @cfg_keywords = split /,/, $self->config->setting ('CFG_KEYWORD');
+  @cfg_keywords    = map {$cfg_labels{$_}} @cfg_keywords;
+
+  # Filter out repeated declarations
+  my @bdeclares = ();
+  for my $bdeclare (reverse @{ $self->{BDECLARE} }) {
+    my $label = $bdeclare->{LABEL};
+
+    # Do not filter any declarations that can be declared multiple times
+    my $unshift_ok = grep {
+      uc ($label) eq $_ or index (uc ($label), $_ . '::') == 0;
+    } @cfg_keywords;
+    # @bdeclare contains nothing, last entry
+    $unshift_ok    = 1 unless $unshift_ok or @bdeclares;
+    # Check if a later entry already exists
+    $unshift_ok    = 1
+      unless $unshift_ok or grep {$_->{LABEL} eq $label} @bdeclares;
+
+    # Reconstruct array from bottom up
+    unshift @bdeclares, $bdeclare if $unshift_ok;
+  }
+
+  $self->{BDECLARE} = \@bdeclares;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_write_ext_cfg ();
+#
+# DESCRIPTION
+#   This internal method writes the expanded extract configuration file.
+# ------------------------------------------------------------------------------
+
+sub _write_ext_cfg {
+  my $self = shift;
+
+  my %cfg_labels = %{ $self->config->setting ('CFG_LABEL') };
+  my %subdir     = %{ $self->config->setting ('DIR') };
+  my %cfgname    = %{ $self->config->setting ('CFG_NAME') };
+
+  # Create new config file object and assign lines to it
+  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, TYPE => 'ext',);
+
+  # Set up config file header
+  $cfg->add_header ();
+
+  # Re-use pre-extracted expanded ext cfg
+  if (@{ $self->{USE} }) {
+    $cfg->add_comment_block ('Other ext cfg');
+
+    for my $reuse (@{ $self->{USE} }) {
+      my $rootdir = $reuse->dest ('ROOTDIR');
+      my $ext_cfg = $reuse->cfg->src;
+
+      # Default location of build config file
+      my $def_ext_cfg = catfile $rootdir, $subdir{CFG}, $cfgname{EXT};
+
+      $cfg->add_line (
+        LABEL => $cfg_labels{USE},
+        VALUE => $ext_cfg eq $def_ext_cfg ? $rootdir : $ext_cfg,
+      );
+    }
+
+    # Blank line
+    $cfg->add_line;
+  }
+
+  # Destination directories, config file, etc
+  my $dest = $self->{DEST};
+
+  $cfg->add_comment_block ('Destination');
+
+  $cfg->add_line (
+    LABEL => $cfg_labels{DEST}{ROOTDIR},
+    VALUE => $dest->{ROOTDIR},
+  );
+
+  for my $label (qw/CFG SRC CACHE/) {
+    my $dir = $label . 'DIR';
+
+    if ($dest->{$dir} ne catfile $dest->{ROOTDIR}, $subdir{$label}) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{DEST}{$dir},
+        VALUE => $dest->{$dir},
+      );
+    }
+  }
+
+  for my $name (qw/BLD EXT/) {
+    my $label = $name . '_CFG';
+
+    if ($dest->{$label} ne catfile $dest->{CFGDIR}, $cfgname{$name}) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{DEST}{$label},
+        VALUE => $dest->{$label},
+      );
+    }
+  }
+
+  # Blank line
+  $cfg->add_line;
+
+  # Remote destination directories, config file, etc
+  if ($self->{RDEST}{MACHINE}) {
+    my $rdest = $self->{RDEST};
+
+    $cfg->add_comment_block ('Remote destination');
+
+    for my $label (qw/MACHINE LOGNAME ROOTDIR/) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{RDEST}{$label},
+        VALUE => $rdest->{$label},
+      );
+    }
+
+    for my $label (qw/CFG SRC/) {
+      my $dir = $label . 'DIR';
+      if ($rdest->{$dir} ne catfile $rdest->{ROOTDIR}, $subdir{$label}) {
+        $cfg->add_line (
+          LABEL => $cfg_labels{RDEST}{$dir},
+          VALUE => $rdest->{$dir},
+        );
+      }
+    }
+
+    for my $name (qw/BLD EXT/) {
+      my $label = $name . '_CFG';
+
+      if ($rdest->{$label} ne catfile $rdest->{CFGDIR}, $cfgname{$name}) {
+        $cfg->add_line (
+          LABEL => $cfg_labels{RDEST}{$label},
+          VALUE => $rdest->{$label},
+        );
+      }
+    }
+
+    $cfg->add_line (
+      LABEL => $cfg_labels{MIRROR},
+      VALUE => $self->config->setting (qw/TOOL MIRROR/),
+    );
+
+    # Blank line
+    $cfg->add_line;
+  }
+
+  if ($self->{OVERRIDE}) {
+    $cfg->add_line (
+      LABEL => $cfg_labels{OVERRIDE},
+      VALUE => $self->{OVERRIDE} ? 1 : 0,
+    );
+    $cfg->add_line;
+  }
+
+  # Source directories
+  $cfg->add_comment_block ('Source directories');
+
+  # Set up lines in the ext cfg
+  my @lines = ();
+  for my $my_label (keys %{ $self->{SRCDIRS} }) {
+    for my $layer (@{ $self->{SRCDIRS}{$my_label}{STACK} }) {
+      next if $layer->extracted;
+
+      my $tag = $layer->package . '::' . $layer->tag;
+
+      # Repository
+      my $exists = grep {
+        $_->{LABEL} eq $cfg_labels{REPOS} . '::' . $tag;
+      } @lines;
+      push @lines, {
+        LABEL   => $cfg_labels{REPOS} . '::' . $tag,
+        VALUE   => $layer->reposroot,
+      } if not $exists;
+
+      # Version
+      $exists = grep {
+        $_->{LABEL} eq $cfg_labels{VERSION} . '::' . $tag;
+      } @lines;
+      push @lines, {
+        LABEL   => $cfg_labels{VERSION} . '::' . $tag,
+        VALUE   => $layer->version,
+      } unless $layer->user or $exists;
+
+      # Source directory
+      my ($pcks, $path);
+
+      if ($layer->reposroot) {
+        # Repository root declaration exists, print relative path
+        if ($layer->location eq $layer->reposroot) {
+          $path  = '';
+
+        } else {
+          $path  = substr ($layer->location, length ($layer->reposroot) + 1);
+        }
+        my @pcks = split /::/, $my_label;
+        shift @pcks;
+
+        if (join ('::', @pcks) eq join ('::', File::Spec->splitdir ($path))) {
+          # Print top package name if relative path matches sub-package name
+          $pcks = $layer->package;
+
+        } else {
+          # Print full sub-package name otherwise
+          $pcks = $my_label;
+        }
+
+      } else {
+        # No repository root declaration
+        # Print full path and full sub-package name
+        $path = $layer->location;
+        $pcks = $my_label;
+      }
+
+      my $length = $layer->reposroot ? length ($layer->reposroot) + 1 : 0;
+      push @lines, {
+        LABEL   => join ('::', ($cfg_labels{SRCDIR}, $pcks, $layer->tag)),
+        VALUE   => $path,
+      };
+    }
+  }
+
+  # Sort lines for specifying repository, version and source directories
+  @lines = sort {
+    my $rep_label = $cfg_labels{REPOS};
+    my $ver_label = $cfg_labels{VERSION};
+
+    if ($a->{LABEL} =~ /^$rep_label/) {
+
+      # Repository labels
+      if ($b->{LABEL} =~ /^$rep_label/) {
+        $a->{LABEL} cmp $b->{LABEL} or $a->{VALUE} cmp $b->{VALUE};
+      } else {
+        -1;
+      }
+
+    } elsif ($a->{LABEL} =~ /^$ver_label/) {
+
+      # Version labels
+      if ($b->{LABEL} =~ /^$rep_label/) {
+        1;
+      } elsif ($b->{LABEL} =~ /^$ver_label/) {
+        $a->{LABEL} cmp $b->{LABEL} or $a->{VALUE} cmp $b->{VALUE};
+      } else {
+        -1;
+      }
+    } else {
+
+      # Source directories labels
+      if ($b->{LABEL} =~ /^(?:$rep_label|$ver_label)/) {
+        1;
+      } else {
+        $a->{LABEL} cmp $b->{LABEL} or $a->{VALUE} cmp $b->{VALUE};
+      }
+
+    }
+  } @lines;
+
+  # Add lines for specifying repository, version and source directories
+  while (my $line = shift @lines) {
+    $cfg->add_line (
+      LABEL => $line->{LABEL},
+      VALUE => $line->{VALUE},
+    );
+  }
+
+  # Add declared bld cfg entries
+  if (@{ $self->{BDECLARE} }) {
+    # Blank line
+    $cfg->add_line;
+
+    $cfg->add_comment_block ('Declared bld cfg entries');
+    for my $bdeclare (@{ $self->{BDECLARE} }) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{BDECLARE} . '::' . $bdeclare->{LABEL},
+        VALUE => $bdeclare->{VALUE},
+      );
+    }
+  }
+
+  # Print lines to config file
+  $cfg->print_cfg ($self->{DEST}{EXT_CFG});
+
+  return 1;
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_write_bld_cfg ();
+#
+# DESCRIPTION
+#   This internal method writes the build configuration file.
+# ------------------------------------------------------------------------------
+
+sub _write_bld_cfg {
+  my $self = shift;
+
+  my %cfg_labels = %{ $self->config->setting ('CFG_LABEL') };
+  my %subdir     = %{ $self->config->setting ('DIR') };
+  my %cfgname    = %{ $self->config->setting ('CFG_NAME') };
+
+  # Create new config file object and assign lines to it
+  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, TYPE => 'bld');
+
+  # Set up config file header
+  $cfg->add_header ();
+
+  # Pre-compile source
+  if (@{ $self->{USE} }) {
+    $cfg->add_comment_block ('Pre-compile source');
+
+    for my $reuse (@{ $self->{USE} }) {
+      my $rootdir;
+      my $bld_cfg;
+
+      if ($self->{RDEST}{MACHINE}) {
+        $rootdir = $reuse->rdest ('ROOTDIR');
+        $bld_cfg = $reuse->rdest ('BLD_CFG');
+      } else {
+        $rootdir = $reuse->dest ('ROOTDIR');
+        $bld_cfg = $reuse->dest ('BLD_CFG');
+      }
+
+      # Default location of build config file
+      my $def_bld_cfg = catfile $rootdir, $subdir{CFG}, $cfgname{BLD};
+
+      $cfg->add_line (
+        LABEL => $cfg_labels{USE},
+        VALUE => $bld_cfg eq $def_bld_cfg ? $rootdir : $bld_cfg,
+      );
+    }
+
+    # Blank line
+    $cfg->add_line;
+  }
+
+  # Add declared bld cfg entries
+  if (@{ $self->{BDECLARE} }) {
+    $cfg->add_comment_block ('Declared build options...');
+
+    my @bdeclares = sort {$a->{LABEL} cmp $b->{LABEL}} @{ $self->{BDECLARE} };
+    for my $bdeclare (@bdeclares) {
+      $cfg->add_line (
+        LABEL => $bdeclare->{LABEL},
+        VALUE => $bdeclare->{VALUE},
+      );
+    }
+
+    # Blank line
+    $cfg->add_line;
+  }
+
+  # Add source directories to config file
+  $cfg->add_comment_block ('Project directory tree');
+
+  my $dest = $self->{RDEST}{MACHINE} ? $self->{RDEST} : $self->{DEST};
+  $cfg->add_line (
+    LABEL => $cfg_labels{DIR} . '::ROOT',
+    VALUE => $dest->{ROOTDIR},
+  );
+  for my $label (qw/SRC CFG/) {
+    my $dir = $label . 'DIR';
+    if ($dest->{$dir} ne catfile $dest->{ROOTDIR}, $subdir{$label}) {
+      $cfg->add_line (
+        LABEL => $cfg_labels{DIR} . '::' . $label,
+        VALUE => $dest->{$dir},
+      );
+    }
+  }
+
+  # Blank line
+  $cfg->add_line;
+
+  # Add source directories to config file
+  $cfg->add_comment_block ('Source directories');
+
+  $cfg->add_line (LABEL => $cfg_labels{SEARCH_SRC}, VALUE => '0',);
+  $cfg->add_line;
+
+  for my $srcdir (sort keys %{ $self->{SRCDIRS} }) {
+
+    if (-d $self->{SRCDIRS}{$srcdir}{DEST}) {
+      # Check whether pre-extracted source exists
+      my $pre_extracted = grep {
+        $_->extracted;
+      } @{ $self->{SRCDIRS}{$srcdir}{STACK} };
+
+      # Source directory
+      my $dest = undef;
+      if ($self->{RDEST}{MACHINE}) {
+        my $base = substr $self->{SRCDIRS}{$srcdir}{DEST},
+                          length ($self->{DEST}{SRCDIR}) + 1;
+        $dest    = catfile $self->{RDEST}{SRCDIR}, $base;
+      } else {
+        $dest = $self->{SRCDIRS}{$srcdir}{DEST}
+      }
+
+      # Source directory label
+      my $label = join '::', ($cfg_labels{SRCDIR}, $srcdir);
+
+      $cfg->add_line (LABEL => $label, VALUE => $dest,)
+    }
+
+  }
+
+  # Print lines to config file
+  $cfg->print_cfg ($self->{DEST}{BLD_CFG});
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_mirror_extract ();
+#
+# DESCRIPTION
+#   This internal method mirrors the current extract to a remote machine.
+# ------------------------------------------------------------------------------
+
+sub _mirror_extract {
+  my $self = shift;
+
+  # Needs mirroring only if remote machine is set
+  return unless $self->{RDEST}{MACHINE};
+
+  my $verbose = $self->config->verbose;
+
+  my $mirror = $self->config->setting (qw/TOOL MIRROR/);
+
+  if ($mirror eq 'rdist') {
+    # Use "rdist" to mirror extract
+
+    # Variable for "remote_logname@remote_machine"
+    my $rhost = $self->{RDEST}{LOGNAME} . '@' . $self->{RDEST}{MACHINE};
+
+    # Print distfile content to temporary file
+    my @distfile = ();
+    for my $my_label (qw/BLD_CFG EXT_CFG SRCDIR/) {
+      push @distfile, '( ' . $self->{DEST}{$my_label} . ' ) -> ' . $rhost . "\n";
+      push @distfile, '  install ' . $self->{RDEST}{$my_label} . ';' . "\n";
+    }
+
+    # Set up mirroring command (use "rdist" at the moment)
+    my $command = 'rdist -R';
+    $command   .= ' -q' unless $verbose > 1;
+    $command   .= ' -f - 1>/dev/null';
+
+    # Diagnostic
+    my $croak = 'Cannot execute "' . $command . '"';
+    if ($verbose > 2) {
+      print timestamp_command ($command, 'Start');
+      print '  ', $_ for (@distfile);
+    }
+
+    # Execute the mirroring command
+    open COMMAND, '|-', $command or croak $croak, ' (', $!, '), abort';
+    for my $line (@distfile) {
+      print COMMAND $line;
+    }
+    close COMMAND or croak $croak, ' (', $?, '), abort';
+
+    # Diagnostic
+    print timestamp_command ($command, 'End  ') if $verbose > 2;
+
+  } elsif ($mirror eq 'rsync') {
+    # Use "rsync" to mirror extract
+
+    my $rsh = $self->config->setting (qw/TOOL REMOTE_SHELL/);
+
+    # Variable for "remote_logname@remote_machine"
+    my $rhost = $self->{RDEST}{LOGNAME} . '@' . $self->{RDEST}{MACHINE};
+
+    for my $my_label (qw/BLD_CFG EXT_CFG SRCDIR/) {
+      my $rdir = dirname $self->{RDEST}{$my_label}; # remote container directory
+
+      {
+        # Create remote container directory with remote shell command
+        my @command = (
+          $rsh, $self->{RDEST}{MACHINE}, '-n', '-l', $self->{RDEST}{LOGNAME},
+          qw/mkdir -p/, $rdir,
+        );
+
+        # Execute command
+        &run_command (\@command, TIME => $verbose > 2);
+      }
+
+      {
+        # Build the rsync command
+        my @command = qw/rsync -a --exclude='.*' --delete-excluded/;
+        push @command, '-v' if $verbose > 2;
+        push @command, $self->{DEST}{$my_label};
+        push @command, $rhost . ':' . $rdir;
+
+        # Execute command
+        &run_command (\@command, TIME => $verbose > 2);
+      }
+    }
+
+  } else {
+    w_report $mirror, ': unknown mirroring tool, abort.';
+    return;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/ReposBranch.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/ReposBranch.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/ReposBranch.pm	(revision 5166)
@@ -0,0 +1,516 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::ReposBranch
+#
+# DESCRIPTION
+#   This class contains methods for gathering information for a repository
+#   branch. It currently supports Subversion repository and local user
+#   directory.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::ReposBranch;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+use File::Spec::Functions;
+use File::Basename;
+use File::Find;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch = Fcm::ReposBranch->new (
+#     CONFIG  => $config,
+#     PACKAGE => $package,
+#     TAG     => $tag,
+#     REPOS   => $repos,
+#     VERSION => $version,
+#     TYPE    => $type,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::ReposBranch class.
+#
+# ARGUMENTS
+#   CONFIG  - reference to a Fcm::Config instance
+#   PACKAGE - package name of which this repository belongs
+#   TAG     - "tag" name of this branch of the repository
+#   REPOS   - repository branch root URL/path
+#   VERSION - this version of the branch is used by the extract
+#   TYPE    - repository type
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG  => (exists $args{CONFIG}  ? $args{CONFIG}  : &main::cfg),
+    PACKAGE => (exists $args{PACKAGE} ? $args{PACKAGE} : undef),
+    TAG     => (exists $args{TAG}     ? $args{TAG}     : undef),
+    REPOS   => (exists $args{REPOS}   ? $args{REPOS}   : undef),
+    VERSION => (exists $args{VERSION} ? $args{VERSION} : undef),
+    TYPE    => (exists $args{TYPE}    ? $args{TYPE}    : undef),
+
+    # Use this list of directories in this branch
+    DIRS    => {},
+
+    # Expand this list of directories in this branch
+    EXPDIRS => {},
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $branch->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package = $branch->package;
+#   $branch->package ($package);
+#
+# DESCRIPTION
+#   This method returns the package name of this repository branch. If an
+#   argument is specified, the name is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub package {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PACKAGE} = shift;
+  }
+
+  return $self->{PACKAGE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $tag = $branch->tag;
+#   $branch->tag ($tag);
+#
+# DESCRIPTION
+#   This method returns the tag name of this repository branch. If an
+#   argument is specified, the name is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub tag {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TAG} = shift;
+  }
+
+  return $self->{TAG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $repos = $branch->repos;
+#   $branch->repos ($repos);
+#
+# DESCRIPTION
+#   This method returns the URL/path name of this repository branch. If an
+#   argument is specified, the URL/path is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub repos {
+  my $self = shift;
+
+  if (@_) {
+    $self->{REPOS} = shift;
+  }
+
+  return $self->{REPOS};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version= $branch->version;
+#   $branch->version ($version);
+#
+# DESCRIPTION
+#   This method returns the revision number of this repository branch. If an
+#   argument is specified, the revision is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub version {
+  my $self = shift;
+
+  if (@_) {
+    $self->{VERSION} = shift;
+  }
+
+  return $self->{VERSION};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $branch->type;
+#   $branch->type ($type);
+#
+# DESCRIPTION
+#   This method returns the repository type ("svn" or "user"). If an
+#   argument is specified, the type is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub type {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TYPE} = shift;
+  }
+
+  return $self->{TYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $branch->dir ($name);
+#   $branch->dir ($name, $dir);
+#
+# DESCRIPTION
+#   This method returns the path to the source directory with sub-package name
+#   $name. If $dir is specified, the path is set to its value.
+# ------------------------------------------------------------------------------
+
+sub dir {
+  my $self = shift;
+  my $name = shift;
+
+  if (@_) {
+    $self->{DIRS}{$name} = $_[0];
+  }
+
+  if (exists $self->{DIRS}{$name}) {
+    return $self->{DIRS}{$name};
+
+  } else {
+    return undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %dirs = $branch->dirs;
+#
+# DESCRIPTION
+#   This method returns a hash containing the source directories of this
+#   repository. The keys of the hash are the sub-package names, and the values
+#   of the hash are the URL/path to the source directories.
+# ------------------------------------------------------------------------------
+
+sub dirs {
+  my $self = shift;
+
+  return %{ $self->{DIRS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $branch->expdir ($name);
+#   $branch->expdir ($name, $dir);
+#
+# DESCRIPTION
+#   This method returns the path to the expandable source directory with
+#   sub-package name $name. If $dir is specified, the path is set to its
+#   value.
+# ------------------------------------------------------------------------------
+
+sub expdir {
+  my $self = shift;
+  my $name = shift;
+
+  if (@_) {
+    $self->{EXPDIRS}{$name} = $_[0];
+  }
+
+  if (exists $self->{EXPDIRS}{$name}) {
+    return $self->{EXPDIRS}{$name};
+
+  } else {
+    return undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %dirs = $branch->expdirs;
+#
+# DESCRIPTION
+#   This method returns a hash containing the expandable source directories of
+#   this repository. The keys of the hash are the sub-package names, and the
+#   values of the hash are the URL/path to the expandable source directories.
+# ------------------------------------------------------------------------------
+
+sub expdirs {
+  my $self = shift;
+
+  return %{ $self->{EXPDIRS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch->expand_version_tag;
+#
+# DESCRIPTION
+#   This method expands the VERSION of the current repository branch to a
+#   revision number.
+# ------------------------------------------------------------------------------
+
+sub expand_version_tag {
+  my $self = shift;
+
+  if ($self->type eq 'svn') {
+    # Expand revision keyword
+    my $rev = expand_rev_keyword (
+      REV  => $self->version,
+      URL  => $self->repos,
+      HEAD => 1,
+    );
+
+    # Find out whether the specified revision is current or not
+    if (uc ($self->version) ne 'HEAD' and $self->config->verbose > 1) {
+      # Get last commit revision
+      my $lc_rev = expand_rev_keyword (
+        REV => 'HEAD',
+        URL => $self->repos,
+      );
+
+      # Print information if used rev is less than the last commit rev
+      print 'Info: using rev ', $rev, ' of ', $self->repos,
+            ', last commit rev is ', $lc_rev, ".\n"
+        if $rev < $lc_rev;
+    }
+
+    $self->version ($rev) if $rev ne $self->version;
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    e_report $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch->expand_path;
+#
+# DESCRIPTION
+#   This method expands the relative path names of sub-directories to full
+#   path names. It returns 1 on success.
+# ------------------------------------------------------------------------------
+
+sub expand_path {
+  my $self = shift;
+
+  my $separator = $self->{CONFIG}->setting (qw/MISC DIR_SEPARATOR/);
+
+  if ($self->type eq 'svn') {
+    # SVN repository
+    # Do nothing unless there is a declared repository for this branch
+    return unless $self->{REPOS};
+
+    # Remove trailing /
+    $self->{REPOS} =~ s/$separator+$//;
+
+    # Consider all declared (expandable) sub-directories
+    for my $name (qw/DIRS EXPDIRS/) {
+      for my $dir (keys %{ $self->{$name} }) {
+        # Do nothing if declared sub-directory is quoted as a full URL
+        next if &is_url ($self->{$name}{$dir});
+
+        # Expand sub-directory to full URL
+        $self->{$name}{$dir} = $self->{REPOS} . (
+          $self->{$name}{$dir} ? ($separator . $self->{$name}{$dir}) : ''
+        );
+      }
+    }
+    # Note: "catfile" cannot be used in the above statement because it has
+    #       the tendency of removing a slash from double slashes.
+
+  } elsif ($self->type eq 'user') {
+    # Local user directories
+
+    # Expand leading ~ for all declared (expandable) sub-directories
+    for my $name (qw/DIRS EXPDIRS/) {
+      for my $dir (keys %{ $self->{$name} }) {
+        $self->{$name}{$dir} = expand_tilde $self->{$name}{$dir};
+      }
+    }
+
+    # A top directory for the source is declared
+    if ($self->{REPOS}) {
+      # Expand leading ~ for the top directory
+      $self->{REPOS} = expand_tilde $self->{REPOS};
+
+      # Get the root directory of the file system
+      my $rootdir = File::Spec->rootdir ();
+
+      # Expand top directory to absolute path, if necessary
+      $self->{REPOS} = File::Spec->rel2abs ($self->{REPOS})
+        if $self->{REPOS} !~ m/^$rootdir/;
+
+      # Remove trailing /
+      $self->{REPOS} =~ s/$separator+$//;
+
+      # Consider all declared (expandable) sub-directories
+      for my $name (qw/DIRS EXPDIRS/) {
+        for my $dir (keys %{ $self->{$name} }) {
+          # Do nothing if declared sub-directory is quoted as a full path
+          next if $self->{$name}{$dir} =~ m#^$rootdir#;
+
+          # Expand sub-directory to full path
+          $self->{$name}{$dir} = $self->{$name}{$dir}
+                               ? catfile ($self->{REPOS}, $self->{$name}{$dir})
+                               : $self->{REPOS};
+        }
+      }
+    }
+
+  } else {
+    e_report $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch->expand_all;
+#
+# DESCRIPTION
+#   This method searches the expandable source directories recursively for
+#   source directories containing regular files. These sub-directories are
+#   then added to the source directory list. The method returns total number
+#   of sub-directories to be extracted from the current repository.
+# ------------------------------------------------------------------------------
+
+sub expand_all {
+  my $self = shift;
+
+  my %dirs = ();
+
+  # Directory separator for SVN repository
+  my $separator = $self->{CONFIG}->setting (qw/MISC DIR_SEPARATOR/);
+
+  if ($self->type eq 'user') {
+    for my $rootname (keys %{ $self->{EXPDIRS} }) {
+      my %subdirs = find_srcdir $self->{EXPDIRS}{$rootname}, $rootname, '::';
+
+      for my $key (keys %subdirs) {
+        $dirs{$key} = $subdirs{$key};
+      }
+    }
+
+  } elsif  ($self->type eq 'svn') {
+    for my $rootname (keys %{ $self->{EXPDIRS} }) {
+      # Execute the "svn ls -R" command
+      my @lines   = &run_command (
+        [qw/svn ls -R/, $self->{EXPDIRS}{$rootname} . '@' . $self->{VERSION}],
+        METHOD => 'qx', TIME => $self->config->verbose > 2,
+      );
+
+      # Get list of sub-directories containing source files
+      for my $line (@lines) {
+        chomp $line;
+        next if $line =~ /$separator$/;
+
+        my $dir = dirname $line;
+
+        my @pck = split /::/, $rootname;
+        push @pck, (File::Spec->splitdir ($dir)) unless $dir eq '.';
+        my $pck = join '::', @pck;
+
+        my $val = $self->{EXPDIRS}{$rootname};
+        $val   .= $separator . $dir unless $dir eq '.';
+
+        $dirs{$pck} = $val;
+      }
+    }
+
+  } else {
+    e_report $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+  }
+
+  for my $key (keys %dirs) {
+    $self->{DIRS}{$key} = $dirs{$key};
+  }
+
+  return scalar keys %dirs;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch->add_base_dirs ($base);
+#
+# DESCRIPTION
+#   Add a list of source directories to the current branch based on the set
+#   provided by $base, which must be a reference to a Fcm::ReposBranch
+#   instance. It returns the total number of used sub-directories in the
+#   current repositories.
+# ------------------------------------------------------------------------------
+
+sub add_base_dirs {
+  my $self = shift;
+  my $base = shift;
+
+  my %base_dirs = $base->dirs;
+
+  for my $key (keys %base_dirs) {
+    # Remove repository root from base directories
+    if ($base_dirs{$key} eq $base->repos) {
+      $base_dirs{$key} = '';
+
+    } else {
+      $base_dirs{$key} = substr $base_dirs{$key}, length ($base->repos) + 1;
+    }
+
+    # Append base directories to current repository root
+    $self->dir ($key, $base_dirs{$key}); 
+  }
+
+  # Expand relative path names of sub-directories
+  $self->expand_path;
+
+  return scalar keys %{ $self->{DIRS} };
+  
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcDirLayer.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcDirLayer.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcDirLayer.pm	(revision 5166)
@@ -0,0 +1,481 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::SrcDirLayer
+#
+# DESCRIPTION
+#   This class contains methods to manipulate the extract of a source
+#   directory from a branch of a (Subversion) repository.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::SrcDirLayer;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+use File::Spec::Functions;
+use File::Basename;
+use File::Path;
+use File::Compare;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $layer = Fcm::SrcDirLayer->new (
+#     CONFIG    => $config,
+#     NAME      => $dir,
+#     PACKAGE   => $package,
+#     TAG       => $tag,
+#     LOCATION  => $loc,
+#     REPOSROOT => $repos,
+#     VERSION   => $ver,
+#     TYPE      => $type,
+#     COMMIT    => $com,
+#     EXTRACTED => $ext,
+#     CACHEDIR  => $cac,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::SrcDirLayer class.
+#
+# ARGUMENTS
+#   CONFIG    - reference to a Fcm::Config instance
+#   NAME      - sub-package name of the source directory
+#   PACKAGE   - top level package name of which the current repository belongs
+#   TAG       - package/revision tag of the current repository branch
+#   LOCATION  - location of the source directory in the branch
+#   REPOSROOT - repository root URL
+#   VERSION   - revision of the repository branch
+#   TYPE      - type of the repository branch ("svn" or "user")
+#   COMMIT    - revision at which the source directory was changed
+#   EXTRACTED - is this branch already extracted?
+#   CACHEDIR  - cache directory for this directory branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG    => (exists $args{CONFIG}    ? $args{CONFIG}    : &main::cfg),
+    NAME      => (exists $args{NAME}      ? $args{NAME}      : undef),
+    PACKAGE   => (exists $args{PACKAGE}   ? $args{PACKAGE}   : undef),
+    TAG       => (exists $args{TAG}       ? $args{TAG}       : undef),
+    LOCATION  => (exists $args{LOCATION}  ? $args{LOCATION}  : undef),
+    REPOSROOT => (exists $args{REPOSROOT} ? $args{REPOSROOT} : undef),
+    VERSION   => (exists $args{VERSION}   ? $args{VERSION}   : undef),
+    TYPE      => (exists $args{TYPE}      ? $args{TYPE}      : undef),
+    COMMIT    => (exists $args{COMMIT}    ? $args{COMMIT}    : undef),
+    EXTRACTED => (exists $args{EXTRACTED} ? $args{EXTRACTED} : undef),
+    CACHEDIR  => (exists $args{CACHEDIR}  ? $args{CACHEDIR}  : undef),
+
+    # List of source files in this directory branch
+    FILES     => [],
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $layer->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $layer->name;
+#   $layer->name ($name);
+#
+# DESCRIPTION
+#   This method returns the sub-package name of the current source directory.
+#   If an argument is specified, the sub-package name is set to the value of
+#   the argument.
+# ------------------------------------------------------------------------------
+
+sub name {
+  my $self = shift;
+
+  if (@_) {
+    $self->{NAME} = shift;
+  }
+
+  return $self->{NAME};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package = $layer->package;
+#   $layer->package ($package);
+#
+# DESCRIPTION
+#   This method returns the top level package name in which the current source
+#   directory belongs. If an argument is specified, the package name is set to
+#   the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub package {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PACKAGE} = shift;
+  }
+
+  return $self->{PACKAGE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $tag = $layer->tag;
+#   $layer->tag ($tag);
+#
+# DESCRIPTION
+#   This method returns the branch/revision tag of the current repository
+#   branch. If an argument is specified, the tag is set to the value of the
+#   argument.
+# ------------------------------------------------------------------------------
+
+sub tag {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TAG} = shift;
+  }
+
+  return $self->{TAG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $location = $layer->location;
+#   $layer->location ($location);
+#
+# DESCRIPTION
+#   This method returns the URL/location of the source directory in the
+#   branch. If an argument is specified, the location is set to the value of
+#   the argument.
+# ------------------------------------------------------------------------------
+
+sub location {
+  my $self = shift;
+
+  if (@_) {
+    $self->{LOCATION} = shift;
+  }
+
+  return $self->{LOCATION};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $reposroot = $layer->reposroot;
+#   $layer->reposroot ($reposroot);
+#
+# DESCRIPTION
+#   This method returns the URL/location of the repository root of this
+#   branch. If an argument is specified, the location is set to the value of
+#   the argument.
+# ------------------------------------------------------------------------------
+
+sub reposroot {
+  my $self = shift;
+
+  if (@_) {
+    $self->{REPOSROOT} = shift;
+  }
+
+  return $self->{REPOSROOT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version = $layer->version;
+#   $layer->version ($version);
+#
+# DESCRIPTION
+#   This method returns the revision number of this branch. If an argument is
+#   specified, the revision number is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub version {
+  my $self = shift;
+
+  if (@_) {
+    $self->{VERSION} = shift;
+  }
+
+  return $self->{VERSION};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $layer->type;
+#   $layer->type ($type);
+#
+# DESCRIPTION
+#   This method returns the repository type ("svn" or "user"). If an argument is
+#   specified, the type is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub type {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TYPE} = shift;
+  }
+
+  return $self->{TYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version = $layer->commit;
+#   $layer->commit ($version);
+#
+# DESCRIPTION
+#   This method returns the last modified revision of the source directory in
+#   the branch. If an argument is specified, this revision is set to the value
+#   of the argument.
+# ------------------------------------------------------------------------------
+
+sub commit {
+  my $self = shift;
+
+  if (@_) {
+    $self->{COMMIT} = shift;
+  }
+
+  return $self->{COMMIT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $extracted = $layer->extracted;
+#   $layer->extracted ($extracted);
+#
+# DESCRIPTION
+#   This method returns the "extracted flag" of the source directory branch
+#   If an argument is specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub extracted {
+  my $self = shift;
+
+  if (@_) {
+    $self->{EXTRACTED} = shift;
+  }
+
+  return $self->{EXTRACTED};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $layer->cachedir;
+#   $layer->cachedir ($dir);
+#
+# DESCRIPTION
+#   This method returns the cache directory of the source directory branch
+#   If an argument is specified, the cache directory is set to the value of
+#   the argument.
+# ------------------------------------------------------------------------------
+
+sub cachedir {
+  my $self = shift;
+
+  if (@_) {
+    my $dir = shift;
+    $self->{CACHEDIR} = $dir;
+  }
+
+  return $self->{CACHEDIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $layer->localdir;
+#
+# DESCRIPTION
+#   This method returns the user or cache directory for the current revision
+#   of the repository branch.
+# ------------------------------------------------------------------------------
+
+sub localdir {
+  my $self = shift;
+
+  return $self->user ? $self->{LOCATION} : $self->{CACHEDIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @files = $layer->files;
+#
+# DESCRIPTION
+#   This method returns a list of regular files in this directory branch.
+#   This method should only be called after a successful operation of the
+#   get_files method that will be described below.
+# ------------------------------------------------------------------------------
+
+sub files {
+  my $self = shift;
+
+  return @{ $self->{FILES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $user = $layer->user;
+#
+# DESCRIPTION
+#   This method returns the string "user" if the current source directory
+#   branch is a local directory. Otherwise, it returns "undef".
+# ------------------------------------------------------------------------------
+
+sub user {
+  my $self = shift;
+
+  return $self->{TYPE} eq 'user' ? 'user' : undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $version = $layer->get_commit;
+#
+# DESCRIPTION
+#   If the current repository type is "svn", this method attempts to obtain
+#   the revision in which the branch is last committed. On a successful
+#   operation, it returns this revision number. Otherwise, it returns
+#   "undef".
+# ------------------------------------------------------------------------------
+
+sub get_commit {
+  my $self = shift;
+
+  if ($self->type eq 'svn') {
+    # Execute the "svn info" command
+    my @lines   = &run_command (
+      [qw/svn info/, $self->{LOCATION} . '@' . $self->{VERSION}],
+      METHOD => 'qx', TIME => $self->config->verbose > 2,
+    );
+
+    my $rev;
+    for (@lines) {
+      if (/^Last\s+Changed\s+Rev\s*:\s*(\d+)/i) {
+        $rev = $1;
+        last;
+      }
+    }
+
+    # Commit version of this source directory
+    $self->{COMMIT} = $rev;
+
+    return $self->{COMMIT};
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    e_report 'Repository type "', $self->type, '" not supported.';
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $layer->update_cache;
+#
+# DESCRIPTION
+#   If the current repository type is "svn", this method attempts to extract
+#   the current version source directory from the current branch from the
+#   repository, sending the output to the cache directory. It returns true on
+#   a successful operation, or false if the repository is not of type "svn".
+# ------------------------------------------------------------------------------
+
+sub update_cache {
+  my $self = shift;
+
+  return unless $self->{CACHEDIR};
+
+  # Create cache extract destination, if necessary
+  my $dirname = dirname $self->{CACHEDIR};
+  mkpath $dirname if not -d $dirname;
+
+  e_report $dirname, ': cannot write to cache, abort.'
+    unless -d $dirname and -w $dirname;
+  
+  if ($self->type eq 'svn') {
+    # Set up the extract command, "svn export --force -q -N"
+    my @command = (
+      qw/svn export --force -q -N/,
+      $self->{LOCATION} . '@' . $self->{VERSION},
+      $self->{CACHEDIR},
+    );
+
+    &run_command (\@command, TIME => $self->config->verbose > 2);
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    e_report 'Repository type "', $self->type, '" not supported.';
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @files = $layer->get_files;
+#
+# DESCRIPTION
+#   This method returns a list of files in the cache or local user directory
+#   of the current version of the source directory in the current branch.
+# ------------------------------------------------------------------------------
+
+sub get_files {
+  my $self = shift;
+
+  # Get a list of files in the cache (or local user) directory
+  my @files = ();
+
+  opendir (DIR, $self->localdir)
+    or die $self->localdir, ': cannot read directory';
+
+  while (my $file = readdir DIR) {
+    next if $file =~ /^\.\.?/;                   # ignore . and .. and hidden
+    next if $file =~ /~$/;                       # ignore emacs swap files
+    next if -d catfile ($self->localdir, $file); # ignore sub-directories
+    push @files, $file;
+  }
+  closedir DIR;
+
+  # Return the (base name) of the list of files
+  $self->{FILES} = \@files;
+  return @files;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcFile.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcFile.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcFile.pm	(revision 5166)
@@ -0,0 +1,1538 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::SrcFile
+#
+# DESCRIPTION
+#   This class contains methods to manipulate the build process of a source
+#   file of supported type.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::SrcFile;
+
+# Standard pragma
+
+use strict;
+use warnings;
+
+# Standard modules
+use Cwd;
+use Carp;
+use File::Basename;
+use File::Spec;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::Timer;
+
+# Other modules
+use Ecmwf::Fortran90_stuff ();
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcfile = Fcm::SrcFile->new (
+#     CONFIG     => $config,
+#     SRCPACKAGE => $srcpackage,
+#     SRC        => $src,
+#     PPSRC      => $ppsrc,
+#     TYPE       => $type,
+#     SCAN       => $scan,
+#     EXEBASE    => $exebase,
+#     PCKCFG     => $pckcfg,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::SrcFile class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   SRCPACKAGE - reference to the container Fcm::SrcPackage instance
+#   SRC        - source path of this file
+#   PPSRC      - pre-processed source path of this file
+#   TYPE       - type flag of this source file
+#   SCAN       - scan source file for dependency?
+#   EXEBASE    - name of executable
+#   PCKCFG     - this source file is modified by a package cfg?
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = {
+    CONFIG     => exists $args{CONFIG}     ? $args{CONFIG}     : &main::cfg,
+    SRCPACKAGE => exists $args{SRCPACKAGE} ? $args{SRCPACKAGE} : undef,
+    SRC        => exists $args{SRC}        ? $args{SRC}        : undef,
+    PPSRC      => exists $args{PPSRC}      ? $args{PPSRC}      : undef,
+    TYPE       => exists $args{TYPE}       ? $args{TYPE}       : undef,
+    SCAN       => exists $args{SCAN}       ? $args{SCAN}       : 1,
+    EXEBASE    => exists $args{EXEBASE}    ? $args{EXEBASE}    : undef,
+    PCKCFG     => exists $args{PCKCFG}     ? $args{PCKCFG}     : undef,
+
+    PROGNAME   => undef,
+    LANG       => undef,
+    DEP        => {}, 
+    RULES      => {},
+  };
+  bless $self, $class;
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $srcfile->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcpackage = $srcfile->srcpackage;
+#   $srcfile->srcpackage ($srcpackage);
+#
+# DESCRIPTION
+#   This method returns the reference to the container Fcm::SrcPackage of this
+#   source file. If an argument is specified, the reference is set to the
+#   value of the argument.
+# ------------------------------------------------------------------------------
+
+sub srcpackage {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SRCPACKAGE} = shift;
+  }
+
+  return $self->{SRCPACKAGE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $src = $srcfile->src;
+#   $srcfile->src ($src);
+#
+# DESCRIPTION
+#   This method returns the reference to the location of this source file. If
+#   an argument is specified, the location is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub src {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SRC} = shift;
+  }
+
+  return $self->{SRC};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ppsrc = $srcfile->ppsrc;
+#   $srcfile->ppsrc ($ppsrc);
+#
+# DESCRIPTION
+#   This method returns the reference to the location of the pre-processed
+#   file of this source file. If an argument is specified, the location is set
+#   to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub ppsrc {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PPSRC} = shift;
+  }
+
+  return $self->{PPSRC};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $time = $srcfile->mtime;
+#
+# DESCRIPTION
+#   This method returns the last modified time of the source file. If a
+#   pre-processed version of the source file exists, it returns the last
+#   modified time of the pre-processed source file instead.
+# ------------------------------------------------------------------------------
+
+sub mtime {
+  my $self = shift;
+
+  return $self->{PPSRC} ? (stat $self->{PPSRC})[9] : (stat $self->{SRC})[9];
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $srcfile->base;
+#
+# DESCRIPTION
+#   This method returns the base name of the source file.
+# ------------------------------------------------------------------------------
+
+sub base {
+  my $self = shift;
+
+  return basename ($self->{SRC});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ppbase = $srcfile->ppbase;
+#
+# DESCRIPTION
+#   This method returns the base name of the pre-processed source file.
+# ------------------------------------------------------------------------------
+
+sub ppbase {
+  my $self = shift;
+
+  return basename ($self->{PPSRC});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $interfacebase = $srcfile->interfacebase;
+#
+# DESCRIPTION
+#   This method returns the base name of the F9X interface file.
+# ------------------------------------------------------------------------------
+
+sub interfacebase {
+  my $self   = shift;
+  my $return = undef;
+
+  if ($self->is_type_or (qw/FORTRAN FPP/) and
+      uc ($self->select_tool ('GENINTERFACE')) ne 'NONE' and
+      not $self->is_type_or (qw/PROGRAM MODULE/)) {
+
+    my $flag = lc ($self->select_tool ('INTERFACE'));
+    my $ext  = $self->config->setting (qw/OUTFILE_EXT INTERFACE/);
+
+    $return = ($flag eq 'program' ? $self->intname : $self->root) . $ext;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $root = $srcfile->root;
+#
+# DESCRIPTION
+#   This method returns the root name (i.e. base name without file extension)
+#   of the source file.
+# ------------------------------------------------------------------------------
+
+sub root {
+  my $self = shift;
+
+  (my $root = $self->base) =~ s/\.\w+$//;
+
+  return $root;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ext = $srcfile->ext;
+#
+# DESCRIPTION
+#   This method returns the file extension of the source file.
+# ------------------------------------------------------------------------------
+
+sub ext {
+  my $self = shift;
+
+  return substr $self->base, length ($self->root);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ppext = $srcfile->ppext;
+#
+# DESCRIPTION
+#   This method returns the file extension of the pre-processed source file.
+# ------------------------------------------------------------------------------
+
+sub ppext {
+  my $self = shift;
+
+  return substr $self->ppbase, length ($self->root);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $srcfile->dir;
+#
+# DESCRIPTION
+#   This method returns the dir name of the source file.
+# ------------------------------------------------------------------------------
+
+sub dir {
+  my $self = shift;
+
+  return dirname ($self->{SRC});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ppdir = $srcfile->ppdir;
+#
+# DESCRIPTION
+#   This method returns the dir name of the pre-processed source file.
+# ------------------------------------------------------------------------------
+
+sub ppdir {
+  my $self = shift;
+
+  return dirname ($self->{PPSRC});
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $progname = $srcfile->progname();
+#   $srcfile->progname ($progname);
+#
+# DESCRIPTION
+#   This method returns the name of the first program unit in a Fortran source
+#   file. If an argument is specified, the name is set to the value of the
+#   argument.
+# ------------------------------------------------------------------------------
+
+sub progname {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PROGNAME} = $_[0];
+  }
+
+  return $self->{PROGNAME};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $intname = $srcfile->intname ();
+#
+# DESCRIPTION
+#   This method returns the internal name of the source file.
+# ------------------------------------------------------------------------------
+
+sub intname {
+  my $self = shift;
+
+  return $self->progname ? $self->progname : lc ($self->root);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $objbase = $srcfile->objbase ();
+#
+# DESCRIPTION
+#   If the source file contains a compilable procedure, this method returns
+#   the name of the object file.
+# ------------------------------------------------------------------------------
+
+sub objbase {
+  my $self   = shift;
+  my $return = undef;
+
+  if ($self->is_type ('SOURCE')) {
+    my $ext = $self->config->setting (qw/OUTFILE_EXT OBJ/);
+
+    if ($self->is_type_or (qw/FORTRAN FPP/)) {
+      $return = $self->progname . $ext if $self->progname;
+
+    } else {
+      $return = $self->intname . $ext;
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $donebase = $srcfile->donebase ();
+#
+# DESCRIPTION
+#   This method returns the DONE file for a source file containing a compilable
+#   procedure, or the IDONE file for an include file.
+# ------------------------------------------------------------------------------
+
+sub donebase {
+  my $self   = shift;
+  my $return = undef;
+
+  if ($self->is_type ('SOURCE')) {
+    if ($self->objbase and not $self->is_type ('PROGRAM')) {
+      $return = $self->intname . $self->config->setting (qw/OUTFILE_EXT DONE/);
+    }
+
+  } elsif ($self->is_type ('INCLUDE')) {
+    $return = $self->base . $self->config->setting (qw/OUTFILE_EXT IDONE/);
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $exebase = $srcfile->exebase ();
+#   $srcfile->exebase ($exebase);
+#
+# DESCRIPTION
+#   If the source file contains a compilable main program, this method returns
+#   the executable name. If an argument is specified, the executable name is
+#   set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub exebase {
+  my $self = shift;
+
+  if (@_) {
+    $self->{EXEBASE} = $_[0];
+  }
+
+  my $return;
+
+  if ($self->objbase and $self->is_type ('PROGRAM')) {
+    if ($self->config->setting ('EXE_NAME', $self->root)) {
+      $return = $self->config->setting ('EXE_NAME', $self->root);
+
+    } elsif ($self->{EXEBASE}) {
+      $return = $self->{EXEBASE};
+
+    } else {
+      $return = $self->root . $self->config->setting (qw/OUTFILE_EXT EXE/);
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $srcfile->flagsbase ([$flag]);
+#
+# DESCRIPTION
+#   If the source file contains a compilable program unit, it returns the base
+#   name of the compiler flags-file. If $flag is set, it returns the base name
+#   of the flags file as specified by $flag. The value of $flag can be:
+#     FLAGS   - compiler flags flags-file (default)
+#     PPKEYS  - pre-processor keys (i.e. macro definitions) flags-file
+#     LD      - linker flags-file
+#     LDFLAGS - linker flags flags-file
+# ------------------------------------------------------------------------------
+
+sub flagsbase {
+  my ($self, $flag) = @_;
+  $flag             = 'FLAGS' if not $flag;
+  my $return        = undef;
+
+  if ($self->is_type ('SOURCE')) {
+    if ($flag eq 'FLAGS' or $flag eq 'PPKEYS') {
+      my %src_tool = %{ $self->config->setting ('SRC_TOOL') };
+
+      if ($self->lang and exists $src_tool{$self->lang}{$flag}) {
+        $return = join ('__', (
+          $src_tool{$self->lang}{$flag}, $self->srcpackage->name, $self->root,
+        )) . $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+      }
+
+    } elsif ($self->is_type ('PROGRAM')) {
+      $return = join ('__', ($flag, $self->srcpackage->name, $self->root)) .
+                $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %dep   = $srcfile->dep;
+#   @files = $srcfile->dep ($type);
+#   $srcfile->dep (\%dep);
+#
+# DESCRIPTION
+#   This method returns the dependencies of this source file. If no argument
+#   is set, the method returns the dependency hash of this source file. The
+#   keys of the hash are the names of the files this source files depends on
+#   and the values of the hash are the dependency types of the corresponding
+#   files. If an argument is specified and the argument is a normal string,
+#   the method returns the keys of the dependency hash, which have their
+#   corresponding values equal to $type. If an argument is specified and the
+#   argument is a reference to a hash, the reference to the dependency hash of
+#   the current source file is re-set to point to the reference of this new
+#   hash.
+# ------------------------------------------------------------------------------
+
+sub dep {
+  my $self = shift;
+
+  if (@_) {
+    if (ref $_[0] eq 'HASH') {
+      $self->{DEP} = $_[0];
+
+    } else {
+      my $type = $_[0];
+      return grep {
+        $self->{DEP}{$_} eq $type;
+      } keys %{ $self->{DEP} };
+    }
+  }
+
+  return %{ $self->{DEP} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcfile->add_dep ($target, $type);
+#
+# DESCRIPTION
+#   This method adds (or modifies) a dependency to the dependency hash of the
+#   source file. The argument $type is the type of the dependency and the
+#   argument $target is the dependency target.
+# ------------------------------------------------------------------------------
+
+sub add_dep {
+  my $self = shift;
+  my ($target, $type) = @_;
+
+  $self->{DEP}{$target} = $type;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @pklist = $self->get_package_list ();
+#
+# DESCRIPTION
+#   This method returns a list of package names associated with this source
+#   file. The list begins with the top level container package to the
+#   sub-package name of the current source file.
+# ------------------------------------------------------------------------------
+
+sub get_package_list {
+  my $self = shift;
+
+  my @pknames = ();
+
+  my @packages = split /__/, $self->srcpackage->name;
+  push @packages, $self->root;
+
+  for my $i (0 .. $#packages) {
+    push @pknames, join ('__', (@packages[0 .. $i]));
+  }
+
+  return @pknames;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $pckcfg = $srcfile->pckcfg ();
+#   $srcfile->pckcfg ($pckcfg);
+#
+# DESCRIPTION
+#   This method returns the name of the flag to indicate whether this source
+#   file is modified by a package level configuration file. If an argument is
+#   specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub pckcfg {
+  my $self = shift;
+
+  if (@_) {
+    $self->{PCKCFG} = $_[0];
+  }
+
+  return $self->{PCKCFG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $srcfile->scan ();
+#   $srcfile->scan ($flag);
+#
+# DESCRIPTION
+#   This method returns the "scan" flag that determines whether the source
+#   file needs to be scanned for dependency. If an argument is specified, the
+#   flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub scan {
+  my $self = shift;
+
+  if (@_) {
+    $self->{SCAN} = $_[0];
+  }
+
+  return $self->{SCAN};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $srcfile->type;
+#   $srcfile->type ($type);
+#
+# DESCRIPTION
+#   This method returns the type flag of the source file. If an argument is
+#   specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub type {
+  my $self = shift;
+
+  if (@_) {
+    $self->{TYPE} = shift;
+  }
+
+  return $self->{TYPE};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $srcfile->is_type ($type1[, $type2, ...]);
+#
+# DESCRIPTION
+#   This method returns true if current file is a known type matching all the
+#   arguments.
+# ------------------------------------------------------------------------------
+
+sub is_type {
+  my $self    = shift;
+  my @intypes = @_;
+  my $rc      = 0;
+
+  if ($self->{TYPE}) {
+    my @types = split /::/, $self->{TYPE};
+
+    for my $intype (@intypes) {
+      $rc = grep {uc $_ eq uc $intype} @types;
+      last unless $rc;
+    }
+
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $srcfile->is_type_or ($type1[, $type2, ...]);
+#
+# DESCRIPTION
+#   This method returns true if current file is a known type matching any of
+#   the arguments.
+# ------------------------------------------------------------------------------
+
+sub is_type_or {
+  my $self    = shift;
+  my @intypes = @_;
+  my $rc      = 0;
+
+  if ($self->{TYPE}) {
+    my @types = split /::/, $self->{TYPE};
+
+    for my $intype (@intypes) {
+      $rc = grep {uc $_ eq uc $intype} @types;
+      last if $rc;
+    }
+
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $lang = $srcfile->lang ();
+#
+# DESCRIPTION
+#   This method returns the language name of the source file if it contains
+#   compilable source of a supported language.
+# ------------------------------------------------------------------------------
+
+sub lang {
+  my $self = shift;
+
+  if ((not $self->{LANG}) and $self->is_type ('SOURCE')) {
+    my %src_tool = %{ $self->config->setting ('SRC_TOOL') };
+
+    for my $key (keys %src_tool) {
+      if ($self->is_type ($key)) {
+        $self->{LANG} = $key;
+        last;
+      }
+    }
+  }
+
+  return $self->{LANG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $srcfile->determine_type;
+#
+# DESCRIPTION
+#   This method determines whether the source file is a type known to the
+#   build system. If so, it sets the "type" flag.
+# ------------------------------------------------------------------------------
+
+sub determine_type {
+  my $self = shift;
+
+  if (not $self->{TYPE}) {
+    # Do not set a type if the file name matches the "ignore" list
+    my @ignore = split /,/, $self->config->setting ('INFILE_IGNORE');
+
+    for (@ignore) {
+      return if $self->base eq $_;
+    }
+  }
+
+  if (not $self->{TYPE}) {
+    # Determine file type by comparing its extension with supported ones
+    my %known_ext = %{ $self->config->setting ('INFILE_EXT') };
+    my $ext       = $self->ext ? substr ($self->ext, 1) : 0;
+    $self->{TYPE} = $known_ext{$ext} if $ext and exists $known_ext{$ext};
+  }
+
+  if (not $self->{TYPE}) {
+    # Determine file type by comparing its name with known patterns
+    my %known_pat = %{ $self->config->setting ('INFILE_PAT') };
+    for my $pat (keys %known_pat) {
+      if ($self->base =~ /$pat/) {
+        $self->{TYPE} = $known_pat{$pat};
+        last;
+      }
+    }
+  }
+
+  if (-s $self->{SRC} and -T $self->{SRC} and not $self->{TYPE}) {
+    # Determine file type by inspecting its first line (text file only)
+    if (open SRC, '<', $self->{SRC}) {
+      my $line = <SRC>;
+      close SRC;
+
+      my %known_txt = %{ $self->config->setting ('INFILE_TXT') };
+      for my $txt (keys %known_txt) {
+        if ($line =~ /^#!.*$txt/) {
+          $self->{TYPE} = $known_txt{$txt};
+          last;
+        }
+      }
+    }
+  }
+
+  if ($self->is_type_or (qw/FORTRAN FPP/)) {
+    # Determine whether source file is a main Fortran program or module
+    if (open SRC, '<', $self->{SRC}) {
+      while (my $line = <SRC>) {
+        if ($line =~ /^\s*(PROGRAM|MODULE)\b/i) {
+          $self->{TYPE} = $self->{TYPE} . '::' . uc ($1);
+          last;
+
+        } elsif ($line =~ /^\s*BLOCK\s*DATA\b/i) {
+          $self->{TYPE} = $self->{TYPE} . '::' . 'BLOCKDATA';
+          last;
+        }
+      }
+      close SRC;
+    }
+
+  } elsif ($self->is_type (qw/C/)) {
+    # Determine whether source file is a main C program
+    if (open SRC, '<', $self->{SRC}) {
+      while (my $line = <SRC>) {
+        next unless $line =~ /int\s*main\s*\(/i;
+        $self->{TYPE} = $self->{TYPE} . '::PROGRAM';
+        last;
+      }
+      close SRC;
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @pp_src = @{ $srcfile->pre_process () };
+#
+# DESCRIPTION
+#   This method invokes the pre-processor on the source file. It returns a
+#   reference to an array containing the lines of the pre-processed source if
+#   the pre-processor command succeeded.
+# ------------------------------------------------------------------------------
+
+sub pre_process {
+  my $self = shift;
+
+  # Support only Fortran and C source files
+  return unless $self->is_type_or (qw/FPP C/);
+
+  # List of include directories
+  my @inc = @{ $self->config->setting (qw/PATH INC/) };
+
+  # Build the pre-processor command according to file type
+  my $name    = $self->is_type ('FPP') ? 'FPP' : 'CPP';
+  my %tool    = %{ $self->config->setting ('TOOL') };
+
+  # The pre-processor command and its options
+  my @command = ($tool{$name});
+  my @ppflags = split /\s+/, $self->select_tool ($name . 'FLAGS');
+
+  # List of defined macros, add "-D" in front of each macro
+  my @ppkeys  = split /\s+/, $self->select_tool ($name . 'KEYS');
+  @ppkeys     = map {($tool{$name . '_DEFINE' }. $_)} @ppkeys;
+
+  # Add "-I" in front of each include directories
+  @inc        = map {($tool{$name . '_INCLUDE'}. $_)} @inc;
+
+  push @command, (@ppflags, @ppkeys, @inc, $self->base);
+
+  my $verbose = $self->config->verbose;
+  my $cwd     = cwd;
+
+  # Change to container directory of source file
+  print 'cd ', $self->dir, "\n" if $verbose > 1;
+  chdir $self->dir;
+
+  # Execute the command, getting the output lines
+  my @outlines = &run_command (
+    \@command, METHOD => 'qx', PRINT => $verbose > 1, TIME => $verbose > 2,
+  );
+
+  # Change back to original directory
+  print 'cd ', $cwd, "\n" if $self->config->verbose > 1;
+  chdir $cwd;
+
+  return \@outlines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @interface_block = @{ $srcfile->gen_interface () };
+#
+# DESCRIPTION
+#   This method invokes the Fortran 9x interface block generator to generate
+#   an interface block for the current source file. It returns a reference to
+#   an array containing the lines of the interface block.
+# ------------------------------------------------------------------------------
+
+sub gen_interface {
+  my $self = shift;
+
+  my $generator = $self->select_tool ('GENINTERFACE');
+
+  my $src      = $self->{PPSRC} ? $self->{PPSRC} : $self->{SRC};
+  my @outlines = ();
+
+  if ($generator eq 'f90aib') {
+    # Use F90AIB
+
+    # Open pipeline to interface file generator and read its output
+    my $devnull = File::Spec->devnull;
+    my $command = $generator;
+    $command   .= " <'" . $src . "'" . " 2>'" . $devnull . "'";
+    my $croak   = $command . ' failed';
+
+    print timestamp_command ($command, 'Start') if $self->config->verbose > 2;
+    open COMMAND, '-|', $command or croak $croak, ' (', $!, '), abort';
+    @outlines = readline 'COMMAND';
+    close COMMAND or croak $croak, ' (', $?, '), abort';
+    print timestamp_command ($command, 'End  ') if $self->config->verbose > 2;
+
+  } elsif ($generator eq 'ECMWF') {
+    # Use ECMWF interface generator
+  
+    # Read source file into an array
+    open FILE, '<', $src or croak 'Cannot open "', $src, '" (', $!, '), abort';
+    my @src_lines = <FILE>;
+    close FILE;
+  
+    # Process standalone subroutines and functions only
+    if (not grep /^\s*(?:program|module)\b/i, @src_lines) {
+      print timestamp_command ('Analyse: ' . $self->src, 'Start')
+        if $self->config->verbose > 2;
+
+      my @statements = ();
+      my %prog_info  = ();
+  
+      # Set name of source file
+      &Ecmwf::Fortran90_stuff::fname ($src);
+  
+      # Parse lines in source
+      &Ecmwf::Fortran90_stuff::setup_parse ();
+
+      # Expand continuation lines in source
+      &Ecmwf::Fortran90_stuff::expcont (\@src_lines, \@statements);
+  
+      # Analyse statements in source
+      $Ecmwf::Fortran90_stuff::study_called = 0;
+      &Ecmwf::Fortran90_stuff::study (\@statements, \%prog_info);
+  
+      # Source code is not a module
+      if (not $prog_info{is_module}) {
+        my @interface_block = ();
+        my @line_hash       = ();
+  
+        # Create an interface block for the program unit
+        &Ecmwf::Fortran90_stuff::create_interface_block (
+          \@statements,
+          \@interface_block,
+        );
+
+        # Put continuation lines back
+        &Ecmwf::Fortran90_stuff::cont_lines (
+          \@interface_block,
+          \@outlines,
+          \@line_hash,
+        );
+      }
+
+      print timestamp_command ('Analyse: ' . $self->src, 'End')
+        if $self->config->verbose > 2;
+    }
+
+  } elsif (uc ($generator) eq 'NONE') {
+    print $self->root, ': interface generation is switched off', "\n"
+      if $self->config->verbose > 2;
+
+  } else {
+    e_report 'Error: Unknown Fortran 9x interface generator: ', $generator, '.';
+  }
+
+  return \@outlines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $tool = $self->select_tool ($name);
+#
+# DESCRIPTION
+#   This method selects the correct "tool" for the current source file by
+#   following the name of its container package. The argument $name must be
+#   the generic name of the "tool" to be selected. The method returns the
+#   value of the selected tool.
+# ------------------------------------------------------------------------------
+
+sub select_tool {
+  my $self  = shift;
+  my $name  = shift;
+
+  return undef unless $name;
+
+  my @pknames = $self->get_package_list ();
+
+  my %tool    = %{ $self->config->setting ('TOOL') };
+
+  for my $pkname (reverse @pknames) {
+    my $cur_name = join '__', ($name, $pkname);
+    return $tool{$cur_name} if exists $tool{$cur_name};
+  }
+
+  return exists $tool{$name} ? $tool{$name} : '';
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $srcfile->scan_dependency ();
+#   $rc = $srcfile->scan_dependency (HEADER_ONLY => 1);
+#
+# DESCRIPTION
+#   This method scans the source file for dependencies. If no argument is
+#   specified, the method scans the pre-processed source file if it exists.
+#   Otherwise, the original source file is scanned. If HEADER_ONLY is
+#   specified, only pre-processing header dependencies are scanned from the
+#   source file. (The HEADER_ONLY flag should only be specified if "ppsrc" is
+#   not already specified.) This method returns the number of 1 on success.
+# ------------------------------------------------------------------------------
+
+sub scan_dependency {
+  my $self = shift;
+  my %args = @_;
+
+  my $header_only = exists $args{HEADER_ONLY} ? $args{HEADER_ONLY} : 0;
+
+  return 0 unless $self->{SCAN};
+  return 0 unless $self->{TYPE};
+
+  my $src = $self->{PPSRC} ? $self->{PPSRC} : $self->{SRC};
+  return 0 unless $src;
+
+  # Determine what dependencies are supported by this known type
+  my %types = $header_only
+              ? %{ $self->config->setting ('PP_DEP_TYPE') }
+              : %{ $self->config->setting ('DEP_TYPE') };
+
+  # List of excluded dependencies
+  my %excl_dep = %{ $self->config->setting ('EXCL_DEP') };
+
+  # Package list
+  my @pknames = $self->get_package_list ();
+
+  my @depends = ();
+  for my $key (keys %types) {
+    # Check if current file is a type of file requiring dependency scan
+    next unless $self->is_type ($key);
+    
+    # Get list of dependency type for this file
+    DEPEND: for my $depend ((split /::/, $types{$key})) {
+      # Ignore a dependency type if the dependency is in the exclude list
+      if (exists $excl_dep{$depend}) {
+        # Global exclude
+        next DEPEND if exists $excl_dep{$depend}{''};
+
+        # Sub-package exclude
+        for my $pkname (@pknames) {
+          next DEPEND if exists $excl_dep{$depend}{$pkname};
+        }
+      }
+
+      # Add to dependency list for current file
+      push @depends, $depend;
+    }
+  }
+
+  # Scan dependencies, if necessary ...
+  if (@depends) {
+    # Print diagnostic
+    print timestamp_command ('scan dependency in file: ' . $src, 'Start')
+      if $self->config->verbose > 2;
+
+    open FILE, '<', $src or croak 'Cannot open "', $src, '" (', $!, ')';
+    my @lines = readline 'FILE';
+    close FILE;
+
+    # List of dependency patterns
+    my %dep_pattern = %{ $self->config->setting ('DEP_PATTERN') };
+
+    LINE: for my $line (@lines) {
+      # Ignore empty lines
+      next LINE if $line =~ /^\s*$/;
+
+      # Fortran source, also scan for program unit name
+      if (! $header_only and ! $self->progname) {
+        if ($self->is_type ('SOURCE') and $self->is_type_or (qw/FPP FORTRAN/)) {
+          my $pfx_pttn = '(?:(?:ELEMENTAL|(?:RECURSIVE(?:\s+PURE)?|' .
+                         'PURE(?:\s+RECURSIVE)?))\s+)?';
+          my $spc_pttn = '(?:(?:CHARACTER|COMPLEX|DOUBLE\s*PRECISION|INTEGER|' .
+                         'LOGICAL|REAL|TYPE)(?:\s*\(.+\)|\s*\*\d+\s*)??\s+)?';
+
+          if ($line =~ /^\s*PROGRAM\s+(\w+)/i) {
+            # Matches the beginning of a named main program
+            $self->progname (lc $1);
+            next LINE;
+
+          } elsif ($line =~ /^\s*MODULE\s+(\w+)/i) {
+            my $keyword = $1;
+
+            if (uc ($keyword) ne 'PROCEDURE') {
+              # Matches the beginning of a module
+              $self->progname (lc $keyword);
+              next LINE;
+            }
+
+          } elsif ($line =~ /^\s*BLOCK\s*DATA\s+(\w+)/i) {
+            # Matches the beginning of a named block data program unit
+            $self->progname (lc $1);
+            next LINE;
+
+          } elsif ($line =~ /^\s*$pfx_pttn SUBROUTINE\s+(\w+)/ix) {
+            # Matches the beginning of a subroutine
+            $self->progname (lc $1);
+            next LINE;
+
+          } elsif ($line =~ /^\s*$pfx_pttn $spc_pttn FUNCTION\s+(\w+)/ix) {
+            # Matches the beginning of a function
+            $self->progname (lc $1);
+            next LINE;
+          }
+        }
+      }
+
+      # Scan known dependencies
+      for my $depend (@depends) {
+        # Check if a pattern exists for the current dependency
+        next unless exists $dep_pattern{$depend};
+
+        # Attempt to match the pattern
+        my $pattern = $dep_pattern{$depend};
+
+        if ($line =~ /$pattern/i) {
+          my $match = $1;
+
+          # $match may contain multiple items delimited by space
+          NAME: for my $name (split /\s+/, $match) {
+            # Skip dependency if it is in the exclusion list
+            my $key = uc ($depend . '::' . $name);
+
+            if (exists $excl_dep{$key}) {
+              # Exclude this dependency, in the global list
+              next NAME if exists $excl_dep{$key}{''};
+
+              # Exclude this dependency, current sub-package
+              for my $pkname (@pknames) {
+                next NAME if exists $excl_dep{$key}{$pkname};
+              }
+            }
+
+            # Add this dependency to the list
+            $self->add_dep ($name, $depend);
+          }
+
+          next LINE;
+        }
+      }
+    }
+
+    # Diagnostic messages
+    if ($self->config->verbose > 2) {
+      my $base = $self->ppsrc ? $self->ppbase : $self->base;
+
+      print $self->srcpackage->name, ': ', $base;
+      print ': scanned ', scalar (@lines), ' lines for ';
+      print 'header ' if $header_only;
+      print 'dependencies: ', scalar (keys %{ $self->{DEP} }), "\n";
+      print timestamp_command ('scan dependency in file: ' . $src, 'End');
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %rules = $srcfile->required_rules ();
+#
+# DESCRIPTION
+#   This method returns a hash in the following format:
+#     %rules = (
+#       target => {ACTION => action, DEP => [dependencies], ...},
+#       ...    => {...},
+#     );
+#   where the 1st rank keys are the available targets for building this source
+#   file, the second rank keys are ACTION and DEP. The value of ACTION is the
+#   action for building the target, which can be "COMPILE", "LOAD", "TOUCH",
+#   "CP" or "AR". The value of DEP is a refernce to an array containing a list
+#   of dependencies suitable for insertion into the Makefile.
+# ------------------------------------------------------------------------------
+
+sub required_rules {
+  my $self = shift;
+
+  if (not keys %{ $self->{RULES} }) {
+    my %outfile_ext = %{ $self->config->setting ('OUTFILE_EXT') };
+
+    if ($self->is_type (qw/SOURCE/)) {
+      # Source file
+      # ------------------------------------------------------------------------
+      # Determine the whether the language of the source file is supported
+      my %src_tool = %{ $self->config->setting ('SRC_TOOL') };
+
+      return () unless $self->lang;
+
+      # Compile object
+      # ------------------------------------------------------------------------
+      if ($self->objbase) {
+        # Depends on the source file
+        my @dep = ($self->_makerule_srcfile);
+
+        # Depends on the compiler flags flags-file
+        my @flags;
+        push @flags, ('FLAGS' )
+          if $self->flagsbase ('FLAGS' );
+        push @flags, ('PPKEYS')
+          if $self->flagsbase ('PPKEYS') and not $self->ppsrc;
+
+        push @dep, $self->flagsbase ($_) for (@flags);
+
+        # Source file dependencies
+        for my $name (sort keys %{ $self->{DEP} }) {
+          # A Fortran 9X module, lower case object file name
+          if ($self->{DEP}{$name} eq 'USE') {
+            (my $root = $name) =~ s/\.\w+$//;
+            push @dep, lc ($root) . $outfile_ext{OBJ};
+
+          # An include file
+          } elsif ($self->{DEP}{$name} =~ /^(?:INC|H|INTERFACE)$/) {
+            push @dep, $name;
+          }
+        }
+
+        $self->{RULES}{$self->objbase} = {ACTION => 'COMPILE', DEP => \@dep};
+
+        # Touch flags-files
+        # ----------------------------------------------------------------------
+        for my $flag (@flags) {
+          next unless $self->flagsbase ($flag);
+
+          $self->{RULES}{$self->flagsbase ($flag)} = {
+            ACTION => 'TOUCH',
+            DEP    => [
+              $self->srcpackage->flagsbase ($src_tool{$self->lang}{$flag}),
+            ],
+            DEST   => '$(FCM_FLAGSDIR)',
+          };
+        }
+      }
+
+      if ($self->exebase) {
+        # Link into an executable
+        # ----------------------------------------------------------------------
+        my @dep = ();
+        push @dep, $self->objbase               if $self->objbase;
+        push @dep, $self->flagsbase ('LD'     ) if $self->flagsbase ('LD'     );
+        push @dep, $self->flagsbase ('LDFLAGS') if $self->flagsbase ('LDFLAGS');
+
+        # Depends on BLOCKDATA program units, for Fortran programs
+        my %blockdata = %{ $self->config->setting ('BLOCKDATA') };
+        my @blkobj    = ();
+
+        if ($self->is_type_or (qw/FPP FORTRAN/) and keys %blockdata) {
+          # List of BLOCKDATA object files
+          if (exists $blockdata{$self->exebase}) {
+            @blkobj = keys (%{ $blockdata{$self->exebase} });
+
+          } elsif (exists $blockdata{''}) {
+            @blkobj = keys (%{ $blockdata{''} });
+          }
+
+          for my $name (@blkobj) {
+            (my $root = $name) =~ s/\.\w+$//;
+            $name = $root . $outfile_ext{OBJ};
+            push @dep, $root . $outfile_ext{DONE};
+          }
+        }
+
+        # Extra executable dependencies
+        my %exe_dep = %{ $self->config->setting ('EXE_DEP') };
+        if (keys %exe_dep) {
+          my @exe_deps;
+          if (exists $exe_dep{$self->exebase}) {
+            @exe_deps = keys (%{ $exe_dep{$self->exebase} });
+
+          } elsif (exists $exe_dep{''}) {
+            @exe_deps = keys (%{ $exe_dep{''} });
+          }
+
+          my $pattern = '\\' . $outfile_ext{OBJ} . '$';
+
+          for my $name (@exe_deps) {
+            if ($name =~ /$pattern/) {
+              # Extra dependency is an object
+              (my $root = $name) =~ s/\.\w+$//;
+              push @dep, $root . $outfile_ext{DONE};
+
+            } else {
+              # Extra dependency is a sub-package
+              my $var;
+              if ($self->config->setting ('FCM_PCK_OBJECTS', $name)) {
+                # sub-package name contains unusual characters
+                $var = $self->config->setting ('FCM_PCK_OBJECTS', $name);
+
+              } else {
+                # sub-package name contains normal characters
+                $var = $name ? join ('__', ('OBJECTS', $name)) : 'OBJECTS';
+              }
+
+              push @dep, '$(' . $var . ')';
+            }
+          }
+        }
+
+        # Source file dependencies
+        for my $name (sort keys %{ $self->{DEP} }) {
+          (my $root = $name) =~ s/\.\w+$//;
+
+          # Lowercase name for object dependency
+          $root = lc ($root) unless $self->{DEP}{$name} =~ /^(?:INC|H)$/;
+
+          # Select "done" file extension
+          if ($self->{DEP}{$name} =~ /^(?:INC|H)$/) {
+            push @dep, $name . $outfile_ext{IDONE};
+
+          } else {
+            push @dep, $root . $outfile_ext{DONE};
+          }
+        }
+
+        $self->{RULES}{$self->exebase} = {
+          ACTION => 'LOAD', DEP => \@dep, BLOCKDATA => \@blkobj,
+        };
+
+        # Touch Linker flags-file
+        # ----------------------------------------------------------------------
+        for my $flag (qw/LD LDFLAGS/) {
+          $self->{RULES}{$self->flagsbase ($flag)} = {
+            ACTION => 'TOUCH',
+            DEP    => [$self->srcpackage->flagsbase ($flag)],
+            DEST   => '$(FCM_FLAGSDIR)',
+          };
+        }
+
+      }
+
+      if ($self->donebase) {
+        # Touch done file
+        # ----------------------------------------------------------------------
+        my @dep = ($self->objbase);
+
+        for my $name (sort keys %{ $self->{DEP} }) {
+          (my $root = $name) =~ s/\.\w+$//;
+
+          # Lowercase name for object dependency
+          $root = lc ($root) unless $self->{DEP}{$name} =~ /^(?:INC|H)$/;
+
+          # Select "done" file extension
+          if ($self->{DEP}{$name} =~ /^(?:INC|H)$/) {
+            push @dep, $name . $outfile_ext{IDONE};
+
+          } else {
+            push @dep, $root . $outfile_ext{DONE};
+          }
+        }
+
+        $self->{RULES}{$self->donebase} = {
+          ACTION => 'TOUCH', DEP => \@dep, DEST => '$(FCM_DONEDIR)',
+        };
+      }
+      
+      if ($self->interfacebase) {
+        # Interface target
+        # ----------------------------------------------------------------------
+        # Source file dependencies
+        my @dep = ();
+        for my $name (sort keys %{ $self->{DEP} }) {
+          # Depends on Fortran 9X modules
+          push @dep, lc ($name) . $outfile_ext{OBJ}
+            if $self->{DEP}{$name} eq 'USE';
+        }
+
+        $self->{RULES}{$self->interfacebase} = {DEP => \@dep};
+      }
+
+    } elsif ($self->is_type ('INCLUDE')) {
+      # Copy include target
+      # ------------------------------------------------------------------------
+      my @dep = ($self->_makerule_srcfile);
+
+      for my $name (sort keys %{ $self->{DEP} }) {
+        # A Fortran 9X module, lower case object file name
+        if ($self->{DEP}{$name} eq 'USE') {
+          (my $root = $name) =~ s/\.\w+$//;
+          push @dep, lc ($root) . $outfile_ext{OBJ};
+
+        # An include file
+        } elsif ($self->{DEP}{$name} =~ /^(?:INC|H|INTERFACE)$/) {
+          push @dep, $name;
+        }
+      }
+
+      $self->{RULES}{$self->base} = {
+        ACTION => 'CP', DEP => \@dep, DEST => '$(FCM_INCDIR)',
+      };
+
+      # Touch IDONE file
+      # ------------------------------------------------------------------------
+      if ($self->donebase) {
+        my @dep = ($self->_makerule_srcfile);
+
+        for my $name (sort keys %{ $self->{DEP} }) {
+          (my $root = $name) =~ s/\.\w+$//;
+
+          # Lowercase name for object dependency
+          $root   = lc ($root) unless $self->{DEP}{$name} =~ /^(?:INC|H)$/;
+
+          # Select "done" file extension
+          if ($self->{DEP}{$name} =~ /^(?:INC|H)$/) {
+            push @dep, $name . $outfile_ext{IDONE};
+
+          } else {
+            push @dep, $root . $outfile_ext{DONE};
+          }
+        }
+
+        $self->{RULES}{$self->donebase} = {
+          ACTION => 'TOUCH', DEP => \@dep, DEST => '$(FCM_DONEDIR)',
+        };
+      }
+
+    } elsif ($self->is_type_or (qw/EXE SCRIPT/)) {
+      # Copy executable file
+      # ------------------------------------------------------------------------
+      my @dep = ($self->_makerule_srcfile);
+
+      # Depends on dummy copy file, if file is an "always build type"
+      push @dep, $self->config->setting (qw/MISC CPDUMMY/)
+        if $self->is_type_or (
+          split (/,/, $self->config->setting ('ALWAYS_BUILD_TYPE'))
+        );
+
+      # Depends on other executable files
+      for my $name (sort keys %{ $self->{DEP} }) {
+        push @dep, $name if $self->{DEP}{$name} eq 'EXE';
+      }
+
+      $self->{RULES}{$self->base} = {
+        ACTION => 'CP', DEP => \@dep, DEST => '$(FCM_BINDIR)',
+      };
+
+    } elsif ($self->is_type ('LIB')) {
+      # Archive object library
+      # ------------------------------------------------------------------------
+      my @dep;
+      for my $name (sort keys %{ $self->{DEP} }) {
+        next unless $self->{DEP}{$name} eq 'OBJ';
+
+        if ($name =~ /^\$\(\w+\)$/) {
+          # Dependency is a Makefile variable
+          push @dep, $name;
+
+        } else {
+          # Dependency is an object
+          (my $root = $name) =~ s/\.\w+$//;
+          push @dep, lc ($root) . $outfile_ext{OBJ};
+        }
+      }
+
+      $self->{RULES}{$self->base} = {ACTION => 'AR', DEP => \@dep};
+    }
+  }
+
+  return %{ $self->{RULES} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $srcfile->write_makerules ();
+#
+# DESCRIPTION
+#   This method returns a string containing the "Make" rules for building the
+#   source file.
+# ------------------------------------------------------------------------------
+
+sub write_makerules {
+  my $self  = shift;
+  my $mk    = '';
+  my %rules = $self->required_rules;
+  my $nl    = " \\\n" . ' ' x 10;
+
+  for my $target (sort keys %rules) {
+    $mk .= $target . ':';
+    
+    for my $dep (@{ $rules{$target}{DEP} }) {
+      $mk .= $nl . $dep;
+    }
+
+    $mk .= "\n";
+
+    if (exists $rules{$target}{ACTION}) {
+      if ($rules{$target}{ACTION} eq 'COMPILE') {
+        if ($self->lang) {
+          $mk .= "\t" . 'fcm_internal compile:' . substr ($self->lang, 0, 1) .
+                 ' ' . $self->srcpackage->name . ' $< $@';
+          $mk .= ' 1' if ($self->flagsbase ('PPKEYS') and not $self->ppsrc);
+          $mk .= "\n";
+        }
+
+      } elsif ($rules{$target}{ACTION} eq 'LOAD') {
+        $mk .= "\t" . 'fcm_internal load ' . $self->srcpackage->name . ' $< $@';
+        $mk .= ' ' . join (' ', @{ $rules{$target}{BLOCKDATA} })
+          if @{ $rules{$target}{BLOCKDATA} };
+        $mk .= "\n";
+
+      } elsif ($rules{$target}{ACTION} eq 'TOUCH') {
+        $mk .= "\t" . 'touch ' . catfile ($rules{$target}{DEST}, '$@') . "\n";
+
+      } elsif ($rules{$target}{ACTION} eq 'CP') {
+        $mk .= "\t" . 'cp $< ' . $rules{$target}{DEST} . "\n";
+        $mk .= "\t" . 'chmod u+w ' . catfile ($rules{$target}{DEST}, '$@') . "\n";
+
+      } elsif ($rules{$target}{ACTION} eq 'AR') {
+        $mk .= "\t" . 'fcm_internal archive $@ $(^F)' . "\n";
+      }
+    }
+
+    $mk .= "\n";
+  }
+
+  return $mk;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $srcfile->_makerule_srcfile ();
+#
+# DESCRIPTION
+#   This internal method returns a string containing the location of the
+#   source file relative to a package source path. This string will be
+#   suitable for use in a "Make" rule file for FCM.
+# ------------------------------------------------------------------------------
+
+sub _makerule_srcfile {
+  my $self = shift;
+
+  my $return;
+  my @searchpath;
+  my $label;
+  my $dir;
+  my $base;
+
+  if ($self->ppsrc) {
+    $return     = $self->ppsrc;
+    @searchpath = $self->srcpackage->ppsearchpath;
+    $label      = 'PPSRCDIR';
+    $dir        = $self->ppdir;
+    $base       = $self->ppbase;
+
+  } else {
+    $return     = $self->src;
+    @searchpath = $self->srcpackage->searchpath;
+    $label      = 'SRCDIR';
+    $dir        = $self->dir;
+    $base       = $self->base;
+  }
+
+  $return = catfile $dir, $base;
+
+  # Use variable for directory name
+  # if container package name contains word characters only
+  if ($self->srcpackage->name =~ /^\w+$/) {
+    for my $i (0 .. $#searchpath) {
+      if ($dir eq $searchpath[$i]) {
+        my $returndir = '$(' . $label . $i . '__' . $self->srcpackage->name .
+                        ')';
+        $return = catfile $returndir, $base;
+        last;
+      }
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcPackage.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcPackage.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/SrcPackage.pm	(revision 5166)
@@ -0,0 +1,895 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::SrcPackage
+#
+# DESCRIPTION
+#   This is a class to process a source directory package. It uses the
+#   supplied inheritance hierarchy to obtain a list of source files of this
+#   package.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::SrcPackage;
+
+# Standard pragma
+use strict;
+use warnings;
+
+# Standard modules
+use Carp;
+use File::Spec::Functions;
+use File::Basename;
+use File::Path;
+
+# FCM component modules
+use Fcm::Util;
+use Fcm::SrcFile;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package = Fcm::SrcPackage->new (
+#     CONFIG     => $config,
+#     NAME       => $name,
+#     CURRENT    => $current,
+#     REQUIREPP  => $requirepp,
+#     NEWPP      => $newpp,
+#     SEARCHPATH => \@path,
+#   );
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::SrcPackage class.
+#
+# ARGUMENTS
+#   CONFIG     - reference to a Fcm::Config instance
+#   NAME       - name of the source directory package
+#   CURRENT    - package declared in current build?
+#   REQUIREPP  - require pre-processing?
+#   NEWPP      - pre-process option has changed?
+#   SEARCHPATH - search path of files in the source package
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self  = {
+    CONFIG     => exists $args{CONFIG}     ? $args{CONFIG}     : &main::cfg,
+    NAME       => exists $args{NAME}       ? $args{NAME}       : undef,
+    CURRENT    => exists $args{CURRENT}    ? $args{CURRENT}    : undef,
+    REQUIREPP  => exists $args{REQUIREPP}  ? $args{REQUIREPP}  : undef,
+    NEWPP      => exists $args{NEWPP}      ? $args{NEWPP}      : undef,
+    SEARCHPATH => exists $args{SEARCHPATH} ? $args{SEARCHPATH} : [],
+
+    # Reference to Fcm::CfgFile, source package configuration file
+    CFG       => undef,
+
+    # References to Fcm::SrcFile, list of source files
+    SRCFILE   => [],
+  };
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = $package->config;
+#
+# DESCRIPTION
+#   This method returns a reference to the Fcm::Config instance.
+# ------------------------------------------------------------------------------
+
+sub config {
+  my $self = shift;
+
+  return $self->{CONFIG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $package->name;
+#   $package->name ($name);
+#
+# DESCRIPTION
+#   This method returns the name of this package. If an argument is specified,
+#   the name is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub name {
+  my $self = shift;
+
+  if (@_) {
+    $self->{NAME} = shift;
+  }
+
+  return $self->{NAME};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $package->current;
+#   $package->current ($flag);
+#
+# DESCRIPTION
+#   This method returns the "current" flag of the source package. If an
+#   argument is specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub current {
+  my $self = shift;
+
+  if (@_) {
+    $self->{CURRENT} = shift;
+  }
+
+  return $self->{CURRENT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $package->requirepp;
+#   $package->requirepp ($flag);
+#
+# DESCRIPTION
+#   This method returns the "require PP" flag of the source package. If an
+#   argument is specified, the flag is set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub requirepp {
+  my $self = shift;
+
+  if (@_) {
+    $self->{REQUIREPP} = shift;
+  }
+
+  return $self->{REQUIREPP};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $package->newpp;
+#   $package->newpp ($flag);
+#
+# DESCRIPTION
+#   This method returns the flag to denote whether pre-processor option for
+#   this source package has changed. If an argument is specified, the flag is
+#   set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub newpp {
+  my $self = shift;
+
+  if (@_) {
+    $self->{NEWPP} = shift;
+  }
+
+  return $self->{NEWPP};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cfgfile = $package->cfg;
+#   $package->cfg ($cfgfile);
+#
+# DESCRIPTION
+#   This method returns a reference to a Fcm::CfgFile instance for the source
+#   package configuration file. If an argument is specified, the reference is
+#   set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub cfg {
+  my $self = shift;
+
+  if (@_) {
+    $self->{CFG} = $_[0];
+  }
+
+  return $self->{CFG};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @path = $package->searchpath;
+#   $package->searchpath (@path);
+#
+# DESCRIPTION
+#   This method returns the source file search path associated with this
+#   source package in the current build. If arguments are specified, the
+#   search path is replaced by the array in the argument list.
+# ------------------------------------------------------------------------------
+
+sub searchpath {
+  my $self = shift;
+
+  @{ $self->{SEARCHPATH} } = @_ if @_; 
+
+  return @{ $self->{SEARCHPATH} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @path = $package->ppsearchpath;
+#
+# DESCRIPTION
+#   This method returns the pre-processed source file search path associated
+#   with this source package in the current build.
+# ------------------------------------------------------------------------------
+
+sub ppsearchpath {
+  my $self = shift;
+
+  my @path = ();
+  my @name = split /__/, $self->name;
+
+  for my $ppsrcdir (@{ $self->config->setting (qw/PATH PPSRC/) }) {
+    push @path, catfile ($ppsrcdir, @name);
+  }
+
+  return @path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $package->flagsbase ($flag);
+#
+# DESCRIPTION
+#   Returns the base name of a flags-file, determined by $flag.
+# ------------------------------------------------------------------------------
+
+sub flagsbase {
+  my ($self, $flag) = @_;
+
+  return join ('__', ($flag, $self->name)) .
+         $self->config->setting (qw/OUTFILE_EXT FLAGS/);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @srcfile = $package->srcfile;
+#
+# DESCRIPTION
+#   This method returns a list of references to Fcm::SrcFile instances
+#   associated with this package.
+# ------------------------------------------------------------------------------
+
+sub srcfile {
+  my $self = shift;
+
+  return @{ $self->{SRCFILE} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package->update_file_info ();
+#
+# DESCRIPTION
+#   This method updates the source file information of this package. Please
+#   note that information is only updated if the cache file for this package
+#   does not exist. For a package declared in the current build, the
+#   information is also updated if the cache file is out of date.
+# ------------------------------------------------------------------------------
+
+sub update_file_info {
+  my $self      = shift;
+
+  # Check if the cache file exists and up to date
+  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
+  my $cachefile = find_file_in_path ($self->_cache_basename, \@cachepath);
+
+  my $uptodate  = $cachefile ? 1 : 0;
+  if ($uptodate and $self->{CURRENT}) {
+    # Is cache file up to date compared with directory?
+    $uptodate = (stat $cachefile) [9] > (stat $self->{SEARCHPATH}[0]) [9];
+
+    # Is cache file up to date compared with each file?
+    if ($uptodate) {
+      my $dir = $self->{SEARCHPATH}[0];
+
+      if (opendir DIR, $dir) {
+        my @files = map {catfile $dir, $_} grep {!/^\.\.?/} readdir 'DIR';
+        closedir DIR;
+        $uptodate = (grep {(stat $cachefile) [9] > (stat) [9]} @files) ? 1 : 0;
+      }
+    }
+  }
+
+  # Read package source file information if it appears to be up to date
+  $uptodate = $self->_read_file_list_cache ($cachefile) if ($uptodate);
+
+  # Update package source file information if necessary
+  if (not $uptodate) {
+    # Get list of files by searching through the search path
+    my @files = ();
+    for my $dir (@{ $self->{SEARCHPATH} }) {
+      opendir DIR, $dir;
+      while (my $base = readdir 'DIR') {
+        next if $base =~ /^\./;
+
+        my $file = catfile $dir, $base;
+        next if -d $file;
+
+        push @files, $file unless grep {basename ($_) eq $base} @files;
+      }
+      closedir DIR;
+    }
+
+    # Declare new instances of source file objects
+    my @srcfile = ();
+    for my $file (@files) {
+      if (basename ($file) eq $self->config->setting (qw/CFG_NAME SRCPACKAGE/)) {
+        $self->{CFG} = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
+
+      } else {
+        my $srcfile = Fcm::SrcFile->new (
+          CONFIG     => $self->config,
+          SRC        => $file,
+          SRCPACKAGE => $self,
+        );
+
+        # Determine source file types
+        $srcfile->determine_type;
+
+        # Record files of known types
+        push @srcfile, $srcfile;
+      }
+    }
+
+    # Set each SRCFILE to reference the source file instances
+    $self->{SRCFILE} = \@srcfile;
+
+    # Decipher configuration file if necessary
+    $self->_decipher_cfg if $self->cfg;
+
+    # Write to a new cache file
+    $self->_update_file_list_cache ();
+
+    # Source package info updated. Make sure the "current" flag is set to true
+    $self->current (1);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $up_to_date = $self->_read_file_list_cache ($file);
+#
+# DESCRIPTION
+#   This internal method reads the cache $file of this package and assigns the
+#   information to the SRCFILE list. It returns true if the cache appears to
+#   be up to date.
+# ------------------------------------------------------------------------------
+
+sub _read_file_list_cache {
+  my $self = shift;
+  my $file = shift;
+
+  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
+
+  # Read from config file
+  $cfg->read_cfg;
+  my @lines = $cfg->lines;
+
+  my %filetype = ();
+  my $uptodate = 1;
+  for my $line (@lines) {
+    next unless $line->{LABEL};
+
+    # On package declared in the current build, check that file is not deleted
+    if (not -f $line->{LABEL}) {
+      $uptodate = 0;
+      last;
+    }
+
+    $filetype{$line->{LABEL}} = $line->{VALUE};
+  }
+
+  # Assign to SRCFILE list if cache file is up to date
+  if ($uptodate) {
+    my @srcfiles = ();
+
+    for my $file (sort keys %filetype) {
+      if ($filetype{$file} eq 'SRCPACKAGECFG') {
+        $self->{CFG} = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
+
+      } else {
+        my $srcfile = Fcm::SrcFile->new (
+          CONFIG     => $self->config,
+          SRC        => $file,
+          TYPE       => $filetype{$file},
+          SRCPACKAGE => $self,
+        );
+
+        push @srcfiles, $srcfile;
+      }
+    }
+
+    $self->{SRCFILE} = [@srcfiles];
+
+    $self->_decipher_cfg if $self->cfg;
+  }
+
+  return $uptodate;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_update_file_list_cache (\@cachepath);
+#
+# DESCRIPTION
+#   This internal method updates the cache file of this package by writing
+#   current SRCFILE information to it. The argument @cachepath must be the
+#   search path of the build cache directory.
+# ------------------------------------------------------------------------------
+
+sub _update_file_list_cache {
+  my $self      = shift;
+  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
+
+  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+  if ($self->{CFG}) {
+    $cfg->add_line (LABEL => $self->cfg->src, VALUE => 'SRCPACKAGECFG')
+  }
+
+  for my $file (@{ $self->{SRCFILE} }) {
+    $cfg->add_line (LABEL => $file->src, VALUE => $file->type);
+  }
+
+  my $cachefile = catfile $cachepath[0], $self->_cache_basename;
+  $cfg->print_cfg ($cachefile);
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $basename = $self->_cache_basename ($type);
+#
+# DESCRIPTION
+#   This internal method returns the basename of a cache file for this
+#   package. If no argument is specified, it returns the package file list
+#   cache name. Otherwise, it returns the package file dependency cache name.
+# ------------------------------------------------------------------------------
+
+sub _cache_basename {
+  my $self = shift;
+  my $type = $_[0] ? $_[0] : 'PCKFILE';
+
+  return $self->{NAME} . $self->config->setting ('CACHE', $type);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_decipher_cfg ();
+#
+# DESCRIPTION
+#   This internal method deciphers the CFG file associated with this source
+#   package.
+# ------------------------------------------------------------------------------
+
+sub _decipher_cfg {
+  my $self = shift;
+
+  $self->cfg->read_cfg;
+  my @lines = $self->cfg->lines;
+
+  my %cfg_label = %{ $self->config->setting ('CFG_LABEL') };
+
+  LINE: for my $line (@lines) {
+    my $label = $line->{LABEL};
+    my $value = $line->{VALUE};
+
+    next unless $label;
+    next if uc $label eq $cfg_label{CFGFILE}{TYPE};
+    next if uc $label eq $cfg_label{CFGFILE}{VERSION};
+
+    my ($prefix, $name) = split /::/, $label;
+
+    # Get name of file from the package cfg
+    my $srcfile;
+    if ($name) {
+      ($srcfile) = grep {$_->base eq $name} @{ $self->{SRCFILE} };
+
+      # Create new instance of Fcm::SrcFile if not already in package
+      if (not $srcfile) {
+        my $src    = find_file_in_path ($name, $self->{SEARCHPATH});
+        my $target = $name unless $src;
+
+        $srcfile   = Fcm::SrcFile->new (
+          CONFIG     => $self->config,
+          SRCPACKAGE => $self,
+          SRC        => $src ? $src : $name,
+          TARGET     => $target,
+          PCKCFG     => 1,
+        );
+        push @{ $self->{SRCFILE} }, $srcfile;
+
+      } else {
+        $srcfile->pckcfg (1);
+      }
+
+    } else {
+      w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
+               ': label "', $label, '" not recognised.';
+      next LINE;
+    }
+
+    $prefix = uc $prefix;
+    if ($prefix eq $cfg_label{TYPE}) {
+      # Type label of source file
+      $srcfile->type (uc $value);
+      $srcfile->scan (0) if $srcfile->is_type (qw/BINARY LIB/);
+      next LINE;
+
+    } elsif ($prefix eq $cfg_label{SCAN}) {
+      # Scan original file for dependency?
+      $srcfile->scan ($value);
+      next LINE;
+
+    } elsif ($prefix eq $cfg_label{TARGET}) {
+      # Name of build target for this source file
+      $srcfile->exebase ($value);
+      next LINE;
+
+    } elsif ($prefix eq $cfg_label{INTNAME}) {
+      # Program unit name of this source file
+      $srcfile->progname ($value);
+      next LINE;
+
+    } elsif ($prefix eq $cfg_label{DEP}) {
+      # Dependency of this source file
+      my ($type, $target) = split /::/, $value;
+      $srcfile->add_dep ($target, uc $type);
+      next LINE;
+
+    } else {
+      w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
+               ': label "', $label, '" not recognised.';
+      next LINE;
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package->scan_dependency ();
+#   $package->scan_dependency (HEADER_ONLY => 1);
+#
+# DESCRIPTION
+#   This method scans the dependency in each source file in this source
+#   package and updates the package dependency cache. If HEADER_ONLY is
+#   specified, it performs dependency scan for pre-processor headers only if
+#   this source package requires pre-processing.
+# ------------------------------------------------------------------------------
+
+sub scan_dependency {
+  my $self = shift;
+  my %args = @_;
+
+  # Search for include header dependencies only
+  my $header_only = exists $args{HEADER_ONLY} ? $args{HEADER_ONLY} : 0;
+
+  # Get list of source files
+  # If header dependencies only, only consider FPP, C and CPP files
+  my @srcfiles = $header_only
+                 ? grep {$_->is_type_or (qw/FPP C CPP/)} $self->srcfile
+                 : grep {$_->type} $self->srcfile;
+  return unless @srcfiles;
+
+  # Location of the cache
+  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
+  my $cachebase = $header_only
+                  ? $self->_cache_basename ('PCKPPDEPEND')
+                  : $self->_cache_basename ('PCKDEPEND');
+  my $cachefile = find_file_in_path ($cachebase, \@cachepath);
+
+  # Obtain old dependency information from cache file if it exists
+  my %dep     = ();
+  my %intname = ();
+
+  if ($cachefile) {
+    # Read the cache
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $cachefile);
+    $cfg->read_cfg;
+    my @lines = $cfg->lines;
+
+    # Get list of source file base names
+    my %srcfilebase;
+    for (@srcfiles) {
+      my $base = $_->ppsrc ? $_->ppbase : $_->base;
+      $srcfilebase{$base} = 1;
+    }
+
+    for my $line (@lines) {
+      next unless $line->{LABEL};
+
+      # Label is either INTNAME or a dependency type name
+      # For INTNAME, value is the program unit name
+      # Otherwise, value is file::dependency
+      my $type = $line->{LABEL};
+      (my $file, my $depend) = split /::/, $line->{VALUE};
+
+      # Make sure $file exists in the list of source file base names
+      next unless exists $srcfilebase{$file};
+
+      if ($type eq 'INTNAME') {
+        $intname{$file} = $depend;
+
+      } else {
+        $dep{$file}{$depend} = $type;
+      }
+    }
+  }
+
+  # If a source file is newer than the cache file, re-scan dependency for that
+  # source file.
+  my $uptodate        = $cachefile ? 1 : 0;
+  my $cachefile_mtime = $cachefile ? (stat $cachefile) [9] : undef;
+  my $count           = 0;
+
+  for my $srcfile (@srcfiles) {
+    # Check modified time of source file
+    my $srcfile_mtime = $srcfile->mtime;
+
+    # If a package config file exists and it affects the source file,
+    # compare its timestamp with that of the source file
+    if ($srcfile->pckcfg) {
+      $srcfile_mtime = $self->cfg->mtime if not defined $srcfile_mtime;
+      $srcfile_mtime = ($self->cfg->mtime > $srcfile_mtime) ? $self->cfg->mtime
+                                                            : $srcfile_mtime;
+    }
+
+    # For files requiring PP, must re-scan if PP option has changed
+    my $rescan = ($self->newpp and $srcfile->is_type_or (qw/FPP C/)) ? 1 : 0;
+
+    if ($cachefile_mtime and $cachefile_mtime > $srcfile_mtime and ! $rescan) {
+      # No need to re-scan dependency, read dependency from cache
+      my $base = ($srcfile->ppsrc ? $srcfile->ppbase : $srcfile->base);
+
+      $srcfile->progname ($intname{$base}) if $intname{$base};
+      $srcfile->dep ($dep{$base})          if $dep{$base};
+
+    } else {
+      # Rescan dependency
+      $srcfile->progname (undef);
+      my $rc = $srcfile->scan_dependency (HEADER_ONLY => $header_only);
+      my %dp = $srcfile->dep;
+
+      # Get list of dependencies for updating the cache
+      my $base = ($srcfile->ppsrc ? $srcfile->ppbase : $srcfile->base);
+
+      $intname{$base} = $srcfile->progname;
+      $dep    {$base} = \%dp;
+
+      $uptodate = 0;
+      $count++ if $rc;
+    }
+  }
+
+  # Output diagnostic, if necessary
+  if ($self->config->verbose > 1 and $count) {
+    my $out =  $self->name . ': scanned ' . $count . ' file(s) for';
+    $out   .= ' header' if $header_only;
+    $out   .= ' dependency' . "\n";
+    print $out;
+  }
+
+  # Check whether package config file is newer than the dependency cache
+  if ($uptodate and $self->cfg) {
+    $uptodate = $cachefile_mtime > $self->cfg->mtime ? 1 : 0;
+  }
+
+  if (not $uptodate) {
+    # Update dependency cache file
+    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
+
+    # Program unit name of source files
+    for my $file (keys %intname) {
+      next unless $intname{$file};
+
+      $cfg->add_line (
+        LABEL => 'INTNAME',
+        VALUE => $file . '::' . $intname{$file},
+      );
+    }
+
+    # Dependencies of source files
+    for my $file (keys %dep) {
+      for my $depend (keys %{ $dep{$file} }) {
+        $cfg->add_line (
+          LABEL => $dep{$file}{$depend},
+          VALUE => $file . '::' . $depend,
+        );
+      }
+    }
+
+    # Create an empty config file if no dependency in this source package
+    $cfg->add_line unless $cfg->lines;
+
+    # Write to config file
+    my $outfile = catfile $cachepath[0], $cachebase;
+    $cfg->print_cfg ($outfile);
+  }
+
+  return not $uptodate;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $package->makerule_uptodate ();
+#
+# DESCRIPTION
+#   This method returns true if the make rule file for this source package
+#   is up to date.
+# ------------------------------------------------------------------------------
+
+sub makerule_uptodate {
+  my $self = shift;
+
+  my $return = 0;
+
+  if (not $self->newpp) {
+    # Check whether a Make rule file already exists
+    my $mkbase = $self->name . $self->config->setting (qw/OUTFILE_EXT MK/);
+    my $mkfile = find_file_in_path (
+      $mkbase,
+      $self->config->setting (qw/PATH BLD/),
+    );
+
+    # Check location of source package file type cache
+    my $pckfile = find_file_in_path (
+      $self->_cache_basename ('PCKFILE'),
+      $self->config->setting (qw/PATH CACHE/),
+    );
+
+    # Check location of source package dependency cache
+    my $pckdepend = find_file_in_path (
+      $self->_cache_basename ('PCKDEPEND'),
+      $self->config->setting (qw/PATH CACHE/),
+    );
+
+    # If make rule file exists, determine whether it is out of date
+    if ($pckdepend) {
+      if ($mkfile) {
+        my $pckfile_mt   = (stat $pckfile)  [9];
+        my $pckdepend_mt = (stat $pckdepend)[9];
+        my $mkfile_mt    = (stat $mkfile)   [9];
+
+        $return = 1 if $mkfile_mt >= $pckdepend_mt and $mkfile_mt >= $pckfile_mt;
+      }
+
+    } else {
+      $return = 1; # No cache file, no need to have a make rule
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $package->write_makerule ();
+#
+# DESCRIPTION
+#   This method writes to the I<Make> rule file of the current source package.
+# ------------------------------------------------------------------------------
+
+sub write_makerule {
+  my $self = shift;
+
+  # Package Make rule header
+  my $mk = '# Automatic Make rule for ' . $self->name . "\n\n";
+
+  # Set up variable for directory name
+  # if package name contains only word characters
+  my @searchpath   = $self->searchpath;
+  my @ppsearchpath = $self->ppsearchpath;
+
+  if ($self->name =~ /^\w+$/) {
+    # Package search path
+    my %path = (SRCDIR => \@searchpath, PPSRCDIR => \@ppsearchpath);
+
+    for my $key (keys %path) {
+      my $count = 0;
+      my @dirs  = @{ $path{$key} };
+
+      for my $i (0 .. $#dirs) {
+        next unless -d $dirs[$i];
+        $mk .= $key . $i . '__' . $self->name . ' = ' . $dirs[$i] . "\n";
+        $count++;
+      }
+
+      $mk .= "\n" if $count;
+    }
+  }
+
+  my $mk_out;
+
+  # Make rules for copying data files, if necessary
+  {
+    # Get a list of files with no associated type
+    my @files = grep {not $_->type} @{ $self->{SRCFILE} };
+
+    if (@files) {
+      my $target = $self->name . $self->config->setting (qw/OUTFILE_EXT ETC/);
+      $mk_out .= $target . ' :';
+
+      # Depends on all un-typed source files
+      my $nl = " \\\n" . ' ' x 10;
+      for my $file (@files) {
+        my $dir = $file->dir;
+
+        # Use variable for directory name
+        # if package name contains only word characters
+        if ($self->name =~ /^\w+$/) {
+          for my $i (0 .. $#searchpath) {
+            if ($dir eq $searchpath[$i]) {
+              $dir = '$(SRCDIR' . $i . '__' . $self->name . ')';
+              last;
+            }
+          }
+        }
+
+        $mk_out .= $nl . catfile ($dir, $file->base);
+      }
+
+      # Depends on dummy copy file, so there will be no dependency inheritance
+      $mk_out .= $nl . $self->config->setting (qw/MISC CPDUMMY/);
+
+      # Actions for target
+      $mk_out .= "\n";
+      $mk_out .= "\t" . 'cp $^ $(FCM_ETCDIR)' . "\n";
+      $mk_out .= "\t" . 'touch ' . catfile ('$(FCM_DONEDIR)', '$@') . "\n";
+
+      $mk_out .= "\n";
+    }
+  }
+
+  # Make rules for source files
+  my @srcfiles = grep {$_->type} @{ $self->{SRCFILE} };
+  for my $srcfile (@srcfiles) {
+    $mk_out .= $srcfile->write_makerules;
+  }
+
+  # Write make rule file only if necessary
+  if ($mk_out) {
+    $mk .= $mk_out;
+
+    # Write to output file
+    my $mkbase = $self->name . $self->config->setting (qw/OUTFILE_EXT MK/);
+    my $blddir = ${ $self->config->setting (qw/PATH BLD/) }[0];
+    my $mkfile = catfile $blddir, $mkbase;
+
+    if (not -d $blddir) {
+      print 'Make directory: ', $blddir, "\n" if $self->config->verbose > 1;
+      mkpath $blddir or croak $blddir, ': cannot create directory, abort';
+    }
+
+    open OUT, '>', $mkfile
+      or croak 'Cannot open "', $mkfile, '" (', $!, '), abort';
+    print OUT $mk;
+    close OUT or croak 'Cannot close "', $mkfile, '" (', $!, '), abort';
+
+    print 'Generated: ', $mkfile, "\n" if $self->config->verbose > 1;
+
+    return 1;
+
+  } else {
+    return 0;
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Timer.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Timer.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Timer.pm	(revision 5166)
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Timer
+#
+# DESCRIPTION
+#   This is a package of timer utility used by the FCM command.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Timer;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Exports
+our (@ISA, @EXPORT, @EXPORT_OK);
+
+sub timestamp_command;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(timestamp_command);
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %cmd_start_time = (); # Command start time, (key = command, value = time)
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &Fcm::Timer::timestamp_command ($command[, $status]);
+#
+# DESCRIPTION
+#   This function returns a string adding to $command a prefix according the
+#   value of $status. If $status is not specified or does not match the word
+#   "end", the status is assumed to be "start". At "start", the prefix will
+#   contain the current timestamp. If $status is the word "end", the prefix
+#   will contain the total time taken since this function was called with the
+#   same $command at the "start" status.
+# ------------------------------------------------------------------------------
+
+sub timestamp_command {
+  (my $command, my $status) = @_;
+
+  my $prefix;
+  if ($status and $status =~ /end/i) {
+    # Status is "end", insert time taken
+    my $lapse = time () - $cmd_start_time{$command};
+    $prefix = sprintf "# Time taken: %12d s=> ", $lapse;
+
+  } else {
+    # Status is "start", insert time stamp
+    $cmd_start_time{$command} = time;
+
+    (my $sec, my $min, my $hour, my $mday, my $mon, my $year) = localtime;
+    $prefix = sprintf "# Start: %04d-%02d-%02d %02d:%02d:%02d=> ",
+              $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
+  }
+
+  return $prefix . $command . "\n";
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Util.pm
===================================================================
--- /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Util.pm	(revision 5166)
+++ /branches/publications/ORCHIDEE_gmd-2018-14C/_OLD_ORCHIDEE/tools/FCM_V1.2/lib/Fcm/Util.pm	(revision 5166)
@@ -0,0 +1,848 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Util
+#
+# DESCRIPTION
+#   This is a package of misc utilities used by the FCM command.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Util;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Exports
+our (@ISA, @EXPORT, @EXPORT_OK);
+
+sub expand_rev_keyword;
+sub expand_tilde;
+sub expand_url_keyword;
+sub e_report;
+sub find_srcdir;
+sub find_file_in_path;
+sub get_browser_url;
+sub get_command_string;
+sub get_rev_of_wc;
+sub get_rev_keyword;
+sub get_url_of_wc;
+sub get_url_keyword;
+sub get_wct;
+sub is_url;
+sub is_wc;
+sub print_command;
+sub run_command;
+sub svn_date;
+sub touch_file;
+sub w_report;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(
+  expand_rev_keyword
+  expand_tilde
+  expand_url_keyword
+  e_report
+  find_srcdir
+  find_file_in_path
+  get_browser_url
+  get_command_string
+  get_rev_of_wc
+  get_rev_keyword
+  get_url_of_wc
+  get_url_keyword
+  get_wct
+  is_url
+  is_wc
+  print_command
+  run_command
+  svn_date
+  touch_file
+  w_report
+);
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Find;
+use File::Path;
+use File::Spec;
+use POSIX qw/strftime/;
+
+# FCM component modules
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %svn_info       = (); # "svn info" log, (key1 = path,
+                         # key2 = URL, Revision, Last Changed Rev)
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %srcdir = &Fcm::Util::find_srcdir ($topdir, $toppck, $join);
+#
+# DESCRIPTION
+#   Search $topdir for sub-directories containing regular files. Returns a hash
+#   with each key/value pair assigned to a unique name of the source directory
+#   and the location of the source directory. If $toppck is set the name of
+#   each source directory will be prefixed with this package name, and the
+#   search may include the $topdir in the result. If $join is set, the name of
+#   the sub-package will use $join as the delimiter of packages. Otherwise, the
+#   default double underscore '__' will be used.  Please note that all
+#   directories beginning with a ".", i.e. hidden directories, are ignored.
+# ------------------------------------------------------------------------------
+
+sub find_srcdir {
+  (my $topdir, my $toppck, my $join) = @_;
+  $join = defined ($join) ? $join : '__';
+
+  my @dirs = ();
+
+  # Locate all source directories containing regular files
+  if (-d $topdir) {
+    find (
+      sub {
+        my $dir = $File::Find::name;
+        return 0 if $dir eq $topdir and not $toppck;
+
+        if (-d $dir) {
+          # Ignore sub-directories with names beginning with .
+          if ($dir ne $topdir) {
+            my $subdir = substr ($dir, length ($topdir) + 1);
+            return 0 if grep {m/^\./} File::Spec->splitdir ($subdir);
+          }
+
+          # Read contents of directory
+          opendir DIR, $dir;
+          my @files = readdir 'DIR';
+          closedir DIR;
+
+          # Check if the directory contains one or more source file
+          my $contain_src;
+          for my $file (@files) {
+            next if $file =~ /^\./; # ignore hidden file
+
+            if (-f File::Spec->catfile ($dir, $file)) {
+              $contain_src = 1;
+              last;
+            }
+          }
+
+          push @dirs, $dir if $contain_src;
+          return 1;
+
+        } else {
+          return 0;
+        }
+      },
+
+      $topdir,
+    );
+  }
+
+  # String length of src directory name
+  my $topdir_len = length $topdir;
+
+  # Assign new source directories to current build
+  my @pck    = $toppck ? split (/$join/, $toppck) : ();
+  my %srcdir = ();
+  for my $dir (@dirs) {
+    my $name = ($dir eq $topdir) ? '' : substr $dir, $topdir_len + 1;
+    my @path = File::Spec->splitdir ($name);
+    my $key  = join $join, (@pck, @path);
+
+    $srcdir{$key} = $dir;
+  }
+
+  return %srcdir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %srcdir = &Fcm::Util::find_file_in_path ($file, \@path);
+#
+# DESCRIPTION
+#   Search $file in @path. Returns the full path of the $file if it is found
+#   in @path. Returns "undef" if $file is not found in @path.
+# ------------------------------------------------------------------------------
+
+sub find_file_in_path {
+  my ($file, $path) = @_;
+
+  for my $dir (@$path) {
+    my $full_file = File::Spec->catfile ($dir, $file);
+    return $full_file if -e $full_file;
+  }
+
+  return undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $expanded_path = &Fcm::Util::expand_tilde ($path);
+#
+# DESCRIPTION
+#   Returns an expanded path if $path is a path that begins with a tilde (~).
+# ------------------------------------------------------------------------------
+
+sub expand_tilde {
+  my $file = $_[0];
+
+  $file =~ s#^~([^/]*)#$1 ? (getpwnam $1)[7] : ($ENV{HOME} || $ENV{LOGDIR})#ex;
+
+  return $file;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &Fcm::Util::touch_file ($file);
+#
+# DESCRIPTION
+#   Touch $file if it exists. Create $file if it does not exist. Return 1 for
+#   success or 0 otherwise.
+# ------------------------------------------------------------------------------
+
+sub touch_file {
+  my $file = $_[0];
+  my $rc   = 1;
+
+  if (-e $file) {
+    my $now = time;
+    $rc = utime $now, $now, $file;
+
+  } else {
+    mkpath dirname ($file) unless -d dirname ($file);
+
+    $rc = open FILE, '>', $file;
+    $rc = close FILE if $rc;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $new_url = &Fcm::Util::expand_url_keyword (URL => $url[, CFG => $cfg]);
+#
+# DESCRIPTION
+#   Expand URL if its begins with a pre-defined pattern followed by a keyword
+#   that can be found in the setting of CFG. If URL is a genuine URL, the
+#   function also attempts to expand any . or .. in the path. If CFG is not
+#   set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub expand_url_keyword {
+  my %args = @_;
+  my $url  = $args{URL};
+  my $cfg  = exists $args{CFG} ? $args{CFG} : &main::cfg;
+
+  # Prefix for URL keyword
+  my $prefix = $cfg->setting (qw/MISC EXPURL_PREFIX/);
+
+  # Pattern for URL keyword
+  my $pattern = '^' . $prefix . '([^/]+)';
+
+  # Standard suffix for URL keyword
+  my %suffix_value = (tr => 'trunk', br => 'branches', tg => 'tags');
+
+  # URL matches pattern?
+  if ($url =~ /$pattern/) {
+    my $keyword = $1;
+
+    # Determine whether keyword is registered.
+    my $keyval = $cfg->setting ('URL', uc ($keyword));
+
+    if ((not $keyval) and $keyword =~ s/[-_](tr|br|tg)$//) {
+      # Keyword is not registered, but it matches a standard suffix
+      my $suffix = $suffix_value{$1};
+
+      $keyval = $cfg->setting ('URL', uc ($keyword)) . '/' . $suffix
+        if $cfg->setting ('URL', uc ($keyword));
+    }
+
+    # Expand if keyword is registered
+    $url =~ s/$pattern/$keyval/ if $keyval;
+  }
+
+  # Expand . and ..
+  if (&is_url ($url)) {
+    while ($url =~ s#/+\.(?:/+|$)#/#g) {next}
+    while ($url =~ s#/+[^/]+/+\.\.(?:/+|$)#/#g) {next}
+  }
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &Fcm::Util::get_url_keyword (URL => $url[, CFG => $cfg]);
+#
+# DESCRIPTION
+#   Return a FCM URL keyword if URL matches a registered project URL or undef
+#   otherwise. If CFG is not set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub get_url_keyword {
+  my %args = @_;
+  my $url  = $args{URL};
+  my $cfg  = exists $args{CFG} ? $args{CFG} : &main::cfg;
+
+  my $return;
+
+  for my $key (%{ $cfg->setting ('URL') }) {
+    my $value = $cfg->setting ('URL', $key);
+    next unless defined $value;
+    next unless $url =~ s#^$value(?:/+|$)##;
+
+    $return = $cfg->setting (qw/MISC EXPURL_PREFIX/) . $key .
+              ($url ? '/' . $url : '');
+    last;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $new_rev = &Fcm::Util::expand_rev_keyword (
+#     REV  => $rev,
+#     URL  => $url,
+#    [HEAD => $flag,]
+#    [CFG  => $cfg,]
+#  );
+#
+# DESCRIPTION
+#   Expand REV if URL is a known URL in CFG setting and REV matches a revision
+#   keyword of this URL, or if REV is "HEAD". SVN revision numbers, date and
+#   other keywords are ignored. HEAD should only be specified if REV has the
+#   value "HEAD". If HEAD is specified and is true, the return value of the
+#   function will be the operative revision number of the HEAD revision.
+#   Otherwise, the last commit revision will be returned. If CFG is not set,
+#   it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub expand_rev_keyword {
+  my %args = @_;
+  my $rev  = $args{REV};
+  my $url  = $args{URL};
+  my $head = exists $args{HEAD} ? $args{HEAD} : undef;
+  my $cfg  = exists $args{CFG } ? $args{CFG } : &main::cfg;
+
+  if (uc ($rev) eq 'HEAD') {
+    # Expand HEAD revision
+    &_invoke_svn_info (PATH => $url, CFG => $cfg) unless exists $svn_info{$url};
+    my $expanded_rev = $head
+                     ? $svn_info{$url}{Revision}
+                     : $svn_info{$url}{'Last Changed Rev'};
+
+    &w_report ($url, ': cannot determine HEAD revision.')
+      if $cfg->verbose > 1 and not $expanded_rev;
+
+    $rev = $expanded_rev if $expanded_rev;
+
+  } elsif ($rev !~ /^(?:\d+|BASE|COMMITTED|PREV|\{.+\})$/i) {
+    # Expand revision keyword, if required
+
+    # Get configuration settings
+    my %keywords  = %{ $cfg->setting (qw/REVISION/) };
+    my $separator = $cfg->setting (qw/MISC DIR_SEPARATOR/);
+
+    my $name      = '';
+
+    # Find out whether URL matches a registered repository
+    for my $keyword (keys %keywords) {
+      my $repos = $cfg->setting ('URL', uc ($keyword));
+      next unless $repos;
+
+      if ($url =~ m#^$repos(?:$separator|$)#) {
+        $name = $keyword;
+        last;
+      }
+    }
+
+    # If revision keyword exists for the registered repository, expand it
+    if ($name and exists $keywords{$name}{uc ($rev)}) {
+      $rev = $keywords{$name}{uc ($rev)};
+
+    } else {
+      &e_report (
+        $rev, ': revision keyword not found for ', $url,
+        ' in FCM configuration file, abort.',
+      );
+    }
+  }
+
+  return $rev;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $keyword = Fcm::Util::get_rev_keyword (
+#     REV => $rev,
+#     URL => $url,
+#    [CFG => $cfg,]
+#  );
+#
+# DESCRIPTION
+#   Returns a revision keyword if URL is a known URL in CFG setting and REV is
+#   a revision number that matches a revision keyword of this URL. Otherwise,
+#   it returns REV unchanged. If CFG is not set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub get_rev_keyword {
+  my %args = @_;
+  my $rev  = $args{REV};
+  my $url  = $args{URL};
+  my $cfg  = exists $args{CFG} ? $args{CFG} : &main::cfg;
+
+  if ($rev =~ /^\d+$/) {
+    # Get revision keyword, if REV is a revision number
+
+    # Get configuration settings
+    my %keywords  = %{ $cfg->setting (qw/REVISION/) };
+    my $separator = $cfg->setting (qw/MISC DIR_SEPARATOR/);
+
+    my $name      = '';
+
+    # Find out whether URL matches a registered repository
+    for my $keyword (keys %keywords) {
+      my $repos = $cfg->setting ('URL', uc ($keyword));
+      next unless $repos;
+
+      if ($url =~ m#^$repos(?:$separator|$)#) {
+        $name = $keyword;
+        last;
+      }
+    }
+
+    # If revision keyword for REV exists for the registered repository, get it
+    if ($name and exists $keywords{$name} and ref $keywords{$name} eq 'HASH') {
+      for my $key (keys %{ $keywords{$name} }) {
+        if ($rev eq $keywords{$name}{$key}) {
+          $rev = $key;
+          last;
+        }
+      }
+    }
+  }
+
+  return $rev;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $browser_url = Fcm::Util::get_browser_url (
+#     URL => $url,
+#    [CFG => $cfg,]
+#  );
+#
+# DESCRIPTION
+#   Returns a web address for browsing URL from Trac if URL is a known URL in
+#   CFG setting, and that it is a matching web address. Otherwise, it returns
+#   "undef". If CFG is not set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub get_browser_url {
+  my %args        = @_;
+  my $url         = $args{URL};
+  my $cfg         = exists $args{CFG} ? $args{CFG} : &main::cfg;
+  my $browser_url = undef;
+
+  # Get configuration settings
+  my %keywords  = %{ $cfg->setting (qw/TRAC/) };
+  my $separator = $cfg->setting (qw/MISC DIR_SEPARATOR/);
+
+  my $name  = '';
+  my $trail = '';
+
+  # Find out whether URL matches a registered repository
+  for my $keyword (keys %keywords) {
+    my $repos = $cfg->setting ('URL', uc ($keyword));
+    next unless $repos;
+
+    if ($url =~ m#^$repos(?:$separator(.*$)|$)#) {
+      $name  = $keyword;
+      $trail = $1 if $1;
+      last;
+    }
+  }
+
+  # If TRAC web address exists for the registered repository, get it
+  if ($name and exists $keywords{$name}) {
+    $browser_url  = $keywords{$name};
+    $browser_url .= $separator . $trail if $trail;
+  }
+
+  return $browser_url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = &is_wc ([$path]);
+#
+# DESCRIPTION
+#   Returns true if current working directory (or $path) is a Subversion
+#   working copy.
+# ------------------------------------------------------------------------------
+
+sub is_wc {
+  my $path = @_ ? $_[0] : cwd ();
+
+  if (-d $path) {
+    return (-e File::Spec->catfile ($path, qw/.svn format/)) ? 1 : 0;
+
+  } elsif (-f $path) {
+    return (-e File::Spec->catfile (dirname ($path), qw/.svn format/)) ? 1 : 0;
+
+  } else {
+    return 0;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = &is_url ($url);
+#
+# DESCRIPTION
+#   Returns true if $url is a URL.
+# ------------------------------------------------------------------------------
+
+sub is_url {
+  # This should handle URL beginning with svn://, http:// and svn+ssh://
+  return ($_[0] =~ m#^[\+\w]+://#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_wct ([$dir]);
+#
+# DESCRIPTION
+#   If current working directory (or $dir) is a Subversion working copy,
+#   returns the top directory of this working copy; otherwise returns an empty
+#   string.
+# ------------------------------------------------------------------------------
+
+sub get_wct {
+  my $dir = @_ ? $_[0] : cwd ();
+
+  return '' if not &is_wc ($dir);
+
+  my $updir = dirname $dir;
+  while (&is_wc ($updir)) {
+    $dir   = $updir;
+    $updir = dirname $dir;
+    last if $updir eq $dir;
+  }
+
+  return $dir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_url_of_wc ([$path[, $refresh]]);
+#
+# DESCRIPTION
+#   If current working directory (or $path) is a Subversion working copy,
+#   returns the URL of the associated Subversion repository; otherwise returns
+#   an empty string. If $refresh is specified, do not use the cached
+#   information.
+# ------------------------------------------------------------------------------
+
+sub get_url_of_wc {
+  my $path    = @_ ? $_[0] : cwd ();
+  my $refresh = exists $_[1] ? $_[1] : 0;
+  my $url  = '';
+
+  if (&is_wc ($path)) {
+    delete $svn_info{$path} if $refresh;
+    &_invoke_svn_info (PATH => $path) unless exists $svn_info{$path};
+    $url = $svn_info{$path}{URL};
+  }
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &_invoke_svn_info (PATH => $path, [CFG => $cfg]);
+#
+# DESCRIPTION
+#   The function is internal to this module. It invokes "svn info" on $path to
+#   gather information on URL, Revision and Last Changed Rev. The information
+#   is stored in a hash table at the module level, so that the information can
+#   be re-used. If CFG is not set, it defaults to &main::cfg.
+# ------------------------------------------------------------------------------
+
+sub _invoke_svn_info {
+  my %args = @_;
+  my $path = $args{PATH};
+  my $cfg  = exists $args{CFG} ? $args{CFG} : &main::cfg;
+
+  return if exists $svn_info{$path};
+
+  # Invoke "svn info" command
+  my @info = &run_command (
+    [qw/svn info/, $path],
+    PRINT => $cfg->verbose > 2, METHOD => 'qx', DEVNULL => 1, ERROR => 'ignore',
+  );
+  for (@info) {
+    chomp;
+
+    if (/^(URL|Revision|Last Changed Rev):\s*(.+)$/) {
+      $svn_info{$path}{$1} = $2;
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_command_string ($cmd);
+#   $string = &get_command_string (\@cmd);
+#
+# DESCRIPTION
+#   The function returns a string by converting the list in @cmd or the scalar
+#   $cmd to a form, where it can be executed as a shell command.
+# ------------------------------------------------------------------------------
+
+sub get_command_string {
+  my $cmd    = $_[0];
+  my $return = '';
+
+  if (ref ($cmd) and ref ($cmd) eq 'ARRAY') {
+    # $cmd is a reference to an array
+
+    # Print each argument
+    for my $i (0 .. @{ $cmd } - 1) {
+      my $arg = $cmd->[$i];
+
+      $arg =~ s/./*/g if $i > 0 and $cmd->[$i - 1] eq '--password';
+
+      if ($arg =~ /[\s'"*?]/) {
+        # Argument contains a space, quote it
+        if (index ($arg, "'") >= 0) {
+          # Argument contains an apostrophe, quote it with double quotes
+          $return .= ($i > 0 ? ' ' : '') . '"' . $arg . '"';
+
+        } else {
+          # Otherwise, quote argument with apostrophes
+          $return .= ($i > 0 ? ' ' : '') . "'" . $arg . "'";
+        }
+
+      } else {
+        # Argument does not contain a space, just print it
+        $return .= ($i > 0 ? ' ' : '') . ($arg eq '' ? "''" : $arg);
+      }
+    }
+
+  } else {
+    # $cmd is a scalar, just print it "as is"
+    $return = $cmd;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &print_command ($cmd);
+#   &print_command (\@cmd);
+#
+# DESCRIPTION
+#   The function prints the list in @cmd or the scalar $cmd, as it would be
+#   executed by the shell.
+# ------------------------------------------------------------------------------
+
+sub print_command {
+  my $cmd = $_[0];
+
+  print '=> ', &get_command_string ($cmd) , "\n";
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @return = &run_command (\@cmd, <OPTIONS>);
+#   @return = &run_command ($cmd , <OPTIONS>);
+#
+# DESCRIPTION
+#   This function executes the command in the list @cmd or in the scalar $cmd.
+#   The remaining are optional arguments in a hash table. Valid options are
+#   listed below. If the command is run using "qx", the function returns the
+#   standard output from the command. If the command is run using "system", the
+#   function returns true on success. By default, the function dies on failure.
+#
+# OPTIONS
+#   METHOD  => $method - this can be "system", "exec" or "qx". This determines
+#                        how the command will be executed. If not set, the
+#                        default is to run the command with "system".
+#   PRINT   => 1       - if set, print the command before executing it.
+#   ERROR   => $flag   - this should only be set if METHOD is set to "system"
+#                        or "qx". The $flag can be "die" (default), "warn" or
+#                        "ignore". If set to "die", the function dies on error.
+#                        If set to "warn", the function issues a warning on
+#                        error, and the function returns false. If set to
+#                        "ignore", the function returns false on error.
+#   RC      => 1       - if set, must be a reference to a scalar, which will be
+#                        set to the return code of the command.
+#   DEVNULL => 1       - if set, re-direct STDERR to /dev/null before running
+#                        the command.
+#   TIME    => 1       - if set, print the command with a timestamp before
+#                        executing it, and print the time taken when it
+#                        completes. This option supersedes the PRINT option.
+# ------------------------------------------------------------------------------
+
+sub run_command {
+  my $cmd     = shift;
+  my %options = @_;
+  my $method  = exists $options{METHOD}  ? $options{METHOD}  : 'system';
+  my $print   = exists $options{PRINT}   ? $options{PRINT}   : undef;
+  my $error   = exists $options{ERROR}   ? $options{ERROR}   : 'die';
+  my $rc      = exists $options{RC}      ? $options{RC}      : undef;
+  my $devnull = exists $options{DEVNULL} ? $options{DEVNULL} : undef;
+  my $time    = exists $options{TIME}    ? $options{TIME}    : undef;
+  my @return  = ();
+
+  # Check that the $error flag is set correctly
+  $error = 'die' unless $error =~ /^(?:die|warn|ignore)$/i;
+
+  # Print the command before execution, if necessary
+  if ($time) {
+    print &timestamp_command (&get_command_string ($cmd));
+
+  } elsif ($print) {
+    &print_command ($cmd);
+  }
+
+  # Re-direct to /dev/null if necessary
+  if ($devnull) {
+    $devnull = File::Spec->devnull;
+
+    # Save current STDERR
+    no warnings;
+    open OLDERR, ">&STDERR" or croak 'Cannot dup STDERR (', $!, '), abort';
+    use warnings;
+
+    # Redirect STDERR to /dev/null
+    open STDERR, '>', $devnull
+      or croak 'Cannot redirect STDERR (', $!, '), abort';
+
+    # Make sure the channels are unbuffered
+    my $select = select;
+    select STDERR; $| = 1;
+    select $select;
+  }
+
+  if (ref ($cmd) and ref ($cmd) eq 'ARRAY') {
+    # $cmd is an array
+    my @command = @{ $cmd };
+
+    if ($method eq 'qx') {
+      @return = qx(@command);
+
+    } elsif ($method eq 'exec') {
+      exec (@command);
+
+    } else {
+      system (@command);
+      @return = $? ? () : (1);
+    }
+
+  } else {
+    # $cmd is an scalar
+    if ($method eq 'qx') {
+      @return = qx($cmd);
+
+    } elsif ($method eq 'exec') {
+      exec ($cmd);
+
+    } else {
+      system ($cmd);
+      @return = $? ? () : (1);
+    }
+  }
+
+  # Put STDERR back to normal, if redirected previously
+  if ($devnull) {
+    close STDERR;
+
+    open STDERR, ">&OLDERR" or croak 'Cannot dup STDERR (', $!, '), abort';
+  }
+
+  # Print the time taken for command after execution, if necessary
+  print &timestamp_command (&get_command_string ($cmd), 'end') if $time;
+
+  if ($?) {
+    # The command has failed
+    if ($error eq 'die') {
+      # Throw fatal error if ERROR is set to "die"
+      croak &get_command_string ($cmd), ' failed (', $?, ')';
+
+    } elsif ($error eq 'warn') {
+      # Issue warning if ERROR is set to "warn"
+      carp  &get_command_string ($cmd), ' failed (', $?, ')';
+    }
+  }
+
+  # Set the return code if necessary
+  $$rc = $? if $rc;
+
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &e_report (@message);
+#
+# DESCRIPTION
+#   The function prints @message to STDERR and aborts with a error.
+# ------------------------------------------------------------------------------
+
+sub e_report {
+  print STDERR @_, "\n" if @_;
+
+  exit 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &w_report (@message);
+#
+# DESCRIPTION
+#   The function prints @message to STDERR and returns.
+# ------------------------------------------------------------------------------
+
+sub w_report {
+  print STDERR @_, "\n" if @_;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $date = &svn_date ($time);
+#
+# DESCRIPTION
+#   The function returns a date, formatted as by Subversion. The argument $time
+#   is the number of seconds since epoch.
+# ------------------------------------------------------------------------------
+
+sub svn_date {
+  my $time = shift;
+
+  return strftime ('%Y-%m-%d %H:%M:%S %z (%a, %d %b %Y)', localtime ($time));
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
